BEGIN                                                                   00000490 
% THIS APL/B5500 PROGRAM WAS DEVELOPED BY THE COMPUTER SCIENCE GROUP
% AT THE UNIVERSITY OF WASHINGTON UNDER THE SPONSORSHIP OF PROFESSOR
% HELLMUT GOLDE.  THE PROGRAM MAY BE NOT BE OFFERED FOR SALE OR LEASE
% IN ITS ORIGINAL OR ANY MODIFIED FORM.  ANY PUBLICATION RELATING TO
% THIS PROGRAM OR ANY MODIFICATION OF THE PROGRAM MUST EXPLICITLY CREDIT
% THE COMPUTER SCIENCE GROUP OF THE UNIVERSITY OF WASHINGTON AND THE
% PRINCIPAL IMPLEMENTORS, GARY KILDALL, LEROY SMITH, SALLY SWEDINE,
% AND MARY ZOSEL.  COMPUTER RESOURCES FOR THE DEVELOPMENT OF THE
% PROGRAM WERE MADE AVAILABLE BY THE UNIVERSITY OF WASHINGTON COMPUTER
% CENTER.
DEFINE VERSIONDATE="1-11-71"# ;
%MODIFICATIONS FOR B-5500 TIME-SHARING MCP MADE BY:
% JOSE HERNANDEZ, BURROUGHS CORPORATION.
BOOLEAN BREAKFLAG;
ARRAY GIA[0:1];
LABEL FINIS; %GO THERE WHEN YOU ARE IN TROUBLE (SPOUT A MESSAGE)
BOOLEAN PROCEDURE LIBRARIAN(A,B); VALUE A,B: REAL A,B; FORWARD;
LABEL FAULTL; % FAULT LABEL
MONITOR EXPOVR,INTOVR,INDEX:=INDEXF,FLAG,ZERO;
REAL BIGGEST, NULLV;
INTEGER STACKSIZE,LIBSIZE;
    REAL STATUSWORD,CORELOC;
    BOOLEAN RETURN;
BOOLEAN MEMBUG,DEBUG;
COMMENT   MEMBUG  SWITCHES ----------------------
            BIT        FUNCTION        BIT     FUNCTION
-----------------------------------------------------------------
            1                           25
            2                           26
            3                           27
            4                           28
            5     DUMP TYPES @ INSERT   30
            6    DUMP TYPES @ DELETE  30
            7                           31
            8                           32
            9                           33
           10                           34
           11                           35
           12                           36
           13                           37
           14                           38
           15                           39
           16                           40
           17                           41
           18                           42
           19                           43
           20     DUMP INDEX            44
           21                           45
           22     DUMP TYPES            46
           23     CHECK TYPES           47
           24     DUMP BUFFER #S
           ;
FILE PRINT 4 "SYSTEMS" " BOX   " (1,15);
FILE TWXIN 19(2,30),TWXOUT 19(2,10);
%
DEFINE
    PAGESIZE=120#,
    AREASIZE=40#,
    CF=[26:13]#,    COMMENT COUNT FIELD -- NUMBER OF ITEMS ON PAGE;
    TF=[39:9] #,    COMMENT     T-FIELD (TYPE FIELD);
    FF=[9:1]#,  COMMENT FULL FIELD FOR SEQUENTIAL STORAGE;
    AF=[1:23] #,    COMMENT A-FIELD;
    BF=[24:23]#,    COMMENT B-FIELD;
    MF=[1:1]#,    COMMENT METHOD OF STORAGE FIELD;
    SF=[13:13]#,    COMMENT SEQUENTIAL STORAGE SIZE FIELD (#CHRS);
    BOOL=[47:1]#,
    SKIP=1#,        COMMENT --AMOUNT OF SPACE RESERVED AT THE
                    START OF EACH PAGE;
    ALLOWANCE=10#,  COMMENT --DEVIATION FROM THE AVERAGE PAGE SIZE
                    ALLOWED BEFORE CORRECTION;                          00001550
    RECSIZE=2#,
    MAXPAGES=20#,
    PAGESPACE=20#,
    NEXTP=[42:6]#,
    LASTP=[36:6]#,
    PAGEF=[19:11]#,
    BUFF=[12:6]#,
    CHANGEDBIT=[1:1]#,
    MBUFF=8#,
    SBUFF=4#,
    FLAGB=[18:1]#,    COMMENT FLAG BIT FOR BUFFER MAINTENANCE;
    EXTRAROOM=1#,
    LIBJOB="/APLIBE"#,%MFID FOR APL SYSTEM FILE
    ENDOFDEFINES=#;
REAL PROCEDURE CDR(X); VALUE X; REAL X; CDR:=X.NEXTP;
PROCEDURE RPLACD(X,Y); VALUE Y;REAL X,Y; X.NEXTP:=Y;
BOOLEAN PROCEDURE NULL(X); VALUE X; REAL X;  NULL:=X.NEXTP=0;
BOOLEAN STREAM PROCEDURE EOFMARK(SK,RS,A); VALUE SK,RS;
    BEGIN LABEL NO; SI:=A; SK(SI:=SI+8);
    RS(8(  2(IF SB THEN JUMP OUT 3 TO NO; SKIP SB);
    3(IF SB THEN SKIP SB ELSE JUMP OUT 3 TO NO); IF SB THEN
    JUMP OUT 2 TO NO; SKIP SB));TALLY:=1;EOFMARK:=TALLY;
    NO:
    END;
STREAM PROCEDURE MARKEOF(SK,RS,A); VALUE SK,RS;
    BEGIN DI:=A;
    SK(DI:=DI+8);
    RS(8(DS:=2RESET; DS:=3SET; DS:=RESET));
    END;
SAVE FILE ESTABLISH DISK [MAXPAGES:AREASIZE]
    (1,PAGESIZE,SAVE 100);
FILE NEWDISK DISK (1,PAGESIZE);
FILE DISK1 DISK (1,PAGESIZE),
     DISK2 DISK (1,PAGESIZE),
     DISK3 DISK (1,PAGESIZE),
     DISK4 DISK (1,PAGESIZE),
     DISK5 DISK (1,PAGESIZE),
     DISK6 DISK (1,PAGESIZE),
     DISK7 DISK (1,PAGESIZE),
     DISK8 DISK (1,PAGESIZE);
SWITCH FILE POINTERS:=DISK1,DISK1,DISK2,DISK3,DISK4,DISK5,DISK6,DISK7,
    DISK8;
PROCEDURE SETPOINTERNAMES;
    BEGIN
        IF NOT LIBRARIAN(LIBJOB,TIME(-1)) THEN
        BEGIN
        WRITE(ESTABLISH);
        MARKEOF(SKIP,RECSIZE,ESTABLISH(0));
        WRITE(ESTABLISH[1]);
        WRITE(ESTABLISH[MAXPAGES|AREASIZE-1]);
        LOCK(ESTABLISH);
        CLOSE(ESTABLISH)
        ;LIBSIZE~-1;
        END
    END;
DEFINE
    LIBMAINTENANCE=0#,
    MESSDUM=#;
    PROCEDURE MEMORY(MODE,TYPE,A,N,M);VALUE MODE,TYPE;
        INTEGER MODE,TYPE,N,M; ARRAY A[0]; FORWARD;
STREAM PROCEDURE MOVE(A,N,B); VALUE N;
    BEGIN SI:=A; DI:=B; DS:=N WDS;
    END;
PROCEDURE MESSAGE(I); VALUE I; INTEGER I;
    BEGIN
    FORMAT F("MEMORY ERROR",I5);
COMMENT CHANGE LINE 3050 TO WRITE(PRINT,SF[I]) FOR MEMORY ERROR PROBS.
    THIS FORMAT IS NOW EXCLUDED SINCE MEMORY IS SEEMINGLY WELL DEBUGED
    SWITCH FORMAT SF:=
    ("LIBRARY MAINTENANCE IN PROGRESS."),
    ("SYSTEM ERROR--MEMORY ACCESS WITH EXPRESSION FOR N OR M."),
    ("SYSTEM ERROR--IMPROPER ARGUMENTS TO FREEPAGE."),
    ("SYSTEM ERROR--TOO LARGE A SUBSCRIPT FOR TYPE SPECIFIED."),
    ("SYSTEM ERROR--TYPE CANNOT BE ZERO WHEN INSERTING OR DELETING."),
    ("SYSTEM ERROR--CHARACTER STTRING TOO LONG TO STORE."),
    ("SYSTEM ERROR--ATTEMPT TO INSERT NON-SEQUENTIAL ELEMENT",
     "IN TYPE A STORAGE."),
    ("SYSTEM ERROR--NO BLANKS IN PAGES."),
    ("SYSTEM ERROR--ATTEMPTED BINARY SEARCH OF UNORDERED DATA."),
    ("SYSTEM ERROR--BINARY SEARCH OF UNALLOCATED DATA ATTEMPTED."),
    ("SYSTEM ERROR--BINARY SEARCH FOUND A BLANK PAGE."),
    ("SYSTEM ERROR--DELETION OF TYPE B STORAGE NOT IMPLEMENTED."),
    ("SYSTEM ERROR--ATTEMPT TO DELETE FROM NON-EXISTENT STORAGE."),     00002970
    ("SYSTEM ERROR--ATTEMPT TO DELETE RECORD FROM OUTSIDE",
     " ALLOCATED STORAGE."),
    ("SYSTEM ERROR--ATTEMPTED MEMORY SEARCH WITH -N- TOO LARGE."),
    ("SYSTEM ERROR--ATTEMPT TO CHANGE PREVIOUSLY DEIGNATED STORAGE",
     " KIND"),
    ("SYSTEM ERROR--POINTERS TO DATA TYPES OVERLAP."),
    (" ");
    WRITE(PRINT,F,I);
    IF I GTR 0 THEN
        BEGIN
        INTEGER GT1,GT2,GT3;
        MEMORY(10,GT1,GIA,GT2,GT3);
        GO TO FINIS;
        END;
    END;
PROCEDURE MEMORY(MODE,TYPE,A,N,M); VALUE MODE,TYPE;
    INTEGER MODE,TYPE,N,M; ARRAY A[0];
    BEGIN
DEFINE T64= DI:=LOC T; DI:=DI+1; DS:=7 CHR#;
STREAM PROCEDURE WRITERECS(PAGE,A,SKP,NB,NR,NS,RL);
    VALUE SKP,NB,NR,NS,RL;
    BEGIN
    COMMENT -- NS IS THE NUMBER OF WORDS TO SAVE (ON THE
    TAIL OF THE PAGE);
    LOCAL T,T1,T2,TT;
    COMMENT -- MOVE TO POSITION FOR WRITE;
    SI:=LOC NB; T64; SI:=PAGE; SKP(SI:=SI+8);
    T(2(32(RL(SI:=SI+8)))); NB(RL(SI:=SI+8));
    T1:=SI; COMMENT -- RECORDS WILL BE WRITTEN HERE;
    DI:=LOC TT; SI:=LOC NS; DI:=DI+1; DS:=7CHR;
    SI:=T1; COMMENT MOVE TO THE END OF THE FIELD TO BE SAVED;
    TT(2(32(RL(SI:=SI+8)))); NS(RL(SI:=SI+8));
    T2:=SI; COMMENT -- END OF FIELD TO BE SAVED;
    SI:=LOC NR; T64; DI:=T2;
    T(2(32(RL(DI:=DI+8)))); NR(RL(DI:=DI+8));
    SI:=T2; SI:=SI-8; DI:=DI-8;
    TT(2(32(RL(DS:=WDS; SI:=SI-16); DI:=DI-16))));
    NS(RL(DS:=WDS; SI:=SI-16; DI:=DI-16));
    COMMENT -- HAVE ACCOMPLISHED THE "SAVE", NOW DO THE WRITE;
    SI:=A; DI:=T1;
    T(2(32(DS:=RL WDS))); NR(DS:=RL WDS)
    END;
STREAM PROCEDURE READRECS(PAGE,A,SKP,NB,NR,NM,RL);
    VALUE SKP,NB,NR,NM,RL;
    BEGIN
    COMMENT
        SKP = "SKIP"   - - THE NUMBER OF WORDS TO JUMP OVER
        NB  = "NUMBER BEFORE" -- "    " RECORDS TO SKIP BEFORE
              READING THE RECORD,
        NR  = "NUMBER OF RECORDS"  " "  "     "  READ FROM THE
              BUFFER,
        NM  ="NUMBER TO MOVE"   - - "   "  "    "  MOVE OVER TO
              THE PREVIOUSLY READ AREA,
        RL  ="RECORD LENGTH"  -  - THE LENGTH OF EACH ITEM
        ;
    LOCAL T,T1,T2;
    SI:=LOC NB; T64; SI:=PAGE; SKP(SI:=SI+8);
    T(2(32(RL(SI:=SI+8)))); NB(RL(SI:=SI+8));
    T1:=SI;
    COMMENT - - T1 NOW HAS THE STARTING POSITION FOR THE READ;
    SI:=LOC NR; T64; SI:=T1; DI:=A;
    T(2(32(DS:=RL WDS))); NR(DS:=RL WDS);
    T2:=SI; COMMENT T2 CONTAINS THE END OF THE READ;
    SI:=LOC NM; T64; SI:=T2; DI:=T1;
    T(2(32(DS:=RL WDS))); NM(DS:=RL WDS)
    END READRECS;
DEFINE MOVEALOG=
    DI:=LOC C; DI:=DI+6; DS:=2CHR; DI:=LOC Z;
    TSI:=SI; TALLY:=TALLY+1;
    IF TOGGLE THEN
        BEGIN SI:=LOC C; SI:=SI+6;
        IF 2 SC NEQ DC THEN
            BEGIN TAL:=TALLY; SI:=LOC TAL; SI:=SI+7;
            IF SC="0" THEN
                BEGIN TALLY:=TMP; TALLY:=TALLY+1; TMP:=TALLY;
                TALLY:=0;
                END ELSE
                BEGIN SI:=LOC Z; IF SC LEQ"9" THEN ;
                END
            END ELSE
            BEGIN  DI:=TDI; SI:=LOC SIZE; SI:=SI+6; DS:=2CHR;
            TDI:=DI; SI:=SI-2; DI:=LOC C64; DI:=DI+7 ; DS:=CHR;         00003750
            SI:=NEW; DI:=TDI; C64(2(DS:=32CHR)); DS:=SIZE CHR;
            TDI:=DI; SI:=TSI; DI:=LOC C; DI:=DI+6;
            DS:=2CHR; TSI:=SI;
            TALLY:=TAL;CHRSTORE:=TALLY; SI:=LOC TMP; SI:=SI+7;
            DI:=LOC CHRSTORE; DI:=DI+6; DS:=CHR END
        END;
    SI:=LOC C; DI:=LOC C64; DI:=DI+1; DS:=7CHR; DI:=TDI; SI:=SI-1;
    DS:=2CHR; SI:=TSI;
    C64(2(DS:=32CHR)); DS:=C CHR; TDI:=DI; TSI:=SI#;
INTEGER STREAM PROCEDURE CHRSTORE(A,SKP,B,NEW,NB,SIZE,NA,MODE,
    PAGESIZE); VALUE SKP,NB,SIZE,NA,MODE,PAGESIZE;
    BEGIN LOCAL T,C,TSI,TDI,
    Z,C64,TMP,TAL;
    LABEL DONE;
    SI:=LOC NB; T64;
    SI:=LOC MODE; SI:=SI+7;
    IF SC="0" THEN ; COMMENT SET TOGGLE;
    SI:=A; DI:=B; SKP(DS:=8CHR);
    TSI:=SI; TDI:=DI;
    T(2(32(MOVEALONG)));  NB(MOVEALONG);
    COMMENT NOW HAVE MOVED UP TO NB;
    IF TOGGLE THEN
        BEGIN TALLY:=TAL; CHRSTORE:=TALLY; SI:=LOC TMP; SI:=SI+7;
        DI:=LOC CHRSTORE; DI:=DI+6; DS:=CHR;
        SI:=LOC SIZE; SI:=SI+6; DI:=TDI; DS:=2CHR; TDI:=DI;
        SI:=LOC SIZE; DI:=LOC C64; DI:=DI+1; DS:=7CHR; SI:=NEW;
        DI:=TDI; C64(2(DS:=32CHR)); DS:=SIZE CHR;
        END ELSE
        BEGIN TSI:=SI; TDI:=DI;
        SI:=LOC MODE; SI:=SI+7;
        IF SC="1" THEN
        COMMENT REMOVE AN ENTRY HERE;
            BEGIN DI:=LOC C; DI:=DI+6; SI:=TSI; DS:=2CHR;
            TSI:=SI; DI:=LOC C64; DI:=DI+1; SI:=LOC C;
            DS:=7CHR; SI:=TSI;  C64(2(SI:=SI+32)); SI:=SI+C;
            TSI:=SI; DI:=LOC CHRSTORE; SI:=LOC C; DS:=WDS;
            DI:=TDI; DS:=2LIT"0"; TDI:=DI;
            END ELSE
        IF SC="2" THEN
        COMMENT READ OUT AND ENTRY
            BEGIN DI:=LOC C; DI:=DI+6; SI:=TSI; DS:=2CHR;
            TSI:=SI; DI:=LOC C64; DI:=DI+1; SI:=LOC C;
            DS:=7CHR; SI:=TSI; DI:=NEW;
            C64(2(DS:=32CHR)); DS:=C CHR;
            SI:=LOC C; DI:=LOC CHRSTORE; DS:=WDS; GO DONE END;
        SI:=LOC NA; T64; SI:=TSI; DI:=TDI;
        T(2(32(TDI:=DI; DI:=LOC C; DI:=DI+6; DS:=2CHR;
        TSI:=SI; SI:=LOC C; DI:=LOC C64; DI:=DI+1; DS:=7CHR;
    SI:=SI-1;DT:=TDI;DS:=2CHR;SI:=TSI;C64(2(DS:=32CHR));DS:=C CHR)));
        NA( TDI:=DI; DI:=LOC C; DI:=DI+6; DS:=2CHR; TSI:=SI;
        SI:=LOC C;DI:=LOC C64;DI:=DI+1;DS:=7CHR;SI:=SI-1;
        DI:=TDI;DS:=2CHR;SI:=TSI;C64(2(DS:=32CHR));DS:=C CHR);
        END;
    SI:=LOC PAGESIZE; T64; SI:=B; DI:=A;
%CARD LIST UNSAFE
COMMENT $CARD LIST UNSAFE;
    T(2(DS:=32WDS)); DS:=PAGESIZE WDS;
%CARD LIST SAFE
COMMENT $CARD LIST SAFE;
    DONE:
    END;
STREAM PROCEDURE SETNTH(P,K,N); VALUE K,N;
    BEGIN DI:=P; SI:=LOC K; N(DI:=DI+8); DS:=WDS END;
BOOLEAN STREAM PROCEDURE LESS(A,AN,B,BN,K); VALUE K,AN,BN;
    BEGIN
    SI:=A; DI:=B; SI:=SI+AN; DI:=DI+BN;
    IF K SC LSS DC THEN TALLY:=1;
    LESS:=TALLY;
    END;
REAL STREAM PROCEDURE ADDD(A,B); VALUE A,B;
    BEGIN SI:=LOC A; DI:=LOC B; DS:=8ADD; SI:=LOC B;
    DI:=LOC ADDD; DS:=WDS
    END;
