eval

.PAGE 'EVAL'

; TEST A CHAR TO SEE IF ALPHABETIC
; CARRY SET IF ALPHABETIC, CARRY CLEAR IF NOT ALPHABETIC
; REG X CONTAINS INDEX INTO ICRD

NALPH	LDA ICRD,X      ;CHAR TO TEST
	CMP #'A'
	BCC J30         ;LESS THAN ALPHABET
	CMP #$5B        ;'Z' + 1
	BCC J40         ;IN ALPHABET RANGE
	BCS J30

; TESTS A CHAR TO SEE IF NUMERIC
; CARRY SET IF NUMERIC, CARRY CLEAR IF NOT NUMERIC
; REG X CONTAINS INDEX INTO ICRD

NUMRC	LDA ICRD,X      ;CHAR TO TEST
	CMP #'0'
	BCC J30         ;LESS THAN NUMBERS
	CMP #':'        ;'9' + 1
	BCC J40
	BCS J30         ;NOT NUMERIC

; *********************************
; * CONSTRUCTS A SYMBOL
; * NON-ALPHABETIC CAUSES CARRY CLR
; * OTHERWISE CARRY SET .X IS INDEX
; *********************************

CONSYM	LDY #$FF        ;Y IS A COUNTER
C10	INY
	CPY #5          ;MAXIMUM SYMBOL LENGTH
	BEQ C12
	BCS NUMR2       ;SUCESSFUL CONSTRUCT (CARRY IS SET)
C12	CPY KLEN        ;ALL CHARS TO SYM?
	BCC C14
	BCS C30         ;YES...FILL IN BLANKS

C14	JSR NALPH       ;CHAR ALPHABETIC
	BCS C20         ;YES...
	JSR NUMRC       ;IS IT A NUMBER
	BCS C20         ;YES-(CARRY IS SET) (ALPHA)
	RTS
NUMR2	SEC
	RTS

C20	LDA ICRD,X      ;NEXT CHAR OF SYM
	STA ISYM,Y
	INX             ;NEXT COLUMN OF SOURCE
	BNE C10
C30	LDA #$20        ;FILL IN WITH BLANKS
	STA ISYM,Y
	BNE C10         ;ALWAYS

.PAGE
; **********************************************************************
;
;    EVALUATES AN EXPRESSION
;
; REG X CONTAINS INDEX TO START OF EXPRESSION TO BE EVALUATED.
; UPON RTN FROM ROUTINE X CONTAINS POINTER TO FIRST CHARACTER
; BEYOND END, OR ON ERROR RETURN, CONTAINS POINTER TO BAD PORTION.
;
; RETURN SET AS FOLLOWS:
;
;   0  --  STRING COULD BE EVALUATED (IEXP = VALUE OF THE STRING)
;   1  --  UNDEFINED SYMBOL
;   2  --  EXPRESSION IS BAD
;
; **********************************************************************

EVAL	LDA #0          ;INIT EXPRESSION
	STA IEXP
	STA IEXP+1
	LDA #$FC        ;IEXP & KNVAL TO PLUS
	AND IFLAGS+1
	STA IFLAGS+1
	CPX IMAXCL      ;BEYOND CARD?
	BEQ D10         ;NO...
	BCC D10         ;NO....
JD300	JMP D300        ;NULL STRING
D10	JSR ENDTST      ;END OF EXPR?
	BCS JD300       ;YES-NULL STRING

;
; GET INITIAL OPERATION
;

D11	LDY #'+'
	CMP #'-'        ;UNARY MINUS?
	BNE D15         ;NO
	LDY #'-'
	INX
D15	STY KOP         ;SAVE OPER
	CPX IMAXCL      ;END OF CARD
	BEQ D20         ;NO
	BCS JD300       ;YES-UNINTERPRETABLE

;
; SEARCH FOR '<' & '>' FLAG
;

D20	LDA #0          ;INITIALIZE
	STA KLOW        ;<> FLAGS
	STA KHIGH
	JSR ENDTST      ;END OF EXPRESSION?
	BCS JD300       ;UNINTERPRETABLE

D21	CMP #'<'        ;LOWER BYTE
	BNE D150
	INC KLOW
	JMP D151
D150	CMP #'>'        ;HIGHER BYTE
	BNE D158
	INC KHIGH
D151	INX
	CPX IMAXCL
	BEQ D158
	BCS JD300

;
; CONSTANT NUMBER ?
;

D158	JSR NUMRC       ;CHAR NUMERIC
	BCC D25         ;NO...NOT BASE 10
	LDY #10         ;BASE 10
	JMP D55         ;EVALUATE THE NUMBER

