;TP1.MAC contains primitive functions of TRAC80
;Look under entry points for names.

	PAGE 80
	.Z80
	TITLE TP1

	ENTRY PFRS,PFPS,PFTN,PFTF,PFHL
	ENTRY PFDS,PFCL,PFDD,PFDA
	ENTRY PFPF,PFLN,PFNB,PFSS
	ENTRY PFCS,PFCC,PFCR,PFLP,PFRP
	ENTRY PFEQ,PFIT

	ENTRY PRTFRM,CODA,FNAME,FENTRY,SUCCF
	ENTRY FLUP,CMPSTR,MOVAS,DELEF
	ENTRY MATCH,GAPCD
	ENTRY ESCARG,RESFP,COUNT,DIVA,DIVBC


	SUBTTL RS

	INCLUDE ERRMSG.INC
PFRS:
	EXTERNAL BDOS,OUTPUT,OUTSTR,CHECK2,BREAK,CRNLFD,DELOUT,CLRTAB
	EXTERNAL CCM,LFD,VALST,$VALST,ACTST,AUXST,$AUXST
	CALL CLRTAB	;re-init TAB-expansion stack
RSCON:	LD E,0FFH
	LD C,6
	CALL BDOS
	OR A
	JR Z,RSCON	;char available?
	CP 20H		;yes, control char?
	JP C,RSCON2
	CP 7FH
	JP Z,RSCON7	;DEL?
	JP NC,RSCON3	;out of range?

RSCON1:	LD HL,CCM	;meta char?
	CP (HL)
	JP Z,RSCON4
	CALL RSCONE	;no, echo output and append at VALST
	JP RSCON	;next char

RSCON2:	LD HL,RSCTBL	;compare with control char table
	LD BC,RSCJPS-RSCTBL
	CPIR
	JP NZ,RSCON	;not in table?
	LD HL,RSCJPS
	ADD HL,BC
	ADD HL,BC
	LD E,(HL)
	INC HL
	LD D,(HL)
	EX DE,HL
	JP (HL)
RSCTBL:
	DB 0DH		;CR
	DB 0AH		;LF
	DB 09H		;Tab
	DB 07H		;Ctrl/G (Bell)
	DB 03H		;Ctrl/C
	DB 12H		;Ctrl/R
	DB 15H		;Ctrl/U

RSCJPS:	;Note: Table of jump addresses in inverse order!
	DW RSCONU	;Ctrl/U (erase input)
	DW RSCONR	;Ctrl/R (show input)
	DW RSCONC	;Ctrl/C (abort input, break to main algorithm)
	DW RSCON1	;Ctrl/G (Bell)
	DW RSCON1	;Tab
	DW RSCON1	;LF
	DW RSCOND	;CR (echo with LF)

RSCONC:	CALL OUTPUT	;echo Ctrl/C
	JP BREAK

RSCOND:	CALL RSCONE	;echo CR
	LD A,(LFD)	;with LF
	JP RSCON1

RSCONR:	CALL CRNLFD	;on Ctrl/R
	CALL CLRTAB	;re-init TAB-expansion stack,
	LD HL,(VALST)	;show current VALST
	LD (AUXST),HL
	LD HL,($VALST)
	LD ($AUXST),HL
	CALL OUTSTR
	JP RSCON	;and continue with input.

RSCONU:	CALL OUTPUT	;on Ctrl/U echo ^U
	CALL CRNLFD	;followed by CR&LF,
	LD HL,(VALST)	;re-init VALST,
	DEC HL
	LD ($VALST),HL
	JP PFRS		;and start all over.

RSCON3:	JP RSCON	;ignore char > 7FH

RSCON4:	CALL OUTPUT	;echo meta char
	CALL CRNLFD	;and CR/LF
	RET

RSCON7:	LD DE,($VALST)	;cut off last char from VALST
	LD HL,(VALST)
	SCF
	SBC HL,DE
	JP NC,RSCON	;if VALST not already empty
	LD A,(DE)
	DEC DE
	LD ($VALST),DE
	CALL DELOUT	;delete char in A on screen
	JP RSCON

RSCONE:	;echoes char in A and appends it at VALST
	PUSH AF
	CALL OUTPUT
	POP AF
	LD HL,(ACTST)
	LD DE,($VALST)
	INC DE
	SCF
	CCF
	SBC HL,DE
	JP Z,RSCONX	;enough space for VALST?
	LD (DE),A
	LD ($VALST),DE
	RET

RSCONX:	ERRMSG 'R'	;no, print message
	JP CHECK2	;and jump to recovery point via subroutine CHECK


	SUBTTL PS

	EXTERNAL SUCCA,OUTSTR
	EXTERNAL ARGST,AUXST
PFPS:
	LD IX,ARGST
	LD IY,AUXST
	CALL SUCCA
	CALL OUTSTR
	RET


	SUBTTL TN/TF

	EXTERNAL TRCFLG

PFTN:	LD HL,TRCFLG
	LD (HL),1
	RET

PFTF:	LD HL,TRCFLG
	LD (HL),0
	RET


	SUBTTL HL

	EXTERNAL BDOS
PFHL:
	LD C,0		;return to CP/M
	CALL BDOS


	SUBTTL DS
