	PAGE 80
	TITLE TRAC80
	SUBTTL DECLARATIONS

;13 Aug 86
;T.MAC contains all declarations and the main part of the TRAC80 interpreter.

;Files to be included:
;Macros:		ERRMSG,PREFC,PSTFC,APPND	(.INC)
;Files to be linked:
;Subroutines:		TS1,TS2				(.REL)
;Primitive Functions:	TP1,TP2,TP3			(.REL)
;Diagnostics:		STATUS or DUMMY or MONI		(.REL)
;Prim.Fct. List:	PLIST				(.REL)
;Note: 
;PLIST must be the last file to be linked since it determines the
;end of the program area and the beginning of the data storage area.

	IF1
	.PRINTX /Pass 1/
	ELSE
	.PRINTX /Pass 2/
	ENDIF
	.Z80

	ASEG
	ORG 103H

;	Constants
;CP/M specific constants
	GLOBAL BDOS
BDOS	EQU 5	;address of BDOS jump

;I/O device codes
	GLOBAL DEVCON,DEVRDR,DEVPUN,DEVLST,DEVDSK
DEVCON	EQU 0	;keyboard console
DEVRDR	EQU 1	;serial input port
DEVPUN	EQU 2	;serial output port
DEVLST  EQU 3	;printer
DEVDSK	EQU 4	;disk file
;standard set of syntactical symbols
?CCM	EQU '^'	;meta symbol
?CCF	EQU '#'	;function mode char
?CCL	EQU '('	;left delimiter
?CCS	EQU ','	;separator
?CCR	EQU ')'	;right delimiter

;	Run time stack

	DS 100H		;reserved area for run time stack
RTSTCK	EQU $-1

;	Screen control codes 	Note: All codes are global.
DIMON$::	DB 2		;reduced brightness on
		DB 1BH,'R'
		DB 0,0,0
DIMOF$::	DB 2		;reduced brightness off
		DB 1BH,'S'
		DB 0,0,0


;	Variables		Note: All variables are global.
;current set of syntactical symbols
CCM::		DB ?CCM
CCF::		DB ?CCF		 		;Note:
CCL::		DB ?CCL				;The ordering
CCS::		DB ?CCS				;of these 7
CCR::		DB ?CCR				;variables
;special characters and codes			;is
CRN::		DB 0DH	;carriage return	;crucial
LFD::		DB 0AH	;line feed		;for the
TAB::		DB 09H	;tabulator		;scan algorithm.
CLB::		DB '<'	;left bracket
CUA::		DB '^'	;up arrow
CRB::		DB '>'	;right bracket
CMI::		DB '-'	;minus sign
CZO::		DB '0'	;zero
CHP::		DB 'P'
CHR::		DB 'R'
CHS::		DB 'S'
CTRLC::		DB 03H	;BREAK key
CTRLT::		DB 14H	;TRACE key
SGTYP::		DB 0C0H	;segment gap marker
GAPNRM::	DB 01FH	;gap no. mask
GAPTYP::	DB 0E0H	;gap type mask
GAPLGM::	DB 03FH	;gap length mask
;variables
TRCFLG::	DB 0	;trace mode flag
STATE::		DW 0	;scan status
MODE::		DB 0	;function mode
CHAR::		DB 0	;character
INCHL::		DB 0	;input channel
OUTCHL::	DB 0	;output channel
CLCCNT::	DB 0	;console line char count
CLCMAX::	DB 0	;no max.count
STKPTR::	DW 0	;stack pointer on entry
BASIS::		DB 10	;numerical basis (max. 72 dec.)
REGH::		DW 0	;3 auxiliary 16-bit registers
REGJ::		DW 0
REGK::		DW 0
REGL::		DB 0	;3 auxiliary 8-bit registers
REGM::		DB 0
REGN::		DB 0
;pointers on data structures
ACTST::		DW 0	;active string
$ACTST::	DW 0
ARGST::		DW 0	;argument string
$ARGST::	DW 0
AUXST::		DW 0	;auxiliary string
$AUXST::	DW 0
ENTST::		DW 0	;form entry string
$ENTST::	DW 0
FRMST::		DW 0	;form string
$FRMST::	DW 0
VALST::		DW 0	;value string
$VALST::	DW 0
ALIST::		DW 0	;argument list
$ALIST::	DW 0
FLIST::		DW 0	;form storage list
$FLIST::	DW 0
STACK::		DW 0	;function stack (=neutral string)
$STACK::	DW 0

	EXTERNAL PLIST,$PLIST	;primitive function names and addresses
	EXTERNAL STATUS		;diagnose output
	GLOBAL BREAK		;re-entry from abort during RS input

	SUBTTL INITIALIZE

