;TP2.MAC contains primitive functions of TRAC80
;Look under entry points for names.
;07/13/86

	PAGE 80
	.Z80
	TITLE TP2

	ENTRY PFAD,PFGR
	ENTRY NTAIL,SIGNT,STRIP0,STADD,STSUB,CMPGR

	SUBTTL AD

PFAD:
	EXTERNAL CMI,CZO,REGM
	EXTERNAL ARGST,$ARGST,AUXST,$AUXST,VALST,$VALST
	EXTERNAL SCHEM1,SUCCA,CHECK,PSTF,PREF
	INCLUDE PREFC.INC
	INCLUDE PSTFC.INC

	CALL SCHEM1	;IF ARGST>$ALIST GOTO EXIT
	JP C,PFAD4
	LD IX,ARGST
	LD IY,AUXST
	CALL NTAIL
	LD HL,(AUXST)	;$ARGST.=AUXST-1
	DEC HL
	LD ($ARGST),HL
	INC HL
	LD DE,(ARGST)	;HL=$ARGST-ARGST+1
	SCF
	CCF
	SBC HL,DE
	CALL NZ,CHECK
	LD IX,ARGST
	LD IY,VALST
	CALL PSTF
	LD IX,AUXST
	LD IY,ARGST
	CALL SUCCA
	LD IX,ARGST
	LD IY,ARGST
	CALL NTAIL
	LD DE,(ARGST)	;IF ARGST>$ARGST GOTO PFAD2
	LD HL,($ARGST)
	SCF
	CCF
	SBC HL,DE
	JP C,PFAD2
	LD DE,(AUXST)	;IF AUXST>$AUXST GOTO PFAD1
	LD HL,($AUXST)
	SCF
	CCF
	SBC HL,DE
	JP C,PFAD1
	CALL SIGNT	;returns REGM=0,-1,-2,-3, or -4
	LD A,(REGM)	;IF REGM#-1 GOTO PFADD1
	INC A
	JP NZ,PFADD1
	LD IX,ARGST	;it's -AUXST+ARGST
	LD IY,AUXST
	JP PFADD2
PFADD1:	INC A		;IF REGM#-2 GOTO PFADD3
	JP NZ,PFADD3
	LD IX,AUXST	;it's AUXST-ARGST
	LD IY,ARGST
PFADD2:	CALL STSUB
	JP PFADD4
PFADD3:	LD IX,AUXST	;it's -AUXST-ARGST
	LD IY,ARGST
	CALL STADD
PFADD4:	LD A,(REGM)	;IF REGM>=0 GOTO PFADD5
	OR A
	JP P,PFADD5
	PREFC CMI,AUXST
PFADD5:	LD IX,VALST
	LD IY,AUXST
	CALL PREF
PFADD6:	LD HL,(AUXST)	;VALST.=AUXST
	LD (VALST),HL
	LD HL,($AUXST)
	LD ($VALST),HL
	JP PFAD4
PFAD1:	LD IX,VALST
	LD IY,ARGST
	CALL PREF
	LD HL,(ARGST)	;VALST.=ARGST
	LD (VALST),HL
	LD HL,($ARGST)
	LD ($VALST),HL
	JP PFAD4
PFAD2:	LD DE,(AUXST)	;IF AUXST>$AUXST GOTO PFADD6
	LD HL,($AUXST)
	SCF
	CCF
	SBC HL,DE
	JP NC,PFADD6
PFAD3:	LD HL,1		;both argument strings were empty
	CALL CHECK
	PSTFC CZO,VALST	;append "0" at VALST
PFAD4:	RET


	SUBTTL GR

PFGR:
	EXTERNAL CMI,CZO,REGM
	EXTERNAL ARGST,$ARGST,AUXST,$AUXST,VALST,$VALST
	EXTERNAL SCHEM1,SUCCA

	CALL SCHEM1	;IF ARGST>$ALIST GOTO EXIT
	JP C,PFGR6
	LD IX,ARGST
	LD IY,AUXST
	CALL NTAIL
	LD IX,AUXST
	LD IY,ARGST
	CALL SUCCA
	LD IX,ARGST
	LD IY,ARGST
	CALL NTAIL
	LD IX,ARGST
	LD IY,VALST
	CALL SUCCA
	LD HL,($ARGST)	;IF ARGST>$ARGST GOTO PFGR1
	LD DE,(ARGST)
	SCF
	CCF
	SBC HL,DE
	JP C,PFGR1
	LD HL,($AUXST)	;IF AUXST>$AUXST GOTO PFGR3
	LD DE,(AUXST)
	SCF
	CCF
	SBC HL,DE
	JP C,PFGR3
	CALL SIGNT	;returns REGM=0,-1,-2,-3, or -4
	LD A,(REGM)	;IF REGM=-1 GOTO PFGR5 (not greater)
	INC A
	JP Z,PFGR5
	INC A		;IF REGM=-2 GOTO PFGR6 (greater)
	JP Z,PFGR6
	LD IX,AUXST	;check AUXST-ARGST
	LD IY,ARGST
	CALL STSUB
	LD A,(REGM)	;IF REGM=1 GOTO PFGR6 (greater)
	CP 1
	JP Z,PFGR6
	JP PFGR5	;else GOTO PFGR5 (not greater)
