sub.mac

calculator code ,use toshibaor nec LSI

		call	dp_adjust	;V1.17
		ret			;V1.17
ten_to_w2dp:
		call	ten_to_w2
;V3.04		call	w2_zerock;V1.13		V1.36
;V3.04		j	nz,ten_to_w2dp5;V1.13	V1.36
;V3.04		and	(W2_S),0x00;V1.13	V1.36	;clear tenkey sign(not allowed -0 entry)
ten_to_w2dp5:
		ld	hl,W2
		call	dp_adjust
		ret

;DP location is  adjusted by follow DP selector value...............
;input: HL <- work resister top address(keep hl content)
;       DP_POS  <- DP selector value (0,1,2,3,4,6)
dp_adjust:
		ld	a,(hl+OFF_DP)		;
		cmp	a,(DP_POS)		;compare work register DP <> DP selector value
		j	lt,dp_adj_00		;lower than DP selector  -> work reg. left shift(add 0 to under DP)
		j	gt,dp_adj_10		;greater than DP selector  -> work reg. right shift(remove 0 from under DP)
dp_adj_90:
		ret	

;work reg. left shift....................
dp_adj_00:
;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
		@BBC	(M14,dp_adj_0x)		;V1.21
		ld	a,(hl+OFF_MSD)		;V1.21check MSD (in case of 14digit)
		jp	dp_adj_0z		;V1.21
dp_adj_0x:					;V1.21
		@BBS	(M10,dp_adj_0y)
		ld	a,(hl+OFF_MSD12)	;V1.21check MSD (in case of 12digit)
		jp	dp_adj_0z		;V1.21
dp_adj_0y:					;V1.21
		ld	a,(hl+OFF_MSD10)	;v1.21
dp_adj_0z:					;V1.21
		@if_finance_on			;V1.07
		j	t,dp_adj_01		;V1.07
		ld	a,(hl+OFF_MSD)		;V1.07
dp_adj_01:					;V1.07
		and	a,0xf0
		j	nz,dp_adj_90		;found data at MSD  yes-> exit
		call	stg_sfl47		;work reg. left shift by nibble
		inc	(hl+OFF_DP)		;DP+1
		j	dp_adjust

;work reg. right shift....................
dp_adj_10:
		ld	a,(hl+OFF_LSD)		;check LSD
		and	a,0x0f
		j	nz,dp_adj_90		;found data at LSD  yes-> exit
		call	stg_sfr47		;work reg. right shift by nibble
		dec	(hl+OFF_DP)		;DP-1
		j	dp_adjust
;==============================================================================
;V2.10-----------------------------------
wk_round_down:
	ld	a,(MDFLG_1)
	push	a
	@CLB	(SW_RND54)
	@CLB	(SW_RNDUP)
	call	wk_round
	pop	a
	ld	(MDFLG_1),a
	ret

wk_round_up:
	ld	a,(MDFLG_1)
	push	a
	@CLB	(SW_RND54)
	@SEB	(SW_RNDUP)
	call	wk_round
	pop	a
	ld	(MDFLG_1),a
	ret
;================================================
wk_round_with_2DP:
	ld	a,(DP_POS)		
	push	a			
	ld	a,2
	ld	(DP_POS),a
	jp	wk_round_with_ten_dp_1	
	;--------------------------------
wk_round_with_const_dp:		
	ld	a,(DP_POS)		
	push	a			
	ld	a,(CONST+OFF_DP)	
	jp	wk_round_with_ten_dp_0
	;-------------------------------
wk_round_with_ten_dp:
	ld	a,(DP_POS)
	push	a
	ld	a,(TEN_DP)
	;--------------------------------
wk_round_with_ten_dp_0:
	cmp	a,(DP_POS)
	j	le,wk_round_with_ten_dp_1
	ld	(DP_POS),a
wk_round_with_ten_dp_1:
;V1.31	call	wk_round_0
	call	wk_round	;V1.31
	pop	a
	ld	(DP_POS),a
	ret
;==============================================================================
;	work resister rounding
;==============================================================================
;work registor rounding follow DP_POS and RND_STS
;	input: hl <- work reg. address (keep hl content)
;              DP_POS <- DP selector value (0,1,2,3,4,6)
;              MDFLG_0 <- DP selector position(if no any flag turn on means 'FDP')
;	       SW_RNDUP,SW_RND54 (rounding selector status)
wk_round:
		ld	a,(MDFLG_0)		;if selected floting DP
		j	nz,wk_round_0		;   no -> rounding process