;Initialize data structures

TRAC80:	
	LD HL,RTSTCK	;Set up new stack pointer
	LD SP,HL
	LD (STKPTR),HL
	LD HL,(BDOS+1)	;Right storage area limit = (start of BDOS) - 1
	DEC HL
	DEC HL
	LD (FLIST),HL	
	LD ($FLIST),HL
	EX DE,HL
	LD HL,$PLIST	;Left storage area limit = $PLIST + 1
	INC HL
	LD (STACK),HL
	LD ($STACK),HL
	PUSH HL
	EX DE,HL	;Fill storage area with 0
	SCF
	CCF
	SBC HL,DE
	LD B,H
	LD C,L
	POP HL
	XOR A
	LD (HL),A
	INC DE
	LDIR

;Re-init before main program

BREAK:
	LD HL,(STKPTR)
	LD SP,HL
	LD A,(CTRLC)
	LD (CHAR),A
	LD A,DEVCON
	LD (INCHL),A
	LD HL,(STACK)
	LD ($STACK),HL
	XOR A		;c($STACK).=0
	LD HL,(STACK)
	LD (HL),A
	INC HL
	LD (HL),A
	LD DE,ACTST	;ACTST.=FLIST
	LD HL,FLIST
	LDI
	LDI
	LD HL,(ACTST)	;$ACTST.=ACTST-1
	DEC HL
	LD ($ACTST),HL
	LD HL,0		;STATE.=0
	LD (STATE),HL

	INCLUDE ERRMSG.INC
	INCLUDE PREFC.INC
	INCLUDE PSTFC.INC
	INCLUDE APPND.INC

;Main algorithm loop ---------------------------------------

	SUBTTL MAIN LOOP
	EXTERNAL CRNLFD,FCTINI,OUTSTR,OUTPUT,DIMON,DIMOFF

	.PRINTX /now in MAIN/
MAIN:
	CALL STATUS
	DB 'MAIN$'

;Insert idling string into active string

IDLIN0:	LD HL,(ACTST)	;check if enough space between neutral string
	LD DE,11	;and formstore
	SCF
	CCF
	SBC HL,DE
	PUSH HL
	LD DE,($STACK)
	INC DE
	SBC HL,DE
	POP HL
	JP NC,IDLIN1
	ERRMSG 'I'	;macro for error message
	LD HL,(FLIST)	;if not, delete latest form definition
	LD E,(HL)
	INC HL
	LD D,(HL)
	DEC HL
	ADD HL,DE
	LD (FLIST),HL
	LD (ACTST),HL
	DEC HL
	LD ($ACTST),HL
	JP IDLIN0	;and try again
IDLIN1:	LD (ACTST),HL	;insert idling string in active string
	IRP CH,<CCF,CCL,CHP,CHS,CCS,CCF,CCL,CHR,CHS,CCR,CCR>
	LD A,(CH)
	LD (HL),A
	INC HL
	ENDM

	CALL CRNLFD	;print CR/LF
	CALL FCTINI	;init function list
	LD A,(CHAR)	;check for break char (CTRL/C)
	LD HL,CTRLC
	CP (HL)
	JR NZ,BREAK1
	LD HL,(ACTST)	;AUXST.=ACTST
	LD (AUXST),HL
	LD HL,($ACTST)	;$AUXST.=$ACTST
	LD ($AUXST),HL
	CALL OUTSTR	;show idling string
	LD A,(CCM)	;and meta char
	CALL OUTPUT
	CALL CRNLFD

	EXTERNAL STEST,ARGMT,SUCCA,CHKKEY,INKEY

