Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/10/ls.mac
There are 2 other files named ls.mac in the archive. Click here to see a list.
SEARCH SIMMC1,SIMMAC
CTITLE LS
SUBTTL LS
COMMENT;
AUTHOR: I WENNERSTR@M
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
>
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
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
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
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
DFMP X1RA,X1R0 ;MULTIPLY WITH SCALE FACTOR
JFOV L2 ;FLOATING OVERFLOW?
ELSE
DFDV X1RA,X1R0 ;DIVIDE WITH SCALE FACTOR
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
LD X1RA,[ XWD 377777,777777
XWD 377777,777777]
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
DFMP X1RA,[
XWD 204500,000000
XWD 0,0 ] ;VALUE * FLOATING TEN
L X1R0,LSNFT-"0"(X1BYTE) ;FIND LEFT PART FLOATING DIGIT
SETZ X1R1,
DFAD X1RA,X1R0 ;ADD NEW DIGIT
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
>
TLNN X1RB,200000
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
DMOVEM X1RA,YLSVAL ;FILL IN RETURN VALUE
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