.PROCEDURE IDNBS;
.BEGIN
SETIDENT;
ALLOWSPACE :=
.Z;
STACK(
IDENT1);
STACK(
IDENT2);
NBS;
IDENT2 :=
UNSTACK;
IDENT1 :=
UNSTACK;
.END;
.CONDITIONAL .PROCEDURE IDSYMBOL;
& CHECKS FOR A LETTER OR DIGIT, TAKES SPECIAL
& ACTION ON CHARACTERS 5, 6, 7, 8, 9 BY
& FEEDING THEM OUT AS A BLANK, FOLLOWED BY
& ANOTHER CHARACTER
.INTEGER HOLDER,
KEEPER;
.BEGIN
.WHEN IDFLAG .LZ .THEN
.BEGIN IDFLAG :=
.Z;
@ :=
KEEPER;
TRUEEXIT:
HOLDER := @;
INCHAR;
@ :=
HOLDER;
.EXITTRUE;
.END;
.WHEN ALLOWSPACE .LZ .THEN
.WHILE BASIC(
SPACE)
.DO INCHAR;
.WHEN LETTER .THEN
.BEGIN
@ :=
BS -
LCONSTANT;
.GOTO TRUEEXIT;
.END;
.WHEN DIGIT .THEN
.BEGIN
.WHEN BS <
FIVESYMBOL .THEN
.WHEN @ >
ZEROSYMBOL .THEN
.BEGIN @ := @ -
DCONSTANT;
.GOTO TRUEEXIT;
.END;
KEEPER := @ -
DDCONSTANT;
IDFLAG := -1; @ :=
FLAGSYMBOL;
.EXITTRUE;
.END;
.END;
.PROCEDURE READLINE;
.BEGIN
LINEPOINTER :=
LINESIZE;
.WHEN INDEVICE = 1
.THEN
.BEGIN
%
JST* '766;
& READ A LINE
.EXIT;
.END;
L:
.IF INDEVICE .Z .THEN
.BEGIN
%
SKS,'104; %
JMP,*-1; %
OCP,4;
%
INA,'1004; %
JMP,*-1;
.END
.ELSE
.BEGIN
%
OCP,1; %
INA,'1001; %
JMP,*-1; %
OCP,'101;
.END;
BS := @
.AND '177
.NEV '200;
.WHEN BASIC(
CRSYMBOL)
.THEN .GOTO CREXIT;
.WHEN BASIC(
EXCLAIMSYMBOL)
.THEN
.BEGIN
LINEPOINTER :=
LINEPOINTER - 1;
.GOTO L;
.END;
.WHEN BASIC(
EOMSYMBOL)
.THEN
.BEGIN
NEWLINE;
OUT2($*
N);
OUT2($
EX);
OUT2($
T*);
%
HLT;
.GOTO L;
.END;
.WHEN @ <
SPACE .OR @ > '337
.THEN .GOTO L;
LINE[
LINEPOINTER] := @;
%
IRS,
LINEPOINTER;
.GOTO L;
CREXIT:
LINE[
LINEPOINTER] :=
CRSYMBOL;
LINEPOINTER :=
LINESIZE;
.END;
.PROCEDURE INCHAR;
.BEGIN .IF KEPT .LZ .THEN
.BEGIN
KEPT :=
.Z;
BS :=
RETAIN;
.END
.ELSE
.BEGIN
BS :=
LINE[
LINEPOINTER];
%
IRS,
LINEPOINTER;
.WHEN BASIC(
CRSYMBOL)
.THEN READLINE;
TRACE[
CYCLE] := @;
%
IRS,
CYCLE;
.GOTO EXIT;
%
LDX,
CYCLESIZE; %
STX,
CYCLE;
EXIT:
.END;
.END;
.PROCEDURE LEAVE;
.BEGIN
@ :=
UNSTACK;
%
STA,*-2;
.END;
.CONDITIONAL .PROCEDURE LETTER;
.BEGIN
.WHEN BS -
ASYMBOL .GEZ .THEN
.WHEN @ - 26
.LZ .THEN
.EXITTRUE;
.END;
@
.PROCEDURE LHSPUT;
.BEGIN
LHSINST[
LHSPT] := @;
%
IRS,
LHSPT;
.GOTO LHSEXIT;
FAIL(
TOOMUCHLHS);
LHSEXIT:
.END;
.CONDITIONAL .PROCEDURE LOCLEVEL;
.BEGIN
.WHEN CLEVEL > 1
.THEN .EXITTRUE;
.END;
.PROCEDURE LHS;
.ARRAY TYPELHS[3](
INT,
ARRAY,
TABLE);
.SWITCH S =
LINT,
LARRAY,
LTABLE;
.BEGIN
.WHEN ID .LZ .THEN .GOTO OK;
.IF LETTER .THEN
.BEGIN IDENTIFIER;
OK:
ID :=
.Z;
.FOR # := -3
.DO
.WHEN TYPE =
TYPELHS[#]
.THEN .GOTO S[#];
FAIL(
LHSTYPE);
.GOTO FF;
LINT:
LHSPUT(
STA +
ADD);
.GOTO FF;
LTABLE:
@ :=
.INC ADD; %
SKP;
LARRAY:
@ :=
ADD;
STACK(@);
SUBSCRIPT;
LHSPUT(
UNSTACK +
STI);
FF:
.END
.ELSE .IF BASIC(
STARSYMBOL)
.THEN
.BEGIN NBS;
IDENTIFIER;
.WHEN TYPE .NE INT .THEN FAIL(
PTRNINT);
LHSPUT(
STI +
ADD);
.END
.ELSE .IF BASIC(
ACSYMBOL)
.THEN NBS
.ELSE FAIL(
INVLHS);
.END;
.PROCEDURE LOCAL;
.BEGIN @ :=
LA +
LSTART;
.END;
.PROCEDURE LOCALCOLLAPSE;
.INTEGER I;
.BEGIN I :=
DECPOINTER;
.WHILE NAMELIST[
I]
.NZ .DO
.BEGIN
LOCDP :=
I;
.WHEN .SENSE3 .THEN PRINTNAMELISTENTRY;
.WHEN NAMELIST[
I]
.LZ .THEN %
IRS,
I;
%
IRS,
I;
.IF NAMELIST[
I] =
LABEL .THEN
.BEGIN %
IRS,
I;
.WHEN NAMELIST[
I]
.LZ .THEN FAIL(
LABELNOTMET);
.END .ELSE %
IRS,
I;
%
IRS,
I;
.END;
LOCDP :=
I;
DECPOINTER := @ + 3;
CLEVEL :=
CLEVEL - 1;
.END;
.PROCEDURE MAKELABEL;
.BEGIN
.IF TYPE =
LABEL .THEN
.BEGIN
.IF LEVEL = 1
.THEN GENERATE(
.SSP ADD +
JMPI)
.ELSE
.BEGIN
.IF ADD .LZ .THEN
.BEGIN PUTADD('100000 +
LA);
GENERATE(
ADD .AND '777 +
JMPSO);
.END
.ELSE GENERATE(@ +
JMPSO);
.END
.END
.ELSE .IF TYPE =
SWTCH .THEN
.BEGIN
STACK(
ADD);
TYPEFIRST :=
.Z;
SUBSCRIPT;
GENERATE(
UNSTACK +
JMPI);
.END
.ELSE
.BEGIN
NOTDECLAREDCHECK;
TYPE :=
LABEL;
MAKEDEC;
PUTADD ('100000 +
LA);
GENERATE(
JMPSO + '777);
.END;
.END;
.PROCEDURE MAKECONST;
.BEGIN
.WHEN CPPT .NZ .THEN
.FOR # :=
CPPT .DO
.IF CPOOL[#] =
VALUE .THEN
.BEGIN %
IRS,0;
ADD :=
CPOOL[#] + '1000;
.GOTO EXIT;
.END
.ELSE %
IRS,0;
.WHEN CPPT .LE CPOOLSIZE .THEN FAIL(
POOLTOOBIG);
INDEX,
CPPT :=
CPPT - 2;
CPOOL[#] :=
VALUE;
%
IRS,0;
ADD := '1777;
EXIT:
CPOOL[#] :=
LA;
.END;
.PROCEDURE MAKEDEC;
.BEGIN
.IF IDENT1 .LZ .THEN @ := -4
.ELSE @ := -3;
INDEX,
DECPOINTER := @ +
DECPOINTER;
NAMELIST[#] :=
IDENT1; %
IRS,0;
.WHEN @
.LZ .THEN
.BEGIN NAMELIST[#] :=
IDENT2; %
IRS,0;
.END;
NAMELIST[#] :=
TYPE; %
STX,
POS;
%
IRS,0;
.END;
.PROCEDURE MAKEWORD;
.BEGIN
MAKEDEC;
.IF LOCLEVEL .THEN
.BEGIN
@ :=
LA + '1000;
%
IRS,
LA;
.END
.ELSE
.BEGIN
@ :=
GA;
%
IRS,
GA;
.END;
NAMELIST[#] := @;
.END;
.NEXTSECTOR;
&*********************************************************
.PROCEDURE NBS;
.COMPCONST SPECSYMBOLS = -5;
.ARRAY SPECIAL[
SPECSYMBOLS] (
COMPCHAR,
CRSYMBOL,
SPACE,
COMMENT,
COLONSYMBOL);
.SWITCH ACTION =
COMPBS,
AGAIN,
AGAIN,
CHAT,
COLN;
.BEGIN
AGAIN:
INCHAR;
.FOR # :=
SPECSYMBOLS .DO .WHEN BASIC(
SPECIAL[#])
.THEN
.GOTO ACTION[#];
.EXIT;
COMPBS:
INCHAR;
SETIDENT;
.FOR # :=
BSCOUNT .DO
.BEGIN
.IF COMPLIST[#] =
IDENT1 .THEN
.IF @
.GEZ .THEN .GOTO FOUND
.ELSE
.BEGIN %
IRS,0;
.WHEN COMPLIST[#] =
IDENT2 .THEN .GOTO FOUND;
.END
.ELSE .WHEN @
.LZ .THEN %
IRS,0;
%
IRS,0;
.END;
FAIL(
FCOMPSYMBOL);
FOUND:%
IRS,0;
BS :=
COMPLIST[#];
.EXIT;
CHAT:
.UNTIL BASIC(
CRSYMBOL)
.DO INCHAR;
.GOTO AGAIN;
COLN:
INCHAR;
.IF BASIC(
EQUALSSYMBOL)
.THEN BS :=
BECOMES
.ELSE
.BEGIN
RETAIN :=
BS;
KEPT := -1;
BS :=
COLONSYMBOL;
.END;
.END;