;
;  EXPR.ASM
;
;  PROVIDE FOR EXPRESSIONS IN OPERANDS
;
MUL16	LDA	OPNDL-1,X
	STA	SECVAL
	LDA	OPNDH-1,X
	STA	SECVAL+1
	LDA	OPNDH-2,X
	PHA
	LDA	OPNDL-2,X
	TAX
	LDA	#0
	STA	VALUE
	STA	VALUE+1
	LDA	#8
	STA	CNT
	PLA
ML0	JSR	MUL1
	DEC	CNT
	BNE	ML0
;
	LDA	#8
	STA	CNT
	TXA
ML1	JSR	MUL1
	DEC	CNT
	BNE	ML1
	RTS
;
MUL1	ASL	VALUE
	ROL	VALUE+1
MUL0	ASL	A
	BCC	MEX
	PHA
	CLC
	LDA	VALUE
	ADC	SECVAL
	STA	VALUE
	LDA	VALUE+1
	ADC	SECVAL+1
	STA	VALUE+1
	PLA
MEX	RTS
;
DIV16	LDA	OPNDL-1,X
	STA	SECVAL
	LDA	OPNDH-1,X
	STA	SECVAL+1
	LDA	OPNDL-2,X
	PHA
	LDA	OPNDH-2,X
	TAX
	LDA	#0
	STA	VALUE
	STA	VALUE+1
	LDA	#-16
	STA	CNT
	PLA
GETSIZ	BIT	SECVAL+1
	BMI	DODVS
	ASL	SECVAL
	ROL	SECVAL+1
	INC	CNT
	BNE	GETSIZ
	RTS
;
DODVS	PHA
	LDA	CNT
	AND	#$0F
	STA	CNT
	PLA
CMP16	CPX	SECVAL+1
	BNE	CMPX
	CMP	SECVAL
CMPX	PHP
	ROL	VALUE
	ROL	VALUE+1
	PLP
	BCC	NOSUB
	SBC	SECVAL
	PHA
	TXA
	SBC	SECVAL+1
	TAX
	PLA
NOSUB	LSR	SECVAL+1
	ROR	SECVAL
	DEC	CNT
	BPL	CMP16
	RTS
;
DOADD	CLC
	LDA	OPNDL-2,X
	ADC	OPNDL-1,X
	STA	OPNDL-2,X
	LDA	OPNDH-2,X
	ADC	OPNDH-1,X
	STA	OPNDH-2,X
	JMP	DOOPXB
;
DOSUB	SEC
	LDA	OPNDL-2,X
	SBC	OPNDL-1,X
	STA	OPNDL-2,X
	LDA	OPNDH-2,X
	SBC	OPNDH-1,X
	STA	OPNDH-2,X
	JMP	DOOPXB
;
DONEG	SEC
	LDA	#0
	SBC	OPNDL-1,X
	STA	OPNDL-1,X
	LDA	#0
	SBC	OPNDH-1,X
	STA	OPNDH-1,X
	JMP	DOOPXU
;
DOOP	LDX	OPDSP
	CMP	#'+'
	BEQ	DOADD
	CMP	#'-'
	BEQ	DOSUB
	CMP	#'!'
	BEQ	DONEG
	CMP	#'*'
	BEQ	DOMUL
	CMP	#'/'
	BEQ	DODIV
	CMP	#'%'
	BEQ	DOMOD
	CMP	#'&'
	BEQ	DOAND
	CMP	#'|'
	BEQ	DOOR
	BNE	DOOPXU
;
DOOPCX	LDX	OPDSP
	LDA	VALUE
	STA	OPNDL-2,X
	LDA	VALUE+1
	STA	OPNDH-2,X
DOOPXB	DEC	OPDSP
DOOPXU	DEC	OPRSP
	LDX	OPRSP
	LDA	OPERS+1,X
	CLC
	RTS
;
DOMUL	JSR	MUL16
	JMP	DOOPCX
;
DODIV	JSR	DIV16
	JMP	DOOPCX
;
DOMOD	JSR	DIV16
	PHA
	TXA
	LDX	OPDSP
	STA	OPNDH-2,X
	PLA
	STA	OPNDL-2,X
	JMP	DOOPXB
