; Doug's Programming Language  -- DPL, Version 2.22
; Copyright (c) 1988 Douglas S. Cody, All rights reserved.
;-------------------------==============================-----------------------
;-------------------------==============================-----------------------
;-------------------------==============================-----------------------
;
SUBPGM	EXPR
;
; EXPR - This subroutine performs "recursive decent parsing" on an
; algebraic formula to derive a 16 bit signed answer. The routine uses
; a subset of the hierarchy of operators from 'The "C" Programming
; Language', chapter 2, page 49.
;
; Entry Conditions:
;	AX points to an UPPERCASE string
; Exit Conditions:
;	CARRY SET    - bad formula
;			AX holds the error number
;			BX holds the character position of the bad token
;	      CLEAR  - good formula
;			result in AX
;
; Possible Errors:
;
_PARENERR	EQU	1	; Unbalanced Parenthesis
_BADVAL		EQU	2	; Bad literal #
_INVALID	EQU	3	; invalid formal error
;
; local string storage for token extraction
;
STRING		TOKEN,32	; Holds the extracted string token
TOKENTYPE	DB	0	; Holds the token type
;
_UNKTYPE		EQU	0	; Illegal token type
_DELIM			EQU	1	; DELIMITER token type
_NUMERIC		EQU	2	; NUMERIC token type
_VARIABLE		EQU	3	; VARIABLE token type
_FUNC			EQU	4	; FUNCTION token type
;
; delimiter lists
;
LLIST1	DB	0DH,' ',9,"+-*/%()",0	; LLIST1 contains all delimiters
LLIST2		EQU	LLIST1+3	; LLIST2 doesn't include cr,tab,space
L1SIZE		EQU	11		; 11 delimiters
L2SIZE		EQU	 8		;  8 delimiters
;
	PUBLIC	SYMLOOK
SYMLOOK	DW	0		; Holds the address of a symbol lookup
;				; function. This vector is supplied by
;				; the user program. Functions & keywords
;				; must be searched for by this routine.
;
VARFUNC DW	0		; Holds the vector/variable value returned
;				; by SYMLOOK.
;
; The SYMLOOK routine must accept and return the following conditions:
;
; Entry Conditions:
;	DS:SI points to the TOKEN
; Exit Conditions:
;	AX,BX,CX,DX may be modified. No other registers may be changed
;	CARRY SET   - No match found, string undefined.
;	      CLEAR - Match found, AX holds the value
;		      BH holds the token type, _VARIABLE or _FUNC
;
;-------------------------==============================-----------------------
;-------------------------====< START OF EXECUTION >====-----------------------
;-------------------------==============================-----------------------
;
BEGIN	EXPR
	EXTRN	_DV1616:NEAR, _DEC:NEAR
	PUSH	BP		; SAVE THE INDEXES
	PUSH	SI
	PUSH	AX		; SAVE A COPY OF THE STRING ADDRESS
	MOV	BP,SP		; IN CASE OF AN ERROR, WE CAN FLUSH THE STACK
	MOV	SI,AX		; SI POINTS TO THE STRING
;
	CALL	GETTOKEN	; PRIME THE PUMP, GET THE 1ST ELEMENT
	CMP	[TOKEN],0	; ANY EXPRESSION?
	MOV	AX,_INVALID	; (FIRST, LOAD THE ERROR NUMBER)
	JZ	EXPR_ERR	; YES, ITS NOT A VALID FORMULA
;
	CALL	LEVEL1		; GET THE FINAL RESULT
;
	POP	BX		; FLUSH THE STRING ADDRESS
	POP	SI		; RESTORE THE OTHERS
	POP	BP
	CLC
	RET
;
EXPR_ERR:
	MOV	SP,BP		; ERROR, FLUSH ALL & RETURN
	MOV	BX,SI		; BX POINTS TO THE STRING
	POP	SI		; GET THE ORIGINAL ADDRESS
	SUB	BX,SI		; BX HOLDS THE 0 BASED POINTER
	DEC	BX
	POP	SI
	POP	BP
	STC
	RET
;
;
; L E V E L 1  --  PROCESS '=' '+=' '-=', ETC
;
LEVEL1	PROC	NEAR
	CALL	LEVEL11		; NOT INCORPORATED YET
	RET