PFDS:
	EXTERNAL ACTST,$ACTST,ARGST,$ARGST,FRMST,$FRMST,ENTST,$ENTST
	EXTERNAL ALIST,$ALIST,FLIST,$FLIST
	EXTERNAL SCHEM1,SUCCA,CHECK
	CALL SCHEM1	;IF ARGST>$ALIST GOTO EXIT
	RET C
	LD IX,ARGST	;USE SUCCA(ARGST,FRMST)
	LD IY,FRMST
	CALL SUCCA
	LD HL,($ALIST)	;IF FRMST>$ALIST GOTO EXIT
	LD DE,(FRMST)
	SCF
	CCF
	SBC HL,DE
	RET C
	LD IX,ARGST	;USE FLUP(ARGST,ENTST)
	LD IY,ENTST
	CALL FLUP
	LD HL,($ENTST)	;REGM.=$ENTST-ENTST
	LD DE,(ENTST)
	SCF
	CCF
	SBC HL,DE
	INC HL		;INCR REGM
	PUSH HL		;save old form length
	LD HL,(ARGST)	;ARGST will be new form entry
	DEC HL		;DECR ARGST
	DEC HL
	LD (ARGST),HL
	LD HL,($FRMST)	;$ARGST.=$FRMST+1
	INC HL
	LD ($ARGST),HL
	PUSH HL		;c($ARGST).=FRMST-$ARGST
	LD DE,(FRMST)
	EX DE,HL
	SCF
	CCF
	SBC HL,DE
	EX DE,HL
	POP HL
	LD (HL),E
	INC HL
	LD (HL),D
	INC HL
	LD DE,(ARGST)	;REGL.=$ARGST-ARGST
	SCF
	CCF
	SBC HL,DE
	INC HL		;REGL.=REGL+2
	INC HL		;REGL = HL = overall length of new form entry
	POP DE		;REGM = DE = overall length of old form entry
	SCF		;IF REGM>REGL GOTO PFDS1
	CCF
	SBC HL,DE
	JP C,PFDS1
	CALL CHECK	;HL=REGL-REGM, i.e. check if new form >= old form

PFDS1:	LD HL,(ENTST)	;IF ENTST=$FLIST GOTO PFDS2
	LD DE,($FLIST)
	SCF
	CCF
	SBC HL,DE
	JP Z,PFDS2
	LD IX,ENTST	;USE DELEF(ENTST)
	CALL DELEF	;Note: DELEF does not move ACTST !

PFDS2:	LD HL,(FLIST)	;Move ACTST so that new form entry will fit
	LD DE,($ACTST)	;between ACTST and FLIST.
	SCF
	SBC HL,DE
	PUSH HL
	LD HL,($ARGST)
	LD DE,(ARGST)
	SCF
	CCF
	SBC HL,DE
	INC HL
	INC HL
	INC HL
	INC HL		;HL = space needed for new form entry
	POP DE		;DE = free space left by old form entry
	EX DE,HL
	SCF
	CCF
	SBC HL,DE	;old space - new space = 0 ?
	JP Z,PFDS3
	LD DE,(ACTST)	;No, move ACTST to the left or right.
	ADD HL,DE
	EX DE,HL
	CALL MOVAS

PFDS3:	LD HL,($ARGST)	;bring new entry left from FLIST
	INC HL
	PUSH HL		;save end of entry address
	LD DE,(ARGST)
	SCF
	CCF
	SBC HL,DE
	INC HL
	LD B,H		;BC = length of entry
	LD C,L
	LD DE,(FLIST)
	DEC DE
	POP HL
	PUSH BC
	LDDR
	POP BC
	INC BC		;adjust pointer to FLIST element
	INC BC
	EX DE,HL
	LD (HL),B
	DEC HL
	LD (HL),C
	LD (FLIST),HL	;set pointer on new first FLIST element
	RET


	SUBTTL FLUP

FLUP:	;P1: IX = string containing form name
	;P2: IY = string to contain form if found, or
	;	  empty string at end of formstore if not found
	EXTERNAL FLIST,$FLIST
	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
	INC HL
	LD B,H		;BC=length of P1
	LD C,L
	LD HL,(FLIST)
FLUP1:	LD DE,($FLIST)
	PUSH HL
	SCF		;IF P2=$FLIST GOTO FLUP5
	CCF
	SBC HL,DE
	POP HL
	JP Z,FLUP5
	PUSH HL
	INC HL		;get length of form name
	INC HL
	LD E,(HL)
	INC HL
	LD D,(HL)
	EX DE,HL
	DEC HL
	SCF		;if names have equal length goto FLUP3
	SBC HL,BC
	JP Z,FLUP3
FLUP2:	POP HL
	LD E,(HL)	;skip to next form
	INC HL
	LD D,(HL)
	ADD HL,DE
	DEC HL
	JP FLUP1	;and try again
FLUP3:	EX DE,HL
	INC HL		;HL = start of form name
	LD E,(IX+0)	;DE = start of name string
	LD D,(IX+1)
	CALL CMPSTR	;compare both strings
	JP NC,FLUP2
	POP HL		;if strings are equal return form spec
FLUP5:	LD E,(HL)
	INC HL
	LD D,(HL)
	DEC HL
	LD (IY+0),L
	LD (IY+1),H
	ADD HL,DE
	DEC HL
	DEC HL
	LD (IY+2),L
	LD (IY+3),H
	RET


	SUBTTL CMPSTR

CMPSTR:	;HL 5 start of first string to be compared
	;DE = start of second string to be compared
	;BC = length of either string
	;C-flag = 1 if strings are equal
	;	= 0 else
	LD A,B		;first, check on empty string
	OR C
	SCF
	RET Z
	PUSH HL
	PUSH DE
	PUSH BC
CMPST1:	LD A,(DE)
	CP (HL)
	JP NZ,CMPST2
	INC HL		;if chars equal proceed
	INC DE
	DEC BC
	LD A,B
	OR C
	JP NZ,CMPST1	;until end of string
	SCF
	JP CMPST3