BREAK1:	;process active string
MAIN1:
	CALL CHKKEY	;check keyboard
	JP Z,MAIN2
	LD HL,CTRLC
	CP (HL)
	JP Z,BREAK	;break on Ctrl/C
	LD HL,CTRLT
	CP (HL)
	JP NZ,MAIN2
	LD A,1		;set trace flag on Ctrl/T
	LD (TRCFLG),A
MAIN2:	LD HL,(ACTST)	;CHAR.=c(ACTST)
	LD A,(HL)
	LD (CHAR),A
	INC HL		;INCR ACTST
	LD (ACTST),HL
;	CALL STATUS
;	DB 'MAIN1 $'
	LD A,(STATE)	;IF STATE>0 GOTO MAIN6
	CP 1
	JP P,MAIN6
	LD A,(CHAR)	;compare CHAR with syntactical symbols
	LD BC,7
	LD HL,CCF
	CPIR
	JP NZ,MAINCH	;jump if char (not syntactical symbol)
	LD HL,MAINTB
	ADD HL,BC
	ADD HL,BC
	LD E,(HL)
	INC HL
	LD D,(HL)
	EX DE,HL
	JP (HL)		;or jump according to table.
MAINTB:			;Note: Table of jump addresses is reverse.
	DW MAIN9	;TAB
	DW MAIN9	;LFD
	DW MAIN9	;CRN
	DW MAINCR	;CCR
	DW MAINCS	;CCS
	DW MAINCL	;CCL
	DW MAINCF	;CCF

MAINCF:	LD DE,(STATE)	;IF STATE=-2 GOTO MAIN8
	LD HL,-2
	SCF
	CCF
	SBC HL,DE
	JP Z,MAIN8
	DEC DE		;DECR STATE
	LD (STATE),DE
	JP MAIN9	;GOTO MAIN9

MAINCL:	LD HL,(STATE)	;IF STATE#0 GOTO LDELM
	LD A,H
	OR L
	JR NZ,LDELM
	INC HL		;INCR STATE
	LD (STATE),HL
	JP MAIN9	;GOTO MAIN9

LDELM:			;left delimiter
	LD DE,($ARGST)	;REGH.=$ARGST+2
	INC DE
	PUSH DE
	INC DE
	LD HL,(ACTST)
	SCF
	CCF
	SBC HL,DE
	JR NC,LDELM1
	POP DE
	ERRMSG 'W'	;workstore full
	JP BREAK
LDELM1:	POP HL		;$ALIST.=$ARGST+1
	LD ($ALIST),HL
	LD DE,(ARGST)	;c($ALIST).=ARGST-$ALIST
	EX DE,HL
	SCF
	CCF
	SBC HL,DE
	EX DE,HL
	LD HL,($ALIST)
	LD (HL),E
	INC HL
	LD (HL),D
	PREFC MODE,ALIST
	LD DE,($ALIST)	;REGH.=$ALIST+1
	INC DE
	INC DE
	PUSH DE
	LD HL,($STACK)	;c(REGH).=$STACK-REGH
	SCF
	CCF
	SBC HL,DE
	EX DE,HL
	POP HL
	LD ($STACK),HL	;$STACK.=REGH
	LD (HL),E
	INC HL
	LD (HL),D
	LD A,(STATE)	;MODE.=STATE
	LD (MODE),A
	LD HL,0		;STATE.=0
	LD (STATE),HL
	CALL FCTINI
	JP MAIN9