LEVEL1	ENDP
;
;
; L E V E L 1 1  --  PROCESS '+' & '-' EQUATIONS
;
; Entry Conditions:
;	TOKEN holds the 1st term
;	SI points to the operator
; Exit Conditions:
;	Result in AX
;
LEVEL11	PROC	NEAR
	CALL	LEVEL12			; PROCESS HIGHER PRECEDENCE OPERATORS
;
L11_LOOP:
	CMP	[TOKEN],'+'		; ADDITION?
	JZ	L11_ADD			; YES, CONTINUE ON...
	CMP	[TOKEN],'-'		; SUBTRACTION?
	JZ	L11_SUB			; YES, CONTINUE ON...
	RET				; NO, ALL DONE
;
L11_ADD:
	CALL	L11_COMM		; DO COMMON CODE
	ADD	AX,BX			; ADD TWO TERMS
	JMP	SHORT L11_LOOP		; CONTINUE TILL DONE
;
L11_SUB:
	CALL	L11_COMM
	SUB	AX,BX			; SUBTRACT TWO TERMS
	JMP	SHORT L11_LOOP
;
L11_COMM	PROC	NEAR
	PUSH	AX			; SAVE 1ST TERM
	CALL	GETTOKEN		; FETCH NEXT ELEMENT
	CALL	LEVEL12			; DO CHECK IT OUT
	POP	BX
	XCHG	AX,BX			; STRAIGTHEN OUT THE ORDER
	RET
L11_COMM	ENDP
LEVEL11		ENDP
;
;
; L E V E L 1 2  --  PROCESS '*' & '/' & '%' EQUATIONS
;
; Entry Conditions:
;	TOKEN holds the 1st term
;	SI points to the operator
; Exit Conditions:
;	Result in AX
;
LEVEL12	PROC	NEAR
	CALL	LEVEL13			; PROCESS HIGHER PRECEDENCE OPERATORS
;
L12_LOOP:
	CMP	[TOKEN],'*'		; MULTIPLICATION?
	JZ	L12_MUL			; YES, CONTINUE ON...
	CMP	[TOKEN],'/'		; DIVISION?
	JZ	L12_DIV			; YES, CONTINUE ON...
	CMP	[TOKEN],'%'		; MODULO DIVISION?
	JZ	L12_MOD			; YES, CONTINUE ON...
	RET				; NO, ALL DONE
;
L12_MUL:
	CALL	L12_COMM		; DO COMMON CODE
	IMUL	BX			; MULTIPLY TWO TERMS
	JMP	SHORT L12_LOOP		; CONTINUE TILL DONE
;
L12_DIV:
	CALL	L12_COMM
	CALL	_DV1616			; DIVIDE TWO TERMS
;
L12_DIVCOMM:
	CMP	STATUS,0		; GOOD?
	JZ	L12_LOOP
	SUB	AX,AX
	JMP	SHORT L12_LOOP
;
L12_MOD:
	CALL	L12_COMM
	CALL	_DV1616			; DIVIDE TWO TERMS
	MOV	AX,DX
	JMP	SHORT L12_DIVCOMM
;
L12_COMM	PROC	NEAR
	PUSH	AX			; SAVE 1ST TERM
	CALL	GETTOKEN		; FETCH NEXT ELEMENT
	CALL	LEVEL13			; DO CHECK IT OUT
	POP	BX
	XCHG	AX,BX			; STRAIGTHEN OUT THE ORDER
	RET
L12_COMM	ENDP
LEVEL12		ENDP
;
;
; L E V E L 1 3  --  PROCESS UNARY '+' & '-' TERMS
;
; Entry Conditions:
;	TOKEN holds the unary sign
;	SI points to the term
; Exit Conditions:
;	Result in AX
;
LEVEL13	PROC	NEAR
	CMP	[TOKEN],'+'		; POSITIVE?
	JZ	L13_UADD		; YES, CONTINUE ON...
	CMP	[TOKEN],'-'		; NEGATIVE?
	JZ	L13_USUB		; YES, CONTINUE ON...
	CALL	LEVEL14A		; GO GET THE VALUE & RETUR IT
	RET				; NO, ALL DONE
;
L13_UADD:
	CALL	GETTOKEN		; GET THE TERM
	CALL	LEVEL14A		; GET THE VALUE
	RET				; RETURN UNCHANGED
;
L13_USUB:
	CALL	GETTOKEN		; GET THE TERM
	CALL	LEVEL14A		; GET THE BINARY VALUE
	NEG	AX			; INVERT 2 COMP.
	RET