;
DOAND	LDA	OPNDL-2,X
	AND	OPNDL-1,X
	STA	OPNDL-2,X
	LDA	OPNDH-2,X
	AND	OPNDH-1,X
	STA	OPNDH-2,X
	JMP	DOOPXB
;
DOOR	LDA	OPNDL-2,X
	ORA	OPNDL-1,X
	STA	OPNDL-2,X
	LDA	OPNDH-2,X
	ORA	OPNDH-1,X
	STA	OPNDH-2,X
	JMP	DOOPXB
;
;  SYMBOLIC FUNCTION TESTS
;
LTEST	LDA	SYMBOL
	CMP	#'L'
	BNE	NOTM
	LDA	SYMBOL+1
	CMP	#'O'
	BNE	NOTM
	LDA	SYMBOL+2
	BEQ	TMATCH
	CMP	#'W'
	BNE	NOTM
	LDA	SYMBOL+3
	BNE	NOTM
;
TMATCH	SEC
	RTS			;CY=1
;
HTEST	LDA	SYMBOL
	CMP	#'H'
	BNE	NOTM
	LDA	SYMBOL+1
	CMP	#'I'
	BNE	NOTM
	LDA	SYMBOL+2
	BEQ	TMATCH
	CMP	#'G'
	BNE	NOTM
	LDA	SYMBOL+3
	CMP	#'H'
	BNE	NOTM
	LDA	SYMBOL+4
	BEQ	TMATCH
NOTM	CLC
	RTS
;
DOFUN	LDX	OPDSP
	LDA	FUNC
	CMP	#'H'
	BNE	SAVLO
	LDA	OPNDH-1,X
	STA	OPNDL-1,X
SAVLO	LDA	#0
	STA	OPNDH-1,X
	BEQ	UNEXIT
;
LOWFUN	LDA	#'L'
	BNE	LFXIT
;
HIGHFUN	LDA	#'H'
LFXIT	STA	FUNC
	LDA	(TEXTP),Y
	CMP	#'['
	BNE	NOBMP
	INY
NOBMP	LDA	#'@'
	BNE	PUSHOP
;
CKPAREN	LDA	(TEXTP),Y
	INY
	CMP	#'-'		;UNARY MINUS?
	BEQ	PSHCOM
	CMP	#'['
	BEQ	PUSHOP
RETERR	SEC
	RTS			;ELSE, EXPRESSION ERROR!
;
PSHCOM	LDA	#'!'		;UNARY MINUS ON STACK
PUSHOP	LDX	OPRSP
	STA	OPERS,X		;PUT NEW OPERATOR ON STACK
	INC	OPRSP
	JMP	EVAL
;
UNEST	LDX	OPRSP
	BEQ	RETERR
	LDA	OPERS-1,X
	CMP	#'['
	BEQ	UNEXIT
	CMP	#'@'
	BEQ	DOFUN
	JSR	DOOP
	BCC	UNEST
	RTS
;
UNEXIT	DEC	OPRSP
	JMP	GETOPR
;
EVALAB	LDA	#0
	STA	OPRSP
	STA	OPDSP		;CLEAR EVALUATION STACKS
	STA	FWDREF		;AND FORWARD REF. FLAG
	JSR	NXTFLD
EVAL	STY	TXTPTR
	JSR	GETSYM
	JSR	HTEST
	BCS	HIGHFUN
	JSR	LTEST
	BCS	LOWFUN
	LDY	TXTPTR		;NOT A SYMBOLIC FUNCTION
	JSR	PRIMRY
	BCS	CKPAREN
	LDX	OPDSP
	LDA	VALUE
	STA	OPNDL,X
	LDA	VALUE+1
	STA	OPNDH,X
	INC	OPDSP
;
GETOPR	LDA	(TEXTP),Y
	INY
	CMP	#'-'
	BEQ	ADDSUB
	CMP	#'+'
	BEQ	ADDSUB
	CMP	#'*'
	BEQ	MULDIV
	CMP	#'/'
	BEQ	MULDIV
	CMP	#'%'
	BEQ	MULDIV
	CMP	#'&'
	BEQ	ANDOP
	CMP	#'|'
	BEQ	OROP
	CMP	#']'
	BEQ	UNEST