MAINCS:	CALL STEST
	APPND ARGST,ALIST
	LD HL,($ALIST)	;ARGST.=$ALIST+1
	INC HL
	LD ($ARGST),HL
	INC HL		;$ARGST.=$ALIST
	LD (ARGST),HL
	JP MAIN9

MAINCR:	CALL STEST
	LD DE,(STACK)	;IF STACK#$STACK GOTO RDELM
	LD HL,($STACK)
	SCF
	CCF
	SBC HL,DE
	JP NC,RDELM
	CALL FCTINI
	JP MAIN9

MAINCH:	CALL STEST
	JP MAIN8

MAIN6:			;Quote mode
	LD A,(CHAR)
	LD HL,CCR	;IF CHAR#CCR GOTO MAIN7
	CP (HL)
	JP NZ,MAIN7
	LD HL,(STATE)	;DECR STATE
	DEC HL
	LD (STATE),HL
	LD A,L		;IF STATE=0 GOTO MAIN9
	OR H
	JP Z,MAIN9
	JP MAIN8	;GOTO MAIN8

MAIN7:	LD HL,CCL	;IF CHAR#CCL GOTO MAIN8
	CP (HL)
	JP NZ,MAIN8
	LD HL,(STATE)	;INCR STATE
	INC HL
	LD (STATE),HL

MAIN8:	PSTFC CHAR,ARGST

MAIN9:	LD HL,($ACTST)	;IF $ACTST>=ACTST GOTO MAIN1
	LD DE,(ACTST)
	SCF
	CCF
	SBC HL,DE
	JP NC,MAIN1
	LD HL,($STACK)	;IF STACK=$STACK GOTO MAIN
	LD DE,(STACK)
	SCF
	CCF
	SBC HL,DE
	JP Z,MAIN	;----------end of main algorithm loop

	LD A,(CCR)	;CHAR.=CCR
	LD (CHAR),A
	LD HL,(STATE)	;IF STATE>0 GOTO MAIN6
	LD DE,1
	SCF
	CCF
	SBC HL,DE
	JP NC,MAIN6
	CALL STEST

RDELM:			;right delimiter
	APPND ARGST,ALIST
	LD HL,($ALIST)	;$VALST.=$ALIST+1
	INC HL
	LD ($VALST),HL
	INC HL		;VALST.=$VALST+1
	LD (VALST),HL
	LD A,(TRCFLG)	;IF TRCFLG=0 GOTO XEQFCT
	OR A
	JP Z,XEQFCT

;While in trace mode print argument list
	CALL DIMON
	LD A,(MODE)	;IF MODE#-2 GOTO PRTAL1
	CP -2
	JR NZ,PRTAL1
	LD A,(CLB)
	CALL OUTPUT
PRTAL1:	LD A,(CLB)
	CALL OUTPUT
	LD A,1		;USE ARGMT(ONE,AUXST)
	LD IY,AUXST
	CALL ARGMT
	LD HL,($ALIST)	;IF AUXST>$ALIST GOTO PRTAL3
	LD DE,(AUXST)
	SCF
	CCF
	SBC HL,DE
	JP C,PRTAL3
PRTAL2:	CALL OUTSTR
	LD IX,AUXST
	LD IY,AUXST
	CALL SUCCA
	LD HL,($ALIST)	;IF AUXST>$ALIST GOTO PRTAL3
	LD DE,(AUXST)
	SCF
	CCF
	SBC HL,DE
	JP C,PRTAL3
	LD A,(CUA)
	CALL OUTPUT
	JP PRTAL2
PRTAL3:	LD A,(CRB)
	CALL OUTPUT
	CALL DIMOFF
	CALL INKEY	;get one char from keyboard
	LD (CHAR),A
	LD HL,CRN	;IF CHAR#CRN GOTO PRTAL4
	CP (HL)
	JR NZ,PRTAL4
	CALL CRNLFD
	JP XEQFCT