LEVEL13	ENDP
;
;
; L E V E L 1 4 A  --  PROCESS A FUNCTION TOKEN
;
; Entry Conditions:
;	SI points to the next term
; Exit Conditions:
;	Result in AX
;
LEVEL14A	PROC	NEAR
	CMP	[TOKENTYPE],_FUNC	; START OF FUNCTION?
	JZ	L14A_FUNC		; YES, CONTINUE ON...
	CALL	LEVEL14B		; NO, GO GET THE # & RETURN IT
	RET				; RETURN WITH THE VALUE
;
L14A_FUNC:
	PUSH	[VARFUNC]		; SAVE OUR VECTOR
	CALL	GETTOKEN		; GET THE NEXT TERM
	CALL	LEVEL14B		; GET THE #
;
L14A_DOIT:
	POP	BX			; GET THE VECTOR
	PUSH	SI			; DO NOT DISTURB OUR POINTER
;
	CALL	BX			; & GO DO IT
;
	POP	SI
	RET				; RETURN WITH NEW VALUE

LEVEL14A	ENDP
;
;
; L E V E L 1 4 B  --  PROCESS '(' & ')' OPERATORS
;
; Entry Conditions:
;	TOKEN might hold the '('
;	SI points to the next term
; Exit Conditions:
;	Result in AX
;
LEVEL14B	PROC	NEAR
	CMP	[TOKEN],'('		; START OF PAREN EXPRESSION?
	JZ	L14B_PAREN		; YES, CONTINUE ON...
	CALL	GETTERM			; NO, GO DECODE THE NUMBER
	RET				; RETURN WITH THE VALUE
;
L14B_PAREN:
	CALL	GETTOKEN		; GET THE NEXT TERM
	CALL	LEVEL1			; GET THE RESULT
	CMP	[TOKEN],')'		; ENDING PAREN?
	JNZ	L14B_ERR		; NO, EXIT IN ERROR
	PUSH	AX			; SAVE THE VALUE
	CALL	GETTOKEN		; SKIP THE PAREN & GET THE NEXT TERM
	POP	AX
	RET				; RETURN UNCHANGED
;
L14B_ERR:
	MOV	AX,_PARENERR		; GIVE THE ERROR
	JMP	EXPR_ERR		; EXIT IN ERROR

LEVEL14B	ENDP
;
;
; G E T T E R M  --  Convert the decimal string to binary
;
; Entry Conditions:
;	TOKEN holds the string value
; Exit Conditions:
;	AX holds the value
;
GETTERM	PROC	NEAR
	PUSH	SI			; SAVE THE INDEXES
;
	CMP	[TOKENTYPE],_VARIABLE	; VARIABLE TOKEN?
	JNZ	GETE_05			; NO, CONTINUE ON...
	CMP	[SYMLOOK],0		; VECTOR SET?
	JZ	GETE_BAD		; NO, GO SIGNAL AN ERROR
	MOV	AX,[VARFUNC]		; GET THE VARIABLE VALUE
	JMP	SHORT GETE_10		; EXIT ALSO IF GOOD
;
GETE_05:
	MOV	SI,OFFSET TOKEN
	CMP	BYTE PTR [SI],0		; NULL VALUE?
	JZ	GETE_BAD		; YES, ITS INVALID
	CALL	_DEC			; CONVERT TO BINARY
	CMP	[STATUS],0		; GOOD VALUE
	JZ	GETE_10			; YES, CONTINUE ON...
;
GETE_BAD:
	MOV	AX,_BADVAL
	POP	SI			; SI MUST POINT TO THE STRING
	JMP	EXPR_ERR		; EXIT BAD
;
GETE_10:
	POP	SI			; GET THE STRING POINTER BACK
	PUSH	AX			; SAVE THE VALUE
	CALL	GETTOKEN		; LOAD THE NEXT TOKEN
	POP	AX
	RET

GETTERM	ENDP
;
;
; G E T T O K E N  --  GET THE NEXT TOKEN FROM INPUT
;
; Entry Conditions:
;	SI points to the input string
; Exit conditions:
;	TOKEN holds the next element
;
GETTOKEN	PROC	NEAR
	PUSH	ES			; SAVE ALL INDEXES, SEGMENTS
	PUSH	DI
	PUSH	DS			; ES POINTS TO DATA SEGMENT
	POP	ES
	MOV	DI,OFFSET TOKEN		; ES:DI POINTS TO TOKEN