PFGR1:	LD HL,($AUXST)	;IF AUXST>$AUXST GOTO PFGR5
	LD DE,(AUXST)
	SCF
	CCF
	SBC HL,DE
	JP C,PFGR5
	LD HL,CMI
	JP NZ,PFGR2	;IF AUXST<$AUXST GOTO PFGR2
	LD HL,CZO
PFGR2:	LD A,(DE)	;IF c(AUXST)=CMI or =CZO GOTO PFGR5
	CP (HL)
	JP Z,PFGR5
	JP PFGR6	;else GOTO PFGR6
PFGR3:	LD HL,($ARGST)	;IF ARGST=$ARGST GOTO PFGR5
	LD DE,(ARGST)
	SCF
	CCF
	SBC HL,DE
	JP Z,PFGR5
PFGR4:	LD HL,CMI	;IF c(ARGST)=CMI GOTO PFGR6
	LD A,(DE)
	CP (HL)
	JP Z,PFGR6
PFGR5:	LD IX,VALST	;not greater
	LD IY,VALST
	CALL SUCCA
PFGR6:	RET


	SUBTTL NTAIL

NTAIL:	;P1: IX = string in which numeric tail is to be found
	;P2: IY = part of P1 containing only the numeric tail
	;Note:	A leading minus sign is part of the numeric tail
	;	and so are leading zeros. Leading zeros, however,
	;	will be stripped off in the sign test subroutine (SIGNT).
	EXTERNAL CMI,CZO
	LD L,(IX+2)	;$P2.=$P1
	LD H,(IX+3)
	LD B,H		;store end-of-string address
	LD C,L
	LD (IY+2),L
	LD (IY+3),H
	EX DE,HL	;DE=$P1
	LD L,(IX+0)	;IF P1>DE GOTO NTAIL2
	LD H,(IX+1)
NTAIL1:	PUSH HL
	SCF
	SBC HL,DE
	JP NC,NTAIL2
	LD A,(DE)	;check if c(DE)=minus sign
	LD HL,CMI
	CP (HL)
	JP Z,NTAIL3
	CP 30H		;or digit
	JP C,NTAIL2
	CP 3AH
	JP NC,NTAIL2
	DEC DE		;DECR DE
	POP HL
	JP NTAIL1
NTAIL2:	INC DE		;positive number
	JP NTAIL5
NTAIL3:	LD A,C		;negative number
	CP E		;if it's the only character
	JP NZ,NTAIL5
	LD A,B
	CP D
	JP NZ,NTAIL5
	LD A,(CZO)	;generate string "0"
	LD (DE),A
NTAIL5:	POP HL
	LD (IY+0),E
	LD (IY+1),D
	RET


	SUBTTL SIGNT

SIGNT:	;checks for leading minus signs in both ARGST and AUXST.
	;Depending upon the signs of the two argument strings 
	;the subroutine returns
	;REGM =  0	iff	 AUXST   ARGST
	;	-1	iff	-AUXST	 ARGST
	;	-2	iff	 AUXST	-ARGST
	;	-3	iff	-AUXST	-ARGST
	;Note:	The subroutine strips not only the minus signs off 
	;	the strings but then also any leading zeros.
	EXTERNAL CMI,REGM
	EXTERNAL ARGST,AUXST
	XOR A
	LD B,A		;REGM.=0
	LD HL,CMI
	LD DE,(AUXST)	;IF c(AUXST)#CMI GOTO SIGNT1
	LD A,(DE)
	CP (HL)
	JP NZ,SIGNT1
	INC DE		;INCR AUXST
	LD (AUXST),DE
	DEC B		;DECR REGM
SIGNT1:	LD DE,(ARGST)	;IF c(ARGST)#CMI GOTO SIGNT2
	LD A,(DE)
	CP (HL)
	JP NZ,SIGNT2
	INC DE		;INCR ARGST
	LD (ARGST),DE
	DEC B		;DECR REGM
	DEC B		;DECR REGM
