.TITLE	EXPRESS
	.IDENT	"V1.3"
	.NLIST	BEX
;
;   Author:	D. Mischler	26-MAY-87
;
;   This module contains all code necessary for
;   expression evaluation.
;
	.PAGE
	.SBTTL	Table definitions
	.PSECT	RODATA,D,RO
;
;   Table of character attributes.
;   High bit set = Legal symbol constituent.
;   Bit 6 set	 = Legal digit in one or more radices.
;   Bit 5 set	 = Legal expression terminator.
;   Low 4 bits	 = Digit value.
;
S	=	200
D	=	100
T	=	40
SYMCHR::
	.BYTE	T,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0	; NUL through SI.
	.BYTE	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0	; DLE through US.
	.BYTE	T,0,0,0,S,0,0,0,T,0,0,0,T,0,S,0	; SP through '/'.
	.BYTE	S!D!0,S!D!1,S!D!2,S!D!3,S!D!4	; '0' through '4'.
	.BYTE	S!D!5,S!D!6,S!D!7,S!D!8.,S!D!9.	; '5' through '9'.
	.BYTE	T,T,0,T,0,0,0,S!D!10.,S!D!11.	; ':' through 'B'.
	.BYTE	S!D!12.,S!D!13.,S!D!14.,S!D!15.	; 'C' through 'F'.
	.BYTE	S,S,S,S,S,S,S,S,S,S,S,S,S,S,S,S	; 'G' through 'V'.
	.BYTE	S,S,S,S,0,0,0,0,0		; 'W' through '_'.
	.WORD	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0	; '`' through DEL.

;
;   Binary operator table.
;
BINTBL:
	.WORD	'+,ADDOPS	; Addition.
	.WORD	'-,SUBOPS	; Subtract.
	.WORD	'*,MULOPS	; Multiply.
	.WORD	'/,DIVOPS	; Divide.
	.WORD	'&,ANDOPS	; Logical AND.
	.WORD	'!,OROPS	; Logical inclusive OR.
	.WORD	'>,CLOSE	; Close sub-expression.
BINLEN	=	<.-BINTBL>/4

;
;   Unary operator table.
;
UNATBL:	.WORD	'-,NEGATE	; Negate operand.
	.WORD	'@,DEFER	; Fetch value from address.
	.WORD	'',ASCBYT	; Single ASCII character.
	.WORD	'",ASCWRD	; Double ASCII character.
	.WORD	'%,RAD50	; RAD50 conversion.
	.WORD	'<,OPEN		; Open sub-expression.
	.WORD	'^,ESCAPE	; Unary operator escape.
UNALEN	=	<.-UNATBL>/4

;
;   Secondary unary operator table.
;
UN2TBL:	.WORD	'B,BINRDX	; Binary radix.
	.WORD	'C,COMPL	; 1's complement.
	.WORD	'D,DECRDX	; Decimal radix.
	.WORD	'O,OCTRDX	; Octal radix.
	.WORD	'R,RAD50	; RAD50 conversion.
	.WORD	'X,HEXRDX	; Hexadecimal radix.
UN2LEN	=	<.-UN2TBL>/4
	.PAGE
	.SBTTL	Process binary operators
	.PSECT	CODE,I,RO
;
;   Subroutine to evaluate an expression.
;   On entry:	R0 points to expression string.
;
;   On exit:	R0 points after expression.
;		R1 contains expression value.
;		The carry will be set if an error is detected.
;
XPRESS::
	JSR	R5,$SAVRG	; Save registers R3 - R5.
;
;   Subexpression recursion point.
;
RECURS:	CALL	OPRAND		; Get an operand, OK?
	BCS	50$		; No, complain.
10$:	MOVB	(R0),R3		; End of the line?
	BEQ	40$		; Yes, return with value.
	BITB	#T,SYMCHR(R3)	; Expression terminator?		
	BNE	40$		; Yes, return value.
	MOV	#BINTBL,R3	; Point to binary operators table.
	MOV	#BINLEN,R4	; Get table length.