CMPST2:	SCF
	CCF		;turns out: not equal
CMPST3:	POP BC
	POP DE
	POP HL
	RET


	SUBTTL MOVAS

MOVAS:	;moves the active string ACTST to the left or right
	;DE = new start address of ACTST
	EXTERNAL ACTST,$ACTST
	PUSH DE
	LD HL,($ACTST)
	INC HL
	LD DE,(ACTST)
	PUSH DE
	SCF
	CCF
	SBC HL,DE
	LD B,H		;BC = length of ACTST
	LD C,L
	POP HL
	POP DE
	PUSH AF		;save Zero flag (i.e. whether or not empty string)
	SCF
	CCF
	SBC HL,DE
	JP C,MOVAS2	;new location to the right of old one?
	JP Z,MOVAS4	;or identical?
	LD HL, (ACTST)	;no, new one to the left of old one.
	LD (ACTST),DE
	POP AF
	JP Z,MOVAS1	;empty string?
	LDIR
MOVAS1:	DEC DE
	LD ($ACTST),DE
	JP MOVAS5

MOVAS2:	EX DE,HL	;new location to the right of old one
	ADD HL,BC	;copy from rear end of ACTST
	DEC HL
	EX DE,HL
	LD HL,($ACTST)
	LD ($ACTST),DE
	POP AF
	JP Z,MOVAS3
	LDDR
MOVAS3:	INC DE
	LD (ACTST),DE
	JP MOVAS5
MOVAS4:	POP AF		;both addresses are identical
MOVAS5:	RET


	SUBTTL DELEF

DELEF:	;P1: IX = specifies form to be deleted in FLIST
	;The form is deleted by moving the remaining FLIST on the left
	;to the right and thus over the form.
	EXTERNAL FLIST
	LD L,(IX+0)
	LD H,(IX+1)
	PUSH HL
	LD DE,(FLIST)
	SCF
	CCF
	SBC HL,DE
	LD B,H		;BL = length of form to be deleted
	LD C,L
	POP HL
	DEC HL
	LD E,(IX+2)
	LD D,(IX+3)
	INC DE
	JP Z,DELEF1	;length = 0?
	LDDR		;no, move remaining FLIST
DELEF1:	INC DE
	LD (FLIST),DE
	RET


	SUBTTL CL

PFCL:
	EXTERNAL SCHEM1,USERF
	CALL SCHEM1
	JP C,PFCL1
	LD A,2
	CALL USERF
PFCL1:	RET


	SUBTTL DD

	EXTERNAL ACTST,ENTST,FLIST
	EXTERNAL SCHEM1,SCHEM3
PFDD:
	LD HL,(FLIST)	;save old FLIST address
	PUSH HL
PFDD0:	CALL SCHEM1	;IF ARGST>$ALIST GOTO PFDD1
	JP C,PFDD1
	CALL SCHEM3	;if entry not in FLIST continue with next name
	JP Z,PFDD0
	LD IX,ENTST
	CALL DELEF
	JP PFDD0
PFDD1:	POP DE		;move ACTST over space gained
	LD HL,(FLIST)
	SCF
	CCF
	SBC HL,DE
	JP Z,PFDD2	;(if there was some space gained at all)
	LD DE,(ACTST)
	ADD HL,DE
	EX DE,HL	;DE=new start address af ACTST
	CALL MOVAS
PFDD2:	RET


	SUBTTL DA

	EXTERNAL FLIST,$FLIST
PFDA:
	LD HL,($FLIST)
	LD (FLIST),HL
	DEC HL
	EX DE,HL
	CALL MOVAS
	RET


	SUBTTL PF

	EXTERNAL CLB,CUA,CRB
	EXTERNAL FRMST,$FRMST,ENTST,$ENTST,AUXST,$AUXST,VALST,$VALST
	EXTERNAL SCHEM1,SCHEM3,AFORM,NFORM,CRNLFD,OUTPUT,DIMON,DIMOFF
PFPF:
	CALL SCHEM1	;IF ARGST>$ALIST GOTO EXIT
	JP C,PFPF3
	CALL SCHEM3	;if form not in FLIST try next name
	JP Z,PFPF
	CALL CRNLFD
	LD IX,ENTST
	LD IY,FRMST
	CALL NFORM
	LD HL,($FRMST)	;IF FRMST>$FRMST GOTO PFPF2
	LD DE,(FRMST)
	SCF
	CCF
	SBC HL,DE
	JP C,PFPF2
	CALL PRTFRM
	CALL DIMON
	LD A,(CLB)
	CALL OUTPUT
	LD A,(CUA)
	CALL OUTPUT
	LD A,(CRB)
	CALL OUTPUT
	CALL DIMOFF
PFPF2:	LD IX,ENTST
	LD IY,FRMST
	CALL AFORM
	CALL PRTFRM
	JP PFPF
PFPF3:	RET


	SUBTTL PRTFRM

PRTFRM:	;prints the form specified by FRMST
	EXTERNAL SGTYP,GAPNRM
	EXTERNAL FRMST,$FRMST,AUXST,$AUXST
	EXTERNAL OUTSTR,OUTPUT,SKIPF,DIMON,DIMOFF
	LD HL,(FRMST)	;AUXST.=FRMST
	LD (AUXST),HL
	DEC HL		;$AUXST.=AUXST-1
	LD ($AUXST),HL
	LD DE,(FRMST)	;IF FRMST>$FRMST GOTO PRTFR4
