.TITLE	LINE EVALUATION ROUTINES
	.SBTTL	SETUP
;	ONCE THE LINE UNDER EXAMINATION HAS HAD ITS TYPE DETERMINED,
;	THEN THE APPROPRIATE CODE IN THIS MODULE IS CALLED (EXCEPT
;	FOR AN 'END' LINE) TO PARSE THAT LINE.
	.IF	NDF,RSX
	.MCALL	.CSISPC,.READW
	.MCALL	.LOOKUP,.EXIT,.PURGE,.PRINT
	.GLOBL	EXT,INBUF,LEOF,INBLK,IOARA,DOFLOW
	.IFF
	.MCALL	CSI$1,CSI$2,OPEN$R,CLOSE$,EXIT$S,QIOW$S,CSI$SW,CSI$ND,GET$
	.GLOBL	HIINBP,SAVEPT,IBUFF
	.ENDC
	.IF	DF,F4P
	.GLOBL	SAVE,RESTFI
	.ENDC
	.GLOBL	HIGPTR,TMP,PLEVEL,CLOSE,PNMFLG,PNAME
	.GLOBL	TYPE,TYPECH,MOVCHR,ICHNO,ERRCNT,NOSRC,STOFLO
	.GLOBL	VARTYP,LINPT,TYPE,TYPECH,PRTLIN,DOFLOW
	.GLOBL	GETVAR,GETLBL,LIF,LINENO,LIN,INBFPT,GETLIN
	.GLOBL	ARGFLG,SKIP,SAVENO,SAVEPT,DOFLOW,VNM50,PNAME
	.GLOBL	$UU,$VV,$WW,$XX,$YY,$ARTH,$EL,$EI,PRNFLG
	.PSECT	EVAL,I,RO,GBL
	.PAGE
	.SBTTL	$EL,$EI,$UU,$VV,$WW,$XX,$YY NO EVALUATIONS
					; FOR THOSE ROUTINES THAT DONT NEED
					; TO BE EVALUATED
$EL:
$EI:
$UU:
$VV:
$WW:
$XX:
$YY:
1$:	INC	LINPT
	JSR	PC,MOVCHR
	TSTB	R0
	BNE	1$
	RTS	PC
	.PAGE
	.SBTTL	$ARTH IS TO SCAN AN ARITHMETIC LINE
$ARTH:	MOV	#LIN+6,LINPT
	JSR	PC,GETVAR		; FOR FIRST VAR GOTTEN
	MOV	#"  ,VARTYP		; REST OF LINE IS ALL JST PART OF ARTH
					; STATEMENT
LIST:					; ALSO ALL SIMPLE LISTS ENTER HERE
E1LB:	JSR	PC,GETVAR		; GET A VARIABLE IF THERE
LISTT:	TST	ARGFLG			; END OF LINE FOUND YET
	BEQ	E1LB			; NO-KEEP TRYING UNTILL YES
	RTS	PC
	.PAGE
	.SBTTL	$AC,$RC,$PR,$TY IS FOR I/O STATEMENTS ACCEPT,READ,PRINT,TYPE
	.GLOBL	$AC,$RC,$PR,$TY
;	OF THE FORM   KEY WORD    F,LIST
$AC:
$RC:
$PR:
$TY:
E2EVL:	JSR	PC,MOVCHR
	JSR	PC,TYPE
	TST	TYPECH
	BGT	6$
	JSR	PC,GETLBL
	BR	E2LB
6$:	JSR	PC,GETVAR
E2LB:	JMP	LISTT			; SCAN LIST
	.PAGE
	.SBTTL	$AS SCANS ASSIGN
	.GLOBL	$AS
$AS:	JSR	PC,GETLBL		; GET LABEL
	JSR	PC,MOVCHR
	INC	LINPT
	JSR	PC,MOVCHR
	INC	LINPT			; SKIP THE 'TO' IN ASSIGN N TO X
	JSR	PC,GETVAR		; GET VAR NAME
	RTS	PC
	.PAGE
	.SBTTL	$BS,$EF,$RW,$UN BACKSPACE,ENDFILE,REWIND,UNLOCK MAY USE VAR NAME
	.GLOBL	$BS,$EF,$RW,$UN
;	IN PLAC EOF A NUMBER
$BS:
$EF:
$UN:
$RW:
	JMP	LIST			; JUST A SIMPLE LIST
	.PAGE
	.SBTTL	$CL EVALUATES CALL SUBROUTINE
	.GLOBL	$CL
$CL:	JSR	PC,GETVAR
	TST	DOFLOW			;WANT CALLING ROUTINES?
	BEQ	5$			;NO
	CLR	PRNFLG
	CALL	STOFLO
5$:	MOV	#"AG,VARTYP		; REST ARE ARGUMENTS
7$:	CALL	MOVCHR			;MOVE TO '(' OR IF NONE-END OF LINE
	INC	LINPT
	TSTB	ARGFLG			;END OF LINE?
	BNE	2$
	CMPB	#'(,R0
	BNE	7$