20$:	CMPB	(R3),(R0)	; Found operator?
	BEQ	30$		; Yes, evaluate it.
	CMP	(R3)+,(R3)+	; Point to next table entry.
	SOB	R4,20$		; Check all entries.
;   Unknown binary operator encountered.
	MOV	#E.BONF,R1	; Point to error message.
	SEC			; Indicate failure.
	RETURN
;   Evaluate binary operator.
30$:	INC	R0		; Point past operator character.
	TST	(R3)+		; Point to operator dispatch address.
	CALL	@(R3)+		; Call operator evaluation routine, OK?
	BCC	10$		; Yes, check for another operator.
	RETURN			; Indicate failure.
;   Exit evaluation level.
40$:	CLC			; Indicate success.
50$:	RETURN
	.PAGE
	.SBTTL	Process operands and unary operators
;
;   Subroutine to get an operand.
;
OPRAND:	MOV	#UNATBL,R3	; Point to unary operator table.
	MOV	#UNALEN,R4	; Get table length.
10$:	CMPB	(R3),(R0)	; Found operator?
	BEQ	20$		; Yes, evaluate it.
	CMP	(R3)+,(R3)+	; Point to next table entry.
	SOB	R4,10$		; Check all entries.
;   Operand must be numeric or symbolic.
	CMPB	(R0),#'0	; Is character too low to be numeric?
	BLO	SYMBOL		; Yes, assume symbolic.
	CMPB	(R0),#'9	; Too high to be decimal?
	BHI	SYMBOL		; Yes, assume symbolic.
	CALLR	NUMBER		; Process numeric value.
;   Process unary operator.
20$:	INC	R0		; Point past unary operator character.
	TST	(R3)+		; Point to operator dispatch address.
	CALLR	@(R3)+		; Process unary operator.
	.PAGE
;
;   Process symbolic value.
;
SYMBOL:	MOV	R0,R5		; Save pointer to symbol name.
10$:	MOVB	(R5)+,R3	; Fetch a character, patently illegal?
	BMI	20$		; Yes, trash it.
	TSTB	SYMCHR(R3)	; Is character a legal symbol constituent?
	BMI	10$		; Yes, try next one too.
20$:	DEC	R5		; Back up over non-symbol character.
	SUB	R0,R5		; Is "symbol" zero characters long?
	BEQ	SUBXMS		; Yes, complain.
;   Check for register name symbol.
	MOV	R0,R4		; Save symbol name pointer.
	CALL	U$SYMN		; Get symbol name in R2, R3.
	MOV	R0,R5		; Save expression pointer.
	MOV	#REGSYM,R0	; Point to register symbol table head.
	CALL	S$LNAM		; Look up symbol value, OK?
	BCC	30$		; Yes, get value and exit.
;   Check main symbol table.
	MOV	#SYMTBL,R0	; Point to main symbol table head.
	CALL	S$LNAM		; Look up symbol value, OK?
	BCS	SYMNTF		; No, symbol not found.
30$:	MOV	S.VALU(R0),R1	; Get symbol value.
	MOV	R5,R0		; Restore expression pointer.
	RETURN

;
;   Missing subexpresssion.
;
SUBXMS:	MOV	#E.MSBX,R1	; Point to error message.
	SEC			; Indicate failure.
	RETURN

;
;   Symbol not found.
;
SYMNTF:	MOV	#E.SYNF,R1	; Point to error message.
	MOV	R4,R0		; Point to unknown symbol name.
	SEC			; Indicate failure.
	RETURN
	.PAGE
;
;   Process a numeric value.
;   Allow decimal values to be denoted by a trailing period.
;
NUMBER:	CLR	R1		; Zero value.
	MOV	R0,R5		; Copy numeric constant pointer.
10$:	MOVB	(R5)+,R3	; Fetch a character, obviously illegal?
	BMI	20$		; Yes, cut off scan.
	BITB	#D,SYMCHR(R3)	; Is character a legal digit in some radix?
	BNE	10$		; Yes, keep scanning.
20$:	DEC	R5		; Point back to scan terminator.
	MOV	#10.,R4		; Assume decimal radix forced.
	CMPB	#'.,(R5)	; Has decimal conversion been forced?
	BEQ	30$		; Yes, assumption paid off.
	MOVB	RADIX,R4	; Get current radix.