PRTFR2:	LD HL,($FRMST)
	SCF
	CCF
	SBC HL,DE
	JP C,PRTFR4
	LD A,(DE)	;CHAR.=c(FRMST)
	LD HL,SGTYP	;IF TYPE(CHAR)=SGTYP GOTO PRTFR3
	AND (HL)
	CP (HL)
	JP Z,PRTFR3
	INC DE		;INCR FRMST
	LD HL,($AUXST)	;INCR $AUXST
	INC HL
	LD ($AUXST),HL
	JP PRTFR2
PRTFR3:	PUSH DE
	CALL OUTSTR
	POP DE
	PUSH  DE
	LD A,(DE)
	LD HL,GAPNRM
	AND (HL)
	LD HL,(VALST)
	LD (AUXST),HL
	LD HL,($VALST)
	LD ($AUXST),HL
	LD IX,AUXST
	CALL CODA	;convert binary integer in A into string AUXST
	CALL DIMON
	LD A,(CLB)
	CALL OUTPUT
	CALL OUTSTR
	LD A,(CRB)
	CALL OUTPUT
	CALL DIMOFF
	POP HL		;FRMST.=FRMST+GAPLG(CHAR)
	CALL SKIPF
	LD (FRMST),HL
	EX DE,HL
	LD HL,(VALST)	;re-init VALST
	DEC HL
	LD ($VALST),HL
	JP PRTFRM
PRTFR4:	CALL OUTSTR
	RET


CODA:	;converts the segment gap no. in A to string P1
	;P1: IX = string to contain code of integer
	;Note: Maximum segment no is 32 and is coded as 0.
	LD E,(IX+2)
	LD D,(IX+3)
	OR A
	JP NZ,CODA1	;<32?
	OR 20H		;=32?
CODA1:	LD L,A
	XOR A
	LD H,A		;HL = dividend
	LD A,10		;A  = divisor
	CALL DIVA	;binary division
	LD A,L		;L = quotient
	OR A		;H = residuum
	JP Z,CODA2
	OR 30H		;convert quotient to ASCII
	INC DE
	LD (DE),A
CODA2:	LD A,H		;convert residuum to ASCII
	OR 30H
	INC DE
	LD (DE),A
	LD (IX+2),E
	LD (IX+3),D
	RET

DIVA:	;divides binary in HL by binary in A 
	;returns quotient in L and residuum in H.
	PUSH BC
	LD C,A		;save divisor
	LD B,8		;counts no. of bits in divisor
DIVA1:	ADD HL,HL	;shift dividend, quotient left 1 bit
	LD A,H		;can divisor be subtracted?
	SUB C
	JP C,DIVA2	;no, go to next step
	LD H,A		;yes, subtract divisor from dividend
	INC L		;add 1 to quotient
DIVA2:	DJNZ DIVA1	;done?
	POP BC
	RET


	SUBTTL LN

	EXTERNAL REGJ
	EXTERNAL ACTST,ARGST,$ARGST,AUXST,$AUXST,ENTST,VALST,$VALST
	EXTERNAL FLIST,$FLIST
	EXTERNAL SUCCA,CHECKN,PREF
PFLN:
	LD IX,ARGST
	LD IY,ARGST
	CALL SUCCA
	LD HL,($ARGST)
	LD DE,(ARGST)
	SCF
	CCF
	SBC HL,DE
	INC HL
	LD (REGJ),HL	;REGJ.=,ARGST-ARGST+1
	LD HL,(ACTST)	;move VALST before ACTST
	LD (VALST),HL
	DEC HL
	LD ($VALST),HL
	LD IX,FLIST
	LD IY,ENTST
	CALL FENTRY
PFLN1:	LD HL,($FLIST)	;IF ENTST=$FLIST GOTO EXIT
	LD DE,(ENTST)
	SCF
	CCF
	SBC HL,DE
	JP Z,PFLN2
	LD IX,ENTST	;next form name
	LD IY,AUXST
	CALL FNAME
	LD HL,($AUXST)
	LD DE,(AUXST)
	SCF
	CCF
	SBC HL,DE
	INC HL
	CALL CHECKN
	LD IX,AUXST	;prefix argument string
	LD IY,VALST
	CALL PREF
	LD IX,ENTST
	LD IY,ENTST
	CALL SUCCF
	LD HL,(REGJ)
	CALL CHECKN
	LD IX,ARGST
	LD IY,VALST
	CALL PREF
	JP PFLN1
PFLN2:	RET


	SUBTTL NB

PFNB:
	EXTERNAL ARGST,VALST
	EXTERNAL SCHEM1,SCHEM3,SUCCA
	CALL SCHEM1	;IF ARGST>$ALIST GOTO EXIT
	JP C,PFNB1
	LD IX,ARGST
	LD IY,VALST
	CALL SUCCA
	CALL SCHEM3	;if entry ARGST in FLIST goto exit
	JP NZ,PFNB1
	LD IX,VALST
	LD IY,VALST
	CALL SUCCA
PFNB1:	RET


	SUBTTL FNAME

FNAME:	;P1: IX = form in formstore
	;P2: IY = string to contain the name of P1
	LD L,(IX+0)
	LD H,(IX+1)
	INC HL
	INC HL
	PUSH HL
	LD E,(HL)
	INC HL
	LD D,(HL)
	INC HL
	LD (IY+0),L
	LD (IY+1),H
	POP HL
	ADD HL,DE
	DEC HL
	LD (IY+2),L
	LD (IY+3),H
	RET

	SUBTTL FENTRY

FENTRY:	;P1: IX = pointer to element in FLIST
	;P2: IY = form entry at P1
	EXTERNAL FLIST,$FLIST
	LD L,(IX+0)
	LD H,(IX+1)
	LD DE,(FLIST)