WRPUP	LDX	OPRSP
	BEQ	EVDON
	LDA	OPERS-1,X
	CMP	#'['
	BEQ	EVDON
	JSR	DOOP
	BCC	WRPUP
	RTS
;
EVDON	CLC
	DEC	OPDSP
	BEQ	EVNXIT
	SEC
EVNXIT	LDA	OPNDL
	STA	VALUE
	LDA	OPNDH
	STA	VALUE+1
	RTS
;
ADDSUB	LDX	OPRSP
	STA	OPERS,X		;IF WE NEED TO DO IT NOW
	BEQ	EXIT
	LDA	OPERS-1,X
	CMP	#'['
	BEQ	EXIT
	CMP	#'@'
	BEQ	EXIT
	JSR	DOOP
	BCC	ADDSUB
	RTS
;
ANDOP	LDX	OPRSP
	STA	OPERS,X
	BEQ	EXIT
	LDA	OPERS-1,X
	CMP	#'!'
	BNE	EXIT
	JSR	DOOP
	BCC	ANDOP
	RTS
;
EXIT	INC	OPRSP
	JMP	EVAL
;
MULDIV	LDX	OPRSP
	STA	OPERS,X
	BEQ	EXIT
	LDA	OPERS-1,X
	CMP	#'+'
	BEQ	EXIT
	CMP	#'-'
	BEQ	EXIT
	CMP	#'['
	BEQ	EXIT
	CMP	#'@'
	BEQ	EXIT
	JSR	DOOP
	BCC	MULDIV
	RTS
;
OROP	LDX	OPRSP
	STA	OPERS,X
	BEQ	EXIT
	LDA	OPERS-1,X
	CMP	#'!'
	BEQ	ORDOOP
	CMP	#'&'
	BNE	EXIT
ORDOOP	JSR	DOOP
	BCC	OROP
	RTS
;
EVLSYM	STY	TXTPTR
	JSR	FIND		;GET SYMBOL FROM TABLE
	BCS	UNDFSM		;IF SYMBOL UNDEFINED
;
	JSR	GETVAL
;
	LDA	SFLGS
	AND	#$08		;PROPOGATE FORWARD REFERENCES
	ORA	FWDREF		;NOTE THAT THE FLAG IS IN BIT 3 NOW
	STA	FWDREF		;(BIT 2 IN THE SYMBOL TABLE)
;
	BIT	SFLGS
	BMI	UNDFSM
	LDA	SVAL
	STA	VALUE
	LDA	SVAL+1
	STA	VALUE+1
EVSXIT	LDY	TXTPTR
	CLC
	RTS
;
UNDFSM	LDA	#'U'
	STA	ADRERR
	BNE	EVSXIT
;
;  EVALUATE AN OPERAND EXPRESSION
;
PRIMRY	LDA	#0
	STA	VALUE
	STA	VALUE+1
	STA	SYMBOL
	JSR	GETSYM
	LDA	SYMBOL
	BNE	EVLSYM		;IF A SYMBOL WAS FOUND
	LDA	(TEXTP),Y
	CMP	#'$'
	BNE	NOTHEX
HEXCVL	INY
	LDA	(TEXTP),Y
	CMP	#'f'+1
	BCS	ENDEXP
	CMP	#'a'
	BCC	NLCHD
	SBC	#'a'-10
	BCS	HEXDGT
;
NLCHD	CMP	#'F'+1
	BCS	ENDEXP
	CMP	#'A'
	BCC	NUCHD
	SBC	#'A'-10
	BCS	HEXDGT
;
NUCHD	CMP	#'9'+1
	BCS	ENDEXP
	CMP	#'0'
	BCC	ENDEXP
	SBC	#'0'
HEXDGT	ASL	VALUE
	ROL	VALUE+1
	ASL	VALUE
	ROL	VALUE+1
	ASL	VALUE
	ROL	VALUE+1
	ASL	VALUE
	ROL	VALUE+1
	ORA	VALUE
	STA	VALUE
	JMP	HEXCVL
