SEARCH	SIMMC1,SIMMAC
	CTITLE	LS
	SUBTTL	LS
	COMMENT;
	AUTHOR:	I WENNERSTR@M
		UPDATED AT ACADIA UNIVERSITY FOR KA10
	VERSION:	4 [14,15,101,144,164,262]
	PURPOSES:
		LS, LEXICAL SCANNER, IS A SUBROUTINE THAT IS CALLED FROM SR,
		SYNTAX RECOGNITION.
		LEXICAL SCANNER INPUTS CHARACTERS ONE BY ONE AND
		RECOGNIZES THE BASIC SYMBOLS WHICH
		IT RETURNS TO THE CALLING ROUTINE.
		AT THE END OF A LINE THE LC, LINE CONTROL
		ROUTINE IS CALLED.

		LS PERFORMS THE FOLLOWING FUNCTIONS:
		1) NON-SIGNIFICANT SPACES,TABS AND
		   LINE CONTROL CHARACTERS ARE REMOVED.
		2) COMMENTS ARE REMOVED.
		3) OPTIONS STATEMENTS ARE HANDLED AND REMOVED.
		4) SINGLE CHARACTER AND COMPOUND CHARACTERS
		   DELIMITERS ARE REPLACED BY THE BASIC SYMBOLS.
		5) THE RESERVED WORDS OF THE LANGUAGE ARE REPLACED
		   BY THE BASIC SYMBOLS.
		6) THE CHARACTERS OF A TEXT CONSTANT ARE DIRECTLY
		   OUTPUT ON THE BINARY CODE FILE NNNREL.TMP.
		   THE TEXT CONSTANT SYMBOL IS RETURNED TOGETHER WITH
		   THE VALUE  THAT IS THE RELATIVE ADDRESS PLUS LENGTH.
		7) A CHARACTER CONSTANT IS REPLACED BY THE
		   CHARACTER SYMBOL AND THE VALUE, THAT IS THE
		   INTERNAL REPRESENTATION, IS RETURNED.
		8) NUMBERS ARE CONVERTED INTO THE INTERNAL FORMAT
		   AND RETURNED TOGETHER WITH THE
		   CORRESPONDING BASIC SYMBOL.
		9) EACH NEW IDENTIFIER IS ENTERED INTO THE SYMBOL TABLE
		   AND REPLACED BY THE INTERNAL NUMBER. AN IDENTIFIER
		   THAT HAS ALREADY APPEARED IS REPLACED BY THE EXISTING
		   INTERNAL NUMBER. TO DO THIS THE SH, SYMBOL HASH,
		   ROUTINE IS CALLED.
		
	ENTRIES:	LS	NORMAL ENTRY FROM SR
			LSIPAG	ENTRY FROM I1SW

	NORMAL EXIT:	RETURN
	ERROR EXIT:	-
	INPUT ARGUMENTS ARE: X1LBP BYTE POINTER TO THE INPUT BUFFER AND 
			     X1NXT LAST SYNTAX SYMBOL
	OUTPUT ARGUMENTS ARE:   X1NXT NEXT SYNTAX SYMBOL
			        X1CUR PREVIOUS  X1NXT VALUE
				YLSVAL VALUE OF X1NXT SYMBOL IF CHARACTER
				     TEXT,INTEGER OR REAL CONSTANT
				YLSNLS,YLSCLS,YLSLLS VARIABLES FOR LINE NUMBERS
					AND SEMICOLON COUNTERS TO BE USED IN ERROR
					MESSAGES
	CONTENTS:

		LSIS,LSIOSC,LSSEM,LSCHIG,LSCHBL,LSCHNP,LSCHGR,LSXTXT,LSTNXT,
		LSNSM,LSNDL,LSNCO,LSNEXP,LSNSCE,LSNRD AND LSNKEY
		ALL SUBROUTINES USED LOCALLY BY LS
		AND
		LS MAIN PART  A SUBROUTINE CALLED FROM SR
		AND
		LSIPAG A SUBROUTINE CALLED FROM I1SW
	ERRORS GENERATED:
		WARNINGS:SIM034,SIM035,SIM036,SIM037,SIM040,SIM041,SIM042,SIM043,SIM044
		ERRORS:  SIM063,SIM064,SIM065,SIM066,SIM067,SIM070,SIM071,SIM072,
		         SIM073,SIM074,SIM075,SIM076,SIM077,SIM100,SIM101,SIM102,
			 SIM103,SIM104,SIM105

	;
	SALL
	TWOSEG
	RELOC	400000
	MACINIT

IFG QDEBUG,<EXTERN LSTRAC>
	EXTERN	LCLS1
	EXTERN	LCEOF,SH,LC,O1LS1,I1SW,O1IC1,O1RL  	;EXTERNAL ROUTINES
	EXTERN	YELIN1,YELIN2,YESEM,YLSNSD,YLSNPM,YREL  ;EXTERNAL VARIABLES
	EXTERN	YLSVAL,YENDNO,YBEGNO			;EXTERNAL VARIABLES
				edit(144)
	EXTERN	YSFDSW		;[144] -1 when SFD list parsed by SR

	ENTRY	LS		;ENTRY FROM SR
	ENTRY	LSIPAG		;ENTRY FROM I1SW WHEN A TEXT STRING IN A PAGE SWITCH 
				;IS LOCATED IN AN OPTION STATEMENT
	SUBTTL	LOCAL REGISTER, OPDEF'S AND MACRO DEFINITIONS


	;GENERAL ACCUMULATOR ALLOCATION IN MODULE MC1
	X1CN=10
	;ACCUMULATORS USED IN THE NUMBER HANDLING ROUTINES ARE NAMED SPECIALLY IN  
	;ORDER TO FACILITATE THE CONVERSION OF THE CORRESPONDING ALGOL ROUTINES.
	X1RA=X1ID1
	X1RB=X1ID2
	X1RD=X1R3


	OPDEF	RFAI[OUTSTR]
	OPDEF	SCAN[ILDB X1BYTE,X1LBP]
	OPDEF	SCANNO[LDB  X1BYTE,X1LBP]
	DEFINE	SCANLC	<SCAN
		L	X1LEX,Z1CH(X1BYTE) >
	DEFINE	SCANIG	<EXEC	LSCHIG	>
	DEFINE	SCANBL	<EXEC	LSCHBL	>
	DEFINE	RETIBP	<IBP	X1LBP
		RETURN>
	DEFINE	BIFCHA	(FPV,FPL)
		<CAIN	X1BYTE,FPV
		GOTO	FPL>

	DEFINE	BIFNCHA	(FPV,FPL)
		<CAIE	X1BYTE,FPV
		GOTO	FPL>

	DEFINE	BIFLEX	(FPV,FPL)
		<CAIN	X1NXT,FPV
		GOTO	FPL>

	DEFINE	BIFNLEX	(FPV,FPL)
		<CAIE	X1NXT,FPV
		GOTO	FPL>

	;MACROS USED TO GENERATE CALL OF THE ERROR ROUTINES

	DEFINE	MERRO (FTXT)	 <
		IFG	QDEBUG,<
;		OUTSTR	[ASCIZ	%
; FTXT %]
	>
		>

DEFINE MERRT(TP,NO,T,FTXT)
<	EXEC	LSLNSM
.X="X"
.N=-1
IRPC T<.N=.N+1
	IFIDN<T><X>,<STOPI>
	>
.A=ASCII %'T'%
.A=.A-<.X>B<6+.N*7>
	MOVE	X1,X1BYTE
	LSH	X1,7*<4-.N>+1
	IOR	X1,[.A]
	ERRT	Q'TP,<NO+Q1LS.'TP>
	MERRO	<FTXT>
>


DEFINE	MERR	(TP,NO,FTXT)
		<
		EXEC	LSLNSM
		ERR	Q'TP,<NO+Q1LS.'TP>
		MERRO	<FTXT>
			>

DEFINE	MERRI1	(TP,NO,FTXT)
		<
		EXEC	LSLNSM
		ERRI1	Q'TP,<NO+Q1LS.'TP>
		MERRO	<FTXT>
		>
	SUBTTL	LOCAL DECLARATIONS
	;THE Z1CH TABLE HAS ONE ENTRY FOR EACH OF THE 128 POSSIBLE INPUT CHARACTERS.
	;THE FIRST SIX BITS HOLD THE SIXBIT VALUE OF A LETTER OR DIGIT OR
	;			  AN INDEX VALUE FOR ALL OTHER CHARACTERS.
	;THE MIDDLE BITS (6-12) HOLD BIT SWITCHES.
	;AND THE LAST BITS (13-35) GIVE THE ADDRESS OF THE LS ROUTINE THAT
	;			   HANDLES A SYNTACTIC UNIT STARTING WITH
	;			   THIS CHARACTER.

	;BIT AND INDEX DEFINITIONS USED IN Z1CH TABLE

	Z1CHBL=^D24		; BIT 6 LETTER
	Z1CHBD=^D25		; BIT 7 DIGIT
	Z1CHBI=^D26		; BIT 8 INSIDE IDENTIFIER
	Z1CHBE=^D27		; BIT 9 MARKED IN END COMMENT
	Z1CHBT=^D28		; BIT 10 MARKED IN TEXT CONSTANT
	Z1CHBC=^D29		; BIT 11 MARKED IN COMMENT
	Z1CHBS=^D30		; BIT 12 IGNORED ON INPUT OR NONPRINTABLE CHARACTERS

	Z1CHVL=1B<Z1CHBL>+1B<Z1CHBI>
	Z1CHVD=1B<Z1CHBD>+1B<Z1CHBI>	;
	Z1CHVI=1B<Z1CHBI>
	Z1CHVE=1B<Z1CHBE>
	Z1CHVT=1B<Z1CHBT>
	Z1CHVC=1B<Z1CHBC>
	Z1CHVS=1B<Z1CHBS>
	Z1CHVG=Z1CHVE+Z1CHVT+Z1CHVC	;GROUP OF BITS

	Z1CHIR=0		;INDEX REST OF CHAR
	Z1CHIB=1		;INDEX BLANKS
	Z1CHIP=2		;INDEX CHAR .
	Z1CHIA=3		;INDEX CHAR &
	Z1CHIG=4		;INDEX LINE CONTROL(NOT EOT TAB [14] CR )
				; TEST CHAR AND ALL CHAR's THAT ARE NONPRINTABLE
	Z1CHII=5		;INDEX ILLEGAL CHAR
	Z1CHIT=6		;INDEX TAB, [14] CR
	Z1CHIE=7		;INDEX EOT


	;DEFINE THE SWITCHES THAT ARE PRESENT IN Z1CH TABLE
	DSW	(Z1CHSL,Z1CH,6,X1BYTE)
	DSW	(Z1CHSD,Z1CH,7,X1BYTE)
	DSW	(Z1CHSI,Z1CH,8,X1BYTE)
	DSW	(Z1CHSE,Z1CH,9,X1BYTE)
	DSW	(Z1CHST,Z1CH,10,X1BYTE)
	DSW	(Z1CHSC,Z1CH,11,X1BYTE)
	DSW	(Z1CHSS,Z1CH,12,X1BYTE)

	;LOCAL FIELDS


	DF	(Z1CHI,Z1CH,6,5)		;INDEX FIELD



	;CREATE Z1CH TABLE
	DEFINE	CRZ1CH	(MPROUT,MPINDX,MPBITV<0>)
	<
	IFIDN	<MPROUT> <LSF>,
		<XWD	<MPINDX>B23+MPBITV+Z1CHVE+Z1CHVT+Z1CHVC+Z1CHVS,MPROUT>
	IFDIF	<MPROUT> <LSF>,
		<XWD	<MPINDX>B23+MPBITV,MPROUT>
	>