wkrnd_zsp0:					;
		ld	a,(hl+OFF_DP)		;
		j	z,wkrnd_zsp9		;DP is zero?  yes -> exit
		ld	a,(hl+OFF_LSD)		;check LSD
		and	a,0x0f			; 
		j	nz,wkrnd_zsp9		;having data on last digit?  yes-> stop right shift
		call	stg_sfr47		;work reg. right shift by nibble
		dec	(hl+OFF_DP)		;DP-1
		j	wkrnd_zsp0		;
wkrnd_zsp9:					;
		j	wk_round_9		;-> exit
wk_round_0:					;

		ld	a,(hl+OFF_DP)		;
		cmp	a,(DP_POS)		;compare work register DP <> DP selector value
		j	lt,dp_adj_00		;lower than DP selector  -> jump to dp_adjust routine(left shift)
		j	gt,wk_rnd_10		;greater than DP selector  -> work reg. right shift
wk_round_9:
;V1.28		@BBS	(M_V1297,wk_round_99)	;V1.26
;V1.28		@BBC	(M_V1205,wk_round_99)	;V1.28
;V3.04		call	_zerock		;V1.28	;zero check working register(hl)V1.36
;V3.04		j	nz,wk_round_99  ;V1.28					V1.36
;V3.04		ld	(hl+OFF_S),0	;V1.28	;If all 0, then clear '-' sign	V1.36
wk_round_99:
		ret
;work reg. right shift with rounding data.......
wk_rnd_10:
		ld	b,(hl+OFF_LSD)		;keep LSD before right shift
		call	stg_sfr47		;work reg. right shift by nibble
		dec	(hl+OFF_DP)		;DP-1
		ld	a,(hl+OFF_DP)		;
		cmp	a,(DP_POS)		;compare work register DP <> DP selector value
		j	gt,wk_rnd_10		;greater than DP selector  -> contine right shift
;work reg. DP = DP selector......
		and	b,0x0f			;check previouse LSD
		j	z,wk_round_9		; if previouse LSD is ? -> no round up
		@BBS	(SW_RNDUP,wk_rnd_up)	; -> round up
		@BBC	(SW_RND54,wk_round_9)	; -> round down
;5/4...........
		cmp	b,0x05
		j	lt,wk_round_9		; -> no round up
;round up......
wk_rnd_up:
		ld	c,OFF_LSD
		ld	b,0y00000001		;for set CF=1
;work reg. +1........
wk_rnd_up0:
		ld	a,(hl+c)
		ld	CF,b.0			;set CF
		addc	a,0
		daa	a			;decimal adjust for addition
		ld	b.0,CF			;save CF to reg.b
		ld	(hl+c),a
		dec	c
		cmp	c,OFF_MSD
		j	ge,wk_rnd_up0
		j	wk_round_9

;==============================================================================
;		work register update
;==============================================================================
;	work reg <- work reg + W2
;	input: hl <- work reg. address(keep hl content)
;	output: work reg.
;	*note: DP location is  adjusted by follow DP selector value(DP_POS)
;
wk_update:
		push	hl
		ld	ix,hl
		call	move_to_w1		;W1 <- work reg.
		@BBC	(F_MIN_TRA,wk_update2)	;minus tranzaction?  no ->
		xor	(W2_S),0x01		;W2 sign change
		call	calc_add		;W1 <- W1+W2
		xor	(W2_S),0x01		;W2 sign change
		j	wk_update4
wk_update2:
		call	calc_add		;W1 <- W1+W2
wk_update4:
		ld	hl,W1		;V1.33
		call	_zerock		;V1.33	;zero check working register(hl)
		j	nz,wk_update5	;V1.33
		ld	(hl+OFF_S),0	;V1.33	;If all 0, then clear '-' sign
wk_update5:
		@BBS	(F_CALER,wk_update9)	;if error occured?  yes-> doesn't update work reg. and no dp adjustment
		ld	hl,W1
		call	dp_adjust		;adjustment DP location for accumulated answer
		pop	hl			;recover hl
		ld	iy,hl			;work reg. address set to iy
		ld	ix,W1
		call	move_9byte		;work reg. <- W1
		ret