FENTR1:	PUSH HL
	SCF
	CCF
	SBC HL,DE
	JP Z,FENTR3
	JP C,FENTR2
	EX DE,HL
	LD E,(HL)
	INC HL
	LD D,(HL)
	DEC HL
	ADD HL,DE
	EX DE,HL
	POP HL
	JP FENTR1
FENTR2:	LD HL,($FLIST)
	LD (IY+0),L
	LD (IY+9),H
	JP FENTR4
FENTR3:	POP HL
	LD (IY+0),L
	LD (IY+1),H
	LD E,(HL)
	INC HL
	LD D,(HL)
	DEC HL
	ADD HL,DE
	DEC HL
	DEC HL
FENTR4:	LD (IY+2),L
	LD (IY+3),H
	RET


	SUBTTL SUCCF

SUCCF:	;P1: IX = form entry in FLIST
	;P2: IY = successor entry of P1
	LD L,(IX+2)
	LD H,(IX+3)
	PUSH HL
	INC HL
	INC HL
	LD (IY+0),L
	LD (IY+1),H
	LD E,(HL)
	INC HL
	LD D,(HL)
	POP HL
	ADD HL,DE
	LD (IY+2),L
	LD (IY+3),H
	RET


	SUBTTL SS

	EXTERNAL REGM
	EXTERNAL FRMST,$FRMST,ENTST,$ENTST,ARGST,$ARGST,AUXST,$AUXST
	EXTERNAL SCHEM1,SCHEM3,AFORM
PFSS:
	CALL SCHEM1	;IF ARGST>$ALIST GOTO EXIT
	JP C,PFSS5
	CALL SCHEM3	;if form not in FLIST goto exit
	JP Z,PFSS5
	LD IX,ENTST
	LD IY,FRMST
	CALL AFORM
	LD HL,($FRMST)	;IF FRMST>$FRMST GOTO EXIT
	LD DE,(FRMST)
	SCF
	CCF
	SBC HL,DE
	JP C,PFSS5
	LD A,1		;REGM.=1
	LD (REGM),A
PFSS1:	CALL SCHEM1	;IF ARGST>$ALIST GOTO EXIT
	JP C,PFSS5
	LD HL,($ARGST)	;IF ARGST>$ARGST GOTO PFSS4
	LD DE,(ARGST)
	SCF
	CCF
	SBC HL,DE
	JP C,PFSS4
PFSS2:	LD IX,ARGST	;USE MATCH(ARGST,AUXST)
	LD IY,AUXST
	CALL MATCH
	LD HL,($AUXST)	;IF AUXST>$AUXST GOTO PFSS3
	LD DE,(AUXST)
	SCF
	CCF
	SBC HL,DE
	JP C,PFSS3
	LD A,(REGM)	;USE GAPCD(M,AUXST)
	LD IX,AUXST
	CALL GAPCD
	LD HL,($AUXST)	;FRMST.=$AUXST-1
	INC HL
	LD (FRMST),HL
	JP PFSS2
PFSS3:	LD IX,ENTST	;USE AFORM(ENTST)
	LD IY,FRMST
	CALL AFORM
PFSS4:	LD HL,REGM	;INCR REGM
	INC (HL)
	JP PFSS1
PFSS5:	RET


	SUBTTL MATCH

MATCH:	;P1: IX = searches for the first occurrence of string P1 in FRMST.
	;P2: IY = first substring in FRMST identical with P1, if found,
	;	  or empty string at the end of FRMST, if not found.
	EXTERNAL REGH,REGJ,REGK,CHAR,SGTYP
	EXTERNAL FRMST,$FRMST
	EXTERNAL SKIPF
	LD E,(IX+0)
	LD D,(IX+1)
	LD B,D
	LD C,E		;BC = P1
	LD L,(IX+2)
	LD H,(IX+3)
	PUSH HL
	SCF
	CCF
	SBC HL,DE	;HL.=$P1-P1
	EX DE,HL
	LD HL,($FRMST)
	SCF
	CCF
	SBC HL,DE
	LD (REGH),HL	;REGH.=$FRMST-HL
	LD HL,(FRMST)
	LD (REGJ),HL	;REGJ.=FRMST
	POP DE		;DE = $P1
MATCH1:	LD (REGK),BC	;REGK.=P1
	LD HL,(REGJ)	;IF REGJ>REGH GOTO MATCH6
	PUSH DE
	LD DE,(REGH)
	SCF
	SBC HL,DE
	POP DE
	JP NC,MATCH6
	JP MATCH4	;GOTO MATCH4
MATCH2:	LD HL,(REGJ)	;CHAR.=c(REGJ)
	LD A,(HL)
	LD (CHAR),A
	LD HL,SGTYP	;IF TYPE(CHAR)#SGTYP GOTO MATCH3
	AND (HL)
	CP (HL)
	JP NZ,MATCH3
	LD HL,(REGJ)	;REGJ.=REGJ+GAPLG(CHAR)
	PUSH DE
	CALL SKIPF
	POP DE
	LD (REGJ),HL	;HL points to next form segment
	JP MATCH1	;try again
MATCH3:	LD HL,(REGK)	;IF c(REGK)#CHAR GOTO MATCH5
	LD A,(HL)
	LD HL,CHAR
	CP (HL)
	JP NZ,MATCH5
	LD HL,(REGK)	;INCR REGK
	INC HL
	LD (REGK),HL
	LD HL,(REGJ)	;INCR REGJ
	INC HL
	LD (REGJ),HL
