.TITLE	LINE TYPE
	.GLOBL	FINLIN,STOLBL,EVLRTN,$ARTH
	.GLOBL	LIN,KEY,SCANLN,LINTYP,LINPT,NEM
	.GLOBL	LABL,VARTYP,KEY,PLEVEL,EQFLG,$ERR
	.PSECT	LTYPE,I,RO,GBL
	.PAGE
SCANLN:					; FROOM THE TABLE OF KEY WORDS DETERMINE WHAT THYPE OF
					; LINE THIS IS
	.IF	DF,PREPRC		;HANDLE PREPROCESSED FORTRAN FILES
	.GLOBL	PRESW,FLXNO
	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$:
	.ENDC
	CLRB	@FINLIN			; IF COLS 73+USED FOR NO.S -DONT USE
	MOV	#LIN,R4
	MOV	#LABL,R3
CHRFTC:	MOVB	(R4)+,R0		; GET ANY LABL DEF
	CMPB	#' ,R0
	BEQ	NXTLCH
	CMPB	#'0,R0
	BNE	XFR
	CMP	#LABL,R3
	BEQ	NXTLCH
XFR:	MOVB	R0,(R3)+
NXTLCH:	CMP	#LIN+5,R4
	BNE	CHRFTC
LBLBLK:	CMP	#LABL,R3
	BEQ	NOLABL
LBLB1:	CMP	#LABL+6,R3
	BEQ	STLABL
	MOVB	#' ,(R3)+
	BR	LBLB1
STLABL:	MOV	#"* ,VARTYP
	JSR	PC,STOLBL
NOLABL:	MOV	#LIN+6,R4
	MOV	R4,LINPT
	MOV	#KEY,R2			; SET UP TO SCAN FOR KEY WORD
	CLR	R3
NOKELB:	INC	R3
	MOV	#LIN+6,R4
KEYLB:	MOVB	(R2)+,R1
	BEQ	FDMTCH
1$:	MOVB	(R4)+,R0
	CMPB	#' ,R0
	BEQ	1$
	CMPB	R1,R0
	BEQ	KEYLB
NXTKEY:	TSTB	(R2)+
	BNE	NXTKEY
	BR	NOKELB
FDMTCH:	DEC	R3
	ASL	R3
	MOV	EVLRTN(R3),LINTYP	; STORE LINE TYPE
	MOV	NEM(R3),VARTYP
	CLR	PLEVEL			; SET PAREN LEVEL=0
	CLR	EQFLG			; FOUND= FLAG=0
	MOV	R4,R1
	MOV	R4,LINPT
	.MACRO	DBLCK NO,DST
					CMP	#"NO,VARTYP
					BNE	.+6
					JMP	DST
	.ENDM
;	SINCE SOME KEY WORDS ARE LT 6 CHRS AND COUTLD
;	BE THAT WE HAVE JST LOCATED A VAR NAME THAT
;	MATCHES THE KEY WORD TO THE PONT CHECKED, A DOUBLE
;	CHECK MUST BE MADE( DO IS THE BEST EXAMLE)
	DBLCK	CL,ECALL		; CHECK CALL
	DBLCK	DA,EDATA		; CHECK DATA
	DBLCK	DO,EDO			; CHECK DO
	DBLCK	ZZ,EEND			; HECK END
	DBLCK	GT,EGOTO		; DITTO GO TO
	DBLCK	WW,EPAUSE
	DBLCK	PR,EPRINT
	DBLCK	RC,EREAD
	DBLCK	UU,ESTOP
	DBLCK	TY,ETYPE
	DBLCK	RL,EREAL
	DBLCK	<= >,EARTH		; IS IT ARITHMETIC STATMEMENT
	DBLCK	EY,ENTRY
	DBLCK	BY,EBYTE
	DBLCK	SA,ESAVE
	DBLCK	TH,ETHEN
	DBLCK	EL,EELSE
	DBLCK	EI,EENDIF
	DBLCK	U*,EUNLOCK
	JMP	DCOUT			; NON OF ABOVE-NO CHECK NEEDED JUST GET OUT
EREAD:		MOV	#"RD,VARTYP
		BR	ECLLB
EUNLOCK:	MOV	#"UN,VARTYP
ESAVE:
ENTRY:
EDATA:
EBYTE:
EREAL:
ECALL:
EGOTO:
EPRINT:
ETYPE:
ECLLB:	MOVB	(R1)+,R0		; GET CHR FROM LINE
	BEQ	ECLLEX			; IF NULL DONE CHECK
	CMPB	#50,R0			; IS IT '('
	BNE	ECRPTS			; SKIP NEXT IF NO
	INC	PLEVEL			; INC PAREN LEVEL
	BR	ECLLB			; NEXT CHR
