.TITLE	LINE EVALUATION ROUTINES
	.MCALL	..V2..,.REGDEF
	..V2..
	.REGDEF
	.GLOBL	EVL18
	.GLOBL	EVL1,EVL40,EVL0,EVL4,EVL10,EVL15,EVL14,EVL2,EVL5
	.GLOBL	EVL7,EVL8,EVL9,EVL13,EVL15,EVL16,EVL17,EVL3,EVL11
	.GLOBL	EVL6,VARTYP,LINPTR,TYPE,TYPECH,PRTLIN,LINTYP
	.GLOBL	GETVAR,GETLBL,IFRTN,LINENO,LINE
	.GLOBL	ARGFLG
	.CSECT	EVAL
;
	; EVL RTN 0 IS FOR THOSE ROUTINES THAT DONT NEED
	; TO BE EVALUATED
EVL0:	RTS	PC
;
;EVLRTN 1 IS TO SCAN AN ARITHMETIC LINE
EVL1:	MOV	#LINE,LINPTR
	MOV	#1,VARTYP	;SET VARTYPE TO ARTH SET = TO
	JSR	PC,GETVAR	;FOR FIRST VAR GOTTEN
	CLR	ARGFLG
	MOV	#0,VARTYP	;REST OF LINE IS ALL JST PART OF ARTH
				;STATEMENT
E1LB:	JSR	PC,GETVAR	;GET A VARIABLE IF THERE
	TST	ARGFLG	;END OF LINE FOUND YET
	BEQ	E1LB	;NO-KEEP TRYING UNTILL YES
	RTS	PC
;
;	EVL RTN 2 IS FOR I/O STATEMENTS ACCEPT,READ,PRINT,TYPE
;	OF THE FORM   KEY WORD    F,LIST
EVL2:	CLR	ARGFLG
	CMP	#1,LINTYP	;WAS I/O STATEMENT ACCEPT
	BNE	.+12	;NO
	MOV	#2,VARTYP	;YES SET HOW USED NEMONIC CODE TO 'AC'
	BR	E2EVL
	CMP	#27.,LINTYP	;READ
	BNE	.+12
	MOV	#22.,VARTYP
	BR	E2EVL
	CMP	#25.,LINTYP	;PRINT
	BNE	.+12
	MOV	#21.,VARTYP
	BR	E2EVL
	MOV	#25.,VARTYP	;DEFALT IS TYPE
E2EVL:	JSR	PC,GETLBL	;GET FORMAT NO
E2LB:	TST	ARGFLG	;REACHED END OF LINE YET
	BNE	E2DNE	;YES
	JSR	PC,GETVAR	;NO SCAN UNTILL YES
	BR	E2LB
E2DNE:	RTS	PC
;
;	EVL RTN 3 SCANS ACCEPT
EVL3:	MOV	#3,VARTYP	;SET NEMONIC TO 'AC'
	JSR	PC,GETLBL	;GET LABEL
	ADD	#2,LINPTR	;SKIP THE 'TO' IN ASSIGN N TO X
	JSR	PC,GETVAR	;GET VAR NAME
	RTS	PC
;
;	EVL RTN 4  BACKSPACE,ENDFILE,REWIND MAY USE VAR NAME
;	IN PLAC EOF A NUMBER
EVL4:	CMP	#3,LINTYP	;BACKSPACE??
	BNE	.+12
	MOV	#4,VARTYP
	BR	E4EVL
	CMP	#13.,LINTYP	;ENDFILE???
	BNE	.+12
	MOV	#14.,VARTYP
	BR	E4EVL
	MOV	#23.,VARTYP	;REWIND IS DEFALT
E4EVL:	JSR	PC,GETVAR
	RTS	PC
;
;	EVL RTN 5 EVALUATES CALL SUBROUTINE
EVL5:	CLR	ARGFLG
	MOV	#5,VARTYP	;1ST NAME GOTTEN IS SUB NAME
	JSR 	PC,GETVAR
	MOV	#38.,VARTYP	;REST ARE ARGUMENTS
E5LB:	TST	ARGFLG	;REPEAT UNTILL END OF LINE FOUND
	BNE	E5DNE	
	JSR	PC,GETVAR
	BR	E5LB
E5DNE:	RTS	PC
;
;	EVL RTN 6     COMMON    LIST AND COMMON/NAME/LIST
EVL6:	MOVB	@LINPTR,R0	;GET NXT CHR
	CMPB	#'/,R0	;NAMED COMMON????
	BNE	BLNKCM	;NO BLAMK COMMON
	INC	LINPTR
	MOV	#6,VARTYP	;SET HOW USE NEMONIC TO COMMON NAME
	JSR	PC,GETVAR
	INC	LINPTR	;SKIP 2ND '/'