MATCH4:	LD HL,(REGK)	;IF REGK<=$P1 GOTO MATCH2
	SCF
	SBC HL,DE
	JP C,MATCH2
	LD HL,(REGJ)	;$P2.=REGJ-1
	DEC HL
	LD (IY+2),L
	LD (IY+3),H
	SCF		;P2.=$P2-$P1+P1
	CCF
	SBC HL,DE
	ADD HL,BC
	LD (IY+0),L
	LD (IY+1),H
	JP MATCH7
MATCH5:	PUSH DE
	LD HL,(REGJ)	;REGJ.=REGJ-REGK+P1+1
	LD DE,(REGK)
	SCF
	CCF
	SBC HL,DE
	ADD HL,BC
	INC HL
	LD (REGJ),HL
	POP DE
	JP MATCH1
MATCH6:	LD HL,($FRMST)	;P2.=$FRMST
	LD (IY+0),L
	LD (IY+1),H
	DEC HL
	LD (IY+2),L	;$P2.=P2-1
	LD (IY+3),H
MATCH7:	RET


	SUBTTL GAPCD

GAPCD:	;substitutes a parameter marker for a substring in a form
	;P1: A  = parameter no.
	;P2: IX = substring in form
	EXTERNAL SGTYP,GAPNRM,GAPTYP,GAPLGM
	LD E,(IX+0)
	LD D,(IX+1)
	LD L,(IX+2)
	LD H,(IX+3)
	LD B,H		;BC.=string end address
	LD C,L
	SCF
	CCF
	SBC HL,DE	;HL.=string length-1
	JP NZ,GAPCD1
;substring length = 1
	LD HL,GAPNRM
	AND (HL)
	LD HL,SGTYP	;code gap no. and type
	OR (HL)
	LD (DE),A	;and substitute into string
	JP GAPCD5
;substring length > 1
GAPCD1:	LD HL,GAPNRM
	AND (HL)
	LD HL,GAPTYP
	OR (HL)
	LD (DE),A	;substitute gap no. and type in beginning and end
	LD (BC),A
	INC DE
	LD H,B
	LD L,C
	SCF
	CCF
	SBC HL,DE
	JP Z,GAPCD5
;substring length > 2
	DEC HL
	LD A,H
	OR L
	JP NZ,GAPCD2
;substring length = 3
	XOR A
	LD (DE),A
	JP GAPCD5
;substring length > 3
GAPCD2:	DEC HL
	LD A,H
	OR L
	JP NZ,GAPCD3
;substring length = 4
	LD A,40H
	LD (DE),A
	INC DE
	LD (DE),A
	JP GAPCD5
;substring length > 4
GAPCD3:	DEC HL
	LD A,H
	OR L
	JP NZ,GAPCD4
;substring length = 5
	LD A,80H
	LD (DE),A
	INC DE
	INC DE
	LD (DE),A
	DEC DE
	XOR A
	LD (DE),A
	JP GAPCD5
;substring length > 5
GAPCD4:	LD A,H
	AND 3FH
	OR 80H
	LD (DE),A	;high byte of end of string address
	DEC BC
	LD (BC),A
	LD A,L		;low byte
	INC DE
	LD (DE),A
	DEC BC
	LD (BC),A
GAPCD5:	RET


	SUBTTL CS

PFCS:
	EXTERNAL SGTYP
	EXTERNAL FRMST,$FRMST,ENTST,$ENTST,VALST,$VALST
	EXTERNAL SCHEM1,SCHEM3,AFORM,SKIPF,CHECK

	CALL SCHEM1	;IF ARGST>$ALIST GOTO EXIT
	JP C,PFCS5
	CALL SCHEM3
	JP Z,PFCS5
	LD IX,ENTST
	LD IY,FRMST
	CALL AFORM
	LD HL,($FRMST)	;IF FRMST>$FRMST GOTO PFCS4
	LD DE,(FRMST)
	SCF
	CCF
	SBC HL,DE
	JP C,PFCS4
	LD B,0		;BC=counter
	LD C,B		;DE=FRMST
PFCS1:	LD A,(DE)	;CHAR.=c(FRMST)
	LD HL,SGTYP	;IF TYPE(CHAR)=SGTYP GOTO PFCS2
	AND (HL)
	CP (HL)
	JP Z,PFCS2
	INC BC		;increment counter
	INC DE
	LD HL,($FRMST)	;IF FRMST>$FRMST GOTO PFCS3
	SCF
	CCF
	SBC HL,DE
	JP C,PFCS3
	JP PFCS1
PFCS2:	EX DE,HL	;FRMST=FRMST+GAPLG(CHAR)
	CALL SKIPF	
	EX DE,HL	;DE=FRMST
PFCS3:	LD H,B
	LD L,C
	CALL CHECK
;update form pointer
	LD HL,($ENTST)	;c($ENTST).=FRMST-$ENTST
	PUSH HL
	EX DE,HL
	SCF
	CCF
	SBC HL,DE
	EX DE,HL
	POP HL
	LD (HL),E
	INC HL
	LD (HL),D
;append segment at VALST
	LD DE,($VALST)
	INC DE
	LD HL,(FRMST)
	LDIR
	DEC DE
	LD ($VALST),DE
	JP PFCS5
PFCS4:	CALL ESCARG
PFCS5:	RET


	SUBTTL CC

PFCC:
	EXTERNAL SGTYP,CHAR
	EXTERNAL ENTST,$ENTST,FRMST,$FRMST,VALST
	EXTERNAL SCHEM1,SCHEM3,AFORM,SKIPF,CHECK
	INCLUDE PSTFC.INC
	CALL SCHEM1
	JP C,PFCC4
	CALL SCHEM3
	JP Z,PFCC4
	LD IX,ENTST
	LD IY,FRMST
	CALL AFORM
	LD DE,(FRMST)	;IF FRMST>$FRMST GOTO PFCC3