Z1CH:	;ENTRY LABEL 
	CRZ1CH	LSNU,Z1CHIB,Z1CHVS	;  0 NULL IGNORED ON INPUT
	CRZ1CH	LSF,Z1CHIG		;  1 ^A
	CRZ1CH	LSF,Z1CHIG		;  2 ^B
	CRZ1CH	LSF,Z1CHIG		;  3 ^C
	CRZ1CH	LSE,Z1CHIE,Z1CHVG	;  4 ^D EOT
	CRZ1CH	LSF,Z1CHIG		;  5 ^E WRU
	CRZ1CH	LSF,Z1CHIG		;  6 ^F
	CRZ1CH	LSF,Z1CHIG		;  7 ^G
	CRZ1CH	LSF,Z1CHIG		; 10 ^H BACKSPACE
	CRZ1CH	LSB,Z1CHIT,Z1CHVT	; 11 ^I TAB
	CRZ1CH	LSL,Z1CHIG,Z1CHVG	; 12 ^J LINE FEED
	CRZ1CH	LSL,Z1CHIG,Z1CHVG	; 13 ^K VERT TAB
	CRZ1CH	LSL,Z1CHIG,Z1CHVG	; 14 ^L FORM FEED
					edit(14)
	CRZ1CH	LSB,Z1CHIT,Z1CHVT	; 15 ^M CARRIAGE RETURN	;[14]
	CRZ1CH	LSF,Z1CHIG		; 16 ^N
	CRZ1CH	LSF,Z1CHIG		; 17 ^O
	CRZ1CH	LSF,Z1CHIG		; 20 ^P
	CRZ1CH	LSF,Z1CHIG		; 21 ^Q XON
	CRZ1CH	LSF,Z1CHIG		; 22 ^R TAPE
	CRZ1CH	LSF,Z1CHIG		; 23 ^S XOFF
	CRZ1CH	LSF,Z1CHIG		; 24 ^T NOTAPE
	CRZ1CH	LSF,Z1CHIG		; 25 ^U
	CRZ1CH	LSF,Z1CHIG		; 26 ^V
	CRZ1CH	LSF,Z1CHIG		; 27 ^W
	CRZ1CH	LSF,Z1CHIG		; 30 ^X
	CRZ1CH	LSF,Z1CHIG		; 31 ^Y
	CRZ1CH	LSF,Z1CHIG		; 32 ^Z
	CRZ1CH	LSF,Z1CHIG		; 33 ^LBRAC ESC
	CRZ1CH	LSF,Z1CHIG		; 34 ^SLASH
	CRZ1CH	LSF,Z1CHIG		; 35 ^RBRAC 
	IFN	QDEBUG<
	CRZ1CH	LST,Z1CHIG,Z1CHVG	; 36 ^^ USED FOR TESTING
		    >
	IFE	QDEBUG<
	CRZ1CH	LSF,Z1CHIG		; 36 ^^ PRODUCTION ENTRY
		    >
	CRZ1CH	LSF,Z1CHIG		; 37 ^LEFT ARROW
	CRZ1CH	LSB,Z1CHIB		; 40 SPACE
	CRZ1CH	LSK,Z1CHIR		; 41 !
	CRZ1CH	LSX,Z1CHIR,Z1CHVT	; 42 "
	CRZ1CH	LSI,'#',Z1CHVL		; 43 #
	CRZ1CH	LSI,'$',Z1CHVL		; 44 $
	CRZ1CH	LSFP,Z1CHII		; 45 %
	CRZ1CH	LSNPR,Z1CHIA		; 46 &
	CRZ1CH	LSC,Z1CHIR,Z1CHVT	; 47 '
	CRZ1CH	LSDC,Z1CHIR,Z1CHVE	; 50 (
	CRZ1CH	LSDD,Z1CHIR		; 51 )
	CRZ1CH	LSDS,Z1CHIR		; 52 *
	CRZ1CH	LSDG,Z1CHIR		; 53 +
	CRZ1CH	LSDA,Z1CHIR		; 54 ,
	CRZ1CH	LSDH,Z1CHIR		; 55 -
	CRZ1CH	LSDK,Z1CHIP		; 56 .
	CRZ1CH	LSDR,Z1CHIR		; 57 /
	CRZ1CH	LSN,'0',Z1CHVD		; 60 0
	CRZ1CH	LSN,'1',Z1CHVD		; 61 1
	CRZ1CH	LSN,'2',Z1CHVD		; 62 2
	CRZ1CH	LSN,'3',Z1CHVD		; 63 3
	CRZ1CH	LSN,'4',Z1CHVD		; 64 4
	CRZ1CH	LSN,'5',Z1CHVD		; 65 5
	CRZ1CH	LSN,'6',Z1CHVD		; 66 6
	CRZ1CH	LSN,'7',Z1CHVD		; 67 7
	CRZ1CH	LSN,'8',Z1CHVD		; 70 8
	CRZ1CH	LSN,'9',Z1CHVD		; 71 9
	CRZ1CH	LSDM,Z1CHIR,Z1CHVE	; 72 :
	CRZ1CH	LSDB,Z1CHIR,Z1CHVG	; 73 ; 
	CRZ1CH	LSDN,Z1CHIR		; 74 LESS THAN
	CRZ1CH	LSDL,Z1CHIR		; 75 =
	CRZ1CH	LSDO,Z1CHIR		; 76 GREATER THAN
	CRZ1CH	LSFP,Z1CHII		; 77 ?
	CRZ1CH	LSI,'@',Z1CHVL		;100 @
	CRZ1CH	LSI,'A',Z1CHVL		;101 A
	CRZ1CH	LSI,'B',Z1CHVL		;102 B
	CRZ1CH	LSI,'C',Z1CHVL		;103 C
	CRZ1CH	LSI,'D',Z1CHVL		;104 D
	CRZ1CH	LSI,'E',Z1CHVL		;105 E
	CRZ1CH	LSI,'F',Z1CHVL		;106 F
	CRZ1CH	LSI,'G',Z1CHVL		;107 G
	CRZ1CH	LSI,'H',Z1CHVL		;110 H
	CRZ1CH	LSI,'I',Z1CHVL		;111 I
	CRZ1CH	LSI,'J',Z1CHVL		;112 J
	CRZ1CH	LSI,'K',Z1CHVL		;113 K
	CRZ1CH	LSI,'L',Z1CHVL		;114 L
	CRZ1CH	LSI,'M',Z1CHVL		;115 M
	CRZ1CH	LSI,'N',Z1CHVL		;116 N
	CRZ1CH	LSI,'O',Z1CHVL		;117 O
	CRZ1CH	LSI,'P',Z1CHVL		;120 P
	CRZ1CH	LSI,'Q',Z1CHVL		;121 Q
	CRZ1CH	LSI,'R',Z1CHVL		;122 R
	CRZ1CH	LSI,'S',Z1CHVL		;123 S
	CRZ1CH	LSI,'T',Z1CHVL		;124 T
	CRZ1CH	LSI,'U',Z1CHVL		;125 U
	CRZ1CH	LSI,'V',Z1CHVL		;126 V
	CRZ1CH	LSI,'W',Z1CHVL		;127 W
	CRZ1CH	LSI,'X',Z1CHVL		;130 X
	CRZ1CH	LSI,'Y',Z1CHVL		;131 Y
	CRZ1CH	LSI,'Z',Z1CHVL		;132 Z
	CRZ1CH	LSDE,Z1CHIR		;133 LBRAC
	CRZ1CH	LSDP,Z1CHIR		;134 \
	CRZ1CH	LSDF,Z1CHIR		;135 RBRAC
	CRZ1CH	LSDI,Z1CHIR		;136 ^
	CRZ1CH	LSFP,'_',Z1CHVI		;137 UNDERLINE 
 	CRZ1CH	LSI,'@',Z1CHVL		;140 LOW @
	CRZ1CH	LSI,'A',Z1CHVL		;141 LOW A
	CRZ1CH	LSI,'B',Z1CHVL		;142 LOW B
	CRZ1CH	LSI,'C',Z1CHVL		;143 LOW C
	CRZ1CH	LSI,'D',Z1CHVL		;144 LOW D
	CRZ1CH	LSI,'E',Z1CHVL		;145 LOW E
	CRZ1CH	LSI,'F',Z1CHVL		;146 LOW F
	CRZ1CH	LSI,'G',Z1CHVL		;147 LOW G
	CRZ1CH	LSI,'H',Z1CHVL		;150 LOW H
	CRZ1CH	LSI,'I',Z1CHVL		;151 LOW I
	CRZ1CH	LSI,'J',Z1CHVL		;152 LOW J
	CRZ1CH	LSI,'K',Z1CHVL		;153 LOW K
	CRZ1CH	LSI,'L',Z1CHVL		;154 LOW L
	CRZ1CH	LSI,'M',Z1CHVL		;155 LOW M
	CRZ1CH	LSI,'N',Z1CHVL		;156 LOW N
	CRZ1CH	LSI,'O',Z1CHVL		;157 LOW O
	CRZ1CH	LSI,'P',Z1CHVL		;160 LOW P
	CRZ1CH	LSI,'Q',Z1CHVL		;161 LOW Q
	CRZ1CH	LSI,'R',Z1CHVL		;162 LOW R
	CRZ1CH	LSI,'S',Z1CHVL		;163 LOW S
	CRZ1CH	LSI,'T',Z1CHVL		;164 LOW T
	CRZ1CH	LSI,'U',Z1CHVL		;165 LOW U
	CRZ1CH	LSI,'V',Z1CHVL		;166 LOW V
	CRZ1CH	LSI,'W',Z1CHVL		;167 LOW W
	CRZ1CH	LSI,'X',Z1CHVL		;170 LOW X
	CRZ1CH	LSI,'Y',Z1CHVL		;171 LOW Y
	CRZ1CH	LSI,'Z',Z1CHVL		;172 LOW Z
	CRZ1CH	LSI,'#',Z1CHVL		;173 LOW #
	CRZ1CH	LSFP,Z1CHII		;174 VERTICAL BAR 
	CRZ1CH	LSI,'$',Z1CHVL		;175 LOW $
	CRZ1CH	LSFP,Z1CHII		;176 NOT
	CRZ1CH	LSNU,Z1CHIB,Z1CHVS	;177 DELETE IGNORE ON INPUT


	;GENERATE RESERVED WORD TABLE WITH SYNTAX SYMBOLS AND SWITCHES
	;
	;RESWORD MACRO DEFINED IN SIMMAC
	;GENERATE Z1RW



	DEFINE	RESW$	(A,B,C<0>)<
		IFB<B>  <XWD	C,%'A>
		IFNB<B> <XWD	C,%'B>

	>

Z1RW:	RESWORD
	DSW	(Z1RWSE,0,0,X1R0)	;RESERVED WORD THAT IS RECOGNIZED IN AN END
					; COMMENT
	DSW	(Z1RWSM,0,1,X1R0)	;RESERVED WORD THAT IS RECOGNIZED IN LS



	DF	(Z1RWKL,<Z1RW>,18,35)
;ASSEMBLY TIME CONSTANTS



QLRESW=QLOWID-1		;LAST RESERVED WORD IN DICTIONARY (INDEX)

QLSRT2="B"B24		;BEGIN RECORD CONSTANT LS1
QLSRT3="E"B24		;END RECORD CONSTANT LS1

QTEXTQ=42		;ASCII CONSTANT
QSEM=73			;SEMICOLON
QTAB=11
QTST=36
IFNDEF Q1LS.W	<Q1LS.W=0	>
IFNDEF	Q1LS.E	<Q1LS.E=0	>




LSNFT:	;FLOATING NUMBERS
	XWD	000000,0	;0
	XWD	201400,0	;1
	XWD	202400,0	;2
	XWD	202600,0	;3
	XWD	203400,0	;4
	XWD	203500,0	;5
	XWD	203600,0	;6
	XWD	203700,0	;7
	XWD	204400,0	;8
	XWD	204440,0	;9

	IFN	QKA10,<;THESE NUMBERS ARE DEPENDENT ON THE DOUBLE FLOATING POINT 
			;INSTRUCTIONS IN KI10

>
LSNHTEN:	;FLOATING POINT SCALE FACTORS ,HIGH ORDER WORDS
	XWD	201400,000000	;1.0
	XWD	204500,000000	;1.0&&1
	XWD	207620,000000	;1.0&&2
	XWD	212764,000000	;1.0&&3
	XWD	216470,400000	;1.0&&4
	XWD	221606,500000	;1.0&&5
	XWD	224750,220000	;1.0&&6
	XWD	230461,132000	;1.0&&7
	XWD	233575,360400	;1.0&&8
	XWD	236734,654500	;1.0&&9
	XWD	242452,013710	;1.0&&10
	XWD	245564,416672	;1.0&&11
	XWD	250721,522450	;1.0&&12
	XWD	254443,023471	;1.0&&13
	XWD	257553,630407	;1.0&&14
	XWD	262706,576511	;1.0&&15
	XWD	266434,157115	;1.0&&16
	XWD	271543,212741	;1.0&&17
	XWD	274674,055531	;1.0&&18
	XWD	300425,434430	;1.0&&19
	XWD	303532,743536	;1.0&&20
	XWD	306661,534465	;1.0&&21
	XWD	312417,031701	;1.0&&22
	XWD	315522,640261	;1.0&&23
	XWD	320647,410336	;1.0&&24
	XWD	324410,545213	;1.0&&25
	XWD	327512,676455	;1.0&&26
	XWD	332635,456171	;1.0&&27
	XWD	336402,374713	;1.0&&28
	XWD	341503,074076	;1.0&&29
	XWD	344623,713116	;1.0&&30
	XWD	347770,675742	;1.0&&31
	XWD	353473,426555	;1.0&&32
	XWD	356612,334310	;1.0&&33
	XWD	361755,023372	;1.0&&34
	XWD	365464,114134	;1.0&&35
	XWD	370601,137163	;1.0&&36
	XWD	373741,367020	;1.0&&37
	XWD	377454,732312	;1.0&&38

	IFN	QKA10,<;THESE NUMBERS ARE DEPENDENT ON THE DOUBLE FLOATING POINT
			;INSTRUCTIONS IN KI10