;
GET_SP:
	LODSB				; GET THE NEXT CHARACTER
	CMP	AL,' '			; SPACE?
	JZ	GET_SP			; YES, EAT IT
	CMP	AL,9			; TAB?
	JZ	GET_SP			; YES, EAT IT
;
GETO_10:
	MOV	CX,L2SIZE		; CHECK AGAINST LIST
	MOV	BX,OFFSET LLIST2-1
	CALL	CMPLIST			; DELIMITER?
	JNZ	GETO_15			; NO, CONTINUE ON...
	STOSB				; YES, SAVE IT & RETURN
	SUB	AL,AL
	STOSB				; SET THE TERMINATOR
	MOV	[TOKENTYPE],_DELIM	; AND THE TYPE
	JMP	GETO_EXIT
;
GETO_15:
	CMP	AL,'_'			; ACCEPTABLE VARIABLE CHARACTER?
	JZ	GETO_17			; YES, GO SAVE IT
	CMP	AL,'@'			; ACCEPTABLE VARIABLE CHARACTER?
	JB	GETO_20			; NO, GO CHECK FOR LITERAL NUMBER
	CMP	AL,'Z'			; ACCEPTABLE VARIABLE CHARACTER?
	JA	GETO_20			; NO, GO CHECK FOR LITERAL NUMBER
;
GETO_17:
	STOSB				; SAVE IN STRING
	LODSB				; FETCH THE NEXT CHARACTER
	CMP	AL,'0'			; MUST BE A LITERAL NUMBER
	JB	GETO_18			; EXIT BAD...
	CMP	AL,'9'			; IS IT 0 - 9?
	JLE	GETO_17			; YES, SAVE IN THE STRING
;
GETO_18:
	MOV	CX,L1SIZE		; CHECK FOR TERMINATOR
	MOV	BX,OFFSET LLIST1-1
	CALL	CMPLIST			; IS IT A TERMINATOR?
	JZ	GETO_19			; YES, EXIT GOOD
	JMP	GETO_15			; GO CHECK FOR AN ALPHA CHARACTER
;
GETO_19:
	DEC	SI			; TERMINATOR, POINT TO IT
	SUB	AL,AL
	STOSB				; SET THE TERMINATOR
	CMP	[SYMLOOK],0		; VARIABLE VECTOR SET?
	JZ	GETO_BAD		; NO, GO SIGNAL AN ERROR
	PUSH	SI			; SAVE THE SOURCE POINTER...
	MOV	SI,OFFSET TOKEN		; POINT FOR NEXT ROUTINE
	CALL	[SYMLOOK]		; GO PROCESS THE VARIABLE
	POP	SI			; RESTORE FIRST...
	JC	GETO_BAD		; EXIT IF BAD
	MOV	[TOKENTYPE],BL		; SET THE TOKEN TYPE
	MOV	[VARFUNC],AX		; SAVE THE VALUE/VECTOR
	JMP	GETO_EXIT		; ALL DONE, RETURN NOW
;
GETO_20:
	CMP	AL,'0'			; MUST BE A LITERAL NUMBER
	JB	GETO_BAD		; EXIT BAD...
	CMP	AL,'9'
	JA	GETO_BAD
	STOSB				; SAVE IN THE STRING
	LODSB				; FETCH NEXT CHARACTER
	MOV	CX,L1SIZE		; CHECK FOR TERMINATOR
	MOV	BX,OFFSET LLIST1-1
	CALL	CMPLIST			; IS IT A TERMINATOR?
	JNZ	GETO_20			; NO, GO SAVE IT
;
	DEC	SI			; TERMINATOR, POINT TO IT
	SUB	AL,AL
	STOSB
	MOV	[TOKENTYPE],_NUMERIC	; SET THE TOKEN TYPE FOR LITERAL NUMBER
;
GETO_EXIT:
	POP	DI
	POP	ES
	RET
;
GETO_BAD:
	MOV	[TOKEN],0		; NULL OUT THE BAD TOKEN & RETURN
	MOV	[TOKENTYPE],_UNKTYPE
	MOV	AX,_INVALID
	JMP	EXPR_ERR
;
CMPLIST	PROC	NEAR
	INC	BX			; MOVE TO NEXT ELEMENT
	CMP	AL,[BX]			; IS IT THE TERMINATOR?
	LOOPNE	CMPLIST			; NO, CONTINUE SEARCHING
	RET

CMPLIST	ENDP
GETTOKEN	ENDP
;
ENDPGM	EXPR
;