PFCC1:	LD HL,($FRMST)
	SCF
	CCF
	SBC HL,DE
	JP C,PFCC3
	LD A,(DE)	;CHAR.=c(FRMST)
	LD (CHAR),A
	LD HL,SGTYP	;IF TYPE(CHAR)#SGTYP GOTO PFCC2
	AND (HL)
	CP (HL)
	JP NZ,PFCC2
	EX DE,HL	;FRMST.=FRMST+GAPLG(CHAR)
	CALL SKIPF
	EX DE,HL
	LD (FRMST),DE
	JP PFCC1
PFCC2:	INC DE		;INCR FRMST
	LD (FRMST),DE
	LD HL,1
	CALL CHECK
	PSTFC CHAR,VALST
;update form pointer
	LD HL,(FRMST)	;c($ENTST).=FRMST-$ENTST
	LD DE,($ENTST)
	PUSH DE
	SCF
	CCF
	SBC HL,DE
	POP DE
	EX DE,HL
	LD (HL),E
	INC HL
	LD (HL),D
	JP PFCC4
PFCC3:	CALL ESCARG
PFCC4:	RET


	SUBTTL ESCARG

ESCARG:	;returns the "escape argument" in VALST
	;and forces the function call mode to "active".
	EXTERNAL MODE,ARGST,VALST
	EXTERNAL SUCCA
	LD IX,ARGST
	LD IY,VALST
	CALL SUCCA
	LD A,-1
	LD (MODE),A
	RET


	SUBTTL CR

PFCR:
	EXTERNAL ENTST
	EXTERNAL SCHEM1,SCHEM3
	CALL SCHEM1
	JP C,PFCR1
	CALL SCHEM3
	JP Z,PFCR
	LD IX,ENTST
	CALL RESFP
	JP PFCR
PFCR1:	RET


	SUBTTL RESFP

RESFP:	;resets the form pointer ("cursor") in a form
	;P1: IX = formstore entry
	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	;HL = start of form body
	LD E,(IX+2)
	LD D,(IX+3)
	SCF
	CCF
	SBC HL,DE
	EX DE,HL
	LD (HL),E
	INC HL
	LD (HL),D
	RET


	SUBTTL LP

PFLP:
	EXTERNAL ENTST,FRMST
	EXTERNAL SCHEM1,SCHEM3,NFORM
	CALL SCHEM1
	JP C,PFLP1
	CALL SCHEM3
	JP Z,PFLP1
	LD IX,ENTST
	LD IY,FRMST
	CALL NFORM
	CALL COUNT
PFLP1:	RET


	SUBTTL RP

PFRP:
	EXTERNAL ENTST,FRMST
	EXTERNAL SCHEM1,SCHEM3,AFORM
	CALL SCHEM1
	JP C,PFRP1
	CALL SCHEM3
	JP Z,PFRP1
	LD IX,ENTST
	LD IY,FRMST
	CALL AFORM
	CALL COUNT
PFRP1:	RET

	
	SUBTTL COUNT

COUNT:	;counts characters in FRMST and returns the number
	;in VALST as an ASCII string.
	EXTERNAL SGTYP,FRMST,$FRMST
	EXTERNAL SKIPF
	LD B,0
	LD C,B		;BC = count result
	LD DE,(FRMST)
COUNT1:	LD HL,($FRMST)	;IF FRMST>$FRMST GOTO COUNT3
	SCF
	CCF
	SBC HL,DE
	JP C,COUNT3
	LD A,(DE)	;CHAR.=c(FRMST)
	LD HL,SGTYP	;IF TYPE(CHAR)=SGTYP GOTO COUNT2
	AND (HL)
	CP (HL)
	JP Z,COUNT2
	INC BC		;increment count
	INC DE		;INCR FRMST
	JP COUNT1
COUNT2:	EX DE,HL	;FRMST.=FRMST+GAPLG(CHAR)
	CALL SKIPF
	EX DE,HL
	JP COUNT1
COUNT3:	CALL CODBC
	RET


	SUBTTL CODBC

CODBC:	;converts integer in BC to ASCII string VALST
	;according to the current numerical basis (max. 72 decimal).
	;Note: VALST is being built backwards from ACTST.
	EXTERNAL BASIS
	EXTERNAL ACTST,$ARGST,VALST,$VALST
	EXTERNAL CHECK1
	LD HL,(ACTST)
	LD (VALST),HL
	DEC HL
	LD ($VALST),HL
	LD A,(BASIS)	;HL = divisor (num.basis)
	OR A
	RET Z		;return if divisor=0
	LD L,A
	LD H,0
	LD D,B		;DE = dividend
	LD E,C
CODBC1:	CALL DIVBC	;DE.=DE/HL, BC.=DE mod HL
	LD A,C		;A = residuum
	CP 10
	JP NC,CODBC2
	OR 30H
	JP CODBC3
CODBC2:	ADD A,37H	;residuum > 9
CODBC3:	PUSH HL		;save divisor
	LD HL,($ARGST)	;check if enough space in front of VALST
	LD BC,(VALST)
	SCF
	CCF
	SBC HL,BC
	POP HL
	JP NC,CHECK1
	DEC BC		;if so, prefix char at VALST
	LD (BC),A
	LD (VALST),BC
	LD A,D		;and continue if quotient > 0
	OR E
	JP NZ,CODBC1
	RET


	SUBTTL DIVBC