>
;***AUBEG
;	INSERT LOW ORDER WORDS FOR KA10
IFN	QKA10,<
LSNLTEN:	;FLOATING POINT SCALE FACTORS ,LOW ORDER WORDS FOR KA10
	XWD	000000,000000	;1.0
	XWD	000000,000000	;1.0&&1
	XWD	000000,000000	;1.0&&2
	XWD	000000,000000	;1.0&&3
	XWD	000000,000000	;1.0&&4
	XWD	000000,000000	;1.0&&5
	XWD	000000,000000	;1.0&&6
	XWD	000000,000000	;1.0&&7
	XWD	000000,000000	;1.0&&8
	XWD	000000,000000	;1.0&&9
	XWD	000000,000000	;1.0&&10
	XWD	000000,000000	;1.0&&11
	XWD	215400,000000	;1.0&&12
	XWD	221240,000000	;1.0&&13
	XWD	224510,000000	;1.0&&14
	XWD	227432,000000	;1.0&&15
	XWD	233760,200000	;1.0&&16
	XWD	236354,240000	;1.0&&17
	XWD	241647,310000	;1.0&&18
	XWD	245110,475000	;1.0&&19
	XWD	250132,614200	;1.0&&20
	XWD	253561,357240	;1.0&&21
	XWD	257446,725444	;1.0&&22
	XWD	262760,512755	;1.0&&23
	XWD	265354,635550	;1.0&&24
	XWD	271024,002441	;1.0&&25
	XWD	274631,003151	;1.0&&26
	XWD	277177,204004	;1.0&&27
	XWD	304617,422402	;1.0&&28
	XWD	306563,327103	;1.0&&29
	XWD	311320,214724	;1.0&&30
	XWD	314004,260111	;1.0&&31
	XWD	320202,556055	;1.0&&32
	XWD	323443,311471	;1.0&&33
	XWD	326554,174007	;1.0&&34
	XWD	332543,515404	;1.0&&35
	XWD	335674,440705	;1.0&&36
	XWD	340653,551067	;1.0&&37
	XWD	344413,241542	;1.0&&38
>
	IFN QKI10,<
;***AUEND
LSNLTEN:	;FLOATING POINT SCALE FACTORS ,LOW ORDER WORDS
	XWD	000000,000000	;1.0
	XWD	000000,000000	;1.0&&1
	XWD	000000,000000	;1.0&&2
	XWD	000000,000000	;1.0&&3
	XWD	000000,000000	;1.0&&4
	XWD	000000,000000	;1.0&&5
	XWD	000000,000000	;1.0&&6
	XWD	000000,000000	;1.0&&7
	XWD	000000,000000	;1.0&&8
	XWD	000000,000000	;1.0&&9
	XWD	000000,000000	;1.0&&10
	XWD	000000,000000	;1.0&&11
	XWD	200000,000000	;1.0&&12
	XWD	120000,000000	;1.0&&13
	XWD	244000,00000	;1.0&&14
	XWD	215000,000000	;1.0&&15
	XWD	370100,000000	;1.0&&16
	XWD	166120,000000	;1.0&&17
	XWD	323544,000000	;1.0&&18
	XWD	044236,400000	;1.0&&19
	XWD	055306,100000	;1.0&&20
	XWD	270567,520000	;1.0&&21
	XWD	223352,622000	;1.0&&22
	XWD	370245,366400	;1.0&&23
	XWD	166316,664100	;1.0&&24
	XWD	012001,220450	;1.0&&25
	XWD	314401,464562	;1.0&&26
	XWD	077502,001717	;1.0&&27
	XWD	307611,201141	;1.0&&28
	XWD	271553,441371	;1.0&&29
	XWD	150106,351670	;1.0&&30
	XWD	002130,044246	;1.0&&31
	XWD	101267,026547	;1.0&&32
	XWD	221544,634301	;1.0&&33
	XWD	266076,003362	;1.0&&34
	XWD	261646,602127	;1.0&&35
	XWD	336220,342555	;1.0&&36
	XWD	325664,433310	;1.0&&37
	XWD	205520,661075	;1.0&&38
;***AUBEG
;	CLOSE KI10 CONDITIONAL
>
;***UWOEND
	
	SUBTTL	SUBROUTINES


	
LSSEM:	PROC
				;UPDATE SEMICOLON COUNTER (WITHIN LINE)
	LF	(X1R0)  YLSNSEM
	AOJ	X1R0,
	SF	(X1R0)  YLSNSEM	
	RETURN
	EPROC
	




LSCHIG:PROC
		;SCAN PAST ALL CHARACTERS THAT ARE TO BE IGNORED
		;AND GIVE ERROR MESSAGES FOR ALL ILLEGAL CHARACTERS.
	LOOP	SCAN
	AS	IFOFF	Z1CHSS
		RET			;ORDINARY CHAR
		EXEC	LSCHNP		;HANDLE NONPRINTABLE CHAR.
					;IGNORE CHAR.
		GOTO	TRUE
	SA
	EPROC



LSCHBL:	PROC
		;SCAN TO NEXT NONBLANK CHARACTER
	LOOP	SCAN
LSCHBE:		;ENTRY IF TEST BEFORE SCAN NEEDED
	AS	BIFCHA	" ",TRUE
		IFOFF	Z1CHSS
		RET			;NONBLANK CHARACTER FOUND
		EXEC	LSCHNP		;HANDLE NONPRINTABLE CHAR.
					;IGNORE CHAR
		GOTO	TRUE
	SA
	EPROC

LSCHNP:	PROC
		;CREATE ERROR IF NONPRINTABLE CHAR.

	IFOFF	Z1CHSE
	RETURN

LSCHN1:		;ENTRY IF NO TEST NEEDED

	STACK	X1
	MERR	E,1,<NONPRINTABLE CHAR.>
	UNSTK	X1
	RETURN

	EPROC
LSIS:	PROC
	COMMENT;
	PURPOSES:FIND END OF IDENTIFIER.
		IF YSFDSW is zero, CALL SH TO FIND KEYWORD OR
		IDENTIFIER IN THE DICTIONARY.
	ENTRY: LSIS
	INPUT ARGUMENTS: X1LBP POINTS AT FIRST LETTER IN IDENTIFIER
			  SWITCH YZSE IS ON WHEN NO ADDITION IS TO BE
			  MADE  IN SH TO THE DICTIONARY.
	NORMAL EXITS:	RETURN WHEN USER IDENTIFIER
		        SKIP RETURN WHEN KEYWORD FOUND
	OUTPUT ARGUMENTS: X1LBP POINTS AT FIRST CHARACTER THAT IS NOT
			   PART OF IDENTIFIER
			  X1NXT CONTAINS VALUE SET BY SH WHICH IS BASIC
			  SYMBOL IF KEYWORD OTHERWISE THE INTERNAL IDENTIFIER NUMBER
			[144] If SH was not called, X1ID1-X1ID2 contain SIXBIT id.
	USED SUBROUTINES:SH SYMBOL HASH EXTERNAL ROUTINE AND
				   LSCHIG AND LSCHNP LS ROUTINES
	;
	L	X1LEX,Z1CH(X1BYTE)		;LOAD SIXBIT VALUE+SWITCHES
	LI	X1R1,6
	LOOP	LSHC	X1ID2,6		;SHIFT SIXBIT CODE FROM X1LEX REGISTER
L3():!			SCANLC		;NEXT CHARACTER
		IFOFFA	Z1CHSI
		 GOTO	L1		;TEST IF END OF IDENTIFIER
	
	AS

		DECR	X1R1,TRUE		
	SA
	L	X1ID1,X1ID2			;FIRST PART OF IDENTIFIER
	LI	X1R1,6
	LOOP	LSHC	X1ID2,6
L4():!			SCANLC
		IFOFFA	Z1CHSI
		 GOTO	L2
	AS
		DECR	X1R1,TRUE
	SA

;MORE THAN 12 LETTERS IN IDENTIFIER
;ALL STATEMENTS USED TO PRODUCE ERROR MESSAGE IDENTIFIER LONGER THAN 12 CHAR. REMOVED
; TWO ; PLACED BEFORE THESE STATEMENTS
;;	SETONA	YLSID		;INDICATE POSSIBLE ERROR
	LOOP	SCANIG		;SCAN TO END OF IDENTIFIER
	AS	IFON	Z1CHSI
		GOTO TRUE
	SA			;END FOUND
;;	EXEC	SH
;;	IF	IFOFFA	YLSID
;;		GOTO	FALSE	;IDENTIFIER NOT ADDED TO DICTIONARY
;;	THEN
;;		SETOFA	YLSID
;;		L	X1R1,X1NXT
;;				;FETCH IDENTIFIER NUMBER
;;		MERRI1	W,0,<IDENTIFIER TOO LONG>
;;	FI
;;	GOTO	L5		;RETURN FROM LSIS
	GOTO	LSIS1		;TO BE REMOVED IF ;; REMOVED

L1():!	IF
		IFOFFA	Z1CHSS
		GOTO	TRUE+1
		SCANNO	
		EXEC	LSCHNP
		GOTO	L3		;CONTINUE
	THEN	;END OF IDENTIFIER FOUND
		LSH	X1ID2,6
		DECR	X1R1,.-1
		L	X1ID1,X1ID2
		LI	X1ID2,0

	FI

LSIS1:		;IDENTIFIER IN X1ID1,X1ID2
	SCANNO
				edit(144)
	LI	X1NXT,2000	;[144] Identifier code indicated
	SKIPE	YSFDSW		;[144] No hash if SFD id
	 RET			;[144]
	EXEC	SH			;FIND IDENTIFIER IN DICTIONARY
L5():!	IF	CAILE	X1NXT,QLRESW
		RET				;IDENTIFIER IN DICTIONARY
		JUMPE	X1NXT,FALSE		;NEW IDENTIFIER OR OVERFLOW
	THEN					;KEYWORD
		ASSERT	<IF	CAIL	X1NXT,QLRESW-QNRESW+1
				GOTO	FALSE		;OK RESERVED WORD
			THEN	RFAIL	<LSI ERR  NOT RESERVED WORD>
			FI>
		AOS	,(XPDP)		;SKIP RETURN WHEN RESERVED WORD
	FI
	RET			;EXIT LSIS

L2():	IF	IFOFFA	Z1CHSS
		GOTO	TRUE+1
		SCANNO
		EXEC	LSCHNP		;HANDLE NONPRINTABLE CHAR.
		GOTO	L4		;CONTINUE
	THEN	; END OF IDENTIFIER
		LSH	X1ID2,6
		DECR	X1R1,.-1
		GOTO	LSIS1
	FI
	
	EPROC

LSIPAG:	PROC
	COMMENT;
	PURPOSE:SCAN THE PAGE SWITCH TEXT STRING IN AN OPTIONS STATEMENT.
	ENTRY:ENTRY FROM I1SW WHEN A PAGE SWITCH WITH TEXT STRING IS FOUND
	INPUT ARGUMENTS:X1R3 POINTS TO CURRENT CHARACTER WHICH MUST BE A :
	NORMAL EXITS:SKIP RETURN TO LSI OPTIONS ROUTINE WHICH IS ALWAYS 
					THE ROUTINE THAT CALLED I1SW.
		ERROR EXITS:RETURN TO LSI 
	OUTPUT ARGUMENTS:X1R3 POINTS AT CHARACTER FOLLOWING " OR
					AT EOF OR FIRST CHARACTER ON
					NEW LINE OR CHARACTER FOLLOWING :
	CALL FORMAT: BRANCH LSIPAG
	USED SUBROUTINES:LSXTXT AND LSCHIG
	;

	ST	X1R3,X1LBP		;RESTORE REGISTER FOR LS 
	SCANIG				;SCAN PAST : CHAR
	BIFNCH	QTEXTQ,L1			
	LI	X1NXT,%OPT
	HRROI	X1ID1,-^D60		;MAX 60 CHARACTERS
	EXEC	LSXTXT			;SCAN STRING
	IF	JUMPLE	X1ID1,FALSE	;LENGTH OK
	THEN	MERR	W,5,<PAGE STRING LONGER THAN 60 CHARACTERS>
		HRROI	X1ID1,-^D136	;SCAN NOT MORE THAN ONE LINE
		SETZ	X1NXT,		;INDICATE PAGE STRING OVERFLOW ENTRY
		EXEC	LSXTXT
					;SCAN TO NEXT " OR EOF OR END OF LINE
	L2():	;ENTRY AFTER ERROR
		LI	X1NXT,%OPT
		ST	X1LBP,X1R3
		RETURN		;RETURN IF ERROR FOUND
	FI
	SETONA	YLSENW		;RESET SWITCH FOUND SWITCH
	ST	X1LBP,X1R3	;RESTORE REGISTER FOR I1SW
	UNSTK	X1R1
	BRANCH	1(X1R1)		;RETURN IF NO ERROR
L1():	MERR	W,4,<PAGE STRING MISSING AFTER : IN OPTIONS>
	GOTO	L2
	EPROC


LSIOSC:	PROC
	;SCAN CHARACTERS IN OPTIONS STATEMENT
	;EXIT TO RETURN ADDRESS+2 IF / FOUND
	;EXIT TO RETURN ADDRESS+1 IF ; FOUND
	;EXIT TO RETURN ADDRESS   FOR REMAINING CHARACTERS
	;IF EOF FOUND BRANCH TO LSLOP
	;HANDLE AND SCAN PAST BLANKS,ILLEGAL CHAR.,TAB,END OF LINE CHARACTERS 
	; AND TEST CHAR.

LSIOS1:	;ENTRY IF SCAN BEFORE TEST
L8():	SCANBL
LSIOS2:	;ENTRY IF NO SCAN BEFORE TEST
	IFON	Z1CHSI
	RETURN			;RETURN IF LETTER ,DIGIT OR _
	LF	(X1R1) Z1CHI(X1BYTE)
	GOTO	@LSIT1(X1R1)	;TO RELEVANT ROUTINE
