;01.06.86
;MAIN.INC contains the scanning and processing of the active string
;including the execution of a primitive or user function.

	.PRINTX /including MAIN/

	EXTERNAL STEST,ARGMT,SUCCA,INKEY

MAIN1:
	LD HL,(ACTST)	;CHAR.=c(ACTST)		first from ACTST to CHAR
	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
	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 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
;check for name of primitive function
	LD HL,(ARGST)
	LD B,(HL)	;B=1st char
	INC HL
	LD C,(HL)	;C=2nd char
	LD DE,($ARGST)
	EX DE,HL
	SCF
	CCF
	SBC HL,DE
	JP NZ,PLUP3	
;(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
	EX DE,HL
	SCF
	CCF
	SBC HL,DE
	EX DE,HL
	JP NC,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
;jump to primitive function subroutine
XEQPF:
	CALL STATUS
	DB 'XEQPF$'
	JP (HL)
;or continue with user function
XEQFC2:	LD A,1		
	CALL USERF
;remove function call 
XEQFC3:
	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

	.PRINTX /included/
