.TITLE	AS3B
	.IDENT	/X01/
 
	.NLIST	BEX
	.ENABL	LC
 
;
; AS
; EXPRESSIONS
;
; VERSION X01
;
; DAVID G. CONROY	24-MAY-78
; LAST UPDATED:		11-JUN-79
;
 
	.GLOBL	EXPR
	.GLOBL	REGXPR
	.GLOBL	FPPXPR
 
	.MCALL	CALL
	.MCALL	CALLR
	.MCALL	RETURN
 
;+
; ** EXPR - EVALUATE EXPRESSION
;
; OUTPUTS:
;	R0=VALUE OF THE EXPRESSION
;	R1=TYPE OF THE EXPRESSION
;-
 
EXPR:	MOV	R5,-(SP)	;SAVE REGISTERS
	MOV	R4,-(SP)	;
	MOV	R3,-(SP)	;
	MOV	R2,-(SP)	;
 
	CLR	R0		;GET A DEFAULT VALUE IN CASE NULL EXPR.
	MOV	#ST.ABS,R1	;
	CALL	TERM		;GET A TERM
	BCS	35$		;NONE, ERROR
	MOV	R2,R0		;COPY OVER INITIAL VALUE
	MOV	R3,R1		;AND TYPE
 
10$:	MOV	R0,-(SP)	;REGISTERS ARE TIGHT
	MOV	R1,-(SP)	;BUT THE CODE MUST RECURSE
	CALL	GETOKN		;GET OPERATOR
	MOV	R0,R2		;ALL OF THIS LEAVES THE C BIT ALONE
	MOV	(SP)+,R1	;
	MOV	(SP)+,R0	;
	BCS	40$		;BR ON END OF LINE
 
	MOV	#50$,R4		;LOOK IT UP IN THE OP TABLE
20$:	CMP	R2,(R4)+	;
	BEQ	30$		;HIT
	TST	(R4)+		;
	CMP	R4,#60$		;ANY MORE
	BLO	20$		;BR IF YES
	CALL	UNGET		;NOT AN OPERATOR, PUSH IT BACK
	BR	40$		;AND RETURN WHAT YOU HAVE
 
30$:	CALL	TERM		;GET THE RIGHT OPERAND
	BCS	35$		;ERROR
	CALL	@(R4)+		;PERFORM THE OPERATION AND
	BR	10$		;DO IT AGAIN
 
35$:	INCB	EERROR		;E FLAG FOR BAD EXPRESSION
	CALL	SKIP		;SKIP OVER JUNK
 
40$:	MOV	(SP)+,R2	;RETURN
	MOV	(SP)+,R3	;
	MOV	(SP)+,R4	;
	MOV	(SP)+,R5	;
	RETURN			;
 
;
; OPERATOR DISPATCH TABLE
;
 
50$:	.WORD	'+,70$		;ADDITION
	.WORD	'-,80$		;SUBTRACTION
	.WORD	'*,90$		;MULTIPLICATION
	.WORD	'%,95$		;DIVISION
	.WORD	SL,110$		;SHIFT LEFT
	.WORD	SR,100$		;SHIFT RIGHT
	.WORD	'&,120$		;AND
	.WORD	174,125$	;OR
	.WORD	'^,130$		;TYPE EXCHANGE
60$:	.BLKB	0		;END OF TABLE
 
;
; ADDITION
;
; OTH + ABS -> OTH
; ABS + OTH -> OTH
; ABS + ABS -> ABS
;
 
70$:	CMP	R1,R3		;SAME TYPE
	BNE	72$		;NO
	CMP	R1,#ST.ABS	;IF YES, BETTER BOTH BE ABSOLUTE
	BNE	76$		;R
	BR	78$		;
72$:	CMP	R1,#ST.ABS	;LEFT ABSOLUTE
	BNE	74$		;NO
	MOV	R3,R1		;YES, USE TYPE OF RIGHT
	BR	78$		;
74$:	CMP	R3,#ST.ABS	;RIGHT ABSOLUTE
	BEQ	78$		;YES, USE TYPE OF LEFT
76$:	INCB	RERROR		;RELOCATION ERROR
78$:	ADD	R2,R0		;DO THE ADD
	RETURN			;
 
;
; SUBTRACTION
;
; OTH - OTH -> ABS
; ABS - ABS -> ABS
; OTH - ABS -> OTH
;
 
80$:	CMP	R1,R3		;IF THE TYPES ARE THE SAME
	BNE	82$		;
	MOV	#ST.ABS,R1	;THE RESULT IS ABSOLUTE
	BR	84$		;
82$:	CMP	R3,#ST.ABS	;IF DIFFERENT, RIGHT MUST BE ABS
	BEQ	84$		;
	INCB	RERROR		;
84$:	SUB	R2,R0		;DO THE SUBTRACT
	RETURN			;
 