INTEGER PROCEDURE FREEPAGE(INDEX,TYPEZERO,START,FINISH);
    VALUE TYPEZERO,START,FINISH; INTEGER TYPEZERO,START,FINISH;
    ARRAY INDEX[0,0];
    IF START GTR FINISH THEN MESSAGE(2) ELSE
    BEGIN ARRAY T[0:RECSIZE+EXTRAROOM+SKIP-1],P[0:FINISH-START];
    INTEGER T,J,K,R;
    R:=RECSIZE+EXTRAROOM+SKIP;
    J:=START-(FINISH+1);
    FOR I:=FINISH STEP -1 UNTIL TYPEZERO DO
           IF K:=(I+J) LESS TYPEZERO THEN                               00004690
               BEGIN T[R-1]:=P[TYPEZERO-K-1];
               MOVE(T,R,INDEX[I,0])
               END ELSE
               BEGIN IF I GEQ START THEN P[FINISH-I]:=INDEX[I,R-1];
               MOVE(INDEX[K,0],R,INDEX[I,0]);
               END;
       FREEPAGE:=TYPEZERO-J;
       END;
   INTEGER PROCEDURE SEARCH(A,B,N,MIN,MAX,NP); VALUE N,MIN,MAX;
       INTEGER N,MIN,MAX,NP;
       ARRAY A[0,0]; REAL B;
       BEGIN
       INTEGER I,T;
       FOR I:=MIN STEP 1 WHILE T:=T+A[I,0].CF LEQ B AND I LESS MAX-1 DO;
       IF T LSS B THEN
           BEGIN MESSAGE(3); SEARCHL:=NP:=0;
           END ELSE
           BEGIN SEARCHL:=I; NP:=B-T+A[I,0].CF
           END
       END;
   PROCEDURE SORT(A,P,N,C); VALUE P,N,C; INTEGER P,N,C;
       ARRAY A[0,0];
       BEGIN INTEGER R;
           BEGIN
           ARRAY T[0:R:=RECSIZE+EXTRAROOM+SKIP-1];
           LABEL ENDJ;
           INTEGER I,J,L,K,M,SK; R:=R+1;
           SK:=SKIP TIMES 8;
           K:=N-P+1; I:=1; DO UNTIL (I:=I TIMES 2) GTR K;
           M:=I-1;
           WHILE (M:=M DIV 2) NEQ 0 DO
               BEGIN K:=N-M; J:=P;
               DO  BEGIN
                   L:=(I:=J)+M;
                   DO BEGIN
                   IF A[L,0].TF GTR A[I,0].TF THEN GO ENDJ;
                   IF A[L,0].TF EQL A[I,0].TF THEN
                       IF NOT(LESS(A[L,0],SK,A[I,0],SK,C)) THEN
                       GO ENDJ;
                       MOVE(A[L,0],R,T); MOVE(A[I,0],R,A[L,0]);
                       MOVE(T,R,A[I,0])
                       END UNTIL (I:=(L:=I)-M) LSS P;
                   ENDJ:
                   END UNTIL (J:=J+1) GTR K;
               END
           END
       END SORT;
       COMMENT - - - - - - - - - - - - - - - - - - - - - - - - - -
               MODE                            MEANING
               ----                            -------
                1 =                            INTERROGATE TYPE
                2 =                     INSERT RECORD REL ADDRS N
                                        (RELATIVE TO START OF LAST PAGE)
                3 =                     RETURN THE NUMBER OF RECORDS (M)
                4 =                       "    ITEM AT RECORD # N
                5 =                     INSERT  "    "    "   " "
                6 =                     DELETE  "    "    "   " "
                7 =                     SEARCH FOR THE RECORD -A-
                8 =                     FILE OVERFLOW, INCREASE BY N
                9 =                     FILE MAINTENANCE
               10 =                     EMERGENCY FILE MAINTENANCE
                11                      SET STORAGE KIND
              12=                      ALTER STORAGE ALLOCATION RESOURCES
              13=                      RELEASE "TYPE" STORAGE TO SYSTEM
              14=                      CLOSE ALL PAGES FOR AREA TRANSITION
       NOTE THAT WHEN SEQUENTIAL STORAGE MAINTENANCE IS DONE, N
       WILL ALWAYS INDICATE THE ADDRESS OF THE STRING RELATIVE TO
       THE TYPE SPECIFIED, AND M WILL ALWAYS BE THE LENGTH OF THE
       STRING IN -A- (EITHER AS INPUT OR OUTPUT)
       ;
       PROCEDURE UPDATE(T,L,U,D); VALUE L,U,D; INTEGER L,U,D;
           ARRAY T[0];
           BEGIN INTEGER I,J,K;
           FOR I:=L STEP 1 UNTIL U DO
               BEGIN J:=T[I].AF+D; T[I].AF:=J;
               J:=T[I].BF+D; T[I].BF:=J
               END
           END;
       OWN INTEGER CURPAGE,NPAGES,NTYPES,P,PS,U,L;
       OWN INTEGER FIRST,AVAIL,MAXBUFF,CURBUFF;
   REAL GT1;
   LABEL MOREPAGES;
  COMMENT
  IF MEMBUG.[21:1] THEN DUMPMEMORY(MODE,TYPE,N,M);                      00005620
  IF MODE=8 THEN NPAGES:=NPAGES+N;
  MOREPAGES:
      BEGIN
      OWN BOOLEAN POINTERSET, TYPESET;
      INTEGER I, T, NR;
      OWN ARRAY BUF[0:MBUFF], TYPS[0:511];
          OWN ARRAY INDX[0:NPAGES,0:RECSIZE+EXTRAROOM+SKIP-1];
      PROCEDURE SETTYPES;
      BEGIN INTEGER I, T;
           FOR I := 0 STEP 1 UNTIL NPAGES DO
           IF INDX[I,0].TF NEQ T THEN
           BEGIN
                TYPS[T].BF := I; TYPS[T:=INDX[I,0].TF].AF := I;
                TYPS[T].BOOL := INDX[I,0].MF;
           END;
           TYPS[T].BF := I;
      END SETTYPES;
      REAL PROCEDURE BUFFNUMBER(I); VALUE I; INTEGER I;
          BEGIN INTEGER K,L,M;
          LABEL D;
          DEFINE B=BUF#;
          IF( IF K:=INDX[I,P].BUFF=0 THEN TRUE ELSE BUF[K].PAGEF
              NEQ INDX[I,P].PAGEF+1) THEN
              BEGIN IF NULL(K:=CDR(AVAIL)) THEN
                  BEGIN K:=CDR(FIRST);
                  WHILE M:=CDR(B[K]) NEQ 0 DO
                      BEGIN L:=K; K:=M; END;
                  RPLACD(B[L],0);
                  IF BOOLEAN(B[K].CHANGEDBIT) THEN
                      WRITE(POINTERS[K][B[K].PAGEF-1]);
                  B[K].CHANGEDBIT:=0;
                  END ELSE  RPLACD(AVAIL,CDR(B[K]));
              B[K].PAGEF:=INDX[I,P].PAGEF+1;
              INDX[I,P].BUFF:=K;
              READ(POINTERS[K][INDX[I,P].PAGEF]);
              END ELSE
              IF CDR(FIRST)=K THEN GO TO D ELSE
                  BEGIN L:=CDR(FIRST);
                  WHILE M:=CDR(B[L]) NEQ K DO L:=M;
                  RPLACD(B[L],CDR(B[M]));
                  END;
          RPLACD(B[K],CDR(FIRST)); RPLACD(FIRST,K);
          B: BUFFNUMBER:=K
          END;
      PROCEDURE MARK(I); VALUE I; INTEGER I;
              BUF[INDX[I,P].BUFF].CHANGEDBIT:=1;
  BOOLEAN PROCEDURE WRITEBUFFER;
      BEGIN INTEGER I;
      I:=CDR(FIRST);
      WHILE NOT NULL(I) DO
          IF BOOLEAN(BUF[I].CHANGEDBIT) THEN
          BEGIN WRITEBUFFER:=TRUE;
          BUF[I].CHANGEDBIT:=0;
          WRITE(POINTERS[I][BUF[I].PAGEF-1]);
          RPLACD(I,0);
          END ELSE I:=CDR(BUF[I]);
      END;
      IF NOT POINTERSET THEN
          BEGIN LABEL EOF;
          READ(POINTERS[1][NPAGES])[EOF];
          IF EOFMARK(SKIP,RECSIZE,POINTERS[1](0))THEN GO TO EOF;
          MOVE(POINTERS[1](0),1,T);
              COMMENT -- USE T TO DETERMIN THE VARIABLE REC SIZE LATER;
          MOVE(POINTERS[1](0),RECSIZE+SKIP,INDX[NPAGES,0]);
              INDX[NPAGES,RECSIZE+1].PAGEF:=NPAGES;
              NPAGES:=NPAGES+1;
          GO TO MOREPAGES;
          COMMENT - - INITIALIZE VARIABLES;
      EOF: POINTERSET:=TRUE;
      U:=PAGESIZE-SKIP-PAGESPACE;
      L:=(U-ALLOWANCE)/RECSIZE;
      U:=(U+ALLOWANCE+RECSIZE/2)/RECSIZE;
      PS:=(U+L)/2;
      CURPAGE:=NPAGES:=NPAGES-1;
      CURBUFF:=1;
      P:=RECSIZE+SKIP;
      FOR T:=1 STEP 1 UNTIL SBUFF DO RPLACD(BUF[T],T+1);
      RPLACD(BUF[SBUFF],0); RPLACD(AVAIL,1);
      MAXBUFF:=SBUFF;
              T:=0;
      SORT(INDX,0,NPAGES,RECSIZE TIMES 8);
      FOR I:=0 STEP 1 UNTIL NPAGES DO                                   00006370
          IF INDX[I,0].TF GTR T THEN T:=INDX[I,0].TF;
      NTYPES:=T;
      END;
      IF TYPE GTR NTYPES THEN NTYPES:=TYPE;
          IF NOT TYPESET THEN
          BEGIN TYPESET:=TRUE; SETTYPES;
          COMMENT
          IF MEMBUG THEN DUMPINDEX(TYPS,NTYPES,INDX,RECSIZE,
          P);
          END;
  COMMENT --- DECIDE WHETHER TO SAVE CURRENT PAGE BEFORE GOING ON;
  IF MODE=2 THEN
      BEGIN  MODE:=5; NR:=N
      END ELSE
  IF MODE GEQ 4 THEN                      %MAY BE FILE MAINTENANCE
      IF MODE GEQ 8 THEN                  %IS FILE MAINTENANCE
      ELSE                                %WE MAY BE GOING TO
      IF MODE NEQ 7 THEN                  %ANOTHER PAGE
          BEGIN
          IF TYPE=0 THEN BEGIN MESSAGE(4); MODE:=0 END ELSE
          IF TYPS[TYPE].AF=TYPS[TYPE].BF THEN
              IF TYPS[0].BF GTR 0 THEN
              BEGIN INTEGER J,K; REAL PG;
              K:=TYPS[0].BF-1; TYPS[0].BF:=K; PG:=INDX[K,P];
              FOR I:=1 STEP 1 UNTIL TYPE-1 DO
              IF (T:=TYPS[I]).AF NEQ T.BF THEN
                  BEGIN FOR K:=T.AF STEP 1 UNTIL T.BF -1 DO
                  MOVE(INDX[K,0]),P+EXTRAROOM,INDX[K-1,0]);
                  TYPS[I].AF:=T.AF-1; TYPS[I].BF:=K:=T.BF-1
                  END;
              IF CURPAGE GTR TYPS[0].BF THEN
                  IF CURPAGE LEQ K THEN CURPAGE:=CURPAGE-1;
              TYPS[TYPE].BF:=K+1; TYPS[TYPE].AF:=K;
              INDX[K,P]:=PG; INDX[K,0]:=0; INDX[K,0].TF:=TYPE;
              IF TYPS[TYPE].BOOL=1 THEN
                  BEGIN SETNTH(INDX[K,0],0,1); INDX[K,0].MF:=1
                  END;
              COMMENT
              IF MEMBUG.[22:1] THEN DUMPTYPES(MODE,TYPS,NTYPES);
              MEMORY(MODE,TYPE,A,N,M);  MODE:=0
              END ELSE
              BEGIN T:=1; MEMORY(8,TYPE,A,T,M); MEMORY(MODE,TYPE,A,N,M);
              MODE:=0
              END ELSE
      IF NOT( BOOLEAN(TYPS[TYPE].BOOL) AND MODE=5) THEN
          CURBUFF:=BUFFNUMBER(CURPAGE:=
              SEARCHL(INDX,N,NPAGES,TYPS[TYPE].AF,TYPS[TYPE].BF,
                  NR)  );
      COMMENT
        IF MEMBUG.[23:1] THEN CHECKTYPES(TYPS,NTYPES);
          END;
      COMMENT
      IF MEMBUG.[20:1] THEN DUMPINDEX(TYPS,NTYPES,INDX,RECSIZE,P);
      COMMENT
      IF MEMBUG.[24:1] THEN DUMPBUFF(BUF,FIRST,AVAIL);
  CASE MODE OF
      BEGIN
      %------- MODE=0 ------- RESERVED ---------------
      ;
      %------- MODE=1 --------------------------------------------------
      IF M=0 THEN N:=TYPS[TYPE].BOOL ELSE
      IF M=1 THEN
          BEGIN FOR I:=1 STEP 1 UNTIL NTYPES DO
          IF (T:=TYPS[I].AF=T.BF THEN
              BEGIN N:=I; I:=NTYPES+1
              END;
          IF I=NTYPES+1 THEN N:=NTYPES+1
          END;
      %------- MODE=2 ------- RESERVED ---------------
      ;
      %------- MODE=3 ------- RETURN THE NUMBER OF RECORDS----
      BEGIN COMMENT IF TYPE LSS 0 THEN THE TOTAL NUMBER
      OF PAGES IS GIVEN, OTHERWISE THE NUMBER OF "TYPE" PAGES IS
      GIVEN;
      FOR I:=0 STEP 1 UNTIL NPAGES DO
          IF INDX[I,0].TF=TYPE OR TYPE LSS 0 THEN
          NR:=NR+INDX[I,0].CF;
      M:=NR
      END;
      %------- MODE=4 ------- RETURN ITEM AT SUBSCRIPT N -----
      IF NR GEQ INDX[CURPAGE,0].CF THEN MESSAGE(3) ELSE
      IF BOOLEAN (TYPS[TYPE].BOOL) THEN COMMENT SEQUENTIAL STORAGE;
         BEGIN ARRAY B[0:PAGESIZE];                                    00007270
         M:=CHRSTORE(POINTERS[CURBUFF](0),2,B,A,NR,0,0,2,0);
         END ELSE
     BEGIN
     M:=RECSIZE|8;
     READRECS(POINTERS[CURBUFF](0),A,SKIP,NR,1,0,RECSIZE);
     END;
     %------- MODE=5 ------- INSERT ITEM AT SUBSCRIPT N;
     BEGIN INTEGER K,J,S; REAL PG;
     IF BOOLEAN(TYPS[TYPE].BOOL) THEN
     COMMENT FIND A PLACE FOR THE CHARACTER STRING OF LENGTH
     M;
     IF M GTR (PAGESIZE-SKIP-1)|8-2 THEN MESSAGE(5) COMMENT
     THIS CHARACTER STRING IS TOO LONG ; ELSE
         BEGIN ARRAY C[0:PAGESIZE];
         STREAM PROCEDURE ADDZERO(CHARS,POINTER); VALUE CHARS;
             BEGIN LOCAL T;
             SI:=LOC CHARS; DI:=LOC T; DI:=DI+1; DS:=7CHR;
             DI:=POINTER; T(2(DI:=DI+32)); CHARS(DI:=DI+1);
             DS:=2LIT"0";
             END;
         BOOLEAN B,NOTLASTPAGE;
         LABEL TRYITAGAIN;
         TRYITAGAIN:
         FOR I:=(T:=TYPS[TYPE]).AF STEP 1 WHILE I LSS T.BF AND
         NOT B DO
             IF NOT(B:=((PAGESIZE-SKIP-1)|8-(GT1:=INDX[I,0]).SF)GEQ M+2
             AND NOT BOOLEAN(GT1.FF)) THEN S:=S+GT1.CF ELSE I:=I-1;
         NOTLASTPAGE:=B AND I NEQ T.BF-1;
         COMMENT IF B IS TRUE, THEN A PAGE HAS BEEN FOUND;
         IF NOT B THEN COMMENT GET A PAGE THAT IS FREE;
             BEGIN
             COMMENT
             IF MEMBUG.[5:1] THEN DUMPTYPES(5,1,TYPS,NTYPES);
                 IF TYPS[0].BF=0 THEN BEGIN K:=CURPAGE; T:=1;
                 MEMORY(8,TYPE,A,T,M); CURPAGE:=K+1
                 END
             ELSE
             IF (PAGESIZE-SKIP-1)|8-INDX[(I:=I-1)-1,0].SF GTR 2 THEN
                 BEGIN
                 CURBUFF:=BUFFNUMBER(CURPAGE:=I-1);
                 ADDZERO((GT1:INDX[CURPAGE,0].SF)+8|(SKIP+1),POINTERS
                     [CURBUFF](0));
                 INDX[CURPAGE,0].SF:=GT1+2;
                 INDX[CURPAGE,0].CF:=INDX[CURPAGE,0].CF+1;
                 COMMENT SINCE ALLOCATING A NEW PAGE, SET COUNT TO
                 ONE MORE AND FREEZE THE COUNT;
                 S:=S+1; % SINCE THE COUNT INCREASED
                 MOVE(INDX[CURPAGE,0],SKIP+1,POINTERS[CURBUFF](0));
                 MARK(CURPAGE);
                 END;
             T:=TYPS[0].BF; TYPS[0].BF:=T:=T-1;
             COMMENT T IS THE SUBSCRIPT INTO THE NEW PAGE;
             PG:=INDX[T,P]; COMMENT PG HOLDS THE NEW PAGE #;
             FOR K:=T+1 STEP 1 UNTIL I DO
                 MOVE(INDX[K,0],RECSIZE+SKIP+EXTRAROOM,INDX[K-1,0]);
             T:=TYPS[TYPE].AF; UPDATE(TYPS,1,TYPE-1,-1);
             IF CURPAGE GTR TYPS[0].BF THEN IF CURPAGE LEQ
                 I THEN CURPAGE:=CURPAGE-1;
             INDX[I,0]:=0; INDX[I,0].MF:=1; INDX[I,0].TF:=TYPE;
             COMMENT MUST ALSO ASSIGN A NUMBER TO THIS PAGE
             (TO BE STORED IN THE PAGE) TO KEEP IT IN SEQUENCE
             WITHIN THIS TYPE;
             IF (T:=TYPS[TYPE]).AF LSS T.BF-1 THEN
                 T:=INDX[T.BF-1,1] ELSE T:=0;
             SETNTH(INDX[I,0],ADDD(1,T),1);
             COMMENT END OF THE INITIALIZATION OF THE INDEX ARRAY,
             WE STILL HAVE TO MAKE SOME ENTRIES INTO THE PAGE
             WHICH WE WILL DO BELOW;
             END OF TEST FOR NEW PAGE;
         COMMENT I IS SET TO THE PROPER SUBSCRIPT FOR THE CHR STORE;
             CURBUFF:=BUFFNUMBER(CURPAGE:=I);
         COMMENT NOW THE CORRECT PAGE IS IN CORE.
             ------------------------------
             M= NUMBER OF CHARACTERS IN A (ON INPUT)
             N= ADDRESS OF A WITHIN IN THIS TYPE (ON OUTPUT
             ------------------------------;
         K:=INDX[I,0];
         T:=CHRSTORE(POINTERS[CURBUFF](0),SKIP+1,C,A,K,CF,M,0,0,
             PAGESIZE);
         COMMENT K.CF IS THE NUMBER OF ITEMS ALREADY IN THIS
         PAGE.  IF THERE IS A SEGMENT WHICH IS NULL, IT WILL
         BE FOUND AND ASSIGNED AS THE SEG NUMBER FOR                   00007860
         THIS CHARACTER STRING (T).  IF NOT, IT WILL STICK THE
         STRING ON THE END (WE KNOW THERE IS ENOUGH ROOM
         SINCE WE CHECKED INDX[I,0].SF -- THE NUMBER OF CHRS USED
         IN THIS PAGE, OR WE CREATED A NEW PAGE);
         N:=S+T; S:=K.SF; COMMENT S CONTAINS THE # OF CHRS USED UP;
         IF T:=T+1 GTR K.CF THEN COMMENT ADDED THE STRING ON THE END;
             IF NOTLASTPAGE THEN % PAGE ALREADY FULL
                 BEGIN S:=0; B:=FALSE; INDX[I,0].FF:=1;
                 MOVE(INDX[I,0],SKIP+1,POINTERS[CURBUFF](0));
                 MARK(CURPAGE); GO TRYITAGAIN; END ELSE
             BEGIN K.CF:=T; S:=S+2;
             END
         ELSE IF T=K.CF AND NOTLASTPAGE THEN INDX[I,0].FF:=1;
         INDX[I,0].CF:=K.CF; INDX[I,0].SF:=S+M;
         MOVE(INDX[I,0],SKIP+1,POINTERS[CURBUFF](0));
         MARK(CURPAGE);
         COMMENT THE PAGE DESCRIPTOR HAS BEEN UPDATED;
         COMMENT
             IF MEMBUG.[5:1] THEN DUMPTYPES(5,2,TYPS,NTYPES);
         END ELSE COMMENT KIND OF STORAGE IS SORTED;
     IF NR GTR (T:=INDX[CURPAGE,0].CF) THEN
     COMMENT SUBSCRIPT IS NOT IN THE MIDDLE OF THE PAGE;
     MESSAGE(6) ELSE
         BEGIN
         IF T GEQ U THEN COMMENT WILL EXCEED UPPER PAGE BOUND;
             BEGIN ARRAY B[0:RECSIZE TIMES
             (T-PS+(I:=(IF NR GEQ PS THEN 0 ELSE 1)))-1];
             COMMENT B IS JUST BIG ENOUGH TO CARRY THE
             EXCESS FROM THE OLD PAGE;
             READRECS(POINTERS[CURBUFF](0),B,SKIP,PS-I,
                 J:=(T-PS+I),0,RECSIZE);
             COMMENT -- B NOW HAS THE EXCESS;
             INDX[CURPAGE,0].CF:=T-J; SETNTH(POINTERS[CURBUFF](0),
             INDX[CURPAGE,0],0);
             MARK(CURPAGE);
             IF TYPS[0].BF=0 THEN
                 BEGIN K:=CURPAGE; T:=1;
                 MEMORY(8,TYPE,A,T,M); CURPAGE:=K+1;
                 END;
             COMMENT -- ASSIGN A FREE PAGE (SUBS T);
             T:=TYPS[0].BF; TYPS[0].BF:=T:=T-1;
             
             PG:=INDX[T,P];
             FOR K:=T+1 STEP 1 UNTIL CURPAGE DO
             MOVE(INDX[K,0],RECSIZE+SKIP+EXTRAROOM,INDX[K-1,0]);
             INDX[CURPAGE,P]:=PG;
             T:=0;T.CF:=J;T.TF:=TYPE;
             CURBUFF:=BUFFNUMBER(CURPAGE);
             WRITERECS(POINTERS[CURBUFF](0),B,SKIP,0,J,0,RECSIZE);
             SETNTH(POINTERS[CURBUFF](0),T,0);
             MOVE(POINTERS[CURBUFF](0),RECSIZE+SKIP,INDX[CURPAGE,0]);
             MARK(CURPAGE);
             T:=TYPS[TYPE].AF; TYPS[TYPE].AF:=T-1;
             UPDATE(TYPS,1,TYPE-1,-1);
             IF J=0 THEN MESSAGE(7);
             IF BOOLEAN (I) THEN
             COMMENT    I=0 IMPLIES THE RECORD GOES TO NEW PAGE,
                        I=1 IMPLIES THE RECORD GOES TO NOOLD PAGE;
                 BEGIN
                 T:=INDX[CURPAGE:=CURPAGE-1,0].CF;
                 CURBUFF:=BUFFNUMBER(CURPAGE);
                 ; COMMENT OLD PAGE IS NOW BACK;
                 END ELSE
                 BEGIN T:=J; NR:=NR-PS
                 END
             END;
         WRITERECS(POINTERS[CURBUFF](0),A,SKIP,NR,1,T-NR,RECSIZE);
         T:=INDX[CURPAGE,0].CF; INDX[CURPAGE,0].CF:=T+1;
         SETNTH(POINTERS[CURBUFF](0),INDX[CURPAGE,0],0);
         IF NR=0 THEN MOVE(POINTERS[CURBUFF](0),RECSIZE+SKIP,INDX
         [CURPAGE,0]);  MARK(CURPAGE);
         END;
     END;
     %------- MODE=6 ------- DELETE A RECORD FROM THE FILE ----
     IF (T:=TYPS[TYPE].AF=T.BF THEN MESSAGE(12) COMMENT
     ATTEMPT TO DELETE NON-EXISTENT STORAGE;
     ELSE
     IF NR GEQ(T:=INDX[CURPAGE,0].CF) THEN MESSAGE(13) COMMENT
     ATTEMPT TO DELETE OUTSIDE STORAGE RANGE; ELSE
     IF BOOLEAN(T.BOOL) THEN COMMENT SEQUENTIAL STORAGE;
         BEGIN COMMENT NR IS THE RECORD TO DELETE;
         ARRAY B[0:PAGESIZE-1];                                         00008610
         COMMENT PAGESIZE -1 SHOULD BE COMPUTED TO THE EXACT
         NUMBER OF WORDS TO MOVE -- IT WOULD SPEED THINGS UP;
         INTEGER L;
         T:=INDX[CURPAGE,0]; COMMENT T.CF IS THE NUMBER OF
         RECORDS ON THIS PAGE, T.SF IS THE NUMBER OF CHRS;
         L:=CHRSTORE(POINTERS[CURBUFF](0),SKIP+1,B,A,NR,0,T.CF
         -NR-1,1,PAGESIZE);
         COMMENT WE WILL BRING BACK THE NUMBER OF CHRS IN M;
         M:=L;
         MARK(CURPAGE);
         COMMENT MAKE CHANGES TO THE CHARACTER COUNT;
         INDX[CURPAGE,0].SF:=T.SF-L;
         INDX[CURPAGE,0].FF:=0; % PAGE IS CERTAINLY NOT FULL NOW
         COMMENT AND  WE ARE DONE WITH THE DELETION;
         MOVE(INDX[CURPAGE,0],SKIP+1,POINTERS[CURBUFF](0));
         END
     ELSE
     BEGIN ARRAY A[0:RECSIZE-1];
     INDX[CURPAGE,0].CF:=I-1;
     SETNTH(POINTERS[CURBUFF](0),INDX[CURPAGE,0],0);
     IF I GTR 1 THEN
         BEGIN
         READRECS(POINTERS[CURBUFF](0),A,SKIP,NR,1,I-NR-1,RECSIZE);
         MARK(CURPAGE);
         IF NR=0 THEN
             MOVE(POINTERS[CURBUFF](0),RECSIZE+SKIP,INDX[CURPAGE,0])
         END ELSE COMMENT FREE THE EMPTY PAGE;
         BEGIN MARK(CURPAGE);
         ;TYPS[0].BF:=FREEPAGE(INDX,TYPS[0].BF,CURPAGE,CURPAGE);
         UPDATE(TYPS,1,TYPE-1,1); TYPS[TYPE].AF:=T.AF+1;
         COMMENT
         IF MEMBUG.[6:1] THEN DUMPTYPES(MODE,TYPS,NTYPES);
         END
     END;
     %------- MODE=7 ------- SEARCH FOR A RECORD FROM THE FILE ---
     IF N GTR 3 THEN MESSAGE(14) ELSE
 COMMENT RETURN RECORD CLOSEST (BUT LESS THAN OR EQUAL TO) TO
     THE CONTENT OF -A-.  A WILL BE REPLACED BY THE RECORD FOUND;
     IF BOOLEAN((I:=TYPS[TYPE].BOOL) THEN
     MESSAGE(8) COMMENT BINARY SEARCH OF NON-SEQUENTIAL DATA;
     ELSE
     IF I.AF=I.BF THEN MESSAGE(9) COMMENT --NO STORAGE OF
     THIS TYPE ALLOCATED AS YET;
     ELSE BEGIN
         INTEGER F,U,L;
         ARRAY B[0:RECSIZE-1];
         U:=TYPS[TYPE].BF; L:=TYPS[TYPE].AF;
         WHILE U-L GTR 1 DO
         IF LESS(A,0,INDX[F:=(U+L) DIV 2,0],8,M) THEN U:=F ELSE L:=F;
         CURBUFF:=BUFFNUMBER(CURPAGE:=L);
         L:=0; U:=INDX[CURPAGE,0].CF;
         IF L-U=0 THEN MESSAGE(10) COMMENT BINARY SEARCH FOUND
         A PAGE WITH NO RECORDS;
         ELSE BEGIN
             WHILE U-L GTR 1 DO
             BEGIN READRECS(POINTERS[CURBUFF](0),B,SKIP,
             F:=(U+L) DIV 2,1,0,RECSIZE);
             IF LESS(A,0,B,0,M) THEN U:=F ELSE L:=F
             END;
             COMMENT -----------------------------------
             ON INPUT:
                 N=0    IMPLIES    DO NOT PLACE RECORD INTO FILE
                                   IF RECORD IS FOUND. RETURN RELA-
                                   TIVE POSITION OF THE CLOSEST RECORD
                                   IN THIS PAGE.
                 N=1      "        DO NO PLACE IN FILE. RETURN ABSO-
                                   LUTE SUBSCRIPT OF CLOSSEST RECORD.
                 N=2      "        PLACE RECORD INTO FILE IF NOT FOUND.
                                   RETURN RELATIVE POSITION OF RECORD.
                 N=3      "        PLACE RECORD INTO FILE, IF NOT
                                   FOUND, RETURN ABS SUBSCRIPT OF
                                   THE RECORD.
            ON OUTPUT:
                 M=0      "        RECORD FOUND WAS EQUAL TO RECORD
                                   SOUGHT.
                 M=1      "        RECORD FOUND WAS GREATER THAN THE
                                   SOUGHT.
                 M=2      "        RECORD FOUND WAS LESS THAN THE
                                   RECORD SOUGHT.
;
             READRECS(POINTERS[CURBUFF](0),B,SKIP,L,1,0,RECSIZE);
             IF LESS(A,0,B,0,M) THEN M:=1 ELSE
                   IF LESS(B,0,A,0,M) THEN M:=2 ELSE                    00009410
                   M:=0;
               T:=0; IF BOOLEAN(N) THEN
                   FOR I:=TYPS[TYPE].AF STEP 1 UNTIL CURPAGE-1 DO
                   T:=T+INDX[I,0].CF;
               IF N GTR 1 THEN IF M GEQ 1 THEN
                   MEMORY(2,TYPE,A,L+M-1,NR);
               MOVE(B,RECSIZE,A);
               N:=T+L;
               END
           END;
       %------- MODE=8 ------- FILE OVERFLOW, FIX ARRAYS AND PAGES
           BEGIN BOOLEAN TOG;
                 ARRAY A[0:PAGESIZE-1]; T:=NPAGES-N+1;
           IF TOG:=(T DIV AREASIZE) LSS (NPAGES DIV AREASIZE ) OR
               (T=NPAGES AND T MOD AREASIZE =0) THEN
               MEMORY(14,TYPE,A,N,M);
           FOR I:=T STEP 1 UNTIL NPAGES DO
           BEGIN WRITE(NEWDISK[I],PAGESIZE,A[*]);INDX[I,P].PAGEF:=I END;
           MARKEOF(SKIP,RECSIZE,NEWDISK(0));
           WRITE(NEWDISK[I]);
           TYPS[0].BF:=FREEPAGE(INDX,TYPS[0]).BF,T,NPAGES);
           UPDATE(TYPS,1,NTYPES,NPAGES-T+1);
           IF TOG THEN CLOSE(NEWDISK);
           END;
       %------- MODE=9 ------- FILE MAINTENANCE ------------------
       BEGIN BOOLEAN ITHPAGEIN;
       INTEGER I,J,K,T1,T2,T3,M,W,Q;
       ARRAY A,B[0:PAGESIZE-1];
       COMMENT
       MONITOR PRINT(Q,W,N, I,J,K,T1,T2,T3,M,A,B);
       IF I:=TYPS[0].BF LEQ NPAGES THEN
       DO
           BEGIN COMMENT OUTER "DO-LOOP" TO FIND TROUBLE WITH
           THE FILE;
           IF T1:=(Q:=INDX[I,0]).CF LSS L THEN COMMENT MAY BE CORRECTABLE;
               IF NOT BOOLEAN((Q:=TYPS[Q.TF]).BOOL) THEN
               COMMENT -- THIS PAGE IS CORRECTABLE;
                   IF I NEQ NPAGES THEN
                   COMMENT -- THIS IS NOT THE LAST PAGE OF THE FILE;
                       IF (J:=I+1) LSS Q.BF THEN
                       COMMENT -- THIS IS NOT THE LAST PAGE OF THIS TYPE;
                       BEGIN COMMENT -- FIND RECORDS TO MOVE INTO
                       THIS PAGE;
                       DO IF T2:=INDX[J,0].CF GTR 0 THEN
                       COMMENT THIS PAGE HAS RECS TO MOVE;
                           BEGIN COMMENT HOW MANY;
                           IF T2 LSS K:=PS-T1 THEN K:=T2;
                           IF NOT ITHPAGEIN THEN
                               BEGIN COMMENT BRING IN PAGE I;
                               MOVE(POINTERS[BUFFNUMBER(I)](0),
                               PAGESIZE,B); ITHPAGEIN:=TRUE
                               END;
                           COMMENT -- BRING IN PAGE J;
                           CURBUFF:=BUFFNUMBER(CURPAGE:=J);
                           COMMENT -- MOVE SOME INTO A;
                           READRECS(POINTERS[CURBUFF](0),A,SKIP,0,K,
                           T2:=T2-K,RECSIZE); INDX[J,0].CF:=T2;
                           IF T2=0 THEN
                               COMMENT SET THIS PAGE FREE;
                               INDX[J,0]:=0;
                           SETNTH(POINTERS[CURBUFF](0),INDX[J,0],0);
                           MOVE(POINTERS[CURBUFF](0),RECSIZE+SKIP,INDX[J
                           ,0]); MARK(CURPAGE);
                           COMMENT -- PUT THE RECORDS INTO PAGE I;
                           WRITERECS(B,A,SKIP,T1,K,0,RECSIZE);
                           END
                          ELSE K:=0 COMMENT SINCE NO CONTRI-
                          BUTION;
                       UNTIL T1:=T1+K GEQ PS OR J:=J+1 GEQ Q.BF;
                       INDX[I,0].CF:=T1; B[0]:=INDX[I,0];
                       COMMENT -- PUT THE PAGE BACK OUT ON DISK;
                       MOVE(B,RECSIZE+SKIP,INDX[I,0]);
                       MOVE(B,PAGESIZE,POINTERS[CURBUFF:=BUFFNUMBER
                       (I)](0)); SORT(INDX,0,NPAGES,RECSIZE|8);
                       MARK(CURPAGE:=I); SETTYPES;
                       N:=1;
                       END
                       ELSE N:=0 COMMENT LAST PAGE OF THIS TYPE;
                   ELSE N:=0 COMMENT LAST PAGE OF FILE;
               ELSE N:=0 COMMENT PAGE CANNOT BE CHANGED;
           ELSE N:=0 COMMENT THIS PAGE IS NOT TOO SMALL;
           END UNTIL I:=I+1 GTR NPAGES OR N NEQ 0 ELSE N:=0;
    IF I GTR NPAGES THEN N:=REAL(WRITEBUFFER);                          00010240
    END OF FILE UPDATE;
    %------- MODE=10 ------ EMERGENCY FILE MAINTENANCE -------
    DO MEMORY(9,TYPE,A,N,M) UNTIL N NEQ 1
    %------- MODE=11 ------- SET THE KIND OF STORAGE FOR TYPE ----------
   ;COMMENT  TYPE "TYPE" STORAGE IS BEING SET TO SEQUENTIAL;
    IF TYPE=0 THEN MESSAGE(4) ELSE
    IF (T:=TYPS[TYPE]).AF= T.BF THEN TYPS[TYPE].BOOL:=1 ELSE
    MESSAGE(15); COMMENT ATTEMPT TO CHANGE KINDS IN MIDSTREAM;
%------- MODE=12 ----------- ALTER STORAGE ALLOCATION RESOURCES---
    COMMENT N IS THE "FACTOR" (PERCENT OF RESOURCES | 100),
    AND M IS THE STORAGE "LEVEL" (0 IS THE ONLY ONE THAT
    DOES ANYTHING ON THE B5500);
    BEGIN INTEGER J,K;
    BOOLEAN TOG;
    IF T:=N|(MBUFF-1)/100+1 GTR MAXBUFF THEN
        BEGIN COMMENT ADD TO AVAILABLE LIST;
        FOR I:=CDR(FIRST),CDR(AVAIL) DO
        WHILE NOT NULL(I) DO
            BEGIN BUF[I].FLAGB:=1; I:=CDR(BUF[I]);
            END;
        FOR I:=MAXBUFF+1 STEP 1 UNTIL T DO
            BEGIN WHILE BUF[K:=K+1].FLAGB=1 DO;
            BUF[K]:=0; RPLACD(BUF[K],CDR(AVAIL));
            RPLACD(AVAIL,K)
            END;
        MAXBUFF:=T;
        FOR I:=1 STEP 1 UNTIL MBUFF DO BUF[I].FLAGB:=0;
        END ELSE
    IF T LSS MAXBUFF THEN
        BEGIN COMMENT CUT DOWN ON THE NUMBER OF BUFFERS;
        I:=CDR(FIRST);
        FOR J:=1 STEP 1 UNTIL MAXBUFF DO
            IF TOG THEN
                IF NOT NULL(I) THEN
                    IF J GEQ T THEN
                        BEGIN K:=CDR(BUF[I]); BUF[I]:=0
                        ; I:=K END
                    ELSE I:=CDR(BUF[I])
                ELSE
            ELSE
            IF TOG:=NULL(I) THEN
                BEGIN J:=J-1; I:=CDR(AVAIL)
                END
            ELSE
                IF J EQL T THEN
                    BEGIN K:=CDR(BUF[I]); RPLACD(BUF[I],0);
                    I:=K END ELSE
                IF J GTR T THEN
                    BEGIN
                    IF BOOLEAN(BUF[I].CHANGEDBIT) THEN
                        WRITE(POINTERS[I][BUF[I].PAGEF-1);
                    K:=CDR(BUF[I]);
                    CLOSE(POINTERS[I]);
                    BUF[I]:=0; I:=K
                    END ELSE I:=CDR(BUF[I])
                ;
        MAXBUFF:=T
        END;
    END;
    %------- MODE=13 ------- RELEASE "TYPE" STORAGE TO SYSTEM ----------
    IF (T:=TYPS[TYPE]).BF GTR T.AF THEN
        BEGIN INTEGER J;
        J:=T.BF-1;
        FOR I:=T.AF STEP 1 UNTIL J DO
            BEGIN CURBUFF:=BUFFNUMBER(I);
            SETNTH(POINTERS[CURBUFF](0),0,0); MARK(CURPAGE:=I);
            END;
        TYPS[0].BF:=FREEPAGE(INDX,TYPS[0].BF,T,AF,J);
        UPDATE(TYPS,1,TYPE-1,J-T.AF+1);
        TYPS[TYPE].BF:=T.AF;  TYPS[TYPE].BOOL:=0;
        END;
    %------- MODE=14 ------ RELEASE ALL PAGES FOR TRANSITION -----------
    BEGIN INTEGER K;
    I:=CDR(FIRST);
    WHILE NOT NULL(I) DO
        BEGIN IF BOOLEAN(BUF[I].CHANGEDBIT ) THEN WRITE(POINTERS[I]
            [BUF[I].PAGEF-1]);  CLOSE(POINTERS[I]);
        K:=CDR(BUF[I]);  BUF[I]:=0;
        RPLACD(BUF[I],CDR(AVAIL)); RPLACD(AVAIL,I); I:=K
        END  ; CURPAGE:=CURBUFF:=-1; RPLACD(FIRST,0);
    END;
    END OF CASE STMT;
END OF INNER BLOCK;                                                     00011110
END OF PROCEDURE;
INTEGER QM,QN;
ARRAY QA[0:0];
PROCEDURE NAME(MFID,FID); VALUE MFID,FID; REAL MFID,FID;
    BEGIN INTEGER I; FILL NEWDISK WITH MFID,FID;
    FOR I:=0 STEP 1 UNTIL MBUFF DO
        FILL POINTERS[I] WITH MFID,FID;
    FILL ESTABLISH WITH MFID,FID;
    SETPOINTERNAMES
    END;
PROCEDURE SEQUENTIAL(UNIT); VALUE UNIT; INTEGER UNIT;
    MEMORY(11,UNIT,QA,QN,QM);
INTEGER PROCEDURE CONTENTS(UNIT,N,AR); VALUE UNIT,N;
    INTEGER UNIT,N; ARRAY AR[0];
    BEGIN
    MEMORY(4,UNIT,AR,N,QM); CONTENTS:=QM;
    END;
PROCEDURE DELETE1(UNIT,N); VALUE UNIT,N; INTEGER UNIT,N;
    MEMORY(6,UNIT,QA,N,QM);
INTEGER PROCEDURE SEARCHORD(UNIT,REC,LOC,M); VALUE UNIT,M;
    INTEGER UNIT,LOC,M; ARRAY REC[0];
    BEGIN LOC:=1;
    MEMORY(7,UNIT,REC,LOC,M);
    SEARCHORD:=M;
    END;
PROCEDURE STOREORD(UNIT,REC,N); VALUE UNIT,N; INTEGER UNIT,N;
    ARRAY REC[0];
    MEMORY(5,UNIT,REC,N,QM);
PROCEDURE STOREORDR(UNIT,REC,N); VALUE UNIT,N; INTEGER UNIT,N;
    ARRAY REC[0];
    MEMORY(2,UNIT,REC,N,QM);
BOOLEAN PROCEDURE MAINTENANCE;
    BEGIN MEMORY(9,0,QA,QN,QM); MAINTENANCE:=QN:=1
    END;
PROCEDURE WRAPUP; MEMORY(10,0,QA,QN,QM);
INTEGER PROCEDURE STORESEQ(UNIT,REC,N); VALUE UNIT,N; INTEGER UNIT, N;
    ARRAY REC[0];
    BEGIN
    MEMORY(5,UNIT,REC,QN,N); STORESEQ:=QN;
    END;
PROCEDURE DELETEN(UNIT,N,M); VALUE UNIT,N,M; INTEGER UNIT,N,M;
    BEGIN M:=M-N;
    DO MEMORY(6,UNIT,QA,N,QM) UNTIL M:=M-1 LSS 0;
    END;
INTEGER PROCEDURE NEXTUNIT;
    BEGIN MEMORY(1,0,QA,QN,1); NEXTUNIT:=QN
    END;
INTEGER PROCEDURE SIZE(UNIT); VALUE UNIT; INTEGER UNIT;
    BEGIN MEMORY(3,UNIT,QA,QN,QM); SIZE:=QM
    END;
PROCEDURE ALLOCATE(J,FACTOR); VALUE J,FACTOR; INTEGER J;
    REAL FACTOR;
    BEGIN
    QN:=ENTIER( ABS( (FACTOR | 100) MOD 101));
    MEMORY(12,0,QA,QN,J)
    END;
PROCEDURE RELEASEUNIT(UNIT); VALUE UNIT; INTEGER UNIT;
    MEMORY(13,UNIT,QA,QN,QM);
DEFINE
    ALLOWQUESIZE=4#,
    ACOUNT=ACCUM[0].[1:11]#,
    DATADESC=[1:1]#,
    SCALAR=[4:1]#,
    NAMED=[3:1]#,
    CHRMODE=[5:1]#,
    CHECKT=5#,   % NUMBER OF TIMES THRU EXECUTE BEFORE CHECK
    CCIF=18:36:12#,
    CDID=1:43:5#,
    CSPF=30:30:18#,
    CRF=24:42:6#,
    CLOCF=6:30:18#,
    PF=[1:17]#,
    XEQMODE=1#,
    FUNCMODE=2#,
    CALCMODE=0#,
    INPUTMODE=3#,
    ERRORMODE=4#,
    FUNCTION=1#,
    CURRENTMODE = PSRM[0]#,
    VARIABLES = PSRM[1]#,
    VARSIZE = PSRM[2]#,
    FUNCPOINTER = PSRM[3]#,                                             00013160
    FUNCSEQ = PSRM[4]#,
    CURLINE = PSRM[5]#,
    STACKBASE = PSRM[6]#,
    INCREMENT = STACKBASE#,  %FUNCMODE/CALCMODE
    SYMBASE = PSRM[7]#,
    FUNCSIZE = SYMBASE#,     %FUNCMODE/CALCMODE
    USERMASK = PSRM[8]#,
    SEED = PSRM[10]#,
    ORIGIN = PSRM[11]#,
    FUZZ = PSRM[12]#,
    FSTART = 9#,  %PSR[9] IS WHERE NAME OF CURRENTLY EDITED FCN GOES
    PSRSIZE = 13#,
    PSR = PSRM[*]#,
    WF=[18:8]#,
    WDSPERREC=10#,
    WDSPERBLK=30#,
    NAREAS=10#,
    SIZEAREAS=210#,
    LIBF1=[6:15]#,
    LIBF2=[22:16]#,
    LIBF3=[38:10]#,
    LIBSPACES=1#,
    IDENT=RESULT=1#,
    SPECIAL=RESULT=3#,
    NUMERIC=RESULT=2#,
    REPLACELOC=0#,
    REPLACEV=4#,
    SPF=[30:18]#,
    RF=[24:6]#,
    DID=[1:5]#,
    XRF=[12:18]#,
    DDPNSW=30#, % DATA DESC PRESENT NAMED SCALAR WORD
    DDNNVW=20#, %DATA DESC NON-PRES NAMED VECTOR WORD
    DDNUVW=16#, %DATA DESC NONPRES..(POINTS INTO SYM TAB FOR LOCALS)
    DDPUVW=24#, % DATA DESC PRESENT UNNAMED VECTOR WORD
    DDNNSW=22#, % DATA DESC NON-PRES NAMED SCALAR WORD
    PDC=10#, % DROG DESC CALC MODE
    INTO=0#,
    DDPUSW=26#,    % DATA DESC PRESENT UNNAMED SCALAR WORK (MODE)
    DDPUSC=27#,    % DATA DESC PRESENT UNNAMED SCALAR CHR
    DDPUVC=25#,    % DATA DESC PRESENT UNNAMED VECTOR CHR
    DDPNVC=29#,  %DATA DESC PRES PERMANENT VECTOR CHAR MODE
    DDPNVW=28#,  %DATA DESC PRES NAMED VEC WORD (NAMED=PERMANENT)
    OUTOF=1#,
    NAMEDNULLV=0&7[1:45:3]#, %DLUDGE...NAMED VERSION OF NULLV
    BACKP=[6:18]#,
       SCALARDATA=0#,
       ARRAYDATA=2#,
       DATATYPE=[4:1]#,
       ARRAYTYPE=[5:1]#,
       CHARARRAY=1#,
       NUMERICARRAY=0#,
        BLOCKSIZE=30#, %#WORDS OF CONTIGUOUS DATA IN SEQUENTIAL STORE
       VARTYPE=[42:6]#,
       WS=WORKSPACE#,
    DIMPTR=SPF#,
    INPTR=BACKP#,
    QUADIN=[18:3]#,
    QUADINV=18:45:3#,
    STATEVECTORSIZE=16#,
    SUSPENDED=[5:1]#,
    SUSPENDVAR=[2:1]#,
    CTYPEF=3:45:3#,
    CSUSVAR=2:47:1#,
    CNAMED=3:47:1#,
    MAXWORDSTORE=3960#, %APL PREVENTS CREATION OF ARRAYS BIGGER THAN
                        %3960 ELEMENTS.  THIS NUMBER IS THE PRODUCT OF
                        %4,(NUMBER OF POINTERS TO SEQUENTIAL STORE
                        %BLOCKS THAT ARE STORED IN ONE WORD)
                        %30, (BLOCKSIZE),
                        %AND 33, (SIZE OF ARRAY USED TO STORE THESE
                        %POINTERS IN GETARRAY, MOVEARRAY, AND
                        %RELEASEARRAY).  SUBSCRIPTS ALLOWS 8|3960
                        %ELEMENTS IF THEY ARE CHARACTERS.
                        %HOWEVER, SP WILL GET FULL BEFORE THAT SINCE
                        %BIGGEST SP SIZE IS CURRENTLY 3584
    MAXBUFFSIZE=30#,
    MAXHEADERARGS=30#,
    BUFFERSIZE=BUFFSIZE#,
    LINEBUFFER=LINEBUFF#,
    LINEBUFF = OUTBUFF[*]#,
    APPENDTOBUFFER=APPENDTOBUFF#,
     FOUND=TARRAY[0]#,                                                  00022000
     EOB=TARRAY[1]#,
     MANT=TARRAY[2]#,
     MANTLEN=TARRAY[3]#,
     FRAC=TARRAY[4]#,
     FRACLEN=TARRAY[5]#,
     POWER=TARRAY[6]#,
     POWERLEN=TARRAY[7]#,
     MANTSIGN=TARRAY[8]#,
     TABSIZE = 43#,
     LOGINCODES=1#,
     LOGINPHRASE=2#,
     LIBRARY=1#,
     WORKSPACEUNIT=2#,
     RTPAREN=9#,
     MASTERMODE=USERMASK.[1:1]#,
     EDITOG=USERMASK.[2:1]#,
     POLBUG=USERMASK.[3:1]#,
     FPTF=9#,     % FUNCTION POINTER FIELD (STARTS AT CHR POS 9)
     FSQF=11#,   % FUNCTION SEQNTL FIELD
     FFL=2#,     % FUNCTION FIELD LENGTH (2 CHR POSITIONS)
     CRETURN=3:47:1#,
     RETURNVALUE=[3:1]#,
     CNUMBERARGS=4:46:2#,
     NUMBERARGS=[4:2]#,
     RETURNVAL=1#,
     NOSYNTAX=USERMASK.[4:1]#,
     LINESIZE=USERMASK.[41:7]#,
     DIGITS=USERMASK.[37:4]#,
     SUSPENSION=USERMASK.SUSPENDED#,
     SAVEDWS=USERMASK.[7:1]#,
     DELTOG=USERMASK.[6:1]#,
     DELCHR="$"#, %USED IN DELPRESENT (IN FUNCTIONHANDLER)
     MAXMESS=27#,
     USERTOP=21#,
     MARGINSIZE=6#,
     LFTBRACKET=SPECIAL AND ACCUM[0]=11#,
     QUADV=SPECIAL AND ACCUM[0]=10#,
     QUOTEV=ACCUM[0]=20#,
     EXPANDV=38#,
     SLASHV=6#,
     GOTOV=5#,
     DOTV=17#,
     ROTV=37#,
     RGTBRACKET=SPECIAL AND ACCUM[0]=12#,
     DELV=SPECIAL AND ACCUM[0]=13#,
     PLUS        = SPECIAL AND ACCUM[0] = 48#,
     MINUS       = SPECIAL AND ACCUM[0] = 49#,
     NEGATIVE     = SPECIAL AND ACCUM[0] = 51#,
     TIMES       = SPECIAL AND ACCUM[0] = 50#,
     LOGS        = SPECIAL AND ACCUM[0] = 54#,
     SORTUP      = SPECIAL AND ACCUM[0] = 55#,
     SORTDN      = SPECIAL AND ACCUM[0] = 56#,
     NAND        = SPECIAL AND ACCUM[0] = 58#,
     NOR         = SPECIAL AND ACCUM[0] = 59#,
     TAKE        = SPECIAL AND ACCUM[0] = 60#,
     DROPIT      = SPECIAL AND ACCUM[0] = 61#,
     LFTARROW    = SPECIAL AND ACCUM[0] = 04#,
     TRANS       = SPECIAL AND ACCUM[0] = 05#,
     SLASH       = SPECIAL AND ACCUM[0] = 06#,
     INTDIVIDE   = SPECIAL AND ACCUM[0] = 07#,
     LFTPAREN    = SPECIAL AND ACCUM[0] = 08#,
     RGTPAREN    = SPECIAL AND ACCUM[0] = 09#,
     QUOTEQUAD   = SPECIAL AND ACCUM[0] = 14#,
     SEMICOLON   = SPECIAL AND ACCUM[0] = 15#,
     COMMA       = SPECIAL AND ACCUM[0] = 16#,
     DOT         = SPECIAL AND ACCUM[0] = 17#,
     STAR        = SPECIAL AND ACCUM[0] = 18#,
     AT          = SPECIAL AND ACCUM[0] = 19#,
     QUOTE       = SPECIAL AND ACCUM[0] = 20#,
     BOOLAND     = SPECIAL AND ACCUM[0] = 21#,
     BOOLOR      = SPECIAL AND ACCUM[0] = 22#,
     BOOLNOT     = SPECIAL AND ACCUM[0] = 23#,
     LESSTHAN    = SPECIAL AND ACCUM[0] = 24#,
     LESSEQ      = SPECIAL AND ACCUM[0] = 25#,
     EQUAL       = SPECIAL AND ACCUM[0] = 26#,
     GRTEQ       = SPECIAL AND ACCUM[0] = 27#,
     GREATER     = SPECIAL AND ACCUM[0] = 28#,
     NOTEQ       = SPECIAL AND ACCUM[0] = 29#,
     CEILING     = SPECIAL AND ACCUM[0] = 30#,
     FLOOR       = SPECIAL AND ACCUM[0] = 31#,
     STICK       = SPECIAL AND ACCUM[0] = 32#,
     EPSILON     = SPECIAL AND ACCUM[0] = 33#,
     RHO         = SPECIAL AND ACCUM[0] = 34#,                          00030950
     IOTA        = SPECIAL AND ACCUM[0] = 35#,
     TRACE       = SPECIAL AND ACCUM[0] = 36#,
     PHI         = SPECIAL AND ACCUM[0] = 37#,
     EXPAND      = SPECIAL AND ACCUM[0] = 38#,
     BASVAL      = SPECIAL AND ACCUM[0] = 39#,
     EXCLAMATION = SPECIAL AND ACCUM[0] = 40#,
     MINUSLASH   = SPECIAL AND ACCUM[0] = 41#,
     QUESTION    = SPECIAL AND ACCUM[0] = 42#,
     OSLASH      = SPECIAL AND ACCUM[0] = 43#,
     TAU         = SPECIAL AND ACCUM[0] = 44#,
     CIRCLE      = SPECIAL AND ACCUM[0] = 45#,
     LOCKIT       =IDENT AND ACCUM[0]="4LOCK  "#,
     COLON       = SPECIAL AND ACCUM[0] = 47#,
     QUADLFTARROW=51#,
     REDUCT=52#,
     ROTATE=53#,
     SCANV=57#,
     LINEBUFFSIZE=17#,
     MAXPOLISH=100#, MESSIZE=10#,
     MAXCONSTANT=30#,
     MAXMEMACCESSES=3584#,   %MAXSPROWS | SPRSIZE
     MAXSYMBOL=30#,
     MAXSPROWS=28#,
     TYPEFIELD=[3:3]#,
     OPTYPE=[1:2]#,
     LOCFIELD=BACKP#,
     ADDRFIELD=SPF#,
     SYMTYPE=[3:3]#,
     OPERAND=5#,
     CONSTANT=2#,
     OPERATOR=3#,
     LOCALVAR=4#,
     SYMTABSIZE=1#,
     LFTPARENV=8#,
     RGTPARENV=9#,
     LFTBRACKETV=11#,
     RGTBRACKETV=12#,
     SEMICOLONV=15#,
     QUAD=10#,
     QQUAD=14#,
     LFTARROWV=4#,
     SORTUPV=55#,
     SORTDNV=56#,
     ALPHALABEL=1#,
     NUMERICLABEL=2#,
     NEXTLINE=0#,
     ERRORCOND=3#,
     PRESENCE=[2:1]#,
     CHANGE=[1:1]#,
     XEQ=1#,
     CLEARCORE=2#,
     WRITECORE=3#,
 %%%
 %%%
     XEQUTE=1#,
     SLICE=120#,      %TIME SLICE IN 60THS OF A SECOND
     ALLOC=2#,
     WRITEBACK=3#,
     LOOKATSTACK=5#,

     LEN=[1:23]#,
     NEXT=[24:24]#,
     LOC=L.[30:11],L.[41:7]#,
     NOC=N.[30:11],N.[41:7]#,
     MOC=M.[30:11],M.[41:7]#,
     SPRSIZE=128#, % SP ROW SIZE
     NILADIC=0#,
     MONADIC=1#,
     DYADIC=2#,
     TRIADIC=3#,
        DEPTHERROR=1#,
        DOMAINERROR=2#,
        INDEXERROR=4#,
        LABELERROR=5#,
        LENGTHERROR=6#,
        NONCEERROR=7#,
        RANKERROR=8#,
        SYNTAXERROR=9#,
        SYSTEMERROR=10#,
        VALUEERROR=11#,
        SPERROR=12#,
         KITEERROR=13#,
        STREAMBASE=59823125#,                                           00032200
        APLOGGED=[10:1]#,
        APLHEADING=[11:1]#,
        CSTATION = STATION#,
        CAPLOGGED=10:47:1#,
        CAPHEADING=11:47:1#,
        APLCODE = STATIONPARAMS#,

        
        SPECMODE = BOUNDARY.[1:3]#,
        DISPLAYIMG=1#,
        EDITING=2#,
        DELETING=3#,
        RESEQUECING=4#,
        LOWER = BOUNDARY.[4:22]#,
        UPPER = BOUNDARY.[26:22]#,
        OLDBUFFER = OLDINPBUFFER[*]#,

        ENDEFINES=#;
        REAL ADDRESS, ABSOLUTEADDRESS,
        LADDRESS;
        BOOLEAN LINETOG; %GO TO NEXT LINE IF TRUE WHEN WRITING OUT
        INTEGER BUFFSIZE,ITEMCOUNT,RESULT,
        LOGINSIZE,
    %%%  
        ERR,
        NROWS,
    %%%
        CUSER;
    LABEL ENDOFJOB,TRYAGAIN;
    REAL GT1,GT2,GT3;
    DEFINE LINE=PRINT#;
    SAVE ARRAY BUFFER[0:MAXBUFFSIZE];
    ARRAY TARRAY[0:8],
        COMMENT PROGRAM STATE REGISTER;
        PSRM[0:PSRSIZE],
        OLDINPBUFFER[0:MAXBUFFSIZE],
        SP[0:27, 0:SPRSIZE-1],
        IDTABLE[0:TABSIZE],
        MESSTAB[0:MAXMESS],
        JIGGLE[0:0],
        SCR[0:2],
        CORRESPONDENCE[0:7],
        ACCUM[0:MAXBUFFSIZE];
        DEFINE OUTBUFFSIZE=29#,CLOGGED=7:47:1#,STU=15:9:9#;
        ARRAY OUTBUFF[0:OUTBUFFSIZE];
        ALPHA STATION, JOBNUM,  STATIONPARAMS, BOUNDARY;
        INTEGER CHRCOUNT, WORKSPACE;

    STREAM PROCEDURE INITBUFF(B,BUFFSIZE); VALUE BUFFSIZE;
        BEGIN
        DI~B; BUFFSIZE(DS~8LIT" "); DS~LIT"~";
        END;
    STREAM PROCEDURE TRANSFER(A,AS,B,BS,L); VALUE AS,BS,L;
        BEGIN LOCAL T,U,V;
        SI:=LOC AS; DI:=LOC T; DI:=DI+1; DS:=7CHR;
        SI:=LOC BS; DI:=LOC U; DI:=DI+1; DS:=7CHR;
        SI:=LOC L; DI:=LOC V; DI:=DI+1; DS:=7CHR;
        SI:=A; T(2(SI:=SI+32)); SI:=SI+AS;
        DI:=B; U(2(DI:=DI+32)); DI:=DI+BS;
        V(2(DS:=32CHR)); DS:=L CHR;
        END;
    REAL PROCEDURE NUMBER; FORWARD; %LINE 111500
    BOOLEAN PROCEDURE SCAN;
      BEGIN
    REAL STREAM PROCEDURE GNC(ADDR,ACC); VALUE ADDR;
      BEGIN SI:=ADDR; DI:=ACC; DI:=DI+7; DS:=CHR; GNC:=SI;
      DI:=ACC; SKIP DB; DS:=SET; END OF GNC;
    REAL STREAM PROCEDURE RESWD(TAB,BUF,ADDR,EOB,FOUND,K);
        VALUE ADDR,K;
        BEGIN
        LOCAL T,TSI,TDI;
        LABEL TRY,L,KEEPGOING,FINIS,RESTORE;
        LABEL NUMBERFOUND;
        DI:=EOB; DS:=8LIT"0"; DI:=FOUND; DS:=8LIT"0";
        SI:=ADDR;
        L: IF SC NEQ " " THEN GO TO KEEPGOING;
            SI:=SI+1;
            GO TO L;
        KEEPGOING:
        RESWD:=SI;
        ADDR:=SI;
        IF SC GEQ "0" THEN IF SC LEQ "9" THEN GO TO NUMBERFOUND;
        IF SC="#" THEN GO TO NUMBERFOUND;                               00059100
        IF SC="@" THEN GO TO NUMBERFOUND;
        IF SC="." THEN
               BEGIN SI:=SI+1;
               IF SC GEQ "0" THEN IF SC LEQ "9" THEN
               GO TO NUMBERFOUND; SI:=SI-1;
               END;
    DI:=LOC T; DS:=2RESET; DS:=2SET; DS:=2RESET;
    DI:=LOC T;
    IF SC=DC THEN
        BEGIN DI:=EOB; DI:=DI+7; DS:=LIT"1";
        GO TO FINIS
        END;
    SI:=TAB; TSI:=SI;
    TRY:
    IF SC="0" THEN
        BEGIN SI:=ADDR;
        IF SC=ALPHA THEN
        IF SC GEQ"0" THEN
            IF SC LEQ "9" THEN
NUMBERFOUND:
            TALLY:=2 ELSE TALLY := 0
        ELSE TALLY:=1
        ELSE TALLY:=3;
        T:=TALLY; SI:=LOC T; SI:=SI+7; DI:=FOUND; DI:=DI+7;
        DS:=CHR; GO FINIS;
        END;
    DI:=LOC T; DI:=DI+7; DS:=CHR;
    DI:=ADDR;
    IF T SC=DC THEN
        BEGIN
        TSI:=SI; TDI:=DI; SI:=SI-1;
        IF SC=ALPHA THEN
            BEGIN DI:=DI+16; SI:=TDI;
            IF SC NEQ " " THEN IF SC =ALPHA THEN ;
            END;
        SI:=TSI;
        END ELSE GO TO RESTORE;
    IF TOGGLE THEN
    RESTORE:
        BEGIN SI:=SI+K; DI:=ADDR; GO TO TRY
        END;
    DI:=FOUND; DS:=K OCT;
    DI:=TDI; RESWD:=DI;
    FINIS:
    END;
REAL STREAM PROCEDURE ACCUMULATE(ACC,EDB,ADDR); VALUE ADDR;
   BEGIN LOCAL T; LABEL EOBL,E,ON,L;
   DI:=ACC; 9(DS:=8LIT" ");
   DI:=EOB; DS:=8LIT"0"; SI:=ADDR; DI:=LOC T; SKIP 2 DB;
   DS:=2SET; DI:=LOC T;
   63(IF SC=ALPHA THEN TALLY:=TALLY+1 ELSE JUMP OUT TO E;
   SI:=SI+1);
   L:  IF SC=ALPHA THEN BEGIN SI:=SI+1; GO L END ELSE GO ON;
   IF SC=" " THEN GO ON;
   E:  IF SC = DC THEN ;
      SI:=SI-1; IF TOOGLE THEN GO TO EOBL ELSE GO ON;
   EOBL:  DI:=EOB; DI:=DI+7; DS:=LIT"1";
   ON:  ACCUMULATE:=SI; DI:=ACC; T:=TALLY; SI:=LOC T; SI:=SI+6;
   DS:=2CHR; SI:=ADDR; DS:=T CHR;
   END OF ACCUMULATE;
BOOLEAN STREAM PROCEDURE ARROW(ADDR,I); VALUE ADDR,I;
   BEGIN SI:=ADDR; SI:=SI-1; DI:=LOC I; DI:=DI+7;
   IF SC=DC THEN TALLY:=1; ARROW :=TALLY
   END OF ARROW;
  IF NOT BOOLEAN(EOB) THEN BEGIN
     LADDRESS:=ADDRESS;
     ADDRESS:=RESWD(IDTABLE,BUFFER,ADDRESS,EOB,FOUND,2);
     IF RESULT:=FOUND NEQ 0 THEN BEGIN
        IF RESULT=1 THEN ADDRESS:=ACCUMULATE(ACCUM,EOB,ADDRESS)
        ELSE IF RESULT=2 THEN ACCUM[0]:=NUMBER
        ELSE IF RESULT=3 THEN ADDRESS:=GNC(ADDRESS,ACCUM)
        ELSE BEGIN ACCUM[0]:=RESULT; RESULT:=3 END;
        ITEMCOUNT:=ITEMCOUNT+1;
        SCAN:=TRUE;
        IF ARROW(ADDRESS,31) THEN
           BEGIN EOB:=1; SCAN:=FALSE END;
        END ELSE EOB:=1;
     END;
   END OF THE SCAN PROCEDURE;
PROCEDURE FORMROW(CC,BL,A,S,N); VALUE CC,RL,S,N;
    INTEGER CC,BL,S,N; ARRAY A[0]; FORWARD
    ;
PROCEDURE INDENT(R); VALUE R; REAL R; FORWARD;                          00096300
PROCEDURE TERPRINT; FORWARD;
PROCEDURE PROCESS(MODE);VALUE MODE;INTEGER MODE; FORWARD;
REAL STREAM PROCEDURE ABSADDR(A);
    BEGIN SI:=A; ABSADDR:=SI
    END;
BOOLEAN PROCEDURE LIBRARIAN(MFID,FID); VALUE MFID,FID;
    REAL MFID,FID;
    BEGIN
    REAL ARRAY A[0:6]; FILE DF DISK(1,1);
    REAL T;
    COMMENT LIBRARIAN IS TRUE IF MFID/FID IS PRESENT ON DISK;
     FILL DF WITH MFID,FID;
    SEARCH(DF,A[*]);
    LIBRARIAN:=
        A[0]!-1;
    END;
FILE SPO 11(1,3);
PROCEDURE SPOUT(K); VALUE K; INTEGER K;
    BEGIN FORMAT ERRF("APL ERROR:",I8,A1);
    WRITE(SPO,ERRF,K,31);
    END;
PROCEDURE INITIALIZETABLE;
    BEGIN DEFINE STARTSEGMENT= #;
    INTEGER I;
    LADDRESS:=
    ABSOLUTEADDRESS:=ABSADDR(BUFFER);
    BIGGEST := REAL(NOT FALSE) & 0[1:46:2];
    NULLV := 0 & 3[1:46:2];
    STATUSWORD~REAL(BOOLEAN(STATUSWORD) OR BOOLEAN(1));
    JOBNUM~TIME(-1);
    STATION~0&1[CLOGGED]&STATUSWORD[STU];
    FILL JIGGLE[*] WITH OCT5757575757575737;%CARRIAGE RETURNS LEFT ARROW
    FILL IDTABLE[*] WITH
    "1+481-49", "1&501%07", "1.171@19", "1#411(08",
    "1)091/06", "3XEQ623L", "OG541;15", OCT0333777601040177,
            %LAST IN ABOVE LINE IS REALLY 3["]141"
    "202:=042", "[]101[11", "1]123AND", "212OR223",
    "NOT233LS", "S243LEQ2", "53GEQ273", "GTR283NE", "Q292=:05",
    "2GO051=2", "63MAX304", "CEIL303F", "LR313MIN",
    "314RESD3","23ABS323","RHO341*1","84IOTA35",
    "1|384RND", "M425TRAN", "S431$133", "PHI374FA",
    "CT404COM", "B406CIRC", "LE456SOR", "TUP556SO",
    "RTDN561:", "474NAND5", "83NOR594", "TAKE604D",
    "ROP613RE", "P446BASV", "AL393EPS", "331,1600";
  COMMENT IDTABLE IS TABLE OF RESERVED WORDS AND SPECIAL SYMBOLS.
    FORMAT IS NUMBER OF CHARACTERS IN SYMBOL, FOLLOWED BY SYMBOL
    ITSELF, FOLLOWED BY A TWO-DIGIT DECIMAL CODE WHICH APL USES
    FOR THE RESERVED WORD--LIKE IN THE EXECUTION CASE STATEMENT AND
    IN SYNTAX CHECKING.  FOR SCAN TO WORK, THE TWO-DIGIT CODE MUST
    BE GREATER THAN 3 AND IDTABLE MUST HAVE AT LEAST ONE "0" AT THE
    END TO MARK THE END.  TABSIZE IS THE DEFINE (LINE 30000) GIVING
    THE SIZE OF IDTABLE;
    IF STACKSIZE=0 THEN STACKSIZE:=100 ELSE
        IF STACKSIZE GTR 1022 THEN STACKSIZE:=1022;
    BUFFSIZE:=MAXBUFFSIZE;
    LINETOG := TRUE; %USUALLY GO TO NEXT LINE WHEN WRITING OUT
    
    INITBUFF(OUTBUFF, 10);
    INITBUFF(BUFFER,BUFFSIZE);
    NROWS:=-1;
    NAME(LIBJOB,TIME(-1));
    FILL MESSTAB[*] WITH
    "4SAVE  ",
    "4LOAD  ",
    "5CLEAR ",
    "4COPY  ",
    "4VARS  ",
    "3FNS   ",
    "6LOGGED",
    "3MSG   ",
    "5WIDTH ",
    "3OPR   ",
    "6DIGITS",
    "3OFF   ",
    "6ORIGIN",
    "4SEED  ",
    "4FUZZ  ",
    "3SYN   ",
    "5NOSYN ",
    "5STORE ",
    "5ABORT ",
    "2SI    ",
    "3SIV   ",                                                          00105360
    "5ERASE ",
    %--------------MASTERMODE BELOW HERE...(SEE USERTOP)--------
    "6ASSIGN",
    "6DELETE",
    "4LIST  ",
    "5DEBUG ",
    "5FILES ";
    
    IF LIBSIZE=-1 THEN
    BEGIN LIBSIZE~1;GTA[0]~"       ";STOREORD(LIBRARY,GTA,0);WRAPUP;
    END ELSE BEGIN LIBSIZE~SIZE(LIBRARY);
             FOR I~1 STEP 1 UNTIL LIBSIZE-1 DO
              BEGIN GT1~CONTENTS(LIBRARY,I,ACCUM);
              IF NOT LIBRARIAN(ACCUM[0],TIME(-1)) THEN
              BEGIN DELETE1(LIBRARY,I);LIBSIZE~LIBSIZE-1;END;
    IF (LOGINSIZE:=SIZE(LOGINCODES)=0) THEN
              END;
             END;
    FILL CORRESPONDENCE[*] WITH
      OCT1111111111110311,
      OCT1111111111111111,
      OCT1104111121221113,
      OCT2014151617100706,
      OCT1111111111111112,
      OCT1111111111111100,
      OCT0201111111251111,
      OCT2324111111111111;
    COMMENT  CORRESPONDENCE GIVES THE CORRESPONDENCE BETWEEN THE
      APL CODES FOR DYADIC SCALAR OPERATORS (EXCEPT CIRCLE) AND
      THEIR POSITIONS IN THE "CASE STATEMENT" IN "OPERATION".
      E.G. APL CODE 7 IS "OPERATION" CODE 3 IN OCTAL (FOR DIVIDE).
      IF N-TH CHARACTER IN CORRESPONDECE IS OCTAL 11, THEN N
      IS NOT AN APL CODE FOR A DYADIC SCALAR OPERATOR.  CHARACTER
      COUNT STARTS AT 1 FOR FIRST CHARACTER. TO MAKE IT COME OUT
      RIGHT, STREAM PROCEDURE GETOP IS ACTUALLY CALLED WITH APL
      OPERATION CODE MINUS 1;
    END;
REAL STREAM PROCEDURE CONV(ADDR,N);
  VALUE N,ADDR;
  BEGIN SI:=ADDR;
  DI:=LOC CONV;
  DS:=N OCT; END;
REAL STREAM PROCEDURE BUMP(ADDR,N); VALUE ADDR,N;
  BEGIN SI:=ADDR; SI:=SI+N; BUMP:=SI; END;
REAL PROCEDURE NUMBER;
  BEGIN REAL NCHR;
  LABEL GETFRAC,GETPOWER,QUIT,KITE;
  MONITOR EXPOVR;
  REAL PROCEDURE INTCON(COUNT); VALUE COUNT;
       REAL COUNT;
    BEGIN REAL TLO,THI,T; INTEGER N;
    BOOLEAN DPTOG; DEFINE ADDR=ADDRESS#;
    COMMENT:  VALUE OF INTCON IS THE CONVERSION OF AN INTEGER
              CONSISTING OF COUNT NUMERICAL CHARACTERS STARTING
              AT THE CHARACTER ADDRESS.  ADDRESS IS SET TO POINT
              TO THE NEXT CHARACTER DURING INTCON;
    DPTOG:=COUNT GTR 8;
    THI:=T:=CONV(ADDR,N:=COUNT MOD 8);
    ADDR:=BUMP(ADDR,N);
    COUNT:=COUNT DIV 8;
    FOR N:=1 STEP 1 UNTIL COUNT DO BEGIN
         IF DPTOG THEN BEGIN
         DOUBLE(THI,TLO,100000000.0,0,|,CONV(ADDR,8),
                0,+,:=,THI,TLO);
         T:=THI
       END ELSE T:=T|100000000 + CONV(ADDR,8);
        ADDR:=BUMP(ADDR,8); END;
    INTCON:=T;
    END OF INTCON;
  INTEGER STREAM PROCEDURE SUBSCAN(ADDR,NEXT); VALUE ADDR;
    BEGIN SI:=ADDR;
    63(IF SC GEQ "0" THEN
      IF SC LEQ "9" THEN BEGIN SI:=SI+1; TALLY:=TALLY+1;
             END ELSE JUMP OUT);
    DI:=NEXT; DI:=DI+7; DS:=1 CHR; SUBSCAN:=TALLY;
    END;
  COMMENT--VALUE OF SUBSCAN IS NUMBER OF NUMERIC CHARACTERS
   FOUND. NEXT CONTAINS THE FIRST NON-NUMERIC CHARACTER;
  EXPOVR:=KITE;
  MANTSIGN:=1;
  MANT:=MANTLEN:=POWER:=POWERLEN:=FRAC:=FRACLEN:=0;
  MANLEN:=SUBSCAN(ADDRESS,NCHR);
  IF MANTLEN=0 AND NCHR="#" THEN BEGIN                                  00130500
     MANTSIGN:=-1;
     ADDRESS:=BUMP(ADDRESS,1);
     MANTLEN:=SUBSCAN(ADDRESS,NCHR); END;
  IF MANTLEN=0 THEN BEGIN ADDRESS:=BUMP(ADDRESS,1);
     IF NCHR="." THEN GO TO GETFRAC
       ELSE IF NCHR="@" OR NCHR="E" THEN GO TO GETPOWER
           ELSE BEGIN ERR:=SYNTAXERROR;
                      GO TO QUIT; END; END;
  MANT:=INTCON(MANTLEN);
  IF NCHR="." THEN BEGIN ADDRESS:=BUMP(ADDRESS,1); GO GETFRAC END;
  IF NCHR="@" OR NCHR="E" THEN BEGIN
      ADDRESS:=BUMP(ADDRESS,1); GO TO GETPOWER END;
  IF NCHR=12 THEN EOB:=1;
  GO TO QUIT;
  GETFRAC:  FRACLEN:=SUBSCAN(ADDRESS,NCHR);
    IF FRACLEN=0 THEN BEGIN ERR:=SYNTAXERROR; GO TO QUIT; END;
    FRAC:=INTCON(FRACLEN);
    IF NCHR="@" OR NCHR="E" THEN BEGIN
       ADDRESS:=BUMP(ADDRESS,1); GO TO GETPOWER; END;
    IF NCHR=12 THEN EOB:=1 ELSE
       IF NCHR="." OR NCHR="#" THEN ERR:=SYNTAXERROR;
    GO TO QUIT;
  GETPOWER:
    POWERLEN:=SUBSCAN(ADDRESS,NCHR);
    IF POWERLEN=0 THEN BEGIN
       IF NCHR="-" OR NCHR="#" THEN POWER:=-1
          ELSE IF NCHR="+" THEN POWER:=1
            ELSE BEGIN ERR:=SYNTAXERROR; GO TO QUIT; END;
       POWERLEN:=SUBSCAN(ADDRESS:=BUMP(ADDRESS,1), NCHR);
       END ELSE POWER:=1;
    IF POWERLEN=0 THEN ERR:=SYNTAXERROR
          ELSE BEGIN
            POWER:=INTCON(POWERLEN)|POWER;
            IF NCHR="#" OR NCHR="@" OR NCHR="."
                THEN ERR:=SYNTAXERROR; END;
    GO TO QUIT;
  KITE:  ERR:=KITEERROR;
  QUIT:  IF ERR=0 THEN
    NUMBER:=IF MANTLEN+FRACLEN=0 THEN
       IF POWERLEN=0 THEN 0
       ELSE MANTSIGN|10*ENTIER(POWER)
       ELSE MANTSIGN|(MANT|10*ENTIER(POWER)
             + FRAC|10*ENTIER(POWER-FRACLEN)) ELSE EOB:=1;
  END OF NUMBER;
STREAM PROCEDURE APPENDTOBUFF(BUF,NBUF,NBLANK,A,SA,NA);
    VALUE NBUF,NBLANK,SA,NA;
    BEGIN LOCAL T;
    LOCAL TSI,TDI;
    SI:=LOC NBUF; DI:=LOC T; DI:=DI+1; DS:=7CHR;
    DI:=BUF; T(2(DI:=DI+32)); DI:=DI+NBUF;
    NBLANK(DS:=LIT" "); TDI:=DI;
    SI:=LOC SA; DI:=LOC T; DI:=DI+1; DS:=7CHR;
    SI:=A; T(2(SI:=SI+32)); SI:=SI+SA;
    TSI:=SI; SI:=LOC NA; DI:=LOC T; DI:=DI+1; DS:=7CHR;
    SI:=TSI; DI:=TDI; T(2(DS:=32CHR)); DS:=NA CHR
    END;
PROCEDURE TERPRINT;
    BEGIN LABEL BK;
STREAM PROCEDURE FINISHBUFF(BUF,N,TER);VALUE N,TER;
    BEGIN LOCAL T;
    SI:=LOC TER;SI:=SI+7;IF SC="1" THEN;
    SI:=LOC N; DI:=LOC T; DI:=DI+1; DS:=7 CHR;
    DI:=BUF; T(2(DI:=DI+32));DI:=DI+N;
    IF TOOGLE THEN DS:=2 LIT"{!"; %CARRIAGE RETURN/LINE FEED
    DS:=RESET;DS:=5 SET; %END OF MESSAGE LEFT ARROW
    END OF FINISHBUFF;
 IF CHRCOUNT NEQ 0 THEN BEGIN
    FINISHBUFF(OUTBUFF,CHRCOUNT,LINETOG);
    CHRCOUNT:=0;
    IF LINETOG THEN
    WRITE(TWXOUT,9,OUTBUFF[*])[BK:BK] ELSE
    WRITE(TWXOUT[STOP],9,OUTBUFF[*])[BK:BK];
    INITBUFF(OUTBUFF, 10);
    END;
    IF FALSE THEN
OK: IF CURRENTMODE=XEQMODE THEN BREAKFLAG:=TRUE;
 END OF TERPRINT;
PROCEDURE FORMWD(CC,WD); VALUE CC,WD; REAL WD; INTEGER CC;
    BEGIN
    INTEGER I,K,L;
    COMMENT CC=-1 STAY ON LINE, OUTPUT, DON"T GO TO NEXT LINE
    COMMENT CC=0 STAY ON THIS LINE, MORE TO COME.
            CC=1 STAY ON THIS LINE BUT TERMINATE PRINT.                 00257000
            CC=2 SKIP TO NEXT LINE - MORE TO COME.
            CC=3 SKIP TO NEXT LINE - TERMINATE PRINT.;
    REAL STREAM PROCEDURE OCTAL(I); VALUE I;
        BEGIN SI:=LOC I; DI:=LOC OCTAL; DS:=8OCT
        END;
    IF L:=LINESIZE LEQ 9 OR L GTR 72 THEN L:=72; K:=2;
    IF CC GTR 1 AND CHRCOUNT GTR OTHEN TERPRINT;
    IF CHRCOUNT+(I:=OCTAL(WD.[1:11])) GTR L THEN
    
        BEGIN APPENDTOBUFF(LINEBUFFER,CHRCOUNT,
        0,WD,2,K:=L-CHRCOUNT);
    CHRCOUNT:=L; TERPRINT;
    
        I:=I-K;
        
        END;
    APPENDTOBUFF(LINEBUFFER,CHRCOUNT,0,WD,K,I);
    
    CHRCOUNT:=CHRCOUNT+I;
    IF BOOLEAN(CC) THEN
       IF CC=-1 THEN BEGIN LINETOG:=FALSE;
                          TERPRINT; LINETOG:=TRUE
                    END ELSE TERPRINT;
    END;
BOOLEAN PROCEDURE FUNCTIONHEADER(SPECS,HADDR);
    ARRAY SPECS[0]; REAL HADDR; FORWARD;
    
    
    
REAL PROCEDURE LINENUMBER(R); VALUE R; REAL R;
    COMMENT STARTS ON 8030000;
    FORWARD;
    
PROCEDURE INDENT(R); VALUE R; REAL R;
    BEGIN
    INTEGER STREAM PROCEDURE FORM(A,I,K);VALUE K,I;
        BEGIN
        LOCAL T1,T2;
        LABEL SHORT,L,M,FINIS;
        TALLY:=K; FORM:=TALLY;
        SI:=LOC I; DI:=LOC T1; IF 8SC=DC THEN
            BEGIN DI:=A; K(DS:=LIT" "); GO FINIS
            END;
        SI:=LOC I; DI:=A; TALLY:=3; DS:=LIT"[";
        IF SC GTR "0" THEN IF SC LSS "0" THEN ;
        3(TALLY:=TALLY+1; IF TOGGLE THEN DS:=CHR ELSE
            IF SC NEQ "0" THEN DS:=CHR ELSE
            BEGIN TALLY:=TALLY+63; SI:=SI+1
            END );
        DS:=CHR; T1:=TALLY; TALLY:=4; SI:=SI+3;
        4(IF SC NEQ "0" THEN JUMP OUT TO M;
            TALLY:=TALLY+63; SI:=SI-1); GO TO L;
        M:
        T2:=TALLY; SI:=LOC I; SI:=SI+4; DS:=LIT"."; DS:=T2 CHR;
        TALLY:=T1; TALLY:=TALLY+T2; TALLY:=TALLY+1; T1:=TALLY;
        L:
        DS:=LIT"]"; TALLY:=K;
        T1(TALLY:=TALLY+63; T2:=TALLY; SI:=LOC T2; SI:=SI+7;
            IF SC="0" THEN JUMP OUT TO SHORT);
        T2(DS:=LIT" "); GO FINIS;
        SHORT:
        TALLY:=T1; TALLY:=TALLY+1; FORM:=TALLY; DS:=LIT" ";
        FINIS:
        DS:=RESET; DS:=5SET;
        END;
    IF R LSS 0 THEN R:=LINENUMBER(-R) ELSE R:=ABS(R); % -0
    CHRCOUNT:=FORM(LINEBUFF,R,MARGINSIZE)+1
    
    END;
INTEGER PROCEDURE HEADER(ADDR1,ADDR2,BUF); VALUE ADDR1,ADDR2;
  INTEGER ADDR1, ADDR2; ARRAY BUF[0];
  BEGIN
 INTEGER STREAM PROCEDURE HEADRR(ADDR1,ADDR2,BUF); VALUE ADDR1,
    ADDR2;
    BEGIN
    LOCAL C,T,TDI;
    LOCAL QM,AR;
    LABEL L,ENDSCAN,M,N;
    DI:=LOC QM; DS:=2RESET; DS:=2SET;
    DI:=LOC AR; DS:=RESET; DS:=5SET;
    DI:=BUF;
    SI:=ADDR1;
    L: T:=SI; TDI:=DI                                                   00287210
    DI:=LOC QM; IF SC=DC THEN GO TO ENDSCAN;
    DI:=LOC AR; SI:=SI-1; IF SC=DC THEN GO TO ENDSCAN;
    SI:=LOC T; DI:=LOC ADDR2;
    IF 8SC=DC THEN COMMENT END OF SCAN;
        GO TO ENDSCAN;
    SI:=T; DI:=TDI; DS:=CHR;
    GO TO L;
    ENDSCAN:
    SI:=TDI;
    M:    SI:=SI-1;
    IF SC=" " THEN GO TO M;
    SI:=SI+1;
    ADDR2:=SI;
    SI:=BUF;
    N: T:=SI; DI:=LOC ADDR2;
    SI:=LOC T;
    IF 8SC NEQ DC THEN
        BEGIN
        TALLY:=TALLY+1; TDI:=TALLY;
        SI:=LOC TDI; SI:=SI+7;
        IF SC="0" THEN
            BEGIN TALLY:=C; TALLY:=TALLY+1; C:=TALLY;
            TALLY:=0;
            END;
        SI:=T; SI:=SI+1; GO TO N;
        END;
    HEADRR:=TALLY; SI:=LOC C; DI:=LOC HEADRR; SI:=SI+1; DS:=6 CHR;
    END;
  HEADER:=HEADRR(ADDR1,ADDR2,BUF);
  END OF PHONY HEADER;
PROCEDURE STARTSCAN;
    BEGIN
    
    
    
   LADDRESS:=
    ADDRESS:=ABSOLUTEADDRESS;
        BEGIN TERPRINT;
        END;
    READ(TWXIN[STOP],29,BUFFER[*]);
    BUFFER[30]:=0&31[1:43:5];
    ITEMCOUNT:=0;
    EOB:=0
    END;
PROCEDURE FORMROW(CC,BL,A,S,N); VALUE CC,BL,S,N; INTEGER CC,BL,
    S,N; ARRAY A[0];
    COMMENT:  CC--SAME CODE AS IN FORMWD, LINE 253000
              BL--#BLANKS TO PUT IN FRONT OF IT
               A--ARRAY WHERE THE STUFF TO PUT ON LINE IS STORED
               S--#CHARACTERS TO SKIP AT START OF A
               N--#CHARACTERS TO TAKE FROM A TO PUT ON OUTPUT LINE;
    BEGIN INTEGER K;
    INTEGER T;
    IF CC GTR 1 AND CHRCOUNT GTR 0  THEN TERPRINT;
    IF K:=LINESIZE LEQ 9 OR K GTR 72 THEN K:=72;
    WHILE CHRCOUNT+N+BL GTR K DO
        BEGIN
        APPENDTOBUFFER(LINEBUFFER,CHRCOUNT,BL,A,S,T:=K-CHRCOUNT-BL);
        CHRCOUNT:=K; TERPRINT;
        S:=S+T; N:=N-T;
        BL:=0;
        END;
    APPENDTOBUFFER(LINEBUFFER,CHRCOUNT,BL,A,S,N);
    
    CHRCOUNT:=CHRCOUNT+N+BL;
    IF BOOLEAN(CC) THEN
       IF CC=-1 THEN BEGIN LINETOG:=FALSE;
                          TERPRINT; LINETOG:=TRUE;
                    END ELSE TERPRINT;
    END;
PROCEDURE NUMBERCON(R,A); VALUE R; REAL R; ARRAY A[0];
    BEGIN FORMAT F(F24.*), G(E24.*);
    REAL S; DEFINE MAXIM = 10@9#;
    
    STREAM PROCEDURE ADJUST(A,B);
        BEGIN LOCAL T,FRAC,MANT,T1,TSI,TDI;
        DI:=LOC T; DI:=DI+1; T1:=DI;
        SI:=B; DI:=A; DI:=DI+2;
        24(IF SC=" " THEN SI:=SI+1 ELSE
            BEGIN TSI:=SI; SI:=LOC T;
            IF SC="1" THEN; SI:=TSI;
            IF TOGGLE THEN
               IF SC NEQ "0" THEN                                       00342000 P24
                   IF SC="@" THEN BEGIN
                       TSI:=SI; DI:=T1; DS:=LIT"1"; JUMP OUT;
                       END ELSE FRAC:=TALLY
                   ELSE TALLY := TALLY+0
               ELSE
           IF SC="." THEN
               BEGIN MANT:=TALLY; TDI:=DI; DI:=LOC T; DS:=
               LIT"1"; TALLY:=0;DI:=TDI;
               END;
           TALLY:=TALLY+1; DS:=CHR
           END);
       SI:=LOC MANT; SI:=SI+7; IF SC="0" THEN MANT:=TALLY;
       
       TALLY:=MANT; SI:=LOC FRAC; SI:=SI+7; IF SC GTR "0"
       THEN TALLY:=TALLY+1; TALLY:=TALLY+FRAC; MANT:=TALLY;
       SI:=T1; IF SC="1" THEN BEGIN
           DI:=A; DI:=DI+MANT; DI:=DI+2;
           SI:=TSI;  DS:=4CHR;
           TALLY:=TALLY+4; MANT:=TALLY; END;
       SI:=LOC MANT; SI:=SI+6; DI:=A; DS:=2CHR;
       END;
    IF S:=ABS(R) GEQ MAXIM OR S LEQ 10*(-DIGITS) AND S NEQ 0 THEN
       WRITE(SCR[*],G,DIGITS,R) ELSE
    WRITE(SCR[*],F,DIGITS,R);
    ADJUST(A,SCR)
    END;
PROCEDURE STOREPSR;
    BEGIN INTEGER I;
    DELETE1(WORKSPACE,0);
    I:=STORESEQ(WORKSPACE,PSR,PSRSIZE|8);
        COMMENT USED TO CALL WRAPUP;
    END;
PROCEDURE RESCANLINE;
    BEGIN ADDRESS:=ABSOLUTEADDRESS; EOB:=0; END;
PROCEDURE PROCESS(MODE);VALUE MODE;  INTEGER MODE; FORWARD;
PROCEDURE MESSAGEHANDLER; FORWARD;
PROCEDURE FUNCTIONHANDLER; FORWARD;
PROCEDURE ERRORMESS(N,ADDR,R); VALUE N,ADDR,R; REAL R;
    INTEGER N;REAL ADDR;FORWARD; COMMENT LINE 5000000;
STREAM PROCEDURE SETFIELD(A,S,L,R); VALUE S,L,R;
    BEGIN DI:=A; DI:=DI+S; SI:=LOC R; SI:=SI+8; L(SI:=SI-1);
    DS:=L CHR;
    END;
COMMENT:  VALUE OF GETFIELD IS L CHARACTERS, STARTING AT J-TH
          CHARACTER OF A, RIGHT-ADJUSTED.  L MUST BE LEQ 8 AND
          J MUST BE LESS THAT 64;
REAL STREAM PROCEDURE GETFIELD(A,S,L); VALUE S,L;
    BEGIN SI:=A; SI:=SI+S; DI:=LOC GETFIELD; DI:=DI+8; L(DI:=DI-1);
    DS:=L CHR;
    END;
REAL PROCEDURE TOPLINE(ORD); VALUE ORD; INTEGER ORD;
    BEGIN
    INTEGER STREAM PROCEDURE CON(A); VALUE A;
        BEGIN SI:=LOC A; DI:=LOC CON; DS:=8OCT END;
        ARRAY A[0:1]; INTEGER I;
        I:=CONTENTS(ORD,SIZE(ORD)-1,A);
        TOPLINE:=CON(A[0])/10000
    END;
BOOLEAN PROCEDURE FUNCTIONHEADER(SPECS,HADDR);
ARRAY SPECS[0]; REAL HADDR;
BEGIN
LABEL A,B,C;
INTEGER P;
DEFINE NOTE=HADDR.[24:24]:=ADDRESS#,P8=8|P+1#;
ERR:=0;
SPECS[0]:=SPECS[1]:=SPECS[2]:=SPECS[3]:=0;
NOTE; HADDR.[1:23]:=GT1:=ADDRESS;
IF SCAN AND IDENT THEN
    BEGIN
    TRANSFER(ACCUM,2,SPECS,1,7);
    NOTE;
    IF SCAN THEN
        IF LFTARROW THEN
            BEGIN
            SPECS[1]:=1;
            SPECS[3]:=1;
            TRANSFER(SPECS,1,SPECS,33,7);
            GT2:=ADDRESS;
            IF SCAN AND IDENT THEN
                BEGIN
                TRANSFER(ACCUM,2,SPECS,1,7);
                NOTE;
                   IF SCAN THEN                                         00501600
                       C: IF IDENT THEN
                           BEGIN
                           P:=(SPECS[3]:=SPECS[3]+1)+3;
                          TRANSFER(ACCUM,2,SPECS,P8,7);
                           SPECS[2]:=1;
                          NOTE;
                           IF SCAN THEN IF IDENT THEN
                           BEGIN SPECS[2]:=2;
                           P:=(SPECS[3]:=SPECS[3]+1)+2;
                          TRANSFER(SPECS,1,SPECS,P8+8,7);
                          TRANSFER(SPECS,P8,SPECS,1,7);
                          TRANSFER(ACCUM,2,SPECS,P8,7);
                          
                           B: NOTE; IF SCAN THEN
                           A: IF SEMICOLON THEN IF SCAN THEN
                           IF IDENT THEN
                           BEGIN
                           P:=(SPECS[3]:=SPECS[3]+1)+3;
                          TRANSFER(ACCUM,2,SPECS,P8,7);
                           GO TO B;
                           END ELSE GO TO A
                           ELSE ELSE ELSE
                           END ELSE GO TO A
                           ELSE END
                       ELSE GO TO A ELSE
               END ELSE ERRORMESS(ERR:=1,GT2,0)
               END ELSE GO TO C
           ELSE
       END ELSE ERRORMESS(ERR:=SYNTAXERROR,GT1,0);
   FUNCTIONHEADER:=ERR=0;
   ADDRESS:=HADDR.[24:24];
   END FUNCTIONHEADER;

   INTEGER PROCEDURE DAYTIME(B); ARRAY B[0]; FORWARD;
       COMMENT ON LINE 8014000, ARRAY B MUST HAVE LENGTH
       AT LEAST 3 WDS;
   PROCEDURE EDITLINE; FORWARD;
   INTEGER PROCEDURE LENGTH(A,M);VALUE M; BOOLEAN M; ARRAY A[0];
       FORWARD; COMMENT LINE 8007900;
   BOOLEAN PROCEDURE LABELSCAN(L,K); VALUE K; INTEGER K;
       ARRAY L[0]; FORWARD; COMMENT LINE 8013910;


   PROCEDURE CHECKSEQ(SEQ,L,INC); REAL SEQ,L,INC; FORWARD;
       COMMENT ON LINE 8040000;
   PROCEDURE RELEASEARRAY(D);VALUE D; REAL D;
       BEGIN COMMENT  RELEASE PERMANENT STORAGE FOR THE ARRAY DESC D;
       INTEGER K,J,PT;
       ARRAY BLOCK[0:32];  %SEE MAXWORDSTORE, LINE 17260
       ARRAY TEMP[0:1];
       IF D.RF NEQ 0 THEN
           BEGIN DELETE1(WS,D.DIMPTR);
           K:=CONTENTS(WS,D.INPTR,BLOCK)-1;
           DELETE1(WS,D,INPTR);
           FOR J:=0 STEP 2 UNTIL K DO
           BEGIN TRANSFER(BLOCK,J,TEMP,6,2);
               PT:=TEMP[0]; DELETE1(WS,PT); END;
           END;
       END;
   PROCEDURE TRANSFERSP(DIR,SP,L,B,M,N); VALUE DIR,N,M,L;       
       INTEGER DIR,N,M,L;
       ARRAY SP[0,0],B[0];
       BEGIN COMMENT
       DIR= INTO:  TRANSFER N WORDS FROM B[L] INTO SP[M]
                   (ACTUALLY SP[*,M] SINCE ARRAY ROW IS USUALLY THE ARG)
       DIR= OUTOF (OPPOSITE);
       STREAM PROCEDURE MOVER(DIR,SP,M,B,L,N); VALUE DIR,
           L,M,N;
           BEGIN LOCAL T;
           SI:=LOC L; DI:=LOC T; DI:=DI+1; DS:=7CHR;
           SI:=SP; T(16(SI:=SI+32)); L(SI:=SI+8); L:=SI;
           SI:=LOC M; DI:=LOC T; DI:=DI+1; DS:=7CHR;
           SI:=B; T(16(SI:=SI+32)); M(SI:=SI+8); M:=SI;
           SI:=LOC N; DI:=LOC T; DI:=DI+1; DS:=7CHR;
           SI:=LOC DIR; SI:=SI+7;
           IF SC="0" THEN
                 BEGIN SI:=M; DI:=L
                 END ELSE
                 BEGIN SI:=L ; DI:=M
                 END;
           T(2(DS:=32WDS)); DS:=N WDS;
           END;
       INTEGER K;                                                       03002210
       WHILE N:=N-K GTR 0 DO
           MOVER(DIR,SP[(L:=L+K)DIV SPRSIZE,*],
           M:=M+K,B,K:=L MOD SPRSIZE,
           K:=MIN(SPRSIZE-K,N))
       END;
       
   PROCEDURE DUMPOLISH(SP,PD); VALUE PD; REAL PD; ARRAY SP[0,0];
       BEGIN INTEGER L;
       LABEL SKIPREST;
       INTEGER I,N,M,U; REAL T;
       L:=PD.SPF;
       I:=SP[LOC]+L;
       FOR L:=L+2 STEP 1 UNTIL I DO
   IF (T:=SP[LOC]).TYPEFIELD=FUNCTION THEN
       BEGIN % OUTPUT MESSAGE AND NAME
       FORMWD(2,"5FUNC: ");
       N:=T.LOCFIELD; % N HAS LOCATION OF DESCRIPTOR
       N:=N-1; % BACK UP ONE TO GET NAME
       GTA[0]:=SP[NOC];
       FORMROW(1,1,GTA,1,7);
       END
   ELSE % MIGHT BE AN OPERATOR
   IF T.TYPEFIELD=OPERATOR THEN
           BEGIN COMMENT OUTPUT MESSAGE AND OP CODE;
           FORMWD(2,"5ATOR: ");
           NUMBERCON(T.OPTYPE,ACCUM);
           FORMROW(0,1,ACCUM,2,ACOUNT);
           NUMBERCON(T.LOCFIELD,ACCUM);
           FORMROW(1,1,ACCUM,2,ACOUNT);
           END ELSE %MAY BE A CONSTANT
       IF T.TYPEFIELD=CONSTANT THEN
           BEGIN COMMENT GET DATA DESCRIPTOR;
           N:=T.LOCFIELD;
           FORMWD(2,"5CONS: ");
           T:=SP[NOC];     %T HAS THE DATA DESCRIPTOR
           IF T.SPF=0 THEN BEGIN % A NULL VECTOR
           FORMWD(1,"4NULL  ");
           GO TO SKIPREST; END;
           N:=T.SPF;       %N HAS THE SCALAR OR TOP OF VECTOR LOC.
           IF BOOLEAN(T.SCALAR) THEN M:=U:=N ELSE
               BEGIN U:=SP[NOC]+N; M:=N+1; %UPPER AND LOWER BOUNDS
               END;
   IF BOOLEAN(T.CHRMODE) THEN %CHARACTER FORMAT
       BEGIN COMMENT SP[NOC] IS NUMBER OF CHRS;
       TRANSFERSP(OUTOF,SP,M,BUFFER,0,ENTIER(((T:=
          SP[NOC])-1)DIV 8+1));
       FORMROW(1,1,BUFFER,0,T);
       END ELSE % SHOULD TEST FOR NULL...DO IT LATER.
           FOR N:=M STEP 1 UNTIL U DO
               BEGIN NUMBERCON(SP[NOC],ACCUM);
               FORMROW(0,1,ACCUM,2,ACOUNT);
               END;
           TERPRINT;
           SKIPREST:
           END ELSE COMMENT MUST BE AN OPERAND;
       IF T.TYPEFIELD=LOCALVAR THEN
           BEGIN FORMWD(2,"5LOCL: ");
           N:=T.SPF; % N HAS LOCATION OF NAME;
           GTA[0]:=SP[NOC];  % PUT NAME IN GTA
           FORMROW(1,1,GTA,1,7);
           END ELSE
           BEGIN COMMENT TREAT IT AS VARIABLE;
           N:=T.LOCFIELD; COMMENT N HAS LOC OF DESCRIPTOR;
           N:=N-1; COMMENT BACKUP OVER THE DESCRIPTOR;
           GTA[0]:=SP[NOC];
           FORMWD(2,"5AND : ");
           FORMROW(1,1,GTA,1,7);
           END;
       END;
       
   PROCEDURE PROCESS(MODE); VALUE MODE; INTEGER MODE;
       BEGIN
       OWN INTEGER J;
       OWN REAL RESULTD;
       LABEL EXPOVRL,INTOVRL,INDEXL,FLAGL,ZEROL;
       MONITOR EXPOVR,INTOVR,INDEX,FLAG,ZERO;
       LABEL DEBUGSP; %DEBUGGING PURPOSES ONLY.
       INTEGER PROCEDURE BUILDCONSTANT(LASTCONSTANT);
           INTEGER LASTCONSTANT; FORWARD;
       INTEGER PROCEDURE GETSPACE(LENGTH); VALUE LENGTH;
           INTEGER LENGTH; FORWARD;
       PROCEDURE OPERANDTOSYMTAB(L);VALUE L;INTEGER L;FORWARD;
       REAL PROCEDURE BUILDALPHA(LASTCONSTANT);                         03100440
           INTEGER LASTCONSTANT; FORWARD;
   INTEGER PROCEDURE BUILDNULL(LASTCONSTANT);
       INTEGER LASTCONSTANT; FORWARD;
           PROCEDURE SCRATCHDATA(D);VALUE D;REAL D; FORWARD;
               COMMENT LINE 3121400;
   PROCEDURE FORGETPROGRAM(U);VALUE U;REAL U; FORWARD;
       COMMENT ANALYZE IS IN PROCESS BECAUSE OWN ARRAY SP
         IS ADDRESSED INCORRECTLY OTHERWISE;
   REAL PROCEDURE ANALYZE(DISPLAYOP); VALUE DISPLAYOP;BOOLEAN DISPLAYOP;
       BEGIN COMMENT
       BC= BUILDCONSTANT,
       GS= GET SPACE PROCEDURE ;
       ARRAY INFIX[0:MAXPOLISH];
       
       INTEGER LASTCONSTANT;
       DEFINE GS=GETSPACE#;
       BOOLEAN STREAM PROCEDURE EQUAL(A,B);
           BEGIN SI:=A; SI:=SI+1; DI:=B; DI:=DI+2;
           IF 7SC=DC THEN TALLY:=1;
           EQUAL:=TALLY;
           END;
   PROCEDURE UNSTACK(DEST,L,ORIG,OTOP,N,CHR1,CHR2);
       VALUE N,CHR1,CHR2;
      INTEGER N,CHR1,CHR2,L,OTOP;
           ARRAY DEST[0,0],ORIG[0];
           BEGIN
           REAL T,U;
           WHILE OTOP GTR 0 AND N GTR 0 AND ERR=0 DO
           IF(IF (T:=ORIG[OTOP]).TYPEFIELD=FUNCTION THEN FALSE ELSE
               U:=T.LOCFIELD=CHR1 OR U=CHR2) THEN %UNSTACK
               BEGIN
               IF N GTR 1  THEN
                   IF U=CHR2 THEN ERR:=SYNTAXERROR ELSE
                       OTOP:=OTOP-1;
                   N:=N-1;
               END ELSE
              COMMENT WE ARE LOOKING AT AN OPERATOR OR A FUNCTION;
              
              
               BEGIN
               IF J NEQ 0 THEN
                    BEGIN L:=L+1;
                    DEST[LOC]:=ORIG[OTOP]
                    END;
               OTOP:OTOP-1
               END;
          IF N GTR 1 THEN ERR:=SYNTAXERROR;
           END;
       INTEGER ITOP,K,L,I;
       INTEGER M,N,FLOC; REAL T;
       LABEL SKIPSCAN,FILLER;
       LABEL SPFULLAB;


       PROCEDURE FORGETSPACE(L,LENGTH,SP); VALUE L,LENGTH;
           INTEGER L,LENGTH; ARRAY SP[0,0];
           BEGIN IF LENGTH GTR 0 THEN
           BEGIN SP[LOC]:=SP[0,0];
           SP[LOC].LEN:=LENGTH; SP[0,0]:=L
           END;
           END;
       
       IF CURRENTMODE=FUNCMODE OR STACKBASE=0 THEN FLOC:=0 ELSE

           BEGIN L:=STACKBASE+1;L:=SP[LOC].SPF+1;M:=SP[LOC].SPF+L;
           FLOC:= IF M=L OR BOOLEAN(T:=SP[MOC]).SUSPENDED THEN 0 ELSE T.SPF

           END;

       T:=ADDRESS;
       ITOP:=0;
       DO
       SKIPSCAN:
       IF ITOP LSS MAXPOLISH THEN
           BEGIN
           INFIX[ITOP:=ITOP+1].ADDRFIELD:=T;
           IF SPECIAL THEN
       IF QUOTEV THEN % CONSTANT VECTOR
           BEGIN INFIX[ITOP].TYPEFIELD:=CONSTANT;
           IF T:=BUILDALPHA(LASTCONSTANT) NEQ 0 THEN
           INFIX[ITOP].LOCFIELD:=T ELSE ERR:=SYNTAXERROR
           END ELSE % ORDINARY OPERATOR
              BEGIN INFIX[ITOP].TYPEFIELD:=OPERATOR;                    03101550
...
    UNTIL NOT(SCAN AND ERR=0); %DROP THRU WHEN INPUT FIN OR ERR         03104040 P29
...
        IF INFIX[I].OPTPE NEQ DYADIC THEN SINFIX[I].OPTYPE:=MONADIC;    03104840 P30
...
    IF OTOP LSS ITOP DIV 2 THEN ELSE ERR:=SYNTAXERROR;                  03105087 P31
...
        BEGIN                                                           03105383 P32
...
                T.OPTYPE:=MONADIC;                                      03106260 P33
...
        GTR MAXPROGS THEN %OFF THE END OF SP                            03110920 P34
...
            BUILDCONSTANT:=L:=GS(1); %VECTOR DESCRIPTOR                 03114800 P35
...
    BEGIN                                                               03121255 P36
...
                SETFIELD(NEWDESC,7,1, IF BIOOLEAN(T.SCALAR)             03124650 P37
...
        END;                                                            03140080 P38
        INTEGER C;
...
            T:=SP[NOC]; SP[NOC.NAMED:=1; N:=T;                          03140600 P39
...
        BEGIN SI:=A;SI:=SI+B;DI:=C;DI:=DI+D;DS:=CHR;END;                03150085 P40
...
                L:=GETSPACE(N:=(NUMELEMENTS(D)+D,RF));                  03150650 P41
...
            WHILE TRUE DO % RECURSIVE EVALUATION LOOP                   03151310 P42
...
            M := M + NJ;  CC := 2;  END;                                03152646 P43
...
                AND N.QUADIN=4) THEN POPPROGRAM:=TRUE;                  03155000 P44
...
        %ESE WE HAVE AN ERROR (MISSING " ETC)                           03210520 P45
...
      OUTER:=(START:=L+RANK+J|MAT) + COL - 1;                           03221020 P46
...
    OP    APL OPERATOR    OP    APL OPERATOR                            03230015 P47
...
    ANS := IF  RIGHT | LEFT = 1 THEN 0 ELSE 1;  %NAND                   03233400 P48
...
    DESC.SPF:=I; DESC.DID:=DDPUVW; SPCOPY(L,I,RANK1);                   03235100 P49
...
    IF I = 0 OR PICK LSS SP[MOC] THEN N:=TEMP                           03239380 P50
...
    LABEL QUIT, DONE;                                                   03240800 P51
...
                  GO TO QUIT END                                        03243705 P52
...
        OR LDESC.ARRAYTYPE=1 THEN GO TO DOMAIN;                         03254510 P53
...
          THEN GO TO DOMAIN;                                            03268280 P54
...
    BEGIN                                                               03269860 P55
...
                                                                        03271000 P56
...
    MM := M + RRANK - 1;                                                03272500 P57
...
    LABEL QUIT, FORGET, RANKERR;                                        03273620 P58
...
    HOP := (DIM-1) | JUMP;                                              03274600 P59
...
     SUB[I]:=TEMP-1; I:=I+1 END;                                        03277000 P60
...
              FORMROW(0,2,ACCUM,2,ACOUNT); FOLD:=ACOUNT+2; END ELSE     03500140 P61
...
    FOR N:=N+4 STEP 2 UNTIL T DO %ONCE FOR EACH LOCAL                   03507100 P62
...
%------------------ CASE 2.....MODE=ALLOC------------------------       03702300 P63
...
            CASE T.TYPEFIELD OF                                         03752700 P64
                BEGIN %-------TF=0 (REPLACEMENT)--------------
                    BEGIN %MAY BE A LOCAL OR A GLOBAL VARIABLE
                    DEFINE STARTSEGMENT=#; %/////////////////////
                    PUSH; IF ERR NEQ 0 THEN GO TO SKIPPOP;
                    N:=T.LOCFIELD;
                    IF BOOLEAN(T.OPTYPE) THEN %A LOCAL VARIABLE
                        BEGIN M:=FUNCLOC;%FIND LAST MKS
                        M:=SP[MOC].SPF+M;
                        N:=SP[MOC].LOCFIELD+N; END;
                    U:=SP[NOC]; U.LOCFIELD:=N; AREG:=U;
                        IF U.DATADES=0 THEN ERR:=NONCEERROR;
                        COMMENT PROBABLY MIXUP WITH FUNCTION NAMES
                        AND NAMES OF LOCAL SUSPENDED VARIABLES;
                END;
                    %-------------FUNCTION CALL-----------------
%&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
BEGIN COMMENT SET UP STACK FOR A FUNCTION CALLL;
EAL U,V,NARGS,D;
INTEGER I,FLOC;
LABEL TERMINATE;
COMMENT
        MONITOR PRINT(D,L,M,N,FLOC,SP,LASTMKS);%::::::::::::::::::::
    FLOC:=N:=T.LOCFIELD;
    IF BOOLEAN(SP[NOC].DATADESC) THEN BEGIN ERR:=NONCEERROR;
        FO TO TERMINATE;END;%SUSPENDED VAR CONFUSED WITH FUNCTION
    IF NOT BOOLEAN(SP[NOC].PRESENCE) THEN MAKEFUNCTIONPRESENT(N);
    D:=SP[NOC]; L:=LASTMKS;   %D IS TEH DESC, L IS THE PROG MKS
    SP[LUOC].CIF:=CINDEX; %SAVE CURRENT POLISH LOCATION
    L:=STACKBASE+1; L:=SP[LOC].SPF+1;
    M:=SP[LOC].SPF;
    IF N:=M+L NEQ L THEN %THERE IS A NESTED CALL
        IF NOT BOOLEAN(SP[NOC].SUSPENDED) THEN
        BEGIN N:=SP[NOC].LOCFIELD;SP[NOC].CIF:=CURLINE;END;


    SETFIELD(GTA,0,8,0); SETFIELD(GTA,8,8,0); %INITIALIZE GTA
    NARGS:=D.NUMBERARGS;
    FOR I:=1 STEP 1 UNTIL NARGS DO
        IF BOOLEAN((T:=AREG).DATADESC) THEN
            BEGIN
            IF BOOLEAN(T.NAMED) THEN %MAKE A COPY
            COMMENT YOU COULD MAKE A CALL BY NAME HERE;
                BEGIN U:=GETSPACE(V:=(NUMELEMENTS(T)+1,RF));
                SPCOPY(T,SPF,U,V); T.NAMED:=0; T.SPF:=U;
                T.BACKP:=0;
                END ELSE %NO NEED TO MAKE A COPY
            AREG.PRESENCE:=0;
            POP; GTA[I-1]:=T; %SAVE THE DESCRIPTOR FOR LATER USE
            END ELSE ERR:=SYSTEMERROR;
    IF (N:=M+1) GEQ STATEVECTORSIZE THEN ERR:=DEPTHERROR;        
    IF ERR NEQ 0 THEN GO TO TERMINATE;
    SP[LOC].SPF:=N;
    PUSH;AREG:=OLDDATA&(LASTMKS-STACKBASE)[BACKPT]&IMKS[CDID];
    OLDDATA:=0; %REINITIALIZE OLDDATA CHAIN FOR THIS FUNCTION
    %NOW SET UP THE FUNCTION MARK STACK.

    M:=N+L;PUSH;SP[MOC]:=D.SPF&ST[CLOCF];
    M:=D.SPF; M:=M+2; % M IS LOC OF LOC OF FIRST LINE
    AREG:=0&FLOC[CSPF]&((LASTMKS:=ST)-STACKBASE-1)[BACKPT]&
        (U:=SP[MOC]-D.SPF)[CCIF]&FMKS[CDID]; % FUNCTION MKS
    CURLINE:=U;
   
    U:=(U-6)/2; % U IS THE NUMBER OF LOCALS, LABELS, AND ARGS
    M:=M+5; % M IS ON TEH FIRST DESC IOF THE FIRST LAB, LOC,...
    FOR I:=1 STEP 1 UNTIL U DO % GET DESCRIPTORS INTO THE STACK
        BEGIN IF SP[MOC] NNEQ 0 THEN %MAKE UP THE DESC
            BEGIN L:=GETSPACE(1); SP[LOC]:=SP[MOC];
            T:=L&DDPUSW[CDID]&0[CCIF]
            END ELSE
            T:=NULLV;
        PUSH; M:=M+2;
        AREG:=T; %A SINGLE LOCAL
        END;
    %COPY OVER THE ARGUMENTS
    FOR I:=1 STEP 1 UNTIL NARGS DO %COPY OVER
        BEGIN M:=D.SPF; %M IS THE LOACTION OF THE LABEL TABLE.
        M:=M+2+I; %M IS LOCATION OF REL LOCATION OF VARIABLE
        M:=SP[MOC];
        N:=LASTMKS+MM;
        SP[NOC]:=GTA[I-1];
        END;
    %PUT IN A PHONEY PROG DESC TO START THINGS OFF
    PUSH;  IF ERR NEQ 0 THEN GO TO TERMINATE;                           03753400 P65
    ARFG:=0&4094[CCIF]&(LASKMKS-STACKBASE)[BACKU[];
    LASTMKS:=ST; POLTOP:=POLLOC:=0;
    TERMINATE:
    END;
%&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
                    %-------END OF LOAD FUNCTION FOR CALL-----
                %-------------TF=2 (CONSTANT)---------------------
                BEGIN PUSH; IF ERR=0 THEN BEGIN
                    N:=POLWORD.LOCFIELD;AREG:=SP[NOC];END;
                END;
                %-------------TF=3 (OPERATOR)-----------------
                COMMENT SEQUENCE NUMBERS CORRESPOND TO OPERATOR
                ASSIGNMENT NUMBER;
                BEGIN IF T.OPTYPE=MONADIC THEN
                    BEGIN PUSH;IF ERR=0 THEN AREG:=0; END;
                    CASE T.LOCFIELD OF
BEGIN %--------------- OPERATE ON STACK ---------------------
 COMMENT EACH EXECUTION PROCEDURE SETS RESULT TO THE
   DESCRIPTOR OF THE RESULT OF THE OPERATION.
    AREG AND BREG ARE THE LEFT AND RIGHT-HAND OPERANDS AND
    ARE ACTUALLY THE TOP TWO DESCRIPTORS ON THE STACK.
    IF AREG IS ZERO, THE OPERATOR IS TAKEN TO BE MONADIC.;
;
;
;
;
    %---------------------REPLACEMENT OPERATOR---------------
    BEGIN DEFINE STARTSEGMENT=#; %///////////////////////////////
    IF NOT BOOLEAN(L:=AREG.NAMED) THEN % SHOULD BE LOCAL VARIABLE
        AREG.NAMED:=1; % DONT LET IT BE FORGOTTEN.

    IF BOOLAN(T:=AREG).PRESENCE) AND T.SPF NEQ 0 THEN
        OLDDATA:=CHAIN(T,OLDATA);
    M:=T.LOCFIELD;

    IF(RESUT:=BREG).SPF = 0 THEN U:=T:=0 ELSE
        U:=GETSPACE(T:=NUMELEMENTS(RESULT)+RESULT.RF);
    SPCOPY(RESULT,SPF,U,T);
    RESULT.SPF:=U; RESULT.NAMED:=L; %L IS 0 FOR LOCJLS
    GT1:=IF BOOLEAN(U:=SP[MOC]).PRESENCE) THEN U.BACKP ELSE 0;
    SP[MOC]:=RESULT>1[CLOCF];
    IF BOOLEAN(L) AND GT1=0 THEN %CHECK FOR GLOBAL
        BEGIN M:=M-1;IFSP[MOC].SUSPENDVAR=0)THEN SP[MOC].CHANGE:=1;

        END;
    RESULT.NAMED:=1; %KEEP "PUSH" FROM TOSSING THE DATA
    END
    %-------TRANSFER OPERATOR---------------------------------
    BEGIN DEFINE STARTSEGMENT=#; %////////////////////////////////
    SCRATCHAIN(OLDDATA);ODDATA:=0;
    IF BOOLEAN(D.DPTYPE) THEN ST:=ST-1; %GET RID OF PH7ONEY TOP
    L:=FUNCLOC;
    IF SP[LOC] NEQ 0 THEN STEPLINE(TRUE) ELSE
        ERR:=SYNTAXERROR;
    GO TO SKIPPOP;
    END;
    BEGIN %--------------COMPRESSION------------------------------------
    DEFINE STARTSEGMENT=#; %/////////////////////////////////////
    L:=ST-2; IF T.OPTYPE=MONADIC THEN COMPRESS(BREG,SP[LOC],AREG)
        ELSE COMPRESS(AREG,S[]LOC],BREG); COMMENT A/B HAS BEEN
        STACKAED AS B,A,NULL...A/[I] B HAS BEEN STACKED AS B,I,A;
    END;
    ARITH(3); %OPERATION IS DIVIDE
    ;
;
%-------------QUAD INPUT--------------------------------
  EVALQ:  BEGIN LABEL EVALQUAD;
    IF JUMP THEN BEGIN JUMP:=FALSE; GO TO EVALQQUAD END;
    CURRENTMODE:=INPUTMODE;
    FORMWD(3,"3[]:   "); INDENT(0);

    IMS(2); % SETUP MARKSTACK FOR QUAD EXIT
    IF ERR NEQ 0 THEN GOTO SKIPPOP;
    GO TO EXECEXIT; % EXIT TO MONITOR TILL INPUT IS COMPLETE
EVALQUAD: %LO7OK AT BUFFER TO SEE WHAT CAME IN
    BEGIN
    IF NOT SCAN THEN BEGIN CINDEX:=CINDEX-1;GO TO SKIPPOP;END;
    IF NOT SETUPLINE THEN CINDEX:=CINDEX-1;%MAKE THEM REDO IT
        GO TO SKIPPOP;
        END;
    END;
    BEGIN % -----EVALUATE SUBSCRIPTS---------------
    DEFINE STARTSEGMENT=#; %/////////////////////////////////////       03811002 P66
    T:=AREG; L:=BREG.SPPF;
    IF BOOLEAN(T.SCALAR) THEN BEGIN ERR:=DOMAINERROR; GO TO SKIPPOP;END;
    U:=SP[LOC]; % GET # OF SUBSCRIPTS
    IF U GTR 32 THEN ERR:=INDEXERROR ELSE
    BEGIN
    IF U GTR 0 THEN BEGIN
    IF T.PRESENCE NQ 1 THEN % GET ARRAY INTO SP
        BEGIN N:=T.LOCFIELD;
        IF (T:=SP[NOC]).PRESENCE NEQ 1 THEN
                BEGIN T:=GETARRAY(T); SP[NOC]:=T END;
        T.LOCFIELD:= N;
        END;
    IF ERR=0 THEN % NOW EVAVLUATE

        RESULT:=SUBSCRIPTS(L:=(IF T.LOCFIELD=0 THEN OUTOF
            ELSE INTO),T,U);
        IF L=INTO THEN BEGIN

            CINDEX:=CINDEX+1;END; % SKIP OVER REPLACE OP
    END ELSE % NO SUBSCRIPTS
        BEGIN BREG:=T; ST:=ST-1; GO TO SKIPPOP;
        END; % DON{T LET TEH DESC. IN T BE POPPED.
    U:=U+2; % # OF THINGS TO POP
    FOR N:=1 STEP 1 UNTIKL U DO POP;
    IF L=OUTOF THEN PUSH; AREG:=RESULT;

    GO TO SKIPPOP;
    END;
    END;
;
;
%-------------QQUAD INPUT-------------------------------
  EVALQQ: BEGIN LABEL EVALQQUAD;
    IF JUMP THEN BEGIN JUMP:=FALSE; GO TO EVALQQUAD END;
    CURRENTMODE:=INPUTMODE;
    IMS(1); %SET UP MARKSTACKS FOR QQUAD EXIT
    IF ERR NEQ 0 THEN GO TO SKIPPOP;
    GO TO EXECEXIT;
EVALQQUAD:  % BUFFER CONTAINS THE INPUT STRING
    IF (L:=LENGTH(BUFFER,TRUE))NEQ 0 THEN BEGIN %L IS # CHAR INPUT
    N:=ENTIER((3L+7) DIV 8); % FIND NUMBER OF WORDS
    M:=GETSPACE(N+1); % GET SPACE FOR EACH VECTOR IN SP
    TRANSFERSP(INTO,SP,M+1,BUFFER,0,N);
    SP[MOC]:=L; % STORE LENGTH OF VECTOR
    RESULT:=M&1[CRF]&DDPUVC[CDID]; % SET UP DESCRIPTOR
    END ELSE RESULT:=NULLV;% NOTHING WAS INPUT
    PUSH; IF ERR=0 THEN AREG:=RESULT;
    GO TO SKIPPOP;
    END;
    RESULTD := SEMICOL;  %CONVERSIEON CONCATENATION
    COMMAP;    %CATENATE
    BEGIN%----------INNER PRODUCR (PERIOD)---------------------
    M:=(CINDEX:=CINDEX+2) + POLLOC; T:=SP[MOC];M:=M-1;U:=SP[MOC];
    PERIOD(AREG,BREG,U.LOCFIELD,T.LOCFIELD);
    END;
    ARITH(4);  %*
;
;
    ARITH(17);  %AND
    ARITH(18);  %OR
    ARITH(9);  %NOT
    ARITH(11);  %LESS:THAN
    ARITH(16);  %LEQ
    ARITH(13);  %=
    ARITH(14);  %GREATER-THAN
    ARITH(15);  %NEQ
    ARITH(8);   %MAX/CEIL
    ARITH(7);   %MIN/FLOOR
    ARITH(6);   %RESD/AAAABS
    IF T.OPTYPE=MONADIC THEN GO TO XEQEPS ELSE MEMBER; %MEMBERSHIP
    RHOP;       %RHO
    IOTAP;      %IOTA
;
    REDUCESORTSCAN(0,BREG,AREG,4);  %REVERSAL;
    BEGIN %-----------EXPANSION-------------------------
      DEFINE STARTSEGMENT=#; %///////////////////////////////////
      L:=ST-2; IF T.OPTYPE=MONADIC THEN EXPAND(BREG,SP[LOC],AREG)
       ELSE EXPAND(REG,SP[LOC],BREG); COMMENTS A EXPN B HAS BEEN
      STACKED AS B,A,NULL WHILE A EXPN [I] B IS STACKED AS B,I,A;
    END;
     RESULTD:=BASEVALUE;  %BASE VALUE
    ARITH(10);  %COMB/FACT                                              03840000 P67
;
    IF T.EOPTYPE=MONADIC THEN ARITH(5) ELSE
               DYADICRNDM; %RNDM
    IF T.OPTYPE=MONADIC THEN TRANSPOSE ELSE DYADICTRANS;%GUESS WHAT
    RESULTID := REPRESENT;  %REPRESENTATION
    ARITH(45);  %CIRCLE--TRIGONOMETRIC FUNCTIONS
;
;
    ARITH(0);   %ADD
    ARITH(2);   %SUBTRACT
    ARITH(1);   %MULTIPLY
    %-------------------DISPLAY---------------------------------------

    BEFIN DEFINE STRATSEGMENT=#; %/////////////////////////////////
    IF BREG.SPF=0 THEN FORMROW(3,0,ACCUM,2,0) ELSE %FOR A NULL
    IF BOOLEAN((RESULT:=BREG).DATADESC)THEN %THIS IS A DATA DESC
        IF BOOLEAN(RESULT,PRESENCE) AND M:=RESULT.SPF NEQ 0 THEN
            IF BOOLEAN(RESULT.SCALAR) THEN
                 BEGIN NUMBERCON(SP[MOC],ACCUM);
                 FORMROW(3,0,ACCUM,2,ACOUNT)
                 END
            ELSE %A VECTOR
            IF L:=RESULT.RF NEQ 0 THEN % SOMETHING TO PRINT
                IF BOOLEAN(RESULT.CHRMEODE) THEN DISPLAYCHARV(RESULT)
                ELSE
                BEGIN RESULT:=M:=GETSPACE(L+1);
                SP[MOC]:=L; RESULT.DF:=1; RESULT.DIS:=DDPUVW;
                AREG:=RESULT;
                FOR T:=1 STEP 1 UNTIL 1L DO
                    BEGIN M:=M+1; SP[MEOC]:=1
                    END;
                DISPLAY(AREG,BREG);
                RESULT:=BREG;
                END ELSE TERPRQINT
            ENS TERPRINT
       ELSE ; %PROBABLY AN FUNCTION....DONT DO ANYTHING
    IF BREAKFLAG THEN %USER HIT BREAK DURING OUTPUT
        GO TO BREAKKEY;
   POP; GO TO SKIPPOP;
   END;
    BEGIN % ---------------REDUCTION---------------------------------------
    M:=(CINDEX:= CINDEX+1) + POLLOC; % FIND OPERATION IN POLISH
    IF (T:=SP[MOC]).TYPEFIELD NEQ 3 THEN ERR:=SYSTEMERROR
      ELSE REDUCESORTSCAN(T.LOCFIELD,BREG,AREG,1);
    END;
   BEGIN %--------ROTATION----------------------------
     DEFINE STARTSEGMENT=#; %////////////////////////////////////
     L:=ST-2; IF T.OPTYPE=MONADIC THEN
         REDUCESORTSCAN(BREG,SP[LOC],AREG,5) ELSE
         REDUCESORTSCAN(AREG,SP[LOC],BREG,5); COMMENT A ROT B IS
     STACKED AS R,A,NULL WHILE A ROT [I] B IS STACKED AS B,I,A;
   END;
    ARITH(21);  %LOG
   REDUCESORTSCAN(0,BREG,AREG,2);  % SORTUP
   REDUCESORTSCAN(-1,BREG,AREG,2); %SORTDN
   BEGIN%--------------SCAN-------LIKE REDUCTION----------------
    DEFINE STARTSEGMENT=#; %//////////////////////////////////////
     M:=(CINDEX:=CINDEX+1) + POLLOC;  %FIND OPERATOR IN POLISH
     IF (T:=SP[MOC]).TYPEFIELD NEW 3 THEN ERR:=SYSTEMERROR
        ELSE REDUCESORTSCAN(T.LOCFIELD,BREG,AREG,3);
     END;
    ARITH(19);  %NAND
    RITH(20)   %NOR
    IF (T:=BREG).RF NEQ 0 THEN RESULT:=SUBSCRIPTS(3,T,T,RF)
        ELSE ERR:=RANKERROR; % OPERATION IS TAKE
    IF (T:=BREG).RF NEQ 0 THEN RESULT:=SUBSCRIPTS(3,T,T,RF)
        ELSE ERR:=RANKERROR; % OPERATION IS DROP
    %------------------------XEQ---------------------------------
XEQEPS:  BEGIN DEFINE STARTSEGMENT=#; %////////////////
    IF AREG NEQ 0 THEN ERR:=SYNTAXERROR %MUST BE MONADIC ONLY
    EFLSE IF (T:=BREG).RF NEQ 1 OR   %MUST BE A VECTOR
    NOT BOOLEAN(T.CHRMODE) THEN ERR:=DOMAINERROR %MUST BE CHAR STRING
    ELSE IF U:=NUMELEMENTS(T) GTR MAXBUFFSIZE THEN ERR:=LENGTHERROR
    ELSE BEGIN
        M:=GT1; % # OF CHARCATERS SET BY NUMELEMENTS
        INITBUFF(BUFFER.MAXBUFFSIZE);RESCANLINE;
        TRANSFERSP(QUTOF,SP,T,SPF+1,BUFFER,0,U);
        IF(U:=U|8-M) GTR 0 THEN SETFIELD(BUFFER,M,U,"       ");
        IF T.SPF=0 OR NOT SCAN THEN RESULT:=0&1[CRF]&DDPUVW[CDID]% NULL
        ELSE BEGIN POP;IF SETUPLINE THEN; GO TO SKIPPOP;END
         END; END;
    END; %--------------EN OF OPERATION ON STACK---------------------
                        POP;POP;PUSH;IF ERR=0 THEN AREG:=RESULT;        03869970 P68
SKIPPOP:                END OF TYPEFIELD EQUALS OPERATOR;
                    %-------TF=4 (LOCAL VARIABLE)------------
                    BEGIN COMMENT MOVE DESCRIPTOR UP TO TOP;
                    DEFINE STARTSEGMENT=#; %/////////////////
                    N:=T.LOCFIELD;M:=FUNCLOC;M:=SP[MOC]+M;

                    N:=SP[MOC].LOCFIELD+N;
                    T:=SP[NOC]; T.NAMED:=1; %KEEP FROM THROWING AWAY
                    PUSH; AREG:=T;
                    END;
                    %-------TF=5 (OPERAND)-----------------------
                    BEGIN PUSH; IF ERR=0 THEN BEGIN
                        N:=POLWORD.LOCFIELD; U:=SP[NOC];
                         IF U.DATADESC=0 THEN ERR:=NONCEERROR ELSE
                        IF U.PRESENCE NEQ 1 THEN BEGIN
                        U:=GETARRAY(U); SP[NOC]:=U END;
                    U.LOCFIELD:=0;
                        AREG:=U; END;
                    END;
                END;  % OF CASE STATEMENT TESTING TYPEFILED
            END % OF TEST FOR CINDEX LEQ POLTOP
            ELSE % WE ARE AT THE END OF THE POLISH
            BEGIN COMMENT LASKMKS CONTAINS THE LOCATION
            OF THE LAST WARK STACK.  GET MARK STACK AND CONTINUE;

            SCRATCHCHAIN(OLDDDATA); OLDDATE:=0;
            L:=LASTMKS;M:=(U:=SP[LOC]).BACKF+STACKBASE;T:=SP[MOC];
            IF T.DIF=IMKS AND T.QUADIN=3 THEN %SINGLE LINE DONE
                IF (RESULT:=AREG)=T THEN ERR:=SYNTAXERROR%NIO RESULT
                ELSE BEGIN RESULT.NAMED:=0;%MAKE NEW COPY
                IF BOOLEAN(RESULT.SCALAR) THEN
                    BEGIN M:=GETSPACE(2);L:=RESULT.SPF;
                    RESULT.SPF:=M+1;SP[MOC]:=RESULT;
                    M:=M+1;SP[MOC]:=SP[LOC];
                    END ELSE % MAKE COPY OF A VECTOR
                    BEGIN M:=GETSPACE(1+(N:=RESULT.RF+NUMELEMENTS(
                        RESULT)));
                    L:=RESULT.SPF;RESULT.SPF:=M+1;
                    SP[MOC]:=RESULT; SPCOPY(L,M+1,N); END;


                FORGETPROGRAM(U);

                DO POP UNTIL ST LSS 2LASTMKS;%CUT BACK STACK TO IMS
                OLDDATA:=T.SPF;L:=LASTMKS:=T.BACKF+STACKBASE;
                AREG:=RESULT; % STORE EXECUTION RESULT OVER IMS
                CINDEX:=SP[LOC].CIF; M:= SP[LOC].SPF;
                POLLOC:=M:=SP[MOC].SPF; POLTOP:=SP[MOC];
                END ELSE
                BEGIN L:=FUNCLOC;M:=SP[LOC.SPF+L;
                IF M NEQ L AND NOT BOOLEAN(SP[MOC].SUSPENDED)THEN
                BEGIN
                IF O=(LOOP:=LOOP+1) MOD 5) THEN
                WRITE(TWXOUT,1,JIGG1LE[*])[BREAKKEY:BREAKKEY];
                %THAT WAS TO CHECK FOR A BREAK TO INTERRUT A PROG
                    STEPLINE(FALSE);
                END;
                ELSE BEGIN XIT:=TRUE;CURRENTMODE:=CALCMODE;
                    WHILE POPROGRAM(OLDDATA,LASTMKS) DO;
                    END;
                END;
            END; %COMPLETION OF ONE POLISH EVALUATION (1 CELL)
        IF ERR NEQ 0 THEN % PUT OUT ERROR MESSAGE
            BEGIN
            DEFINE STARTSEGMENT=#; %/////////////////////////////
            COMMENT
            MONITOR PRINT(ST,L,M,SP,GTA,T);%::::::::::::::::::::::
            XIT:=TRUE;CURRENTMODE:=ERRORMODE;

            L:=POLLOC+1;
            TRANSFERSP(OUTOF,SP,(L:=SP[LOC],SPF)+1,BUFFER,
            0,MIN(MAXBUFFSIZE,ENTIER((SP[LOC]+7)DIV 8)));
            L:=FUNCLWOC;M:=SP[LOC].SPF+1;
            GT1:=1;N:=SP[MOC].LOCFIELD;%LOCATION OF FMKS
            WHILE LASTMKS GTR N AND BOOLEAN (GT1) DO GT1:=IF
                POPPROGRAM(OLDDATA.LASTMKS)THEN 1 ELSE 0;
            IF M NEQ L AND NOT BOOLEAN(SP[MOC]).SUSPENDED)THEN%GET LINE#
                BEGIN SP[LOC].RF:=SP[LOC].RF+1;%UP SUSPENDED COUNT
                L:=SP[NOC].SPF-1;%LOCATION WOF FUNCTION NAME
                SETFIELD(GTA,0,1,0);
                GTA(0):=SP(LOC);
                FORMROW(3,0,GTA,1,7);
                L:=SP[MOC].SPF; %BASE OF LABEL TABLE                    03918475 P69
                L:=L+CURLINE;
                T:=SP[LOC];

                %ALSO PUT THE FUNCTION INTO SUSPENSION
                IMS(4);SP[MOC].SUSPENDED:=1;SUSPENSION:=1;
                PUSHINTOSYMTAB(SP[MOC]);
                END ELSE T:=0;
           ERRORMESS(ERR,POLWORD,SPF,T);
            END;
        END UNTIL XIT;
BREAKKEY:   BEGIN BREAKFLAG:=FALSE;
            XIT:=TRUE;CURRENTMODE:=CASLCMODE;
            L:=FUNCJLOC;M:=SP[LOC].SPF+L;
            IF M NEW L AND NOT BOOLEAN(SP[MOC].SUSPENDED) THEN
                BEGIN SP[MOC].SUSPENDED:=1;SUSPENSION:=1;
                PUSHINTOSYMTAB(SP[MOC]);SP[KLOC].RG:=SP[LOC].RF+1;
                M:=SP[MOC].LOCFIELD;%LOCATION OF FMKS IN STACK
                WHILE LASTMKS GTR M DO IF POPPROGRAM(OLDDATA,LASTMKS)
                THEN; LASTMKS:=M;IMS(4);
                END
        IF FALSE THEN
            END;
EXECEXIT:
        IF STACKBASE NEQ 0 THEN BEGIN
        L:=STACKBASE; SP[LOC]:=ST-L; %UPDATE SIZE OF STACK

        END;
    END OF EXECUTION LOOP;
PROCESSEXIT:
        IF BOOLEAN(POLBUG) THEN % DUMP SP
        IF MODE=EQUTE OR MODE=3 OR MODE=6 THEN GO TO DEBUGSP;
    IF FALSE THEN
        BEGIN CASE O OF BEGIN
        EXPOVRL: SPOUT(3951200);
        INTOVRL: SPOUT(3591300);
        INDEXL:  SPOUT(3951500);
        ZEROL:   SPOUT(3951600);
                        END;
        REALLYERROR:=1;
    DEBUGSP:
       WRITE(PRINT,MIN(15,PSRSIZE),PSR);
            BEGIN
            STREAM PROCEDURE FORM(A,B,N); VALUE N;
            BEGIN
            DI:=B; 15(DS:=BLIT(" ");
            SI:=LOC N; DI:=B; DS:=8DEC; DI:=DI+3;
            SI:=A; 10(DS:=8CHR; DI:=DI+1);
            END;
            M:=MIN(NROWS+1|SPRSIZE-1,MAXMEMACCESSES);
                FOR N:=0 STEP 10 UNTIL M DO
                BEGIN TRANSFERSP(OUTOF,SP,N,ACCUM,0,MIN(M*N,10));
                FORM(ACCUM,BUFFER,N);
                WRITE(PRINT,15,BUFFER[*]);
                END;
            END;
            IF POLBUG=0 OR BOOLEAN(REALLYERROR) THEN
        BEGIN
        ERRORMESS(IF ERR NEQ SPERROR THEN SYSTEMERROR ELSE ERR,0,0);
        SUSPENSION:=0;
        CURRENTMODE:=CALCMODE;
        REALLYERROR:=ERR:=0;
        END;
        END;
    END OF PROCESS PROCEDURE;
PROCEDURE ERRORMESS(N,ADDR,R); VALUE N,ADDR,R; REAL R;
    INTEGER N; REAL ADDR;
    BEGIN
    INTEGER STREAM PROCEDURE FORM(A,B); VALUE A;
        BEGIN LOCAL T,U;
        LABEL L,M;
        SI:=A;
        L: IF SC=" " THEN
            BEGIN SI:=SI+1; GO TO L;
            END;
        DI:=LOC I; DS:=2RESET; DS:=2SET;
        DI:=8; MESSIZEU:=DI; DI:=LOC T; IF SC=DC THEN JUMP OUT TO M;
        SI:=SI-1; DI:=U; DS:=CHR; TALLY:=TALLY+1); M:
        FORM:=TALLY;
        END;
    ARRAY ERMES[0:13],B[0:MESSIZE/8];
   FILL ERMES[*] WITH
       "1       ",                                                      05001510 P70
       "5DEPTH  ",
       "6DOMAIN ",
       "7EDITING",
       "5INDEX  ",
       "5LABEL  ",
       "6LENGTH ",
       "5NONCE  ",
       "4RANK   ",
       "6SYNTAX ",
       "6SYSTEM ",
       "5VALUE  ",
    "7SP FULL",
    "7FLYKITE";
   IF R NEQ 0 THEN
        BEGIN INDENT(R);CHRCOUNT:=CHRCOUNT-1;
       END;
       FORMROW((IF R=0 THEN 2 ELSE 0),0,ERMES,N|8+1,
       ERMES[N].[1:5]);
       FORMWORD(0,"6 ERROR");
        IF ADDR.[33:15] GEQ 512 THEN
        BEGIN
        FORMD(D,"4 AT   ");
        FORMROW(1,1,B,0,FORM(ADDR,B))
        END;
        FORMWD(3,"1      ");
   END;
PROCEDURE LOADWORKSPACE(JOBNUM,NAME,IDENT); VALUE JOBNUM,NAME;
    REAL JOBNUM,NAME; ARRAY IDENT[0]; FORWARD;
PROCEDURE LOGINAPLUSER;
    BEGIN
    COMMENT LOG:IN THE CURRENT USER;
    COMMENT INPUT LINE IS THE BUFFER;
    LABEL EXEC, GUESS;
    DEFINE T=GT1#, J=GT2#,I=GT3#;
    PROCEDURE INITIALIZEPSR;
        BEGIN FOR I:=0 STEP 1 UNTIL PSRSIZE-1 DO
            PSRM[I] := 0;
        SEED:=STREAMBASE; ORIGIN:=1;
        FUZZ:-1@-11;
        LINESIZE:=72; DIGITS:=9;
        END;
    LADDRESS := ADDRESS := ABSOLUTEADDRESS;
    WORKSPACE:=WORKSPACEUNIT;
    ITEMCOUNT := EOB := 0;
    IF NEXTUNIT=WORKSPACEUNIT THEN % ESTABLISH A WORKSPACE
        BEGIN
                WORKSPACE:=NEXTUNIT;
                SEQUENTIAL(WORKSPACE);
                INITIALIZEPSR;
                I=STORESEQ(WORKSPACE,PSR,PSRSIZE|8);
                INITBUFF(OLDBUFFER,BUFFSIZE);

        END ELSE % WORKSPACE ASSIGNED
            I:=CONTENTS(WORKSPACE,0,PSR);
            FILL ACCUM[*] WITH "LOGGED 1", "N      ";
            FORMROW(0,1,ACCUM,0,RI);
            SYMBASE:=STAKCBASE:=0;
            CSTATION.APLOGGED:=1;
            CASE CURRENTMODE OF
                BEGIN %--------CALCMODE--------------
                ;COMMENT NOTHING TO DO ANYMORE;
                %--------------XEQUTEMODE----------------------
EXEC:
                 BEGIN F9ILL ACCUM[*] WITH "LAST RUN"," STOPPED";
                 FORMROW(3,0,ACCUM,0,16);
                CURRENTMODE:=CALCMODE;
                 END;
                %-------------FUNCMODE-----------------
                 BEGIN FILL ACCUM[*]WITH "CONTINUE"," DEFINIT",
                 "ION OF  ";
                 FORMROW(2,0,ACCUM,0,23); FORMROW(1,0,PSR,
                 FSTART|8,7);
                CURLINE:=GT3:=TOPLINE(GT1:=FUNCPOINTER);
                CHECKSEQ(CURLINE,GT3,INCREMENT); %GET INCREMENT
                CURLINE:=CURLINE+INCRMENT; INDENT(-CURLINE);
                FUNCSIZE:=SIZE(GT1);
                END;
                %------------INPUTMODE-------------ERRORMODE----
                 GOTOEXEC; GO TO EXEC;
                END;
    GUESS:  %SHOULD BE BETTER PLACE BUT HERE IS WHERE OTHERS COME OUT   07044001 P71
    STOREPSR;
    IF CURRENTMODE NEQ FUNCMODE THEN
    INDENT(0); TERPRINT;
    VARSIE:=IF VARPIABLES=0 THEN 0 ELSE SIZE(VARIABLES);
    END;
PROCEDURE APLMONITOR;
    BEGIN
    REAL T;
    INTEGER I;
    BOOLEAN WORK;
    LABEL AROUND, NEWUSER;
    LABEL CALULATE,EXECITEIT,FUNCTIONSTART,BACKAGAIN;
    LABEL CALCULATEDIT;
    I := CUSER := 1;
    T := STATION;
                BEGIN FILL ACCUM[*] WITH "APL/B550","0 UW COM"
                ,"PUTER SC","IENCE #",VERSIONDATE;
                WORK:=TRUE;
                FORMROW(3,MARGINSIZE,ACCUM,0,40);
                INDENT(0); TERPRINT; CSTATION.APLHEADING:=1
                ; LOGINAPLUSER;
                END;
 AROUND:
        BEGIN
        IF MAINTENANCE THEN;
        CASE CURRENTMODE OF
        BEGIN %-------CALCMODE--------------------------------
        COMMENT HE MUST BE READ READY FOR THE CALCMODE STUFF;

            GO CALCULATE;
        %--------XEQUTE MODE--------------------------------
            GO TO EXECUTEIT;
        %----------FUNCMODE-----------------------------------
            GO TO FUNCTIONSTART;
        %-----------INPUTMODE---------------------------------
        COMMENT REQUIRES INPUT;

             BEGIN COMMENT GET HT ELINE AND GO BACK;
             STARTSCAN;
             CURRENTMODE:=XEQM+ODE;
            GO TO EXECUTEIT;
             END;
        %----------ERRORMODE---------------------------------
        GO TO BACKAGAIN;

        END; %OF CASES
        END;
    COMMENT GET HERE IF NOTHING TO DO;

    GO TO AROUND;
    CALCULATE:
        STARTSCAN;
CALCULATEDIT:
        ERR:=0; %AND DON"T RESET IT IN SCAN OR IN ANALYZE
        IF SCAN THEN
            IF RGTPAREN THEN MESSAGEHANDLER EALSE
        IF DELV THEN FUNCTIONHANDLER ELSE
            BEGIN COMMENT PROCESS CAJLCULATOR MODE REQUEST;
            MOVE(OLDBUFFER,BUFFERSIZE,BUFFER);
            IF NOT BOOLEAN(SUSPENSION) THEN BEGIN %INITIALIZE USER
%%%
%%%
            SYMBASE:=STACKBASE:=0;
            END;
            PROCESS(XEQUTE);
            IF CURRENTMODE=CALCMODE THEN
BACKAGAIN:      BEGIN INDENT(0); TERPRINT;
                IF NOT BOOLEAN(SUSPENSION) THEN
                    BEGIN IF CURRENTMODE NEQ ERRORMODE THEN
                    PROCESS(WRITEBACK);
                    SP[0,0]:=0;NROWS:=-1;
%%%
                    END;
                CURRENTMODE:=CALCMODE;
            END;
        IF EDITOG=1 THEN
                BEGIN MOVE(OLDBUFFER,BUFFERSIZE,BUFFER);
                RESCANLINE; EDITOG:=0; GO TO CALCULATEDIT;
                END;
        I:=0;
        GO AROUND;                                                      07127000 P72
    EXECUTEIT:
        POECESS(XEQUTE); %GO BACK TO PROCESS FOR AWHILE
        IF CURRENTMODE=CALCMODE THEN GO TO BACKAGAIN;
        I:=0;
        GO AROUND;
    FUNCTIONSTART:
    IF SPECMODE = 0 THEN
        BEGIN %SEE IF A SPECIAL FUNCTION.
        STARTSCAN;
        IF SCAN AND RGTPAREN THEN MESSAGEHANDLER ELSE
        FUNCTIONHANDLER
        END ELSE
    FUNCTIONHANDLER;
        I:=0;
        GO AROUND
    END;
INTEGER PROCEDURE LENGTH(A,M);VLUE M; BOOLEAN M; ARRAY A[0];
    BEGIN
INTEGER STREAM PROCEDURE LENGT(A,M,L); VALUE M,L;
    BEGIN LOCAL T;
    LOCAL C,CC,TST;      LABEL LAB;
    LOCAL AR; LABEL LAB2;
    SI:=LOC M; SI:=SI+7;
    IF SC'"1" THEN
        BEGIN COMMENT LOOK FOR LEFT ARROW.;
        DI:=LOC AR; DS:=RESET; DS:=5SET;
        SI:=LOCL; DI:=LOC T; DI:=DI+1; DS:=7CHR;
        SI:=A;
        T(2(32(DI:=LOC AR; IF SC=DC THEN JUMP OUT 3 TO LAB;
        TALLY:=TALLY+1;
        C:=TALLY; TSI:=SI; SI:=L9OC C;
        SI:=SI+7; IF SI="0" THEN
            BEGIN TALLY:=CC; TALLY:=TALLY+1; CC:=TALLY;
            TALLY:=0;
            END; SI:=TSI)));
        L(DI:=LOC AR; IF SC=DC THEN JUMP OUT TO LAB;
        TALLY:=TALLY+1; C:=TALLY; TSI:=SI; SI:=LOC C; SI:=SI+7;
        IF SC="0" THEN
            BEGIN TALLY:=CC; TALLY:=TALLY+1; CC:=TALLY; TALLY:=0;
            END; SI:=TSI);
        LAB: SI:=LOC CC; DI:=LOC LENGT; DI:=DI+6; SI:=SI+7;
        DS:=CHR; SI:=LOC C; SI:=SI+7; DS:=CHR;
        END ELSE
        BEGIN
        SI:=LOC L; DI:=LOC T; DI:=DI+1; DS:=7CHR;
        SI:=A; T(2(SI:=SI+32)); SI:=SI+L;
        T(2(32(SI:=SI-1; IF SC NEQ " " THEN JUMP OUT 3 TO LAB2;
        TALLY:=TALLY+1; C:=TALLY; SI:=SI; SI:=LOC C; SI:=SI+7;
        IF SC="0" THEN
            BEGIN TALLY:=CC; TALLY:=TALLY+1; CC:=TALLY; TALLY:=0
            END; SI:=TSI)));
        LAB2: GO TO LAB
        END
    END;
INTEGER I;
I:=LENGT(A,M,BUFFSIZE|8);
LENGTH:=IF M THEN I ELSE BUFFSIZE|8-I
    END
BOOLEAN PRUOCEDURE LABELSCAN(L,K); VALUE K; INTEGER K; ARRAY L[0];
    BEGIN REAL T;
    T:=ADDRSS;
    IF SCAN AND IDENT THEN
        BEGIN SETFIELD(ACCUM,1,1,0); TRANSFER(ACCUM,1,L,K|8,8);
        IF NOT(LABELSCAN:=(SCAN AND COLON)) THEN
            BEGIN ADDRESS:=T; EOB:=0; IF SCAN THEN;
            END;
        END
    END;
STREAM PROCEDURE MOVEWDS(A,N,B); VALUE N;
    BEGIN SI:=A; DT:=8; DS:=N WDS END;
INTEGER PROCEURE DAYTIME(B); ARRAY B[0];
    BEGIN

    INTEGER D,H,M,MIN,Q,P,Y,TIME1;
    LABEL OWT;
    STREAM PROCEDURE FORM(A,DAY,MD,DA,YR,HR,MIN,AP);
        VALUE DAY,MD,DA,YR,HR,MIN,AP;
        BEGIN DI:=A;                                                    08014064 P73
        SI:=LOC DAY; SI:=SI+7;
        IF SC="0" THEN DS:=3LIT"SUN" ELSE
        IF SC="1" THEN DS:=3LIT"MON" ELSE
        IF SC="2" THEN DS:=4LIT"TUES" ELSE
        IF SC="3" THEN DS:=6LIT"WEDNES" ELSE
        IF SC="4" THEN DS:=5LIT"THURS" ELSE
        IF SC="5" THEN DS:=3LIT"FRI" ELSE DS:=5LIT"SATUR";
        DS:=4LIT"DAY "; SI:=LOC MO; DS:=2DEC;
        DS:=LIT"-"; SI:=LOC DA; DS:=2DEC; DS:=LIT"-";
        SI:=LOC YR; DS:=2DEC; DS:=2LIT" ";
        SI:=LOC HR; DS:=2DEC; DS:=LIT":"; SI:=LOC MIN;
        SI:=SI+6; DS:=2CHR; SI:=LOC AP; SI:=SI+7; DS:=LIT" ";
        DS:=CHR; DS:=LIT"M"
        END;
    TIME1:=TIME(1);
    Y:=TIME(0);
        D:=Y.[30:1]|100+Y.[36:6]|10+Y.[42:6];
        Y:=Y.[18:6]|10+Y.[24:6];
    FOR H:=31,IF Y MOD 4=0 THEN 29 ELSE 28,31,30,
       31,30,31,31,30,31,30 DO
        IF D LEQ H THEN GO OWT ELSE
            BEGIN D:=D-H; M:=M+1;
            END;
    OWT:
    H:=TIME1 DIV 216000;
    MIN:=(TIME1 DIV 3600) MOD 60;
    IF M LSS 2 THEN
        BEGIN Q:=M+11; P:=Y-1;
        END ELSE
        BEGIN Q:=M-1; P:=Y
        END;
    M:=M+1;
    FORM(B,TIME1:=((Q|26-2)DIV 10+D+P+P.[36:10]+1)MOD 7,
        M,D,Y,Q:= H MOD 12, Q:=MIN MOD 10+(MIN DIV 10)|64,
        IF H GEQ 12 THEN "P" ELSE 17);
    DAYTIME:=(IF TIME1=6 THEN 5 ELSE
        IF TIME1=5 THEN 3 ELSE
            IF TIME2=2 THEN 4 ELSE 3)+22;


    END;
PROCEDURE LOADWORKSPACE(NAME1,NAME2,IDENT); VALUE NAME1,NAME2;
    REAL NAME1,NAME2; ARRAY IDENT[0];
    BEGIN
    FILE DISK DISK(2,WDSPERREC,WDSPERBLK);
    INTEGER PROCEDURE RD(D,N,A);
        VALUE N; INTEGER N; FILE D; ARRAY A[0];
        BEGIN READ(D[N],WDSPERREC,A[*]);
        RD:=N+1;
        END;
    PROCEDURE LOADITEM(RD,D,ITEM);
        INTEGER PR+OCEDURE RD; FILE D;
        ARRAY ITEM[0];
        BEGIN
        DEFINE T=ITEM#;
    PROCEDURE GETALINE(C,S,L,R,RD,D,LEN);
        VALUE LEN; INTEGER C,S,L,LEN;
        ARRAY A[0]; INTEGER PROCEDURE RD; FILE D;
        BEGIN % GET 2 CHRS GIVING ENSUING CHAR COUNT
        INTEGER P;
        IF C GTR LEN-2 THEN
            IF C GTR LEN-1 THEN % READ A NEW RECORD AND TAKE 2 CHRS
                BEGIN
                S:=RD(D,S,R);
                C:=2;
               TRANSFER(B,0,L,6,2);
               END
            ELSE % 1 CHR LEFT ON LINE
                BEGIN
                TRANSFER(B,C,L,6,1);
                S:=RD(D,S,B);
                TRANSFER(B,0,L,7,1);
                C:=1;
                END
        ELSE % AT LEAST 2 CHARS REMAINING ON LINE
            BEGIN
            TRANSFER(B,C,L,6,2);
            C:=C+2;
            END;
        P:=0;
        +IF L NEQ 0 THEN % SOMETHING LEFT IN FUNCTION
            BEGIN
            WHILE P LSS L DO                                            08014459 P74
            IF (L-P) GTR (LEN-C) THEN % # OF CHARS IN LINE
               % EXTENDS INTO NEXT RECORD
                BEGIN
                TRANSFER(B,C,BUFFER,P,LEN-C); % FINISH OUT RECORD
                S:=RD(D,S,R);
                P:=P+(LEN-C); % AMOUNT READ SO FAR
                C:=0;
                END
            ELSE % ALL ON ONE RECORD
                BEGIN
                TRANSFER(B,C,BUFFER,P,L-P);
                C:=C_L-P;
                P:=L; % FINISHED
                END;
            END;
        END OF GETALINE;
        INTEGER S,K,L,M,C,LEN,SQ,PT,G,I,SIZE;
        INTEGER HOLD;
        LABEL SCALARL;
        ARRAY U[0:1],B[0:WDSPERREC-1];
        BOOLEAN TOG;
        TRANSFER(T,0,U,0,7);
        G:=GETFIELD(T,7,1);
        IF VARSRSIZE GTR 0 THEN
            IF K+;SEARCHORD(VARIABLES,U,HOLD,7)=0 THEN
                IF K:=GETFIELD(U,7,1)=FUNCTION THEN TOG:=TRUE
                ELSE % NOT A FUNCTION IN THE SYMBOL TABLE
                IF G=FUNCTION THEN
                    BEGIN
                    DELETE1(VARIABLES,HOLD);
                    IF K=ARRAYDATA THEN RELEASEARRAY(U[1]);
                    END;
                ELSE TOG:=TRUE % DON-T CHANGE
            ELSE % NOT IN VARIABLES
                BEGIN
                VARSIZE:=VARSIZE+1;
                HOLD:=HOLD+K-1;
                END;
        ELSE VARSIZE:=1;
        LEN:=(WDSPERREC-1)|8;
        IF NOT TOG THEN % OK TO PUT INTO VARIABLES
            IF G=FUNCTION THEN % READ A FUNCTION INTO VARIABLES
                BEGIN
                TRANSFER(T,0,U,0,9); % U HOLDS FUNCTION NAME,
                %NUMBER OF ARGUMENTS, AND WHETHER FN RETURNS A VALUE
                S:=T[1].LIBF1; % RECORD NUMBER
                M:=T[1].LIBF2; % WORD WITHIN RECORD
                SIZE:=T[1].LIBF3; % SIZE OF POINTERS TABLE
                PR:=NEXTUNIT;
                S:=RD(D,S,B);
                FOR I:=0 STEP 1 UNTIL SIZE-1 DO
                    BEGIN
                    TRANSFER(M,M|8,T,0,16);
                    M:=M+2;
                    IF M GEQ WDSPERREC-1 THEN
                        BEGIN
                        S:=RD(D,S,R);
                        IF M GEQ WDSPERREC THEN
                            BEGIN
                            TRANSFER(B,0,T,8,8);
                                M:=1;
                            END
                        ELSE M:=0;
                         END;
                    STOREORD(PT,T,I);
                    END; % HAV FINISHED FILLIN G POINTERS TABLE
                IF VARIABLES=0 THEN BEGIN
                    VARIABLES:=NEXTUNIT; TOG:=TRUE; %KEEP THE UNIT OPEN
                    STOREORD(VARIABLES,U,HOLD); END;
                SEQUENTIAL (SQ:=MEXTUNIT);
                SETFIELD(U,FPTF,FFL,PT);
                SETFIELD(U,FSQF,FFL,SQ);
                STOREORD(VARIABLES,U,HOLD);
                IF TOC THEN DELETE1(VARIABLES,HOSLD+1);%REMOVE 1 EXTRA
                COMMENT NOW FILL IN SEQ STORAGE;
                IF M NEQ 0 THEN BEGIN
                M:=C:=0;
                S:=RD(D,S,B); % TEXT STARTS AT BEG. OF NEW RECORD
                                END;
                L:=1;

                WHILE L NEQ 0 DO
                    BEGIN                                               08014747 P75
                    GETALINE(C,S,L,B,RD,D,LEN);
                    GT1:=STORESEQ(SQ,BUFFER,L);
                    END
                END
            ELSE
            IF G=ARRAYDATA THEN
                    IF T[1].INTPTR=0 THEN % NULL VECTOR
                        GOTO SCALARL
                    ELSE
                BEGIN
                ARRAY DIMVECT[0,MAXBUFFSIZE];
                S:=T[1].INPTR; % RECORD NUMBER
                M:=T[1].DIMPTR; % LOC WITHIN RECORD
                C:=M|8;
                SIZE:=RD(D,S,B);
                GETALINE(C,S,L,B,RD,D,LEN);
                T[1].DIMPTR:=STORESEQ(WS,BUFFER,L);
                    % PUTS DIMVECT INTO WORKSPACE
                GETALINE(C,S,L,B,RD,D,LEN); % # BLOCKS
                SIZE:=L-1;
                FOR K:=0 STEP 2 UNTIL SIZE DO
                    BEGIN
                    GETALINE(C,S,L,B,RD,D,LEN);
                    SETFIELD(DIMVECT,K,S,STORESEQ(WS,BUFFER,L));
                    END; COMMENT THIS STORES THE VALUES OF THE
                         ARRAY INTO THE W+ORKSPACE, AND ALSO RECORDS
                         THE LOCATION WITHIN WS IN DIMVECT,TO BE STORED;
                T[1].INPTR:=STORESEQ(WS,DIMVECT,SIZE+1);
                IF VARIABLES=0 THEN VARIABLES:=NECTUNIT;
                STOREORD(VARIABLES,T,HOLD);
                END
            ELSE % MUST BE A SCALER
                    SCALARL:
                BEGIN
                 IF VARIABLES=0 THEN VARIABLES:=NEXTUNIT;
                STOREORD(VARIABLES,T,HOLD);
                END
        ELSE % WILL NOT REPLACE IN SYMBOL TABLE
            BEGIN
            FILL BUFFER[*] WITH " ","NOT REPL","ACED    ";
                TRANSFER(T,0,BUFFER,0,7);
                FORMROW(3,0,BUFFER,0,20);
            END;
        END LOADITEM;
    BOOLEAN STREAM PROCEDURE EQUAL(A,B);
        BEGIN SI:=A; DI:=B; SI:=SI+2; IF 7SC=DC THEN TALLY:=1;
        EQUAL:=TALLY
        END;
    INTEGER I,J,L,NDIR,N;
    LABEL MOVEVAR,SKIP;
    ARRAY T,U[0:1],D[0:WDSPERREC-1];
    FILL DISK WITH NAME1,NAME2; L:=RD(DISK,L,D);
    IF D[1] NEQ JOBNUM AND D[1] NEQ 0 THEN GO SKIP; % FILE LOCKED
    FOR I:=2 STEP 1 UNTQIL 9 DO IF GETFIELD(D[I],1,7) NEQ C THEN GO SKIP;
    IF NDIR:=D[0] NEQ 0 THEN
    BEGIN N:=LIBSPACES+ENTIER(NDIR|2/(J:=WDSPERREC-1));
        IF(NDIR|2) MOD J NEQ 0 THEN N:=N+1;
        FOR I:=1 STEP 1 UNTIL NDIR DO
            BEGIN COMMENT GET FUNCTION OR VARIABLE NAME FROM LIB;
            IF WDSPERREC-J LSS 3 THEN
                IF WDSPERREC-J=1 THEN
                BEGIN L:=RD(DISK,L,D); J:=0; GO MOVEVAR
                END ELSE
                BEGIN TRANSFER(D,J|8,T,08); L:=RD(DISK,L,D);
                TRANSFER(D,0,T,8,8); J:=1
                END ELSE MOVEVAR:
                BEGIN TRANSFER(D,J|8,T,0,16); J:=J+2
                END;
            IF(IF IDENT[0]=0 THEN TRUE ELSE EQUAL(IDENT,T)) THEN
                BEGIN IF IDENT[0] NEQ 0 THEN I:=NDIR+1;
                LOADITEM(RD,DISK,T);
                END
            END;
    STOREPSR; % UPDATE SINCE HAVE ADDED TO VARIABLES
    END;
    IF FALS THEN SKIP; FORMWD(1,"6BADFIL");
    EOB:=1;
    END OF LIBRARY LOAD;
PROCEDURE PURGEWORKSPACE(WS); VALUE WS; INTEGER WS;
    IF WORKSPACE NEQ 0 THEN
    BEGIN
    INTEGER I,J,K,V,L,G;                                                08015020 P76
    ARRAY T[0,1];
    J:=SIZE(V:=VARIABLES)-1;
    FOR I:=0 STEP 1 UNTIL J DO
        BEGIN K:=CONTENTS(V,I,T);
        IF GETFIELD(T,7,1)=FUNCTION THEN
        FOR L:=FPTF,FSQF DO   % GET RID OF STORAGE
        IF G:=GETFIELD(T,L,FFL) NEQ 0 THEN RELEASEUNIT(G);
        END;
    RELEASEUNIT(V);
    VARIABLES:=0; VARSIZE:=0;
    CURRENTMODE:=0; J:=SIZE(WS)-1;
    FOR I:=1 STEP 1 UNTIL J DO DELETE1(WS,I);
    STORESPR;
    END;
PROCEDURE ELIMWORKSPACE(WS); VALUE WS; INTEGER WS;
    BEGIN LABEL QQQ; QQQ:
    IF WORKSPACE NEQ 0 THEN
        BEGIN
        PURGEWORKSPACE(WS); RELEASEUNIT(WS);
%
    END ELSE SPOUT(8015222);
    END;
PROCEDURE SAVEWORKSPACE(NAME1,NAME2,LOCKFILE);
    VALUE NAME1,NAME2,LOCKFILE;
    REAL NAME1,NAME2,LOCKFILE;
    BEGIN
    SAVE FILE DISK [NAREAS:SIZEAREAS]
      (2,WDSPERREC,WDSPERBLK,SAVE 100);
    INTEGER PROCEDURE WR(D,N,A); VALUE N; INTEGER N;
        F+ILE D; ARRAY A[0];
        BEGIN REAL STREAM PROCEDURE CON(A); VALUE A;
            BEGIN SI:=LOCA; DI:=LOC C9ON; DS:=8DEC END;
        STREAM PROCEDURE CLEANER(A);
            BEGIN DI:=A; WDSPERREC(DS:=BLIT".") END;
        A[WDSPERREC-1]:=CON(N);
        WRITE(D[N],WDSPERREC,A[*]);
        WR:=N+1; CLEANER(A);
        END;
    PROCEDURE PUTAWAY(C,J,WR,D,N,M,B,L); VALUE L,J;
        INTEGER L,C,J,N,M;
    ARRAY B[0]; INTEGER PROCEDURE WR; FILE D;
        BEGIN INTEGER P,K;
        IF C+2 GTR L THEN
            BEGIN TRANSFER(J,6,B,C,1); N:=WR(D,N,B); C:=1;
            TRANSFER(J,7,B,0,1);
            END ELSE
            BEGIN TRANSFER(J,6,B,C,2); C:=C+2;
            END;
        WHILE J NEW 0 DO
        IF J GTR K:=(L-C) THEN
            BEGIN TRANSFER(BUFFER,P,B,C,K);
            N:=WR(D.N.B); J:=J-K; C:=0; P:=P+K
             END ELSE
            BEGIN TRANSFER(BUFFER,P,B,C,J); C:=C+J; J:=0
            END;
        IF C=L THEN
            BEGIN N:=WR(D,N,B); C:=0
            END;
        END;

    PROCEDURE MOVETWO(U,B,M,WR,L,D);
        ARRAY U,B[0]; INTEGER M,L; INTEGER PROCEDURE WR; FILE D;
        BEGIN
        COMMENT PUTS 2 WORDS OF U IN B AND WRITES ON D IF A FULLRECORD;
        TRANSFER(U,0,B,M|8,16); % CONTENTS OF U INTO B
        M:=M+2;
        IF M GEQ WDSPERREC-1 THEN % FULL RECORD
            BEGIN
            L:=WR(D,L,B);
            IF M GEQ WDSPERREC THEN % 1 OVER FULL RECORD

                BEGIN
                TRANSFER(U,8,B,0,8);
                M:=1;
                END
            ELSE M:=D;
            END;
        END OF MOVETWO;
        INTEGER H,Q,M,N,I,L,S,J,K,LINE,MAX,PT,SQ,C,LEN,W;
        REAL LSD,STP;
        LABEL SKIP;
        ARRAY T,U[0:1],DIR,B,SEX[0:WDSPERREC];
        N:=LIBSPACES+ENTIER((S:=SIZE(VARIABLES))|2/(WDSPERREC-1));      08015575 P77
            IF (S|) MOD (WDSPERREC-1) NEQ 0 THEN N:=N+1; % ADJUST
            LEN:=(WDSPERREC-1)|8;
            FILLS DISK WITH NAME1,NAME2;
            DIR[0]:=S; % SIZE OF SYMBOL TABLE
            IF BOOLEAN (LOCKFILE) THEN DIR[1]:=JOBNUM;
            S:=S-1;
            L:=WR(DISK,L,DIR); % FIRST LINE CPONTAINS # OF ENTRIES IN
            COMMENT SYMBOL TABLE AND LOCK INFORMATION;
            FOR I:=0 STEP 1 UNTIL 5 DO
                BEGIN
                J:=CONTENTS(VARIABLES,T,T); % RETURNS VALUE OF I-TH LOC
                % IN VARIABLES INTO T
                IF GT2:=GETFIELD(T,7,1)=FUNCTION THEN
                    BEGIN
                    PT:=GETFIELD(T,FPTF,FFL); % FUNCTION POINTER FIELD
                    SQ:=GETFIELD(T,FSQF,FFL); % FUNCTION SEQUENTIAL FIELD
                    %PT=# OF ORDERED STORAGE UNIT CONTAINING HEADER AND POINTE
                    %SQ=# OF SEQ STORAGE UNIT CPONTAINING TEXT
                    MAX:=SIZE(PT);
                    T[1].LIBF1:=N; % RECORD #
                    T[1].LIBF2:=M; % LOC WITHIN RECORD
                    T[1].LIBF3:=MAX; % SIZE OF  POINTERS TABLE;
                    % SAVE ENOUGH ROOM FOR THE ENTIRE POINTERS TABLE
                    H:=ENTIER(GT1:=(M+MAX|2)/(WDSPERREC-1));
                    H:=IF GT1 NEQ H THEN H+N+1 ELSE H+N;
                    U[0]:=0;
                    J:=SEARCHORD(PT,U,LINE,8); % LOOK FOR ALL ZEROS
                    IF J=2 THEN GO SKIP;
                    FOR W:=0 STEP 1 UNTIL LINE-1 DO
                        %MOVE LOCALS AND LABELS INTO THE SAVE FILE
                        BEGIN
                    J:=CONTENTS(PT,W,U);
                        MOVETWO(U,B,M,WR,N,DISK);
                        END;
                        FOR LINE:=LINE STEP 1 UNTIL MAX-1 DO
                            BEGIN

                            J:=CONTENTS(PT,LINE,U);
                                GT1:=U[1];
                            U[1]:=LINE-W;
                            MOVETWO(U,B,M,WR,N,DISK); % POINTERS TABLE
                                J:=CONTENTS(SQ,GT1,BUFFER);
                            PUTAWAY(C,J,WR,DISK,H,Q,SEX,LEN); % TEXT
                            END;
                        PUTAWAY(C,0,WR,DISK,H,Q,SEX,LEN);
                  SKIP:
                    Q:=C DIV 8;
                        IF C MOD 8 NEQ 0 THEN Q:=Q+1;
                        IF Q=WDSPERREC-1 THEN
                            BEGIN
                            H:=WR(DISK,H,SEX);
                            Q:=0;
                            END;
                        IF M GTR 0 THEN N:=WR(DISK,N,B);
                        M:=Q; N:=H;
                        TRANSFER(SEX,0,B,0,C); % MOVE BACK TO B
                        C:=0;
                    END
                ELSE
                    BEGIN
                    T[1].INPTR:=N; T[1].DIMPTR:=M;
                    C:=M|8;
                    J:=CONTENTS(WS,LSD,DIMPTR,BUFFER); % DIM VECT
                    PUTAWAY(C,J,WR,DISK,N,M,B,LEN); % STD DIM VECT
                    J:=CONTENTS(WS,LSD,INPTR,DIMVECT);
                    TRANSFER(DIMVECT,0,BUFFER,0,J);
                    PUTAWAY(C,J,WR,DISK,N,M,B,LEN);
                    J:=J-1;
                    FOR LINE:=0 STEP 2 UNTIL J DO
                        BEGIN
                        PT:=GETFIELD(DIMVECT,LINE,2);
                        STP:=CONTENTS(WS,PT,BUFFER);
                        PUTAWAY(C,STP,WR,DISK,N,M,B,LEN);
                        END;
                    M:=C DIV A; IF C MOD A NEQ 0 THEN M:=M+1; C:=0;
                    IF M=WDSPERREC-1 THEN BEGIN N:=WR(DISK,N,8);
                        M:=0;         END;                              08015888 P78
                    END;
                END;
                MOVETWO(T,DIR,K,WR,L,DISK);
            END;
        EOB:=1;
    IF M GTR 0 THEN N:=WR(DISK,N,B);
    IF K GTR 0 THEN L:=WR(DISK,L,DIR);
    LOCK(DISK);
    END;
BOOLEAN PROCEDURE LIBNAMES(A,B); REAL A,B;
BEGIN REAL T;
    A:=B:=GT1:=0;
%
%
    IF SCAN AND IDENT THEN
    BEGIN T~ACCUM[0]; T.[6:6]~"/";
    IF SCAN AND LOCKIT THEN GT1~1 ELSE IF IDENT THEN LIBNAMES~TRUE;
          A~T; B~ JOBNUM;
    END
    ELSE LIBNAMES~ TRUE;
    END;
PROCEDURE MESSAGEHANDLER;
    BEGIN
    LABEL ERR1;
%
    IF SCAN THEN IF IDENT THEN
    BEGIN INTEGER I; REAL R,S;
        PROCEDURE NOFILEPRESENT;
            BEGIN
            FILL BUFFER[*] WITH "FILE NOT", " ON DISK";
            FORMROW(3,0,BUFFER,0,16);
            END OF NOFILEPRESENT;
        PROCEDURE PRINTF(VARS); VALUE VARS; BOOLEAN VARS;
            BEGIN INTEGER I,J,K,L,M; ARRAY T[0:1]; BOOLEAN TOG;
            INTEGER NUM;
            J:=VARSIZE-1; M:=VARIABLES;
            FOR I:=0 STEP 1 UNTIL N DO
                BEGIN L:=CONTENTS(M,I,T); TOG:=GETFIELD(T,7,1)
                 =FUNCTION;
                IF NUM:=3|REAL(TOG AND VARS)+8+NUM GTR LINESIZE
                  THEN BEGIN TERPRINT; NUM:=8|READL(TOG AND VARS)+8 END;
                IF VARS THEN
                    BEGIN FORMROW(0,1,T,0,7); L:=L+1;
                    IF TOG THEN FORMWRD(0,"3(F)   ");
                    END ELSE
                IF TOG THEN BEGIN L:=L+1; FORMROW(0,1,T,0,7) END;
                END;
            IF L=0 THEN FORMWD(3,"6 NULL.") ELSE TERPRINT
            END;
    R:=ACCUM[0];
    FOR I:=0 STEP 1 UNTIL MAXMESS DO
        IF R=MESSTAB[I] THEN
            BEGIN R:=I; I:=MAXMESS+1
            END;
    IF I=MAXMESS+2 THEN
        CASE R OF
        BEGIN
        %  ------- SAVE -------
        IF NOT LIBNAMES(R,S) THEN
            IF NOT LIBRARIAN(R,S) THEN BEGIN
                SAVEWORKSPACE(R,S,GT1); %GT1 SET IN LIBNAMES
         GTA[0]~GTA[1]~0;TRANSFER(R,1,GTA,1,7);
                IF(GT1~SEARCHORD(LIBRARY,GTA, I, 7)) NEQ 0 THEN
                BEGIN GTA[0]~GTA[1]~0;TRANSFER(R,1,GTA,1,7);
                      STOREORD(LIBRARY,GTA,I+(IF GT1=1 THEN -1 ELSE 1));
                END; LIBSIZE~LIBSIZE+1;
        END
            ELSE
                BEGIN
                FILL BUFFER[*] WITH "FILE ALR","EADY ON ",
                    "DISK    ";
                FORMROW(3,0,BUFFER,0,20);
                END
        ELSE GO ERR1;
        %  ------- LOAD -------
        IF NOT LIBNAMES(R,S) AND R NEQ 0 THEN
            IF LIBRARIAN(R,S) THEN
                BEGIN ARRAYA[0:1];
                LOADWORKSPACE(R,S,A);
                END
            ELSE NOFILEPRESENT
        ELSE GO ERR1;                                                   0801626? P79
        %  ------- DROP -------
        IF CURRENTMODE=CALCMODE THEN
        IF NOT LIBNAME(R,S) THEN
            IF LIBRARIAN(R,S) THEN
            BEGIN FILE ELIF DISK (1,1);
            FILL ELIF WITH R,S; WRITE(ELIF[0]);
            CLOSE(ELIF,PURGE)
           ;GTA[0]~GTA[1]~0;TRANSFER(R,1,GTA,1,7);
            IF SEARCHORD(LIBRARY,GTA,I,7)=0 THEN DELETE1(LIBRARY,I);
            LIBSIZE~LIBSIZE-1;
            END
            ELSE NOFILEPRESENT
        ELSE
        IF NOT BOOLEAN(SUSPENSION)THEN PURGEWORKSPACE(WORKSPACE)
        ELSE GO ERR1 ELSE GO ERR1;
        % ------- COPY -------
        IF LIBNAMES(R,S) THEN
            IF LIBRARIAN(R,S) THEN
            LOADWORKSPCE(R,S,ACCUM)
        ELSE NOFILEPRESENT
        ELSE GO ERR1;

        %  --------  VARS -------
        PRINTID(TRUE);
        %------- FNS -------
        PRINTID(FALSE);
        %-------- LOGGED ----------------
;
        %-------- MSG --------
        ERRORMESS(SYNTAXERROR,LADDRESS,0);
        %-----WIDTH (INTEGER) ---------------------------
        IF NOT SCAN THEN BEGIN NUMBERCON(LINSIZE, ACCUM);
                          FORMROW(3,0,ACCUM,2,ACOUNT); END
            ELSE IF NUMERIC AND I:=ACCUM[0] GTR 9 AND I LEQ 72
                THEN BEGIN TERPRINT; LINESIZE:=I; STOREPSR;
            END
        %IF A NUMBER CONVERSION ERROR, RESULT WILL BE ZERO
            %AND WE"LL GET AN ERROR ANYWAY
            ELSE GO TO ERR1;
        %-------- OPR --------
        ;
        %------DIGITS (INTEGER) ------------------------
        IF NOT SCAN THEN BEGIN NUMBERCON(DIGITS,ACCUM);
                               FORMROW(3,0,ACCUM,2,ACOUNT); END
            ELSE IF NUMERIC AND I:=ACCUM[0] GEQ 0 AND I LEQ 12
              AND ERR=0 THEN BEGIN DIGITS:=I; STOREPSR END
        ELSE GO TO ERR1;
        %-------- OFF --------
        BEGIN
        IF SCAN THEN IF ACCUM[0]="7DISCAR" THEN
            ELTMWORKSPACE(WORKSPACE) ELSE
            GO TO ERR1;
       FILL ACCUM[*] WITH "END OF R","UN      ";
        FORMROW(3,MARGINSIZE,ACCUM,0,10);
        CURRENTMODE=CALCMODE;
       GT1:=CSTATION;
       CSTATION:=GT1&0[CAPLOGGED]
      ;GO TO FINIS;
        END;
        %--------ORIGIN----------------------------------
        IF NO SCAN THEN BEGIN NUMBERCON(ORIGIN,ACCUM);
                              FORMROW(3,0,ACCUM,2,ACOUNT) END
        ELSE IF NUMERIC AND ERR=0 THEN BEGIN ORIGIN:=
        I:=ACCUM[0]; STOREPSR END ELSE GO TO ERR1;
        %--------SEED---------------------------------
        IF NOT SCAN THEN BEGIN NUMBERCON(SEED,ACCUM);
                               FORMROW(3,0,ACCUM,2,ACOUNT) END
        ELSE IF NUMERIC AND ERR=0 THEN BEGIN
            SEED:=ABS(I:=ACCUM[0]);
            STOREPSR END ELSE GO TO ERR1;
        %--------FUZZ------------------------------------
        IF NOT SCAN THEN BEGIN
            NUMBERCRON(FUZZ,ACCUM);
            FORMROW(3,0,ACCUM,2,ACOUNT) END
        ELSE IF NUMERIC AND ERR=0 THEN BEGIN FUZZ:=ABS(ACCUM[0]);
            SIDREPSR END ELSE GO TO ERR1;
        %------- SYN, NOSYN-------------------------------------
       NOSYNTAX:=0; NOSYNTAX:=1;
        %-----------------STORE-------------------------
        IF SYMBASE NEQ 0 THEN PROCESS(WRITEBACK);
                                                                        08017970 P80
        %-----------------ABORT-------------------------
        BEGIN IF BOOLEAN(SUSPENSION) THEN
            SP[0,0]:=0; NROWS:=-1;
%%%
        SUSPENSION:=0;
        STOREPSR;
        END;
        %-----------------SI------------------------------
        IF BOOLEAN(SUSPENSION) THEN
            BEGIN GT1:=0;
            PROCESS(LOOKATSTACK);
        END ELSE FORMWD(3,"6 NULL.");
        %------------------SIV------------------------------
        IF BOOLEAN(SUSPENSION) THEN
            BEGIN GIT1:=1;
            PROCESS(LOOKATSTACK);
        END ELSE FORMWD(3,"6 NULL.");
        %------------------ERASE------------------------------
        IF CURRENTMODE=FUNCMODE OR BOOLEAN(SUSPENSION) THEN GO TO ERR1;
        ELSE WHILE SCAN AND IDENT DO
            BEGIN % LOOK FOR THE INDENTIFIER NAME IN ACCUM
            TRANSFER(ACCUM,2,GTA,0,7);
            IF (IF VARIABLES=0 THEN FALSE ELSE
                SEARCHWORD(VARIABLES,GTA,GT1,7)=0) THEN
                BEGIN % FOUND SYMBOL TABLE ENTRY MATCHING NAME
                DELETE1(VARIABLES,GT1); % REMOVE FROM SYMBOL TABLE
                IF VARSIZE:=VARSIZE-1=0 THEN VARIABLES:=0;
                COMMENT IF NOTHING IS IN THE UNIT IT IS DELETED;

                % CHECK IF THERE ARE MORE TO DELETE
                IF GT1:=GETFIELD(GTA,7,1)=FUNCTION THEN
                    BEGIN
                    RELEASEUNIT(GETFIELD(GTA,FPTF,FFL));
                    RELEASEUNIT(GETFIELD(GTA,FSQF,FFL));
                    END
                ELSE IF GT1 GTR 0 THEN % MUST BE AN ARRAY
                RELEASEARRAY(GTA[1]);
                END ELSE % THERE IS NO SUCH VARIABLE
                ERRORMESS(LABELERROR,LADDRESS,0);
            END;  % OF TAKING CARE OF ERASE
        %------------ ASSIGN --------------------------------
;
        %------------ DELETE ---------------------------------
;
        %------------- LIST ------------------------------------
;
        % -------------DEGUG --------------------------------
        IF SCAN AND IDENT THEN
            IF ACCUM[0]="6POLISH" THEN POLBUG:=ABS(POLBUG-1);

        %----------------------------- FILES ----------------------
        IF LIBSIZE>1 THEN
        BEGIN FOR I~1 STEP 1 UNTIL LINSIZE-1 DO
              BEGIN R~CONTENTS(LIBRARY,I   ,ACCUM);
                    FORMROW(0,1,ACCUM,2,6);
              END; TERPRINT;
        END ELSE FORMWD(3,"6 NULL.");
        %------------------------ END OF CASES -----------------------
            END ELSE GO TO ERR1;
        IF CURRENTMODE=FUNCMODE THEN INDENT(-CURLINE);
        END ELSE
        IF QUOTE THEN EDITLINE ELSE
        ERR1:  ERRORMESS(SYNTAXERROR,0,0);
        INDENT(0);
        TERPRINT;
    END;
REAL PROCEDURE LINENUMBER(R); VALUE R; REAL R;
    BEGIN
    REAL STREAM PROCEDURE CON(R); VALUE R;
        BEGIN SI:=LOC R; DI:=LOC CON; DS:=DEC
        END;
    LINENUMBER:=CON(ENTIER(R+.00005)|10000))
    END;
DEFINE DELIM="""#, ENDCHR="$"#;
BOOLEAN PROCEDURE WITHINALINE(COMMAND,OLD,NEW,CHAR,WORD);
  VALUE COMMAND,CHAR,WORD; INTEGER COMMAND,CHAR,WORD;
  ARRAY OLD, NEWEDIT; BEGIN
BOOLEAN STREAM PROCEDURE WITHINALINE(COMMAND,OLD,NEW,CHAR,WORD);
    VALUE COMMAND,CHAR.WORD;
    BEGIN
    LOCAL OLDLINE,NEWLINE,F,BCHR;
    LOCAL N,M,T;
    LOCAL X,Y,Z;                                                        080301?? P81
    LABEL LOOKING,FOUND,BETWEEN,TAIL,FINISH,
    OVER;
    DI:=NEW; WORD(DS:=BLIT" ");
    SI:=LOC CHAR; DI:=LOC T; DI:=DI+1; DS:=7CHR;
    SI:=COMMAND;
    TALLY:=T; X:=TALLY; TALLY:=2; Y:=TALLY; TALLY:=32; Z:=TALLY;
    TALLY:=0;
        IF SC!"~" THEN
        BEGIN RCHR:=SI; SI:=OLD; OLDLINE:=SI;
        DI:=NEW; NEWLINE:=DI; SI:=RCHR;
        63(IF SC=DELIM THEN JUMP OUT ELSE SI:=SI+1; TALLY
        :=TALLY+1); N:=TALLY;
        IF TOGGLE THEN
            BEGIN
            SI:=SI+1; TALLY:=0;
            63(IF SC=DELIM THEN TALLY:=0 ELSE
                IF SC="~" THEN JUMP OUT ELSE TALLY:=TALLY+1; SI:=SI+1);
            IF TOGGLE THEN M:=TALLY;;
            DI:=OLDLINE; SI:=RCHR;
            2( X( Y( Z( CI:=CI+F;
            GO LOOKING; GO FOUND; GO BETWEEN; GO TAIL; GO FINISH;
LOOKING: %************ LOOKING FOR THE FIRST UNIQUE STRING*************
        IF SC=DELIM THEN BEGIN SI:=SI+1; TALLY:=2; F:= TALLY ;
            DI:=NEWLINE; GO BETWEEN END ELSE
        IF N SC=DC THEN BEGIN SI:=OLDLINE; SI:=SI+N; OLDLINE:=SI;
            DI:=NELINE; SI:=BCHR; TALLY:=1; F:=TALLY;
            GO FOUND END ELSE
                BEGIN SI:=OLDLINE; DI:=NEWLINE; DS:=CHR; NEWJLINE:=DI;
                OLDLINE:=SI; SI:=BCHR;   DI:=OLDLINE;
                END; GO OVER;
FOUND:   %**************FOUND THE FIRST UNIQUE STRING *****************
        IF SC=DELIM THEN BEGIN SI:=SI+1; TALLY:=2;
            F:=TALLY; GO BETWEEN END ELSE
        DS:=CHR;  GO OVER;
BETWEEN:  % ********** BETWEEN THEN // ********************************
        IF SC=DELIM THEN BEGIN SI:=SI+1; NEWLINE:=DI; DI:=OLDLINE;
            TALLY:=3; F:=TALLY; GO TAIL END ELSE
        IF SC="~" THEN BEGIN TALLY:=4; F:=TALLY;
                SI:=OLDLINE; GO FINWISH END ELSE
        DS:=CHR; GO OVER;
TAIL:  % ******* THE TAIL END OF THE COMMAND **************************
        IF M SC=DC THEN BEGIN DI:=NEWLINE; SI:=OLDLINE; TALLY:=4;
                F:=TALLY; GO FINISH END ELSE
            BEGIN SI:=SI-M; DI:=DI-M; DI:=DI+1; OLDLINE:=DI; END;
        GO OVER;
FINISH:   % ********FINISH UP THE CHAR MOVE FROM OLD TO NEW************
            DS:=CHR; OVER:)));
            TALLY:=CHAR; X:=TALLY; TALLY:=1; Y:=TALLY;
            Z:=TALLY);
            SI:=NEW; DI:=OLD; DS:=WORD WDS; TALLY:=1;
            WITHINLINE:=TALLY;
            END
        END
    END OF WITHINALINE;
  WITHINALINE := WITHINALINE(COMMAND,OLD,NEW,CHAR,WORD);
  END OF PHONY WITHINALINE;
PROCEDURE EDITLINE;
    BEGIN ARRAY T[0:MAXBUFFSIZE];
    INITBUFF(T,BUFFSIZE);
    TRANSFER(OLDBUFFER,0,T,0,LENGTH(OLDBUFFER,TRUE));
    IF WITHINALINE(ADDRESS,T,OLDBUFFER,BUFFSIZE|8,BUFFSIZE) THEN
        BEGIN MOVEWDS(OLDBUFFER,BUFFSIZE,BUFFER);

        IF SCAN AND RGTPAREN THEN
            ERRORMESS(SYNTAXERROR,LADDRESS,0) ELSE EDITOG:=1;
        END;

        FORMROW(3,0,BUFFER,0,LENGTH(BUFFER,FALSE));
    END;
PROCEDURE CHECKSEQ(SEQ,L,INC); REAL SEQ,L,INC;
    BEGIN
    INTEGER I,J;
    I:=L|10000 MOD 10000;
    FOR J:=-4 STEP 1 WHILE J LSS 0 AND I MOD 10=0 DO
        I:=I/10;
    INC:=10*J;
    SEQ:=L;
    END;
PROCEDURE FUNCTIONHANDLER;
    BEGIN
    LABEL ENDHANDLER;
    OWN BOOLEAN EDITMODE;                                               09003000 P82
    DEFINE FPT=FUNCPOINTER@,
        FSQ=FUNCSEQ#,
        SEQ=CURLINE#,
        INC=INCREMENT#,
    MODE=SPECMODE#,
        ENDDEFINES=#;
    INTEGER STREAM PROCEDURE DELPRESENT(ADDR); VALUE ADDR;
        BEGIN LABEL L,FINIS;
        LOCAL Q;
        DI:=LOC Q; DS:=RESET; DS:=5SET; DS:=2RESET; DS:=2SET;
        % LEFT-ARROW / QUESTION MARK
        SI:=ADDR;
        L: DI:=LOCQ;
        IF SC=DELCHR THEN
            BEGIN ADDR:=SI; SI:=LOC; DS:=ADDR; DS:=LIT" ";
            TALLY:=1; DELPRESENT:=TALLY; GO TO FINIS;
            END;
        IF SC=DC THEN GO TO FINIS; SI:=SI-1;
        IF SC=DC THEN GO TO FINIS;
        GO TO SL;
        FINIS:
        END;
INTEGER PROCEDURE OLDLABCONFLICT(PT,S); VALUE PT,S;
    INTEGER PT, REAL S;
    IF PT NEQ 0 THEN
        BEGIN INTEGER K; ARRAY L[0:1];
        ADDRESS:=ABSOLUTEADDRESS;
        WHILE LABELSCAN(L,0) AND ERR EQL 0 DO
        IF SEARCHORD(PT,L,K,8)=0 THEN
            IF L[1] NEQ S THEN ERR:=24;
    OLDLABELCONFLICT:=ERR
    END;
INTEGER PROCEDURE ELIMOLDLINE(PT,SQ,L); VALUE PT,SQ,L; INTEGER PT,
        SQ,L; FORWARD;
INTEGER PROCEDURE STOREAWAY(PT,SQ,B,SEQ); VALUE SEQ;
    INTEGER PT,SQ; REAL SEQ; ARRAY B[0]; FORWARD;
    PROCEDURE BUFFERCLEAN(BUFFER,BUFFSIZE,ADDR); VALUE BUFFSIZE,
        ADDR; REAL ADDR; INTEGER BUFFSIZE; ARRAY BUFFER[0];
        FORWARD; COMMENT THIS IS A PHONEY DEAL, BUT I CAN"T
       DECLARE CLEANBUFFER FORWARD (MOVE IT UP HERE LATER);
PROCEDURE EDITDRIVER(PT,SQ,I,K); VALUE PT,SQ,I,K;
    INTEGER PT,SQ,I,K;
    BEGIN ARRAY C,LAB[0:1],OLD,NEW[0:MAXBUFFSIZE];
    STREAM PROCEDURE BL(A);
        BEGIN DI:=A; MAXBUFFSIZE(DS:=8LIT" ") END;
    DEFINE MOVE=MOVEWDS#;
    REAL T,SEQ; INTEGER A,B,L,H;
    T:=ADDRESS;
    FOR A:=I STEP 1 WHILE A LEQ K AND EDITMODE DO
        BEGIN B:=CONTENTS(PT,A,C); BL(OLD);
        SEQ:=C[0];
        B:=CONTENTS(SQ,C[1],OLD);
        IF EDITMODE:=WITHINALINE(T,OLD,NEW,BUFFSIZE|8,BUFFSIZE)
        THEN BEGIN MOVE(BUFFER,MAXBUFFSIZE+1,NEW);
            MOVE(OLD,MAXBUFFSIZE,BUFFER);
            IF EDITMODE:=ERR:=OLDLABELCONFICT(PT,C[0])=0 THEN
                BEGIN B:=ELIMOLDLINE(PT,SQ,C[1]);
                DELTOG:=DELPRESENT(ADDRESS);
                DELETE1(SQ,C[1]); DELET1(PT,A+B); C[1]:=
                STORESEQ(SQ,BUFFER,LENGTH(BUFFER,FALSE));
                STOREORD(PT,C,A+B);
                RESCANLINE; L:=0; M:=1; LAB[1]L=C[0];
                WHILE LABELSCAN(C,0) DO
                    BEGIN MOVEWDS(C,1,LAB);
                    IF (IF FUNCSSIZE=0 THEN TRUE ELSE L:=
                    SEARCHWROD(PT,C,M,B)NEQ 0) THEN
                        BEGIN B:=B+1; FUNCSIZE:=FUNCSIZE+1;
                        STOREORD(PT,ALAR,L+M-1);
               END END;
           A:=A+B; K:=K+B;
            COMMENT THE NEXT LINE CAUSE A SYSTEM CRASH AFTER THE EDIT
            IF NOSYNTAX=0 THEN PROCESS(XEQUTE);
           END END;
       MOVE(NEW,MAXBUFFSIZE+1,BUFFER)
   END END;
    PROCEDURE LISTLINE(PT,SQ,I); VALUE PT,SQ,I; INTEGER PT,SQ,I;
        BEGIN
        GT1:=CONTENTS(PT,I,GTA);
        INDENT(GTA[0]);
        GT1:=CONTENTS(SQ,GTA[1],BUFFER);
        CHRCOUNT:=CHRCOUNT-1;
        FORMROW(1,0,BUFFER,0,GT1);
        END;                                                            090528?? P83
INTEGER PROCEDURE DISPLAY(A,B,PT,SQ); VALUE A,B,PT,SQ;
    INTEGER PT,SQ; REAL A,B;
    IF A LEQ B AND FUNCSIZE NEQ 0 THEN
        BEGIN
        ARRAY C[0:1];
        INTEGER I,J,K;
        DEFINE CLEANBUFFER=BUFFERCLEAN#;
        A:=LINENUMBER(A); B:=LINENUMBER(B);
        C[0]:=A;
        I:=SEARCHORD(PT,C,K,8);
        I:=( IF I=2 THEN IF K LSS FUNCSIZE-1 THEN K:=K+1 ELSE
              K ELSE K);
        IF A NEQ B THEN
            BEGIN
            C[0]:=B; B:=SEARCHORD(PT,C,K,8);
            END;
        IF EDITMODE THEN % MAY HAVE ONLY ONE LINE TO EDIT
            IF I=K THEN
                IF A NEQ 0 THEN %NOT EDITING THE HEADER
                    EDITDRIVER(PT,SQ,I,K);
                ELSE %EDITING THE FUNCTION HEADER, FIX LATER.
                    ERR:=3;
                ELSE %EDITING MORE THAN ONE LINE
            BEGIN MODE:=EDITING;
                IF A=0 THEN I:=I+1;
            CLEANBUFFER(BUFFER,BUFFSIZE,ADDRESS);
            MOVE(BUFFER,BUFFSIZE,OLDBUFFER);
            LOWER:=I; UPPER:=K
            END
        ELSE %NOT EDITING, MUST BE A LIST
        BEGIN
        FORMWD(3,"1      ");
        IF K=I THEN % LISTING A SINGLE LINE
            BEGIN LISTLINE(PT,SQ,I);
            FORMWD(3,"1      ");
            END ELSE % LISTING A SET OF LINES
            BEGIN MODE:=DISPLAYING;
            LOWER:=I; UPPER:=K;
            END;
        END;
        EOB:=1;
        END ELSE DISPLAY:=20;
INTEGER PROCEDURE DELETE(A,B,PT,SQ); VALUE A,B;
    INTEGER PT,SQ; REAL A,B;
    IF A LEQ B AND FUNCSIZE NEQ 0 AND A NEQ Q THEN
        BEGIN
        INTEGER I,J,K,L;
        ARRAY C[0:1];
        A:=LINENUMBER(B);
        B:=LINENUMBER(B);
        C[0]:=A;
        IF SEARCHOR(PT,C,I,8)=1 THEN I:=I-1;
        IF K GTR I OR I GEQ FUNCSIZE THEN DELETE:=21 ELSE
            BEGIN
            FOR J:=K STEP 1 UNTIL I DO
                BEGIN A:=CONTENTS(PT,J,C);
                L:=ELIMOLDLINE(PT,SQ,C[1]);
                FUNCSIZE:=FUNCSIZE+L; I:=I+L; K:=K+L; J:=J+L;
                DELETE1(SQ,C[1])
                END;
            FUNCSIZE:=FUNCSIZE-(I-K+1)
            ; EOF:=1;
            DELETEN(PT,K,I);
        IF FUNCSIZE=0 THEN
             BEGIN
            PT:=0; RESEASEUNIT(SQ); SQ:=0;
            STOREPSR;
            END;
        END;
        END ELSE DELETE:=22;
    INTEGER PROCEDURE ELIMOLDLINE(PT,SQ,L); VALUE PT,SQ,L;
    INTEGER PT,SQ,L;
        BEGIN INTEGER K,J;
        REAL AD;
        ARRAY T[0:MAXBUFFERSIZE],LAB[0:1];
         AD:=ADDRESS;
        MOVEWDS(BUFFER,MAXBUFFSIZE+1,T);
        INITBUFF(BUFFER,BUFFSIZE);
        K:=CONTENTS(SQ,L,BUFFER);
        RESCANLINE;
        WHILE LABELSCAN(LAB,0) DO                                       091240?? P84
            IF SEARCHORD(PT,LAB,K,8)=0 THEN
            BEGIN DELETE1(PT,K); J:=J-1 END;
        ADDRESS:=AD;
        MOVEWDS(T,MAXBUFFSIZE+1,BUFFER);
        ELIMOLDLINE:=J
        END;
INTEGER PROCEDURE STOREAWAY(PT,SQ,B,SEQ); VALUE SEQ;
        INTEGER PT,SQ; REAL SEQ; ARRAY B[0]
        BEGIN DEFINE BUFFER=B#;
        ARRAY C,LAB[0:1];
        INTEGER I,J,K,L;
        BOOLEAN TOG;
        SEQ:=LINENUMBER(SEQ);
        C[0]:=SEQ;
        IF TOG:=(PT=0 OR FUNCSIZE=0) THEN
            BEGIN SEQUENTIAL(SQ:=NEXTUNIT); I:=0
            END ELSE
        IF J:=SEARCHORD(PT,C,I,8)=0 THEN
            BEGIN
            K:=ELIMOLDLINE(PT,SQ,C[1]);
            I:=J+K; FUNCSIZE:=FUNCSIZE+K;
            DELETE1(PT,T);
            FUNCSIZE:=FUNCSIZE-1;
            DELETE1(SQ,C[1]);
            END ELSE
        I:=I+J-1;
        RESCANLINE;
        DELTOG:=DELPRESENT(ADDRESS);
        K:=STORESEQ(SQ,BUFFER,LENGTH(BUFFER,TRUE));
        LAB[1]:=SEQ; L:=0; J:=1;
        IF TOG THEN PT:=NEXTUNIT;
        WHILE LABELSCAN(C,0) DO
            BEGIN
            MOVEWDS(C,1,LAB);
            IF (IF FUNCSIZE=0 THEN TRUE ELSE L:=
                SEARCHORD(PT,C,J,8)NEQ 0 ) THEN
                BEGIN I:=I+1; FUNCSIZE:=FUNCSIZE+1;
                STOREORD(PT,LAB,L+J-1);
                END;
            END;
        C[1]:=K;
        C[0]:=SEQ;
        FUNCSIZE:=FUNCSIZE+1;
        STQOREORD(PT,C,I);
        IF TOG THEN STOREPSR;
        EOD:=1;
        END;
    BOOLEAN PROCEDURE BOUND(PT); VALUE PT; INTEGER PT;
    IF NOT(BOUND:=NUMERIC) THEN
        IF INDENT AND FUNCSIZE GTR 0 THEN
        BEGIN ARRAY L[0:1]; INTEGER K;
        REAL T,U;
        REAL STREAM PROCEDURE CON(A);
        VALUE A;
            BEGIN SI:=LOC A; DI:=LOC CON; DS:=8OCT
            END;
        TRANSFER(ACCUM,2,L,1,7);
        IF BOUND:=SEARCHORD(PT,L,K,8)=0 THEN
            BEGIN T:=ADDRESS;
            U:=CON(MAX(L[1],0))/10000; %ARGS AND RESULT ARE NEG
            IF SCAN AND PLUS OR MINUS THEN
                BEGIN K:=(IF PLUS THEN 1 ELSE -1);
                IF SCAN AND NUMERIC THEN
                ACCUM[0]:=MAX(U+K|ACCUM[0],0) ELSE
                    BEGIN ACCUM[0]:=U;
                    ADDRESS:=T;
                    END;
                END ELSE BEGIN ACCUM[0]:=U; ADDRESS:=T;
                         END;
            EOB:=0;
            END;
        END;


    PROCEDURE FINISHUP;
    BEGIN COMMENT GET HIM BACK TO CALCULATOR MODE;
    IF FUNCPOINTER=0 THEN % HE DELETED EVERYTHING
        BEGIN TRANSFER(PSR,FSTART|8,GTA,0,8);
        IF SEARCHORD(VARIABLES,GTA,GT1,7)=0 THEN
            BEGIN DELETE1(VARIABLES,GT1);
            IF VARSIZE:=VARSIZE-1=0 THEN VARIABLES:=0;
            END ELSE SPOUT(9198260);
        END;                                                            09198270 P85
    DELTOG:=CURRENTMODE:=CURLINE:=INCREMENT:=0;
    STOREPSR;
    END;

    LABEL SHORTCUT;
    REAL L,U,TADD;
    STREAM PROCEDURE CLEANBUFFER(BUFFER,BUFFSIZE,ADDR);
    VALUE BUFFSIZE,ADDR;
    BEGIN LABEL L; LOCAL T,U,TSI,TDI;
    SI:=ADDR; SI:=SI-1; L:
    IF SC NEQ "]" THEN
        BEGIN SI:=SI-1; GO TO L END;
    SI:=SI+1; DI:=LOC T; SKIP 2 DB; DS:=2SET;
    DI:=BUFFER; TDI:=DI; DI:=LOC T; TSI:=SI;
    BUFFSIZE(8(IF TOGGLE THEN DS:=LIT" " ELSE
        IF SC=DC THEN
            BEGIN SI:=LOC U; DI:=TDI; DS:=LIT" "
            END ELSE
        BEGIN TSI:=SI; SI:=SI-1; DI:=LOC U; DS:=CHR;
        DI:=TDI; SI:=LOC U; DS:=CHR; TDI:=DI; DI:=LOC T;
        SI:=TSI;
        END))
    END;
    PROCEDURE BUFFERCLEAN(BUFFER,BUFFSIZE,ADDR); VALUE BUFFSIZE,
        ADDR; REAL ADDR; INTEGER BUFFSIZE; ARRAY BUFFER[0];
        CLEANBUFFER(BUFFER,BUFFSIZE,ADDR);
COMMENT DETERMINE WHETHER OR NOT WE CAME FROM CALCULATOR MODE;
    ERR:=0;
    IF BOOLEAN(SUSPENSION) THEN GO TO ENDHANDLER;
    BEGIN DEFINE STARTSEGMENT=#; %///////////////////////////////
    IF GT1:=CURRENTMODE=CALCMODE THEN % TAKE CARE OF HEADER.
        BEGIN ARRAY A[0:MAXHEADERSARGS];
    LABEL HEADERSTORE,FORGETITFELLA;
        IF FUNCTIONHEADER(A,TADD) THEN %HEADER OK
            IF VARIABLES NEQ 0 THEN % MAY BE A RE-DEFINITION
                BEGIN COMMENT GET THE FUNCTION NAME;
                TRANSFER(A,1,GTA,0,7);
                IF GT2:=SEARCHORD(VARIABLES,GTA,GT3,7)=0 THEN
                    COMMENT RE-DEFINING A FUNCTION.  MAKE SURE NULL ;
                    IF GETFIELD(GTA,7,1)=FUNCTIUON AND
                    (A[1]+A[2]+A[3])=0  THEN %NULL HEADER--OK
%--------------------SET UP FOR CONTINUATION OF DEFINITION------
    BEGIN
    FUNCPOINTER:=GETFIELD(GTA,FPTF,FFL);
    FUNCSEQ:=GETFIELD(GTA,FSQF,FFL);
    GT3:=CURLINE:=TOPLINE(FPT);
    CHECKSEQ(CURLINE,GT3,INC); %SET THE INCREMENT
    COMMENT THE CURRENT LINE IS SET TO THE LAST LINE OF THE
    FUNCTION;
    FUNCSIZE:=SIZE(FPT);
    CURLINE:=CURLINE+INC;
    DELTOG:=DELPRESENT(ADDRESS);
    END ELSE
%------------------REDEFINING THE HEADER OF A DEFINED FUNCTION----
                    GO TO FORGETITFELLA
                    ELSE
%--------------------NAME NOT FOUND IN DIRECTWORY, SET UP
HEADERSTORE:
    BEGIN COMMENT GET THE HEADER TO INSERT AT LINE 0;
    ARRAY OLDBUFFER[0:MAXBUFFSIZE];
    INTEGER L,U,F,K,J;
    INTEGER A1,A2;
        COMMENT FUNCTIONHEADER RETURN AN ARRAY WITH THE
        FOLLOWING VALUES:
        A[0]   = FUNCTION NAME , I.E., 0AAAAAAA
        A[1]   = 0 IF NO RESULT, 1 IF A RESULT IS RETURNED BY THE
                 FUNCTION.
        A[2]   = NUMBER OF ARGUMENTS TO THE FUNCTION.
        A[3]   = NUMBER OF LOCALS + RESULT +ARGUMENTS.
        A[4]....A[N]   ARE ALL OF THE LOCALS, RESULT, AND ARGUMENTS.
        THE RESULT IS FIRST, THEN THE SECOND ARGUMENT, THEN
        THE FIRST ARGUMENT, FOLL7OWED BY THE LOCALS.  ALL
        ARE OF THE FORM 0XXXXXXX;
        U:=(A1:=A[1])+(A2:=A[2])+3;
        FOR L:=4 STEP 1 UNTIL 0 DO %LOOK FOR DUPLICATES AMONG
            FOR K:=L+1 STEP 1 UNTIL 0 DO %THE RESULT/ARGUMENT SET
                IF A[L]=A[K] THEN GO TO FORGETITFELLA;
    SEQUENTIAL(FUNCSEQ:=NEXTUNIT);
    SETFIELD(GTA,8,8,STORESEQ(FUNCSEQ,OLDBUFFER,
            HEADER(TADD.[1:23],TADD.[24:24],OLDBUFFER)));
    SETFIELD(GTA,0,8,0);
    STOREORD(F:=FUNCPOINTER:=NEXTUNIT,GTA,0);
    SETFIELD(GTA,0,8,0); SETFIELD(GTA,8,8,0);                           09229004 P86
    FOR L:=4 STEP 1 UNTIL U DO
        BEGIN GTA[0]:=A[L]; IF A1 GTR 0 THEN
            BEGIN A1:=0; GTA[1]:=-1; %"RESULT" SET TO -1
            STOREORD(F,GTA,0);
            END ELSE %LOOKING AT THE ARGUMENTS
            BEGIN K:=SEARCHORD(F,GTA,J,8);
            GTA[1]:=A2-4; A2:=A2-1; GTA[0]:=A[L];
            STOREORD(F,GTA,J+K-1);
        END END;
    FUNCSIZE:=U:=U-2; U:=A[3]-U+L;
    FOR L:=L STEP 1 UNTIL U DO %GET LOCALS INTO THE LABEL TABLE
        BEGIN GTA[0]:=A[L];
        IF K:=SEARCHORD(F,GTA,J,8) NEQ 0 THEN %NOT YET IN TABLE.
            BEGIN GTA[0]:=A[L]; GTA[1]:=0;
            STOREORD(F,GTA,J+K-1);
            FUNCSIZE:=FUNCSIZE+1
            END;
        END;
        GTA[1]:=0&ENTIER(A[1])[CRETURN]&ENTIER(A[2])[CNUMBERARGS];
    CURLINE:=INCREMENT:=1;
    DELTOG:=0;
    COMMENT GET THE "TYPE" OF THE FUNCTION LATER WHEN THERE
    IS A PLACE FOR IT.  THE TYPE IS EITHER 1 (FUNCTION CALL), OR
    0 (SUBROUTINE CALL);
    END;
%--------------------------------------------------------
                END ELSE % VARIABLES=0, MAKE UP A DIRECTORY
                BEGIN GT3:=0; GT2:=1; GO TO HEADERSTORE
                END
            ELSE % HEADER SYNTAX IS BAD
            GO TO ENDHANDLER;
    COMMENT WE MAKE IT TO HERE IF ALL IS WELL ABOVE;
        IF GT2 NEQ 0 THEN %NME NOT FOUND IN DIRECTORY;
            BEGIN
            TRANSFER(A,1,GTA,0,7); %GET FUNCTION NAME
            SETFIELD(GTA,7,1,FUNCTION);
            SETFIELD(GTA,FPTF,FFL,FUNCPOINTER);
            SETFIELD(GTA,FSQF,FFL,FUNCSEQ);
            IF VARIABLES=0 THEN
                VARIABLE:=NEXTUNIT;
            STOREORD(VARIABLES,GTA,GT3+GT2-1);
            VARSIZE:=VARSIZE+1;
            END;
            CURRENTMODE:=FUNCMODE;
            TRANSFER(GTA,0,PSR,FSTART|8,8);
            STOREPSR;
        IF SCAN THEN GO TO SHORTCUT;
        IF FALSE THEN
        FORGETITFELLA: ERRORMESS(ERR:=LABELERROR,TADD.[1:23],0);
        END ELSE % WE ARE IN FUNCTION DEFINITION MODE
    IF GT1:=MODE NEQ 0 THEN % A SPECIAL FUNCTION SUCH AS DISPLAY OR EDIT
        BEGIN L:=LOWER;
        IF GT1=DISPLAYING THEN
            LISTLINE(FPT,FSQ,L) ELSE
        IF GT1=EDITING THEN
            BEGIN INITBUFF(BUFFER,BUFFSIZE);
            MOVE(OLDBUFFER,BUFFSIZE,BUFFER);
            EDITMODE:=TRUE; ADDRESS:=ABSOLUTEADDRESS;
            EDITDRIVER(FP1,FSQ,L,L)
            ;IF NOT EDITMODE THEN
                BEGIN MODE:=0; ERR:=30
                END;
        END ELSE
        IF GT1=RESEQUENCING THEN
            IF GT1:=L LEQ UPPER THEN
                BEGIN GT2:=CONTENTS(FPT,L,GTA);
                GT3:=GTA[0]:=LINENUMBER(CURLINE);
                DELETE1(FPT,L);
                STOREORD(FPT,GTA,L);
                CURLINE:=CURLINE+INCREMENT;
                GT2:=CONTENTS(FSQ,GTA[1],BUFFER); RESCANLINE;
                WHILE (IF ERR NEQ 0 THEN FALSE ELSE
                    LABELSCAN(GTA,0)) FO
                    IF GT1:=SEARCHORD(FPT,GTA,GT2,8)=0 THEN
                    BEGIN GTA[1]:=GT3; DELETE1(FPT,GT2);
                    STOREORD(FPT,GTA,GT2)
                    END ELSE ERR:=16
                END
            ELSE MODE:=0;
        LOWER:=L+1;
        IF LOWER GTR UPPER THEN
            BEGIN IF MODE=DISPLAYING THEN
            FORMWD(3,"1       ");                                       092314?? P87
            MODE:=0;
            END;
        GO TO ENDHANDLER
        END;
    END ; % OF BLOCK STARTED EON LINE 9225115 //////////////////


    IF ERR=0 AND EOB=0 THEN

SHORTCUT:  BEGIN LABEL RGTBRACK,DELOPTION; %//////////////////////////
    IF DEDLV THEN FINISHUP ELSE
        IF LFTBRACKET THEN
          BEGIN
          IF SCAN THEN
              IF DOUND(FPT) THEN
               BEGIN L:=ACCUM[0];
               IF SCAN THEN
                   IF QUDV OR EDITMWODE:=(QUOTEQUAD) THEN
                    IF SCAN THEN
                        IF BOUND(FPT) THEN
                         BEGIN U:=ACCUM[0];
RGTBRACK:
                         IF SCAN AND RGTBRACKET THEN
                         IF(IF EDITMODE THEN FALSE ELSE SCAN) THEN
                             IF DELV THEN
                               BEGIN ERR:=DISPLAY(L,U,FPT,FSQ);
                               DELTOG:=1;
                               END
                             ELSEERR:=1;
                           ELSE ERR:=DISPLAY(L,U,FPT,FSQ)
                         ELSE ERR:=2
                         END
                       ELSE
                       IF RGTBRACKT THEN
                       IF(IF EDITMODE THEN FALSE ELSE SCAN) THEN
                           IF DELV THEN
                             BEGIN ERR:=DISPLAY(L,L,FPT,FSQ);
                             DELTOG:=1;
                             END
                           ELSE ERR:=3
                         ELSE ERR:=DISPLAY(L,L,FPT,FSQ)
                       ELSE ERR:=4
                     ELSE ERR:=5
                   ELSE
                   IF RGTBRACKET THEN
                     BEGIN TADD:=ADDRESS;
                     IF SCAN THEN
                       IF IDENT AND ACCUM[0]="ADELETE" THEN
                         IF SCAN THEN
                           IF LFTBRACKET THEN
DELOPTION:
                             IF SCAN AND BOUND(FPT) THEN
                               BEGIN U:=ACCUM[0];
                               IF SCAN AND RGTBRACKET THEN
                                 IF SCAN THEN
                                   IF DELV THEN
                                     BEGIN ERR:=DELETE(L,U,FPT,FSQ);
                                     FINISHUP
                                     END
                                   ELSE ERR:=6
                                 ELSE ERR:=DELETE(L,U.FPT,FSQ)
                               ELSE ERR:=7
                               END
                             ELSE ERR:=8
                           ELSE
                           IF DELV THEN
                             BEGIN ERR:=DELETE(L,L,FPT,FSQ);
                             FINISHUP
                             END
                           ELSE ERR:=9
                         ELSE ERR:=DELETE(L,L,FPT,FSQ)
                       ELSE
                       IF LFTBRACKET TEHN GO TO DESLOPTION ELSE
                         BEGIN CHECKSEQ(SEQ,L,INC);
                         CLEANBUFFER(BUFFER,BUFFSIZE,TADD);
                         ADDRESS:=ABSADDR(BUFFER); ITEMCOUNT:=0;
                         IF SCAN THEN GO TO SHORTCUT
                         END
                     ELSE ERR:=DELETE(L,L,FPT,FSQ)
                    END
                   ELSE ERR:=10
            ELSE ERR:=11                                                09310000 P88
              END ELSE
            IF QUADV OR EDITMODE:=(QUOTEQUAD) THEN
                BEGIN L:=0; U:=9999.9999; GO TO RGTBRACK
            END ELSE
        IF IOTA THEN
            IF SCAN AND RGTBRACKET AND FPT NEQ 0 THEN
            BEGIN IF SCAN THEN
                IF DELV THEN DELTOG:=1; ELSE ERR:=15;
            IF ERR == 0 THEN
                BEGIN MODE:=RFSEQUENCING; CURLINE:=INCREMENT:=1;
                SETFIELD(GTA,0,8,0);
                GT1:=SEARCHORD(FPT,GTA,GT2,8);
                LOWER:=GTT2+1; UPPER:=FUNCSIZE-1;
                END
            END
    ELSE ERR:=14;
          ELSE ERR:=12
        ELSE ERR:=13
        END
      ELSE
        IF CURLINE=0 THEN %CHANGING HEADER
        ERR:=26 ELSE
      IF ERR:=OLDLABCONFLICT(FPT,LINENUMBER(SEQ))=0 THEN
        BEGIN
       IF NOSYNTAX=0 THEN PROCESS(XEQUTE);
        IF ERR:=STOREAWAY(FPT,FSQ,BUFFER,SEQ)=0 THEN SEQ:=SEQ+INC;
        END;
        IF ERR NEQ 0 TEHN
    BEGIN FORMWD(2,"5ERROR ");
    EOD:=1;
    FORMROW(1,1,ACCUM,2,ACCUM[0].[1:11]);
    END;
  END; %OF BLOCK STARTED ON LINE 9238000 //////////////////////
    ENDHANDLER:
        IF BOOLEAN(SUSPENSION) THEN BEGIN
            FILL ACCUM[*] WITH "ABORT SU", "SP. FNS.";
            FORMROW(3,0,ACCUM,0,16);  INDENT(0); TERPRINT;
            END ELSE
        IF MODE=0 THEN
        BEGIN
        IF BOOLEAN(DELTOG) THEN FINISHUP;
        INDENT(-CURLINE); TERPRINT;
        END;

    END;
    EXPOVR:=FAULTL; INTOVR:=FAULTL; INDEXF:=FAULTL;
    FLAG:=FAULTL; ZERO:=FAULTL;
INITIALIZETABLE;
TRYAGAIN:
    IF FALSE THEN %ENTERS WITH A FAULT.
    FAULTL:
        BEGIN SPOUT(09334300); %SEND MESSAGE TO SPO

            BEGIN CSTATION.APLOGGED:=0; CSTATION.APLHEADING:=0
            END
        END;
    APLMONITOR;
ENDOFJOB:

    FINIS:
    WRAPUP;

END.
    END;END.          LAST CARD ON OCRDING TAPE



                TOTAL LOGICAL RECORDS=  7273
                END OF JOB.