SIGNT2:	LD A,B
	LD (REGM),A
	LD HL,(AUXST)	;strip leading zeros off AUXST
	LD DE,($AUXST)
	CALL STRIP0
	LD (AUXST),HL
	LD HL,(ARGST)	;strip leading zeros off ARGST
	LD DE,($ARGST)
	CALL STRIP0
	LD (ARGST),HL
	RET

STRIP0:	;strips leading zeros off the string between HL and DE
	LD A,(CZO)
STRIP1:	PUSH HL
	SCF		;end of string?
	CCF
	SBC HL,DE
	POP HL
	JP P,STRIP2
	CP (HL)
	JP NZ,STRIP2
	INC HL
	JP STRIP1
STRIP2:	RET


	SUBTTL STADD

STADD:	;returns as AUXST a string containing the arithmetic sum 
	;of two strings to the current basis.
	;P1: IX = string containing first summand
	;P2: IY = string containing second summand
	EXTERNAL REGH,REGJ,REGK,REGL,REGN,BASIS,CZO
	EXTERNAL AUXST,$AUXST
	LD E,(IX+0)
	LD D,(IX+1)
	PUSH DE
	LD L,(IX+2)
	LD H,(IX+3)
	PUSH HL
	SCF
	CCF
	SBC HL,DE
	EX DE,HL	;DE=$P1-P1
	LD C,(IY+0)
	LD B,(IY+1)
	PUSH BC
	LD L,(IY+2)
	LD H,(IY+3)
	PUSH HL
	SCF
	CCF
	SBC HL,BC	;HL=$P2-P2
	SCF		;IF HL>DE GOTO STADD1
	SBC HL,DE
	JP NC,STADD1	;swap argument strings
	POP BC		;BC=$P2
	POP HL
	LD (REGJ),HL	;REGJ=P2
	POP DE		;DE=$P1
	POP HL
	LD (REGK),HL	;REGK=P1
	JP STADD7
STADD1:	POP DE		;DE=$P2
	POP HL
	LD (REGK),HL	;REGK=P2
	POP BC		;BC=$P1
	POP HL
	LD (REGJ),HL	;REGJ=P1
STADD7:	LD ($AUXST),DE	;$AUXST.=$P2
	LD A,(BASIS)	;REGL.=BASIS+CZO
	LD HL,CZO
	ADD A,(HL)
	LD (REGL),A
	XOR A		;REGN.=0 (Carry)
	LD (REGN),A
STADD2:	LD A,(BC)	;A.=c(BC)-CZO
	LD HL,CZO
	SUB (HL)
STADD3:	EX DE,HL	;A.=A+c(DE)
	ADD A,(HL)
	EX DE,HL
	LD HL,REGN	;A.=A+REGN
	ADD A,(HL)
	LD (HL),0	;REGN.=0
	LD HL,REGL	;IF REGL>A GOTO STADD4
	CP (HL)
	JP C,STADD4
	LD HL,REGN	;INCR REGN
	INC (HL)
	LD HL,BASIS	;A.=A-BASIS
	SUB (HL)
STADD4:	LD (DE),A	;c(DE).=A
	DEC DE		;DECR DE
	LD HL,(REGJ)	;IF BC=REGJ GOTO STADD5
	SCF
	CCF
	SBC HL,BC
	JP Z,STADD5
	DEC BC		;DECR BC
	JP STADD2	;GOTO STADD2
STADD5:	LD A,(REGN)	;IF REGN=0 GOTO STADD6
	OR A
	JP Z,STADD6
	XOR A		;A.=0
	LD HL,(REGK)	;IF REGK<=DE GOTO STADD3
	SCF
	SBC HL,DE
	JP C,STADD3
	LD A,(CZO)	;c(DE).=CZO+1
	INC A
	LD (DE),A
	LD (REGK),DE
STADD6:	LD HL,(REGK)	;AUXST.=REGK
	LD (AUXST),HL
	RET


	SUBTTL STSUB