1$:	TST	ARGFLG
	BNE	2$
	CALL	MOVCHR			;GET NEXT CHAR-FIRST OF ARGUMENT
	CALL	TYPE			;WHAT TYPE OF CHAR
	TST	TYPECH			;TELL ME 
	BGE	3$			;LETTER OR NUMBER
	CMPB	#'*,R0			;SPECIAL CHARACTER-IS IT LABEL ARGUMENT TO SUBROUTINE CALL
	BEQ	10$			;IF SPECIAL CHAR-BR
	CMPB	#',,R0			;IS IT A NULL ARGUMENT
	BNE	3$			;BR IF NOT
	INC	LINPT			;OTHERWISE SKIP OVER IT
	BR	1$			;AND CONTINUE
10$:	INC	LINPT
	CALL	GETLBL			;YES-IS RETURN LABEL FOR SUB CALL
	BR 	4$
3$:	CALL	GETVAR			;OTHERWISE GET VARIABLE
4$:	CALL	MOVCHR			;GET NEXT CHAR
	TST	ARGFLG
	BEQ	1$
2$:	RETURN
	.PAGE
	.SBTTL	$CN COMMON LIST AND COMMON/NAME/LIST
	.GLOBL	$CN
$CN:	JSR	PC,MOVCHR		; GET NXT CHR
	CMPB	#'/,R0			; NAMED COMMON????
	BNE	BLNKCM			; NO BLAMK COMMON
	INC	LINPT
	JSR	PC,GETVAR
	JSR	PC,MOVCHR
	INC	LINPT			; SKIP 2ND '/'
BLNKCM:	MOV	#"CM,VARTYP		; COMMON LIST NEM
E6LB:	JMP	LIST			; SIMPLE LIST
	.PAGE
	.SBTTL	$DA RTN HANDLES DATA LINES
	.GLOBL	$DA
$DA:
2$:	JSR	PC,GETVAR
	TST	ARGFLG
	BNE	EVLDNE
	JSR	PC,MOVCHR
	CMPB	#'/,R0
	BNE	2$
	TST	SKIP
	BNE	1$
	INC	SKIP
	BR	2$
1$:	CLR	SKIP
	BR	2$
EVLDNE:	RTS	PC
	.PAGE
	.SBTTL	$DF DEFINE FILE
	.GLOBL	$DF
$DF:	JSR	PC,GETVAR		; GET L.U.N IF IT IS VAR NAME
	INC	LINPT			; SKIP'('
	JSR	PC,GETVAR		; GET RECORD CNT IF VAR
	INC	LINPT			; SKIP ','
	JSR	PC,GETVAR		; GET REC SIZE IF VAR
	INC	LINPT
	JSR	PC,MOVCHR		; GET PAST U
	INC	LINPT
	JSR	PC,MOVCHR		; GET PAST ,
	INC	LINPT
	JSR	PC,GETVAR		; GET INDEX VAR
	INC	LINPT			; GET PAST )
	JSR	PC,MOVCHR		; ANOTHER SPEC??','
	TSTB	R0
	BEQ	EVL9O
	INC	LINPT
	BR	$DF			; YES  REPEAT
EVL9O:	RTS	PC
	.PAGE
	.SBTTL	$DI,$EQ,$PA,$BD,$PG,$VI
	.SBTTL	DIMENSION, EQUIVALENCE,EXTERNAL,PROGRAM,BLOCKDATA,VIRTUAL
	.GLOBL	$DI,$EQ,$EX,$PA,$BD,$PG,$VI
$BD:	TST	DOFLOW
	BEQ	1$
	INC	ERRCNT
	.IF	DF,RSX
	QIOW$S	#IO.WLB,#9.,#1,,,,<#BDFLOW,#69.,#40>
	.IFF
	BISB	#4,@#53
	.PRINT	#BDFLOW
	.ENDC
1$:	MOV	BD,PNAME
	MOV	BD+2,PNAME+2		; DEFAULT NAME FOR BD IS BLKDAT
$PG:	INC	PNMFLG
	CALL	GETVAR
	TST	DOFLOW
	BEQ	1$
	CLR	PRNFLG
	CALL	STOFLO
1$:
$DI:
$EQ:
$PA:
$VI:
	JMP	LIST			; SIMPLE LIST
BD:	.RAD50	/BLKDAT/
BDFLOW:	.ASCIZ	/ INDEX-W-ENTRY POINT CROSS REFERENCE ON BLOCK DATA CAUSES FALSE ENTRY/
	.EVEN
	.PAGE
	.SBTTL	$DO DO N VAR=A,B,C
	.GLOBL	$DO
$DO:	JSR	PC,GETLBL		; GET END OF LOOP LABLE
	JMP	LIST			; SIMPLE LIST
	.PAGE
	.SBTTL	$ZZ HANDLED ELSWARE
