sub.mac

calculator code ,use toshibaor nec LSI

;==============================================================================
;	Basic calculation routines  (Division)
;==============================================================================
calc_div:
		@BBC	(F_CALER,cdiv_00)
		ret
cdiv_00:
		call	w1_to_w3
		call	w1_clear
		ld	c,(W3_DP)		;DP culculation  W1_DP <- W3_DP(W1_DP) - W2_DP
		sub	c,(W2_DP)		;reg.c is use for keep DP value (BBC,CLB macro use wa register)
		@BBC	(F_PERCAL,cdiv_07)	;% calculation ?
		sub	c,2			;yes -> subtruct more 2
		@CLB	(F_PERCAL)
cdiv_07:
		ld	(W1_DP),c		;store calculated dp
		ld	(W3_DP),0		;clear loop counter
cdiv_08:
		call	sub_00			;W1 <- W1 - W2
		j	cc,cdiv_09		;no borrow?  yes->
		ld	a,(W1_S)		;15th digit is zero?
		j	z,cdiv_10		; yes(can't subtruct) -> restore(add data) W2 and shift data
		dec	(W1_S)			;15th digit - 1
cdiv_09:
		ld	a,(W3_LSD)		;W3_LSD (subtruction times)
		swap	a
		add	a,0x10
		daa	a
		swap	a
		ld	(W3_LSD),a		;W3_LSD + 1
		j	cc,cdiv_08		;still not yet 10 times  yes->
		@SEB	(F_ZDIVER)
;Zero divide error..............................
;error exit for Mul,Div routine.................
error_calc_s:
		ld	a,(W1_S)
		add	a,(W2_S)
		and	a,0x01
		ld	(W1_S),a		;update minus sign
		call	neg_check		;-0 --> 0
;error exit for Plus,Minus routine.................
error_calc:
		@SEB	(F_CALER)
		@CLB	(F_PERCAL)
		ld	a,(W1_DP)
		add	a,0			;check negative flag
		j	p,error_c9		;W1_DP is plus?  yes->
;V1.21	@if(@eqs(@D14,@ON))then(
;V1.21		add	(W1_DP),LENG_WK*2	;W1_DP adjustment for calclation error print (14digit)
;V1.21	)else(
;V1.21		add	(W1_DP),(LENG_WK-1)*2	;W1_DP adjustment for calclation error print (12digit)
;V1.21	)fi
		push	wa
		@BBC	(M14,error_calc6)	;V1.21
		add	(W1_DP),LENG_WK*2	;V1.21
		jp	error_calc8		;V1.21
error_calc6:					;V1.21
		@BBS	(M10,error_calc7)	;V1.21
		add	(W1_DP),(LENG_WK-1)*2	;V1.21
		jp	error_calc8		;V1.21
error_calc7:					;V1.21
		add	(W1_DP),(LENG_WK-2)*2	;V1.21
error_calc8:					;V1.21
		pop	wa			;V1.21
		@if_finance_on			;V1.07
		j	t,error_c9		;V1.07
		add	(W1_DP),LENG_WK*2	;V1.07

error_c9:
		@BBC(E_MUL,error_c9x)		;V3.09
error_c9y:					;V3.09
		ld	a,(W1_DP)		;V3.09
		j	eq,error_c9x		;V3.09
		ld	a,(W1_LSD)		;V3.09
		and	a,0x0f			;V3.09
		j	ne,error_c9x		;V3.09
		ld	hl,W1			;V3.09
		call	stg_sfr47		;V3.09
		dec	(W1_DP)			;V3.09
		jp	error_c9y		;V3.09
error_c9x:					;V3.09
		ret


;Add back W2, and shift data W3_LSD to W1_S.....
cdiv_10:
		call	add_00			;W1 <- W1 + W2
		cmp	(W3_DP),LENG_WK*2	;data shift 14 times?
		j	ge,cdiv_20		;if W3_DP is greater than or equal to length of work area?  yes ->division end
		inc	(W3_DP)			;increment loop cnt
cdiv_11:
		ld	hl,W3
		ld	c,OFF_LSD
		ld	a,0			;shift W3_LSD to W3_MSD(14digits)
cdiv_12:		
		rold	a,(hl+c)
		dec	c
		cmp	c,OFF_S
		j	ne,cdiv_12		;if c is not equal to sign pointer?  yes -> loop

		ld	hl,W1
		ld	c,OFF_LSD		;shift W1_LSD to W1_S(16digits)
cdiv_14:		
		rold	a,(hl+c)
		cmp	c,OFF_S
		j	eq,cdiv_16		;if c equal to sign pointer?  yes -> exit
		dec	c
		j	cdiv_14
cdiv_16:
		and	(W1_S),0x0f
		j	cdiv_08

cdiv_20:
		ld	a,(W3_MSD)		;14th digit of result
		and	a,0xf0
		j	nz,cdiv_29		;if 14th digit is not zero?  yes-> exit
		ld	a,(W1_DP)
		add	a,0			;check negative flag
		j	m,cdiv_22		;W1_DP is minus?  yes-> continue divide
		cmp	(W1_DP),LENG_WK*2-1	;W1_DP is maximum? (over 13?)
		j	ge,cdiv_29		;W1_DP is greater or equal to 13?  yes-> exit
cdiv_22:
		inc	(W1_DP)			;
		j	cdiv_11			;continue divide
cdiv_29:
		ld	a,(W1_DP)
		add	a,0			;check negative flag
		j	p,cdiv_30		;W1_DP is plus?  yes->
;over flow error.........
		ld	w,(W1_DP)		;reg.w is use for keep DP value (w3_to_w1 routine use a,c,ix,iy register)
		call	w3_to_w1		;transfer result(W3) to W1
		ld	(W1_DP),w		;recover W1_DP
		call	adjust_12		;adjust 14digit result -> 12 digits (selected 12digit model only)
		j	error_calc_s

cdiv_30:
		cmp	(W1_DP),LENG_WK*2
		j	lt,cdiv_32		;if W1_DP is lower than maximum digit?(14)  yes->
		ld	hl,W3
		call	stg_sfr47
		dec	(W1_DP)
		j	cdiv_30
cdiv_32:
		ld	w,(W1_DP)		;reg.w is use for keep DP value (w3_to_w1 routine use a,c,ix,iy register)
		call	w3_to_w1
		ld	(W1_DP),w		;update W1_DP
		call	adjust_12		;adjust 14digit result -> 12 digits (selected 12digit model only)
		j	m,error_calc_s		;W1_DP is minus?  yes-> error
		call	zsup_under_dp		;zero suppression for under dp
		ld	a,(W1_S)
		add	a,(W2_S)
		and	a,0x01
		ld	(W1_S),a		;update minus sign
		call	neg_check		;-0 --> 0
		ret

;==============================================================================
;	(WORK_01) <--- |(WORK_01)| + |(WORK_02)|  7bytes addition
;==============================================================================
add_00:
		ld	c,0
		clr	cf
		push	psw			;carry flag save
		ld	ix,W1_LSD
		ld	iy,W2_LSD
add_01:
		pop	psw			;carry flag recover
		ld	a,(ix)
		addc	a,(iy)
		daa	a			;decimal adjust for addition
		ld	(ix),a			;(W1) <- (W1)+(W2)
		push	psw			;carry flag save
		dec	ix
		dec	iy
		inc	c
		cmp	c,LENG_WK
		j	lt,add_01		;if c is lower than length of work area?  yes->loop
		pop	psw			;carry flag recover
		ret
;==============================================================================
;	(WORK_01) <--- |(WORK_01)| - |(WORK_02)|  7bytes subtruction
;==============================================================================
sub_00:
		ld	c,0
		clr	cf			;clear borrow flag
		push	psw			;borrow flag save
		ld	ix,W1_LSD
		ld	iy,W2_LSD
sub_01:
		pop	psw			;borrow flag recover
		ld	a,(ix)
		subb	a,(iy)
		das	a			;decimal adjust for subtruction
		ld	(ix),a			;(W1) <- (W1)-(W2)
		push	psw			;borrow flag save
		dec	ix
		dec	iy
		inc	c
		cmp	c,LENG_WK
		j	lt,sub_01		;if c is lower than length of work area?  yes->loop
		pop	psw			;borrow flag recover
		ret
;==============================================================================
;	Zero suppression for under DP	xx.xxx0000 ->  xx.xxx
;==============================================================================
zsup_under_dp:
		ld	a,(W1_DP)
		j	z,zsup_udp_9		;DP is zero?  yes -> exit
		ld	a,(W1_LSD)
		and	a,0x0f
		j	nz,zsup_udp_9
		ld	hl,W1
		call	stg_sfr47
		dec	(W1_DP)
		j	zsup_under_dp
zsup_udp_9:
		ret

;==============================================================================
;   	Adjust W1 contents 14 -> 12digit length (in case of D14 is off)
;==============================================================================
adjust_12:
	@if_finance_on		;V1.07
	j	f,adj12_6	;V1.07
;V1.21	@if(@eqs(@D14,@ON))then(
;V1.21		cmp	(W1_DP),0		;check negative flag
;V1.21	)else(
		@BBC	(M14,adj12_2)	;V1.21
		cmp	(W1_DP),0	;V1.21
		jp	adj12_9		;V1.21
adj12_2:
		@BBC	(M10,adjnot10)
		ld	a,(W1_MSD)	;V1.21
		or	a,(W1_MSD+1)	;V1.21
		jp	adjis12		;V1.21
adjnot10:
		ld	a,(W1_MSD)		;check 14,13 digit
adjis12:
		j	z,adj12_4		;zero? yes -> no right shift 
		ld	hl,W1
		call	stg_sfr47		;W1 right shift by nibble
		dec	(W1_DP)
		j	adj12_2
adj12_4:
		cmp	(W1_DP),0		;check negative flag
		j	m,adj12_9		;W1_DP is minus?  yes-> overflow error
;V1.21		cmp	(W1_DP),MAX_DIGIT	;DP is less than 12? (check in case of 0.123456789012)
		@BBS	(M14,adj12_41)	;V1.21
		@BBC	(M10,adj12_42)	;V1.21
		cmp	(W1_DP),10	;V1.21
		jp	adj12_43	;V1.21
adj12_41:				;V1.21
		cmp	(W1_DP),14	;V1.21
		jp	adj12_43	;V1.21
adj12_42:
		cmp	(W1_DP),12	;V1.21
adj12_43:	
		j	lt,adj12_6		; yes -> OK
		ld	hl,W1
		call	stg_sfr47		;W1 right shift one more time
		dec	(W1_DP)
		j	adj12_4
adj12_6:
		cmp	(W1_DP),0		;check negative flag
adj12_9:
;V1.21	)fi
		ret

;==============================================================================
;	Zero check, Negative 0 check
;==============================================================================
neg_check:
;V4.17		@BBC	(M_5514T,neg_check9)	;v4.11
;V4.19		@IS_5514_ON(neg_check9)	;V4.17
		@IS_5514_OFF(neg_check9)	;V4.19
		call	w1_zerock	;V1.13 V1.36
		j	nz,neg_check9	;V1.13 V1.36
		ld	(W1_S),0	;V1.13 V1.36;If all 0, then clear '-' sign and DP
		ld	(W1_DP),0	;V1.13 V1.36
neg_check9:
		ret

ten_zerock:
		ld	hl,TENKEY
		j	_zerock
w1_zerock:
		ld	hl,W1
		j	_zerock
w2_zerock:
		ld	hl,W2
_zerock:
		ld	a,(hl+OFF_MSD)		;7byte data zero check
		or	a,(hl+OFF_MSD+1)
		or	a,(hl+OFF_MSD+2)
		or	a,(hl+OFF_MSD+3)
		or	a,(hl+OFF_MSD+4)
		or	a,(hl+OFF_MSD+5)
		or	a,(hl+OFF_MSD+6)
		ret
_spaceck:
		ld	a,(hl+OFF_MSD)		;7byte data zero check
		cmp	a,0xff
		j	ne,_spaceck_end
		ld	a,(hl+OFF_MSD+1)
		cmp	a,0xff
		j	ne,_spaceck_end
		ld	a,(hl+OFF_MSD+2)
		cmp	a,0xff
		j	ne,_spaceck_end
		ld	a,(hl+OFF_MSD+3)
		cmp	a,0xff
		j	ne,_spaceck_end
		ld	a,(hl+OFF_MSD+4)
		cmp	a,0xff
		j	ne,_spaceck_end
		ld	a,(hl+OFF_MSD+5)
		cmp	a,0xff
		j	ne,_spaceck_end
		ld	a,(hl+OFF_MSD+6)
		cmp	a,0xff
		j	ne,_spaceck_end
		ld	a,(hl+OFF_MSD+7)
		cmp	a,0xff
		j	ne,_spaceck_end
_spaceck_end:
		ret		
;==============================================================================
;	Adjust DP position for W1 and W2 (for before addition)
;==============================================================================
adjust_dpw12:
		ld	a,(W1_DP)
		cmp	a,(W2_DP)
		j	eq,adj_dp_90
		j	lt,adj_dp_50		;if W1_DP is Lower than W2_DP?  yes ->
;W1_DP > W2_DP....................
		ld	hl,W2
adj_dp_02:
;V1.21	@if(@eqs(@D14,@ON))then(
;V1.21		ld	a,(hl+OFF_MSD)		;check MSD (in case of 14digit)
;V1.21	)else(
;V1.21		ld	a,(hl+OFF_MSD12)	;check MSD (in case of 12digit)
;V1.21	)fi
		@BBS	(F_FINCAL,adj_dp_020)	;V1.39b
		@BBC	(M14,adj_dp_021)	;V1.21;V1.32;V1.39b
adj_dp_020:
		ld	a,(hl+OFF_MSD)		;V1.21
		jp	adj_dp_022		;V1.21;V1.32;V1.39b
adj_dp_021:					;V1.21;V1.32;V1.39b
		@BBS	(M10,adj_dp_0210)	;V1.21;V1.32;V1.39b
		ld	a,(hl+OFF_MSD12)	;V1.21;V1.32;V1.39b
		jp	adj_dp_022		;V1.21;V1.32;V1.39b
adj_dp_0210:					;V1.21;V1.32;V1.39b
		ld	a,(hl+OFF_MSD10)	;V1.21;V1.32;V1.39b
adj_dp_022:					;V1.21;V1.32;V1.39b
		@if_finance_on			;V1.07
		j	t,adj_dp_03		;V1.07
		ld	a,(hl+OFF_MSD)		;V1.07
adj_dp_03:					;V1.07
		and	a,0xf0
		j	z,adj_dp_52		;no data?  yes->
		cmp	hl,W1
		j	eq,adj_dp_51
		ld	hl,W1
adj_dp_05:
		call	stg_sfr47		;4bit shift ->
		dec	(hl+OFF_DP)		;decriment DP
		j	adjust_dpw12
;W1_DP < W2_DP....................
adj_dp_50:
		ld	hl,W1
		j	adj_dp_02
adj_dp_51:
		ld	hl,W2
		j	adj_dp_05
adj_dp_52:
		call	stg_sfl47		;4bit shift <-
		inc	(hl+OFF_DP)		;increment DP
		j	adjust_dpw12
adj_dp_90:
		ret

;===================================================
;	7bytes data shift to right by 4bit
;	input:	HL <- data top address
;	shift area: top address +1 to +7
;===================================================
stg_sfr47:
		ld	c,OFF_MSD
		ld	a,0
stg_sfr470:		
		rord	a,(hl+c)
		inc	c
		cmp	c,OFF_DP
		j	lt,stg_sfr470		;if c is lower than offset of dp pointer?  yes->loop
		ret
;===================================================
;	7bytes data shift to left by 4bit
;	input:	HL <- data top address
;	shift area: top address +1 to +7
;===================================================
stg_sfl47:
		ld	c,OFF_LSD
		ld	a,0
stg_sfl470:		
		rold	a,(hl+c)
		dec	c
		cmp	c,OFF_MSD
		j	ge,stg_sfl470		;if c is greater or equal to MSD pointer?  yes->loop
		ret
;===================================================
;	9bytes data shift to right by 4bit(for #/D)
;	input:	HL <- data top address
;	shift area: top address +0 to +8
;===================================================
stg_sfr49:
		ld	c,0
		ld	a,0
stg_sfr490:		
		rord	a,(hl+c)
		inc	c
		cmp	c,9
		j	lt,stg_sfr490
		ret
;===================================================
;	9bytes data shift to left by 4bit(for #/D)
;	input:	HL <- data top address
;	shift area: top address +0 to +8
;===================================================
stg_sfl49:
		ld	c,8
		ld	a,0
stg_sfl490:		
		rold	a,(hl+c)
		dec	c
		j	f,stg_sfl490		;if c is not FF  yes->loop
		ret



	end