ECRPTS:	CMPB	#51,R0			; IS IT ')'
	BNE	ECSLTS			; SKIP NEXT IF NOT
	DEC	PLEVEL			; DEC PAREN LEVEL
	BR	ECLLB			; NEXT CHR
ECSLTS:	CMPB	#'!,R0
	BEQ	1$
	TST	PLEVEL			; ARE WE AT 0 PLEVEL???
	BNE	ECLLB			; IF NO THEN NO NEED DOING EXTRA WORK,NEXT CHR PLEASE
	CMPB	#57,R0
	BNE	ECEQTS			; HAVE WE ENCOUNTERD A 0 PLEVEL,BEFORE = SLASH
1$:	JMP	DCOUT			; YES-GOOD DATA STATEMENT
ECEQTS:	CMPB	#75,R0			; HOW ABOUT A ZERO LEVEL =
	BNE	ECLLB			; NO GO BACK FOR NEW CHR
	MOV	#$ARTH,LINTYP		; THIS IS ARITH STATEMENT-RE CLASSIFY
	MOV	#"= ,VARTYP
ECLLEX:	JMP	DCOUT			; CHECK DONE
EDO:	MOVB	(R1)+,R0		; GET CHR FROM LINE
	BEQ	EDER			; NULL HERE MEANS ERROR-GO TO ERROR RTN
	CMPB	#'(,R0			; IS TO '('
	BNE	.+10			; SKIP NEXT IF NOT
	INC	PLEVEL			; INC PAREN LEVEL
	BR	EDO			; GO BACK FOR NEW CHR
	CMPB	#'),R0			; ')'
	BNE	.+10
	DEC	PLEVEL
	BR	EDO
	TST	PLEVEL			; SAME ROUTINE AS BEFORE
	BNE	EDO
	TST	EQFLG			; HAVE WE FOUND '=' YET
	BNE	CMCK			; IF YES GO TO COMMA CHECK
	CMPB	#'=,R0			; '='??
	BNE	EDO			; NO GO BACK FOR NEW CHR
	INC	EQFLG			; YES SET EQ FOUIND FLAG
	BR	EDO
CMCK:					; OK AT THIS POINT WE HAVE FOUND
					; A ZERO LEVEL '=' NO TO CONFERM DO WE MUST FIND
					; A ZERO LEVEL ',' AFTER THE '='
	CMPB	#',,R0			; ','???
	BNE	EDO			; NO GRAB ANOTHER CHR
EDOUT:	JMP	DCOUT			; IT IS A DO TYPE EXIT
EDER:					; OK IS IT ARITH OR ERROR
	MOV	#$ARTH,LINTYP		; SET TO ARTIH STATEMENT
	MOV	#"= ,VARTYP
	TST	EQFLG			; WAS EQ FLAG FOUND
	BNE	EDOUT			; YES = FOUND-IT IS ARITH STATEMENT
	MOV	#$ERR,LINTYP		; NO = FOUND-UNKNOWN STATEMENT-SET
	MOV	#"$$,VARTYP
					; ERROR LINETYPE
	BR	EDOUT
EELSE:
EENDIF:
ETHEN:
EEND:	MOVB	(R1)+,R0
	BEQ	EDOUT
	CMPB	#' ,R0
	BEQ	EEND
	CMPB	#'!,R0
	BEQ	EDOUT
	MOV	#$ARTH,LINTYP
	MOV	#"= ,VARTYP
	JMP	EARTH			; AND LET ARITH RTN CONFERME
ESTOP:
EPAUSE:
EPSKP:	MOVB	(R1)+,R0
	BEQ	EPOUT
	CMPB	#' ,R0
	BEQ	EPSKP
	CMPB	#47,R0
	BEQ	EPOUT
	CMPB	#42,R0
	BEQ	EPOUT
	CMPB	#'!,R0
	BEQ	EPOUT
	CMPB	#'=,R0
	BNE	EPSKP
	MOV	#$ARTH,LINTYP		; OOPS
	MOV	#"= ,VARTYP
	JMP	EARTH
EPOUT:	JMP	DCOUT
EARTH:	MOV	#LIN+6,R1
	MOV	R1,LINPT
EALB:	MOVB	(R1)+,R0
	BEQ	EARER			; NULL IS ERROR
	CMPB	#50,R0
	BNE	.+10			; '('???
	INC	PLEVEL
	BR	EALB
	CMPB	#51,R0
	BNE	.+10			; ')'???
	DEC	PLEVEL
	BR	EALB
	TST	PLEVEL			; PLEVEL=0???
	BNE	EALB			; DONT DO MORE WORK THAN NECESSARY
	CMPB	#75,R0			; '='????
	BNE	EALB			; NO
	JMP	DCOUT			; YES IT IS ARITH
EARER:	MOV	#$ERR,LINTYP		; SETT ERROR LINE TYPE
	MOV	#"$$,VARTYP
DCOUT:	RTS	PC
	.END