;TS2.MAC contains subroutines for TRAC80
; See list of entry points for names.

	PAGE 80
	.Z80
	TITLE TS2
	SUBTTL VARIOUS SUBROUTINES

	ENTRY PSTF,PREF,USERF,AFORM,NFORM,CALLF,SKIPF
	ENTRY FCTINI,STEST,ARGMT,SUCCA,CHECK,CHECKN
	ENTRY SCHEM1,SCHEM2,SCHEM3

	INCLUDE PSTFC.INC
	INCLUDE ERRMSG.INC

PSTF:	;P1: IX = string to be postfixed to P2
	;P2: IY = string
	LD E,(IX+0)	;start of P1
	LD D,(IX+1)
	LD L,(IX+2)	;end of P1
	LD H,(IX+3)
	SCF
	CCF
	SBC HL,DE
	RET C		;exit if length of P1=0?
	INC HL
	LD B,H		;BC=length of P1
	LD C,L
	EX DE,HL	;HL=start of P1
	LD E,(IY+2)	;DE=end of P2
	LD D,(IY+3)
	INC DE
	LDIR
	DEC DE
	LD (IY+2),E	;new end of P2
	LD (IY+3),D
	RET

PREF:	;P1: IX = string to be prefixed to P2
	;P2: IY = string
	LD E,(IX+0)	;start of P1
	LD D,(IX+1)
	LD L,(IX+2)	;end of P1
	LD H,(IX+3)
	PUSH HL
	SCF
	CCF
	SBC HL,DE
	INC HL
	LD B,H		;BC=length of P1
	LD C,L
	POP HL		;HL=start of P1
	RET C		;exit if length of P1=0?
	LD E,(IY+0)	;DE=start of P2
	LD D,(IY+1)
	DEC DE
	LDDR
	INC DE
	LD (IY+0),E	;new start of P2
	LD (IY+1),D
	RET

USERF:	;P1: A = argument no.
	;calls user function in formstore
	EXTERNAL ARGST,ENTST,FRMST,$FLIST
	EXTERNAL FLUP
	PUSH AF
	LD IX,ARGST	;USE FLUP(ARGST,ENTST)
	LD IY,ENTST
	CALL FLUP
	POP AF
	LD HL,(ENTST)
	LD DE,($FLIST)
	SCF
	CCF
	SBC HL,DE
	RET Z
	PUSH AF
	LD IX,ENTST	;USE AFORM(ENTST,FRMST)
	LD IY,FRMST
	CALL AFORM
	POP AF
	CALL CALLF	;USE CALLF
	RET

AFORM:	;P1: IX = form 
	;P2: IY = string to contain active part of P1
	LD L,(IX+2)	;P2.=$P1+c($P1)
	LD H,(IX+3)
	PUSH HL
	LD E,(HL)
	INC HL
	LD D,(HL)
	DEC HL
	ADD HL,DE
	LD (IY+0),L
	LD (IY+1),H
	POP HL
	DEC HL		;$P2.=$P1-1
	LD (IY+2),L
	LD (IY+3),H
	RET

NFORM:	;P1: IX = form 
	;P2: IY = string to contain neutral part of P1
	LD L,(IX+0)
	LD H,(IX+1)
	INC HL
	INC HL
	LD E,(HL)
	INC HL
	LD D,(HL)
	INC HL
	ADD HL,DE
	LD (IY+0),L
	LD (IY+1),H
	LD L,(IX+2)
	LD H,(IX+3)
	LD E,(HL)
	INC HL
	LD D,(HL)
	DEC HL
	ADD HL,DE
	DEC HL
	LD (IY+2),L
	LD (IY+3),H
	RET

CALLF:	;A = no. of first argument
	;VALST = string to contain assembled form 
	;	 with parameters substituted
	;Note:	This subroutine should be optimized later.
	;	Form segments should be localized in FRMST
	;	and then be postfixed to VALST "en bloc".
	EXTERNAL FRMST,$FRMST,ARGST,$ARGST,VALST
	EXTERNAL REGN,CHAR,SGTYP,GAPNRM
	LD (REGN),A	;save A in REGN
