;TP3.MAC contains primitive functions of TRAC80
;Look under entry points for names.
;08/03/86

	PAGE 80
	.Z80
	TITLE TP3

	ENTRY PFML
	ENTRY CVRTAB,CVRTBA,MULTHL

	SUBTTL ML

PFML:
	EXTERNAL CMI,CZO,REGM,BASIS
	EXTERNAL REGH,REGJ,REGK,REGL,REGN
	EXTERNAL ARGST,$ARGST,AUXST,$AUXST,ENTST,$ENTST,VALST,$VALST
	EXTERNAL SCHEM1,SUCCA,CHECK,NTAIL,SIGNT,DIVA,PREF,STRIP0

	INCLUDE PREFC.INC
	INCLUDE PSTFC.INC

	CALL SCHEM1	;IF ARGST>$ALIST GOTO EXIT
	JP C,PFML9
	LD IX,ARGST
	LD IY,AUXST
	CALL NTAIL
	LD HL,(AUXST)	;$ENTST.=AUXST-1 (save Alpha-prefix as ENTST)
	DEC HL
	LD ($ENTST),HL
	LD DE,(ARGST)
	LD (ENTST),DE
	INC HL		;HL=$ARGST-ARGST+1
	SCF
	CCF
	SBC HL,DE
	CALL NZ,CHECK	;check if space for Alpha-prefix
	LD IX,AUXST
	LD IY,ARGST
	CALL SUCCA
	LD IX,ARGST
	LD IY,ARGST
	CALL NTAIL
	LD DE,(ARGST)	;IF ARGST>$ARGST GOTO PFML7 (result is 0)
	LD HL,($ARGST)
	SCF
	CCF
	SBC HL,DE
	JP C,PFML7
	LD DE,(AUXST)	;IF AUXST>$AUXST GOTO PFML7 (result is 0)
	LD HL,($AUXST)
	SCF
	CCF
	SBC HL,DE	;HL=length-1 of AUXST
	JP C,PFML7
	CALL SIGNT	;returns REGM=0,-1,-2, or -3
	LD DE,(ARGST)
	LD HL,($ARGST)
	SCF
	CCF
	SBC HL,DE
	PUSH HL
	LD DE,(AUXST)
	LD HL,($AUXST)
	SCF
	CCF
	SBC HL,DE	;HL=length-1 of AUXST
	POP DE		;DE=length-1 of ARGST
	PUSH HL		;make sure HL points to the longer string
	SCF		;if HL>=DE goto PFML1
	CCF
	SBC HL,DE
	POP HL
	JP NC,PFML1
	PUSH HL
	LD HL,(ARGST)	;else swap ARGST and AUXST
	PUSH HL
	LD HL,($ARGST)
	PUSH HL
	LD HL,(AUXST)
	LD (ARGST),HL
	LD HL,($AUXST)
	LD ($ARGST),HL
	POP HL
	LD ($AUXST),HL
	POP HL
	LD (AUXST),HL
	POP HL
	EX DE,HL
PFML1:	INC HL
	LD (REGJ),HL	;REGJ=length of AUXST
	INC DE
	LD (REGK),DE	;REGK=length of ARGST
	ADD HL,DE
	PUSH HL
	CALL CHECK	;check if space for maximum VALST
	POP BC
	INC BC
	LD HL,(VALST)
	LD (REGH),HL	;REGH.=VALST
	ADD HL,BC	;shift VALST for max.result
	LD (VALST),HL
	LD HL,($VALST)
	ADD HL,BC
	LD ($VALST),HL
	LD HL,(AUXST)	;convert AUXST from ASCII to binary
	LD DE,($AUXST)
	CALL CVSTAB
	LD HL,(ARGST)	;convert ARGST from ASCII to binary
	LD DE,($ARGST)
	CALL CVSTAB
	LD BC,(REGK)	;for BC=REGK downto 1
PFML2:	XOR A			;REGN.=0 (carry)
	LD (REGN),A
	LD HL,(ARGST)		;REGL.=c(ARGST(BC))
	ADD HL,BC
	DEC HL
	LD A,(HL)
	LD (REGL),A
	LD DE,(REGJ)		;for DE=REGJ downto 1