;
ENDEXP	CLC
	RTS
;
NOPRIM	SEC
	RTS
;
NOTHEX	CMP	#'%'
	BEQ	ISBIN
	CMP	#'@'
	BEQ	ISOCT
	CMP	#'*'
	BEQ	ISPC
	CMP	#$27	;QUOTED CHARACTERS
	BEQ	ISQSTR
	CMP	#'9'+1
	BCS	NOPRIM
	CMP	#'0'
	BCC	NOPRIM
DECCVL	CMP	#'9'+1
	BCS	ENDEXP
	CMP	#'0'
	BCC	ENDEXP
	SBC	#'0'
	PHA
	ASL	VALUE
	ROL	VALUE+1
	LDA	VALUE+1
	STA	TEMP
	LDA	VALUE
	ASL	A
	ROL	TEMP
	ASL	A
	ROL	TEMP
	CLC
	ADC	VALUE
	STA	VALUE
	LDA	TEMP
	ADC	VALUE+1
	STA	VALUE+1
	CLC
	PLA
	ADC	VALUE
	STA	VALUE
	LDA	#0
	ADC	VALUE+1
	STA	VALUE+1
	INY
	LDA	(TEXTP),Y
	JMP	DECCVL
;
ISBIN	INY
	LDA	(TEXTP),Y
	CMP	#'0'
	BCC	ENDEXP
	CMP	#'1'
	BCC	SHFTBN
	BNE	ENDEXP
SHFTBN	ROL	VALUE
	ROL	VALUE+1
	JMP	ISBIN
;
ISOCT	INY
	LDA	(TEXTP),Y
	CMP	#'7'+1
ENDOCT	BCS	ENDEXP
	CMP	#'0'
ND2OCT	BCC	ENDEXP
	SBC	#'0'
	ASL	VALUE
	ROL	VALUE+1
	ASL	VALUE
	ROL	VALUE+1
	ASL	VALUE
	ROL	VALUE+1
	ORA	VALUE
	STA	VALUE
	JMP	ISOCT
;
ISPC	INY
	LDA	PC
	STA	VALUE
	LDA	PC+1
	STA	VALUE+1
	BCS	ENDOCT
;
ISQSTR	INY
	LDA	(TEXTP),Y
	INY
	CMP	#$27
	BEQ	ENDOCT
	CMP	#EOL
	BEQ	STRERR
	STA	VALUE
	LDA	(TEXTP),Y
	INY
	CMP	#$27
	BEQ	ENDOCT
	CMP	#EOL
	BEQ	STRERR
	STA	VALUE+1
	LDA	(TEXTP),Y
	INY
	CMP	#$27
	BEQ	ENDOCT
STRERR	LDA	#'S'
	STA	ADRERR
	JMP	ENDEXP
;
GETSYM	LDX	#0
GSYMLP	LDA	(TEXTP),Y
GSLP1	CMP	#'A'
	BCC	ENDOPC
	CMP	#'Z'+1
	BCC	STCHAR
	CMP	#'_'		;ALLOW UNDERSCORES IN SYMBOLS
	BEQ	STCHAR
	CMP	#'a'
	BCC	ENDOPC
	CMP	#'z'+1
	BCS	ENDOPC
STCHAR	INY
	CPX	#SYMSIZ		;ALLOW 8 CHAR SYMBOLS
	BCS	GSYMLP
	STA	SYMBOL,X
	INX
	LDA	(TEXTP),Y
	CMP	#'9'+1
	BCS	GSLP1
	CMP	#'0'
	BCS	STCHAR
;
ENDOPC	LDA	#0
	INX
	STA	SYMBOL-1,X
	RTS
;
SKPTXT	LDA	(TEXTP),Y
	CMP	#EOL
	BEQ	SKXIT
	CMP	#' '
	BEQ	SKXIT
	CMP	#TAB
	BNE	SKPTXT

SKIPF	INY
NXTFLD	LDA	(TEXTP),Y
	CMP	#' '
	BEQ	SKIPF
	CMP	#TAB
	BEQ	SKIPF
SKXIT	RTS