;	$ZZ IS END AND HANDLED ELSE WARE AS IT OUTPUTS ALL INFO
;	ACCUMULATED AND RESETS FOR NEW RUN
	.PAGE
	.SBTTL	$FN FIND(L.U.N'INDEX)
	.GLOBL	$FN
$FN:	JSR	PC,GETVAR		; GET FIRST VARIABLE
	JSR	PC,MOVCHR		; SKIP	QUOTE MARK
	INC	LINPT			; UPDATE POINTER
	JMP	LIST			; THE REST IS A SIMPLE LIST
	.PAGE
	.SBTTL	$SU,$FU,$FI,$FL,$FR,$FD,$FC,$EY,$FH FUNCTION/SUBROUTINE/ENTRY
	.GLOBL	$SU,$FU,$FI,$FL,$FR,$FD,$FC,$EY,$FH,$FB
$SU:
$FB:
$FU:
$FI:
$FL:
$FR:
$FD:
$FC:
$FH:
	INC	PNMFLG
$EY:	;ENTRY DOES NOT UPDATE PROGRAM NAME-USE FIRST DECLARED NAME
E14EVL:	JSR	PC,GETVAR
	TST	DOFLOW
	BEQ	2$
	CLR	PRNFLG
	CALL	STOFLO
2$:	CMP	#"FR,VARTYP
	BNE	1$
	JSR	PC,MOVCHR
	CMPB	#'*,R0
	BNE	1$
	INC	LINPT
	JSR	PC,MOVCHR
	INC	LINPT
	CMPB	#'8,R0
	BNE	1$
	MOV	HIGPTR,R0
	ADD	#6,R0
	MOV	#"FD,-2(R0)
1$:	MOV	#"AG,VARTYP
E14LB:	JMP	LISTT
	.PAGE
	.SBTTL	$IT,$EX  INTRINSIC,EXTERNAL
	.GLOBL	$IT,$EX
$IT:
$EX:
	CLR	VNM50
	CALL	GETVAR
	TST	ARGFLG
	BNE	1$
	TST	DOFLOW
	BEQ	$EX
	CLR	PRNFLG
	CALL	STOFLO
	BR	$EX
1$:	RETURN
	.PAGE
	.SBTTL	$IN,$CH,$LG,$RL,$DP,$CX,$BY,$CS,$CT TYPE VAR ,TYPE*N VAR
	.SBTTL	$SA   SAVE
	.GLOBL	$IN,$CH,$LG,$RL,$DP,$CX,$BY,$CS,$SA,$CT
$CT:	MOV	LINPT,R0
	CLR	R1
	CLR	R2
3$:	INC	R2	;YES BUMP PARREN POINTER
5$:	MOVB	(R0)+,R1
	BNE	21$
20$:	JMP	$CH
21$:	CMPB	#'(,R1	;OPEN PARREN
	BEQ	3$
	CMPB	#'),R1	;CLOSE PARREN
	BNE	5$
	DEC	R2
	TST	R2
	BGT	5$
	BR	CTCS
$CS:	MOV	LINPT,R0	;CHECK FOR CHARACTER * FUNCTION
	CLR	R2
	CLR	R1
	MOVB	(R0)+,R1
2$:	CMPB	#'0,R1	;OF FORM CHARACTER*M
	BGT	19$
	CMPB	#'9,R1
	BLT	19$
	MOVB	(R0)+,R1
	BNE	2$
	JMP	$CH
19$:	DEC	R0
CTCS:
	.MACRO	CC	L	;CHECK TO SEE IF WORD 'FUNCTION FOLLOWS
	CMPB	#40,(R0)
	BNE	.+6
	INC	R0
	BR	.-10
	CMPB	#''L,(R0)+
	BNE	$CH
	.ENDM
	CC	F
	CC	U
	CC	N
	CC	C
	CC	T
	CC	I
	CC	O
	CC	N
	MOV	R0,LINPT
	MOV	#"FH,VARTYP
	JMP	$FH
$SA:
$IN:
$CH:
$LG:
$DP:
$CX:
$BY:
	JMP	LIST
$RL:
2$:	JSR	PC,GETVAR
	TST	ARGFLG
	BNE	E15DN
	JSR	PC,MOVCHR
	CMPB	#'*,R0
	BNE	2$
	TSTB	R0
	BNE	11$
	INC	ARGFLG
	BR	2$
11$:	INC	LINPT
	JSR	PC,MOVCHR
	INC	LINPT
	CMPB	#'8,R0
	BNE	2$
	MOV	HIGPTR,R0
	ADD	#6,R0
	MOV	#"DP,-2(R0)
	BR	2$
E15DN:	RTS	PC
	.PAGE
	.SBTTL	$IF HANDLES IF()A,B,B OR IF ()INSTR
	.GLOBL	$IF,$TH
$IF:
	CLR	PLEVEL
E16LB1:	JSR	PC,MOVCHR
	CMPB	#'(,R0			; FOUND '('
	BNE	E16RPC
	INC	PLEVEL			; YES
	INC	LINPT
	BR	E16LB1
E16RPC:	CMPB	#'),R0			; FOUND ')'
	BNE	E16LB2
	INC	LINPT
	DEC	PLEVEL			; YES
	BLT	CONDNE			; IF .LT. 0 CONDITIONAL PART IF IF DONE
	BR	E16LB1
E16LB2:	JSR	PC,GETVAR
	TST	ARGFLG
	BEQ	E16LB1
	JMP	$ERR			; E.O.L. MEANS ERROR
CONDNE:	JSR	PC,MOVCHR		; GET 1ST CHR AFTER CONDITIONAL PART
					; OF IF
	JSR	PC,TYPE
	TST	TYPECH
	BEQ	STDIF			; NUMBER-STD 3 WAY BRANCH
	INC	LIF			; SET FLAG SECOND PAR LOGICAL
					; IF-FLAG FOR RETURN
					; FROM SUBROUTINE TO SPECIAL
					; REENTRY POINT IN MAIN PROGRAM
	.IF	NDF,F4P			;F4P DOES NOT DO THIS
	INC	LINENO			; FOR COMPATABILITY WITH F4 COMPILOR
	.ENDC
	MOV	LINPT,R1
	MOV	#LIN,R2
	MOV	#20040,(R2)+
	MOV	#20040,(R2)+
	MOV	#20040,(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	#LIN,LINPT
	RTS	PC
STDIF:	JSR	PC,GETLBL
	INC	LINPT
	TST	ARGFLG
	BEQ	STDIF
	RTS	PC
;THE TREATMENT OF THE IF()THEN AND ELSEIF()THEN IS A DOUBLE SHUFFLE.
;IT IS TREATED AS A LOGICAL IF() WHERE THE ACTION IF TRUE IS TREATED AS A NEW LINE
;THE THEN CLUASE IS THEN USED TO TAKE THAT NEW LINE AWAY BECAUSE THERE ISNOT ONE.
;THE 'THEN' IS TREATED LIKE A KEYWORD ON A LINE BY ITSELF.
$TH:	.IF	NDF,F4P
	DEC	LINENO
	.ENDC
	JMP	$YY
	.PAGE
	.SBTTL	$GT GO TO 10 GO TO A GO TO ( , , ,),X ETC
	.GLOBL	$GT
$GT:
	JSR	PC,MOVCHR
	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	LINPT			; COMPUTED GO TO-SKIP'('
	JSR	PC,GETLBL		; GET LABEL
	TST	ARGFLG			; END OF LINE
	BEQ	.+6
	JMP	$ERR
	JSR	PC,MOVCHR
	CMPB	R0,#')
	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
1$:	TST	ARGFLG
	BNE	E18DN
ASGNGT:	JSR	PC,GETVAR		; GET VAR NAME
E18LB3:	TST	ARGFLG			; END OF LINE-CETIONAL LABLE LIST CAN FOLLOW
	BNE	E18DN
	INC	LINPT
	JSR	PC,GETLBL
	BR	E18LB3
E18DN:	RTS	PC
	.PAGE
	.SBTTL	$OP,$CE OPEN/CLOSE,$EN,$DE ENCODE/DECODE,$WR,$RD READ()/WRITE()
	.SBTTL	$B7,$E7$R7 REWIND/BACKSPACE/ENDFILE-FTN-77
	.SBTTL	$OP,$CE,$IQ OPEN/CLOSE/INQUIRE
	.SBTTL	$U7,$DL,$RR UNLOCK,DELETE,REWRITE
	.GLOBL	$OP,$CE,$B7,$E7,$R7,$WR,$RD,$EN,$DE,$IQ,$U7,$DL,$RR
$B7:
$E7:
$R7:
$RD:
$WR:
$IQ:
$EN:
$DE:
$OP:
$CE:
$U7:
$DL:
$RR:
;	ALL THE I/O HAS A SIMILAR FORM SO I AM USEING THE SAME
;	ROUTINE TO PARSE THEM-THIS CAN LEAD TO SOME STRANGE
;	SYNTAX BEING ACCEPTED BY VARIOUS CONSTRUCTS
	CLR	PLEVEL	;FOR EXPRESSIONS-SET P LEVEL FLAG TO ZERO
	CALL	IOARG	;IS FIRST ARGUMENT OF FORM UNIT=
	TST	R0
	BEQ	2$
	JMP	IOEQ	;YES-ENTIRE STATEMENT IS OF THAT FORM
2$:	CALL	GETVAR	;GET VARIABLE
	TST	ARGFLG	;END OF LINE??
	BEQ	1$	;NO
	RETURN		;YES
1$:	CALL	MOVCHR	;GET NEXT CHR
	CMPB	#',,R0	;COMMA TO TERMINATE ARG VALUE
	BEQ	10$	;YES-NEXT ARG
	CMPB	#47,R0	;QUOTE-DITTO
	BEQ	11$	;GO TO RANDOM ACCESS I/O-DEC FORTRAN STYLE
	CMPB	#'(,R0	;L PARREN
	BNE	3$	;NO
	INC	PLEVEL	;UP PARREN LEVEN
	BR	2$	;GET NEXT CHR
3$:	CMPB	#'),R0	;CLOSEING PARREN
	BNE	2$	;NO-GO GET NEXT
	DEC	PLEVEL
	TST	PLEVEL	;CLOSE OF RG LIST
	BGE	2$	;NO
	JMP	IOND	;ARG LIST DONE INSIDE PARREN-DO OUTSIDE
10$:	INC	LINPT	;NEXT ARG
	CMP	#"RD,VARTYP	;ONLY CERTAIN STATEMENTS HAVE FORMAT NEXT
	BEQ	12$		;PULL THOSE OUT
	CMP	#"WR,VARTYP	;AND CHECK IF FMT OR FMT=
	BEQ	12$
	CMP	#"RR,VARTYP
	BEQ	12$
	CMP	#"EN,VARTYP	;ENCODE AND DECODE HAVE FMT ONLY
	BEQ	5$
	CMP	#"DE,VARTYP
	BEQ	5$
	BR	IOEQ		;EVERYTHING ELSE HAS FORM XXX=YYY	
12$:	CALL	IOARG		;FORM OF SECOND ARGUMENT
	TST	R0
	BNE	IOEQ		;GO HANDLE AS ALL OTHERS
5$:	CALL	MOVCHR		;GET FIRST CHR OF FORMAT LETTER OR NUMBER
	CMPB	#'0,R0		;IF NOT NUMBER
	BGT	13$		;THEN TREAT AS LETTER
	CMPB	#'9,R0
	BLT	13$
	CALL	GETLBL	;GET THE LABEL
	BR	14$
13$:	CALL	GETVAR	;GET THE ARRAY NAME
14$:	CMPB	#"EN,VARTYP	;ENCODE/DECODE HAVE VAR NAME NEXT
	BEQ	6$		;GET IT
	CMPB	#"DE,VARTYP
	BNE	IOEQ		;EVERYTHIN ELSE HANDLE AS FORM XXX=
6$:	INC	LINPT		;JUMP SEPERATOR
	CALL	GETVAR		;GET VAR FOR ENODE/DECODE
	BR	IOEQ
11$:	CLR	PLEVEL		;HANDLE RANDOM ACCESS I/O READ/WRITE
15$:	INC	LINPT		;SKIP SEPERATOR
20$:	CALL	MOVCHR		;EXPRESSION ANALYZER
	CMPB	#'(,R0		;OPEN PARREN
	BNE	16$
	INC	PLEVEL
	BR	15$
16$:	CMPB	#'),R0		;CLOSE PARREN
	BNE	17$
	DEC	PLEVEL
	TST	PLEVEL
	BLT	18$		;DONE IF CLOSEING WHOLE ARG LIST
	BR	15$
17$:	CMPB	#',,R0		;COMMA
	BEQ	18$
	CALL	GETVAR		;GET VARIABLE ARGUMENT
	BR	20$		;AND LOOP
18$:	CALL	MOVCHR		;CHECK TO SEE IF THIS IS RANDOM ACCESS I/O
				;WITH FORMAT SPECIFER IN THIRD POSIITON
				;THIS IS FOR F4P
	CMPB	#'),R0		;COMPLETED???
	BNE	21$
	JMP	IOND		;IF YES-GET I/O LIST
21$:	INC 	LINPT		;NEXT CHR
	CALL	IOARG		;IS IT OF FORM XXX=
	TST	R0
	BNE	IOEQ		;YES-GO TO PROPER HANDLEING ROUTINE
	CALL	MOVCHR		;GET FIRST CHR OF ARG
	CMPB	#'9,R0		;SEE IF NUMBER
	BLT	19$		;IF NOT NUST BE ARRAY NAME
	CMPB	#'0,R0
	BGT	19$
	CALL	GETLBL		;GET THE LABEL
	BR	IOEQ		;EVERYTHING ELSE MUST BE OF FORM XXX=
19$:	CALL	GETVAR		;GET FORMAT IN VAR ARRAY
IOEQ:	CALL	MOVCHR		;IS CHR A LETTER
	TST	R0		;NULL??
	BNE	11$
	JMP	IOND		;TREAT AS END OF LINE
11$:	CMPB	#'A,R0
	BGT	1$		;NOT A LETTER
	CMPB	#'Z,R0
	BLT	1$
	CALL	IOARG		;IS IT AN ARG OF FORM XXX=
				;THIS MUST BE DONE BECAUSE
				;THE F4P OPEN STATEMENT HAS ONE ARGUMENT
				;NOT OF THIS FORM 'READONLY'
	TST	R0
	BEQ	1$		;GO SKIP TO BEGINNING OF NEXT ARGUMANT
	CALL	LABEQ		;IS IT A LABEL TYPE???
	MOV	R2,LINPT	;UPDATE POINTER TO START OF ARGUMENT VALUE
	TST	R0		;WELL WHAT IS IT
	BEQ	2$		;NO-JUST GET VAR NAME
	CALL	MOVCHR		;GET FIRST CHR OF VALUE
	CMPB	#'0,R0		;SEE IF NUMBER
	BGT	2$		;IF NOT TREAT AS A VAR NAME
	CMPB	#'9,R0
	BLT	2$
	CALL	GETLBL		;LABEL-GO GET IT
	BR	1$		;POSITION FOR NEXT ARG OR END
2$:	CMP	#"OP,VARTYP	;OPEN HAS SPECIAL KEY= ARGUMENT
	BNE	10$		;NOT OPEN
	CMPB	#'K,-4(R2)	;IS FIRST LETTER 'K'
	BNE	10$		;IF NOT THEN NOT ARGUEMNT 'KEY='
	CMPB	#'E,-3(R2)	;DITTO LETTER E
	BNE	10$
	CMPB	#'Y,-2(R2)	;AND FINALLY THE LETTER Y
	BNE	10$
	CALL	MOVCHR		;GET AND SKIP LEADING '('
	INC	LINPT
6$:	CALL	GETKEY		;OF FORM KEY=(X:Y[:ZZZ] [,]) GET THE X
	CALL	MOVCHR
	TSTB	R0		;END OF LINE
	BEQ	IOND
	INC	LINPT
	CALL	GETKEY		;GET THE Y
	CALL	MOVCHR		;SKIP :
	TSTB	R0
	BEQ	IOND
	INC	LINPT
8$:	CMPB	#',,R0		;NEXT ARG?
	BEQ	6$		;YES -LOP AND GET NEXT
	CMPB	#'),R0		;END OF ARGUMENTS FOR KEY=
	BEQ	IOEQ		;YES-NEXT ARG
	CMPB	#':,R0		;OPTIONAL THIRD ARGUMENT?
	BNE	6$		;ASSUME OTHER TERMINATOR 
7$:	CALL	MOVCHR		;SKIP STRING-CONTENTS DON'T NEED TO BE INDEXED
	TSTB	R0
	BEQ	IOND
	INC	LINPT
	CALL	TYPE
	TST	TYPECH
	BGT	7$
	BR	8$
10$:	CLR	PLEVEL		;FOR EXPRESSION
3$:	CALL	GETVAR		;GET VARIABLE NAME
25$:	CALL	MOVCHR		;GET STOP CHARACTER
	CALL	TYPE		;SPECIAL CODE NEEDED FOR MULTAPLE STOP CHARS IN SEQUENCE
	TST	TYPECH
	BGE	3$	
	CMPB	#'',R0		;CHECK FOR HOLERITH,OCTAL,LOGICAL START CHARS
	BEQ	3$
	CMPB	#'",R0
	BEQ	3$
	CMPB	#'.,R0
	BEQ	3$
	INC	LINPT
	TST	R0		;NUL IS EXIT
	BEQ	IOND
	CMPB	#'),R0
	BNE	4$		;NO
	DEC	PLEVEL		;CLOSEING??
	TST	PLEVEL
	BLT	IOND		;YES-DONE
	BR	25$
4$:	CMPB	#'(,R0		;OPENING
	BNE	5$
	INC	PLEVEL
	BR	25$
5$:	CMPB	#',,R0		;COMMA??
	BNE	25$		;NEXT VAR NAME
	JMP	IOEQ
1$:	CALL	MOVCHR		;MOVE TO NEXT ARG
	INC	LINPT
	TST	R0
	BEQ	IOND
	CMPB	#'),R0		;CLOSEING PARREN
	BEQ	IOND
	CMPB	#',,R0		;COMMA
	BNE	1$
	JMP	IOEQ		;GO GET NEXT ARGUMENT
IOND:	JMP	LISTT		;GO GET I/O LIST (IF ANY)
;	CHECK TO SEE IF ARGUMENT IN I/O STATEMENT IS OF FORM XXX=
;	R0=0 IF NOT OF FORM
;	R0=1 IS OF FORM
;	R1=ADDR OF CHR FOLLOWING = OR TERMINATOR
IOARG:	MOV	LINPT,R1	;GET ADDR OF FIRST CHAR OF ARG
2$:	MOVB	(R1)+,R0	;GET CHR
	BNE	1$		;IF NULL
	CLR	(SP)+		;ERROR-TAKE OFF RETURN ADDRESS
	JMP	$ERR		;AND TAKE ERROR EXIT
1$:	CMP	#'),R0		;CLOSEING PARREN
	BEQ	10$		;YES-THIS IS NOT OF FORM XXX=
	CMPB	#'(,R0		;OPENING PARREN
	BEQ	10$		;YES-MUST BE EXPRESSION
	CMPB	#47,R0		;QUOTE MARK (DIRECT ACCESS IO)
	BEQ	10$		;YES AGIN NOT OF FORM
	CMPB	#',,R0		;COMMA
	BEQ	10$		;AGAIN
	CMPB	#'=,R0		;OF FORM?
	BNE	2$		;NO-KEEP TRYING
	MOV	#1,R0		;OF FORM XXX=
	RETURN
10$:	CLR	R0		;NOT OF FORM
	RETURN
;	IS ARGUMENT OF FORM XXX= ONE THAT TAKESA LABEL ARGUMENT
;	END=,ERR=,FMT=
;	RETURN R0=0 IF NOT
;	R0=1 IF YES
;	R1 MUST CONTAIN VALUE OUTPUT BY IOARG
LABEQ:	MOV	R1,R2	;COPY ADDRESS OF CHR AFTER =
	SUB	LINPT,R1;GET LENGTH OF FIRST PART OF ARGUMENT
	CMP	#4,R1	;IS IT 4 CHRS LONG
	BNE	10$	;NO-THEN BY SIZE ALONE IT IS NOT LABEL TYPE
	MOV	LINPT,R1	;GET STARTING POINT
	CMPB	#'E,(R1)+	;ERR OR END
	BNE	11$		;NO SEE IF FMT
	CMPB	#'R,(R1)+	;ER OF ERR
	BNE	13$		;NO TRY END
	CMPB	#'R,(R1)+	;ERR
	BEQ	12$		;BINGO
	BR	10$		;ZIP
13$:	CMPB	#'N,-1(R1)	;TRY END
	BNE	10$		;NOPE
	CMPB	#'D,(R1)	;END??
	BEQ	12$		;BULL'S EYE
10$:	CLR	R0		;ZILCH
	RETURN
11$:	CMPB	#'F,-1(R1)	;FMT
	BNE	10$		;NOPE
	CMPB	#'M,(R1)+	;M
	BNE	10$		;NO GOOD
	CMPB	#'T,(R1)	;LAST TRY
	BNE	10$		;EMPTY
12$:	MOV	#1,R0		;CONGRADUALTIONS
	RETURN
GETKEY:	CLR	PLEVEL
2$:	CALL	MOVCHR		;GET CHAR
	TST	R0
	BEQ	3$
	CMPB	#'(,R0		;OPENING PARREN
	BNE	1$
	INC	LINPT
	INC	PLEVEL
	BR	2$
1$:	CMPB	#'),R0		;CLOSEING PARREN
	BNE	4$
	INC	LINPT
	DEC	PLEVEL
	TST	PLEVEL
	BLT	3$
	BR	2$
4$:	CMPB	#':,R0
	BEQ	3$
	CMPB	#',,R0
	BEQ	3$
	CALL	TYPE
	TST	TYPECH
	BGT	5$
	INC	LINPT
	BR	2$
5$:	CALL	GETVAR
	BR	2$
3$:	RETURN
	.PAGE
	.SBTTL	$FO FORMAT (F4+ ONLY)
	.GLOBL	$FO
$FO:
	.IF	DF,F4P	;F4 DOES NOT NEED THIS CODE
	MOV	#1,PLEVEL
E2:
2$:	JSR	PC,MOVCHR
	INC	LINPT
	TST	ARGFLG
	BNE	FOEX
	CMPB	#'),R0
	BNE	FOCO
	DEC	PLEVEL
	BGT	2$
22$:	INC	LINPT
	JSR	PC,MOVCHR
	TST	ARGFLG
	BNE	FOEX
	TSTB	R0
	BNE	22$
FOEX:
	RTS	PC
FOCO:	CMPB	#'(,R0
	BNE	6$
	INC	PLEVEL
	BR	E2
6$:	CMPB	#'<,R0
	BEQ	AG			; INSIDE ANGLE BRACKETS-START LOOKING FOR VARS
	CMPB	#'',R0
	BNE	3$			; SKIP QUOTE HOLS
	.GLOBL	SUEXP
	INC	SUEXP
4$:	JSR	PC,MOVCHR
	INC	LINPT
	TST	ARGFLG
	BNE	FOEX
	CMPB	#'',R0
	BNE	4$
	CLR	SUEXP
	BR	E2
3$:	CMPB	#'H,R0			; 1 HOL CHR
	BNE	5$
	INC	LINPT
	BR	E2
5$:	JSR	PC,TYPE			; IS IT NO
	TST	TYPECH
	BNE	E2
	CLR	R1
7$:	SUB	#60,R0
	ADD	R0,R1
	JSR	PC,MOVCHR
	TST	ARGFLG
	BNE	FOEX
	JSR	PC,TYPE
	TST	TYPECH
	BNE	ECH
	INC	LINPT
	ASL	R1
	MOV	R1,-(SP)
	ASL	R1
	ASL	R1
	ADD	(SP)+,R1
	BR	7$
ECH:	CMPB	#'H,R0			; HOL STATEMENT
	BEQ	.+6
	JMP	E2
	INC	LINPT			; SKIP HOL
	MOV	R1,SUEXP
1$:	JSR	PC,MOVCHR
	TST	ARGFLG
	BNE	FOEX
	INC	LINPT			; SKIP CHR
	DEC	SUEXP
	BNE	1$
	JMP	E2
AG:	JSR	PC,GETVAR
	JSR	PC,MOVCHR
	TST	ARGFLG
	BNE	FOEX
	CMPB	#'>,R0			; RIGHT ANG BRK SAYS DONE SCANN
	BNE	AG
	JMP	E2
	.IFF
	JMP	$YY	;	FORMAT FOR F4 COMPILER DOES NOT NEED TO BE PARSED
	.ENDC
	.PAGE
	.SBTTL	$II INCLUDE FILE HANDLEING(F4P ONLY)
	.IF	DF,F4P
;	INCLDES ONLY WORK FOR F4P SO DONT BOTHER FOR F4
;	AM LEAVING IN THE RT-11 CODE JUST SO ANY FELLOW HACKER WHO
;	WANTS TO CAN INCLUDE 'INCLUDE'  UNDER RT-11
$II::	CMP	#F4P,SAVENO
	BNE	NOVFS
	MOV	#OVFMSG,R0
E21ERR:	JSR	PC,PRTLIN
	JSR	PC,CLOSE
	INC	ERRCNT
	.IF	NDF,RSX
	BISB	#10,@#53
	.PRINT	#IXIT	
	.IFF
	QIOW$S	#IO.WLB,#9.,#1,,,,<#IXIT,#33.,#40>
	.IFT
	CLR	R0
	.EXIT
	.IFF
	EXIT$S
SWLIST:	CSI$SW	LIST,0,SUPER,SET,NEG,,EXACT
	CSI$ND
	.ENDC
IXIT:	.ASCIZ	/ INDEX-F-INCLUDE PROCESSING ERROR/
OVFMSG:	.ASCIZ	/ INDEX-F-INCLUDE NESTING LIMIT EXCEEDED/
	.EVEN
NOVFS:	.IF	NDF,RSX
	SUB	#6.,SAVEPT
	.IFTF
	INC	SAVENO
	MOV	R1,-(SP)
	MOV	R2,-(SP)
	MOV	SAVEPT,R1
	.IFT
	MOV	NOSRC,4.(R1)
	MOV	INBLK,2.(R1)
	MOV	INBFPT,(R1)
	INC	ICHNO
	MOV	SP,TMP
	.IFF
	MOV	LEOF,(R1)+
	MOV	HIINBP,(R1)+
	MOV	NOSRC,(R1)+
	MOV	#IBUFF,R0
	MOV	#<134./2>,R2
16$:	MOV	(R0)+,(R1)+
	DEC	R2
	BNE	16$
	ADD	#140.,SAVEPT
	ADD	#2,ICHNO
	CLR	LEOF
	.IFTF
	MOV	#LIN,R1
	MOVB	#'=,(R1)+
1$:	JSR	PC,MOVCHR
	INC	LINPT
	TSTB	R0		;SEE IF ERROR IN SPEC(NO LEADING "'"
	BNE	3$		;IF NOT-QUIT-FATALLY IF RUN OUT OF LINE
	JMP	INCSTX
3$:	CMPB	#'',R0
	BNE	1$
2$:	JSR	PC,MOVCHR
	INC	LINPT
	CMPB	#'',R0
	BEQ	NDINC
	CMPB	#'/,R0		;/[NO]LIST SWITCH
	BEQ	LISW		;YES-GO EVAL-NO NEED TO INCLUDE IN CSI STRING
	MOVB	R0,(R1)+
	BEQ	NDINC
	BR	2$
LISW:
	.IFT
	TST	SAVE-2		;WAS NOLIST SWITCH USED??
	.IFF
	TST	SAVE+4		;WAS NOLIST SWITCH USED??
	.IFTF
	BNE	NDINC		;IF YES-THEN IGNORE SWITCH
	CALL	MOVCHR		;GET NEXT CHAR-EITHER N OR L
	INC	LINPT
	CMPB	#'N,R0		;WAS IT NOLIST
	BNE	1$		;NO-WAS LIST
	MOV	#1,NOSRC	;SET NO SRC
	BR	2$
1$:	CLR	NOSRC		;SET LIST
2$:	TST	R0		;EMPTY LINE
	BEQ	NDINC
	CMPB	#'',R0
	BEQ	NDINC
	CALL	MOVCHR
	INC	LINPT
	BR	2$
NDINC:	
	.IFT
	CLRB	(R1)
	SUB	#140.,SP
	MOV	SP,R2
	.CSISPC	R2,#EXT,#LIN
	ADD	#30.,R2
	.LOOKUP	#IOARA,ICHNO,R2
	BCC	NOINCE
	.IFF
	MOV	#LIN,R2
	SUB	R2,R1
	CSI$1	#CSIBLK,R2,R1
	BCS	11$
	CSI$2	#CSIBLK,INPUT,#SWLIST
	BCS	11$
	OPEN$R	@ICHNO,,#CSIBLK+C.DSDS
	BCC	NOINCE
	.IFT
	MOV	TMP,SP
	.IFTF
11$:
INCSTX:	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	#INLE,R0
	JMP	E21ERR
INLE:	.ASCIZ	/ INDEX-F-INCLUDE FILE SPECIFICATION ERROR/
	.EVEN
NOINCE:	
	.IFT
	CLR	INBLK
	MOV	TMP,SP
	.IFTF
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	.IFT
	.READW	#IOARA,ICHNO,#INBUF,#256.,INBLK
	MOV	#INBUF,INBFPT
	CMPB	#15,INBUF
	BNE	NOCR
	INC	INBFPT
NOCR:	INC	INBLK
	.IFF
	GET$	@ICHNO,#IBUFF,#132.
	BCC	2$
	INC	LEOF
2$:	MOV	#IBUFF,INBFPT
	MOV	F.NRBD+2(R0),HIINBP
	ADD	F.NRBD(R0),HIINBP
	.ENDC
1$:	JSR	PC,GETLIN
	TSTB	LIN
	BEQ	1$
	RTS	PC
RESTFI:	DEC	SAVENO
	.IF	NDF,RSX
	.PURGE	ICHNO
	DEC	ICHNO
	MOV	SAVEPT,R0
	MOV	(R0),INBFPT
	MOV	2.(R0),INBLK
	MOV	4.(R0),NOSRC
	DEC	INBLK
	.READW	#IOARA,ICHNO,#INBUF,#256.,INBLK
	INC	INBLK
	ADD	#6.,SAVEPT
	.IFF
	CLOSE$	@ICHNO
	SUB	#2,ICHNO
	MOV	R1,-(SP)
	MOV	R2,-(SP)
	SUB	#140.,SAVEPT
	MOV	SAVEPT,R1
	MOV	(R1)+,LEOF
	MOV	(R1)+,HIINBP
	MOV	(R1)+,NOSRC
	MOV	#IBUFF,R0
	MOV	#<134./2>,R2
17$:	MOV	(R1)+,(R0)+
	DEC	R2
	BNE	17$
	MOV	#IBUFF,INBFPT
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	.ENDC
	RTS	PC
	.ENDC
	.PAGE
	.SBTTL	$ERR--ERROR REPORTING
	.GLOBL	$ERR
$ERR:	MOV	#ERRMSG,R0
	JSR	PC,PRTLIN
45$:	INC	LINPT
	JSR	PC,MOVCHR
	TSTB	R0
	BNE	45$
	.IF	NDF,RSX
	BISB	#2,@#53
	.ENDC
	INC	ERRCNT
	RTS	PC
ERRMSG:	.ASCIZ	/ INDEX-W-UNKNOWN LINE TYPE OR SYNTAX ERROR/
	.EVEN
	.END