BLNKCM:	MOV	#7,VARTYP	;COMMON LIST NEM
	CLR	ARGFLG
E6LB:	JSR	PC,GETVAR
	TST	ARGFLG	;END OF LINE YET??
	BEQ	E6LB	;KEEP LOOPING UTILL YES
	RTS	PC
;
;	EVL 7 RTN HANDLES DATA LINES
EVL7:	MOV	#8.,VARTYP
EVL7LB:	CMPB	#'/,@LINPTR	;COME TO END OF DATA LIST YET
	BEQ	DATDNE	;YES -SCAN DONE
	JSR	PC,GETVAR
	BR	EVL7LB
DATDNE:	RTS	PC
;
;	EVL 8   DECODE ENCODE
EVL8:	CMP	#9.,LINTYP	;DECODE
	BNE	.+12
	MOV	#9.,VARTYP
	BR	E8EVL
	MOV	#13.,VARTYP	;DEFALT IS ENCODE
E8EVL:	CLR	ARGFLG
	JSR	PC,GETVAR	;IF CHR CNT SPECIFIED BY VAR-GET IT
	INC	LINPTR	;SKIP ','
	JSR	PC,GETLBL	;GET FORMAT NUMBER
E8LB:	TST	ARGFLG
	BNE	E8DNE	;ALL REST IS I/O VAR NAME & LIST LOOP UNTILL GOT
	JSR	PC,GETVAR
	BR	E8LB
E8DNE:	RTS	PC
;
	;EVL 9    DEFINE FILE
EVL9:	MOV	#10.,VARTYP
	JSR	PC,GETVAR	;GET L.U.N IF IT IS VAR NAME
	INC	LINPTR	;SKIP'('
	JSR	PC,GETVAR	;GET RECORD CNT IF VAR
	INC	LINPTR	;SKIP ','
	JSR	PC,GETVAR	;GET REC SIZE IF VAR
	ADD	#3,LINPTR	;SIP ',U,'
	JSR	PC,GETVAR	;GET INDEX VAR
	ADD	#2,LINPTR	;SKIP '),'
	TSTB	@LINPTR	;ANOTHER D.F. SPEC???
	BNE	EVL9	;YES  REPEAT
	RTS	PC
;
;	EVL 10   DIMENSION, EQUIVALENCE,EXTERNAL
EVL10:	CLR	ARGFLG
	CMP	#11.,LINTYP	;DIMENSION
	BNE	.+12
	MOV	#11.,VARTYP	
	BR	E10EVL
	CMP	#16.,LINTYP	;EQUIVALENCE
	BNE	.+12
	MOV	#15.,VARTYP
	BR	E10EVL
	MOV	#16.,VARTYP	;DEFALT EXTERNAL
E10EVL:	JSR	PC,GETVAR	;GET LIST
	TST	ARGFLG
	BEQ	E10EVL	;UNTILL END OF LINE FOUND
	RTS	PC
;
;	EVL 11   DO N VAR=A,B,C
EVL11:	MOV	#12.,VARTYP
	JSR	PC,GETLBL	;GET END OF LOOP LABLE
	JSR	PC,GETVAR	;GET INDEX VAR
	INC	LINPTR	;SKIP '='
E11LB:	JSR	PC,GETVAR	;IF ANY OF INDEX SPECS SPECIFED BY VAR-GET
	INC	LINPTR
	TST	ARGFLG
	BEQ	E11LB
	RTS	PC