D25	CMP #'$'        ;HEX?
	BNE D30         ;NO...NOT BASE 16
	LDY #16         ;BASE 16
	JMP D50         ;GET NEXT CHAR

D30	CMP #'@'        ;OCTAL?
	BNE D35         ;NO...NOT BASE 8
	LDY #8          ;BASE 8
	JMP D50         ;GET NEXT CHAR

D35	CMP #'%'        ;BINARY?
	BNE D40         ;NO...NOT BASE 2
	LDY #2          ;BASE 2
	BNE D50

;
; SYMBOLS ?
;

D40	JSR NALPH       ;ALPHABETIC?
	BCC D46         ;NO...MAYBE ASSEM CNTER

; PROCESS A SYMBOL

	TXA             ;LOOKS LIKE A SYMBOL
	TAY

D41	INX             ;FIND LENGTH OF SYMBOL
	CPX IMAXCL      ;OFF END OF CARD
	BEQ D415        ;NO
	BCS D42         ;YES-COMPUTE LENGTH
D415	JSR NUMRC       ;CHAR NUMERIC?
	BCS D41         ;YES...CONTINUE
	JSR NALPH       ;CHARACTER ALPHA?
	BCS D41         ;YES...CONTINUE
D42	STY TEMP        ;END..COMPUTE LENGTH
	TXA             ;GET ENDING COLUMN
	SEC
	SBC TEMP        ;STARTING COLUMN
	CMP #7          ;LENGTH OVER 6 CHARS?
	BCC D43         ;NO...CONTINUE
J2D300	JMP D300        ;YES-UNINT
D43	STA KLEN        ;LENGTH OF SYM
	LDX TEMP
	JSR CONSYM      ;CONSTRUCT SYMBOL
	BCC J2D300      ;BAD SYMBOL

D44	STX TEMP+1
	JSR NFIND
	LDX TEMP+1
	BCS D60
	LDX TEMP
	JMP D200

; EVALUATE '*' ASSEMBLY COUNTER

D46	CMP #'*'
	BNE J2D300      ;NO-BAD EXPRESSION
D47	LDA IPC
	STA KNVAL+1
	LDA IPC+1
	STA KNVAL
	INX
	JMP D60

;
; EVALUATE NUMERIC FIELD
;

D50	INX
	CPX IMAXCL      ;END OF CARD?
	BEQ D51         ;NO...CONTINUE
	BCS J2D300      ;YES...BAD EXPRESSION
D51	JSR NUMRC       ;CHAR NUMERIC?
	BCS D55         ;YES...CONTINUE
	JSR NALPH       ;CHAR ALPHA?
	BCC J2D300      ;NO...BAD EXPRESSION
D55	STY KBASE       ;BASE OF OPERATION

; GET LENGTH OF NUMBER

	TXA             ;STARTING COLUMN
	TAY
D56	INX             ;NEXT CHARACTER
	CPX IMAXCL      ;END OF CARD?
	BEQ D565        ;NO...
	BPL D57         ;YES...
D565	JSR NUMRC       ;CHAR NUMERIC?
	BCS D56         ;YES...GET NEXT CHAR
	JSR NALPH       ;NO...IS CHAR ALPHA?
	BCS D56         ;YES...GET NEXT CHAR
D57	STY TEMP        ;COMPUTE LENGTH
	TXA             ;GET ENDING COLUMN
	SEC
	SBC TEMP        ;STARTING COLUMN
	STA KLEN        ;LENGTH OF NUMBER

	TYA             ;COMPUTE THE VALUE
	TAX
	JSR NUMBER      ;COMPUTE NUMBER
	BCS D60         ;SUCCESSFUL CONVERSION
	JMP D300        ;COULDN'T COMPUTE

;
; DO THE OPERATION
;

D60	LDA KLOW
	BEQ XXXT
	LDA #0
	STA KNVAL
	BEQ XXXU
XXXT	LDA KHIGH
	BEQ XXXU
	LDA KNVAL
	STA KNVAL+1
	LDA #0
	STA KNVAL
XXXU	LDA KOP         ;GET THE OPERATION
	CMP #'+'        ;AN ADD?
	BNE D65         ;NO...

;
; '+' = ADDITION
;

	LDA IEXP+1      ;LOW BYTE OF EXPR
	CLC
	ADC KNVAL+1     ;LOW BYTE OF NUMBER
	STA IEXP+1
	LDA IEXP
	ADC KNVAL       ;HI BYTE OF NUMBER
	STA IEXP
	LDA #0
	ROL A
	TAY
	LDA #1
	AND IFLAGS+1
	ASL A
	STA TEMP
	LDA #2
	AND IFLAGS+1
	EOR TEMP
	BNE XXXV
	TYA
	BEQ XXXW
	LDA #8
	ORA IFLAGS+1
	STA IFLAGS+1
	BNE XXXW