LSIT1:	;BRANCH TABLE FOR OPTIONS STATEMENT
	L4			;REST OF CHAR.
	L8			;BLANK
	L4			; .
	L4			; &
	L5			;TEST PLUS LINE CONTROL CHAR.
	L6			;ILLEGAL CHAR.
	L8			;TAB, [14] AND CR
	L7			;EOF

L6():	MERRT	E,2,<  X  >,<ILLEGAL PRINTABLE CHAR.>
	GOTO	L8

L7():	;EOF FOUND
	MERR	W,10,<END OF FILE IN OPTIONS STMT>
	UNSTK	X1R0
	BRANCH	LSLOP		;HANDLE EOF

L5():	EXEC	LSCHGR		;HANDLE TEST OR LINE CONTROL CHAR
	GOTO	L8

L4():	UNSTK	X1R1		;PREPARE RETURN
	BIFCHA	"/",<2(X1R1)>	;RETURN IF /
	BIFCHA	QSEM,L9
	BRANCH	0(X1R1)		;RETURN IF OTHER CHARACTER
L9():	EXEC	LSSEM		;UPDATE SEMICOLON COUNTER
	BRANCH	1(X1R1)		;RETURN IF ;

	EPROC
LSCHGR:	PROC
	;HANDLE SPECIAL CHARACTERS
	;TEST,FF,CR,LF,VT,
	;AND NONPRINTABLE CHARACTERS

	IFN	QDEBUG<		;ONLY IF TEST VERSION
	IF	BIFNCHA	QTST,FALSE
	THEN		;TEST CHARACTER
		EXEC	LSTPRO		;TREAT TEST CHARACTERS
		RET
	FI	>

	IF	IFOFF	Z1CHSS
		GOTO	FALSE		;MUST BE LINE CONTROL CHAR.
	THEN
		EXEC	LSCHN1		;NONPRINTABLE CHAR.
		RET
	FI

	EXEC	LC		;HANDLE END OF LINE
	ZF	YLSNSEM		;Clear SEMICOLON COUNTER

	RET

	EPROC				



	
LSLNSM:	PROC
		;PREPARE LINE AND SEMICOLON NUMBERS FOR ERROR ROUTINE
	LF	X0,YLSNSEM
	ST	X0,YESEM

	LF	X0,YLSNLIN
	ST	X0,YELIN1
	ST	X0,YELIN2
	RETURN

	EPROC
LSNDL:	PROC
	;NUMBER ROUTINE
	;CHECK THAT DECIMAL POINT WAS NOT LAST NONBLANK CHARACTER IN NUMBER
	IF	SKIPN	,YLSNPM
		GOTO 	FALSE		;DECIMAL POINT NOT PRESENT
		CAME	X1RD,YLSNPM
		GOTO 	FALSE		;DIGIT AFTER DEC.POINT
	THEN	MERR	E,14,<DIGIT MISSING AFTER DECIMAL POINT>
	FI 	RETURN
	EPROC

LSNCO:	PROC
	;NUMBER ROUTINE PROCEDURE
	;CONVERT FROM INTEGER TO DOUBLE FLOATING NUMBER
	IFN	QKA10,<;ROUTINE DEPENDENT ON DOUBLE FLOATING INSTRUCTIONS
>
	IF	IFONA	YLSNUM
		GOTO	FALSE		;ALREADY CONVERTED
	THEN	SETONA	YLSNUM		;INDICATE CONVERSION DONE
;***AUBEG
;	PLACE KI10 CODE UNDER CONDITIONAL
IFN	QKI10,<
;***AUEND
		SETZ	X1RB,
		LSHC	X1RA,-^D9	;SHIFT
		LSH	X1RB,-^D1	;SHIFT
		TLO	X1RA,(244B8) 	;OR IN AN EXPONENT TO LEFT PART
		DFAD	X1RA,[EXP	0,0]	;NORMALIZE NUMBER
;***AUBEG
;	CLOSE KI10 CONDITIONAL
;	INSERT	KA10 CONDITIONAL
>
IFN QKA10,<
		HLRE	X1RB,X1RA	; GET HIGH PART OF INTEGER
		HLL	X1RA,X1RB	; EXTEND SIGN ON LOW PART
		SKIPE	X1RA
		FSC	X1RA,233
		FSC	X1RB,255
		FADL	X1RA,X1RB
>
;***AUEND
		SETOFA	YLSENW		;SET FLAG TO INDICATE NO OVERFLOW
					; IN FLOATING NUMBER
	FI	RETURN
	EPROC

LSNEXP:	PROC
	COMMENT /
	PURPOSE:
			NUMBER ROUTINE PROCEDURE
			SCAN EXPONENT
	INPUT ARGUMENTS:YLSNPM DECIMAL POINT MARKER
			X1RD DECIMAL POINT COUNTER
			YLSNSD NUMBER OF DIGITS AFTER OVERFLOW
	OUTPUT ARGUMENTS:X1RD AND YLSNSD
	/
	SKIPE	,YLSNPM
	SUBM	X1RD,YLSNPM		;CALCULATE DECIMAL POINT SCALING
					;IF ANY
	IFOFFA	YLSENW
	GOTO	.+3			;NO OVERFLOW OF FLOATING NUMBER
	L	X1RD,YLSNSD		;FETCH NUMBER OF DIGITS AFTER OVERFLOW
	ADDM	X1RD,YLSNPM		;CORRECT SCALING
	SETZB	X1RD,YLSNSD		;ZERO TO EXPONENT AND SIGN
	SETOFA	YLSENW			;INDICATE NO DIGIT FOUND IN EXPONENT
	BIFCHA	"+",L1			;; FOUND
	BIFNCHA	"-",L2			;MUST BE DIGIT
	SETOM	YLSNSD			;SAVE MINUS SIGN
L1():!	SCANBL				;SCAN PAST ANY BLANKS
L2():!	IF	IFOFF	Z1CHSD
		GOTO	FALSE		;END OF NUMBER
	THEN	;DIGIT FOUND
	SETONA	YLSENW			;INDICATE DIGIT FOUND IN EXPONENT
		IMULI	X1RD,^D10
		ADDI	X1RD,-"0"(X1BYTE)	;ADD NEW DECIMAL VALUE
		GOTO	L1		;NEXT CHARACTER IN EXPONENT
	FI	;END OF EXPONENT
	IF	IFONA	YLSENW
		GOTO	FALSE		
	THEN				;NO DIGITS IN EXPONENT
		MERR	E,15,<NO DIGITS IN EXPONENT>
	FI
	SKIPE	,YLSNSD
	MOVN	X1RD,X1RD		;NEGATE EXPONENT IF SIGN WAS MINUS
	ADD	X1RD,YLSNPM		;ADD IN EXPONENT TO DECIMAL POINT COUNTER
	RETURN
	EPROC
LSNSCE:	PROC
	COMMENT /
	PURPOSE:
		;NUMBER ROUTINE
		;SCALE NUMBER ACCORDING TO DECIMAL POINT AND EXPONENT VALUE
	INPUT ARGUMENTS: X1RD SCALE FACTOR
			X1RA,X1RB DOUBLE FLOATING NUMBER
	OUTPUT ARGUMENTS:X1RA,X1RB DOUBLE FLOATING NUMBER
	/

	IFN	QKA10,<;ROUTINE DEPENDENT ON DOUBLE FLOATING INSTRUCTIONS
>

	JUMPE	X1RA,L1			;NUMBER IS 0
	JUMPE	X1RD,L1			;SCALE VALUE IS 0
	JFCL	17,.+1
	ST	X1RD,YLSNSD		;SAVE SCALE VALUE
	MOVM	X1RD,X1RD		;DELETE SIGN
	L	X1R0,LSNHTEN+^D38
	L	X1R1,LSNLTEN+^D38	;FILL IN MAX SCALE FACTORS
LOOP	IF	CAIL	X1RD,^D38
		GOTO	FALSE		;USE SCALE 38
	THEN	L	X1R0,LSNHTEN(X1RD)
		L	X1R1,LSNLTEN(X1RD)	;FILL IN SCALE FACTORS
	FI
	IF	SKIPG	,YLSNSD
		GOTO	FALSE		;DIVIDE
	THEN
;***AUBEG
;	PLACE KI10 CODE UNDER CONDITIONAL
;	KA10 CODE BECOMES MACRO CALL
IFN	QKI10,< DFMP	X1RA,X1R0	>;MULTIPLY WITH SCALE FACTOR
IFN	QKA10,< .DFMP	X1RA,X1R0	>;          -"-
;***AUEND
		JFOV	L2		;FLOATING OVERFLOW?
	ELSE
;***AUBEG
;	PLACE KI10 CODE UNDER CONDITIONAL
;	KA10 CODE INSERTED (MACRO CALL)
IFN	QKI10,< DFDV	X1RA,X1R0	>;DIVIDE WITH SCALE FACTOR
IFN	QKA10,< .DFDV	X1RA,X1R0	>;          -"-
;***AUEND
		JFOV	L3		;FLOATING UNDERFLOW?
	FI
AS
	SUBI	X1RD,^D38
	JUMPG	X1RD,TRUE		;SCALE VALUE NOT YET USED
L1():!	RETURN
SA
L2():!	;FLOATING OVERFLOW USE MAX NUMBER
;***AUBEG
;	KI10 FLOATING POINT NUMBER UNDER CONDITIONAL
IFN	QKI10,<
;***AUEND
	LD	X1RA,[	XWD	377777,777777
			XWD	377777,777777]
;***AUBEG
;	CLOSE KI10 CONDITIONAL
;	USE KA10 FLOATING POINT FORMAT
;	PARENTHESISE LITERAL FOR KA10
>
IFN	QKA10,<
	LD	X1RA,<[XWD	377777,777777
		       XWD	344777,777777]>
>
;***AUEND
	MERR	E,16,<FLOATING OVERFLOW>
	GOTO	L1

L3():!	;FLOATING UNDERFLOW, USE ZERO
	SETZB	X1RA,X1RB
	MERR	E,17,<FLOATING UNDERFLOW>
	GOTO	L1
	EPROC
LSNRDD:	PROC	
	COMMENT /
	PURPOSE:
		;NUMBER ROUTINE PROCEDURE
		;PROCEDURE USED  WHILE SCANNING RADIX INTEGER NUMBER
	ENTRIES:LSNRDD,LSNRDN AND LSNRDS
	INPUT ARGUMENTS: X1RA INTEGER VALUE ,CURRENT 
			X1LBP INPUT CHAR. POINTER IF ENTRY LSNRDD
			X1BYTE INPUT DIGIT IF ENTRY LSNRDN
			X1RB BINARY VALUE OF INPUT  CHAR. IF ENTRY LSNRDS
	NORMAL EXIT: SKIP RETURN IF RADIX CONSTANT OK SO FAR
	ERROR EXIT: RETURN IF OVERFLOW OR INVALID DIGIT
	OUTPUT ARGUMENTS:X1RA  VALUE OF RADIX CONSTANT 			 
	/

L2():!	SCANIG
LSNRDN:	;ENTRY IF RADIX 16 NUMBER AND NOT LETTER
	IFOFF	Z1CHSD
	GOTO	L4				;RETURN IF NOT DIGIT
	LI	X1RB,-"0"(X1BYTE)		;FETCH BINARY VALUE OF DIGIT
LSNRDS:	; ENTRY IF RADIX 16 NUMBER AND LETTER
	IF	CAML	X1RB,YLSVAL
		GOTO	FALSE			;FOUND DIGIT NOT LESS THAN BASE
	THEN	;DIGIT ACCEPTED
		SETONA	YLSNUM			;VALID DIGIT FOUND
		L	X1R1,X1RA
		MUL	X1R1,YLSVAL		;OLD VALUE  *  BASE
		ADD	X1RA,X1RB
		JUMPE	X1R1,L2			;NO OVERFLOW
		CAIE	X1R1,1
		GOTO	L1			;OVERFLOW
		TLO	X1RA,400000		;IF NEGATIVE NUMBER 
		GOTO	L2
	FI	
	SCANNO
	MERRT	E,22,<  X  >,<DIGIT NOT LESS THAN RADIX BASE>
	RETURN
L1():!	;ERROR OVERFLOW
	HRLOI	X1RA,777777			;MAX INTEGER VALUE TO RESULT
	MERR	E,20,<INTEGER OVERFLOW IN RADIX CONS.>
	RETURN

L4():!	;NORMAL EXIT TO 1+RETURN ADDRESS
	POP	XPDP,X1RB
	BRANCH	1(X1RB)		;RETURN
	EPROC

LSNKEY:	PROC
	COMMENT /
	PURPOSE:
		;CALLED FROM LSNR ROUTINE WHEN A RADIX 16 CONSTANT IS SCANNED AND
		;FROM LSI WHEN AN ERROR IS FOUND IN AN OPTIONS STATEMENT
		;SCAN IDENTIFIER IF ANY FOUND AND SIGNAL IF IT IS A KEYWORD

	ENTRIES:LSNKEY SCAN INPUT BEFORE TEST
		LSNKY1 TEST BEFORE SCAN

	INPUT ARGUMENT: X1LBP

	NORMAL EXITS:
		;EXIT TO RETURN ADDRESS IF FIRST CHARACTER IS NOT A LETTER
		;EXIT TO RETURN ADDRESS +1 IF KEYWORD
		;EXIT TO RETURN ADDRESS +2 IF NORMAL IDENTIFIER

	OUTPUT ARGUMENTS:
			;AT EXIT REGISTER X1LBP IS UNCHANGED BUT
			;X1R0 POINTS TO CHAR. AFTER IDENTIFIER IF ONE FOUND

	USED SUBROUTINES: LSIS
	/

	SCANBL			;SCAN PAST BLANKS