PFML3:	PUSH DE
	LD HL,(AUXST)			;A.=c(AUXST(DE))
	ADD HL,DE
	DEC HL
	LD A,(HL)
	LD L,A				;L.=A
	LD A,(REGL)			;H.=REGL
	LD H,A
	CALL MULTHL			;HL=H*L (8-bit multiplication)
	PUSH HL
	LD HL,(REGH)			;HL.=REGH+REGJ+REGK
	ADD HL,BC
	ADD HL,DE
	XOR A				;A.=0
	PUSH HL				;if HL<VALST GOTO PFML4
	LD DE,(VALST)
	SCF
	CCF
	SBC HL,DE
	POP HL
	EX DE,HL			;save HL in DE
	JP C,PFML4
	LD A,(DE)			;A.=c(DE)
PFML4:	POP HL				;HL.=HL+A+REGN
	PUSH DE
	LD D,0
	LD E,A
	ADD HL,DE
	LD A,(REGN)
	LD E,A
	ADD HL,DE
	LD A,(BASIS)			;REGN.=HL / BASIS (integer division)
	CALL DIVA			;L=quotient
	LD A,L
	LD (REGN),A
	LD A,H				;H=residuum
	POP HL				;replace digit in VALST
	LD (HL),A
	POP DE
	DEC DE			;next DE
	LD A,D
	OR E
	JP NZ,PFML3
	LD A,(REGN)		;if REGN>0 then
	OR A
	JP Z,PFML5
	DEC HL			;prefix carry at VALST
	LD (HL),A
PFML5:	LD (VALST),HL
	DEC BC		;next BC
	LD A,B
	OR C
	JP NZ,PFML2
	LD DE,($VALST)	;convert VALST from binary to ASCII
	CALL CVSTBA
	LD HL,(VALST)	;strip off leading zeros between HL and DE
	LD DE,($VALST)
	CALL STRIP0
	LD (VALST),HL
	LD A,(REGM)	;check sign
	INC A
	JP Z,PFML6	;if REGM=-1
	INC A
	JP NZ,PFML8	;or REGM=-2
PFML6:	PREFC CMI,VALST	;put a minus sign before VALST
	JP PFML8
PFML7:	LD HL,1		;both argument strings were empty
	CALL CHECK
	PSTFC CZO,VALST	;append "0" at VALST
PFML8:	LD IX,ENTST	;attach Alpha-prefix
	LD IY,VALST
	CALL PREF
PFML9:	RET


CVRTAB:	;converts the ASCII char in A into a binary number.
	;The result is taken modulo the current numerical basis.
	EXTERNAL BASIS
	PUSH HL
	SUB 30H
	CP 0AH
	JP C,CVRTA1
	SUB 7
CVRTA1:	LD HL,BASIS
CVRTA2:	CP (HL)
	JP C,CVRTA3
	SUB (HL)
	JP CVRTA2
CVRTA3: POP HL
	RET

CVRTBA:	;converts the binary number in A into an ASCII char.
	ADD A,30H
	CP 3AH
	JP C,CVRTB1
	ADD A,7
CVRTB1:	RET

CVSTAB:	;converts the string between HL and DE from ASCII to binary.
	LD A,(HL)
	CALL CVRTAB
	LD (HL),A
	INC HL
	PUSH HL
	SCF
	SBC HL,DE
	POP HL
	JP C,CVSTAB
	RET
CVSTBA:	;converts the string between HL and DE from binary to ASCII. 
	LD A,(HL)
	CALL CVRTBA
	LD (HL),A
	INC HL
	PUSH HL
	SCF
	SBC HL,DE
	POP HL
	JP C,CVSTBA
	RET

MULTHL:	;multiplies the 8-bit binary numbers in H and L
	;and returns the result as a 16-bit binary in HL.
	PUSH DE
	PUSH BC
	LD E,H		;multiplicand
	LD D,0		;extended to 16 bits
	LD A,L		;multiplier
	LD HL,0		;product = 0
	LD B,8		;count = bit length of multiplier
MULTH1:	ADD HL,HL	;shift product left 1 bit
	RLA		;shift multiplier left 1 bit
	JP NC,MULTH2	;is carry from multiplier 1?
	ADD HL,DE	;yes, add multiplicand to product
MULTH2:	DJNZ MULTH1
	POP BC
	POP DE
	RET

	END