;   Convert the number in the selected radix.
30$:	MOVB	(R0)+,R2	; Fetch a character, obviously illegal?
	BMI	40$		; Yes, conversion must be complete.
	MOVB	SYMCHR(R2),R2	; Get character attributes.
	BITB	#D,R2		; Is character a legal digit in some radix?
	BEQ	40$		; No, forget it.
	BIC	#^C<17>,R2	; Mask character to digit value.
	CMP	R2,R4		; Is digit legal in this radix?
	BHIS	40$		; No, terminate conversion.
	MUL	R4,R1		; Make room for new digit.
	ADD	R2,R1		; Add in new digit.
	BR	30$
;   If radix is decimal then remove '.' terminator.
40$:	CMP	#10.,R4		; Was conversion in decimal?
	BNE	50$		; No, back up over terminator.
	CMPB	#'.,-1(R0)	; Was terminator a period?
	BEQ	60$		; Yes, skip over it.
50$:	DEC	R0		; Back up over terminator.
60$:	CLC			; Indicate success.
	RETURN
	.PAGE
	.SBTTL	Unary operators
;
;   Fetch ASCII character.
;
ASCBYT:	CLR	R1		; Take no chances.
ASCII:	BISB	(R0)+,R1	; Get character, null?
	BNE	10$		; No, just leave.
	DEC	R0		; Back up over null.
10$:	RETURN

;
;   Fetch a pair of ASCII character.
;
ASCWRD:	CALL	ASCBYT		; Fetch first character.
	SWAB	R1		; Put first character in high byte.
	CALL	ASCII		; Fetch second character.
	SWAB	R1		; Put characters in proper bytes.
	RETURN

;
;   Temporarily set radix to binary.
;
BINRDX:	MOVB	RADIX,-(SP)	; Push current radix.
	MOVB	#2,RADIX	; Set radix to binary.
	BR	RADSET		; Fetch operand and restore radix.

;
;   Complement operand.
;
COMPL:	CALL	OPRAND		; Get an operand, OK?
	BCS	ERRXIT		; No, complain.
	COM	R1		; Complement it.
	BR	SUCRTN		; Take successful return.

;
;   Temporarily set radix to decimal.
;
DECRDX:	MOVB	RADIX,-(SP)	; Push current radix.
	MOVB	#10.,RADIX	; Set radix to decimal.
	BR	RADSET		; Fetch operand and restore radix.

;
;   Fetch value from specified address.
;
DEFER:	CALL	OPRAND		; Get an operand, OK?
	BCS	20$		; No, complain.
	BIT	#1,R1		; Is address odd?
	BNE	10$		; Yes, complain.
	MOV	R1,R5		; Copy address.
	CALL	M$RD5P		; Read word value, OK?
	BCC	20$		; Yes, exit.
10$:	MOV	#E.DFER,R1	; Point to deferred address error message.
	SEC			; Indicate failure.
20$:	RETURN
	.PAGE
;
;   Escape to second set of unary operators.
;
ESCAPE:	MOV	#UN2TBL,R3	; Point to secondary unary operator table.
	MOV	#UN2LEN,R4	; Get table length.
10$:	CMPB	(R3),(R0)	; Found operator?
	BEQ	20$		; Yes, evaluate it.
	CMP	(R3)+,(R3)+	; Point to next table entry.
	SOB	R4,10$		; Check all entries.
;   Can't find operator in table.
	DEC	R0		; Point back to unary operator escape.
	MOV	#E.BONF,R1	; Point to appropriate message.
	SEC			; Indicate failure.
	RETURN
;   Evaluate secondary unary operator.
20$:	INC	R0		; Skip past operator character.
	TST	(R3)+		; Point to operator dispatch address.
	CALLR	@(R3)+		; Process unary operator.

;
;   Temporarily set radix to hexadecimal.
;
HEXRDX:	MOVB	RADIX,-(SP)	; Push current radix.
	MOVB	#16.,RADIX	; Set radix to hexadecimal.
	BR	RADSET		; Fetch operand and restore radix.