STSUB:	;returns as AUXST a string containing the arithmetic difference
	;of two strings to the current basis.
	;P1: IX = string containing subtrahend
	;P2: IY = string containing subtractor
	;Note: The subroutine sets the auxiliary register
	;	REGM= 1	iff 	  > 0
	;	REGM= 0	iff IX-IY = 0
	;	REGM=-1 iff	  < 0
	EXTERNAL REGH,REGJ,REGK,REGL,REGM,REGN,BASIS,CZO
	EXTERNAL AUXST,$AUXST
	LD E,(IX+0)
	LD D,(IX+1)
	PUSH DE
	LD L,(IX+2)
	LD H,(IX+3)
	PUSH HL
	SCF
	CCF
	SBC HL,DE
	EX DE,HL	;DE=$P1-P1
	LD C,(IY+0)
	LD B,(IY+1)
	PUSH BC
	LD L,(IY+2)
	LD H,(IY+3)
	PUSH HL
	SCF
	CCF
	SBC HL,BC	;HL=$P2-P2
	EX DE,HL	;IF HL#DE GOTO STSUB1
	SCF
	CCF
	SBC HL,DE
	JP NZ,STSUB1
	CALL CMPGR	;Compare |string IX| with |string IY|
	OR A
	JP M,STSUB2	;it's <
	JP NZ,STSUB3	;it's >
	LD (REGM),A	;it's =, i.e. AUXST="0"
	LD A,(CZO)
	POP HL
	LD (HL),A
	LD (AUXST),HL
	LD ($AUXST),HL
	POP HL
	POP HL
	POP HL
	JP STSUBX
STSUB1:	JP NC,STSUB3	;IF DE<HL GOTO STSUB3
STSUB2:	POP BC		;Swap argument strings. Result's gonna be <0
	POP HL
	LD (REGJ),HL
	POP DE
	POP HL
	LD (REGK),HL
	LD A,-1
	JP STSUB9
STSUB3:	POP DE
	POP HL
	LD (REGK),HL
	POP BC
	POP HL
	LD (REGJ),HL
	LD A,1
STSUB9:	LD (REGM),A
	LD ($AUXST),BC	;$AUXST.=BC
STSUB4:	XOR A		;REGN.=0  (Borrow)
	LD (REGN),A
	LD A,(BC)	;A.=c(BC)-c(DE)  (Difference)
	LD H,D
	LD L,E
	SUB (HL)
	JP P,STSUB5	;IF A>=0 GOTO STSUB5
	LD HL,BASIS	;A.=A+BASIS
	ADD A,(HL)
	LD HL,REGN	;INCR REGN
	INC (HL)
STSUB5:	LD HL,CZO	;c(BC).=A+CZO
	ADD A,(HL)
	LD (BC),A
	DEC BC		;DECR BC
	LD HL,(REGK)	;IF DE=REGK GOTO STSUB6
	SCF
	CCF
	SBC HL,DE
	JP Z,STSUB6
	DEC DE		;DECR DE
	LD A,(DE)	;c(DE).=c(DE)+REGN
	LD HL,REGN
	ADD A,(HL)
	LD (DE),A
	JP STSUB4	;GOTO STSUB4
STSUB6:	LD HL,(REGJ)	;IF BC<REGJ GOTO STSUB7
	SCF
	SBC HL,BC
	JP NC,STSUB7
	LD A,(REGN)	;IF REGN=0 GOTO STSUB8
	OR A
	JP Z,STSUB8
	LD A,(CZO)	;c(DE).=CZO+1
	INC A
	LD (DE),A
	JP STSUB4	;GOTO STSUB4
STSUB7:	LD A,(CZO)	;IF c(REGJ)#CZO GOTO STSUB8
	LD HL,(REGJ)
STSUB0:	CP (HL)
	JP NZ,STSUB8
	INC HL		;INCR REGJ
	LD (REGJ),HL
	JP STSUB0
STSUB8:	LD HL,(REGJ)	;AUXST.=REGJ
	LD (AUXST),HL
STSUBX:	RET


	SUBTTL CMPGR

CMPGR:	;compares two strings P1 and P2 for which one is numerically greater.
	;P1: IX = string
	;P2: IY = string
	;Note:	Both strings have to be of equal length 
	;	and must not contain leading zeros.
	;The subroutine returns
	;A =  1	iff P1 is greater than P2
	;A =  0	iff P1 is equal to P2
	;A = -1 iff P1 is less than P2
	LD L,(IX+0)
	LD H,(IX+1)
	LD E,(IX+2)
	LD D,(IX+3)
	LD C,(IY+0)
	LD B,(IY+1)
CMPGR1:	LD A,(BC)
	SUB (HL)
	JP NZ,CMPGR2
	INC BC
	INC HL
	PUSH HL
	SCF
	SBC HL,DE
	POP HL
	JP C,CMPGR1
	XOR A
	JP CMPGR4
CMPGR2:	JP C,CMPGR3
	LD A,-1
	JP CMPGR4
CMPGR3:	LD A,1
CMPGR4:	RET


	END