;
; OTHERS
;
; ABS ? ABS -> ABS
;
 
90$:	CALL	BOTHAB		;MAKE SURE BOTH ARE ABSOLUTE
	MOV	R0,R1		;MULTIPLY
	MOV	R2,-(SP)	;
	CALL	$MULR1		;FROM CC LIBRARY (EISBX.MAC)
	TST	(SP)+		;
	MOV	R1,R0		;
	MOV	#ST.ABS,R1	;SET ABSOLUTE RESULT
	RETURN			;
 
95$:	CALL	BOTHAB		;DIVIDE
	MOV	R0,R1		;SIGN EXTEND DIVIDEND
	CLR	R0		;
	TST	R1		;
	BPL	96$		;IS HARD WITHOUT AN SXT
	COM	R0		;
96$:	MOV	R2,-(SP)	;DO THE DIVIDE
	CALL	$DIVR0		;
	TST	(SP)+		;
	MOV	#ST.ABS,R1	;SET RESULT TYPE
	RETURN			;
 
100$:	CALL	BOTHAB		;RIGHT SHIFT
101$:	DEC	R2		;MORE
	BMI	112$		;NO
	ASR	R0		;DO A SHIFT STEP
	BR	101$		;
 
110$:	CALL	BOTHAB		;LEFT SHIFT
111$:	DEC	R2		;MORE
	BMI	112$		;NO
	ASL	R0		;DO A SHIFT STEP
	BR	111$		;
112$:	RETURN			;DONE
 
120$:	CALL	BOTHAB		;AND
	COM	R2		;NASTY ON THE 11
	BIC	R2,R0		;
	RETURN			;
 
125$:	CALL	BOTHAB		;OR
	BIS	R2,R0		;
	RETURN			;
 
;
; TYPE EXCHANGE
;
; VALUE OF LEFT AND TYPE OF RIGHT
;

130$:	MOV	R3,R1		;DO JUST THAT
	RETURN			;

