.PROCEDURE CONSTANT;
.BEGIN
ENTER;
.IF BASIC(
CHARSYMBOL)
.THEN
.BEGIN VALUE :=
.SWOP INCHAR;
VALUE :=
INCHAR +
VALUE;
NBS;
VADD :=
.Z;
.END
.ELSE .IF NUMERICAL .THEN
.BEGIN NUMBER;
VADD :=
.Z;
.END
.ELSE .IF BASIC(
ADDSYMBOL)
.THEN
.BEGIN NBS;
.IF BASIC(
STARSYMBOL)
.THEN
.BEGIN VALUE := '100000;
NBS;
.END
.ELSE VALUE :=
.Z;
.WHEN BASIC(
COLONSYMBOL)
.THEN
.BEGIN NBS;
VALUE :=
VALUE + '40000;
.END;
TYPEIDENT;
.WHEN ADD > '777
.THEN ADD := @ - '1000 +
LSTART;
VALUE :=
VALUE +
ADD;
VADD :=
.Z;
.END
.ELSE .IF LETTER .THEN
.BEGIN IDENTIFIER;
.IF TYPE =
CONST .THEN
.BEGIN VALUE :=
GETCODE(
ADD);
VADD :=
ADD;
.END
.ELSE .IF @ =
COMPCONST .THEN
.BEGIN VALUE :=
ADD;
VADD :=
.Z;
.END
.ELSE FAIL(
NOTCONST);
.END
.ELSE .IF BASIC(
LABRACKET)
.THEN
.BEGIN
NBS;
CONSTEXPRESSION;
.WHEN BSCOMMA .THEN
.BEGIN
STACK(
VALUE);
NBS;
CONSTEXPRESSION;
@ :=
VALUE .SHDRL 8;
VALUE :=
UNSTACK .SHDLL 8;
.END;
VADD :=
.Z;
FAILIFNOT(
RABRACKET);
.END
.ELSE FAIL(
BADSTART);
LEAVE;
.END;
.PROCEDURE DECTEST;
.BEGIN
NBS;
IDENTIFIER;
NOTDECLAREDCHECK;
.END;
@
.PROCEDURE DAPPRINT;
.INTEGER INST;
.BEGIN
INST := @;
OUT1(
SPACE);
IDFLAG,
TAB :=
.Z;
.IF INST .AND '36000 = '30000
.THEN
.BEGIN
.IF DAPDECODE(
INST .AND '176000)
.NZ .THEN
.BEGIN
OUT3X(@);
OUTSIX(
INST .AND '1777);
.END
.ELSE
.GOTO GENERIC;
.END
.ELSE .IF @
.Z .THEN
.BEGIN
.IF INST .AND '140000 - '40000
.Z .THEN
.WHEN DAPDECODE(
INST .AND '177700)
.NZ .THEN
.BEGIN
OUT3X(@);
OCTAL3(
.NEG INST .AND '77);
.END
.ELSE
GENERIC:
.WHEN DAPDECODE(
INST)
.NZ .THEN OUT3X(@);
.END
.ELSE
.WHEN INST .AND '176000
.NE '176000
.THEN
.BEGIN
.IF INST .AND '76000 - '72000
.Z .THEN
.BEGIN
OUT3X('30230);
& LDX
.IF INST .LZ .THEN OUT1(
STARSYMBOL)
.ELSE OUT1(
SPACE);
OUT1(
SPACE);
.END
.ELSE
.BEGIN
OUT3X(
DAPDECODE(
INST .AND '36000));
.IF INST .LZ .THEN OUT1(
STARSYMBOL)
.ELSE OUT1(
SPACE);
.IF INST .SHSLL 1
.LZ .THEN OUT1(
COLONSYMBOL)
.ELSE OUT1(
SPACE);
.END;
.IF INST .AND '1000
.NZ .THEN
@ :=
INST .AND '777 +
LSTART
.ELSE @ :=
INST .AND '777;
OUTSIX(@);
.END;
.END;
.SET TERMTYPES[
WAYS OF BEGINNING]
(
ACSYMBOL,
ZEROIZE,
LRBSYMBOL,
IFSYMBOL,
ONEBS,
BREGISTER);
.NEXTSECTOR;
.PROCEDURE DECLARATIONS;
.INTEGER JJ,
KK;
.ARRAY ATYPE[3] (
ARRAY,
TABLE,
TABLE);
.SWITCH SW =
DINT,
DDOUBLE,
DTABLE,
DTRIANGLE,
DARR,
DCON,
DCCON,
DLAB,
DPROC,
DPROC,
DPROC,
DFORW,
DLIST,
DSWITCH,
DNEXT,
DORG,
DSTRING,
DGLOBAL,
DSET;
.BEGIN
ENTER;
START :;
.FOR # :=
NOFBASICS .DO .WHEN BASIC(
BASICS[#])
.THEN .GOTO SW[#];
DEX:
DLIST:
.WHEN BASIC(
SEMICOLONSYMBOL)
.THEN
.BEGIN NBS;
.GOTO START;
.END;
.WHEN BS .NE BEGINSYMBOL .THEN
.BEGIN
FAIL(
BEGINSYMBOL);
.UNTIL BASIC(
SEMICOLONSYMBOL)
.DO NBS;
.GOTO START;
.END;
LEAVE;
DINT:;
DECTEST;
TYPE :=
INT;
MAKEWORD;
.WHEN BSCOMMA .THEN
.GOTO DINT;
.GOTO DEX;
DDOUBLE:
DECTEST;
.IF CLEVEL .EVEN .THEN
.WHEN LA .ODD .THEN %
IRS,
LA
.ELSE .WHEN GA .ODD .THEN %
IRS,
GA;
TYPE :=
INT;
MAKEWORD;
.IF CLEVEL .EVEN .THEN %
IRS,
LA .ELSE %
IRS,
GA;
.WHEN BSCOMMA .THEN .GOTO DDOUBLE;
.GOTO DEX;
DARR:
@ := -3;
.GOTO ARRCOMMON;
DTABLE:
@ := -2;
.GOTO ARRCOMMON;
DTRIANGLE:
@ := -1;
ARRCOMMON:
ARRTYPE := @;
NEXTARRAY:
DECTEST;
TYPE :=
ATYPE[
ARRTYPE];
MAKEWORD;
.WHEN ARRTYPE + 2
.GEZ .THEN
.IF CLEVEL .EVEN .THEN %
IRS,
LA .ELSE %
IRS,
GA;
.IF BASIC(
LATERSYMBOL)
.THEN
.BEGIN
NBS;
.WHEN CLEVEL .EVEN .THEN FAIL(
NESTLATER);
GETADD;
VALUE :=
ARRTYPE;
SETWORD;
.END .ELSE ARRAYVALUES;
.WHEN BSCOMMA .THEN .GOTO NEXTARRAY;
.GOTO DEX;
DCON: ;
DECTEST;
TYPE :=
CONST;
MAKEWORD;
STACK(
GETADD);
FAILIFNOT(
EQUALSSYMBOL);
CONSTEXPRESSION;
ADD :=
UNSTACK;
SETWORD;
.WHEN BSCOMMA .THEN
.GOTO DCON;
.GOTO DEX;
DCCON: ;
DECTEST;
TYPE :=
COMPCONST;
MAKEDEC;
FAILIFNOT(
EQUALSSYMBOL);
STACK(
POS);
CONSTEXPRESSION;
POS :=
UNSTACK;
PUTADD(
VALUE);
.WHEN BSCOMMA .THEN
.GOTO DCCON;
.GOTO DEX;
DLAB: ;
DECTEST;
TYPE :=
LABEL;
MAKEDEC;
.IF CLEVEL .EVEN .THEN
PUTADD('100777)
.ELSE
.BEGIN
PUTADD(
.SSM GA);
%
IRS,
GA;
.END;
.WHEN BSCOMMA .THEN
.GOTO DLAB;
.GOTO DEX;
DPROC: ;
SETKWITHPROCTYPE;
IDENTIFIER;
.IF TYPE .Z .THEN
.BEGIN
NEWLEVEL:
TYPE :=
K;
MAKEWORD;
.END
.ELSE
.BEGIN
.WHEN LEVEL -
CLEVEL .NZ .THEN .GOTO NEWLEVEL;
.WHEN TYPE .NE K .THEN
FAIL(
DIFFPROCTYPE);
.END;
STACK(
POS);
FAILIFNOT(
SEMICOLONSYMBOL);
CLEVEL := 2;
DECPOINTER :=
DECPOINTER - 3;
NAMELIST[
DECPOINTER] :=
.Z;
%
IRS,0;
NAMELIST[#] := 1;
DECLARATIONS;
POS :=
UNSTACK;
INDEX :=
GETADD;
CODE[#] :=
LOCAL;
TYPE :=
NAMELIST[
POS];
STACK(
LA);
PROCPOSITION :=
LA + '101000;
.WHEN TYPE .AND '177776 = '12
.THEN
PROCPOSITION :=
.SSP PROCPOSITION;
GENERATE(
.Z);
COMPSTATEMENT;
GENERATE(
UNSTACK +
JMPI + '1000);
CLEARWORKSPACE;
LOCALCOLLAPSE;
.GOTO DEX;
DFORW: ;
NBS;
SETKWITHPROCTYPE;
MORE12:
IDENTIFIER;
NOTDECLAREDCHECK;
TYPE :=
K;
MAKEWORD;
JJ :=
GETADD;
.IF BASIC(
EQUALSSYMBOL)
.THEN
.BEGIN
NBS;
CONSTEXPRESSION;
@ :=
VALUE;
.END
.ELSE @ :=
.Z;
CODE[
JJ] := @;
.WHEN BSCOMMA .THEN
.BEGIN
NBS;
.GOTO MORE12;
.END;
.GOTO DEX;
DSWITCH: ;
DECTEST;
TYPE :=
SWTCH;
MAKEWORD;
FAILIFNOT(
EQUALSSYMBOL);
STACK(
GETADD);
MORE13:;
IDENTIFIER;
.WHEN TYPE .NE LABEL .THEN
.BEGIN
NOTDECLAREDCHECK;
TYPE :=
LABEL;
MAKEDEC;
LEVEL :=
CLEVEL;
.IF @
.EVEN .THEN @ := '100777
.ELSE
.BEGIN
@ :=
.SSM GA; %
IRS,
GA;
.END;
ADD := @;
PUTADD(@);
.END;
.IF LEVEL .ODD .THEN
GENERATE(
.SSM ADD)
.ELSE
.BEGIN
PUTADD(
.SSM LA);
GENERATE(
.SSP(
ADD +
LSTART));
.END;
.WHEN BSCOMMA .THEN
.BEGIN
NBS;
.GOTO MORE13
.END;
ADD :=
UNSTACK;
VALUE :=
LOCAL + '140000;
SETWORD;
.GOTO DEX;
DNEXT: ;
NBS;
FORCENEXTSECTOR:
.IF CLEVEL .ODD .THEN
.BEGIN
NSTART :=
LOCAL + '1000
.AND '177000;
.GOTO ORG
.END
.ELSE FAIL(
LOCNEXTSEC);
.GOTO DEX;
DORG: ;
NBS;
CONSTEXPRESSION;
.WHEN VALUE .Z .THEN
@ :=
.NEG CPPT .SHSRA 1 +
LSTART +
LA;
NSTART := @;
.IF CLEVEL .ODD .THEN
.BEGIN
ORG:
CLEARPOOL;
.WHEN .SENSE4 .THEN
.BEGIN
NEWLINE;
OUTSIX(
LOCAL);
.END;
LSTART :=
NSTART .AND '177000;
LA := @
.NEV NSTART;
.END
.ELSE
FAIL(
LOCORGDEC);
.GOTO DEX;
DSTRING: ;
DECTEST;
TYPE :=
ARRAY;
MAKEWORD;
GETADD;
VALUE :=
LOCAL + '40000;
SETWORD;
.WHEN BS .NE EQUALSSYMBOL .THEN
FAIL(
NULLSTRING);
VISIBLECHAR:
INCHAR;
.WHEN BASIC(
SPACE)
.THEN .GOTO VISIBLECHAR;
CHAR1 :=
BS;
K :=
.Z;
MORE5 :;
INCHAR;
.WHEN BS .NE CHAR1 .THEN
.BEGIN
.IF K .EVEN .THEN
J :=
.SWOP BS
.ELSE
.BEGIN
GENWORD(
J +
BS);
.END;
%
IRS,
K;
.GOTO MORE5
.END;
.WHEN K .ODD .THEN
.BEGIN
GENWORD(
J +
SPACE);
.END;
NBS;
.WHEN BSCOMMA .THEN
.GOTO DSTRING;
.GOTO DEX;
DGLOBAL: ;
.WHEN .SENSE4 .THEN
.BEGIN NEWLINE;
OCTAL3(
GA);
.END;
NBS;
CONSTEXPRESSION;
GA :=
VALUE;
.WHEN @ -
HIGHZERO .GEZ .THEN FAIL(
SECOFLO);
.GOTO DEX;
DSET: ;
NBS;
IDENTIFIER;
.WHEN TYPE =
ARRAY .THEN .GOTO PASS;
.WHEN @
.NE TABLE .THEN FAIL(
SETNARRAY);
PASS:
.IF GETCODE(
ADD)
.GEZ .THEN FAIL(
ARRTWICE)
.ELSE .BEGIN
ARRTYPE := @;
ARRAYVALUES;
.END;
.WHEN BSCOMMA .THEN .GOTO DSET;
.GOTO DEX;
.END;