.TITLE	GET
	.GLOBL	LABL,TYPECH,MOVCHR,GETLIN,EOF,LIN,DEBUG,PRTLIN,FILLER
	.GLOBL	GETVAR,VAR,VARTYP,LOGCK,LOGOP,TYPE,TYPECH,VARTYP
	.GLOBL	ARGFLG,GETLBL,LABL,STOLBL,STOVAR,LOGNEM,LINPT,TMP,FINLIN
	.GLOBL	SKIP,SAVENO,PUTCHR,PNMFLG,SUEXP,NOSRC,PRNFLG
	.PSECT	GET,I,RO,GBL
	.PAGE
;	A '.' HAS BEEN FOUND-IS IT THE BEGINNING OF
;	A LOGICAL OPERATOR WHICH IS TO BE SKIPPED
;	IF LOGOP=0 IT IS NOT A LOGICAL OF IF LOGOP.NE.0 IT IS
;	EQUAL TO THE NUMBER OF CHRS IN LOGICAL OP TO BE SKIPPED
LOGCK:	MOV	R1,-(SP)
	MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	R4,-(SP)
	MOV	#LOGNEM,R2		; GET BEGINING OF LOGICAL NEM.TABLE
NXTLOG:	MOV	LINPT,R3		; GET LOC OF '.' IN STRING LINE
	CLR	R1			; R1 IS LOG OP LENGTH CTR
LOGLB:	MOVB	(R2)+,R0		; GET NEM CHR
	BEQ	NDLOG			; IF NULL BYTE DONE FOUND LOG OP OR END OF THABLE
1$:	INC	R1
	CMPB	#' ,(R3)
	BNE	2$
	INC	R3
	BR	1$
2$:	CMPB	R0,(R3)+
	BNE	SKPLOG
	BR	LOGLB			; ONE MORE TIME
SKPLOG:	MOVB	(R2)+,R0		; CHECK NEXT CHR
	BNE	SKPLOG			; NULL YET
	BR	NXTLOG			; YES TRY NEXT NEM
NDLOG:	MOV	R1,LOGOP		; DONE XFER COUNT TO LOGOP
	MOV	(SP)+,R4
	MOV	(SP)+,R3
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	RTS	PC
	.PAGE
;	THIS ROUTINE TESTS THE CHR IN R0 AND RETURNS IN VAR TYPECH
;	TYPECH=1 IF CHR =LETTER
;	TYPECH=0 IF CHR= NUMBER
;	TYPECH=-1 IF CHR ANYTHING ELSE
TYPE:	CMPB	R0,#133			; IS ASCII CODE HIGHER THAN LETTER
	BHIS	NTLTNO			; NOT LETTER TO HIGH
	CMPB	R0,#101			; TEST LOW END LETTER ASCII VALUE
	BLO	NTLET			; TO LOW FOR LETTER BRANCH
	MOV	#1,TYPECH		; YES LETTER
	RTS	PC
NTLET:	CMPB	R0,#72			; HIGHER THAN NUMBER
	BHIS	NTLTNO
	CMPB	R0,#60			; LOWER THAN NUMBER
	BLO	NTLTNO
	CLR	TYPECH			; IT IS A NUMBER
	RTS	PC
NTLTNO:	MOV	#-1,TYPECH		; ONLTHING LEFT
	RTS	PC
	.PAGE
;	WHEN A NUMBER IS FOUND IN A LINE AND IT IS TO BE
;	SKIPPED, THIS ROUTINE DOES IT
SKPNUM:	MOV	LINPT,TMP
NXTNUM:	MOVB	@LINPT,R0
	INC	LINPT
	CMPB	#' ,R0
	BEQ	NXTNUM
	JSR	PC,TYPE			; IS IT A NUMBER
	TST	TYPECH
	BEQ	NXTNUM			; IF YES GO BACK UNTILL NON NUMBER FOUND
	BLT	NDNUSK			; NON NUMBER NON LETTER FOUND
	CMPB	#'R,R0
	BEQ	HOL			; TREAT RAD50 SAME AS HOL
	CMPB	#'H,R0			; WAS 'H' FOUND (HOLERATH)
	BEQ	HOL			; YES
	CMPB	#'E,R0			; WAS AN 'E' FOUND X.XXXXX E+-XX
	BEQ	FPNUM
	CMPB	#'D,R0			; SAME FOR 'D' X.XXXXX D+_XX
	BEQ	FPNUM
NDNUSK:	CMPB	#'.,R0			; WAS IT A POINT
	BNE	NDSKDW			; NO
	DEC	LINPT
	JSR	PC,LOGCK		; IS IT A LOGICAL OPERATOR
	INC	LINPT
	TST	LOGOP
	BEQ	NXTNUM			; NOT LOG OP CONTINUE NUMBER SKIP
	DEC	LINPT
	ADD	LOGOP,LINPT		; UPDATE LINEPTR TO AFER OP