;
;   Negate operand.
;
NEGATE:	CALL	OPRAND		; Get an operand, OK?
	BCS	ERRXIT		; No, complain.
	NEG	R1		; Negate it.
SUCRTN:	CLC			; Indicate success.
ERRXIT:	RETURN

;
;   Temporarily set radix to octal.
;
OCTRDX:	MOVB	RADIX,-(SP)	; Push current radix.
	MOVB	#8.,RADIX	; Set radix to octal.
RADSET:	CALL	OPRAND		; Fetch next operand.
	MOVB	(SP)+,RADIX	; Restore radix.
	RETURN

;
;   Convert next 3 characters to RAD50.
;
RAD50:	MOV	#1,R1		; Accept periods.
	CALL	$CAT5B		; Perform RAD50 conversion.
	TSTB	R2		; Was conversion terminated by end-of-line?
	BNE	10$		; No, assume everything is OK.
	DEC	R0		; Point to terminator.
10$:	RETURN
	.PAGE
	.SBTTL	Binary operators
;
;   Add operands.
;
ADDOPS:	CALL	GETOPR		; Fetch second operand.
	ADD	(SP)+,R1	; Add operands.
	BR	SUCXIT

;
;   Logically AND operands.
;
ANDOPS:	CALL	GETOPR		; Fetch second operand.
	COM	(SP)		; Invert source operand.
	BIC	(SP)+,R1	; Finish and operation.
	BR	SUCXIT

;
;   Divide operands.
;
DIVOPS:	CALL	GETOPR		; Fetch second operand.
	MOV	(SP)+,R5	; Pop source operand.
	CLR	R4		; Zero extend operand.
	DIV	R1,R4		; Perform division, OK?
	BCS	10$		; No, divide by zero attempted.
	BVS	20$		; No, result not representable.
	MOV	R4,R1		; Put quotient in place.
	BR	SUCXIT
;   Divide by zero attempted.
10$:	MOV	#E.DBZA,R1	; Point to error message.
	RETURN
;   Quotient cannot be represented.
20$:	MOV	#E.QCBR,R1	; Point to error message.
	SEC			; Indicate failure.
	RETURN

;
;   Multiply operands.
;
MULOPS:	CALL	GETOPR		; Fetch second operand.
	MUL	(SP)+,R1	; Multiply operands.
	BR	SUCXIT

;
;   Logically OR operands.
;
OROPS:	CALL	GETOPR		; Fetch second operand.
	BIS	(SP)+,R1	; OR operands.
	BR	SUCXIT

;
;   Subtract operands.
;
SUBOPS:	CALL	GETOPR		; Fetch second operand.
	SUB	R1,(SP)		; Subtract operands.
	MOV	(SP)+,R1	; Pop value.
SUCXIT:	CLC			; Indicate success.
	RETURN
	.PAGE
;
;   Subroutine to fetch second operand for a binary operator.
;   If an error occurs then a 2-level return will be effected.
;
GETOPR:	MOV	(SP),-(SP)	; Move return address down.
	MOV	R1,2(SP)	; Insert operand value in stack.
	CALL	OPRAND		; Fetch next operand, OK?
	BCC	10$		; Yes, return to evaluate operator.
	CMP	(SP)+,(SP)+	; Pop stack to previous return address.
	SEC			; Indicate failure.
10$:	RETURN

	.ENABL	LSB
;
;   Open a subexpression.
;
OPEN:	CALL	RECURS		; Recurse to process subexpression.
OPNRTN:	BCS	20$		; Preserve first diagnostic seen.
10$:	MOV	#E.UMSI,R1	; Indicate unmatched open/close indicators.
	SEC			; Indicate failure.
20$:	RETURN

;
;   Close a subexpression.
;
CLOSE:	CMP	#OPNRTN,2(SP)	; Was subexpression ever opened?
	BNE	10$		; No, complain.
	CMP	(SP)+,(SP)+	; Pop last two return addresses.
	CLC			; Indicate success.
	RETURN
	.DSABL	LSB
	.END