;+
; ** SKIP -- SKIP OVER ILL-FORMED EXPRESSION
;
; THIS ROUTINE GETS CALLED WHEN AN ILL-FORMED EXPRESSION IS DISCOVERED
; IN THE INPUT (TERM WAS CALLED AND DIDN'T FIND SOMETHING THAT HE JUST
; DID NOT LIKE. IT SKIPS TO THE NEXT EOL, BLANK, TAB, SLASH, COMMA  OR
; SEMICOLON.
;
; USES:
;	R0
;-

SKIP:	CALL	GETC		;GET CHARACTER
	BCS	20$		;EOL
	CMP	R0,#40		;BLANK (UGH!)
	BEQ	10$		;
	CMP	R0,#11		;TAB (UGH!)
	BEQ	10$		;
	CMP	R0,#',		;COMMA
	BEQ	10$		;
	CMP	R0,#';		;SEMICOLON
	BEQ	10$		;
	CMP	R0,#'/		;SLASH
	BNE	SKIP		;NONE OF THE ABOVE
10$:	DEC	LINPTR		;UNGETC
20$:	RETURN			;FINIS

;+
; ** BOTHAB - CHECK OF BOTH OPERANDS ARE ABSOLUTE
;
; INPUTS:
;	R1=TYPE OF LEFT
;	R3=TYPE OF RIGHT
;
; OUTPUTS:
;	R1=ST.ABS (ALWAYS)
;-
 
BOTHAB:	CMP	R1,#ST.ABS	;IS THE LEFT ABSOLUTE
	BNE	10$		;NO
	CMP	R3,#ST.ABS	;IS THE RIGHT ABSOLUTE
	BEQ	20$		;YES, ALL OK
10$:	MOV	#ST.ABS,R1	;FORCE TYPE TO ABSOLUTE
	INCB	RERROR		;R FLAG
20$:	RETURN			;
 
;+
; ** TERM - GET A TERM OF THE EXPRESSION
;
; OUTPUTS:
;	R2=VALUE OF THE TERM
;	R3=TYPE OF THE TERM
;
;	C BIT SET IF NO TERM FOUND
;
;-
 
TERM:	MOV	R5,-(SP)	;SAVE REGISTERS
	MOV	R4,-(SP)	;
	MOV	R1,-(SP)	;
	MOV	R0,-(SP)	;
 
	CALL	GETOKN		;GET AN INPUT TOKEN
	BCS	70$		;EOL, NO TOKEN
	CMP	R0,#TLAB	;TEMP LABEL
	BNE	5$		;NO
	MOVB	F.T(R1),R3	;TYPE
	MOV	F.V(R1),R2	;VALUE
	BR	60$		;RETURN IT
 
5$:	CMP	R0,#ID		;IDENTIFIER
	BNE	20$		;NO
	MOV	#UST,R5		;IN USER TABLE
	CALL	LOOKUP		;
	BCC	10$		;YES
	MOV	#PST,R5		;IN SYSTEM TABLE
	CALL	LOOKUP		;
	BCC	10$		;YES
	CALL	INSERT		;IF UNDEFINED, DEFINE IT
10$:	MOV	S.T(R5),R3	;TYPE
	CMP	R3,#ST.UND	;IS IT UNDEFINED
	BNE	12$		;NO
	BIT	S.F(R5),#SF.GBL	;IF GLOBAL ITS OK, BUT
	BEQ	11$		;
	MOV	R5,R1		;SET TYPE CORRECTLY
	SUB	#UST+2,R1	;THAT IS
	CLR	R0		;GLOBAL
	MOV	#S.N+8.,-(SP)	;SYMBOL
	CALL	$DIVR0		;BASED
	TST	(SP)+		;RELOCATION
	MOV	R0,R3		;TYPE IS OFFSET + SYREL
	BIS	#SYREL,R3	;SET SYMBOL RELATIVE FLAG
	CLR	R2		;OFFSET IS 0
	BR	60$		;
11$:	INCB	UERROR		;UNDEFINED SYMBOL
	CLR	R2		;ABS 0
	BR	55$		;
12$:	MOV	S.V(R5),R2	;NOT UNDEFINED
	BR	60$		;
 
20$:	CMP	R0,#CON		;TOKEN A CONSTANT
	BNE	22$		;NO
	MOV	R1,R2		;YES, GET IT
	BR	55$		;
 
22$:	CMP	R0,#'[		;EXPRESSION IN BRACKETS
	BNE	26$		;NO
	CALL	EXPR		;READ EXPRESSION
	MOV	R0,R2		;PUT RESULT IN CORRECT PLACE
	MOV	R1,R3		;
	CALL	GETOKN		;DELIMITER MUST BE ']'
	BCS	24$		;
	CMP	R0,#']		;
	BEQ	60$		;OK
24$:	INCB	EERROR		;EXPRESSION ERROR
	BR	60$		;
 
26$:	CMP	R0,#''		;SINGLE CHARACTER CONSTANT
	BNE	30$		;NO
	CLR	R5		;GET IT
	CALL	MAPC		;
	BCS	50$		;ERROR IF EOL
	MOV	R0,R2		;
	BR	55$		;
 
30$:	CMP	R0,#'-		;UNARY '-'
	BEQ	32$		;YES
	CMP	R0,#'!		;OR '!'
	BNE	50$		;NO
32$:	MOV	R0,R4		;SAVE THE OPERATOR
	CALL	TERM		;GET THE TERM ON THE RIGHT
	BCS	50$		;ERROR IF NO TERM
	CMP	R3,#ST.ABS	;MUST BE ABSOLUTE
	BEQ	34$		;OR ERROR
	INCB	RERROR		;
34$:	CMP	R4,#'-		;WAS THE OPERATOR A '-'
	BNE	36$		;NO
	NEG	R2		;YES, DO IT
	BR	55$		;
36$:	COM	R2		;DO '!'
	BR	55$		;
 
50$:	CALL	UNGET		;NOT A LEGAL TERM
	SEC			;SET ERROR
	BR	70$		;
 
55$:	MOV	#ST.ABS,R3	;SET TYPE ABSOLUTE
60$:	CLC			;LEGAL TERM
70$:	MOV	(SP)+,R0	;RETURN
	MOV	(SP)+,R1	;
	MOV	(SP)+,R4	;
	MOV	(SP)+,R5	;
	RETURN			;
 
;+
; ** REGXPR - GET A REGISTER EXPRESSION
;
; OUTPUTS:
;	R0=VALUE OF THE REGISTER
;
; USES:
;	R1
;-
 
REGXPR:	CALL	EXPR		;GET AN EXPRESSION
	CMP	R1,#ST.REG	;IS THE TYPE CORRECT
	BNE	10$		;NO
	CMP	R0,#7		;IS THE VALUE IN RANGE
	BLOS	20$		;YES
10$:	INCB	AERROR		;NO, A ERROR
	BIC	#177770,R0	;J.I.C.
20$:	RETURN			;
 
;+
; ** FPPXPR -- GET AN FPP REGISTER EXPRESSION
;
; OUTPUTS:
;	R0=VALUE.
;
; USES:
;	R1
;-

FPPXPR:	CALL	EXPR		;GET EXPRESSION
	CMP	R1,#ST.REG	;REG?
	BNE	10$		;NO, A ERROR!
	CMP	R0,#3		;AC0 TO AC3
	BLOS	20$		;YES!
10$:	INCB	AERROR		;EGADS!!!
	BIC	#177774,R0	;J.I.C.
20$:	RETURN			;FINIS

	.END