NDSKDW:	DEC	LINPT
	RTS	PC
FPNUM:	MOVB	@LINPT,R0
	INC	LINPT
	CMPB	#' ,R0
	BEQ	FPNUM
	CMPB	#'+,R0
	BEQ	FPEXSG			; FP EXP SIGN
	CMPB	#'-,R0
	BEQ	FPEXSG
TSTSKP:	JSR	PC,TYPE			; TYPE??
	TST	TYPECH
	BNE	NDSKDW			; NOT NUMBER,DONE
FPEXSG:	MOVB	@LINPT,R0
	INC	LINPT
	CMPB	#' ,R0
	BEQ	FPEXSG
	BR	TSTSKP			; NEXT CHR	ONLY 1ST AFTER E OR D IS +-
HOL:	CLR	R3			; HOLERATH STATEMENT-GET SET TO GET COUNT OF NUMBER
					; OF CHRS TO SKIP AND PRAY THERE ARE NO BLANKS SQUESSED OUT
	CLR	R2
HOLCNT:	MOV	TMP,LINPT
7$:	MOVB	@LINPT,R0
	INC	LINPT
	CMPB	#' ,R0
	BEQ	7$
1$:	SUB	#60,R0			; CONVERT FROM ASCII TO BINARY
	ASL	R3			; MULT CONTENTS OF R3 BY 10
	MOV	R3,R2
	ASL	R2			; R2=4* ORIG CONTENTS OF R3
	ASL	R2			; 8* NOW
	ADD	R3,R2			; 10* DECIMAL OF COURSE
	MOV	R2,R3
	ADD	R0,R3			; UPDATED COUNT
10$:	MOVB	@LINPT,R0
	INC	LINPT
	CMPB	#' ,R0
	BEQ	10$
	CMPB	#'H,R0
	BEQ	2$
	CMPB	#'R,R0
	BEQ	2$
	BR	1$
2$:	MOV	R3,SUEXP
3$:	JSR	PC,MOVCHR
	INC	LINPT
	DEC	SUEXP
	BNE	3$
	RTS	PC
	.PAGE