DIVBC:	;divides the 16-bit integer in DE by the 16-bit integer in HL.
	;Returns the quotient in DE, the residuum in BC, and the
	;divisor in HL.
	LD A,H		;check divisor
	OR L		;if it's zero return with A=0 (otherwise A=FFH)
	RET Z
	PUSH HL		;save divisor
	LD B,0
	LD C,B
	SCF		;dividend < divisor ?
	SBC HL,DE
	JP NC,DIVBC8
	POP HL
	PUSH HL
	XOR A		;init shift count
DIVBC1:	PUSH HL		;align divisor to dividend
	SCF
	CCF
	SBC HL,DE
	POP HL
	JP Z,DIVBC3
	PUSH HL
	ADD HL,HL
	PUSH HL
	JP C,DIVBC2
	SCF
	SBC HL,DE
	JP NC,DIVBC2
	POP HL
	POP BC
	INC A
	JP DIVBC1
DIVBC2:	POP HL
	POP HL
DIVBC3:	PUSH HL
	LD B,0		;quotient = 0
	LD C,B
	LD (DIVBCA),A	;save shift count
DIVBC4:	EX DE,HL	;repeat subtractions
	SCF
	CCF
	SBC HL,DE
	EX DE,HL
	INC BC
DIVBC5:	OR A
	JP Z,DIVBC6	;no more shifts
	DEC A
	LD H,B
	LD L,C
	ADD HL,HL
	LD B,H
	LD C,L
	EX DE,HL
	ADD HL,HL
	EX DE,HL
	POP HL
	PUSH HL
	SCF
	SBC HL,DE
	POP HL
	PUSH HL
	JP NC,DIVBC5
	JP DIVBC4
DIVBC6:	POP HL		;throw away shifted divisor
	LD A,(DIVBCA)	;get shift count and
DIVBC7:	OR A
	JP Z,DIVBC8
	DEC A		;shift residuum to right hand end
	SRL E
	SRL D
	JP NC,DIVBC7
	SET 7,E
	JP DIVBC7
DIVBC8:	LD H,B		;load registers with output values
	LD L,C
	EX DE,HL	;DE = quotient
	LD B,H
	LD C,L		;BC = residuum
	POP HL		;HL = divisor
	LD A,0FFH	;indicates "No error"
	RET
DIVBCA:	DB 0		;shift count


	SUBTTL EQ

PFEQ:
	EXTERNAL ARGST,$ARGST,AUXST,$AUXST,VALST,$VALST
	EXTERNAL SCHEM1,SUCCA

	CALL SCHEM1	;IF ARGST>$ALIST GOTO EXIT
	JP C,PFEQ3
	LD IX,ARGST
	LD IY,AUXST
	CALL SUCCA
	LD IX,AUXST
	LD IY,VALST
	CALL SUCCA
	LD HL,($AUXST)	;DE=$AUXST-AUXST
	LD DE,(AUXST)
	SCF
	CCF
	SBC HL,DE
	EX DE,HL
	LD HL,($ARGST)	;HL=$ARGST-ARGST
	LD BC,(ARGST)
	SCF
	CCF
	SBC HL,BC
	PUSH AF
	PUSH HL
	SCF		;IF HL#DE GOTO PFEQ2
	CCF
	SBC HL,DE
	JP NZ,PFEQ2
	POP BC		;BC=length(ARGST)
	POP AF
	JP C,PFEQ3	;IF AUXST>$AUXST GOTO PFEQ3
	LD HL,(ARGST)
	LD DE,(AUXST)
	INC BC
	CALL CMPSTR
	JP C,PFEQ3
	PUSH HL		;dummy push
	PUSH AF
PFEQ2:	LD IX,VALST	;strings are different
	LD IY,VALST
	CALL SUCCA
	POP HL
	POP AF
PFEQ3:	RET


	SUBTTL IT

PFIT:
	EXTERNAL ARGST,$ARGST,AUXST,$AUXST,ENTST,FRMST,$FRMST,VALST
	EXTERNAL SCHEM1,SCHEM3,SUCCA,AFORM

	CALL SCHEM1	;IF ARGST>$ALIST GOTO EXIT
	JP C,PFIT2
	CALL SCHEM3	;IF ENTST>$FLIST GOTO EXIT
	JP Z,PFIT2
	LD IX,ARGST
	LD IY,ARGST
	CALL SUCCA
	LD DE,ARGST	;IF ARGST>$ARGST GOTO EXIT
	LD HL,$ARGST
	SCF
	CCF
	SBC HL,DE
	JP C,PFIT2
	LD IX,ARGST
	LD IY,VALST
	CALL SUCCA
	LD IX,ENTST
	LD IY,FRMST
	CALL AFORM
	LD HL,($FRMST)
	LD DE,(FRMST)
	SCF
	CCF
	SBC HL,DE
	PUSH HL
	LD HL,($ARGST)
	LD DE,(ARGST)
	SCF
	CCF
	SBC HL,DE	;HL=$ARGST-ARGST
	POP DE		;DE=$FRMST-FRMST
	SCF		;IF HL>DE GOTO PFIT1
	SBC HL,DE
	JP NC,PFIT1
	LD IX,ARGST
	LD IY,AUXST
	CALL MATCH
	LD HL,($AUXST)	;IF $AUXST>=AUXST GOTO PFIT2
	LD DE,(AUXST)
	SCF
	CCF
	SBC HL,DE
	JP NC,PFIT2
PFIT1:	LD IX,VALST
	LD IY,VALST
	CALL SUCCA
PFIT2:	RET

	END