;
;	EVL 12 IS END AND HANDLED ELSE WARE AS IT OUTPUTS ALL INFO
;	ACCUMULATED AND RESETS FOR NEW RUN
;
;	EVL 13  FIND(L.U.N'INDEX)
EVL13:	MOV	#17.,VARTYP
	CLR	ARGFLG
E13LB:	JSR	PC,GETVAR
	INC	LINPTR
	TST	ARGFLG
	BEQ	E13LB
	RTS	PC
;
;	EVL 14    FUNCTION/SUBROUTINE
EVL14:	CLR	ARGFLG
	CMP	#20.,LINTYP	;IS IT FUNCTION
	BNE	.+12
	MOV	#18.,VARTYP
	BR	E14EVL
	CMP	#31.,LINTYP	;SUBROUTINE
	BNE	.+10
	MOV	#24.,VARTYP	
E14EVL:	JSR	PC,GETVAR
	MOV	#38.,VARTYP
E14LB:	TST	ARGFLG
	BNE	E14DN
	JSR	PC,GETVAR
	BR	E14LB
E14DN:	RTS	PC
;
;	EVL 15   TYPE VAR ,TYPE*N VAR  TYPE FUNCTION*N 
EVL15:	CMP	#35.,LINTYP	;REAL
	BNE	.+12
	MOV	#1.,VARTYP
	BR	E15EVL
	CMP	#34.,LINTYP	;INTEGER
	BNE	.+12
	MOV	#2,VARTYP
	BR	E15EVL
	CMP	#12.,LINTYP	;DOUBLE PRECISION
	BNE	.+12
	MOV	#3,VARTYP
	BR	E15EVL
	CMP	#36.,LINTYP	;LOGICAL
	BNE	.+12
	MOV	#4,VARTYP
	BR	E15EVL
	MOV	#5,VARTYP	;COMPLEX IS DEFALT
E15EVL:	MOVB	@LINPTR,R0
	CMPB	#'*,R0	;*N???
	BNE	FNTST	;NO SKIP NEXT
	ADD	#2,LINPTR	;YES-SKIP
FNTST:	MOV	LINPTR,R1
	MOV	#ASFN,R2	;IS NEXT KEY WORD FUNCTION
	MOV	#8.,R3
FNTST1:	CMPB	(R1)+,(R2)+	;
	BNE	NTFN	;IF FAIL NOT FUNCTION
	DEC	R3
	BGT	FNTST1	;IF COMPLETE YES FN, IF NOT TEST NXT CHR
	ADD 	#8.,LINPTR	;YES-INC LINEPTR TO SKIP FUNCTION
	ADD	#32.,VARTYP	;SET VAR TYPE
	CMPB	#'*,@LINPTR	;*N
	BNE	FNGO	;NO SKIP NEXT
	INC 	LINPTR	;SKIP '*'
	CMPB	#'8,@LINPTR	;*8??
	BNE	FNGO1
	MOV	#35.,VARTYP	;D.P.FUNCTION
FNGO1:	INC	LINPTR
FNGO:	JMP	EVL14	;EVALUATE AS A FUNCTION
NTFN:	CLR	ARGFLG	;NOT FUNCTION JUST GET LIST
	ADD	#25.,VARTYP
	JMP	E10EVL	;HANDLE AS DIMENSION
ASFN:	.ASCII	/FUNCTION/
	.EVEN
;
;	EVL 16 HANDLES IF()A,B,B  OR IF ()INSTR
EVL16:	MOV	#20.,VARTYP
	CLR	ARGFLG
	CLR	PLEVEL
E16LB1:	CMPB	#'(,@LINPTR	;FOUND '('
	BNE	E16RPC
	INC	PLEVEL	;YES
	INC	LINPTR
	BR	E16LB1
E16RPC:	CMPB	#'),@LINPTR	;FOUND ')'
	BNE	E16LB2
	INC	LINPTR
	DEC	PLEVEL	;YES
	BLT	CONDNE	;IF .LT. 0 CONDITIONAL PART IF IF DONE
	BR	E16LB1
E16LB2:	JSR	PC,GETVAR
	TST	ARGFLG
	BEQ	E16LB1
	JMP	EVL40	;E.O.L. MEANS ERROR
CONDNE:	MOVB	@LINPTR,R0	;GET 1ST CHR AFTER CONDITIONAL PART
				;OF IF
	JSR	PC,TYPE
	TST	TYPECH
	BEQ	STDIF	;NUMBER-STD 3 WAY BRANCH
	MOV	#IFRTN,(SP)	;LETTER-INST TYPE IF-RESET RETURN
				;FROM SUBROUTINE TO SPECIAL
				;REENTRY POINT IN MAIN PROGRAM
	INC	LINENO	;FOR COMPATABILITY WITH COMPILOR
	MOV	LINPTR,R1
	MOV	#LINE,R2
E16LB3:	MOVB	(R1)+,(R2)+	;SHIFT PART OF IF AFTER COND. TO
				;BEGINNING OF LINE-MAKE SCANER THINK
				; NEW LINE
	BNE	.-2	;NULL MEANS END OF LINE
	MOVB	(R1)+,(R2)+
	MOVB	(R1)+,(R2)+	;ADD SOME MORE NULLS JUST TO BE SAFE
	MOV	#LINE,LINPTR
	RTS	PC
STDIF:	JSR	PC,GETLBL
	INC	LINPTR
	TST	ARGFLG
	BEQ	STDIF
	RTS	PC
PLEVEL:	.WORD	0
;
;	EVL17   READ()/WRITE()--(N),(N'M),(N,M)
;	PLUS END= OR/AND ERR= IN THERE TOO
EVL17:	CMP	#26.,LINTYP	;READ
	BNE	.+12
	MOV	#22.,VARTYP
	BR	E17EVL
	MOV	#31.,VARTYP	;WRITE DEFALT
E17EVL:	JSR	PC,GETVAR	;IF L.U.N. SPEC AS VAR-GET IT
	CMPB	#'),@LINPTR	;DONE
	BEQ	E17LST	;YES
	INC	LINPTR	;NO SKIP PUNCTUATION
	MOVB	@LINPTR,R0
	JSR	PC,TYPE
	TST	TYPECH	;WHAT IS NEXT SPEC
	BGT	LET	;NOT A FMT LABEL NO
	JSR	PC,GETLBL	;YES LABEL-GET IT
	CMPB	#'),@LINPTR	;DONE YET
	BEQ	E17LST	;YES
	INC	LINPTR	;NO
	JSR	PC,NDERCK	;GET END=,ERR=
	BR	E17LST
LET:	JSR	PC,NDERCK	;IS IT END=,ERR=
	CMPB	#'),@LINPTR
	BEQ	E17LST
	JSR	PC,GETVAR	;ERR=,END= ARE LAST ITEMS
				;FOUND IN SPEC SO IF')' NOT FOUND-END/ERR
				;NOT FOUND SO PTR NOT MOVED 
	CMPB	#'),@LINPTR
	BEQ	E17LST
	JSR	PC,NDERCK
E17LST:	CLR	ARGFLG	;DONE WITH I/O  SPECS NOW GET I/O LIST
E17LB:	JSR	PC,GETVAR
	TST	ARGFLG
	BEQ	E17LB
	RTS	PC
NDERCK:	MOV	LINPTR,R1
	CMPB	#'E,(R1)+
	BNE	RTN
	CMPB	#'N,(R1)+
	BNE	RCK
	CMPB	#'D,(R1)+
	BEQ	EQTST
RTN:	RTS	PC
RCK:	DEC	R1
	CMPB	#'R,(R1)+
	BNE	RTN
	CMPB	#'R,(R1)+
	BNE	RTN
EQTST:	CMPB	#'=,(R1)+
	BNE	RTN
	MOV	R1,LINPTR
	JSR	PC,GETLBL
	CMPB	@LINPTR,#')
	BEQ	RTN
	INC	LINPTR
	BR	NDERCK
;
;	EVL 18   GO TO 10    GO TO A    GO TO (  ,   ,   ,),X   ETC
EVL18:	MOV	#19.,VARTYP	;SET NEM TYPE
	CLR	ARGFLG
	MOVB	@LINPTR,R0
	JSR	PC,TYPE	;WHAT THYPE OF GO TO IS IT
	TST	TYPECH
	BGT	ASGNGT	;CHR IS LETTER-ASSIGNED GO TO
	BEQ	UNCDGT	;NUMBER	-UNCONDITIONAL GO TO
E18LB1:	INC	LINPTR	;COMPUTED GO TO-SKIP'('
	JSR	PC,GETLBL	;GET LABEL
	TST	ARGFLG	;END OF LINE
	BNE	EVL40	;IF YESS THATS AN ERROR
	CMPB	@LINPTR,#')	;END OF SPECIFIED LABELS?
	BNE	E18LB1	;NO CONTINUE
E18LB2:	JSR	PC,GETVAR	;GET THE VAR NME
	TST	ARGFLG	;DONE??
	BEQ	E18LB2	;NO-GOT PUNCTUATION INSTEAD
	RTS	PC
UNCDGT:	JSR	PC,GETLBL	;GET LABEL
	RTS	PC
ASGNGT:	JSR	PC,GETVAR	;GET VAR NAME
E18LB3:	TST	ARGFLG	;END OF LINE-OPTIONAL LABLE LIST CAN FOLLOW
	BNE	E18DN
	INC	LINPTR
	JSR	PC,GETLBL
	BR	E18LB3
E18DN:	RTS	PC
;
;	EVL 40--ERROR REPORTING
EVL40:	MOV	#ERRMSG,R0
	JSR	PC,PRTLIN
	RTS	PC
ERRMSG:	.ASCIZ	/       ****UNKNOWN LINE TYPE OR SYNTAX ERROR****/
	.EVEN
	.END