LSNKY1:	;ENTRY IF X1LBP SHOULD BE UNCHANGED

	IFOFF	Z1CHSL
	RETURN			;NO LETTER FOUND
	SETZM	,YLSNSD		;PREPARE FOR EXIT
	STACK	X1RA		;SAVE REGISTERS
	STACK	X1LBP
	STACK	X1NXT
	SETONA	YZSE		;NO ADDITION TO DICTIONARY
	EXEC	LSIS		;FIND IDENTIFIER
	AOS	,YLSNSD		;RETURN IF NORMAL IDENTIFIER
	AOS	,YLSNSD		;RETURN IF KEYWORD
	SETOFA	YZSE
	UNSTK	X1NXT
	ST	X1LBP,X1R0	;SAVE NEW X1LBP
	UNSTK	X1LBP
	SCANNO			;RESTORE X1BYTE
	UNSTK	X1RA
	UNSTK	X1R1		;FIND RETURN ADDRESS
	ADD	X1R1,YLSNSD
	BRANCH	0(X1R1)		;RETURN

	EPROC
LSXTXT:	PROC
	COMMENT /
	PURPOSE:
		;CALLED FROM LSX AND LSIPAG 
		;SCAN TEXT CONSTANT
	INPUT ARGUMENTS:
			;X1NXT IS %CONT OR %OPT
			; -X1ID1 CONTAINS MAXIMUM LENGTH TO 
			; BE SCANNED BEFORE RETURN
			;AT ENTRY X1LBP POINTS TO CHARACTER " OR
			;LAST NOT YET TREATED CHAR.
	OUTPUT ARGUMENTS:
			;AT EXIT X1LBP POINTS AT CHAR. " PLUS ONE OR
			;AT EOT OR FIRST NOT YET HANDLED CHAR. IF
			;X1ID1 IS POSITIVE
	USED SUBROUTINES:O1RL OUTPUT TO REL FILE ,EXTERNAL SUBROUTINE
			O1LS1 OUTPUT TO LS1 FILE, EXTERNAL SUBROUTINE
			LSCHIG,LSCHGR 
	/

	STACK	X1CN
	LI	X1CN,5
	BIFNCH	QTEXTQ,L10	;SKIP SCAN PAST "
	SETOFA	YLSENW		;PREVENT SEVERAL WARNINGS FROM SAME TEXT CONSTANT
L1():!	LI 	X1CN,5		;5 CHARACTERS PER WORD
L7():!	SCAN			;NEXT CHAR.
	;SCANIG IS ONLY CALLED IF SPECIAL CHAR.FOUND
	IFON	Z1CHSS
	EXEC	LSCHIG+1	;CHAR ALREADY LOADED
L10():!	IFON	Z1CHST
	GOTO	L4		;CHECK CHARACTER
				;CHARACTER ACCEPTED
L5():!	ROT	X1BYTE,-7
	LSHC	X1ID2,7		;SHIFT SEVEN BIT CHARACTER TO X1ID2
	AOJG	X1ID1,L9	;INCREMENT COUNTER
				;MAXIMUM LENGTH REACHED?
	DECR	X1CN,L7		;CONTINUE
	LSH	X1ID2,1		;BIT35 TO ZERO WORD FILLED
	EXEC	LSXTX1		;OUTPUT WORD
	GOTO	L1		;NEXT WORD
L4():!	;			SPECIAL CHARACTERS TO BE HANDLED

	BIFCHA	QTEXTQ,L3		;END OF TEXT CONSTANT OR CHARACTER DOUBLE QUOTE

	BIFCHA	QCR,L7	;[14] IGNORE <CR> IN TEXT CONSTANTS

	BIFCHA	<";">,<[EXEC	LSSEM
		     GOTO	L5	;SEMICOLON ACCEPTED
		   ]>
	BIFCHA	"'",L5
	BIFCHA	QTAB,<[MERR	E,11,<TAB IN TEXT CONST.>	
		       LI	X1BYTE," "	
		       GOTO	L5		
		     ]>
			;ERROR TAB IN TEXT CONSTANT
			;REPLACE WITH BLANK
	BIFCHA	QEOT,<[MERR	E,6,<EOF IN TEXT CONST.>	
		      GOTO	L8
		     ]>
				;SPECIAL CHARACTERS LEFT
	IF
		IFN	QDEBUG <
		BIFCHA	QTST,FALSE
				>
	THEN	JUMPE	X1NXT,L2		;CALLED AFTER PAGE STRING OVERFLOW,
						;X1LBP MUST POINT TO FIRST CHAR.	
						; ON NEW LINE
						;RETURN WHEN END OF LINE FOUND
		IF
			IFONA	YLSENW
			GOTO	FALSE		;WARNING ALREADY CREATED
		THEN
			MERR	W,3,<END OF LINE IN TEXT CONST.>
			SETONA	YLSENW		;PREVENT MORE WARNINGS
		FI
	FI
	EXEC	LSCHGR
	JUMPE	X1NXT,L2
	GOTO	L7		;NEXT CHARACTER

L3():!	PUSH	XPDP,X1LBP	;SEARCH FOR 			
				;"" ,SAVE BYTE POINTER
	SCANIG
	BIFCHA	QTEXTQ,L6	;"" FOUND
		edit(101)
	SKIPA	;[101]
	LOOP	;[101]
		LOOP	;Skipping illegal char's, blanks, tabs and carr. returns
			SCANIG
		AS
			BIFCHA	" ",TRUE
			CAIE	X1BYTE,QTAB
			CAIN	X1BYTE,QCR
			GOTO	TRUE
		SA
		IF	;Line control character
			CAIE	X1BYTE,QLF
			CAIN	X1BYTE,QFF
			GOTO	TRUE
			BIFNCHA	QVT,FALSE
		THEN	;Handle end of line
			EXEC	LSCHGR
			ST	X1LBP,(XPDP)
		ELSE	;Exit from loop
			SKIPA
		FI
	AS	GOTO	TRUE	;Must be only one instr - see SKIPA above!!!
	SA	;[101]
	IF	;[101] text quote found now
		BIFNCHA	QTEXTQ,FALSE
	THEN	;Go on with text constant
					edit(164)
		POP	XPDP,X1R0	;[164] DUMMY POP
		GOTO 	L7		;[164] CHECK CHARACTER
	FI	;[101]
	UNSTK	X1LBP	;RESTORE
	SCANNO
	GOTO	L2		;TRUE END OF TEXT CONSTANT
L6():!	LI	X1BYTE,QTEXTQ	;REPLACE "" WITH "
	POP	XPDP,X1R0	;DUMMY POP
	GOTO	L5
L2():!	;			END OF TEXT CONSTANT FOUND
	SCAN			;POINT TO NEXT CHARACTER
L8():!	;			;EOT EXIT
L9():!	;MAX LENGTH EXIT
	IF	CAIN	X1CN,5
		GOTO	FALSE		;LAST WORD FILLED
	THEN	LSH	X1ID2,7		;FILL WITH ASCII NULLS
		DECR	X1CN,TRUE
		LSH	X1ID2,1		;BIT 35 TO 0
		EXEC	LSXTX1		;OUTPUT LAST WORD

	FI
	UNSTK	X1CN
	RETURN
	EPROC
	


LSXTX1:	PROC
	;ONLY CALLED FROM LSXTXT
	;OUTPUT WORD TO REL FILE OR LIST FILE

	L	XLSTXT,X1ID2		;OUTPUT ARGUMENT IN PARAMETER ACC.
	IF	BIFLEX	%CONT,FALSE		;TEXT CONSTANT HANDLED?
	THEN	;PAGE SWITCH STRING
		IF	JUMPE	X1NXT,FALSE	;NO OUTPUT AFTER LENGTH OVERFLOW
		THEN	PUTLS1			;WORD TO LIST FILE
		FI
	ELSE
		EXEC	O1RL			;WORD TO REL FILE
	FI
	RETURN
	EPROC
	SUBTTL	LS MAIN ,CHARACTER ROUTINES


	COMMENTS ;
	PURPOSE:
		LS IS THE ENTRY POINT TO THE LEXICAL SCANNER SUBROUTINE
		LS SCANS THE INPUT CHARACTERS AND USES THE Z1CH TABLE AS A
		BRANCH TABLE. Z1CH HAS ONE ENTRY FOR EACH CHARACTER AND THE
		LSLOP AND LSB ENTRIES ARE USED WHEN AN INPUT CHARACTER
		STARTS A NEW SYNTACTICAL UNIT.
		LS MAIN IS DIVIDED INTO:
		CHARACTER ROUTINES LSNU,LSB,LSDA,LSDB,LSDC,LSDD,LSDE,LSDF,LSDG,LSDH,
				   LSDI,LSDL,LSDM,LSDN,LSDO,LSDP,LSDR,LSDF,LSDS,LSE,
				   LSL,LSF,LSFP AND LST
		IDENTIFIER ROUTINE LSI
		COMMENT ROUTINES LSEND AND LSK
		CONSTANT ROUTINES  LSC AND LSX
		NUMBER ROUTINES LSN, LSDT, LSNPR AND LSDK
		
	;
;START LEXICAL SCANNER

LS:	PROC
IFN	QDEBUG,<
				;CREATE DEBUG OUTPUT ,OUTPUT X1NXT RESULTING SYMBOL
	EXEC	LSDEB

	IFONA	TRLS
	EXEC	LSTRAC
	RETURN
	EPROC
LSDEB:	PROC
	>

	;ENTRY POINT.AT ENTRY BUFFER POINTER X1LBP POINTS AT A CHARACTER
	;THAT HAS NOT YET BEEN TREATED BY  LS.
	L	X1CUR,X1NXT	;CURRENT SYMBOL IS NOW PREVIOUS NEXT SYMBOL
	;UPDATE LINE NUMBER AND SEMICOLON COUNTERS
	LD	X1R0,YLSNLS	;NEXT + CURRENT TO 
	STD	X1R0,YLSCLS	;CURRENT + LAST

	IFONA	YLSEND	
	GOTO LSEND		;SCAN REST OF END COMMENT
				;OR HANDLE EOF
				;OR HANDLE GO TO
LSLOP:
				;START NEW SYNTACTIC ENTITY, X1LBP ALREADY MOVED
	SCANNO
	GOTO	@Z1CH(X1BYTE)	;GOTO CHARACTER ROUTINE

LSNU:	;			NULL AND DELETE CHARACTERS
LSB:	;			SPACE AND TAB CHARACTERS
				;START NEW SYNTACTIC ENTITY, SKIP CURRENT CHARACTER
	SCAN
				edit(262)	;[262]
LSB1:	GOTO	@Z1CH(X1BYTE)	;GO TO CHARACTER ROUTINE


LSDA:	; , FOUND
	LI	X1NXT,%COMMA
	RETIBP			;EXIT  LS
	
LSDB:	;SEMICOLON FOUND
	LI	X1NXT,%SEMIC
	EXEC	LSSEM		;UPDATE SEMICOLON COUNTER
	RETIBP			;EXIT LS

LSDC:	; ( FOUND
	LI	X1NXT,%LP
	RETIBP			;EXIT LS

LSDD:	; )FOUND
	LI	X1NXT,%RP
	RETIBP			;EXIT LS

LSDE:	; LBRAC FOUND
	LI	X1NXT,%LB
	RETIBP			;EXIT LS
 
LSDF:	; RBRAC FOUND
	LI X1NXT,%RB
	RETIBP			;EXIT LS

LSDG:	; + FOUND
	LI	X1NXT,%PLUS
	RETIBP			;EXIT LS

LSDH:	; - FOUND
	LI	X1NXT,%MINUS
	RETIBP			;EXIT LS

LSDI:	; ^ FOUND
	LI	X1NXT,%POW
	RETIBP			;EXIT LS

LSDL:	; =FOUND
	SCANIG
	IF	BIFNCHA	"=",FALSE
	THEN	LI	X1NXT,%DEQ	; == FOUND
		RETIBP			;EXIT LS
	FI
	IF	BIFNCHA	"/",FALSE
	THEN	SCANIG
		LI	X1NXT,%NDEQ	;ASSUME =/=
		IF	BIFNCHA	"=",FALSE
		THEN
			RETIBP		;EXIT LS
		FI	;CREATE ERROR = MUST FOLLOW =/
		MERR	E,0,<= MUST FOLLOW =/>
		RETURN			;EXIT LS  WITH =/=
	FI	LI	X1NXT,%EQ	; = FOUND
		RETURN			; EXIT LS

LSDM:	; : FOUND
	SCANIG
	IF	BIFNCHA	"=",FALSE
	THEN	LI	X1NXT,%BECOM	;ASSIGN FOUND
		RETIBP			;EXIT LS  WITH ==
	FI
	IF	BIFNCHA	"-",FALSE
	THEN	LI	X1NXT,%DENOT	;DENOTES FOUND
		RETIBP			;EXIT LS
	FI	LI	X1NXT,%COLON	;COLON FOUND
		RETURN			;EXIT LS