wk_update9:
		pop	hl			;recover hl
		ret

;==============================================================================
;		item counter update
;==============================================================================
;	item counter <- item counter + 1
;	input: hl <- work reg. address(keep hl content)
;
ic_update:
		@BBC	(SW_ICPM,ic_update0)	;V1.17
		@BBC	(F_MIN_TRA,ic_update0)	;V1.17
;V2.03		@BBS	(M_V1297,ic_update_y)	;V1.29
		ld	a,(hl)		;V1.29
		and	a,0x0f		;V1.29
		or	a,(hl+1)	;V1.29
		j	ne,ic_update_y1	;V1.29
		ldw	(hl),0x9909	;V1.29
		jp	ic_update_end	;V1.29
ic_update_y:					;V1.17
		ld	a,(hl)			;V1.26
		and	a,0x10			;V1.26
		j	ne,ic_update01		;V1.26
ic_update_y1:
		set	cf			;V1.17
		ld	a,(hl+1)		;V1.17
		sub	a,1			;V1.17
		das	a			;V1.17
		ld	(hl+1),a		;V1.17
		ld	a,(hl)			;V1.17
		and	a,0x0f
		subb	a,0			;V1.17
		das	a
		ld	w,(hl)
		and	w,0x10
		and	a,0x1f
		or	a,w
		ld	(hl),a			;V1.17
		j	cs,ic_update_y2
		;--------------------------check item is "0"?
		ld	w,(hl+1)
		ld	a,(hl)
		and	a,0x0f
		or	a,w
		j	ne,ic_update_end
		ld	(hl),a
		jp	ic_update_end
ic_update_y2:
;V1.29		@BBC	(M_V1297,ic_update_end)	;V1.26
		ld	a,(hl)			;V1.26
		and	a,0x10			;V1.26
		j	eq,ic_update_end	;V1.26
		push	bc
		ld	c,(hl+1)
		ld	a,0
		set	cf
		sub	a,c
		das	a
		ld	(hl+1),a
		ld	a,0
		ld	c,(hl)
		and	c,0x0f
		subb	a,c
		das	a
		and	a,0x0f
		ld	c,(hl)
		and	c,0x10
		xor	a,c
		ld	(hl),a
		pop	bc
		jp	ic_update_end		;V1.17
ic_update0:					;V1.17
;V1.29		@BBC	(M_V1297,ic_update01)	;V1.26
		ld	a,(hl)			;V1.26
		and	a,0x10			;V1.26
		j	ne,ic_update_y1		;V1.26		
ic_update01:
		ld	a,(hl+1)
		add	a,1
		daa	a
		ld	(hl+1),a
		ld	a,(hl)
		addc	a,0
		daa	a
		and	a,0x0f
		ld	w,(hl)	;V1.26
		and	w,0x10	;V1.26
		or	a,w	;V1.26
		ld	(hl),a
		;--------------------------check item is "0"?
		ld	w,(hl+1)
		ld	a,(hl)
		and	a,0x0f
		or	a,w
		j	ne,ic_update_end
		ld	(hl),a
ic_update_end:
		ret

;==============================================================================
;	Basic calculation routines  (Addtion/Subtruction)
;==============================================================================
;
;   W1 <- W1 + or -  W2
;	note: W2 value is kept as before calculation
;	note: use W3
;
calc_add:
		@BBC	(F_CALER,cadd_00)
		ret
cadd_00:
		call	w2_to_w3		;for keep W2 contents
		call	adjust_dpw12		;adjust DP position for W1 and W2
cadd_01:
		ld	a,(W1_S)
		j	nz,cadd_15		;W1 is 'Minus'?  yes->
		ld	a,(W2_S)
		j	nz,cadd_20		;W2 is 'Minus'?  yes->

;W1 and W2 both 'Plus' or both 'Minus'...........
cadd_09:
		call	add_00			;WORK_01<-WORK_01+WORK_02
		j	cc,csub_99		;no carry?  yes-> exit
;Carry occur.............
		ld	hl,W1
		call	stg_sfr47		;W1 right shift
		set	(W1_MSD).4		;set carry to MSD
		dec	(W1_DP)			;W1_DP decrement
		j	t,error_calc		;if DP is 'Minus'?  yes-> over flow error
		j	csub_99			; -> exit

