.PROCEDURE INX;
.BEGIN
.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;
.END;
.PROCEDURE INCHAR;
.BEGIN .IF KEPT .LZ .THEN
.BEGIN
KEPT :=
.Z;
BS :=
RETAIN;
.END
.ELSE
.BEGIN
L:
INX;
BS := @
.AND '177
.NEV '200;
.WHEN BASIC(
CRSYMBOL)
.THEN .GOTO CREXIT;
.WHEN @ - '340
.GEZ .THEN .GOTO L;
.WHEN BASIC(
EOMSYMBOL)
.THEN
.BEGIN
NEWLINE;
OUT2($
NE);
OUT2($
XT);
%
HLT;
.GOTO L;
.END;
.WHEN @ <
SPACE .THEN .GOTO L;
CREXIT:
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;
.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(
BREGISTER)
.THEN
.BEGIN LHSPUT(
IAB);
NBS;
.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 := 1;
.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 CLEVEL .EVEN .THEN
.BEGIN
@ :=
LA + '1000;
%
IRS,
LA;
.END
.ELSE
.BEGIN
@ :=
GA;
%
IRS,
GA;
.END;
NAMELIST[#] := @;
.END;
.ORIGIN 0;
.SET
OPTABLE[124](
'401,'041100,
&SHDLA
'402,'041200,
&SHDLC
'403,'041000,
&SHDLL
'404,'040100,
&SHDRA
'405,'040200,
&SHDRC
'406,'040000,
&SHDRL
'407,'041500,
&SHSLA
'410,'041600,
&SHSLC
'411,'041400,
&SHSLL
'412,'040500,
&SHSRA
'413,'040600,
&SHSRC
'414,'040400,
&SHSRL
0,
'1027,'101400,'140407,
&NEGABS
'447,'140442,
&INC2
'1030,'100400,'140407,
&ABS
'431,'141216,
&ADDC
'432,'140024,
&CHS
'433,'141050,
&CLEFT
'434,'140320,
©
'435,'141044,
&CRIGHT
'436,'141140,
&ICLEFT
'437,'141240,
&ICRIGHT
'440,'141206,
&INC
'441,'140407,
&NEG
'442,'140401,
&NOT
'443,'140500,
&SSM
'444,'140100,
&SSP
'445,'141340,
&SWOP
'446,'120777,
& ABUG
0,
'460,'101036,
&ANYKEY
'461,'101001,
&CSET
'465,'100036,
&NOKEY
'466,'100001,
&NOTC
'471,'101020,
& SENSE1
'472,'101010,
& SENSE2
'473,'101004,
& SENSE3
'474,'101002,
& SENSE4
0,
'676,-6,
& >
'573,-5,
& .GE
'674,-4,
& <
'574,-3,
& .LE
'675,-2,
& =
'575,-1,
& .NE
0,
'462,'100100,
&EVEN
'463,'100400,
&GEZ
'464,'101400,
&LZ
'467,'101040,
&NZ
'470,'101100,
&ODD
'475,'100040,
&Z
0,
'653,'014000,
& +
'655,'016000,
& -
'1252,'034000,'041161,
& *
'1257,'040161,'036000,
& /
'1571,'040161,'036000,'000201,
& .MOD
'570,'006000,
& AND
'572,'012000,
& NEV
0);
.ORIGIN 0;
.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;
.PROCEDURE NEWLINE;
.BEGIN OUT2('106612);
.END;
.PROCEDURE NOTDECLAREDCHECK;
.BEGIN .WHEN TYPE .NZ .THEN
.WHEN LEVEL =
CLEVEL .THEN FAIL(
DECTWICE);
.END;
.PROCEDURE NUMBER;
.INTEGER N;
.BEGIN .IF BASIC(
MINUSSYMBOL)
.THEN
.BEGIN NBS;
I := -1;
.END .ELSE I :=
.Z;
VALUE :=
.Z;
.IF BASIC(
OCTALSYMBOL)
.THEN
L1:
.BEGIN NBS;
.WHEN BS .LE SEVENSYMBOL .THEN
.WHEN @ -
ZEROSYMBOL .GEZ .THEN
.BEGIN VALUE := @
.SHDRL 3 +
VALUE .SHDLL 3;
.GOTO L1;
.END;
.END
.ELSE
.BEGIN
.IF DIGIT .THEN
VALUE :=
BS -
ZEROSYMBOL
.ELSE FAIL(
NONNUMERIC);
L2:
NBS;
.WHEN DIGIT .THEN
.BEGIN
N :=
BS - '260;
VALUE :=
VALUE .SHSLA 3 +
VALUE +
VALUE +
N;
.GOTO L2;
.END;
.END;
EXIT:
.WHEN I .LZ .THEN VALUE :=
.NEG VALUE;
.END;