LSDN:	;< FOUND
	SCANIG
	IF	BIFNCHA	"=",FALSE
	THEN	LI	X1NXT,%NGRT	; <= FOUND
		RETIBP			;EXIT LS
	FI	LI	X1NXT,%LESS	; < FOUND
		RETURN			;EXIT LS

LSDO:	; > FOUND
	SCANIG
	IF	BIFNCHA	"=",FALSE
	THEN	LI	X1NXT,%NLESS	; >= FOUND
		RETIBP			;EXIT LS
	FI	LI	X1NXT,%GRT	; > FOUND
		RETURN			; EXIT LS

LSDP:	; \ FOUND,BACKSLASH
	SCANIG
	IF	BIFNCHA	"=",FALSE
	THEN	LI	X1NXT,%NEQ	;\= FOUND
		RETIBP			;EXIT LS
	FI	LI	X1NXT,%NOT	; SINGLE \ FOUND
		RETURN			;EXIT LS

LSDR:	; / FOUND
	SCANIG
	IF	BIFNCHA	"/",FALSE
	THEN	LI	X1NXT,%IDIV	; // FOUND
		RETIBP			;EXIT LS
	FI	LI	X1NXT,%DIV	; SINGLE / FOUND
		RETURN			;EXIT LS

LSDS:	; * FOUND
	SCANIG
	BIFCHA	"*",LSDI		; ** FOUND
	LI	X1NXT,%MULT		; SINGLE * FOUND
	RETURN				;EXIT LS

LSE:	; EOT FOUND
	EXEC	LCEOF		;CALL LC TO SHOW EOF
	GOTO	LSF		; IF UNKNOWN EOF
	SKIPA			;TRUE EOF
	GOTO	LSLOP		; IF MORE SOURCE FILES
				;CONTINUE SCANNING

	LI	X1NXT,%EOF	;RETURN EOT
	SETONA	YLSEND		;INDICATE EOF RETURNED TO ENABLE LS
				;TO FIND ONE EXTRA ENTRY FROM SR AFTER EOF
	RETURN			;EXIT LS

LSL:	; VT,LF OR FF FOUND
	EXEC	 LC		;HANDLE  NEW  LINE
	ZF	YLSNSEM
	edit(262)
	LOOP	;[262]
		SCAN
	AS	JUMPE	X1BYTE,TRUE
	SA
	CAIE	X1BYTE,"%"
	 BRANCH	 LSB1	;Handle first char of line proper

LSLPRC:	;[262] Percent found at start of line, ignore the line!

	MERR	W,23,<% at start of line>

	LOOP	;Over characters in line
		SCAN
	AS	;Long as no end-of-line char is found
		HRRZ	Z1CH(X1BYTE)
		CAIE	LSL
		 GOTO	 TRUE
	SA

	GOTO	LSL

LSF:
				;CREATE ERROR
	EXEC	LSCHN1		;NONPRINTABLE CHAR
	GOTO	LSB	

LSFP:				;ILLEGAL CHARACTER 
		edit(262)
	IF	;[262] Percent (%)
		CAIE	X1BYTE,"%"
		GOTO	FALSE
	THEN	;Check for start of line
		L	YLCLBS##
		ADDI	1
		LOOP
			ILDB	X1BYTE,
		AS
			JUMPE	X1BYTE,TRUE
		SA
		CAMN	X1LBP
		 GOTO	 LSLPRC
	FI
	MERRT	E,2,<  X  >,<ILLEGAL PRINTABLE CHAR.>
	GOTO	LSB		;SCAN NEXT CHARACTER

	IFN	QDEBUG<		;ONLY IF TEST VERSION
		BEGIN

LST:	; ^^ USED FOR TESTING PURPOUSES
	EXEC	LSTPRO		;CALL  TEST HANDLING  ROUTINE
	BRANCH	LSB		;HANDLE NEXT CHARACTER
LSTPRO:	;PROC		;LOCAL SUBROUTINE

	STACK	X1R1
	STACK	X1ID1
	STACK	X1ID2

	LI	X1ID2,0		;TEST VALUE REGISTER
	EXEC	LSTNXT		;FIND NEXT CHARACTER
	LSHC	X1ID2,6
	EXEC	LSTNXT		;FIND SECOND CHARACTER  LETTER
	LSHC	X1ID2,6		;SIXBIT FROM SECOND CHARACTER
	EXEC	LSTNXT		;FIND SIXBIT DIGIT
	LSHC	X1ID2,6		;SIXBIT  FROM DIGIT

;HANDLE TEST TABLES TEST VALUE IN X1ID2
	;HANDLE LSTT1
	LI	X1R1,LSTT1E-LSTT1
L2():	IF	HLRZ	X1ID1,LSTT1(X1R1)		;FETCH TABLE VALUE
		CAME	X1ID1,X1ID2
		GOTO	FALSE		;NO MATCH CONTINUE
	THEN	HRLZ	X1R1,LSTT1(X1R1)	;FETCH MASK FROM TABLE
		IORM	X1R1,X1MASK		;SET BITS ON IN X1MASK 
		GOTO	L10		;EXIT 
	FI	SOJGE	X1R1,L2		;CONTINUE
	;HANDLE LSTT2
	LI	X1R1,LSTT2E-LSTT2
L3():	IF	HLRZ	X1ID1,LSTT2(X1R1)		;FETCH TABLE VALUE
		CAME	X1ID1,X1ID2
		GOTO	FALSE	;NO MATCH
	THEN	HRLO	X1R1,LSTT2(X1R1)	;FETCH MASK FROM TABLE
		ANDM	X1R1,X1MASK		;SET BITS OFF IN X1MASK
		GOTO	L10
	FI	SOJGE	X1R1,L3

	;HANDLE LSTT3
	LI	X1R1,LSTT3E-LSTT3
L4():	IF	HLRZ	X1ID1,LSTT3(X1R1)
		CAME	X1ID1,X1ID2
	GOTO	FALSE
	THEN	HRRZ	X1R1,LSTT3(X1R1)
	PUSHJ	XPDP,0(X1R1)		;EXEC	DEBUG ROUTINE
	GOTO	L10
	FI	SOJGE	X1R1,L4

;	NO MATCH FOUND 
	LI	X1SR0,%DEBUG
	PUTIC1	X1SR0
	PUTIC1	X1ID2
	
L10():	UNSTK	X1ID2
	UNSTK	X1ID1
	UNSTK	X1R1
	RETURN

	;DUMMY EPROC


;LOCAL SUBROUTINE
LSTNXT:	;	PROC
;		RETURNS SIXBIT VALUE IN X1LEX
	SCANIG
	IFOFF	Z1CHSI
	GOTO	L1
	L	X1LEX,Z1CH(X1BYTE)	;SIXBIT VALUE TO REGISTER
	RETURN
L1():	MERRT	W,11,<  X  >,<CHAR. AFTER TEST NOT VALID>
	LI	X1LEX,0		;0 ASSUMED
	RETURN
	;	EPROC

;TEST TABLES
ZLSTT1:	;DOCUMENTATION NAME
LSTT1:	;SET SWITCH IN X1MASK ON IF MATCH
	XWD	'LS1',20
				;NOTE !
				;ENTRIES SD1,SR1,O11 SHOULD BE DELETED
				;THESE SWITCHES ARE NEVER USED 
	XWD	'SD1',100
	XWD	'SR1',1
	XWD	'O11',2
	XWD	'IC1',4
	XWD	'DF1',10
LSTT1E:	0			;LAST ENTRY
ZLSTT2:	;DOCUMENTATION NAME
LSTT2:	;SET OFF SWITCH IN X1MASK
				;NOTE !
				;ENTRIES SR0,SD0,O10 SHOULD BE DELETED
				;THESE ENTRIES ARE NEVER USED
	XWD	'SR0',-1-1
	XWD	'SD0',-1-100
	XWD	'O10',-1-2
LSTT2E:	XWD	'LS0',-1-20
				;LAST ENTRY
ZLSTT3:		;NAME IN DOCUMENTATION
LSTT3:	;EXECUTE DEBUG ROUTINE
	XWD	-1,-1		;DUMMY ENTRY
LSTT3E:	XWD	-1,-1
	ENDD
>
	SUBTTL	LS MAIN,IDENTIFIER ROUTINE

	BEGIN
	COMMENTS ;
	PURPOSES:
		THE ROUTINE LSI HANDLES AN IDENTIFIER
		IT IS ENTERED WHEN LETTER IS FOUND
		THE SPECIAL KEYWORDS BEGIN,END,COMMENT,GO,TO AND OPTIONS ARE RECOGNIZED
		LSI RETURNS THE IDENTIFIER NUMBER OR KEYWORD SYMBOL TO SR EXCEPT FOR
		 TO,COMMENT AND THE OPTIONS KEYWORDS WHICH ARE NOT KNOWN TO SR
	USED ROUTINES: LSIS,LSIOS2,LSIOS1,LSNKY1 AND LSLOP (INTERNAL LS SUBROUTINES)
			I1SW SWITCH ROUTINE IN I1 (EXTERNAL ROUTINE)


	;

LSI:	EXEC	LSIS		;LOCATE IDENTIFIER
	RETURN			;FROM LSIS IF IDENTIFIER , EXIT LS
				;FROM LSIS IF KEYWORD
	SUBI	X1NXT,QLRESW-QNRESW+1
	WLF	(X1R0)  Z1RWKL(X1NXT)	;LOAD BOTH SYNTAX SYMBOL AND SWITCHES
	LF	(X1NXT)  Z1RWKL(X1NXT)	;LOAD RETURN SYMBOL
LSI1:	;ENTRY FROM END COMMENT HANDLING
	; WHEN TERMINATING KEYWORD FOUND
	IFOFFA	Z1RWSM
	RETURN				;EXIT LS IF NO SPECIAL LS PROCESSING


;SPECIAL RESERVED WORD FOUND BEGIN,END,COMMENT,GO,TO,OPTIONS

	IF	BIFNLEX	%BEGIN,FALSE
	THEN	;BEGIN 
		HRLZI	X0,QLSRT2	;BEGIN RECORD
		EXEC	LCLS1

		AOS	,YBEGNO		;COUNT NUMBER OF BEGINS
					;USED IN PASS 3
		RETURN			;EXIT LS
	FI
	IF	BIFNLEX	%END,FALSE
	THEN	;END 
		HRLZI	X0,QLSRT3	;END RECORD
		EXEC	LCLS1		;CREATE LS1 RECORD

		SETONA	YLSEND		;SET ON SWITCH FOR END COMMENT HANDLING
		RETURN			;EXIT LS
	FI

	BIFLEX	%COMM,LSK1		;HANDLE COMMENT
	IF	BIFNLEX	%OPT,FALSE

	THEN	;HANDLE OPTIONS STATEMENT
	
		BEGIN
		SETOFA	YLSENW			;NO SWITCH FOUND
		EXEC	LSIOS2			;SCAN
		IF	GOTO	TRUE		;RETURN REST OF CHAR.
			GOTO	FALSE		; ; FOUND
			GOTO	FALSE		; / FOUND
		THEN
			BIFCHA	"(",L1	
		FI
	
		MERRT	W,6,< X, (>,<INVALID CHAR. X,( EXPECTED IN OPTION>
		GOTO	L9		;SCAN UNTIL / OR ;OR KEYWORD
	L1():
		SCANBL
	L3():	EXEC	LSIOS2		;SCAN 
		GOTO	L6		;RETURN REST OF CHAR.
		GOTO	L4		;RETURN IF ; FOUND
					;RETURN IF / FOUND
	L8():	SETONA	YLSENW		;INDICATE START OF SWITCH FOUND
		
		ST	X1LBP,X1R3		;PREPARE POINTER 
		SETONA	YI1OPT		;FLAG OPTIONS TO I1SW
		EXEC	I1SW		;CALL I1SW TO TREAT ONE SWITCH

					;ERROR RETURN FROM I1SW OR LSIPAG
		GOTO	[	ST	X1R3,X1LBP
				SCANNO
				GOTO	L9				
			]

					;NORMAL RETURN FROM I1SW OR LSIPAG
		ST	X1R3,X1LBP	;UPDATE POINTER
		SCANNO
		GOTO	L3		;SCAN AND TEST NEXT CHARACTER

	L4():	MERRT	W,6,< X, )>,<INVALID CHAR. X, ) EXPECTED IN OPTION>
		BRANCH	L9		;END OF OPTION STMT CONTINUE

	L6():	IF	BIFNCH	")",FALSE
		THEN	EXEC	LSIOS1
			IF	GOTO	FALSE		;REST OF CHAR.
				GOTO	TRUE		; ; FOUND
				GOTO	FALSE		; / FOUND
			THEN
				IFONA	YLSENW
				BRANCH	LSB		;NORMAL RETURN FROM OPTIONS 
							;STATEMENT, NO ERRORS
				MERR	W,7,<SWITCH MISSING FROM OPTIONS STMT>
				BRANCH	LSB
			FI
			MERRT	W,6,< X, ;>,<INVALID CHAR. X,; EXPECTED IN OPTION>
			GOTO	L9
		FI

		MERRT	W,6,< X, />,<INVALID CHAR. X,/ EXPECTED IN OPTION>
	L9():	;SCAN TO / OR ; OR KEYWORD
		EXEC	LSIOS2
		GOTO	L7			;CHAR. NOT RECOGNIZED
		BRANCH	LSB			;RETURN IF ;
		GOTO	L8			;RETURN IF / ,CONTINUE NEW SWITCH

	L7():	;CHECK IF KEYWORD
		EXEC	LSNKY1		
		GOTO	L5			;RETURN IF NOT LETTER
		BRANCH	LSLOP			;RETURN IF KEYWORD
						;STOP SCANNING OPTION AND
						;FIND KEYWORD AGAIN
		ST	X1R0,X1LBP		;RETURN IF IDENTIFIER
						;SKIP IDENTIFIER
		SCANNO				;RESTORE X1BYTE
		GOTO	L9			;CONTINUE SCANNING
	L5():	SCANBL
		GOTO	L9
		ENDD
	FI

	;HANDLE GO AND TO

	IF	BIFLEX	%GO,FALSE
	THEN	;TO FOUND
	ASSERT	<IF	BIFLEX	%TO,FALSE
		THEN	RFAIL	(LSI NOT TO )
		FI>
	
		POP	XPDP,X1R0	;FIND RETURN FROM LS ADDRESS
		HRRZ	X1R0,X1R0	;ZERO LEFT PART
		CAIN	X1R0,LSI3
		GOTO	LSLOP		;GO WAS JUST FOUND
					;DUMMY RETURN DELETED
		PUSH	XPDP,X1R0	;RESTORE TRUE RETURN ADDRESS
		MERR	E,4,<GO MISSING BEFORE TO>
		BRANCH	LSLOP		;IGNORE TO AND CONTINUE
	FI	
	
	
	; GO FOUND ,RETURN GOTO SYMBOL

	LI	X1NXT,%GOTO	;GOTO ASSUMED
	SETONA	YLSEND		;INDICATE THAT TO MUST FOLLOW
	RETURN			;EXIT LS