cadd_15:
		ld	a,(W2_S)
		j	nz,cadd_09		;W1 is 'Minus' and W2 is 'Minus'?  yes->
cadd_20:
;W1 is 'Plus'and W2 is 'Minus' ..................
;or W1 is 'Minus' and W2 is 'Plus'...............
		call	sub_00			;WORK01<-WORK_01-WORK_02
		j	cc,csub_99		;no borrow?  yes-> exit
;Borrow occur -> (00 --- 00) - calculated answer........
		ld	c,0
		clr	cf			;clear borrow flag
		push	psw			;borrow flag save
		ld	ix,W1_LSD
csub_03:
		pop	psw			;borrow flag recover
		ld	a,0
		subb	a,(ix)
		das	a			;decimal adjust for subtruction
		ld	(ix),a			;(W1) <- (00......00)-(W1)
		push	psw			;borrow flag save
		dec	ix
		inc	c
		cmp	c,LENG_WK
		j	lt,csub_03		;if c is lower than length of work area?  yes->loop
		pop	psw			;borrow flag recover
		xor	(W1_S),0x01		;sign invert
csub_99:
		call	adjust_12		;adjust 14digit result -> 12 digits/or 10 digit
		j	m,error_calc		;W1_DP is minus?  yes-> error
		call	zsup_under_dp
		call	neg_check		;if W1 contents is -0, then convert to --> 0
		call	w3_to_w2		;restore w2
		ret

;==============================================================================
;	Basic calculation routines  (Multiplication)
;==============================================================================
calc_mult:
		@BBC	(F_CALER,cmul_00)
		ret
cmul_00:
		call	w1_to_w3
		call	w1_clear
		
		ld	c,(W2_DP)		;DP culculation  W1_DP <- W3_DP(W1_DP) + W2_DP
		add	c,(W3_DP)		;reg.c is use for keep DP value (BBC,CLB macro use wa register)
		@BBC	(F_PERCAL,cmul_07)	;% calculation ?
		add	c,2			;yes -> add more 2
		@CLB	(F_PERCAL)
cmul_07:
		ld	(W1_DP),c		;store calculated dp
		ld	(W3_DP),0		;clear loop counter
cmul_08:
		ld	a,(W3_LSD)
		and	a,0x0f
		j	nz,cmul_85
		inc	(W3_DP)			;increment loop cnt

;4bit Right shift W1_S to W1_LSD(8bytes) -> W3_MSD to W3_LSD(7bytes).................. 
cmul_09:
		ld	hl,W1
		ld	c,OFF_S
		ld	a,0			;shift W1_S to W1_LSD(16digits)
cmul_10:		
		rord	a,(hl+c)
		inc	c
		cmp	c,OFF_DP
		j	lt,cmul_10		;if c is lower than offset of dp pointer?  yes->loop
		ld	hl,W3
		ld	c,OFF_MSD		;shift W3 MSD to W3LSD(14digits)
cmul_12:		
		rord	a,(hl+c)
		inc	c
		cmp	c,OFF_DP
		j	lt,cmul_12		;if c is lower than offset of dp pointer?  yes->loop

		cmp	(W3_DP),LENG_WK*2	;data shift 14 times?
		j	lt,cmul_08		;if W3_DP is lower than length of work area?  yes->loop

		ld	hl,W1			;check whether W1_S to W1_LSD is zero?
		ld	c,OFF_S			;
cmul_81:
		ld	a,(hl+c)
		j	nz,cmul_83		;Not Zero  yes->
		inc	c
		cmp	c,OFF_DP
		j	lt,cmul_81		;if c is lower than offset of dp pointer?  yes->loop
		j	cdiv_29			;W1_S to W1_LSD is Zero! -> exit

;WORK_01 not Zero ... WORK_01-WORK_03 right shift
cmul_83:
		dec	(W1_DP)			;
		j	cmul_09

cmul_85:
		dec	(W3_LSD)		;
		call	add_00			;W1 <- W1 + W2
		j	cc,cmul_88		;not overflow ,yes->
		inc	(W1_S)			;MSD +1(add carry to 15th digit)
cmul_88:
		j	cmul_08