BEGIN                                                                   00000100
% THIS APL/B5500 PROGRAM WAS DEVELOPED BY THE COMPUTER SCIENCE GROUP    00000200
% AT THE UNIVERSITY OF WASHINGTON UNDER THE SPONSORSHIP OF PROFESSOR    00000300
% HELLMUT GOLDE.  THE PROGRAM MAY BE NOT BE OFFERED FOR SALE OR LEASE   00000400
% IN ITS ORIGINAL OR ANY MODIFIED FORM.  ANY PUBLICATION RELATING TO    00000500
% THIS PROGRAM OR ANY MODIFICATION OF THE PROGRAM MUST EXPLICITLY CREDIT00000600
% THE COMPUTER SCIENCE GROUP OF THE UNIVERSITY OF WASHINGTON AND THE    00000700
% PRINCIPAL IMPLEMENTORS, GARY KILDALL, LEROY SMITH, SALLY SWEDINE,     00000800
% AND MARY ZOSEL.  COMPUTER RESOURCES FOR THE DEVELOPMENT OF THE        00000900
% PROGRAM WERE MADE AVAILABLE BY THE UNIVERSITY OF WASHINGTON COMPUTER  00001000
% CENTER.                                                               00001100
DEFINE VERSIONDATE="1-11-71"# ;                                         00001200
%MODIFICATIONS FOR B-5500 TIME-SHARING MCP MADE BY:                     00001300
% JOSE HERNANDEZ, BURROUGHS CORPORATION.                                00001400
BOOLEAN BREAKFLAG;                                                      00001500
ARRAY GTA[0:1];                                                         00001600
LABEL FINIS; %GO THERE WHEN YOU ARE IN TROUBLE (SPOUT A MESSAGE)        00001700
BOOLEAN PROCEDURE LIBRARIAN(A,B); VALUE A,B; REAL A,B; FORWARD;         00001800
LABEL FAULTL; % FAULT LABEL                                             00001900
MONITOR EXPOVR,INTOVR,INDEX:=INDEXF,FLAG,ZERO;                          00002000
REAL BIGGEST, NULLV;                                                    00002100
INTEGER STACKSIZE,LIBSIZE;                                              00002200
    REAL STATUSWORD,CORELOC;                                            00002300
    BOOLEAN RETURN;                                                     00002400
BOOLEAN MEMBUG,DEBUG;                                                   00002500
COMMENT   MEMBUG  SWITCHES ----------------------                       00002600
            BIT        FUNCTION        BIT     FUNCTION                 00002700
-----------------------------------------------------------------       00002800
            1                           25                              00002900
            2                           26                              00003000
            3                           27                              00003100
            4                           28                              00003200
            5     DUMP TYPES @ INSERT   30                              00003300
            6    DUMP TYPES @ DELETE  30                                00003400
            7                           31                              00003500
            8                           32                              00003600
            9                           33                              00003700
           10                           34                              00003800
           11                           35                              00003900
           12                           36                              00004000
           13                           37                              00004100
           14                           38                              00004200
           15                           39                              00004300
           16                           40                              00004400
           17                           41                              00004500
           18                           42                              00004600
           19                           43                              00004700
           20     DUMP INDEX            44                              00004800
           21                           45                              00004900
           22     DUMP TYPES            46                              00005000
           23     CHECK TYPES           47                              00005100
           24     DUMP BUFFER #S                                        00005200
           ;                                                            00005300
FILE PRINT 4 "SYSTEMS" " BOX   " (1,15);                                00005400
FILE TWXIN 19(2,30),TWXOUT 19(2,10);                                    00005500
%                                                                       00005600
DEFINE                                                                  00005700
    PAGESIZE=120#,                                                      00005800
    AREASIZE=40#,                                                       00005900
    CF=[26:13]#,    COMMENT COUNT FIELD -- NUMBER OF ITEMS ON PAGE;     00006000
    TF=[39:9] #,    COMMENT     T-FIELD (TYPE FIELD);                   00006100
    FF=[9:1]#,  COMMENT FULL FIELD FOR SEQUENTIAL STORAGE;              00006200
    AF=[1:23] #,    COMMENT A-FIELD;                                    00006300
    BF=[24:23]#,    COMMENT B-FIELD;                                    00006400
    MF=[1:1]#,    COMMENT METHOD OF STORAGE FIELD;                      00006500
    SF=[13:13]#,    COMMENT SEQUENTIAL STORAGE SIZE FIELD (#CHRS);      00006600
    BOOL=[47:1]#,                                                       00006700
    SKIP=1#,        COMMENT --AMOUNT OF SPACE RESERVED AT THE           00006800
                    START OF EACH PAGE;                                 00006900
    ALLOWANCE=10#,  COMMENT --DEVIATION FROM THE AVERAGE PAGE SIZE      00007000
                    ALLOWED BEFORE CORRECTION;                          00007100
    RECSIZE=2#,                                                         00007200
    MAXPAGES=20#,                                                       00007300
    PAGESPACE=20#,                                                      00007400
    NEXTP=[42:6]#,                                                      00007500
    LASTP=[36:6]#,                                                      00007600
    PAGEF=[19:11]#,                                                     00007700
    BUFF=[12:6]#,                                                       00007800
    CHANGEDBIT=[1:1]#,                                                  00007900
    MBUFF=8#,                                                           00008000
    SBUFF=4#,                                                           00008100
    FLAGB=[18:1]#,    COMMENT FLAG BIT FOR BUFFER MAINTENANCE;          00008200
    EXTRAROOM=1#,                                                       00008300
    LIBJOB="/APLIBE"#,%MFID FOR APL SYSTEM FILE                         00008400
    ENDOFDEFINES=#;                                                     00008500
REAL PROCEDURE CDR(X); VALUE X; REAL X; CDR:=X.NEXTP;                   00008600
PROCEDURE RPLACD(X,Y); VALUE Y;REAL X,Y; X.NEXTP:=Y;                    00008700
BOOLEAN PROCEDURE NULL(X); VALUE X; REAL X;  NULL:=X.NEXTP=0;           00008800
BOOLEAN STREAM PROCEDURE EOFMARK(SK,RS,A); VALUE SK,RS;                 00008900
    BEGIN LABEL NO; SI:=A; SK(SI:=SI+8);                                00009000
    RS(8(  2(IF SB THEN JUMP OUT 3 TO NO; SKIP SB);                     00009100
    3(IF SB THEN SKIP SB ELSE JUMP OUT 3 TO NO); IF SB THEN             00009200
    JUMP OUT 2 TO NO; SKIP SB));TALLY:=1;EOFMARK:=TALLY;                00009300
    NO:                                                                 00009400
    END;                                                                00009500
STREAM PROCEDURE MARKEOF(SK,RS,A); VALUE SK,RS;                         00009600
    BEGIN DI:=A;                                                        00009700
    SK(DI:=DI+8);                                                       00009800
    RS(8(DS:=2RESET; DS:=3SET; DS:=RESET));                             00009900
    END;                                                                00010000
SAVE FILE ESTABLISH DISK [MAXPAGES:AREASIZE]                            00010100
    (1,PAGESIZE,SAVE 100);                                              00010200
FILE NEWDISK DISK (1,PAGESIZE);                                         00010300
FILE DISK1 DISK (1,PAGESIZE),                                           00010400
     DISK2 DISK (1,PAGESIZE),                                           00010500
     DISK3 DISK (1,PAGESIZE),                                           00010600
     DISK4 DISK (1,PAGESIZE),                                           00010700
     DISK5 DISK (1,PAGESIZE),                                           00010800
     DISK6 DISK (1,PAGESIZE),                                           00010900
     DISK7 DISK (1,PAGESIZE),                                           00011000
     DISK8 DISK (1,PAGESIZE);                                           00011100
SWITCH FILE POINTERS:=DISK1,DISK1,DISK2,DISK3,DISK4,DISK5,DISK6,DISK7,  00011200
    DISK8;                                                              00011300
PROCEDURE SETPOINTERNAMES;                                              00011400
    BEGIN                                                               00011500
        IF NOT LIBRARIAN(LIBJOB,TIME(-1)) THEN                          00011600
        BEGIN                                                           00011700
        WRITE(ESTABLISH);                                               00011800
        MARKEOF(SKIP,RECSIZE,ESTABLISH(0));                             00011900
        WRITE(ESTABLISH[1]);                                            00012000
        WRITE(ESTABLISH[MAXPAGES|AREASIZE-1]);                          00012100
        LOCK(ESTABLISH);                                                00012200
        CLOSE(ESTABLISH)                                                00012300
        ;LIBSIZE~-1;                                                    00012400
        END                                                             00012500
    END;                                                                00012600
DEFINE                                                                  00012700
    LIBMAINTENANCE=0#,                                                  00012800
    MESSDUM=#;                                                          00012900
    PROCEDURE MEMORY(MODE,TYPE,A,N,M);VALUE MODE,TYPE;                  00013000
        INTEGER MODE,TYPE,N,M; ARRAY A[0]; FORWARD;                     00013100
STREAM PROCEDURE MOVE(A,N,B); VALUE N;                                  00013200
    BEGIN SI:=A; DI:=B; DS:=N WDS;                                      00013300
    END;                                                                00013400
PROCEDURE MESSAGE(I); VALUE I; INTEGER I;                               00013500
    BEGIN                                                               00013600
    FORMAT F("MEMORY ERROR",I5);                                        00013700
COMMENT CHANGE LINE 3050 TO WRITE(PRINT,SF[I]) FOR MEMORY ERROR PROBS.  00013800
    THIS FORMAT IS NOW EXCLUDED SINCE MEMORY IS SEEMINGLY WELL DEBUGED  00013900
    SWITCH FORMAT SF:=                                                  00014000
    ("LIBRARY MAINTENANCE IN PROGRESS."),                               00014100
    ("SYSTEM ERROR--MEMORY ACCESS WITH EXPRESSION FOR N OR M."),        00014200
    ("SYSTEM ERROR--IMPROPER ARGUMENTS TO FREEPAGE."),                  00014300
    ("SYSTEM ERROR--TOO LARGE A SUBSCRIPT FOR TYPE SPECIFIED."),        00014400
    ("SYSTEM ERROR--TYPE CANNOT BE ZERO WHEN INSERTING OR DELETING."),  00014500
    ("SYSTEM ERROR--CHARACTER STTRING TOO LONG TO STORE."),             00014600
    ("SYSTEM ERROR--ATTEMPT TO INSERT NON-SEQUENTIAL ELEMENT",          00014700
     "IN TYPE A STORAGE."),                                             00014800
    ("SYSTEM ERROR--NO BLANKS IN PAGES."),                              00014900
    ("SYSTEM ERROR--ATTEMPTED BINARY SEARCH OF UNORDERED DATA."),       00015000
    ("SYSTEM ERROR--BINARY SEARCH OF UNALLOCATED DATA ATTEMPTED."),     00015100
    ("SYSTEM ERROR--BINARY SEARCH FOUND A BLANK PAGE."),                00015200
    ("SYSTEM ERROR--DELETION OF TYPE B STORAGE NOT IMPLEMENTED."),      00015300
    ("SYSTEM ERROR--ATTEMPT TO DELETE FROM NON-EXISTENT STORAGE."),     00015400
    ("SYSTEM ERROR--ATTEMPT TO DELETE RECORD FROM OUTSIDE",             00015500
     " ALLOCATED STORAGE."),                                            00015600
    ("SYSTEM ERROR--ATTEMPTED MEMORY SEARCH WITH -N- TOO LARGE."),      00015700
    ("SYSTEM ERROR--ATTEMPT TO CHANGE PREVIOUSLY DESIGNATED STORAGE",   00015800
     " KIND"),                                                          00015900
    ("SYSTEM ERROR--POINTERS TO DATA TYPES OVERLAP."),                  00016000
    (" ");                                                              00016100
    WRITE(PRINT,F,I);                                                   00016200
    IF I GTR 0 THEN                                                     00016300
        BEGIN                                                           00016400
        INTEGER GT1,GT2,GT3;                                            00016500
        MEMORY(10,GT1,GTA,GT2,GT3);                                     00016600
        GO TO FINIS;                                                    00016700
        END;                                                            00016800
    END;                                                                00016900
PROCEDURE MEMORY(MODE,TYPE,A,N,M); VALUE MODE,TYPE;                     00017000
    INTEGER MODE,TYPE,N,M; ARRAY A[0];                                  00017100
    BEGIN                                                               00017200
DEFINE T64= DI:=LOC T; DI:=DI+1; DS:=7 CHR#;                            00017300
STREAM PROCEDURE WRITERECS(PAGE,A,SKP,NB,NR,NS,RL);                     00017400
    VALUE SKP,NB,NR,NS,RL;                                              00017500
    BEGIN                                                               00017600
    COMMENT -- NS IS THE NUMBER OF WORDS TO SAVE (ON THE                00017700
    TAIL OF THE PAGE);                                                  00017800
    LOCAL T,T1,T2,TT;                                                   00017900
    COMMENT -- MOVE TO POSITION FOR WRITE;                              00018000
    SI:=LOC NB; T64; SI:=PAGE; SKP(SI:=SI+8);                           00018100
    T(2(32(RL(SI:=SI+8)))); NB(RL(SI:=SI+8));                           00018200
    T1:=SI; COMMENT -- RECORDS WILL BE WRITTEN HERE;                    00018300
    COMMENT -- SKIP OVER TO END OF RECORDS TO BE SAVED;                 00018400
    DI:=LOC TT; SI:=LOC NS; DI:=DI+1; DS:=7CHR;                         00018500
    SI:=T1; COMMENT MOVE TO THE END OF THE FIELD TO BE SAVED;           00018600
    TT(2(32(RL(SI:=SI+8)))); NS(RL(SI:=SI+8));                          00018700
    T2:=SI; COMMENT -- END OF FIELD TO BE SAVED;                        00018800
    SI:=LOC NR; T64; DI:=T2;                                            00018900
    T(2(32(RL(DI:=DI+8)))); NR(RL(DI:=DI+8));                           00019000
    SI:=T2; SI:=SI-8; DI:=DI-8;                                         00019100
    TT(2(32(RL(DS:=WDS; SI:=SI-16; DI:=DI-16))));                       00019200
    NS(RL(DS:=WDS; SI:=SI-16; DI:=DI-16));                              00019300
    COMMENT -- HAVE ACCOMPLISHED THE "SAVE", NOW DO THE WRITE;          00019400
    SI:=A; DI:=T1;                                                      00019500
    T(2(32(DS:=RL WDS))); NR(DS:=RL WDS)                                00019600
    END;                                                                00019700
STREAM PROCEDURE READRECS(PAGE,A,SKP,NB,NR,NM,RL);                      00019800
    VALUE SKP,NB,NR,NM,RL;                                              00019900
    BEGIN                                                               00020000
    COMMENT                                                             00020100
        SKP = "SKIP"   - - THE NUMBER OF WORDS TO JUMP OVER             00020200
        NB  = "NUMBER BEFORE" -- "    " RECORDS TO SKIP BEFORE          00020300
              READING THE RECORD,                                       00020400
        NR  = "NUMBER OF RECORDS"  " "  "     "  READ FROM THE          00020500
              BUFFER,                                                   00020600
        NM  ="NUMBER TO MOVE"   - - "   "  "    "  MOVE OVER TO         00020700
              THE PREVIOUSLY READ AREA,                                 00020800
        RL  ="RECORD LENGTH"  -  - THE LENGTH OF EACH ITEM              00020900
        ;                                                               00021000
    LOCAL T,T1,T2;                                                      00021100
    SI:=LOC NB; T64; SI:=PAGE; SKP(SI:=SI+8);                           00021200
    T(2(32(RL(SI:=SI+8)))); NB(RL(SI:=SI+8));                           00021300
    T1:=SI;                                                             00021400
    COMMENT - - T1 NOW HAS THE STARTING POSITION FOR THE READ;          00021500
    SI:=LOC NR; T64; SI:=T1; DI:=A;                                     00021600
    T(2(32(DS:=RL WDS))); NR(DS:=RL WDS);                               00021700
    T2:=SI; COMMENT T2 CONTAINS THE END OF THE READ;                    00021800
    SI:=LOC NM; T64; SI:=T2; DI:=T1;                                    00021900
    T(2(32(DS:=RL WDS))); NM(DS:=RL WDS)                                00022000
    END READRECS;                                                       00022100
DEFINE MOVEALONG=                                                       00022200
    DI:=LOC C; DI:=DI+6; DS:=2CHR; DI:=LOC Z;                           00022300
    TSI:=SI; TALLY:=TALLY+1;                                            00022400
    IF TOGGLE THEN                                                      00022500
        BEGIN SI:=LOC C; SI:=SI+6;                                      00022600
        IF 2 SC NEQ DC THEN                                             00022700
            BEGIN TAL:=TALLY; SI:=LOC TAL; SI:=SI+7;                    00022800
            IF SC="0" THEN                                              00022900
                BEGIN TALLY:=TMP; TALLY:=TALLY+1; TMP:=TALLY;           00023000
                TALLY:=0;                                               00023100
                END ELSE                                                00023200
                BEGIN SI:=LOC Z; IF SC LEQ"9" THEN ;                    00023300
                END                                                     00023400
            END ELSE                                                    00023500
            BEGIN  DI:=TDI; SI:=LOC SIZE; SI:=SI+6; DS:=2CHR;           00023600
            TDI:=DI; SI:=SI-2; DI:=LOC C64; DI:=DI+7 ; DS:=CHR;         00023700
            SI:=NEW; DI:=TDI; C64(2(DS:=32CHR)); DS:=SIZE CHR;          00023800
            TDI:=DI; SI:=TSI; DI:=LOC C; DI:=DI+6;                      00023900
            DS:=2CHR; TSI:=SI;                                          00024000
            TALLY:=TAL;CHRSTORE:=TALLY; SI:=LOC TMP; SI:=SI+7;          00024100
            DI:=LOC CHRSTORE; DI:=DI+6; DS:=CHR END                     00024200
        END;                                                            00024300
    SI:=LOC C; DI:=LOC C64; DI:=DI+1; DS:=7CHR; DI:=TDI; SI:=SI-1;      00024400
    DS:=2CHR; SI:=TSI;                                                  00024500
    C64(2(DS:=32CHR)); DS:=C CHR; TDI:=DI; TSI:=SI#;                    00024600
INTEGER STREAM PROCEDURE CHRSTORE(A,SKP,B,NEW,NB,SIZE,NA,MODE,          00024700
    PAGESIZE); VALUE SKP,NB,SIZE,NA,MODE,PAGESIZE;                      00024800
    BEGIN LOCAL T,C,TSI,TDI,                                            00024900
    Z,C64,TMP,TAL;                                                      00025000
    LABEL DONE;                                                         00025100
    SI:=LOC NB; T64;                                                    00025200
    SI:=LOC MODE; SI:=SI+7;                                             00025300
    IF SC="0" THEN ; COMMENT SET TOGGLE;                                00025400
    SI:=A; DI:=B; SKP(DS:=8CHR);                                        00025500
    TSI:=SI; TDI:=DI;                                                   00025600
    T(2(32(MOVEALONG)));  NB(MOVEALONG);                                00025700
    COMMENT NOW HAVE MOVED UP TO NB;                                    00025800
    IF TOGGLE THEN                                                      00025900
        BEGIN TALLY:=TAL; CHRSTORE:=TALLY; SI:=LOC TMP; SI:=SI+7;       00026000
        DI:=LOC CHRSTORE; DI:=DI+6; DS:=CHR;                            00026100
        SI:=LOC SIZE; SI:=SI+6; DI:=TDI; DS:=2CHR; TDI:=DI;             00026200
        SI:=LOC SIZE; DI:=LOC C64; DI:=DI+1; DS:=7CHR; SI:=NEW;         00026300
        DI:=TDI; C64(2(DS:=32CHR)); DS:=SIZE CHR;                       00026400
        END ELSE                                                        00026500
        BEGIN TSI:=SI; TDI:=DI;                                         00026600
        SI:=LOC MODE; SI:=SI+7;                                         00026700
        IF SC="1" THEN                                                  00026800
        COMMENT REMOVE AN ENTRY HERE;                                   00026900
            BEGIN DI:=LOC C; DI:=DI+6; SI:=TSI; DS:=2CHR;               00027000
            TSI:=SI; DI:=LOC C64; DI:=DI+1; SI:=LOC C;                  00027100
            DS:=7CHR; SI:=TSI;  C64(2(SI:=SI+32)); SI:=SI+C;            00027200
            TSI:=SI; DI:=LOC CHRSTORE; SI:=LOC C; DS:=WDS;              00027300
            DI:=TDI; DS:=2LIT"0"; TDI:=DI;                              00027400
            END ELSE                                                    00027500
        IF SC="2" THEN                                                  00027600
        COMMENT READ OUT AND ENTRY;                                     00027700
            BEGIN DI:=LOC C; DI:=DI+6; SI:=TSI; DS:=2CHR;               00027800
            TSI:=SI; DI:=LOC C64; DI:=DI+1; SI:=LOC C;                  00027900
            DS:=7CHR; SI:=TSI; DI:=NEW;                                 00028000
            C64(2(DS:=32CHR)); DS:=C CHR;                               00028100
            SI:=LOC C; DI:=LOC CHRSTORE; DS:=WDS; GO DONE END;          00028200
        SI:=LOC NA; T64; SI:=TSI; DI:=TDI;                              00028300
        T(2(32(TDI:=DI; DI:=LOC C; DI:=DI+6; DS:=2CHR;                  00028400
        TSI:=SI; SI:=LOC C; DI:=LOC C64; DI:=DI+1; DS:=7CHR;            00028500
    SI:=SI-1;DI:=TDI;DS:=2CHR;SI:=TSI;C64(2(DS:=32CHR));DS:=C CHR)));   00028600
        NA( TDI:=DI; DI:=LOC C; DI:=DI+6; DS:=2CHR; TSI:=SI;            00028700
        SI:=LOC C;DI:=LOC C64;DI:=DI+1;DS:=7CHR;SI:=SI-1;               00028800
        DI:=TDI;DS:=2CHR;SI:=TSI;C64(2(DS:=32CHR));DS:=C CHR);          00028900
        END;                                                            00029000
    SI:=LOC PAGESIZE; T64; SI:=B; DI:=A;                                00029100
%CARD LIST UNSAFE                                                       00029200
COMMENT $CARD LIST UNSAFE;                                              00029300
    T(2(DS:=32WDS)); DS:=PAGESIZE WDS;                                  00029400
%CARD LIST SAFE                                                         00029500
COMMENT $CARD LIST SAFE;                                                00029600
    DONE:                                                               00029700
    END;                                                                00029800
STREAM PROCEDURE SETNTH(P,K,N); VALUE K,N;                              00029900
    BEGIN DI:=P; SI:=LOC K; N(DI:=DI+8); DS:=WDS END;                   00030000
BOOLEAN STREAM PROCEDURE LESS(A,AN,B,BN,K); VALUE K,AN,BN;              00030100
    BEGIN                                                               00030200
    SI:=A; DI:=B; SI:=SI+AN; DI:=DI+BN;                                 00030300
    IF K SC LSS DC THEN TALLY:=1;                                       00030400
    LESS:=TALLY;                                                        00030500
    END;                                                                00030600
REAL STREAM PROCEDURE ADDD(A,B); VALUE A,B;                             00030700
    BEGIN SI:=LOC A; DI:=LOC B; DS:=8ADD; SI:=LOC B;                    00030800
    DI:=LOC ADDD; DS:=WDS                                               00030900
    END;                                                                00031000
INTEGER PROCEDURE FREEPAGE(INDEX,TYPEZERO,START,FINISH);                00031100
    VALUE TYPEZERO,START,FINISH; INTEGER TYPEZERO,START,FINISH;         00031200
    ARRAY INDEX[0,0];                                                   00031300
    IF START GTR FINISH THEN MESSAGE(2) ELSE                            00031400
    BEGIN ARRAY T[0:RECSIZE+EXTRAROOM+SKIP-1],P[0:FINISH-START];        00031500
    INTEGER I,J,K,R;                                                    00031600
    R:=RECSIZE+EXTRAROOM+SKIP;                                          00031700
    J:=START-(FINISH+1);                                                00031800
    FOR I:=FINISH STEP -1 UNTIL TYPEZERO DO                             00031900
        IF K:=(I+J) LSS TYPEZERO THEN                                   00032000
            BEGIN T[R-1]:=P[TYPEZERO-K-1];                              00032100
            MOVE(T,R,INDEX[I,0])                                        00032200
            END ELSE                                                    00032300
            BEGIN IF I GEQ START THEN P[FINISH-I]:=INDEX[I,R-1];        00032400
            MOVE(INDEX[K,0],R,INDEX[I,0]);                              00032500
            END;                                                        00032600
    FREEPAGE:=TYPEZERO-J;                                               00032700
    END;                                                                00032800
INTEGER PROCEDURE SEARCHL(A,B,N,MIN,MAX,NP); VALUE N,MIN,MAX;           00032900
    INTEGER N,MIN,MAX,NP;                                               00033000
    ARRAY A[0,0]; REAL B;                                               00033100
    BEGIN                                                               00033200
    INTEGER I,T;                                                        00033300
    FOR I:=MIN STEP 1 WHILE T:=T+A[I,0].CF LEQ B AND I LSS MAX-1 DO;    00033400
    IF T LSS B THEN                                                     00033500
        BEGIN MESSAGE(3); SEARCHL:=NP:=0;                               00033600
        END ELSE                                                        00033700
        BEGIN SEARCHL:=I; NP:=B-T+A[I,0].CF                             00033800
        END                                                             00033900
    END;                                                                00034000
PROCEDURE SORT(A,P,N,C); VALUE P,N,C; INTEGER P,N,C;                    00034100
    ARRAY A[0,0];                                                       00034200
    BEGIN INTEGER R;                                                    00034300
        BEGIN                                                           00034400
        ARRAY T[0:R:=RECSIZE+EXTRAROOM+SKIP-1];                         00034500
        LABEL ENDJ;                                                     00034600
        INTEGER I,J,L,K,M,SK; R:=R+1;                                   00034700
        SK:=SKIP TIMES 8;                                               00034800
        K:=N-P+1; I:=1; DO UNTIL (I:=I TIMES 2) GTR K;                  00034900
        M:=I-1;                                                         00035000
        WHILE (M:=M DIV 2) NEQ 0 DO                                     00035100
            BEGIN K:=N-M; J:=P;                                         00035200
            DO  BEGIN                                                   00035300
                L:=(I:=J)+M;                                            00035400
                DO BEGIN                                                00035500
                IF A[L,0].TF GTR A[I,0].TF THEN GO ENDJ;                00035600
                IF A[L,0].TF EQL A[I,0].TF THEN                         00035700
                    IF NOT(LESS(A[L,0],SK,A[I,0],SK,C)) THEN            00035800
                    GO ENDJ;                                            00035900
                    MOVE(A[L,0],R,T); MOVE(A[I,0],R,A[L,0]);            00036000
                    MOVE(T,R,A[I,0])                                    00036100
                    END UNTIL (I:=(L:=I)-M) LSS P;                      00036200
                ENDJ:                                                   00036300
                END UNTIL (J:=J+1) GTR K;                               00036400
            END                                                         00036500
        END                                                             00036600
    END SORT;                                                           00036700
    COMMENT - - - - - - - - - - - - - - - - - - - - - - - - - -         00036800
            MODE                            MEANING                     00036900
            ----                            -------                     00037000
             1 =                            INTERROGATE TYPE            00037100
             2 =                     INSERT RECORD REL ADDRS N          00037200
                                     (RELATIVE TO START OF LAST PAGE)   00037300
             3 =                     RETURN THE NUMBER OF RECORDS (M)   00037400
             4 =                       "    ITEM AT RECORD # N          00037500
             5 =                     INSERT  "    "    "   " "          00037600
             6 =                     DELETE  "    "    "   " "          00037700
             7 =                     SEARCH FOR THE RECORD -A-          00037800
             8 =                     FILE OVERFLOW, INCREASE BY N       00037900
             9 =                     FILE MAINTENANCE                   00038000
            10 =                     EMERGENCY FILE MAINTENANCE         00038100
             11                      SET STORAGE KIND                   00038200
           12=                      ALTER STORAGE ALLOCATION RESOURCES  00038300
           13=                      RELEASE "TYPE" STORAGE TO SYSTEM    00038400
           14=                      CLOSE ALL PAGES FOR AREA TRANSITION 00038500
    NOTE THAT WHEN SEQUENTIAL STORAGE MAINTENANCE IS DONE, N            00038600
    WILL ALWAYS INDICATE THE ADDRESS OF THE STRING RELATIVE TO          00038700
    THE TYPE SPECIFIED, AND M WILL ALWAYS BE THE LENGTH OF THE          00038800
    STRING IN -A- (EITHER AS INPUT OR OUTPUT)                           00038900
    ;                                                                   00039000
    PROCEDURE UPDATE(T,L,U,D); VALUE L,U,D; INTEGER L,U,D;              00039100
        ARRAY T[0];                                                     00039200
        BEGIN INTEGER I,J,K;                                            00039300
        FOR I:=L STEP 1 UNTIL U DO                                      00039400
            BEGIN J:=T[I].AF+D; T[I].AF:=J;                             00039500
            J:=T[I].BF+D; T[I].BF:=J                                    00039600
            END                                                         00039700
        END;                                                            00039800
    OWN INTEGER CURPAGE,NPAGES,NTYPES,P,PS,U,L;                         00039900
    OWN INTEGER FIRST,AVAIL,MAXBUFF,CURBUFF;                            00040000
REAL GT1;                                                               00040100
LABEL MOREPAGES;                                                        00040200
COMMENT                                                                 00040300
IF MEMBUG.[21:1] THEN DUMPMEMORY(MODE,TYPE,N,M);                        00040400
IF MODE=8 THEN NPAGES:=NPAGES+N;                                        00040500
MOREPAGES:                                                              00040600
    BEGIN                                                               00040700
    OWN BOOLEAN POINTERSET, TYPESET;                                    00040800
    INTEGER I, T, NR;                                                   00040900
    OWN ARRAY BUF[0:MBUFF], TYPS[0:511];                                00041000
        OWN ARRAY INDX[0:NPAGES,0:RECSIZE+EXTRAROOM+SKIP-1];            00041100
    PROCEDURE SETTYPES;                                                 00041200
    BEGIN INTEGER I, T;                                                 00041300
         FOR I := 0 STEP 1 UNTIL NPAGES DO                              00041400
         IF INDX[I,0].TF NEQ T THEN                                     00041500
         BEGIN                                                          00041600
              TYPS[T].BF := I; TYPS[T:=INDX[I,0].TF].AF := I;           00041700
              TYPS[T].BOOL := INDX[I,0].MF;                             00041800
         END;                                                           00041900
         TYPS[T].BF := I;                                               00042000
    END SETTYPES;                                                       00042100
    REAL PROCEDURE BUFFNUMBER(I); VALUE I; INTEGER I;                   00042200
        BEGIN INTEGER K,L,M;                                            00042300
        LABEL D;                                                        00042400
        DEFINE B=BUF#;                                                  00042500
        IF( IF K:=INDX[I,P].BUFF=0 THEN TRUE ELSE BUF[K].PAGEF          00042600
            NEQ INDX[I,P].PAGEF+1) THEN                                 00042700
            BEGIN IF NULL(K:=CDR(AVAIL)) THEN                           00042800
                BEGIN K:=CDR(FIRST);                                    00042900
                WHILE M:=CDR(B[K]) NEQ 0 DO                             00043000
                    BEGIN L:=K; K:=M; END;                              00043100
                RPLACD(B[L],0);                                         00043200
                IF BOOLEAN(B[K].CHANGEDBIT) THEN                        00043300
                    WRITE(POINTERS[K][B[K].PAGEF-1]);                   00043400
                B[K].CHANGEDBIT:=0;                                     00043500
                END ELSE  RPLACD(AVAIL,CDR(B[K]));                      00043600
            B[K].PAGEF:=INDX[I,P].PAGEF+1;                              00043700
            INDX[I,P].BUFF:=K;                                          00043800
            READ(POINTERS[K][INDX[I,P].PAGEF]);                         00043900
            END ELSE                                                    00044000
            IF CDR(FIRST)=K THEN GO TO D ELSE                           00044100
                BEGIN L:=CDR(FIRST);                                    00044200
                WHILE M:=CDR(B[L]) NEQ K DO L:=M;                       00044300
                RPLACD(B[L],CDR(B[M]));                                 00044400
                END;                                                    00044500
        RPLACD(B[K],CDR(FIRST)); RPLACD(FIRST,K);                       00044600
        D: BUFFNUMBER:=K                                                00044700
        END;                                                            00044800
    PROCEDURE MARK(I); VALUE I; INTEGER I;                              00044900
            BUF[INDX[I,P].BUFF].CHANGEDBIT:=1;                          00045000
BOOLEAN PROCEDURE WRITEBUFFER;                                          00045100
    BEGIN INTEGER I;                                                    00045200
    I:=CDR(FIRST);                                                      00045300
    WHILE NOT NULL(I) DO                                                00045400
        IF BOOLEAN(BUF[I].CHANGEDBIT) THEN                              00045500
        BEGIN WRITEBUFFER:=TRUE;                                        00045600
        BUF[I].CHANGEDBIT:=0;                                           00045700
        WRITE(POINTERS[I][BUF[I].PAGEF-1]);                             00045800
        RPLACD(I,0);                                                    00045900
        END ELSE I:=CDR(BUF[I]);                                        00046000
    END;                                                                00046100
    IF NOT POINTERSET THEN                                              00046200
        BEGIN LABEL EOF;                                                00046300
        READ(POINTERS[1][NPAGES])[EOF];                                 00046400
        IF EOFMARK(SKIP,RECSIZE,POINTERS[1](0))THEN GO TO EOF;          00046500
        MOVE(POINTERS[1](0),1,T);                                       00046600
            COMMENT -- USE T TO DETERMIN THE VARIABLE REC SIZE LATER;   00046700
        MOVE(POINTERS[1](0),RECSIZE+SKIP,INDX[NPAGES,0]);               00046800
            INDX[NPAGES,RECSIZE+1].PAGEF:=NPAGES;                       00046900
            NPAGES:=NPAGES+1;                                           00047000
        GO TO MOREPAGES;                                                00047100
        COMMENT - - INITIALIZE VARIABLES;                               00047200
    EOF: POINTERSET:=TRUE;                                              00047300
    U:=PAGESIZE-SKIP-PAGESPACE;                                         00047400
    L:=(U-ALLOWANCE)/RECSIZE;                                           00047500
    U:=(U+ALLOWANCE+RECSIZE/2)/RECSIZE;                                 00047600
    PS:=(U+L)/2;                                                        00047700
    CURPAGE:=NPAGES:=NPAGES-1;                                          00047800
    CURBUFF:=1;                                                         00047900
    P:=RECSIZE+SKIP;                                                    00048000
    FOR T:=1 STEP 1 UNTIL SBUFF DO RPLACD(BUF[T],T+1);                  00048100
    RPLACD(BUF[SBUFF],0); RPLACD(AVAIL,1);                              00048200
    MAXBUFF:=SBUFF;                                                     00048300
            T:=0;                                                       00048400
    SORT(INDX,0,NPAGES,RECSIZE TIMES 8);                                00048500
    FOR I:=0 STEP 1 UNTIL NPAGES DO                                     00048600
          IF INDX[I,0].TF GTR T THEN T:=INDX[I,0].TF;                   00048700
      NTYPES:=T;                                                        00048800
      END;                                                              00048900
      IF TYPE GTR NTYPES THEN NTYPES:=TYPE;                             00049000
          IF NOT TYPESET THEN                                           00049100
          BEGIN TYPESET:=TRUE; SETTYPES;                                00049200
          COMMENT                                                       00049300
          IF MEMBUG THEN DUMPINDEX(TYPS,NTYPES,INDX,RECSIZE,            00049400
          P);                                                           00049500
          END;                                                          00049600
  COMMENT --- DECIDE WHETHER TO SAVE CURRENT PAGE BEFORE GOING ON;      00049700
  IF MODE=2 THEN                                                        00049800
      BEGIN  MODE:=5; NR:=N                                             00049900
      END ELSE                                                          00050000
  IF MODE GEQ 4 THEN                      %MAY BE FILE MAINTENANCE      00050100
      IF MODE GEQ 8 THEN                  %IS FILE MAINTENANCE          00050200
      ELSE                                %WE MAY BE GOING TO           00050300
      IF MODE NEQ 7 THEN                  %ANOTHER PAGE                 00050400
          BEGIN                                                         00050500
          IF TYPE=0 THEN BEGIN MESSAGE(4); MODE:=0 END ELSE             00050600
          IF TYPS[TYPE].AF=TYPS[TYPE].BF THEN                           00050700
              IF TYPS[0].BF GTR 0 THEN                                  00050800
              BEGIN INTEGER J,K; REAL PG;                               00050900
              K:=TYPS[0].BF-1; TYPS[0].BF:=K; PG:=INDX[K,P];            00051000
              FOR I:=1 STEP 1 UNTIL TYPE-1 DO                           00051100
              IF (T:=TYPS[I]).AF NEQ T.BF THEN                          00051200
                  BEGIN FOR K:=T.AF STEP 1 UNTIL T.BF -1 DO             00051300
                  MOVE(INDX[K,0],P+EXTRAROOM,INDX[K-1,0]);              00051400
                  TYPS[I].AF:=T.AF-1; TYPS[I].BF:=K:=T.BF-1             00051500
                  END;                                                  00051600
              IF CURPAGE GTR TYPS[0].BF THEN                            00051700
                  IF CURPAGE LEQ K THEN CURPAGE:=CURPAGE-1;             00051800
              TYPS[TYPE].BF:=K+1; TYPS[TYPE].AF:=K;                     00051900
              INDX[K,P]:=PG; INDX[K,0]:=0; INDX[K,0].TF:=TYPE;          00052000
              IF TYPS[TYPE].BOOL=1 THEN                                 00052100
                  BEGIN SETNTH(INDX[K,0],0,1); INDX[K,0].MF:=1          00052200
                  END;                                                  00052300
              COMMENT                                                   00052400
              IF MEMBUG.[22:1] THEN DUMPTYPES(MODE,TYPS,NTYPES);        00052500
              MEMORY(MODE,TYPE,A,N,M);  MODE:=0                         00052600
              END ELSE                                                  00052700
              BEGIN T:=1; MEMORY(8,TYPE,A,T,M); MEMORY(MODE,TYPE,A,N,M);00052800
              MODE:=0                                                   00052900
              END ELSE                                                  00053000
      IF NOT( BOOLEAN(TYPS[TYPE].BOOL) AND MODE=5) THEN                 00053100
          CURBUFF:=BUFFNUMBER(CURPAGE:=                                 00053200
              SEARCHL(INDX,N,NPAGES,TYPS[TYPE].AF,TYPS[TYPE].BF,        00053300
                  NR)  );                                               00053400
      COMMENT                                                           00053500
        IF MEMBUG.[23:1] THEN CHECKTYPES(TYPS,NTYPES);                  00053600
          END;                                                          00053700
      COMMENT                                                           00053800
      IF MEMBUG.[20:1] THEN DUMPINDEX(TYPS,NTYPES,INDX,RECSIZE,P);      00053900
      COMMENT                                                           00054000
      IF MEMBUG.[24:1] THEN DUMPBUFF(BUF,FIRST,AVAIL);                  00054100
  CASE MODE OF                                                          00054200
      BEGIN                                                             00054300
      %------- MODE=0 ------- RESERVED ---------------                  00054400
      ;                                                                 00054500
      %------- MODE=1 --------------------------------------------------00054600
      IF M=0 THEN N:=TYPS[TYPE].BOOL ELSE                               00054700
      IF M=1 THEN                                                       00054800
          BEGIN FOR I:=1 STEP 1 UNTIL NTYPES DO                         00054900
          IF (T:=TYPS[I]).AF=T.BF THEN                                  00055000
              BEGIN N:=I; I:=NTYPES+1                                   00055100
              END;                                                      00055200
          IF I=NTYPES+1 THEN N:=NTYPES+1                                00055300
          END;                                                          00055400
      %------- MODE=2 ------- RESERVED ---------------                  00055500
      ;                                                                 00055600
      %------- MODE=3 ------- RETURN THE NUMBER OF RECORDS----          00055700
      BEGIN COMMENT IF TYPE LSS 0 THEN THE TOTAL NUMBER                 00055800
      OF PAGES IS GIVEN, OTHERWISE THE NUMBER OF "TYPE" PAGES IS        00055900
      GIVEN;                                                            00056000
      FOR I:=0 STEP 1 UNTIL NPAGES DO                                   00056100
          IF INDX[I,0].TF=TYPE OR TYPE LSS 0 THEN                       00056200
          NR:=NR+INDX[I,0].CF;                                          00056300
      M:=NR                                                             00056400
      END;                                                              00056500
      %------- MODE=4 ------- RETURN ITEM AT SUBSCRIPT N -----          00056600
      IF NR GEQ INDX[CURPAGE,0].CF THEN MESSAGE(3) ELSE                 00056700
      IF BOOLEAN (TYPS[TYPE].BOOL) THEN COMMENT SEQUENTIAL STORAGE;     00056800
         BEGIN ARRAY B[0:PAGESIZE];                                     00056900
         M:=CHRSTORE(POINTERS[CURBUFF](0),2,B,A,NR,0,0,2,0);            00057000
         END ELSE                                                       00057100
     BEGIN                                                              00057200
     M:=RECSIZE|8;                                                      00057300
     READRECS(POINTERS[CURBUFF](0),A,SKIP,NR,1,0,RECSIZE);              00057400
     END;                                                               00057500
     %------- MODE=5 ------- INSERT ITEM AT SUBSCRIPT N;                00057600
     BEGIN INTEGER K,J,S; REAL PG;                                      00057700
     IF BOOLEAN(TYPS[TYPE].BOOL) THEN                                   00057800
     COMMENT FIND A PLACE FOR THE CHARACTER STRING OF LENGTH            00057900
     M;                                                                 00058000
     IF M GTR (PAGESIZE-SKIP-1)|8-2 THEN MESSAGE(5) COMMENT             00058100
     THIS CHARACTER STRING IS TOO LONG ; ELSE                           00058200
         BEGIN ARRAY C[0:PAGESIZE];                                     00058300
         STREAM PROCEDURE ADDZERO(CHARS,POINTER); VALUE CHARS;          00058400
             BEGIN LOCAL T;                                             00058500
             SI:=LOC CHARS; DI:=LOC T; DI:=DI+1; DS:=7CHR;              00058600
             DI:=POINTER; T(2(DI:=DI+32)); CHARS(DI:=DI+1);             00058700
             DS:=2LIT"0";                                               00058800
             END;                                                       00058900
         BOOLEAN B,NOTLASTPAGE;                                         00059000
         LABEL TRYITAGAIN;                                              00059100
         TRYITAGAIN:                                                    00059200
         FOR I:=(T:=TYPS[TYPE]).AF STEP 1 WHILE I LSS T.BF AND          00059300
         NOT B DO                                                       00059400
             IF NOT(B:=((PAGESIZE-SKIP-1)|8-(GT1:=INDX[I,0]).SF)GEQ M+2 00059500
             AND NOT BOOLEAN(GT1.FF)) THEN S:=S+GT1.CF ELSE I:=I-1;     00059600
         NOTLASTPAGE:=B AND I NEQ T.BF-1;                               00059700
         COMMENT IF B IS TRUE, THEN A PAGE HAS BEEN FOUND;              00059800
         IF NOT B THEN COMMENT GET A PAGE THAT IS FREE;                 00059900
             BEGIN                                                      00060000
             COMMENT                                                    00060100
             IF MEMBUG.[5:1] THEN DUMPTYPES(5,1,TYPS,NTYPES);           00060200
                 IF TYPS[0].BF=0 THEN BEGIN K:=CURPAGE; T:=1;           00060300
                 MEMORY(8,TYPE,A,T,M); CURPAGE:=K+1                     00060400
                 END                                                    00060500
             ELSE                                                       00060600
             IF (PAGESIZE-SKIP-1)|8-INDX[(I:=I-1)-1,0].SF GTR 2 THEN    00060700
                 BEGIN                                                  00060800
                 CURBUFF:=BUFFNUMBER(CURPAGE:=I-1);                     00060900
                 ADDZERO((GT1:=INDX[CURPAGE,0].SF)+8|(SKIP+1),POINTERS  00061000
                     [CURBUFF](0));                                     00061100
                 INDX[CURPAGE,0].SF:=GT1+2;                             00061200
                 INDX[CURPAGE,0].CF:=INDX[CURPAGE,0].CF+1;              00061300
                 COMMENT SINCE ALLOCATING A NEW PAGE, SET COUNT TO      00061400
                 ONE MORE AND FREEZE THE COUNT;                         00061500
                 S:=S+1; % SINCE THE COUNT INCREASED                    00061600
                 MOVE(INDX[CURPAGE,0],SKIP+1,POINTERS[CURBUFF](0));     00061700
                 MARK(CURPAGE);                                         00061800
                 END;                                                   00061900
             T:=TYPS[0].BF; TYPS[0].BF:=T:=T-1;                         00062000
             COMMENT T IS THE SUBSCRIPT INTO THE NEW PAGE;              00062100
             PG:=INDX[T,P]; COMMENT PG HOLDS THE NEW PAGE #;            00062200
             FOR K:=T+1 STEP 1 UNTIL I DO                               00062300
                 MOVE(INDX[K,0],RECSIZE+SKIP+EXTRAROOM,INDX[K-1,0]);    00062400
             T:=TYPS[TYPE].AF; TYPS[TYPE].AF:=T-1;                      00062500
             INDX[I,P]:=PG; UPDATE(TYPS,1,TYPE-1,-1);                   00062600
             IF CURPAGE GTR TYPS[0].BF THEN IF CURPAGE LEQ              00062700
                 I THEN CURPAGE:=CURPAGE-1;                             00062800
             INDX[I,0]:=0; INDX[I,0].MF:=1; INDX[I,0].TF:=TYPE;         00062900
             COMMENT MUST ALSO ASSIGN A NUMBER TO THIS PAGE             00063000
             (TO BE STORED IN THE PAGE) TO KEEP IT IN SEQUENCE          00063100
             WITHIN THIS TYPE;                                          00063200
             IF (T:=TYPS[TYPE]).AF LSS T.BF-1 THEN                      00063300
                 T:=INDX[T.BF-1,1] ELSE T:=0;                           00063400
             SETNTH(INDX[I,0],ADDD(1,T),1);                             00063500
             COMMENT END OF THE INITIALIZATION OF THE INDEX ARRAY,      00063600
             WE STILL HAVE TO MAKE SOME ENTRIES INTO THE PAGE           00063700
             WHICH WE WILL DO BELOW;                                    00063800
             END OF TEST FOR NEW PAGE;                                  00063900
         COMMENT I IS SET TO THE PROPER SUBSCRIPT FOR THE CHR STORE;    00064000
             CURBUFF:=BUFFNUMBER(CURPAGE:=I);                           00064100
         COMMENT NOW THE CORRECT PAGE IS IN CORE.                       00064200
             ------------------------------                             00064300
             M= NUMBER OF CHARACTERS IN A (ON INPUT)                    00064400
             N= ADDRESS OF A WITHIN IN THIS TYPE (ON OUTPUT             00064500
             ------------------------------;                            00064600
         K:=INDX[I,0];                                                  00064700
         T:=CHRSTORE(POINTERS[CURBUFF](0),SKIP+1,C,A,K.CF,M,0,0,        00064800
             PAGESIZE);                                                 00064900
         COMMENT K.CF IS THE NUMBER OF ITEMS ALREADY IN THIS            00065000
         PAGE.  IF THERE IS A SEGMENT WHICH IS NULL, IT WILL            00065100
         BE FOUND AND ASSIGNED AS THE SEG NUMBER FOR                    00065200
         THIS CHARACTER STRING (T).  IF NOT, IT WILL STICK THE          00065300
         STRING ON THE END (WE KNOW THERE IS ENOUGH ROOM                00065400
         SINCE WE CHECKED INDX[I,0].SF -- THE NUMBER OF CHRS USED       00065500
         IN THIS PAGE, OR WE CREATED A NEW PAGE);                       00065600
         N:=S+T; S:=K.SF; COMMENT S CONTAINS THE # OF CHRS USED UP;     00065700
         IF T:=T+1 GTR K.CF THEN COMMENT ADDED THE STRING ON THE END;   00065800
             IF NOTLASTPAGE THEN % PAGE ALREADY FULL                    00065900
                 BEGIN S:=0; B:=FALSE; INDX[I,0].FF:=1;                 00066000
                 MOVE(INDX[I,0],SKIP+1,POINTERS[CURBUFF](0));           00066100
                 MARK(CURPAGE); GO TRYITAGAIN; END ELSE                 00066200
             BEGIN K.CF:=T; S:=S+2;                                     00066300
             END                                                        00066400
         ELSE IF T=K.CF AND NOTLASTPAGE THEN INDX[I,0].FF:=1;           00066500
                                                                        00066600
         INDX[I,0].CF:=K.CF; INDX[I,0].SF:=S+M;                         00066700
         MOVE(INDX[I,0],SKIP+1,POINTERS[CURBUFF](0));                   00066800
         MARK(CURPAGE);                                                 00066900
         COMMENT THE PAGE DESCRIPTOR HAS BEEN UPDATED;                  00067000
         COMMENT                                                        00067100
             IF MEMBUG.[5:1] THEN DUMPTYPES(5,2,TYPS,NTYPES);           00067200
         END ELSE COMMENT KIND OF STORAGE IS SORTED;                    00067300
     IF NR GTR (T:=INDX[CURPAGE,0].CF) THEN                             00067400
     COMMENT SUBSCRIPT IS NOT IN THE MIDDLE OF THE PAGE;                00067500
     MESSAGE(6) ELSE                                                    00067600
         BEGIN                                                          00067700
         IF T GEQ U THEN COMMENT WILL EXCEED UPPER PAGE BOUND;          00067800
             BEGIN ARRAY B[0:RECSIZE TIMES                              00067900
             (T-PS+(I:=(IF NR GEQ PS THEN 0 ELSE 1)))-1];               00068000
             COMMENT B IS JUST BIG ENOUGH TO CARRY THE                  00068100
             EXCESS FROM THE OLD PAGE;                                  00068200
             READRECS(POINTERS[CURBUFF](0),B,SKIP,PS-I,                 00068300
                 J:=(T-PS+I),0,RECSIZE);                                00068400
             COMMENT -- B NOW HAS THE EXCESS;                           00068500
             INDX[CURPAGE,0].CF:=T-J; SETNTH(POINTERS[CURBUFF](0),      00068600
             INDX[CURPAGE,0],0);                                        00068700
             MARK(CURPAGE);                                             00068800
             IF TYPS[0].BF=0 THEN                                       00068900
                 BEGIN K:=CURPAGE; T:=1;                                00069000
                 MEMORY(8,TYPE,A,T,M); CURPAGE:=K+1;                    00069100
                 END;                                                   00069200
             COMMENT -- ASSIGN A FREE PAGE (SUBS T);                    00069300
             T:=TYPS[0].BF; TYPS[0].BF:=T:=T-1;                         00069400
                                                                        00069500
             PG:=INDX[T,P];                                             00069600
             FOR K:=T+1 STEP 1 UNTIL CURPAGE DO                         00069700
             MOVE(INDX[K,0],RECSIZE+SKIP+EXTRAROOM,INDX[K-1,0]);        00069800
             INDX[CURPAGE,P]:=PG;                                       00069900
             T:=0;T.CF:=J;T.TF:=TYPE;                                   00070000
             CURBUFF:=BUFFNUMBER(CURPAGE);                              00070100
             WRITERECS(POINTERS[CURBUFF](0),B,SKIP,0,J,0,RECSIZE);      00070200
             SETNTH(POINTERS[CURBUFF](0),T,0);                          00070300
             MOVE(POINTERS[CURBUFF](0),RECSIZE+SKIP,INDX[CURPAGE,0]);   00070400
             MARK(CURPAGE);                                             00070500
             T:=TYPS[TYPE].AF; TYPS[TYPE].AF:=T-1;                      00070600
             UPDATE(TYPS,1,TYPE-1,-1);                                  00070700
             IF J=0 THEN MESSAGE(7);                                    00070800
             IF BOOLEAN (I) THEN                                        00070900
             COMMENT    I=0 IMPLIES THE RECORD GOES TO NEW PAGE,        00071000
                        I=1 IMPLIES THE RECORD GOES TO NOOLD PAGE;      00071100
                 BEGIN                                                  00071200
                 T:=INDX[CURPAGE:=CURPAGE-1,0].CF;                      00071300
                 CURBUFF:=BUFFNUMBER(CURPAGE);                          00071400
                 ; COMMENT OLD PAGE IS NOW BACK;                        00071500
                 END ELSE                                               00071600
                 BEGIN T:=J; NR:=NR-PS                                  00071700
                 END                                                    00071800
             END;                                                       00071900
         WRITERECS(POINTERS[CURBUFF](0),A,SKIP,NR,1,T-NR,RECSIZE);      00072000
         T:=INDX[CURPAGE,0].CF; INDX[CURPAGE,0].CF:=T+1;                00072100
         SETNTH(POINTERS[CURBUFF](0),INDX[CURPAGE,0],0);                00072200
         IF NR=0 THEN MOVE(POINTERS[CURBUFF](0),RECSIZE+SKIP,INDX       00072300
         [CURPAGE,0]);  MARK(CURPAGE);                                  00072400
         END;                                                           00072500
     END;                                                               00072600
     %------- MODE=6 ------- DELETE A RECORD FROM THE FILE ----         00072700
     IF (T:=TYPS[TYPE]).AF=T.BF THEN MESSAGE(12) COMMENT                00072800
     ATTEMPT TO DELETE NON-EXISTENT STORAGE;                            00072900
     ELSE                                                               00073000
     IF NR GEQ(T:=INDX[CURPAGE,0].CF) THEN MESSAGE(13) COMMENT          00073100
     ATTEMPT TO DELETE OUTSIDE STORAGE RANGE; ELSE                      00073200
     IF BOOLEAN(T.BOOL) THEN COMMENT SEQUENTIAL STORAGE;                00073300
         BEGIN COMMENT NR IS THE RECORD TO DELETE;                      00073400
         ARRAY B[0:PAGESIZE-1];                                         00073500
         COMMENT PAGESIZE -1 SHOULD BE COMPUTED TO THE EXACT            00073600
         NUMBER OF WORDS TO MOVE -- IT WOULD SPEED THINGS UP;           00073700
         INTEGER L;                                                     00073800
         T:=INDX[CURPAGE,0]; COMMENT T.CF IS THE NUMBER OF              00073900
         RECORDS ON THIS PAGE, T.SF IS THE NUMBER OF CHRS;              00074000
         L:=CHRSTORE(POINTERS[CURBUFF](0),SKIP+1,B,A,NR,0,T.CF          00074100
         -NR-1,1,PAGESIZE);                                             00074200
         COMMENT WE WILL BRING BACK THE NUMBER OF CHRS IN M;            00074300
         M:=L;                                                          00074400
         MARK(CURPAGE);                                                 00074500
         COMMENT MAKE CHANGES TO THE CHARACTER COUNT;                   00074600
         INDX[CURPAGE,0].SF:=T.SF-L;                                    00074700
         INDX[CURPAGE,0].FF:=0; % PAGE IS CERTAINLY NOT FULL NOW        00074800
         COMMENT AND  WE ARE DONE WITH THE DELETION;                    00074900
         MOVE(INDX[CURPAGE,0],SKIP+1,POINTERS[CURBUFF](0));             00075000
         END                                                            00075100
     ELSE                                                               00075200
     BEGIN ARRAY A[0:RECSIZE-1];                                        00075300
     INDX[CURPAGE,0].CF:=I-1;                                           00075400
     SETNTH(POINTERS[CURBUFF](0),INDX[CURPAGE,0],0);                    00075500
     IF I GTR 1 THEN                                                    00075600
         BEGIN                                                          00075700
         READRECS(POINTERS[CURBUFF](0),A,SKIP,NR,1,I-NR-1,RECSIZE);     00075800
         MARK(CURPAGE);                                                 00075900
         IF NR=0 THEN                                                   00076000
             MOVE(POINTERS[CURBUFF](0),RECSIZE+SKIP,INDX[CURPAGE,0])    00076100
         END ELSE COMMENT FREE THE EMPTY PAGE;                          00076200
         BEGIN MARK(CURPAGE);                                           00076300
         ;TYPS[0].BF:=FREEPAGE(INDX,TYPS[0].BF,CURPAGE,CURPAGE);        00076400
         UPDATE(TYPS,1,TYPE-1,1); TYPS[TYPE].AF:=T.AF+1;                00076500
         COMMENT                                                        00076600
         IF MEMBUG.[6:1] THEN DUMPTYPES(MODE,TYPS,NTYPES);              00076700
         END                                                            00076800
     END;                                                               00076900
     %------- MODE=7 ------- SEARCH FOR A RECORD FROM THE FILE ---      00077000
     IF N GTR 3 THEN MESSAGE(14) ELSE                                   00077100
 COMMENT RETURN RECORD CLOSEST (BUT LESS THAN OR EQUAL TO) TO           00077200
     THE CONTENT OF -A-.  A WILL BE REPLACED BY THE RECORD FOUND;       00077300
     IF BOOLEAN((I:=TYPS[TYPE]).BOOL) THEN                              00077400
     MESSAGE(8) COMMENT BINARY SEARCH OF NON-SEQUENTIAL DATA;           00077500
     ELSE                                                               00077600
     IF I.AF=I.BF THEN MESSAGE(9) COMMENT --NO STORAGE OF               00077700
     THIS TYPE ALLOCATED AS YET;                                        00077800
     ELSE BEGIN                                                         00077900
         INTEGER F,U,L;                                                 00078000
         ARRAY B[0:RECSIZE-1];                                          00078100
         U:=TYPS[TYPE].BF; L:=TYPS[TYPE].AF;                            00078200
         WHILE U-L GTR 1 DO                                             00078300
         IF LESS(A,0,INDX[F:=(U+L) DIV 2,0],8,M) THEN U:=F ELSE L:=F;   00078400
         CURBUFF:=BUFFNUMBER(CURPAGE:=L);                               00078500
         L:=0; U:=INDX[CURPAGE,0].CF;                                   00078600
         IF L-U=0 THEN MESSAGE(10) COMMENT BINARY SEARCH FOUND          00078700
         A PAGE WITH NO RECORDS;                                        00078800
         ELSE BEGIN                                                     00078900
             WHILE U-L GTR 1 DO                                         00079000
             BEGIN READRECS(POINTERS[CURBUFF](0),B,SKIP,                00079100
             F:=(U+L) DIV 2,1,0,RECSIZE);                               00079200
             IF LESS(A,0,B,0,M) THEN U:=F ELSE L:=F                     00079300
             END;                                                       00079400
             COMMENT -----------------------------------                00079500
             ON INPUT:                                                  00079600
                 N=0    IMPLIES    DO NOT PLACE RECORD INTO FILE        00079700
                                   IF RECORD IS FOUND. RETURN RELA-     00079800
                                   TIVE POSITION OF THE CLOSEST RECORD  00079900
                                   IN THIS PAGE.                        00080000
                 N=1      "        DO NO PLACE IN FILE. RETURN ABSO-    00080100
                                   LUTE SUBSCRIPT OF CLOSSEST RECORD.   00080200
                 N=2      "        PLACE RECORD INTO FILE IF NOT FOUND. 00080300
                                   RETURN RELATIVE POSITION OF RECORD.  00080400
                 N=3      "        PLACE RECORD INTO FILE, IF NOT       00080500
                                   FOUND, RETURN ABS SUBSCRIPT OF       00080600
                                   THE RECORD.                          00080700
            ON OUTPUT:                                                  00080800
                 M=0      "        RECORD FOUND WAS EQUAL TO RECORD     00080900
                                   SOUGHT.                              00081000
                 M=1      "        RECORD FOUND WAS GREATER THAN THE    00081100
                                   SOUGHT.                              00081200
                 M=2      "        RECORD FOUND WAS LESS THAN THE       00081300
                                   RECORD SOUGHT.                       00081400
;                                                                       00081500
             READRECS(POINTERS[CURBUFF](0),B,SKIP,L,1,0,RECSIZE);       00081600
             IF LESS(A,0,B,0,M) THEN M:=1 ELSE                          00081700
                 IF LESS(B,0,A,0,M) THEN M:=2 ELSE                      00081800
                 M:=0;                                                  00081900
             T:=0; IF BOOLEAN(N) THEN                                   00082000
                 FOR I:=TYPS[TYPE].AF STEP 1 UNTIL CURPAGE-1 DO         00082100
                 T:=T+INDX[I,0].CF;                                     00082200
             IF N GTR 1 THEN IF M GEQ 1 THEN                            00082300
                 MEMORY(2,TYPE,A,L+M-1,NR);                             00082400
             MOVE(B,RECSIZE,A);                                         00082500
             N:=T+L;                                                    00082600
             END                                                        00082700
         END;                                                           00082800
     %------- MODE=8 ------- FILE OVERFLOW, FIX ARRAYS AND PAGES        00082900
         BEGIN BOOLEAN TOG;                                             00083000
               ARRAY A[0:PAGESIZE-1]; T:=NPAGES-N+1;                    00083100
         IF TOG:=(T DIV AREASIZE) LSS (NPAGES DIV AREASIZE ) OR         00083200
             (T=NPAGES AND T MOD AREASIZE =0) THEN                      00083300
             MEMORY(14,TYPE,A,N,M);                                     00083400
         FOR I:=T STEP 1 UNTIL NPAGES DO                                00083500
         BEGIN WRITE(NEWDISK[I],PAGESIZE,A[*]);INDX[I,P].PAGEF:=I END;  00083600
         MARKEOF(SKIP,RECSIZE,NEWDISK(0));                              00083700
         WRITE(NEWDISK[I]);                                             00083800
         TYPS[0].BF:=FREEPAGE(INDX,TYPS[0].BF,T,NPAGES);                00083900
         UPDATE(TYPS,1,NTYPES,NPAGES-T+1);                              00084000
         IF TOG THEN CLOSE(NEWDISK);                                    00084100
         END;                                                           00084200
     %------- MODE=9 ------- FILE MAINTENANCE ------------------        00084300
     BEGIN BOOLEAN ITHPAGEIN;                                           00084400
     INTEGER I,J,K,T1,T2,T3,M,W,Q;                                      00084500
     ARRAY A,B[0:PAGESIZE-1];                                           00084600
     COMMENT                                                            00084700
     MONITOR PRINT(Q,W,N, I,J,K,T1,T2,T3,M,A,B);                        00084800
     IF I:=TYPS[0].BF LEQ NPAGES THEN                                   00084900
     DO                                                                 00085000
         BEGIN COMMENT OUTER "DO-LOOP" TO FIND TROUBLE WITH             00085100
         THE FILE;                                                      00085200
         IF T1:=(Q:=INDX[I,0]).CF LSS L THEN COMMENT MAY BE CORRECTABLE;00085300
             IF NOT BOOLEAN((Q:=TYPS[Q.TF]).BOOL) THEN                  00085400
             COMMENT -- THIS PAGE IS CORRECTABLE;                       00085500
                 IF I NEQ NPAGES THEN                                   00085600
                 COMMENT -- THIS IS NOT THE LAST PAGE OF THE FILE;      00085700
                     IF (J:=I+1) LSS Q.BF THEN                          00085800
                     COMMENT -- THIS IS NOT THE LAST PAGE OF THIS TYPE; 00085900
                     BEGIN COMMENT -- FIND RECORDS TO MOVE INTO         00086000
                     THIS PAGE;                                         00086100
                     DO IF T2:=INDX[J,0].CF GTR 0 THEN                  00086200
                     COMMENT THIS PAGE HAS RECS TO MOVE;                00086300
                         BEGIN COMMENT HOW MANY;                        00086400
                         IF T2 LSS K:=PS-T1 THEN K:=T2;                 00086500
                         IF NOT ITHPAGEIN THEN                          00086600
                             BEGIN COMMENT BRING IN PAGE I;             00086700
                             MOVE(POINTERS[BUFFNUMBER(I)](0),           00086800
                             PAGESIZE,B); ITHPAGEIN:=TRUE               00086900
                             END;                                       00087000
                         COMMENT -- BRING IN PAGE J;                    00087100
                         CURBUFF:=BUFFNUMBER(CURPAGE:=J);               00087200
                         COMMENT -- MOVE SOME INTO A;                   00087300
                         READRECS(POINTERS[CURBUFF](0),A,SKIP,0,K,      00087400
                         T2:=T2-K,RECSIZE); INDX[J,0].CF:=T2;           00087500
                         IF T2=0 THEN                                   00087600
                             COMMENT SET THIS PAGE FREE;                00087700
                             INDX[J,0]:=0;                              00087800
                         SETNTH(POINTERS[CURBUFF](0),INDX[J,0],0);      00087900
                         MOVE(POINTERS[CURBUFF](0),RECSIZE+SKIP,INDX[J  00088000
                         ,0]); MARK(CURPAGE);                           00088100
                         COMMENT -- PUT THE RECORDS INTO PAGE I;        00088200
                         WRITERECS(B,A,SKIP,T1,K,0,RECSIZE);            00088300
                         END                                            00088400
                        ELSE K:=0 COMMENT SINCE NO CONTRI-              00088500
                        BUTION;                                         00088600
                     UNTIL T1:=T1+K GEQ PS OR J:=J+1 GEQ Q.BF;          00088700
                     INDX[I,0].CF:=T1; B[0]:=INDX[I,0];                 00088800
                     COMMENT -- PUT THE PAGE BACK OUT ON DISK;          00088900
                     MOVE(B,RECSIZE+SKIP,INDX[I,0]);                    00089000
                     MOVE(B,PAGESIZE,POINTERS[CURBUFF:=BUFFNUMBER       00089100
                     (I)](0)); SORT(INDX,0,NPAGES,RECSIZE|8);           00089200
                     MARK(CURPAGE:=I); SETTYPES;                        00089300
                     N:=1;                                              00089400
                     END                                                00089500
                     ELSE N:=0 COMMENT LAST PAGE OF THIS TYPE;          00089600
                 ELSE N:=0 COMMENT LAST PAGE OF FILE;                   00089700
             ELSE N:=0 COMMENT PAGE CANNOT BE CHANGED;                  00089800
         ELSE N:=0 COMMENT THIS PAGE IS NOT TOO SMALL;                  00089900
         END UNTIL I:=I+1 GTR NPAGES OR N NEQ 0 ELSE N:=0;              00090000
    IF I GTR NPAGES THEN N:=REAL(WRITEBUFFER);                          00090100
    END OF FILE UPDATE;                                                 00090200
    %------- MODE=10 ------EEMERGENCY FILE MAINTENANCE -------          00090300
    DO MEMORY(9,TYPE,A,N,M) UNTIL N NEQ 1                               00090400
    %------- MODE=11 ------- SET THE KIND OF STORAGE FOR TYPE ----------00090500
   ;COMMENT  TYPE "TYPE" STORAGE IS BEING SET TO SEQUENTIAL;            00090600
    IF TYPE=0 THEN MESSAGE(4) ELSE                                      00090700
    IF (T:=TYPS[TYPE]).AF= T.BF THEN TYPS[TYPE].BOOL:=1 ELSE            00090800
    MESSAGE(15); COMMENT ATTEMPT TO CHANGE KINDS IN MIDSTREAM;          00090900
%------- MODE=12 ----------- ALTER STORAGE ALLOCATION RESOURCES---      00091000
    COMMENT N IS THE "FACTOR" (PERCENT OF RESOURCES | 100),             00091100
    AND M IS THE STORAGE "LEVEL" (0 IS THE ONLY ONE THAT                00091200
    DOES ANYTHING ON THE B5500);                                        00091300
    BEGIN INTEGER J,K;                                                  00091400
    BOOLEAN TOG;                                                        00091500
    IF T:=N|(MBUFF-1)/100+1 GTR MAXBUFF THEN                            00091600
        BEGIN COMMENT ADD TO AVAILABLE LIST;                            00091700
        FOR I:=CDR(FIRST),CDR(AVAIL) DO                                 00091800
        WHILE NOT NULL(I) DO                                            00091900
            BEGIN BUF[I].FLAGB:=1; I:=CDR(BUF[I]);                      00092000
            END;                                                        00092100
        FOR I:=MAXBUFF+1 STEP 1 UNTIL T DO                              00092200
            BEGIN WHILE BUF[K:=K+1].FLAGB=1 DO;                         00092300
            BUF[K]:=0; RPLACD(BUF[K],CDR(AVAIL));                       00092400
            RPLACD(AVAIL,K)                                             00092500
            END;                                                        00092600
        MAXBUFF:=T;                                                     00092700
        FOR I:=1 STEP 1 UNTIL MBUFF DO BUF[I].FLAGB:=0;                 00092800
        END ELSE                                                        00092900
    IF T LSS MAXBUFF THEN                                               00093000
        BEGIN COMMENT CUT DOWN ON THE NUMBER OF BUFFERS;                00093100
        I:=CDR(FIRST);                                                  00093200
        FOR J:=1 STEP 1 UNTIL MAXBUFF DO                                00093300
            IF TOG THEN                                                 00093400
                IF NOT NULL(I) THEN                                     00093500
                    IF J GEQ T THEN                                     00093600
                        BEGIN K:=CDR(BUF[I]); BUF[I]:=0                 00093700
                        ; I:=K END                                      00093800
                    ELSE I:=CDR(BUF[I])                                 00093900
                ELSE                                                    00094000
            ELSE                                                        00094100
            IF TOG:=NULL(I) THEN                                        00094200
                BEGIN J:=J-1; I:=CDR(AVAIL)                             00094300
                END                                                     00094400
            ELSE                                                        00094500
                IF J EQL T THEN                                         00094600
                    BEGIN K:=CDR(BUF[I]); RPLACD(BUF[I],0);             00094700
                    I:=K END ELSE                                       00094800
                IF J GTR T THEN                                         00094900
                    BEGIN                                               00095000
                    IF BOOLEAN(BUF[I].CHANGEDBIT) THEN                  00095100
                        WRITE(POINTERS[I][BUF[I].PAGEF-1]);             00095200
                    K:=CDR(BUF[I]);                                     00095300
                    CLOSE(POINTERS[I]);                                 00095400
                    BUF[I]:=0; I:=K                                     00095500
                    END ELSE I:=CDR(BUF[I])                             00095600
                ;                                                       00095700
        MAXBUFF:=T                                                      00095800
        END;                                                            00095900
    END;                                                                00096000
    %------- MODE=13 ------- RELEASE "TYPE" STORAGE TO SYSTEM ----------00096100
    IF (T:=TYPS[TYPE]).BF GTR T.AF THEN                                 00096200
        BEGIN INTEGER J;                                                00096300
        J:=T.BF-1;                                                      00096400
        FOR I:=T.AF STEP 1 UNTIL J DO                                   00096500
            BEGIN CURBUFF:=BUFFNUMBER(I);                               00096600
            SETNTH(POINTERS[CURBUFF](0),0,0); MARK(CURPAGE:=I);         00096700
            END;                                                        00096800
        TYPS[0].BF:=FREEPAGE(INDX,TYPS[0].BF,T.AF,J);                   00096900
        UPDATE(TYPS,1,TYPE-1,J-T.AF+1);                                 00097000
        TYPS[TYPE].BF:=T.AF;  TYPS[TYPE].BOOL:=0;                       00097100
        END;                                                            00097200
    %------- MODE=14 ------ RELEASE ALL PAGES FOR TRANSITION -----------00097300
    BEGIN INTEGER K;                                                    00097400
    I:=CDR(FIRST);                                                      00097500
    WHILE NOT NULL(I) DO                                                00097600
        BEGIN IF BOOLEAN(BUF[I].CHANGEDBIT ) THEN WRITE(POINTERS[I]     00097700
            [BUF[I].PAGEF-1]);  CLOSE(POINTERS[I]);                     00097800
        K:=CDR(BUF[I]);  BUF[I]:=0;                                     00097900
        RPLACD(BUF[I],CDR(AVAIL)); RPLACD(AVAIL,I); I:=K                00098000
        END  ; CURPAGE:=CURBUFF:=-1; RPLACD(FIRST,0);                   00098100
    END;                                                                00098200
    END OF CASE STMT;                                                   00098300
                                                                        00098400
END OF INNER BLOCK;                                                     00098500
END OF PROCEDURE;                                                       00098600
INTEGER QM,QN;                                                          00098700
ARRAY QA[0:0];                                                          00098800
PROCEDURE NAME(MFID,FID); VALUE MFID,FID; REAL MFID,FID;                00098900
    BEGIN INTEGER I; FILL NEWDISK WITH MFID,FID;                        00099000
    FOR I:=0 STEP 1 UNTIL MBUFF DO                                      00099100
        FILL POINTERS[I] WITH MFID,FID;                                 00099200
    FILL ESTABLISH WITH MFID,FID;                                       00099300
    SETPOINTERNAMES                                                     00099400
    END;                                                                00099500
PROCEDURE SEQUENTIAL(UNIT); VALUE UNIT; INTEGER UNIT;                   00099600
    MEMORY(11,UNIT,QA,QN,QM);                                           00099700
INTEGER PROCEDURE CONTENTS(UNIT,N,AR); VALUE UNIT,N;                    00099800
    INTEGER UNIT,N; ARRAY AR[0];                                        00099900
    BEGIN                                                               00100000
    MEMORY(4,UNIT,AR,N,QM); CONTENTS:=QM;                               00100100
    END;                                                                00100200
PROCEDURE DELETE1(UNIT,N); VALUE UNIT,N; INTEGER UNIT,N;                00100300
    MEMORY(6,UNIT,QA,N,QM);                                             00100400
INTEGER PROCEDURE SEARCHORD(UNIT,REC,LOC,M); VALUE UNIT,M;              00100500
    INTEGER UNIT,LOC,M; ARRAY REC[0];                                   00100600
    BEGIN LOC:=1;                                                       00100700
    MEMORY(7,UNIT,REC,LOC,M);                                           00100800
    SEARCHORD:=M;                                                       00100900
    END;                                                                00101000
PROCEDURE STOREORD(UNIT,REC,N); VALUE UNIT,N; INTEGER UNIT,N;           00101100
    ARRAY REC[0];                                                       00101200
    MEMORY(5,UNIT,REC,N,QM);                                            00101300
PROCEDURE STOREORDR(UNIT,REC,N); VALUE UNIT,N; INTEGER UNIT,N;          00101400
    ARRAY REC[0];                                                       00101500
    MEMORY(2,UNIT,REC,N,QM);                                            00101600
BOOLEAN PROCEDURE MAINTENANCE;                                          00101700
    BEGIN MEMORY(9,0,QA,QN,QM); MAINTENANCE:=QN=1                       00101800
    END;                                                                00101900
PROCEDURE WRAPUP; MEMORY(10,0,QA,QN,QM);                                00102000
INTEGER PROCEDURE STORESEQ(UNIT,REC,N); VALUE UNIT,N; INTEGER UNIT, N;  00102100
    ARRAY REC[0];                                                       00102200
    BEGIN                                                               00102300
    MEMORY(5,UNIT,REC,QN,N); STORESEQ:=QN;                              00102400
    END;                                                                00102500
PROCEDURE DELETEN(UNIT,N,M); VALUE UNIT,N,M; INTEGER UNIT,N,M;          00102600
    BEGIN M:=M-N;                                                       00102700
    DO MEMORY(6,UNIT,QA,N,QM) UNTIL M:=M-1 LSS 0;                       00102800
    END;                                                                00102900
INTEGER PROCEDURE NEXTUNIT;                                             00103000
    BEGIN MEMORY(1,0,QA,QN,1); NEXTUNIT:=QN                             00103100
    END;                                                                00103200
INTEGER PROCEDURE SIZE(UNIT); VALUE UNIT; INTEGER UNIT;                 00103300
    BEGIN MEMORY(3,UNIT,QA,QN,QM); SIZE:=QM                             00103400
    END;                                                                00103500
PROCEDURE ALLOCATE(J,FACTOR); VALUE J,FACTOR; INTEGER J;                00103600
    REAL FACTOR;                                                        00103700
    BEGIN                                                               00103800
    QN:=ENTIER( ABS( (FACTOR | 100) MOD 101));                          00103900
    MEMORY(12,0,QA,QN,J)                                                00104000
    END;                                                                00104100
PROCEDURE RELEASEUNIT(UNIT); VALUE UNIT; INTEGER UNIT;                  00104200
    MEMORY(13,UNIT,QA,QN,QM);                                           00104300
DEFINE                                                                  00104400
    ALLOWQUESIZE=4#,                                                    00104500
    ACOUNT=ACCUM[0].[1:11]#,                                            00104600
    DATADESC=[1:1]#,                                                    00104700
    SCALAR=[4:1]#,                                                      00104800
    NAMED=[3:1]#,                                                       00104900
    CHRMODE=[5:1]#,                                                     00105000
    CHECKT=5#,   % NUMBER OF TIMES THRU EXECUTE BEFORE CHECK            00105100
    CCIF=18:36:12#,                                                     00105200
    CDID=1:43:5#,                                                       00105300
    CSPF=30:30:18#,                                                     00105400
    CRF=24:42:6#,                                                       00105500
    CLOCF=6:30:18#,                                                     00105600
    PF=[1:17]#,                                                         00105700
    XEQMODE=1#,                                                         00105800
    FUNCMODE=2#,                                                        00105900
    CALCMODE=0#,                                                        00106000
    INPUTMODE=3#,                                                       00106100
    ERRORMODE=4#,                                                       00106200
    FUNCTION=1#,                                                        00106300
    CURRENTMODE = PSRM[0]#,                                             00106400
    VARIABLES = PSRM[1]#,                                               00106500
    VARSIZE = PSRM[2]#,                                                 00106600
    FUNCPOINTER = PSRM[3]#,                                             00106700
    FUNCSEQ = PSRM[4]#,                                                 00106800
    CURLINE = PSRM[5]#,                                                 00106900
    STACKBASE = PSRM[6]#,                                               00107000
    INCREMENT = STACKBASE#,  %FUNCMODE/CALCMODE                         00107100
    SYMBASE = PSRM[7]#,                                                 00107200
    FUNCSIZE = SYMBASE#,     %FUNCMODE/CALCMODE                         00107300
    USERMASK = PSRM[8]#,                                                00107400
    SEED = PSRM[10]#,                                                   00107500
    ORIGIN = PSRM[11]#,                                                 00107600
    FUZZ = PSRM[12]#,                                                   00107700
    FSTART = 9#,  %PSR[9] IS WHERE NAME OF CURRENTLY EDITED FCN GOES    00107800
    PSRSIZE = 13#,                                                      00107900
    PSR = PSRM[*]#,                                                     00108000
    WF=[18:8]#,                                                         00108100
    WDSPERREC=10#,                                                      00108200
    WDSPERBLK=30#,                                                      00108300
    NAREAS=10#,                                                         00108400
    SIZEAREAS=210#,                                                     00108500
    LIBF1=[6:15]#,                                                      00108600
    LIBF2=[22:16]#,                                                     00108700
    LIBF3=[38:10]#,                                                     00108800
    LIBSPACES=1#,                                                       00108900
    IDENT=RESULT=1#,                                                    00109000
    SPECIAL=RESULT=3#,                                                  00109100
    NUMERIC=RESULT=2#,                                                  00109200
    REPLACELOC=0#,                                                      00109300
    REPLACEV=4#,                                                        00109400
    SPF=[30:18]#,                                                       00109500
    RF=[24:6]#,                                                         00109600
    DID=[1:5]#,                                                         00109700
    XRF=[12:18]#,                                                       00109800
    DDPNSW=30#, % DATA DESC PRESENT NAMED SCALAR WORD                   00109900
    DDNNVW=20#, %DATA DESC NON-PRES NAMED VECTOR WORD                   00110000
    DDNUVW=16#, %DATA DESC NONPRES..(POINTS INTO SYM TAB FOR LOCALS)    00110100
    DDPUVW=24#, % DATA DESC PRESENT UNNAMED VECTOR WORD                 00110200
    DDNNSW=22#, % DATA DESC NON-PRES NAMED SCALAR WORD                  00110300
    PDC=10#, % DROG DESC CALC MODE                                      00110400
    INTO=0#,                                                            00110500
    DDPUSW=26#,    % DATA DESC PRESENT UNNAMED SCALAR WORK (MODE)       00110600
    DDPUSC=27#,    % DATA DESC PRESENT UNNAMED SCALAR CHR               00110700
    DDPUVC=25#,    % DATA DESC PRESENT UNNAMED VECTOR CHR               00110800
    DDPNVC=29#,  %DATA DESC PRES PERMANENT VECTOR CHAR MODE             00110900
    DDPNVW=28#,  %DATA DESC PRES NAMED VEC WORD (NAMED=PERMANENT)       00111000
    OUTOF=1#,                                                           00111100
    NAMEDNULLV=0&7[1:45:3]#, %DLUDGE...NAMED VERSION OF NULLV           00111200
    BACKP=[6:18]#,                                                      00111300
       SCALARDATA=0#,                                                   00111400
       ARRAYDATA=2#,                                                    00111500
       DATATYPE=[4:1]#,                                                 00111600
       ARRAYTYPE=[5:1]#,                                                00111700
       CHARARRAY=1#,                                                    00111800
       NUMERICARRAY=0#,                                                 00111900
        BLOCKSIZE=30#, %#WORDS OF CONTIGUOUS DATA IN SEQUENTIAL STORE   00112000
       VARTYPE=[42:6]#,                                                 00112100
       WS=WORKSPACE#,                                                   00112200
    DIMPTR=SPF#,                                                        00112300
    INPTR=BACKP#,                                                       00112400
    QUADIN=[18:3]#,                                                     00112500
    QUADINV=18:45:3#,                                                   00112600
    STATEVECTORSIZE=16#,                                                00112700
    SUSPENDED=[5:1]#,                                                   00112800
    SUSPENDVAR=[2:1]#,                                                  00112900
    CTYPEF=3:45:3#,                                                     00113000
    CSUSVAR=2:47:1#,                                                    00113100
    CNAMED=3:47:1#,                                                     00113200
    MAXWORDSTORE=3960#, %APL PREVENTS CREATION OF ARRAYS BIGGER THAN    00113300
                        %3960 ELEMENTS.  THIS NUMBER IS THE PRODUCT OF  00113400
                        %4,(NUMBER OF POINTERS TO SEQUENTIAL STORE      00113500
                        %BLOCKS THAT ARE STORED IN ONE WORD)            00113600
                        %30, (BLOCKSIZE),                               00113700
                        %AND 33, (SIZE OF ARRAY USED TO STORE THESE     00113800
                        %POINTERS IN GETARRAY, MOVEARRAY, AND           00113900
                        %RELEASEARRAY).  SUBSCRIPTS ALLOWS 8|3960       00114000
                        %ELEMENTS IF THEY ARE CHARACTERS.               00114100
                        %HOWEVER, SP WILL GET FULL BEFORE THAT SINCE    00114200
                        %BIGGEST SP SIZE IS CURRENTLY 3584              00114300
    MAXBUFFSIZE=30#,                                                    00114400
    MAXHEADERARGS=30#,                                                  00114500
    BUFFERSIZE=BUFFSIZE#,                                               00114600
    LINEBUFFER=LINEBUFF#,                                               00114700
    LINEBUFF = OUTBUFF[*]#,                                             00114800
    APPENDTOBUFFER=APPENDTOBUFF#,                                       00114900
     FOUND=TARRAY[0]#,                                                  00115000
     EOB=TARRAY[1]#,                                                    00115100
     MANT=TARRAY[2]#,                                                   00115200
     MANTLEN=TARRAY[3]#,                                                00115300
     FRAC=TARRAY[4]#,                                                   00115400
     FRACLEN=TARRAY[5]#,                                                00115500
     POWER=TARRAY[6]#,                                                  00115600
     POWERLEN=TARRAY[7]#,                                               00115700
     MANTSIGN=TARRAY[8]#,                                               00115800
     TABSIZE = 43#,                                                     00115900
     LOGINCODES=1#,                                                     00116000
     LOGINPHRASE=2#,                                                    00116100
     LIBRARY=1#,                                                        00116200
     WORKSPACEUNIT=2#,                                                  00116300
     RTPAREN=9#,                                                        00116400
     MASTERMODE=USERMASK.[1:1]#,                                        00116500
     EDITOG=USERMASK.[2:1]#,                                            00116600
     POLBUG=USERMASK.[3:1]#,                                            00116700
     FPTF=9#,     % FUNCTION POINTER FIELD (STARTS AT CHR POS 9)        00116800
     FSQF=11#,   % FUNCTION SEQNTL FIELD                                00116900
     FFL=2#,     % FUNCTION FIELD LENGTH (2 CHR POSITIONS)              00117000
     CRETURN=3:47:1#,                                                   00117100
     RETURNVALUE=[3:1]#,                                                00117200
     CNUMBERARGS=4:46:2#,                                               00117300
     NUMBERARGS=[4:2]#,                                                 00117400
     RETURNVAL=1#,                                                      00117500
     NOSYNTAX=USERMASK.[4:1]#,                                          00117600
     LINESIZE=USERMASK.[41:7]#,                                         00117700
     DIGITS=USERMASK.[37:4]#,                                           00117800
     SUSPENSION=USERMASK.SUSPENDED#,                                    00117900
     SAVEDWS=USERMASK.[7:1]#,                                           00118000
     DELTOG=USERMASK.[6:1]#,                                            00118100
     DELCHR="$"#, %USED IN DELPRESENT (IN FUNCTIONHANDLER)              00118200
     MAXMESS=27#,                                                       00118300
     USERTOP=21#,                                                       00118400
     MARGINSIZE=6#,                                                     00118500
     LFTBRACKET=SPECIAL AND ACCUM[0]=11#,                               00118600
     QUADV=SPECIAL AND ACCUM[0]=10#,                                    00118700
     QUOTEV=ACCUM[0]=20#,                                               00118800
     EXPANDV=38#,                                                       00118900
     SLASHV=6#,                                                         00119000
     GOTOV=5#,                                                          00119100
     DOTV=17#,                                                          00119200
     ROTV=37#,                                                          00119300
     RGTBRACKET=SPECIAL AND ACCUM[0]=12#,                               00119400
     DELV=SPECIAL AND ACCUM[0]=13#,                                     00119500
     PLUS        = SPECIAL AND ACCUM[0] = 48#,                          00119600
     MINUS       = SPECIAL AND ACCUM[0] = 49#,                          00119700
     NEGATIVE     = SPECIAL AND ACCUM[0] = 51#,                         00119800
     TIMES       = SPECIAL AND ACCUM[0] = 50#,                          00119900
     LOGS        = SPECIAL AND ACCUM[0] = 54#,                          00120000
     SORTUP      = SPECIAL AND ACCUM[0] = 55#,                          00120100
     SORTDN      = SPECIAL AND ACCUM[0] = 56#,                          00120200
     NAND        = SPECIAL AND ACCUM[0] = 58#,                          00120300
     NOR         = SPECIAL AND ACCUM[0] = 59#,                          00120400
     TAKE        = SPECIAL AND ACCUM[0] = 60#,                          00120500
     DROPIT      = SPECIAL AND ACCUM[0] = 61#,                          00120600
     LFTARROW    = SPECIAL AND ACCUM[0] = 04#,                          00120700
     TRANS       = SPECIAL AND ACCUM[0] = 05#,                          00120800
     SLASH       = SPECIAL AND ACCUM[0] = 06#,                          00120900
     INTDIVIDE   = SPECIAL AND ACCUM[0] = 07#,                          00121000
     LFTPAREN    = SPECIAL AND ACCUM[0] = 08#,                          00121100
     RGTPAREN    = SPECIAL AND ACCUM[0] = 09#,                          00121200
     QUOTEQUAD   = SPECIAL AND ACCUM[0] = 14#,                          00121300
     SEMICOLON   = SPECIAL AND ACCUM[0] = 15#,                          00121400
     COMMA       = SPECIAL AND ACCUM[0] = 16#,                          00121500
     DOT         = SPECIAL AND ACCUM[0] = 17#,                          00121600
     STAR        = SPECIAL AND ACCUM[0] = 18#,                          00121700
     AT          = SPECIAL AND ACCUM[0] = 19#,                          00121800
     QUOTE       = SPECIAL AND ACCUM[0] = 20#,                          00121900
     BOOLAND     = SPECIAL AND ACCUM[0] = 21#,                          00122000
     BOOLOR      = SPECIAL AND ACCUM[0] = 22#,                          00122100
     BOOLNOT     = SPECIAL AND ACCUM[0] = 23#,                          00122200
     LESSTHAN    = SPECIAL AND ACCUM[0] = 24#,                          00122300
     LESSEQ      = SPECIAL AND ACCUM[0] = 25#,                          00122400
     EQUAL       = SPECIAL AND ACCUM[0] = 26#,                          00122500
     GRTEQ       = SPECIAL AND ACCUM[0] = 27#,                          00122600
     GREATER     = SPECIAL AND ACCUM[0] = 28#,                          00122700
     NOTEQ       = SPECIAL AND ACCUM[0] = 29#,                          00122800
     CEILING     = SPECIAL AND ACCUM[0] = 30#,                          00122900
     FLOOR       = SPECIAL AND ACCUM[0] = 31#,                          00123000
     STICK       = SPECIAL AND ACCUM[0] = 32#,                          00123100
     EPSILON     = SPECIAL AND ACCUM[0] = 33#,                          00123200
     RHO         = SPECIAL AND ACCUM[0] = 34#,                          00123300
     IOTA        = SPECIAL AND ACCUM[0] = 35#,                          00123400
     TRACE       = SPECIAL AND ACCUM[0] = 36#,                          00123500
     PHI         = SPECIAL AND ACCUM[0] = 37#,                          00123600
     EXPAND      = SPECIAL AND ACCUM[0] = 38#,                          00123700
     BASVAL      = SPECIAL AND ACCUM[0] = 39#,                          00123800
     EXCLAMATION = SPECIAL AND ACCUM[0] = 40#,                          00123900
     MINUSLASH   = SPECIAL AND ACCUM[0] = 41#,                          00124000
     QUESTION    = SPECIAL AND ACCUM[0] = 42#,                          00124100
     OSLASH      = SPECIAL AND ACCUM[0] = 43#,                          00124200
     TAU         = SPECIAL AND ACCUM[0] = 44#,                          00124300
     CIRCLE      = SPECIAL AND ACCUM[0] = 45#,                          00124400
     LOCKIT       =IDENT AND ACCUM[0]="4LOCK  "#,                       00124500
     COLON       = SPECIAL AND ACCUM[0] = 47#,                          00124600
     QUADLFTARROW=51#,                                                  00124700
     REDUCT=52#,                                                        00124800
     ROTATE=53#,                                                        00124900
     SCANV=57#,                                                         00125000
     LINEBUFFSIZE=17#,                                                  00125100
     MAXPOLISH=100#, MESSIZE=10#,                                       00125200
     MAXCONSTANT=30#,                                                   00125300
     MAXMEMACCESSES=3584#,   %MAXSPROWS | SPRSIZE                       00125400
     MAXSYMBOL=30#,                                                     00125500
     MAXSPROWS=28#,                                                     00125600
     TYPEFIELD=[3:3]#,                                                  00125700
     OPTYPE=[1:2]#,                                                     00125800
     LOCFIELD=BACKP#,                                                   00125900
     ADDRFIELD=SPF#,                                                    00126000
     SYMTYPE=[3:3]#,                                                    00126100
     OPERAND=5#,                                                        00126200
     CONSTANT=2#,                                                       00126300
     OPERATOR=3#,                                                       00126400
     LOCALVAR=4#,                                                       00126500
     SYMTABSIZE=1#,                                                     00126600
     LFTPARENV=8#,                                                      00126700
     RGTPARENV=9#,                                                      00126800
     LFTBRACKETV=11#,                                                   00126900
     RGTBRACKETV=12#,                                                   00127000
     SEMICOLONV=15#,                                                    00127100
     QUAD=10#,                                                          00127200
     QQUAD=14#,                                                         00127300
     LFTARROWV=4#,                                                      00127400
     SORTUPV=55#,                                                       00127500
     SORTDNV=56#,                                                       00127600
     ALPHALABEL=1#,                                                     00127700
     NUMERICLABEL=2#,                                                   00127800
     NEXTLINE=0#,                                                       00127900
     ERRORCOND=3#,                                                      00128000
     PRESENCE=[2:1]#,                                                   00128100
     CHANGE=[1:1]#,                                                     00128200
     XEQ=1#,                                                            00128300
     CLEARCORE=2#,                                                      00128400
     WRITECORE=3#,                                                      00128500
 %%%                                                                    00128600
 %%%                                                                    00128700
     XEQUTE=1#,                                                         00128800
     SLICE=120#,      %TIME SLICE IN 60THS OF A SECOND                  00128900
     ALLOC=2#,                                                          00129000
     WRITEBACK=3#,                                                      00129100
     LOOKATSTACK=5#,                                                    00129200
                                                                        00129300
     LEN=[1:23]#,                                                       00129400
     NEXT=[24:24]#,                                                     00129500
     LOC=L.[30:11],L.[41:7]#,                                           00129600
     NOC=N.[30:11],N.[41:7]#,                                           00129700
     MOC=M.[30:11],M.[41:7]#,                                           00129800
     SPRSIZE=128#, % SP ROW SIZE                                        00129900
     NILADIC=0#,                                                        00130000
     MONADIC=1#,                                                        00130100
     DYADIC=2#,                                                         00130200
     TRIADIC=3#,                                                        00130300
        DEPTHERROR=1#,                                                  00130400
        DOMAINERROR=2#,                                                 00130500
        INDEXERROR=4#,                                                  00130600
        LABELERROR=5#,                                                  00130700
        LENGTHERROR=6#,                                                 00130800
        NONCEERROR=7#,                                                  00130900
        RANKERROR=8#,                                                   00131000
        SYNTAXERROR=9#,                                                 00131100
        SYSTEMERROR=10#,                                                00131200
        VALUEERROR=11#,                                                 00131300
        SPERROR=12#,                                                    00131400
         KITEERROR=13#,                                                 00131500
        STREAMBASE=59823125#,                                           00131600
        APLOGGED=[10:1]#,                                               00131700
        APLHEADING=[11:1]#,                                             00131800
        CSTATION = STATION#,                                            00131900
        CAPLOGGED=10:47:1#,                                             00132000
        CAPHEADING=11:47:1#,                                            00132100
        APLCODE = STATIONPARAMS#,                                       00132200
                                                                        00132300
                                                                        00132400
        SPECMODE = BOUNDARY.[1:3]#,                                     00132500
        DISPLAYING=1#,                                                  00132600
        EDITING=2#,                                                     00132700
        DELETING=3#,                                                    00132800
        RESEQUENCING=4#,                                                00132900
        LOWER = BOUNDARY.[4:22]#,                                       00133000
        UPPER = BOUNDARY.[26:22]#,                                      00133100
        OLDBUFFER = OLDINPBUFFER[*]#,                                   00133200
                                                                        00133300
        ENDEFINES=#;                                                    00133400
        REAL ADDRESS, ABSOLUTEADDRESS,                                  00133500
        LADDRESS;                                                       00133600
        BOOLEAN LINETOG; %GO TO NEXT LINE IF TRUE WHEN WRITING OUT      00133700
        INTEGER BUFFSIZE,ITEMCOUNT,RESULT,                              00133800
        LOGINSIZE,                                                      00133900
    %%%                                                                 00134000
        ERR,                                                            00134100
        NROWS,                                                          00134200
    %%%                                                                 00134300
        CUSER;                                                          00134400
    LABEL ENDOFJOB,TRYAGAIN;                                            00134500
    REAL GT1,GT2,GT3;                                                   00134600
    DEFINE LINE=PRINT#;                                                 00134700
    SAVE ARRAY BUFFER[0:MAXBUFFSIZE];                                   00134800
    ARRAY TARRAY[0:8],                                                  00134900
        COMMENT PROGRAM STATE REGISTER;                                 00135000
        PSRM[0:PSRSIZE],                                                00135100
        OLDINPBUFFER[0:MAXBUFFSIZE],                                    00135200
        SP[0:27, 0:SPRSIZE-1],                                          00135300
        IDTABLE[0:TABSIZE],                                             00135400
        MESSTAB[0:MAXMESS],                                             00135500
        JIGGLE[0:0],                                                    00135600
        SCR[0:2],                                                       00135700
        CORRESPONDENCE[0:7],                                            00135800
        ACCUM[0:MAXBUFFSIZE];                                           00135900
        DEFINE OUTBUFFSIZE=29#,CLOGGED=7:47:1#,STU=15:9:9#;             00136000
        ARRAY OUTBUFF[0:OUTBUFFSIZE];                                   00136100
        ALPHA STATION, JOBNUM,  STATIONPARAMS, BOUNDARY;                00136200
        INTEGER CHRCOUNT, WORKSPACE;                                    00136300
                                                                        00136400
    STREAM PROCEDURE INITBUFF(B,BUFFSIZE); VALUE BUFFSIZE;              00136500
        BEGIN                                                           00136600
        DI~B; BUFFSIZE(DS~8LIT" "); DS~LIT"~";                          00136700
        END;                                                            00136800
    STREAM PROCEDURE TRANSFER(A,AS,B,BS,L); VALUE AS,BS,L;              00136900
        BEGIN LOCAL T,U,V;                                              00137000
        SI:=LOC AS; DI:=LOC T; DI:=DI+1; DS:=7CHR;                      00137100
        SI:=LOC BS; DI:=LOC U; DI:=DI+1; DS:=7CHR;                      00137200
        SI:=LOC L; DI:=LOC V; DI:=DI+1; DS:=7CHR;                       00137300
        SI:=A; T(2(SI:=SI+32)); SI:=SI+AS;                              00137400
        DI:=B; U(2(DI:=DI+32)); DI:=DI+BS;                              00137500
        V(2(DS:=32CHR)); DS:=L CHR;                                     00137600
        END;                                                            00137700
    REAL PROCEDURE NUMBER; FORWARD; %LINE 111500                        00137800
    BOOLEAN PROCEDURE SCAN;                                             00137900
      BEGIN                                                             00138000
    REAL STREAM PROCEDURE GNC(ADDR,ACC); VALUE ADDR;                    00138100
      BEGIN SI:=ADDR; DI:=ACC; DI:=DI+7; DS:=CHR; GNC:=SI;              00138200
      DI:=ACC; SKIP DB; DS:=SET; END OF GNC;                            00138300
    REAL STREAM PROCEDURE RESWD(TAB,BUF,ADDR,EOB,FOUND,K);              00138400
        VALUE ADDR,K;                                                   00138500
        BEGIN                                                           00138600
        LOCAL T,TSI,TDI;                                                00138700
        LABEL TRY,L,KEEPGOING,FINIS,RESTORE;                            00138800
        LABEL NUMBERFOUND;                                              00138900
        DI:=EOB; DS:=8LIT"0"; DI:=FOUND; DS:=8LIT"0";                   00139000
        SI:=ADDR;                                                       00139100
        L: IF SC NEQ " " THEN GO TO KEEPGOING;                          00139200
            SI:=SI+1;                                                   00139300
            GO TO L;                                                    00139400
        KEEPGOING:                                                      00139500
        RESWD:=SI;                                                      00139600
        ADDR:=SI;                                                       00139700
        IF SC GEQ "0" THEN IF SC LEQ "9" THEN GO TO NUMBERFOUND;        00139800
        IF SC="#" THEN GO TO NUMBERFOUND;                               00139900
        IF SC="@" THEN GO TO NUMBERFOUND;                               00140000
        IF SC="." THEN                                                  00140100
               BEGIN SI:=SI+1;                                          00140200
               IF SC GEQ "0" THEN IF SC LEQ "9" THEN                    00140300
               GO TO NUMBERFOUND; SI:=SI-1;                             00140400
               END;                                                     00140500
    DI:=LOC T; DS:=2RESET; DS:=2SET; DS:=2RESET;                        00140600
    DI:=LOC T;                                                          00140700
    IF SC=DC THEN                                                       00140800
        BEGIN DI:=EOB; DI:=DI+7; DS:=LIT"1";                            00140900
        GO TO FINIS                                                     00141000
        END;                                                            00141100
    SI:=TAB; TSI:=SI;                                                   00141200
    TRY:                                                                00141300
    IF SC="0" THEN                                                      00141400
        BEGIN SI:=ADDR;                                                 00141500
        IF SC=ALPHA THEN                                                00141600
        IF SC GEQ"0" THEN                                               00141700
            IF SC LEQ "9" THEN                                          00141800
NUMBERFOUND:                                                            00141900
            TALLY:=2 ELSE TALLY := 0                                    00142000
        ELSE TALLY:=1                                                   00142100
        ELSE TALLY:=3;                                                  00142200
        T:=TALLY; SI:=LOC T; SI:=SI+7; DI:=FOUND; DI:=DI+7;             00142300
        DS:=CHR; GO FINIS;                                              00142400
        END;                                                            00142500
    DI:=LOC T; DI:=DI+7; DS:=CHR;                                       00142600
    DI:=ADDR;                                                           00142700
    IF T SC=DC THEN                                                     00142800
        BEGIN                                                           00142900
        TSI:=SI; TDI:=DI; SI:=SI-1;                                     00143000
        IF SC=ALPHA THEN                                                00143100
            BEGIN DI:=DI+16; SI:=TDI;                                   00143200
            IF SC NEQ " " THEN IF SC =ALPHA THEN ;                      00143300
            END;                                                        00143400
        SI:=TSI;                                                        00143500
        END ELSE GO TO RESTORE;                                         00143600
    IF TOGGLE THEN                                                      00143700
    RESTORE:                                                            00143800
        BEGIN SI:=SI+K; DI:=ADDR; GO TO TRY                             00143900
        END;                                                            00144000
    DI:=FOUND; DS:=K OCT;                                               00144100
    DI:=TDI; RESWD:=DI;                                                 00144200
    FINIS:                                                              00144300
    END;                                                                00144400
REAL STREAM PROCEDURE ACCUMULATE(ACC,EOB,ADDR); VALUE ADDR;             00144500
   BEGIN LOCAL T; LABEL EOBL,E,ON,L;                                    00144600
   DI:=ACC; 9(DS:=8LIT" ");                                             00144700
   DI:=EOB; DS:=8LIT"0"; SI:=ADDR; DI:=LOC T; SKIP 2 DB;                00144800
   DS:=2SET; DI:=LOC T;                                                 00144900
   63(IF SC=ALPHA THEN TALLY:=TALLY+1 ELSE JUMP OUT TO E;               00145000
   SI:=SI+1);                                                           00145100
   L:  IF SC=ALPHA THEN BEGIN SI:=SI+1; GO L END ELSE GO ON;            00145200
   IF SC=" " THEN GO ON;                                                00145300
   E:  IF SC = DC THEN ;                                                00145400
      SI:=SI-1; IF TOGGLE THEN GO TO EOBL ELSE GO ON;                   00145500
   EOBL:  DI:=EOB; DI:=DI+7; DS:=LIT"1";                                00145600
   ON:  ACCUMULATE:=SI; DI:=ACC; T:=TALLY; SI:=LOC T; SI:=SI+6;         00145700
   DS:=2CHR; SI:=ADDR; DS:=T CHR;                                       00145800
   END OF ACCUMULATE;                                                   00145900
BOOLEAN STREAM PROCEDURE ARROW(ADDR,I); VALUE ADDR,I;                   00146000
   BEGIN SI:=ADDR; SI:=SI-1; DI:=LOC I; DI:=DI+7;                       00146100
   IF SC=DC THEN TALLY:=1; ARROW :=TALLY                                00146200
   END OF ARROW;                                                        00146300
  IF NOT BOOLEAN(EOB) THEN BEGIN                                        00146400
     LADDRESS:=ADDRESS;                                                 00146500
     ADDRESS:=RESWD(IDTABLE,BUFFER,ADDRESS,EOB,FOUND,2);                00146600
     IF RESULT:=FOUND NEQ 0 THEN BEGIN                                  00146700
        IF RESULT=1 THEN ADDRESS:=ACCUMULATE(ACCUM,EOB,ADDRESS)         00146800
        ELSE IF RESULT=2 THEN ACCUM[0]:=NUMBER                          00146900
        ELSE IF RESULT=3 THEN ADDRESS:=GNC(ADDRESS,ACCUM)               00147000
        ELSE BEGIN ACCUM[0]:=RESULT; RESULT:=3 END;                     00147100
        ITEMCOUNT:=ITEMCOUNT+1;                                         00147200
        SCAN:=TRUE;                                                     00147300
        IF ARROW(ADDRESS,31) THEN                                       00147400
           BEGIN EOB:=1; SCAN:=FALSE END;                               00147500
        END ELSE EOB:=1;                                                00147600
     END;                                                               00147700
   END OF THE SCAN PROCEDURE;                                           00147800
PROCEDURE FORMROW(CC,BL,A,S,N); VALUE CC,BL,S,N;                        00147900
    INTEGER CC,BL,S,N; ARRAY A[0]; FORWARD                              00148000
    ;                                                                   00148100
PROCEDURE INDENT(R); VALUE R; REAL R; FORWARD;                          00148200
PROCEDURE TERPRINT; FORWARD;                                            00148300
PROCEDURE PROCESS(MODE);VALUE MODE;INTEGER MODE; FORWARD;               00148400
REAL STREAM PROCEDURE ABSADDR(A);                                       00148500
    BEGIN SI:=A; ABSADDR:=SI                                            00148600
    END;                                                                00148700
BOOLEAN PROCEDURE LIBRARIAN(MFID,FID); VALUE MFID,FID;                  00148800
    REAL MFID,FID;                                                      00148900
    BEGIN                                                               00149000
    REAL ARRAY A[0:6]; FILE DF DISK(1,1);                               00149100
    REAL T;                                                             00149200
    COMMENT LIBRARIAN IS TRUE IF MFID/FID IS PRESENT ON DISK;           00149300
     FILL DF WITH MFID,FID;                                             00149400
    SEARCH(DF,A[*]);                                                    00149500
    LIBRARIAN:=                                                         00149600
        A[0]!-1;                                                        00149700
    END;                                                                00149800
FILE SPO 11(1,3);                                                       00149900
PROCEDURE SPOUT(K); VALUE K; INTEGER K;                                 00150000
    BEGIN FORMAT ERRF("APL ERROR:",I8,A1);                              00150100
    WRITE(SPO,ERRF,K,31);                                               00150200
    END;                                                                00150300
PROCEDURE INITIALIZETABLE;                                              00150400
    BEGIN DEFINE STARTSEGMENT= #;                                       00150500
    INTEGER I;                                                          00150600
    LADDRESS:=                                                          00150700
    ABSOLUTEADDRESS:=ABSADDR(BUFFER);                                   00150800
    BIGGEST := REAL(NOT FALSE) & 0[1:46:2];                             00150900
    NULLV := 0 & 3[1:46:2];                                             00151000
    STATUSWORD~REAL(BOOLEAN(STATUSWORD) OR BOOLEAN(1));                 00151100
    JOBNUM~TIME(-1);                                                    00151200
    STATION~0&1[CLOGGED]&STATUSWORD[STU];                               00151300
    FILL JIGGLE[*] WITH OCT5757575757575737;%CARRIAGE RETURNS LEFT ARROW00151400
    FILL IDTABLE[*] WITH                                                00151500
    "1+481-49", "1&501%07", "1.171@19", "1#411(08",                     00151600
    "1)091/06", "3XEQ623L", "OG541;15", OCT0333777601040177,            00151700
            %CAST IN ABOVE LINE IS REALLY 3["]141"                      00151800
    "202:=042", "[]101[11", "1]123AND", "212OR223",                     00151900
    "NOT233LS", "S243LEQ2", "53GEQ273", "GTR283NE", "Q292=:05",         00152000
    "2GO051=2", "63MAX304", "CEIL303F", "LR313MIN",                     00152100
    "314RESD3","23ABS323","RHO341*1","84IOTA35",                        00152200
    "1|384RND", "M425TRAN", "S431$133", "PHI374FA",                     00152300
    "CT404COM", "B406CIRC", "LE456SOR", "TUP556SO",                     00152400
    "RTDN561:", "474NAND5", "83NOR594", "TAKE604D",                     00152500
    "ROP613RE", "P446BASV", "AL393EPS", "331,1600";                     00152600
  COMMENT IDTABLE IS TABLE OF RESERVED WORDS AND SPECIAL SYMBOLS.       00152700
    FORMAT IS NUMBER OF CHARACTERS IN SYMBOL, FOLLOWED BY SYMBOL        00152800
    ITSELF, FOLLOWED BY A TWO-DIGIT DECIMAL CODE WHICH APL USES         00152900
    FOR THE RESERVED WORD--LIKE IN THE EXECUTION CASE STATEMENT AND     00153000
    IN SYNTAX CHECKING.  FOR SCAN TO WORK, THE TWO-DIGIT CODE MUST      00153100
    BE GREATER THAN 3 AND IDTABLE MUST HAVE AT LEAST ONE "0" AT THE     00153200
    END TO MARK THE END.  TABSIZE IS THE DEFINE (LINE 30000) GIVING     00153300
    THE SIZE OF TDTABLE;                                                00153400
    IF STACKSIZE=0 THEN STACKSIZE:=100 ELSE                             00153500
        IF STACKSIZE GTR 1022 THEN STACKSIZE:=1022;                     00153600
    BUFFSIZE:=MAXBUFFSIZE;                                              00153700
    LINETOG := TRUE; %USUALLY GO TO NEXT LINE WHEN WRITING OUT          00153800
                                                                        00153900
    INITBUFF(OUTBUFF, 10);                                              00154000
    INITBUFF(BUFFER,BUFFSIZE);                                          00154100
    NROWS:=-1;                                                          00154200
    NAME(LIBJOB,TIME(-1));                                              00154300
    FILL MESSTAB[*] WITH                                                00154400
    "4SAVE  ",                                                          00154500
    "4LOAD  ",                                                          00154600
    "5CLEAR ",                                                          00154700
    "4COPY  ",                                                          00154800
    "4VARS  ",                                                          00154900
    "3FNS   ",                                                          00155000
    "6LOGGED",                                                          00155100
    "3MSG   ",                                                          00155200
    "5WIDTH ",                                                          00155300
    "3OPR   ",                                                          00155400
    "6DIGITS",                                                          00155500
    "3OFF   ",                                                          00155600
    "6ORIGIN",                                                          00155700
    "4SEED  ",                                                          00155800
    "4FUZZ  ",                                                          00155900
    "3SYN   ",                                                          00156000
    "5NOSYN ",                                                          00156100
    "5STORE ",                                                          00156200
    "5ABORT ",                                                          00156300
    "2SI    ",                                                          00156400
    "3SIV   ",                                                          00156500
    "5ERASE ",                                                          00156600
    %--------------MASTERMODE BELOW HERE...(SEE USERTOP)--------        00156700
    "6ASSIGN",                                                          00156800
    "6DELETE",                                                          00156900
    "4LIST  ",                                                          00157000
    "5DEBUG ",                                                          00157100
    "5FILES ";                                                          00157200
                                                                        00157300
    IF LIBSIZE=-1 THEN                                                  00157400
    BEGIN LIBSIZE~1;GTA[0]~"       ";STOREORD(LIBRARY,GTA,0);WRAPUP;    00157500
    END ELSE BEGIN LIBSIZE~SIZE(LIBRARY);                               00157600
             FOR I~1 STEP 1 UNTIL LIBSIZE-1 DO                          00157700
              BEGIN GT1~CONTENTS(LIBRARY,I,ACCUM);                      00157800
              IF NOT LIBRARIAN(ACCUM[0],TIME(-1)) THEN                  00157900
              BEGIN DELETE1(LIBRARY,I);LIBSIZE~LIBSIZE-1;END;           00158000
    IF (LOGINSIZE:=SIZE(LOGINCODES)=0) THEN                             00158100
              END;                                                      00158200
             END;                                                       00158300
    FILL CORRESPONDENCE[*] WITH                                         00158400
      OCT1111111111110311,                                              00158500
      OCT1111111111111111,                                              00158600
      OCT1104111121221113,                                              00158700
      OCT2014151617100706,                                              00158800
      OCT1111111111111112,                                              00158900
      OCT1111111111111100,                                              00159000
      OCT0201111111251111,                                              00159100
      OCT2324111111111111;                                              00159200
    COMMENT  CORRESPONDENCE GIVES THE CORRESPONDENCE BETWEEN THE        00159300
      APL CODES FOR DYADIC SCALAR OPERATORS (EXCEPT CIRCLE) AND         00159400
      THEIR POSITIONS IN THE "CASE STATEMENT" IN "OPERATION".           00159500
      E.G. APL CODE 7 IS "OPERATION" CODE 3 IN OCTAL (FOR DIVIDE).      00159600
      IF N-TH CHARACTER IN CORRESPONDECE IS OCTAL 11, THEN N            00159700
      IS NOT AN APL CODE FOR A DYADIC SCALAR OPERATOR.  CHARACTER       00159800
      COUNT STARTS AT 1 FOR FIRST CHARACTER. TO MAKE IT COME OUT        00159900
      RIGHT, STREAM PROCEDURE GETOP IS ACTUALLY CALLED WITH APL         00160000
      OPERATION CODE MINUS 1;                                           00160100
    END;                                                                00160200
REAL STREAM PROCEDURE CONV(ADDR,N);                                     00160300
  VALUE N,ADDR;                                                         00160400
  BEGIN SI:=ADDR;                                                       00160500
  DI:=LOC CONV;                                                         00160600
  DS:=N OCT; END;                                                       00160700
REAL STREAM PROCEDURE BUMP(ADDR,N); VALUE ADDR,N;                       00160800
  BEGIN SI:=ADDR; SI:=SI+N; BUMP:=SI; END;                              00160900
REAL PROCEDURE NUMBER;                                                  00161000
  BEGIN REAL NCHR;                                                      00161100
  LABEL GETFRAC,GETPOWER,QUIT,KITE;                                     00161200
  MONITOR EXPOVR;                                                       00161300
  REAL PROCEDURE INTCON(COUNT); VALUE COUNT;                            00161400
       REAL COUNT;                                                      00161500
    BEGIN REAL TLO,THI,T; INTEGER N;                                    00161600
    BOOLEAN DPTOG; DEFINE ADDR=ADDRESS#;                                00161700
    COMMENT:  VALUE OF INTCON IS THE CONVERSION OF AN INTEGER           00161800
              CONSISTING OF COUNT NUMERICAL CHARACTERS STARTING         00161900
              AT THE CHARACTER ADDRESS.  ADDRESS IS SET TO POINT        00162000
              TO THE NEXT CHARACTER DURING INTCON;                      00162100
    DPTOG:=COUNT GTR 8;                                                 00162200
    THI:=T:=CONV(ADDR,N:=COUNT MOD 8);                                  00162300
    ADDR:=BUMP(ADDR,N);                                                 00162400
    COUNT:=COUNT DIV 8;                                                 00162500
    FOR N:=1 STEP 1 UNTIL COUNT DO BEGIN                                00162600
         IF DPTOG THEN BEGIN                                            00162700
         DOUBLE(THI,TLO,100000000.0,0,|,CONV(ADDR,8),                   00162800
                0,+,:=,THI,TLO);                                        00162900
         T:=THI                                                         00163000
       END ELSE T:=T|100000000 + CONV(ADDR,8);                          00163100
        ADDR:=BUMP(ADDR,8); END;                                        00163200
    INTCON:=T;                                                          00163300
    END OF INTCON;                                                      00163400
  INTEGER STREAM PROCEDURE SUBSCAN(ADDR,NEXT); VALUE ADDR;              00163500
    BEGIN SI:=ADDR;                                                     00163600
    63(IF SC GEQ "0" THEN                                               00163700
      IF SC LEQ "9" THEN BEGIN SI:=SI+1; TALLY:=TALLY+1;                00163800
             END ELSE JUMP OUT);                                        00163900
    DI:=NEXT; DI:=DI+7; DS:=1 CHR; SUBSCAN:=TALLY;                      00164000
    END;                                                                00164100
  COMMENT--VALUE OF SUBSCAN IS NUMBER OF NUMERIC CHARACTERS             00164200
   FOUND. NEXT CONTAINS THE FIRST NON-NUMERIC CHARACTER;                00164300
  EXPOVR:=KITE;                                                         00164400
  MANTSIGN:=1;                                                          00164500
  MANT:=MANTLEN:=POWER:=POWERLEN:=FRAC:=FRACLEN:=0;                     00164600
  MANTLEN:=SUBSCAN(ADDRESS,NCHR);                                       00164700
  IF MANTLEN=0 AND NCHR="#" THEN BEGIN                                  00164800
     MANTSIGN:=-1;                                                      00164900
     ADDRESS:=BUMP(ADDRESS,1);                                          00165000
     MANTLEN:=SUBSCAN(ADDRESS,NCHR); END;                               00165100
  IF MANTLEN=0 THEN BEGIN ADDRESS:=BUMP(ADDRESS,1);                     00165200
     IF NCHR="." THEN GO TO GETFRAC                                     00165300
       ELSE IF NCHR="@" OR NCHR="E" THEN GO TO GETPOWER                 00165400
           ELSE BEGIN ERR:=SYNTAXERROR;                                 00165500
                      GO TO QUIT; END; END;                             00165600
  MANT:=INTCON(MANTLEN);                                                00165700
  IF NCHR="." THEN BEGIN ADDRESS:=BUMP(ADDRESS,1); GO GETFRAC END;      00165800
  IF NCHR="@" OR NCHR="E" THEN BEGIN                                    00165900
      ADDRESS:=BUMP(ADDRESS,1); GO TO GETPOWER END;                     00166000
  IF NCHR=12 THEN EOB:=1;                                               00166100
  GO TO QUIT;                                                           00166200
  GETFRAC:  FRACLEN:=SUBSCAN(ADDRESS,NCHR);                             00166300
    IF FRACLEN=0 THEN BEGIN ERR:=SYNTAXERROR; GO TO QUIT; END;          00166400
    FRAC:=INTCON(FRACLEN);                                              00166500
    IF NCHR="@" OR NCHR="E" THEN BEGIN                                  00166600
       ADDRESS:=BUMP(ADDRESS,1); GO TO GETPOWER; END;                   00166700
    IF NCHR=12 THEN EOB:=1 ELSE                                         00166800
       IF NCHR="." OR NCHR="#" THEN ERR:=SYNTAXERROR;                   00166900
    GO TO QUIT;                                                         00167000
  GETPOWER:                                                             00167100
    POWERLEN:=SUBSCAN(ADDRESS,NCHR);                                    00167200
    IF POWERLEN=0 THEN BEGIN                                            00167300
       IF NCHR="-" OR NCHR="#" THEN POWER:=-1                           00167400
          ELSE IF NCHR="+" THEN POWER:=1                                00167500
            ELSE BEGIN ERR:=SYNTAXERROR; GO TO QUIT; END;               00167600
       POWERLEN:=SUBSCAN(ADDRESS:=BUMP(ADDRESS,1), NCHR);               00167700
       END ELSE POWER:=1;                                               00167800
    IF POWERLEN=0 THEN ERR:=SYNTAXERROR                                 00167900
          ELSE BEGIN                                                    00168000
            POWER:=INTCON(POWERLEN)|POWER;                              00168100
            IF NCHR="#" OR NCHR="@" OR NCHR="."                         00168200
                THEN ERR:=SYNTAXERROR; END;                             00168300
    GO TO QUIT;                                                         00168400
  KITE:  ERR:=KITEERROR;                                                00168500
  QUIT:  IF ERR=0 THEN                                                  00168600
    NUMBER:=IF MANTLEN+FRACLEN=0 THEN                                   00168700
       IF POWERLEN=0 THEN 0                                             00168800
       ELSE MANTSIGN|10*ENTIER(POWER)                                   00168900
       ELSE MANTSIGN|(MANT|10*ENTIER(POWER)                             00169000
             + FRAC|10*ENTIER(POWER-FRACLEN)) ELSE EOB:=1;              00169100
  END OF NUMBER;                                                        00169200
STREAM PROCEDURE APPENDTOBUFF(BUF,NBUF,NBLANK,A,SA,NA);                 00169300
    VALUE NBUF,NBLANK,SA,NA;                                            00169400
    BEGIN LOCAL T;                                                      00169500
    LOCAL TSI,TDI;                                                      00169600
    SI:=LOC NBUF; DI:=LOC T; DI:=DI+1; DS:=7CHR;                        00169700
    DI:=BUF; T(2(DI:=DI+32)); DI:=DI+NBUF;                              00169800
    NBLANK(DS:=LIT" "); TDI:=DI;                                        00169900
    SI:=LOC SA; DI:=LOC T; DI:=DI+1; DS:=7CHR;                          00170000
    SI:=A; T(2(SI:=SI+32)); SI:=SI+SA;                                  00170100
    TSI:=SI; SI:=LOC NA; DI:=LOC T; DI:=DI+1; DS:=7CHR;                 00170200
    SI:=TSI; DI:=TDI; T(2(DS:=32CHR)); DS:=NA CHR                       00170300
    END;                                                                00170400
PROCEDURE TERPRINT;                                                     00170500
    BEGIN LABEL BK;                                                     00170600
STREAM PROCEDURE FINISHBUFF(BUF,N,TER);VALUE N,TER;                     00170700
    BEGIN LOCAL T;                                                      00170800
    SI:=LOC TER;SI:=SI+7;IF SC="1" THEN;                                00170900
    SI:=LOC N; DI:=LOC T; DI:=DI+1; DS:=7 CHR;                          00171000
    DI:=BUF; T(2(DI:=DI+32));DI:=DI+N;                                  00171100
    IF TOGGLE THEN DS:=2 LIT"{!"; %CARRIAGE RETURN/LINE FEED            00171200
    DS:=RESET;DS:=5 SET; %END OF MESSAGE LEFT ARROW                     00171300
    END OF FINISHBUFF;                                                  00171400
 IF CHRCOUNT NEQ 0 THEN BEGIN                                           00171500
    FINISHBUFF(OUTBUFF,CHRCOUNT,LINETOG);                               00171600
    CHRCOUNT:=0;                                                        00171700
    IF LINETOG THEN                                                     00171800
    WRITE(TWXOUT,9,OUTBUFF[*])[BK:BK] ELSE                              00171900
    WRITE(TWXOUT[STOP],9,OUTBUFF[*])[BK:BK];                            00172000
    INITBUFF(OUTBUFF, 10);                                              00172100
    END;                                                                00172200
    IF FALSE THEN                                                       00172300
BK: IF CURRENTMODE=XEQMODE THEN BREAKFLAG:=TRUE;                        00172400
 END OF TERPRINT;                                                       00172500
PROCEDURE FORMWD(CC,WD); VALUE CC,WD; REAL WD; INTEGER CC;              00172600
    BEGIN                                                               00172700
    INTEGER I,K,L;                                                      00172800
    COMMENT CC=-1 STAY ON LINE, OUTPUT, DON"T GO TO NEXT LINE           00172900
    COMMENT CC=0 STAY ON THIS LINE, MORE TO COME.                       00173000
            CC=1 STAY ON THIS LINE BUT TERMINATE PRINT.                 00173100
            CC=2 SKIP TO NEXT LINE - MORE TO COME.                      00173200
            CC=3 SKIP TO NEXT LINE - TERMINATE PRINT.;                  00173300
    REAL STREAM PROCEDURE OCTAL(I); VALUE I;                            00173400
        BEGIN SI:=LOC I; DI:=LOC OCTAL; DS:=8OCT                        00173500
        END;                                                            00173600
    IF L:=LINESIZE LEQ 9 OR L GTR 72 THEN L:=72; K:=2;                  00173700
    IF CC GTR 1 AND CHRCOUNT GTR 0THEN TERPRINT;                        00173800
    IF CHRCOUNT+(I:=OCTAL(WD.[1:11])) GTR L THEN                        00173900
                                                                        00174000
        BEGIN APPENDTOBUFF(LINEBUFFER,CHRCOUNT,                         00174100
        0,WD,2,K:=L-CHRCOUNT);                                          00174200
    CHRCOUNT:=L; TERPRINT;                                              00174300
                                                                        00174400
        I:=I-K;                                                         00174500
                                                                        00174600
        END;                                                            00174700
    APPENDTOBUFF(LINEBUFFER,CHRCOUNT,0,WD,K,I);                         00174800
                                                                        00174900
    CHRCOUNT:=CHRCOUNT+I;                                               00175000
    IF BOOLEAN(CC) THEN                                                 00175100
       IF CC=-1 THEN BEGIN LINETOG:=FALSE;                              00175200
                          TERPRINT; LINETOG:=TRUE                       00175300
                    END ELSE TERPRINT;                                  00175400
    END;                                                                00175500
BOOLEAN PROCEDURE FUNCTIONHEADER(SPECS,HADDR);                          00175600
    ARRAY SPECS[0]; REAL HADDR; FORWARD;                                00175700
                                                                        00175800
                                                                        00175900
                                                                        00176000
REAL PROCEDURE LINENUMBER(R); VALUE R; REAL R;                          00176100
    COMMENT STARTS ON 8030000;                                          00176200
    FORWARD;                                                            00176300
                                                                        00176400
PROCEDURE INDENT(R); VALUE R; REAL R;                                   00176500
    BEGIN                                                               00176600
    INTEGER STREAM PROCEDURE FORM(A,I,K);VALUE K,I;                     00176700
        BEGIN                                                           00176800
        LOCAL T1,T2;                                                    00176900
        LABEL SHORT,L,M,FINIS;                                          00177000
        TALLY:=K; FORM:=TALLY;                                          00177100
        SI:=LOC I; DI:=LOC T1; IF 8SC=DC THEN                           00177200
            BEGIN DI:=A; K(DS:=LIT" "); GO FINIS                        00177300
            END;                                                        00177400
        SI:=LOC I; DI:=A; TALLY:=3; DS:=LIT"[";                         00177500
        IF SC GTR "0" THEN IF SC LSS "0" THEN ;                         00177600
        3(TALLY:=TALLY+1; IF TOGGLE THEN DS:=CHR ELSE                   00177700
            IF SC NEQ "0" THEN DS:=CHR ELSE                             00177800
            BEGIN TALLY:=TALLY+63; SI:=SI+1                             00177900
            END );                                                      00178000
        DS:=CHR; T1:=TALLY; TALLY:=4; SI:=SI+3;                         00178100
        4(IF SC NEQ "0" THEN JUMP OUT TO M;                             00178200
            TALLY:=TALLY+63; SI:=SI-1); GO TO L;                        00178300
        M:                                                              00178400
        T2:=TALLY; SI:=LOC I; SI:=SI+4; DS:=LIT"."; DS:=T2 CHR;         00178500
        TALLY:=T1; TALLY:=TALLY+T2; TALLY:=TALLY+1; T1:=TALLY;          00178600
        L:                                                              00178700
        DS:=LIT"]"; TALLY:=K;                                           00178800
        T1(TALLY:=TALLY+63; T2:=TALLY; SI:=LOC T2; SI:=SI+7;            00178900
            IF SC="0" THEN JUMP OUT TO SHORT);                          00179000
        T2(DS:=LIT" "); GO FINIS;                                       00179100
        SHORT:                                                          00179200
        TALLY:=T1; TALLY:=TALLY+1; FORM:=TALLY; DS:=LIT" ";             00179300
        FINIS:                                                          00179400
        DS:=RESET; DS:=5SET;                                            00179500
        END;                                                            00179600
    IF R LSS 0 THEN R:=LINENUMBER(-R) ELSE R:=ABS(R); % -0              00179700
    CHRCOUNT:=FORM(LINEBUFF,R,MARGINSIZE)+1                             00179800
                                                                        00179900
    END;                                                                00180000
INTEGER PROCEDURE HEADER(ADDR1,ADDR2,BUF); VALUE ADDR1,ADDR2;           00180100
  INTEGER ADDR1, ADDR2; ARRAY BUF[0];                                   00180200
  BEGIN                                                                 00180300
 INTEGER STREAM PROCEDURE HEADRR(ADDR1,ADDR2,BUF); VALUE ADDR1,         00180400
    ADDR2;                                                              00180500
    BEGIN                                                               00180600
    LOCAL C,T,TDI;                                                      00180700
    LOCAL QM,AR;                                                        00180800
    LABEL L,ENDSCAN,M,N;                                                00180900
    DI:=LOC QM; DS:=2RESET; DS:=2SET;                                   00181000
    DI:=LOC AR; DS:=RESET; DS:=5SET;                                    00181100
    DI:=BUF;                                                            00181200
    SI:=ADDR1;                                                          00181300
    L: T:=SI; TDI:=DI;                                                  00181400
    DI:=LOC QM; IF SC=DC THEN GO TO ENDSCAN;                            00181500
    DI:=LOC AR; SI:=SI-1; IF SC=DC THEN GO TO ENDSCAN;                  00181600
    SI:=LOC T; DI:=LOC ADDR2;                                           00181700
    IF 8SC=DC THEN COMMENT END OF SCAN;                                 00181800
        GO TO ENDSCAN;                                                  00181900
    SI:=T; DI:=TDI; DS:=CHR;                                            00182000
    GO TO L;                                                            00182100
    ENDSCAN:                                                            00182200
    SI:=TDI;                                                            00182300
    M:    SI:=SI-1;                                                     00182400
    IF SC=" " THEN GO TO M;                                             00182500
    SI:=SI+1;                                                           00182600
    ADDR2:=SI;                                                          00182700
    SI:=BUF;                                                            00182800
    N: T:=SI; DI:=LOC ADDR2;                                            00182900
    SI:=LOC T;                                                          00183000
    IF 8SC NEQ DC THEN                                                  00183100
        BEGIN                                                           00183200
        TALLY:=TALLY+1; TDI:=TALLY;                                     00183300
        SI:=LOC TDI; SI:=SI+7;                                          00183400
        IF SC="0" THEN                                                  00183500
            BEGIN TALLY:=C; TALLY:=TALLY+1; C:=TALLY;                   00183600
            TALLY:=0;                                                   00183700
            END;                                                        00183800
        SI:=T; SI:=SI+1; GO TO N;                                       00183900
        END;                                                            00184000
    HEADRR:=TALLY; SI:=LOC C; DI:=LOC HEADRR; SI:=SI+1; DS:=6 CHR;      00184100
    END;                                                                00184200
  HEADER:=HEADRR(ADDR1,ADDR2,BUF);                                      00184300
  END OF PHONY HEADER;                                                  00184400
PROCEDURE STARTSCAN;                                                    00184500
    BEGIN                                                               00184600
                                                                        00184700
                                                                        00184800
                                                                        00184900
   LADDRESS:=                                                           00185000
    ADDRESS:=ABSOLUTEADDRESS;                                           00185100
        BEGIN TERPRINT;                                                 00185200
        END;                                                            00185300
    READ(TWXIN[STOP],29,BUFFER[*]);                                     00185400
    BUFFER[30]:=0&31[1:43:5];                                           00185500
    ITEMCOUNT:=0;                                                       00185600
    EOB:=0                                                              00185700
    END;                                                                00185800
PROCEDURE FORMROW(CC,BL,A,S,N); VALUE CC,BL,S,N; INTEGER CC,BL,         00185900
    S,N; ARRAY A[0];                                                    00186000
    COMMENT:  CC--SAME CODE AS IN FORMWD, LINE 253000                   00186100
              BL--#BLANKS TO PUT IN FRONT OF IT                         00186200
               A--ARRAY WHERE THE STUFF TO PUT ON LINE IS STORED        00186300
               S--#CHARACTERS TO SKIP AT START OF A                     00186400
               N--#CHARACTERS TO TAKE FROM A TO PUT ON OUTPUT LINE;     00186500
    BEGIN INTEGER K;                                                    00186600
    INTEGER T;                                                          00186700
    IF CC GTR 1 AND CHRCOUNT GTR 0  THEN TERPRINT;                      00186800
    IF K:=LINESIZE LEQ 9 OR K GTR 72 THEN K:=72;                        00186900
    WHILE CHRCOUNT+N+BL GTR K DO                                        00187000
        BEGIN                                                           00187100
        APPENDTOBUFFER(LINEBUFFER,CHRCOUNT,BL,A,S,T:=K-CHRCOUNT-BL);    00187200
        CHRCOUNT:=K; TERPRINT;                                          00187300
        S:=S+T; N:=N-T;                                                 00187400
        BL:=0;                                                          00187500
        END;                                                            00187600
    APPENDTOBUFFER(LINEBUFFER,CHRCOUNT,BL,A,S,N);                       00187700
                                                                        00187800
    CHRCOUNT:=CHRCOUNT+N+BL;                                            00187900
    IF BOOLEAN(CC) THEN                                                 00188000
       IF CC=-1 THEN BEGIN LINETOG:=FALSE;                              00188100
                          TERPRINT; LINETOG:=TRUE;                      00188200
                    END ELSE TERPRINT;                                  00188300
    END;                                                                00188400
PROCEDURE NUMBERCON(R,A); VALUE R; REAL R; ARRAY A[0];                  00188500
    BEGIN FORMAT F(F24.*), G(E24.*);                                    00188600
    REAL S; DEFINE MAXIM = 10@9#;                                       00188700
                                                                        00188800
    STREAM PROCEDURE ADJUST(A,B);                                       00188900
        BEGIN LOCAL T,FRAC,MANT,T1,TSI,TDI;                             00189000
        DI:=LOC T; DI:=DI+1; T1:=DI;                                    00189100
        SI:=B; DI:=A; DI:=DI+2;                                         00189200
        24(IF SC=" " THEN SI:=SI+1 ELSE                                 00189300
            BEGIN TSI:=SI; SI:=LOC T;                                   00189400
            IF SC="1" THEN; SI:=TSI;                                    00189500
            IF TOGGLE THEN                                              00189600
               IF SC NEQ "0" THEN                                       00189700
                   IF SC="@" THEN BEGIN                                 00189800
                       TSI:=SI; DI:=T1; DS:=LIT"1"; JUMP OUT;           00189900
                       END ELSE FRAC:=TALLY                             00190000
                   ELSE TALLY := TALLY+0                                00190100
               ELSE                                                     00190200
           IF SC="." THEN                                               00190300
               BEGIN MANT:=TALLY; TDI:=DI; DI:=LOC T; DS:=              00190400
               LIT"1"; TALLY:=0;DI:=TDI;                                00190500
               END;                                                     00190600
           TALLY:=TALLY+1; DS:=CHR                                      00190700
           END);                                                        00190800
       SI:=LOC MANT; SI:=SI+7; IF SC="0" THEN MANT:=TALLY;              00190900
                                                                        00191000
       TALLY:=MANT; SI:=LOC FRAC; SI:=SI+7; IF SC GTR "0"               00191100
       THEN TALLY:=TALLY+1; TALLY:=TALLY+FRAC; MANT:=TALLY;             00191200
       SI:=T1; IF SC="1" THEN BEGIN                                     00191300
           DI:=A; DI:=DI+MANT; DI:=DI+2;                                00191400
           SI:=TSI;  DS:=4CHR;                                          00191500
           TALLY:=TALLY+4; MANT:=TALLY; END;                            00191600
       SI:=LOC MANT; SI:=SI+6; DI:=A; DS:=2CHR;                         00191700
       END;                                                             00191800
   IF S:=ABS(R) GEQ MAXIM OR S LEQ 10*(-DIGITS) AND S NEQ 0 THEN        00191900
       WRITE(SCR[*],G,DIGITS,R) ELSE                                    00192000
   WRITE(SCR[*],F,DIGITS,R);                                            00192100
   ADJUST(A,SCR)                                                        00192200
   END;                                                                 00192300
PROCEDURE STOREPSR;                                                     00192400
    BEGIN INTEGER I;                                                    00192500
    DELETE1(WORKSPACE,0);                                               00192600
    I:=STORESEQ(WORKSPACE,PSR,PSRSIZE|8);                               00192700
        COMMENT USED TO CALL WRAPUP;                                    00192800
    END;                                                                00192900
PROCEDURE RESCANLINE;                                                   00193000
    BEGIN ADDRESS:=ABSOLUTEADDRESS; EOB:=0; END;                        00193100
PROCEDURE PROCESS(MODE);VALUE MODE;  INTEGER MODE; FORWARD;             00193200
PROCEDURE MESSAGEHANDLER; FORWARD;                                      00193300
PROCEDURE FUNCTIONHANDLER; FORWARD;                                     00193400
PROCEDURE ERRORMESS(N,ADDR,R); VALUE N,ADDR,R; REAL R;                  00193500
    INTEGER N;REAL ADDR;FORWARD; COMMENT LINE 5000000;                  00193600
STREAM PROCEDURE SETFIELD(A,S,L,R); VALUE S,L,R;                        00193700
    BEGIN DI:=A; DI:=DI+S; SI:=LOC R; SI:=SI+8; L(SI:=SI-1);            00193800
    DS:=L CHR;                                                          00193900
    END;                                                                00194000
COMMENT:  VALUE OF GETFIELD IS L CHARACTERS, STARTING AT J-TH           00194100
          CHARACTER OF A, RIGHT-ADJUSTED.  L MUST BE LEQ 8 AND          00194200
          J MUST BE LESS THAT 64;                                       00194300
REAL STREAM PROCEDURE GETFIELD(A,S,L); VALUE S,L;                       00194400
    BEGIN SI:=A; SI:=SI+S; DI:=LOC GETFIELD; DI:=DI+8; L(DI:=DI-1);     00194500
    DS:=L CHR;                                                          00194600
    END;                                                                00194700
REAL PROCEDURE TOPLINE(ORD); VALUE ORD; INTEGER ORD;                    00194800
    BEGIN                                                               00194900
    INTEGER STREAM PROCEDURE CON(A); VALUE A;                           00195000
        BEGIN SI:=LOC A; DI:=LOC CON; DS:=8OCT END;                     00195100
        ARRAY A[0:1]; INTEGER I;                                        00195200
        I:=CONTENTS(ORD,SIZE(ORD)-1,A);                                 00195300
        TOPLINE:=CON(A[0])/10000                                        00195400
    END;                                                                00195500
BOOLEAN PROCEDURE FUNCTIONHEADER(SPECS,HADDR);                          00195600
ARRAY SPECS[0]; REAL HADDR;                                             00195700
BEGIN                                                                   00195800
LABEL A,B,C;                                                            00195900
INTEGER P;                                                              00196000
DEFINE NOTE=HADDR.[24:24]:=ADDRESS#,P8=8|P+1#;                          00196100
ERR:=0;                                                                 00196200
SPECS[0]:=SPECS[1]:=SPECS[2]:=SPECS[3]:=0;                              00196300
NOTE; HADDR.[1:23]:=GT1:=ADDRESS;                                       00196400
IF SCAN AND IDENT THEN                                                  00196500
    BEGIN                                                               00196600
    TRANSFER(ACCUM,2,SPECS,1,7);                                        00196700
    NOTE;                                                               00196800
    IF SCAN THEN                                                        00196900
        IF LFTARROW THEN                                                00197000
            BEGIN                                                       00197100
            SPECS[1]:=1;                                                00197200
            SPECS[3]:=1;                                                00197300
            TRANSFER(SPECS,1,SPECS,33,7);                               00197400
            GT2:=ADDRESS;                                               00197500
            IF SCAN AND IDENT THEN                                      00197600
                BEGIN                                                   00197700
                TRANSFER(ACCUM,2,SPECS,1,7);                            00197800
                NOTE;                                                   00197900
                IF SCAN THEN                                            00198000
                    C: IF IDENT THEN                                    00198100
                        BEGIN                                           00198200
                        P:=(SPECS[3]:=SPECS[3]+1)+3;                    00198300
                       TRANSFER(ACCUM,2,SPECS,P8,7);                    00198400
                        SPECS[2]:=1;                                    00198500
                       NOTE;                                            00198600
                        IF SCAN THEN IF IDENT THEN                      00198700
                        BEGIN SPECS[2]:=2;                              00198800
                        P:=(SPECS[3]:=SPECS[3]+1)+2;                    00198900
                       TRANSFER(SPECS,1,SPECS,P8+8,7);                  00199000
                       TRANSFER(SPECS,P8,SPECS,1,7);                    00199100
                       TRANSFER(ACCUM,2,SPECS,P8,7);                    00199200
                                                                        00199300
                        B: NOTE; IF SCAN THEN                           00199400
                        A: IF SEMICOLON THEN IF SCAN THEN               00199500
                        IF IDENT THEN                                   00199600
                        BEGIN                                           00199700
                        P:=(SPECS[3]:=SPECS[3]+1)+3;                    00199800
                       TRANSFER(ACCUM,2,SPECS,P8,7);                    00199900
                        GO TO B;                                        00200000
                        END ELSE GO TO A                                00200100
                        ELSE ELSE ELSE                                  00200200
                        END ELSE GO TO A                                00200300
                        ELSE END                                        00200400
                    ELSE GO TO A ELSE                                   00200500
            END ELSE ERRORMESS(ERR:=1,GT2,0)                            00200600
            END ELSE GO TO C                                            00200700
        ELSE                                                            00200800
    END ELSE ERRORMESS(ERR:=SYNTAXERROR,GT1,0);                         00200900
FUNCTIONHEADER:=ERR=0;                                                  00201000
ADDRESS:=HADDR.[24:24];                                                 00201100
END FUNCTIONHEADER;                                                     00201200
                                                                        00201300
INTEGER PROCEDURE DAYTIME(B); ARRAY B[0]; FORWARD;                      00201400
    COMMENT ON LINE 8014000, ARRAY B MUST HAVE LENGTH                   00201500
    AT LEAST 3 WDS;                                                     00201600
PROCEDURE EDITLINE; FORWARD;                                            00201700
INTEGER PROCEDURE LENGTH(A,M);VALUE M; BOOLEAN M; ARRAY A[0];           00201800
    FORWARD; COMMENT LINE 8007900;                                      00201900
BOOLEAN PROCEDURE LABELSCAN(L,K); VALUE K; INTEGER K;                   00202000
    ARRAY L[0]; FORWARD; COMMENT LINE 8013910;                          00202100
                                                                        00202200
                                                                        00202300
PROCEDURE CHECKSEQ(SEQ,L,INC); REAL SEQ,L,INC; FORWARD;                 00202400
    COMMENT ON LINE 8040000;                                            00202500
PROCEDURE RELEASEARRAY(D);VALUE D; REAL D;                              00202600
    BEGIN COMMENT  RELEASE PERMANENT STORAGE FOR THE ARRAY DESC D;      00202700
    INTEGER K,J,PT;                                                     00202800
    ARRAY BLOCK[0:32];  %SEE MAXWORDSTORE, LINE 17260                   00202900
    ARRAY TEMP[0:1];                                                    00203000
    IF D.RF NEQ 0 THEN                                                  00203100
        BEGIN DELETE1(WS,D.DIMPTR);                                     00203200
        K:=CONTENTS(WS,D.INPTR,BLOCK)-1;                                00203300
        DELETE1(WS,D.INPTR);                                            00203400
        FOR J:=0 STEP 2 UNTIL K DO                                      00203500
        BEGIN TRANSFER(BLOCK,J,TEMP,6,2);                               00203600
            PT:=TEMP[0]; DELETE1(WS,PT); END;                           00203700
        END;                                                            00203800
    END;                                                                00203900
PROCEDURE TRANSFERSP(DIR,SP,L,B,M,N); VALUE DIR,N,M,L;                  00204000
    INTEGER DIR,N,M,L;                                                  00204100
    ARRAY SP[0,0],B[0];                                                 00204200
    BEGIN COMMENT                                                       00204300
    DIR= INTO:  TRANSFER N WORDS FROM B[L] INTO SP[M]                   00204400
                (ACTUALLY SP[*,M] SINCE ARRAY ROW IS USUALLY THE ARG)   00204500
    DIR= OUTOF (OPPOSITE);                                              00204600
    STREAM PROCEDURE MOVER(DIR,SP,M,B,L,N); VALUE DIR,                  00204700
        L,M,N;                                                          00204800
        BEGIN LOCAL T;                                                  00204900
        SI:=LOC L; DI:=LOC T; DI:=DI+1; DS:=7CHR;                       00205000
        SI:=SP; T(16(SI:=SI+32)); L(SI:=SI+8); L:=SI;                   00205100
        SI:=LOC M; DI:=LOC T; DI:=DI+1; DS:=7CHR;                       00205200
        SI:=B; T(16(SI:=SI+32)); M(SI:=SI+8); M:=SI;                    00205300
        SI:=LOC N; DI:=LOC T; DI:=DI+1; DS:=7CHR;                       00205400
        SI:=LOC DIR; SI:=SI+7;                                          00205500
        IF SC="0" THEN                                                  00205600
              BEGIN SI:=M; DI:=L                                        00205700
              END ELSE                                                  00205800
              BEGIN SI:=L ; DI:=M                                       00205900
              END;                                                      00206000
        T(2(DS:=32WDS)); DS:=N WDS;                                     00206100
        END;                                                            00206200
    INTEGER K;                                                          00206300
    WHILE N:=N-K GTR 0 DO                                               00206400
        MOVER(DIR,SP[(L:=L+K)DIV SPRSIZE,*],                            00206500
        M:=M+K,B,K:=L MOD SPRSIZE,                                      00206600
        K:=MIN(SPRSIZE-K,N))                                            00206700
    END;                                                                00206800
                                                                        00206900
PROCEDURE DUMPOLISH(SP,PD); VALUE PD; REAL PD; ARRAY SP[0,0];           00207000
    BEGIN INTEGER L;                                                    00207100
    LABEL SKIPREST;                                                     00207200
    INTEGER I,N,M,U; REAL T;                                            00207300
    L:=PD.SPF;                                                          00207400
    I:=SP[LOC]+L;                                                       00207500
    FOR L:=L+2 STEP 1 UNTIL I DO                                        00207600
IF (T:=SP[LOC]).TYPEFIELD=FUNCTION THEN                                 00207700
    BEGIN % OUTPUT MESSAGE AND NAME                                     00207800
    FORMWD(2,"5FUNC: ");                                                00207900
    N:=T.LOCFIELD; % N HAS LOCATION OF DESCRIPTOR                       00208000
    N:=N-1; % BACK UP ONE TO GET NAME                                   00208100
    GTA[0]:=SP[NOC];                                                    00208200
    FORMROW(1,1,GTA,1,7);                                               00208300
    END                                                                 00208400
ELSE % MIGHT BE AN OPERATOR                                             00208500
IF T.TYPEFIELD=OPERATOR THEN                                            00208600
        BEGIN COMMENT OUTPUT MESSAGE AND OP CODE;                       00208700
        FORMWD(2,"5ATOR: ");                                            00208800
        NUMBERCON(T.OPTYPE,ACCUM);                                      00208900
        FORMROW(0,1,ACCUM,2,ACOUNT);                                    00209000
        NUMBERCON(T.LOCFIELD,ACCUM);                                    00209100
        FORMROW(1,1,ACCUM,2,ACOUNT);                                    00209200
        END ELSE %MAY BE A CONSTANT                                     00209300
    IF T.TYPEFIELD=CONSTANT THEN                                        00209400
        BEGIN COMMENT GET DATA DESCRIPTOR;                              00209500
        N:=T.LOCFIELD;                                                  00209600
        FORMWD(2,"5CONS: ");                                            00209700
        T:=SP[NOC];     %T HAS THE DATA DESCRIPTOR                      00209800
        IF T.SPF=0 THEN BEGIN % A NULL VECTOR                           00209900
        FORMWD(1,"4NULL  ");                                            00210000
        GO TO SKIPREST; END;                                            00210100
        N:=T.SPF;       %N HAS THE SCALAR OR TOP OF VECTOR LOC.         00210200
        IF BOOLEAN(T.SCALAR) THEN M:=U:=N ELSE                          00210300
            BEGIN U:=SP[NOC]+N; M:=N+1; %UPPER AND LOWER BOUNDS         00210400
            END;                                                        00210500
IF BOOLEAN(T.CHRMODE) THEN %CHARACTER FORMAT                            00210600
    BEGIN COMMENT SP[NOC] IS NUMBER OF CHRS;                            00210700
    TRANSFERSP(OUTOF,SP,M,BUFFER,0,ENTIER(((T:=                         00210800
       SP[NOC])-1)DIV 8+1));                                            00210900
    FORMROW(1,1,BUFFER,0,T);                                            00211000
    END ELSE % SHOULD TEST FOR NULL...DO IT LATER.                      00211100
        FOR N:=M STEP 1 UNTIL U DO                                      00211200
            BEGIN NUMBERCON(SP[NOC],ACCUM);                             00211300
            FORMROW(0,1,ACCUM,2,ACOUNT);                                00211400
            END;                                                        00211500
        TERPRINT;                                                       00211600
        SKIPREST:                                                       00211700
        END ELSE COMMENT MUST BE AN OPERAND;                            00211800
    IF T.TYPEFIELD=LOCALVAR THEN                                        00211900
        BEGIN FORMWD(2,"5LOCL: ");                                      00212000
        N:=T.SPF; % N HAS LOCATION OF NAME;                             00212100
        GTA[0]:=SP[NOC];  % PUT NAME IN GTA                             00212200
        FORMROW(1,1,GTA,1,7);                                           00212300
        END ELSE                                                        00212400
        BEGIN COMMENT TREAT IT AS VARIABLE;                             00212500
        N:=T.LOCFIELD; COMMENT N HAS LOC OF DESCRIPTOR;                 00212600
        N:=N-1; COMMENT BACKUP OVER THE DESCRIPTOR;                     00212700
        GTA[0]:=SP[NOC];                                                00212800
        FORMWD(2,"5AND : ");                                            00212900
        FORMROW(1,1,GTA,1,7);                                           00213000
        END;                                                            00213100
    END;                                                                00213200
                                                                        00213300
PROCEDURE PROCESS(MODE); VALUE MODE; INTEGER MODE;                      00213400
    BEGIN                                                               00213500
    OWN INTEGER J;                                                      00213600
    OWN REAL RESULTD;                                                   00213700
    LABEL EXPOVRL,INTOVRL,INDEXL,FLAGL,ZEROL;                           00213800
    MONITOR EXPOVR,INTOVR,INDEX,FLAG,ZERO;                              00213900
    LABEL DEBUGSP; %DEBUGGING PURPOSES ONLY.                            00214000
    INTEGER PROCEDURE BUILDCONSTANT(LASTCONSTANT);                      00214100
        INTEGER LASTCONSTANT; FORWARD;                                  00214200
    INTEGER PROCEDURE GETSPACE(LENGTH); VALUE LENGTH;                   00214300
        INTEGER LENGTH; FORWARD;                                        00214400
    PROCEDURE OPERANDTOSYMTAB(L);VALUE L;INTEGER L;FORWARD;             00214500
    REAL PROCEDURE BUILDALPHA(LASTCONSTANT);                            00214600
        INTEGER LASTCONSTANT; FORWARD;                                  00214700
INTEGER PROCEDURE BUILDNULL(LASTCONSTANT);                              00214800
    INTEGER LASTCONSTANT; FORWARD;                                      00214900
        PROCEDURE SCRATCHDATA(D);VALUE D;REAL D; FORWARD;               00215000
            COMMENT LINE 3121400;                                       00215100
PROCEDURE FORGETPROGRAM(U);VALUE U;REAL U; FORWARD;                     00215200
    COMMENT ANALYZE IS IN PROCESS BECAUSE OWN ARRAY SP                  00215300
      IS ADDRESSED INCORRECTLY OTHERWISE;                               00215400
REAL PROCEDURE ANALYZE(DISPLAYOP); VALUE DISPLAYOP;BOOLEAN DISPLAYOP;   00215500
    BEGIN COMMENT                                                       00215600
    BC= BUILDCONSTANT,                                                  00215700
    GS= GET SPACE PROCEDURE ;                                           00215800
    ARRAY INFIX[0:MAXPOLISH];                                           00215900
                                                                        00216000
    INTEGER LASTCONSTANT;                                               00216100
    DEFINE GS=GETSPACE#;                                                00216200
    BOOLEAN STREAM PROCEDURE EQUAL(A,B);                                00216300
        BEGIN SI:=A; SI:=SI+1; DI:=B; DI:=DI+2;                         00216400
        IF 7SC=DC THEN TALLY:=1;                                        00216500
        EQUAL:=TALLY;                                                   00216600
        END;                                                            00216700
PROCEDURE UNSTACK(DEST,L,ORIG,OTOP,N,CHR1,CHR2);                        00216800
    VALUE N,CHR1,CHR2;                                                  00216900
   INTEGER N,CHR1,CHR2,L,OTOP;                                          00217000
        ARRAY DEST[0,0],ORIG[0];                                        00217100
        BEGIN                                                           00217200
        REAL T,U;                                                       00217300
        WHILE OTOP GTR 0 AND N GTR 0 AND ERR=0 DO                       00217400
        IF(IF (T:=ORIG[OTOP]).TYPEFIELD=FUNCTION THEN FALSE ELSE        00217500
            U:=T.LOCFIELD=CHR1 OR U=CHR2) THEN %UNSTACK                 00217600
            BEGIN                                                       00217700
            IF N GTR 1  THEN                                            00217800
                IF U=CHR2 THEN ERR:=SYNTAXERROR ELSE                    00217900
                    OTOP:=OTOP-1;                                       00218000
                N:=N-1;                                                 00218100
            END ELSE                                                    00218200
           COMMENT WE ARE LOOKING AT AN OPERATOR OR A FUNCTION;         00218300
                                                                        00218400
                                                                        00218500
            BEGIN                                                       00218600
            IF J NEQ 0 THEN                                             00218700
                 BEGIN L:=L+1;                                          00218800
                 DEST[LOC]:=ORIG[OTOP]                                  00218900
                 END;                                                   00219000
            OTOP:=OTOP-1                                                00219100
            END;                                                        00219200
       IF N GTR 1 THEN ERR:=SYNTAXERROR;                                00219300
        END;                                                            00219400
    INTEGER ITOP,K,L,I;                                                 00219500
    INTEGER M,N,FLOC; REAL T;                                           00219600
    LABEL SKIPSCAN,FILLER;                                              00219700
    LABEL SPFULLAB;                                                     00219800
                                                                        00219900
                                                                        00220000
    PROCEDURE FORGETSPACE(L,LENGTH,SP); VALUE L,LENGTH;                 00220100
        INTEGER L,LENGTH; ARRAY SP[0,0];                                00220200
        BEGIN IF LENGTH GTR 0 THEN                                      00220300
        BEGIN SP[LOC]:=SP[0,0];                                         00220400
        SP[LOC].LEN:=LENGTH; SP[0,0]:=L                                 00220500
        END;                                                            00220600
        END;                                                            00220700
                                                                        00220800
    IF CURRENTMODE=FUNCMODE OR STACKBASE=0 THEN FLOC:=0 ELSE            00220900
                                                                        00221000
        BEGIN L:=STACKBASE+1;L:=SP[LOC].SPF+1;M:=SP[LOC].SPF+L;         00221100
        FLOC:= IF M=L OR BOOLEAN(T:=SP[MOC]).SUSPENDED THEN 0 ELSE T.SPF00221200
                                                                        00221300
        END;                                                            00221400
                                                                        00221500
    T:=ADDRESS;                                                         00221600
    ITOP:=0;                                                            00221700
    DO                                                                  00221800
    SKIPSCAN:                                                           00221900
    IF ITOP LSS MAXPOLISH THEN                                          00222000
        BEGIN                                                           00222100
        INFIX[ITOP:=ITOP+1].ADDRFIELD:=T;                               00222200
        IF SPECIAL THEN                                                 00222300
    IF QUOTEV THEN % CONSTANT VECTOR                                    00222400
        BEGIN INFIX[ITOP].TYPEFIELD:=CONSTANT;                          00222500
        IF T:=BUILDALPHA(LASTCONSTANT) NEQ 0 THEN                       00222600
        INFIX[ITOP].LOCFIELD:=T ELSE ERR:=SYNTAXERROR                   00222700
        END ELSE % ORDINARY OPERATOR                                    00222800
           BEGIN INFIX[ITOP].TYPEFIELD:=OPERATOR;                       00222900
           INFIX[ITOP].LOCFIELD:=ENTIER(ACCUM[0]);                      00223000
           END ELSE                                                     00223100
       IF NUMERIC THEN                                                  00223200
       IF ERR NEQ 0 THEN COMMENT NOTHING; ELSE                          00223300
           BEGIN INFIX[ITOP].TYPEFIELD:=CONSTANT;                       00223400
           IF CURRENTMODE=FUNCMODE THEN                                 00223500
           COMMENT DO NOT STORE NUMERIC IN SCRATCH PAD;                 00223600
           DO UNTIL NOT SCAN OR NOT NUMERIC %THE NULL STATEMENT         00223700
           ELSE                                                         00223800
                BEGIN                                                   00223900
           T:=BUILDCONSTANT(LASTCONSTANT);                              00224000
           IF T=0 THEN ERR:=IF ERR=0 THEN VALUEERROR ELSE ERR ELSE      00224100
           INFIX[ITOP].LOCFIELD:=T;                                     00224200
                END;                                                    00224300
               IF EOB=0 AND ERR=0 THEN GO TO SKIPSCAN;                  00224400
           END ELSE                                                     00224500
       IF IDENT THEN                                                    00224600
               BEGIN INFIX[ITOP].DID:=OPERAND; %SET OPTYPE=NILADIC      00224700
           IF NOT(FUNCMODE EQL CURRENTMODE) THEN                        00224800
               BEGIN J:=0;                                              00224900
               IF FLOC GTR 0 THEN %CHECK LOCAL NAMES                    00225000
                   BEGIN L:=FLOC+2;                                     00225100
                       K:=SP[LOC]-2;%LAST ALPHA POINTER IN TABLE        00225200
                       %SHOULD CONVERT TO BINARY SEARCH                 00225300
                       T:=L+4;                                          00225400
                       FOR L:=T STEP 2 UNTIL K DO                       00225500
                           IF EQUAL(SP[LOC],ACCUM) THEN                 00225600
                           BEGIN J:=L;L:=K;I:=0;                        00225700
                           INFIX[ITOP].SPF:=J;                          00225800
                           INFIX[ITOP].RF:=M-FLOC;                      00225900
                           J:=(J-T+2)/2;                                00226000
                           END;                                         00226100
                   END;                                                 00226200
                                                                        00226300
                                                                        00226400
               IF J EQL 0 THEN                                          00226500
                   BEGIN COMMENT LOOK IN SP SYMBOL TABLE;               00226600
                   IF L:=SYMBASE NEQ 0 THEN COMMENT OK TO LOOK;         00226700
                       BEGIN T:=SP[LOC];K:=L+T;                         00226800
                       COMMENT T=N VARS TIMES 2. K IS TOP LIMIT;        00226900
                       FOR L:=L +1 STEP 2 UNTIL K DO                    00227000
                       IF EQUAL(SP[LOC],ACCUM) THEN                     00227100
                       BEGIN                                            00227200
                       INFIX[ITOP].TYPEFIELD:=I:=SP[LOC].TYPEFIELD;     00227300
                       L:=J:=L+1;                                       00227400
                       IF I=FUNCTION THEN BEGIN                         00227500
                       INFIX[ITOP].RF:=SP[LOC].RETURNVALUE;             00227600
                       INFIX[ITOP].OPTYPE:=SP[LOC].NUMBERARGS;END;      00227700
                       L:=K;                                            00227800
                       END;                                             00227900
                       IF J EQL 0 THEN                                  00228000
                           IF T LSS MAXSYMBOL|2 THEN %INSERT ID         00228100
                           BEGIN L:=K+1; %NEXT AVAILABLE.               00228200
FILLER:                    SETFIELD(GTA,0,1,0);                         00228300
                           TRANSFER(ACCUM,2,GTA,1,7);                   00228400
                           SP[LOC]:=GTA[0];%STORE VARIABLE NAME         00228500
                           OPERANDTOSYMTAB(L);%SET TYPEFIELD AND DESC.  00228600
                           IF GT1=FUNCTION THEN%FUNCTION-FIX INFIX      00228700
                               BEGIN                                    00228800
                               INFIX[ITOP].OPTYPE:=GTA[1].NUMBERARGS;   00228900
                               INFIX[ITOP].TYPEFIELD:=FUNCTION;         00229000
                               INFIX[ITOP].RF:=GTA[1].RETURNVALUE;      00229100
                               END;                                     00229200
                           J:=L+1;                                      00229300
                           L:=SYMBASE;SP[LOC]:=T+2;%UPDATE SYM TAB #    00229400
                           END ELSE SPFULLAB: ERR:=SPERROR;%TAB FULL    00229500
                       END ELSE %CREATE SYMBOL TABLE                    00229600
                       BEGIN                                            00229700
                       SYMBASE:=L:=GS(MAXSYMBOL|2+1);                   00229800
                       IF ERR NEQ 0 THEN                                00229900
                           BEGIN SYMBASE:=0;                            00230000
                           GO TO SPFULLAB;                              00230100
                         END;                                           00230200
                       T:=0; L:=L+1;                                    00230300
                       GO  TO FILLER;                                   00230400
                       END                                              00230500
                   END ELSE INFIX[ITOP].DID:=LOCALVAR&1[44:47:1];       00230600
               INFIX[ITOP].LOCFIELD:=J                                  00230700
               END                                                      00230800
              END ELSE ERR:=SYSTEMERROR;                                00230900
       IF ERR EQL 0 THEN T:=ADDRESS                                     00231000
       END ELSE ERR:=SPERROR                                            00231100
    UNTIL NOT(SCAN AND ERR=0); %DROP THRU WHEN INPUT FIN OR ERR         00231200
    COMMENT NOW LOOK FOR THE POLISH;                                    00231300
    IF ERR NEQ 0 THEN                                                   00231400
        BEGIN ERRORMESS(ERR,INFIX[ITOP].ADDRFIELD,0);                   00231500
        END ELSE                                                        00231600
        BEGIN COMMENT MAKE UP THE POLISH;                               00231700
        ARRAY OPERATORS[0:ITOP];                                        00231800
        BOOLEAN PROCEDURE ANDORATOR (VAR,TYPE);                         00231900
            VALUE VAR, TYPE;                                            00232000
            REAL VAR,TYPE;                                              00232100
            BEGIN                                                       00232200
            REAL T;                                                     00232300
            LABEL OPERAN, ATOR;                                         00232400
            COMMENT PROCEDURE TRUE IF VAR IS OF TYPE SPECIFIED;         00232500
            IF T:=VAR.TYPEFIELD=OPERATOR THEN                           00232600
                IF T:=VAR.LOCFIELD NEQ RGTPARENV AND T NEQ              00232700
                    QQUAD AND T NEQ QUAD AND T NEQ                      00232800
                    RGTBRACKETV THEN GO ATOR                            00232900
                ELSE GO OPERAN                                          00233000
            ELSE                                                        00233100
            IF T=FUNCTION THEN                                          00233200
                IF VAR.OPTYPE GTR NILADIC THEN                          00233300
            ATOR:   ANDORATOR:=TYPE=OPERATOR                            00233400
                ELSE GO OPERAN                                          00233500
            ELSE                                                        00233600
            OPERAN: ANDORATOR:=TYPE=OPERAND;                            00233700
            END OF ANDORATOR;                                           00233800
    BOOLEAN PROCEDURE RGTOPERAND(VAR); VALUE VAR; REAL VAR;             00233900
        BEGIN REAL T; DEFINE RT=RGTOPERAND:=TRUE#;                      00234000
    IF T:=VAR.TYPEFIELD=OPERAND OR T=CONSTANT OR T=LOCALVAR THEN RT     00234100
        ELSE IF T=OPERATOR AND VAR.LOCFIELD=LFTPARENV THEN RT           00234200
        ELSE IF T=FUNCTION AND VAR.OPTYPE LEQ MONADIC THEN RT;          00234300
        END OF RGTOPERAND;                                              00234400
        BOOLEAN VALID;                                                  00234500
        INTEGER OTOP;                                                   00234600
      INTEGER BCT,N; REAL COLONCTR;                                     00234700
        LABEL STACKOPERAND, STACKFUNCTION;                              00234800
        DEFINE PTOP=L#;                                                 00234900
        LABEL AROUND, NOK, OK, LFTARROWL, LFTPARENL, RGTPARENL,         00235000
            SLASHL,EXPL,ROTL,MONADICL,DYADICL,ERRL,SORTL,               00235100
            SEMICOLONL, QUADL, DOTL, RELATIONL,                         00235200
            LFTBRACKETL, RGTBRACKETL, QUOTEQUADL;                       00235300
        SWITCH OPERATORSWITCH:= %  IN GROUPS OF 5, STARTING AT 1        00235400
                 NOK, NOK, NOK, LFTARROWL, % 1-4                        00235500
            MONADICL, SLASHL, OK, LFTPARENL,RGTPARENL, %5-9             00235600
            QUADL,LFTBRACKETL,RGTBRACKETL,ERRL,QUOTEQUADL, %10-14       00235700
            SEMICOLONL, OK, DOTL, OK, OK, % 15-19                       00235800
            OK,DYADICL,DYADICL,MONADICL,RELATIONL, % 20-24              00235900
                RELATIONL, RELATIONL, RELATIONL, RELATIONL,             00236000
                RELATIONL,                 % 25-29                      00236100
            OK, OK, OK, OK, OK, %30-34                                  00236200
            OK, OK, ROTL, EXPL, OK, % 35-39                             00236300
            OK,OK,OK,OK,DYADICL, %40-44                                 00236400
            OK, OK, ERRL, OK, OK, %45-49                                00236500
            OK, NOK, NOK, NOK, OK, % 50-54                              00236600
            SORTL,SORTL,OK,OK,OK, % 55-59                               00236700
            DYADICL, DYADICL, MONADICL;     % 60-62                     00236800
        %-----------------------------------------------                00236900
    COMMENT GET AN AREA OF SCRATCH PAD IF WE ARE NOT IN                 00237000
    THE SYNTAX CHECKING MODE;                                           00237100
    J:=(IF CURRENTMODE=FUNCMODE THEN 0 ELSE                             00237200
    GS(ITOP+3));                                                        00237300
        I:=ITOP+1;                                                      00237400
    COMMENT A QUICK SYNTAX CHECK;                                       00237500
    IF ANDORATOR(INFIX[ITOP],OPERATOR) THEN ERR:=SYNTAXERROR;           00237600
    L:=J+1; COMMENT POLISH WILL START TWO UP IN ARRAY;                  00237700
    WHILE ERR=0 AND I GTR 1 DO                                          00237800
    IF T:=INFIX[I:=I-1].TYPEFIELD=OPERATOR THEN                         00237900
    BEGIN                                                               00238000
    GO OPERATORSWITCH[INFIX[I].LOCFIELD];                               00238100
ROTL:                                                                   00238200
    IF I=1 OR NOT ANDORATOR(INFIX[I-1],OPERAND) THEN GO OK;             00238300
    T:=INFIX[I];                                                        00238400
    T.LOCFIELD:=ROTATE;                                                 00238500
    T.OPTYPE:=IF INFIX[I].OPTYPE NEQ DYADIC THEN MONADIC ELSE DYADIC;   00238600
    INFIX[I]:=T; GO TO STACKFUNCTION;                                   00238700
EXPL:                                                                   00238800
SLASHL:     BEGIN DEFINE STARTSEGMENT= #; %/////////////////////        00238900
    IF INFIX[I-1].TYPEFIELD=FUNCTION THEN GO ERRL ELSE                  00239000
    IF ANDORATOR(INFIX[I-1],OPERATOR) THEN                              00239100
        BEGIN                                                           00239200
        INFIX[I].LOCFIELD:=IF INFIX[I].LOCFIELD=SLASHV THEN             00239300
            REDUCT ELSE SCANV;                                          00239400
                                                                        00239500
        IF INFIX[I].OPTYPE NEQ DYADIC THEN INFIX[I].OPTYPE:=MONADIC;    00239600
        GO OK;                                                          00239700
        END                                                             00239800
    ELSE                                                                00239900
                                                                        00240000
    IF INFIX[I].OPTYPE NEQ DYADIC THEN INFIX[I].OPTYPE:=MONADIC;        00240100
    IF I=1 THEN                                                         00240200
                                                                        00240300
        BEGIN                                                           00240400
        ERR:=SYNTAXERROR;                                               00240500
        GO AROUND;                                                      00240600
        END;                                                            00240700
    GO OK; END;                                                         00240800
SORTL:                                                                  00240900
    IF I=1 OR ANDORATOR(INFIX[I-1],OPERATOR) THEN GO OK ELSE GO ERRL;   00241000
LFTPARENL:                                                              00241100
    K:=I;                                                               00241200
    UNSTACK(SP,PTOP,OPERATORS,OTOP,2,RGTPARENV,RGTBRACKETV);            00241300
    GO AROUND;                                                          00241400
RELATIONL:                                                              00241500
DYADICL:                                                                00241600
    IF I GTR 1 THEN                                                     00241700
        IF ANDORATOR(INFIX[I-1],OPERAND) THEN                           00241800
            BEGIN                                                       00241900
            INFIX[I].OPTYPE:=DYADIC;                                    00242000
            GO STACKFUNCTION;                                           00242100
            END;                                                        00242200
    IF (GT3:=(T:=INFIX[I+1]).LOCFIELD=REDUCT OR GT3=SCANV)              00242300
        AND T.TYPEFIELD=OPERATOR THEN GO OK;                            00242400
    IF(T:=INFIX[I-1]).LOCFIELD=DOTV AND T.TYPEFIELD=OPERATOR THEN GO OK;00242500
    GO TO ERRL;                                                         00242600
MONADICL:                                                               00242700
    IF I=1 OR ANDORATOR(INFIX[I-1],OPERATOR)                            00242800
        THEN BEGIN                                                      00242900
        INFIX[I].OPTYPE:=MONADIC;                                       00243000
        GO TO STACKFUNCTION;                                            00243100
        END                                                             00243200
        ELSE                                                            00243300
        GO ERRL;                                                        00243400
LFTBRACKETL:                                                            00243500
    IF BCT:=BCT-1 LSS 0 THEN ERR:=SYNTAXERROR;                          00243600
   UNSTACK(SP,PTOP,OPERATORS,OTOP,1,RGTBRACKETV,RGTPARENV);             00243700
    IF OTOP=1 THEN BEGIN                                                00243800
        ERR:=SYNTAXERROR; GO AROUND; END                                00243900
    ELSE IF J NEQ 0 THEN                                                00244000
        BEGIN                                                           00244100
        IF T:=INFIX[I-1].TYPEFIELD=OPERAND OR T=LOCALVAR   THEN         00244200
      BEGIN DEFINE STARTSEGMENT= #; %///////////////////////////        00244300
          %LFTBRACKET PART OF SUBSCRIPTED VARIABLE                      00244400
            IF OPERATORS[OTOP].OPTYPE=0 THEN GO TO ERRL;                00244500
            COMMENT IF ABOVE TRUE THEN THERE WAS AN OPERAND TO THE RITE;00244600
            L:=L+1;                                                     00244700
            N:=GT1:=GETSPACE(1);                                        00244800
            SP[NOC]:=COLONCTR+1; % STORE NUMBER OF DIMENSIONS           00244900
            N:=GETSPACE(1); % BUILD A DESCRIPTOR FOR # OF DIMENSIONS    00245000
            T.SPF:=GT1;                                                 00245100
             T.DID:=DDPNSW;                                             00245200
            T.BACKP:=LASTCONSTANT;                                      00245300
            SP[NOC]:=T;                                                 00245400
            T:=INFIX[I];                                                00245500
           T.LOCFIELD:=LASTCONSTANT:=N; % LINK TO CONSTANT CHAIN        00245600
           T.TYPEFIELD:=CONSTANT;                                       00245700
           SP[LOC]:=T; % PUT ON POLISH                                  00245800
           L:=L+1;                                                      00245900
            IF OPERATORS[OTOP].OPTYPE=3 THEN % LEFT SIDE OF REPLACEOP   00246000
            INFIX[I-1].TYPEFIELD:=REPLACELOC;                           00246100
            SP[LOC]:=INFIX[I-1]; % PLACE OPERAND ON POLISH              00246200
            L:=L+1;                                                     00246300
            SP[LOC]:=INFIX[I]; % COLLAPSE OPERATOR TO POLISH            00246400
            I:=I-1;                                                     00246500
            END                                                         00246600
        ELSE IF T:=INFIX[I-1].LOCFIELD=SLASHV OR                        00246700
            T=EXPANDV OR T=ROTV OR T=SORTUPV OR T=SORTDNV THEN          00246800
            IF INFIX[I-1].TYPEFIELD=OPERATOR AND OPERATORS[OTOP]        00246900
                .OPTYPE=0 THEN INFIX[I-1].OPTYPE:=DYADIC                00247000
            ELSE ERR:=SYNTAXERROR                                       00247100
            ELSE ERR:=SYNTAXERROR;                                      00247200
       END;                                                             00247300
        COLONCTR:=OPERATORS[OTOP:=OTOP-1];                              00247400
        IF OTOP:=OTOP-1 LSS 0 THEN ERR:=SYNTAXERROR;                    00247500
        GO AROUND;                                                      00247600
RGTPARENL:                                                              00247700
    IF OTOP LSS ITOP DIV 2 THEN ELSE ERR:=SYNTAXERROR;                  00247800
    OPERATORS[OTOP:=OTOP+1]:=INFIX[I];                                  00247900
    GO AROUND;                                                          00248000
RGTBRACKETL:  BEGIN DEFINE STARTSEGMENT= #; %///////////////////        00248100
   BCT:=BCT+1;                                                          00248200
    IF OTOP+2 GEQ ITOP THEN                                             00248300
    BEGIN                                                               00248400
    ERR:=SYNTAXERROR;                                                   00248500
    GO AROUND;                                                          00248600
    END;                                                                00248700
   OPERATORS[OTOP:=OTOP+1]:=COLONCTR;                                   00248800
    GT1:=OPERATORS[OTOP:=OTOP+1]:=INFIX[I]; COLONCTR:=0;                00248900
    IF I NEQ ITOP THEN                                                  00249000
        IF GT1.OPTYPE NEQ 3 THEN                                        00249100
            OPERATORS[OTOP].OPTYPE:=IF RGTOPERAND(INFIX[I+1]) THEN      00249200
               0 ELSE 2                                                 00249300
        ELSE                                                            00249400
    ELSE OPERATORS[OTOP].OPTYPE:=2;                                     00249500
          IF J NEQ 0 AND INFIX[I-1].LOCFIELD=SEMICOLONV THEN            00249600
         BEGIN                                                          00249700
        T.LOCFIELD:=BUILDNULL(LASTCONSTANT);                            00249800
        T.TYPEFIELD:=CONSTANT;                                          00249900
        L:=L+1; K:=I;                                                   00250000
        SP[LOC]:=T;                                                     00250100
        END;                                                            00250200
    GO AROUND; END;                                                     00250300
LFTARROWL:                                                              00250400
    IF I=1 THEN ERR:=SYNTAXERROR                                        00250500
    ELSE                                                                00250600
    IF T:=INFIX[I-1].TYPEFIELD=OPERAND OR T=LOCALVAR THEN               00250700
            INFIX[I-1].TYPEFIELD:=REPLACELOC                            00250800
    ELSE                                                                00250900
    IF T=OPERATOR THEN                                                  00251000
        IF T:=INFIX[I-1].LOCFIELD=QUAD OR T=QUADLFTARROW THEN           00251100
            INFIX[I:=I-1].LOCFIELD:=QUADLFTARROW                        00251200
        ELSE IF T=RGTBRACKETV THEN INFIX[I-1].OPTYPE:=3                 00251300
        %WILL TEST LATER TO INDICATE REPLACEMENT IN MATRIX 3105154      00251400
            ELSE ERR:=SYNTAXERROR                                       00251500
    ELSE ERR:=SYNTAXERROR;                                              00251600
    IF ERR=0 THEN GO OK ELSE GO AROUND;                                 00251700
QUOTEQUADL:                                                             00251800
QUADL:                                                                  00251900
    COMMENT INPUT IS BEING REQUESTED;                                   00252000
    GO TO STACKOPERAND;                                                 00252100
DOTL:  BEGIN DEFINE STARTSEGMENT=#; %////////////////////////////       00252200
    IF I GTR 2 THEN                                                     00252300
        IF (T:=INFIX[I-1]).TYPEFIELD=OPERATOR AND                       00252400
            ANDORATOR(T,OPERATOR) THEN                                  00252500
            IF (T:=INFIX[I+1]).TYPEFIELD=OPERATOR AND                   00252600
                ANDORATOR(T,OPERATOR) THEN                              00252700
                    IF ANDORATOR(INFIX[I-2],OPERAND) THEN               00252800
            COMMENT THEN SYNTAX OK;                                     00252900
            BEGIN                                                       00253000
            COMMENT STACK OPERATORS SO THAT IF GIVEN A+.XB              00253100
                POLISH IS BA.+X;                                        00253200
            OPERATORS[OTOP].OPTYPE:=TRIADIC;                            00253300
            OPERATORS[OTOP:=OTOP+1]:=INFIX[I-1];                        00253400
            INFIX[I].OPTYPE:=TRIADIC;                                   00253500
            OPERATORS[OTOP:=OTOP+1]:=INFIX[I];                          00253600
            I:=I-1;                                                     00253700
            VALID:=TRUE;                                                00253800
            END;                                                        00253900
        IF NOT VALID THEN ERR:=SYNTAXERROR;                             00254000
        VALID:=FALSE;                                                   00254100
    GO AROUND; END;                                                     00254200
SEMICOLONL:  BEGIN DEFINE STARTSEGMENT=#; %//////////////////////       00254300
    IF BCT NEQ 0 THEN                                                   00254400
    BEGIN                                                               00254500
    COLONCTR:=COLONCTR+1;                                               00254600
    IF I-1=0 THEN ERR:=SYNTAXERROR                                      00254700
    ELSE                                                                00254800
    BEGIN                                                               00254900
     UNSTACK(SP,PTOP,OPERATORS,OTOP,1,RGTBRACKETV,RGTPARENV);           00255000
    IF J NEQ 0 AND (T:=INFIX[I-1].LOCFIELD=SEMICOLONV                   00255100
    OR T =LFTBRACKETV) THEN BEGIN                                       00255200
        T.LOCFIELD:=BUILDNULL(LASTCONSTANT);                            00255300
        T.TYPEFIELD:=CONSTANT;                                          00255400
        L:=L+1; K:=I;                                                   00255500
        SP[LOC]:=T;                                                     00255600
        END;                                                            00255700
    END                                                                 00255800
    END                                                                 00255900
   ELSE COMMENT MUST BE MIXED MODE EXPRESSION;                          00256000
        BEGIN                                                           00256100
        IF ANDORATOR(T:=INFIX[I-1],OPERATOR) THEN                       00256200
            IF T.LOCFIELD NEQ SEMICOLONV THEN GO ERRL;                  00256300
        UNSTACK(SP,PTOP,OPERATORS,OTOP,1,RGTPARENV,RGTBRACKETV);        00256400
        OPERATORS[OTOP:=OTOP+1]:=INFIX[I];                              00256500
        END;                                                            00256600
        GO AROUND;                                                      00256700
    END;                                                                00256800
NOK:                                                                    00256900
    ERR:=SYNTAXERROR;                                                   00257000
    GO AROUND;                                                          00257100
ERRL:                                                                   00257200
    ERR:=SYNTAXERROR;                                                   00257300
    GO AROUND;                                                          00257400
OK:                                                                     00257500
    IF INFIX[I].OPTYPE NEQ 0 THEN GO TO STACKFUNCTION ELSE              00257600
    IF I LSS 2 THEN INFIX[I].OPTYPE:=MONADIC ELSE                       00257700
    INFIX[I].OPTYPE:=IF ANDORATOR(INFIX[I-1],OPERATOR) THEN             00257800
        MONADIC ELSE DYADIC;                                            00257900
                                                                        00258000
                                                                        00258100
STACKFUNCTION:                                                          00258200
        IF I=K-1 THEN OPERATORS[OTOP:=OTOP+1]:=INFIX[I]                 00258300
        ELSE                                                            00258400
        BEGIN                                                           00258500
        UNSTACK(SP,PTOP,OPERATORS,OTOP,1,RGTPARENV,RGTBRACKETV);        00258600
        OPERATORS[OTOP:=OTOP+1]:=INFIX[I];                              00258700
        END;                                                            00258800
        GO AROUND;                                                      00258900
AROUND:                                                                 00259000
    END % OF PROCESSING AN OPERATOR----                                 00259100
        ELSE % COULD BE A FUNCTION                                      00259200
        IF INFIX[I].TYPEFIELD=FUNCTION THEN                             00259300
            IF (T:=INFIX[I]).OPTYPE GEQ MONADIC THEN                    00259400
                GO TO STACKFUNCTION                                     00259500
            ELSE                                                        00259600
            IF T.RF=RETURNVAL THEN GO TO STACKOPERAND                   00259700
            ELSE % MUST NOT RETURN A VALUE                              00259800
            IF I=1 THEN GO TO STACKOPERAND                              00259900
            ELSE ERR:=SYNTAXERROR                                       00260000
    ELSE % MUST BE AN OPERAND, CONSTANT OR LOCAL                        00260100
STACKOPERAND:                                                           00260200
        BEGIN DEFINE STARTSEGMENT=#; %///////////////////////////////   00260300
        IF ITOP=1 THEN ELSE                                             00260400
        IF I=ITOP AND I NEQ 1 THEN                                      00260500
            IF ANDORATOR(INFIX[I-1],OPERAND) THEN                       00260600
                IF INFIX[I-1].LOCFIELD=RGTBRACKETV THEN                 00260700
                ELSE GO ERRL                                            00260800
            ELSE                                                        00260900
        ELSE                                                            00261000
        IF I=1 AND I NEQ ITOP THEN                                      00261100
            IF RGTOPERAND(INFIX[I+1]) THEN GO ERRL                      00261200
            ELSE                                                        00261300
        ELSE                                                            00261400
        IF ANDORATOR(INFIX[I-1],OPERAND) OR RGTOPERAND(INFIX[I+1])      00261500
            THEN                                                        00261600
                IF INFIX[I-1].LOCFIELD=RGTBRACKETV THEN                 00261700
                ELSE GO ERRL;                                           00261800
        IF J NEQ 0 THEN                                                 00261900
            BEGIN L:=L+1;                                               00262000
            SP[LOC]:=INFIX[I];                                          00262100
           END; K:=I;                                                   00262200
        UNSTACK(SP,PTOP,OPERATORS,OTOP,1,RGTPARENV,RGTBRACKETV);        00262300
        END; % OF GOING THROUGH INFIX                                   00262400
        IF ERR NEQ 0 THEN ERRORMESS(ERR,INFIX[I].ADDRFIELD,0) ELSE      00262500
        WHILE OTOP GTR 0 AND ERR=0 DO                                   00262600
        BEGIN IF T:=OPERATORS[OTOP].LOCFIELD=RGTPARENV OR               00262700
        T=RGTBRACKETV THEN                                              00262800
            IF OPERATORS[OTOP].TYPEFIELD=OPERATOR THEN                  00262900
           ERRORMESS(ERR:=SYNTAXERROR,OPERATORS[OTOP].ADDRFIELD         00263000
           ,0);                                                         00263100
        IF J NEQ 0 THEN                                                 00263200
            BEGIN L:=L+1;                                               00263300
            SP[LOC]:=OPERATORS[OTOP]                                    00263400
            END; OTOP:=OTOP-1;                                          00263500
        END;                                                            00263600
        IF J NEQ 0 AND DISPLAYOP THEN                                   00263700
            IF SP[LOC].TYPEFIELD NEQ OPERATOR OR                        00263800
                T:=SP[LOC].LOCFIELD NEQ LFTARROWV                       00263900
                AND T NEQ QUADLFTARROW AND T NEQ GOTOV THEN             00264000
                BEGIN COMMENT ADD DIISPLAY OPERATOR TO POLISH;          00264100
                L:=L+1;                                                 00264200
                T.TYPEFIELD:=OPERATOR;                                  00264300
                T.OPTYPE:=MONADIC;                                      00264400
                T.LOCFIELD:=QUADLFTARROW;                               00264500
                SP[LOC]:=T;                                             00264600
                END;                                                    00264700
        IF J NEQ 0 THEN                                                 00264800
            IF ERR NEQ 0 THEN FORGETSPACE (J,ITOP+3,SP) ELSE            00264900
            COMMENT STORE POLISH AND BUFFER;                            00265000
        BEGIN COMMENT SAVE LENGTH OF POLISH;                            00265100
    DEFINE STARTSEGMENT=#; %////////////////////////////////////        00265200
        T:=L-J; % DELETE ANY EXTRA SPACE ALLOCATED FOR POLISH           00265300
        IF T LSS ITOP+2 THEN FORGETSPACE(L+1,2+ITOP-T,SP);              00265400
        COMMENT THEN GETSPACE FOR BUFFER;                               00265500
    L:=GS(((K:=LENGTH(BUFFER, CURRENTMODE=                              00265600
            CALCMODE))-1) DIV 8 +2);                                    00265700
        COMMENT L IS THE ADDRESS OF THE BUFFER;                         00265800
        SP[LOC]:=K; %NUMBER OF CHARACTERS IN THE BUFFER;                00265900
        TRANSFERSP(INTO,SP,L+1,BUFFER,0,ENTIER((K+7)DIV 8));            00266000
            COMMENT WE HAVE MOVED IN THE BUFFER;                        00266100
        K:=L; %SAVE THE ADDRESS OF THE BUFFER;                          00266200
        L:=J+1; % ONE WORD UP IN THE POLISH                             00266300
        SP[LOC].SPF:=K; %STORE ADDRESS OF BUFFER                        00266400
        SP[LOC].RF:=1;  % SET THE RANK TO 1                             00266500
        SP[LOC].DID:=DDPNVC;                                            00266600
        L:=L-1;          %SET THE LENGTH OF POLISH                      00266700
        SP[LOC]:=T;       %STORE THE LENGTH OF THE POLISH               00266800
        T:=0; T.SPF:=J; T.RF:=1; %SET UP PROG DESC IN T                 00266900
        T.BACKP:=LASTCONSTANT;                                          00267000
        T.DID:=PDC; ANALYZE:=T;                                         00267100
        COMMENT DEBUG THE POLISH IF NECESSARY;                          00267200
       IF POLBUG=1 THEN DUMPOLISH(SP,T);                                00267300
            END;                                                        00267400
        %--------------------------------------------------             00267500
        END;                                                            00267600
    END;                                                                00267700
    PROCEDURE OPERANDTOSYMTAB(L);VALUE L;INTEGER L;                     00267800
        BEGIN                                                           00267900
        INTEGER N;                                                      00268000
        TRANSFER(ACCUM,2,GTA,0,7);                                      00268100
        IF(IF VARIABLES=0 THEN FALSE ELSE                               00268200
            SEARCHORD(VARIABLES,GTA,GT1,7)=0) THEN                      00268300
            BEGIN                                                       00268400
            SP[LOC].TYPEFIELD:=GT1:=GETFIELD(GTA,7,1);                  00268500
            IF GT1=FUNCTION THEN                                        00268600
                BEGIN                                                   00268700
                L:=L+1;SP[LOC]:=GTA[1]                                  00268800
                END ELSE %MUST BE AN OPERAND                            00268900
                BEGIN                                                   00269000
                SP[LOC].TYPEFIELD:=OPERAND;                             00269100
                L:=L+1;                                                 00269200
                IF GT1=0 THEN % THIS IS THE SCALAR CASE                 00269300
                    BEGIN N:=GETSPACE(1);                               00269400
                    SP[LOC]:=N&DDPNSW[CDID];                            00269500
                    SP[NOC]:=GTA[1];                                    00269600
                    END ELSE %IT MUST BE A VECTOR                       00269700
                    SP[LOC]:=GTA[1];                                    00269800
                END;                                                    00269900
            END ELSE % NOT IN THE SYMBOL TABLE                          00270000
            BEGIN                                                       00270100
            SP[LOC].TYPEFIELD:=GT1:=OPERAND;                            00270200
            L:=L+1; SP[LOC]:=NAMEDNULLV;                                00270300
            % THE UNDEFINED SYMBOL IS A NULL                            00270400
                                                                        00270500
            END;                                                        00270600
        END; %OF PROCEDURE OPERANDTOSYMTAB                              00270700
    INTEGER PROCEDURE GETSPACE(LENGTH); VALUE LENGTH;                   00270800
        INTEGER LENGTH;                                                 00270900
        BEGIN                                                           00271000
        LABEL ENDGETSPACE,SPOVERFLOW;                                   00271100
        MONITOR INDEX;                                                  00271200
        INTEGER L,NEXTAREA,LASTAREA,OLDROW,K;                           00271300
        INTEGER MEMCHECK;                                               00271400
        REAL LINK;                                                      00271500
        INDEX:=SPOVERFLOW;                                              00271600
        NEXTAREA:=SP[0,0];                                              00271700
        LASTAREA:=0;                                                    00271800
        DO BEGIN COMMENT FIND A LARGE ENOUGH AREA;                      00271900
            IF MEMCHECK:=MEMCHECK+1 GTR MAXMEMACCESSES THEN %ERR        00272000
        BEGIN GETSPACE:=-1@10; ERR:=SPERROR;                            00272100
            GO TO ENDGETSPACE END;                                      00272200
            IF NEXTAREA =0 THEN COMMENT END OF STORAGE;                 00272300
                BEGIN                                                   00272400
                    IF NROWS:=(OLDROW:=NROWS)+K:=ENTIER(LENGTH/         00272500
                        SPRSIZE+1)                                      00272600
                    GTR MAXSPROWS THEN %OFF THE END OF SP               00272700
                    BEGIN COMMENT TAKE EASY WAY IOUT FOR NOW;           00272800
                    GETSPACE:=-1@10; %CAUSE INVALID INDEX               00272900
                NROWS:=OLDROW; ERR:=SPERROR;                            00273000
                    GO TO ENDGETSPACE;                                  00273100
                    END;                                                00273200
                K:=K|SPRSIZE;                                           00273300
                                                                        00273400
                L:=LASTAREA;                                            00273500
                IF OLDROW = -1 THEN COMMENT FORST RQOW OF SP;           00273600
                     BEGIN SP[0,0].NEXT:=L:=1; K:=K-1                   00273700
                     END ELSE                                           00273800
                BEGIN SP[LOC].NEXT:=(OLDROW+1)|SPRSIZE;                 00273900
                    L:=(OLDROW+1)|SPRSIZE;                              00274000
                     END;                                               00274100
                SP[LOC].LEN:=K; SP[LOC].NEXT:=0;                        00274200
                NEXTAREA:=L                                             00274300
                END ELSE L:=NEXTAREA;                                   00274400
            LINK:=SP[LOC];                                              00274500
            K:=LINK.LEN-LENGTH;                                         00274600
            IF K LSS 0 THEN COMMENT NOT ENOUGH ROOM;                    00274700
                BEGIN L:=LASTAREA:=NEXTAREA;                            00274800
                NEXTAREA:=LINK.NEXT                                     00274900
                END;                                                    00275000
            END UNTIL K GEQ 0;                                          00275100
        IF K GTR 0 THEN                                                 00275200
            BEGIN ;L:=L+LENGTH;                                         00275300
            SP[LOC]:=0;                                                 00275400
            SP[LOC].LEN:=K; SP[LOC].NEXT:=LINK.NEXT;                    00275500
            END ELSE L:=LINK.NEXT;                                      00275600
        K:=L; L:=LASTAREA;                                              00275700
        COMMENT ZERO OUT THE STORAGE BEFORE ALLOCATION;                 00275800
        SP[LOC].NEXT:=K; K:=NEXTAREA+LENGTH-1;                          00275900
        FOR L:=GETSPACE:=NEXTAREA STEP 1 UNTIL K DO SP[LOC]:=0;         00276000
        IF FALSE THEN SPOVERFLOW: BEGIN                                 00276100
            GETSPACE:=-1@10;ERR:=SPERROR END;                           00276200
        ENDGETSPACE:                                                    00276300
        END OF GETSPACE;                                                00276400
    PROCEDURE FORGETSPACE(LOCATE,LENGTH); VALUE LOCATE,LENGTH;          00276500
        INTEGER LOCATE,LENGTH;                                          00276600
        BEGIN INTEGER L;                                                00276700
            IF LENGTH GTR 0 THEN BEGIN                                  00276800
        L:=LOCATE;                                                      00276900
        SP[LOC]:=SP[0,0];                                               00277000
        SP[LOC].LEN:=LENGTH;                                            00277100
        SP[0,0]:=L;                                                     00277200
            END;                                                        00277300
        END;                                                            00277400
INTEGER PROCEDURE BUILDNULL(LASTCONSTANT);                              00277500
    INTEGER LASTCONSTANT;                                               00277600
    BEGIN REAL T, N;                                                    00277700
    IF NOT CURRENTMODE=FUNCMODE THEN                                    00277800
    BEGIN                                                               00277900
    T:=0;                                                               00278000
    T.DID:=DDPNVW;                                                      00278100
    T.BACKP:=LASTCONSTANT;                                              00278200
    LASTCONSTANT:=BUILDNULL:=N:=GETSPACE(1);                            00278300
    SP[NOC]:=T;                                                         00278400
    END;                                                                00278500
    END OF BUILDNULL;                                                   00278600
                                                                        00278700
INTEGER PROCEDURE BUILDCONSTANT(LASTCONSTANT);                          00278800
INTEGER LASTCONSTANT;                                                   00278900
    BEGIN ARRAY A[0:MAXCONSTANT];                                       00279000
    INTEGER ATOP,L,K;                                                   00279100
    REAL AP;                                                            00279200
    DEFINE GS=GETSPACE#;                                                00279300
    DO                                                                  00279400
        A[ATOP:=ATOP+1]:=ACCUM[0]                                       00279500
    UNTIL NOT SCAN OR NOT NUMERIC OR ATOP = MAXCONSTANT;                00279600
    IF MAXCONSTANT=ATOP OR ERR NEQ 0 THEN COMMENT AN ERROR;             00279700
        ELSE                                                            00279800
                                                                        00279900
        IF ATOP=1 THEN COMMENT SCALAR FOUND;                            00280000
            BEGIN L:=K:=GS(1);                                          00280100
            SP[LOC]:=A[1];                                              00280200
            BUILDCONSTANT:=L:=GETSPACE(1);                              00280300
            SP[LOC]:=K&DDPNSW[CDID]&LASTCONSTANT[CLOCF];                00280400
            LASTCONSTANT:=L;                                            00280500
            END ELSE COMMENT VECTOR;                                    00280600
            BEGIN L:=K:=GS(ATOP+1);                                     00280700
            TRANSFERSP(INTO,SP,L+1,A,1,ATOP);                           00280800
            SP[LOC]:=ATOP;                                              00280900
            BUILDCONSTANT:=L:=GS(1); %VECTOR DESCRIPTOR                 00281000
            SP[LOC]:=K&1[CRF]&DDPNVW[CDID]&LASTCONSTANT[CLOCF];         00281100
            LASTCONSTANT:=L;                                            00281200
            END                                                         00281300
                                                                        00281400
    END;                                                                00281500
    OWN INTEGER OLDDATA,REALLYERROR;                                    00281600
    INTEGER L,N,M;                                                      00281700
     OWN REAL ST,T,U;                                                   00281800
    LABEL EXECUTION,PROCESSEXIT;                                        00281900
    DEFINE STLOC=ST.[30:11],ST.[41:7]#,                                 00282000
    STMINUS=(ST-1).[30:11],(ST-1).[41:7]#,                              00282100
    AREG=SP[STLOC]#,                                                    00282200
    BREG=SP[STMINUS]#,                                                  00282300
    BACKPT=6:36:12#,                                                    00282400
    CI=18:36:12#,                                                       00282500
    SPTSP=30:30:18#,                                                    00282600
    PROGMKS=0#,                                                         00282700
    IMKS=2#,                                                            00282800
    FMKS=1#,                                                            00282900
                                                                        00283000
    BACKF=[6:12]#,                                                      00283100
    CIF=[18:12]#,                                                       00283200
    ENDEF=#;                                                            00283300
    PROCEDURE PACK(L,OFFSET,N);VALUE L,OFFSET,N;INTEGER L,OFFSET,N;     00283400
        FORWARD;                                                        00283500
    INTEGER PROCEDURE UNPACK(S,OFFSET,N);VALUE S,OFFSET,N;              00283600
        INTEGER S,OFFSET,N; FORWARD;                                    00283700
    PROCEDURE PUSH;                                                     00283800
        IF ST LSS STACKSIZE+STACKBASE THEN ST:=ST+1 ELSE                00283900
       ERR:=DEPTHERROR;                                                 00284000
   PROCEDURE POP;                                                       00284100
        BEGIN REAL U;                                                   00284200
        IF ST GTR STACKBASE THEN                                        00284300
            IF BOOLEAN((U:=AREG).NAMED)OR NOT BOOLEAN(U.PRESENCE)       00284400
                THEN ST:=ST-1 ELSE                                      00284500
            BEGIN COMMENT GET RID OF SP STORAGE FOR THIS VARIABLE;      00284600
            IF U.SPF NEQ 0 AND BOOLEAN(U.DATADESC) THEN                 00284700
            SCRATCHDATA(U);                                             00284800
                                                                        00284900
            ST:=ST-1;                                                   00285000
            END                                                         00285100
        ELSE ERR:=SYSTEMERROR;                                          00285200
        END;                                                            00285300
    REAL PROCEDURE GETARRAY(DESCRIPTOR); VALUE DESCRIPTOR;              00285400
        REAL DESCRIPTOR;                                                00285500
        BEGIN                                                           00285600
        INTEGER R,I,J,K,L,LL,TOTAL,PT;                                  00285700
        REAL T;                                                         00285800
        ARRAY BLOCK[0:BLOCKSIZE],DIMVECTOR[0:32];                       00285900
        %SEE MAXWORDSTORE, LINE 17260                                   00286000
                                                                        00286100
       T:=DESCRIPTOR;                                                   00286200
       IF (R:=DESCRIPTOR.RF=0) THEN T.DIMPTR:=0                         00286300
        ELSE BEGIN                                                      00286400
           I:=CONTENTS(WS,DESCRIPTOR.DIMPTR,DIMVECTOR);                 00286500
            TOTAL:=1;                                                   00286600
            FOR I:=0 STEP 1 UNTIL R-1 DO                                00286700
                TOTAL:=TOTAL|DIMVECTOR[I];                              00286800
            IF DESCRIPTOR.ARRAYTYPE=CHARARRAY THEN                      00286900
                TOTAL:=ENTIER((TOTAL+7) DIV 8);                         00287000
            TOTAL:=TOTAL+R;                                             00287100
            LL:=GETSPACE(TOTAL);                                        00287200
            TRANSFERSP(INTO,SP,LL,DIMVECTOR,0,R);                       00287300
            L:=LL+R;                                                    00287400
            J:=CONTENTS(WS,DESCRIPTOR.INPTR,DIMVECTOR)-1;               00287500
           GTA[0]:=0;                                                   00287600
            FOR I:=0 STEP 2 UNTIL J DO                                  00287700
                 BEGIN                                                  00287800
                TRANSFER(DIMVECTOR,I,GTA,6,2);                          00287900
                PT:=GTA[0];                                             00288000
               K:=CONTENTS(WS,PT,BLOCK);                                00288100
                 TRANSFERSP(INTO,SP,L,BLOCK,0,                          00288200
                (K:=ENTIER((K+7)DIV 8)));                               00288300
                 L:=L+K;                                                00288400
                 END;                                                   00288500
            T.DIMPTR:=L;                                                00288600
           END;                                                         00288700
       T.INPTR:=0;                                                      00288800
       T.PRESENCE:=1;                                                   00288900
       GETARRAY:=T;                                                     00289000
        END;                                                            00289100
    INTEGER PROCEDURE FINDSIZE(D);VALUE D; REAL D;                      00289200
        BEGIN                                                           00289300
        INTEGER I,J,M,R;                                                00289400
     J:=1; I:=D.SPF; R:=D.RF+I-1;                                       00289500
    IF I NEQ 0 THEN                                                     00289600
     FOR M:=T STEP 1 UNTIL R DO J:=J|SP[MOC];                           00289700
     FINDSIZE:=J;                                                       00289800
     END PROCEDURE FINDSIZE;                                            00289900
                                                                        00290000
    INTEGER PROCEDURE NUMELEMENTS(D); VALUE D; REAL D;                  00290100
        BEGIN                                                           00290200
        INTEGER I;                                                      00290300
        GT1:=I:=FINDSIZE(D);                                            00290400
        IF D.ARRAYTYPE=CHARARRAY THEN                                   00290500
            I:=ENTIER((I+7) DIV 8);                                     00290600
        NUMELEMENTS:=I;                                                 00290700
        END;                                                            00290800
    PROCEDURE SCRATCHDATA(D); VALUE D; REAL D;                          00290900
        BEGIN                                                           00291000
        INTEGER T,R;                                                    00291100
        IF BOOLEAN(D.SCALAR) THEN T:=1 ELSE                             00291200
            IF R:=D.RF = 0 THEN T:=0 ELSE %BONAFIDE VECTOR              00291300
                BEGIN T:=NUMELEMENTS(D)+R;                              00291400
                                                                        00291500
                END;                                                    00291600
        IF T NEQ 0 THEN FORGETSPACE(D.SPF,T);                           00291700
        END;                                                            00291800
    COMMENT RELEASEARRAY HAS BEEN MOVED WOUT OF PROCESS SO THAT IT      00291900
        CAN BE CALLED ELSEWHERE;                                        00292000
    REAL PROCEDURE MOVEARRAY(SPDESC); VALUE SPDESC;                     00292100
        REAL SPDESC;                                                    00292200
        COMMENT MOVE THE ARRAY FROM SCRATCHPAD TO PERMANENT             00292300
        STORAGE AND CONSTRUCT NEW DESCRIPTOR;                           00292400
        BEGIN                                                           00292500
        INTEGER TOTAL,R,J,M,K;                                          00292600
        REAL T;                                                         00292700
    ARRAY BLOCK[0:BLOCKSIZE],BUFFER[0:32]; %SEE MAXWORDSTORE, LINE 1726000292800
        T:=SPDESC;                                                      00292900
        TRANSFERSP(OUTOF,SP,SPDESC.SPF,BUFFER,0,R:=SPDESC.RF);          00293000
        T.DIMPTR:=STORESEQ(WS,BUFFER,8|R);                              00293100
        TOTAL:=NUMELEMENTS(SPDESC);                                     00293200
        M:=SPDESC.SPF+R;                                                00293300
        K:=ENTIER(TOTAL DIV BLOCKSIZE)-1;                               00293400
        FOR J:=0 STEP 1 UNTIL K DO BEGIN                                00293500
            TRANSFERSP(OUTOF,SP,M,BLOCK,0,BLOCKSIZE);                   00293600
            R:=STORESEQ(WS,BLOCK,BLOCKSIZE|8);                          00293700
            TRANSFER(R,6,BUFFER,J|2,2);                                 00293800
            M:=M+BLOCKSIZE;                                             00293900
            END;                                                        00294000
        IF J:=TOTAL-(K:=K+1)|BLOCKSIZE GTR 0 THEN                       00294100
            BEGIN                                                       00294200
            TRANSFERSP(OUTOF,SP,M,BLOCK,0,J); %GET REMAINDER OF MATRIX  00294300
            R:=STORESEQ(WS,BLOCK,J|8);                                  00294400
            TRANSFER(R,6,BUFFER,K|2,2);                                 00294500
            K:=K+1;                                                     00294600
            END;                                                        00294700
        T.INPTR:=STORESEQ(WS,BUFFER,K|K);                               00294800
        MOVEARRAY:=T;                                                   00294900
        END;                                                            00295000
    PROCEDURE WRITEBACK;                                                00295100
        COMMENT COPY CHANGED VARIABLES INTO PREMANENT STORAGE;          00295200
        BEGIN                                                           00295300
        INTEGER I,J,K,L,M,NUM;                                          00295400
        REAL T;                                                         00295500
        ARRAY NEWDESC[0:1],OLDDESC [0:1];                               00295600
        L:=SYMBASE;                                                     00295700
        NUM:=SP[LOC]-1;                                                 00295800
        L:=L-1;                                                         00295900
        FOR I:=1 STEP 2 UNTIL NUM DO BEGIN                              00296000
            L:=L+2;                                                     00296100
            IF ((T:=SP[LOC]).TYPEFIELD) NEQ FUNCTION THEN               00296200
              IF BOOLEAN(T.CHANGE) THEN BEGIN                           00296300
               IF VARIABLES=0 THEN                                      00296400
                                                                        00296500
                    BEGIN VARIABLES:=NEXTUNIT;                          00296600
                    T:=CURRENTMODE;                                     00296700
                    VARSIZE:=1; STOREPSR;                               00296800
                    CURRENTMODE:=T; VARSIZE:=0;                         00296900
                    END;                                                00297000
                M:=L+1;WHILE(T:=SP[MOC]).BACKP NEQ 0 AND T.PRESENCE=1   00297100
                AND(GT1:=GT1+1)LSS MAXMEMACCESSES DO M:=T.BACKP;GT1:=0; 00297200
                GTA[0]:=SP[LOC];GTA[1]:=T;                              00297300
                TRANSFER(GTA,1,NEWDESC,0,7);                            00297400
                                                                        00297500
                SETFIELD(NEWDESC,7,1, IF BOOLEAN(T.SCALAR)              00297600
                THEN SCALARDATA ELSE ARRAYDATA);                        00297700
                MOVE(NEWDESC,1,OLDDESC); K:=1;                          00297800
                IF (IF VARSIZE=0 THEN FALSE ELSE                        00297900
                    K:=SEARCHORD(VARIABLES,NEWDESC,J,7)=0)              00298000
                    THEN BEGIN                                          00298100
                    K:=CONTENTS(VARIABLES,J,OLDDESC);                   00298200
                    DELETE1(VARIABLES,J);                               00298300
                    IF GETFIELD(OLDDESC,7,1)=ARRAYDATA THEN             00298400
                        RELEASEARRAY(OLDDESC[1]);                       00298500
                END ELSE                                                00298600
                BEGIN VARSIZE:=VARSIZE+1; J:=J+K-1;                     00298700
                MOVE(OLDDESC,1,NEWDESC);                                00298800
                END;                                                    00298900
                SETFIELD(NEWDESC,7,1,IF BOOLEAN(T.SCALAR)               00299000
                THEN SCALARDATA ELSE ARRAYDATA);                        00299100
                IF BOOLEAN(T.SCALAR) THEN                               00299200
                    BEGIN M:=T.SPF;                                     00299300
                    NEWDESC[1]:=SP[MOC];                                00299400
                    END ELSE %A VECTEOR                                 00299500
                    BEGIN T.PRESENCE:=0;                                00299600
                    NEWDESC[1]:=(IF T.RF NEQ 0 THEN                     00299700
                    MOVEARRAY(T) ELSE T)                                00299800
                    END;                                                00299900
                STOREORD(VARIABLES,NEWDESC,J);                          00300000
                                                                        00300100
                END;                                                    00300200
            END;                                                        00300300
        END;                                                            00300400
    PROCEDURE SPCOPY(S,D,N);VALUE S,D,N;INTEGER S,D,N;                  00300500
        BEGIN                                                           00300600
        INTEGER K;                                                      00300700
        WHILE (N:=N-K) GTR 0 DO                                         00300800
        TRANSFERSP(INTO,SP,(D:=D+K),SP[(S:=S+K)DIV SPRSIZE,*],          00300900
            K:=S MOD SPRSIZE,K:=MIN(N,SPRSIZE-K));                      00301000
        END;                                                            00301100
    INTEGER PROCEDURE CHAIN(D,CHAINLOC); VALUE D,CHAINLOC;              00301200
        INTEGER CHAINLOC; REAL D;                                       00301300
        BEGIN                                                           00301400
        INTEGER M;                                                      00301500
        CHAIN:=M:=GETSPACE(1);                                          00301600
        D.LOCFIELD:=CHAINLOC;                                           00301700
        SP[MOC]:=D;                                                     00301800
        END;                                                            00301900
    PROCEDURE SCRATCHAIN(L); VALUE L; INTEGER L;                        00302000
        BEGIN                                                           00302100
        REAL R;                                                         00302200
        WHILE L NEQ 0 DO BEGIN                                          00302300
            SCRATCHDATA(R:=SP[LOC]);                                    00302400
            FORGETSPACE(L,1);                                           00302500
            IF L=R.LOCFIELD THEN L:=0 ELSE                              00302600
            L:=R.LOCFIELD;                                              00302700
            END;                                                        00302800
        END;                                                            00302900
PROCEDURE RESTORELOCALS(FPTR);VALUE FPTR;REAL FPTR;                     00303000
    BEGIN                                                               00303100
    INTEGER L,M,N,I,K,FLOC;                                             00303200
    REAL T;                                                             00303300
    M:=FPTR.LOCFIELD;                                                   00303400
    L:=FPTR.SPF+2;K:=SP[LOC]-2;%LAST ALPHA POINTER                      00303500
    T:=L+4;                                                             00303600
    FOR I:=T STEP 2 UNTIL K DO % ONCE FOR EACH LOCAL                    00303700
        BEGIN                                                           00303800
        M:=M+1;N:=SP[MOC].SPF; %LOCATION IN SYMBOL TABLE                00303900
        T:=SP[NOC];L:=T.BACKP;T.BACKP:=0;T.NAMED:=0;                    00304000
        SP[MOC]:=T;%COPY OF DESCRIPTOR TO STACK                         00304100
        IF L=0 THEN                                                     00304200
            BEGIN N:=N-1; GTA[0]:=SP[NOC];                              00304300
            TRANSFER(GTA,1,ACCUM,2,7); OPERANDTOSYMTAB(N);              00304400
            END                                                         00304500
        ELSE BEGIN SP[NOC]:=SP[LOC];FORGETSPACE(L,1);END;               00304600
        END;                                                            00304700
    END; % OF PROCEDURE RESTORELOCALS                                   00304800
    OWN INTEGER FUNCLOC,POLLOC,LASTMKS,POLTOP,CINDEX;                   00304900
    PROCEDURE STEPLINE(LABELED); VALUE LABELED;                         00305000
        BOOLEAN LABELED;                                                00305100
                                                                        00305200
        BEGIN                                                           00305300
        LABEL ENDFUNC,TERMINATE,DONE;                                   00305400
        LABEL BUMPLINE;                                                 00305500
        LABEL TRYNEXT;                                                  00305600
        REAL STREAM PROCEDURE CON(A); VALUE A;                          00305700
            BEGIN SI:=LOC A; DI:=LOC CON; DS:=8DEC;                     00305800
        END;                                                            00305900
        INTEGER C;                                                      00306000
        REAL N,T,L,TLAST,M,BASE;                                        00306100
            COMMENT                                                     00306200
    MONITOR PRINT (FUNCLOC,POLLOC,LASTMKS,POLTOP,CINDEX,N,T,L,          00306300
        TLAST,M,BASE);                                                  00306400
        L:=FUNCLOC;M:=SP[LOC].SPF+L;                                    00306500
        IF BOOLEAN(SP[MOC].SUSPENDED) THEN                              00306600
            BEGIN %RESUME A SUSPENDED FUNCTI+ON                         00306700
            SP[MOC].SUSPENDED:=0;%REMOVE SUSPENDED BIT                  00306800
            RESTORELOCALS(SP[MOC]);                                     00306900
            SP[LOC].RF:=N:=SP[LOC].RF-1;                                00307000
            IF N LEQ 0 THEN SUSPENSION:=0;% NO MORE SUSPENDED FNS       00307100
            END;                                                        00307200
        IF LABELED THEN %MAKE INITIAL CHECKS AND CHANGES;               00307300
            BEGIN                                                       00307400
            IF NOT BOOLEAN((T:=AREG).PRESENCE) OR L:=T.SPF=0            00307500
                THEN                                                    00307600
                BEGIN LABELED:=FALSE; GO TO BUMPLINE;                   00307700
                END;                                                    00307800
            IF BOOLEAN (T.CHRMODE) THEN GO TO TERMINATE;                00307900
            L:=L+T.RF; %PICK UP THE FIRST ELEMENT OF THE ARRAY          00308000
            IF T:=SP[LOC] GTR 9999.99994 OR T LSS 0 THEN                00308100
                T:=0;                                                   00308200
            T:=CON(ENTIER(T|10000+.5))                                  00308300
            END; BUMPLINE:                                              00308400
        L:=LASTMKS; TLAST:=SP[LOC].BACKF;                               00308500
        C:=(LASTMKS:=SP[MOC].LOCFIELD)-STACKBASE;%LOC OF FMKS           00308600
        WHILE TLAST GTR C DO %STRIP OFF CURRENT LINE                    00308700
            BEGIN L:=TLAST+STACKBASE;TLAST:=(N:=SP[LOC]).BACKF;         00308800
            IF N.DID=IMKS THEN SCRATCHAIN(N.SPF);                       00308900
            END;                                                        00309000
        WHILE ST GEQ L AND ERR=0 DO POP;                                00309100
        IF ERR NEQ 0 THEN GO TO DONE;                                   00309200
        M:=BASE:=SP[MOC].SPF;%LOC OF LABEL TABLE                        00309300
TRYNEXT:                                                                00309400
        N:=SP[MOC]+M+1;  % N IS ONE BUIGGER THAN TOP                    00309500
        M:=M+2; M:=SP[MOC]+2;  % M IS ON THE FIRST POINTER              00309600
        IF LABELED THEN %BINARY SEARCH FOR THE DESIRED LINE             00309700
            BEGIN                                                       00309800
            IF N-M LSS 2 THEN GO TO ENDFUNC;                            00309900
            WHILE N-M GTR 2 AND C LSS 1@8 DO                            00310000
                                                                        00310100
                BEGIN L:=M+ENTIER((N-M)DIV 4)|2; C:=C+1;                00310200
                IF T LSS SP[LOC] THEN N:=L ELSE M:=L                    00310300
                END;                                                    00310400
        IF C=1@8 THEN GO TO TERMINATE;                                  00310500
            IF SP[MOC] NEQ T THEN GO ENDFUNC; T:=M;                     00310600
            %T HAS THE SP LOCATION OF THE CORRECT LABEL                 00310700
            END ELSE %BUMP THE POINTER                                  00310800
        IF T:=CURLINE+2+BASE GEQ N OR T LSS M THEN GO ENDFUNC;          00310900
        M:=T+1; CURLINE:=T-BASE; %M IS SET TO PROG DESC                 00311000
        IF NOT BOOLEAN((T:=SP[MOC]).PRESENCE) THEN %MAKE POLISH         00311100
            BEGIN N:=BASE+1;N:=SP[NOC].SPF;%SEQ STORAGE UNIT            00311200
            INITBUFF(BUFFER,BUFFSIZE);                                  00311300
            N:=CONTENTS(N,T,BUFFER); %GET TEXT                          00311400
            RESCANLINE; WHILE LABELSCAN(GTA,0) DO; %CLEAR LABELS        00311500
            IF BOOLEAN(EOB) THEN % AN EMPTY LINE--BUMP POINTER          00311600
                BEGIN M:=BASE;LABELED:=FALSE;GO TO TRYNEXT;END ELSE     00311700
            IF T:=ANALYZE(TRUE)=0 THEN % NO GOOD                        00311800
                GO TO DONE;                                             00311900
            SP[MOC]:=T; %SAVE THE POLISH DESCRIPTOR AT M                00312000
            END;                                                        00312100
        PUSH; IF ERR NEQ 0 THEN GO TO DONE;                             00312200
        AREG:=(L:=ENTIER(M))&1[CCIF]&TLAST[BACKPT];                     00312300
        LASTMKS:=ST;                                                    00312400
        POLLOC:=SP[LOC].SPF;                                            00312500
        L:=T.SPF; POLTOP:=SP[LOC]; CINDEX:=1;                           00312600
        GO TO DONE;                                                     00312700
ENDFUNC:                                                                00312800
        %ARRIVE HERE WHEN FUNCTION IS COMPLETED.                        00312900
        %GET RESULT OF FUNCTION                                         00313000
        M:=FUNCLOC;M:=SP[MOC].SPF+M;N:=TLAST:=SP[MOC].LOCFIELD;         00313100
        M:=SP[NOC].SPF;M:=SP[MOC];                                      00313200
        COMMENT I CANNOT CONJURE UP A CASE WHERE A USER RETURNS TO A    00313300
        FUNCTION WHOSE DESCRIPTOR HAS BEEN PUSHED DOWN BY A SUSPENDED   00313400
        VARIABLE.IF THIS HAPPENS-HOPE FOR A GRACEFUL CRASH;             00313500
        %M IS THE DESCRIPTOR FOR THE FUNCTION, TLAST  IS BASE ADDRESS   00313600
                                                                        00313700
        IF BOOLEAN(M.RETURNVALUE) THEN %GET THE RESULT                  00313800
            BEGIN                                                       00313900
            N:=M.SPF+5;%RELATIVE LOCATION OF RESULT                     00314000
            N:=SP[NOC]+TLAST; %LOCATION IN STACK OF RESKLULT            00314100
            T:=SP[NOC]; SP[NOC].NAMED:=1; N:=T;                         00314200
            END;                                                        00314300
        WHILE ST GEQ TLAST AND ERR=0 DO POP; %GET RID OF TEMPS          00314400
        OLDDATA:=(T:=AREG).SPF; POP;% GET RID OF INTERRUPT MKS          00314500
        IF ERR NEQ 0 THEN GO TO DONE;                                   00314600
        IF BOOLEAN(M.RETURNVALUE) THEN %REPLACE RESULT                  00314700
            BEGIN PUSH; IF ERR NEQ 0 THEN GO TO DONE;                   00314800
            AREG:=N; %RESULT OF CALL                                    00314900
            END;                                                        00315000
        L:=STACKBASE+1;L:=SP[LOC].SPF;M:=SP[LOC].SPF+L;                 00315100
                                                                        00315200
        SP[MOC]:=0;SP[LOC].SPF:=(M:=M-1)-L;                             00315300
        COMMENT NOW INITIATE ANY OLD FUNCTIONS, AND GET POLISH          00315400
        GOING;                                                          00315500
        LASTMKS:=N:=T.BACKF+STACKBASE; %LOCATION OF PROGRAM DESC.       00315600
        T:=SP[NOC]; % PICK UP PROGRAM DESCRIPTOR                        00315700
        N:=T.SPF; %LOCATION OF POLISH DESCRIPTOR                        00315800
        POLLOC:=(N:=SP[NOC].SPF);                                       00315900
        POLTOP:=SP[NOC];                                                00316000
        CINDEX:=T.CIF;                                                  00316100
        IF M NEQ L THEN % GET LAST FUNCTION STARTED                     00316200
            BEGIN N:=SP[MOC].LOCFIELD;                                  00316300
            T:=SP[NOC];                                                 00316400
            CURLINE:=T.CIF                                              00316500
            END ELSE CURLINE:=0;                                        00316600
        GO TO DONE;                                                     00316700
TERMINATE:                                                              00316800
        ERR:=LABELERROR;                                                00316900
DONE:                                                                   00317000
        END;                                                            00317100
                                                                        00317200
PROCEDURE FIXTAKEORDROP(LDESC,RDESC,OPT,MAP,SIZEMAP,SIZE);              00317300
  VALUE LDESC,RDESC,OPT; REAL LDESC,RDESC;                              00317400
  INTEGER OPT, SIZE; ARRAY MAP, SIZEMAP[1];                             00317500
  BEGIN INTEGER LRANK,LSIZE,L,M,RRANK,N,I,TOP,PUT;                      00317600
    DEFINE TAKE = OPT = 2#;                                             00317700
    INTEGER LNUM, RNUM; LABEL QUIT;                                     00317800
  IF LSIZE := FINDSIZE(LDESC) NEQ RRANK := RDESC.RF AND LSIZE NEQ 1     00317900
    OR LRANK:=LDESC.RF GTR 1 AND LSIZE NEQ 1                            00318000
    OR L := LDESC.SPF=0                                                 00318100
    OR M := RDESC.SPF = 0 THEN BEGIN                                    00318200
       ERR:=DOMAINERROR; GO TO QUIT; END;                               00318300
  L := L + LRANK;                                                       00318400
                                                                        00318500
  SIZE := 1;                                                            00318600
  FOR I := 1 STEP 1 UNTIL RRANK DO BEGIN                                00318700
    RNUM:=SP[MOC];                                                      00318800
    LNUM:=IF TAKE THEN SP[LOC] ELSE (PUT:=SP[LOC])-SIGN(PUT)|RNUM;      00318900
    IF ABS(LNUM) GTR RNUM THEN BEGIN                                    00319000
      ERR:=DOMAINERROR; GO TO QUIT; END;                                00319100
    IF LNUM = 0 THEN BEGIN                                              00319200
       SIZE := 0; GO TO QUIT; END;                                      00319300
    IF LNUM = 0 THEN BEGIN                                              00319400
      SIZEMAP[1] := LNUM;                                               00319500
      MAP[I] . SPF := 0;                                                00319600
      MAP[I] . RF := 1;                                                 00319700
    END ELSE BEGIN                                                      00319800
      LNUM:=ABS(LNUM);                                                  00319900
      PUT := RNUM - LNUM +ORIGIN;                                       00320000
     MAP[I].SPF := N := GETSPACE(LNUM+1);                               00320100
      SIZEMAP[I] := SP[NOC] := LNUM;                                    00320200
      TOP := N + LNUM;                                                  00320300
      FOR N:=N+1 STEP 1 UNTIL TOP DO BEGIN                              00320400
        SP[NOC]:=PUT; PUT:=PUT+1; END;                                  00320500
      MAP[I].RF := 1;                                                   00320600
      MAP[I] := - MAP[I];                                               00320700
      END;                                                              00320800
    IF LSIZE NEQ 1 THEN L:=L+1;                                         00320900
    M:=M+1;                                                             00321000
    SIZE:=SIZE | LNUM;                                                  00321100
    END;                                                                00321200
 QUIT:  END PROCEDURE FIXTAKEORDROP;                                    00321300
    REAL PROCEDURE SUBSCRIPTS(DIRECTION,D,RANK);                        00321400
        VALUE DIRECTION,D,RANK; REAL D,RANK; INTEGER DIRECTION;         00321500
        BEGIN COMMENT THIS PROCEDURE EVALUATES A SET OF SUBSCRIPTS      00321600
        ,POPS THEM OFF THE STACK, AND RESTURNS WITH A DESC.             00321700
        FOR THE ITEM REFERENCED;                                        00321800
        LABEL GOHOME,DONE;                                              00321900
        INTEGER SIZE,I,L,M,N,VALUW;                                     00322000
        INTEGER ADDRESS,NOTSCAL,DIM,LEVEL,TEMP,K,J;                     00322100
        REAL SUBDESC,T;                                                 00322200
        BOOLEAN DCHARS;                                                 00322300
        STREAM PROCEDURE TCHAR(A,B,C,D);VALUE B,D;                      00322400
        BEGIN SI:=A;SI:=SI+B;DI:=C;DI:=DI+D;DS:=CHR;END;                00322500
    ARRAY MAP[1:RANK],SIZEMAP[1:RANK];                                  00322600
    ARRAY BLOCKSIZE[1:RANK],POINTER[0:RANK],PROGRESS[1:RANK];           00322700
    INTEGER PROCEDURE SUBINDEX(M,S,P);VALUE M,S,P;REAL M,S,P;           00322800
        IF M LSS 0 THEN BEGIN M:=-M;                                    00322900
            M:=P+M.SPF+M.RF-1;SUBINDEX:=SP[MOC]-ORIGIN;END              00323000
            ELSE SUBINDEX:=(IF S=1 THEN M.SPF ELSE M.SPF+P-1);          00323100
    COMMENT                                                             00323200
    MONITOR PRINT(I,L,M,N,VALUE,ADDRESS,T,ERR,MAP,SIZEMAP,              00323300
     SIZE,D,RANK,DIRECTION);                                            00323400
    DCHARS:=BOOLEAN(D.CHRMODE);                                         00323500
    IF DIRECTION GTR 1 THEN % THIS IS A TAKE OR DROP                    00323600
        BEGIN                                                           00323700
        NOTSCAL:=1;                                                     00323800
    FIXTAKEORDROP(AREG,BREG,DIRECTION,MAP,SIZEMAP,SIZE);                00323900
    IF ERR NEQ 0 THEN GO TO GOHOME;                                     00324000
    IF SIZE=0 THEN BEGIN D.DID:=DDPUVW; D.RF:=1;                        00324100
      D.SPF:=0; SUBSCRIPTS:=D; GO TO GOHOME; END;                       00324200
      %IF SIZE=0 AND TAKE OR DROP, RESULT IS A NULL                     00324300
    END ELSE BEGIN                                                      00324400
    IF RANK NEQ D.RF THEN BEGIN ERR:=RANKERROR;GO TO GOHOME;END;        00324500
    SIZE:=1;                                                            00324600
    N:=D.SPF-1;                                                         00324700
    L:=ST-1; % LOCATE THE EXECUTION STACK                               00324800
    FOR I:=1 STEP 1 UNTIL RANK DO                                       00324900
        BEGIN                                                           00325000
        L:=L-1; SUBDESC:=SP[LOC]; % WANDER INTO EXEC STACK              00325100
        IF ERR NEQ 0 THEN GO TO GOHOME;                                 00325200
        N:=N+1;                                                         00325300
        IF BOOLEAN(SUBDESC.SCALAR) THEN                                 00325400
            BEGIN M:=SUBDESC.SPF;                                       00325500
            IF (VALUW:=SP[MOC]-ORIGIN) GEQ SP[NOC]                      00325600
            OR VALUW LSS 0 THEN BEGIN ERR:=INDEXERROR;GO TO             00325700
            GOHOME; END;                                                00325800
            MAP[I]:=VALUW; SIZEMAP[I]:=1;                               00325900
            END ELSE % CHECK FOR A NULL                                 00326000
            IF SUBDESC.SPF=0 THEN % THIS IS A NULL                      00326100
                BEGIN                                                   00326200
                NOTSCAL:=1;                                             00326300
                SIZE:=SIZE|(M:=SP[NOC]);                                00326400
                MAP[I].RF:=1;SIZEMAP[I]:=M;                             00326500
                END ELSE % IT MUST BE A VECTOR                          00326600
    BEGIN DEFINE STARTSEGMENT=#; %//////////////////////////            00326700
                                                                        00326800
                                                                        00326900
                NOTSCAL:= 1;                                            00327000
                MAP[I]:=-((M:=SUBDESC.SPF)&SUBDESC.RF[CRF]);            00327100
                SIZE:=SIZE|(SIZEMAP[I]:=FINDSIZE(SUBDESC));             00327200
                J:=SP[NOC]+ORIGIN;M:=M+SUBDESC.RF;T:=SIZEMAP[I]+M       00327300
                -1;                                                     00327400
                FOR M:=M STEP 1 UNTIL T DO                              00327500
                    IF SP[MOC] GEQ J OR SP[MOC] LSS ORIGIN THEN         00327600
                    BEGIN ERR:=INDEXERROR; GO TO GOHOME; END;           00327700
                END;                                                    00327800
        END; % OF THE FOR STATEMENT                                     00327900
    END;                                                                00328000
    IF SIZE LEQ 0 THEN BEGIN ERR:=INDEXERROR;GO TO GOHOME;END;          00328100
    IF SIZE=1 AND NOT BOOLEAN(NOTSCAL) THEN %SCALAR REFERENCED          00328200
        BEGIN                                                           00328300
DEFINE STARTSEGMENT=#; %////////////////////////////////                00328400
        N:=D.SPF; M:=RANK-1;                                            00328500
        FOR I:=1 STEP 1 UNTIL M DO                                      00328600
            BEGIN N:= N+1;                                              00328700
            ADDRESS:=SP[NOC]|(ADDRESS+MAP[I]);                          00328800
            END;                                                        00328900
        ADDRESS:=ADDRESS+MAP[RANK] +1;                                  00329000
        IF DIRECTION=OUTOF THEN                                         00329100
            IF DCHARS THEN BEGIN                                        00329200
                N:=(ADDRESS+7)DIV 8+N;J:=(ADDRESS-1)MOD 8;              00329300
                T:=M:=GETSPACE(2);SP[MOC]:=1;M:=M+1;                    00329400
                SP[MOC]:=0; TCHAR(SP[NOC],J,SP[MOC],0);                 00329500
                SUBSCRIPTS:=T&1[CRF]&DDPUVC[CDID];                      00329600
                END ELSE                                                00329700
            BEGIN N:= ADDRESS+N;                                        00329800
            M:=GETSPACE(1);SP[MOC]:=SP[NOC];                            00329900
            T:=M; T.DID:=DDPUSW;                                        00330000
            SUBSCRIPTS:=T;                                              00330100
            END ELSE % DIRECTION IS INTO                                00330200
            BEGIN                                                       00330300
            L:=L-1;SUBSCRIPTS:=SUBDESC:=SP[LOC];                        00330400
            IF DCHARS AND FINDSIZE(SUBDESC)=1 OR                        00330500
                BOOLEAN(SUBDESC.SCALAR) THEN                            00330600
                BEGIN                                                   00330700
                L:=GETSPACE(N:=(NUMELEMENTS(D)+D.RF));                  00330800
                SPCOPY(D.SPF,L,N); % MAKE A NEW COPY                    00330900
                IF DCHARS THEN BEGIN                                    00331000
                N:=(ADDRESS+7)DIV 8+L;J:=(ADDRESS-1)MOD 8;              00331100
                M:=SUBDESC.SPF;IF SP[MOC] GTR 1 OR SUBDESC.RF           00331200
                    NEQ 1 THEN BEGIN ERR:=DOMAINERROR;GO TO             00331300
                    GOHOME;END;                                         00331400
                M:=M+1;TCHAR(SP[MOC],0,SP[NOC],J);                      00331500
                END ELSE BEGIN                                          00331600
                M:=L+ADDRESS+D.RF-1;                                    00331700
                N:=SUBDESC.SPF;                                         00331800
                SP[MOC]:=SP[NOC]; %PERFORM THE REPLACEMENT              00331900
                END;                                                    00332000
                N:=D.LOCFIELD;I:=SP[NOC].BACKP;                         00332100
                SP[NOC]:=D&L[CSPF]&I[CLOCF];%STORE NEW DESC             00332200
                OLDDATA:=CHAIN(D,OLDDATA);                              00332300
                IF BOOLEAN(D.NAMED) THEN BEGIN                          00332400
                    N:=N-1;IF I=0 AND SP[NOC].SUSPENDVAR=0              00332500
                    THEN SP[NOC].CHANGE:=1%MUST BE A REAL GLOBAL        00332600
                    END ELSE %MUST BE A LOCAL VARIABLE                  00332700
                    AREG.NAMED:=1; %DONT LET IT BE FORGOTTEN            00332800
                END ELSE ERR:=RANKERROR;                                00332900
            END;                                                        00333000
        END ELSE % A VECTOR IS REFERENCED                               00333100
        BEGIN % START WITH INITIALIZATION                               00333200
        N:=D.SPF+D.RF;BLOCKSIZE[RANK]:=PROGRESS[RANK]:=J:=1;            00333300
        FOR I:=RANK-1 STEP -1 UNTIL 1 DO                                00333400
            BEGIN N:=N-1;                                               00333500
            J:=BLOCKSIZE[I]:=J|SP[NOC];                                 00333600
            PROGRESS[I]:=1;                                             00333700
            END;                                                        00333800
        K:=POINTER[1]:=SUBINDEX(MAP[1],SIZEMAP[1],PROGRESS[1])          00333900
            |BLOCKSIZE[1];                                              00334000
        FOR I:=2 STEP 1 UNTIL RANK DO                                   00334100
            K:=POINTER[I]:=K+SUBINDEX(MAP[I],SIZEMAP[I],                00334200
                PROGRESS[I])|BLOCKSIZE[I];                              00334300
        DIM:=0;                                                         00334400
        FOR I:=1 STEP 1 UNTIL RANK DO                                   00334500
            IF SIZEMAP[I] GTR 1 THEN DIM:=DIM+MAP[I].RF;                00334600
        IF DCHARS THEN BEGIN TEMP:=D; D.SPF:=UNPACK(D.SPF,              00334700
            RANK,FINDSIZE(D)); IF DIM=0 THEN DIM:=1; END;               00334800
    IF DIRECTION GTR 0 THEN % OUTOF..TAKE.. OR DROP                     00334900
    BEGIN DEFINE STARTSEGMENT=#; %//////////////////////////            00335000
IF SIZE+DIM GTR MAXWORDSTORE THEN BEGIN ERR:=KITEERROR; GO TO           00335100
   GOHOME END ELSE TEMP:=L:=GETSPACE(SIZE+DIM); %RPOOM FOR RESULT       00335200
            IF DIM GTR 0 THEN                                           00335300
            IF DIM=1 THEN BEGIN SP[LOC]:=SIZE; L:=L+1;END               00335400
            ELSE FOR I:=1 STEP 1 UNTIL RANK DO                          00335500
                IF SIZEMAP[I] GTR 1 THEN                                00335600
                IF (M:=MAP[I].SPF)=0 THEN BEGIN SP[LOC]:=               00335700
                    SIZEMAP[I];L:=L+1;END ELSE                          00335800
                    BEGIN N:=M+MAP[I].RF-1;                             00335900
                                                                        00336000
                    FOR M:=M STEP 1 UNTIL N DO BEGIN                    00336100
                    SP[LOC]:=SP[MOC];L:=L+1;END;                        00336200
                    END;                                                00336300
                COMMENT THIS INITIALIZES RESULT DIM VECTOR;             00336400
            ADDRESS:= D.SPF+D.RF;                                       00336500
            END ELSE % DIRECTION IS INTO                                00336600
             BEGIN DEFINE STARTSEGMENT=#; %/////////////////            00336700
             L:=L-1; SUBSCRIPTS:=SUBDESC:=SP[LOC];                      00336800
            IF FINDSIZE(SUBDESC) NEQ SIZE THEN                          00336900
                BEGIN ERR:=RANKERROR; GO TO GOHOME;END;                 00337000
            N:=SUBDESC.RF;                                              00337100
            IF BOOLEAN(SUBDESC.CHRMODE) THEN SUBDESC.SPF:=              00337200
                UNPACK(SUBDESC.SPF,N,FINDSIZE(SUBDESC));                00337300
            IF DCHARS THEN L:= D.SPF ELSE BEGIN                         00337400
            L:=GETSPACE(N:=(NUMELEMENTS(D)+D.RF));                      00337500
            SPCOPY(D.SPF,L,N); % MAKE FRESH COPY TO PATCH INTO          00337600
            END;                                                        00337700
            ADDRESS:=L+D.RF; % SP LOCATION TO STORE INTO                00337800
            N:=D.LOCFIELD;I:=SP[NOC].BACKP;                             00337900
            SP[NOC]:=D&L[CSPF]&I[CLOCF];%STORE NEW DESC.                00338000
            OLDDATA:=CHAIN(IF DCHARS THEN TEMP ELSE D,OLDDATA);         00338100
            IF BOOLEAN(D.NAMED ) THEN BEGIN                             00338200
                N:=N-1;IF I=0 AND SP[NOC].SUSPENDVAR=0                  00338300
                THEN SP[NOC].CHANGE:=1%MUST BE A REAL GLOCAL            00338400
                END ELSE %IT MUST BE A LOCAL VARIABLE                   00338500
                AREG.NAMED:=1;%DONT LET IT BE FORGOTTEN ON POP          00338600
            L:=SUBDESC.SPF+SUBDESC.RF;%POINT TO SOURCE                  00338700
            END;                                                        00338800
                                                                        00338900
                                                                        00339000
            WHILE TRUE DO % RECURSIVE EVALUATION LOOP                   00339100
                BEGIN N:=POINTER[RANK]+ADDRESS;                         00339200
                LEVEL:=RANK;                                            00339300
            IF DIRECTION GTR 0 THEN  %OUTOF..TAKE..DROP                 00339400
                    BEGIN SP[LOC]:=SP[NOC]; L:=L+1;                     00339500
                    END ELSE BEGIN % INTO                               00339600
                    SP[NOC]:= SP[LOC];L:=L+1; END;                      00339700
                WHILE PROGRESS[LEVEL]GEQ SIZEMAP[LEVEL] DO              00339800
                    BEGIN PROGRESS[LEVEL]:=1 ; %LOOK FOR MORE WORK      00339900
                    IF LEVEL:=LEVEL-1 LEQ 0 THEN GO TO DONE;            00340000
                    END;                                                00340100
                COMMENT THERE IS MORE ON THIS LEVEL;                    00340200
                PROGRESS[LEVEL]:=PROGRESS[LEVEL]+1;                     00340300
                K:=POINTER[LEVEL]:=POINTER[LEVEL-1] +SUBINDEX(          00340400
                    MAP[LEVEL],SIZEMAP[LEVEL],PROGRESS[LEVEL])|         00340500
                    BLOCKSIZE[LEVEL];%POINTER[0] IS 0                   00340600
                FOR I:=LEVEL+1 STEP 1 UNTIL RANK DO                     00340700
                    K:=POINTER[I]:=K+SUBINDEX(MAP[I],SIZEMAP[I],        00340800
                    PROGRESS[I])|BLOCKSIZE[I];                          00340900
                END; % OF RECURSIVE EVALUATION LOOP                     00341000
    DONE:   IF DIRECTION GTR 0 THEN % OUTOF TAKE OR DROP                00341100
                IF DCHARS THEN BEGIN PACK(TEMP,DIM,SIZE);               00341200
                    FORGETSPACE(D.SPF,RANK+FINDSIZE(D));                00341300
                    SUBSCRIPTS:=TEMP&DIM[CRF]&DDPUVC[CDID];             00341400
                    END ELSE % THIS IS A NUMERIC VECTOR                 00341500
                IF DIM=0 THEN SUBSCRIPTS:=TEMP&DDPUSW[CDID] ELSE        00341600
                SUBSCRIPTS:=TEMP&DIM[CRF]&DDPUVW[CDID]                  00341700
                ELSE % THE DIRECTION IS INTO                            00341800
                BEGIN IF BOOLEAN(SUBDESC.CHRMODE) THEN                  00341900
                    FORGETSPACE(SUBDESC.SPF,FINDSIZE(SUBDESC)+1);       00342000
                IF DCHARS THEN PACK(D.SPF,RANK,FINDSIZE(D));            00342100
                END;                                                    00342200
                                                                        00342300
            END;                                                        00342400
GOHOME:  IF DIRECTION GTR 1 THEN                                        00342500
    FOR I:=1 STEP 1 UNTIL RANK DO                                       00342600
     IF MAP[I] LSS 0 THEN FORGETSPACE(MAP[I].SPF,SIZEMAP[I]+1);         00342700
         END; % OF SUBSCRIPTS PROCEDURE                                 00342800
    PROCEDURE IMS(N); VALUE N; INTEGER N;                               00342900
        BEGIN COMMENT N=0 FOR REGULAR INTERRUPT MKS                     00343000
                      N=1 FOR QQUAD INTERRUPT MKS                       00343100
                      N=2 FOR QUAD INTERRUPT MKS                        00343200
                      N=3 FOR EXECUTION LINE FOLLOWING                  00343300
                      N=4 FOR SUSPENDED FUNCTION;                       00343400
        INTEGER L,M;                                                    00343500
                                                                        00343600
        PUSH;AREG:=OLDDATA&(LASTMKS-STACKBASE)                          00343700
            [BACKPT]&N[QUADINV]&IMKS[CDID];                             00343800
        IF N NEQ 4 THEN BEGIN L:=LASTMKS;SP[LOC].CIF:=CINDEX;END;       00343900
        L:=STACKBASE+1;L:=SP[LOC].SPF +1;                               00344000
        IF (M:=SP[LOC].SPF) NEQ 0 THEN % SAVE CURLINE                   00344100
            BEGIN L:=L+M; L:=SP[LOC].LOCFIELD;                          00344200
            SP[LOC].CIF:=CURLINE;                                       00344300
            END;                                                        00344400
        LASTMKS:=ST;                                                    00344500
        END;                                                            00344600
PROCEDURE DISPLAYCHARV(D); VALUE D; REAL D;                             00344700
    BEGIN INTEGER I,J,K,L,M,NWORDS,NJ,T,NMAT,II,JJ,WDLINE,F,CC;         00344800
    COMMENT WDLINE=#WORDS NEEDED TO FILL A TELETYPE LINE                00344900
            NWORDS=#WORDS NEEDED TO GET F CHARACTERS FOR LAST           00345000
                          TELETYPE LINE OF A ROW                        00345100
            F=#CHARACTERS IN LAST TELETYPE LINE OF A ROW                00345200
            T=#TELETYPE LINES NEEDED PER ROW BEYOND FIRST LINE          00345300
            NMAT=#MATRICES TO BE PRINTED OUT (1 IF RANK=2);             00345400
    L := (T:=D.SPF) + (NJ:=D.RF) - 1;                                   00345500
    J := SP[LOC];  %J IS NUMBER OF CHARACTERS PER ROW                   00345600
    IF NJ GTR 1 THEN BEGIN                                              00345700
        L:=L-1; K:=SP[LOC]                                              00345800
        END ELSE K := 1;  %K IS NUMBER OF ROWS PER MATRIX               00345900
                                                                        00346000
    L := T + NJ;                                                        00346100
        NMAT := FINDSIZE(D) DIV (J|K);                                  00346200
        WDLINE := (LINESIZE+6) DIV 8 + 1;                               00346300
        IF II:=J-LINESIZE GTR 0 THEN BEGIN                              00346400
            T:= II DIV (I:=LINESIZE-2)+(IF II MOD I=0 THEN 0  ELSE 1);  00346500
            NWORDS:=((F:=II-(T-1)|T)+6) DIV 8 + 1;                      00346600
        END ELSE BEGIN NWORDS:=((F:=J)+6)DIV 8 + 1; T:=0; END;          00346700
        FOR II:=1 STEP 1 UNTIL NMAT DO BEGIN                            00346800
            FOR I:=1 STEP I UNTIL K DO BEGIN                            00346900
              CC:=0;                                                    00347000
              FOR JJ:=1 STEP 1 UNTIL T DO BEGIN                         00347100
                TRANSFERSP(OUTOF,SP,L+M DIV 8,BUFFER,0,WDLINE);         00347200
                FORMROW(3,CC,BUFFER,ENTIER(M MOD 8),NJ:=LINESIZE-CC);   00347300
                M := M + NJ;  CC := 2;  END;                            00347400
              IF I=K AND II=NMAT THEN IF L+M DIV 8 + NWORDS GTR         00347500
                  (1+NROWS)|SPRSIZE THEN NWORDS:=NWORDS-1;              00347600
                  %TO TAKE CARE OF BEING AT THE END OF SP               00347700
              TRANSFERSP(OUTOF,SP,L+M DIV 8, BUFFER,0,NWORDS);          00347800
              FORMROW(3,CC,BUFFER,ENTIER(M MOD 8), F);                  00347900
              M := M + F;                                               00348000
              END;                                                      00348100
            FORMWD(3,"1      ");                                        00348200
        END;                                                            00348300
    END OF CHARACTER DISPLAY PROCEDURE;                                 00348400
   REAL PROCEDURE SEMICOL;                                              00348500
        BEGIN COMMENT FORM CHAR STRING FROM TWO DESCRIPTORS;            00348600
        INTEGER J,K,L;                                                  00348700
        REAL LD, RD;                                                    00348800
        STREAM PROCEDURE BLANKS(B,J,K);VALUE J,K;                       00348900
            BEGIN LOCAL T,U;                                            00349000
            SI:=LOC K; DI:=LOC U; DI:=DI+1; DS:=7 CHR;                  00349100
            SI:=LOC J; DI:=LOC T; DI:=DI+1; DS:=7 CHR;                  00349200
            DI:=B; U(2(DI:=DI+32));; DI:= DI+K;                         00349300
            T(2(DS:=32 LIT " "));J(DS:=1 LIT " ");                      00349400
            END;                                                        00349500
        PROCEDURE MOVEC(J,L,K);VALUE J,L,K; INTEGER J,L,K;              00349600
            BEGIN INTEGER I;                                            00349700
            IF(J+K+8) GTR MAXBUFFSIZE|8 THEN ERR:=LENGTHERROR ELSE      00349800
                BEGIN TRANSFERSP(OUTOF,SP,L,BUFFER,ENTIER((J+7)DIV 8),  00349900
                    ENTIER((K+7) DIV 8));                               00350000
                IF I:=(J MOD 8) NEQ 0 THEN TRANSFER(BUFFER,J+8-I,       00350100
                BUFFER,J,K); END;                                       00350200
            END;                                                        00350300
        INTEGER PROCEDURE MOVEN(J,L,K);VALUE J,L,K;INTEGER J,L,K;       00350400
            BEGIN INTEGER I;K:=K+L-1; I:=MAXBUFFSIZE|8;                 00350500
            BLANKS(BUFFER,I-J,J);                                       00350600
            FOR L:= L STEP 1 UNTIL K DO                                 00350700
                BEGIN NUMBERCON(SP[LOC],ACCUM);                         00350800
                TRANSFER(ACCUM,2,BUFFER,J:=J+1,ACOUNT);                 00350900
                IF (J:=J+ACOUNT)GTR I THEN BEGIN L:=K;ERR:=LENGTHERROR; 00351000
                END;END;                                                00351100
            MOVEN:=J;                                                   00351200
            END;                                                        00351300
       LD := AREG; RD := BREG;                                          00351400
        IF L:=LD.RF GTR 1 THEN ERR:= RANKERROR ELSE                     00351500
            IF LD.SPF NEQ 0 THEN                                        00351600
            IF BOOLEAN(LD.CHRMODE) THEN MOVEC(0,L+LD.SPF,J:=FINDSIZE    00351700
                (LD))ELSE J:=MOVEN(0,L+LD.SPF,FINDSIZE(LD));            00351800
            IF L:=RD.RF GTR 1 OR ERR NEQ 0 THEN ERR:=RANKERROR ELSE     00351900
                IF RD.SPF NEQ 0 THEN IF BOOLEAN(RD.CHRMODE) THEN        00352000
                    BEGIN MOVEC(J,L+RD.SPF,K:=FINDSIZE(RD));J:=J+K;     00352100
                    END ELSE J:=MOVEN(J,L+RD.SPF,FINDSIZE(RD));         00352200
            IF ERR=0 THEN                                               00352300
                IF J=0 THEN SEMICOL:=NULLV ELSE                         00352400
                BEGIN L:=GETSPACE((K:=ENTIER((J+7)DIV 8))+1);           00352500
                TRANSFERSP(INTO,SP,L+1,BUFFER,0,K);                     00352600
                SP[LOC]:=J; SEMICOL:=L&1[CRF]&DDPUVC[CDID];             00352700
                END;                                                    00352800
                                                                        00352900
        END;                                                            00353000
    BOOLEAN PROCEDURE SETUPLINE;                                        00353100
        BEGIN REAL T;INTEGER M;                                         00353200
        IF T:=ANALYZE(FALSE) NEQ 0 THEN % WE HAVE A PROGRAM DESC        00353300
            BEGIN IMS(3);                                               00353400
            M:=GETSPACE(1); SP[MOC]:=T;                                 00353500
            LASTMKS:=ST-STACKBASE;                                      00353600
            PUSH; IF ERR=0 THEN                                         00353700
                BEGIN AREG:=PROGMKS&LASTMKS[BACKPT]&1[CI]&M[SPTSP];     00353800
                POLLOC:=M:=T.SPF; POLTOP:=SP[MOC];                      00353900
                LASTMKS:=LASTMKS+1+STACKBASE; CINDEX:=1;                00354000
                END;                                                    00354100
            SETUPLINE:=TRUE;                                            00354200
            END ELSE SETUPLINE:=FALSE;                                  00354300
        END;                                                            00354400
BOOLEAN PROCEDURE POPPROGRAM(OLDDATA,LASTMKS);                          00354500
    REAL OLDDATA,LASTMKS;                                               00354600
    BEGIN LABEL EXIT;REAL L,M,N;                                        00354700
    WHILE TRUE DO                                                       00354800
        BEGIN                                                           00354900
        WHILE(L:=AREG).DATADESC NEQ 0 AND ERR=0 DO POP;                 00355000
        IF L.DID=PROGMKS THEN                                           00355100
            IF L=0 THEN %SOMETHING IS FUNNY...CONTINUE POPPING          00355200
            POP                                                         00355300
            ELSE BEGIN                                                  00355400
            LASTMKS:=M:=L.BACKF+STACKBASE;                              00355500
            IF L.BACKF NEQ 0 AND NOT ((N:=SP[MOC]).DID=IMKS             00355600
                AND N.QUADIN=4) THEN POPPROGRAM:=TRUE;                  00355700
            IF N.DID NEQ FMKS THEN                                      00355800
            FORGETPROGRAM(L);POP;GO TO EXIT;                            00355900
            END ELSE %NOT A PROGRAM MKS                                 00356000
            IF L.DID=FMKS THEN                                          00356100
                BEGIN % MUST CUT BACK STATE VECTOR                      00356200
                M:=STACKBASE+1;M:=SP[MOC].SPF+1;N:=SP[MOC].SPF+M;       00356300
                IF BOOLEAN(SP[NOC].SUSPENDED) THEN BEGIN SP[MOC].RF:=L:=00356400
                    SP[MOC].RF-1;IF L=0 THEN SUSPENSION:=0;END;         00356500
                SP[NOC]:=0;SP[MOC].SPF:=N-M-1;POP;                      00356600
                END ELSE % NOT A FMKS EITHER                            00356700
                IF L.DID=IMKS THEN                                      00356800
                    BEGIN SCRATCHAIN(OLDDATA);OLDDATA:=L.SPF;POP;END;   00356900
        IF ERR NEQ 0 THEN GO TO EXIT;                                   00357000
        END; % OF THE DO                                                00357100
EXIT: END;%OF PROCEDURE POPPROGRAM                                      00357200
REAL PROCEDURE BUILDALPHA(LASTCONSTANT);                                00357300
INTEGER LASTCONSTANT;                                                   00357400
    BEGIN                                                               00357500
    ARRAY B[0:BUFFSIZE];                                                00357600
    REAL R;                                                             00357700
    INTEGER L,N;                                                        00357800
    REAL STREAM PROCEDURE GETCHRS(ADDR,B); VALUE ADDR;                  00357900
        BEGIN LOCAL C1,C2,TDI,TSI,QM;                                   00358000
        LOCAL ARROW;                                                    00358100
        LABEL L,DSONE,FINIS,ERR;                                        00358200
        DI:=LOC QM; DS:=2RESET; DS:=2SET;                               00358300
        DI:=LOC ARROW; DS:=RESET; DS:=7SET;                             00358400
        DI:=B; DS:=8LIT"0";                                             00358500
        SI:=ADDR;                                                       00358600
    L:                                                                  00358700
        IF SC=""" THEN % MAY BE DOUBLE QUOTE                            00358800
            BEGIN                                                       00358900
            SI:=SI+1;                                                   00359000
            IF SC=""" THEN % GET RID OF QUOTE                           00359100
                GO TO DSONE;                                            00359200
            COMMENT ELSE WE ARE LOOKING PAST THE RH QUOTE;              00359300
            GO TO FINIS;                                                00359400
            END ELSE % LOOK FOR THE QUESTION MARK                       00359500
            BEGIN TDI:=DI; DI:=LOC QM;                                  00359600
            IF SC=DC THEN % END OF BUFFER ENCOUNTERED                   00359700
                GO TO ERR;                                              00359800
            SI:=SI-1; DI:=LOC ARROW;                                    00359900
            IF SC=DC THEN %FOUND LEFT ARROW                             00360000
                GO TO ERR;                                              00360100
            SI:=SI-1; DI:=TDI; GO TO DSONE                              00360200
            END;                                                        00360300
    DSONE: DS:=CHR; TALLY:=TALLY+1;                                     00360400
        C2:=TALLY; TSI:=SI; SI:=LOC C2; SI:=SI+7;                       00360500
        IF SC="0" THEN                                                  00360600
            BEGIN TALLY:=C1; TALLY:=TALLY+1; C1:=TALLY;                 00360700
            TALLY:=0;                                                   00360800
            END;                                                        00360900
        SI:=TSI;                                                        00361000
        GO TO L;                                                        00361100
    FINIS: GETCHRS:=SI;                                                 00361200
        DI:=B; SI:=LOC C1; SI:=SI+1; DS:=7CHR; SI:=LOC C2;              00361300
        SI:=SI+7; DS:=CHR;                                              00361400
    ERR:                                                                00361500
    END;                                                                00361600
    IF R:=GETCHRS(ADDRESS,B) NEQ 0 THEN % GOT A VECTOR                  00361700
        IF NOT CURRENTMODE=FUNCMODE THEN                                00361800
        BEGIN ADDRESS:=R;                                               00361900
        COMMENT B[0] HAS THE LENGTH OF THE STRING;                      00362000
        IF R:=B[0] GEQ 1 THEN COMMENT A VECTOR;                         00362100
            BEGIN                                                       00362200
     L:=GETSPACE(N:=(R-1)DIV 8+2);                                      00362300
    TRANSFERSP(INTO,SP,L,B,0,N);                                        00362400
            SP[LOC]:=R;                                                 00362500
            END;                                                        00362600
        N:=GETSPACE(1);                                                 00362700
       R:= L;                                                           00362800
        R.DID:=DDPNVC;                                                  00362900
    R.BACKP:=LASTCONSTANT;                                              00363000
   LASTCONSTANT:=N;                                                     00363100
        IF B[0]=0 THEN R.DID:=DDPNVW %NULL BECAUSE .SPF=.RF=0           00363200
                 %DON"T WANT CHARACTER NULL TO LOOK LIKE CHARS          00363300
            ELSE R.RF:=1;                                               00363400
        SP[NOC]:=R;                                                     00363500
        COMMENT WE HAVE BUILT THE VECTOR AND DESCRIPTOR                 00363600
        BUILDALPHA:=N;                                                  00363700
        END                                                             00363800
            ELSE BEGIN BUILDALPHA:=1;ADDRESS:=R END;                    00363900
        %ELSE WE HAVE AN ERROR (MISSING " ETC.)                         00364000
    END; % OF THE BUILD ALPHA PROCEDURE;                                00364100
PROCEDURE PACK(L,OFFSET,N); VALUE L,OFFSET,N;                           00364200
    INTEGER L,OFFSET,N;                                                 00364300
    BEGIN                                                               00364400
    LABEL QUIT;                                                         00364500
    INTEGER M,T,MB,S;                                                   00364600
    STREAM PROCEDURE PACKEM(A,B,N); VALUE N;                            00364700
        BEGIN LOCAL T;                                                  00364800
        SI:=LOC N; DI:=LOC T; DI:=DI+1; DS:=7CHR;                       00364900
        SI:=A; DI:=B;                                                   00365000
        T(2(32(SI:=SI+7; DS:=CHR))); N(SI:=SI+7; DS:=CHR);              00365100
        END;                                                            00365200
     IF N = 0 THEN GO TO QUIT;                                          00365300
    T:=(M:=L:=L+OFFSET)+N;                                              00365400
    MB:=MAXBUFFSIZE DIV 8 | 8;                                          00365500
    WHILE M LSS T DO                                                    00365600
        BEGIN                                                           00365700
        TRANSFERSP(OUTOF,SP,M,BUFFER,0,MB:=MIN(MB,T-M));                00365800
        PACKEM(BUFFER,ACCUM,MB);                                        00365900
        TRANSFERSP(INTO,SP,L,ACCUM,0,S:=(MB+7)DIV 8);                   00366000
        L:=L+S; M:=M+MB;                                                00366100
        END;                                                            00366200
    FORGETSPACE(L,T-L);                                                 00366300
  QUIT:  END PROCEDURE PACK;                                            00366400
INTEGER PROCEDURE UNPACK(S,OFFSET,N); VALUE N,S,OFFSET;                 00366500
    INTEGER N,S,OFFSET;                                                 00366600
    BEGIN                                                               00366700
    INTEGER L,M,K,MB,T;                                                 00366800
    LABEL QUIT;                                                         00366900
    STREAM PROCEDURE UNPACKEM(A,B,N); VALUE N;                          00367000
        BEGIN                                                           00367100
        LOCAL T;                                                        00367200
        SI:=LOC N; DI:=LOC T; DI:=DI+1; DS:=7CHR;                       00367300
        SI:=A; DI:=B;                                                   00367400
        T(2(32(DS:=7LIT"0"; DS:=CHR)));                                 00367500
        N(DS:=7LIT"0"; DS:=CHR);                                        00367600
        END;                                                            00367700
    IF N = 0 THEN BEGIN UNPACK := S; GO TO QUIT; END;                   00367800
    UNPACK:=L:=GETSPACE(OFFSET+N); K:=S+OFFSET-1;                       00367900
    FOR M:=S STEP 1 UNTIL K DO;                                         00368000
        BEGIN SP[LOC]:=SP[MOC]; L:=L+1                                  00368100
        END;                                                            00368200
    K:=L+N; S:=S+OFFSET;                                                00368300
    MB:=MAXBUFFSIZE DIV 8;                                              00368400
    N := MB | 8;                                                        00368500
    WHILE L LSS K DO                                                    00368600
        BEGIN                                                           00368700
        TRANSFERSP(OUTOF,SP,S,BUFFER,0,M:=MIN(MB,(K-L+7)DIV 8));        00368800
        UNPACKEM(BUFFER,ACCUM, M:= MIN(K-L, M|8));                      00368900
        TRANSFERSP(INTO,SP,L,ACCUM,0,M);                                00369000
        L := L+N; S:= S+MB;                                             00369100
        END;                                                            00369200
  QUIT:  END PROCEDURE UNPACK;                                          00369300
PROCEDURE TRANSPOSE;                                                    00369400
  BEGIN INTEGER M,N,L,I,ROW,COL,RANK,OUTER,INNER; REAL NEWDESC;         00369500
    INTEGER SIZE,J,MAT,TOP,START; BOOLEAN CHARACTER;                    00369600
  LABEL QUIT; DEFINE GIVEUP=GO TO QUIT#;                                00369700
  REAL NULL, DESC;                                                      00369800
  DEFINE RESULT=RESULTD#;                                               00369900
  NULL := AREG; DESC := BREG;                                           00370000
  IF L:=DESC.SPF=0 THEN BEGIN ERR:=DOMAINERROR; GIVEUP; END;            00370100
  RANK := DESC.RF;                                                      00370200
  SIZE := FINDSIZE(DESC);                                               00370300
  IF RANK LSS 2 THEN BEGIN NEWDESC:=DESC;                               00370400
    %THEN THE TRANSPOSE IS THE THING ITSELF                             00370500
          NEWDESC.NAMED:=0;                                             00370600
        NEWDESC.SPF := N:=GETSPACE(RANK+SIZE);                          00370700
        SPCOPY(L,N,RANK+SIZE);                                          00370800
        GO TO QUIT; END;                                                00370900
    IF DESC.ARRAYTYPE=1 THEN BEGIN                                      00371000
      L:=UNPACK(L,RANK,SIZE);                                           00371100
      CHARACTER := TRUE; END;                                           00371200
    N:=L+RANK-1; COL := SP[NOC];                                        00371300
    N:=N-1; ROW := SP[NOC];                                             00371400
    TOP := SIZE DIV (MAT:=ROW|COL);                                     00371500
    NEWDESC := DESC;                                                    00371600
    NEWDESC.SPF := M := GETSPACE(SIZE+RANK);                            00371700
    SPCOPY (L,M,RANK-2);                                                00371800
    N:=M+RANK-1; SP[NOC]:=ROW;                                          00371900
    N:=N-1; SP[NOC] := COL;                                             00372000
    J:=0; M:=M+RANK;                                                    00372100
   WHILE J LSS TOP DO BEGIN                                             00372200
     OUTER:=(START:=L+RANK+J|MAT) + COL - 1;                            00372300
    FOR I:=START STEP 1 UNTIL OUTER DO BEGIN INNER:=I+MAT-1;            00372400
     FOR N:=I STEP COL UNTIL INNER DO                                   00372500
      BEGIN SP[MOC] := SP[NOC]; M:=M+1; END; END;                       00372600
     J:=J+1; END;                                                       00372700
  QUIT:  IF CHARACTER THEN BEGIN NEWDESC.ARRAYTYPE:=1;                  00372800
        FORGETSPACE(L,SIZE+RANK);                                       00372900
        PACK(NEWDESC.SPF, RANK,SIZE); END;                              00373000
   RESULTD := NEWDESC;                                                  00373100
 END PROCEDURE TRANSPOSE;                                               00373200
BOOLEAN PROCEDURE MATCHDIM(DESC1,DESC2); REAL DESC1,DESC2;              00373300
 BEGIN INTEGER I,L,M,TOP; LABEL DONE;                                   00373400
    MATCHDIM:= TRUE;                                                    00373500
    IF DESC1.RF NEQ DESC2.RF THEN BEGIN MATCHDIM:=FALSE;                00373600
       ERR:=RANKERROR; GO TO DONE; END;                                 00373700
    I:=DESC1.SPF; M:=DESC2.SPF; TOP:=I+DESC1.RF-1;                      00373800
    FOR L:=I STEP 1 UNTIL TOP DO BEGIN                                  00373900
      IF SP[LOC] NEQ SP[MOC] THEN BEGIN MATCHDIM:=FALSE;                00374000
       ERR:=LENGTHERROR; GO TO DONE; END;                               00374100
    M:=M+1; END;                                                        00374200
  DONE:  END PROCEDURE MATCHDIM;                                        00374300
INTEGER PROCEDURE RANDINT(A,B,U); VALUE A,B;                            00374400
   REAL A,B,U;                                                          00374500
  BEGIN DEFINE QQMODUL = 67108864#, QQMULT = 8189#,                     00374600
     QQRANDOM=(U:=U|QQMULT MOD QQMODUL)/QQMODUL#;                       00374700
    RANDINT := (B-A+1)|QQRANDOM+A-.5;                                   00374800
  END PROCEDURE RANDINT;                                                00374900
BOOLEAN PROCEDURE BOOLTYPE(A,B); REAL A,B;                              00375000
  BEGIN IF ABS(A-1) LEQ FUZZ THEN A:=1;                                 00375100
    IF ABS(A) LEQ FUZZ THEN A:=0;                                       00375200
    IF ABS(B-1) LEQ FUZZ THEN B:=1;                                     00375300
    IF ABS(B) LEQ FUZZ THEN B:=0;                                       00375400
    BOOLTYPE := (IF A=1 OR A=0 AND B=1 OR B=0 THEN TRUE                 00375500
        ELSE FALSE); END PROCEDURE BOOLTYPE;                            00375600
REAL PROCEDURE GAMMA(X); REAL X;                                        00375700
   COMMENT THIS PROCEDURE WAS TAKEN FROM ACM ALGORITHM 31.              00375800
     THE ONLY DIFFERENCE IS THAT THERE IS NO PROVISION FOR              00375900
     X LEQ 0 SINCE IT WILL NOT BE CALLED IN THAT CASE.  IT              00376000
     IS SUPPOSED TO GIVE ACCURACY TO 7 DIGITS;                          00376100
  BEGIN REAL H,Y; LABEL A1, A2;                                         00376200
  H := 1; Y := X;                                                       00376300
  A1:  IF Y = 2 THEN GO TO A2 ELSE IF Y LSS 2 THEN BEGIN                00376400
       H:=H/Y; Y:=Y+1; GO TO A1 END                                     00376500
     ELSE IF Y GEQ 3 THEN BEGIN                                         00376600
       Y:=Y-1; H:=H|Y; GO TO A1 END                                     00376700
     ELSE BEGIN Y := Y - 2;                                             00376800
       H := (((((((.0016063118 | Y + .0051589951) | Y                   00376900
            + .0044511400) | Y + .0721101567) | Y                       00377000
            + .0821117404) | Y + .4117741955) | Y                       00377100
            + .4227874605) | Y + .9999999758) | H END;                  00377200
  A2:  GAMMA := H;                                                      00377300
  END OF PROCEDURE GAMMA;                                               00377400
BOOLEAN PROCEDURE EXCLAM(MARG,NARG,M,ANS); VALUE MARG,NARG,M;           00377500
     REAL MARG,NARG,ANS; INTEGER M;                                     00377600
   BEGIN INTEGER N,I; REAL DENOM; LABEL PUT;                            00377700
    EXCLAM := TRUE;                                                     00377800
  IF I:=NARG.[1:8] NEQ 0 OR DENOM:=MARG.[1:8] NEQ 0 THEN BEGIN          00377900
    IF MARG LSS 0 OR NARG LSS 0 THEN BEGIN EXCLAM:=FALSE;               00378000
           GO TO PUT; END;                                              00378100
    IF M=0 THEN ANS:=GAMMA(NARG) ELSE BEGIN                             00378200
      IF (NARG-MARG) LEQ 0 THEN BEGIN EXCLAM:=FALSE; GO TO PUT END;     00378300
      ANS := 1;                                                         00378400
      IF I=0 THEN FOR I:=2 STEP 1 UNTIL NARG DO ANS:=ANS|I              00378500
            ELSE ANS:=GAMMA(NARG);                                      00378600
      IF DENOM=0 THEN BEGIN DENOM:=1; FOR I:=2 STEP 1 UNTIL MARG DO     00378700
         DENOM:=DENOM|I END ELSE DENOM:=GAMMA(MARG);                    00378800
      ANS := ANS / (DENOM | GAMMA(NARG-MARG));                          00378900
    END;                                                                00379000
   GO TO PUT; END;                                                      00379100
      IF M=0 THEN BEGIN ANS := 1;                                       00379200
      FOR I:=1 STEP 1 UNTIL NARG DO ANS:=ANS|I;                         00379300
        GO TO PUT; END                                                  00379400
       ELSE BEGIN IF MARG GTR NARG THEN                                 00379500
       BEGIN ANS:=0; GO TO PUT; END;                                    00379600
      IF MARG=0 THEN BEGIN ANS:=1; GO TO PUT; END;                      00379700
      ANS := NARG - MARG + 1;                                           00379800
      FOR I:=NARG-MARG+2 STEP 1 UNTIL NARG DO ANS:=ANS|I;               00379900
      DENOM := 1;                                                       00380000
      FOR I:=2 STEP 1 UNTIL MARG DO DENOM:=DENOM|I;                     00380100
      ANS := ANS / DENOM; END;                                          00380200
  PUT:  END PROCEDURE EXCLAM;                                           00380300
BOOLEAN PROCEDURE OPERATION(LEFT,RIGHT,LPTR,OP,ANS);                    00380400
  COMMENT:  OP DEFINES THE APL OPERATORS AS FOLLOWS:                    00380500
   OP    APL OPERATOR    OP    APL OPERATOR                             00380600
    0         +          10      FACT-COMB                              00380700
    1        TIMES       11         LSS                                 00380800
    2         -          12          =                                  00380900
    3        DIV         13         GEQ                                 00381000
    4         *          14         GTR                                 00381100
    5        RNDM        15         NEQ                                 00381200
    6      RESD-ABS      16         LEQ                                 00381300
    7      MIN-FLR       17         AND                                 00381400
    8      MAX-CEIL      18          OR                                 00381500
    9        NOT        19          NAND                                00381600
                        20          NOR                                 00381700
                        21         LN-LOG                               00381800
       THE "CIRCLE" OPERATORS FOLLOW.                                   00381900
   22      PI |         30   SQRT(1-B*2)                                00382000
   23     ARCTANH       31        SIN                                   00382100
   24     ARCCOSH       32        COS                                   00382200
   25     ARCSINH       33        TAN                                   00382300
   26     SQRT(B*2-1)   34      SQRT(1+B*2)                             00382400
   27     ARCTAN        35        SINH                                  00382500
   28     ARCCOS        36        COSH                                  00382600
   29     ARCSIN        37        TANH;                                 00382700
                                                                        00382800
   COMMENT:  LPTR IS LSS 0 IF THE CALL COMES FROM A                     00382900
                             REDUCTION TYPE PROCEDURE.                  00383000
            LPTR = 0 IF OPERATOR IS MONADIC.                            00383100
             LPTR GTR 0 IF OPERATOR IS DYADIC.                          00383200
             LPTR LSS 0 IF COMES FORM REDUCTION TYPE OPERATION;         00383300
      VALUE LEFT,RIGHT,LPTR,OP;                                         00383400
    REAL LEFT,RIGHT,LPTR,OP;                                            00383500
  REAL ANS;                                                             00383600
BEGIN LABEL PUT,DOMAIN,KITE; DEFINE GIVEUP=GO TO PUT#;                  00383700
   DEFINE MAXEXP=158.037557167#,                                        00383800
          MINEXP=-103.7216898#;                                         00383900
   MONITOR INTOVR, ZERO, EXPOVR;                                        00384000
   OPERATION:=TRUE;                                                     00384100
    IF LPTR LSS 0 THEN IF OP GTR 10 AND OP LSS 21 THEN                  00384200
          IF NOT BOOLTYPE(LEFT,RIGHT) THEN GO TO DOMAIN;                00384300
    IF OP = 45 THEN IF LPTR=0 THEN OP:=22                               00384400
     ELSE IF ABS(LEFT) GTR 7 THEN GO TO DOMAIN                          00384500
       ELSE OP := LEFT + 30;                                            00384600
    IF OP GTR 16 AND OP LSS 21 THEN IF NOT BOOLTYPE(LEFT,RIGHT)         00384700
         THEN GO TO DOMAIN;                                             00384800
    ZERO:=DOMAIN; INTOVR:=KITE; EXPOVR:=KITE;                           00384900
      CASE OP OF BEGIN                                                  00385000
    ANS := LEFT + RIGHT;                                                00385100
    ANS := IF LPTR=0 THEN SIGN(RIGHT) ELSE LEFT | RIGHT;                00385200
    ANS := LEFT - RIGHT;                                                00385300
    ANS := LEFT / RIGHT;                                                00385400
   IF LPTR=0 THEN IF RIGHT GTR MINEXP AND RIGHT LSS MAXEXP              00385500
                      THEN ANS:=EXP(RIGHT) ELSE GO TO KITE              00385600
       ELSE IF RIGHT.[3:6]=0 THEN ANS:=LEFT*ENTIER(RIGHT)               00385700
          ELSE IF LEFT GTR 0 THEN IF ANS:=RIGHT|LN(LEFT) GTR MINEXP     00385800
                               AND ANS LSS MAXEXP THEN                  00385900
                           ANS:=EXP(ANS) ELSE GO TO KITE                00386000
              ELSE IF LEFT=0 AND RIGHT GTR 0 THEN ANS:=0                00386100
                  ELSE GO TO DOMAIN;                                    00386200
    IF LPTR NEQ 0 THEN BEGIN ERR:=SYSTEMERROR; GIVEUP; END ELSE         00386300
  IF RIGHT LSS ORIGIN THEN GO TO DOMAIN ELSE                            00386400
      ANS := RANDINT(ORIGIN,RIGHT,SEED);                                00386500
    IF LPTR=0 THEN ANS := ABS(RIGHT) ELSE                               00386600
      BEGIN IF LEFT=0 THEN IF RIGHT GEQ 0 THEN                          00386700
     ANS := RIGHT ELSE GO TO DOMAIN                                     00386800
       ELSE IF (ANS:=RIGHT MOD LEFT) LSS 0                              00386900
       THEN ANS:=ANS + ABS(LEFT); END;                                  00387000
    ANS := (IF LPTR=0 THEN ENTIER(RIGHT+FUZZ)                           00387100
       ELSE IF LEFT LEQ RIGHT THEN LEFT ELSE RIGHT);                    00387200
    ANS := (IF LPTR=0 THEN -ENTIER(-RIGHT+FUZZ)                         00387300
       ELSE IF LEFT GTR RIGHT THEN LEFT ELSE RIGHT);                    00387400
    IF LPTR NEQ 0 THEN BEGIN ERR:=SYNTAXERROR; GIVEUP; END              00387500
       ELSE IF NOT BOOLTYPE(0,RIGHT) THEN                               00387600
        BEGIN ERR:=DOMAINERROR; GIVEUP; END                             00387700
      ELSE ANS := (IF RIGHT=1 THEN 0 ELSE 1);                           00387800
   IF NOT EXCLAM(LEFT,RIGHT,LPTR,ANS) THEN GO TO DOMAIN;                00387900
                                                                        00388000
    ANS := (IF RIGHT-LEFT GTR FUZZ|ABS(RIGHT) THEN 1 ELSE 0);           00388100
    ANS:=(IF ABS(LEFT-RIGHT) LEQ FUZZ|ABS(RIGHT) THEN 1 ELSE 0);        00388200
    ANS:=(IF RIGHT-LEFT LEQ FUZZ|ABS(RIGHT) THEN 1 ELSE 0);             00388300
    ANS:=(IF LEFT-RIGHT GTR FUZZ|ABS(RIGHT) THEN 1 ELSE 0);             00388400
    ANS:=(IF ABS(LEFT-RIGHT) GTR FUZZ|ABS(RIGHT) THEN 1 ELSE 0);        00388500
    ANS:=(IF LEFT-RIGHT LEQ FUZZ|ABS(RIGHT) THEN 1 ELSE 0);             00388600
    ANS := RIGHT | LEFT;  %AND                                          00388700
    ANS := IF RIGHT + LEFT = 0 THEN 0  ELSE 1;  %OR                     00388800
    ANS := IF  RIGHT | LEFT = 1 THEN 0 ELSE 1;  %NAND                   00388900
    ANS := IF RIGHT + LEFT = 0 THEN 1 ELSE 0; %NOR                      00389000
   IF RIGHT LEQ 0 THEN GO TO DOMAIN ELSE IF LPTR=0 THEN                 00389100
        ANS:=LN(RIGHT) ELSE                                             00389200
      IF LEFT LEQ 1 THEN GO TO DOMAIN ELSE                              00389300
        ANS := LN(RIGHT) / LN(LEFT);          %LOGARITHMS               00389400
    ANS := 3.1415926536 | RIGHT;                                        00389500
    IF ABS(RIGHT) GEQ 1 THEN GO TO DOMAIN ELSE                          00389600
      ANS:= .5|LN((1+RIGHT)/(1-RIGHT));  %ARCTANH                       00389700
                                                                        00389800
    IF RIGHT LSS 1 THEN GO TO DOMAIN ELSE                               00389900
     ANS:=LN(RIGHT+SQRT(RIGHT|RIGHT-1));  %ARCCOSH                      00390000
   ANS := LN(RIGHT + SQRT(RIGHT|RIGHT+1));  %ACRSINH                    00390100
                                                                        00390200
    IF ABS(RIGHT) LSS 1 THEN GO TO DOMAIN ELSE                          00390300
     ANS:=SQRT(RIGHT|RIGHT-1);                                          00390400
    ANS := ARCTAN(RIGHT);                                               00390500
   IF ABS(RIGHT) GTR 1 THEN GO TO DOMAIN ELSE                           00390600
       IF RIGHT=0 THEN ANS:=1.5707963268 ELSE                           00390700
     ANS:=ARCTAN(SQRT(1-RIGHT*2)/RIGHT);     %ARCCOS                    00390800
    IF ABS(RIGHT) GTR 1 THEN GO TO DOMAIN ELSE                          00390900
       ANS:=ARCTAN(RIGHT/ SQRT(1-RIGHT*2));   %ARCSIN                   00391000
    IF ABS(RIGHT) GTR 1 THEN GO TO DOMAIN ELSE                          00391100
       ANS := SQRT(1-RIGHT*2);                                          00391200
    ANS := SIN(RIGHT);                                                  00391300
    ANS := COS(RIGHT);                                                  00391400
    ANS := SIN(RIGHT) / COS(RIGHT);       %TAN                          00391500
   ANS := SQRT(1+RIGHT|RIGHT);                                          00391600
    ANS := (EXP(RIGHT) - EXP(-RIGHT))/2;   %SINH                        00391700
    ANS := (EXP(RIGHT) + EXP(-RIGHT))/2;   %COSH                        00391800
    ANS := ((OP:=EXP(RIGHT))-(ANS:=EXP(-RIGHT)))/(OP+ANS); %TANH        00391900
   END;                                                                 00392000
 GO TO PUT;                                                             00392100
 KITE:  ERR:=KITEERROR; GO TO PUT;                                      00392200
  DOMAIN:  ERR:=DOMAINERROR;                                            00392300
  PUT:  IF ERR NEQ 0 THEN OPERATION := FALSE;                           00392400
    END PROCEDURE OPERATION;                                            00392500
PROCEDURE ARITH(OP); VALUE OP;                                          00392600
      INTEGER OP;                                                       00392700
  COMMENT:  ARITH HANDLES ALL APL OPERATORS THAT EMPLOY THE             00392800
     VECTOR-VECTOR, SCALAR-VECTOR, SCALAR-SCALAR, VECTOR-SCALAR         00392900
     FEATURE.  DESC1 AND DESC2 ARE THE DESCRIPTORS FOR THE              00393000
     LEFTHAND AND RIGHTHAND OPERANDS, RESPECTIVELY.  IF                 00393100
     IF DESC1 = 0, THE OPERATOR IS TAKEN TO BE MONADIC.                 00393200
     IF DESC.SPF = 0, THE OPERAND IS NULL AND A DOMAIN ERROR            00393300
     RESULTS EXCEPT IN THE CASE OF MULTIPLICATION.                      00393400
     OP IS AN INTERNAL OPERATION CODE FOR THE OPERATOR, WHICH           00393500
     DEPENDS ON THE CASE STATEMENT IN THE OPERATION PROCEDURE.;         00393600
BEGIN INTEGER L,M,I,N,SIZE,RANK1,RANK2,TOP,                             00393700
         FORGETL, FORGETM;                                              00393800
    REAL DESC,LEFT,RIGHT,ANS,SIZE1,SIZE2,DESC1,DESC2;                   00393900
    LABEL DONE, LEFTSCALE, SCALVECT, DOMAIN, VECTSCAL;                  00394000
  BOOLEAN CHAR1, CHAR2;                                                 00394100
  DESC1 := AREG; DESC2 := BREG;                                         00394200
  L:=DESC1.SPF; M:=DESC2.SPF;                                           00394300
  RANK1:=DESC1.RF; RANK2:=DESC2.RF;                                     00394400
  SIZE1:=FINDSIZE(DESC1);  SIZE2:=FINDSIZE(DESC2);                      00394500
  IF(CHAR1:=DESC1.ARRAYTYPE=1) OR (CHAR2:=DESC2.ARRAYTYPE=1)            00394600
  THEN BEGIN IF OP LSS 11 OR OP GTR 16                                  00394700
     OR NOT(CHAR1 AND CHAR2) AND NOT(OP=12 OR OP=15)                    00394800
      THEN BEGIN CHAR1:=CHAR2:=FALSE; GO TO DOMAIN; END;                00394900
    IF CHAR1 THEN                                                       00395000
        FORGETL := L := UNPACK(L,RANK1,SIZE1);                          00395100
    IF CHAR2 THEN                                                       00395200
        FORGETM := M := UNPACK(M,RANK2,SIZE2); END;                     00395300
                                                                        00395400
                                                                        00395500
    IF M=0 THEN BEGIN IF OP NEQ 1 THEN GO TO DOMAIN                     00395600
                   ELSE BEGIN DESC := NULLV;                            00395700
                                    GO TO DONE; END;  END;              00395800
  IF L=0 THEN BEGIN                                                     00395900
  IF DESC1.DID NEQ 0 THEN                                               00396000
    IF OP=1 THEN BEGIN DESC:=NULLV; GO TO DONE; END                     00396100
      ELSE GO TO DOMAIN;                                                00396200
    IF OP GTR 10 AND OP LSS 21 THEN GO TO DOMAIN;                       00396300
     LEFT := OP MOD 2; GO TO LEFTSCALE; END;                            00396400
   IF SIZE1=1                                                           00396500
       THEN BEGIN L:=L+RANK1; LEFT:=SP[LOC];                            00396600
     GO TO LEFTSCALE; END;                                              00396700
   IF SIZE2=1 THEN BEGIN                                                00396800
     % DESC1 IS A VECTOR, DESC2 IS A SCALAR;                            00396900
   VECTSCAL:  M:=M+RANK2; RIGHT:=SP[MOC];                               00397000
   I := GETSPACE( SIZE:=SIZE1+RANK1);                                   00397100
   DESC.SPF:=I; DESC.DID:=DDPUVW; SPCOPY(L,I,RANK1);                    00397200
   L:=L+RANK1; I:=I+RANK1;                                              00397300
   DESC.RF:=RANK1;  TOP:=SIZE1+I-1;                                     00397400
   FOR N:=I STEP 1 UNTIL TOP DO BEGIN                                   00397500
     IF OPERATION(SP[LOC],RIGHT,L,OP,ANS) THEN                          00397600
          SP[NOC] := ANS ELSE GO TO DONE;                               00397700
     L:=L+1; END;                                                       00397800
   GO TO DONE; END;                                                     00397900
% BOTH DESC1 AND DESC2 ARE ARRAYS;                                      00398000
  IF NOT MATCHDIM(DESC1,DESC2) THEN GO TO DONE                          00398100
     ELSE BEGIN                                                         00398200
     I := GETSPACE( SIZE := SIZE2 + RANK2 );                            00398300
     SPCOPY(M,I,RANK2); DESC.SPF:=I; DESC.DID:=DDPUVW;                  00398400
     DESC.RF := RANK2;                                                  00398500
     M:=M+RANK2; I:=I+RANK2; L:=L+RANK2;                                00398600
     TOP := I+SIZE2-1;                                                  00398700
     FOR N:=I STEP 1 UNTIL TOP DO BEGIN                                 00398800
     IF OPERATION(SP[LOC],SP[MOC],L,OP,ANS) THEN                        00398900
         SP[NOC] := ANS ELSE GO TO DONE;                                00399000
       L:=L+1; M:=M+1; END;                                             00399100
     GO TO DONE; END;                                                   00399200
   LEFTSCALE:  IF SIZE2 = 1                                             00399300
          THEN BEGIN                                                    00399400
 IF RANK1 NEQ RANK2 THEN BEGIN                                          00399500
     IF RANK1=0 THEN GO TO SCALVECT;                                    00399600
      IF RANK2=0 THEN BEGIN L:=L-RANK1; GO TO VECTSCAL; END;            00399700
   IF CHAR1 AND RANK1=1 THEN GO TO SCALVECT;                            00399800
   IF CHAR2 AND RANK2=1 THEN GO TO VECTSCAL;                            00399900
     ERR:=KITEERROR; GO TO DONE; END                                    00400000
    ELSE IF RANK1|RANK2 NEQ 0 THEN GO TO SCALVECT;                      00400100
 % BOTH OPERANDS ARE SCALAR;                                            00400200
   M := M + RANK2;                                                      00400300
   N := GETSPACE(SIZE:=1); RIGHT:=SP[MOC];                              00400400
    DESC.SPF := N; DESC.DID := DDPUSW;                                  00400500
    IF OPERATION(LEFT,RIGHT,L,OP,ANS) THEN                              00400600
      SP[NOC] := ANS ELSE GO TO DONE;                                   00400700
    GO TO DONE; END                                                     00400800
   ELSE BEGIN %DESC1 IS SCALAR, DESC2 IS VECTOR;                        00400900
                                                                        00401000
 SCALVECT:  I := GETSPACE( SIZE := SIZE2 + RANK2);                      00401100
    DESC.SPF := I; DESC.RF := RANK2; DESC.DID:=DDPUVW;                  00401200
    SPCOPY(M,I,RANK2);                                                  00401300
     M:=M+RANK2; I:=I+RANK2; TOP:=SIZE2+I-1;                            00401400
    FOR N:=I STEP 1 UNTIL TOP DO BEGIN                                  00401500
      IF OPERATION(LEFT,SP[MOC],L,OP,ANS)                               00401600
       THEN SP[NOC] := ANS ELSE GO TO DONE;                             00401700
      M := M+1; END;                                                    00401800
     END;                                                               00401900
   GO TO DONE;                                                          00402000
  DOMAIN:  ERR:= DOMAINERROR;                                           00402100
 DONE:  RESULTD := DESC;                                                00402200
   IF CHAR1 THEN FORGETSPACE(FORGETL,SIZE1+RANK1);                      00402300
   IF CHAR2 THEN FORGETSPACE(FORGETM,SIZE2+RANK2);                      00402400
 IF ERR NEQ 0 THEN FORGETSPACE(DESC.SPF, SIZE);                         00402500
  END PROCEDURE ARITH;                                                  00402600
PROCEDURE DYADICRNDM;                                                   00402700
  BEGIN INTEGER NUM, KIND; REAL DESC;                                   00402800
  REAL DESC1, DESC2;                                                    00402900
  INTEGER L,M,N,T,I,TEMP,OUTTOP,TOP,PICK; LABEL QUIT;                   00403000
  INTEGER START; LABEL INSERT;                                          00403100
    DESC1 := AREG; DESC2 := BREG;                                       00403200
    IF FINDSIZE(DESC1) NEQ 1 OR FINDSIZE(DESC2) NEQ 1                   00403300
      THEN BEGIN ERR:=RANKERROR; GO TO QUIT; END;                       00403400
    IF DESC1.SPF=0 OR DESC2.SPF=0 THEN BEGIN                            00403500
             ERR:=DOMAINERROR; GO TO QUIT; END;                         00403600
    L:=DESC1.SPF+DESC1.RF; M:=DESC2.SPF+DESC2.RF;                       00403700
    NUM := SP[LOC]; KIND := SP[MOC];                                    00403800
    IF KIND LSS ORIGIN                                                  00403900
     OR NUM GTR PICK := KIND-ORIGIN+1                                   00404000
     OR DESC1.ARRAYTYPE=1                                               00404100
     OR DESC2.ARRAYTYPE=1 THEN BEGIN ERR:=DOMAINERROR;                  00404200
      GO TO QUIT; END;                                                  00404300
    DESC.DID := DDPUVW; DESC.RF := 1;                                   00404400
  IF NUM LEQ 0 THEN BEGIN DESC := NULLV; GO TO QUIT; END;               00404500
  IF NUM GTR MAXWORDSTORE THEN BEGIN ERR:=KITEERROR; GO TO QUIT; END;   00404600
    DESC.SPF := L := GETSPACE(NUM+1);                                   00404700
    SP[LOC] := NUM; L := L+1;                                           00404800
    OUTTOP := L+NUM-1;                                                  00404900
  TEMP := GETSPACE(NUM);                                                00405000
  START:=ORIGIN; I:=0;                                                  00405100
  FOR L:=L STEP 1 UNTIL OUTTOP DO BEGIN                                 00405200
    PICK:=RANDINT(START,KIND,SEED);                                     00405300
    M:=TEMP;                                                            00405400
    IF I = 0 OR PICK LSS SP[MOC] THEN N:=TEMP                           00405500
      ELSE BEGIN TOP:=TEMP+I-1;                                         00405600
        N:=TEMP+T:=I DIV 2;                                             00405700
        WHILE T GTR 0 DO                                                00405800
          IF PICK GEQ SP[NOC] THEN N:=N+T:=T DIV 2                      00405900
                      ELSE N:=N-T:=T DIV 2;                             00406000
                                                                        00406100
        FOR N:=MAX(TEMP,N-1) STEP 1 UNTIL TOP DO                        00406200
          IF SP[NOC] GTR PICK THEN                                      00406300
               GO TO INSERT;                                            00406400
      END;                                                              00406500
    INSERT:  IF L LSS OUTTOP THEN BEGIN TOP:=N+1; N:=TEMP+I;            00406600
     FOR M:=N STEP -1 UNTIL TOP DO BEGIN                                00406700
       N:=N-1;  SP[MOC] := SP[NOC] - 1; END;                            00406800
     SP[NOC] := PICK; END;                                              00406900
    SP[LOC] := N - TEMP + PICK;                                         00407000
    KIND:=KIND-1;                                                       00407100
    I:=I+1;                                                             00407200
    END;                                                                00407300
  FORGETSPACE(TEMP,NUM);                                                00407400
  QUIT:  RESULTD := DESC;                                               00407500
  END PROCEDURE DYADICRNDM;                                             00407600
PROCEDURE RHOP;                                                         00407700
  BEGIN INTEGER RANK,M,POINT; REAL NEWDESC,DESC1,DESC;                  00407800
  LABEL QUIT, WORK; BOOLEAN CHARACTER;                                  00407900
  DEFINE TOOBIG=BEGIN ERR:=KITEERROR; GO TO QUIT; END#;                 00408000
  INTEGER N,TOP,NEWRANK,RANK1, POINT1,SIZE1,L,SIZE2;                    00408100
  DESC1 := AREG; DESC := BREG;                                          00408200
  IF DESC.SPF = 0 THEN BEGIN ERR:=DOMAINERROR; GO TO QUIT; END;         00408300
  IF DESC1.DID NEQ 0 THEN BEGIN %--DYADIC RHO--RESTRUCTURING---------   00408400
    IF L:=DESC1.SPF = 0 THEN BEGIN %NULL LEFT OP MEANS SCALAR ANS       00408500
      IF DESC.ARRAYTYPE=1 THEN TOOBIG; %NO SCALAR CHARACTERS            00408600
      NEWDESC.SPF:=M:=GETSPACE(1);                                      00408700
      NEWDESC.DID:=DDPUSW;                                              00408800
      L:=DESC.SPF+DESC.RF;                                              00408900
      SP[MOC]:=SP[LOC]; GO TO QUIT; END;                                00409000
    IF DESC1.ARRAYTYPE NEQ 0 THEN BEGIN                                 00409100
         ERR:=DOMAINERROR; GO TO QUIT; END;                             00409200
    RANK1:=DESC1.RF;                                                    00409300
    IF FINDSIZE(DESC1)=1 THEN BEGIN                                     00409400
      N:=L+RANK1;                                                       00409500
      IF SIZE1:=ENTIER(SP[NOC]+.5) LSS 0 THEN BEGIN                     00409600
            ERR:=DOMAINERROR; GO TO QUIT; END;                          00409700
      NEWRANK:=1; TOP:=N; GO TO WORK; END;                              00409800
    IF RANK1 NEQ 1 THEN BEGIN ERR:=RANKERROR; GO TO QUIT; END;          00409900
    IF NEWRANK:=SP[LOC] GTR 31 THEN TOOBIG;                             00410000
    SIZE1:=1; TOP := L+NEWRANK+RANK1-1;                                 00410100
    IF NEWRANK LEQ 0 THEN BEGIN ERR:=SYSTEMERROR; GO TO QUIT; END;      00410200
    FOR N:=L+RANK1 STEP 1 UNTIL TOP DO                                  00410300
        IF SIZE1:=SIZE1|ENTIER(SP[NOC]+.5) LSS 0 THEN BEGIN             00410400
            ERR:=DOMAINERROR; GO TO QUIT; END;                          00410500
WORK:  IF SIZE1=0 THEN BEGIN NEWDESC := NULLV; GO TO QUIT END;          00410600
  IF SIZE1 GTR MAXWORDSTORE THEN TOOBIG;                                00410700
  NEWDESC.DID:=DDPUVW; NEWDESC.RF:=NEWRANK;                             00410800
  NEWDESC.SPF := M := GETSPACE(SIZE1+NEWRANK);                          00410900
 %CANT USE SPCOPY FOR DIM VECTOR AS LEFT OP MAY NOT BE INTEGER          00411000
  FOR L:=L+RANK1 STEP 1 UNTIL TOP DO;                                   00411100
    BEGIN SP[MOC]:=ENTIER(SP[LOC]+.5); M:=M+1; END;                     00411200
    SIZE2:=FINDSIZE(DESC); L:=DESC.SPF; RANK:=DESC.RF;                  00411300
    IF DESC.ARRAYTYPE=1 THEN BEGIN L:=UNPACK(L,RANK,SIZE2);             00411400
      CHARACTER:=TRUE; END; TOP:=SIZE1 DIV SIZE2; POINT:=L+RANK;        00411500
      FOR N:=1 STEP 1 UNTIL TOP DO BEGIN SPCOPY(POINT,M,SIZE2);         00411600
          M := M+SIZE2; END;                                            00411700
      TOP := SIZE1 MOD SIZE2; SPCOPY(POINT,M,TOP);                      00411800
      GO TO QUIT; END ELSE                                              00411900
%--------MONADIC RHO-----DIMENSION VECTOR----------------------         00412000
    RANK := DESC.RF; POINT := DESC.SPF;                                 00412100
    NEWDESC.DID := DDPUVW; NEWDESC.RF := 1;                             00412200
    IF DESC.DATATYPE = 1 THEN BEGIN                                     00412300
      NEWDESC := NULLV; GO TO QUIT END;                                 00412400
    NEWDESC.SPF := M := GETSPACE(RANK+1);                               00412500
    SP[MOC] := RANK;                                                    00412600
    SPCOPY(POINT,M+1, RANK);                                            00412700
  QUIT:  IF CHARACTER THEN BEGIN NEWDESC.ARRAYTYPE:=1;                  00412800
            FORGETSPACE(L,SIZE2+RANK);                                  00412900
            PACK(NEWDESC.SPF, NEWRANK,SIZE1); END;                      00413000
    RESULTD := NEWDESC;                                                 00413100
  END PROCEDURE RHOP;                                                   00413200
PROCEDURE IOTAP;                                                        00413300
  BEGIN INTEGER I,L,M,TOP; REAL DESC;                                   00413400
  REAL LEFTOP, RIGHTOP;                                                 00413500
  INTEGER RSIZE,LSIZE,RRANK,LRANK,N,LL,MM,TIP,NIX;                      00413600
                                                                        00413700
  LABEL QUIT, DONE;                                                     00413800
  LEFTOP:=AREG; RIGHTOP:=BREG;                                          00413900
  IF L:=RIGHTOP.SPF=0 THEN BEGIN ERR:=DOMAINERROR; GO TO QUIT END;      00414000
  RSIZE:=FINDSIZE(RIGHTOP); RRANK:=RIGHTOP.RF;                          00414100
  DESC.DID := DDPUVW; DESC.RF := 1;                                     00414200
  IF LEFTOP.DID NEQ 0 THEN BEGIN  %-------DYADIC IOTA------------       00414300
   IF LRANK := LEFTOP.RF GTR 1 THEN BEGIN ERR:=RANKERROR;               00414400
                         GO TO QUIT; END;                               00414500
   LSIZE := FINDSIZE(LEFTOP);                                           00414600
   IF M:=LEFTOP.SPF=0 THEN BEGIN %RESULT IS ORIGIN IF IT WAS NULL       00414700
     DESC.SPF:=M:=GETSPACE(1); DESC.RF:=0; DESC.SCALAR:=1;              00414800
     SP[MOC] := ORIGIN; GO TO QUIT; END;                                00414900
  IF LEFTOP.ARRAYTYPE=1 THEN M:=UNPACK(M,LRANK,LSIZE);                  00415000
  IF RIGHTOP.ARRAYTYPE=1  THEN L:=UNPACK(L,RRANK,RSIZE);                00415100
   TIP := (NIX:=LSIZE+ORIGIN) - 1;                                      00415200
   DESC.SPF:=N:=GETSPACE(RSIZE+RRANK);                                  00415300
  IF RRANK=0 THEN DESC.SCALAR:=1 ; DESC.RF:=RRANK;                      00415400
   SPCOPY(L,N,RRANK);                                                   00415500
   MM := M+LRANK; LL:=L:=L+RRANK;                                       00415600
    TOP:=N+RRANK+RSIZE-1;                                               00415700
   FOR N:=N+RRANK STEP 1 UNTIL TOP DO BEGIN                             00415800
     SP[NOC] := NIX;                                                    00415900
     M := MM;                                                           00416000
     FOR I:=ORIGIN STEP 1 UNTIL TIP DO                                  00416100
      IF OPERATION(SP[MOC],SP[LOC],1,12,LEFTOP) AND LEFTOP=1            00416200
        THEN BEGIN SP[NOC]:=I; GO TO DONE;                              00416300
         END ELSE M:=M+1;                                               00416400
     DONE:  L:=L+1;  END;                                               00416500
  IF LEFTOP.ARRAYTYPE=1 THEN FORGETSPACE(MM-LRANK,LRANK+LSIZE);         00416600
  IF RIGHTOP.ARRAYTYPE=1 THEN FORGETSPACE(LL-RRANK,RRANK+RSIZE);        00416700
  END ELSE BEGIN %-------------MONADIC IOTA------------------           00416800
  IF RIGHTOP.ARRAYTYPE=1 THEN                                           00416900
       BEGIN ERR:=DOMAINERROR; GO TO QUIT                               00417000
        END;                                                            00417100
  IF RSIZE NEQ 1 THEN BEGIN ERR:=RANKERROR; GO TO QUIT END;             00417200
                                                                        00417300
  L := L + RRANK;                                                       00417400
  IF TOP:=SP[LOC] GTR MAXWORDSTORE THEN                                 00417500
     BEGIN ERR:=KITEERROR; GO TO QUIT                                   00417600
     END;                                                               00417700
                                                                        00417800
  IF TOP LSS ORIGIN THEN BEGIN DESC:=NULLV; GO TO QUIT END;             00417900
  DESC.SPF := M := GETSPACE(TOP+1);                                     00418000
  SP[MOC] := TOP; M := M+1;                                             00418100
  TOP := TOP + ORIGIN - 1;                                              00418200
  FOR I := ORIGIN STEP 1 UNTIL TOP DO BEGIN                             00418300
     SP[MOC] := I; M := M+1;  END;                                      00418400
  END;                                                                  00418500
QUIT:  RESULTD := DESC;                                                 00418600
 END PROCEDURE IOTAP;                                                   00418700
PROCEDURE COMMAP;                                                       00418800
  BEGIN REAL LDESC, RDESC;                                              00418900
    INTEGER L,M,N,LRANK,RRANK,LSIZE,RSIZE,SIZE;                         00419000
   REAL DESC; LABEL QUIT; BOOLEAN CHARACTER;                            00419100
    LDESC := AREG; RDESC := BREG;                                       00419200
   RRANK := RDESC.RF;  LRANK := LDESC.RF;                               00419300
   LSIZE := IF (L := LDESC.SPF) = 0 THEN 0 ELSE FINDSIZE(LDESC);        00419400
   RSIZE := IF (M := RDESC.SPF) = 0 THEN 0 ELSE FINDSIZE(RDESC);        00419500
   IF RDESC.ARRAYTYPE = 1 THEN BEGIN                                    00419600
       M := UNPACK(M,RRANK,RSIZE);                                      00419700
       CHARACTER :=  TRUE;  END;                                        00419800
   DESC.DID := DDPUVW; DESC.RF := 1;                                    00419900
   IF LDESC.DID = 0 THEN BEGIN  %-----MONADIC COMMA--RAVEL--------      00420000
    IF RSIZE=0 THEN BEGIN DESC:=NULLV; GO TO QUIT END;                  00420100
    DESC.SPF := L := GETSPACE(RSIZE+1);                                 00420200
    SP[LOC] := RSIZE;                                                   00420300
    SPCOPY(M+RRANK, L+1, RSIZE);                                        00420400
    N := L; SIZE := RSIZE;                                              00420500
    GO TO QUIT; END                                                     00420600
   ELSE BEGIN                                                           00420700
  %HERE IS THE CODE FOR DYADIC COMMA, I.E. CATENATION                   00420800
    IF RRANK NEQ 1 AND RSIZE GTR 1 OR                                   00420900
       LRANK NEQ 1 AND LSIZE GTR 1 THEN BEGIN                           00421000
         ERR:= RANKERROR; GO TO QUIT; END;                              00421100
  IF SIZE:=LSIZE+RSIZE GTR MAXWORDSTORE THEN BEGIN                      00421200
          ERR:=KITEERROR; GO TO QUIT; END;                              00421300
   COMMENT CANT MIX NUMBER AND CHARACTERS. HAVE TO JUGGLE               00421400
        IF LEFT IS NUMBERS AND RIGHT IS CHARACTERS AS RIGHT             00421500
        HAS ALREADY BEEN UNPACKED AND WE DONT WANT TO FORGET            00421600
        LEFT AND DONT WANT TO PACK THE NON-RESULT;                      00421700
   IF CHARACTER THEN                                                    00421800
      IF LDESC.ARRAYTYPE=1 OR LSIZE=0 THEN L:=UNPACK(L,LRANK,LSIZE)     00421900
          ELSE BEGIN SIZE:=0; LSIZE:=-LRANK; ERR:=DOMAINERROR;          00422000
              GO TO QUIT END                                            00422100
   ELSE IF LDESC.ARRAYTYPE=1 THEN                                       00422200
      IF RSIZE NEQ 0 THEN                                               00422300
         BEGIN ERR:=DOMAINERROR; GO TO QUIT END                         00422400
      ELSE BEGIN CHARACTER:=TRUE;                                       00422500
                 L:=UNPACK(L,LRANK,LSIZE); END;                         00422600
   IF SIZE=0 THEN BEGIN DESC:=NULLV; GO TO QUIT END;                    00422700
   DESC.SPF := N := GETSPACE(SIZE+1);                                   00422800
   SP[NOC] := SIZE;                                                     00422900
      SPCOPY(L+LRANK, N+1, LSIZE);                                      00423000
      SPCOPY(M+RRANK, N+LSIZE+1, RSIZE);                                00423100
   END;                                                                 00423200
   QUIT:                                                                00423300
   IF CHARACTER THEN BEGIN DESC.ARRAYTYPE := 1;                         00423400
      PACK(N,1,SIZE);                                                   00423500
      FORGETSPACE(L,LSIZE+LRANK);                                       00423600
      FORGETSPACE(M,RSIZE+RRANK);                                       00423700
        END;                                                            00423800
   RESULTD := DESC;                                                     00423900
  END PROCEDURE COMMAP;                                                 00424000
INTEGER STREAM PROCEDURE GETOP(A,N); VALUE N;                           00424100
  BEGIN SI := A; SI := SI + N;                                          00424200
    DI := LOC GETOP;                                                    00424300
    DS := 7 LIT "0"; DS := CHR;                                         00424400
  END PROCEDURE GETOP;                                                  00424500
  REAL PROCEDURE IDENTITY(OP); VALUE OP; INTEGER OP;                    00424600
  BEGIN                                                                 00424700
  CASE OP OF BEGIN                                                      00424800
      IDENTITY := 0;       %FOR +                                       00424900
      IDENTITY := 1;       %FOR |                                       00425000
      IDENTITY := 0;       %FOR -                                       00425100
      IDENTITY := 1;       %FOR DIV                                     00425200
      IDENTITY := 1;       %FOR *                                       00425300
                   ;       %NO REDUCTION ON RNDM                        00425400
      IDENTITY := 0;       %FOR RESD                                    00425500
    IDENTITY := BIGGEST;  %FOR MIN                                      00425600
    IDENTITY := -BIGGEST; %FOR MAX                                      00425700
                   ;        %NOT ISNT DYADIC                            00425800
      IDENTITY := 1;        %FOR COMB                                   00425900
     IDENTITY := 0;        %FOR LSS                                     00426000
     IDENTITY := 1;        %FOR =                                       00426100
     IDENTITY := 1;       %FOR GEQ                                      00426200
     IDENTITY := 0;        %FOR GTR                                     00426300
     IDENTITY := 0;        %FOR NEQ                                     00426400
     IDENTITY := 1;        %FOR LEQ                                     00426500
      IDENTITY := 1;        %FOR AND                                    00426600
      IDENTITY := 0;        %FOR OR                                     00426700
   END;   END PROCEDURE IDENTITY;                                       00426800
INTEGER PROCEDURE GETT(ALONG,RANK); VALUE ALONG, RANK;                  00426900
      INTEGER ALONG, RANK;                                              00427000
  GETT:= IF ALONG=1 THEN 0 ELSE                                         00427100
         IF ALONG=RANK THEN 2 ELSE                                      00427200
         IF ALONG=RANK-1 THEN 1 ELSE 0;                                 00427300
BOOLEAN PROCEDURE CHECKANDADD(SIZE,L,SUM);                              00427400
    VALUE SIZE,L; INTEGER SIZE,L,SUM;                                   00427500
  BEGIN LABEL QUIT; INTEGER I,TOP,M,S,T;                                00427600
    CHECKANDADD:=TRUE;                                                  00427700
    SUM := 0;                                                           00427800
    TOP := SIZE DIV 2 | 2 - 1 + L;                                      00427900
    FOR L:=L STEP 2 UNTIL TOP DO BEGIN  M:=L+1;                         00428000
       IF NOT BOOLTYPE(S:=SP[LOC], T:=SP[MOC]) THEN BEGIN               00428100
            CHECKANDADD:=FALSE; GO TO QUIT; END                         00428200
          ELSE SUM := SUM+S+T; END;                                     00428300
    IF SIZE MOD 2 = 1 THEN BEGIN                                        00428400
      IF NOT BOOLTYPE(T:=SP[LOC],0) THEN                                00428500
        CHECKANDADD := FALSE ELSE SUM := SUM+T;                         00428600
      END;                                                              00428700
  QUIT:  END PROCEDURE CHECKANDADD;                                     00428800
PROCEDURE COMPRESS(LDESC, RDESC, DIM); VALUE LDESC,RDESC,DIM;           00428900
     REAL LDESC, RDESC, DIM;                                            00429000
  BEGIN INTEGER I,J,K,L,M,N,T,RANK,LSIZE,RSIZE,ALONG,TOP,               00429100
          FACTOR,SUM,DIMMOD,SIZE,LEFT,RIGHT,S;                          00429200
    REAL DESC; BOOLEAN CHARACTER;                                       00429300
    LABEL QUIT,RANKE,DOMAIN,IDENT;                                      00429400
  DESC.DID := DDPUVW;                                                   00429500
  IF L := LDESC.SPF = 0 THEN GO TO DOMAIN;                              00429600
  IF M:=RDESC.SPF = 0 THEN BEGIN DESC:=NULLV; GO TO QUIT; END;          00429700
  LSIZE := FINDSIZE(LDESC); RSIZE := FINDSIZE(RDESC);                   00429800
  IF RANK:=LDESC.RF NEQ 1 THEN IF LSIZE NEQ 1                           00429900
     THEN GO TO DOMAIN;                                                 00430000
  LEFT := L := L+RANK;                                                  00430100
  RANK := RDESC.RF;                                                     00430200
  IF N:=DIM.SPF=0 AND DIM.DID NEQ 0 OR DIM.ARRAYTYPE=1                  00430300
    OR LDESC.ARRAYTYPE=1 THEN GO TO DOMAIN;                             00430400
  IF J:=DIM.RF NEQ 0 THEN BEGIN                                         00430500
      IF FINDSIZE(DIM)=1 THEN N:=N+J ELSE GO TO DOMAIN END;             00430600
  IF ALONG:=(IF N=J THEN RANK ELSE SP[NOC]-ORIGIN+1) GTR RANK           00430700
    OR ALONG LSS 1 AND RANK NEQ 0                                       00430800
    THEN BEGIN ERR:=INDEXERROR; GO TO QUIT; END;                        00430900
  IF RANK = 0 THEN                                                      00431000
    IF LSIZE NEQ 1 THEN GO TO DOMAIN ELSE BEGIN                         00431100
      IF TOP:=SP[LOC]=0 THEN BEGIN DESC:=NULLV; GO TO QUIT; END;        00431200
      IF TOP = 1 THEN BEGIN DESC.SPF := N := GETSPACE(2);               00431300
          DESC.RF := SP[NOC] := 1;                                      00431400
          N:=N+1; SP[NOC]:=SP[MOC]; GO TO QUIT;                         00431500
       END ELSE GO TO DOMAIN; END;                                      00431600
   IF LSIZE = 1 THEN BEGIN                                              00431700
       COMMENT IF LEFT ARG IS SCALAR, ANSWER IS NULL IF 0,              00431800
                RIGHT ARG IF 1;                                         00431900
    SUM:=SP[LOC];                                                       00432000
    IF SUM NEQ 0 AND SUM NEQ 1 THEN GO TO DOMAIN                        00432100
                                                                        00432200
       ELSE GO TO IDENT; END;                                           00432300
  N := M+ALONG - 1;                                                     00432400
  IF LSIZE NEQ (T:=SP[NOC]) THEN BEGIN                                  00432500
    ERR:=LENGTHERROR; GO TO QUIT; END;                                  00432600
  IF NOT CHECKANDADD(LSIZE,LEFT,SUM) THEN GO TO DOMAIN;                 00432700
    IDENT:  IF SUM=0 THEN BEGIN DESC:=NULLV; GO TO QUIT END;            00432800
    IF SUM = LSIZE THEN BEGIN                                           00432900
      IF RDESC.ARRAYTYPE=1 THEN BEGIN                                   00433000
        RSIZE:=RSIZE DIV 8 + (IF RSIZE MOD 8 NEQ 0 THEN 1 ELSE 0);      00433100
        DESC.CHRMODE:=1; END;                                           00433200
      DESC.SPF:=N:=GETSPACE(TOP:=RSIZE+RANK);                           00433300
      DESC.RF := RANK; SPCOPY(M,N,TOP); GO TO QUIT; END;                00433400
  SIZE := RSIZE DIV T | SUM;                                            00433500
  DESC.RF:=RANK;                                                        00433600
  IF RDESC.ARRAYTYPE = 1 THEN BEGIN M:=UNPACK(M,RANK,RSIZE);            00433700
             CHARACTER := TRUE; END;                                    00433800
  RIGHT := M;                                                           00433900
  DESC.SPF := S := GETSPACE(SIZE+RANK);                                 00434000
  N := S;                                                               00434100
  FOR I:=1 STEP 1 UNTIL RANK DO BEGIN                                   00434200
    IF I=ALONG THEN SP[NOC]:=SUM ELSE SP[NOC]:=SP[MOC];                 00434300
    N:=N+1; M:=M+1; END;                                                00434400
  T := GETT(ALONG, RANK);                                               00434500
  FACTOR := 1; TOP := RIGHT+ALONG;                                      00434600
  FOR N:=RIGHT+RANK-1 STEP -1 UNTIL TOP DO FACTOR:=                     00434700
            FACTOR | SP[NOC];                                           00434800
  N:=RIGHT + RANK - 1; DIM := SP[NOC];                                  00434900
  N := N+1; M:=S+RANK; I:=0;                                            00435000
    DIMMOD := DIM-1;                                                    00435100
    WHILE I LSS RSIZE DO BEGIN                                          00435200
      CASE T OF BEGIN                                                   00435300
       L := I DIV FACTOR MOD LSIZE;                                     00435400
        L := I DIV FACTOR MOD DIMMOD;                                   00435500
        L := I MOD DIM; END;                                            00435600
    L := L+LEFT;                                                        00435700
    IF SP[LOC] = 1 THEN FOR K:=1 STEP 1 UNTIL FACTOR DO BEGIN           00435800
      SP[MOC]:=SP[NOC]; I:=I+1; M:=M+1; N:=N+1;                         00435900
        END ELSE BEGIN I:=I+FACTOR; N:=N+FACTOR; END;                   00436000
      END;                                                              00436100
    GO TO QUIT;                                                         00436200
  RANKE:  ERR:=RANKERROR; GO TO QUIT;                                   00436300
  DOMAIN:  ERR:=DOMAINERROR; GO TO QUIT;                                00436400
  QUIT:  IF CHARACTER THEN BEGIN PACK(S,RANK,SIZE);                     00436500
            DESC.ARRAYTYPE:=1; FORGETSPACE(RIGHT,RSIZE+RANK); END;      00436600
    RESULTD := DESC;                                                    00436700
    POP;                                                                00436800
  END PROCEDURE COMPRESS;                                               00436900
PROCEDURE EXPAND(LDESC,RDESC,DIM); VALUE LDESC,RDESC,DIM;               00437000
    REAL LDESC,RDESC, DIM;                                              00437100
  BEGIN INTEGER I,J,K,L,M,N,S,T,RANK,LSIZE,RSIZE,SIZE,                  00437200
                ALONG,TOP,LADDR,MADDR,FACTOR, SUM;                      00437300
    REAL DESC, INSERT;                                                  00437400
    LABEL QUIT, DOMAIN;                                                 00437500
    BOOLEAN CHARACTER;                                                  00437600
    LSIZE:=FINDSIZE(LDESC); RSIZE:=FINDSIZE(RDESC);                     00437700
    RANK := RDESC.RF;                                                   00437800
    IF M:=RDESC.SPF=0                                                   00437900
      OR L:=LDESC.SPF=0                                                 00438000
      OR I:=LDESC.RF GTR 1                                              00438100
                                                                        00438200
      OR N:=DIM.SPF=0 AND DIM.DID NEQ 0                                 00438300
      OR DIM.ARRAYTYPE=1                                                00438400
      OR FINDSIZE(DIM ) NEQ 1                                           00438500
      OR LDESC.ARRAYTYPE=1                                              00438600
       THEN GO TO DOMAIN;                                               00438700
    N:=N + (T:=DIM.RF);                                                 00438800
  IF ALONG :=(IF N=T THEN RANK ELSE SP[NOC]-ORIGIN+1) GTR RANK          00438900
        OR ALONG LSS 1 AND RANK NEQ 0                                   00439000
     THEN BEGIN ERR:=INDEXERROR; GO TO QUIT; END;                       00439100
   IF RANK=0 THEN DIM:=1                                                00439200
      ELSE BEGIN N:=M+ALONG-1; DIM:=SP[NOC]; END;                       00439300
  IF SIZE:=RSIZE DIV DIM | LSIZE GTR MAXWORDSTORE                       00439400
       THEN BEGIN ERR:=KITEERROR; GO TO QUIT; END;                      00439500
    IF NOT CHECKANDADD(LSIZE,LADDR:=L+I, SUM) THEN GO TO DOMAIN;        00439600
    IF SUM NEQ DIM THEN BEGIN ERR:=RANKERROR; GO TO QUIT; END;          00439700
  IF RANK=0 THEN BEGIN                                                  00439800
    DIM:=SP[MOC]; DESC.SPF:=N:=GETSPACE(LSIZE+I);                       00439900
    DESC.RF:=I; DESC.DID:=(IF I=0 THEN DDPUSW ELSE DDPUVW);             00440000
    SPCOPY(L,N,I);  L:=L+I; N:=N+I; TOP:=L+LSIZE-1;                     00440100
    FOR L:=L STEP 1 UNTIL TOP DO BEGIN                                  00440200
     IF SP[LOC]=1 THEN SP[NOC]:=DIM;                                    00440300
     N:=N+1; END;                                                       00440400
  GO TO QUIT END;                                                       00440500
    IF RDESC.ARRAYTYPE=1 THEN BEGIN CHARACTER:=TRUE;                    00440600
       M:=UNPACK(M,RANK,RSIZE);                                         00440700
       INSERT := " "; END;                                              00440800
    FACTOR:=1; TOP:=M+ALONG;                                            00440900
    FOR N:=M+RANK-1 STEP -1 UNTIL TOP DO FACTOR:=FACTOR|SP[NOC];        00441000
  T := GETT(ALONG, RANK);                                               00441100
    J:=0; N:=(MADDR:=M) + RANK;                                         00441200
    DESC.SPF:=M:=GETSPACE(SIZE+RANK);                                   00441300
    I:=M+RANK;                                                          00441400
    WHILE J LSS SIZE DO BEGIN                                           00441500
      CASE T OF BEGIN                                                   00441600
       S := J DIV FACTOR MOD LSIZE;                                     00441700
        S:=J DIV FACTOR MOD LSIZE;                                      00441800
        S:=J MOD LSIZE; END;                                            00441900
    L:=S + LADDR;                                                       00442000
    IF SP[LOC]=1  THEN FOR K:=1 STEP 1 UNTIL FACTOR DO                  00442100
        BEGIN L:=J+I; SP[LOC] := SP[NOC];                               00442200
          J:=J+1; N:=N+1;                                               00442300
        END ELSE FOR K:=1 STEP 1 UNTIL FACTOR DO BEGIN                  00442400
          L:=J+I; SP[LOC]:=INSERT; J:=J+1; END;                         00442500
     END;                                                               00442600
    L := MADDR;                                                         00442700
    FOR I:=1 STEP 1 UNTIL RANK DO BEGIN                                 00442800
      IF I = ALONG THEN SP[MOC]:=LSIZE ELSE SP[MOC]:=SP[LOC];           00442900
      M:=M+1; L:=L+1; END;                                              00443000
    DESC.DID:=DDPUVW; DESC.RF:=RANK;                                    00443100
    GO TO QUIT;                                                         00443200
   DOMAIN:  ERR:=DOMAINERROR;                                           00443300
   QUIT:  IF CHARACTER THEN BEGIN DESC.ARRAYTYPE:=1;                    00443400
               FORGETSPACE(MADDR, RSIZE+RANK);                          00443500
               PACK(DESC.SPF,RANK,SIZE); END;                           00443600
    RESULTD:=DESC;                                                      00443700
    POP;                                                                00443800
   END PROCEDURE EXPAND;                                                00443900
PROCEDURE MEMBER;                                                       00444000
  BEGIN REAL LDESC, RDESC;                                              00444100
    INTEGER L,M,N,I,S,T,LSIZE,RSIZE,LRANK,RRANK,TOP;                    00444200
    REAL DESC, TEMP, ANS;                                               00444300
    LABEL QUIT;                                                         00444400
  LDESC := AREG; RDESC := BREG;                                         00444500
  LSIZE:=FINDSIZE(LDESC); RSIZE:=FINDSIZE(RDESC);                       00444600
  LRANK:=LDESC.RF; RRANK:=RDESC.RF;                                     00444700
  IF L:=LDESC.SPF=0 OR M:=RDESC.SPF=0 THEN BEGIN                        00444800
       ERR:=DOMAINERROR; GO TO QUIT END;                                00444900
  IF LDESC.ARRAYTYPE=1 THEN L:=UNPACK(L,LRANK,LSIZE);                   00445000
  IF RDESC.ARRAYTYPE=1 THEN M:=UNPACK(M,RRANK,RSIZE);                   00445100
  DESC:=LDESC; DESC.NAMED:=0;                                           00445200
  DESC.ARRAYTYPE:=0;                                                    00445300
  DESC.SPF:=N:=GETSPACE(LSIZE+LRANK);                                   00445400
  SPCOPY(L,N,LRANK);                                                    00445500
  N:=N+LRANK; L:=(T:=L)+LRANK; M:=(S:=M)+RRANK;                         00445600
  T:=M+RSIZE-1; TOP := L+LSIZE-1;                                       00445700
  FOR L:=L STEP 1 UNTIL TOP DO BEGIN                                    00445800
    TEMP:=SP[LOC]; M:=S;                                                00445900
    WHILE M LEQ T DO                                                    00446000
      IF OPERATION(TEMP,SP[MOC],0,12,ANS) AND ANS=1 THEN BEGIN          00446100
        SP[NOC]:=1; M:=M+T; END ELSE M:=M+1;                            00446200
    N:=N+1;  END;                                                       00446300
                                                                        00446400
  IF RDESC.ARRAYTYPE=1 THEN FORGETSPACE(S,RSIZE+RRANK);                 00446500
  IF LDESC.ARRAYTYPE=1 THEN FORGETSPACE(I,LSIZE+LRANK);                 00446600
  QUIT:  RESULTD:=DESC;                                                 00446700
  END PROCEDURE MEMBER;                                                 00446800
REAL PROCEDURE BASEVALUE;                                               00446900
    BEGIN                                                               00447000
    COMMENT THIS RETURNS A DESCRIPTOR FOR A SCALAR RESULT;              00447100
    LABEL OUTE,BAD;                                                     00447200
     REAL E,L,M,LEFT,RIGHT,T,LARG,RARG;                                 00447300
     LARG := AREG; RARG := BREG;                                        00447400
    IF M:=RARG.SPF=0 OR LARG.CHRMODE=1 OR RARG.CHRMODE=1                00447500
        OR L:=LARG.SPF=0 AND LARG.DID NEQ 0                             00447600
            THEN GO TO BAD;                                             00447700
    RIGHT:=SP[MOC];                                                     00447800
    LEFT:=SP[LOC];                                                      00447900
    IF FINDSIZE(LARG)=1 THEN % A 1 ELEMENT VECTOR                       00448000
        BEGIN                                                           00448100
        L:=L+LARG.RF;                                                   00448200
        LARG.SCALAR:=1;                                                 00448300
        LEFT:=SP[LOC];                                                  00448400
        END;                                                            00448500
    IF FINDSIZE(RARG)=1 THEN % A ONE ELEMENT VECTOR                     00448600
        BEGIN                                                           00448700
        M:=M+RARG.RF;                                                   00448800
        RIGHT:=SP[MOC];                                                 00448900
        RARG.SCALAR:=1;                                                 00449000
        END;                                                            00449100
    IF L=0 THEN                                                         00449200
        BEGIN % BASEVAL MONADIC                                         00449300
        LEFT:=2; %IF MONADIC, ITS 2 BASVAL X                            00449400
        LARG.SCALAR:=1;                                                 00449500
        END;                                                            00449600
    IF BOOLEAN(LARG.SCALAR )THEN %SCALAR                                00449700
        IF BOOLEAN(RARG.SCALAR) THEN                                    00449800
            BEGIN                                                       00449900
            T:=RIGHT; %SCALAR-SCALAR                                    00450000
            GO OUTE;                                                    00450100
            END                                                         00450200
        ELSE                                                            00450300
    IF RARG.RF=1 THEN                                                   00450400
            BEGIN COMMENT SCALAR-VECTOR--LEFT IS VALUE OF SCALAR, RIGHT 00450500
                IS # OF ELEMENTS;                                       00450600
            IF LEFT=0 THEN GO OUTE                                      00450700
            ELSE E:=1/LEFT;                                             00450800
            FOR L :=M+RIGHT STEP -1 UNTIL M+1 DO                        00450900
                T:=T+SP[LOC]|(E:=E|LEFT);                               00451000
            GO OUTE;                                                    00451100
            END                                                         00451200
        ELSE BAD: ERR:=DOMAINERROR                                      00451300
    ELSE                                                                00451400
    IF RARG.SCALAR=0 THEN                                               00451500
            IF LARG.RF NEQ 1 OR RARG.RF NEQ 1 THEN                      00451600
                ERR:=DOMAINERROR                                        00451700
            ELSE                                                        00451800
        BEGIN                                                           00451900
        GT2:=L; % SAVE FOR LATER TEST                                   00452000
        GT1:=M+2; % WANT TO STOP 2 UP IN LOOP                           00452100
        L:=L+LEFT; % START AT OTHER END                                 00452200
        E:=1;                                                           00452300
        M:=M+RIGHT;                                                     00452400
        T:=SP[MOC]; % INITIAL VALUE                                     00452500
        FOR M:=M-1 STEP -1 UNTIL GT1 DO                                 00452600
            BEGIN                                                       00452700
        IF L:=L-1 LSS GT2 THEN L:=GT2+LEFT; % START OVER                00452800
            E:=E|SP[LOC];                                               00452900
            T:=T+SP[MOC]|E;                                             00453000
            END;                                                        00453100
OUTE:                                                                   00453200
        L:=GETSPACE(1);                                                 00453300
        SP[LOC]:=T;                                                     00453400
        T:=0;                                                           00453500
        T.DID:=DDPUSW; % BUILD DESCRIPTOR                               00453600
        T.SPF:=L;                                                       00453700
        BASEVALUE:=T;                                                   00453800
        END                                                             00453900
        ELSE ERR := DOMAINERROR                                         00454000
    END OF BASEVALUE;                                                   00454100
REAL PROCEDURE REPRESENT;                                               00454200
    BEGIN                                                               00454300
    COMMENT RETURNS DESCRIPTOR OF VECTOR IF LARG VECTOR AND RARG SCALAR;00454400
     REAL L,M,LEFT,RIGHT,T,E,LARG,RARG;                                 00454500
    LABEL AROUND;                                                       00454600
     LARG := AREG; RARG := BREG;                                        00454700
    IF (RARG.SCALAR=1 OR FINDSIZE(RARG)=1 AND RARG.CHRMODE=0)           00454800
        AND NOT(LARG.SCALAR=1 OR LARG.CHRMODE=1 OR LARG.RF NEQ 1) THEN  00454900
        BEGIN                                                           00455000
        COMMENT VECTOR-SCALAR;                                          00455100
        IF L:=LARG.SPF=0 OR M:=RARG.SPF=0 THEN GO AROUND;               00455200
        IF RARG.SCALAR=0 THEN M:=M+RARG.RF;                             00455300
        RIGHT:=SP[MOC]; % VALUE OF SCALAR                               00455400
        LEFT:=SP[LOC]; % LENGTH OF VECTOR                               00455500
        E:=M:=GETSPACE(LEFT+1); % MAKE ROOM FOR ANSWER                  00455600
        SP[MOC]:=LEFT; % LENGTH OF ANSWER                               00455700
        M:=M+LEFT;                                                      00455800
        GT1:=L+2;                                                       00455900
        FOR L:=L+LEFT STEP -1 UNTIL GT1 DO                              00456000
            IF T:=SP[LOC] LEQ 0 THEN                                    00456100
                IF T LSS 0 THEN ERR:= DOMAINERROR                       00456200
                ELSE                                                    00456300
                    BEGIN                                               00456400
                    L:=GT1-1 ; % STOP THE LOOP                          00456500
                    M:=M-1;                                             00456600
                    END                                                 00456700
            ELSE                                                        00456800
            BEGIN                                                       00456900
            SP[MOC]:= RIGHT MOD T;                                      00457000
            RIGHT:=RIGHT DIV T;                                         00457100
            M:=M-1;                                                     00457200
            IF RIGHT LSS FUZZ THEN L:=GT1-1; % STOP THE LOOP            00457300
            END;                                                        00457400
        SP[MOC]:=RIGHT; % LEFTOVER GOES HERE                            00457500
        T.DID:=DDPUVW;                                                  00457600
        T.RF:=1;                                                        00457700
        T.SPF:=E;                                                       00457800
        REPRESENT:=T;                                                   00457900
        END                                                             00458000
    ELSE AROUND: ERR:=DOMAINERROR;                                      00458100
    END OF REPRESENT;                                                   00458200
PROCEDURE PERIOD(LDESC,RDESC,LOP,ROP);                                  00458300
   VALUE LDESC,RDESC,LOP,ROP; REAL LDESC,RDESC; INTEGER LOP,ROP;        00458400
BEGIN INTEGER L,M,N,J,LRANK,RRANK,RANK,LSIZE,RSIZE,SIZE,LL,MM,I,        00458500
               RROW,RCOL,LROW,LCOL,LJUMP,RJUMP,MSAVE,LSAVE,RSTART;      00458600
  REAL DESC, TEMP;                                                      00458700
  BOOLEAN CHARACTER, FIRST,LSCALAR, RSCALAR;                            00458800
  LABEL QUIT, DOMAIN, FORGET, OUTERPROD;                                00458900
  IF L:=LDESC.SPF = 0 OR M:= RDESC.SPF=0 THEN GO TO DOMAIN;             00459000
  LSIZE := FINDSIZE(LDESC); RSIZE:=FINDSIZE(RDESC);                     00459100
  LRANK:=LDESC.RF; RRANK := RDESC.RF;                                   00459200
  IF LOP NEQ 45 THEN                                                    00459300
  IF LRANK GTR 2 AND LSIZE NEQ 1 OR RRANK GTR 2 AND RSIZE NEQ 1 THEN    00459400
   BEGIN ERR:=KITEERROR; GO TO QUIT; END;                               00459500
  IF ROP:=GETOP(CORRESPONDENCE,ROP-1) = 9 THEN BEGIN                    00459600
       ERR:=SYNTAXERROR; GO TO QUIT; END;                               00459700
  IF LL:=LDESC.ARRAYTYPE=1 OR MM:=RDESC.ARRAYTYPE=1 THEN                00459800
      IF LL | MM NEQ 1 THEN GO TO DOMAIN                                00459900
    ELSE BEGIN                                                          00460000
                                                                        00460100
      IF ROP LSS 11 OR ROP GTR 16 THEN GO TO DOMAIN;                    00460200
      CHARACTER:=TRUE;                                                  00460300
      M:=UNPACK(M,RRANK,RSIZE);                                         00460400
      L:=UNPACK(L,LRANK,LSIZE); END;                                    00460500
  MSAVE := M; LSAVE:=L;  IF ROP NEQ 45 THEN                             00460600
  IF LOP=45 THEN GO TO OUTERPROD ELSE                                   00460700
    IF LOP:=GETOP(CORRESPONDENCE,LOP-1)=9 THEN                          00460800
         BEGIN ERR:=SYNTAXERROR; GO TO QUIT; END;                       00460900
  IF LRANK=2 THEN BEGIN                                                 00461000
     N:=L+LRANK-1; LCOL := SP[NOC];                                     00461100
     N:=N-1; LROW:=SP[NOC]; END;                                        00461200
  IF LRANK=1 THEN BEGIN LROW:=1; LCOL:=SP[LOC]; END;                    00461300
  IF RRANK=2 THEN BEGIN                                                 00461400
     N :=M+RRANK-1; RCOL:=SP[NOC];                                      00461500
     N:=N-1; RROW:=SP[NOC]; END;                                        00461600
  IF RRANK=1 THEN BEGIN RROW:=SP[MOC]; RCOL:=1; END;                    00461700
  IF LSIZE =1 OR RSIZE=1 THEN BEGIN                                     00461800
  IF LSIZE = 1 AND RSIZE = 1 THEN LROW:=LCOL:=RROW:=RCOL:=1             00461900
     ELSE IF LSIZE=1 THEN BEGIN LCOL:=RROW; LROW:=1;                    00462000
                          L:=L+LRANK-1; LRANK:=1;                       00462100
                          LSCALAR:=TRUE; END                            00462200
     ELSE BEGIN RROW := LCOL; RCOL := 1;                                00462300
                            M:=M+RRANK-1; RRANK:=1;                     00462400
                            RSCALAR:=TRUE; END;                         00462500
  END;                                                                  00462600
  IF LCOL NEQ RROW                                                      00462700
    THEN BEGIN ERR:=RANKERROR; GO TO QUIT; END;                         00462800
  DESC.SPF:=N:=GETSPACE((RANK:=MAX(0,LRANK+RRANK-1))+                   00462900
                        SIZE:=LROW|RCOL);                               00463000
  SPCOPY(L,N,LRANK-1);                                                  00463100
  SPCOPY(M+1,N+LRANK-1,RRANK-1);                                        00463200
  DESC.RF:=RANK; DESC.DID:=(IF RANK=0 THEN DDPUSW ELSE DDPUVW);         00463300
  N:=N+RANK;                                                            00463400
  LL := L + LRANK - 1;                                                  00463500
  MM := M + RRANK - 1;                                                  00463600
  LJUMP := LCOL-1; RJUMP := IF RSCALAR THEN 0 ELSE (RROW-1) | RCOL;     00463700
  FOR J:=1 STEP LCOL UNTIL LSIZE DO                                     00463800
    FOR RSTART:=1 STEP 1 UNTIL RCOL DO BEGIN                            00463900
      FIRST:=TRUE;                                                      00464000
      M := MM + RSTART + RJUMP; RROW := LL + J;                         00464100
      FOR I:=LL + LJUMP + J STEP -1 UNTIL RROW DO BEGIN                 00464200
        IF LSCALAR THEN L:=LL+1 ELSE L:=I;                              00464300
        IF FIRST THEN BEGIN                                             00464400
          IF NOT OPERATION(SP[LOC],SP[MOC],1,ROP,SP[NOC])               00464500
             THEN GO TO FORGET ELSE FIRST := FALSE;                     00464600
        END ELSE BEGIN                                                  00464700
          IF NOT OPERATION(SP[LOC],SP[MOC],1,ROP,TEMP)                  00464800
             THEN GO TO FORGET;                                         00464900
          IF NOT OPERATION(TEMP,SP[NOC],-1,LOP,SP[NOC])                 00465000
             THEN GO TO FORGET END;                                     00465100
        IF NOT RSCALAR THEN M:=M-RCOL; END;                             00465200
      N := N+1;                                                         00465300
      END;                                                              00465400
  GO TO QUIT;                                                           00465500
OUTERPROD:  IF SIZE:=LSIZE|RSIZE GTR MAXWORDSTORE                       00465600
    OR RANK := LRANK+RRANK GTR 31 THEN BEGIN                            00465700
     ERR:=KITEERROR; GO TO QUIT; END;                                   00465800
   DESC.SPF:=N:=GETSPACE(SIZE+RANK);                                    00465900
   DESC.DID:=IF RANK=0 THEN DDPUSW ELSE DDPUVW;                         00466000
   DESC.RF:=RANK;                                                       00466100
   SPCOPY(L,N,LRANK);                                                   00466200
  SPCOPY(M,N+LRANK,RRANK);                                              00466300
   N:=N+RANK;                                                           00466400
   I:=L + LRANK + LSIZE - 1;                                            00466500
   MM := M+RRANK + RSIZE - 1;                                           00466600
   FOR L:=L+LRANK STEP 1 UNTIL I DO                                     00466700
     FOR M:=MSAVE+RRANK STEP 1 UNTIL MM DO                              00466800
      IF NOT OPERATION(SP[LOC],SP[MOC],1,ROP,SP[NOC]) THEN              00466900
        GO TO FORGET ELSE N:=N+1;                                       00467000
  GO TO QUIT;                                                           00467100
  FORGET:  FORGETSPACE(DESC.SPF,RANK+SIZE);                             00467200
  DOMAIN:  ERR:=DOMAINERROR;                                            00467300
  QUIT:  IF CHARACTER THEN BEGIN                                        00467400
         FORGETSPACE(MSAVE , RRANK+RSIZE);                              00467500
         FORGETSPACE(LSAVE , LRANK+LSIZE); END;                         00467600
   RESULTD := DESC;                                                     00467700
 END PROCEDURE PERIOD;                                                  00467800
PROCEDURE REVERSE(SOURCE,LENGTH,DEST,JUMP); VALUE SOURCE,DEST,          00467900
     LENGTH,JUMP; INTEGER SOURCE,LENGTH,DEST,JUMP;                      00468000
  BEGIN INTEGER L,M,TOP;                                                00468100
    M:=SOURCE + TOP:=(LENGTH-1) | JUMP; TOP:=DEST+TOP;                  00468200
    FOR L:=DEST STEP JUMP UNTIL TOP DO BEGIN                            00468300
      SP[LOC] := SP[MOC]; M:=M-JUMP; END;                               00468400
   END PROCEDURE REVERSE;                                               00468500
PROCEDURE ROTATE(SOURCE,LENGTH,DEST,JUMP,ROT); VALUE SOURCE,            00468600
  LENGTH,DEST,JUMP,ROT; INTEGER SOURCE,LENGTH,DEST,JUMP,ROT;            00468700
  BEGIN INTEGER L,M,TOP;                                                00468800
    TOP := SOURCE + (LENGTH-1) | JUMP;                                  00468900
    FOR L:=SOURCE STEP JUMP UNTIL TOP DO BEGIN                          00469000
      M:=DEST+(ROT MOD LENGTH)|JUMP; SP[MOC]:=SP[LOC];                  00469100
      ROT := ROT + 1; END;                                              00469200
  END PROCEDURE ROTATE;                                                 00469300
INTEGER PROCEDURE GETNUM(TIM,L,SIZE,DIM); VALUE TIM,L,                  00469400
     SIZE,DIM; INTEGER TIM,L,SIZE,DIM;                                  00469500
  BEGIN INTEGER NUM;                                                    00469600
    IF SIZE NEQ 0 THEN L := L + TIM;                                    00469700
      NUM:=SIGN(NUM:=SP[LOC]) | ENTIER(ABS(NUM)) MOD DIM;               00469800
      IF NUM LSS 0 THEN GETNUM := -NUM  %FOR RIGHT ROTATION             00469900
                    ELSE GETNUM:=DIM-NUM; %FOR LEFT ROTATION            00470000
  END PROCEDURE GETNUM;                                                 00470100
BOOLEAN PROCEDURE MATCHROT(LDESC,RDESC,ALONG); VALUE LDESC,             00470200
     RDESC,ALONG; INTEGER LDESC,RDESC,ALONG;                            00470300
  BEGIN INTEGER I,L,M,R; LABEL QUIT;                                    00470400
    MATCHROT:=TRUE; L:=LDESC.SPF; M:=RDESC.SPF;                         00470500
    IF R:=LDESC.RF NEQ RDESC.RF-1 THEN BEGIN                            00470600
         MATCHROT:=FALSE; GO TO QUIT; END;                              00470700
    FOR I:=1 STEP 1 UNTIL R DO BEGIN IF I=ALONG THEN M:=M+1;            00470800
       IF SP[LOC] NEQ SP[MOC] THEN BEGIN MATCHROT:=FALSE;               00470900
              GO TO QUIT; END; M:=M+1; L:=L+1; END;                     00471000
   QUIT:  END PROCEDURE MATCHROT;                                       00471100
PROCEDURE REDUCESORTSCAN(LOP,RDESC,DIM,KIND); VALUE LOP,RDESC,          00471200
  DIM,KIND; REAL LOP,RDESC,DIM; INTEGER KIND;                           00471300
  BEGIN INTEGER L,M,N,I,J,K,ALONG,FACTOR,T,MSAVE,DIFF,SSIZE,            00471400
                JUMP,RANK,SIZE,TOP,LASTDIM,INTERVAL,TEMP,HOP;           00471500
    INTEGER REMDIM,LRANK,LSAVE,LSIZE,S;                                 00471600
    BOOLEAN CHARACTER,REDUCE,SORT,SCAN,REVERSAL,ROTATION;               00471700
    REAL DESC;                                                          00471800
    LABEL QUIT, FORGET, RANKERR;                                        00471900
  COMMENT:  KIND=1 FOR REDUCTION                                        00472000
            KIND=2 FOR SORTUP OR SORTDN                                 00472100
            KIND=3 FOR SCAN                                             00472200
            KIND=4 FOR REVERSAL                                         00472300
            KIND=5 FOR ROTATION;                                        00472400
   PROCEDURE SORTIT(L,M,SIZE,JUMP,UP); VALUE L,M,SIZE,JUMP,UP;          00472500
         INTEGER L,M,SIZE,JUMP; BOOLEAN UP;                             00472600
     BEGIN INTEGER N,TIP,TOP,LSAVE;                                     00472700
     REAL COMPARE,OUTOFIT;                                              00472800
     OUTOFIT:=IF UP THEN BIGGEST ELSE -BIGGEST;                         00472900
     TIP := M + (N:=(SIZE-1) | JUMP); TOP := L + N;                     00473000
     LSAVE := L;                                                        00473100
     FOR M:=M STEP JUMP UNTIL TIP DO BEGIN                              00473200
       L := LSAVE; COMPARE := SP[LOC]; N:=L;                            00473300
       FOR L:=L+1 STEP 1 UNTIL TOP DO                                   00473400
       IF UP THEN BEGIN IF SP[LOC] LSS COMPARE THEN BEGIN               00473500
              N:=L; COMPARE:=SP[LOC]; END;                              00473600
        END ELSE IF SP[LOC] GTR COMPARE THEN BEGIN                      00473700
              N:=L; COMPARE:=SP[LOC]; END;                              00473800
       SP[NOC] := OUTOFIT;                                              00473900
       SP[MOC] := (N-LSAVE) + ORIGIN;                                   00474000
     END;                                                               00474100
    END PROCEDURE SORTIT;                                               00474200
  CASE KIND OF BEGIN ; REDUCE:=TRUE; SORT:=TRUE; SCAN:=TRUE;            00474300
             REVERSAL:=TRUE; ROTATION:=TRUE; END;                       00474400
  IF LOP GTR 64 AND NOT ROTATION THEN BEGIN                             00474500
        ERR:=SYSTEMERROR; GO TO QUIT; END;                              00474600
  IF REDUCE OR SCAN THEN IF LOP NEQ 45 THEN                             00474700
       LOP := GETOP(CORRESPONDENCE,LOP-1);                              00474800
  IF M:=RDESC.SPF=0 AND NOT REDUCE                                      00474900
    OR DIM.DID NEQ 0 AND N:=DIM.SPF=0 OR DIM.ARRAYTYPE=1                00475000
    OR FINDSIZE(DIM) NEQ 1 THEN BEGIN                                   00475100
       ERR:=DOMAINERROR; GO TO QUIT END;                                00475200
    IF (REDUCE OR SCAN) AND LOP=9 THEN BEGIN %OP NOT DYADIC SCALAR      00475300
       ERR:=SYNTAXERROR; GO TO QUIT END;                                00475400
   IF M=0 THEN BEGIN                                                    00475500
     %FOR REDUCTION, RESULT OF A NULL IS CORRESPONDING IDENTITY         00475600
    %EXCEPT THAT NAND, NOR, CIRCLE, AND LOG (LOP GTR 18)                00475700
     %HAVE NO IDENTITIES, SO THE RESULT IS A NULL                       00475800
   DESC.DID := DDPUSW;                                                  00475900
   IF LOP LEQ 18 THEN BEGIN DESC.SPF:=N:=GETSPACE(1);                   00476000
     SP[NOC] := IDENTITY(LOP); END ELSE DESC.RF:=1;                     00476100
   GO TO QUIT; END;                                                     00476200
  IF RDESC.ARRAYTYPE=1 AND (REDUCE OR SCAN) THEN                        00476300
      BEGIN ERR:=DOMAINERROR; GO TO QUIT; END;                          00476400
  SIZE:=FINDSIZE(RDESC);                                                00476500
  RANK:=RDESC.RF;                                                       00476600
  IF SIZE=1 THEN BEGIN                                                  00476700
   %UNLESS SORT, RESULT OF SINGLE-VALUED ARGUMENT IS THAT ARGUMENT      00476800
    DESC := RDESC;                                                      00476900
    DESC.SPF := N := GETSPACE(RANK+1);                                  00477000
       SPCOPY(M,N,RANK);M:=M+RANK;N:=N+RANK;                            00477100
    IF SORT THEN BEGIN SP[NOC]:=ORIGIN; DESC.ARRAYTYPE:=0;              00477200
          END ELSE SP[NOC]:=SP[MOC];                                    00477300
    GO TO QUIT; END;                                                    00477400
                                                                        00477500
  IF RDESC.ARRAYTYPE=1 THEN BEGIN                                       00477600
    CHARACTER := TRUE;                                                  00477700
    M:=UNPACK(M,RANK,SIZE); END;                                        00477800
  MSAVE:=M;                                                             00477900
  N:=N+(T:=DIM.RF);                                                     00478000
  IF ALONG:=(IF N=T THEN RANK ELSE SP[NOC]-ORIGIN+1) GTR RANK           00478100
    OR ALONG LSS 1                                                      00478200
    THEN BEGIN ERR:=INDEXERROR; GO TO QUIT; END;                        00478300
 IF ROTATION THEN BEGIN                                                 00478400
    IF LSAVE:=LOP.SPF=0 OR LOP.ARRAYTYPE=1 THEN                         00478500
        BEGIN ERR:=DOMAINERROR; GO TO QUIT; END;                        00478600
    IF LSIZE:=FINDSIZE(LOP) NEQ 1 THEN                                  00478700
        IF NOT MATCHROT(LOP,RDESC,ALONG) THEN BEGIN                     00478800
            ERR:=RANKERROR; GO TO QUIT; END;                            00478900
    LSAVE := LSAVE + LRANK := LOP.RF;                                   00479000
    IF LSIZE = 1 THEN LRANK := 0; END;                                  00479100
  N:=M+ALONG-1;                                                         00479200
  DIM:=SP[NOC];                                                         00479300
  JUMP:=1; I:=M+ALONG;                                                  00479400
  FOR L:=M+RANK-1 STEP -1 UNTIL I DO JUMP:=JUMP | SP[LOC];              00479500
  N:=M+RANK-1; LASTDIM:=SP[NOC];                                        00479600
  IF ALONG = RANK-1 THEN BEGIN N:=N-1;                                  00479700
    FACTOR:=LASTDIM | SP[NOC]; END;                                     00479800
  T := GETT(ALONG, RANK);                                               00479900
  J := M + RANK;                                                        00480000
  REMDIM := 1;                                                          00480100
  HOP := (DIM-1) | JUMP;                                                00480200
  DESC.DID := DDPUVW;                                                   00480300
  IF ALONG GTR 1 AND ALONG LSS RANK-1 THEN BEGIN TOP:=M+ALONG-2;        00480400
    FOR L:=M STEP 1 UNTIL TOP DO REMDIM:=REMDIM|SP[LOC]; END;           00480500
  IF REDUCE THEN BEGIN DESC.SPF:=N:=GETSPACE(SSIZE:=SSIZE DIV DIM       00480600
                                + RANK - 1);                            00480700
     IF RANK=1 THEN DESC.SCALAR:=1 ELSE DESC.RF:=RANK-1;                00480800
     FOR I:=1 STEP 1 UNTIL RANK DO BEGIN                                00480900
      IF I NEQ ALONG THEN BEGIN SP[NOC]:=SP[MOC]; N:=N+1; END;          00481000
        M:=M+1; END;                                                    00481100
     JUMP := - JUMP;                                                    00481200
  END ELSE BEGIN DESC.SPF:=N:=GETSPACE(SSIZE:=SIZE+RANK);               00481300
     INTERVAL := (DIFF := N-M) + HOP;                                   00481400
     SPCOPY(M,N,RANK); DESC.RF:=RANK; END;                              00481500
  IF SORT THEN TEMP:=GETSPACE(DIM);                                     00481600
  TOP := SIZE DIV (DIM | REMDIM) - 1;                                   00481700
  FOR S:=1 STEP 1 UNTIL REMDIM DO BEGIN                                 00481800
  FOR I:=0 STEP 1 UNTIL TOP DO BEGIN                                    00481900
    CASE T OF BEGIN                                                     00482000
      L := I + J;                                                       00482100
      L:=I DIV LASTDIM|FACTOR + I MOD LASTDIM + J;                      00482200
      L:=I|LASTDIM + J; END;                                            00482300
    IF REDUCE THEN BEGIN M:=I+N;  L:=HOP + (K:=L);                      00482400
      SP[MOC] := SP[LOC];                                               00482500
      FOR L:=L+JUMP STEP JUMP UNTIL K DO                                00482600
         IF NOT OPERATION(SP[LOC],SP[MOC],-1,LOP,SP[MOC])               00482700
             THEN GO TO FORGET;                                         00482800
     END ELSE                                                           00482900
    IF SORT THEN BEGIN K:=L+HOP; N:=TEMP;                               00483000
       FOR M:=L STEP JUMP UNTIL K DO BEGIN                              00483100
        SP[NOC] := SP[MOC]; N:=N+1; END;                                00483200
       IF LOP LSS 0 THEN SORTIT(TEMP,L+DIFF,DIM,JUMP,FALSE)             00483300
                    ELSE SORTIT(TEMP,L+DIFF,DIM,JUMP,TRUE);             00483400
    END ELSE IF SCAN THEN BEGIN                                         00483500
     K:=L+INTERVAL; N:=L+DIFF; SP[NOC] := SP[LOC];                      00483600
     FOR N:=N+JUMP STEP JUMP UNTIL K DO BEGIN                           00483700
         M:=N-JUMP; L:=L+JUMP;                                          00483800
         IF NOT OPERATION(SP[MOC],SP[LOC],-1,LOP,SP[NOC])               00483900
           THEN GO TO FORGET; END;                                      00484000
  END ELSE IF REVERSAL THEN REVERSE(L,DIM,L+DIFF,JUMP)                  00484100
  ELSE IF ROTATION THEN ROTATE(L,DIM,L+DIFF,JUMP,                       00484200
                 GETNUM(I,LSAVE,LRANK,DIM));                            00484300
    END;                                                                00484400
  J := J + ABS(JUMP|DIM);                                               00484500
  N := N + TOP + 1;                                                     00484600
  DIFF := DIFF + TOP + 1;                                               00484700
  END;                                                                  00484800
  GO TO QUIT;                                                           00484900
  RANKERR:  ERR:=RANKERROR; FORGETSPACE(DESC.SPF,SSIZE);GO QUIT;        00485000
  FORGET:  ERR:=DOMAINERROR; FORGETSPACE(DESC.SPF, SSIZE);              00485100
QUIT:  IF CHARACTER THEN BEGIN                                          00485200
     FORGETSPACE(MSAVE,SIZE+RANK);                                      00485300
     IF (REVERSAL OR ROTATION) AND ERR=0 THEN BEGIN                     00485400
       DESC.ARRAYTYPE:=1; PACK(DESC.SPF,RANK,SIZE); END; END;           00485500
    IF SORT THEN FORGETSPACE(TEMP,DIM);                                 00485600
  RESULTD := DESC;                                                      00485700
   IF ROTATION THEN POP;                                                00485800
 END PROCEDURE REDUCESORTSCAN;                                          00485900
PROCEDURE DYADICTRANS;                                                  00486000
BEGIN REAL LDESC,RDESC;                                                 00486100
  INTEGER L,M,N,RANK,NEWRANK,SIZE,TEMP,I,J;                             00486200
  DEFINE SPTOP=RDESC#,MIN=RDESC#,PTR=NEWRANK#,MBASE=LDESC#,TOP=RDESC#   00486300
        ,RESULT=RESULTD#;                                               00486400
  LABEL QUIT; BOOLEAN CARRY;                                            00486500
INTEGER ARRAY RVEC,DEL,SUB,OLDEL[0:3];                                  00486600
  LDESC:=AREG; RDESC:=BREG;                                             00486700
  RESULT:=0; L:=LDESC.SPF; J:=LDESC.RF; RANK:=RDESC.RF;                 00486800
  IF M:=RDESC.SPF=0 OR L=0 OR LDESC.ARRAYTYPE=1 THEN BEGIN              00486900
        ERR:=DOMAINERROR; GO TO QUIT; END;                              00487000
  IF NUMELEMENTS(LDESC)=1 THEN BEGIN N:=L+J;                            00487100
    IF SP[NOC] NEQ ORIGIN OR RANK GTR 1 THEN BEGIN                      00487200
          ERR:=DOMAINERROR; GO TO QUIT END;                             00487300
   %IF WE GET HERE, THE ANSWER IS ITSELF                                00487400
    RESULT:=RDESC; I:=NUMELEMENTS(RDESC);                               00487500
    RESULT.SPF:=N:=GETSPACE(SIZE:=RANK+1); RESULT.NAMED:=0;             00487600
    SPCOPY(M,N,SIZE); GO TO QUIT END;                                   00487700
  IF J GTR 1 THEN BEGIN ERR:=RANKERROR; GO TO QUIT END;                 00487800
  IF SP[LOC] NEQ RANK THEN BEGIN ERR:=LENGTHERROR; GO TO QUIT END;      00487900
% FIND MAX OF LDESC FOR NOW- DO THE REST LATER                          00488000
%LDESC W/R/T ORIGIN 0 GETS STORED IN SUB[I]                             00488100
  SPTOP:=L+RANK; NEWRANK:=0; I:=0;                                      00488200
  FOR N:=L+1 STEP 1 UNTIL SPTOP DO BEGIN                                00488300
     IF TEMP:=SP[NOC]-ORIGIN+1 GTR NEWRANK THEN NEWRANK:=TEMP;          00488400
     SUB[I]:=TEMP-1; I:=I+1 END;                                        00488500
  IF NEWRANK GTR RANK THEN BEGIN ERR:=DOMAINERROR;GO TO QUIT END;       00488600
% CALCULATE THE OLD DEL VECTOR, OLDEL                                   00488700
  OLDEL[RANK-1]:=1; N:=M+RANK-1;                                        00488800
  FOR I:=RANK-2 STEP -1 UNTIL 0 DO BEGIN                                00488900
      OLDEL[I]:=OLDEL[I+1]|SP[NOC]; N:=N-1 END;                         00489000
  MBASE:=M; SIZE:=1;                                                    00489100
%FIX UP THE NEW RVAC AND DEL                                            00489200
  FOR I:=NEWRANK-1 STEP -1 UNTIL 0 DO BEGIN                             00489300
% FIND SMALLEST EL. OF RHO RDESC [J] S.T. A[J]=I                        00489400
%         AND SUM OF OLDEL[J] S.T. A[J]=1                               00489500
  MIN:=31; TEMP:=0;                                                     00489600
  FOR J:=RANK-1 STEP -1 UNTIL 0 DO                                      00489700
     IF SUB[J]=1 THEN BEGIN                                             00489800
       M:=MBASE+J;                                                      00489900
       IF SP[MOC] LSS MIN THEN MIN:=SP[MOC];                            00490000
       TEMP:=TEMP+OLDEL[J] END;                                         00490100
     RVEC[I]:=MIN; DEL[I]:=TEMP; SIZE:=SIZE|RVEC[I];                    00490200
     IF TEMP=0 THEN BEGIN %IT DOESN7T EXHAUSE IOTA NEWRANK              00490300
          ERR:=DOMAINERROR; GO TO QUIT END;                             00490400
     END;                                                               00490500
  RESULT:=M:=GETSPACE(NEWRANK+SIZE);                                    00490600
  RESULT.RF:=NEWRANK; RESULT.DID:=DDPUVW;                               00490700
  IF BOOLEAN(BREG.ARRAYTYPE) THEN BEGIN                                 00490800
     RESULT.ARRAYTYPE:=1; N:=MBASE;                                     00490900
     MBASE:=UNPACK(MBASE,RANK,N:=OLDEL[0]|SP[NOC]);                     00491000
     FORGETSPACE(MBASE,N+RANK) END;                                     00491100
  FOR I:=1 STEP 1 UNTIL NEWRANK DO BEGIN                                00491200
     SP[MOC]:=RVEC[I-1]; M:=M+1 END;                                    00491300
  %INTIALIZE FOR STEPPING THRU NEW ARRAY                                00491400
   FOR I:=NEWRANK-1 STEP -1 UNTIL 0 DO BEGIN                            00491500
     SUB[I]:=0; OLDEL[I]:=RVEC[I]|DEL[I] END;                           00491600
  L:=MBASE+RANK;                                                        00491700
%STEP THRU THE SUBSCRIPTS OF THE ANSWER TO PICK UP THE ELEMENTS         00491800
%    IN ROW ORDER ACCORDING TO THE MAPPING GIVEN BY DEL                 00491900
  PTR:=TOP:=NEWRANK-1;                                                  00492000
  FOR I:=1 STEP 1 UNTIL SIZE DO BEGIN                                   00492100
     SP[MOC] :=SP[LOC];                                                 00492200
     M:=M+1;                                                            00492300
%GET NEXT SUBSCRIPT FOR NEW ARRAY AND SET NEXT L;                       00492400
     SUB[PTR]:=SUB[PTR]+1;                                              00492500
     L:=L+DEL[TOP];                                                     00492600
     CARRY:=TRUE;                                                       00492700
     WHILE CARRY AND I NEQ SIZE DO                                      00492800
       IF SUB[PTR] GEQ RVEC[PTR] THEN BEGIN                             00492900
         SUB[PTR]:=0;                                                   00493000
         L:=L-OLDEL[PTR]+DEL[PTR:=PTR-1];                               00493100
         SUB[PTR]:=SUB[PTR]+1                                           00493200
         END ELSE CARRY := FALSE;                                       00493300
     PTR:=TOP;                                                          00493400
     END;                                                               00493500
  IF BOOLEAN(RESULT.ARRAYTYPE) THEN PACK(RESULT.SPF,TOP+1,SIZE);        00493600
QUIT:  END OF DYADICTRANS;                                              00493700
    INTEGER PROCEDURE LOCATE(L,M); VALUE L,M; REAL L,M;                 00493800
        BEGIN                                                           00493900
        COMMENT L IS THE DIMENSION OF THE VECTOR(DESCRIPTOR),           00494000
        M IS THE INDEX VECTOR;                                          00494100
        INTEGER P,I,UB;                                                 00494200
        L:=I:=L.SPF; M:=I:=M.SPF;                                       00494300
        UB:=SP[MOC]-1;                                                  00494400
        M:=M+1;                                                         00494500
        FOR I:=1 STEP 1 UNTIL UB DO                                     00494600
            BEGIN                                                       00494700
            L:=L+1;                                                     00494800
            P:=(P+SP[MOC]-1)|SP[LOC];                                   00494900
            M:=M+1;                                                     00495000
            END;                                                        00495100
        P:=P+SP[MOC];                                                   00495200
        LOCATE:=P+L;                                                    00495300
        END;                                                            00495400
    PROCEDURE DISPLAY(A,B); VALUE A,B; REAL A,B;                        00495500
        BEGIN                                                           00495600
    PROCEDURE PRINTMATRIX(L,ROW,COL);VALUE L,ROW,COL;                   00495700
        INTEGER L,ROW,COL;                                              00495800
    BEGIN INTEGER I,J,CC,FOLD; DEFINE WIDE=GT2#;                        00495900
    WIDE:=LINESIZE;                                                     00496000
        FOR I:=1 STEP 1 UNTIL ROW DO                                    00496100
            BEGIN CC:=0; %NO BLANKS AT BEGINNING OF LINE                00496200
        FOLD:=0;                                                        00496300
            FOR J:=1 STEP 1 UNTIL COL DO                                00496400
                BEGIN NUMBERCON(SP[LOC],ACCUM);                         00496500
                IF FOLD:=FOLD+ACOUNT+CC GTR WIDE AND ACOUNT+CC          00496600
                  LEQ WIDE THEN BEGIN TERPRINT;                         00496700
                 FORMROW(0,2,ACCUM,2,ACOUNT); FOLD:=ACOUNT+2; END ELSE  00496800
                FORMROW(0,CC,ACCUM,2,ACOUNT); L:=L+1;                   00496900
                CC:=2; %PUT 2 BLANKS AFTER FIRST ITEM.                  00497000
                END;                                                    00497100
            TERPRINT;                                                   00497200
            END                                                         00497300
        END;                                                            00497400
        INTEGER L,N,M,BOTTOM,ALOC,BLOC;                                 00497500
        INTEGER ROW,COL;                                                00497600
        ALOC:=A.SPF; BLOC:=B.SPF-1;                                     00497700
        L:=(M:=B.RF)+ BLOC; COL:=SP[LOC];                               00497800
        L:=L-1;                                                         00497900
        ROW:=(IF M GTR 1 THEN SP[LOC] ELSE 1);                          00498000
        L:=BOTTOM:=M-2;                                                 00498100
        PRINTMATRIX(LOCATE(B,A),ROW,COL);                               00498200
        WHILE L GTR 0 DO                                                00498300
            BEGIN                                                       00498400
            M:=ALOC+L; N:=BLOC+L;                                       00498500
            IF SP[MOC]:=SP[MOC]+1 GTR SP[NOC] THEN                      00498600
                BEGIN SP[MOC]:=1; L:=L-1; END                           00498700
                ELSE BEGIN FORMWD(3,"1      ");                         00498800
                PRINTMATRIX(LOCATE(B,A),ROW,COL);                       00498900
                L:=BOTTOM;                                              00499000
                END;                                                    00499100
            END;                                                        00499200
        FORMWD(3,"1      ");                                            00499300
         END;                                                           00499400
    PROCEDURE MAKEFUNCTIONPRESENT(L); VALUE L ; REAL L; %LOC DESC       00499500
        BEGIN                                                           00499600
        INTEGER I;                                                      00499700
        REAL M,N,SEQ,ORD,D;                                             00499800
        BOOLEAN NUMERIC;                                                00499900
        REAL STREAM PROCEDURE CON(A);VALUE A;                           00500000
            BEGIN SI:=LOC A; DI:=LOC CON; DS:=8OCT                      00500100
            END;                                                        00500200
        D:=SP[LOC]; %DESCRIPTOR FOR FUNCTION IS IN D                    00500300
        SEQ:=GETFIELD(D,FSQF-8,FFL); ORD:=GETFIELD(D,FPTF-8,FFL);       00500400
        N:=GETSPACE((M:=SIZE(ORD))|2+6); %GET SPACE FOR TABLE           00500500
        SP[NOC]:=M|2+5; %SIZE OF THE VECTOR WHICH FOLLOWS               00500600
        D:=D&N[CSPF]&1[CRF]&0[BACKPT]; D.PRESENCE:=1;                   00500700
        SP[LOC]:=D; %THIS SETS UP THE FUNCTION DESCRIPTOR.              00500800
        N:=N+1; SP[NOC]:=SEQ;                                           00500900
        COMMENT                                                         00501000
            SP[N]   = SIZE OF THE VECTOR                                00501100
            SP[N+1] = SEQUENTIAL STORAGE UNIT FOR THE TEXT              00501200
            SP[N+2] = SP LOC OF FIRST NUMERIC POINTER TO TEXT           00501300
                                                                        00501400
            SP[N+3] = REL LOC (TO N+5) OF THE FIRST ARG                 00501500
            SP[N+4] = REL LOC TO THE SECOND ARG                         00501600
            SP[N+5] = REL LOC OF RESULT .  IF ANY ARE ZERO, THEN        00501700
                      THEY ARE NOT THERE.;                              00501800
        D:=M; M:=(N:=N+4)+1; %D IS #ITEMS, M IS LOC 1ST, N=M-1          00501900
        FOR I:=1 STEP 1 UNTIL D DO %GET LABELS FROM STORAGE             00502000
            BEGIN L:=CONTENTS(ORD,I-1,GTA);                             00502100
            IF NOT NUMERIC THEN %RESULT, ARGS, OR LOCALS/LABELS         00502200
                IF NUMERIC:=GTA[0]=0 THEN %FIRST NUMERIC POINTER        00502300
                    BEGIN L:=N-3; SP[LOC]:=N+I|2-1;                     00502400
                    END;                                                00502500
            SP[MOC]:=GTA[0]; M:=M+1;                                    00502600
            IF NUMERIC THEN SP[MOC]:=GTA[1] ELSE                        00502700
                BEGIN                                                   00502800
                IF SEQ:=GTA[1] LSS 0 THEN %RESULT OR ARG                00502900
                    BEGIN L:=N+SEQ+1; SP[LOC]:=I;                       00503000
                    SEQ:=0;                                             00503100
                    END ELSE SEQ:=CON(SEQ)/10000;                       00503200
                SP[MOC]:=SEQ                                            00503300
                END;                                                    00503400
            M:=M+1                                                      00503500
            END;                                                        00503600
        COMMENT WE HAVE TO SET UP THE FUNCTION LABEL TABLE, LET         00503700
        SOMEONE ELSE FIGURE OUT HOW TO EXECUTE IT;                      00503800
        END;                                                            00503900
PROCEDURE PUSHINTOSYMTAB(FPTR);VALUE FPTR;REAL FPTR;                    00504000
    BEGIN COMMENT ...PUT THE LOCAL VARIABLES FROM THIS SUSPENDED        00504100
    FUNCTION INTO THE SYMBOL TABLE TO BE TREATED AS GLOBAL VARIABLES    00504200
    WHILE THE FUNCTION IS SUSPENDED. FPTR IS THE ENTRY FROM THE         00504300
    STATE INDICATOR VECTOR FOR THE FUNCTION.;                           00504400
                                                                        00504500
    REAL T,U;                                                           00504600
    LABEL COPY;                                                         00504700
    INTEGER K,L,M,N;                                                    00504800
    M:=FPTR.LOCFIELD+1;%LOCATE FMKS TO FIND LOCAL VALUES IN STACK       00504900
    N:=FPTR.SPF+2;T:=SP[NOC]-2;%FIND LOCAL NAMES                        00505000
    FOR N:=N+4 STEP 2 UNTIL T DO %ONCE FOR EACH LOCAL                   00505100
        BEGIN GT1:=SP[NOC].[6:42];%PICK UP THE LOCAL NAME               00505200
        L:=SYMBASE;K:=L+SP[LOC];% LOOK IN SYMBOL TABLE                  00505300
        FOR L:=L+1 STEP 2 UNTIL K DO % CHECK EACH NAME                  00505400
            IF GT1=SP[LOC].[6:42] THEN % WE FOUND A MATCH               00505500
            BEGIN GT1:=M;K:=M:=GETSPACE(1);L:=L+1;                      00505600
            SP[MOC]:=SP[LOC]; %PUSH CURRENT DESCRIPTOR DOWN             00505700
            M:=GT1; GO TO COPY;                                         00505800
            END;                                                        00505900
        COMMENT GET HERE IF NO MATCH...MUST MAKE A NEW ENTRY IN         00506000
        SYMBOL TABLE;                                                   00506100
        IF K LSS MAXSYMBOL|2 THEN % THERE IS ROOM IN SYMBOL TABLE       00506200
            BEGIN L:=SYMBASE;SP[LOC]:=SP[LOC]+2; L:=K+1;                00506300
            SP[LOC]:=GT1&OPERAND[CTYPEF]&1[CSUSVAR];L:=L+1;K:=0;        00506400
COPY:       COMMENT L IS LOC IN SYMBOL TABLE FOR DESC. K WILL BE        00506500
            CONTENTS OF BACKF. NOW SET UP THE NEW DESCRIPTOR AND        00506600
            SAVE ITS LOCATION IN THE STACK. M IS THE STACK LOCATION     00506700
            OF THE LOCAL;                                               00506800
                                                                        00506900
            SP[LOC]:=SP[MOC]&K[CLOCF]&1[CNAMED];                        00507000
            SP[MOC]:=L&DDNUVW[CDID];M:=M+1;                             00507100
            END ELSE % THERE IS NO ROOM IN THE SYMBEOL TABLE            00507200
            BEGIN N:=T;ERR:=SPERROR;END;                                00507300
        END;% OF FOR LOOP STEPPING THROGH THE LOCALS                    00507400
    END; % OF PUSHINTOSYMTAB PROCEDURE                                  00507500
PROCEDURE FORGETPROGRAM(U);VALUE U; REAL U;                             00507600
    BEGIN REAL L,M;                                                     00507700
    COMMENT U IS A PROGRAMMKS...THE SP STORAGE FOR THIS LINE            00507800
    SHOULD BE RELEASED;                                                 00507900
    M:=U.SPF;SCRATCHAIN(SP[MOC].LOCFIELD);%CONSTANT CHAIN               00508000
    L:=SP[MOC].SPF;FORGETSPACE(M,1);%FORGET PROGRAM DESC.               00508100
    M:=L+1;SCRATCHDATA(SP[MOC]);%FORGET BUFFER                          00508200
    FORGETSPACE(L,SP[LOC]+1);%FORGET THE POLISH                         00508300
    END;                                                                00508400
    EXPOVR:=EXPOVRL;                                                    00508500
    INTOVR:=INTOVRL;                                                    00508600
    INDEX:=INDEXL;                                                      00508700
    FLAG:=FLAGL;                                                        00508800
    ZERO:=ZEROL;                                                        00508900
CASE MODE OF                                                            00509000
BEGIN ;%--------------------------------------------------------        00509100
%---------------- CASE 1....MODE=XEQUTE------------------------         00509200
    CASE  CURRENTMODE OF                                                00509300
    BEGIN%-----------------------------------------------------         00509400
    %------------- SUB-CASE 0....CURRENTMODE=CALCMODE----------         00509500
    IF T:=ANALYZE(TRUE) NEQ 0 THEN % WE HAVE A PROGRAM DESC             00509600
        BEGIN COMMENT SET-UP THE STACK;                                 00509700
    IF STACKBASE=0 THEN BEGIN                                           00509800
        STACKBASE:=L:=GETSPACE(STACKSIZE+1);                            00509900
        IF ERR NEQ 0 THEN BEGIN STACKBASE:=0;                           00510000
        ERRORMESS(ERR,0,0); GO TO PROCESSEXIT;END;                      00510100
        SP[LOC]:=2;                                                     00510200
        L:=L+1;                                                         00510300
        M:=GETSPACE(STATEVECTORSIZE+1);                                 00510400
        SP[LOC]:=M&1[CRF]&DDPNVW[CDID];                                 00510500
        SP[MOC]:=STATEVECTORSIZE;                                       00510600
        M:=M+1; SP[MOC]:=0; % THE STATE VECTOR IS INITIALIZED NOW       00510700
        FUNCLOC:=M;                                                     00510800
        N:=0;                                                           00510900
        L:=L+1;                COMMENT READY FOR A PROG MKS;            00511000
        END ELSE % THERE IS ALREADY A STACK...USE IT                    00511100
        BEGIN L:=STACKBASE;                                             00511200
        ST:=SP[LOC]+L;                                                  00511300
        WHILE M:=AREG.DID NEQ IMKS AND M NEQ PROGMKS AND                00511400
            ERR=0 DO POP;%STRIP BACK TO LASTMARKSTACK                   00511500
        IF M=IMKS THEN BEGIN N:=ST-STACKBASE;PUSH;                      00511600
            END ELSE N:=AREG.BACKF;                                     00511700
        SP[LOC]:=ST-STACKBASE;L:=ST;                                    00511800
        END;                                                            00511900
        CURLINE:=0;                                                     00512000
        M:=GETSPACE(1); SP[MOC]:=T; %STORE PROG DESCRIPTOR              00512100
        SP[LOC]:=M&PROGMKS[CDID]&N[BACKPT]&1[CI];                       00512200
        COMMENT JUST BUILT A PROGRAM MARKSTACK;                         00512300
        GO TO EXECUTION;                                                00512400
        END;                                                            00512500
    %------------SUB-CASE 1....CURRENTMODE=XEQMODE---------------       00512600
        COMMENT RECOVERY FROM A TIME-OUT;                               00512700
        GO TO EXECUTION;                                                00512800
    %----------- SUB-CASE 2....CURRENTMODE=FUNCMODE--------------       00512900
        COMMENT SYNTAX CHECK ONLY;                                      00513000
        IF ANALYZE(TRUE)=0 THEN;                                        00513100
    %------- END OF SUB CASES-----------------------------------        00513200
    END;                                                                00513300
%------------------ CASE 2.....MODE=ALLOC------------------------       00513400
    COMMENT NOTHING TO DO;                                              00513500
    ;                                                                   00513600
%----------------- CASE 3.... MODE=WRITEBACK-------------------         00513700
    COMMENT HAVE TO WRITE BACK ALL THE CHANGED VARIABLES;               00513800
    IF SYMBASE NEQ 0 THEN                                               00513900
        WRITEBACK;                                                      00514000
                                                                        00514100
%----------------- CASE 4.... MODE=DEALLOC---------------------         00514200
    ;                                                                   00514300
                                                                        00514400
                                                                        00514500
%----------------- CASE 5 .... MODE=INTERROGATE----------------         00514600
    COMMENT PRINT OUT THE PROGRAM STATUS VECTOR HERE;                   00514700
    IF L:=STACKBASE+1 NEQ 1 THEN                                        00514800
        BEGIN COMMENT GT1=1 FOR SIV...=0 FOR SI;                        00514900
        U:=GT1;                                                         00515000
        L:=SP[LOC].SPF+1;M:=SP[LOC].SPF+L;                              00515100
        WHILE M GTR L DO                                                00515200
            BEGIN N:=SP[MOC].LOCFIELD;N:=SP[NOC].SPF-1;                 00515300
            % N IS LOCATION OF THE FUNCTION NAME                        00515400
            ACCUM[0]:=SP[NOC];                                          00515500
            FORMROW(2,6,ACCUM,1,7);                                     00515600
            IF BOOLEAN(SP[MOC].SUSPENDED) THEN FORMWD(0,"3 S    ")      00515700
                ELSE FORMWD(0,"3      ");                               00515800
            IF BOOLEAN(U) THEN % PRINT LOCAL VARIABLE NAMES             00515900
                BEGIN                                                   00516000
                N:=SP[MOC].SPF+2;T:=SP[NOC]-2;                          00516100
                FOR N:=N+4 STEP 2 UNTIL T DO                            00516200
                    BEGIN ACCUM[0]:=SP[NOC];                            00516300
                    FORMROW(0,1,ACCUM,1,7);                             00516400
                    END;                                                00516500
                END;                                                    00516600
            TERPRINT; M:=M-1;                                           00516700
            END;                                                        00516800
        END;                                                            00516900
    END;% OF THE CASE STATMENT                                          00517000
%--------------END OF CASES---------------------------------------      00517100
IF FALSE THEN EXECUTION:                                                00517200
    BEGIN COMMENT EXECUTION LOOP;                                       00517300
    INTEGER LOOP;                                                       00517400
    INTEGER INPUTIMS;                                                   00517500
    LABEL BREAKKEY;                                                     00517600
    LABEL SKIPPOP,XEQEPS;                                               00517700
    BOOLEAN XIT, JUMP;                                                  00517800
    REAL POLWORD;                                                       00517900
    DEFINE RESULT=RESULTD#;                                             00518000
    LABEL EXECEXIT, EVALQ, EVALQQ;                                      00518100
%%%                                                                     00518200
    COMMENT THERE IS A PROGRAM DESCRIPTOR AT THE TOP OF THE STACK;      00518300
    ERR:=0;                                                             00518400
    L:=STACKBASE; ST:=L+SP[LOC];                                        00518500
    L:=L+1;FUNCLOC:=SP[LOC].SPF+1;                                      00518600
    T:=AREG;                                                            00518700
    IF CURRENTMODE=XEQMODE THEN %AREG IS INTERRUPT MARK STACK           00518800
        BEGIN LASTMKS:=STACKBASE+T.BACKF;                               00518900
        OLDDATA:=T.SPF; INPUTIMS:=T.QUADIN; POP;                        00519000
        COMMENT MAY BE CURRENTLY EXECUTING A FUNCTION;                  00519100
        L:=STACKBASE+1; L:=SP[LOC].SPF+1;                               00519200
        IF (M:=SP[LOC].SPF) NEQ 0 THEN                                  00519300
            BEGIN M:=M+L; L:=SP[MOC].LOCFIELD;                          00519400
            CURLINE:=SP[LOC].CIF;                                       00519500
                                                                        00519600
            END;                                                        00519700
        END                                                             00519800
            ELSE LASTMKS:=ST;%AREG IS PROGRAM MARK STACK                00519900
    CURRENTMODE:=XEQMODE;                                               00520000
    L:=LASTMKS; T:=SP[LOC]; % T IS PROGRAM MARK STACK                   00520100
    CINDEX:=T.CIF;          % CONTROL INDEX IN POLISH                   00520200
    IF L:=T.SPF =0 THEN %PHONEY PROG DESC FROM FUNCTION CALL            00520300
        N:=POLTOP:=POLLOC:=0 ELSE                                       00520400
        BEGIN                                                           00520500
        N:=POLLOC:=SP[LOC].SPF;                                         00520600
        POLTOP:=SP[NOC]                                                 00520700
        END;                                                            00520800
    IF ERR = 0 THEN % POP WORKED                                        00520900
        IF INPUTIMS=2 THEN BEGIN JUMP:=TRUE; GO TO EVALQ END ELSE       00521000
        IF INPUTIMS = 1 THEN BEGIN JUMP:=TRUE; GO TO EVALQQ; END ELSE   00521100
        DO BEGIN COMMENT EXECUTE UNTIL DONE OR TIME-OUT;                00521200
        IF CINDEX LSS POLTOP THEN %MORE TO EXECUTE IN POLISH            00521300
            BEGIN COMMENT GET NEXT POLISH TO EXECUTE;                   00521400
            M:=(CINDEX:=CINDEX+1)+POLLOC;                               00521500
            POLWORD:=T:=SP[MOC];                                        00521600
            CASE T.TYPEFIELD OF                                         00521700
                BEGIN %-------TF=0 (REPLACEMENT)--------------          00521800
                    BEGIN %MAY BE A LOCAL OR A GLOBAL VARIABLE          00521900
                    DEFINE STARTSEGMENT=#; %/////////////////////       00522000
                    PUSH; IF ERR NEQ 0 THEN GO TO SKIPPOP;              00522100
                    N:=T.LOCFIELD;                                      00522200
                    IF BOOLEAN(T.OPTYPE) THEN %A LOCAL VARIABLE         00522300
                        BEGIN M:=FUNCLOC;%FIND LAST MKS                 00522400
                        M:=SP[MOC].SPF+M;                               00522500
                        N:=SP[MOC].LOCFIELD+N; END;                     00522600
                    U:=SP[NOC]; U.LOCFIELD:=N; AREG:=U;                 00522700
                        IF U.DATADESC=0 THEN ERR:=NONCEERROR;           00522800
                        COMMENT PROBABLY MIXUP WITH FUNCTION NAMES      00522900
                        AND NAMES OF LOCAL SUSPENDED VARIABLES;         00523000
                END;                                                    00523100
                    %-------------FUNCTION CALL-----------------        00523200
%&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&   00523300
BEGIN COMMENT SET UP STACK FOR A FUNCTION CALL;                         00523400
REAL U,V,NARGS,D;                                                       00523500
INTEGER I,FLOC;                                                         00523600
LABEL TERMINATE;                                                        00523700
COMMENT                                                                 00523800
        MONITOR PRINT(D,L,M,N,FLOC,SP,LASTMKS);%::::::::::::::::::::    00523900
    FLOC:=N:=T.LOCFIELD;                                                00524000
    IF BOOLEAN(SP[NOC].DATADESC) THEN BEGIN ERR:=NONCEERROR;            00524100
        GO TO TERMINATE;END;%SUSPENDED VAR CONFUSED WITH FUNCTION       00524200
    IF NOT BOOLEAN(SP[NOC].PRESENCE) THEN MAKEFUNCTIONPRESENT(N);       00524300
    D:=SP[NOC]; L:=LASTMKS;   %D IS TEH DESC, L IS THE PROG MKS         00524400
    SP[LOC].CIF:=CINDEX; %SAVE CURRENT POLISH LOCATION                  00524500
    L:=STACKBASE+1; L:=SP[LOC].SPF+1;                                   00524600
    M:=SP[LOC].SPF;                                                     00524700
    IF N:=M+L NEQ L THEN %THERE IS A NESTED CALL                        00524800
        IF NOT BOOLEAN(SP[NOC].SUSPENDED) THEN                          00524900
        BEGIN N:=SP[NOC].LOCFIELD;SP[NOC].CIF:=CURLINE;END;             00525000
                                                                        00525100
                                                                        00525200
    SETFIELD(GTA,0,8,0); SETFIELD(GTA,8,8,0); %INITIALIZE GTA           00525300
    NARGS:=D.NUMBERARGS;                                                00525400
    FOR I:=1 STEP 1 UNTIL NARGS DO                                      00525500
        IF BOOLEAN((T:=AREG).DATADESC) THEN                             00525600
            BEGIN                                                       00525700
            IF BOOLEAN(T.NAMED) THEN %MAKE A COPY                       00525800
            COMMENT YOU COULD MAKE A CALL BY NAME HERE;                 00525900
                BEGIN U:=GETSPACE(V:=(NUMELEMENTS(T)+T.RF));            00526000
                SPCOPY(T.SPF,U,V); T.NAMED:=0; T.SPF:=U;                00526100
                T.BACKP:=0;                                             00526200
                END ELSE %NO NEED TO MAKE A COPY                        00526300
            AREG.PRESENCE:=0;                                           00526400
            POP; GTA[I-1]:=T; %SAVE THE DESCRIPTOR FOR LATER USE        00526500
            END ELSE ERR:=SYSTEMERROR;                                  00526600
    IF (N:=M+1) GEQ STATEVECTORSIZE THEN ERR:=DEPTHERROR;               00526700
    IF ERR NEQ 0 THEN GO TO TERMINATE;                                  00526800
    SP[LOC].SPF:=N;                                                     00526900
    PUSH;AREG:=OLDDATA&(LASTMKS-STACKBASE)[BACKPT]&IMKS[CDID];          00527000
    OLDDATA:=0; %REINITIALIZE OLDDATA CHAIN FOR THIS FUNCTION           00527100
    %NOW SET UP THE FUNCTION MARK STACK.                                00527200
                                                                        00527300
    M:=N+L;PUSH;SP[MOC]:=D.SPF&ST[CLOCF];                               00527400
    M:=D.SPF; M:=M+2; % M IS LOC OF LOC OF FIRST LINE                   00527500
    AREG:=0&FLOC[CSPF]&((LASTMKS:=ST)-STACKBASE-1)[BACKPT]&             00527600
        (U:=SP[MOC]-D.SPF)[CCIF]&FMKS[CDID]; % FUNCTION MKS             00527700
    CURLINE:=U;                                                         00527800
                                                                        00527900
    U:=(U-6)/2; % U IS THE NUMBER OF LOCALS, LABELS, AND ARGS           00528000
    M:=M+5; % M IS ON THE FIRST DESC OF THE FIRST LAB, LOC,...          00528100
    FOR I:=1 STEP 1 UNTIL U DO % GET DESCRIPTORS INTO THE STACK         00528200
        BEGIN IF SP[MOC] NEQ 0 THEN %MAKE UP THE DESC                   00528300
            BEGIN L:=GETSPACE(1); SP[LOC]:=SP[MOC];                     00528400
            T:=L&DDPUSW[CDID]&0[CCIF]                                   00528500
            END ELSE                                                    00528600
            T:=NULLV;                                                   00528700
        PUSH; M:=M+2;                                                   00528800
        AREG:=T; %A SINGLE LOCAL                                        00528900
        END;                                                            00529000
    %COPY OVER THE ARGUMENTS                                            00529100
    FOR I:=1 STEP 1 UNTIL NARGS DO %COPY OVER                           00529200
        BEGIN M:=D.SPF; %M IS THE LOCATION OF THE LABEL TABLE.          00529300
        M:=M+2+I; %M IS LOCATION OF REL LOCATION OF VARIABLE            00529400
        M:=SP[MOC];                                                     00529500
        N:=LASTMKS+M;                                                   00529600
        SP[NOC]:=GTA[I-1];                                              00529700
        END;                                                            00529800
    %PUT IN A PHONEY PROG DESC TO START THINGS OFF                      00529900
    PUSH;  IF ERR NEQ 0 THEN GO TO TERMINATE;                           00530000
    AREG:=0&4094[CCIF]&(LASTMKS-STACKBASE)[BACKPT];                     00530100
    LASTMKS:=ST; POLTOP:=POLLOC:=0;                                     00530200
    TERMINATE:                                                          00530300
    END;                                                                00530400
%&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&              00530500
                    %-------END OF LOAD FUNCTION FOR CALL-----          00530600
                %-------------TF=2 (CONSTANT)---------------------      00530700
                BEGIN PUSH; IF ERR=0 THEN BEGIN                         00530800
                    N:=POLWORD.LOCFIELD;AREG:=SP[NOC];END;              00530900
                END;                                                    00531000
                %-------------TF=3 (OPERATOR)-----------------          00531100
                COMMENT SEQUENCE NUMBERS CORRESPOND TO OPERATOR         00531200
                ASSIGNMENT NUMBER;                                      00531300
                BEGIN IF T.OPTYPE=MONADIC THEN                          00531400
                    BEGIN PUSH;IF ERR=0 THEN AREG:=0; END;              00531500
                    CASE T.LOCFIELD OF                                  00531600
BEGIN %--------------- OPERATE ON STACK ---------------------           00531700
 COMMENT EACH EXECUTION PROCEDURE SETS RESULT TO THE                    00531800
   DESCRIPTOR OF THE RESULT OF THE OPERATION.                           00531900
    AREG AND BREG ARE THE LEFT AND RIGHT-HAND OPERANDS AND              00532000
    ARE ACTUALLY THE TOP TWO DESCRIPTORS ON THE STACK.                  00532100
    IF AREG IS ZERO, THE OPERATOR IS TAKEN TO BE MONADIC.;              00532200
;                                                                       00532300
;                                                                       00532400
;                                                                       00532500
;                                                                       00532600
    %---------------------REPLACEMENT OPERATOR---------------           00532700
    BEGIN DEFINE STARTSEGMENT=#; %///////////////////////////////       00532800
    IF NOT BOOLEAN(L:=AREG.NAMED) THEN % SHOULD BE LOCAL VARIABLE       00532900
        AREG.NAMED:=1; % DONT LET IT BE FORGOTTEN.                      00533000
                                                                        00533100
    IF BOOLEAN((T:=AREG).PRESENCE) AND T.SPF NEQ 0 THEN                 00533200
        OLDDATA:=CHAIN(T,OLDDATA);                                      00533300
    M:=T.LOCFIELD;                                                      00533400
                                                                        00533500
    IF(RESULT:=BREG).SPF = 0 THEN U:=T:=0 ELSE                          00533600
        U:=GETSPACE(T:=NUMELEMENTS(RESULT)+RESULT.RF);                  00533700
    SPCOPY(RESULT.SPF,U,T);                                             00533800
    RESULT.SPF:=U; RESULT.NAMED:=L; %L IS 0 FOR LOCALS                  00533900
    GT1:=IF BOOLEAN((U:=SP[MOC]).PRESENCE) THEN U.BACKP ELSE 0;         00534000
    SP[MOC]:=RESULT&GT1[CLOCF];                                         00534100
    IF BOOLEAN(L) AND GT1=0 THEN %CHECK FOR GLOBAL                      00534200
        BEGIN M:=M-1;IF(SP[MOC].SUSPENDVAR=0)THEN SP[MOC].CHANGE:=1;    00534300
                                                                        00534400
        END;                                                            00534500
    RESULT.NAMED:=1; %KEEP "PUSH" FROM TOSSING THE DATA                 00534600
    END;                                                                00534700
    %-------TRANSFER OPERATOR-----------------------------              00534800
    BEGIN DEFINE STARTSEGMENT=#; %////////////////////////////////      00534900
    SCRATCHAIN(OLDDATA);OLDDATA:=0;                                     00535000
    IF BOOLEAN(T.OPTYPE) THEN ST:=ST-1; %GET RID OF PHONEY TOP          00535100
    L:=FUNCLOC;                                                         00535200
    IF SP[LOC] NEQ 0 THEN STEPLINE(TRUE) ELSE                           00535300
        ERR:=SYNTAXERROR;                                               00535400
    GO TO SKIPPOP;                                                      00535500
    END;                                                                00535600
    BEGIN %--------------COMPRESSION------------------------------------00535700
    DEFINE STARTSEGMENT=#; %/////////////////////////////////////       00535800
    L:=ST-2; IF T.OPTYPE=MONADIC THEN COMPRESS(BREG,SP[LOC],AREG)       00535900
        ELSE COMPRESS(AREG,SP[LOC],BREG); COMMENT A/B HAS BEEN          00536000
        STACKED AS B,A,NULL...A/[I] B HAS BEEN STACKED AS B,I,A;        00536100
    END;                                                                00536200
    ARITH(3); %OPERATION IS DIVIDE                                      00536300
    ;                                                                   00536400
;                                                                       00536500
%-------------QUAD INPUT-------------------------------                 00536600
  EVALQ:  BEGIN LABEL EVALQUAD;                                         00536700
    IF JUMP THEN BEGIN JUMP:=FALSE; GO TO EVALQUAD END;                 00536800
    CURRENTMODE:=INPUTMODE;                                             00536900
    FORMWD(3,"3[]:   "); INDENT(0);                                     00537000
                                                                        00537100
    IMS(2); % SETUP MARKSTACK FOR QUAD EXIT                             00537200
    IF ERR NEQ 0 THEN GO TO SKIPPOP;                                    00537300
    GO TO EXECEXIT; % EXIT TO MONITOR TILL INPUT IS COMPLETE            00537400
EVALQUAD: %LOOK AT BUFFER TO SEE WHAT CAME IN                           00537500
    BEGIN                                                               00537600
    IF NOT SCAN THEN BEGIN CINDEX:=CINDEX-1;GO TO SKIPPOP;END;          00537700
    IF NOT SETUPLINE THEN CINDEX:=CINDEX-1;%MAKE THEM REDO IT           00537800
        GO TO SKIPPOP;                                                  00537900
        END;                                                            00538000
    END;                                                                00538100
    BEGIN % -----EVALUATE SUBSCRIPTS---------------                     00538200
    DEFINE STARTSEGMENT=#; %/////////////////////////////////////       00538300
    T:=AREG; L:=BREG.SPF;                                               00538400
    IF BOOLEAN(T.SCALAR) THEN BEGIN ERR:=DOMAINERROR; GO TO SKIPPOP;END;00538500
    U:=SP[LOC]; % GET # OF SUBSCRIPTS                                   00538600
    IF U GTR 32 THEN ERR:=INDEXERROR ELSE                               00538700
    BEGIN                                                               00538800
    IF U GTR 0 THEN BEGIN                                               00538900
    IF T.PRESENCE NEQ 1 THEN % GET ARRAY INTO SP                        00539000
        BEGIN N:=T.LOCFIELD;                                            00539100
        IF (T:=SP[NOC]).PRESENCE NEQ 1 THEN                             00539200
                BEGIN T:=GETARRAY(T); SP[NOC]:=T END;                   00539300
        T.LOCFIELD:= N;                                                 00539400
        END;                                                            00539500
    IF ERR=0 THEN % NOW EVALUATE                                        00539600
                                                                        00539700
        RESULT:=SUBSCRIPTS(L:=(IF T.LOCFIELD=0 THEN OUTOF               00539800
            ELSE INTO),T,U);                                            00539900
        IF L=INTO THEN BEGIN                                            00540000
                                                                        00540100
            CINDEX:=CINDEX+1;END; % SKIP OVER REPLACE OP                00540200
    END ELSE % NO SUBSCRIPTS                                            00540300
        BEGIN BREG:=T; ST:=ST-1; GO TO SKIPPOP;                         00540400
        END; % DON{T LET THE DESC. IN T BE POPPED.                      00540500
    U:=U+2; % # OF THINGS TO POP                                        00540600
    FOR N:=1 STEP 1 UNTIL U DO POP;                                     00540700
    IF L=OUTOF THEN PUSH; AREG:=RESULT;                                 00540800
                                                                        00540900
    GO TO SKIPPOP;                                                      00541000
    END;                                                                00541100
    END;                                                                00541200
;                                                                       00541300
;                                                                       00541400
%-------------QQUAD INPUT-------------------------------                00541500
  EVALQQ: BEGIN LABEL EVALQQUAD;                                        00541600
    IF JUMP THEN BEGIN JUMP:=FALSE; GO TO EVALQQUAD END;                00541700
    CURRENTMODE:=INPUTMODE;                                             00541800
    IMS(1); %SET UP MARKSTACKS FOR QQUAD EXIT                           00541900
    IF ERR NEQ 0 THEN GO TO SKIPPOP;                                    00542000
    GO TO EXECEXIT;                                                     00542100
EVALQQUAD:  % BUFFER CONTAINS THE INPUT STRING                          00542200
    IF (L:=LENGTH(BUFFER,TRUE))NEQ 0 THEN BEGIN %L IS # CHAR INPUT      00542300
    N:=ENTIER((L+7) DIV 8); % FIND NUMBER OF WORDS                      00542400
    M:=GETSPACE(N+1); % GET SPACE FOR THE VECTOR IN SP                  00542500
    TRANSFERSP(INTO,SP,M+1,BUFFER,0,N);                                 00542600
    SP[MOC]:=L; % STORE LENGTH OF VECTOR                                00542700
    RESULT:=M&1[CRF]&DDPUVC[CDID]; % SET UP DESCRIPTOR                  00542800
    END ELSE RESULT:=NULLV;% NOTHING WAS INPUT                          00542900
    PUSH; IF ERR=0 THEN AREG:=RESULT;                                   00543000
    GO TO SKIPPOP;                                                      00543100
    END;                                                                00543200
    RESULTD := SEMICOL;  %CONVERSIEON CONCATENATION                     00543300
    COMMAP;    %CATENATE                                                00543400
    BEGIN%----------INNER PRODUCT (PERIOD)---------------------         00543500
    M:=(CINDEX:=CINDEX+2) + POLLOC; T:=SP[MOC];M:=M-1;U:=SP[MOC];       00543600
    PERIOD(AREG,BREG,U.LOCFIELD,T.LOCFIELD);                            00543700
    END;                                                                00543800
    ARITH(4);  %*                                                       00543900
;                                                                       00544000
;                                                                       00544100
    ARITH(17);  %AND                                                    00544200
    ARITH(18);  %OR                                                     00544300
    ARITH(9);  %NOT                                                     00544400
    ARITH(11);  %LESS:THAN                                              00544500
    ARITH(16);  %LEQ                                                    00544600
    ARITH(12);  %=                                                      00544700
    ARITH(13);  %GEQ                                                    00544800
    ARITH(14);  %GREATER-THAN                                           00544900
    ARITH(15);  %NEQ                                                    00545000
    ARITH(8);   %MAX/CEIL                                               00545100
    ARITH(7);   %MIN/FLOOR                                              00545200
    ARITH(6);   %RESD/ABS                                               00545300
    IF T.OPTYPE=MONADIC THEN GO TO XEQEPS ELSE MEMBER; %MEMBERSHIP      00545400
    RHOP;       %RHO                                                    00545500
    IOTAP;      %IOTA                                                   00545600
;                                                                       00545700
   REDUCESORTSCAN(0,BREG,AREG,4);  %REVERSAL;                           00545800
   BEGIN %-----------EXPANSION-------------------------                 00545900
     DEFINE STARTSEGMENT=#; %////////////////////////////////////       00546000
     L:=ST-2; IF T.OPTYPE=MONADIC THEN EXPAND(BREG,SP[LOC],AREG)        00546100
      ELSE EXPAND(AREG,SP[LOC],BREG); COMMENT A EXPN B HAS BEEN         00546200
     STACKED AS B,A,NULL WHILE A EXPN [I] B IS STACKED AS B,I,A;        00546300
   END;                                                                 00546400
    RESULTD:=BASEVALUE;  %BASE VALUE                                    00546500
    ARITH(10);  %COMB/FACT                                              00546600
;                                                                       00546700
    IF T.OPTYPE=MONADIC THEN ARITH(5) ELSE                              00546800
              DYADICRNDM; %RNDM                                         00546900
    IF T.OPTYPE=MONADIC THEN TRANSPOSE ELSE DYADICTRANS;%GUESS WHAT     00547000
    RESULTD := REPRESENT;  %REPRESENTATION                              00547100
    ARITH(45);  %CIRCLE--TRIGONOMETRIC FUNCTIONS                        00547200
;                                                                       00547300
;                                                                       00547400
    ARITH(0);   %ADD                                                    00547500
    ARITH(2);   %SUBTRACT                                               00547600
    ARITH(1);   %MULTIPLY                                               00547700
    %-------------------DISPLAY---------------------------------------  00547800
                                                                        00547900
    BEGIN DEFINE STARTSEGMENT=#; %/////////////////////////////////     00548000
    IF BREG.SPF=0 THEN FORMROW(3,0,ACCUM,2,0) ELSE %FOR A NULL          00548100
    IF BOOLEAN((RESULT:=BREG).DATADESC)THEN %THIS IS A DATA DESC        00548200
        IF BOOLEAN(RESULT.PRESENCE) AND M:=RESULT.SPF NEQ 0 THEN        00548300
            IF BOOLEAN(RESULT.SCALAR) THEN                              00548400
                 BEGIN NUMBERCON(SP[MOC],ACCUM);                        00548500
                 FORMROW(3,0,ACCUM,2,ACOUNT)                            00548600
                 END                                                    00548700
            ELSE %A VECTOR                                              00548800
            IF L:=RESULT.RF NEQ 0 THEN % SOMETHING TO PRINT             00548900
                IF BOOLEAN(RESULT.CHRMODE) THEN DISPLAYCHARV(RESULT)    00549000
                ELSE                                                    00549100
                BEGIN RESULT:=M:=GETSPACE(L+1);                         00549200
                SP[MOC]:=L; RESULT.RF:=1; RESULT.DID:=DDPUVW;           00549300
                AREG:=RESULT;                                           00549400
                FOR T:=1 STEP 1 UNTIL L DO                              00549500
                    BEGIN M:=M+1; SP[MOC]:=1                            00549600
                    END;                                                00549700
                DISPLAY(AREG,BREG);                                     00549800
                RESULT:=BREG;                                           00549900
                END ELSE TERPRINT                                       00550000
            ELSE TERPRINT                                               00550100
       ELSE ; %PROBABLY A FUNCTION....DONT DO ANYTHING                  00550200
    IF BREAKFLAG THEN %USER HIT BREAK DURING OUTPUT                     00550300
        GO TO BREAKKEY;                                                 00550400
   POP; GO TO SKIPPOP;                                                  00550500
   END;                                                                 00550600
    BEGIN % ---------------REDUCTION------------------------------------00550700
    M:=(CINDEX:= CINDEX+1) + POLLOC; % FIND OPERATION IN POLISH         00550800
    IF (T:=SP[MOC]).TYPEFIELD NEQ 3 THEN ERR:=SYSTEMERROR               00550900
      ELSE REDUCESORTSCAN(T.LOCFIELD,BREG,AREG,1);                      00551000
    END;                                                                00551100
   BEGIN %--------ROTATION----------------------------                  00551200
     DEFINE STARTSEGMENT=#; %////////////////////////////////////       00551300
     L:=ST-2; IF T.OPTYPE=MONADIC THEN                                  00551400
         REDUCESORTSCAN(BREG,SP[LOC],AREG,5) ELSE                       00551500
         REDUCESORTSCAN(AREG,SP[LOC],BREG,5); COMMENT A ROT B IS        00551600
     STACKED AS B,A,NULL WHILE A ROT [I] B IS STACKED AS B,I,A;         00551700
   END;                                                                 00551800
    ARITH(21);  %LOG                                                    00551900
   REDUCESORTSCAN(0,BREG,AREG,2);  % SORTUP                             00552000
   REDUCESORTSCAN(-1,BREG,AREG,2); %SORTDN                              00552100
   BEGIN%--------------SCAN-------LIKE REDUCTION----------------        00552200
    DEFINE STARTSEGMENT=#; %//////////////////////////////////////      00552300
     M:=(CINDEX:=CINDEX+1) + POLLOC;  %FIND OPERATOR IN POLISH          00552400
     IF (T:=SP[MOC]).TYPEFIELD NEQ 3 THEN ERR:=SYSTEMERROR              00552500
        ELSE REDUCESORTSCAN(T.LOCFIELD,BREG,AREG,3);                    00552600
     END;                                                               00552700
    ARITH(19);  %NAND                                                   00552800
    ARITH(20);   %NOR                                                   00552900
    IF (T:=BREG).RF NEQ 0 THEN RESULT:=SUBSCRIPTS(3,T,T.RF)             00553000
        ELSE ERR:=RANKERROR; % OPERATION IS TAKE                        00553100
    IF (T:=BREG).RF NEQ 0 THEN RESULT:=SUBSCRIPTS(3,T,T.RF)             00553200
        ELSE ERR:=RANKERROR; % OPERATION IS DROP                        00553300
    %------------------------XEQ---------------------------------       00553400
XEQEPS:  BEGIN DEFINE STARTSEGMENT=#; %////////////////                 00553500
    IF AREG NEQ 0 THEN ERR:=SYNTAXERROR %MUST BE MONADIC ONLY           00553600
    ELSE IF (T:=BREG).RF NEQ 1 OR   %MUST BE A VECTOR                   00553700
    NOT BOOLEAN(T.CHRMODE) THEN ERR:=DOMAINERROR %MUST BE CHAR STRING   00553800
    ELSE IF U:=NUMELEMENTS(T) GTR MAXBUFFSIZE THEN ERR:=LENGTHERROR     00553900
    ELSE BEGIN                                                          00554000
        M:=GT1; % # OF CHARACTERS SET BY NUMELEMENTS                    00554100
        INITBUFF(BUFFER,MAXBUFFSIZE);RESCANLINE;                        00554200
        TRANSFERSP(OUTOF,SP,T.SPF+1,BUFFER,0,U);                        00554300
        IF(U:=U|8-M) GTR 0 THEN SETFIELD(BUFFER,M,U,"       ");         00554400
        IF T.SPF=0 OR NOT SCAN THEN RESULT:=0&1[CRF]&DDPUVW[CDID]% NULL 00554500
        ELSE BEGIN POP;IF SETUPLINE THEN; GO TO SKIPPOP;END             00554600
         END; END;                                                      00554700
    END; %--------------END OF OPERATION ON STACK---------------------  00554800
                        POP;POP;PUSH;IF ERR=0 THEN AREG:=RESULT;        00554900
SKIPPOP:                END OF TYPEFIELD EQUALS OPERATOR;               00555000
                    %-------TF=4 (LOCAL VARIABLE)------------           00555100
                    BEGIN COMMENT MOVE DESCRIPTOR UP TO TOP;            00555200
                    DEFINE STARTSEGMENT=#; %/////////////////           00555300
                    N:=T.LOCFIELD;M:=FUNCLOC;M:=SP[MOC]+M;              00555400
                                                                        00555500
                    N:=SP[MOC].LOCFIELD+N;                              00555600
                    T:=SP[NOC]; T.NAMED:=1; %KEEP FROM THROWING AWAY    00555700
                    PUSH; AREG:=T;                                      00555800
                    END;                                                00555900
                    %-------TF=5 (OPERAND)-----------------------       00556000
                    BEGIN PUSH; IF ERR=0 THEN BEGIN                     00556100
                        N:=POLWORD.LOCFIELD; U:=SP[NOC];                00556200
                         IF U.DATADESC=0 THEN ERR:=NONCEERROR ELSE      00556300
                        IF U.PRESENCE NEQ 1 THEN BEGIN                  00556400
                        U:=GETARRAY(U); SP[NOC]:=U END;                 00556500
                    U.LOCFIELD:=0;                                      00556600
                        AREG:=U; END;                                   00556700
                    END;                                                00556800
                END;  % OF CASE STATEMENT TESTING TYPEFIELD             00556900
            END % OF TEST FOR CINDEX LEQ POLTOP                         00557000
            ELSE % WE ARE AT THE END OF THE POLISH                      00557100
            BEGIN COMMENT LASKMKS CONTAINS THE LOCATION                 00557200
            OF THE LAST MARK STACK.  GET MARK STACK AND CONTINUE;       00557300
                                                                        00557400
            SCRATCHAIN(OLDDATA); OLDDATA:=0;                            00557500
            L:=LASTMKS;M:=(U:=SP[LOC]).BACKF+STACKBASE;T:=SP[MOC];      00557600
            IF T.DID=IMKS AND T.QUADIN=3 THEN %SINGLE LINE DONE         00557700
                IF (RESULT:=AREG)=T THEN ERR:=SYNTAXERROR%NO RESULT     00557800
                ELSE BEGIN RESULT.NAMED:=0;%MAKE NEW COPY               00557900
                IF BOOLEAN(RESULT.SCALAR) THEN                          00558000
                    BEGIN M:=GETSPACE(2);L:=RESULT.SPF;                 00558100
                    RESULT.SPF:=M+1;SP[MOC]:=RESULT;                    00558200
                    M:=M+1;SP[MOC]:=SP[LOC];                            00558300
                    END ELSE % MAKE COPY OF A VECTOR                    00558400
                    BEGIN M:=GETSPACE(1+(N:=RESULT.RF+NUMELEMENTS(      00558500
                        RESULT)));                                      00558600
                    L:=RESULT.SPF;RESULT.SPF:=M+1;                      00558700
                    SP[MOC]:=RESULT; SPCOPY(L,M+1,N); END;              00558800
                                                                        00558900
                                                                        00559000
                FORGETPROGRAM(U);                                       00559100
                                                                        00559200
                DO POP UNTIL ST LSS LASTMKS;%CUT BACK STACK TO IMS      00559300
                OLDDATA:=T.SPF;L:=LASTMKS:=T.BACKF+STACKBASE;           00559400
                AREG:=RESULT; % STORE EXECUTION RESULT OVER IMS         00559500
                CINDEX:=SP[LOC].CIF; M:= SP[LOC].SPF;                   00559600
                POLLOC:=M:=SP[MOC].SPF; POLTOP:=SP[MOC];                00559700
                END ELSE                                                00559800
                BEGIN L:=FUNCLOC;M:=SP[LOC].SPF+L;                      00559900
                IF M NEQ L AND NOT BOOLEAN(SP[MOC].SUSPENDED)THEN       00560000
                BEGIN                                                   00560100
                IF 0=(LOOP:=(LOOP+1) MOD 5) THEN                        00560200
                WRITE(TWXOUT,1,JIGGLE[*])[BREAKKEY:BREAKKEY];           00560300
                %THAT WAS TO CHECK FOR A BREAK TO INTERRUPT A PROG      00560400
                    STEPLINE(FALSE)                                     00560500
                END                                                     00560600
                ELSE BEGIN XIT:=TRUE;CURRENTMODE:=CALCMODE;             00560700
                    WHILE POPPROGRAM(OLDDATA,LASTMKS) DO;               00560800
                    END;                                                00560900
                END;                                                    00561000
            END; %COMPLETION OF ONE POLISH EVALUATION (1 CELL)          00561100
        IF ERR NEQ 0 THEN % PUT OUT ERROR MESSAGE                       00561200
            BEGIN                                                       00561300
            DEFINE STARTSEGMENT=#; %/////////////////////////////       00561400
            COMMENT                                                     00561500
            MONITOR PRINT(ST,L,M,SP,GTA,T);%::::::::::::::::::::::      00561600
            XIT:=TRUE;CURRENTMODE:=ERRORMODE;                           00561700
                                                                        00561800
            L:=POLLOC+1;                                                00561900
            TRANSFERSP(OUTOF,SP,(L:=SP[LOC].SPF)+1,BUFFER,              00562000
            0,MIN(MAXBUFFSIZE,ENTIER((SP[LOC]+7)DIV 8)));               00562100
            L:=FUNCLOC;M:=SP[LOC].SPF+L;                                00562200
            GT1:=1;N:=SP[MOC].LOCFIELD;%LOCATION OF FMKS                00562300
            WHILE LASTMKS GTR N AND BOOLEAN (GT1) DO GT1:=IF            00562400
                POPPROGRAM(OLDDATA,LASTMKS)THEN 1 ELSE 0;               00562500
            IF M NEQ L AND NOT BOOLEAN(SP[MOC].SUSPENDED)THEN%GET LINE# 00562600
                BEGIN SP[LOC].RF:=SP[LOC].RF+1;%UP SUSPENDED COUNT      00562700
                L:=SP[NOC].SPF-1;%LOCATION OF FUNCTION NAME             00562800
                SETFIELD(GTA,0,1,0);                                    00562900
                GTA[0]:=SP[LOC];                                        00563000
                FORMROW(3,0,GTA,1,7);                                   00563100
                L:=SP[MOC].SPF; %BASE OF LABEL TABLE                    00563200
                L:=L+CURLINE;                                           00563300
                T:=SP[LOC];                                             00563400
                                                                        00563500
                %ALSO PUT THE FUNCTION INTO SUSPENSION                  00563600
                IMS(4);SP[MOC].SUSPENDED:=1;SUSPENSION:=1;              00563700
                PUSHINTOSYMTAB(SP[MOC]);                                00563800
                END ELSE T:=0;                                          00563900
           ERRORMESS(ERR,POLWORD.SPF,T);                                00564000
            END;                                                        00564100
        END UNTIL XIT;                                                  00564200
BREAKKEY:   BEGIN BREAKFLAG:=FALSE;                                     00564300
            XIT:=TRUE;CURRENTMODE:=CALCMODE;                            00564400
            L:=FUNCLOC;M:=SP[LOC].SPF+L;                                00564500
            IF M NEQ L AND  NOT BOOLEAN(SP[MOC].SUSPENDED) THEN         00564600
                BEGIN SP[MOC].SUSPENDED:=1;SUSPENSION:=1;               00564700
                PUSHINTOSYMTAB(SP[MOC]);SP[LOC].RF:=SP[LOC].RF+1;       00564800
                M:=SP[MOC].LOCFIELD;%LOCATION OF FMKS IN STACK          00564900
                WHILE LASTMKS GTR M DO IF POPPROGRAM(OLDDATA,LASTMKS)   00565000
                THEN; LASTMKS:=M;IMS(4);                                00565100
                END                                                     00565200
        IF FALSE THEN                                                   00565300
            END;                                                        00565400
EXECEXIT:                                                               00565500
        IF STACKBASE NEQ 0 THEN BEGIN                                   00565600
        L:=STACKBASE; SP[LOC]:=ST-L; %UPDATE SIZE OF STACK              00565700
                                                                        00565800
        END;                                                            00565900
    END OF EXECUTION LOOP;                                              00566000
PROCESSEXIT:                                                            00566100
        IF BOOLEAN(POLBUG) THEN % DUMP SP                               00566200
        IF MODE=XEQUTE OR MODE=3 OR MODE=6 THEN GO TO DEBUGSP;          00566300
    IF FALSE THEN                                                       00566400
        BEGIN CASE 0 OF BEGIN                                           00566500
        EXPOVRL: SPOUT(3951200);                                        00566600
        INTOVRL: SPOUT(3591300);                                        00566700
        INDEXL:  SPOUT(3951400);                                        00566800
        FLAGL:   SPOUT(3951500);                                        00566900
        ZEROL:   SPOUT(3951600);                                        00567000
                        END;                                            00567100
        REALLYERROR:=1;                                                 00567200
    DEBUGSP:                                                            00567300
       WRITE(PRINT,MIN(15,PSRSIZE),PSR);                                00567400
            BEGIN                                                       00567500
            STREAM PROCEDURE FORM(A,B,N); VALUE N;                      00567600
            BEGIN                                                       00567700
            DI:=B; 15(DS:=8LIT" ");                                     00567800
            SI:=LOC N; DI:=B; DS:=8DEC; DI:=DI+3;                       00567900
            SI:=A; 10(DS:=8CHR; DI:=DI+1);                              00568000
            END;                                                        00568100
            M:=MIN(NROWS+1|SPRSIZE-1,MAXMEMACCESSES);                   00568200
                FOR N:=0 STEP 10 UNTIL M DO                             00568300
                BEGIN TRANSFERSP(OUTOF,SP,N,ACCUM,0,MIN(M-N,10));       00568400
                FORM(ACCUM,BUFFER,N);                                   00568500
                WRITE(PRINT,15,BUFFER[*]);                              00568600
                END;                                                    00568700
            END;                                                        00568800
            IF POLBUG=0 OR BOOLEAN(REALLYERROR) THEN                    00568900
        BEGIN                                                           00569000
        ERRORMESS(IF ERR NEQ SPERROR THEN SYSTEMERROR ELSE ERR,0,0);    00569100
        SUSPENSION:=0;                                                  00569200
        CURRENTMODE:=CALCMODE;                                          00569300
        REALLYERROR:=ERR:=0;                                            00569400
        END;                                                            00569500
        END;                                                            00569600
    END OF PROCESS PROCEDURE;                                           00569700
PROCEDURE ERRORMESS(N,ADDR,R); VALUE N,ADDR,R; REAL R;                  00569800
    INTEGER N; REAL ADDR;                                               00569900
    BEGIN                                                               00570000
    INTEGER STREAM PROCEDURE FORM(A,B); VALUE A;                        00570100
        BEGIN LOCAL T,U;                                                00570200
        LABEL L,M;                                                      00570300
        SI:=A;                                                          00570400
        L: IF SC=" " THEN                                               00570500
            BEGIN SI:=SI+1; GO TO L;                                    00570600
            END;                                                        00570700
        DI:=LOC T; DS:=2RESET; DS:=2SET;                                00570800
        DI:=B; MESSIZE(U:=DI; DI:=LOC T; IF SC=DC THEN JUMP OUT TO M;   00570900
        SI:=SI-1; DI:=U; DS:=CHR; TALLY:=TALLY+1); M:                   00571000
        FORM:=TALLY;                                                    00571100
        END;                                                            00571200
    ARRAY ERMES[0:13],B[0:MESSIZE/8];                                   00571300
   FILL ERMES[*] WITH                                                   00571400
       "1       ",                                                      00571500
       "5DEPTH  ",                                                      00571600
       "6DOMAIN ",                                                      00571700
       "7EDITING",                                                      00571800
       "5INDEX  ",                                                      00571900
       "5LABEL  ",                                                      00572000
       "6LENGTH ",                                                      00572100
       "5NONCE  ",                                                      00572200
       "4RANK   ",                                                      00572300
       "6SYNTAX ",                                                      00572400
       "6SYSTEM ",                                                      00572500
       "5VALUE  ",                                                      00572600
    "7SP FULL",                                                         00572700
    "7FLYKITE";                                                         00572800
   IF R NEQ 0 THEN                                                      00572900
        BEGIN INDENT(R);CHRCOUNT:=CHRCOUNT-1;                           00573000
       END;                                                             00573100
       FORMROW((IF R=0 THEN 2 ELSE 0),0,ERMES,N|8+1,                    00573200
       ERMES[N].[1:5]);                                                 00573300
       FORMWD(0,"6 ERROR");                                             00573400
        IF ADDR.[33:15] GEQ 512 THEN                                    00573500
        BEGIN                                                           00573600
        FORMWD(0,"4 AT   ");                                            00573700
        FORMROW(1,1,B,0,FORM(ADDR,B))                                   00573800
        END;                                                            00573900
        FORMWD(3,"1      ");                                            00574000
   END;                                                                 00574100
PROCEDURE LOADWORKSPACE(JOBNUM,NAME,IDENT); VALUE JOBNUM,NAME;          00574200
    REAL JOBNUM,NAME; ARRAY IDENT[0]; FORWARD;                          00574300
PROCEDURE LOGINAPLUSER;                                                 00574400
    BEGIN                                                               00574500
    COMMENT LOG:IN THE CURRENT USER;                                    00574600
    COMMENT INPUT LINE IS IS THE BUFFER;                                00574700
    LABEL EXEC, GUESS;                                                  00574800
    DEFINE T=GT1#, J=GT2#,I=GT3#;                                       00574900
    PROCEDURE INITIALIZEPSR;                                            00575000
        BEGIN FOR I:=0 STEP 1 UNTIL PSRSIZE-1 DO                        00575100
            PSRM[I] := 0;                                               00575200
        SEED:=STREAMBASE; ORIGIN:=1;                                    00575300
        FUZZ:=1@-11;                                                    00575400
        LINESIZE:=72; DIGITS:=9;                                        00575500
        END;                                                            00575600
    LADDRESS := ADDRESS := ABSOLUTEADDRESS;                             00575700
    WORKSPACE:=WORKSPACEUNIT;                                           00575800
    ITEMCOUNT := EOB := 0;                                              00575900
    IF NEXTUNIT=WORKSPACEUNIT THEN % ESTABLISH A WORKSPACE              00576000
        BEGIN                                                           00576100
                WORKSPACE:=NEXTUNIT;                                    00576200
                SEQUENTIAL(WORKSPACE);                                  00576300
                INITIALIZEPSR;                                          00576400
                I:=STORESEQ(WORKSPACE,PSR,PSRSIZE|8);                   00576500
                INITBUFF(OLDBUFFER,BUFFSIZE);                           00576600
                                                                        00576700
        END ELSE % WORKSPACE ASSIGNED                                   00576800
            I:=CONTENTS(WORKSPACE,0,PSR);                               00576900
            FILL ACCUM[*] WITH "LOGGED 1", "N      ";                   00577000
            FORMROW(0,1,ACCUM,0,9);                                     00577100
            I:=DAYTIME(ACCUM);                                          00577200
            FORMROW(1,1,ACCUM,0,I);                                     00577300
            SYMBASE:=STACKBASE:=0;                                      00577400
            CSTATION.APLOGGED:=1;                                       00577500
            CASE CURRENTMODE OF                                         00577600
                BEGIN %--------CALCMODE--------------                   00577700
                ;COMMENT NOTHING TO DO ANYMORE;                         00577800
                %--------------XEQUTEMODE----------------------         00577900
EXEC:                                                                   00578000
                 BEGIN FILL ACCUM[*] WITH "LAST RUN"," STOPPED";        00578100
                 FORMROW(3,0,ACCUM,0,16);                               00578200
                CURRENTMODE:=CALCMODE;                                  00578300
                 END;                                                   00578400
                %-------------FUNCMODE-----------------                 00578500
                 BEGIN FILL ACCUM[*]WITH "CONTINUE"," DEFINIT",         00578600
                 "ION OF  ";                                            00578700
                 FORMROW(2,0,ACCUM,0,23); FORMROW(1,0,PSR,              00578800
                 FSTART|8,7);                                           00578900
                CURLINE:=GT3:=TOPLINE(GT1:=FUNCPOINTER);                00579000
                CHECKSEQ(CURLINE,GT3,INCREMENT); %GET INCREMENT         00579100
                CURLINE:=CURLINE+INCREMENT; INDENT(-CURLINE);           00579200
                FUNCSIZE:=SIZE(GT1);                                    00579300
                END;                                                    00579400
                %------------INPUTMODE--------------ERRORMODE----       00579500
                 GO TO EXEC; GO TO EXEC;                                00579600
                END;                                                    00579700
    GUESS:  %SHOULD BE BETTER PLACE BUT HERE IS WHERE OTHERS COME OUT   00579800
    STOREPSR;                                                           00579900
    IF CURRENTMODE NEQ FUNCMODE THEN                                    00580000
    INDENT(0); TERPRINT;                                                00580100
    VARSIZE:=IF VARIABLES=0 THEN 0 ELSE SIZE(VARIABLES);                00580200
    END;                                                                00580300
PROCEDURE APLMONITOR;                                                   00580400
    BEGIN                                                               00580500
    REAL T;                                                             00580600
    INTEGER I;                                                          00580700
    BOOLEAN WORK;                                                       00580800
    LABEL AROUND, NEWUSER;                                              00580900
    LABEL CALCULATE,EXECUTEIT,FUNCTIONSTART,BACKAGAIN;                  00581000
    LABEL CALCULATEDIT;                                                 00581100
    I := CUSER := 1;                                                    00581200
    T := STATION;                                                       00581300
                BEGIN FILL ACCUM[*] WITH "APL/B550","0 UW COM"          00581400
                ,"PUTER SC","IENCE # ",VERSIONDATE;                     00581500
                WORK:=TRUE;                                             00581600
                FORMROW(3,MARGINSIZE,ACCUM,0,40);                       00581700
                INDENT(0); TERPRINT; CSTATION.APLHEADING:=1             00581800
                ; LOGINAPLUSER;                                         00581900
                END;                                                    00582000
 AROUND:                                                                00582100
                                                                        00582200
        BEGIN                                                           00582300
        IF MAINTENANCE THEN;                                            00582400
        CASE CURRENTMODE OF                                             00582500
        BEGIN %-------CALCMODE--------------------------------          00582600
        COMMENT HE MUST BE READ READY FOR THE CALCMODE STUFF;           00582700
                                                                        00582800
            GO CALCULATE;                                               00582900
        %--------XEQUTE MODE--------------------------------            00583000
            GO TO EXECUTEIT;                                            00583100
        %----------FUNCMODE-----------------------------------          00583200
            GO TO FUNCTIONSTART;                                        00583300
        %-----------INPUTMODE---------------------------------          00583400
        COMMENT REQUIRES INPUT;                                         00583500
                                                                        00583600
             BEGIN COMMENT GET THE LINE AND GO BACK;                    00583700
             STARTSCAN;                                                 00583800
             CURRENTMODE:=XEQMODE;                                      00583900
            GO TO EXECUTEIT;                                            00584000
             END;                                                       00584100
        %----------ERRORMODE---------------------------------           00584200
        GO TO BACKAGAIN;                                                00584300
                                                                        00584400
        END; %OF CASES                                                  00584500
        END;                                                            00584600
    COMMENT GET HERE IF NOTHING TO DO;                                  00584700
                                                                        00584800
    GO TO AROUND;                                                       00584900
    CALCULATE:                                                          00585000
        STARTSCAN;                                                      00585100
CALCULATEDIT:                                                           00585200
        ERR:=0; %AND DON"T RESET IT IN SCAN OR IN ANALYZE               00585300
        IF SCAN THEN                                                    00585400
            IF RGTPAREN THEN MESSAGEHANDLER ELSE                        00585500
        IF DELV THEN FUNCTIONHANDLER ELSE                               00585600
            BEGIN COMMENT PROCESS CALCULATOR MODE REQUEST;              00585700
            MOVE(BUFFER,BUFFERSIZE,OLDBUFFER);                          00585800
            IF NOT BOOLEAN(SUSPENSION) THEN BEGIN %INITIALIZE USER      00585900
%%%                                                                     00586000
%%%                                                                     00586100
            SYMBASE:=STACKBASE:=0;                                      00586200
            END;                                                        00586300
            PROCESS(XEQUTE);                                            00586400
            IF CURRENTMODE=CALCMODE THEN                                00586500
BACKAGAIN:      BEGIN INDENT(0); TERPRINT;                              00586600
                IF NOT BOOLEAN(SUSPENSION) THEN                         00586700
                    BEGIN IF CURRENTMODE NEQ ERRORMODE THEN             00586800
                    PROCESS(WRITEBACK);                                 00586900
                    SP[0,0]:=0;NROWS:=-1;                               00587000
%%%                                                                     00587100
                    END;                                                00587200
                CURRENTMODE:=CALCMODE;                                  00587300
                END;                                                    00587400
            END;                                                        00587500
        IF EDITOG=1 THEN                                                00587600
                BEGIN MOVE(OLDBUFFER,BUFFERSIZE,BUFFER);                00587700
                RESCANLINE; EDITOG:=0; GO TO CALCULATEDIT;              00587800
                END;                                                    00587900
        I:=0;                                                           00588000
        GO AROUND;                                                      00588100
    EXECUTEIT:                                                          00588200
        PROCESS(XEQUTE); %GO BACK TO PROCESS FOR AWHILE                 00588300
        IF CURRENTMODE=CALCMODE THEN GO TO BACKAGAIN;                   00588400
        I:=0;                                                           00588500
        GO AROUND;                                                      00588600
    FUNCTIONSTART:                                                      00588700
    IF SPECMODE = 0 THEN                                                00588800
        BEGIN %SEE IF A SPECIAL FUNCTION.                               00588900
        STARTSCAN;                                                      00589000
        IF SCAN AND RGTPAREN THEN MESSAGEHANDLER ELSE                   00589100
        FUNCTIONHANDLER                                                 00589200
        END ELSE                                                        00589300
    FUNCTIONHANDLER;                                                    00589400
        I:=0;                                                           00589500
        GO AROUND                                                       00589600
    END;                                                                00589700
INTEGER PROCEDURE LENGTH(A,M);VALUE M; BOOLEAN M; ARRAY A[0];           00589800
    BEGIN                                                               00589900
INTEGER STREAM PROCEDURE LENGT(A,M,L); VALUE M,L;                       00590000
    BEGIN LOCAL T;                                                      00590100
    LOCAL C,CC,TSI;      LABEL LAB;                                     00590200
    LOCAL AR; LABEL LAB2;                                               00590300
    SI:=LOC M; SI:=SI+7;                                                00590400
    IF SC="1" THEN                                                      00590500
        BEGIN COMMENT LOOK FOR LEFT ARROW.;                             00590600
        DI:=LOC AR; DS:=RESET; DS:=5SET;                                00590700
        SI:=LOC L; DI:=LOC T; DI:=DI+1; DS:=7CHR;                       00590800
        SI:=A;                                                          00590900
        T(2(32(DI:=LOC AR; IF SC=DC THEN JUMP OUT 3 TO LAB;             00591000
        TALLY:=TALLY+1;                                                 00591100
        C:=TALLY; TSI:=SI; SI:=LOC C;                                   00591200
        SI:=SI+7; IF SC="0" THEN                                        00591300
            BEGIN TALLY:=CC; TALLY:=TALLY+1; CC:=TALLY;                 00591400
            TALLY:=0;                                                   00591500
            END; SI:=TSI)));                                            00591600
        L(DI:=LOC AR; IF SC=DC THEN JUMP OUT TO LAB;                    00591700
        TALLY:=TALLY+1; C:=TALLY; TSI:=SI; SI:=LOC C; SI:=SI+7;         00591800
        IF SC="0" THEN                                                  00591900
            BEGIN TALLY:=CC; TALLY:=TALLY+1; CC:=TALLY; TALLY:=0;       00592000
            END; SI:=TSI);                                              00592100
        LAB: SI:=LOC CC; DI:=LOC LENGT; DI:=DI+6; SI:=SI+7;             00592200
        DS:=CHR; SI:=LOC C; SI:=SI+7; DS:=CHR;                          00592300
        END ELSE                                                        00592400
        BEGIN                                                           00592500
        SI:=LOC L; DI:=LOC T; DI:=DI+1; DS:=7CHR;                       00592600
        SI:=A; T(2(SI:=SI+32)); SI:=SI+L;                               00592700
        T(2(32(SI:=SI-1; IF SC NEQ " " THEN JUMP OUT 3 TO LAB2;         00592800
        TALLY:=TALLY+1; C:=TALLY; TSI:=SI; SI:=LOC C; SI:=SI+7;         00592900
        IF SC="0" THEN                                                  00593000
            BEGIN TALLY:=CC; TALLY:=TALLY+1; CC:=TALLY; TALLY:=0        00593100
            END; SI:=TSI)));                                            00593200
        L(SI:=SI-1; IF SC NEQ" " THEN JUMP OUT TO LAB2;                 00593300
        TALLY:=TALLY+1; C:=TALLY; TSI:=SI; SI:=LOC C; SI:=SI+7;         00593400
        IF SC="0" THEN                                                  00593500
            BEGIN TALLY:=CC; TALLY:=TALLY+1; CC:=TALLY; TALLY:=0        00593600
            END; SI:=TSI);                                              00593700
        LAB2: GO TO LAB                                                 00593800
        END                                                             00593900
    END;                                                                00594000
INTEGER I;                                                              00594100
I:=LENGT(A,M,BUFFSIZE|8);                                               00594200
LENGTH:=IF M THEN I ELSE BUFFSIZE|8-I                                   00594300
   END;                                                                 00594400
BOOLEAN PROCEDURE LABELSCAN(L,K); VALUE K; INTEGER K; ARRAY L[0];       00594500
    BEGIN REAL T;                                                       00594600
    T:=ADDRESS;                                                         00594700
    IF SCAN AND IDENT THEN                                              00594800
        BEGIN SETFIELD(ACCUM,1,1,0); TRANSFER(ACCUM,1,L,K|8,8);         00594900
        IF NOT(LABELSCAN:=(SCAN AND COLON)) THEN                        00595000
            BEGIN ADDRESS:=T; EOB:=0; IF SCAN THEN;                     00595100
            END;                                                        00595200
        END                                                             00595300
    END;                                                                00595400
STREAM PROCEDURE MOVEWDS(A,N,B); VALUE N;                               00595500
    BEGIN SI:=A; DI:=B; DS:=N WDS END;                                  00595600
INTEGER PROCEDURE DAYTIME(B); ARRAY B[0];                               00595700
    BEGIN                                                               00595800
                                                                        00595900
    INTEGER D,H,M,MIN,Q,P,Y,TIME1;                                      00596000
    LABEL OWT;                                                          00596100
    STREAM PROCEDURE FORM(A,DAY,MO,DA,YR,HR,MIN,AP);                    00596200
        VALUE DAY,MO,DA,YR,HR,MIN,AP;                                   00596300
        BEGIN DI:=A;                                                    00596400
        SI:=LOC DAY; SI:=SI+7;                                          00596500
        IF SC="0" THEN DS:=3LIT"SUN" ELSE                               00596600
        IF SC="1" THEN DS:=3LIT"MON" ELSE                               00596700
        IF SC="2" THEN DS:=4LIT"TUES" ELSE                              00596800
        IF SC="3" THEN DS:=6LIT"WEDNES" ELSE                            00596900
        IF SC="4" THEN DS:=5LIT"THURS" ELSE                             00597000
        IF SC="5" THEN DS:=3LIT"FRI" ELSE DS:=5LIT"SATUR";              00597100
        DS:=4LIT"DAY "; SI:=LOC MO; DS:=2DEC;                           00597200
        DS:=LIT"-"; SI:=LOC DA; DS:=2DEC; DS:=LIT"-";                   00597300
        SI:=LOC YR; DS:=2DEC; DS:=2LIT" ";                              00597400
        SI:=LOC HR; DS:=2DEC; DS:=LIT":"; SI:=LOC MIN;                  00597500
        SI:=SI+6; DS:=2CHR; SI:=LOC AP; SI:=SI+7; DS:=LIT" ";           00597600
        DS:=CHR; DS:=LIT"M"                                             00597700
        END;                                                            00597800
    TIME1:=TIME(1);                                                     00597900
    Y:=TIME(0);                                                         00598000
        D:=Y.[30:1]|100+Y.[36:6]|10+Y.[42:6];                           00598100
        Y:=Y.[18:6]|10+Y.[24:6];                                        00598200
    FOR H:=31,IF Y MOD 4=0 THEN 29 ELSE 28,31,30,                       00598300
       31,30,31,31,30,31,30 DO                                          00598400
        IF D LEQ H THEN GO OWT ELSE                                     00598500
            BEGIN D:=D-H; M:=M+1;                                       00598600
            END;                                                        00598700
    OWT:                                                                00598800
    H:=TIME1 DIV 216000;                                                00598900
    MIN:=(TIME1 DIV 3600) MOD 60;                                       00599000
    IF M LSS 2 THEN                                                     00599100
        BEGIN Q:=M+11; P:=Y-1;                                          00599200
        END ELSE                                                        00599300
        BEGIN Q:=M-1; P:=Y                                              00599400
        END;                                                            00599500
    M:=M+1;                                                             00599600
    FORM(B,TIME1:=((Q|26-2)DIV 10+D+P+P.[36:10]+1)MOD 7,                00599700
        M,D,Y,Q:= H MOD 12, Q:=MIN MOD 10+(MIN DIV 10)|64,              00599800
        IF H GEQ 12 THEN "P" ELSE 17);                                  00599900
    DAYTIME:=(IF TIME1=6 THEN 5 ELSE                                    00600000
        IF TIME1=5 THEN 3 ELSE                                          00600100
            IF TIME1=2 THEN 4 ELSE 3)+22;                               00600200
                                                                        00600300
                                                                        00600400
    END;                                                                00600500
PROCEDURE LOADWORKSPACE(NAME1,NAME2,IDENT); VALUE NAME1,NAME2;          00600600
    REAL NAME1,NAME2; ARRAY IDENT[0];                                   00600700
    BEGIN                                                               00600800
    FILE DISK DISK(2,WDSPERREC,WDSPERBLK);                              00600900
    INTEGER PROCEDURE RD(D,N,A);                                        00601000
        VALUE N; INTEGER N; FILE D; ARRAY A[0];                         00601100
        BEGIN READ(D[N],WDSPERREC,A[*]);                                00601200
        RD:=N+1;                                                        00601300
        END;                                                            00601400
    PROCEDURE LOADITEM(RD,D,ITEM);                                      00601500
        INTEGER PROCEDURE RD; FILE D;                                   00601600
        ARRAY ITEM[0];                                                  00601700
        BEGIN                                                           00601800
        DEFINE T=ITEM#;                                                 00601900
    PROCEDURE GETALINE(C,S,L,B,RD,D,LEN);                               00602000
        VALUE LEN; INTEGER C,S,L,LEN;                                   00602100
        ARRAY B[0]; INTEGER PROCEDURE RD; FILE D;                       00602200
        BEGIN % GET 2 CHRS GIVING ENSUING CHAR COUNT                    00602300
        INTEGER P;                                                      00602400
        IF C GTR LEN-2 THEN                                             00602500
            IF C GTR LEN-1 THEN % READ A NEW RECORD AND TAKE 2 CHRS     00602600
                BEGIN                                                   00602700
                S:=RD(D,S,B);                                           00602800
                C:=2;                                                   00602900
               TRANSFER(B,0,L,6,2);                                     00603000
               END                                                      00603100
            ELSE % 1 CHR LEFT ON LINE                                   00603200
                BEGIN                                                   00603300
                TRANSFER(B,C,L,6,1);                                    00603400
                S:=RD(D,S,B);                                           00603500
                TRANSFER(B,0,L,7,1);                                    00603600
                C:=1;                                                   00603700
                END                                                     00603800
        ELSE % AT LEAST 2 CHARS REMAINING ON LINE                       00603900
            BEGIN                                                       00604000
            TRANSFER(B,C,L,6,2);                                        00604100
            C:=C+2;                                                     00604200
            END;                                                        00604300
        P:=0;                                                           00604400
        IF L NEQ 0 THEN % SOMETHING LEFT IN FUNCTION                    00604500
            BEGIN                                                       00604600
            WHILE P LSS L DO                                            00604700
            IF (L-P) GTR (LEN-C) THEN % # OF CHARS IN LINE              00604800
               % EXTENDS INTO NEXT RECORD                               00604900
                BEGIN                                                   00605000
                TRANSFER(B,C,BUFFER,P,LEN-C); % FINISH OUT RECORD       00605100
                S:=RD(D,S,B);                                           00605200
                P:=P+(LEN-C); % AMOUNT READ SO FAR                      00605300
                C:=0;                                                   00605400
                END                                                     00605500
            ELSE % ALL ON ONE RECORD                                    00605600
                BEGIN                                                   00605700
                TRANSFER(B,C,BUFFER,P,L-P);                             00605800
                C:=C+L-P;                                               00605900
                P:=L; % FINISHED                                        00606000
                END;                                                    00606100
            END;                                                        00606200
        END OF GETALINE;                                                00606300
        INTEGER S,K,L,M,C,LEN,SQ,PT,G,I,SIZE;                           00606400
        INTEGER HOLD;                                                   00606500
        LABEL SCALARL;                                                  00606600
        ARRAY U[0:1],B[0:WDSPERREC-1];                                  00606700
        BOOLEAN TOG;                                                    00606800
        TRANSFER(T,0,U,0,7);                                            00606900
        G:=GETFIELD(T,7,1);                                             00607000
        IF VARSIZE GTR 0 THEN                                           00607100
            IF K:=SEARCHORD(VARIABLES,U,HOLD,7)=0 THEN                  00607200
                IF K:=GETFIELD(U,7,1)=FUNCTION THEN TOG:=TRUE           00607300
                ELSE % NOT A FUNCTION IN THE SYMBOL TABLE               00607400
                IF G=FUNCTION THEN                                      00607500
                    BEGIN                                               00607600
                    DELETE1(VARIABLES,HOLD);                            00607700
                    IF K=ARRAYDATA THEN RELEASEARRAY(U[1]);             00607800
                    END                                                 00607900
                ELSE TOG:=TRUE % DON-T CHANGE                           00608000
            ELSE % NOT IN VARIABLES                                     00608100
                BEGIN                                                   00608200
                VARSIZE:=VARSIZE+1;                                     00608300
                HOLD:=HOLD+K-1;                                         00608400
                END                                                     00608500
        ELSE VARSIZE:=1;                                                00608600
        LEN:=(WDSPERREC-1)|8;                                           00608700
        IF NOT TOG THEN % OK TO PUT INTO VARIABLES                      00608800
            IF G=FUNCTION THEN % READ A FUNCTION INTO VARIABLES         00608900
                BEGIN                                                   00609000
                TRANSFER(T,0,U,0,9); % U HOLDS FUNCTION NAME,           00609100
                %NUMBER OF ARGUMENTS, AND WHETHER FN RETURNS A VALUE    00609200
                S:=T[1].LIBF1; % RECORD NUMBER                          00609300
                M:=T[1].LIBF2; % WORD WITHIN RECORD                     00609400
                SIZE:=T[1].LIBF3; % SIZE OF POINTERS TABLE              00609500
                PT:=NEXTUNIT;                                           00609600
                S:=RD(D,S,B);                                           00609700
                FOR I:=0 STEP 1 UNTIL SIZE-1 DO                         00609800
                    BEGIN                                               00609900
                    TRANSFER(M,M|8,T,0,16);                             00610000
                    M:=M+2;                                             00610100
                    IF M GEQ WDSPERREC-1 THEN                           00610200
                        BEGIN                                           00610300
                        S:=RD(D,S,B);                                   00610400
                        IF M GEQ WDSPERREC THEN                         00610500
                            BEGIN                                       00610600
                            TRANSFER(B,0,T,8,8);                        00610700
                                M:=1;                                   00610800
                            END                                         00610900
                        ELSE M:=0;                                      00611000
                         END;                                           00611100
                    STOREORD(PT,T,I);                                   00611200
                    END; % HAVE FINISHED FILLIN G POINTERS TABLE        00611300
                IF VARIABLES=0 THEN BEGIN                               00611400
                    VARIABLES:=NEXTUNIT; TOG:=TRUE; %KEEP THE UNIT OPEN 00611500
                    STOREORD(VARIABLES,U,HOLD); END;                    00611600
                SEQUENTIAL (SQ:=NEXTUNIT);                              00611700
                SETFIELD(U,FPTF,FFL,PT);                                00611800
                SETFIELD(U,FSQF,FFL,SQ);                                00611900
                STOREORD(VARIABLES,U,HOLD);                             00612000
                IF TOG THEN DELETE1(VARIABLES,HOLD+1);%REMOVE 1 EXTRA   00612100
                COMMENT NOW FILL IN SEQ STORAGE;                        00612200
                IF M NEQ 0 THEN BEGIN                                   00612300
                M:=C:=0;                                                00612400
                S:=RD(D,S,B); % TEXT STARTS AT BEG. OF NEW RECORD       00612500
                                END;                                    00612600
                L:=1;                                                   00612700
                                                                        00612800
                WHILE L NEQ 0 DO                                        00612900
                    BEGIN                                               00613000
                    GETALINE(C,S,L,B,RD,D,LEN);                         00613100
                    GT1:=STORESEQ(SQ,BUFFER,L);                         00613200
                    END                                                 00613300
                END                                                     00613400
            ELSE                                                        00613500
            IF G=ARRAYDATA THEN                                         00613600
                    IF T[1].INPTR=0 THEN % NULL VECTOR                  00613700
                        GO TO SCALARL                                   00613800
                    ELSE                                                00613900
                BEGIN                                                   00614000
                ARRAY DIMVECT[0:MAXBUFFSIZE];                           00614100
                S:=T[1].INPTR; % RECORD NUMBER                          00614200
                M:=T[1].DIMPTR; % LOC WITHIN RECORD                     00614300
                C:=M|8;                                                 00614400
                SIZE:=T[1].RF; % RANK                                   00614500
                S:=RD(D,S,B);                                           00614600
                GETALINE(C,S,L,B,RD,D,LEN);                             00614700
                T[1].DIMPTR:=STORESEQ(WS,BUFFER,L);                     00614800
                    % PUTS DIMVECT INTO WORKSPACE                       00614900
                GETALINE(C,S,L,B,RD,D,LEN); % # BLOCKS                  00615000
                SIZE:=L-1;                                              00615100
                FOR K:=0 STEP 2 UNTIL SIZE DO                           00615200
                    BEGIN                                               00615300
                    GETALINE(C,S,L,B,RD,D,LEN);                         00615400
                    SETFIELD(DIMVECT,K,2,STORESEQ(WS,BUFFER,L));        00615500
                    END; COMMENT THIS STORES THE VALUES OF THE          00615600
                         ARRAY INTO THE WORKSPACE, AND ALSO RECORDS     00615700
                         THE LOCATION WITHIN WS IN DIMVECT,TO BE STORED;00615800
                T[1].INPTR:=STORESEQ(WS,DIMVECT,SIZE+1);                00615900
                IF VARIABLES=0 THEN VARIABLES:=NEXTUNIT;                00616000
                STOREORD(VARIABLES,T,HOLD);                             00616100
                END                                                     00616200
            ELSE % MUST BE A SCALAR                                     00616300
                    SCALARL:                                            00616400
                BEGIN                                                   00616500
                 IF VARIABLES=0 THEN VARIABLES:=NEXTUNIT;               00616600
                STOREORD(VARIABLES,T,HOLD);                             00616700
                END                                                     00616800
        ELSE % WILL NOT REPLACE IN SYMBOL TABLE                         00616900
            BEGIN                                                       00617000
            FILL BUFFER[*] WITH " ","NOT REPL","ACED    ";              00617100
                TRANSFER(T,0,BUFFER,0,7);                               00617200
                FORMROW(3,0,BUFFER,0,20);                               00617300
            END;                                                        00617400
        END LOADITEM;                                                   00617500
    BOOLEAN STREAM PROCEDURE EQUAL(A,B);                                00617600
        BEGIN SI:=A; DI:=B; SI:=SI+2; IF 7SC=DC THEN TALLY:=1;          00617700
        EQUAL:=TALLY                                                    00617800
        END;                                                            00617900
    INTEGER I,J,L,NDIR,N;                                               00618000
    LABEL MOVEVAR,SKIP;                                                 00618100
    ARRAY T,U[0:1],D[0:WDSPERREC-1];                                    00618200
    FILL DISK WITH NAME1,NAME2; L:=RD(DISK,L,D);                        00618300
    IF D[1] NEQ JOBNUM AND D[1] NEQ 0 THEN GO SKIP; % FILE LOCKED       00618400
    FOR I:=2 STEP 1 UNTIL 9 DO IF GETFIELD(D[I],1,7) NEQ 0 THEN GO SKIP;00618500
    IF NDIR:=D[0] NEQ 0 THEN                                            00618600
    BEGIN N:=LIBSPACES+ENTIER(NDIR|2/(J:=WDSPERREC-1));                 00618700
        IF(NDIR|2) MOD J NEQ 0 THEN N:=N+1;                             00618800
        FOR I:=1 STEP 1 UNTIL NDIR DO                                   00618900
            BEGIN COMMENT GET FUNCTION OR VARIABLE NAME FROM LIB;       00619000
            IF WDSPERREC-J LSS 3 THEN                                   00619100
                IF WDSPERREC-J=1 THEN                                   00619200
                BEGIN L:=RD(DISK,L,D); J:=0; GO MOVEVAR                 00619300
                END ELSE                                                00619400
                BEGIN TRANSFER(D,J|8,T,0,8); L:=RD(DISK,L,D);           00619500
                TRANSFER(D,0,T,8,8); J:=1                               00619600
                END ELSE MOVEVAR:                                       00619700
                BEGIN TRANSFER(D,J|8,T,0,16); J:=J+2                    00619800
                END;                                                    00619900
            IF(IF IDENT[0]=0 THEN TRUE ELSE EQUAL(IDENT,T)) THEN        00620000
                BEGIN IF IDENT[0] NEQ 0 THEN I:=NDIR+1;                 00620100
                LOADITEM(RD,DISK,T);                                    00620200
                END                                                     00620300
            END;                                                        00620400
    STOREPSR; % UPDATE SINCE HAVE ADDED TO VARIABLES                    00620500
    END;                                                                00620600
    IF FALSE THEN SKIP: FORMWD(1,"6BADFIL");                            00620700
    EOB:=1;                                                             00620800
    END OF LIBRARY LOAD;                                                00620900
PROCEDURE PURGEWORKSPACE(WS); VALUE WS; INTEGER WS;                     00621000
    IF WORKSPACE NEQ 0 THEN                                             00621100
    BEGIN                                                               00621200
    INTEGER I,J,K,V,L,G;                                                00621300
    ARRAY T[0:1];                                                       00621400
    J:=SIZE(V:=VARIABLES)-1;                                            00621500
    FOR I:=0 STEP 1 UNTIL J DO                                          00621600
        BEGIN K:=CONTENTS(V,I,T);                                       00621700
        IF GETFIELD(T,7,1)=FUNCTION THEN                                00621800
        FOR L:=FPTF,FSQF DO   % GET RID OF STORAGE                      00621900
        IF G:=GETFIELD(T,L,FFL) NEQ 0 THEN RELEASEUNIT(G);              00622000
        END;                                                            00622100
    RELEASEUNIT(V);                                                     00622200
    VARIABLES:=0; VARSIZE:=0;                                           00622300
    CURRENTMODE:=0; J:=SIZE(WS)-1;                                      00622400
    FOR I:=1 STEP 1 UNTIL J DO DELETE1(WS,I);                           00622500
    STOREPSR;                                                           00622600
    END;                                                                00622700
PROCEDURE ELIMWORKSPACE(WS); VALUE WS; INTEGER WS;                      00622800
    BEGIN LABEL QQQ; QQQ:                                               00622900
    IF WORKSPACE NEQ 0 THEN                                             00623000
        BEGIN                                                           00623100
        PURGEWORKSPACE(WS); RELEASEUNIT(WS);                            00623200
%                                                                       00623300
    END ELSE SPOUT(8015222);                                            00623400
    END;                                                                00623500
PROCEDURE SAVEWORKSPACE(NAME1,NAME2,LOCKFILE);                          00623600
    VALUE NAME1,NAME2,LOCKFILE;                                         00623700
    REAL NAME1,NAME2,LOCKFILE;                                          00623800
    BEGIN                                                               00623900
    SAVE FILE DISK DISK [NAREAS:SIZEAREAS]                              00624000
      (2,WDSPERREC,WDSPERBLK,SAVE 100);                                 00624100
    INTEGER PROCEDURE WR(D,N,A); VALUE N; INTEGER N;                    00624200
        FILE D; ARRAY A[0];                                             00624300
        BEGIN REAL STREAM PROCEDURE CON(A); VALUE A;                    00624400
            BEGIN SI:=LOC A; DI:=LOC CON; DS:=8DEC END;                 00624500
        STREAM PROCEDURE CLEANER(A);                                    00624600
            BEGIN DI:=A; WDSPERREC(DS:=8LIT".") END;                    00624700
        A[WDSPERREC-1]:=CON(N);                                         00624800
        WRITE(D[N],WDSPERREC,A[*]);                                     00624900
        WR:=N+1; CLEANER(A);                                            00625000
        END;                                                            00625100
    PROCEDURE PUTAWAY(C,J,WR,D,N,M,B,L); VALUE L,J;                     00625200
        INTEGER L,C,J,N,M;                                              00625300
    ARRAY B[0]; INTEGER PROCEDURE WR; FILE D;                           00625400
        BEGIN INTEGER P,K;                                              00625500
        IF C+2 GTR L THEN                                               00625600
            BEGIN TRANSFER(J,6,B,C,1); N:=WR(D,N,B); C:=1;              00625700
            TRANSFER(J,7,B,0,1);                                        00625800
            END ELSE                                                    00625900
            BEGIN TRANSFER(J,6,B,C,2); C:=C+2;                          00626000
            END;                                                        00626100
        WHILE J NEQ 0 DO                                                00626200
        IF J GTR K:=(L-C) THEN                                          00626300
            BEGIN TRANSFER(BUFFER,P,B,C,K);                             00626400
            N:=WR(D,N,B); J:=J-K; C:=0; P:=P+K                          00626500
             END ELSE                                                   00626600
            BEGIN TRANSFER(BUFFER,P,B,C,J); C:=C+J; J:=0                00626700
            END;                                                        00626800
        IF C=L THEN                                                     00626900
            BEGIN N:=WR(D,N,B); C:=0                                    00627000
            END;                                                        00627100
        END;                                                            00627200
                                                                        00627300
    PROCEDURE MOVETWO(U,B,M,WR,L,D);                                    00627400
        ARRAY U,B[0]; INTEGER M,L; INTEGER PROCEDURE WR; FILE D;        00627500
        BEGIN                                                           00627600
        COMMENT PUTS 2 WORDS OF U IN B AND WRITES ON D IF  A FULLRECORD;00627700
        TRANSFER(U,0,B,M|8,16); % CONTENTS OF U INTO B                  00627800
        M:=M+2;                                                         00627900
        IF M GEQ WDSPERREC-1 THEN % FULL RECORD                         00628000
            BEGIN                                                       00628100
            L:=WR(D,L,B);                                               00628200
            IF M GEQ WDSPERREC THEN % 1 OVER FULL RECORD                00628300
                                                                        00628400
                BEGIN                                                   00628500
                TRANSFER(U,8,B,0,8);                                    00628600
                M:=1;                                                   00628700
                END                                                     00628800
            ELSE M:=0;                                                  00628900
            END;                                                        00629000
        END OF MOVETWO;                                                 00629100
        INTEGER H,Q,M,N,I,L,S,J,K,LINE,MAX,PT,SQ,C,LEN,W;               00629200
        REAL LSD,STP;                                                   00629300
        LABEL SKIP;                                                     00629400
        ARRAY T,U[0:1],DIR,B,SEX[0:WDSPERREC];                          00629500
        N:=LIBSPACES+ENTIER((S:=SIZE(VARIABLES))|2/(WDSPERREC-1));      00629600
        IF (S|2) MOD (WDSPERREC-1) NEQ 0 THEN N:=N+1; % ADJUST          00629700
        LEN:=(WDSPERREC-1)|8;                                           00629800
        FILL DISK WITH NAME1,NAME2;                                     00629900
        DIR[0]:=S; % SIZE OF SYMBOL TABLE                               00630000
        IF BOOLEAN (LOCKFILE) THEN DIR[1]:=JOBNUM;                      00630100
        S:=S-1;                                                         00630200
        L:=WR(DISK,L,DIR); % FIRST LINE CONTAINS # OF ENTRIES IN        00630300
        COMMENT SYMBOL TABLE AND LOCK INFORMATION;                      00630400
        FOR I:=0 STEP 1 UNTIL S DO                                      00630500
            BEGIN                                                       00630600
            J:=CONTENTS(VARIABLES,I,T); % RETURNS VALUE OF I-TH LOC     00630700
            % IN VARIABLES INTO T                                       00630800
            IF GT2:=GETFIELD(T,7,1)=FUNCTION THEN                       00630900
                BEGIN                                                   00631000
                PT:=GETFIELD(T,FPTF,FFL); % FUNCTION POINTER FIELD      00631100
                SQ:=GETFIELD(T,FSQF,FFL); % FUNCTION SEQUENTIAL FIELD   00631200
                %PT=# OF ORDERED STORAGE UNIT CONTAINING HEADER&POINTE  00631300
                %SQ=# OF SEQ STORAGE UNIT CPONTAINING TEXT              00631400
                MAX:=SIZE(PT);                                          00631500
                T[1].LIBF1:=N; % RECORD #                               00631600
                T[1].LIBF2:=M; % LOC WITHIN RECORD                      00631700
                T[1].LIBF3:=MAX; % SIZE OF  POINTERS TABLE;             00631800
                % SAVE ENOUGH ROOM FOR THE ENTIRE POINTERS TABLE        00631900
                H:=ENTIER(GT1:=(M+MAX|2)/(WDSPERREC-1));                00632000
                H:=IF GT1 NEQ H THEN H+N+1 ELSE H+N;                    00632100
                U[0]:=0;                                                00632200
                J:=SEARCHORD(PT,U,LINE,8); % LOOK FOR ALL ZEROS         00632300
                IF J=2 THEN GO SKIP;                                    00632400
                FOR W:=0 STEP 1 UNTIL LINE-1 DO                         00632500
                    %MOVE LOCALS AND LABELS INTO THE SAVE FILE          00632600
                    BEGIN                                               00632700
                J:=CONTENTS(PT,W,U);                                    00632800
                    MOVETWO(U,B,M,WR,N,DISK);                           00632900
                    END;                                                00633000
                    FOR LINE:=LINE STEP 1 UNTIL MAX-1 DO                00633100
                        BEGIN                                           00633200
                                                                        00633300
                        J:=CONTENTS(PT,LINE,U);                         00633400
                            GT1:=U[1];                                  00633500
                        U[1]:=LINE-W;                                   00633600
                        MOVETWO(U,B,M,WR,N,DISK); % POINTERS TABLE      00633700
                            J:=CONTENTS(SQ,GT1,BUFFER);                 00633800
                        PUTAWAY(C,J,WR,DISK,H,Q,SEX,LEN); % TEXT        00633900
                        END;                                            00634000
                    PUTAWAY(C,0,WR,DISK,H,Q,SEX,LEN);                   00634100
              SKIP:                                                     00634200
                Q:=C DIV 8;                                             00634300
                    IF C MOD 8 NEQ 0 THEN Q:=Q+1;                       00634400
                    IF Q=WDSPERREC-1 THEN                               00634500
                        BEGIN                                           00634600
                        H:=WR(DISK,H,SEX);                              00634700
                        Q:=0;                                           00634800
                        END;                                            00634900
                    IF M GTR 0 THEN N:=WR(DISK,N,B);                    00635000
                    M:=Q; N:=H;                                         00635100
                    TRANSFER(SEX,0,B,0,C); % MOVE BACK TO B             00635200
                    C:=0;                                               00635300
                END                                                     00635400
            ELSE                                                        00635500
            IF GT2=ARRAYDATA THEN                                       00635600
                BEGIN                                                   00635700
                ARRAY DIMVECT[0:MAXBUFFSIZE];                           00635800
                LSD:=T[1];                                              00635900
                IF H:=LSD.SPF=0 THEN % NULL VECTOR                      00636000
                ELSE                                                    00636100
                    BEGIN                                               00636200
                    T[1].INPTR:=N; T[1].DIMPTR:=M;                      00636300
                    C:=M|8;                                             00636400
                    J:=CONTENTS(WS,LSD.DIMPTR,BUFFER); % DIM VECT       00636500
                    PUTAWAY(C,J,WR,DISK,N,M,B,LEN); % STD DIM VECT      00636600
                    J:=CONTENTS(WS,LSD.INPTR,DIMVECT);                  00636700
                    TRANSFER(DIMVECT,0,BUFFER,0,J);                     00636800
                    PUTAWAY(C,J,WR,DISK,N,M,B,LEN);                     00636900
                    J:=J-1;                                             00637000
                    FOR LINE:=0 STEP 2 UNTIL J DO                       00637100
                        BEGIN                                           00637200
                        PT:=GETFIELD(DIMVECT,LINE,2);                   00637300
                        STP:=CONTENTS(WS,PT,BUFFER);                    00637400
                        PUTAWAY(C,STP,WR,DISK,N,M,B,LEN);               00637500
                        END;                                            00637600
                     M:=C DIV 8; IF C MOD 8 NEQ 0 THEN M:=M+1; C:=0;    00637700
                     IF M=WDSPERREC-1 THEN BEGIN N:=WR(DISK,N,B);       00637800
                        M:=0;         END;                              00637900
                    END;                                                00638000
                END;                                                    00638100
                MOVETWO(T,DIR,K,WR,L,DISK);                             00638200
            END;                                                        00638300
                                                                        00638400
        EOB:=1;                                                         00638500
    IF M GTR 0 THEN N:=WR(DISK,N,B);                                    00638600
    IF K GTR 0 THEN L:=WR(DISK,L,DIR);                                  00638700
    LOCK(DISK);                                                         00638800
    END;                                                                00638900
BOOLEAN PROCEDURE LIBNAMES(A,B); REAL A,B;                              00639000
BEGIN REAL T;                                                           00639100
    A:=B:=GT1:=0;                                                       00639200
%                                                                       00639300
%                                                                       00639400
    IF SCAN AND IDENT THEN                                              00639500
    BEGIN T~ACCUM[0]; T.[6:6]~"/";                                      00639600
    IF SCAN AND LOCKIT THEN GT1~1 ELSE IF IDENT THEN LIBNAMES~TRUE;     00639700
          A~T; B~ JOBNUM;                                               00639800
    END                                                                 00639900
    ELSE LIBNAMES~ TRUE;                                                00640000
    END;                                                                00640100
PROCEDURE MESSAGEHANDLER;                                               00640200
    BEGIN                                                               00640300
    LABEL ERR1;                                                         00640400
%                                                                       00640500
    IF SCAN THEN IF IDENT THEN                                          00640600
    BEGIN INTEGER I; REAL R,S;                                          00640700
        PROCEDURE NOFILEPRESENT;                                        00640800
            BEGIN                                                       00640900
            FILL BUFFER[*] WITH "FILE NOT"," ON DISK";                  00641000
            FORMROW(3,0,BUFFER,0,16);                                   00641100
            END OF NOFILEPRESENT;                                       00641200
        PROCEDURE PRINTID(VARS); VALUE VARS; BOOLEAN VARS;              00641300
            BEGIN INTEGER I,J,K,L,M; ARRAY T[0:1]; BOOLEAN TOG;         00641400
            INTEGER NUM;                                                00641500
            J:=VARSIZE-1; M:=VARIABLES;                                 00641600
            FOR I:=0 STEP 1 UNTIL J DO                                  00641700
                BEGIN L:=CONTENTS(M,I,T); TOG:=GETFIELD(T,7,1)          00641800
                 =FUNCTION;                                             00641900
                IF NUM:=3|REAL(TOG AND VARS)+8+NUM GTR LINESIZE         00642000
                  THEN BEGIN TERPRINT; NUM:=3|REAL(TOG AND VARS)+8 END; 00642100
                IF VARS THEN                                            00642200
                    BEGIN FORMROW(0,1,T,0,7); L:=L+1;                   00642300
                    IF TOG THEN FORMWD(0,"3(F)   ");                    00642400
                    END ELSE                                            00642500
                IF TOG THEN BEGIN L:=L+1; FORMROW(0,1,T,0,7) END;       00642600
                END;                                                    00642700
            IF L=0 THEN FORMWD(3,"6 NULL.") ELSE TERPRINT               00642800
            END;                                                        00642900
    R:=ACCUM[0];                                                        00643000
    FOR I:=0 STEP 1 UNTIL MAXMESS DO                                    00643100
        IF R=MESSTAB[I] THEN                                            00643200
            BEGIN R:=I; I:=MAXMESS+1                                    00643300
            END;                                                        00643400
    IF I=MAXMESS+2 THEN                                                 00643500
        CASE R OF                                                       00643600
        BEGIN                                                           00643700
        %  ------- SAVE -------                                         00643800
        IF NOT LIBNAMES(R,S) THEN                                       00643900
            IF NOT LIBRARIAN(R,S) THEN BEGIN                            00644000
                SAVEWORKSPACE(R,S,GT1); %GT1 SET IN LIBNAMES            00644100
         GTA[0]~GTA[1]~0;TRANSFER(R,1,GTA,1,7);                         00644200
                IF(GT1~SEARCHORD(LIBRARY,GTA, I, 7)) NEQ 0 THEN         00644300
                BEGIN GTA[0]~GTA[1]~0;TRANSFER(R,1,GTA,1,7);            00644400
                      STOREORD(LIBRARY,GTA,I+(IF GT1=1 THEN -1 ELSE 1));00644500
                END; LIBSIZE~LIBSIZE+1;                                 00644600
        END                                                             00644700
            ELSE                                                        00644800
                BEGIN                                                   00644900
                FILL BUFFER[*] WITH "FILE ALR","EADY ON ",              00645000
                    "DISK    ";                                         00645100
                FORMROW(3,0,BUFFER,0,20);                               00645200
                END                                                     00645300
        ELSE GO ERR1;                                                   00645400
        %  ------- LOAD -------                                         00645500
        IF NOT LIBNAMES(R,S) AND R NEQ 0 THEN                           00645600
            IF LIBRARIAN(R,S) THEN                                      00645700
                BEGIN ARRAY A[0:1];                                     00645800
                LOADWORKSPACE(R,S,A);                                   00645900
                END                                                     00646000
            ELSE NOFILEPRESENT                                          00646100
        ELSE GO ERR1;                                                   00646200
        %  ------- DROP -------                                         00646300
        IF CURRENTMODE=CALCMODE THEN                                    00646400
        IF NOT LIBNAMES(R,S) THEN                                       00646500
            IF LIBRARIAN(R,S) THEN                                      00646600
            BEGIN FILE ELIF DISK (1,1);                                 00646700
            FILL ELIF WITH R,S; WRITE(ELIF[0]);                         00646800
            CLOSE(ELIF,PURGE)                                           00646900
           ;GTA[0]~GTA[1]~0;TRANSFER(R,1,GTA,1,7);                      00647000
            IF SEARCHORD(LIBRARY,GTA,I,7)=0 THEN DELETE1(LIBRARY,I);    00647100
            LIBSIZE~LIBSIZE-1;                                          00647200
            END                                                         00647300
            ELSE NOFILEPRESENT                                          00647400
        ELSE                                                            00647500
        IF NOT BOOLEAN(SUSPENSION)THEN PURGEWORKSPACE(WORKSPACE)        00647600
        ELSE GO ERR1 ELSE GO ERR1;                                      00647700
        % ------- COPY -------                                          00647800
        IF LIBNAMES(R,S) THEN                                           00647900
            IF LIBRARIAN(R,S) THEN                                      00648000
            LOADWORKSPACE(R,S,ACCUM)                                    00648100
        ELSE NOFILEPRESENT                                              00648200
        ELSE GO ERR1;                                                   00648300
                                                                        00648400
        %  --------  VARS -------                                       00648500
        PRINTID(TRUE);                                                  00648600
                                                                        00648700
        %------- FNS -------                                            00648800
        PRINTID(FALSE);                                                 00648900
        %-------- LOGGED ----------------                               00649000
;                                                                       00649100
        %-------- MSG --------                                          00649200
        ERRORMESS(SYNTAXERROR,LADDRESS,0);                              00649300
        %-----WIDTH (INTEGER) ---------------------------               00649400
        IF NOT SCAN THEN BEGIN NUMBERCON(LINESIZE, ACCUM);              00649500
                          FORMROW(3,0,ACCUM,2,ACOUNT); END              00649600
            ELSE IF NUMERIC AND I:=ACCUM[0] GTR 9 AND I LEQ 72          00649700
               THEN BEGIN TERPRINT; LINESIZE:=I; STOREPSR;              00649800
            END                                                         00649900
        %IF A NUMBER CONVERSION ERROR, RESULT WILL BE ZERO              00650000
            %AND WE"LL GET AN ERROR ANYWAY                              00650100
            ELSE GO TO ERR1;                                            00650200
        %-------- OPR --------                                          00650300
        ;                                                               00650400
        %------DIGITS (INTEGER) ------------------------                00650500
        IF NOT SCAN THEN BEGIN NUMBERCON(DIGITS,ACCUM);                 00650600
                               FORMROW(3,0,ACCUM,2,ACOUNT); END         00650700
            ELSE IF NUMERIC AND I:=ACCUM[0] GEQ 0 AND I LEQ 12          00650800
              AND ERR=0 THEN BEGIN DIGITS:=I; STOREPSR END              00650900
        ELSE GO TO ERR1;                                                00651000
        %-------- OFF --------                                          00651100
        BEGIN                                                           00651200
        IF SCAN THEN IF ACCUM[0]="7DISCAR" THEN                         00651300
            ELIMWORKSPACE(WORKSPACE) ELSE                               00651400
            GO TO ERR1;                                                 00651500
       FILL ACCUM[*] WITH "END OF R","UN      ";                        00651600
        FORMROW(3,MARGINSIZE,ACCUM,0,10);                               00651700
        CURRENTMODE:=CALCMODE;                                          00651800
       GT1:=CSTATION;                                                   00651900
       CSTATION:=GT1&0[CAPLOGGED]                                       00652000
      ;GO TO FINIS;                                                     00652100
        END;                                                            00652200
        %--------ORIGIN----------------------------------               00652300
        IF NOT SCAN THEN BEGIN NUMBERCON(ORIGIN,ACCUM);                 00652400
                              FORMROW(3,0,ACCUM,2,ACOUNT) END           00652500
        ELSE IF NUMERIC AND ERR=0 THEN BEGIN ORIGIN:=                   00652600
        I:=ACCUM[0]; STOREPSR END ELSE GO TO ERR1;                      00652700
        %--------SEED---------------------------------                  00652800
        IF NOT SCAN THEN BEGIN NUMBERCON(SEED,ACCUM);                   00652900
                               FORMROW(3,0,ACCUM,2,ACOUNT) END          00653000
        ELSE IF NUMERIC AND ERR=0 THEN BEGIN                            00653100
            SEED:=ABS(I:=ACCUM[0]);                                     00653200
            STOREPSR END ELSE GO TO ERR1;                               00653300
        %--------FUZZ------------------------------------               00653400
        IF NOT SCAN THEN BEGIN                                          00653500
            NUMBERCON(FUZZ,ACCUM);                                      00653600
            FORMROW(3,0,ACCUM,2,ACOUNT) END                             00653700
        ELSE IF NUMERIC AND ERR=0 THEN BEGIN FUZZ:=ABS(ACCUM[0]);       00653800
            STOREPSR END ELSE GO TO ERR1;                               00653900
        %------- SYN, NOSYN-------------------------------------        00654000
       NOSYNTAX:=0; NOSYNTAX:=1;                                        00654100
        %-----------------STORE-------------------------                00654200
        IF SYMBASE NEQ 0 THEN PROCESS(WRITEBACK);                       00654300
                                                                        00654400
                                                                        00654500
        %-----------------ABORT-------------------------                00654600
        BEGIN IF BOOLEAN(SUSPENSION) THEN                               00654700
            SP[0,0]:=0; NROWS:=-1;                                      00654800
%%%                                                                     00654900
        SUSPENSION:=0;                                                  00655000
        STOREPSR;                                                       00655100
        END;                                                            00655200
        %-----------------SI---------------------------------           00655300
        IF BOOLEAN(SUSPENSION) THEN                                     00655400
            BEGIN GT1:=0;                                               00655500
            PROCESS(LOOKATSTACK);                                       00655600
        END ELSE FORMWD(3,"6 NULL.");                                   00655700
        %------------------SIV------------------------------            00655800
        IF BOOLEAN(SUSPENSION) THEN                                     00655900
            BEGIN GT1:=1;                                               00656000
            PROCESS(LOOKATSTACK);                                       00656100
        END ELSE FORMWD(3,"6 NULL.");                                   00656200
        %------------------ERASE------------------------------          00656300
        IF CURRENTMODE=FUNCMODE OR BOOLEAN(SUSPENSION) THEN GO TO ERR1  00656400
        ELSE WHILE SCAN AND IDENT DO                                    00656500
            BEGIN % LOOK FOR THE INDENTIFIER NAME IN ACCUM              00656600
            TRANSFER(ACCUM,2,GTA,0,7);                                  00656700
            IF (IF VARIABLES=0 THEN FALSE ELSE                          00656800
                SEARCHORD(VARIABLES,GTA,GT1,7)=0) THEN                  00656900
                BEGIN  % FOUND A SYMBOL TABLE ENTRY MATCHING NAME       00657000
                DELETE1(VARIABLES,GT1); % REMOVE FROM SYMBOLTABLE       00657100
                IF VARSIZE:=VARSIZE-1=0 THEN VARIABLES:=0;              00657200
                COMMENT IF NOTHING IS IN THE UNIT IT IS DELETED;        00657300
                                                                        00657400
                % CHECK IF THERE IS MORE TO DELETE                      00657500
                IF GT1:=GETFIELD(GTA,7,1)=FUNCTION THEN                 00657600
                    BEGIN                                               00657700
                    RELEASEUNIT(GETFIELD(GTA,FPTF,FFL));                00657800
                    RELEASEUNIT(GETFIELD(GTA,FSQF,FFL));                00657900
                    END                                                 00658000
                ELSE IF GT1 GTR 0 THEN % MUST BE AN ARRAY               00658100
                RELEASEARRAY(GTA[1]);                                   00658200
                END ELSE % THERE IS NO SUCH VARIABLE                    00658300
                ERRORMESS(LABELERROR,LADDRESS,0);                       00658400
            END;  % OF TAKING CARE OF ERASE                             00658500
        %------------ ASSIGN --------------------------------           00658600
;                                                                       00658700
        %------------ DELETE ---------------------------------          00658800
;                                                                       00658900
        %------------- LIST ------------------------------------        00659000
;                                                                       00659100
        % -------------DEBUG --------------------------------           00659200
        IF SCAN AND IDENT THEN                                          00659300
            IF ACCUM[0]="6POLISH" THEN POLBUG:=ABS(POLBUG-1);           00659400
                                                                        00659500
        %----------------------------- FILES ----------------------     00659600
        IF LIBSIZE>1 THEN                                               00659700
        BEGIN FOR I~1 STEP 1 UNTIL LIBSIZE-1 DO                         00659800
              BEGIN R~CONTENTS(LIBRARY,I  ,ACCUM);                      00659900
                    FORMROW(0,1,ACCUM,2,6);                             00660000
              END; TERPRINT;                                            00660100
        END ELSE FORMWD(3,"6 NULL.");                                   00660200
        %------------------------ END OF CASES -----------------------  00660300
            END ELSE GO TO ERR1;                                        00660400
        IF CURRENTMODE=FUNCMODE THEN INDENT(-CURLINE);                  00660500
        END ELSE                                                        00660600
        IF QUOTE THEN EDITLINE ELSE                                     00660700
        ERR1:  ERRORMESS(SYNTAXERROR,0,0);                              00660800
        INDENT(0);                                                      00660900
        TERPRINT;                                                       00661000
    END;                                                                00661100
REAL PROCEDURE LINENUMBER(R); VALUE R; REAL R;                          00661200
    BEGIN                                                               00661300
    REAL STREAM PROCEDURE CON(R); VALUE R;                              00661400
        BEGIN SI:=LOC R; DI:=LOC CON; DS:=8DEC                          00661500
        END;                                                            00661600
    LINENUMBER:=CON( ENTIER( (R+.00005)|10000))                         00661700
    END;                                                                00661800
DEFINE DELIM="""#, ENDCHR="$"#;                                         00661900
BOOLEAN PROCEDURE WITHINALINE(COMMAND,OLD,NEW,CHAR,WORD);               00662000
  VALUE COMMAND,CHAR,WORD; INTEGER COMMAND,CHAR,WORD;                   00662100
  ARRAY OLD, NEW[0]; BEGIN                                              00662200
BOOLEAN STREAM PROCEDURE WITHINLINE(COMMAND,OLD,NEW,CHAR,WORD);         00662300
    VALUE COMMAND,CHAR,WORD;                                            00662400
    BEGIN                                                               00662500
    LOCAL OLDLINE,NEWLINE,F,BCHR;                                       00662600
    LOCAL N,M,T;                                                        00662700
    LOCAL X,Y,Z;                                                        00662800
    LABEL LOOKING,FOUND,BETWEEN,TAIL,FINISH,                            00662900
    OVER;                                                               00663000
    DI:=NEW; WORD(DS:=8LIT" ");                                         00663100
    SI:=LOC CHAR; DI:=LOC T; DI:=DI+1; DS:=7CHR;                        00663200
    SI:=COMMAND;                                                        00663300
    TALLY:=T; X:=TALLY; TALLY:=2; Y:=TALLY; TALLY:=32; Z:=TALLY;        00663400
    TALLY:=0;                                                           00663500
        IF SC!"~" THEN                                                  00663600
        BEGIN BCHR:=SI; SI:=OLD; OLDLINE:=SI;                           00663700
        DI:=NEW; NEWLINE:=DI; SI:=BCHR;                                 00663800
        63(IF SC=DELIM THEN JUMP OUT ELSE SI:=SI+1; TALLY               00663900
        :=TALLY+1); N:=TALLY;                                           00664000
        IF TOGGLE THEN                                                  00664100
            BEGIN                                                       00664200
            SI:=SI+1; TALLY:=0;                                         00664300
            63(IF SC=DELIM THEN TALLY:=0 ELSE                           00664400
                IF SC="~" THEN JUMP OUT ELSE TALLY:=TALLY+1; SI:=SI+1); 00664500
            IF TOGGLE THEN M:=TALLY;;                                   00664600
            DI:=OLDLINE; SI:=BCHR;                                      00664700
            2( X( Y( Z( CI:=CI+F;                                       00664800
            GO LOOKING; GO FOUND; GO BETWEEN; GO TAIL; GO FINISH;       00664900
LOOKING: %************ LOOKING FOR THE FIRST UNIQUE STRING**************00665000
        IF SC=DELIM THEN BEGIN SI:=SI+1; TALLY:=2; F:= TALLY ;          00665100
            DI:=NEWLINE; GO BETWEEN END ELSE                            00665200
        IF N SC=DC THEN BEGIN SI:=OLDLINE; SI:=SI+N; OLDLINE:=SI;       00665300
            DI:=NEWLINE; SI:=BCHR; TALLY:=1; F:=TALLY;                  00665400
            GO FOUND END ELSE                                           00665500
                BEGIN SI:=OLDLINE; DI:=NEWLINE; DS:=CHR; NEWLINE:=DI;   00665600
                OLDLINE:=SI; SI:=BCHR;   DI:=OLDLINE;                   00665700
                END; GO OVER;                                           00665800
FOUND:   %**************FOUND THE FIRST UNIQUE STRING ******************00665900
        IF SC=DELIM THEN BEGIN SI:=SI+1; TALLY:=2;                      00666000
            F:=TALLY; GO BETWEEN END ELSE                               00666100
        DS:=CHR;  GO OVER;                                              00666200
BETWEEN:  % ********** BETWEEN THEN // *********************************00666300
        IF SC=DELIM THEN BEGIN SI:=SI+1; NEWLINE:=DI; DI:=OLDLINE;      00666400
            TALLY:=3; F:=TALLY; GO TAIL END ELSE                        00666500
        IF SC="~" THEN BEGIN TALLY:=4; F:=TALLY;                        00666600
                SI:=OLDLINE; GO FINISH END ELSE                         00666700
        DS:=CHR; GO OVER;                                               00666800
TAIL:  % ******* THE TAIL END OF THE COMMAND ***************************00666900
        IF M SC=DC THEN BEGIN DI:=NEWLINE; SI:=OLDLINE; TALLY:=4;       00667000
                F:=TALLY; GO FINISH END ELSE                            00667100
            BEGIN SI:=SI-M; DI:=DI-M; DI:=DI+1; OLDLINE:=DI; END;       00667200
        GO OVER;                                                        00667300
FINISH:   % ********FINISH UP THE CHAR MOVE FROM OLD TO NEW*************00667400
            DS:=CHR; OVER:)));                                          00667500
            TALLY:=CHAR; X:=TALLY; TALLY:=1; Y:=TALLY;                  00667600
            Z:=TALLY);                                                  00667700
            SI:=NEW; DI:=OLD; DS:=WORD WDS; TALLY:=1;                   00667800
            WITHINLINE:=TALLY;                                          00667900
            END                                                         00668000
        END                                                             00668100
    END OF WITHINALINE;                                                 00668200
  WITHINALINE := WITHINLINE(COMMAND,OLD,NEW,CHAR,WORD);                 00668300
  END OF PHONY WITHINALINE;                                             00668400
PROCEDURE EDITLINE;                                                     00668500
    BEGIN ARRAY T[0:MAXBUFFSIZE];                                       00668600
    INITBUFF(T,BUFFSIZE);                                               00668700
    TRANSFER(OLDBUFFER,0,T,0,LENGTH(OLDBUFFER,TRUE));                   00668800
    IF WITHINALINE(ADDRESS,T,OLDBUFFER,BUFFSIZE|8,BUFFSIZE) THEN        00668900
        BEGIN MOVEWDS(OLDBUFFER,BUFFSIZE,BUFFER);                       00669000
                                                                        00669100
        IF SCAN AND RGTPAREN THEN                                       00669200
            ERRORMESS(SYNTAXERROR,LADDRESS,0) ELSE EDITOG:=1;           00669300
        END;                                                            00669400
                                                                        00669500
                                                                        00669600
        FORMROW(3,0,BUFFER,0,LENGTH(BUFFER,FALSE));                     00669700
    END;                                                                00669800
PROCEDURE CHECKSEQ(SEQ,L,INC); REAL SEQ,L,INC;                          00669900
    BEGIN                                                               00670000
    INTEGER I,J;                                                        00670100
    I:=L|10000 MOD 10000;                                               00670200
    FOR J:=-4 STEP 1 WHILE J LSS 0 AND I MOD 10=0 DO                    00670300
        I:=I/10;                                                        00670400
    INC:=10*J;                                                          00670500
    SEQ:=L;                                                             00670600
    END;                                                                00670700
PROCEDURE FUNCTIONHANDLER;                                              00670800
    BEGIN                                                               00670900
    LABEL ENDHANDLER;                                                   00671000
    OWN BOOLEAN EDITMODE;                                               00671100
    DEFINE FPT=FUNCPOINTER#,                                            00671200
        FSQ=FUNCSEQ#,                                                   00671300
        SEQ=CURLINE#,                                                   00671400
        INC=INCREMENT#,                                                 00671500
    MODE=SPECMODE#,                                                     00671600
        ENDDEFINES=#;                                                   00671700
    INTEGER STREAM PROCEDURE DELPRESENT(ADDR); VALUE ADDR;              00671800
        BEGIN LABEL L,FINIS;                                            00671900
        LOCAL Q;                                                        00672000
        DI:=LOC Q; DS:=RESET; DS:=5SET; DS:=2RESET; DS:=2SET;           00672100
        % LEFT-ARROW / QUESTION MARK                                    00672200
        SI:=ADDR;                                                       00672300
        L: DI:=LOC Q;                                                   00672400
        IF SC=DELCHR THEN                                               00672500
            BEGIN ADDR:=SI; SI:=LOC Q; DI:=ADDR; DS:=LIT" ";            00672600
            TALLY:=1; DELPRESENT:=TALLY; GO TO FINIS;                   00672700
            END;                                                        00672800
        IF SC=DC THEN GO TO FINIS; SI:=SI-1;                            00672900
        IF SC=DC THEN GO TO FINIS;                                      00673000
        GO TO L;                                                        00673100
        FINIS:                                                          00673200
        END;                                                            00673300
INTEGER PROCEDURE OLDLABCONFLICT(PT,S); VALUE PT,S;                     00673400
    INTEGER PT; REAL S;                                                 00673500
    IF PT NEQ 0 THEN                                                    00673600
        BEGIN INTEGER K; ARRAY L[0:1];                                  00673700
        ADDRESS:=ABSOLUTEADDRESS;                                       00673800
        WHILE LABELSCAN(L,0) AND ERR EQL 0 DO                           00673900
        IF SEARCHORD(PT,L,K,8)=0 THEN                                   00674000
            IF L[1] NEQ S THEN ERR:=24;                                 00674100
    OLDLABCONFLICT:=ERR                                                 00674200
    END;                                                                00674300
INTEGER PROCEDURE ELIMOLDLINE(PT,SQ,L); VALUE PT,SQ,L; INTEGER PT,      00674400
        SQ,L; FORWARD;                                                  00674500
INTEGER PROCEDURE STOREAWAY(PT,SQ,B,SEQ); VALUE SEQ;                    00674600
    INTEGER PT,SQ; REAL SEQ; ARRAY B[0]; FORWARD;                       00674700
    PROCEDURE BUFFERCLEAN(BUFFER,BUFFSIZE,ADDR); VALUE BUFFSIZE,        00674800
        ADDR; REAL ADDR; INTEGER BUFFSIZE; ARRAY BUFFER[0];             00674900
        FORWARD; COMMENT THIS IS A PHONEY DEAL, BUT I CAN"T             00675000
       DECLARE CLEANBUFFER FORWARD (MOVE IT UP HERE LATER);             00675100
PROCEDURE EDITDRIVER(PT,SQ,I,K); VALUE PT,SQ,I,K;                       00675200
    INTEGER PT,SQ,I,K;                                                  00675300
    BEGIN ARRAY C,LAB[0:1],OLD,NEW[0:MAXBUFFSIZE];                      00675400
    STREAM PROCEDURE BL(A);                                             00675500
        BEGIN DI:=A; MAXBUFFSIZE(DS:=8LIT" ") END;                      00675600
    DEFINE MOVE=MOVEWDS#;                                               00675700
    REAL T,SEQ; INTEGER A,B,L,M;                                        00675800
    T:=ADDRESS;                                                         00675900
    FOR A:=I STEP 1 WHILE A LEQ K AND EDITMODE DO                       00676000
        BEGIN B:=CONTENTS(PT,A,C); BL(OLD);                             00676100
        SEQ:=C[0];                                                      00676200
        B:=CONTENTS(SQ,C[1],OLD);                                       00676300
        IF EDITMODE:=WITHINALINE(T,OLD,NEW,BUFFSIZE|8,BUFFSIZE)         00676400
        THEN BEGIN MOVE(BUFFER,MAXBUFFSIZE+1,NEW);                      00676500
            MOVE(OLD,MAXBUFFSIZE,BUFFER);                               00676600
            IF EDITMODE:=ERR:=OLDLABCONFLICT(PT,C[0])=0 THEN            00676700
                BEGIN B:=ELIMOLDLINE(PT,SQ,C[1]);                       00676800
                DELTOG:=DELPRESENT(ADDRESS);                            00676900
                DELETE1(SQ,C[1]); DELETE1(PT,A+B); C[1]:=               00677000
                STORESEQ(SQ,BUFFER,LENGTH(BUFFER,FALSE));               00677100
                STOREORD(PT,C,A+B);                                     00677200
                RESCANLINE; L:=0; M:=1; LAB[1]:=C[0];                   00677300
                WHILE LABELSCAN(C,0) DO                                 00677400
                    BEGIN MOVEWDS(C,1,LAB);                             00677500
                    IF(IF FUNCSIZE=0 THEN TRUE ELSE L:=                 00677600
                    SEARCHORD(PT,C,M,8)NEQ 0) THEN                      00677700
                        BEGIN B:=B+1; FUNCSIZE:=FUNCSIZE+1;             00677800
                        STOREORD(PT,LAB,L+M-1)                          00677900
               END END;                                                 00678000
           A:=A+B; K:=K+B;                                              00678100
            COMMENT THE NEXT LINE CAUSE A SYSTEM CRASH AFTER THE EDIT;  00678200
            IF NOSYNTAX=0 THEN PROCESS(XEQUTE);                         00678300
           END END;                                                     00678400
       MOVE(NEW,MAXBUFFSIZE+1,BUFFER)                                   00678500
   END END;                                                             00678600
    PROCEDURE LISTLINE(PT,SQ,I); VALUE PT,SQ,I; INTEGER PT,SQ,I;        00678700
        BEGIN                                                           00678800
        GT1:=CONTENTS(PT,I,GTA);                                        00678900
        INDENT(GTA[0]);                                                 00679000
        GT1:=CONTENTS(SQ,GTA[1],BUFFER);                                00679100
        CHRCOUNT:=CHRCOUNT-1;                                           00679200
        FORMROW(1,0,BUFFER,0,GT1);                                      00679300
        END;                                                            00679400
INTEGER PROCEDURE DISPLAY(A,B,PT,SQ); VALUE A,B,PT,SQ;                  00679500
    INTEGER PT,SQ; REAL A,B;                                            00679600
    IF A LEQ B AND FUNCSIZE NEQ 0 THEN                                  00679700
        BEGIN                                                           00679800
        ARRAY C[0:1];                                                   00679900
        INTEGER I,J,K;                                                  00680000
        DEFINE CLEANBUFFER=BUFFERCLEAN#;                                00680100
        A:=LINENUMBER(A); B:=LINENUMBER(B);                             00680200
        C[0]:=A;                                                        00680300
        I:=SEARCHORD(PT,C,K,8);                                         00680400
        I:=( IF I=2 THEN IF K LSS FUNCSIZE-1 THEN K:=K+1 ELSE           00680500
              K ELSE K);                                                00680600
        IF A NEQ B THEN                                                 00680700
            BEGIN                                                       00680800
            C[0]:=B; B:=SEARCHORD(PT,C,K,8);                            00680900
            END;                                                        00681000
        IF EDITMODE THEN % MAY HAVE ONLY ONE LINE TO EDIT               00681100
            IF I=K THEN                                                 00681200
                IF A NEQ 0 THEN %NOT EDITING THE HEADER                 00681300
                    EDITDRIVER(PT,SQ,I,K)                               00681400
                ELSE %EDITING THE FUNCTION HEADER, FIX LATER.           00681500
                    ERR:=31                                             00681600
                ELSE %EDITING MORE THAN ONE LINE                        00681700
            BEGIN MODE:=EDITING;                                        00681800
                IF A=0 THEN I:=I+1;                                     00681900
            CLEANBUFFER(BUFFER,BUFFSIZE,ADDRESS);                       00682000
            MOVE(BUFFER,BUFFSIZE,OLDBUFFER);                            00682100
            LOWER:=I; UPPER:=K                                          00682200
            END                                                         00682300
        ELSE %NOT EDITING, MUST BE A LIST                               00682400
        BEGIN                                                           00682500
        FORMWD(3,"1      ");                                            00682600
        IF K=I THEN % LISTING A SINGLE LINE                             00682700
            BEGIN LISTLINE(PT,SQ,I);                                    00682800
            FORMWD(3,"1      ");                                        00682900
            END ELSE % LISTING A SET OF LINES                           00683000
            BEGIN MODE:=DISPLAYING;                                     00683100
            LOWER:=I; UPPER:=K;                                         00683200
            END;                                                        00683300
        END;                                                            00683400
        EOB:=1;                                                         00683500
        END ELSE DISPLAY:=20;                                           00683600
INTEGER PROCEDURE DELETE(A,B,PT,SQ); VALUE A,B;                         00683700
    INTEGER PT,SQ; REAL A,B;                                            00683800
    IF A LEQ B AND FUNCSIZE NEQ 0 AND A NEQ 0 THEN                      00683900
        BEGIN                                                           00684000
        INTEGER I,J,K,L;                                                00684100
        ARRAY C[0:1];                                                   00684200
        A:=LINENUMBER(B);                                               00684300
        B:=LINENUMBER(B);                                               00684400
        C[0]:=A;                                                        00684500
        IF SEARCHORD(PT,C,K,8)=2 THEN K:=K+1;                           00684600
        C[0]:=B;                                                        00684700
        IF SEARCHORD(PT,C,I,8)=1 THEN I:=I-1;                           00684800
        IF K GTR I OR I GEQ FUNCSIZE THEN DELETE:=21 ELSE               00684900
            BEGIN                                                       00685000
            FOR J:=K STEP 1 UNTIL I DO                                  00685100
                BEGIN A:=CONTENTS(PT,J,C);                              00685200
                L:=ELIMOLDLINE(PT,SQ,C[1]);                             00685300
                FUNCSIZE:=FUNCSIZE+L; I:=I+L; K:=K+L; J:=J+L;           00685400
                DELETE1(SQ,C[1])                                        00685500
                END;                                                    00685600
            FUNCSIZE:=FUNCSIZE-(I-K+1)                                  00685700
            ; EOB:=1;                                                   00685800
            DELETEN(PT,K,I);                                            00685900
        IF FUNCSIZE=0 THEN                                              00686000
             BEGIN                                                      00686100
            PT:=0; RELEASEUNIT(SQ); SQ:=0;                              00686200
            STOREPSR;                                                   00686300
            END;                                                        00686400
        END;                                                            00686500
        END ELSE DELETE:=22;                                            00686600
    INTEGER PROCEDURE ELIMOLDLINE(PT,SQ,L); VALUE PT,SQ,L;              00686700
    INTEGER PT,SQ,L;                                                    00686800
        BEGIN INTEGER K,J;                                              00686900
        REAL AD;                                                        00687000
        ARRAY T[0:MAXBUFFSIZE],LAB[0:1];                                00687100
         AD:=ADDRESS;                                                   00687200
        MOVEWDS(BUFFER,MAXBUFFSIZE+1,T);                                00687300
        INITBUFF(BUFFER,BUFFSIZE);                                      00687400
        K:=CONTENTS(SQ,L,BUFFER);                                       00687500
        RESCANLINE;                                                     00687600
        WHILE LABELSCAN(LAB,0) DO                                       00687700
            IF SEARCHORD(PT,LAB,K,8)=0 THEN                             00687800
            BEGIN DELETE1(PT,K); J:=J-1 END;                            00687900
        ADDRESS:=AD;                                                    00688000
        MOVEWDS(T,MAXBUFFSIZE+1,BUFFER);                                00688100
        ELIMOLDLINE:=J                                                  00688200
        END;                                                            00688300
INTEGER PROCEDURE STOREAWAY(PT,SQ,B,SEQ); VALUE SEQ;                    00688400
        INTEGER PT,SQ; REAL SEQ; ARRAY B[0];                            00688500
        BEGIN DEFINE BUFFER=B#;                                         00688600
        ARRAY C,LAB[0:1];                                               00688700
        INTEGER I,J,K,L;                                                00688800
        BOOLEAN TOG;                                                    00688900
        SEQ:=LINENUMBER(SEQ);                                           00689000
        C[0]:=SEQ;                                                      00689100
        IF TOG:=(PT=0 OR FUNCSIZE=0) THEN                               00689200
            BEGIN SEQUENTIAL(SQ:=NEXTUNIT); I:=0                        00689300
            END ELSE                                                    00689400
        IF J:=SEARCHORD(PT,C,I,8)=0 THEN                                00689500
            BEGIN                                                       00689600
            K:=ELIMOLDLINE(PT,SQ,C[1]);                                 00689700
            I:=I+K; FUNCSIZE:=FUNCSIZE+K;                               00689800
            DELETE1(PT,I);                                              00689900
            FUNCSIZE:=FUNCSIZE-1;                                       00690000
            DELETE1(SQ,C[1]);                                           00690100
            END ELSE                                                    00690200
        I:=I+J-1;                                                       00690300
        RESCANLINE;                                                     00690400
        DELTOG:=DELPRESENT(ADDRESS);                                    00690500
        K:=STORESEQ(SQ,BUFFER,LENGTH(BUFFER,TRUE));                     00690600
        LAB[1]:=SEQ; L:=0; J:=1;                                        00690700
        IF TOG THEN PT:=NEXTUNIT;                                       00690800
        WHILE LABELSCAN(C,0) DO                                         00690900
            BEGIN                                                       00691000
            MOVEWDS(C,1,LAB);                                           00691100
            IF (IF FUNCSIZE=0 THEN TRUE ELSE L:=                        00691200
                SEARCHORD(PT,C,J,8)NEQ 0 ) THEN                         00691300
                BEGIN I:=I+1; FUNCSIZE:=FUNCSIZE+1;                     00691400
                STOREORD(PT,LAB,L+J-1);                                 00691500
                END;                                                    00691600
            END;                                                        00691700
        C[1]:=K;                                                        00691800
        C[0]:=SEQ;                                                      00691900
        FUNCSIZE:=FUNCSIZE+1;                                           00692000
        STOREORD(PT,C,I);                                               00692100
        IF TOG THEN STOREPSR;                                           00692200
        EOB:=1;                                                         00692300
        END;                                                            00692400
    BOOLEAN PROCEDURE BOUND(PT); VALUE PT; INTEGER PT;                  00692500
    IF NOT(BOUND:=NUMERIC) THEN                                         00692600
        IF IDENT AND FUNCSIZE GTR 0 THEN                                00692700
        BEGIN ARRAY L[0:1]; INTEGER K;                                  00692800
        REAL T,U;                                                       00692900
        REAL STREAM PROCEDURE CON(A);                                   00693000
        VALUE A;                                                        00693100
            BEGIN SI:=LOC A; DI:=LOC CON; DS:=8OCT                      00693200
            END;                                                        00693300
        TRANSFER(ACCUM,2,L,1,7);                                        00693400
        IF BOUND:=SEARCHORD(PT,L,K,8)=0 THEN                            00693500
            BEGIN T:=ADDRESS;                                           00693600
            U:=CON(MAX(L[1],0))/10000; %ARGS AND RESULT ARE NEG         00693700
            IF SCAN AND PLUS OR MINUS THEN                              00693800
                BEGIN K:=(IF PLUS THEN 1 ELSE -1);                      00693900
                IF SCAN AND NUMERIC THEN                                00694000
                ACCUM[0]:=MAX(U+K|ACCUM[0],0) ELSE                      00694100
                    BEGIN ACCUM[0]:=U;                                  00694200
                    ADDRESS:=T;                                         00694300
                    END;                                                00694400
                END ELSE BEGIN ACCUM[0]:=U; ADDRESS:=T;                 00694500
                         END;                                           00694600
            EOB:=0;                                                     00694700
           END                                                          00694800
        END;                                                            00694900
                                                                        00695000
                                                                        00695100
    PROCEDURE FINISHUP;                                                 00695200
    BEGIN COMMENT GET HIM BACK TO CALCULATOR MODE;                      00695300
    IF FUNCPOINTER=0 THEN % HE DELETED EVERY THING                      00695400
        BEGIN TRANSFER(PSR,FSTART|8,GTA,0,8);                           00695500
        IF SEARCHORD(VARIABLES,GTA,GT1,7)=0 THEN                        00695600
            BEGIN DELETE1(VARIABLES,GT1);                               00695700
            IF VARSIZE:=VARSIZE-1=0 THEN VARIABLES:=0;                  00695800
            END ELSE SPOUT(9198260);                                    00695900
        END;                                                            00696000
    DELTOG:=CURRENTMODE:=CURLINE:=INCREMENT:=0;                         00696100
    STOREPSR;                                                           00696200
    END;                                                                00696300
                                                                        00696400
    LABEL SHORTCUT;                                                     00696500
    REAL L,U,TADD;                                                      00696600
    STREAM PROCEDURE CLEANBUFFER(BUFFER,BUFFSIZE,ADDR);                 00696700
    VALUE BUFFSIZE,ADDR;                                                00696800
    BEGIN LABEL L; LOCAL T,U,TSI,TDI;                                   00696900
    SI:=ADDR; SI:=SI-1; L:                                              00697000
    IF SC NEQ "]" THEN                                                  00697100
        BEGIN SI:=SI-1; GO TO L END;                                    00697200
    SI:=SI+1; DI:=LOC T; SKIP 2 DB; DS:=2SET;                           00697300
    DI:=BUFFER; TDI:=DI; DI:=LOC T; TSI:=SI;                            00697400
    BUFFSIZE(8(IF TOGGLE THEN DS:=LIT" " ELSE                           00697500
        IF SC=DC THEN                                                   00697600
            BEGIN SI:=LOC U; DI:=TDI; DS:=LIT" "                        00697700
            END ELSE                                                    00697800
        BEGIN TSI:=SI; SI:=SI-1; DI:=LOC U; DS:=CHR;                    00697900
        DI:=TDI; SI:=LOC U; DS:=CHR; TDI:=DI; DI:=LOC T;                00698000
        SI:=TSI;                                                        00698100
        END))                                                           00698200
    END;                                                                00698300
    PROCEDURE BUFFERCLEAN(BUFFER,BUFFSIZE,ADDR); VALUE BUFFSIZE,        00698400
        ADDR; REAL ADDR; INTEGER BUFFSIZE; ARRAY BUFFER[0];             00698500
        CLEANBUFFER(BUFFER,BUFFSIZE,ADDR);                              00698600
COMMENT DETERMINE WHETHER OR NOT WE CAME FROM CALCULATOR MODE;          00698700
    ERR:=0;                                                             00698800
    IF BOOLEAN(SUSPENSION) THEN GO TO ENDHANDLER;                       00698900
    BEGIN DEFINE STARTSEGMENT=#; %///////////////////////////////       00699000
    IF GT1:=CURRENTMODE=CALCMODE THEN % TAKE CARE OF HEADER.            00699100
        BEGIN ARRAY A[0:MAXHEADERARGS];                                 00699200
    LABEL HEADERSTORE,FORGETITFELLA;                                    00699300
        IF FUNCTIONHEADER(A,TADD) THEN %HEADER OK                       00699400
            IF VARIABLES NEQ 0 THEN % MAY BE A RE-DEFINITION            00699500
                BEGIN COMMENT GET THE FUNCTION NAME;                    00699600
                TRANSFER(A,1,GTA,0,7);                                  00699700
                IF GT2:=SEARCHORD(VARIABLES,GTA,GT3,7)=0 THEN           00699800
                    COMMENT RE-DEFINING A FUNCTION.  MAKE SURE NULL ;   00699900
                    IF GETFIELD(GTA,7,1)=FUNCTION AND                   00700000
                    (A[1]+A[2]+A[3])=0  THEN %NULL HEADER--OK           00700100
%--------------------SET UP FOR CONTINUATION OF DEFINITION------        00700200
    BEGIN                                                               00700300
    FUNCPOINTER:=GETFIELD(GTA,FPTF,FFL);                                00700400
    FUNCSEQ:=GETFIELD(GTA,FSQF,FFL);                                    00700500
    GT3:=CURLINE:=TOPLINE(FPT);                                         00700600
    CHECKSEQ(CURLINE,GT3,INC); %SET THE INCREMENT                       00700700
    COMMENT THE CURRENT LINE IS SET TO THE LAST LINE OF THE             00700800
    FUNCTION;                                                           00700900
    FUNCSIZE:=SIZE(FPT);                                                00701000
    CURLINE:=CURLINE+INC;                                               00701100
    DELTOG:=DELPRESENT(ADDRESS);                                        00701200
    END ELSE                                                            00701300
%------------------REDEFINING THE HEADER OF A DEFINED FUNCTION----      00701400
                    GO TO FORGETITFELLA                                 00701500
                    ELSE                                                00701600
%--------------------NAME NOT FOUND IN DIRECTORY, SET UP                00701700
HEADERSTORE:                                                            00701800
    BEGIN COMMENT GET THE HEADER TO INSERT AT LINE 0;                   00701900
    ARRAY OLDBUFFER[0:MAXBUFFSIZE];                                     00702000
    INTEGER L,U,F,K,J;                                                  00702100
    INTEGER A1,A2;                                                      00702200
        COMMENT FUNCTIONHEADER RETURN AN ARRAY WITH THE                 00702300
        FOLLOWING VALUES:                                               00702400
        A[0]   = FUNCTION NAME , I.E., 0AAAAAAA                         00702500
        A[1]   = 0 IF NO RESULT, 1 IF A RESULT IS RETURNED BY THE       00702600
                 FUNCTION.                                              00702700
        A[2]   = NUMBER OF ARGUMENTS TO THE FUNCTION.                   00702800
        A[3]   = NUMBER OF LOCALS + RESULT +ARGUMENTS.                  00702900
        A[4]....A[N]   ARE ALL OF THE LOCALS, RESULT, AND ARGUMENTS.    00703000
        THE RESULT IS FIRST, THEN THE SECOND ARGUMENT, THEN             00703100
        THE FIRST ARGUMENT, FOLLOWED BY THE LOCALS.  ALL                00703200
        ARE OF THE FORM 0XXXXXXX;                                       00703300
        U:=(A1:=A[1])+(A2:=A[2])+3;                                     00703400
        FOR L:=4 STEP 1 UNTIL U DO %LOOK FOR DUPLICATES AMONG           00703500
            FOR K:=L+1 STEP 1 UNTIL U DO %THE RESULT/ARGUMENT SET       00703600
                IF A[L]=A[K] THEN GO TO FORGETITFELLA;                  00703700
    SEQUENTIAL(FUNCSEQ:=NEXTUNIT);                                      00703800
    SETFIELD(GTA,8,8,STORESEQ(FUNCSEQ,OLDBUFFER,                        00703900
            HEADER(TADD.[1:23],TADD.[24:24],OLDBUFFER)));               00704000
    SETFIELD(GTA,0,8,0);                                                00704100
    STOREORD(F:=FUNCPOINTER:=NEXTUNIT,GTA,0);                           00704200
    SETFIELD(GTA,0,8,0); SETFIELD(GTA,8,8,0);                           00704300
    FOR L:=4 STEP 1 UNTIL U DO                                          00704400
        BEGIN GTA[0]:=A[L]; IF A1 GTR 0 THEN                            00704500
            BEGIN A1:=0; GTA[1]:=-1; %"RESULT" SET TO -1                00704600
            STOREORD(F,GTA,0);                                          00704700
            END ELSE %LOOKING AT THE ARGUMENTS                          00704800
            BEGIN K:=SEARCHORD(F,GTA,J,8);                              00704900
            GTA[1]:=A2-4; A2:=A2-1; GTA[0]:=A[L];                       00705000
            STOREORD(F,GTA,J+K-1);                                      00705100
        END END;                                                        00705200
    FUNCSIZE:=U:=U-2; U:=A[3]-U+L;                                      00705300
    FOR L:=L STEP 1 UNTIL U DO %GET LOCALS INTO THE LABEL TABLE         00705400
        BEGIN GTA[0]:=A[L];                                             00705500
        IF K:=SEARCHORD(F,GTA,J,8) NEQ 0 THEN %NOT YET IN TABLE.        00705600
            BEGIN GTA[0]:=A[L]; GTA[1]:=0;                              00705700
            STOREORD(F,GTA,J+K-1);                                      00705800
            FUNCSIZE:=FUNCSIZE+1                                        00705900
            END;                                                        00706000
        END;                                                            00706100
        GTA[1]:=0&ENTIER(A[1])[CRETURN]&ENTIER(A[2])[CNUMBERARGS];      00706200
    CURLINE:=INCREMENT:=1;                                              00706300
    DELTOG:=0;                                                          00706400
    COMMENT GET THE "TYPE" OF THE FUNCTION LATER WHEN THERE             00706500
    IS A PLACE FOR IT.  THE TYPE IS EITHER 1 (FUNCTION CALL), OR        00706600
    0 (SUBROUTINE CALL);                                                00706700
    END;                                                                00706800
%--------------------------------------------------------               00706900
                END ELSE % VARAIBLES=0, MAKE UP A DIRECTORY             00707000
                BEGIN GT3:=0; GT2:=1; GO TO HEADERSTORE                 00707100
                END                                                     00707200
            ELSE % HEADER SYNTAX IS BAD                                 00707300
            GO TO ENDHANDLER;                                           00707400
    COMMENT WE MAKE IT TO HERE IF ALL IS WELL ABOVE;                    00707500
        IF GT2 NEQ 0 THEN %NAME NOT FOUND IN DIRECTORY;                 00707600
            BEGIN                                                       00707700
            TRANSFER(A,1,GTA,0,7); %GET FUNCTION NAME                   00707800
            SETFIELD(GTA,7,1,FUNCTION);                                 00707900
            SETFIELD(GTA,FPTF,FFL,FUNCPOINTER);                         00708000
            SETFIELD(GTA,FSQF,FFL,FUNCSEQ);                             00708100
            IF VARIABLES=0 THEN                                         00708200
                VARIABLES:=NEXTUNIT;                                    00708300
            STOREORD(VARIABLES,GTA,GT3+GT2-1);                          00708400
            VARSIZE:=VARSIZE+1;                                         00708500
            END;                                                        00708600
            CURRENTMODE:=FUNCMODE;                                      00708700
            TRANSFER(GTA,0,PSR,FSTART|8,8);                             00708800
            STOREPSR;                                                   00708900
        IF SCAN THEN GO TO SHORTCUT;                                    00709000
        IF FALSE THEN                                                   00709100
        FORGETITFELLA: ERRORMESS(ERR:=LABELERROR,TADD.[1:23],0);        00709200
        END ELSE % WE ARE IN FUNCTION DEFINITION MODE                   00709300
    IF GT1:=MODE NEQ 0 THEN % A SPECIAL FUNCTION SUCH AS DISPLAY OR EDIT00709400
        BEGIN L:=LOWER;                                                 00709500
        IF GT1=DISPLAYING THEN                                          00709600
            LISTLINE(FPT,FSQ,L) ELSE                                    00709700
        IF GT1=EDITING THEN                                             00709800
            BEGIN INITBUFF(BUFFER,BUFFSIZE);                            00709900
            MOVE(OLDBUFFER,BUFFSIZE,BUFFER);                            00710000
            EDITMODE:=TRUE; ADDRESS:=ABSOLUTEADDRESS;                   00710100
            EDITDRIVER(FPT,FSQ,L,L)                                     00710200
            ;IF NOT EDITMODE THEN                                       00710300
                BEGIN MODE:=0; ERR:=30                                  00710400
                END;                                                    00710500
        END ELSE                                                        00710600
        IF GT1=RESEQUENCING THEN                                        00710700
            IF GT1:=L LEQ UPPER THEN                                    00710800
                BEGIN GT2:=CONTENTS(FPT,L,GTA);                         00710900
                GT3:=GTA[0]:=LINENUMBER(CURLINE);                       00711000
                DELETE1(FPT,L);                                         00711100
                STOREORD(FPT,GTA,L);                                    00711200
                CURLINE:=CURLINE+INCREMENT;                             00711300
                GT2:=CONTENTS(FSQ,GTA[1],BUFFER); RESCANLINE;           00711400
                WHILE (IF ERR NEQ 0 THEN FALSE ELSE                     00711500
                    LABELSCAN(GTA,0)) DO                                00711600
                    IF GT1:=SEARCHORD(FPT,GTA,GT2,8)=0 THEN             00711700
                    BEGIN GTA[1]:=GT3; DELETE1(FPT,GT2);                00711800
                    STOREORD(FPT,GTA,GT2)                               00711900
                    END ELSE ERR:=16                                    00712000
                END                                                     00712100
            ELSE MODE:=0;                                               00712200
        LOWER:=L+1;                                                     00712300
        IF LOWER GTR UPPER THEN                                         00712400
            BEGIN IF MODE=DISPLAYING THEN                               00712500
            FORMWD(3,"1      ");                                        00712600
            MODE:=0;                                                    00712700
            END;                                                        00712800
        GO TO ENDHANDLER                                                00712900
        END;                                                            00713000
    END ; % OF BLOCK STARTED ON LINE 9225115 //////////////////         00713100
                                                                        00713200
                                                                        00713300
                                                                        00713400
    IF ERR=0 AND EOB=0 THEN                                             00713500
                                                                        00713600
SHORTCUT:  BEGIN LABEL RGTBRACK,DELOPTION; %//////////////////////////  00713700
   IF DELV THEN FINISHUP ELSE                                           00713800
      IF LFTBRACKET THEN                                                00713900
        BEGIN                                                           00714000
        IF SCAN THEN                                                    00714100
           IF BOUND(FPT) THEN                                           00714200
            BEGIN L:=ACCUM[0];                                          00714300
            IF SCAN THEN                                                00714400
               IF QUADV OR EDITMODE:=(QUOTEQUAD) THEN                   00714500
                IF SCAN THEN                                            00714600
                   IF BOUND(FPT) THEN                                   00714700
                    BEGIN U:=ACCUM[0];                                  00714800
RGTBRACK:                                                               00714900
                    IF SCAN AND RGTBRACKET THEN                         00715000
                    IF(IF EDITMODE THEN FALSE ELSE SCAN) THEN           00715100
                        IF DELV THEN                                    00715200
                          BEGIN ERR:=DISPLAY(L,U,FPT,FSQ);              00715300
                          DELTOG:=1;                                    00715400
                          END                                           00715500
                        ELSE ERR:=1                                     00715600
                      ELSE ERR:=DISPLAY(L,U,FPT,FSQ)                    00715700
                    ELSE ERR:=2                                         00715800
                    END                                                 00715900
                  ELSE                                                  00716000
                  IF RGTBRACKET THEN                                    00716100
                  IF(IF EDITMODE THEN FALSE ELSE SCAN) THEN             00716200
                      IF DELV THEN                                      00716300
                        BEGIN ERR:=DISPLAY(L,L,FPT,FSQ);                00716400
                        DELTOG:=1;                                      00716500
                        END                                             00716600
                      ELSE ERR:=3                                       00716700
                    ELSE ERR:=DISPLAY(L,L,FPT,FSQ)                      00716800
                  ELSE ERR:=4                                           00716900
                ELSE ERR:=5                                             00717000
              ELSE                                                      00717100
              IF RGTBRACKET THEN                                        00717200
                BEGIN TADD:=ADDRESS;                                    00717300
                IF SCAN THEN                                            00717400
                  IF IDENT AND ACCUM[0]="6DELETE" THEN                  00717500
                    IF SCAN THEN                                        00717600
                      IF LFTBRACKET THEN                                00717700
DELOPTION:                                                              00717800
                        IF SCAN AND BOUND(FPT) THEN                     00717900
                          BEGIN U:=ACCUM[0];                            00718000
                          IF SCAN AND RGTBRACKET THEN                   00718100
                            IF SCAN THEN                                00718200
                              IF DELV THEN                              00718300
                                BEGIN ERR:=DELETE(L,U,FPT,FSQ);         00718400
                                FINISHUP                                00718500
                                END                                     00718600
                              ELSE ERR:=6                               00718700
                            ELSE ERR:=DELETE(L,U,FPT,FSQ)               00718800
                          ELSE ERR:=7                                   00718900
                          END                                           00719000
                        ELSE ERR:=8                                     00719100
                      ELSE                                              00719200
                      IF DELV THEN                                      00719300
                        BEGIN ERR:=DELETE(L,L,FPT,FSQ);                 00719400
                        FINISHUP                                        00719500
                        END                                             00719600
                      ELSE ERR:=9                                       00719700
                    ELSE ERR:=DELETE(L,L,FPT,FSQ)                       00719800
                  ELSE                                                  00719900
                  IF LFTBRACKET THEN GO TO DELOPTION ELSE               00720000
                    BEGIN CHECKSEQ(SEQ,L,INC);                          00720100
                    CLEANBUFFER(BUFFER,BUFFSIZE,TADD);                  00720200
                    ADDRESS:=ABSADDR(BUFFER); ITEMCOUNT:=0;             00720300
                    IF SCAN THEN GO TO SHORTCUT                         00720400
                    END                                                 00720500
                ELSE ERR:=DELETE(L,L,FPT,FSQ)                           00720600
               END                                                      00720700
              ELSE ERR:=10                                              00720800
            ELSE ERR:=11                                                00720900
              END ELSE                                                  00721000
            IF QUADV OR EDITMODE:=(QUOTEQUAD) THEN                      00721100
                BEGIN L:=0; U:=9999.9999; GO TO RGTBRACK                00721200
            END ELSE                                                    00721300
        IF IOTA THEN                                                    00721400
            IF SCAN AND RGTBRACKET AND FPT NEQ 0 THEN                   00721500
            BEGIN IF SCAN THEN                                          00721600
                IF DELV THEN DELTOG:=1 ELSE ERR:=15;                    00721700
            IF ERR = 0 THEN                                             00721800
                BEGIN MODE:=RESEQUENCING; CURLINE:=INCREMENT:=1;        00721900
                SETFIELD(GTA,0,8,0);                                    00722000
                GT1:=SEARCHORD(FPT,GTA,GT2,8);                          00722100
                LOWER:=GT2+1; UPPER:=FUNCSIZE-1;                        00722200
                END                                                     00722300
            END                                                         00722400
    ELSE ERR:=14                                                        00722500
          ELSE ERR:=12                                                  00722600
        ELSE ERR:=13                                                    00722700
        END                                                             00722800
      ELSE                                                              00722900
        IF CURLINE=0 THEN %CHANGING HEADER                              00723000
        ERR:=26 ELSE                                                    00723100
      IF ERR:=OLDLABCONFLICT(FPT,LINENUMBER(SEQ))=0 THEN                00723200
        BEGIN                                                           00723300
       IF NOSYNTAX=0 THEN PROCESS(XEQUTE);                              00723400
        IF ERR:=STOREAWAY(FPT,FSQ,BUFFER,SEQ)=0 THEN SEQ:=SEQ+INC;      00723500
        END;                                                            00723600
        IF ERR NEQ 0 THEN                                               00723700
    BEGIN FORMWD(2,"5ERROR ");                                          00723800
    NUMBERCON(ERR,ACCUM); ERR:=0;                                       00723900
    EOB:=1;                                                             00724000
    FORMROW(1,1,ACCUM,2,ACCUM[0].[1:11]);                               00724100
    END;                                                                00724200
  END; %OF BLOCK STARTED ON LINE 9238000 //////////////////////         00724300
    ENDHANDLER:                                                         00724400
        IF BOOLEAN(SUSPENSION) THEN BEGIN                               00724500
            FILL ACCUM[*] WITH "ABORT SU", "SP. FNS.";                  00724600
            FORMROW(3,0,ACCUM,0,16);  INDENT(0); TERPRINT;              00724700
            END ELSE                                                    00724800
        IF MODE=0 THEN                                                  00724900
        BEGIN                                                           00725000
        IF BOOLEAN(DELTOG) THEN FINISHUP;                               00725100
        INDENT(-CURLINE); TERPRINT;                                     00725200
        END;                                                            00725300
                                                                        00725400
    END;                                                                00725500
    EXPOVR:=FAULTL; INTOVR:=FAULTL; INDEXF:=FAULTL;                     00725600
    FLAG:=FAULTL; ZERO:=FAULTL;                                         00725700
INITIALIZETABLE;                                                        00725800
TRYAGAIN:                                                               00725900
    IF FALSE THEN %ENTERS WITH A FAULT.                                 00726000
    FAULTL:                                                             00726100
        BEGIN SPOUT(09334300); %SEND MESSAGE TO SPO                     00726200
                                                                        00726300
            BEGIN CSTATION.APLOGGED:=0; CSTATION.APLHEADING:=0          00726400
            END                                                         00726500
        END;                                                            00726600
    APLMONITOR;                                                         00726700
ENDOFJOB:                                                               00726800
                                                                        00726900
    FINIS:                                                              00727000
    WRAPUP;                                                             00727100
                                                                        00727200
END.                                                                    00727300