LSI2:	;ENTRY WHEN TO MUST FOLLOW
	;BRANCH FROM LSEND VIA LS START
	SETOFA	YLSEND
	EXEC	LSLOP		;DUMMY CALL TO FORCE RETURN 
				;HERE AFTER NEXT LEXEME FOUND
				;IF TO WAS FOUND THIS DUMMY RETURN
				;HAS BEEN DELETED
LSI3:	;RETURN ADDRESS IN STACK
	MERR	E,3,<GO NOT FOLLOWED BY TO>
	RETURN			;EXIT LS


	ENDD

	SUBTTL	LS MAIN,COMMENT ROUTINES

LSEND:	;HANDLE END COMMENT

	IF
		BIFLEX	%END,FALSE		;TRUE END COMMENT
	THEN
		BIFLEX	%GOTO,LSI2		;TO MUST FOLLOW

		CAIN	X1NXT,%EOF
		RETURN				;EXIT LS IF EOF WAS RETURNED LAST TIME
	FI


	SETOFA	YLSEND
	BEGIN
	SETOFA	YLSENW		;ONLY ONE WARNING PER ENDCOMMENT
	SCANNO			;LOAD X1BYTE
	SKIPA			;X1BYTE ALREADY LOADED
    LOOP
	SCAN
L5():AS
	IFOFF	Z1CHSL
	GOTO	L1		;NOT START OF IDENTIFIER
	SETONA	YZSE		;INDICATE NO ADDITION TO DICTIONARY

	EXEC	LSIS		;FIND IDENTIFIER
	GOTO	L5		;NO RESERVED WORD CONTINUE

	;RESERVED WORD FOUND

	SUBI	X1NXT,QLRESW-QNRESW+1
	WLF	(X1R0) Z1RWKL(X1NXT)	;LOAD SWITCHES
	LF	(X1NXT) Z1RWKL(X1NXT)	;LOAD LEXEME
	IFOFFA	Z1RWSE
	GOTO	L5		;RESERVED WORD NOT RECOGNIZED IN END COMMENT
	BIFLEX	%GOTO,L3+1	;WARNING IF GOTO FOUND
	SETOFA	YZSE
	GOTO	LSI1		;END COMMENT TERMINATED HANDLE RESERVED WORD FOUND
				;EXIT LSEND