XXXV	TYA
	BEQ XXXW2
	LDA #$FE
	AND IFLAGS+1
	STA IFLAGS+1
XXXW	JMP D70
XXXW2	LDA #1
	ORA IFLAGS+1
	STA IFLAGS+1
	JMP D70         ;CONTINUE

D65	CMP #'-'        ;A SUBTRACT
	BNE D80

;
; '-' = SUBTRACTION
;

	LDA IEXP+1      ;GET LOW BYTE
	SEC
	SBC KNVAL+1     ;LOW BYTE
	STA IEXP+1
	LDA IEXP        ;HIGH BYTE
	SBC KNVAL       ;HIGH BYTE
	STA IEXP
	LDA #0
	ROL A
	TAY
	LDA #1
	AND IFLAGS+1
	ASL A
	STA TEMP
	LDA #2
	AND IFLAGS+1
	EOR TEMP
	BNE XXXX
	TYA
	BEQ XXXY
	LDA #-1+255
	AND IFLAGS+1
	STA IFLAGS+1
	JMP D70
XXXY	LDA #1
	ORA IFLAGS+1
	STA IFLAGS+1
	JMP D70
XXXX	STY TEMP
	LDA #1
	AND IFLAGS+1
	EOR TEMP
	BEQ D70
	LDA #8
	ORA IFLAGS+1
	STA IFLAGS+1

; END OF OPERATION.  DO END CHECK & IF END THEN DO '<' & '>'

D70	CPX IMAXCL      ;START NEXT FIELD
	BEQ D71         ;NOT END OF CARD
	BPL D100        ;YES-END OF CARD
D71	JSR ENDTST      ;END EXPRESSION?
	BCS D100        ;YES-BAD
	LDY ICRD,X      ;(OPERATION)
	INX
	JMP D15

;
; OPERATION CONTINUED
;

D80	PHA             ;SAVE OPERATOR
	LDA #0          ;ZERO FOR MULT OR DIVIDE
	STA TEMP
	STA TEMP+1
	PLA
	CMP #'*'        ;MULTIPLY?
	BNE D90         ;NO...

;
; '*' = MULTIPLY
;

D82	ASL TEMP+1      ;SHIFT PRODUCT
	ROL TEMP
D83	LSR KNVAL       ;SHIFT MULTIPLIER
	ROR KNVAL+1
	BCC D84         ;SKIP ADD-BIT IS 0
	CLC
	LDA TEMP+1      ;MULTIPLICAND+PRODUCT
	ADC IEXP+1
	STA TEMP+1      ;BACK TO PRODUCT
	LDA TEMP
	ADC IEXP
	STA TEMP

;
; NOTE MULTIPLY IS MODULO 64K
;

D84	LDA KNVAL       ;STOP WHEN MULTIPLR
	ORA KNVAL+1
	BNE D82         ;IS ZERO

;
; PRODUCT-QUOTIENT TO IEXP
;

D86	LDA TEMP
	STA IEXP
	LDA TEMP+1
	STA IEXP+1
	JMP D70         ;CONTINUE EXPRESSION

D90	CMP #'/'        ;DIVIDE?
	BNE D300        ;NO...

;
; '/' = DIVISION
;

D92	LDA IEXP+1
	SEC
	SBC KNVAL+1
	STA IEXP+1
	LDA IEXP
	SBC KNVAL
	STA IEXP
	BCC D86
	INC TEMP+1
	BNE D92
	INC TEMP
	JMP D92


;--- EVALUATE END ---
;
; RETURNS - SET CODE AND RETURN

D100	LDA #0          ;GOOD RETURN
	.BYTE $2C

D200	LDA #1          ;UNDEFINED SYMBOL
	.BYTE $2C

D300	LDA #2          ;BAD EXPR
	STA RETURN
	RTS


; TEST FOR THE END OF A STRING (FINDS BLANK, COMMA, RIGHT PAREN)
; CARRY SET IF FOUND, CARRY CLEAR IF NONE FOUND
; X POINTS TO CHAR IN ICRD

ENDTST	LDA ICRD,X
	CMP #$20
	BEQ DD10
	CMP #','
	BEQ DD10
	CMP #')'
	BEQ DD10
	CMP #';'
	BEQ DD10
	CLC             ;CHARACTERS NOT FOUND
DD10	RTS

.END