.ORIGIN START + '200;
.PROCEDURE SUBSCRIPT;
.ARRAY TYPEOF[5](
INT,
CONST,
COMPCONST,
ARRAY,
TABLE);
.SWITCH TO =
ISYM,
CSYM,
CCSYM,
ARSYM,
TABSYM;
.BEGIN
ENTER;
FAILIFNOT(
LSBSYMBOL);
ARRTYPE :=
TYPE;
TYPEFIRST :=
.Z;
OTHER:
STACK(
ADD);
.WHEN BASIC(
XSYMBOL)
.THEN
.BEGIN
NBS;
.WHEN TYPEFIRST .NZ .THEN
.BEGIN
TYPEFIRST :=
.Z;
FAIL(
CORRUPTINDEX);
.END;
.GOTO CONT;
.END;
.IF LETTER .THEN
.BEGIN
IDENTIFIER;
.FOR # := -5
.DO
.WHEN TYPE =
TYPEOF[#]
.THEN .GOTO TO[#];
FAIL(
BADSUBSCRIPT);
.GOTO CONT;
TABSYM:
@ :=
ADD + '100001;
.GOTO TABARR;
ARSYM:
@ :=
.SSM ADD;
TABARR:
STACK(@);
STACK(
ARRTYPE);
SUBSCRIPT;
ARRTYPE :=
UNSTACK;
ADD :=
UNSTACK;
.GOTO ISYM;
CCSYM:
VALUE :=
ADD;
ADD :=
.Z;
ISYM:
CSYM:
.END
.ELSE
.BEGIN
CONSTANT;
ADD :=
.Z;
.END;
%
IRS,
TYPEFIRST;
.IF STATELHS .LZ .THEN
.BEGIN
.IF ADD .Z .THEN
.BEGIN
LHSPUT(
.Z);
LHSPUT(
LDX);
LHSPUT(
VALUE);
.END .ELSE LHSPUT(
LDX +
ADD);
.END
.ELSE .BEGIN
.WHEN ADD .Z .THEN MAKECONST;
GENERATE(
LDX +
ADD);
.END;
CONT:
ADD :=
UNSTACK;
.WHEN ARRTYPE =
TABLE .THEN
.BEGIN
ARRTYPE :=
ARRAY;
.WHEN TYPEFIRST .NZ .THEN
.IF STATELHS .LZ .THEN
.BEGIN
LHSPUT(
LDXI +
ADD);
LHSPUT(
STX1 +
ADD);
.END
.ELSE .BEGIN
GENERATE(
LDXI +
ADD);
GENERATE(
STX1 +
ADD);
.END;
%
IRS,
ADD;
.WHEN GETMARKER .NZ .THEN .GOTO GETEXIT;
FAILIFNOT(
COMMASYMBOL);
.GOTO OTHER;
.END;
GETEXIT:
FAILIFNOT(
RSBSYMBOL);
LEAVE;
.END;
.PROCEDURE TERM;
.SWITCH JOB =
AC,
ZERO,
LRB,
IF,
ONE,
B;
.BEGIN ENTER;
OPCOUNT :=
.Z;
MOREUNARY:
.WHEN ID .Z .THEN
.WHEN BSIS(
UNARY)
.THEN
.BEGIN %
IRS,
OPCOUNT;
STACK(
ADDBS);
NBS;
.GOTO MOREUNARY;
.END;
STACK(
OPCOUNT);
.WHEN ID .LZ .THEN .GOTO OK;
.IF LETTER .THEN
.BEGIN IDENTIFIER;
OK:
.IF TYPE .AND '177776 = '10
.THEN
.BEGIN PROCCALL;
ID :=
.Z;
.END .ELSE
.BEGIN ID := -1;
CELL;
GENVADDINST(
LDA);
.END;
.END .ELSE
.BEGIN
.FOR # :=
WAYS OF BEGINNING .DO
.WHEN BASIC(
TERMTYPES[#])
.THEN .GOTO JOB[#];
.GOTO PASSON;
AC:
NBS;
.GOTO DONE;
ZERO:
NBS;
GENERATE(
CRA);
.GOTO DONE;
LRB:
NBS;
EXPRESSION;
FAILIFNOT(
RRBSYMBOL);
.GOTO DONE;
IF:
STMARK :=
.Z;
IFSTATEMENT;
.GOTO DONE;
ONE:
NBS;
GENERATE('140402);
& LOAD ONE INTO A-REG
.GOTO DONE;
B:
NBS;
GENERATE(
IAB);
.GOTO DONE;
PASSON:
CELL;
GENVADDINST(
LDA);
.END;
DONE:
.WHEN UNSTACK .NZ .THEN
.FOR OPCOUNT :=
.NEG @
.DO
.BEGIN ADDBS :=
UNSTACK;
GENMACRO;
.END;
LEAVE;
.END;
.PROCEDURE TYPEIDENT;
.ARRAY TYPES [3] (0,
COMPCONST,
LABEL);
.LABEL BAD,
LABELTYPE;
.SWITCH S =
BAD,
BAD,
LABELTYPE;
.BEGIN
IDENTIFIER;
.FOR # := -3
.DO
.WHEN TYPE =
TYPES[#]
.THEN .GOTO S[#];
.GOTO SKIP;
BAD:
FAIL(
WRONGTYPE);
.GOTO SKIP;
LABELTYPE:
.WHEN LEVEL = 2
.THEN
.BEGIN
.WHEN ADD .LZ .THEN
PUTADD('100000 +
LA);
ADD :=
ADD + '1000;
.END;
SKIP:
ADD :=
ADD .AND '1777;
.END;
.PROCEDURE UNSTACK;
.BEGIN STACKPOINTER :=
STACKPOINTER - 1;
@ :=
ST[
STACKPOINTER];
.END;
.PROCEDURE XASSIGNMENTSTATEMENT;
.BEGIN
NBS;
FAILIFNOT(
BECOMESSYMBOL);
CELL;
GENVADDINST(
LDX);
.END;
.ORIGIN 0;
.SET LHSINST[
LHSINDEX];
.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);
&MAIN
.ORIGIN START;
.BEGIN
.GOTO COMPILE;
.GOTO ESCAPE;
&ENTRY AT SECOND WORD
.GOTO NEWMAINPROG;
COMPILE:
INDEVICE := -1;
&FACIT READER
CYCLE :=
CYCLESIZE;
.FOR # :=
CYCLESIZE .DO TRACE[#] :=
.Z;
@ := '40000;
%
STA,
CODE;
& CODE IS NOW THE CORE STORE
CLEVEL := 1;
DECPOINTER :=
PERMANENTDECLARATIONS;
STACKPOINTER :=
STACKHEIGHT;
MAXWORK,
WORKING,
WORKFLAG,
ID,
EXPLICITCONST,
KEPT,
ALLOWSPACE,
CPPT,
GETMARKER,
ERRORS,
LA :=
.Z;
GA := '100;
LSTART := '2000;
NBS;
DECLARATIONS;
DECPOINTER :=
DECPOINTER - 3;
NAMELIST[
DECPOINTER] :=
.Z; %
IRS,0;
NAMELIST[#] := 1;
CLEVEL := 2;
PROCPOSITION := -1;
COMPSTATEMENT;
GENERATE(
HLT);
CLEARWORKSPACE;
CLEARPOOL;
GLOBCOLLAPSE;
NEWLINE;
.IF ERRORS .Z .THEN OUT2($
OK)
.ELSE OUT2($
ER);
.WHEN .SENSE4 .THEN
.BEGIN
NEWLINE;
OUTSIX(
LOCAL);
OCTAL3(
GA);
.END;
%
HLT;
ESCAPE: ;
INDEVICE :=
.Z;
&TELETYPR
NEWLINE;
OUT2($->);
NEWMAINPROG:
DECPOINTER :=
LOCDP;
CLEVEL := 2;
KEPT :=
.Z;
TESTSTART :=
.CODEWORD TEST .AND '37777;
LSTART :=
TESTSTART .AND '177000;
LA :=
TESTSTART .AND '777;
NBS;
.WHEN BASIC(
EMSYMBOL)
.THEN .GOTO REPEAT;
STATEMENT;
GENERATE(
.ADDRESS ESCAPE +
JMPI);
CLEARWORKSPACE;
CLEARPOOL;
LOCALCOLLAPSE;
NEWLINE;
REPEAT:
%
JMP*
TESTSTART;
.END
.EM