L1():	; ANY CHAR BUT LETTER

	IFOFF	Z1CHSE		
	GOTO	TRUE			;CONTINUE IF NOT MARKED IN END COMMENT
	SETOFA	YZSE
	BIFCHA	<";">,<LSDB	>	;SEMICOLON FOUND END OF COMMENT
					;EXIT LSEND AND SKIP  ;

	BIFCHA	QEOT,LSE		;EOT IN END COMMENT
					;EXIT LSEND  AND TREAT EOT
	BIFCHA	"(",L3		;PRODUCE WARNING IF ( FOUND
	BIFCHA	":",L4		;MAY BE WARNING
	EXEC	LSCHGR		;TREAT SPECIAL CHARACTERS
	GOTO	TRUE		;CONTINUE
L4():	SCANIG	
	BIFCHA	"=",L3		;:= PRODUCE WARNING
	BIFCHA	"-",L3		;:- FOUND WARNING
	GOTO L5			; CONTINUE SCAN ALREADY DONE
L3():	;GENERATE WARNNING IF  FIRST ENTRY
	SCAN				;SKIP SCAN IF GOTO FOUND
	IFONA	YLSENW
	GOTO L5				;CONTINUE
	MERR	W,2,<END COMMENT WARNING>
	SETONA	YLSENW		;NO MORE WARNINGS
	GOTO L5
    SA
	ENDD



	;COMMENT ROUTINE

LSK:	; ! FOUND
	LOOP SCAN
	AS
LSK1:	;HANDLE COMMENT KEYWORD X1BYTE ALREADY LOADED
	IFOFF	Z1CHSC
	GOTO	TRUE		;CHARACTER NOT RECOGNIZED IN COMMENT
	BIFCHA	<";">,<[	EXEC	LSSEM
			BRANCH	LSB	;END OF COMMENT FOUND , EXIT LSK
		    ]>
	;SPECIAL CHARACTERS
	BIFCHA	QEOT,<[	MERR	E,5,<EOF IN COMMENT>	
			GOTO	LSE		
		     ]>
	EXEC	LSCHGR	;HANDLE SPECIAL CHARACTERS
	GOTO TRUE
	SA
	SUBTTL	LS MAIN,CONSTANT ROUTINES


	BEGIN
LSC:			;HANDLE CHARACTER CONSTANT
	SCANIG
	LI	X1NXT,%CONC		;RETURN SYMBOL
L1():	IF	IFOFF	Z1CHST
		GOTO	FALSE		;ACCEPT CHARACTER
	THEN	BIFCHA	QTAB,L2
		IFOFF	Z1CHSE
		GOTO	FALSE		;IS IT ' OR "  ,YES CONTINUE
		BIFCHA	<";">,<[EXEC	LSSEM
			     GOTO	FALSE]>		;ACCEPT SEMICOLON
		BIFCHA	QEOT,<[
				MERR	E,7,<CHARACTER QUOTE MISSING>
				BRANCH	LSLOP
				]>
					;ERROR 	CHARACTER QUOTE MISSING

		EXEC	LSCHGR		;HANDLE TEST AND LINE CONTROL
					;CHARACTERS
	L2():	MERR	E,10,<LC CHAR. IN CONSTANT>
		LI	X1BYTE," "	;BLANK CHARACTER
	FI				;ACCEPT CHARACTER

	ST	X1BYTE,YLSVAL		;RETURN VALUE
	SCANIG
	IF	BIFCHA	"'",FALSE
	THEN	MERR	E,7,<CHARACTER QUOTE MISSING>
		RETURN
	FI	RETIBP			;EXIT LS
	ENDD


LSX:		;HANDLE TEXT CONSTANT



	L	X1R1,YREL	
	SUBI	X1R1,2			;TEXT CONSTANT ADDRESS
	HRLM	X1R1,YLSVAL		;STORE ADDRESS IN RETURN VALUE
	LI	X1NXT,%CONT		;RETURN TEXT CONSTANT
LSX001:	HRROI	X1ID1,-1B20		;MAX LENGTH IS 2^15
	EXEC	LSXTXT			;SCAN UNTIL END OF TEXT STRING
	IF	JUMPG	X1ID1,[MERR	E,12,<TEXT CONSTANT LONGER THAN 2^15>
				GOTO	LSX001	;CONTINUE SCANNING
				]
	THEN	ADDI	X1ID1,1B20
		HRRM	X1ID1,YLSVAL		;STORE TEXT LENGTH  IN RETURN VALUE 
						;VARIABLE
		RETURN				;EXIT LS

	FI
	

	SUBTTL	LS MAIN, ARITHMETIC CONSTANTS ROUTINES

	COMMENTS ;
	PURPOSES:SCAN THE ARITHMETIC CONSTANTS AND CONVERT THEM TO
		INTERNAL FORM : FIXED BINARY, FLOATING NUMBER OR DOUBLE FLOATING NUMBER
	METHOD:
		THE NUMBER CONSTANT IS SCANNED WITH ABOUT THE SAME METHOD THAT IS USED
		IN THE ALGOL COMPILER.
		THE NUMBER IS TREATED AS AN INTEGER UNTIL EITHER AN OVERFLOW OCCURS
		OR  AN EXPONENT IS FOUND.
		THEN IT IS CONVERTED TO A DOUBLE FLOATING NUMBER.
		AFTER THE END OF THE NUMBER IS FOUND (ANY CHARACTER EXCEPT BLANK, DIGIT
		POINT OR & ) ANY INTEGER IS CONVERTED TO A FLOATING NUMBER (SHORT REAL)
		IF IT CONTAINED A DECIMAL POINT AND ALL DOUBLE FLOATING VALUES ARE
		CONVERTED TO FLOATING NUMBERS (SHORT REAL) EXCEPT TRUE ONES (LONG REAL),
		WHICH CONTAINED A DOUBLE EXPONENT ( && ).
		THE VALUE IS PLACED IN YLSVAL AND
		THE SYMBOL CONI, CONR, CONLR IS RETURNED IN X1NXT
		BEFORE RETURNING AN INTEGER TO SR A CHECK IS MADE TO DETECT IF IT IS A 
		RADIX CONSTANT. LSNR HANDLES  A RADIX CONSTANT.

	;


LSDK:	; . FOUND ,START OF NUMBER OR SINGLE .
	SCANIG
	IFON	Z1CHSD
	GOTO 	LSNDT		;DECIMAL POINT IF DIGIT FOLLOWS


	LI	X1NXT,%DOT	;RETURN DOT
	RETURN			;EXIT LS


LSNDT:	LI	X1RD,^D10	
	ST	X1RD,YLSNPM		;SET DECIMAL POINT MARKER
	GOTO	LSN+1			;SKIP SET ZERO TO YLSNPM

LSN:	;DIGIT FOUND PROCESS NUMBER

	SETZM	YLSNPM			;CLEAR DECIMAL POINT
	LI	X1RD,^D9		;READ FIRST 9 DIGITS WITHOUT OVERFLOV CHECK
	LI	X1RA,-"0"(X1BYTE)	;CONVERT FIRST CHARACTER TO BINARY VALUE
	ST	X1RA,YLSNSD		;SAVE FIRST DIGIT ,USED FOR CHECKING RADIX
					; CONSTANTS


	SETOFA	YLSNUM			;NUMBER NOT YET CONVERTED TO LONG REAL
	BEGIN	;MAIN LOOP FOR SCANNING NUMBER


	;SCAN FIRST TEN DIGITS WITH FAST LOOP
L1():	SCAN
	IF	IFON	Z1CHSD
		GOTO	FALSE		;DIGIT?
	THEN	IFON	Z1CHSI
		GOTO	L4		;IF LETTER
		LF	(X1LEX) Z1CHI(X1BYTE)	;LOAD INDEX
		GOTO	@LSNT1(X1LEX)		;TO RELEVANT ROUTINE
	FI				;DIGIT FOUND
	IMULI	X1RA,^D10		;MULTIPLY PREVIOUS VALUE BY 10
	ADDI	X1RA,-"0"(X1BYTE)	;ADD NEW DIGIT
	DECR	X1RD,L1			;NEXT CHARACTER

;	NUMBER IS LONGER THAN TEN DIGITS OVERFLOW CHECK NECESSARY
	LI	X1RD,30000		;SET NEW INDEX ,USED FOR DECIMAL POINT
					; CALCULATIONS
	SKIPE	,YLSNPM			;
	ADDM	X1RD,YLSNPM		;UPDATE MARKER IF DECIMAL POINT FOUND

L8():	;LOOP  THAT COLLECTS DIGITS IN INTEGER VALUE FORM UNTIL OVERFLOW
	;AND AFTER THAT IN DOUBLE FLOTING FORM
	SCAN
	IF	IFON	Z1CHSD
		GOTO	FALSE
	THEN	IFON	Z1CHSI
		GOTO	L4
		LF	(X1LEX) Z1CHI(X1BYTE)
		GOTO	@LSNT1(X1LEX)


	FI					;DIGIT FOUND
	JFCL	17,.+1				;CLEAR FLAGS
	IF	IFONA	YLSNUM
		GOTO 	FALSE			;HANDLE LONG REAL NUMBER
	THEN					;INTEGER LONGER THAN TEN DIGITS
		ST	X1RA,YLSNSD		;MAKE SPARE COPY IN CASE OF OVERFLOV
		IMULI	X1RA,^D10
		ADDI	X1RA,-"0"(X1BYTE)	;CALCULATE NEW VALUE
	IF	JOV	FALSE
		JUMPL	X1RA,FALSE		;OUT IF OVERFLOW
	THEN	DECR	X1RD,L8			;X1RD NEVER ZERO MAX 135 CHARACTERS 
	ASSERT<	RFAIL	(LSN	ERR1)>
	FI	;INTEGER OVERFLOW CONVERT TO LONG REAL
		L	X1RA,YLSNSD	;RESTORE SAVED VALUE
		EXEC	LSNCO		;CONVERT INTEGER
;		GOTO	FALSE		;NEXT INSTRUCTION


	FI	;DIGIT FOUND  VALUE CONVERTED TO LONG REAL
	IFN	QKA10,<;ROUTINE DEPENDENT ON DOUBLE FLOATING INSTRUCTIONS
>
	IFONA	YLSENW
	GOTO	L2			;OVERFLOW HAS OCCURRED
	STD	X1RA,YLSNSD		;SAVE OLD VALUE IN CASE OF OVERFLOW
;***AUBEG
;	KI10 CODE UNDER CONDITIONAL
IFN	QKI10,<
;***AUEND
	DFMP	X1RA,[
	XWD	204500,000000
	XWD	0,0		]	;VALUE * FLOATING TEN
;***AUBEG
;	CLOSE KI10 CONDITIONAL
;	KA10 CODE INSERTED
>
IFN QKA10,<
	; MULTIPLY X1RA BY 10.0
	MOVE	X1R0,X1RB
	FMPL	X1RA,[204500,,0]
	FMPRI	X1R0,204500
	FADR	X1R0,X1RB
	FADL	X1RA,X1R0
>
;***AUEND
	L	X1R0,LSNFT-"0"(X1BYTE)	;FIND LEFT PART FLOATING DIGIT
;***AUBEG
;	KI10 CODE UNDER CONDITIONAL
IFN	QKI10,<
;***AUEND
	SETZ	X1R1,
	DFAD	X1RA,X1R0		;ADD NEW DIGIT
;***AUBEG
;	CLOSE KI10 CONDITIONAL
;	INSERT KA10 CODE
>
IFN QKA10,<
	UFA	X1R0,X1RB		;ADD LOW ORDER PART TO DIGIT
	FADL	X1RA,X1R1		;ADD INTO HIGH ORDER PART
>
;***AUEND
	JFOV	.+2			;
	DECR	X1RD,L8			;CONTINUE WITH NEXT CHARACTER
	;OVERFLOW OCCURRED
	SETONA	YLSENW			;INDICATE OVERFLOW
	LD	X1RA,YLSNSD		;RESTORE PREVIOUS VALUE
	SETZM	,YLSNSD
L2():	AOS	,YLSNSD			;COUNTER FOR DIGITS AFTER OVERFLOW
	DECR	X1RD,L8			;CONTINUE


	;BRANCH TABLE FOR NUMBER ROUTINE
LSNT1:	L4
	L3
	L6
	L7
	L9
	L10
	L4
	L4

L6():	;DOT FOUND
	IF	SKIPN	,YLSNPM
		GOTO	FALSE		;FIRST DECIMAL POINT
	THEN				;MORE THAN ONE DECIMAL POINT FOUND
		MERR	E,13,<MORE THAN ONE DECIMAL POINT>
		GOTO	L3		;IGNORE EXTRA DECIMAL POINT CONTINUE
	FI	
	ST	X1RD,YLSNPM		;UPDATE DECIMAL POINT MARKER
	CAIG	X1RD,^D10
	GOTO	L1			;CONTINUE FAST LOOP
	EXEC	LSNCO			;CONVERT FROM INTEGER TO DOUBLE FLOATING
					;IF NECESSARY
	GOTO	L8			;NEXT CHARACTER

L10():	;ILLEGAL PRINTABLE CHARACTER
	SCANNO
	MERRT	E,2,<  X  >,<ILLEGAL PRINTABLE CHAR.>

L3():	;BLANK CHARACTERS
	CAIG	X1RD,^D10		;FIRST TEN DIGITS HANDLED
	GOTO	L1			;NO,CONTINUE FAST LOOP
	GOTO	L8			;CONTINUE OTHER LOOP

L7():	;& FOUND ,START EXPONENT
	EXEC	LSNDL			;CHECK THAT DOT WAS NOT LAST CHARACTER
	EXEC	LSNCO			;CONVERT IF NECESSARY
	SCANBL
	IF	BIFCHA	"&",FALSE	;&& FOUND
	THEN	;SHORT REAL NUMBER
		EXEC	LSNEXP		;SCAN EXPONENT
L5():	;HANDLE SHORT REAL NUMBER
		EXEC	LSNSCE		;SCALE VALUE
		LI	X1NXT,%CONR	;RETURN SHORT REAL CONSTANT


		REPEAT 0,<	;[15] ROUNDING REMOVED
		IF	JOV	FALSE	;FLAG SET IN LSNSCE ROUTINE IF
					;OVERFLOW OR UNDERFLOW OCCURRED
		THEN			;ROUND NUMBER IF NO OVERFLOW
			IFN	QKA10,<;ROUTINE DEPENDENT ON DOUBLE FLOATING INSTRUCTIONS
>

;***AUBEG
;	KI10 CONDITIONAL
;	INSERT KA10 CODE
	IFN	QKI10,< TLNN	X1RB,200000>
	IFN	QKA10,< TLNN	X1RB,000400>
;***AUEND
			GOTO	FALSE		;ROUNDING
						; NOT NEEDED
			ADDI	X1RA,1
			TLO	X1RA,000400	;MAKE SURE BIT9 IS SET ON
			JUMPGE	X1RA,FALSE	;NO OVERFLOW WHILE ROUNDING
						; NUMBER
			MERR	E,16,<FLOATING OVERFLOW>
			L	X1RA,[XWD	377777,777777]
						;FILL IN MAX NUMBER
		FI

		>	;END REPEAT 0	;[15]

		ST	X1RA,YLSVAL		;FILL IN RETURN VALUE

		RETURN			;EXIT LS

	FI	;LONG REAL NUMBER
	SCANBL
	EXEC	LSNEXP			;SCAN EXPONENT
	EXEC	LSNSCE			;SCALE CONSTANT VALUE
	LI	X1NXT,%CONLR		;RETURN LONG REAL VALUE
;***AUBEG
;	CODE STD FOR DMOVEM
	STD	X1RA,YLSVAL		;FILL IN RETURN VALUE
;***AUEND

	RETURN				;EXIT LS
L4():	;END OF NUMBER FOUND
	EXEC	LSNDL			;CHECK THAT DOT WAS NOT LAST CHARACTER
	IF	IFOFFA	YLSNUM
		GOTO	FALSE		;NUMBER IN INTEGER FORM
	THEN				;DOUBLE FLOATING FORM
		IF	SKIPE	,YLSNPM
			GOTO	FALSE	;DECIMAL POINT PRESENT
		THEN	;ERROR OVERFLOW ,INTEGER CONVERTED TO REAL
			MERR	W,1,<OVERFLOW,INTEGER CONV. TO REAL>
			ST	X1RD,YLSNPM	;EXPONENT ZERO
		FI	SUB	X1RD,YLSNPM	;FIND DECIMAL POINT CORRECTION

						;IF OVERFLOW OCCURRED, CORRECT EXPONENT

			IFONA	YLSENW
			ADD	X1RD,YLSNSD	;ADD NUMBER OF DECIMAL DIGITS SKIPPED
			GOTO	L5		;HANDLE REAL NUMBER


	FI	;INTEGER FORM

	IF	SKIPN	,YLSNPM
		GOTO	FALSE		;NO DECIMAL POINT IN NUMBER
	THEN	EXEC	LSNCO		;CONVERT TO LONG REAL FORM
		SUB	X1RD,YLSNPM	;CALCULATE DECIMAL POINT CORRECTION
		GOTO	L5		;HANDLE REAL NUMBER

	FI	;INTEGER CONSTANT

	LI	X1NXT,%CONI		;RETURN INTEGER CONSTANT
	ST	X1RA,YLSVAL		;FILL IN RETURN VALUE

	GOTO	LSNR			;FIND OUT IF RADIX CONSTANT OR NORMAL INTEGER 

L9():	;SPECIAL GROUP OF CHARACTERS
	SCANNO				;FETCH CHARACTER AGAIN
	HRRZ	X1R0,Z1CH(X1BYTE)	;FETCH CHARACTER ROUTINE ADDRESS
	CAIN	X1R0,LSL
	GOTO	L4		;IF LINE CONTROL CHARACTER ,END OF NUMBER
	EXEC	LSCHGR		;HANDLE TEST OR ILLEGAL CHARACTER
	GOTO	L3		;NEXT CHARACTER

LSNPR:	; & FOUND ,START OF NUMBER
	SETZM	YLSNPM			;NO DECIMAL POINT
	SETOFA	YLSNUM			;INTEGER VALUE IN X1RA
	LI	X1RA,1			;INTEGER ONE
	GOTO	L7			;TREAT EXPONENT
	ENDD				;END OF NUMBER MAIN ROUTINE
	BEGIN
LSNR:	;FIND OUT IF RADIX INTEGER NUMBER
	SCANNO
	LF	(X1R0) Z1CHI(X1BYTE)
	CAIE	X1R0,'R'
	RETURN			;RETURN IF ORDINARY INTEGER, EXIT LS

	;X1RA CONTAINS INTEGER ,CHECK IF VALID BASE
	LI	X1RD,^D16
LOOP	CAMN	X1RA,X1RD
	GOTO	FALSE		;BASE MAY BE ACCEPTABLE
AS
	LSH	X1RD,-1		;DIVIDE BY TWO
	CAIE	X1RD,1
	GOTO	TRUE		;TRY NEXT BASE VALUE
	RETURN			;NORMAL INTEGER BASE NOT VALID, EXIT LS
SA	SKIPN	,YLSNSD
	RETURN			;BASE NUMBER NOT VALID IT STARTED WITH ZERO
				;EXIT LS


;	BASE VALUE IN YLSVAL
;	CORRECT BASE FOUND SCAN RADIX NUMBER
	SETOFA	YLSNUM		;NO DIGIT IN RADIX NUMBER
	SETZ	X1RA,		;INTEGER VALUE ZERO
IF	CAIN	X1RD,^D16
	GOTO	FALSE		;BASE IS 16
THEN	;BASE IS 2,4 OR 8
	EXEC	LSNRDD
	GOTO	L9		;ERROR RETURN
	BIFCHA	" ",TRUE	;CONTINUE IF BLANK FOUND
L2():	IFONA	YLSNUM
	GOTO	L10		;VALID DIGIT FOUND
	MERR	E,21,<DIGITS MISSING IN RADIX NUMBER>
	RETURN			;BASE VALUE USED FOR INTEGER
				;EXIT LS

L9():	SCANBL
	IFON	Z1CHSD
	GOTO	L9		;SCAN PAST ANY DIGITS
L10():	ST	X1RA,YLSVAL	;RETURN CALCULATED VALUE
	RETURN			;EXIT LS
FI	
;TREAT RADIX NUMBER WITH BASE 16

	SCANIG
L5():	EXEC	LSNRDN
	GOTO	L1		;ERROR EXIT ,OVERFLOW OR LETTER >F
	;NORMAL EXIT
L4():	BIFCHA	" ",L3		;KEYWORD MAY FOLLOW
	IFOFF	Z1CHSL
	GOTO	L2		;END OF NUMBER FOUND

	;LETTER NOT PRECEDED BY BLANK NO KEYWORD CHECK DONE

L7():	L	X1LEX,Z1CH(X1BYTE)	;FETCHRADIX SIX VALUE OF LETTER
	SETZ	X1ID2,
	LSHC	X1ID2,6
	SUBI	X1ID2,'A'-^D10		;CALCULATE LETTER VALUE
	CAIG	X1ID2,9			;VALUE MAY BE OK
					;TREAT $,#,@
	ADDI	X1ID2,'A'-^D10+^D16	;MAKE SURE DIGIT TEST WILL FAIL
	EXEC	LSNRDS
	GOTO	L1			;ERROR EXIT
	GOTO	L4		

L3():	;BLANK FOUND KEYWORD MAY FOLLOW

	EXEC	LSNKEY		;CHECK IF KEYWORD
	GOTO	L5		;RETURN NO LETTER AFTER BLANK
	GOTO	L2		;KEYWORD FOUND,END OF NUMBER
	GOTO	L7		;NORMAL IDENTIFIER
				;STILL PART OF RADIX NUMBER

L1():	;ERROR IN SCANNING RADIX NUMBER WITH BASE
	;CURRENT CHAR. IS DIGIT OR LETTER
	;SCAN UNTIL KEYWORD OR DELIMITING CHAR.
LOOP	SCANIG
AS
L8():	IFON	Z1CHSI
	GOTO	TRUE		;SCAN PAST LETTERS AND DIGITS
	BIFNCH	" ",L10		;END OF NUMBER
	;BLANK FOUND MAY START IDENTIFIER
	EXEC	LSNKEY		;SEEK KEYWORD
	GOTO	L8		;RETURN IF NO LETTER MAY BE DIGIT
	GOTO	L10		;RETURN IF KEYWORD ,END SCANNING
	GOTO	L8		;IDENTIFIER ,SCAN PAST IT
SA
	ENDD
	LIT
	EPROC
	END
	PRINTX A