;ML.OLD contains a defunct version of the primitive function ML of TRAC80
;This version uses a depth-first algorithm that does not work for long numbers
;due probably to an overflow of the 16-bit integer sum.
;The subroutine was replaced by a conventional breadth-first algorithm.
;07/15/86

	PAGE 80
	.Z80
	TITLE TP3

	ENTRY PFML
	ENTRY CVRTAB,CVRTBA,MULTHL

;ORG 1853H

	SUBTTL ML

PFML:
	EXTERNAL CMI,CZO,REGM,BASIS
	EXTERNAL REGH,REGJ,REGK,REGN
	EXTERNAL ARGST,$ARGST,AUXST,$AUXST,ENTST,$ENTST,VALST,$VALST
	EXTERNAL SCHEM1,SUCCA,CHECK,NTAIL,SIGNT,DIVA,PREF
	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 that HL will be related 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		;shift VALST for max.result
	LD HL,(VALST)
	ADD HL,BC
	LD (VALST),HL
	LD HL,($VALST)
	ADD HL,BC
	LD ($VALST),HL
	XOR A		;REGN.=0 (carry)
	LD (REGN),A
	DEC BC		;for BC=REGJ+REGK-1 downto 1
PFML2:	LD A,(REGN)	;REGH.=REGN (carry)
	LD L,A
	LD H,0
	LD (REGH),HL
	LD DE,(REGK)		;for DE=REGK downto 1
PFML3:	LD H,B				;HL.=BC-DE
	LD L,C
	SCF				;if HL>=0 and HL<REGJ then
	CCF
	SBC HL,DE
	JP C,PFML4
	PUSH HL
	PUSH DE
	LD DE,(REGJ)			
	SCF
	CCF
	SBC HL,DE
	POP DE
	POP HL
	JP P,PFML4
	PUSH DE
	EX DE,HL
	LD HL,(AUXST)			;HL.=AUXST+HL
	ADD HL,DE
	POP DE
	LD A,(HL)			;A.=val(c(HL))
	CALL CVRTAB			;convert A from ASCII to binary
	PUSH AF
	LD HL,(ARGST)			;HL.=ARGST+DE-1
	ADD HL,DE
	DEC HL
	LD A,(HL)			;A.=val(c(HL))
	CALL CVRTAB
	LD L,A
	POP AF
	LD H,A
	CALL MULTHL			;HL=H*L (8-bit multiplication)
	PUSH DE
	EX DE,HL
	LD HL,(REGH)			;REGH.=REGH+HL  Here we go, this
	ADD HL,DE			;is probably the cause of trouble.
	LD (REGH),HL
	POP DE
PFML4:	DEC DE			;next DE
	LD A,D
	OR E
	JP NZ,PFML3
	LD HL,(REGH)		;REGN.=REGH / BASIS (integer division)
	LD A,(BASIS)
	CALL DIVA		;L=quotient, H=residuum
	LD A,L
	LD (REGN),A
	LD A,H
	CALL CVRTBA		;convert binary to ASCII
	LD HL,(VALST)		;prefix A at VALST
	DEC HL
	LD (HL),A
	LD (VALST),HL
	DEC BC		;next BC
	LD A,B
	OR C
	JP NZ,PFML2
	LD A,(REGN)	;if REGN>0 then
	OR A
	JP Z,PFML5
	CALL CVRTBA	;convert binary to ASCII
	LD HL,(VALST)	;prefix A at VALST
	DEC HL
	LD (HL),A
	LD (VALST),HL
PFML5:	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


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