;	THIS ROUTINE GETS A LABLE EMBEDED IN A STATEMENT
;	EG. GO TO 100
;	READ(100,
;	ETC
GETLBL:	MOV	#LABL,R0		; BLANK OUT LABL
	MOV	#20040,(R0)+
	MOV	#20040,(R0)+
	MOV	#20040,(R0)+
	MOV	#LABL,R1		; SET UP LABLE CHR PTR
GTLBCH:	JSR	PC,MOVCHR
	TSTB	R0
	BEQ	NDLIN			; NULL SAYS END OF STRING-DONE
	JSR	PC,TYPE			; WHAT TYPE OF SYMBOL IS IT
	TST	TYPECH
	BNE	NTNUM			; NOT A NUMBER
	INC	LINPT			; YES A NUMBER INC PTR
	CMPB	#'0,R0			; IS CHR A ZERO
	BNE	XFR1			; NO SKIP NEXT
	CMP	#LABL,R1		; IS IT A LEADING ZERO
	BEQ	GTLBCH			; IF YES SKIP IT
XFR1:	MOVB	R0,(R1)+		; STO CHR
	CMP	#LABL+5,R1		; GOT MAX OF 5 CHRS YET
	BHI	GTLBCH			; NO GO BACK
SKPNO:	JSR	PC,MOVCHR
	TSTB	R0
	BEQ	NDLIN			; NULL CHECK
	JSR	PC,TYPE
	TST	TYPECH
	BNE	NTNUM			; NOT NUMBER
	INC	LINPT			; INC PTR TO NEXT CHR
	BR	SKPNO			; AND REPEAT
NDLIN:
NTNUM:	CMP	#LABL,R1		; WAS A LABEL FOUND???
	BEQ	NOLABL			; NO SKIP STORE
	JSR	PC,STOLBL		; YESY STORE
NOLABL:	RTS	PC
; WHEN THIS ROUTINE IS EXITED- THE POINTER LINPTR POINTS TO THE
; CHR THAT STOPED THE SCAN
	.PAGE
;THIUS ROUTINE GETS AND STORES A VARIABLE NAME IN A STRING'LINE'
GETVAR:	MOV	#VAR,R1			; BLANK 'VAR'
	MOV	#20040,(R1)+
	MOV	#20040,(R1)+
	MOV	#20040,(R1)+
	JSR	PC,MOVCHR
	TSTB	R0
	BNE	NTNLVR			; NULL=END OF LINE
OT:	INC	ARGFLG
	CLR	PNMFLG			; CLEAR UPDATE UPDATE PROGRAM NAME FLAG
	RTS	PC
NTNLVR:	JSR	PC,TYPE			; IS IT A LETTER
	TST	TYPECH
	BGT	LETR			; YES LETTER
	BEQ	NUMB			; IS IT A NUMBER
	CMPB	#47,R0			; "'"
	BEQ	QTHAL			; ITS A HOLERATH USEING QUOTES
	CMPB	#42,R0			; '"'
	BEQ	OCTNO			; OCTAL NO PREFIX
	CMPB	#56,R0			; '.'
	BEQ	POINT			; PERIOD
	INC	LINPT
	CLR	PNMFLG
	RTS	PC
QTHAL:	INC	LINPT			; INC PTR TO NEXT CHR
	INC	SUEXP
	JSR	PC,MOVCHR
	TSTB	R0
	BEQ	OT			; NULL-DONE
	CMPB	#47,R0			; FOUND CLOSEING "'" YET
	BNE	QTHAL			; NOT YET
	CLR	SUEXP
	INC	LINPT
	CALL	MOVCHR			; GET NEXT CHAR
	CMPB	#'O,R0			; IS IT AN 'O' FOR F77 OCTAL CONSTANT
	BEQ	NTLG			; YES-SKIP IT AND SET UP FOR NEXT CHAR
	CMPB	#'X,R0			; HOW ABOUT AN 'X' FOR HEX F77 CONST.
	BNE	NOBIN			; IF YES-INC CHAR-ELSE JUST CLEAN UP
NTLG:	INC	LINPT			; SET PTR TO CHR AFTER HOL
NOBIN:	CLR	PNMFLG
	RTS	PC
OCTNO:	INC	LINPT
NUMB:	JSR	PC,SKPNUM		; SKIP THE NUMBER
	CLR	PNMFLG
	RTS	PC
POINT:	JSR	PC,LOGCK		; IS POINT BEGINING OF LOGICAL OP
	TST	LOGOP
	BEQ	NTLG			; NO CAN ONLY BE PART OF A NUMBER-HANDLE AS SUCH
	ADD	LOGOP,LINPT		; SKIP LOGICAL OP
	CLR	PNMFLG
	RTS	PC
LETR:	MOV	#VAR,R1			; A LETTER-SET UP PTR FOR STORAGE
STOCHR:	MOVB	R0,(R1)+		; STORE CHR
SKPCHR:	INC	LINPT
	JSR	PC,MOVCHR
	TSTB	R0
	BEQ	NGTVAR			; NULL END OF LINE
	JSR	PC,TYPE
	TST	TYPECH
	BLT	GTVAR			; NOT LETTER OR NUMBER END OF SCAN
	MOV	#VAR,-(SP)
	ADD	#6,(SP)
	CMP	(SP)+,R1
	BEQ	SKPCHR			; YES KEEP GETTING BUT NOT STOREING CHRS
					; UNTILL END OF VAR NAME
	BR	STOCHR			; STOR CHR
NGTVAR:
GTVAR:	TST	SKIP
	BNE	GTDATA
	CLR	PRNFLG			;SEE IF IT HAS A TRAILING '('
	CMP	#"CL,VARTYP		;CATCH CALL'S WITHOUT ARGUMENTS
	BEQ	20$
	CMPB	R0,#'(
	BNE	21$			;NO-SKIP ARRAY/FUNCTION CHECK
	MOV	#LIST,R0		;CHECK TO SEE IF IT IS A FUNCTION CALL
	MOV	#NLIST,R1
10$:	CMP	(R0)+,VARTYP		;IS THIS A MATCH
	BEQ	20$			;YES-THIS IS AN ENTRY POINT DEFEINED ELSEWARE
	DEC	R1			;LIST DONE
	BGT	10$			;NO-CHECK NEXT
	INC	PRNFLG			;ARRAY/FUNCTION-SET FLAG AND LET STORE
					;FIGURE OUT WHICH
	BR	21$			;GO STORE IT
20$:	MOV	#100000,PRNFLG		;TELL STORE THIS IS DEFINED ENTRY 
					;POINT-ENTERED ELSEWARE
21$:
	JSR	PC,STOVAR
GTDATA:	CLR	PRNFLG			;RESET PAREN FLAG
	CLR	PNMFLG
	RTS	PC
LIST:	.ASCII	/CLEXEYFBFCFDFHFIFLFRFUSUIT/
NLIST=<.-LIST>/2
	.PAGE
MOVCHR:	TST	ARGFLG
	BEQ	1$
	JMP	NDLIN2
1$:	TSTB	@LINPT
	BEQ	NLIN
	JMP	NTNUL
NLIN:	JSR	PC,GETLIN
	TST	EOF
	BEQ	101$
	JMP	NDLIN2
101$:	TSTB	LIN
	BNE	102$
	JMP	NDLIN2
102$:	CMPB	#'*,LIN
	BEQ	1$
	CMPB	#'C,LIN
	BEQ	1$
	CMPB	#143,LIN
	BNE	2$
1$:	MOV	#FILLER,R0
	JSR	PC,PRTLIN
	TST	SAVENO
	BNE	11$
	MOV	#40,R0
	BR	12$
11$:	MOV	#'*,R0
12$:	JSR	PC,PUTCHR
	MOV	#LIN,R0
	JSR	PC,PRTLIN
	BR	NLIN
2$:	CMPB	#'D,LIN
	BEQ	3$
	CMPB	#144,LIN
	BNE	CHKCNT
3$:	TST	DEBUG
	BEQ	1$
;	CHECK FOR COMMENT LINES CONSISTING ONLY OF "!"
	MOV	#LIN,R0
4$:	TSTB	(R0)	;FOR NULL LINE-HANLE ELSEWARE
	BEQ	CHKCNT
	CMPB	#40,(R0)+;SEE IF BLANK
	BEQ	4$	;REPEAT UNTILL NOT
	CMPB	#'!,-1(R0)	;SEE IF !
	BEQ	1$	;IF YES-HANDLE AS COMMENT
CHKCNT:	CMPB	#'0,LIN+5
	BEQ	4$
	CMPB	#' ,LIN+5
	BNE	5$
4$:	JMP	NDLIN2
5$:	MOV	#FILLER,R0
	JSR	PC,PRTLIN
	TST	NOSRC
	BNE	3$
	TST	SAVENO
	BNE	1$
	MOV	#40,R0
	BR	2$
1$:	MOV	#'*,R0
2$:	JSR	PC,PUTCHR
	MOV	#LIN,R0
	JSR	PC,PRTLIN
3$:	CMPB	#'D,LIN
	BEQ	9$
	CMPB	#143,LIN
	BNE	NOD
9$:	MOVB	#' ,LIN
NOD:	MOV	#LIN+6,LINPT
	.IF	DF,PREPRC		;HANDLE PREPROCESSED FORTRAN FILES
	.GLOBL	PRESW,FLXNO
	MOV	R1,-(SP)
	TST	PRESW			;PRE PROCESS ENABLE?
	BEQ	1$			;NO
	MOV	#LIN+100.,R0
2$:	TSTB	-(R0)			;FIND END OF LINE
	BNE	3$
	CMP	#LIN+72.,R0		;DOWN TO COL 73
	BLO	2$
	BR	1$			;NO NUMBERS
3$:	MOV	#1,R4
	CLR	R1
4$:	CMPB	#' ,(R0)		;CHECK FOR BLANK-SKIP IT
	BEQ	6$
	CMPB	#'0,(R0)		;CHECK IF NUMBER
	BGT	5$
	CMPB	#'9,(R0)
	BLT	5$
	MOVB	(R0),R2
	SUB	#60,R2		;GET DIGIT
	MOV	R4,R5
	MOV	#16.,R3
7$:	CCC
	ROR	R5
	BCC	8$
	ADD	R2,R1
8$:	CCC
	ROL	R2
	DEC	R3
	BGT	7$
	ASL	R4
	MOV	R4,-(SP)
	ASL	R4
	ASL	R4
	ADD	(SP)+,R4
6$:	DEC	R0
	CMP	#LIN+72.,R0	;END OF LINE
	BLO	4$
5$:	TST	R1		;IF LINE NUMBER 0-DONT UPDATE
	BEQ	1$
	MOV	R1,FLXNO
1$:
	TST	PRESW
	BEQ	11$
	CLRB	@LIN+72.
11$:	MOV	(SP)+,R1
	.ENDC
	CLRB	@FINLIN
	JMP	MOVCHR
NTNUL:	TST	SUEXP
	BNE	NOBL
	CMPB	#' ,@LINPT
	BNE	NOBL
	INC	LINPT
	JMP	MOVCHR
NOBL:	TST	SUEXP
	BNE	1$
	CMPB	#'!,@LINPT
	BNE	1$
	JMP	NLIN
1$:	CMP	LINPT,FINLIN
	BLT	2$
	JMP	NLIN
2$:	MOVB	@LINPT,R0
	RTS	PC
NDLIN2:	INC	ARGFLG
	CLR	R0
	RTS	PC
	.END