CALLF1:	LD DE,(FRMST)	;IF FRMST>$FRMST GOTO CALLF4
	LD HL,($FRMST)
	SCF
	CCF
	SBC HL,DE
	JP C,CALLF4
	LD A,(DE)	;CHAR.=c(FRMST)
	LD (CHAR),A
	LD HL,SGTYP	;IF TYPE(CHAR)=SGTYP GOTO CALLF2
	AND (HL)
	CP (HL)
	JP Z,CALLF2
	LD HL,1		;USE CHECK(ONE)
	CALL CHECK
	PSTFC CHAR,VALST
	INC DE		;INCR FRMST
	LD (FRMST),DE	
	JP CALLF1
CALLF2:	LD A,(CHAR)	;A=REGN+GAPNR(CHAR)
	LD HL,GAPNRM
	AND (HL)
	LD HL,REGN
	ADD A,(HL)
	LD IY,ARGST
	CALL ARGMT	;USE ARGMT(A,ARGST)
	LD HL,($ARGST)	;IF ARGST>$ARGST GOTO CALLF3
	LD DE,(ARGST)
	SCF
	CCF
	SBC HL,DE
	JP C,CALLF3
	INC HL		;REGL.=$ARGST-ARGST+1
	CALL CHECK	;USE CHECK(REGL)
	LD IX,ARGST	;USE PSTF(ARGST,VALST)
	LD IY,VALST
	CALL PSTF
CALLF3:	LD HL,(FRMST)	;FRMST.=FRMST+GAPLG(CHAR)
	CALL SKIPF
	LD (FRMST),HL
	EX DE,HL
	JP CALLF1	;GOTO CALLF1
CALLF4:	RET

SKIPF:	;skips forward over segment gap
	;HL =	on entry, points to first byte of the gap
	;	on exit, points behind last byte of the gap
	EXTERNAL GAPTYP,SGTYP,GAPLGM
	PUSH HL		;skip forward over gap
	LD A,(HL)
	LD HL,GAPTYP
	AND (HL)
	CP (HL)
	JP Z,SKIPF1
	POP HL		;gap length = 1
	JP SKIPF5
SKIPF1:	POP DE		;gap length > 1
	INC DE
	LD A,(DE)
	AND (HL)
	CP (HL)
	JP Z,SKIPF4
	LD HL,SGTYP	;gap length > 2
	AND (HL)
	CP 00H
	JP Z,SKIPF3
	CP 40H		;gap length > 3
	INC DE
	JP Z,SKIPF3
	LD A,(DE)	;gap length > 4
	OR A
	JP Z,SKIPF2
	PUSH AF		;gap length > 5
	DEC DE
	LD A,(DE)
	LD HL,GAPLGM
	AND (HL)
	LD H,A
	POP AF
	LD L,A
	ADD HL,DE
	EX DE,HL
	INC DE
SKIPF2:	INC DE
SKIPF3:	INC DE
SKIPF4:	EX DE,HL
SKIPF5:	INC HL
	RET


FCTINI:	;initializes a new function argument list
	EXTERNAL ALIST,$ALIST,ARGST,$ARGST,$STACK
	EXTERNAL STATUS
	LD HL,($STACK)
	INC HL
	INC HL
	INC HL
	LD (ALIST),HL
	LD ($ALIST),HL
	XOR A
	LD (HL),A
	INC HL
	LD (HL),A
	LD ($ARGST),HL
	INC HL
	LD (ARGST),HL
;CALL STATUS
;DB 'after FCTINI$'
	RET

STEST:	;checks for singular function symbols
	EXTERNAL STATE,CCF,$ARGST
	LD HL,(STATE)	;IF STATE>=0 GOTO STEST2
STEST1:	LD DE,0
	SCF
	CCF
	SBC HL,DE
	JP P,STEST2
	LD A,(CCF)	;(USE PSTFC(CCF,ARGST))
	LD DE,($ARGST)
	INC DE
	LD (DE),A
	LD ($ARGST),DE
	INC HL		;INCR STATE
	LD (STATE),HL
	JP STEST1
STEST2:	RET

ARGMT:	;P1: A  = no. of argument in ALIST
	;P2: IY = spec of string to contain argument
	LD HL,(ALIST)	;P2.=ALIST
