.PROCEDURE STATEMENT;
.INTEGER STEPMARK,
FORADDRESS;
.SWITCH S =
SBUG,
BEGIN,
IND,
AC,
DAP,
EXITT,
EXITF,
FOR,
IF,
WHILE,
BASSIGN,
REPT,
GET,
UNTIL,
XUNLESS,
EXIT,
GOTO,
XSYM,
WHEN,
CASE;
.BEGIN
ENTER;
WORKING :=
.Z;
AGAIN:
.IF LETTER .THEN
.BEGIN IDENTIFIER;
.IF BASIC(
COLONSYMBOL)
.THEN
.BEGIN
.IF TYPE .NE LABEL .THEN
.BEGIN
NOTDECLAREDCHECK;
TYPE :=
LABEL;
MAKEDEC;
PUTADD(
LA);
.END
.ELSE
.BEGIN .IF LEVEL < 2
.THEN
.BEGIN .IF ADD .GEZ .THEN FAIL(
GLOB2LABEL)
.ELSE
.BEGIN PUTADD(
.SSP @);
INDEX :=
ADD;
CODE[#] :=
LOCAL;
.END
.END
.ELSE
.BEGIN .IF ADD .GEZ .THEN FAIL(
LOC2LABEL)
.ELSE .WHEN @
.NE '100777
.THEN
BACKPLUG(
.SSP @);
PUTADD(
LA);
.END
.END;
NBS;
.GOTO AGAIN;
.END
.ELSE .IF TYPE .AND '17776 = '10
.THEN PROCCALL
.ELSE
.BEGIN ID := -1;
ASSIGNMENTSTATEMENT;
.END
.END
.ELSE .FOR # :=
NUMOFTYPES .DO
.WHEN BASIC(
TYPES[#])
.THEN .GOTO S[#];
.GOTO COMMON;
SBUG:
GENERATE(
JSTI +
.ADDRESS SDEBUG);
NBS;
.GOTO COMMON;
BEGIN:
COMPSTATEMENT;
.GOTO COMMON;
IND:
AC:
ASSIGNMENTSTATEMENT;
.GOTO COMMON;
DAP:
CODESTATEMENT;
.GOTO COMMON;
EXITT:
EXITF:
.WHEN PROCPOSITION .LZ .THEN FAIL(
BADEXIT);
.WHEN BASIC(
EXITTRUE)
.THEN GENERATE(
IRS +
PROCPOSITION);
EXIT:
GENERATE(
.SSP PROCPOSITION +
JMPI);
NBS;
.GOTO COMMON;
REPT:
STACK(
LA);
NBS;
STATEMENT;
GENERATE(
UNSTACK +
JMPSO);
.GOTO COMMON;
BASSIGN:
NBS;
FAILIFNOT(
BECOMES);
EXPRESSION;
GENERATE(
IAB);
.GOTO COMMON;
FOR:
NBS;
.WHEN BASIC(
XSYMBOL)
.THEN
.BEGIN XASSIGNMENTSTATEMENT;
FORADDRESS :=
.Z;
.GOTO SIMFOR;
.END;
.IF BASIC(
STARSYMBOL)
.THEN
.BEGIN NBS;
FORADDRESS := '100000;
.END
.ELSE FORADDRESS :=
.Z;
IDENTIFIER;
.WHEN TYPE >
CONST .THEN FAIL(
FORNOTINT);
FORADDRESS :=
ADD +
FORADDRESS;
FAILIFNOT(
BECOMESSYMBOL);
EXPRESSION;
GENERATE(
STA +
FORADDRESS);
& MAY BE OVERWRITTEN
.WHEN BASIC(
TOSYMBOL)
.THEN
.BEGIN
NBS;
STACK(
LA);
GENERATE(
LDA +
FORADDRESS);
STEPMARK := -1;
.GOTO FORCOMMON;
.END;
.WHEN BASIC(
STEPSYMBOL)
.THEN
.BEGIN
@ := -2;
.GOTO COMSTEP;
.END;
.WHEN BASIC(
STEPDOWNSYMBOL)
.THEN
.BEGIN
@ :=
.Z;
COMSTEP:
STEPMARK := @;
STACK(
LA);
& THE (REDUNDANT) STORE INSTRUCTION
STACK(
LA-1);
& WILL BE OVERWRITTEN WITH THE JUMP
NBS;
EXPRESSION;
FAILIFNOT(
UNTILSYMBOL);
GENERATE(
ADDINSTRUCTION +
FORADDRESS);
PLUGJUMP(
LA);
GENERATE(
STA +
FORADDRESS);
FORCOMMON:
CELL;
GENVADDINST(
CAS);
.IF STEPMARK .LZ .THEN
.BEGIN
STACK(
LA); %
IRS,
LA;
GENERATE(
NOP);
.END .ELSE
.BEGIN
GENERATE(
NOP);
GENERATE(
SKP);
STACK(
LA);
%
IRS,
LA;
.END;
FAILIFNOT(
DOSYMBOL);
.WHEN .INC STEPMARK .Z .THEN STACK(
FORADDRESS);
STACK(
STEPMARK);
STATEMENT;
.WHEN .INC UNSTACK .Z .THEN GENERATE(
UNSTACK +
IRS);
PLUGJUMP(
LA + 1);
GENERATE(
UNSTACK +
JMPSO);
.GOTO COMMON;
.END;
SIMFOR:
FAILIFNOT(
DOSYMBOL);
STACK(
LA);
STACK(
FORADDRESS);
STATEMENT;
GENERATE(
UNSTACK +
IRS);
GENERATE(
UNSTACK +
JMPSO);
.GOTO COMMON;
IF:
STMARK := -1;
IFSTATEMENT;
.GOTO COMMON;
WHILE:
@ :=
.Z; %
SKP;
UNTIL:
INVERT := '1000;
NBS;
STACK(
LA);
CONDITION;
STACK(
FJADD);
FAILIFNOT(
DOSYMBOL);
STATEMENT;
PLUGJUMP(
LA+1);
GENERATE(
UNSTACK +
JMPSO);
.GOTO COMMON;
GET:
GETMARKER := -1;
NBS;
IDENTIFIER;
TYPEFIRST :=
.Z;
.IF TYPE .NE TABLE .THEN FAIL(
GETWRONGTYPE)
.ELSE SUBSCRIPT;
.WHEN BSCOMMA .THEN .GOTO GET;
GETMARKER :=
.Z;
.GOTO COMMON;
GOTO:
NBS;
.WHEN BASIC(
IFSYMBOL)
.THEN
.BEGIN
NBS;
CONDITION;
STACK(
FJADD);
FAILIFNOT(
THENSYMBOL);
IDENTIFIER;
MAKELABEL;
FAILIFNOT(
ELSESYMBOL);
IDENTIFIER;
.IF TYPE =
SWTCH .THEN
.BEGIN
PLUGJUMP(
LA);
MAKELABEL;
.END .ELSE
.BEGIN
K :=
LA;
LA :=
UNSTACK;
MAKELABEL;
LA :=
K;
.END;
.GOTO COMMON;
.END;
IDENTIFIER;
MAKELABEL;
.GOTO COMMON;
XSYM:
XASSIGNMENTSTATEMENT;
.GOTO COMMON;
CASE:
STMARK := -1;
CASESTATEMENT;
.GOTO COMMON;
WHEN:
@ :=
.Z; %
SKP;
XUNLESS:
INVERT := '1000;
NBS;
CONDITION;
STACK(
FJADD);
FAILIFNOT(
THENSYMBOL);
STATEMENT;
PLUGJUMP(
LA);
COMMON:
LEAVE;
.END;
& POP THIS DOWN HERE TO CREATE A BIT MORE SPACE FOR MAIN PROCEDURE
.PROCEDURE DECTEST;
.BEGIN
NBS;
IDENTIFIER;
NOTDECLAREDCHECK;
.END;
.ORIGIN 0;
.SET LHSINST[
LHSINDEX];
.SET ST[
STACKHEIGHT];
.SET WORKSPACE[
WORKSIZE];
.SET TYPES[
NUMOFTYPES] (
SBUGSYMBOL,
BEGINSYMBOL,
STARSYMBOL,
ACSYMBOL,
CODESYMBOL,
EXITTRUE,
EXITFALSE,
FORSYMBOL,
IFSYMBOL,
WHILEX,
BREGISTER,
REPEATSYMBOL,
GETSYMBOL,
UNTILSYMBOL,
UNLESSSYMBOL,
EXITSYMBOL,
GOTOSYMBOL,
XSYMBOL,
WHENSYMBOL,
CASESYMBOL);
.ARRAY TEST[0];
.SET CPOOL[
CPOOLSIZE];
.SET
OPTABLE[
SHIFT](
'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
'1576, '22000, '4000, '101000,
& MIN - CAS,LDA,NOP
'2177,
'22000, '101000, '100000, '4000,
& MAX - CAS,NOP,SKP,LDA
0);
.SET LINE[
LINESIZE],
TRACE[
CYCLESIZE];
.SET BASICS[
NOFBASICS]
(
INTSYMBOL,
DBLSYMBOL,
TABLESYMBOL,
TRIANGLE,
ARRAYSYMBOL,
CONSTSYMBOL,
CCONSTSYMBOL,
LABELSYMBOL,
ACSYMBOL,
CONDSYMBOL,
PROCSYMBOL,
FORWARDSYMBOL,
LISTSYMBOL,
SWITCHSYMBOL,
NEXTSECTORSYMBOL,
ORIGINSYMBOL,
STRINGSYMBOL,
GLOBALSYMBOL,
SETSYMBOL,
BLOCKSYMBOL,
FILESYMBOL,
PAPERTAPE,
EQUALSYMBOL);
.SET TERMTYPES[
WAYS OF BEGINNING]
(
ACSYMBOL,
ZEROIZE,
LRBSYMBOL,
IFSYMBOL,
ONEBS,
BREGISTER,
DOUBLEQUOTES,
CASESYMBOL);