First Page Previous Page   Next Page Last Page
.PROCEDURE CONSTEXPRESSION; .INTEGER SUM,SIGN; .BEGIN   ENTER;   SUM := .Z;   MORE:   SIGN := @;   .IF BASIC(GLOBALSYMBOL) .THEN   .BEGIN     @ := GA;     GLORIG:     VALUE := @;     NBS;   .END .ELSE   .IF BASIC(ORIGINSYMBOL) .THEN   .BEGIN     @ := LOCAL;     .GOTO GLORIG;   .END   .ELSE CONSTANT;   @ := SIGN .SHSRL 1 .NEV VALUE;   %SRC; %TCA;   SUM := @ + SUM;   .WHEN BASIC(PLUSSYMBOL) .THEN   .BEGIN     NBS;     @ := .Z;     .GOTO MORE;   .END;   .WHEN BASIC(MINUSSYMBOL) .THEN   .BEGIN     NBS;     @ := 1;     .GOTO MORE;   .END;   VALUE := SUM;   LEAVE; .END; .PROCEDURE CONSTANT; .BEGIN   ENTER;   VALUE := .Z;    & IN CASE ANYTING GOES BAD   .IF BASIC(CHARSYMBOL) .THEN   .BEGIN     .WHEN INCHAR .NE CHARSYMBOL .THEN VALUE := .SWOP @;     VALUE := INCHAR + VALUE;     NBS; VADD := .Z;   .END   .ELSE .IF NUMERICAL .THEN   .BEGIN  NUMBER; VADD := .Z;   .END   .ELSE .IF BASIC(ADDSYMBOL) .THEN   .BEGIN NBS;     .WHEN BASIC(STARSYMBOL) .THEN     .BEGIN VALUE := '100000;       NBS;     .END;     .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 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; .NEXTSECTOR; &********************************************************* .PROCEDURE DECLARATIONS;  .INTEGER THISDEC, 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 ,DBLOCK, DFILE, DPAPERTAPE, DEQUALS; .BEGIN   ENTER;   START :;    .FOR # := NOFBASICS .DO   .WHEN BASIC(BASICS[#]) .THEN   .BEGIN     %STX, THISDEC;  .GOTO SW[#];   .END;   DEX:   DLIST:   .WHEN BASIC(SEMICOLONSYMBOL) .THEN   .BEGIN NBS; .GOTO START;   .END;   LEAVE;   DINT:;   DECTEST;   TYPE := INT;    MAKEWORD;   EXTRA:    .WHEN BSCOMMA .THEN   .GOTO SW[THISDEC];   .GOTO DEX;      DEQUALS:   NBS;   CONSTEXPRESSION;   GENWORD(VALUE);   .GOTO EXTRA;   DBLOCK:   DECPOINTER := DECPOINTER - 3;   NAMELIST[DECPOINTER] := .Z;   %IRS, 0; NAMELIST[#] := CLEVEL;   CLEVEL := .INC @;   NBS;  DECLARATIONS;   LOCALCOLLAPSE;   FAILIFNOT(ENDBLOCKSYMBOL);   .GOTO DEX;   DDOUBLE:   DECTEST;   .IF LOCLEVEL .THEN   .WHEN LA .ODD .THEN %IRS,LA   .ELSE .WHEN GA .ODD .THEN %IRS,GA;   TYPE := INT;   MAKEWORD;   .IF LOCLEVEL .THEN %IRS,LA .ELSE %IRS,GA;   .GOTO EXTRA;   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;     GETADD;     VALUE := ARRTYPE;     SETWORD;   .END .ELSE ARRAYVALUES;   .GOTO EXTRA;   DCON:   DECTEST;   TYPE := CONST;    MAKEWORD;    STACK(GETADD);   FAILIFNOT(EQUALSSYMBOL);    CONSTEXPRESSION;   ADD := UNSTACK;    SETWORD;    .GOTO EXTRA;   DCCON: ;   DECTEST;   TYPE := COMPCONST;    MAKEDEC;   FAILIFNOT(EQUALSSYMBOL);    STACK(POS);    CONSTEXPRESSION;   POS := UNSTACK;   PUTADD(VALUE);   .GOTO EXTRA;   DLAB:   DECTEST;   TYPE := LABEL;    MAKEDEC;    .IF LOCLEVEL .THEN    PUTADD('100777)   .ELSE   .BEGIN     PUTADD(.SSM GA);     %IRS,GA;   .END;    .GOTO EXTRA;   DPROC:   SETKWITHPROCTYPE;    IDENTIFIER;    .IF TYPE .Z .THEN   .BEGIN     NEWLEVEL:     TYPE := K;      MAKEWORD;      CHAR1 := DECPOINTER;   .END   .ELSE   .BEGIN     .WHEN LEVEL .Z .THEN .GOTO NEWLEVEL; & PRE-DECLARED     .WHEN TYPE .NE  K .THEN      FAIL(DIFFPROCTYPE);     .WHEN GETCODE(GETADD) .NZ .THEN FAIL(PDECTWICE);    .END;   STACK(POS);   FAILIFNOT(SEMICOLONSYMBOL);   .WHEN .SENSE4 .THEN   .BEGIN     NEWLINE;  LOCDP := CHAR1;     PRINTIDENT;  OUTSIX(LOCAL);   .END;   DECPOINTER := DECPOINTER - 3;    NAMELIST[DECPOINTER] := .Z;   %IRS,0; NAMELIST[#] := CLEVEL;   CLEVEL := .INC @;    DECLARATIONS;    POS := UNSTACK;   .WHEN GETADD - '1000 .GEZ .THEN ADD := @ + LSTART;   CODE[ADD] := LOCAL;   TYPE := NAMELIST[POS];   STACK(LA);    PROCPOSITION := LA + '101000;   .WHEN TYPE .AND '177776 = '12 .THEN   PROCPOSITION := .SSP PROCPOSITION;   GENERATE(.Z);   STATEMENT;    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 LOCLEVEL .THEN @ := '100777     .ELSE     .BEGIN       @ := .SSM GA; %IRS,GA;     .END;     ADD := @;     PUTADD(@);   .END;   .IF LEVEL < 2 .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;   NSTART := LOCAL + '1000  .AND '177000;   .GOTO ORG;   DORG: ;   NBS;   CONSTEXPRESSION;   .WHEN VALUE .Z .THEN   @ := .NEG CPPT .SHSRA 1 + LSTART + LA;   NSTART := @;   ORG:   CLEARPOOL;   NEWLINE; OUTSIX(LOCAL);   LSTART := NSTART .AND '177000;   LA := @ .NEV NSTART;   .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 GENWORD(J + BS);     %IRS,K;     .GOTO MORE5   .END;    .WHEN K .ODD .THEN   GENWORD(J + SPACE);   NBS;    .GOTO EXTRA;   DGLOBAL:   NEWLINE; OCTAL3(GA);   NBS;   CONSTEXPRESSION;   GA := VALUE;   .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;   .GOTO EXTRA;   DFILE:   .FOR JJ := -3 .DO   .BEGIN     NBS;  KK := .SWOP BS;     NBS;  @ := BS .NEV KK;     # := JJ; %STA*'771;   & MAKE UP FILENAME   .END;   INDEVICE := 1;  %IAB;  & SET UP PARMS FOR 'OPEN'   @ := .CODEWORD LINE;   %JST*'763;  & OPEN FILE   NBSDEX:   NBS;   .GOTO START;   DPAPERTAPE:   INDEVICE := -1; .GOTO NBSDEX; .END; .NEXTSECTOR; &*********************************************************
First Page Previous Page   Next Page Last Page