ARGMT1:	CP 1		;IF P1=1 GOTO ARGMT2
	JP Z,ARGMT2
	DEC A		;DECR P1
	LD E,(HL)	;P2.=P2+c(P2)
	INC HL
	LD D,(HL)
	DEC HL
	ADD HL,DE
	EX DE,HL
	LD HL,($ALIST)	;IF P2#$ALIST GOTO ARGMT1
	SCF
	CCF
	SBC HL,DE
	EX DE,HL
	JR NZ,ARGMT1
	LD (IY+0),L
	LD (IY+1),H
	DEC HL		;$P2.=P2-1
	LD (IY+2),L
	LD (IY+3),H
	JP ARGMT3
ARGMT2:	LD E,(HL)
	INC HL
	LD D,(HL)
	INC HL
	LD (IY+0),L
	LD (IY+1),H
	DEC HL		;$P2.=P2+c(P2)
	DEC HL
	ADD HL,DE
	DEC HL		;DECR $P2
	LD (IY+2),L
	LD (IY+3),H
ARGMT3:	RET

SUCCA:	;P1: IX = string spec of argument in ALIST
	;P2: IY = string spec to contain successor argument
	LD L,(IX+2)	;P2.=$P1+1
	LD H,(IX+3)
	PUSH HL
	INC HL
	LD E,(HL)
	INC HL
	LD D,(HL)
	INC HL		;INCR P2
	LD (IY+0),L
	LD (IY+1),H
	POP HL
	ADD HL,DE	;$P2.=$P1+c(P1)
	LD (IY+2),L
	LD (IY+3),H
	RET

CHECK:	;HL = string length to be checked against space between
	;     $VALST and ACTST.
	;Note:	CHECK1 and CHECK2 serve as side entries when
	;	an overflow was detected. In this case, 
	;	an error message is issued,
	;	the current VALST will be emptied,
	;	and the subroutine exits directly to recovery 
	;	point XEQFC3 in the main algorithm.
	EXTERNAL ACTST,VALST,$VALST,TRCFLG,STKPTR,XEQFC3
	ENTRY CHECK1,CHECK2
	PUSH HL
	PUSH DE
	LD DE,($VALST)
	ADD HL,DE
	LD DE,(ACTST)
	SCF
	CCF
	SBC HL,DE
	POP DE
	POP HL
	RET C
CHECK1:	ERRMSG 'A'
	LD HL,(VALST)
	DEC HL
	LD ($VALST),HL
CHECK2:	LD A,1
	LD (TRCFLG),A
	LD HL,(STKPTR)
	LD SP,HL
	JP XEQFC3

CHECKN:	;HL = string length to be checked against space between
	;     $ALIST+1 and VALST.
	;This test is for functions that are building the VALST backwards.
	EXTERNAL $ALIST,VALST
	PUSH HL
	PUSH DE
	LD DE,($ALIST)
	INC DE
	ADD HL,DE
	LD DE,(VALST)
	SCF
	CCF
	SBC HL,DE
	POP DE
	POP HL
	RET C
	JP CHECK1

SCHEM1:	;returns the next function argument in ARGST
	;or sets the Carry flag if end of ALIST is reached.
	EXTERNAL ARGST,$ALIST
	LD IX,ARGST
	LD IY,ARGST
	CALL SUCCA
	LD HL,($ALIST)
	LD DE,(ARGST)
	SCF
	CCF
	SBC HL,DE
	RET

SCHEM2:	;returns the next function argument in ARGST
	;or sets the Carry flag if the argument is empty
	EXTERNAL ARGST,$ARGST
	LD IX,ARGST
	LD IY,ARGST
	CALL SUCCA
	LD HL,($ARGST)
	LD DE,(ARGST)
	SCF
	CCF
	SBC HL,DE
	RET

SCHEM3:	;returns the form whose name is in ARGST in ENTST
	;or sets the Zero flag if no form with this name was found
	EXTERNAL ARGST,ENTST,$FLIST
	EXTERNAL FLUP
	LD IX,ARGST
	LD IY,ENTST
	CALL FLUP
	LD HL,($FLIST)
	LD DE,(ENTST)
	SCF
	CCF
	SBC HL,DE
	RET

	END