PRTAL4:	XOR A		;TRCFLG=0
	LD (TRCFLG),A
	LD A,(CHAR)	;IF CHAR=CTRLC GOTO BREAK
	LD HL,CTRLC
	CP (HL)
	JP Z,BREAK

	.PRINTX /now in XEQFCT/

	EXTERNAL ARGMT,USERF,PSTF,PREF
	GLOBAL XEQFC3	;entry after workstore full

XEQFCT:	LD A,1		;USE ARGMT(ONE,ARGST)
	LD IY,ARGST
	CALL ARGMT
	LD DE,(ARGST)	;check name length
	LD HL,($ARGST)
	SCF
	SBC HL,DE
	JP NZ,XEQFC2
	EX DE,HL	;2-char name (possibly primitive function)
	LD B,(HL)	;B=1st char
	INC HL
	LD C,(HL)	;C=2nd char

;(The following is a rather straight-forward 
;implementation of the PLIST and the name search)
	LD HL,PLIST	;list of function names
	LD DE,$PLIST
PLUP1:	LD A,(HL)
	INC HL
	CP B		;1st char found?
	JP NZ,PLUP2
	LD A,(HL)
	CP C		;2nd char found?
	JP Z,PLUP3
PLUP2:	INC HL		;no, skip jump address
	INC HL
	INC HL
	PUSH HL
	SCF
	CCF
	SBC HL,DE
	POP HL
	JP C,PLUP1	;end of PLIST reached?
	JP XEQFC2	;yes, continue with user function
PLUP3:	INC HL		;primitive function found
	LD E,(HL)
	INC HL
	LD D,(HL)
	EX DE,HL	;HL=jump address to primitive function
	CALL XEQPF	;put return address on stack
	JP XEQFC3	;primitive function returns here

XEQPF:			;jump to primitive function subroutine
	CALL STATUS
	DB 'XEQPF$'
	JP (HL)

XEQFC2:	LD A,1		;or continue with user function
	CALL USERF

XEQFC3:			;remove function call 
	CALL STATUS
	DB 'XEQFC3$'
	LD HL,($STACK)	;ALIST.=$STACK-c($STACK)
	PUSH HL
	LD E,(HL)
	INC HL
	LD D,(HL)
	INC HL		;INCR ALIST
	ADD HL,DE
	LD (ALIST),HL
	POP DE		;$ALIST.=$STACK-1
	DEC DE
	DEC DE
	LD ($ALIST),DE
	DEC HL		;$STACK.=ALIST-1
	DEC HL
	LD ($STACK),HL
	EX DE,HL	;ARGST.=$ALIST-c($ALIST)
	PUSH HL
	LD E,(HL)
	INC HL
	LD D,(HL)
	DEC HL
	ADD HL,DE
	LD (ARGST),HL
	POP DE		;$ARGST.=$ALIST-1
	DEC DE
	LD ($ARGST),DE
	DEC HL		;$ALIST.=ARGST-1
	DEC HL
	LD ($ALIST),HL
;append value string either to active string or to neutral string
	LD A,(MODE)	;IF MODE#-2 GOTO XEQFC5
	CP -2
	JP NZ,XEQFC5
	LD HL,($ARGST)	;neutral mode: check if VALST directly behind ARGST
	INC HL
	LD DE,(VALST)
	SCF
	CCF
	SBC HL,DE
	JP Z,XEQFC4
	LD IX,VALST
	LD IY,ARGST
	CALL PSTF	;if not, postfix it
	JP XEQFC6
XEQFC4:	LD DE,$ARGST	;if yes, only adjust pointer (thus saving time)
	LD HL,$VALST
	LDI
	LDI
	JP XEQFC6
XEQFC5:	LD IX,VALST	;active mode: prefix VALST at ACTST
	LD IY,ACTST
	CALL PREF
XEQFC6:	LD HL,(ALIST)	;MODE.=c(ALIST)
	LD A,(HL)
	LD (MODE),A
	INC HL
	LD (ALIST),HL	;INCR ALIST
	JP MAIN9	;GOTO MAIN9

	END TRAC80	;specifies start address
