Personal tools
You are here: Home Projects LISP Utah REDUCE 2 and Standard LISP for Burroughs B6700 INCLUDE/ALGOL.alg_m is the portion of the Standard LISP interpreter/runtime that is written in Burroughs ALGOL.
Document Actions

INCLUDE/ALGOL.alg_m is the portion of the Standard LISP interpreter/runtime that is written in Burroughs ALGOL.

by Paul McJones last modified 2022-10-17 10:21

INCLUDE/ALGOL.alg_m is the portion of the Standard LISP interpreter/runtime that is written in Burroughs ALGOL.

Click here to get the file

Size 396.5 kB - File type text/plain

File contents

 % ADDS MODULAR ARITHMETIC FUNCTIONS                                    00000003          
 % ADDS ARBITRARY LENGTH ARITHMETIC                                     00000004          
 % CLEANS UP MACRO STRUCTURE                                            00000005          
 % IMPLEMENTS A TRACE BACK                                              00000006          
 % CHANGES DEFINITIONS OF PSEUDO REGISTERS.                             00000007          
 % SOME IMPROVEMENTS TO GARBAGE COLLECTION                              00000008          
 % ADDS ?HI 1 AS A JERK BACK TO COMMAND LEVEL                           00000009          
 % CHANGES SPREAD, LINK TO $APPLY                                       00000010          
                                                                        00000099          
%=====================================================================  00002800          
%                     STANDARD LISP                                  |  00002810          
%                                                                    |  00002820          
% THE FOLLOWING "TWINKLE-BOX" LIGHTS HAVE MEANINGS:                  |  00002830          
% 255 - SEARCHING THE STRING AREA FOR AN ENTRY.                      |  00002840          
% 254 - SYMBOL TABLE SEARCH.                                         |  00002850          
% 253 - INITIALIZING THE SYMBOL TABLE.                               |  00002860          
% 252 - INITIALIZING THE STRING SPACE.                               |  00002870          
% 251 - INITIALIZING THE PAIR SPACE.                                 |  00002880          
% 249 - LAMBDA BINDING TAKING PLACE.                                 |  00002890          
% 248 - SEARCH STACK FOR LAMBDA VARIABLE.                            |  00002900          
% 247 - SEARCH FOR A LABEL AND ITS BINDING.                          |  00002910          
% 246 - CONS.                                                        |  00002920          
%                                                                    |  00002930          
% IN ADDITION:                                                       |  00002940          
% 0 - 80   P SPACE PAGE REFERENCE IN CAR, CDR ETC.                   |  00002950          
% 96 - *   T SPACE, STACK TOP.                                       |  00002960          
%=====================================================================  00002970          
                                                                        00003000          
                                                                        00003100          
                                                                        00003200          
                                                                        00003300          
LABEL THU;                                                              00003400          
                                                                        00003500          
DEFINE                                                                  00003600          
       FZ         = 20#,                %FIELD SIZE                     00003700          
       TZ         = 19#,                %TAG SIZE                       00003800          
       CZ         = 39#,                %CELL SIZE (FZ+TZ=CZ)           00003900          
       DZ         = 10#,                %DECIMAL SIZE FOR BIG NUMBERS   00003910          
       FIELD      = [FZ-1:FZ]#,         %FIELD PART OF A CELL.          00004000          
       TAG        = [CZ-1:TZ]#,         %TAG PART OF CELL.              00004100          
       CELL       = [CZ-1:CZ]#,         %CELL                           00004200          
       IDCELL     = [FZ:FZ+1]#,         %FIELD PLUS INTERNED BIT        00004300          
       SHIFTUP    = [7:48]#,            %SHIFTS LOW ORDER BYTE TO HIGH  00004400          
       BUCKF      = [17:8]#,            %BUCKET NUMBER FOR STRINGS      00004500          
       SLOCF      = [9:10]#,            %LOCATION OF STRING IN STRING DE00004600          
       LETERF     = [9:8]#,             %HIGH ORDER 8 BITS OF SLOCF     00004700          
       SPGARBF    = [15:1]#,            %GARBAGE COLLECT BIT FOR STRINGS00004800          
       FREEF      = [14:1]#,            %MARKS EMPTY SLOT FOR STRINGS   00004900          
       ISPPTRF    = [13:14]#,           %BACK PNTR FROM STRINGS TO ISP  00005000          
       QSPPTR     = [47:13]#,           %BACK PNTR TO QSPACE            00005100          
                                                                        00005200          
%               BITS IN TAG FIELD.                                      00005300          
       IDTAG      = 1#,                 %IDENTIFIER                     00005400          
       STRINGTAG  = 2#,                 %STRING                         00005500          
       VECTORTAG  = 4#,                 %VECTOR                         00005600          
       FUNCTTAG   = 8#,                 %FUNCTION-POINTER               00005700          
       BIGTAG     =16#,                 %TAG FOR BIG NUMBERS            00005710          
       MAXFIELDV  = 2**FZ-1#,           %SPECIAL USED AS MARKER IN GC   00005800          
                                                                        00005900          
%               GLOBAL MAXIMA                                           00006000          
       ISPMAX     = 8192#,              %I SPACE SIZE.                  00006100          
       SSPBSZE    = 1024#,              %BUCKET SIZE (IN BYTES).        00006200          
       SSPHBUCKETS=   79#,              %WHERE OVERFLOW BUCKETS START.  00006300          
       SSPBMAX    =  160#,              %TOTAL NO. OF BUCKETS.          00006400          
       PAGESIZE   =  256#,              %PAGE SIZE IN P SPACE           00006600          
       PPAGEMAX   =  256#,              %NO OF PAGES IN P SPACE.        00006700          
       PSPMAX     = PAGESIZE*PPAGEMAX#, %P SPACE SIZE.                  00006800          
       VSPMAX     = 4096#,              %V SPACE SIZE.                  00006900          
       QSPMAX     = 6144#,              %Q SPACE SIZE.                  00007000          
       BSPMAX     = 2048#,              %B SPACE SIZE.                  00007100          
       FMAX       =    9#,              %MAXIMUM NUMBER OF FILES.       00007200          
       INSZE      =   80#,              %INPUT BUFFER SIZE.             00007300          
       GLOBLENGTH =   60#,              %NUMBER OF GLOBALS FOR GC.      00007400          
       PRIMNUM    =  120#,              %NUMBER OF PRIMATIVES           00007500          
                                                                        00007600          
%              USEFUL MACROS                                            00007700          
       ZCALL(FN)     = XCALL((FN).FIELD)#,                              00007900          
       ZTRACT(X)     = (X+ZERO)#,                                       00008000          
       ZEXTEND(X)    = (X-ZERO)#,                                       00008010          
       ZEROLIT       = (3*2**(CZ-3))#,                                  00008110          
       BASE          = 10**DZ#,                                         00008120          
       BM1           = (10**DZ-1+ZEROLIT)#,                             00008130          
       MINIMUM       = 2**(CZ-2)#,                                      00008140          
       NUMB[N]       = (N+ZEROLIT)#,                                    00008150          
       MNULL(X)      = CT(X,84) = NIL#,                                 00008200          
       MGARBAGEP(X)  = BOOLEAN(X).[CZ-1:1]#,                            00008300          
       MINTEGERP(X)  = (X).TAG >= BIGTAG#,                              00008400          
       MNUMBERP(X)   = CT(X,87).TAG >= BIGTAG#,                         00008500          
       BIGP(X)       = (X).TAG = BIGTAG#,                               00008510          
       SMALLP(X)     = BOOLEAN(X).[CZ-2:1]#,                            00008520          
       OVERFLOWP(X)  = (X).[44:47-CZ] NEQ 1#,                %PPDMTL19  00008530          
       MVECTORP(X)   = CT(X,59).TAG = VECTORTAG#,                       00008600          
       MSTRINGP(X)   = CT(X,89).TAG = STRINGTAG#,                       00008700          
       MCODEP(X)     = CT(X,85).TAG = FUNCTTAG#,                        00008800          
       MIDP(X)       = CT(X,86).TAG = IDTAG#,                           00008900          
       MCONSTANTP(X) = CT(X,58).[CZ-2:TZ-2] NEQ 0#,                     00009000          
       STRINGIZE(X)  = (X) & STRINGTAG [47:48-FZ]#,                     00009200          
       MPAIRP(X)     = CT(X,88).TAG = 0#,                               00009300          
       MATOM(X)      = CT(X,79).TAG NEQ 0#,                             00009400          
       MINTERNED(X)  = BOOLEAN(X).[FZ:1]#,                              00009500          
       MGLOBALP(X)   = BOOLEAN(ISPPNAME[(X).FIELD]).[FZ+1:1]#,          00009600          
       MFLUIDP(X)    = BOOLEAN(ISPPNAME[(X).FIELD]).[FZ+2:1]#,          00009700          
       MSIMPLE(X)    = ((X).TAG NEQ 0 AND (X).TAG NEQ VECTORTAG AND     00009800          
                                      (X).TAG NEQ BIGTAG)#,             00009900          
       RPUSH(X)      = BEGIN TSP[SP]:=X; SP:=SP+1 END#,                 00010000          
       RPOP          = TSP[SP:=SP-1]#,                                  00010100          
       IGNORE(X)     = (REAL(BOOLEAN(X) AND BOOLEAN(IGNORABLES)) NEQ 0  00010110          
                               OR X=NIL)#,                              00010120          
       CHECKSTACK(S) = IF (S)+TSPPTR>=TSPMAX THEN EXPANDSTACK#,         00010200          
       ERRORID       = (NIL+3)#,                                        00010300          
       BRANDNEW      = ((4"FFFF").ISPPTRF)#,                            00010400          
       TRUTH(X)      = (REAL(X)+NIL)#;                                  00010500          
                                                                        00010600          
%                OTHER USEFUL MACROS                                    00010700          
                                                                        00010800          
                                                                        00010900          
DEFINE                                                                  00011000          
 ZLITER(CHR)       = (CHR IN LETTERS)#,                                 00011100          
 ZDIGIT(CHR)       = (CHR>="0" AND CHR <="9")#,                         00011200          
 XEQUAL            = ARG1 := TRUTH(ZEQUAL(ARG1,ARG2))#,                 00011300          
 VCODEP(R)         = TRUTH(MCODEP(R))#,                                 00011400          
 VIDP(R)           = TRUTH(MIDP(R))#,                                   00011500          
 VNUMBERP(R)       = TRUTH(MNUMBERP(R))#,                               00011600          
 VPAIRP(R)         = TRUTH(MPAIRP(R))#,                                 00011700          
 VATOM(R)          = TRUTH(MATOM(R))#,                                  00011800          
 MORDERP(A,B)      = TRUTH(A>=B)#,                                      00011900          
 VCONSTANTP(R)     = TRUTH(MCONSTANTP(R))#,                             00012000          
 VVECTORP(R)       = TRUTH(MVECTORP(R))#,                               00012100          
 VNULL(R)          = TRUTH(R=NIL)#,                                     00012200          
 VSTRINGP(R)       = TRUTH(MSTRINGP(R))#,                               00012300          
 MXGLOBALP         = ARG1 := IF MIDP(ARG1) THEN                         00012400          
                                TRUTH(MGLOBALP(ARG1)) ELSE NIL#,        00012500          
 MXFLUIDP          = ARG1 := IF MIDP(ARG1) THEN                         00012600          
                                TRUTH(MFLUIDP(ARG1)) ELSE NIL#,         00012700          
 ZADDTOCHRS(X)     = ((X)*4) & STRINGTAG TAG#,                          00012800          
 MUPLIM            = ARG1 := IF MVECTORP(ARG1) THEN                     00013100          
                                  VSP[ARG1.FIELD] ELSE NIL#,            00013200          
 MPUTPROP          = ISPPROP[ARG1.FIELD] := ARG2#,                      00013300          
 MGETPROP(X)       = ISPPROP[(X).FIELD]#,                               00013400          
 MPUTG             = ISPVALUE[ARG1.FIELD] := ARG2#,                     00013500          
 MGETG(X)          = ISPVALUE[(X).FIELD]#,                              00013600          
 VEQ(A,B)          = CT(TRUTH(A=B),26)#,                                00013700          
 VEQN(A,B)         = TRUTH(ZEQN(A,B))#,                                 00013710          
 VEQUAL(A,B)       = TRUTH(ZEQUAL(A,B))#,                               00013800          
 ZEQ(A,B)          = CT(A,26) = B#,                                     00013810          
 ZMEMQ(A,B)        = MMEMQ(A,B) NEQ NIL#,                               00013900          
 ZMEMBER(A,B)      = MMEMBER(A,B) NEQ NIL#;                             00014000          
                                                                        00014100          
                                                                        00014200          
 REAL NIL,T,ZERO,ONE,TWO,THREE,ITEMP,MTEMP,MTEMPLOC,ALWAYS,SOMETIMES;   00014300          
 REAL PRIME,PRIMEZ,PRIMEZZ,PRIMEX;   % FOR MODULAR ARITHMETIC FUNCTIONS 00014310          
 BOOLEAN PRIMEBIG;                                                      00014320          
 REAL WORKSET,INUSE,RHO,OLDTIME,APAGEMAX,ZA,ZB;   %VARIABLES CONTROL GC 00014400          
 REAL IGNORABLES,QPTR;                                                  00014410          
 ARRAY RCVLOC[0:0];       % RECEIVING VARIABLE FOR NEWP INTRINSICS      00014420          
 LONG ARRAY SEARCHPAGE[0:PAGESIZE-1];  % PLACE WHICH ALLOWS SEARCHING   00014430          
                                                                        00014500          
                                                                        00014600          
% I SPACE. EACH ELEMENT IS AN IDENTIFIER CONSISTING OF 3 PARTS:         00014700          
%     (1) POINTER TO A PRINT NAME [I.SP.PNAME(...)]                     00014800          
%     (2) POINTER TO PROPERTY LIST OF IDENTIFIER [ISPPROP(...)]         00014900          
%     (3) POINTER TO GLOBAL VALUE [ISPVALUE(...)]                       00015000          
 LONG ARRAY ISPPNAME[0:511];                                            00015100          
 ARRAY ISPPROP [0:ISPMAX-1];                                            00015200          
 ARRAY ISPVALUE[0:ISPMAX-1];                                            00015300          
 $ SET OMIT = NOT COUNT                                                 00015400          
 ARRAY ISPCNT,ISPWEIGHT[0:ISPMAX-1];                                    00015500          
 $ POP OMIT                                                             00015600          
  REAL ISPFREE,ISPHIGH,AISPMAX;                                         00015700          
                                                                        00015800          
% S SPACE. A BIG OLD CHARACTER STRING. THE FIRST CHARACTER IS 0 - 255   00015900          
% AND IS THE STRING LENGTH OF WHAT FOLLOWS.                             00016000          
  EBCDIC ARRAY SSP[0:SSPBMAX,0:63];                                     00016100          
  REAL ZGET1,ZGET2;                                                     00016200          
                                                                        00016300          
% P SPACE. DOTTED PAIR SPACE IN TWO ARRAYS.                             00016400          
  ARRAY MCAR,MCDR[0:PSPMAX-1];                                          00016500          
  BOOLEAN ARRAY PPAGEUSEDA[0:(PPAGEMAX) DIV 48];                        00016600          
  DEFINE PPAGEUSED[X] = PPAGEUSEDA[(PJUNK:=X) DIV 48].[PJUNK MOD 48:1]#;00016700          
  REAL PJUNK;                                                           00016800          
  REAL PSPFREE;                                                         00016900          
                                                                        00017000          
% V SPACE. JUST POINTERS (THE FIRST ENTRY IS ALWAYS THE UPLIM VALUE)    00017100          
% WHICH ARE THE ELEMENTS OF ARRAYS.                                     00017200          
  ARRAY VSP[0:VSPMAX-1];                                                00017300          
  REAL VSPFREE;                                                         00017400          
                                                                        00017500          
% T SPACE. THIS IS THE STACK WHICH HAS XSUBR NAMES ON IT AND            00017600          
% ALL THE LAMBDA BINDINGS.                                              00017700          
  ARRAY TSP[0:PAGESIZE];                                                00017800          
  REAL TSPMAX,TSPPTR;                                                   00017900          
                                                                        00018000          
% E.SP IS EVAL STACK                                                    00018100          
  ARRAY ESP[0:PAGESIZE];                                                00018200          
  REAL ES,ESPMAX;                                                       00018300          
                                                                        00018400          
% Q.SP IS SPACE WHICH CONTROLS LINKAGE TO GLOBALS, FLUIDS, LITERALS,    00018500          
% AND CODE.                                                             00018600          
  ARRAY QSP[0:QSPMAX-1];                                                00018700          
  REAL  CURQPROGPTR,CURSTACKBASE;             %FOR BACK TRACKING.       00018800          
                                                                        00018906          
% ARITHARRAY1 AND 2 ARE USED FOR ARITHMETIC ON LARGE NUMBERS            00018908          
  ARRAY ARITHARRAY1,ARITHARRAY2[0:20];                                  00018910          
                                                                        00019000          
% I/O STUFF HERE.                                                       00019100          
  EBCDIC ARRAY TLINER,LINER[0:80];                                      00019200          
  REAL SPOCOUNT;                                                        00019300          
  EBCDIC ARRAY OUTER[0:131];                                            00019400          
  REAL INPTR, OUTPTR, CURCHANIN, CURCHANOUT;                            00019500          
  BOOLEAN FILEINUSEA;                                                   00019600          
  DEFINE FILEINUSE[X] = FILEINUSEA.[X:1]#,                              00019700          
       FILEINPUT[X] = FILEINUSEA.[X+23:1]#;                             00019800          
                                                                        00019900          
% GLOBALS ASSOCIATED WITH ERROR/ERRORSET.                               00020000          
  ARRAY ERRS[0:30];                                                     00020100          
                                                                        00020200          
% MISCELLANEOUS DECLARATIONS.                                           00020300          
        BOOLEAN STRINGSNEEDIT;        %USED BY GARBAGE COLLECTION       00020400          
        REAL NEWSCNT1,NEWSCNT2;       %CONTROLS GARB COLLECT OF STRINGS 00020500          
        BOOLEAN ATEND;                %USED AFTER EOF ON ME.            00020600          
        BOOLEAN ASKING;               %USER IS ASKING FOR STATUS        00020700          
        BOOLEAN BREAK;                %USER HIT BREAK KEY               00020800          
        BOOLEAN HIGH;                 %THROWING UNDER A HI              00020810          
        BOOLEAN RECENTREAD;           %LAST TTY I/O WAS A READ          00020900          
        REAL GGENSYM;                 %GENSYM COUNTER.                  00021000          
        REAL BASKET;                  %THROW-BACK.                      00021100          
        BOOLEAN BACKOUT;              %TRUE=THROWING.                   00021200          
        EVENT THROW;                  %CASUED WHEN THROWING             00021300          
        REAL CATCHCOUNTER;            %CATCH RECURSION DEPTH            00021400          
        REAL THROWCOUNTER;            %BUMPED AT EACH THROW             00021500          
        REAL CATCHER;                 %BUMPED FOR EACH CATCH            00021600          
        REAL MICROCOUNT,STARTTRACE;   %MICRO INSTRUCTION COUNTER.       00021700          
        REAL UNBOUND;                 %UNBOUND VALUE.                   00021800          
        REAL BEGINTIME;               %TIME AT BEGINNING.               00021900          
        REAL GARBAGETIME;             %TIME IN GARBAGE COLLECTION       00022000          
                                                                        00022100          
        TRUTHSET LETTERS("ABCDEFGHIJKLMNOPQRSTUVWXYZ" OR                00022200          
                         "abcdefghijklmnopqrstuvwxyz");                 00022300          
        TRUTHSET LETTERSNDIGITS("0123456789" OR LETTERS);               00022400          
        TRUTHSET IDCHARACTERS(LETTERSNDIGITS OR "!");                   00022500          
        TRUTHSET LETTERSNBANG(LETTERS OR "!");                          00022600          
        TRUTHSET DIGITSNSIGN("0123456789" OR "+" OR "-");               00022700          
                                                                        00022800          
% GLOBALS ASSOCIATED WITH IDENTIFIERS REQUIRED.                         00022900          
  ARRAY GLOBALVECT[0:GLOBLENGTH+10];                                    00023000          
  DEFINE GLAMBDA = GLOBALVECT[0] #,                                     00023100          
        GEOL = GLOBALVECT[1] #,                                         00023200          
        GEOF = GLOBALVECT[2] #,                                         00023300          
        GATOM = GLOBALVECT[4] #,                                        00023500          
        GAPPLY = GLOBALVECT[7] #,                                       00023800          
        GEXPR = GLOBALVECT[8] #,                                        00023900          
        GFEXPR = GLOBALVECT[9] #,                                       00024000          
        GSUBR = GLOBALVECT[10] #,                                       00024100          
        GFSUBR = GLOBALVECT[11] #,                                      00024200          
        GMACRO = GLOBALVECT[12] #,                                      00024300          
        GEMSG = GLOBALVECT[13] #,                                       00024400          
        GECHO = GLOBALVECT[14] #,                                       00024500          
        GRAISE = GLOBALVECT[15] #,                                      00024600          
        GCATCH = GLOBALVECT[17] #,                                      00024800          
        GOUTPUT = GLOBALVECT[18] #,                                     00024900          
        GINPUT = GLOBALVECT[19] #,                                      00025000          
        GBPROG = GLOBALVECT[20] #,                                      00025100          
        GFLOATING = GLOBALVECT[22] #,                                   00025300          
        GCFLAG = GLOBALVECT[27] #,                                      00025700          
        GGETV = GLOBALVECT[28] #,                                       00025800          
        GPUTV = GLOBALVECT[29] #,                                       00025900          
        GARITHMETIC = GLOBALVECT[31] #,                                 00026100          
        GID = GLOBALVECT[32] #,                                         00026200          
        GLINELENGTH = GLOBALVECT[33] #,                                 00026300          
        GVECTOR = GLOBALVECT[34] #,                                     00026400          
        GINTEGER = GLOBALVECT[35] #,                                    00026500          
        GREMOB = GLOBALVECT[36] #,                                      00026600          
        GMKVECT = GLOBALVECT[37] #,                                     00026700          
        GPRINC = GLOBALVECT[38] #,                                      00026800          
        GEXPLODE = GLOBALVECT[40] #,                                    00027000          
        GSCNVAL = GLOBALVECT[41] #,                                     00027100          
        GUNBOUND = GLOBALVECT[42] #,                                    00027200          
        GPROMPT = GLOBALVECT[43] #,                                     00027300          
        GSETPCHAR = GLOBALVECT[44] #,                                   00027400          
        GGLOBAL = GLOBALVECT[46] #,                                     00027500          
        GFLUID = GLOBALVECT[47] #,                                      00027600          
        GUNFLUID = GLOBALVECT[48] #,                                    00027700          
        GIDORSTRING = GLOBALVECT[49] #,                                 00027800          
        GINTERN = GLOBALVECT[50] #,                                     00027900          
        GOPEN = GLOBALVECT[51] #,                                       00028000          
        GINITIALISE = GLOBALVECT[52] #,                                 00028100          
        GMOD = GLOBALVECT[53] #;                                        00028110          
                                                                        00028200          
    % HERE ARE THE PSEUDO REGISTERS                                     00028300          
                                                                        00028400          
                                                                        00028500          
 NUMBER NUM,SNUM,QNUM;                                                  00028600          
 REAL ARG1,ARG2,ARG3,ARG4,ARG5,ARG6,ARG7,ARG8,ARG9,ARG10,ARG11,ARG12,   00028700          
      ARG13,ARG14,ARG15,ARG16;                                          00028800          
 DEFINE                                                                 00028900          
    ARG'0 = ARG1#, ARG'1 = ARG2#, ARG'2 = ARG3#, ARG'3 = ARG4#,         00029000          
    ARG'4 = ARG5#, ARG'5 = ARG6#, ARG'6 = ARG7#, ARG'7 = ARG8#,         00029100          
    ARG'8 = ARG9#, ARG'9 = ARG10#, ARG'10 = ARG11#, ARG'11 = ARG12#,    00029200          
    ARG'12 = ARG13#, ARG'13 = ARG14#, ARG'14 = ARG15#, ARG'15 = ARG16#; 00029300          
 DEFINE ARGS[N] = CASE N OF (ARG'0,ARG'1,ARG'2,ARG'3,ARG'4,ARG'5,       00029400          
                          ARG'6,ARG'7,ARG'8,ARG'9,ARG'10,ARG'11,        00029500          
                          ARG'12,ARG'13,ARG'14,ARG'15)#;                00029600          
                                                                        00029800          
%      MACROS, PROCEDURES AND OTHER DECLARATIONS FOR I/O                00030900          
                                                                        00031000          
                                                                        00031100          
% IOFILE IS AN ARRAY OF THE POSSIBLE FILES EXCEPT FOR DATA COMM I/O.    00031200          
% THE POINTERS CUR.CHAN.IN, CUR.CHAN.OUT ARE THE ARRAY ELEMENT + 1.     00031300          
% FILE 0 IS DATA COMM I/O AND IS TREATED SPECIALLY.                     00031400          
FILE ME(KIND=REMOTE,MYUSE=IO,MAXRECSIZE=80,UNITS=CHARACTERS);           00031500          
FILE ME2(KIND=REMOTE,MYUSE=IO,MAXRECSIZE=80,UNITS=CHARACTERS);          00031600          
FILE CARDS(KIND=DISK,FILETYPE=8);                                       00031700          
FILE LINE (KIND=PRINTER,MAXRECSIZE=22);                                 00031800          
FILE FILE1(KIND=DISK,FILETYPE=8);                                       00031900          
FILE FILE2(KIND=DISK,FILETYPE=8);                                       00032000          
FILE FILE3(KIND=DISK,FILETYPE=8);                                       00032100          
FILE FILE4(KIND=DISK,FILETYPE=8);                                       00032200          
FILE FILE5(KIND=DISK,FILETYPE=8);                                       00032300          
FILE FILE6(KIND=DISK,FILETYPE=8);                                       00032400          
FILE FILE7(KIND=DISK,FILETYPE=8);                                       00032500          
SWITCH FILE IOFILE := ME,CARDS,LINE,FILE1,FILE2,FILE3,FILE4,FILE5,      00032600          
      FILE6,FILE7;                                                      00032700          
ARRAY FILEINFO,IOHERE,IOSTOP[0:FMAX];                                   00032800          
                                                                        00032900          
DEFINE                                                                  00033000          
    CAT = ,#,                                                           00033100          
    CONVERT(W,N) = CONVERTPTR FOR CONVERTER(W,N)#,                      00033200          
    STRINGLENGTH(A)= REAL(SSP[A.BUCKF,A.SLOCF],1)#,                     00033300          
    ZGETSTRING(A) = SSP[ZGETSTRINGPROC(A),ZGET1] FOR ZGET2#,            00033400          
    DECIMAL(W,N) = W FOR N DIGITS#,                                     00033500          
    FOUR = 6#,                                                          00033600          
    WRITELINE(S) =                                                      00033700          
         BEGIN                                                          00033800          
              REPLACE COLLECTOR BY S;                                   00033900          
              WRITELINEPROC(1);                                         00034000          
         END#,                                                          00034100          
    WRITELINEDOUBLE(S) =                                                00034200          
         BEGIN                                                          00034300          
              REPLACE COLLECTOR BY S;                                   00034400          
              WRITELINEPROC(2);                                         00034500          
         END#,                                                          00034600          
    WRITETTY(S) =                                                       00034700          
         BEGIN                                                          00034800          
              REPLACE COLLECTOR BY S;                                   00034900          
              WRITETTYPROC;                                             00035000          
         END#,                                                          00035100          
    WRITEIOFILE(N,S) =                                                  00035200          
         BEGIN                                                          00035300          
              REPLACE COLLECTOR BY S;                                   00035400          
              WRITEIOPROC(N);                                           00035500          
         END#,                                                          00035600          
    ERRSTOP(S) =                                                        00035700          
         BEGIN                                                          00035800          
              REPLACE COLLECTOR[7] BY S;                                00035900          
              ERRORSTOP;                                                00036000          
         END#,                                                          00036100          
    ZDMPATOM(A,L) =                                                     00036200          
         BEGIN                                                          00036300          
              STOPCOUNT;                                                00036350          
              IF L+PTR>LL THEN XTERPRI;                                 00036400          
              STARTCOUNT;                                               00036450          
              REPLACE BFR[PTR] BY A;                                    00036500          
              PTR:=PTR+L;                                               00036600          
              MICROBUMP(7);                                             00036700          
         END#;                                                          00036800          
                                                                        00036900          
EBCDIC ARRAY COLLECTOR[0:131];                                          00037000          
POINTER CONVERTPTR;                                                     00037100          
ARRAY CONVERTARRAY[0:1];                                                00037200          
                                                                        00037300          
PROCEDURE WRITELINEPROC(N); VALUE N; REAL N;                            00037400          
    BEGIN LABEL EXIT;                                                   00037500          
         WRITE(LINE[SPACE N],22,COLLECTOR);                             00037600          
         REPLACE COLLECTOR BY " " FOR 132;                              00037700          
    END OF WRITELINEPROC;                                               00037800          
                                                                        00037900          
PROCEDURE WRITETTYPROC;                                                 00038000          
    BEGIN LABEL EXIT;                                                   00038100          
       IF NOT BREAK THEN                                                00038200          
       BEGIN                                                            00038300          
         BREAK := IF ATEND THEN                                         00038400          
              WRITE(ME2,80,COLLECTOR)                                   00038500          
            ELSE                                                        00038600          
              WRITE(ME,80,COLLECTOR);                                   00038700          
         IF BREAK THEN IF RECENTREAD THEN                               00038800          
           BREAK := IF ATEND THEN                                       00038900          
                WRITE(ME2,14,COLLECTOR)                                 00039000          
              ELSE                                                      00039100          
                WRITE(ME,80,COLLECTOR);                                 00039200          
       END;                                                             00039300          
       REPLACE COLLECTOR BY " " FOR 132;                                00039400          
       RECENTREAD := FALSE;                                             00039500          
    END OF WRITETTYPROC;                                                00039600          
                                                                        00039700          
PROCEDURE ERRORSTOP;                                                    00039800          
    BEGIN LABEL EXIT;                                                   00039900          
         REPLACE COLLECTOR BY "*" FOR 7;                                00040000          
         WRITE(ME,80,COLLECTOR);                                        00040100          
         REPLACE COLLECTOR BY "FATAL ERROR " CAT " " FOR 60;            00040200          
         WRITE(ME,80,COLLECTOR);                                        00040300          
         READ(ME);                                                      00040400          
         REPLACE COLLECTOR BY " " FOR 132;                   %PPDMTL10  00040500          
    END OF ERRORSTOP;                                                   00040600          
                                                                        00040700          
PROCEDURE EXPANDSTACK;                                                  00040800          
    BEGIN LABEL EXIT;                                                   00040900          
         IF TSPMAX>2**15 THEN                                           00041000          
              ERRSTOP("STACK OVERFLOW");                                00041100          
         RESIZE(TSP,TSPMAX:=TSPMAX+PAGESIZE,RETAIN);                    00041200          
    END EXPANDSTACK;                                                    00041300          
                                                                        00041400          
                                                                        00041500          
REAL PROCEDURE CONVERTER(W,N); VALUE W,N; REAL W,N;                     00041600          
    BEGIN LABEL EXIT;                                                   00041700          
         CONVERTARRAY[0]:=W;                                            00041800          
         REPLACE CONVERTPTR BY POINTER(CONVERTARRAY[1],4)-N             00041900          
              FOR N WITH HEXTOEBCDIC;                                   00042000          
         CONVERTER:=N;                                                  00042100          
    END CONVERTER;                                                      00042200          
                                                                        00042300          
PROCEDURE WRITEIOPROC(N); VALUE N; REAL N;                              00042400          
    BEGIN LABEL EXIT;                                                   00042500          
         IF N=0 THEN WRITETTYPROC ELSE                                  00042600          
         BEGIN                                                          00042700          
              WRITE(IOFILE[N],IF N=1 THEN 22 ELSE 14,COLLECTOR);        00042800          
              REPLACE COLLECTOR BY " " FOR 132;                         00042900          
         END;                                                           00043000          
    END;                                                                00043100          
                                                                        00043200          
 $ SET OMIT = COUNT                                                     00043300          
    DEFINE COUNT(N) = #, MICROBUMP(I) = #, BEGINCOUNT = #, ENDCOUNT = #,00043400          
           STARTCOUNT = #, STOPCOUNT = #, DECLARECOUNT = #,             00043500          
           DECLAREANDWEIGH = #,                                         00043600          
           PRIMTRACE(N) = #,                                            00043700          
           PRIMCOUNTER(N) = #,                                          00043710          
           DECLARE(X,N,M) =                                             00043800          
                DEFINE X = BEGIN M END##,                               00043900          
           JUMP(B)   = B#,                                              00044000          
           CT(V,N) = V#;                                                00044100          
 $ POP OMIT SET OMIT = NOT COUNT                                        00044200          
    DEFINE COUNT(N) = OPCODE[N]:=*+1#, MICROBUMP(I) = MICROCOUNT:=*+I#, 00044300          
           BEGINCOUNT = C:=-MICROCOUNT; ISPCNT[QSP[QNUM].FIELD]:=*+1#,  00044400          
           ENDCOUNT = ISPWEIGHT[QSP[QNUM].FIELD] := *+C+MICROCOUNT#,    00044500          
           STARTCOUNT = C:=C-MICROCOUNT#, STOPCOUNT = C:=C+MICROCOUNT#, 00044600          
           DECLARECOUNT = REAL C#,                                      00044700          
           PRIMCOUNTER(N) = MICROCOUNT:=*+1;                            00044710          
                            OPCODE[N]:=*+1;                             00044720          
                            OPWEIGHT[N]:=*+C+MICROCOUNT#,               00044730          
           DECLAREANDWEIGH = REAL C; C:=-MICROCOUNT#;                   00044740          
    ARRAY OPWEIGHT,OPCODE[0:PRIMNUM];                                   00044900          
    ARRAY TRACETABLE[0:PRIMNUM*2];                                      00045000          
    DEFINE                                                              00045100          
         PRIMTRACE(N) = MICROBUMP(1); COUNT(N)#,                        00045200          
         DECLARE(X,N,M) =                                               00045300          
              PROCEDURE X;                                              00045400          
                   BEGIN M; PRIMTRACE(N) END#;                          00045500          
         BOOLEAN PROCEDURE JUMP(B); VALUE B; BOOLEAN B;                 00045600          
              BEGIN PRIMTRACE(99); JUMP:=B END;                         00045700          
    REAL PROCEDURE CT(V,N); VALUE V,N; REAL V,N;                        00045800          
         BEGIN LABEL EXIT;                                              00045900          
              PRIMTRACE(N);                                             00046000          
              CT := V;                                                  00046100          
         END CT;                                                        00046200          
 $ POP OMIT                                                             00046300          
                                                                        00046400          
                                                                        00046500          
% NEWP PRIMATIVES FOR GARBAGE COLLECTION                                00047000          
                                                                        00047100          
$ SET OMIT = NOT NEWP                                                   00047200          
                                                                        00047300          
    LIBRARY LISP_SUPPORT(FUNCTIONNAME = "LISPSUPPORT.",      %PPDMTL01  00047400          
                         LIBACCESS = BYFUNCTION);            %PPDMTL01  00047410          
                                                                        00047500          
    REAL PROCEDURE STACKOFFSET(V);                                      00047600          
         VALUE V; REAL V; LIBRARY LISP_SUPPORT;                         00047700          
    PROCEDURE COPYFROMSTACK(N,P,I);                                     00047800          
         VALUE N,I,P; REAL I,N; POINTER P; LIBRARY LISP_SUPPORT;        00047900          
    REAL PROCEDURE MASKSTACKSEARCHER(V,M,R,I);                          00048000          
         VALUE V,I,M; REAL V,I,M; ARRAY R[0]; LIBRARY LISP_SUPPORT;     00048100          
                                                                        00048200          
$ POP OMIT                                                              00048300          
                                                                        00048400          
% FORWARD PROCEDURES.                                                   00049100          
REAL PROCEDURE ZCONS(A,B); VALUE A,B; REAL A,B; FORWARD;                00049200          
PROCEDURE ZERROR(A, B); VALUE A,B; REAL A,B; FORWARD;                   00049300          
PROCEDURE MLIST(A,B); VALUE A,B; REAL A,B; FORWARD;                     00049310          
PROCEDURE MTMSMTCH(A,B,C); VALUE A,B,C; REAL A,B,C; FORWARD;            00049400          
REAL PROCEDURE ZGETSTRINGPROC(A); VALUE A; REAL A; FORWARD;             00049500          
PROCEDURE XCALL(N); VALUE N; REAL N; FORWARD;                           00049600          
PROCEDURE XTERPRI; FORWARD;                                             00049700          
PROCEDURE YEVAL; FORWARD;                                               00049800          
PROCEDURE YERROR; FORWARD;                                              00049810          
PROCEDURE YINITIALISE; FORWARD;                                         00049820          
PROCEDURE YSTANDARDQ11LISP; FORWARD;                                    00049830          
PROCEDURE YQ01TQ19MSMTCH; FORWARD;                                      00049840          
PROCEDURE ZPATOM(A,B,O); VALUE A,B; REAL A; BOOLEAN B;                  00049900          
    EBCDIC ARRAY O[0]; FORWARD;                                         00049910          
PROCEDURE FAULTPROCESSOR(FA,FN); VALUE FN; REAL FN; ARRAY FA[0];        00050000          
    FORWARD;                                                            00050100          
                                                                        00050200          
$ PAGE                                                                  00050300          
%SEGMENT(FASTLOAD);                                                     00050400          
PROCEDURE FASTLOAD;                                                     00050500          
BEGIN                                                                   00050600          
% READ THE FILE CREATED BY SLISP/BOOTER. SEE THE DOCUMENTATION OF       00050700          
% THIS PROGRAM FOR THE FORMATS OF EACH ENTRY.                           00050800          
ARRAY BBF[0:30];                                                        00050900          
%FILE INIT (KIND=DISK,MAXRECSIZE=30,BLOCKSIZE=300);                     00051000          
REAL BPTR, CNT, BNO, I, J, QPROG, TMP;                                  00051200          
POINTER P,Q;                                                            00051300          
REAL PROCEDURE FASTFETCH;                                               00051400          
% RETURN THE NEXT ENTRY FROM THE BBF BUFFER. READ A NEW LINE WHEN       00051500          
% NECESSARY.                                                            00051600          
BEGIN LABEL EOF; REAL J,T;                                              00051700          
IF BPTR>=30 THEN BEGIN                                                  00051800          
  READ(INIT,30,BBF)[EOF];                                               00051900          
  IF FALSE THEN                                                         00052000          
EOF:   ERRSTOP("PREMATURE END OF FILE");                                00052100          
  BPTR := 0;                                                            00052200          
  END;                                                                  00052300          
FASTFETCH:=BBF[BPTR];                                                   00052400          
BPTR:=*+1;                                                              00052500          
END FASTFETCH;                                                          00052600          
                                                                        00052700          
                                                                        00052800          
PROCEDURE FETCHBLOCK(N,P); VALUE N,P; REAL N; POINTER P;                00052900          
BEGIN REAL I,J;                                                         00053000          
    IF I<N THEN                                                         00053100          
    DO BEGIN                                                            00053200          
         IF BPTR=30 THEN                                                00053300          
         BEGIN                                                          00053400          
              FASTFETCH; BPTR:=0;                                       00053500          
         END;                                                           00053600          
         J:=MIN(30-BPTR,N-I);                                           00053700          
         REPLACE P:P BY POINTER(BBF[BPTR]) FOR J WORDS;                 00053800          
         BPTR:=*+J;                                                     00053900          
         I:=I+J;                                                        00054000          
    END UNTIL I>=N;                                                     00054100          
END FETCHBLOCK;                                                         00054200          
                                                                        00054300          
                                                                        00054400          
  BPTR := 30;                    %FORCE THE FIRST READ.                 00054600          
  IF NOT INIT.PRESENT THEN       %QUIT IF NOT FILE AVAILABLE.           00054700          
  BEGIN                                                                 00054800          
    REPLACE OUTER BY " " FOR 132;                                       00054810          
    REPLACE OUTER BY INIT.TITLE;                                        00054820          
    ERRSTOP("MISSING INIT FILE: " CAT OUTER FOR 80);                    00054830          
  END;                                                                  00054840          
  WHILE (TMP:=FASTFETCH)<9 DO                                           00054900          
  BEGIN                        %PICK UP THE IDENTIFIER CODE.            00055000          
  CASE TMP OF BEGIN                                                     00055100          
    ;                     %0 IS A NOP.                                  00055200          
    BEGIN                 %1 -> READ IN THE IDENTIFIER SPACE ENTRIES.   00055300          
        CNT := FASTFETCH;      %PICK UP THE NUMBER OF ENTRIES.          00055400          
        IF CNT>=ISPMAX THEN ERRSTOP("ID SPACE JAM");                    00055500          
        I := MIN((CNT+2*PAGESIZE) DIV PAGESIZE * PAGESIZE,ISPMAX);      00055600          
        IF I>AISPMAX THEN                                               00055700          
          RESIZE(ISPPNAME,AISPMAX:=I,RETAIN);                           00055800          
        FETCHBLOCK(CNT,POINTER(ISPPNAME[0]));                           00055900          
        FETCHBLOCK(CNT,POINTER(ISPVALUE[0]));                           00056000          
        FOR I:=0 STEP 1 UNTIL CNT DO                                    00056100          
        BEGIN                                                           00056200          
             MINTERNED(ISPPNAME[I]) := TRUE;                            00056300          
             ISPPROP[I] := NIL;                                         00056400          
        END;                                                            00056500          
        ISPPNAME[ISPFREE:=CNT] := NIL;                                  00056510          
    END IDSPACEBUILD;                                                   00056600          
                                                                        00056700          
    BEGIN                 %2 -> READ ALL THE PAIRS.                     00056800          
        PSPFREE := CNT := FASTFETCH;                                    00056900          
        IF PSPFREE>=PSPMAX THEN ERRSTOP("P SPACE JAM");                 00057000          
        FETCHBLOCK(CNT,POINTER(MCAR[0]));                               00057100          
        FETCHBLOCK(CNT,POINTER(MCDR[0]));                               00057200          
    END PAIRSPACEBUILD;                                                 00057700          
                                                                        00057800          
    BEGIN                   %3 -> BUILD UP THE STRING SPACE.            00057900          
    BNO := FASTFETCH;       %PICK UP THE BUCKET NUMBER.                 00058000          
    CNT := FASTFETCH;       %PICK UP THE BYTE COUNT.                    00058100          
    I:=SIZE(SSP[BNO,*]);                                                00058200          
    IF I-3<CNT THEN                                                     00058300          
    BEGIN                                                               00058400          
         I:=IF BNO=0 THEN 1024 ELSE 2**FIRSTONE(CNT+4);                 00058500          
         RESIZE(SSP[BNO,*],I);                                          00058600          
    END;                                                                00058700          
    FETCHBLOCK((CNT+5) DIV 6, SSP[BNO,0]);                              00058800          
    IF BNO>0 THEN                                                       00058900          
         REPLACE SSP[BNO,CNT] BY (I-CNT-2).[15:48] FOR 2;               00059000          
    END STRINGSPACEBUILD;                                               00059100          
    ;                       %4 -> NOT USED.                             00059200          
    BEGIN                   %5 --> INITIALIZE ONE OF THE ERROR MESSAGES.00059300          
    CNT := FASTFETCH;       %PICK UP GLOBAL ENTRY NUMBER.               00059400          
    ERRS[CNT] := FASTFETCH;                                             00059500          
    END ERRORMSGFETCH;                                                  00059600          
                                                                        00059700          
    BEGIN                   %6 --> INITIALIZE GLOBAL IDENTIFIERS.       00059800          
    CNT := FASTFETCH;       %GLOBAL TABLE NUMBER.                       00059900          
    GLOBALVECT[CNT] := FASTFETCH;                                       00060000          
    END IDGLOBALBUILD;                                                  00060100          
                                                                        00060200          
    BEGIN                   %7 -> NOT USED                              00060300          
    END INITBSPACE;                                                     00060800          
                                                                        00060900          
    BEGIN                   %8 -> INITIALIZE A Q SPACE BLOCK.           00061000          
    CNT := FASTFETCH;       %COUNT OF WORDS TO MOVE.                    00061100          
    FETCHBLOCK(CNT,POINTER(QSP[QPROG]));                                00061200          
    QPROG:=*+CNT;                                                       00061300          
    END INITQSPACE;                                                     00061400          
                                                                        00061500          
    END CASE;                                                           00061600          
  END READINIT;                                                         00061700          
  IF TMP > 10 THEN ERRSTOP(CONVERT(TMP,FOUR) CAT                        00061800          
                            " IS AN INVALID FASTLOAD OPCODE");          00061900          
MINTERNED(ISPPNAME[ISPVALUE[GUNBOUND.FIELD].FIELD]) := FALSE;           00062000          
UNBOUND := ISPVALUE[GUNBOUND.FIELD];                                    00062100          
QPTR := QPROG;                                                          00062200          
ISPHIGH:=ISPFREE-1;                                                     00062300          
END FASTLOAD;                                                           00062400          
$PAGE                                                                   00062500          
                                                                        00062600          
PROCEDURE ANSWERHI;                                                     00062700          
BEGIN                                                                   00062800          
    EBCDIC ARRAY A[0:29];                                               00062900          
    PICTURE PRETTYI(P EEEDEEEDEEEDEEE), PRETTYP(ZZZZI99),               00063000          
         PRETTYT(P EEDEEEI99);                                          00063100          
    REAL I,J,K;                                                         00063200          
    LABEL EXIT;                                                         00063300          
    IF ATEND THEN WRITETTY("END OF FILE - STANDARD INPUT DEVICE");      00063400          
    J := TIME(12) - BEGINTIME;                                          00063500          
    REPLACE A BY INTEGER(J*2.4@-4) FOR 12 DIGITS, INTEGER(GARBAGETIME*  00063600          
       2.4@-4) FOR 12 DIGITS, INTEGER(10000*GARBAGETIME/J) FOR 6 DIGITS;00063700          
    WRITETTY("TOTAL TIME =" CAT A[5] WITH PRETTYT CAT ",    GC TIME ="  00063800          
      CAT A[17] WITH PRETTYT CAT ",   " CAT A[24] WITH PRETTYP CAT "%");00063900          
    IF CURCHANIN>0 THEN                                                 00063910          
         WRITETTY("LINE NUMBER = " CAT IOHERE[CURCHANIN] FOR 8 NUMERIC);00063920          
    WRITETTY("I = " CAT AISPMAX FOR I:5 NUMERIC CAT                     00064000          
             ",   T = " CAT TSPMAX FOR I:5 NUMERIC CAT                  00064100          
             ",   E = " CAT ESPMAX FOR I:5 NUMERIC CAT                  00064200          
             ",   Q = " CAT QPTR FOR I:5 NUMERIC);                      00064300          
    IF MICROCOUNT <= 1 THEN GO TO EXIT;                                 00064500          
    REPLACE A BY MICROCOUNT FOR 12 DIGITS;                              00064600          
    WRITETTY("   MICRO-INSTRUCTIONS EXECUTED: " CAT                     00064700          
              A WITH PRETTYI);                                          00064800          
    REPLACE A BY (MICROCOUNT DIV (J*2.4@-6)) FOR 12 DIGITS;             00064900          
    WRITETTY("   INSTRUCTIONS/SECOND:         " CAT                     00065000          
              A WITH PRETTYI);                                          00065100          
    WRITETTY("   MILLI SECONDS PER INSTRUCTION:         " CAT           00065200          
              ((J*2.4@-3)/MICROCOUNT) FOR 6 NUMERIC);                   00065300          
 $ SET OMIT = NOT COUNT                                                 00065400          
  J:=K:=0;                                                              00065500          
  FOR I:=0 STEP 1 UNTIL PRIMNUM DO                                      00065600          
  BEGIN J:=OPCODE[I]+J; K:=OPWEIGHT[I]+K END;                           00065700          
  K:=K+J;                                                               00065710          
  FOR I:=0 STEP 1 UNTIL PRIMNUM DO                                      00065800          
  IF OPCODE[I]>0 THEN                                                   00065900          
  BEGIN                                                                 00066000          
    REPLACE A BY OPCODE[I] FOR 12 DIGITS,                               00066100          
        OPCODE[I]*10000 DIV J FOR 6 DIGITS,                             00066200          
        (OPWEIGHT[I]+OPCODE[I])*10000 DIV K FOR 6 DIGITS;               00066210          
    WRITETTY(A WITH PRETTYI CAT A[12] WITH PRETTYP CAT                  00066300          
        A[18] WITH PRETTYP CAT "  " CAT                                 00066310          
        POINTER(TRACETABLE[2*I]) FOR 12);                               00066400          
    OPCODE[I]:=OPWEIGHT[I]:=0;                                          00066500          
  END;                                                                  00066600          
  REPLACE A BY J FOR 12 DIGITS;                                         00066700          
  WRITETTY(A WITH PRETTYI CAT "         TOTAL");                        00066800          
  J:=K:=0; WRITETTY(" "); WRITETTY(" ");                                00066900          
  FOR I:=0 STEP 1 UNTIL ISPHIGH DO                                      00067000          
  BEGIN J:=ISPCNT[I]+J; K:=ISPWEIGHT[I]+K END;                          00067100          
  FOR I:=0 STEP 1 UNTIL ISPHIGH DO                                      00067200          
  IF ISPCNT[I]>0 THEN                                                   00067300          
  BEGIN                                                                 00067400          
    REPLACE A BY ISPCNT[I] FOR 12 DIGITS,                               00067500          
        ISPCNT[I]*10000 DIV J FOR 6 DIGITS,                             00067600          
        ISPWEIGHT[I]*10000 DIV K FOR 6 DIGITS;                          00067700          
    WRITETTY(A WITH PRETTYI CAT A[12] WITH PRETTYP CAT                  00067800          
        A[18] WITH PRETTYP CAT "  " CAT                                 00067900          
        ZGETSTRING(STRINGIZE(ISPPNAME[I])));                            00068000          
    ISPCNT[I]:=ISPWEIGHT[I]:=0;                                         00068100          
  END;                                                                  00068200          
  WRITETTY(" ");                                                        00068300          
  REPLACE A BY J FOR 12 DIGITS;                                         00068400          
  WRITETTY(A WITH PRETTYI CAT "         TOTAL");                        00068500          
 $ POP OMIT                                                             00068600          
EXIT:                                                                   00068700          
  ASKING:=FALSE;                                                        00068800          
END ANSWERHI;                                                           00068900          
                                                                        00069000          
                                                                        00069100          
PROCEDURE TDUMP(MSG, A, B, C); VALUE A,B,C,MSG; BOOLEAN A,B,C;          00069200          
REAL MSG;                                                               00069300          
BEGIN REAL I,L,TMP,TNP;                                                 00069400          
BOOLEAN PRINTIT;                                                        00069500          
LABEL EXIT;                                                             00069600          
EBCDIC ARRAY LNE[0:131];                                                00069700          
WRITELINE ("**********  " CAT MSG FOR 6 CAT "  **********");            00069800          
WRITELINEDOUBLE ("          -- BUFFERS/POINTERS --");                   00069900          
WRITELINEDOUBLE ("LINER:" CAT LINER FOR 80);                            00070000          
WRITELINE ("OUTER:" CAT OUTER FOR 126);                                 00070100          
WRITELINE ("INPTR:" CAT DECIMAL(INPTR, 3) CAT                           00070200          
            "     OUTPTR:" CAT DECIMAL(OUTPTR, 3) CAT                   00070300          
  "    CURCHANIN: " CAT DECIMAL(CURCHANIN, 2) CAT                       00070400          
  "   CURCHANOUT: " CAT DECIMAL(CURCHANOUT, 2));                        00070500          
WRITELINE ("ISPFREE:" CAT CONVERT(ISPFREE,FOUR) CAT                     00070600          
"     PSPFREE:" CAT CONVERT(PSPFREE,FOUR) CAT                           00070700          
"     VSPFREE:" CAT CONVERT(VSPFREE,FOUR) CAT                           00070800          
"     TSPPTR:" CAT CONVERT(TSPPTR,FOUR));                               00070900          
WRITELINE("ARG1-4: " CAT CONVERT(ARG1,FOUR) CAT                         00071000          
  "   " CAT CONVERT(ARG2,FOUR) CAT "   " CAT                            00071100          
  CONVERT(ARG3,FOUR) CAT "   " CAT                                      00071200          
  CONVERT(ARG4,FOUR));                                                  00071300          
WRITELINEDOUBLE(                                                        00071400          
  "MICROCOUNT: " CAT DECIMAL(MICROCOUNT, 8) CAT " BACKOUT: " CAT        00071500          
  (IF BACKOUT THEN "TRUE  " ELSE "FALSE " ) FOR 6);                     00071600          
                                                                        00071700          
%SEGMENT(TDUMP2);                                                       00071800          
IF A THEN                                                               00071900          
BEGIN                                                                   00072000          
  WRITELINE ("          -- SYMBOL TABLE --");                           00072100          
  FOR I:=0 STEP 1 UNTIL ISPHIGH DO                                      00072200          
    IF ISPPROP[I].FIELD NEQ MAXFIELDV THEN                              00072300          
        WRITELINE(CONVERT(I,4) CAT "   " CAT                            00072400          
          CONVERT(ISPPNAME[I].FIELD,4) CAT "   " CAT                    00072500          
          CONVERT(ISPPROP[I].TAG,2) CAT " " CAT                         00072600          
          CONVERT(ISPPROP[I].FIELD,4) CAT "   " CAT                     00072700          
          CONVERT(ISPVALUE[I].TAG,2) CAT " " CAT                        00072800          
          CONVERT(ISPVALUE[I].FIELD,4) CAT                              00072900          
          (IF MINTERNED(ISPPNAME[I]) THEN "   * '" ELSE "     '") CAT   00073000          
          ZGETSTRING(STRINGIZE(ISPPNAME[I])) CAT "'  ");                00073100          
END SYMBOLTABLEDUMP;                                                    00073200          
                                                                        00073300          
%SEGMENT(TDUMP3);                                                       00073400          
% DUMP THE PAIR SPACE.                                                  00073500          
IF B THEN BEGIN                                                         00073600          
  I := 0;  WRITELINEDOUBLE ("          -- P SPACE --");                 00073700          
  WHILE I<PSPMAX DO                                                     00073800          
  BEGIN                                                                 00073900          
    IF PPAGEUSED[I DIV PAGESIZE] THEN                                   00074000          
    BEGIN                                                               00074100          
    TNP := I;  REPLACE LNE BY CONVERT(TNP,FOUR) CAT "  ";               00074200          
    L:= 8; PRINTIT:=FALSE;                                              00074300          
      WHILE I<PSPMAX AND L<115 DO                                       00074400          
      BEGIN                                                             00074500          
      REPLACE LNE[L] BY CONVERT(MCAR[I], 6) CAT " " CAT                 00074600          
       CONVERT(MCDR[I], 6) CAT "  ";                                    00074700          
      IF MCAR[I] NEQ MAXFIELDV THEN PRINTIT:=TRUE;                      00074800          
      L:=L+15; I:=I+1;                                                  00074900          
      END DUMPAPAIR;                                                    00075000          
    IF PRINTIT THEN WRITELINE (LNE FOR L);                              00075100          
    END                                                                 00075200          
    ELSE I:=*+PAGESIZE;                                                 00075300          
  END DUMPPAIRS;                                                        00075400          
                                                                        00075500          
  %NOW DUMP THE Q SPACE.                                                00075600          
  WRITELINEDOUBLE("           -- Q SPACE --");                          00075700          
  TNP:=I:=0; L:=8; REPLACE LNE BY CONVERT(TNP, FOUR) CAT "  ";          00075800          
  WHILE I<QPTR DO                                                       00075900          
  BEGIN                                                                 00076000          
    IF L>=123 THEN BEGIN                                                00076100          
      WRITELINE (LNE FOR L);                                            00076200          
      TNP := I;                                                         00076300          
      REPLACE LNE BY CONVERT(TNP, FOUR) CAT "  "; L:=8;                 00076400          
      END;                                                              00076500          
    REPLACE LNE[L] BY CONVERT(QSP[I], FOUR) CAT " ";                    00076600          
    L:=*+7; I:=*+1;                                                     00076700          
  END DUMPQSPACE;                                                       00076800          
  WRITELINEDOUBLE (LNE FOR L);                                          00076900          
END PSPACEDUMP;                                                         00077000          
                                                                        00077100          
% DUMP THE T SPACE (THE STACK).                                         00077200          
%SEGMENT(TDUMP4);                                                       00077300          
IF C THEN BEGIN                                                         00077400          
I := TSPPTR - 1;                                                        00077500          
WRITELINEDOUBLE("          -- STACK --");                               00077600          
WHILE I>0 DO                                                            00077700          
BEGIN                                                                   00077800          
  TNP := I;                                                             00077900          
  WRITELINE ("*** " CAT CONVERT(TNP,FOUR) CAT "  '"                     00078000          
     CAT ZGETSTRING(STRINGIZE(ISPPNAME[TSP[I-1].FIELD])) CAT "'");      00078100          
  TMP := TSP[I];                                                        00078200          
  I := I-2;                                                             00078300          
    WHILE I>=TMP DO                                                     00078400          
    BEGIN                                                               00078500          
    WRITELINE ("   " CAT CONVERT(TSP[I],FOUR));                         00078600          
    I:=I-1;                                                             00078700          
    END DUMPAFRAME;                                                     00078800          
END DUMPSTACK;                                                          00078900          
END TSPACEDUMP;                                                         00079000          
                                                                        00079100          
EXIT:                                                                   00079200          
END TDUMP;                                                              00079300          
                                                                        00079400          
PROCEDURE XDUMP;                                                        00079500          
BEGIN LABEL EXIT;                                                       00079600          
    DECLAREANDWEIGH;                                                    00079610          
    MICROBUMP(5);                                                       00079620          
    PRIMCOUNTER(55);                                                    00079700          
    TDUMP(" USER ",ARG1 NEQ NIL,ARG2 NEQ NIL,ARG3 NEQ NIL);             00079800          
END;                                                                    00079900          
                                                                        00080000          
PROCEDURE XCHKPOINT;                                                    00080100          
    BEGIN LABEL EXIT;                                                   00080200          
         DECLAREANDWEIGH;                                               00080210          
         MICROBUMP(5);                                                  00080220          
         ANSWERHI;                                                      00080300          
         ARG1:=NIL;                                                     00080400          
         PRIMCOUNTER(57);                                               00080500          
    END;                                                                00080600          
                                                                        00080700          
                                                                        00080800          
                                                                        00080900          
%   THIS IS THE ARITHMETIC SECTION                                      00081000          
                                                                        00081010          
                                                                        00081020          
                                                                        00081030          
REAL PROCEDURE ZOVERFLOW;                                               00081040          
    BEGIN LABEL EXIT;                                                   00081050          
         ZERROR(119, ERRS[19]);                                         00081060          
    END ZOVERFLOW;                                                      00081070          
                                                                        00081080          
                                                                        00081100          
                                                                        00081110          
                                                                        00081120          
DEFINE                                                                  00081130          
       VABS[X]     = MABS(X)#,                                          00081140          
       VMINUS[X]   = MMINUS(X)#,                                        00081150          
       LPLUS2(X,L) = (IF OVERFLOWP(ITEMP:=X+L) THEN                     00081152          
                                 VPLUS2(ITEMP-L,NUMB[L])                00081153          
                            ELSE CT(ITEMP,104))#,                       00081154          
       LDIFF(X,L)  = (IF OVERFLOWP(ITEMP:=X-L) THEN                     00081155          
                                 VDIFFERENCE(ITEMP+L,NUMB[L])           00081156          
                            ELSE CT(ITEMP,105))#,                       00081157          
       ZEROERR     = ZOVERFLOW#;                                        00081160          
                                                                        00081170          
                                                                        00081180          
                                                                        00081190          
REAL PROCEDURE NORMALIZE(L,S,Z); VALUE L,S,Z; REAL L,S,Z;               00081200          
    BEGIN REAL I,N;                                                     00081210          
         IF L=1 THEN                                                    00081220          
              NORMALIZE := IF S<0 THEN 2*ZEROLIT-MCAR[Z] ELSE MCAR[Z]   00081230          
         ELSE                                                           00081240          
         BEGIN                                                          00081250          
              I := ZTRACT(L&S[46:46:1]);                                00081260          
              NORMALIZE := IF L>2 THEN ZCONS(I,Z) & BIGTAG TAG          00081270          
                   ELSE IF OVERFLOWP(N:=ZTRACT(                         00081280          
                        (ZEXTEND(MCAR[Z])*BASE+ZEXTEND(MCAR[MCDR[Z]])) &00081290          
                        S [46:46:1])) THEN                              00081300          
                        ZCONS(I,Z) & BIGTAG TAG ELSE N;                 00081310          
         END;                                                           00081320          
     END NORMALIZE;                                                     00081330          
                                                                        00081340          
REAL PROCEDURE NUMCHECK(X); VALUE X; REAL X;                            00081350          
    BEGIN LABEL EXIT;                                                   00081360          
         IF NOT MNUMBERP(X) THEN                                        00081370          
              MTMSMTCH(X,GINTEGER,GARITHMETIC);                         00081380          
    END NUMCHECK;                                                       00081390          
                                                                        00081400          
REAL PROCEDURE MULTIPLY(X,Y); VALUE X,Y; REAL X,Y;                      00081410          
    BEGIN                                                               00081420          
         DOUBLE R;                                                      00081430          
         REAL I,J,Z,L1,L2,L,S,U;                                        00081440          
         DEFINE A=ARITHARRAY1#, B=ARITHARRAY2#;                         00081450          
         IF NOT MINTEGERP(X) THEN NUMCHECK(X);                          00081460          
         IF BIGP(X) THEN                                                00081470          
         BEGIN                                                          00081480          
              X.TAG := 0;                                               00081490          
              S := ZEXTEND(MCAR[X]);                                    00081500          
              L1 := ABS(S)-1;                                           00081510          
              IF SIZE(A)<=L1 THEN RESIZE(A,3*L1 DIV 2);                 00081520          
              FOR I:=L1 STEP -1 UNTIL 0 DO                              00081530          
              BEGIN X:=MCDR[X]; A[I]:=ZEXTEND(MCAR[X]) END;             00081540          
         END                                                            00081550          
         ELSE                                                           00081560          
         BEGIN                                                          00081570          
              S := ZEXTEND(X);                                          00081580          
              A[0] := ABS(S);                                           00081590          
              L1 := 0;                                                  00081600          
         END;                                                           00081610          
         IF NOT MINTEGERP(Y) THEN NUMCHECK(Y);                          00081620          
         IF BIGP(Y) THEN                                                00081630          
         BEGIN                                                          00081640          
              Y.TAG := 0;                                               00081650          
              L2 := ZEXTEND(MCAR[Y]);                                   00081660          
              S := L2*S;                                                00081670          
              L2 := ABS(L2)-1;                                          00081680          
              IF SIZE(B)<=L2 THEN RESIZE(B,3*L2 DIV 2);                 00081690          
              FOR I:=L2 STEP -1 UNTIL 0 DO                              00081700          
              BEGIN Y:=MCDR[Y]; B[I]:=ZEXTEND(MCAR[Y]) END;             00081710          
         END                                                            00081720          
         ELSE                                                           00081730          
         BEGIN                                                          00081740          
              L2 := ZEXTEND(Y);                                         00081750          
              S := L2*S;                                                00081760          
              B[0] := ABS(L2);                                          00081770          
              L2 := 0;                                                  00081780          
         END;                                                           00081790          
         L := L1+L2;                                                    00081800          
         Z := NIL;                                                      00081810          
         U := -1;                                                       00081820          
         FOR I:=0 STEP 1 UNTIL L DO                                     00081830          
         BEGIN                                                          00081840          
              IF I<=L2 THEN U:=U+1;                                     00081850          
              J := IF I>L1 THEN I-L1 ELSE 0;                            00081860          
              DO R := A[I-J] MUX B[J] + R UNTIL J:=J+1>U;               00081870          
              Z := ZCONS(ZTRACT(INTEGER(R MOD BASE)),Z);                00081880          
              R := R DIV BASE;                                          00081890          
         END;                                                           00081900          
         IF R>0 THEN                                                    00081910          
         BEGIN                                                          00081920          
              IF R>=BASE THEN                                           00081930          
              BEGIN                                                     00081940          
                   Z := ZCONS(ZTRACT(INTEGER(R MOD BASE)),Z);           00081950          
                   R := R DIV BASE;                                     00081960          
                   L := L+1;                                            00081970          
              END;                                                      00081980          
              Z := ZCONS(ZTRACT(INTEGER(R)),Z);                         00081990          
              L := L+1;                                                 00082000          
         END;                                                           00082010          
         MULTIPLY := ZCONS(ZTRACT((L+1)&S[46:46:1]),Z)&BIGTAG TAG;      00082020          
    END MULTIPLY;                                                       00082030          
                                                                        00082040          
                                                                        00082050          
REAL PROCEDURE ADDSUB(X,Y,S); VALUE S,Y,X; REAL S,Y,X;                  00082060          
    BEGIN LABEL EXIT;                                                   00082070          
         REAL L1,L2,L,H,K,D,E,F,Z;                                      00082080          
                                                                        00082090          
         DEFINE ADDON(Z,E) = Z:=MCDR[Z]:=ZCONS(E,NIL)#;                 00082100          
         DEFINE EXCHANGE(Q) = BEGIN                                     00082110          
                                   S:=X; X:=Y; Y:=S;                    00082120          
                                   L1:=L2+L2-L1; Q;                     00082130          
                              END#;                                     00082140          
         DEFINE LAYDOWN = BEGIN                                         00082150          
                               IF E>ZERO THEN ADDON(Z,E) ELSE           00082160          
                               IF Z=ALWAYS THEN L:=L-1 ELSE ADDON(Z,E); 00082170          
                               IF K>0 THEN                              00082180          
                               DO ADDON(Z,F) UNTIL (K:=K-1)=0;          00082190          
                           END#;                                        00082200          
                                                                        00082210          
         IF NOT MNUMBERP(X) THEN NUMCHECK(X);                           00082220          
         IF SMALLP(X) THEN                                              00082230          
         BEGIN                                                          00082240          
              H := ZEXTEND(X); X := ABS(H);                             00082250          
              IF X>=BASE THEN                                           00082260          
              BEGIN L1 := 2;                                            00082270          
                   X:=ZCONS(ZTRACT(X DIV BASE),ZCONS(ZTRACT(X MOD BASE),00082280          
                        NIL));                                          00082290          
              END ELSE                                                  00082300          
              BEGIN L1 := 1;                                            00082310          
                   X := ZCONS(ZTRACT(X),NIL);                           00082320          
                   IF H=0 THEN H := 1;                                  00082330          
              END;                                                      00082340          
              MCAR[SOMETIMES] := X;                                     00082350          
         END                                                            00082360          
         ELSE                                                           00082370          
         BEGIN                                                          00082380          
              X.TAG := 0;                                               00082390          
              H := ZEXTEND(MCAR[X]); L1 := ABS(H); X := MCDR[X];        00082400          
         END;                                                           00082410          
         S := S*H;                                                      00082420          
         IF NOT MNUMBERP(Y) THEN NUMCHECK(Y);                           00082430          
         IF SMALLP(Y) THEN                                              00082440          
         BEGIN                                                          00082450          
              E := ZEXTEND(Y); Y := ABS(E);                             00082460          
              IF Y>=BASE THEN                                           00082470          
              BEGIN L2 := 2;                                            00082480          
                   Y:=ZCONS(ZTRACT(Y DIV BASE),ZCONS(ZTRACT(Y MOD BASE),00082490          
                        NIL));                                          00082500          
              END ELSE                                                  00082510          
              BEGIN L2 := 1;                                            00082520          
                   Y := ZCONS(ZTRACT(Y),NIL);                           00082530          
              END;                                                      00082540          
              MCDR[SOMETIMES] := Y;                                     00082550          
         END                                                            00082560          
         ELSE                                                           00082570          
         BEGIN                                                          00082580          
              Y.TAG := 0;                                               00082590          
              E := ZEXTEND(MCAR[Y]); L2 := ABS(E); Y := MCDR[Y];        00082600          
         END;                                                           00082610          
         S := S*E;                                                      00082620          
         L := MAX(L1,L2);                                               00082630          
         E := ZERO; K := 0; Z := ALWAYS; MCDR[Z] := NIL;                00082640          
         IF S>=0 THEN                                                   00082650          
         BEGIN                                                          00082660          
              IF L1<L2 THEN EXCHANGE(;);                                00082670          
              DO BEGIN                                                  00082680          
                   IF L2<L1 THEN                                        00082690          
                   BEGIN                                                00082700          
                        D := MCAR[X]; L2 := L2+1;                       00082710          
                   END                                                  00082720          
                   ELSE                                                 00082730          
                   BEGIN                                                00082740          
                        D := MCAR[X] + MCAR[Y] - ZERO; Y := MCDR[Y];    00082750          
                   END;                                                 00082760          
                   IF D=BM1 THEN K := K+1                               00082770          
                   ELSE                                                 00082780          
                   BEGIN                                                00082790          
                        IF D>BM1 THEN                                   00082800          
                        BEGIN                                           00082810          
                             D := D-BASE; E := E+1; F := ZERO;          00082820          
                        END                                             00082830          
                        ELSE F := BM1;                                  00082840          
                        LAYDOWN;                                        00082850          
                        E := D;                                         00082860          
                   END;                                                 00082870          
                   X := MCDR[X];                                        00082880          
              END UNTIL X=NIL;                                          00082890          
              F := BM1;                                                 00082900          
         END                                                            00082910          
         ELSE                                                           00082920          
         BEGIN                                                          00082930          
              IF L1=L2 THEN                                             00082940          
              BEGIN                                                     00082950          
                   WHILE MCAR[X] = MCAR[Y] DO                           00082960          
                   BEGIN                                                00082970          
                        X := MCDR[X]; Y := MCDR[Y];                     00082980          
                        L := L-1;                                       00082990          
                        IF L=0 THEN                                     00083000          
                        BEGIN ADDSUB := ZERO; GO TO EXIT END;           00083010          
                   END;                                                 00083020          
                   L1 := L2 := L;                                       00083030          
                   IF MCAR[X] < MCAR[Y] THEN EXCHANGE(H:=-H);           00083040          
              END                                                       00083050          
              ELSE IF L1<L2 THEN EXCHANGE(H:=-H);                       00083060          
              DO BEGIN                                                  00083070          
                   IF L2<L1 THEN                                        00083080          
                   BEGIN                                                00083090          
                        D := MCAR[X]; L2 := L2+1;                       00083100          
                   END                                                  00083110          
                   ELSE                                                 00083120          
                   BEGIN                                                00083130          
                        D := MCAR[X] - MCAR[Y] + ZERO; Y := MCDR[Y];    00083140          
                   END;                                                 00083150          
                   IF D=ZERO THEN K := K+1                              00083160          
                   ELSE                                                 00083170          
                   BEGIN                                                00083180          
                        IF D<ZERO THEN                                  00083190          
                        BEGIN                                           00083200          
                             D := D+BASE; E := E-1; F := BM1;           00083210          
                        END                                             00083220          
                        ELSE F := ZERO;                                 00083230          
                        LAYDOWN;                                        00083240          
                        E := D;                                         00083250          
                   END;                                                 00083260          
                   X := MCDR[X];                                        00083270          
              END UNTIL X=NIL;                                          00083280          
              F := ZERO;                                                00083290          
         END;                                                           00083300          
         LAYDOWN;                                                       00083310          
         ADDSUB := NORMALIZE(L+1,H,MCDR[ALWAYS]);                       00083320          
         MCDR[ALWAYS] := NIL;                                           00083330          
EXIT:                                                                   00083340          
    END ADDSUB;                                                         00083350          
                                                                        00083360          
                                                                        00083370          
REAL PROCEDURE DIVISION(X,Y,P); VALUE X,Y,P; REAL X,Y,P;                00083380          
    BEGIN LABEL EXIT,FINI;                                              00083390          
         DOUBLE D,E;                                                    00083400          
         REAL L1,L2,L,S,Q,R,Z,I,J,K,U,V;                                00083410          
         DEFINE A=ARITHARRAY1#, B=ARITHARRAY2#;                         00083420          
                                                                        00083430          
         DEFINE ADDON(Q,Z) = BEGIN                                      00083440          
                                  IF Q>ZERO THEN                        00083450          
                                       Z:=MCDR[Z]:=ZCONS(Q,NIL)         00083460          
                                  ELSE IF Z=ALWAYS THEN                 00083470          
                                       L := L-1                         00083480          
                                  ELSE Z:=MCDR[Z]:=ZCONS(Q,NIL);        00083490          
                             END#;                                      00083500          
                                                                        00083510          
         Z := ALWAYS; MCDR[Z] := NIL;                                   00083520          
         IF NOT MNUMBERP(X) THEN NUMCHECK(X);                           00083530          
         IF SMALLP(X) THEN                                              00083540          
         BEGIN                                                          00083550          
              R := ZEXTEND(X); X := ABS(R);                             00083560          
              IF X>=BASE THEN                                           00083570          
              BEGIN L1 := 2;                                            00083580          
                   X:=ZCONS(ZTRACT(X DIV BASE),ZCONS(ZTRACT(X MOD BASE),00083590          
                        NIL));                                          00083600          
              END ELSE                                                  00083610          
              BEGIN L1 := 1;                                            00083620          
                   X := ZCONS(ZTRACT(X),NIL);                           00083630          
                   IF R=0 THEN R := 1;                                  00083640          
              END;                                                      00083650          
              MCAR[SOMETIMES] := X;                                     00083660          
         END                                                            00083670          
         ELSE                                                           00083680          
         BEGIN                                                          00083690          
              X.TAG := 0;                                               00083700          
              R := ZEXTEND(MCAR[X]); L1 := ABS(R); X := MCDR[X];        00083710          
         END;                                                           00083720          
         IF NOT MNUMBERP(Y) THEN NUMCHECK(Y);                           00083730          
         IF SMALLP(Y) THEN                                              00083740          
         BEGIN                                                          00083750          
              Y := ZEXTEND(Y); S := Y*R; Y := ABS(Y);                   00083760          
              L := L1;                                                  00083770          
              DO BEGIN                                                  00083780          
                   D := ZEXTEND(MCAR[X]) + BASE MUX V;                  00083790          
                   V := INTEGER(D MOD Y);                               00083800          
                   IF P>0 THEN                                          00083810          
                   BEGIN                                                00083820          
                        Q := ZTRACT(INTEGER(D DIV Y));                  00083830          
                        ADDON(Q,Z);                                     00083840          
                   END;                                                 00083850          
                   X := MCDR[X];                                        00083860          
              END UNTIL X=NIL;                                          00083870          
              V := ZTRACT(V&R[46:46:1]);                                00083880          
              GO TO FINI;                                               00083890          
         END;                                                           00083900          
         Y.TAG := 0;                                                    00083910          
         L2 := ZEXTEND(MCAR[Y]);                                        00083920          
         S := L2*R;;                                                    00083930          
         L2 := ABS(L2);                                                 00083940          
         L := L1-L2+1;                                                  00083950          
         IF SIZE(A)-2<=L1 THEN RESIZE(A,3*L1 DIV 2);                    00083955          
         FOR I:=L1 STEP -1 UNTIL 1 DO                                   00083960          
         BEGIN A[I] := ZEXTEND(MCAR[X]); X := MCDR[X] END;              00083970          
         IF SIZE(B)-2<=L2 THEN RESIZE(B,3*L2 DIV 2);                    00083975          
         FOR J:=L2 STEP -1 UNTIL 1 DO                                   00083980          
         BEGIN Y := MCDR[Y]; B[J] := ZEXTEND(MCAR[Y]) END;              00083990          
         A[L1+1] := A[0] := 0;                                          00084000          
         D := B[L2-1] + B[L2] MUX BASE;                                 00084010          
         FOR I:=L1 STEP -1 UNTIL L2 DO                                  00084020          
         BEGIN                                                          00084030          
              Q := INTEGER((A[I-1]+(A[I+1] MUX BASE+A[I]) MUX BASE) DIV 00084040          
                   D);                                                  00084050          
              U := 0; K := I-L2;                                        00084060          
              FOR J:=1 STEP 1 UNTIL L2 DO                               00084070          
              BEGIN                                                     00084080          
                   K := K+1;                                            00084090          
                   E := B[J] MUX Q + U; U := E DIV BASE;                00084100          
                   V := -INTEGER(E MOD BASE) + A[K];                    00084110          
                   IF V<0 THEN                                          00084120          
                   BEGIN U := U+1; V := V+BASE END;                     00084130          
                   A[K] := V;                                           00084140          
              END;                                                      00084150          
              IF A[K+1]<U THEN                                          00084160          
              BEGIN                                                     00084170          
                   Q := Q-1; K := I-L2; U := 0;                         00084180          
                   FOR J:=1 STEP 1 UNTIL L2 DO                          00084190          
                   BEGIN                                                00084200          
                        K := K+1;                                       00084210          
                        V := A[K]+B[J]+U;                               00084220          
                        IF V<BASE THEN                                  00084230          
                             U := 0                                     00084240          
                        ELSE                                            00084250          
                        BEGIN U := 1; V := V-BASE END;                  00084260          
                        A[K] := V;                                      00084270          
                   END;                                                 00084280          
              END;                                                      00084290          
              A[K+1] := 0;                                              00084300          
              IF P>0 THEN                                               00084310          
              BEGIN Q := ZTRACT(Q); ADDON(Q,Z) END;                     00084320          
         END;                                                           00084330          
         IF P NEQ 1 THEN                                                00084340          
         BEGIN A[0] := 1;                                               00084350          
              WHILE A[L2]=0 DO L2:=L2-1;                                00084360          
              IF L2>0 THEN                                              00084370          
              BEGIN                                                     00084380          
                   V := NIL;                                            00084390          
                   FOR J:=1 STEP 1 UNTIL L2 DO                          00084400          
                        V := ZCONS(ZTRACT(A[J]),V);                     00084410          
                   V := NORMALIZE(L2,R,V);                              00084420          
              END ELSE V := ZERO;                                       00084430          
FINI:                                                                   00084440          
              IF P=0 THEN                                               00084450          
              BEGIN                                                     00084460          
                   DIVISION := V;                                       00084470          
                   GO TO EXIT;                                          00084480          
              END;                                                      00084490          
         END;                                                           00084500          
         Z := IF Z=ALWAYS THEN ZERO ELSE NORMALIZE(L,S,                 00084510          
                             MCDR[ALWAYS]);                             00084520          
         MCDR[ALWAYS] := NIL;                                           00084530          
         DIVISION := IF P=1 THEN Z ELSE ZCONS(Z,V);                     00084540          
EXIT:                                                                   00084550          
    END DIVISION;                                                       00084560          
                                                                        00084570          
                                                                        00084580          
REAL PROCEDURE VPLUS2(X,Y); VALUE X,Y; REAL X,Y;                        00084590          
    BEGIN LABEL EXIT;                                                   00084600          
         DECLAREANDWEIGH;                                               00084610          
         IF OVERFLOWP(VPLUS2:=X+Y-ZERO) THEN                            00084620          
              VPLUS2 := ADDSUB(X,Y,1);                                  00084630          
         MICROBUMP(5);                                                  00084640          
         PRIMCOUNTER(29);                                               00084650          
    END VPLUS2;                                                         00084670          
                                                                        00084680          
REAL PROCEDURE VDIFFERENCE(X,Y); VALUE X,Y; REAL X,Y;                   00084690          
    BEGIN LABEL EXIT;                                                   00084700          
         DECLAREANDWEIGH;                                               00084705          
         IF NOT SMALLP(X) THEN                                          00084710          
              VDIFFERENCE := ADDSUB(X,Y,-1)                             00084720          
         ELSE IF OVERFLOWP(VDIFFERENCE:=X-Y+ZERO) THEN                  00084730          
              VDIFFERENCE := ADDSUB(X,Y,-1);                            00084740          
         MICROBUMP(6);                                                  00084750          
         PRIMCOUNTER(31);                                               00084760          
    END VDIFFERENCE;                                                    00084780          
                                                                        00084790          
REAL PROCEDURE MMINUS(X); VALUE X; REAL X;                              00084800          
    BEGIN LABEL EXIT;                                                   00084810          
         IF OVERFLOWP(MMINUS:=2*ZEROLIT-X) THEN                         00084820          
              MMINUS := IF BIGP(X) THEN                                 00084830          
                      ZCONS(-MCAR[X.FIELD]+2*ZEROLIT,MCDR[X.FIELD])&    00084840          
                             BIGTAG TAG                                 00084842          
                   ELSE ADDSUB(ZERO,X,1);                               00084850          
         MICROBUMP(5);                                                  00084860          
    END MMINUS;                                                         00084870          
                                                                        00084880          
REAL PROCEDURE MABS(X); VALUE X; REAL X;                                00084890          
    BEGIN LABEL EXIT;                                                   00084900          
         MABS := IF X>=ZERO THEN X ELSE                                 00084910          
              IF X>MINIMUM THEN 2*ZEROLIT-X ELSE                        00084920          
              IF X=MINIMUM THEN ADDSUB(ZERO,X,-1) ELSE                  00084930          
              IF NOT BIGP(X) THEN NUMCHECK(X) ELSE                      00084940          
              IF MCAR[X.FIELD]>ZERO THEN X ELSE                         00084950          
              ZCONS(-MCAR[X.FIELD]+2*ZEROLIT,MCDR[X.FIELD])&BIGTAG TAG; 00084960          
    END MABS;                                                           00084970          
                                                                        00084980          
REAL PROCEDURE VTIMES2(X,Y); VALUE X,Y; REAL X,Y;                       00084990          
    BEGIN LABEL EXIT;                                                   00085000          
         DECLAREANDWEIGH;                                               00085010          
         IF OVERFLOWP(VTIMES2 := (X-ZERO)*(Y-ZERO) + ZERO) THEN         00085020          
             VTIMES2 := MULTIPLY(X,Y);                                  00085030          
         MICROBUMP(6);                                                  00085040          
         PRIMCOUNTER(30);                                               00085050          
    END VTIMES2;                                                        00085070          
                                                                        00085080          
REAL PROCEDURE VQUOTIENT(X,Y); VALUE X,Y; REAL X,Y;                     00085090          
    BEGIN LABEL EXIT;                                                   00085100          
         DECLAREANDWEIGH;                                               00085110          
         IF Y=ZERO THEN ZEROERR;                                        00085120          
         IF SMALLP(REAL(BOOLEAN(X) AND BOOLEAN(Y))) AND X>MINIMUM THEN  00085130          
              VQUOTIENT := (X-ZERO) DIV (Y-ZERO) + ZERO ELSE            00085140          
              VQUOTIENT := DIVISION(X,Y,1);                             00085150          
         MICROBUMP(10);                                                 00085160          
         PRIMCOUNTER(31);                                               00085170          
    END VQUOTIENT;                                                      00085190          
                                                                        00085200          
REAL PROCEDURE VREMAINDER(X,Y); VALUE X,Y; REAL X,Y;                    00085210          
    BEGIN LABEL EXIT;                                                   00085220          
         DECLAREANDWEIGH;                                               00085230          
         IF Y=ZERO THEN ZEROERR;                                        00085240          
         VREMAINDER := IF SMALLP(REAL(BOOLEAN(X) AND BOOLEAN(Y))) THEN  00085250          
                             (X-ZERO) MOD (Y-ZERO) + ZERO               00085260          
                        ELSE DIVISION(X,Y,0);                           00085270          
         MICROBUMP(9);                                                  00085280          
         PRIMCOUNTER(36);                                               00085290          
     END VREMAINDER;                                                    00085310          
                                                                        00085320          
REAL PROCEDURE VEXPT(X,Y); VALUE X,Y; REAL X,Y;                         00085330          
    BEGIN                                                               00085340          
         DEFINE P=MCAR[SOMETIMES]#, Q=MCDR[SOMETIMES]#;                 00085350          
         DECLAREANDWEIGH;                                               00085360          
         IF X=ONE THEN VEXPT := ONE ELSE                                00085370          
         IF X=ZERO THEN VEXPT := ZERO ELSE                              00085380          
         IF X+1=ZERO THEN                                               00085390          
         BEGIN                                                          00085400          
              IF BIGP(Y) THEN                                           00085410          
              BEGIN Y.TAG := 0;                                         00085420          
                   P := ABS(MCAR[Y]-ZERO);                              00085430          
                   WHILE P>0 DO                                         00085440          
                   BEGIN Y := MCDR[Y]; P := P-1 END;                    00085450          
                   Y := MCAR[X];                                        00085460          
              END;                                                      00085470          
              VEXPT := IF BOOLEAN(Y) THEN X ELSE ONE;                   00085480          
         END ELSE                                                       00085490          
         IF BIGP(Y) THEN                                                00085500          
         BEGIN                                                          00085510          
              IF MCAR[Y.FIELD]<ZERO THEN                                00085520          
                   VEXPT := ZERO ELSE ZOVERFLOW;                        00085530          
         END ELSE                                                       00085540          
         IF Y<ZERO THEN VEXPT := ZERO ELSE                              00085550          
         BEGIN                                                          00085560          
              MICROBUMP(5);                                             00085570          
              P := ONE; Q := X; Y := Y-ZERO;                            00085580          
              WHILE Y>0 DO                                              00085590          
              BEGIN                                                     00085600          
                   MICROBUMP(6);                                        00085610          
                   IF BOOLEAN(Y) THEN                                   00085620          
                        P := IF P=ONE THEN Q ELSE VTIMES2(P,Q);         00085630          
                   Y := Y.[38:38];                                      00085640          
                   IF Y>0 THEN Q := VTIMES2(Q,Q);                       00085650          
              END;                                                      00085660          
              VEXPT := P;                                               00085670          
         END;                                                           00085680          
         P := Q := NIL;                                                 00085690          
         MICROBUMP(10);                                                 00085700          
         PRIMCOUNTER(61);                                               00085710          
    END VEXPT;                                                          00085730          
                                                                        00085740          
BOOLEAN PROCEDURE ZLESSP(A,B); VALUE A,B; REAL A,B;                     00085750          
    BEGIN LABEL EXIT;                                                   00085760          
         DECLAREANDWEIGH;                                               00085770          
         IF SMALLP(REAL(BOOLEAN(A) AND BOOLEAN(B))) THEN                00085780          
         BEGIN                                                          00085790          
              ZLESSP := A<B;                                            00085800          
              MICROBUMP(3);                                             00085810          
              GO TO EXIT;                                               00085820          
         END;                                                           00085830          
         IF SMALLP(REAL(BOOLEAN(A) OR BOOLEAN(B))) THEN                 00085840          
         BEGIN                                                          00085850          
              ZLESSP := IF BIGP(B) THEN MCAR[B.FIELD]>ZERO ELSE         00085860          
                        IF BIGP(A) THEN MCAR[A.FIELD]<ZERO ELSE         00085870          
                            NUMCHECK(A)>NUMCHECK(B);                    00085880          
              MICROBUMP(5);                                             00085890          
              GO TO EXIT;                                               00085900          
         END;                                                           00085910          
         IF NOT BIGP(REAL(BOOLEAN(A) AND BOOLEAN(B))) THEN              00085920          
         BEGIN NUMCHECK(A); NUMCHECK(B) END;                            00085930          
         MICROBUMP(5);                                                  00085940          
         A.TAG := 0; B.TAG := 0;                                        00085950          
         DO BEGIN                                                       00085960          
              IF MCAR[A] NEQ MCAR[B] THEN                               00085970          
              BEGIN                                                     00085980          
                   MICROBUMP(3);                                        00085990          
                   ZLESSP := MCAR[A]<MCAR[B];                           00086000          
                   GO TO EXIT;                                          00086010          
              END;                                                      00086020          
              MICROBUMP(4);                                             00086030          
              A := MCDR[A]; B := MCDR[B];                               00086040          
         END UNTIL B=NIL;                                               00086050          
EXIT:                                                                   00086060          
         MICROBUMP(4);                                                  00086070          
         PRIMCOUNTER(34);                                               00086080          
    END ZLESSP;                                                         00086100          
                                                                        00086110          
BOOLEAN PROCEDURE ZGREATERP(A,B); VALUE A,B; REAL A,B;                  00086120          
    BEGIN LABEL EXIT;                                                   00086130          
         DECLAREANDWEIGH;                                               00086140          
         IF SMALLP(REAL(BOOLEAN(A) AND BOOLEAN(B))) THEN                00086150          
         BEGIN                                                          00086160          
              ZGREATERP := A>B;                                         00086170          
              MICROBUMP(3);                                             00086180          
              GO TO EXIT;                                               00086190          
         END;                                                           00086200          
         IF SMALLP(REAL(BOOLEAN(A) OR BOOLEAN(B))) THEN                 00086210          
         BEGIN                                                          00086220          
              ZGREATERP := IF BIGP(B) THEN MCAR[B.FIELD]<ZERO ELSE      00086230          
                           IF BIGP(A) THEN MCAR[A.FIELD]>ZERO ELSE      00086240          
                            NUMCHECK(A)<NUMCHECK(B);                    00086250          
              MICROBUMP(5);                                             00086260          
              GO TO EXIT;                                               00086270          
         END;                                                           00086280          
         IF NOT BIGP(REAL(BOOLEAN(A) AND BOOLEAN(B))) THEN              00086290          
         BEGIN NUMCHECK(A); NUMCHECK(B) END;                            00086300          
         MICROBUMP(5);                                                  00086310          
         A.TAG := 0; B.TAG := 0;                                        00086320          
         DO BEGIN                                                       00086330          
              IF MCAR[A] NEQ MCAR[B] THEN                               00086340          
              BEGIN                                                     00086350          
                   MICROBUMP(3);                                        00086360          
                   ZGREATERP := MCAR[A]>MCAR[B];                        00086370          
                   GO TO EXIT;                                          00086380          
              END;                                                      00086390          
              MICROBUMP(4);                                             00086400          
              A := MCDR[A]; B := MCDR[B];                               00086410          
         END UNTIL B=NIL;                                               00086420          
EXIT:                                                                   00086430          
         MICROBUMP(4);                                                  00086440          
         PRIMCOUNTER(33);                                               00086450          
    END ZGREATERP;                                                      00086470          
                                                                        00086480          
BOOLEAN PROCEDURE ZEQN(A,B); VALUE A,B; REAL A,B;                       00086490          
    BEGIN LABEL EXIT;                                                   00086500          
         DECLAREANDWEIGH;                                               00086510          
         IF ZEQN:=A=B THEN GO TO EXIT;                                  00086520          
         IF BIGP(A) THEN IF BIGP(B) THEN                                00086530          
         BEGIN A.TAG := 0; B.TAG := 0;                                  00086540          
              MICROBUMP(5);                                             00086550          
              WHILE MCAR[A] = MCAR[B] DO                                00086560          
              BEGIN MICROBUMP(4);                                       00086570          
                   A := MCDR[A];                                        00086580          
                   IF A=NIL THEN                                        00086590          
                   BEGIN ZEQN := TRUE; GO TO EXIT END;                  00086600          
                   B := MCDR[B];                                        00086610          
              END;                                                      00086620          
         END;                                                           00086630          
EXIT:                                                                   00086640          
         MICROBUMP(4);                                                  00086650          
         PRIMCOUNTER(27);                                               00086660          
    END ZEQN;                                                           00086680          
                                                                        00086690          
                                                                        00086700          
 DEFINE XPLUS2      = ARG1:=VPLUS2(ARG1,ARG2)#,                         00086800          
        XTIMES2     = ARG1:=VTIMES2(ARG1,ARG2)#,                        00086900          
        XQUOTIENT   = ARG1:=VQUOTIENT(ARG1,ARG2)#,                      00087000          
        XREMAINDER  = ARG1:=VREMAINDER(ARG1,ARG2)#,                     00087100          
        XDIFFERENCE = ARG1:=VDIFFERENCE(ARG1,ARG2)#,                    00087200          
        XGREATERP   = ARG1:=TRUTH(ZGREATERP(ARG1,ARG2))#,               00087300          
        XLESSP      = ARG1:=TRUTH(ZLESSP(ARG1,ARG2))#,                  00087400          
        XEXPT       = ARG1:=VEXPT(ARG1,ARG2)#,                          00087500          
        XEQ         = ARG1:=VEQ(ARG1,ARG2)#,                            00087600          
        XEQN        = ARG1:=TRUTH(ZEQN(ARG1,ARG2))#;                    00087605          
                                                                        00087610          
                                                                        00087620          
  %   THIS SECTIONS CONTAINS MODULAR ARITHMETIC FUNCTIONS               00087622          
                                                                        00087624          
                                                                        00087626          
 DECLARE(XCMOD,7,BEGIN                                                  00087630          
                   IF BIGP(ARG1) THEN                                   00087632          
                      ARG1 := DIVISION(ARG1,PRIMEZ,0);                  00087634          
                   IF ARG1>=PRIMEZ THEN                                 00087636          
                      ARG1 := (ARG1-ZERO) MOD PRIME+ZERO                00087640          
                   ELSE IF ARG1<ZERO THEN                               00087650          
                      ARG1 := (ARG1-PRIMEX) MOD PRIME+ZERO;             00087660          
                 END);                                                  00087665          
                                                                        00087670          
 DECLARE(XCPLUS,8,ARG1 := -(IF ARG1+ARG2>=PRIMEZZ THEN                  00087680          
                               PRIMEZ ELSE ZERO)+ARG1+ARG2);            00087690          
                                                                        00087700          
 DECLARE(XCTIMES,9,ARG1 := ZTRACT(IF PRIMEBIG THEN                      00087710          
                        INTEGER(ZEXTEND(ARG1) MUX ZEXTEND(ARG2) MOD     00087720          
                                 PRIME) ELSE                            00087730          
                        ZEXTEND(ARG1)*ZEXTEND(ARG2) MOD PRIME));        00087740          
                                                                        00087750          
 DECLARE(XCDIF,10,ARG1 := (IF ARG1<ARG2 THEN PRIMEZ ELSE ZERO)+         00087760          
                               ARG1-ARG2);                              00087770          
                                                                        00087780          
                                                                        00087790          
PROCEDURE XSETMOD;                                                      00087800          
    BEGIN REAL D,G;                                                     00087810          
         DECLAREANDWEIGH;                                               00087820          
         G := D := ISPVALUE[GMOD.FIELD];                                00087830          
         IF ARG1=NIL THEN                                               00087840          
              G := NIL                                                  00087850          
         ELSE                                                           00087860          
         IF NOT SMALLP(ARG1) THEN                                       00087870          
              BEGIN MLIST(ARG1,ERRS[20]); ZERROR(120,ARG1) END          00087880          
         ELSE                                                           00087890          
         IF ARG1>ONE THEN                                               00087900          
         BEGIN                                                          00087910          
              G := PRIMEZ := ARG1;                                      00087920          
              PRIMEZZ := G+ZERO;                                        00087930          
              PRIME := G-ZERO;                                          00087940          
              PRIMEX := ZERO MOD PRIME;                                 00087950          
              PRIMEBIG := OVERFLOWP(ZTRACT(PRIME**2));                  00087960          
              MICROBUMP(6);                                             00087965          
         END;                                                           00087970          
         ARG1 := D;                                                     00087980          
         ISPVALUE[GMOD.FIELD] := G;                                     00087990          
         MICROBUMP(6);                                                  00087995          
         PRIMCOUNTER(4);                                                00088000          
    END XSETMOD;                                                        00088020          
                                                                        00088030          
PROCEDURE XCRECIP;                                                      00088040          
    BEGIN REAL A,B,X,Y,R;                                               00088050          
         DECLAREANDWEIGH;                                               00088060          
         X := PRIME; Y := ZEXTEND(ARG1); A := 1;                        00088070          
         WHILE Y>0 DO                                                   00088080          
         BEGIN                                                          00088090          
              R := -(X DIV Y)*A+B;                                      00088100          
              B := A; A := R;                                           00088110          
              R := X MOD Y;                                             00088120          
              X := Y; Y := R;                                           00088130          
         END;                                                           00088140          
         B := (IF B>0 THEN 0 ELSE PRIME) + (B MOD PRIME);               00088150          
         ARG1 := ZTRACT(B);                                             00088160          
         MICROBUMP(10);                                                 00088170          
         PRIMCOUNTER(6);                                                00088180          
    END XCRECIP;                                                        00088200          
                                                                        00088210          
                                                                        00088220          
PROCEDURE HI;                                                           00091000          
    BEGIN REAL N;                                                       00091010          
         ARRAY A[0:500];                                                00091020          
         LABEL EXIT;                                                    00091030          
         N := MYSELF.TASKVALUE; MYSELF.TASKVALUE := 0;                  00091040          
         CASE N OF                                                      00091050          
         BEGIN                                                          00091060          
    0:        ASKING := TRUE;                                           00091070          
    1:        ON INVALIDINDEX[A:N],                                     00091080          
                   BEGIN                                                00091090          
                        HIGH := TRUE;                                   00091095          
                        FAULTPROCESSOR(A,-4);                           00091100          
                        GO TO EXIT;                                     00091120          
                   END;                                                 00091130          
              N := MCAR[-1];                                            00091140          
    ELSE:;                                                              00091145          
         END;                                                           00091150          
EXIT:                                                                   00091340          
    END HI;                                                             00091350          
                                                                        00091360          
INTERRUPT ANSWER; HI;                                                   00091370          
                                                                        00091380          
PROCEDURE INITFREECHAIN;                                                00091600          
BEGIN                                                                   00091610          
REAL P,S;                                                               00091620          
S:=PSPFREE DIV PAGESIZE;                                                00091630          
WHILE P<=S DO                                                           00091640          
BEGIN                                                                   00091650          
    PPAGEUSED[P]:=TRUE;                                                 00091660          
    P:=P+1;                                                             00091670          
END INITPAGEUSED;                                                       00091680          
INUSE:=P*PAGESIZE;                                                      00091690          
WORKSET:=PSPFREE;                                                       00091700          
RHO:=100;                                                               00091710          
WHILE P<PPAGEMAX DO                                                     00091720          
BEGIN                                                                   00091730          
    PPAGEUSED[P]:=FALSE;                                                00091740          
    P:=P+1;                                                             00091750          
END INITPAGEFREE;                                                       00091760          
P:=PSPFREE; S:=(PSPFREE+PAGESIZE) DIV PAGESIZE * PAGESIZE;              00091770          
DO BEGIN                                                                00091780          
    MCAR[P]:=MAXFIELDV;              %  MARK WITH SILLY NUMBER.         00091790          
    P:=MCDR[P]:=P+1;                                                    00091800          
END UNTIL P=S;                                                          00091810          
MCDR[P-1]:=-1;                                                          00091820          
P:=MYSELF.COREESTIMATE;                                                 00091830          
P:=(P-50000) DIV 2;                                                     00091840          
P:=MAX(PSPFREE+PAGESIZE*4,P);                                           00091850          
P:=(P+PAGESIZE) DIV PAGESIZE;                                           00091860          
APAGEMAX:=MIN(PPAGEMAX,P);                                              00091870          
WRITETTY("PAIR SPACE =" CAT APAGEMAX FOR 4 NUMERIC CAT " PAGES");       00091880          
P:=ISPFREE;                                                             00091890          
DO BEGIN                                                                00091900          
    ISPPNAME[P]:=0; ISPPROP[P]:=MAXFIELDV;                              00091910          
    ISPVALUE[P].FIELD:=P+1;                                             00091920          
    ISPVALUE[P].TAG:=IDTAG;                                             00091930          
    P:=P+1;                                                             00091940          
END UNTIL P=AISPMAX;                                                    00091950          
ISPVALUE[AISPMAX-1].FIELD:=ISPMAX+1;                                    00091960          
VSP[0]:=VSPMAX-2; VSP[1]:=-1;    % INITIALLY ONE OBJECT FULL LENGTH.    00091970          
END INITFREECHAIN;                                                      00091980          
                                                                        00091990          
PROCEDURE INITIALIZE;                                                   00092000          
BEGIN                                                                   00092100          
REAL TMP;                                                               00092200          
                                                                        00092300          
% LARGE SYSTEM INITIALIZATIONS                                          00092400          
$ SET OMIT = SLOWSTACK OR COUNT                                         00092410          
MTEMP:="LOCAL ";                                                        00092420          
MTEMPLOC:=STACKOFFSET(MTEMP);                                           00092430          
MTEMPLOC:=MASKSTACKSEARCHER("LOCAL ",4"FFFFFFFFFF00",RCVLOC,MTEMPLOC);  00092440          
$ POP OMIT                                                              00092460          
TSPMAX := ESPMAX := PAGESIZE;                                           00092500          
ATTACH ANSWER TO MYSELF.EXCEPTIONEVENT;                                 00092600          
ENABLE ANSWER;                                                          00092700          
CONVERTPTR:=POINTER(CONVERTARRAY,8);                                    00092800          
REPLACE COLLECTOR BY " " FOR 132;                                       00092900          
WRITETTY("OPTIONS SET: " CAT                                            00093000          
 $ POP OMIT SET OMIT = NOT COUNT                                        00093300          
   " COUNT" CAT                                                         00093400          
 $ POP OMIT SET OMIT = NOT SLOWSTACK                                    00093500          
   " SLOWSTACK" CAT                                                     00093600          
 $ POP OMIT SET OMIT = NOT NEWP                                         00093620          
   " NEWP INTRINSICS" CAT                                               00093640          
 $ POP OMIT SET OMIT = NOT FASTLINK                                     00093700          
   " FASTLINK" CAT                                                      00093800          
 $ POP OMIT                                                             00094700          
   " ");                                                                00094800          
NIL := 0 & IDTAG TAG;                                                   00094900          
T := TRUTH(TRUE);                                                       00095000          
ZERO := ZEROLIT; ONE := ZERO+1; TWO := ONE+1; THREE := TWO+1;           00095100          
 $ SET OMIT = NOT COUNT                                                 00095500          
   FILL TRACETABLE WITH                                                 00095600          
         "EXPLODE     ",  %0                                            00095700          
         "CATCH       ",  %1                                            00095800          
         "LENGTHC     ",  %2                                            00095900          
         "GENSYM      ",  %3                                            00096000          
         "SETMOD      ",  %4                                            00096100          
         "COMPRESS    ",  %5                                            00096200          
         "CRECIP      ",  %6                                            00096300          
         "CMOD        ",  %7                                            00096400          
         "CPLUS       ",  %8                                            00096500          
         "CTIMES      ",  %9                                            00096600          
         "CDIF        ",  %10                                           00096700          
         "REMOB       ",  %11                                           00096800          
         "RCONS       ",  %12                                           00096900          
         "NCONS       ",  %13                                           00097000          
         "CONS        ",  %14                                           00097100          
         "RPLACA      ",  %15                                           00097200          
         "RPLACD      ",  %16                                           00097300          
         "TERPRI      ",  %17                                           00097400          
         "PRINC       ",  %18                                           00097500          
         "THROW       ",  %19                                           00097600          
         "INTERN      ",  %20                                           00097700          
         "READCH      ",  %21                                           00097800          
         "LAMBIND     ",  %22                                           00097900          
         "QUIT        ",  %23                                           00098000          
         "PATOM       ",  %24                                           00098100          
         "PATOM2      ",  %25                                           00098200          
         "EQ          ",  %26                                           00098300          
         "EQN         ",  %27                                           00098400          
         "RECLAIM     ",  %28                                           00098500          
         "PLUS2       ",  %29                                           00098600          
         "TIMES2      ",  %30                                           00098700          
         "DIFFERENCE  ",  %31                                           00098800          
         "QUOTIENT    ",  %32                                           00098900          
         "GREATERP    ",  %33                                           00099000          
         "LESSP       ",  %34                                           00099100          
         "SCAN        ",  %35                                           00099200          
         "REMAINDER   ",  %36                                           00099300          
         "UNSTACK     ",  %37                                           00099400          
         "CLOSE       ",  %38                                           00099500          
         "EJECT       ",  %39                                           00099600          
         "$APPLY      ",  %40                                           00099700          
         "OPEN        ",  %41                                           00099800          
         "POSN        ",  %42                                           00099900          
         "RDS         ",  %43                                           00100000          
         "WRS         ",  %44                                           00100100          
         "XXFNPTR     ",  %45                                           00100200          
         "GETV        ",  %46                                           00100300          
         "MKVECT      ",  %47                                           00100400          
         "PUTV        ",  %48                                           00100500          
         "UPLIM       ",  %49                                           00100600          
         "TIME        ",  %50                                           00100700          
         "PUTPROP     ",  %51                                           00100800          
         "GETPROP     ",  %52                                           00100900          
         "PUTG        ",  %53                                           00101000          
         "GETG        ",  %54                                           00101100          
         "DUMP        ",  %55                                           00101200          
         "ORDERP      ",  %56                                           00101300          
         "CHKPOINT    ",  %57                                           00101400          
         "CONSTANTP   ",  %58                                           00101500          
         "VECTORP     ",  %59                                           00101600          
         "SETPCHAR    ",  %60                                           00101700          
         "EXPT        ",  %61                                           00101800          
         "EQUAL       ",  %62                                           00101900          
         "LENGTH      ",  %63                                           00102000          
         "REVERSIP    ",  %64                                           00102100          
         "MEMQ        ",  %65                                           00102200          
         "MEMBER      ",  %66                                           00102300          
         "LITER       ",  %67                                           00102400          
         "DIGIT       ",  %68                                           00102500          
         "GET         ",  %69                                           00102600          
         "GETD        ",  %70                                           00102700          
         "GLOBALP     ",  %71                                           00102800          
         "FLUIDP      ",  %72                                           00102900          
         "GLOBAL      ",  %73                                           00103000          
         "FLUID       ",  %74                                           00103100          
         "UNFLUID     ",  %75                                           00103200          
         "PUTD        ",  %76                                           00103300          
         "CALL FSUBR  ",  %77                                           00103400          
         "CALL SUBR   ",  %78                                           00103500          
         "ATOM        ",  %79                                           00103600          
         "LIST        ",  %80                                           00103700          
         "QUOTE       ",  %81                                           00103800          
         "CAR         ",  %82                                           00103900          
         "CDR         ",  %83                                           00104000          
         "NULL        ",  %84                                           00104100          
         "CODEP       ",  %85                                           00104110          
         "IDP         ",  %86                                           00104120          
         "NUMBERP     ",  %87                                           00104130          
         "PAIRP       ",  %88                                           00104140          
         "STRINGP     ",  %89                                           00104150          
         "ALLOC       ",  %90                                           00104700          
         "DEALLOC     ",  %91                                           00104800          
         "M-PROGBIND  ",  %92                                           00104900          
         "M-LAMBBIND  ",  %93                                           00105000          
         "STORE       ",  %94                                           00105100          
         "STOREXXXXX  ",  %95                                           00105200          
         "SET LOCAL   ",  %96                                           00105300          
         "XXXX        ",  %97                                           00105400          
         "GO TO       ",  %98                                           00105500          
         "COND JUMP   ",  %99                                           00105600          
         "LOAD        ",  %100                                          00105700          
         "FAST-LINK   ",  %101                                          00105710          
         "SLOW-LINK   ",  %102                                          00105720          
         "M-LINK      ",  %103                                          00105730          
         "LIT PLUS    ",  %104                                          00105732          
         "LIT DIFF    ",  %105                                          00105734          
          0;                                                            00105800          
 $ POP OMIT                                                             00105900          
                                                                        00106000          
%SET UP POINTERS.                                                       00106100          
ISPFREE := PSPFREE := VSPFREE := GGENSYM := 0;                          00106200          
TSP[0] := 0; TSPPTR := 1;        %STACK BOTTOM AND POINTER.             00106300          
INPTR := -1;                                                            00106400          
CURCHANOUT := CURCHANIN := OUTPTR := 0;                                 00106500          
FILEINUSEA:=FALSE;       %NONE OF THE AUXILIARY FILES ARE IN USE.       00106600          
REPLACE LINER BY " " FOR INSZE;                                         00106700          
REPLACE OUTER BY " " FOR 132;                                           00106800          
MICROCOUNT := 1;                     %MICRO COUNTER TO 1.               00106900          
ARG16 := NIL;                     %REG 16 = NIL ALWAYS!!!               00107000          
AISPMAX := 512;                                                         00107100          
                                                                        00107200          
%READ THE INIT FILE.                                                    00107300          
FASTLOAD;                                                               00107400          
                                                                        00107500          
%BUILD THE FREE CELL LIST.                                              00107600          
INITFREECHAIN;                                                          00107700          
ALWAYS := ZCONS(NIL,NIL); SOMETIMES := ZCONS(NIL,NIL);                  00108110          
YINITIALISE;                                                            00108200          
TMP:=GINITIALISE.FIELD;                                                 00108300          
QPTR := ISPPNAME[TMP].QSPPTR-1;                                         00108400          
ISPVALUE[TMP] := ISPPROP[TMP] := NIL;                                   00108600          
GINITIALISE := NIL;                                                     00108700          
 $ SET OMIT = NOT COUNT                                                 00108800          
  ISPCNT[TMP] := ISPWEIGHT[TMP] := 0;                                   00108900          
 $ POP OMIT                                                             00109000          
GARBAGETIME := 0;                                                       00109010          
OLDTIME := BEGINTIME := TIME(12);                                       00109020          
END INITIALIZE;                                                         00109100          
                                                                        00109200          
                                                                        00109500          
PROCEDURE RMARKCELL(GP); VALUE GP; REAL GP;                             00109600          
BEGIN REAL BP,SP,GA,GB,I;                                               00109700          
    BP := SP := TSPPTR+1;                                               00109800          
    IF SP+1>=TSPMAX THEN                                                00109900          
      EXPANDSTACK;                                                      00110000          
    RPUSH(-1);               % TO RECOGNIZE FINISH.                     00110100          
    DO BEGIN                                                            00110200          
            IF SP+1>=TSPMAX THEN                                        00110300          
                EXPANDSTACK;                                            00110400          
            IF MPAIRP(GP) THEN                                          00110500          
            BEGIN                                                       00110600          
                GB:=MCAR[GP];                                           00110700          
                IF MGARBAGEP(GB) THEN                                   00110800          
                  GP:=RPOP                                              00110900          
                ELSE                                                    00111000          
                BEGIN                                                   00111100          
                  MGARBAGEP(MCAR[GP]):=TRUE;                            00111200          
                  IF IGNORE(GB) THEN                                    00111300          
                  BEGIN                                                 00111310          
                     GB:=MCDR[GP];                                      00111320          
                     GP:=IF IGNORE(GB) THEN RPOP ELSE GB                00111330          
                  END                                                   00111340          
                  ELSE                                                  00111350          
                  BEGIN                                                 00111360          
                     GP:=MCDR[GP];                                      00111370          
                     IF NOT IGNORE(GP) THEN                             00111380          
                        RPUSH(GP);                                      00111390          
                     GP:=GB;                                            00111400          
                  END;                                                  00111410          
                END;                                                    00111500          
            END ELSE                                                    00111600          
            IF MIDP(GP) THEN                                            00111700          
            BEGIN                                                       00111800          
                GB:=ISPVALUE[GP.FIELD];                                 00111810          
                IF MGARBAGEP(GB) THEN                                   00111900          
                  GP:=RPOP                                              00112000          
                ELSE                                                    00112100          
                BEGIN                                                   00112200          
                  MGARBAGEP(ISPVALUE[GP.FIELD]):=TRUE;                  00112400          
                  IF STRINGSNEEDIT THEN                                 00112600          
                     RPUSH(STRINGIZE(ISPPNAME[GP.FIELD]));              00112700          
                  IF IGNORE(GB) THEN                                    00112710          
                  BEGIN                                                 00112720          
                     GB:=ISPPROP[GP.FIELD];                             00112730          
                     GP:=IF IGNORE(GB) THEN RPOP ELSE GB;               00112740          
                  END                                                   00112750          
                  ELSE                                                  00112760          
                  BEGIN                                                 00112770          
                     GP:=ISPPROP[GP.FIELD];                             00112780          
                     IF NOT IGNORE(GP) THEN                             00112790          
                        RPUSH(GP);                                      00112800          
                     GP:=GB                                             00112810          
                  END;                                                  00112820          
                END;                                                    00112900          
            END ELSE                                                    00113000          
            IF MSTRINGP(GP) THEN                                        00113100          
            BEGIN                                                       00113200          
                GB:=GP.BUCKF; GP:=GP.SLOCF;                             00113500          
                IF GB>0 THEN                                            00113600          
                REPLACE SSP[GB,GP+1] BY (REAL(SSP[GB,GP+1],2)&1 SPGARBF)00113700          
                              .[15:48] FOR 2;                           00113800          
                GP:=RPOP;                                               00114000          
            END ELSE                                                    00114100          
            IF MVECTORP(GP) THEN                                        00114200          
            BEGIN                                                       00114300          
              IF NOT MGARBAGEP(VSP[GP.FIELD]) THEN                      00114400          
              BEGIN                                                     00114700          
                GB := ZEXTEND(VSP[GP:=GP.FIELD])+1;                     00114800          
                MGARBAGEP(VSP[GP]):=TRUE;                               00114900          
                WHILE GB+SP>=TSPMAX DO EXPANDSTACK;                     00115000          
                I:=1;                                                   00115010          
                DO BEGIN                                                00115030          
                   GA:=VSP[GP+I];                                       00115040          
                   IF NOT IGNORE(GA) THEN                               00115050          
                      RPUSH(GA);                                        00115060          
                END UNTIL I:=I+1>GB;                                    00115070          
              END;                                                      00115500          
              GP:=RPOP;                                                 00115510          
            END ELSE                                                    00115600          
            IF BIGP(GP) THEN                                            00115610          
                 GP.TAG := 0                                            00115620          
            ELSE GP:=RPOP;                                              00115630          
    END UNTIL SP=BP;                                                    00115900          
END RMARKCELL;                                                          00116000          
                                                                        00116100          
                                                                        00116200          
PROCEDURE ZGARBAGE(Y); VALUE Y; REAL Y;                                 00116300          
%  THIS IS THE GARBAGE COLLECTOR. IT EXPECTS ONE ARGUMENT IN Y          00116400          
% WHICH IS A STRING GIVING THE REASON FOR THE GARBAGECOLLECTION.        00116500          
BEGIN LABEL FINDUSED,FINI;                                              00116600          
REAL S,P,Q,R,PAVAILABLE,IAVAILABLE,GP;                                  00116700          
REAL T1,T2,T3,NUWORK,NUINUSE;                                           00116800          
ARRAY FA[0:500];                                                        00116900          
                                                                        00117000          
DEFINE MARKCELL(X) =                                                    00117100          
    BEGIN                                                               00117200          
         GP:=X;                                                         00117300          
         IF NOT IGNORE(GP) THEN                                         00117350          
         IF NOT MGARBAGEP(IF MIDP(GP) THEN ISPVALUE[GP.FIELD] ELSE      00117400          
              IF MPAIRP(GP) THEN MCAR[GP] ELSE 0) THEN                  00117410          
                 RMARKCELL(GP);                                         00117600          
    END MARKCELL#;                                                      00117700          
                                                                        00117800          
                                                                        00117900          
T1:=TIME(12);                                                           00118000          
DISABLE ANSWER;                                                         00118010          
IF ISPVALUE[GCFLAG.FIELD] NEQ NIL THEN                                  00118100          
BEGIN                                                                   00118200          
  CASE Y OF                                                             00118300          
  BEGIN                                                                 00118400          
    REPLACE CONVERTPTR BY "PAIR SPACE  ";                               00118500          
    REPLACE CONVERTPTR BY "ID SPACE    ";                               00118600          
    REPLACE CONVERTPTR BY "USER REQUEST";                               00118700          
    REPLACE CONVERTPTR BY "VECTOR SPACE";                               00118800          
  END;                                                                  00118900          
  WRITETTY("GARBAGE COLLECTION FOR " CAT CONVERTPTR FOR 12);            00119000          
END;                                                                    00119100          
IF ISPVALUE[GCFLAG.FIELD] = ONE THEN                                    00119200          
BEGIN                                                                   00119300          
  P:=0;                                                                 00119400          
  ON ZERODIVIDE[FA:P]:                                                  00119500          
    FAULTPROCESSOR(FA,1);                                               00119600          
  P:=P/P;                                                               00119700          
END;                                                                    00119800          
% THAT PUTS OUT THE MESSAGE IF NECESSARY;                               00119900          
STRINGSNEEDIT := NEWSCNT1>NEWSCNT2;                                     00119990          
IGNORABLES.TAG :=                                                       00120000          
      IF STRINGSNEEDIT THEN FUNCTTAG ELSE FUNCTTAG+STRINGTAG;           00120010          
IGNORABLES:=IGNORABLES+MINIMUM;                                         00120020          
MGARBAGEP(IGNORABLES):=TRUE;                                            00120030          
NEWSCNT2 := NEWSCNT1;                                                   00120100          
FOR P:=1 STEP 1 UNTIL APAGEMAX DO                                       00120200          
  PPAGEUSED[P]:=FALSE;                                                  00120300          
PPAGEUSED[0]:=TRUE;                  % MARK FOR NIL.                    00120400          
S:=QPTR-1;     % THE Q POINTER.                                         00120410          
MGARBAGEP(ISPVALUE[NIL.FIELD]):=TRUE;                                   00120500          
Q:=GLOBLENGTH;                                                          00120510          
GLOBALVECT[Q:=Q+1]:=ISPPROP[NIL.FIELD];                                 00120600          
GLOBALVECT[Q:=Q+1]:=STRINGIZE(ISPPNAME[NIL.FIELD]);                     00120700          
GLOBALVECT[Q:=Q+1]:=ZA; GLOBALVECT[Q:=Q+1]:=ZB;                         00120900          
ZA := ZB := NIL;                                                        00121000          
GLOBALVECT[Q:=Q+1]:=ALWAYS; GLOBALVECT[Q:=Q+1]:=SOMETIMES;              00121010          
FOR P:=0 STEP 1 UNTIL Q DO                                              00121100          
    MARKCELL(GLOBALVECT[P]);            % MARK THE GLOBALS.             00121200          
FOR P:=0 STEP 1 UNTIL 15 DO                                             00121300          
    MARKCELL(ARGS[P]);                                                  00121400          
P:=0;                                                                   00121500          
IF STRINGSNEEDIT THEN DO MARKCELL(ERRS[P]) UNTIL ERRS[P:=P+1] = 0;      00121600          
FOR P:=0 STEP 1 UNTIL S DO                                              00121700          
    MARKCELL(QSP[P]);                                                   00121800          
% MARK THE STACK NOW;                                                   00121900          
FOR P:=1 STEP 1 UNTIL ES DO                                             00122000          
     MARKCELL(ESP[P]);                                                  00122100          
Q := TSPPTR - 1;                     % THE INITIAL STACKFRAME;          00122200          
WHILE Q>0 DO                                                            00122300          
BEGIN                                                                   00122400          
    P:=TSP[Q] -1;                    % THE NEXT FRAME, -1 FOR OFFSET    00122500          
    Q:=Q-1;                                                             00122600          
    R:=(IF TSP[Q]=GBPROG THEN 3 ELSE 0)+P;   % IGNORE FUNNIES IN BPROG  00122700          
     DO BEGIN                                                           00122800          
        MARKCELL(TSP[Q]);                                               00122900          
        Q:=Q-1;                                                         00123000          
     END UNTIL Q<=R;          % FINISHED FRAME;                         00123100          
    Q:=P;                                                               00123200          
END SCANSTACK;                                                          00123300          
 $ SET OMIT = SLOWSTACK OR COUNT                                        00123400          
P:=STACKOFFSET(P); S:=MTEMPLOC; MTEMP:="LOCAL ";                        00123500          
WHILE P:=MASKSTACKSEARCHER("LOCAL ",4"FFFFFFFFFF00",RCVLOC,P-1) > S DO  00123600          
BEGIN                                                                   00123700          
  R:=RCVLOC[0].[6:7];                                                   00123800          
  IF R>0 THEN                                                           00123900          
  BEGIN                                                                 00124000          
    CHECKSTACK(R);                                                      00124100          
    COPYFROMSTACK(R,POINTER(TSP[TSPPTR]),P+1);                          00124200          
    Q:=TSPPTR;                                                          00124300          
    TSPPTR:=Q+R;                                                        00124400          
    DO BEGIN                                                            00124500          
      MARKCELL(TSP[Q]);                                                 00124600          
      Q:=Q+1;                                                           00124700          
    END UNTIL Q=TSPPTR;                                                 00124800          
    TSPPTR:=*-R;                                                        00124900          
  END;                                                                  00125000          
END;                                                                    00125100          
 $ POP OMIT                                                             00125200          
% END OF PHASE ONE. NOW HAVE TO DO SCAN OF OBLIST RECHAINING            00125300          
% AND THEN THE LINEAR SCAN  OF THE P AND I SPACES;                      00125400          
%SEGMENT(PHASE2);                                                       00125500          
P:=1;                                                                   00126200          
DO BEGIN                                                                00126300          
  IF MINTERNED(ISPPNAME[P]) THEN                                        00126400          
    IF NOT MGARBAGEP(ISPVALUE[P]) THEN                                  00126500          
      IF ISPVALUE[P] NEQ NIL THEN RMARKCELL(P&IDTAG TAG) ELSE           00126600          
      IF ISPPROP[P] NEQ NIL THEN RMARKCELL(P&IDTAG TAG) ELSE            00126700          
      IF MGLOBALP(P) THEN RMARKCELL(P&IDTAG TAG) ELSE                   00126800          
      IF MFLUIDP(P) THEN RMARKCELL(P&IDTAG TAG);                        00126900          
  P:=P+1                                                                00127000          
END UNTIL P>ISPHIGH;                                                    00127100          
T2:=TIME(12);                                                           00127200          
                                                                        00127300          
% THE USED STORE IS NOW MARKED. WE MUST DO A LINEAR SCAN                00127400          
% OF THE I AND P SPACES TO CONSTRUCT A FREE CHAIN;                      00127500          
R:=APAGEMAX-1;                        % TOP PAGE;                       00127600          
PSPFREE:=-1;                            % JUST IN CASE IT WAS I SPACE.  00127700          
PAVAILABLE:=0;                                                          00127800          
DO BEGIN                                                                00127900          
  P:=(R+1)*PAGESIZE-1;                    % TOP OF THE PAGE;            00128000          
  Q := 0; MGARBAGEP(Q) := TRUE;                                         00128100          
  REPLACE SEARCHPAGE BY POINTER(MCAR[PAGESIZE*R]) FOR PAGESIZE WORDS;   00128150          
  IF MASKSEARCH(Q,Q,SEARCHPAGE[PAGESIZE-1])>=0 THEN                     00128200          
  BEGIN                                                                 00128300          
   NUINUSE:=*+PAGESIZE;                                                 00128400          
   PPAGEUSED[R] := TRUE;                                                00128500          
   S:=P-PAGESIZE;                                                       00128600          
   DO BEGIN                                                             00128700          
    Q:=MCAR[P];                                                         00128900          
    IF NOT MGARBAGEP(Q) THEN                                            00129000          
    BEGIN                                                               00129100          
        PAVAILABLE:=*+1;                                                00129200          
        MCAR[P]:=MAXFIELDV;             % PLACE ON FREE LIST;           00129300          
        MCDR[P]:=PSPFREE;                                               00129400          
        PSPFREE:=P;                                                     00129500          
    END                                                                 00129600          
    ELSE                           % JUST UNMARK;                       00129700          
    BEGIN NUWORK:=*+1;                                                  00129800          
      MGARBAGEP(MCAR[P]):=FALSE;                                        00129900          
    END;                                                                00130000          
    P:=P-1;                                                             00130100          
   END UNTIL P=S;                                                       00130200          
  END                                                                   00130300          
  ELSE                                                                  00130400          
  BEGIN                                                                 00130500          
    PPAGEUSED[R] := FALSE;                                              00130600          
    PAVAILABLE := *+PAGESIZE;                                           00130700          
  END;                                                                  00130800          
  R:=*-1;                                                               00130900          
END UNTIL R<0;                                                          00131000          
IF ISPFREE=ISPMAX+1 OR Y=1 THEN                                         00131100          
IF AISPMAX<ISPMAX THEN                                                  00131200          
  RESIZE(ISPPNAME,AISPMAX:=*+PAGESIZE,RETAIN);                          00131300          
P:=AISPMAX - 1;                        % THE BASE OF THE I SPACE;       00131400          
ISPFREE:=ISPMAX+1;                                                      00131500          
IAVAILABLE:=0;                                                          00131600          
ISPHIGH:=0;                                                             00131700          
DO BEGIN                                                                00131800          
    IF NOT MGARBAGEP(ISPVALUE[P]) THEN BEGIN                            00132000          
        IAVAILABLE:=*+1;                                                00132100          
        ISPVALUE[P].FIELD:=ISPFREE;                                     00132200          
        ISPVALUE[P].TAG:=IDTAG;                                         00132300          
        ISPPNAME[P]:=ISPPROP[P]:=MAXFIELDV;                             00132400          
        ISPFREE:=P;                                                     00132500          
        END                                                             00132600          
    ELSE BEGIN                                                          00132700          
        MGARBAGEP(ISPVALUE[P]):=FALSE;                                  00132800          
        IF ISPHIGH=0 THEN ISPHIGH:=P;                                   00132900          
    END;                                                                00133000          
    P:=P-1;                                                             00133100          
END UNTIL P<0;                                                          00133200          
R:=1;                                                                   00133300          
IF STRINGSNEEDIT THEN                                                   00133400          
DO BEGIN                                                                00133500          
    P:=0;                                                               00133600          
    WHILE S:=(Q:=REAL(SSP[R,P],3)).[23:8] > 0 DO                        00133700          
    BEGIN                                                               00133800          
        IF BOOLEAN(Q).SPGARBF THEN                                      00133900          
        BEGIN                                                           00134000          
            REPLACE SSP[R,P] BY (Q&0 SPGARBF).[23:48] FOR 3;            00134100          
            P:=P+S+3;                                                   00134200          
        END                                                             00134300          
        ELSE                                                            00134400          
        BEGIN                                                           00134500          
            Q:=P;                                                       00134600          
            DO BEGIN                                                    00134700          
                P:=P+S+3;                                               00134800          
                S:=REAL(SSP[R,P],1);                                    00134900          
            END UNTIL P-Q+S>255 OR S=0 OR                               00135000          
                        BOOLEAN(REAL(SSP[R,P],3).SPGARBF);              00135100          
            REPLACE SSP[R,Q] BY (0&1 FREEF & (P-Q-3)[23:8]).[23:48]     00135200          
                FOR 3;                                                  00135300          
        END;                                                            00135400          
    END;                                                                00135500          
    R:=R+1;                                                             00135600          
END UNTIL P=0 AND R>SSPHBUCKETS;                                        00135700          
P:=0; VSPFREE:=-1; R:=-1;                                               00135800          
DO BEGIN                                                                00135900          
    Q:=P;                                                               00136000          
    WHILE P<VSPMAX DO                                                   00136100          
    BEGIN                            % END OF VECTOR SPACE.             00136200          
        IF MGARBAGEP(VSP[P]) THEN BEGIN                                 00136300          
            MGARBAGEP(VSP[P]):=FALSE; GO TO FINDUSED; END;              00136400          
        P:=P+VSP[P].FIELD+2;                                            00136500          
    END;                                                                00136600          
FINDUSED:                                                               00136700          
    IF P NEQ Q THEN BEGIN                                               00136800          
        VSP[Q]:=P-Q-2;                 % LENGTH OF GAP.                 00136900          
        VSP[Q+1]:=-1;                    % TERMINATE THE CHAIN.         00137000          
        IF R<0 THEN VSPFREE:=Q  ELSE VSP[R+1]:=Q;                       00137100          
        R:=Q;                                                           00137200          
    END;                                                                00137300          
    IF P>=VSPMAX THEN GO TO FINI;      % FINISHED.                      00137400          
    P:=P+VSP[P].FIELD+2;                                                00137500          
END UNTIL FALSE;                                                        00137600          
FINI:                                                                   00137700          
IF PAVAILABLE<4*PAGESIZE THEN                                           00137800          
BEGIN                                                                   00137900          
  P:=APAGEMAX;                                                          00138000          
  APAGEMAX:=MIN(APAGEMAX+4,PPAGEMAX);                                   00138100          
  PAVAILABLE:=*+(APAGEMAX-P)*PAGESIZE;                                  00138200          
END;                                                                    00138300          
T3:=TIME(12);                                                           00138400          
GARBAGETIME:=T3-T1+GARBAGETIME;                                         00138500          
IF ISPVALUE[GCFLAG.FIELD] NEQ NIL THEN                                  00138600          
       IF NOT BREAK THEN                                                00138700          
       BEGIN                                                            00138800          
  WRITETTY("GC END; PAIR AVAIL = " CAT DECIMAL(PAVAILABLE,6)            00138900          
     CAT ", SYMBOL AVAIL = " CAT DECIMAL(IAVAILABLE,4));                00139000          
  BREAK:=WRITE(ME,<2A6," =",I6,",",F10.3>,                              00139100          
       "PREV F","REE   ",INUSE-WORKSET,(T1-OLDTIME)*2.4@-3/             00139200          
                            (INUSE-WORKSET),                            00139300          
       "TOTAL ","PAIRS ",NUINUSE,(T3-T2)*2.4@-3/NUINUSE,                00139400          
       "IN USE"," PAIRS",NUWORK,(T2-T1)*2.4@-3/NUWORK);                 00139500          
  BREAK:=WRITE(ME,<"TOTAL TIME = ",F7.2,",  GC TIME =",F7.2,            00139600          
    ",  THIS TIME =", F5.2,F7.2,"%">,                                   00139700          
      (T3-BEGINTIME)*2.4@-6,GARBAGETIME*2.4@-6,(T3-T1)*2.4@-6,          00139800          
      100*GARBAGETIME/(T3-BEGINTIME));                                  00139900          
END;                                                                    00140000          
INUSE:=NUINUSE; WORKSET:=NUWORK; OLDTIME:=T3;                           00140100          
ENABLE ANSWER;                                                          00140110          
IF (PAVAILABLE=0) OR (IAVAILABLE=0) THEN                                00140200          
  ZERROR(110, ERRS[10]);                                                00140300          
END ZGARBAGE;                                                           00140400          
                                                                        00140500          
                                                                        00140600          
PROCEDURE XRECLAIM;                                                     00140700          
BEGIN LABEL EXIT;                                                       00140800          
    DECLAREANDWEIGH;                                                    00140810          
    ARG1:=NIL; ZGARBAGE(2);                                             00140900          
    MICROBUMP(5);                                                       00140910          
    PRIMCOUNTER(28);                                                    00141000          
END XRECLAIM;                                                           00141100          
                                                                        00141200          
$PAGE                                                                   00141300          
%SEGMENT(T.SPACE);                                                      00141400          
                                                                        00141500          
                                                                        00144400          
DEFINE ZPUSH(WHAT) =                                                    00144500          
BEGIN                                                                   00144600          
TSP[TSPPTR] := WHAT;                                                    00144700          
TSPPTR:=TSPPTR+1;                                                       00144800          
END ZPUSH#;                                                             00144900          
                                                                        00145000          
                                                                        00145600          
DECLARE(XQUOTE,81,ARG1:=MCAR[ARG1]);                                    00145700          
                                                                        00145800          
REAL PROCEDURE ZBIND(FRML,ACTUAL);                                      00145900          
% PROCEDURE BINDS THE ACTUAL PARAMETERS TO THE FRML AND PLACES          00146000          
% THEM ON THE STACK WITH LAMBDA AS THE FUNCTION NAME.                   00146100          
% IF NILLER IS TRUE THEN BIND THE VALUES TO NIL AND DON'T WORRY ABOUT   00146200          
% ACTUAL (USED BY PROG FOR PROG VARIABLES).                             00146300          
VALUE FRML,ACTUAL;                                                      00146400          
REAL FRML,ACTUAL;                                                       00146500          
BEGIN REAL OLD,A1,A2;                                                   00146600          
BOOLEAN NILLER;                                                         00146700          
DECLAREANDWEIGH;                                                        00146750          
NILLER := ACTUAL=NIL;                                                   00146800          
OLD := TSPPTR;         %BACK CHAIN POINTER HERE.                        00147000          
CHECKSTACK(18);                                                         00147100          
A2 := NIL;                                                              00147200          
WHILE MPAIRP(FRML) AND (MPAIRP(ACTUAL) OR NILLER) DO                    00147300          
BEGIN MICROBUMP(7);                                                     00147400          
  A1 := MCAR[FRML];                                                     00147500          
  IF NOT NILLER THEN                                                    00147600          
  BEGIN                                                                 00147700          
    A2 := MCAR[ACTUAL];                                                 00147800          
    ACTUAL := MCDR[ACTUAL];                                             00147900          
    MICROBUMP(2);                                                       00148000          
  END;                                                                  00148100          
  ZPUSH(ISPVALUE[A1.FIELD]);              %VALUE HERE.                  00148200          
  ZPUSH(A1);              %VARIABLE NAME HERE.                          00148300          
  ISPVALUE[A1.FIELD] := A2;                                             00148400          
  FRML := MCDR[FRML];       %NEXT FORMAL PARAMETER.                     00148500          
END;                                                                    00148600          
ZPUSH(GLAMBDA);             %ADD LAMBDA AS THE FUNCTION NAME.%PPDMTL05  00148610          
ZPUSH(OLD);               %ADD THE BACK CHAIN POINTER.       %PPDMTL05  00148620          
IF FRML NEQ ACTUAL THEN     %ERROR IF BOTH LISTS ARE NOT EMPTY.         00148700          
  ZERROR(120, ERRS[11]);                                                00148800          
                                                             %PPDMTL05  00148900          
                                                             %PPDMTL05  00149000          
ZBIND := NIL;                                                           00149100          
MICROBUMP(13);                                                          00149200          
PRIMCOUNTER(22);                                                        00149210          
END ZBIND;                                                              00149300          
                                                                        00149400          
                                                                        00149500          
DEFINE XLAMBIND = ARG1 := ZBIND(ARG1,ARG2)#;                            00149600          
                                                                        00149700          
                                                                        00149800          
PROCEDURE ZSPREAD;                                                      00149900          
% PROCEDURE SPREADS THE ACTUAL PARAMETERS IN ACTUAL LIST AMONG THE      00150000          
% REGISTERS ARG1 -> ARG14.                                              00150100          
BEGIN REAL I;                                                           00150200          
    LABEL EXIT;                                                         00150300          
    DECLAREANDWEIGH;                                                    00150400          
    MICROBUMP(5);                                                       00150500          
    ZA := ARG1;                                                         00150600          
    I := ARG2;                                                          00150610          
    IF MATOM(I) THEN                                                    00150700          
    BEGIN ARG1 := NIL; GO TO EXIT END;                                  00150800          
    'FOR NUM:=0 STEP 1 UNTIL 13 DO                                      00150900          
    'BEGIN                                                              00151000          
         MICROBUMP(3);                                                  00151100          
         ARG'NUM := MCAR[I];                                            00151200          
         I := MCDR[I];                                                  00151300          
         IF MATOM(I) THEN GO TO EXIT;                                   00151400          
    'END;                                                               00151500          
    ZERROR(107,ERRS[7]);                                                00151600          
EXIT:                                                                   00151700          
    PRIMCOUNTER(40);                                                    00151800          
END ZSPREAD;                                                            00152000          
                                                                        00152100          
DEFINE XAPPLY =                                                         00152110          
% USER INTERFACE TO ZCALL. PUT FN-POINTER IN $FN GLOBAL;                00152120          
    BEGIN                                                               00152130          
         ZSPREAD;                                                       00152140          
         STOPCOUNT;                                                     00152150          
         ZCALL(ZA);                                                     00152160          
         STARTCOUNT;                                                    00152170          
    END XAPPLY#;                                                        00152180          
                                                                        00152190          
DEFINE XLINK = #, XSPREAD = XAPPLY#;                                    00152195          
                                                                        00152200          
PROCEDURE ZUNSTACK;                                                     00152300          
    BEGIN REAL I,J;                                                     00152400          
         DECLAREANDWEIGH;                                               00152410          
         MICROBUMP(8);                                                  00152420          
         J := TSPPTR-1;                                                 00152500          
         TSPPTR := I := TSP[J];                                         00152600          
         J := J-2;                                                      00152700          
         WHILE I<J DO                                                   00152800          
         BEGIN                                                          00152900          
              ISPVALUE[TSP[I+1].FIELD] := TSP[I];                       00153000          
              I := I+2;                                                 00153100          
              MICROBUMP(4);                                             00153110          
         END;                                                           00153200          
         PRIMTRACE(37);                                                 00153210          
    END ZUNSTACK;                                                       00153300          
                                                                        00153400          
                                                                        00153500          
PROCEDURE XTHROW;                                                       00153600          
% POPS THE STACK UNTIL THE CATCH FUNCTION IS FOUND. SETS BACKOUT.       00153700          
% PTR IS SET TO THE TOP OF THE STACK AT THIS POINT.                     00153800          
% IF TB IS NON-NIL, A TRACEBACK IS GENERATED.                           00153900          
BEGIN                                                                   00154000          
REAL PTR,I;                                                             00154100          
ARRAY A[0:100];                                                         00154110          
LABEL EXIT;                                                             00154200          
DECLAREANDWEIGH;                                                        00154210          
BASKET := ARG1;                                                         00154400          
PTR := TSPPTR - 1;                                                      00154600          
IF ARG2 NEQ NIL THEN             %DISPLAY A TRACEBACK MESSAGE.          00154700          
BEGIN                                                                   00154800          
  STOPCOUNT;                                                            00154850          
  XTERPRI;                                                              00154900          
  REPLACE OUTER BY "***** ERROR TRACEBACK..";                           00155000          
  OUTPTR := 23;                                                         00155100          
  XTERPRI;                                                              00155200          
  ON ZERODIVIDE[A:I]: FAULTPROCESSOR(A,1);                              00155210          
  I := I/I;                                                             00155220          
  STARTCOUNT;                                                           00155300          
  MICROBUMP(5);                                                         00155310          
END;                                                                    00155400          
MICROBUMP(9);                                                           00155500          
WHILE TSP[PTR] NEQ 0 DO                                                 00155600          
BEGIN                                                                   00155700          
  MICROBUMP(7);                                                         00155800          
  IF TSP[PTR-1] = GCATCH THEN         %WE'RE THERE.                     00155900          
  BEGIN MICROBUMP(200);                                                 00156000          
    PRIMCOUNTER(19);                                                    00156050          
    PTR:=*+1;                         %NEW STACK TOP.                   00156100          
    BACKOUT := TRUE;                  %BACK OUT GRACEFULLY.             00156200          
    TSPPTR :=PTR;                                                       00156300          
    THROWCOUNTER := *+1;                                                00156400          
    CAUSE(THROW);                                                       00156500          
    IF HIGH THEN BEGIN HIGH := FALSE; GO TO EXIT END;                   00156510          
    ERRSTOP("NO CATCHER FOR THROW");                                    00156600          
  END;                                                                  00156700          
  IF TSP[PTR-1] = GBPROG THEN                                           00157700          
  BEGIN                                                                 00157800          
    MICROBUMP(2);                                                       00157900          
    CURQPROGPTR := TSP[TSP[PTR]];                                       00158000          
    CURSTACKBASE := TSP[TSP[PTR]+2];                                    00158100          
  END;                                                                  00158200          
  IF TSP[PTR-1] = GLAMBDA THEN                                          00158300          
  BEGIN                                                                 00158400          
    I := TSP[PTR];                                                      00158500          
    WHILE I+1<PTR DO                                                    00158600          
    BEGIN                                                               00158700          
      ISPVALUE[TSP[I+1].FIELD] := TSP[I];                               00158800          
      I := I+2;                                                         00158900          
    END;                                                                00159000          
  END;                                                                  00159100          
  PTR := TSP[PTR] - 1;                                                  00159200          
END;                                                                    00159300          
ERRSTOP("STACK UNDERFLOW DURING BACK TRACK");                           00159400          
EXIT:                                                                   00159410          
END XTHROW;                                                             00159500          
$PAGE                                                                   00159600          
%SEGMENT(PRIMITIVES);                                                   00159700          
DEFINE XCODEP=ARG1:=VCODEP(ARG1)#,                                      00159800          
       XIDP=ARG1:=VIDP(ARG1)#,                                          00159900          
       XNUMBERP=ARG1:=VNUMBERP(ARG1)#,                                  00160000          
       XPAIRP=ARG1:=VPAIRP(ARG1)#,                                      00160100          
       XATOM=ARG1:=VATOM(ARG1)#,                                        00160200          
       XCONSTANTP=ARG1:=VCONSTANTP(ARG1)#,                              00160400          
       XVECTORP=ARG1:=VVECTORP(ARG1)#,                                  00160500          
       XSTRINGP=ARG1:=VSTRINGP(ARG1)#;                                  00160600          
 DECLARE(XGLOBALP,71,MXGLOBALP);                                        00160700          
 DECLARE(XFLUIDP,72,MXFLUIDP);                                          00160800          
 DECLARE(XORDERP,56,ARG1:=MORDERP(ARG1,ARG2));                          00160810          
                                                                        00160900          
REAL PROCEDURE ZCONS(A,B); VALUE A,B; REAL A,B;                         00161000          
% PICKS UP THE NEXT FREE CELL. IF P.SP.FREE IS NEGATIVE THEN LOOK       00161100          
% FOR AN EMPTY PAGE. IF NO SUCH PAGE CALL THE GARBAGE COLLECTOR.        00161200          
BEGIN                                                                   00161300          
REAL I;                                                                 00161400          
DECLAREANDWEIGH;                                                        00161450          
IF PSPFREE<0 THEN                                                       00161500          
BEGIN                                                                   00161600          
    IF RHO*WORKSET<INUSE OR INUSE=PAGESIZE*APAGEMAX THEN                00161700          
    BEGIN ZA:=A; ZB:=B;                                                 00161800          
         ZGARBAGE(0);                                                   00161900          
    END;                                                                00162000          
    IF PSPFREE<0 THEN                                                   00162100          
    BEGIN                                                               00162200          
         WHILE PPAGEUSED[I] DO I:=I+1;                                  00162300          
         INUSE:=*+PAGESIZE;                                             00162400          
         PPAGEUSED[I]:=TRUE;                                            00162500          
         PSPFREE:=I:=I*PAGESIZE;                                        00162600          
         DO I:=MCDR[I]:=I+1 UNTIL I-(PAGESIZE-1) = PSPFREE;             00162700          
         MCDR[I]:=-1;                                                   00162800          
         REPLACE MCAR[PSPFREE] BY MAXFIELDV FOR PAGESIZE WORDS;         00162900          
    END;                                                                00163000          
END;                                                                    00163100          
MCAR[I := ZCONS := PSPFREE] := A;                                       00163200          
PSPFREE := MCDR[PSPFREE];                                               00163300          
MCDR[I] := B;                                                           00163400          
MICROBUMP(8);                                                           00163500          
PRIMCOUNTER(14);                                                        00163600          
END ZCONS;                                                              00163700          
                                                                        00163800          
                                                                        00163900          
 DEFINE XCONS = ARG1:=ZCONS(ARG1,ARG2)#;                                00164000          
 DECLARE(XNCONS,13,ARG1:=ZCONS(ARG1,NIL));                              00164100          
 DECLARE(XRCONS,12,ARG1:=ZCONS(ARG2,ARG1));                             00164200          
 DECLARE(XCAR,82,ARG1:=MCAR[ARG1]);                                     00164300          
 DECLARE(XCDR,83,IF ARG1 NEQ NIL THEN                        %PPDMTL11  00164400          
                   ARG1:=MCDR[ARG1]);                        %PPDMTL11  00164410          
 DECLARE(XNULL,84,ARG1:=TRUTH(ARG1=NIL));                               00164500          
                                                                        00164600          
                                                                        00164700          
PROCEDURE MLIST(A,B); VALUE A,B; REAL A,B;                              00164800          
BEGIN LABEL EXIT;                                                       00164900          
    ARG1:=A;                                                            00165000          
    ARG1 := ZCONS(A,ZCONS(B,NIL));                                      00165100          
    MICROBUMP(6);                                                       00165200          
END MLIST;                                                              00165300          
                                                                        00165400          
                                                                        00165500          
PROCEDURE MTMSMTCH(A,B,C); VALUE A,B,C; REAL A,B,C;                     00165600          
    BEGIN LABEL EXIT;                                                   00165700          
         ARG1:=A; ARG2:=B; ARG3:=C;                                     00165800          
         IF NOT BACKOUT THEN YQ01TQ19MSMTCH;                            00165900          
    END MTMSMTCH;                                                       00166000          
                                                                        00166100          
DECLARE(XRPLACA,15,MCAR[ARG1]:=ARG2);                                   00166200          
DECLARE(XRPLACD,16,MCDR[ARG1]:=ARG2);                                   00166300          
DECLARE(XPUTPROP,51,MPUTPROP);                                          00166400          
DECLARE(XGETPROP,52,ARG1:=MGETPROP[ARG1]);                              00166500          
DECLARE(XPUTG,53,MPUTG);                                                00166600          
DECLARE(XGETG,54,ARG1:=MGETG[ARG1]);                                    00166700          
                                                                        00166800          
                                                                        00166900          
REAL PROCEDURE ZGET(A,B); VALUE A,B; REAL A,B;                          00167000          
BEGIN REAL U,V;                                                         00167100          
    LABEL EXIT;                                                         00167200          
    DECLAREANDWEIGH;                                                    00167250          
    IF MIDP(A) THEN                                                     00167300          
    BEGIN MICROBUMP(2);                                                 00167400          
         U:=ISPPROP[A.FIELD];                                           00167500          
         IF U NEQ NIL THEN                                              00167600          
         DO BEGIN MICROBUMP(5);                                         00167700          
              V:=MCAR[U];                                               00167800          
              IF MPAIRP(V) THEN                                         00167900          
              IF MCAR[V] = B THEN                                       00168000          
              BEGIN                                                     00168100          
                   ZGET:=MCDR[V];                                       00168200          
                   GO TO EXIT;                                          00168300          
              END;                                                      00168400          
              U:=MCDR[U];                                               00168500          
         END UNTIL U=NIL;                                               00168600          
    END;                                                                00168700          
    ZGET:=NIL;                                                          00168800          
EXIT:                                                                   00168900          
    MICROBUMP(5);                                                       00169000          
    PRIMCOUNTER(69);                                                    00169020          
END ZGET;                                                               00169100          
                                                                        00169200          
DEFINE XGET=ARG1:=ZGET(ARG1,ARG2)#;                                     00169300          
                                                                        00169400          
PROCEDURE XGETD;                                                        00169500          
BEGIN REAL W;                                                           00169600          
    LABEL EXIT;                                                         00169700          
    DECLAREANDWEIGH;                                                    00169750          
    IF NOT MIDP(ARG1) THEN                                              00169800          
    BEGIN ARG1:=NIL; GO TO EXIT END;                                    00169900          
    ARG1 := ISPVALUE[ARG1.FIELD];                                       00170000          
    IF MATOM(ARG1) THEN                                                 00170100          
    BEGIN                                                               00170200          
         ARG1 := NIL;                                                   00170300          
         MICROBUMP(1);                                                  00170400          
    END                                                                 00170500          
    ELSE                                                                00170600          
    BEGIN                                                               00170700          
         MICROBUMP(4);                                                  00170800          
         W:=MCAR[ARG1];                                                 00170900          
         IF GSUBR NEQ W THEN                                            00171000          
         IF GFSUBR NEQ W THEN                                           00171100          
         IF GEXPR NEQ W THEN                                            00171200          
         IF GFEXPR NEQ W THEN                                           00171300          
         IF GMACRO NEQ W THEN                                           00171400          
              ARG1 := NIL;                                              00171500          
    END;                                                                00171600          
EXIT:                                                                   00171700          
    MICROBUMP(6);                                                       00171800          
    PRIMCOUNTER(70);                                                    00171900          
END XGETD;                                                              00172000          
                                                                        00172100          
                                                                        00172200          
PROCEDURE XPUTD;                                                        00172300          
BEGIN REAL I;                                                           00172400          
    DECLAREANDWEIGH;                                                    00172450          
    ISPVALUE[ARG1.FIELD] := ARG2;                                       00172500          
    I:=ISPPNAME[ARG1.FIELD].QSPPTR-1;                                   00172600          
    IF I>=0 THEN                                                        00172700          
         QSP[I].[46:1]:=1;                                              00172800          
    MICROBUMP(6);                                                       00172900          
    PRIMCOUNTER(76);                                                    00173000          
END XPUTD;                                                              00173100          
                                                                        00173110          
                                                                        00173120          
PROCEDURE XTIME;                                                        00173130          
BEGIN INTEGER I;                                                        00173140          
    DECLAREANDWEIGH;                                                    00173150          
    I := (TIME(12)-BEGINTIME)*2.4@-3;    % MILLI-SECONDS                00173160          
    ARG1 := ZTRACT(I);                                                  00173170          
    MICROBUMP(5);                                                       00173180          
    PRIMCOUNTER(50);                                                    00173190          
END XTIME;                                                              00173210          
                                                                        00173220          
REAL PROCEDURE SEARCHFORNAME(A); ARRAY A[0];                            00173300          
    BEGIN REAL I,J,K;                                                   00173310          
         POINTER P,Q;                                                   00173320          
         ARRAY B[0:80];                                                 00173330          
         EBCDIC ARRAY S[0:35];                                          00173335          
         LABEL EXIT;                                                    00173340          
         IF NOT PROCS.PRESENT THEN                                      00173350          
         BEGIN SEARCHFORNAME := 8; GO TO EXIT END;                      00173360          
         J := PROCS.LASTRECORD+1;                                       00173370          
         P := POINTER(B[12]);                                           00173380          
         DO BEGIN K:=(I+J) DIV 2;                                       00173390          
              READ(PROCS[K],80,B);                                      00173400          
              IF P>A FOR 8 THEN J:=K ELSE I:=K;                         00173410          
         END UNTIL J-I<2;                                               00173420          
         READ(PROCS[I],80,B);                                           00173430          
         SCAN P:B UNTIL = "P";                                          00173440          
         P := P+10;                                                     00173450          
         SCAN P:P WHILE = " ";                                          00173460          
         IF P="Y" THEN                                                  00173470          
         BEGIN P:=P+1; I:=72;                                           00173480          
              REPLACE Q:A+8 BY "  ";                                    00173490          
              REPLACE S BY                                              00173495          
                  "*$!" CAT """ CAT "#%'()=+-<>^\~|@.&?[]/,:;Q";        00173500          
              DO BEGIN                                                  00173510          
                   I:=I-1;                                              00173515          
                   IF P="Q" THEN                                        00173520          
                   BEGIN                                                00173530          
                        J:=INTEGER(P+1,2); P:=P+3;                      00173540          
                        REPLACE Q:Q BY S[J] FOR 1;                      00173550          
                   END                                                  00173560          
                   ELSE REPLACE Q:Q BY P:P FOR 1;                       00173570          
              END UNTIL NOT P IN ALPHA;                                 00173580          
         END                                                            00173590          
         ELSE                                                           00173600          
         BEGIN                                                          00173610          
              IF P="X" OR P="Z" OR P="V" THEN                           00173620          
                   P:=P+1;                                              00173630          
              REPLACE A+8 BY "  ", P FOR I:72 WHILE IN ALPHA;           00173640          
         END;                                                           00173650          
         SEARCHFORNAME := 82-I;                                         00173660          
EXIT:                                                                   00173670          
    END SEARCHFORNAME;                                                  00173680          
                                                                        00173690          
PROCEDURE FAULTPROCESSOR(FA,FN); VALUE FN; REAL FN; ARRAY FA[0];        00174200          
BEGIN                                                                   00174300          
  REAL I,J;                                                             00174400          
  POINTER P,Q;                                                          00174500          
  ARRAY FB[0:22];                                                       00174600          
  IF FN=4 THEN                                                          00174610          
  BEGIN                                                                 00174620          
    WRITETTY("INVALID INDEX");                                          00174630          
    WRITETTY("ARG1-4 = " CAT                                            00174700          
      CONVERT(ARG1,10) CAT "  " CAT                                     00174800          
      CONVERT(ARG2,10) CAT "  " CAT                                     00174900          
      CONVERT(ARG3,10) CAT "  " CAT                                     00175000          
      CONVERT(ARG4,10));                                                00175100          
  END;                                                                  00175110          
  FA[SIZE(FA)-1] := "().";                                              00175200          
  SCAN P:FA UNTIL = "(";                                                00175300          
  WHILE P NEQ "()." DO                                                  00175400          
  BEGIN                                                                 00175500          
    P := P+1;                                                           00175600          
    REPLACE FB BY P:P FOR 8;                                            00175700          
    I := SEARCHFORNAME(FB);                                             00175800          
    WRITETTY(FB FOR I);                                                 00175900          
    SCAN P:P UNTIL = "(";                                               00176000          
  END;                                                                  00176100          
  IF ABS(FN)=4 THEN                                                     00176400          
  BEGIN  %INVALID INDEX                                                 00176500          
    ISPVALUE[GEMSG.FIELD] := ERRS[IF FN=4 THEN 17 ELSE 14];             00176600          
    ARG1:=ERRORID;                                                      00176700          
    ARG2:=NIL;                                                          00176800          
    XTHROW;                                                             00176900          
  END;                                                                  00177000          
END;                                                                    00177100          
                                                                        00177200          
PROCEDURE ZCATCH;                                                       00177300          
% ARG1 IS REEVALUATED. IF A THROW OCCURS DURING THE EVALUATION, THE     00177400          
% VALUE FROM THROW (IN BASKET) IS RETURNED, OTHERWISE A LIST OF THE     00177500          
% VALUE OF ARG1 IS RETURNED.                                            00177600          
BEGIN                                                                   00177700          
ARRAY FA[0:500];                                                        00177800          
REAL FN,K,S;                                                            00177900          
LABEL FL;                                                               00178000          
INTERRUPT THUD;                                                         00178100          
         IF CATCHCOUNTER=K THEN                                         00178200          
         IF THROWCOUNTER>CATCHER THEN                                   00178300          
         BEGIN                                                          00178400          
              CATCHER := *+1;                                           00178500          
              GO TO FL;                                                 00178600          
         END;                                                           00178700          
DECLAREANDWEIGH;                                                        00178710          
MICROBUMP(100);                                                         00178720          
CHECKSTACK(2);                                                          00178800          
ZPUSH(GCATCH);                %MARK THE STACK.                          00179000          
ZPUSH(TSPPTR-1);                                                        00179100          
ON INVALIDINDEX[FA:FN],                                                 00179200          
BEGIN                                                                   00179300          
  FAULTPROCESSOR(FA,4);                                                 00179400          
  GO TO FL;                                                             00179500          
END;                                                                    00179600          
ATTACH THUD TO THROW;                                                   00179700          
K:=CATCHCOUNTER:=*+1;                                                   00179800          
S:=ES;                                                                  00179900          
STOPCOUNT;                                                              00179910          
YEVAL;                        %SO DO IT.                                00180000          
STARTCOUNT;                                                             00180010          
FL:                                                                     00180100          
DETACH THUD;                                                            00180200          
CATCHCOUNTER:=*-1;                                                      00180300          
ES:=S;                                                                  00180400          
IF BACKOUT THEN BEGIN         %AHA! A THROW HAS OCCURRED.               00180500          
  BACKOUT := FALSE;           %THROW IS COMPLETE.                       00180600          
  ARG1 := BASKET;             %VALUE TO RETURN.                         00180700          
  END                                                                   00180800          
ELSE BEGIN                    %RETURN (VALUE . NIL)                     00180900          
  ARG2 := NIL;                                                          00181000          
  XCONS;                                                                00181100          
  END;                                                                  00181200          
TSPPTR := TSP[TSPPTR-1];                                                00181300          
PRIMCOUNTER(1);                                                         00181310          
END ZCATCH;                                                             00181400          
                                                                        00181500          
                                                                        00181600          
DEFINE XCATCH = BEGIN STOPCOUNT; ZCATCH; STARTCOUNT END#;               00181700          
                                                                        00181800          
                                                                        00181900          
PROCEDURE ZERROR(NUM, MSG); VALUE NUM,MSG; REAL NUM,MSG;                00182000          
% ISOLATE XERROR FROM THE SYSTEM.                                       00182100          
BEGIN LABEL EXIT;                                                       00182200          
ARG1 := ZTRACT(NUM);      %ERROR NUMBER AS ARG1.                        00182300          
ARG2 := MSG;                                                            00182400          
IF NOT BACKOUT THEN YERROR;                                             00182500          
END ZERROR;                                                             00182600          
                                                                        00182605          
PROCEDURE XQUIT;                                                        00182610          
    BEGIN                                                               00182620          
         DECLAREANDWEIGH;                                               00182630          
         PRIMCOUNTER(23);                                               00182635          
         RECENTREAD := ATEND := TRUE; BREAK := FALSE;                   00182640          
         CLOSE(ME);                                                     00182650          
         ANSWERHI;                                                      00182660          
         GO TO THU;                                                     00182670          
    END XQUIT;                                                          00182680          
                                                                        00182700          
PROCEDURE XSETPCHAR;                                                    00182800          
BEGIN REAL S;                                                           00182900          
DECLAREANDWEIGH;                                                        00182950          
IF MIDP(ARG1) THEN                                                      00183000          
  S:=STRINGIZE(ISPPNAME[ARG1.FIELD])                                    00183100          
ELSE                                                                    00183200          
IF MSTRINGP(ARG1) THEN                                                  00183300          
  S:=ARG1                                                               00183400          
ELSE                                                                    00183500          
  MTMSMTCH(ARG1,GIDORSTRING,GSETPCHAR);                                 00183600          
ARG1:=ISPVALUE[GPROMPT.FIELD];                                          00183700          
ISPVALUE[GPROMPT.FIELD] := S;                                           00183800          
MICROBUMP(10);                                                          00183900          
PRIMCOUNTER(60);                                                        00184000          
END XSETPCHAR;                                                          00184100          
                                                                        00184200          
                                                                        00184300          
REAL PROCEDURE ZREADCH(PTR,BFR);                                        00184400          
% PROCEDURE PICKS UP THE NEXT INPUT CHARACTER FROM THE SELECTED         00184500          
% INPUT FILE (CUR.CHAN.IN) AT POSITION I. IF I < 0 THEN A NEW LINE      00184600          
% IS REQUIRED. IF I > 80 THEN RETURN END-OF-LINE. @(4)00@ MEANS         00184700          
% $EOF$ TO READCH, @(4)01@ MEANS $EOL$ TO READCH.                       00184800          
% IF !*RAISE IS T CHANGE LOWER CASES TO UPPER CASES. IF !*ECHO IS T,    00184900          
% THEN DISPLAY THE LINE ON THE CURRENTLY SELECTED INPUT DEVICE.         00185000          
REAL PTR; EBCDIC ARRAY BFR[0];                                          00185100          
BEGIN REAL I,J;                                                         00185200          
LABEL EXIT,EOFME,EOFYOU;                                                00185300          
I:=PTR;                                                                 00185400          
IF I < 0 THEN                                                           00185500          
BEGIN                                                                   00185600          
  IF ASKING THEN ANSWERHI;                                              00185610          
  IF CURCHANIN = 0 THEN                                                 00185700          
  BEGIN                                                                 00185800          
    REPLACE COLLECTOR BY ZGETSTRING(ISPVALUE[GPROMPT.                   00186000          
         FIELD]) CAT " ";                                               00186100          
    WHILE WRITE(ME[STOP],ZGET2+1,COLLECTOR) DO;                         00186200          
    REPLACE COLLECTOR BY " " FOR 132;                                   00186300          
    ATEND := RECENTREAD := TRUE; BREAK := FALSE;                        00186400          
    READ(ME,80,LINER)[EOFME];                                           00186500          
    ATEND:=FALSE;                                                       00186600          
    IF ASKING THEN                                                      00186700          
    BEGIN                                                               00186800          
EOFME:                                                                  00186900          
      ANSWERHI;                                                         00187000          
      IF ATEND THEN GO  TO THU                                          00187100          
    END;                                                                00187200          
    REPLACE BFR BY LINER FOR INSZE;   %MOVE LINE TO INPUT BUFFER.       00187300          
  END                                                                   00187400          
  ELSE                                                                  00187500          
  BEGIN                                                                 00187600          
    READ(IOFILE[CURCHANIN],INSZE,BFR)[EOFYOU];                          00187700          
    IF FALSE THEN                                                       00187800          
    BEGIN                         %BACK TO ME WHEN END OF FILE.         00187900          
EOFYOU:                                                                 00188000          
      CURCHANIN := 0;                                                   00188100          
      ZREADCH:=0;                     %RETURN $EOF$.                    00188200          
      I:=-2;                                                            00188300          
      GO TO EXIT;                                                       00188400          
    END;                                                                00188500          
    IF FILEINFO[CURCHANIN]<INSZE THEN                                   00188600          
    BEGIN                                                               00188610          
         J := INTEGER(BFR[FILEINFO[CURCHANIN]],8);                      00188620          
         REPLACE BFR[FILEINFO[CURCHANIN]] BY " " FOR INSZE-             00188700          
              FILEINFO[CURCHANIN];                                      00188800          
    END                                                                 00188810          
    ELSE                                                                00188820          
         J := IOHERE[CURCHANIN]+100;                                    00188830          
    IOHERE[CURCHANIN] := J;                                             00188840          
    IF J>IOSTOP[CURCHANIN] THEN GO TO EOFYOU;                           00188850          
  END;                                                                  00188900          
  IF NOT MNULL(ISPVALUE[GECHO.FIELD]) THEN   %ECHO?                     00189000          
    WRITEIOFILE(CURCHANOUT,BFR FOR                                      00189100          
        IF CURCHANOUT=0 THEN INSZE ELSE ZEXTEND(ISPVALUE[               00189200          
           GLINELENGTH.FIELD]));                                        00189300          
  MICROBUMP(30);                                                        00189400          
END GETANDECHO;                                                         00189500          
                                                                        00189600          
IF I>=INSZE THEN                  %SHOULD $EOL$ BE RETURNED?            00189700          
BEGIN                                                                   00189800          
  I := -2;                        %FORCE READ NEXT TIME.                00189900          
  ZREADCH:=1;   %1                         %RETURN $EOL$.    %PPDMTL12  00190000          
  GO TO EXIT;                                                           00190100          
END;                                                                    00190200          
                                                                        00190300          
IF I<=0 THEN                                                            00190400          
BEGIN                                                                   00190500          
    IF NOT MNULL(ISPVALUE[GRAISE.FIELD]) THEN                           00190600          
         FOR I:=0 STEP 6 UNTIL INSZE DO                                 00190700          
              REPLACE BFR[I] BY REAL(BOOLEAN(REAL(BFR[I],6)) OR         00190800          
                   BOOLEAN("      ")) FOR 6;                            00190900          
    I:=0;                                                               00191000          
END;                                                                    00191100          
ZREADCH:=REAL(BFR[I],1);                                                00191200          
EXIT:                                                                   00191300          
PTR:=I+1;                                                               00191400          
MICROBUMP(8);                                                           00191500          
END ZREADCH;                                                            00191600          
                                                                        00191700          
                                                                        00191800          
REAL PROCEDURE ZADDTOSTRINGS(A,L); VALUE A,L; POINTER A; REAL L;        00191900          
% PROCEDURE ADDS THE CHARACTER STRING A TO THE STRING AREA BY HASHING ON00192000          
% ON THE FIRST TWO CHARACTERS IF LONGER THAN ONE CHARACTER AND THEN     00192100          
% DOING A LINEAR SEARCH IN THE HASH BUCKET OR AN OVERFLOW AREA. SINGLE  00192200          
% CHARACTER STRINGS STAND FOR THEMSELVES.                               00192300          
BEGIN LABEL EXIT;                                                       00192400          
REAL R,BUCKET,SPTR,LEN,W,WL,WB;                                         00192500          
% SINGLE CHARACTER IDS STAND FOR THEMSELVES.                            00192600          
IF L = 1 THEN                                                           00192700          
BEGIN                                                                   00192800          
  SPTR:=REAL(A,1)*4;                                                    00192900          
  GO TO EXIT;                                                           00193000          
END;                                                                    00193100          
% COMPUTE THE BUCKET NUMBER ON THE FIRST SIX CHARACTERS OF A.           00193200          
R:=REAL(A,MIN(L,6));                                                    00193300          
R:=(R.[47:14]+R.[33:34]+L) MOD SSPHBUCKETS+1;                           00193400          
  %SEARCH ALL BUCKETS UNTIL THE STRING IS FOUND OR THE END OF THE BUCKET00193500          
  %CHAIN IS REACHED.                                                    00193600          
WL:=SSPBSZE;                                                            00193700          
FOR BUCKET:=R, SSPHBUCKETS+1 STEP 1 UNTIL SSPBMAX-1 DO                  00193800          
BEGIN                                                                   00193900          
  MICROBUMP(7);                                                         00194000          
  SPTR := 0;                                                            00194100          
  WHILE LEN:=(R:=REAL(SSP[BUCKET,SPTR],3)).[23:8] > 0 DO                00194200          
  BEGIN                                                                 00194300          
    MICROBUMP(8);                                                       00194400          
    IF BOOLEAN(R.FREEF) THEN                                            00194500          
    BEGIN                                                               00194600          
         IF L+3<LEN OR LEN=L THEN                                       00194700          
         IF WL>LEN THEN                                                 00194800          
         IF BUCKET<=SSPHBUCKETS OR WL=SSPBSZE THEN                      00194900          
         BEGIN W:=SPTR; WL:=LEN; WB:=BUCKET END;                        00195000          
    END                                                                 00195100          
    ELSE                                                                00195200          
    IF LEN = L THEN                                                     00195300          
      IF SSP[BUCKET,SPTR+3]=A FOR L THEN                                00195400          
        GO TO EXIT;                                                     00195500          
    SPTR:=*+LEN+3;                                                      00195600          
  END;                                                                  00195700          
  %IF THERE IS ROOM IN THIS BUCKET, THEN THERE IS NO NEED TO SEARCH FURT00195800          
  %BECAUSE IT WON'T BE THERE.                                           00195900          
  MICROBUMP(10);                                                        00196000          
  IF WL=SSPBSZE THEN                                                    00196100          
  BEGIN                                                                 00196200          
      IF R-3<L THEN                                                     00196300          
      BEGIN                                                             00196400          
        LEN:=SIZE(SSP[BUCKET,*]);                                       00196500          
        IF LEN<SSPBSZE THEN                                             00196600          
        BEGIN                                                           00196700          
          RESIZE(SSP[BUCKET,*],2*LEN,RETAIN);                           00196800          
          R:=R+LEN;                                                     00196900          
          IF 2*LEN >= SSPBSZE THEN NEWSCNT1 := *+1;                     00197000          
        END;                                                            00197100          
      END;                                                              00197200          
      IF L+3<=R THEN                                                    00197300          
      BEGIN                                                             00197400          
        REPLACE SSP[BUCKET,SPTR] BY L.SHIFTUP FOR 1,                    00197500          
                BRANDNEW.[15:48] FOR 2,                                 00197600          
            A FOR L, (R-L-3).[23:48] FOR 3;                             00197700          
        IF NEWSCNT1>0 THEN NEWSCNT1 := *+1;                             00197800          
        GO TO EXIT;                                                     00197900          
      END;                                                              00198000          
  END                                                                   00198100          
  ELSE                                                                  00198200          
  BEGIN                                                                 00198300          
        REPLACE SSP[WB,W] BY L.SHIFTUP FOR 1,                           00198400          
            BRANDNEW.[15:48] FOR 2, A FOR L;                            00198500          
        IF WL>L THEN                                                    00198600          
            REPLACE SSP[WB,W+3+L] BY (0&1 FREEF & (WL-L-3)[23:8]).      00198700          
                [23:48] FOR 3;                                          00198800          
        SPTR:=W; BUCKET:=WB;                                            00198900          
        GO TO EXIT;                                                     00199000          
  END;                                                                  00199100          
  %TRY SEARCH ANOTHER BUCKET.                                           00199200          
END;                                                                    00199300          
ERRSTOP("STRING SPACE JAM");                                            00199400          
EXIT:                                                                   00199500          
ZADDTOSTRINGS := SPTR & BUCKET BUCKF & STRINGTAG TAG;                   00199600          
MICROBUMP(9);                                                           00199700          
END ZADDTOSTRINGS;                                                      00199800          
                                                                        00199900          
                                                                        00200000          
REAL PROCEDURE ZGETSTRINGPROC(A); VALUE A; REAL A;                      00200100          
% RETURN THE STRING ASSOCIATED WITH A. STOP IF A NOT A STRING PTR.      00200200          
BEGIN                                                                   00200300          
  REAL BNO,SPTR,L;                                                      00200400          
  IF NOT MSTRINGP(A) THEN                                               00200500          
    ERRSTOP("NON-STRING --> " CAT CONVERT(A,FOUR));                     00200600          
  BNO:=A.BUCKF;                                                         00200700          
  ZGETSTRINGPROC:=BNO;                                                  00200800          
  SPTR:=A.SLOCF;                                                        00200900          
  ZGET2:=REAL(SSP[BNO,SPTR],1);                                         00201000          
  ZGET1:=SPTR+3;                                                        00201100          
  MICROBUMP(8);                                                         00201200          
END ZGETSTRINGPROC;                                                     00201300          
                                                                        00201400          
                                                                        00201500          
REAL PROCEDURE ZIDSPACE;                                                00201600          
% PROCEDURE RETURNS THE NEXT FREE SLOT IN THE IDENTIFIER SPACE.         00201700          
BEGIN LABEL EXIT;                                                       00201800          
IF ISPFREE=ISPMAX+1 THEN                                                00201900          
  ZGARBAGE(1);                                                          00202000          
IF ISPFREE>ISPHIGH THEN ISPHIGH:=ISPFREE;                               00202100          
ISPFREE:=ISPVALUE[ZIDSPACE:=ISPFREE].FIELD;                             00202200          
MICROBUMP(6);                                                           00202300          
END ZIDSPACE;                                                           00202400          
                                                                        00202500          
                                                                        00202600          
PROCEDURE XINTERN;                                                      00202700          
% SEARCHES THE OBLIST FOR AN OCCURRENCE OF AN IDENTIFIER WITH           00202800          
% PRINT NAME OF ARG1 AND RETURNS THAT ID IF FOUND, OR CREATES           00202900          
% A NEW ONE IF NOT.                                                     00203000          
BEGIN REAL TPTR,U,S,I,J;                                                00203100          
LABEL FOUND,THERE,NOTTHERE;                                             00203200          
DECLAREANDWEIGH;                                                        00203250          
IF MIDP(ARG1) THEN                                                      00203300          
  U:=STRINGIZE(ISPPNAME[ARG1.FIELD])                                    00203400          
ELSE                                                                    00203500          
IF MSTRINGP(ARG1) THEN                                                  00203600          
  U:=ARG1                                                               00203700          
ELSE                                                                    00203800          
  MTMSMTCH(ARG1,GIDORSTRING,GINTERN);                                   00203900          
MINTERNED(U) := TRUE;                                                   00204000          
S:=REAL(SSP[U.BUCKF,U.SLOCF+1],2);                                      00204100          
IF S=BRANDNEW THEN GO TO NOTTHERE;                                      00204200          
IF ISPPNAME[S].IDCELL=U.IDCELL THEN                                     00204300          
  GO THERE;                                                             00204400          
S := MAXFIELDV;                                                         00204500          
MINTERNED(S) := TRUE;                                                   00204600          
MICROBUMP(3);                                                           00204700          
FOR I:=0 STEP 128 UNTIL ISPHIGH DO                                      00204800          
BEGIN MICROBUMP(30);                                                    00204900          
  J:=ISPPNAME[I];                                                       00205000          
  IF I>0 THEN                                                           00205100          
    ISPPNAME[I]:=U;                                                     00205200          
  TPTR:=MASKSEARCH(U,S,ISPPNAME[MIN(I+128,ISPHIGH)]);                   00205300          
  ISPPNAME[I]:=J;                                                       00205400          
  IF TPTR>I OR TPTR=0 THEN                                              00205500          
  BEGIN                                                                 00205600          
      S:=TPTR;                                                          00205700          
      GO TO FOUND;                                                      00205800          
  END;                                                                  00205900          
END;                                                                    00206000          
NOTTHERE:                                                               00206100          
IF MSTRINGP(ARG1) THEN                                                  00206200          
  ISPPNAME[S := ZIDSPACE] := ARG1   %SAVE THE PRINT NAME.               00206300          
ELSE                                                                    00206400          
  S:=ARG1.FIELD;                                                        00206500          
ISPPNAME[S].TAG := 0;                                                   00206600          
MINTERNED(ISPPNAME[S]):=TRUE;                                           00206700          
ISPPROP[S] := NIL;          %EMTPY SO FAR.                              00206800          
ISPVALUE[S] := UNBOUND;                                                 00206900          
MICROBUMP(6);                                                           00207000          
FOUND:                                                                  00207100          
REPLACE SSP[U.BUCKF,U.SLOCF+1] BY S.[15:48] FOR 2;                      00207200          
MICROBUMP(2);                                                           00207300          
THERE:                                                                  00207400          
ARG1.TAG := IDTAG;         %BUILD A NEW ENTRY TO RETURN AND PLACE       00207500          
ARG1.FIELD := S;                                                        00207600          
MICROBUMP(11);                                                          00207700          
PRIMCOUNTER(20);                                                        00207800          
END XINTERN;                                                            00207900          
                                                                        00208000          
                                                                        00208100          
PROCEDURE CHRINTERN(CHR); VALUE CHR; REAL CHR;                          00208200          
    BEGIN REAL R,S;                                                     00208300          
         LABEL EXIT;                                                    00208400          
         MICROBUMP(8);                                                  00208500          
         S:=ZADDTOCHRS(CHR);                                            00208600          
         MINTERNED(S) := TRUE;                                          00208700          
         R := REAL(SSP[0,S.SLOCF+1],2);                                 00208800          
         IF R<BRANDNEW THEN                                             00208900          
         IF ISPPNAME[R].IDCELL = S.IDCELL THEN                          00209000          
         BEGIN                                                          00209100          
              MICROBUMP(2);                                             00209200          
              ARG1 := R&IDTAG TAG;                                      00209300          
              GO TO EXIT;                                               00209400          
         END;                                                           00209500          
         ARG1 := S&STRINGTAG TAG;;                                      00209600          
         XINTERN;                                                       00209700          
EXIT:                                                                   00209800          
    END CHRINTERN;                                                      00209900          
                                                                        00210000          
                                                                        00210100          
PROCEDURE XREMOB;                                                       00210200          
% TYPE MISMATCH ERROR IF NOT AN ID. TURN OFF THE INTERN FLAG IF         00210300          
% IT IS ON AND AN ID.                                                   00210400          
BEGIN LABEL EXIT;                                                       00210500          
DECLAREANDWEIGH;                                                        00210550          
IF NOT MIDP(ARG1) THEN                                                  00210600          
  MTMSMTCH(ARG1, GID, GREMOB);                                          00210700          
MINTERNED(ISPPNAME[ARG1.FIELD]) := FALSE;                               00210800          
MICROBUMP(5);                                                           00211000          
PRIMCOUNTER(11);                                                        00211050          
END XREMOB;                                                             00211100          
                                                                        00211200          
                                                                        00211300          
PROCEDURE XGLOBAL;                                                      00211400          
    BEGIN REAL P;                                                       00211500          
         DECLAREANDWEIGH;                                               00211550          
         WHILE MPAIRP(ARG1) DO                                          00211600          
         BEGIN                                                          00211700          
              P:=MCAR[ARG1];                                            00211800          
              IF NOT MIDP(P) THEN                                       00211900          
                   MTMSMTCH(P,GID,GGLOBAL);                             00212000          
              IF MFLUIDP(P) THEN                                        00212100          
              BEGIN                                                     00212200          
                   MLIST(P,ERRS[15]);                                   00212300          
                   ZERROR(115,ARG1);                                    00212400          
              END;                                                      00212500          
              MGLOBALP(P):=TRUE;                                        00212600          
              IF ISPVALUE[P.FIELD] = UNBOUND THEN                       00212700          
                   ISPVALUE[P.FIELD] := NIL;                            00212800          
              ARG1 := MCDR[ARG1];                                       00212900          
              MICROBUMP(8);                                             00213000          
         END;                                                           00213100          
         ARG1 := NIL;                                                   00213200          
         MICROBUMP(5);                                                  00213300          
         PRIMCOUNTER(73);                                               00213400          
    END XGLOBAL;                                                        00213500          
                                                                        00213600          
                                                                        00213700          
PROCEDURE XFLUID;                                                       00213800          
    BEGIN REAL P;                                                       00213900          
         DECLAREANDWEIGH;                                               00213950          
         WHILE MPAIRP(ARG1) DO                                          00214000          
         BEGIN                                                          00214100          
              P:=MCAR[ARG1];                                            00214200          
              IF NOT MIDP(P) THEN                                       00214300          
                   MTMSMTCH(P,GID,GFLUID);                              00214400          
              IF MGLOBALP(P) THEN                                       00214500          
              BEGIN                                                     00214600          
                   MLIST(P,ERRS[16]);                                   00214700          
                   ZERROR(116,ARG1);                                    00214800          
              END;                                                      00214900          
              MFLUIDP(P) := TRUE;                                       00215000          
              IF ISPVALUE[P.FIELD] = UNBOUND THEN                       00215100          
                   ISPVALUE[P.FIELD] := NIL;                            00215200          
              ARG1:=MCDR[ARG1];                                         00215300          
              MICROBUMP(8);                                             00215400          
         END;                                                           00215500          
         ARG1:=NIL;                                                     00215600          
         MICROBUMP(5);                                                  00215700          
         PRIMCOUNTER(74);                                               00215800          
    END XFLUID;                                                         00215900          
                                                                        00216000          
                                                                        00216100          
PROCEDURE XUNFLUID;                                                     00216200          
    BEGIN REAL P;                                                       00216300          
         DECLAREANDWEIGH;                                               00216350          
         WHILE MPAIRP(ARG1) DO                                          00216400          
         BEGIN                                                          00216500          
              P:=MCAR[ARG1];                                            00216600          
              IF NOT MIDP(P) THEN                                       00216700          
                   MTMSMTCH(P,GID,GUNFLUID);                            00216800          
              MFLUIDP(P) := FALSE;                                      00216900          
              ARG1:=MCDR[ARG1];                                         00217000          
              MICROBUMP(5);                                             00217100          
         END;                                                           00217200          
         ARG1:=NIL;                                                     00217300          
         MICROBUMP(5);                                                  00217400          
         PRIMCOUNTER(75);                                               00217500          
    END XUNFLUID;                                                       00217600          
                                                                        00217700          
                                                                        00217800          
EBCDIC ARRAY ZRATOMARRAY[0:80];                                         00217900          
PROCEDURE ZRATOM(PTR,BFR,SZE);                                          00218000          
% PROCEDURE READS THE NEXT ATOM FROM THE INPUT STRING AND RETURNS       00218100          
% AS FOLLOWS:                                                           00218200          
%   0 - IDENTIFIER, ARG1 = POINTER TO ITS STRING.                       00218300          
%   1 - STRING,     ARG1 = POINTER TO ITS STRING.                       00218400          
%   2 - INTEGER,    ARG1 = INTEGER VALUE AND TAG.                       00218500          
%   3 - CHARACTER,  ARG1 = SINGLE CHARACTER.                            00218600          
%   4 - $EOF$.                                                          00218700          
%   5 - FUNCTION-POINTER. ARG1 = VALUE AND TAG.                         00218800          
VALUE SZE; REAL PTR,SZE; EBCDIC ARRAY BFR[0];                           00218900          
BEGIN REAL I,J,CHR,R,S;                                                 00219000          
LABEL SINGLE;                                                           00219100          
DEFINE IDS=ZRATOMARRAY#,STRNGS=ZRATOMARRAY#;                            00219200          
DECLAREANDWEIGH;                                                        00219250          
                                                                        00219300          
% SKIP TO THE FIRST NON-BLANK CHARACTER.                                00219400          
R:=PTR;                                                                 00219500          
DO BEGIN                                                                00219600          
  IF R<=0 OR R>=SZE THEN                                                00219700          
    DO UNTIL CHR:=ZREADCH(R,BFR) NEQ 1                                  00219800          
  ELSE                                                                  00219900          
  BEGIN                                                                 00220000          
    CHR:=REAL(BFR[R],1);                                                00220100          
    IF CHR=" " THEN                                                     00220200          
    BEGIN                                                               00220300          
      MICROBUMP(10);                                                    00220400          
      SCAN BFR[R] FOR S:SZE-R WHILE = " ";                              00220500          
      R:=SZE-S;                                                         00220600          
      IF R<SZE THEN                                                     00220700          
        CHR:=REAL(BFR[R],1);                                            00220800          
    END;                                                                00220900          
    R:=R+1;                                                             00221000          
  END;                                                                  00221100          
  MICROBUMP(5);                                                         00221200          
END UNTIL CHR NEQ " ";                                                  00221300          
                                                                        00221400          
IF CHR = 0 THEN ARG1:=4 ELSE       %$EOF$ HERE.                         00221500          
                                                                        00221600          
% IF WE HAVE AN IDENTIFER POSSIBLE HERE, THEN READ UP TO 24 CHARACTERS  00221700          
% INTO IDS AND PUT INTO STRING TABLE.                                   00221800          
IF CHR IN LETTERSNBANG THEN                                             00221900          
BEGIN                                                                   00222000          
  R:=R-1;                                                               00222100          
  DO BEGIN                                                              00222200          
    MICROBUMP(13);                                                      00222300          
    IF CHR="!" THEN                                                     00222400          
    BEGIN                                                               00222500          
      MICROBUMP(4);                                                     00222600          
      REPLACE IDS[I] BY BFR[R+1] FOR 1;                                 00222700          
      I:=I+1; R:=R+2;                                                   00222800          
    END;                                                                00222900          
    S:=SZE-R;                                                           00223000          
    REPLACE IDS[I] BY BFR[R] FOR J:S WHILE IN LETTERSNDIGITS;           00223100          
    I:=S-J+I; R:=SZE-J;                                                 00223200          
    CHR:=REAL(BFR[R],1);                                                00223300          
  END UNTIL NOT (CHR IN IDCHARACTERS);                                  00223400          
  J := ZADDTOSTRINGS(IDS,MIN(I,24));    %RETURN A STRING PTR.           00223500          
  IF I > 24 THEN                                             %PPDMTL02  00223550          
    WRITETTY ("Truncated to 24 characters");                 %PPDMTL02  00223560          
  ARG1 := 0;                                                            00223600          
  MICROBUMP(6);                                                         00223700          
END FORMID ELSE                                                         00223800          
                                                                        00223900          
% IF A NUMBER, COLLECT THE DIGITS, COMPRESS AND RETURN THE PROPER       00224000          
% TAG WITH INTEGER VALUE TRUNCATED TO 16 BITS.                          00224100          
IF CHR IN DIGITSNSIGN THEN                                              00224200          
BEGIN                                                                   00224300          
  S:=1;                                                                 00224400          
  IF CHR="-" OR CHR="+" THEN                                            00224500          
  BEGIN                                                                 00224600          
    IF ARG1 NEQ NIL THEN GO TO SINGLE;                                  00224700          
    IF CHR="-" THEN S:=-1;                                              00224800          
    CHR:=ZREADCH(R,BFR);                                                00224900          
    IF NOT ZDIGIT(CHR) THEN                                             00225000          
    BEGIN                                                               00225100          
      R:=*-1;                                                           00225200          
      CHR:=IF S=1 THEN "+" ELSE "-";                                    00225300          
      GO TO SINGLE;                                                     00225400          
    END;                                                                00225500          
  END;                                                                  00225600          
  SCAN BFR[R] FOR I:SZE-R WHILE >= "0";                                 00225700          
  R:=R-1; I:=-R-I+SZE;                                                  00225800          
  IF I>DZ THEN                                                          00225810          
  BEGIN REAL L,Z; Z:=NIL;                                               00225820          
    J:=R+I-DZ;                                                          00225830          
    WHILE J>=R DO                                                       00225840          
    BEGIN                                                               00225850          
      Z:=ZCONS(ZTRACT(INTEGER(BFR[J],DZ)),Z); L:=L+1; J:=J-DZ;          00225860          
    END;                                                                00225870          
    IF R-J<DZ THEN                                                      00225880          
    BEGIN                                                               00225890          
      Z:=ZCONS(ZTRACT(INTEGER(BFR[R],DZ-R+J)),Z); L:=L+1;               00225900          
    END;                                                                00225910          
    J:=NORMALIZE(L,S,Z);                                                00225920          
  END                                                                   00225930          
  ELSE                                                                  00225940          
    J:=ZTRACT(INTEGER(BFR[R],I)*S);                                     00225950          
  ARG1:=2;                                                              00225955          
  R:=R+I;                                                               00225960          
  IF BFR[R]="." THEN                                                    00225970          
  IF BFR[R+1]>="0" THEN                                                 00225980          
  BEGIN R:=R+1;                                                         00225990          
    SCAN BFR[R] FOR I:SZE-R WHILE >= "0";                               00226000          
    R:=SZE-I;                                                           00226010          
    J:=GFLOATING;                                                       00226020          
    ARG1:=1;                                                            00226030          
  END;                                                                  00226040          
  MICROBUMP(20);                                                        00226300          
END FORMINTEGER ELSE                                                    00226400          
                                                                        00226500          
% IF A STRING, THEN GET ALL THE CHARACTERS.                             00226600          
IF CHR = """ THEN                                                       00226700          
BEGIN                       %GET THE FIRST 80 CHARACTERS OF THE STRING. 00226800          
  I:=0;                                                                 00226810          
  DO BEGIN                                                              00226820          
    MICROBUMP(22);                                                      00226830          
    REPLACE STRNGS[I] BY BFR[R] FOR S:SZE-R UNTIL = """;                00226900          
    I:=I+SZE-R-S;                                                       00227000          
    R:=SZE-S+1;                                                         00227010          
    IF S>0 THEN                                                         00227020          
    IF BFR[R]=""" THEN                                                  00227100          
    BEGIN                                                               00227110          
      REPLACE STRNGS[I] BY """;                                         00227120          
      I:=I+1;                                                           00227130          
      R:=R+1;                                                           00227140          
      S:=-1;                                                            00227145          
      MICROBUMP(10);                                                    00227147          
    END                                                                 00227150          
  END UNTIL S>=0;                                                       00227160          
  J:=ZADDTOSTRINGS(STRNGS,MIN(I,SZE));                                  00227200          
  ARG1 := 1;                                                            00227300          
  MICROBUMP(7);                                                         00227400          
END FORMSTRING ELSE                                                     00227500          
                                                                        00227600          
IF CHR = "#" THEN                                                       00227700          
BEGIN                   %BUILD A FUNCTION POINTER.                      00227800          
  IF ARG1 NEQ NIL THEN GO TO SINGLE;                                    00227900          
  FOR I:=15 STEP -4 UNTIL 3 DO                                          00228000          
    J.[I:4] := IF CHR:=ZREADCH(R,BFR)<"0" THEN CHR+9 ELSE CHR;          00228100          
  J.TAG := FUNCTTAG;                                                    00228200          
  ARG1 := 5;                                                            00228300          
  MICROBUMP(30);                                                        00228400          
END FORMFNPTR ELSE                                                      00228500          
                                                                        00228600          
%ANYTHING ELSE RETURN AS 3, A SINGLE CHARACTER.                         00228700          
BEGIN                                                                   00228800          
SINGLE:                                                                 00228900          
  MICROBUMP(6);                                                         00229000          
  J := ZADDTOCHRS(CHR);                                                 00229100          
  ARG1 := 3;                                                            00229200          
END;                                                                    00229300          
                                                                        00229400          
PTR:=R;                                                                 00229500          
ISPVALUE[GSCNVAL.FIELD] := J;                                           00229600          
ARG1 := ZTRACT(ARG1);                                                   00229700          
MICROBUMP(8);                                                           00229800          
PRIMCOUNTER(35);                                                        00229810          
END ZRATOM;                                                             00229900          
                                                                        00230000          
                                                                        00230100          
DEFINE XSCAN = ZRATOM(INPTR,LINER,INSZE)#;                              00230200          
                                                                        00230300          
%SEGMENT(OUTPUT);                                                       00230400          
                                                                        00230500          
                                                                        00230600          
EBCDIC ARRAY ZPATOMARRAY[0:179];                                        00230700          
                                                                        00230710          
PROCEDURE ZPATOM(LL, ESC, OUTER);                                       00230800          
% PROCEDURE DUMPS A SINGLE ATOM TO THE OUTPUT LINE BFR AT LOCATION      00230900          
% PTR. LL IS THE MAXIMUM LENGTH OF THE LINE.                            00231000          
% IF ESC IS TRUE, PRINT ATOM WITH SPECIAL ESCAPE CHARACTERS.            00231100          
VALUE LL,ESC; REAL LL; BOOLEAN ESC;                                     00231200          
EBCDIC ARRAY OUTER[0];                                                  00231210          
BEGIN REAL PP,PR,PL,CH;                                                 00231300          
POINTER P,Q;                                                            00231400          
DEFINE ATOM = ARG1#;                                                    00231500          
DEFINE BFR = OUTER#;                                                    00231600          
DEFINE PTR = OUTPTR#;                                                   00231700          
DEFINE TMP=ZPATOMARRAY#;                                                00231800          
DECLAREANDWEIGH;                                                        00231850          
IF LL=0 THEN LL:=ZEXTEND(ISPVALUE[GLINELENGTH.FIELD]);                  00231900          
IF MSTRINGP(ATOM) THEN          %DUMP A STRING.                         00232000          
BEGIN                                                                   00232100          
  PP := STRINGLENGTH(ATOM);                                             00232200          
  IF ESC THEN                                                           00232210          
  BEGIN                                                                 00232220          
    REPLACE TMP[PP+1] BY ZGETSTRING(ATOM);                              00232230          
    PR := PP+1; PL := PR+PP; PP := PR;                                  00232240          
    DO BEGIN                                                            00232250          
         SCAN TMP[PR] FOR CH:PL-PR UNTIL = """;                         00232260          
         MICROBUMP(PL-PR-CH+6);                                         00232270          
         IF CH>0 THEN                                                   00232280          
         BEGIN                                                          00232290          
              PP := PP-1; PR := PL-CH;                                  00232300          
              REPLACE TMP[PP] BY TMP[PP+1] FOR PR-PP CAT """;           00232310          
              PR := PR+1;                                               00232330          
         END;                                                           00232340          
         MICROBUMP(8);                                                  00232350          
    END UNTIL CH=0;                                                     00232360          
    PP := PP-1; REPLACE TMP[PP] BY """;                                 00232370          
    REPLACE TMP[PL] BY """;                                             00232380          
    ZDMPATOM(TMP[PP] FOR PL+1-PP,PL+1-PP);                              00232390          
    MICROBUMP(18);                                                      00232400          
  END                                                                   00232410          
                                                                        00232420          
  ELSE                                                                  00232500          
  BEGIN                                                                 00232510          
    ZDMPATOM(ZGETSTRING(ATOM), PP);                                     00232600          
    MICROBUMP(4);                                                       00232700          
  END;                                                                  00232710          
END                                                                     00232800          
ELSE IF MCODEP(ATOM) THEN        %DUMP A FUNCTION POINTER.              00232900          
  ZDMPATOM("#" CAT CONVERT(ATOM.FIELD,4), 5)                            00233000          
ELSE IF SMALLP(ATOM) THEN     %DUMP AN INTEGER.                         00233100          
BEGIN                                                                   00233200          
  CH := ZEXTEND(ATOM);                                                  00233300          
  REPLACE TMP BY CH FOR 12 DIGITS;                                      00233400          
  SCAN TMP FOR PP:11 WHILE = "0";                                       00233500          
  PP:=PP+1; PR:=12-PP;                                                  00233600          
  IF CH<0 THEN                                                          00233700          
  BEGIN                                                                 00233800          
    PP := PP+1; PR := PR-1;                                             00233900          
    REPLACE TMP[PR] BY "-";                                             00234000          
  END;                                                                  00234100          
  ZDMPATOM(TMP[PR] FOR PP,PP);                                          00234200          
  MICROBUMP(15);                                                        00234300          
END                                                                     00234400          
ELSE IF MIDP(ATOM) THEN          %DUMP A PRINT NAME.                    00234500          
BEGIN                                                                   00234600          
 CH := STRINGIZE(ISPPNAME[ATOM.FIELD]);                                 00234700          
 IF NOT ESC THEN                                                        00234800          
 BEGIN                                                                  00234900          
  MICROBUMP(9);                                                         00235000          
  PP := STRINGLENGTH(CH);                                               00235100          
  ZDMPATOM(ZGETSTRING(CH),PP)                                           00235200          
 END                                                                    00235300          
 ELSE BEGIN                                                             00235400          
    MICROBUMP(18);                                                      00235500          
    REPLACE TMP BY ZGETSTRING(CH);                                      00235600          
    PL:=PP:=ZGET2;                                                      00235700          
    P:=TMP[0]; Q:=TMP[PL];                                              00235800          
    WHILE PP>0 DO                                                       00235900          
    BEGIN                                                               00236000          
        MICROBUMP(10);                                                  00236100          
        REPLACE Q:Q BY P:P FOR PP:PP WHILE IN LETTERSNDIGITS;           00236200          
        IF PP>0 THEN                                                    00236300          
        BEGIN                                                           00236400          
            PR:=PR+1;                                                   00236500          
            REPLACE Q:Q BY "!", P:P FOR 1;                              00236600          
            PP:=PP-1;                                                   00236700          
        END;                                                            00236800          
    END;                                                                00236900          
    PP:=PL+PR;                                                          00237000          
    ZDMPATOM(TMP[PL] FOR PP,PP);                                        00237100          
   END                                                                  00237110          
END                                                                     00237120          
ELSE IF BIGP(ATOM) THEN     %DUMP AN INTEGER.                           00237130          
BEGIN                                                                   00237140          
  CH := ZEXTEND(MCAR[MCDR[ATOM:=ATOM.FIELD]]);                          00237150          
  REPLACE TMP BY CH FOR 12 DIGITS;                                      00237160          
  SCAN TMP FOR PP:11 WHILE = "0";                                       00237170          
  PP:=PP+1; PR:=12-PP;                                                  00237180          
  IF MCAR[ATOM]<ZERO THEN                                               00237190          
  BEGIN                                                                 00237200          
    PP := PP+1; PR := PR-1;                                             00237210          
    REPLACE TMP[PR] BY "-";                                             00237220          
  END;                                                                  00237230          
  ATOM:=MCDR[MCDR[ATOM]];                                               00237240          
  DO BEGIN MICROBUMP(8);                                                00237250          
    CH:=ZEXTEND(MCAR[ATOM]);                                            00237260          
    REPLACE TMP[PP+PR] BY CH FOR DZ DIGITS;                             00237270          
    PP:=PP+DZ;                                                          00237280          
    IF PP>LL THEN                                                       00237290          
    BEGIN                                                               00237300          
         ZDMPATOM(TMP[PR] FOR LL,LL);                                   00237310          
         REPLACE TMP[0] BY TMP[PR+LL] FOR PP-LL;                        00237320          
         PR:=0; PP:=PP-LL;                                              00237330          
         MICROBUMP(7);                                                  00237340          
    END;                                                                00237350          
    ATOM:=MCDR[ATOM];                                                   00237360          
  END UNTIL ATOM=NIL;                                                   00237370          
  ZDMPATOM(TMP[PR] FOR PP,PP);                                          00237380          
  MICROBUMP(17);                                                        00237390          
END;                                                                    00237395          
MICROBUMP(4);                                                           00237500          
PRIMCOUNTER(25-REAL(ESC));                                              00237550          
END ZPATOM;                                                             00237600          
                                                                        00237700          
                                                                        00237800          
DEFINE XPATOM = ZPATOM(0,TRUE,OUTER)#;                                  00237900          
DEFINE XPATOM2 = ZPATOM(0,FALSE,OUTER)#;                                00238000          
                                                                        00238100          
                                                                        00238200          
PROCEDURE XGENSYM;                                                      00238300          
% ADDS A GENSYM TO THE SYMBOL TABLE AND THE STRING SPACE.               00238400          
% GGENSYM IS THE NUMBER WHICH KEEPS GETTING ADDED.                      00238500          
BEGIN LABEL EXIT;                                                       00238600          
DECLAREANDWEIGH;                                                        00238650          
ARG1 := ZIDSPACE;                                                       00238700          
REPLACE CONVERTPTR BY "G" CAT DECIMAL(GGENSYM,5);                       00238800          
ISPPNAME[ARG1] := ZADDTOSTRINGS(CONVERTPTR,6)&0 TAG;                    00238900          
ISPPROP[ARG1] := ISPVALUE[ARG1] := NIL;                                 00239000          
ARG1.TAG := IDTAG;                                                      00239100          
GGENSYM:=*+1;       %MOVE TO NEXT GENSYM PLEASE.                        00239200          
MICROBUMP(13);                                                          00239400          
PRIMCOUNTER(3);                                                         00239450          
END XGENSYM;                                                            00239500          
                                                                        00239600          
                                                                        00239700          
PROCEDURE XREADCH;                                                      00239800          
% PROCEDURE PICKS UP NEXT CHARACTER FROM BUFFER. IF CHARACTER IS        00239900          
% 0 THEN RETURN $EOF$, IF 1 THEN RETURN $EOL$.                          00240000          
BEGIN REAL CHR;                                                         00240100          
DECLAREANDWEIGH;                                                        00240150          
IF INPTR>0 AND INPTR<INSZE THEN                                         00240200          
BEGIN                                                                   00240300          
  CHRINTERN(REAL(LINER[INPTR],1));                                      00240400          
  INPTR := INPTR+1;                                                     00240500          
END                                                                     00240600          
ELSE                                                                    00240700          
IF (CHR := ZREADCH(INPTR, LINER)) <= 1 THEN    %PICK UP A CHARACTER     00240800          
IF CHR = 0 THEN          %RETURN $EOF$.                                 00240900          
  ARG1 := GEOF                                                          00241000          
ELSE                                                                    00241100          
  ARG1 := GEOL           %RETURN $EOL$.                                 00241200          
ELSE                                                                    00241300          
  CHRINTERN(CHR);                                                       00241400          
MICROBUMP(8);                                                           00241500          
PRIMCOUNTER(21);                                                        00241600          
END XREADCH;                                                            00241700          
                                                                        00241800          
                                                                        00241900          
PROCEDURE XTERPRI;                                                      00242000          
% TERMINATES THE PRINT LINE AND DUMPS TO THE SELECTED FILE.             00242100          
BEGIN LABEL EXIT;                                                       00242200          
    DECLAREANDWEIGH;                                                    00242250          
    WRITEIOFILE(CURCHANOUT,OUTER FOR OUTPTR);                           00242300          
    OUTPTR:=0;                                                          00242400          
    MICROBUMP(45);                                                      00242500          
    PRIMCOUNTER(17);                                                    00242600          
END XTERPRI;                                                            00242700          
                                                                        00242800          
                                                                        00242900          
PROCEDURE XPRINC;                                                       00243000          
% A TYPE MISMATCH ERROR IF ARGUMENT IS NOT AN ID. PRINT THE FIRST       00243100          
% CHARACTER OF IT IF IT IS.                                             00243200          
BEGIN LABEL EXIT;                                                       00243300          
DECLAREANDWEIGH;                                                        00243350          
IF NOT MIDP(ARG1) THEN        %TYPE MISMATCH ERROR.                     00243400          
  MTMSMTCH(ARG1, GID, GPRINC) ELSE                                      00243500          
BEGIN STOPCOUNT;                                                        00243510          
IF ARG1 = GEOL THEN XTERPRI   %DO A TERPRI() IF ARGUMENT IS $EOL$.      00243600          
  ELSE XPATOM;                %OTHERWISE PRINT THE ATOM.                00243700          
STARTCOUNT END;                                                         00243710          
MICROBUMP(5);                                                           00243800          
PRIMCOUNTER(18);                                                        00243900          
END XPRINC;                                                             00244000          
                                                                        00244100          
                                                                        00244200          
PROCEDURE XCLOSE;                                                       00244300          
% CLOSE THE FILE WHOSE NUMBER IS GIVEN. DO NOT CLOSE DATA COMM          00244400          
% I/O AS THIS WILL CAUSE TROUBLE.                                       00244500          
BEGIN REAL TARG1;                                                       00244600          
DECLAREANDWEIGH;                                                        00244610          
MICROBUMP(20000);                                                       00244620          
TARG1 := ZEXTEND(ARG1);                                                 00244700          
IF TARG1 > FMAX OR TARG1 < 0 THEN           %YEECH, BAD CHANNEL NUMBER. 00244800          
BEGIN                                                                   00244900          
  MLIST(ARG1, ERRS[3]);                                                 00245000          
  ZERROR(103, ARG1);                                                    00245100          
END                                                                     00245200          
ELSE                                                                    00245300          
IF TARG1>0 THEN                                                         00245400          
IF FILEINUSE[TARG1] THEN                                                00245500          
BEGIN                                                                   00245600          
  IF FILEINPUT[TARG1] THEN                                              00245700          
    CLOSE(IOFILE[TARG1])                                                00245800          
  ELSE                                                                  00245900          
    CLOSE (IOFILE[TARG1], CRUNCH);                           %PPDMTL06  00246000          
  FILEINUSE[TARG1]:=FALSE;                                              00246100          
  FILEINPUT[TARG1]:=FALSE;                                              00246200          
END;                                                                    00246300          
PRIMCOUNTER(38);                                                        00246400          
END XCLOSE;                                                             00246500          
                                                                        00246600          
                                                                        00246700          
PROCEDURE XEJECT;                                                       00246800          
% SKIP TO TOP OF PAGE ON SOME FILE.                                     00246900          
BEGIN LABEL EXIT;                                                       00247000          
    DECLAREANDWEIGH;                                                    00247010          
    MICROBUMP(50);                                                      00247020          
    IF CURCHANOUT = 0 THEN WRITETTY(4"0C") ELSE                         00247100          
    IF CURCHANOUT = 2 THEN WRITE(LINE[SKIP 1]) ELSE                     00247110          
    WRITE(IOFILE[CURCHANOUT]);   %  ???   PAGE (" ");                   00247200          
    ARG1 := NIL;                                                        00247210          
    PRIMCOUNTER(39);                                                    00247300          
END XEJECT;                                                             00247400          
                                                                        00247500          
                                                                        00247600          
PROCEDURE ZERR(A,S); VALUE A,S; REAL A,S;                               00247700          
% INTERNAL PROCEDURE FOR HANDLING ERROR 12.                             00247800          
BEGIN REAL TARG1;                                                       00247900          
TARG1 := ARG1;                                                          00248000          
ARG1:=A;                                                                00248100          
ARG2:=TARG1;                                                            00248200          
MLIST(ERRS[S], ARG1);                                                   00248300          
ARG1:=ZCONS(ARG2,ARG1);                                                 00248400          
ZERROR(105, ARG1);                                                      00248500          
END ZERR;                                                               00248600          
                                                                        00248700          
                                                                        00248800          
PROCEDURE XOPEN;                                                        00248900          
% ARG1 IS A LIST OF 1 -> 3 STRINGS WHICH FORM THE NAME OF THE FILE      00249000          
% TO OPEN. ARG2 MUST BE EITHER INPUT OR OUTPUT. THE SELECTED CHANNEL    00249100          
% NUMBER WHICH IS A POINTER TO IOFILE IS RETURNED.                      00249200          
BEGIN REAL TMP,TARG1,PTR,START,STOP,I,J,K,V;                            00249300          
EBCDIC ARRAY FID[0:119];                                                00249400          
POINTER P;                                                              00249500          
LABEL EXIT;                                                             00249600          
DECLAREANDWEIGH;                                                        00249700          
MICROBUMP(20000);                                                       00249710          
REPLACE FID BY 0 FOR 20 WORDS;                                          00249800          
START := STOP := -1;                                                    00249810          
TARG1 := ARG1;                                                          00249820          
IF MPAIRP(TARG1) THEN                                                   00249830          
BEGIN                                                                   00249840          
    TMP := MCDR[ARG1]; TARG1 := MCAR[ARG1];                             00249850          
    WHILE START<0 DO                                                    00249860          
    BEGIN                                                               00249870          
         START := STOP;                                                 00249880          
         IF MATOM(TMP) THEN                                             00249890          
              MTMSMTCH(TMP,GINTEGER,GOPEN);                             00249900          
         STOP := MCAR[TMP];                                             00249910          
         IF NOT SMALLP(STOP) THEN                                       00249920          
              MTMSMTCH(STOP,GINTEGER,GOPEN);                            00249930          
         STOP := ZEXTEND(STOP);                                         00249935          
         TMP := MCDR[TMP];                                              00249940          
    END;                                                                00249950          
END                                                                     00249960          
ELSE                                                                    00249970          
BEGIN                                                                   00249980          
    STOP := 100000000;                                                  00249990          
    START := 0;                                                         00250000          
END;                                                                    00250010          
IF MIDP(TARG1) THEN                                                     00250020          
IF TARG1 NEQ NIL THEN                                                   00250100          
  TARG1 := STRINGIZE(ISPPNAME[TARG1.FIELD]);                            00250200          
IF MSTRINGP(TARG1) THEN                                                 00250300          
    REPLACE FID BY ZGETSTRING(TARG1) CAT "."                            00250400          
ELSE                                                                    00250500          
    MTMSMTCH(TARG1,GIDORSTRING,GOPEN);                                  00250600          
SCAN P:FID UNTIL = 0;                                                   00250700          
REPLACE P BY ".";                                                       00250800          
                                                                        00250900          
% ERROR IF NOT INPUT OR OUTPUT REQUESTED.                               00251000          
IF ARG2 NEQ GINPUT AND ARG2 NEQ GOUTPUT THEN                            00251100          
BEGIN                                                                   00251200          
  MLIST(ARG2, ERRS[6]);                                                 00251300          
  ZERROR(106, ARG1);                                                    00251400          
END;                                                                    00251600          
                                                                        00251700          
% SELECT CARDS AND PRINTER SPECIALLY. OTHERS, SEARCH THE FILE LIST.     00251800          
PTR := IF FID = "CARDS." THEN 1                                         00252000          
       ELSE IF FID = "PRINTER." THEN 2 ELSE 3;                          00252100          
IF PTR = 3 THEN                %FILES OTHER THAN CARDS/PRINTER.         00252200          
BEGIN                                                                   00252300          
  WHILE FILEINUSE[PTR] DO                                               00252400          
  BEGIN                                                                 00252500          
    PTR:=PTR+1;                                                         00252600          
    IF PTR > FMAX THEN         %ERROR, NO UNUSED FILES.                 00252700          
    BEGIN                                                               00252800          
      MLIST(TARG1, ERRS[4]);                                            00252900          
      ZERROR(104, ARG1);                                                00253000          
    END;                                                                00253200          
  END;                                                                  00253300          
  REPLACE IOFILE[PTR].TITLE BY FID;                                     00253400          
END;                                                                    00253500          
                                                                        00253600          
% IF AN INPUT FILE, OPEN IT (UNLESS AN ERROR), SET FLAGS AND POINTERS   00253700          
% AND RETURN THE CHANNEL NUMBER.                                        00253800          
IF ARG2 = GINPUT THEN                                                   00253900          
BEGIN                                                                   00254000          
  IF PTR = 2 THEN                                            %PPDMTL08  00254010          
  BEGIN                                                      %PPDMTL08  00254020          
    MLIST (TARG1, ERRS[4]);                                  %PPDMTL08  00254030          
    ZERROR (104, ARG1);                                      %PPDMTL08  00254040          
  END                                                        %PPDMTL08  00254050          
  ELSE BEGIN                                                 %PPDMTL08  00254060          
  IOFILE[PTR](AREASIZE=0,AREAS=0,FILETYPE=8);                           00254100          
  IF NOT IOFILE[PTR].PRESENT THEN                                       00254200          
  BEGIN                                                                 00254300          
    MLIST(TARG1, ERRS[3]);                                              00254400          
    ZERROR(103,ARG1);                                                   00254500          
  END                                                                   00254600          
  ELSE                                                                  00254700          
  BEGIN                                                                 00254800          
    ARG1 := ZTRACT(PTR);                                                00254900          
    FILEINPUT[PTR]:=TRUE;                                               00255000          
    TMP := IOFILE[PTR].FILEKIND;                                        00255100          
    IF TMP >= 32 AND TMP <= 63 THEN                          %PPDMTL04  00255110          
    BEGIN                                                    %PPDMTL04  00255120          
         MLIST (TARG1, ERRS[4]);                             %PPDMTL04  00255130          
         ZERROR (104, ARG1);                                 %PPDMTL04  00255140          
    END;                                                     %PPDMTL04  00255150          
    TMP := IF TMP=VALUE(ALGOLSYMBOL) OR TMP=VALUE(SEQDATA) THEN 72 ELSE 00255200          
           IF TMP=VALUE(DATA) OR TMP=VALUE(CDATA) THEN 80 ELSE 80;      00255300          
    FILEINFO[PTR] := TMP;                                               00255400          
    IOHERE[PTR] := START; IOSTOP[PTR] := STOP;                          00255410          
    IF STOP < 100000000 THEN                                            00255420          
    BEGIN                                                               00255430          
         IF TMP=80 THEN                                                 00255440          
         BEGIN IOHERE[PTR]:=*-100;                                      00255442          
              J := (START+99) DIV 100 - 1                               00255450          
         END                                                            00255455          
         ELSE                                                           00255460          
         BEGIN                                                          00255470          
              P := FID[72];                                             00255475          
              I := -1; J := IOFILE[PTR].LASTRECORD;                     00255480          
              WHILE J-I>1 DO                                            00255490          
              BEGIN                                                     00255500          
                   K := (I+J).[38:38];                                  00255510          
                   READ(IOFILE[PTR][K],14,FID);                         00255520          
                   V := INTEGER(P,8);                                   00255530          
                   IF V=START THEN I:=K;                                00255540          
                   IF V<START THEN I:=K ELSE J:=K;                      00255550          
              END;                                                      00255560          
         END;                                                           00255570          
         IF J<=0 THEN                                                   00255572          
              REWIND(IOFILE[PTR])                                       00255574          
         ELSE                                                           00255576          
              READ(IOFILE[PTR][J-1],14,FID);                            00255578          
    END;                                                                00255580          
  END;                                                                  00255590          
       END                                                   %PPDMTL08  00255595          
END                                                                     00255600          
ELSE                              %DO ALMOST THE SAME FOR OUTPUT.       00255700          
BEGIN                                                                   00255800          
  IF PTR>2 THEN                                              %PPDMTL09  00255810          
  BEGIN                                                      %PPDMTL09  00255820          
    IF IOFILE[PTR].RESIDENT THEN                             %PPDMTL09  00255825          
      WRITETTY ("This file already exists. A CLOSE will override it."); 00255830          
                                                             %PPDMTL09  00255831          
    IOFILE[PTR](MAXRECSIZE=15,BLOCKSIZE=300,AREASIZE=600,    %PPDMTL09  00255900          
      AREAS=40,FILETYPE=0);                                  %PPDMTL09  00256000          
  END;                                                       %PPDMTL09  00256010          
  ARG1 := ZTRACT(PTR);                                                  00256100          
  FILEINPUT[PTR]:=FALSE;                                                00256200          
END;                                                                    00256300          
EXIT:                                                                   00256350          
FILEINUSE[PTR] := TRUE;       %MARK FILE AS IN USE.                     00256400          
PRIMCOUNTER(41);                                                        00256600          
END XOPEN;                                                              00256700          
                                                                        00256800          
                                                                        00256900          
DECLARE(XPOSN,42,ARG1:=ZTRACT(OUTPTR));                                 00257000          
                                                                        00257100          
                                                                        00257200          
PROCEDURE XRDS;                                                         00257300          
% SETS CUR.CHAN.IN TO NUMERIC ARGUMENT IF 0 OR 1. 0-ME, 1-CARDS.        00257400          
BEGIN REAL TMP;                                                         00257500          
DECLAREANDWEIGH;                                                        00257550          
TMP := IF ARG1=NIL THEN 0 ELSE ZEXTEND(ARG1);                           00257600          
IF TMP > FMAX OR TMP < 0 THEN                                           00257700          
  ZERR(GINPUT,5);                                                       00257800          
IF TMP > 0 THEN               %MAKE SURE FILE IS OPEN.                  00257900          
  IF NOT FILEINUSE[TMP] OR NOT FILEINPUT[TMP] THEN                      00258000          
    ZERR(GINPUT,5);                                                     00258100          
ARG1 := ZTRACT(CURCHANIN);     %OLD CHANNEL.                            00258200          
CURCHANIN := TMP;                                                       00258300          
INPTR := -1;                  %FORCE A READ.                            00258400          
MICROBUMP(13);                                                          00258500          
PRIMCOUNTER(43);                                                        00258600          
END XRDS;                                                               00258700          
                                                                        00258800          
                                                                        00258900          
PROCEDURE XWRS;                                                         00259000          
% SAME AS XRDS BUT CUR.CHAN.OUT IS CHANGED.                             00259100          
BEGIN REAL TMP;                                                         00259200          
DECLAREANDWEIGH;                                                        00259250          
TMP := IF ARG1=NIL THEN 0 ELSE ZEXTEND(ARG1);                           00259300          
IF TMP>FMAX OR TMP<0 THEN     %ERROR IF NUMBER TOO LARGE.               00259400          
  ZERR(GOUTPUT,5);                                                      00259500          
IF TMP>0 THEN                 %MAKE SURE FILE IS OPENED.                00259600          
  IF NOT FILEINUSE[TMP] OR FILEINPUT[TMP] THEN                          00259700          
    ZERR(GOUTPUT,5);                                                    00259800          
ARG1 := ZTRACT(CURCHANOUT);                                             00259900          
CURCHANOUT := TMP;                                                      00260000          
MICROBUMP(12);                                                          00260100          
PRIMCOUNTER(44);                                                        00260200          
END XWRS;                                                               00260300          
                                                                        00260400          
                                                                        00260500          
EBCDIC ARRAY EXPCOMARRAY[0:131];                                        00260700          
                                                                        00260710          
PROCEDURE XEXPLODE;                                                     00260800          
% PRINT THE ATOM IN ARG1 INTO A SPECIAL BUFFER AND THEN BUILD IT        00260900          
% INTO A LIST OF CHARACTERS AND RETURN IT.                              00261000          
BEGIN REAL PTR,S;                                                       00261100          
DEFINE TMP=EXPCOMARRAY#;                                                00261200          
DECLAREANDWEIGH;                                                        00261250          
IF MPAIRP(ARG1) OR MVECTORP(ARG1) THEN                                  00261300          
    MTMSMTCH(ARG1, GATOM, GEXPLODE);                                    00261400          
PTR := OUTPTR;                                                          00261600          
OUTPTR := 0;                                                            00261700          
IF BIGP(ARG1) THEN                                                      00261710          
BEGIN                                                                   00261720          
  S:=ABS(ZEXTEND(MCAR[ARG1.FIELD]))*DZ+3;                               00261730          
  IF SIZE(TMP)<=S THEN                                                  00261740          
  BEGIN                                                                 00261742          
    RESIZE(TMP,2*S);                                                    00261744          
    RESIZE(ZPATOMARRAY,2*S);                                            00261746          
  END;                                                                  00261748          
END                                                                     00261750          
ELSE                                                                    00261760          
  S:=132;                                                               00261770          
STOPCOUNT;                                                              00261780          
ZPATOM(S,TRUE,TMP);              %GET THE CHARACTERS.                   00261800          
STARTCOUNT;                                                             00261890          
S := NIL;                      %A POINTER TO PREVIOUS ELEMENT.          00261900          
DO BEGIN                                                                00262000          
  CHRINTERN(REAL(TMP[OUTPTR:=OUTPTR-1],1));                             00262100          
  STOPCOUNT;                                                            00262150          
  S := ZCONS(ARG1,S);          %CHARACTER FIRST ADDED AS AN ID.         00262200          
  STARTCOUNT;                                                           00262250          
  MICROBUMP(4);                                                         00262300          
END UNTIL OUTPTR=0;                                                     00262400          
ARG1 := S;                                                              00262500          
OUTPTR := PTR;                                                          00262700          
MICROBUMP(12);                                                          00262800          
PRIMCOUNTER(0);                                                         00262900          
END XEXPLODE;                                                           00263000          
                                                                        00263100          
                                                                        00263200          
PROCEDURE XCOMPRESS;                                                    00263300          
% BUILD THE CHARACTERS IN THE LIST IN ARG1 INTO AN ATOM AND RETURN.     00263400          
% 101 ERROR IF ANYTHING BAD GOES WRONG.                                 00263500          
BEGIN REAL PTR,TMP,L;                                                   00263600          
DEFINE HBUF=EXPCOMARRAY#;                                               00263700          
LABEL EXIT,ERR;                                                         00263800          
DECLAREANDWEIGH;                                                        00263850          
                                                                        00263900          
% BUILD THE LIST OF CHARACTERS INTO STRING IN HBUF BUFFER.              00264000          
TMP:=132;                                                               00264100          
WHILE MPAIRP(ARG1) DO                                                   00264200          
BEGIN                                                                   00264300          
  L:=MCAR[ARG1];                                                        00264400          
  IF MIDP(L) THEN                                                       00264500          
    REPLACE HBUF[PTR] BY ZGETSTRING(STRINGIZE(ISPPNAME[L.FIELD]))       00264600          
  ELSE                                                                  00264700          
  IF SMALLP(L) THEN                                                     00264800          
  BEGIN                                                                 00264900          
    L:=ZEXTEND(L)+"0";                                                  00265000          
    IF L>"9" THEN GO TO ERR;                                            00265100          
    REPLACE HBUF[PTR] BY L.SHIFTUP FOR 1;                               00265200          
  END                                                                   00265300          
  ELSE GO TO ERR;                                                       00265400          
  PTR:=*+1;                                                             00265500          
  IF PTR>=TMP THEN                                                      00265510          
  BEGIN                                                                 00265520          
    IF PTR>=SIZE(HBUF) THEN RESIZE(HBUF,2*PTR);                         00265530          
    TMP:=SIZE(HBUF);                                                    00265540          
  END;                                                                  00265550          
  ARG1 := MCDR[ARG1];                                                   00265600          
  MICROBUMP(11);                                                        00265700          
END BUILDCHARS;                                                         00265800          
                                                                        00265900          
% BUILD THE ATOM USING RATOM.                                           00266000          
REPLACE HBUF[PTR] BY "  ";                                              00266010          
ARG1 := NIL;                                                            00266100          
TMP:=0;                                                                 00266120          
STOPCOUNT;                                                              00266150          
ZRATOM(TMP, HBUF, PTR+1);                                               00266200          
STARTCOUNT;                                                             00266250          
IF ARG1=ZERO THEN                                                       00266300          
BEGIN                                                                   00266400          
  MICROBUMP(3);                                                         00266500          
  L:=ZIDSPACE;                                                          00266600          
  ISPPNAME[L]:=ISPVALUE[GSCNVAL.FIELD]&0TAG;                            00266700          
  ISPPROP[L]:=ISPVALUE[L]:=NIL;                                         00266800          
  ARG1:=L & IDTAG TAG;                                                  00266900          
END                                                                     00267000          
ELSE                                                                    00267100          
  ARG1 := ISPVALUE[GSCNVAL.FIELD];                                      00267200          
IF TMP < PTR THEN        %ERROR IF NOT ALL CHARACTERS USED.             00267300          
ERR:                                                                    00267400          
  ZERROR(101, ERRS[1]);                                                 00267500          
EXIT:                                                                   00267600          
MICROBUMP(17);                                                          00267700          
PRIMCOUNTER(5);                                                         00267800          
END XCOMPRESS;                                                          00267900          
                                                                        00267910          
                                                                        00267920          
PROCEDURE XLENGTHC;                                                     00267930          
    BEGIN REAL I,J;                                                     00267940          
         DEFINE A = EXPCOMARRAY#;                                       00267945          
         DECLAREANDWEIGH;                                               00267947          
         IF MSTRINGP(ARG1) THEN                                         00267950          
              ARG1 := STRINGLENGTH(ARG1)                                00267960          
         ELSE                                                           00267970          
         IF MIDP(ARG1) THEN                                             00267980          
         BEGIN                                                          00267990          
              ARG1 := ISPPNAME[ARG1.FIELD];                             00267992          
              ARG1 := STRINGLENGTH(ARG1);                               00267994          
         END                                                            00267996          
         ELSE                                                           00268000          
         IF MCODEP(ARG1) THEN                                           00268010          
              ARG1 := 5                                                 00268020          
         ELSE                                                           00268030          
         IF SMALLP(ARG1) THEN                                           00268040          
         BEGIN                                                          00268050          
              MICROBUMP(15);                                            00268055          
              I := ZEXTEND(ARG1);                                       00268060          
              REPLACE A BY I FOR 12 DIGITS;                             00268070          
              SCAN A FOR J:11 WHILE = "0";                              00268080          
              ARG1 := (IF I<0 THEN 2 ELSE 1)+J;                         00268090          
         END                                                            00268091          
         ELSE                                                           00268092          
         IF BIGP(ARG1) THEN                                             00268094          
         BEGIN                                                          00268096          
              MICROBUMP(20);                                            00268097          
              I := ZEXTEND(MCAR[MCDR[ARG1.FIELD]]);                     00268098          
              REPLACE A BY I FOR DZ DIGITS;                             00268100          
              SCAN A FOR J:DZ WHILE = "0";                              00268102          
              I := ZEXTEND(MCAR[ARG1.FIELD]);                           00268104          
              ARG1 := (IF I>0 THEN (I-1)*DZ ELSE (-I-1)*DZ+1)+J;        00268106          
         END                                                            00268108          
         ELSE MTMSMTCH(ARG1,GATOM,GEXPLODE);                            00268110          
         ARG1 := ZTRACT(ARG1);                                          00268120          
         MICROBUMP(6);                                                  00268130          
         PRIMCOUNTER(2);                                                00268140          
    END XLENGTHC;                                                       00268160          
                                                                        00268170          
                                                                        00268180          
PROCEDURE XGETV;                                                        00268200          
% RETRIEVES THE ELEMNT OF A VECTOR. TYPE MISMATCH ERROR OCCURS IF       00268300          
% ARG1 IS NOT A VECTOR, OR ARG2 IS NOT AN INTEGER.                      00268400          
BEGIN LABEL EXIT;                                                       00268500          
DECLAREANDWEIGH;                                                        00268550          
IF NOT MVECTORP(ARG1) THEN                                              00268600          
  MTMSMTCH(ARG1, GVECTOR, GGETV);                                       00268700          
IF NOT SMALLP(ARG2) THEN                                                00268800          
  MTMSMTCH(ARG2, GINTEGER, GGETV);                                      00268900          
IF ARG2<ZERO OR VSP[ARG1.FIELD] < ARG2                                  00269000          
  THEN BEGIN       %SUBSCRIPT RANGE ERROR.                              00269100          
  ARG3 := ARG2;                                                         00269200          
  MLIST(ARG3, ERRS[8]);                                                 00269300          
  ZERROR(108, ARG1);                                                    00269400          
  END                                                                   00269500          
ELSE ARG1 := VSP[ARG1+ARG2-(0&VECTORTAG TAG+ZEROLIT-1)];                00269600          
MICROBUMP(10);                                                          00269700          
PRIMCOUNTER(46);                                                        00269800          
END XGETV;                                                              00269900          
                                                                        00270000          
PROCEDURE GETVECTOR(L); VALUE L; REAL L;                                00270100          
% GET A VECTOR FROM THE V SPACE BY SOME TECHNIQUE.                      00270200          
% RETURNS NUMBER (SIZE) IF NOT ALLOCATED.                               00270300          
BEGIN REAL P,Q,TMP;                                                     00270400          
Q:=-1;                                                                  00270500          
P:=VSPFREE;                                                             00270600          
IF L>0 THEN                                                             00270700          
DO BEGIN                                                                00270800          
    IF VSP[P]=L THEN BEGIN                                              00270900          
        VSP[P]:=ARG1;                                                   00271000          
        ARG1:=P;                                                        00271100          
        ARG1.TAG:=VECTORTAG;                                            00271200          
        IF Q<0 THEN VSPFREE:=VSP[P+1]                                   00271300          
        ELSE VSP[Q+1]:=VSP[P+1];                                        00271400          
        P:=-1;                                                          00271500          
        MICROBUMP(9);                                                   00271600          
    END                                                                 00271700          
    ELSE                                                                00271800          
    IF VSP[P]>L+1 THEN BEGIN                                            00271900          
        TMP:=P;                                                         00272000          
        VSP[P+L+2]:=VSP[P]-L-2;                                         00272100          
        VSP[P]:=ARG1;                                                   00272200          
        VSP[P+L+3]:=VSP[P+1];                                           00272300          
        IF Q<0 THEN VSPFREE:=P+L+2                                      00272400          
        ELSE VSP[Q+1]:=P+L+2;                                           00272500          
        ARG1 := TMP;                                                    00272600          
        ARG1.TAG:=VECTORTAG;                                            00272700          
        P:=-1;                                                          00272800          
        MICROBUMP(12);                                                  00272900          
    END                                                                 00273000          
    ELSE                                                                00273100          
    BEGIN                                                               00273200          
        Q:=P;                                                           00273300          
        P:=VSP[Q+1];                                                    00273400          
        MICROBUMP(5);                                                   00273500          
    END;                                                                00273600          
END UNTIL P<0;                                                          00273700          
MICROBUMP(5);                                                           00273800          
END GETVECTOR;                                                          00273900          
                                                                        00274000          
PROCEDURE XMKVECT;                                                      00274100          
% CREATE A VECTOR OF LENGTH OF THE SINGLE ARGUMENT. TYPE MISMTACH       00274200          
% ERROR CHECKING ONLY.                                                  00274300          
BEGIN REAL I,J;                                                         00274400          
DECLAREANDWEIGH;                                                        00274450          
IF NOT SMALLP(ARG1) THEN BEGIN                                          00274500          
  MTMSMTCH(ARG1, GINTEGER, GMKVECT);                                    00274600          
  END                                                                   00274700          
ELSE BEGIN              %INTEGER ARGUMENT, CHECK FOR SIZE.              00274800          
  J:=ZEXTEND(ARG1);                                                     00274900          
  GETVECTOR(J);                                                         00275000          
  IF SMALLP(ARG1) THEN BEGIN                                            00275100          
    ZGARBAGE(3);                                                        00275200          
    GETVECTOR(J);                                                       00275300          
    IF SMALLP(ARG1) THEN BEGIN                                          00275400          
      MLIST(ARG1,ERRS[9]);                                              00275500          
      ZERROR(109,ARG1);                                                 00275600          
    END;                                                                00275700          
  END;                                                                  00275800          
  I:=ARG1.FIELD+1;                                                      00275900          
  DO BEGIN                                                              00276000          
      VSP[I] := NIL;                                                    00276100          
      I:=I+1;                                                           00276200          
      MICROBUMP(4);                                                     00276300          
      J:=*-1     ;                                                      00276400          
  END UNTIL J<0;                                                        00276500          
  END;                                                                  00276600          
MICROBUMP(7);                                                           00276700          
PRIMCOUNTER(47);                                                        00276800          
END XMKVECT;                                                            00276900          
                                                                        00277000          
                                                                        00277100          
PROCEDURE XPUTV;                                                        00277200          
% PLACES ARG3 AT POSITION ARG2 IN VECTOR ARG1. TYPE MISMATCH CHECKING   00277300          
% ON ARG1, ARG2 AND SUBSCRIPT RANGE CHECKING ON ARG2.                   00277400          
BEGIN LABEL EXIT;                                                       00277500          
DECLAREANDWEIGH;                                                        00277550          
IF NOT MVECTORP(ARG1) THEN                                              00277600          
  MTMSMTCH(ARG1, GVECTOR, GPUTV);                                       00277700          
IF NOT SMALLP(ARG2) THEN                                                00277800          
  MTMSMTCH(ARG2, GINTEGER, GPUTV);                                      00277900          
IF ARG2<ZERO OR VSP[ARG1.FIELD] < ARG2                                  00278000          
  THEN BEGIN                    %SUBSCRIPT RANGE ERROR.                 00278100          
  ARG3 := ARG2;                                                         00278200          
  MLIST(ARG3, ERRS[8]);                                                 00278300          
  ZERROR(108, ARG1);                                                    00278400          
  END                                                                   00278500          
ELSE ARG1 := VSP[ARG1+ARG2-(0&VECTORTAG TAG+ZEROLIT-1)] := ARG3;        00278600          
MICROBUMP(10);                                                          00278700          
PRIMCOUNTER(48);                                                        00278800          
END XPUTV;                                                              00278900          
                                                                        00279000          
                                                                        00279100          
 DECLARE(XUPLIM,49,MUPLIM);                                             00279200          
$PAGE                                                                   00279300          
                                                                        00279400          
                                                                        00280300          
                                                                        00280400          
REAL PROCEDURE ZREGLIST(N); VALUE N; REAL N;                            00280500          
% PROCEDURE BUILDS A LIST OF THE REGISTER 1 -> N AND RETURNS            00280600          
% A POINTER TO IT.                                                      00280700          
BEGIN LABEL EXIT;                                                       00280800          
REAL A;                                                                 00280900          
MICROBUMP(3*N+5);                                                       00281000          
A := NIL;                                                               00281100          
WHILE N>0 DO                                                            00281200          
  A := ZCONS(ARGS[N:=N-1], A);                                          00281300          
ZREGLIST:=A;                                                            00281400          
END ZREGLIST;                                                           00281500          
                                                                        00281600          
                                                                        00281700          
                                                                        00281800          
BOOLEAN PROCEDURE ZEQUAL(P,Q); VALUE P,Q; REAL P,Q;                     00281900          
BEGIN LABEL L,EXIT;                                                     00282000          
    DECLAREANDWEIGH;                                                    00282050          
L:  MICROBUMP(3);                                                       00282100          
    IF P=Q THEN BEGIN ZEQUAL:=TRUE; GO TO EXIT; END;                    00282200          
    IF P.TAG NEQ Q.TAG THEN GO TO EXIT;                                 00282300          
    IF MPAIRP(P) THEN                                                   00282400          
    BEGIN                                                               00282500          
         MICROBUMP(2);                                                  00282600          
         STOPCOUNT;                                                     00282650          
         IF NOT ZEQUAL(MCAR[P],MCAR[Q]) THEN                            00282700          
         BEGIN                                                          00282710          
              STARTCOUNT;                                               00282720          
              GO TO EXIT;                                               00282730          
         END;                                                           00282740          
         STARTCOUNT;                                                    00282750          
         MICROBUMP(2);                                                  00282800          
         P:=MCDR[P]; Q:=MCDR[Q]; GO TO L;                               00282900          
    END;                                                                00283000          
    MICROBUMP(1);                                                       00283010          
    IF BIGP(P) THEN                                                     00283020          
    BEGIN                                                               00283030          
         MICROBUMP(3);                                                  00283040          
         P.TAG:=0; Q.TAG:=0;                                            00283045          
         DO BEGIN                                                       00283050          
              IF MCAR[P] NEQ MCAR[Q] THEN GO TO EXIT;                   00283060          
              MICROBUMP(4);                                             00283070          
              P:=MCDR[P]; Q:=MCDR[Q];                                   00283080          
         END UNTIL Q=NIL;                                               00283090          
         ZEQUAL:=TRUE;                                                  00283100          
         GO TO EXIT;                                                    00283110          
    END;                                                                00283120          
    MICROBUMP(1);                                                       00283130          
    IF NOT MVECTORP(P) THEN GO TO EXIT;                                 00283200          
    MICROBUMP(1);                                                       00283300          
    IF VSP[P.FIELD] NEQ VSP[Q.FIELD] THEN GO TO EXIT;                   00283400          
    MICROBUMP(6);                                                       00283500          
    ZEQUAL := POINTER(VSP[P.FIELD+1]) = POINTER(VSP[Q.FIELD+1])         00283600          
                   FOR (ZEXTEND(VSP[P.FIELD])+1)*6;                     00283700          
EXIT:                                                                   00283800          
    MICROBUMP(3);                                                       00283900          
    PRIMCOUNTER(62);                                                    00284000          
END ZEQUAL;                                                             00284100          
                                                                        00284200          
                                                                        00284300          
PROCEDURE XLENGTH;                                                      00284400          
BEGIN REAL I;                                                           00284500          
    DECLAREANDWEIGH;                                                    00284550          
    WHILE MPAIRP(ARG1) DO                                               00284600          
    BEGIN                                                               00284700          
         I:=I+1;                                                        00284800          
         ARG1:=MCDR[ARG1];                                              00284900          
         MICROBUMP(3);                                                  00285000          
    END;                                                                00285100          
    ARG1:=ZTRACT(I);                                                    00285200          
    MICROBUMP(5);                                                       00285300          
    PRIMCOUNTER(63);                                                    00285400          
END XLENGTH;                                                            00285500          
                                                                        00285600          
                                                                        00285700          
PROCEDURE XREVERSIP;                                                    00285800          
BEGIN REAL P,Q;                                                         00285900          
    DECLAREANDWEIGH;                                                    00285950          
    Q:=NIL;                                                             00286000          
    WHILE ARG1 NEQ NIL DO                                               00286100          
    BEGIN                                                               00286200          
         P:=MCDR[ARG1];                                                 00286300          
         MCDR[ARG1]:=Q;                                                 00286400          
         Q:=ARG1;                                                       00286500          
         ARG1:=P;                                                       00286600          
         MICROBUMP(5);                                                  00286700          
    END;                                                                00286800          
    ARG1:=Q;                                                            00286900          
    MICROBUMP(6);                                                       00287000          
    PRIMCOUNTER(64);                                                    00287100          
END XREVERSIP;                                                          00287200          
                                                                        00287300          
                                                                        00287400          
REAL PROCEDURE MMEMQ(P,Q); VALUE P,Q; REAL P,Q;                         00287500          
BEGIN LABEL EXIT;                                                       00287600          
    DECLAREANDWEIGH;                                                    00287650          
    IF Q NEQ NIL THEN                                                   00287700          
    DO BEGIN                                                            00287800          
         MICROBUMP(3);                                                  00287900          
         IF MCAR[Q] = P THEN GO TO EXIT;                                00288000          
         Q:=MCDR[Q];                                                    00288100          
    END UNTIL Q=NIL;                                                    00288200          
EXIT:                                                                   00288300          
    MMEMQ:=Q;                                                           00288400          
    MICROBUMP(5);                                                       00288500          
    PRIMCOUNTER(65);                                                    00288600          
END MMEMQ;                                                              00288700          
                                                                        00288800          
                                                                        00288900          
REAL PROCEDURE MMEMBER(P,Q); VALUE P,Q; REAL P,Q;                       00289000          
BEGIN LABEL EXIT;                                                       00289100          
    DECLAREANDWEIGH;                                                    00289150          
    IF Q NEQ NIL THEN                                                   00289200          
    IF MSIMPLE(P) THEN                                                  00289300          
    DO BEGIN MICROBUMP(3);                                              00289400          
         IF MCAR[Q]=P THEN GO TO EXIT;                                  00289500          
         Q:= MCDR[Q];                                                   00289600          
    END UNTIL Q=NIL                                                     00289700          
    ELSE                                                                00289800          
    DO BEGIN MICROBUMP(3);                                              00289900          
         STOPCOUNT;                                                     00289950          
         IF ZEQUAL(P,MCAR[Q]) THEN                                      00290000          
         BEGIN                                                          00290010          
              STARTCOUNT;                                               00290020          
              GO TO EXIT;                                               00290030          
         END;                                                           00290040          
         STARTCOUNT;                                                    00290050          
         Q:=MCDR[Q];                                                    00290100          
    END UNTIL Q=NIL;                                                    00290200          
EXIT:                                                                   00290300          
    MMEMBER:=Q;                                                         00290400          
    MICROBUMP(7);                                                       00290500          
    PRIMCOUNTER(66);                                                    00290650          
END MMEMBER;                                                            00290700          
                                                                        00290800          
                                                                        00290900          
 DEFINE XMEMQ = ARG1:=MMEMQ(ARG1,ARG2)#;                                00291000          
 DEFINE XMEMBER = ARG1:=MMEMBER(ARG1,ARG2)#;                            00291100          
                                                                        00291200          
                                                                        00291300          
PROCEDURE XLITER;                                                       00291400          
BEGIN REAL S;                                                           00291500          
    DECLAREANDWEIGH;                                                    00291550          
    S:=NIL;                                                             00291600          
    IF MIDP(ARG1) THEN                                                  00291700          
    IF (ARG1:=ISPPNAME[ARG1.FIELD]).BUCKF = 0 THEN    %SINGLE CHARACTER 00291800          
    IF ZLITER(ARG1.LETERF) THEN S:=T;                                   00291900          
    ARG1:=S;                                                            00292000          
    MICROBUMP(8);                                                       00292100          
    PRIMCOUNTER(67);                                                    00292200          
END ZLITER;                                                             00292300          
                                                                        00292400          
                                                                        00292500          
PROCEDURE XDIGIT;                                                       00292600          
BEGIN REAL S;                                                           00292700          
    DECLAREANDWEIGH;                                                    00292750          
    S:=NIL;                                                             00292800          
                                                             %PPDMTL07  00292900          
                                                             %PPDMTL07  00293000          
    IF ZDIGIT(ARG1.LETERF) THEN S:=T;                                   00293100          
    ARG1:=S;                                                            00293200          
    MICROBUMP(8);                                                       00293300          
    PRIMCOUNTER(68);                                                    00293400          
END ZDIGIT;                                                             00293500          
                                                                        00293600          
                                                                        00293700          
$PAGE                                                                   00293800          
                                                                        00293900          
                                                                        00294000          
DEFINE ALGOLPRIMATIVE(N) =                                              00294100          
BEGIN                                                                   00294200          
                                                                        00294300          
  CASE N OF                                                             00294400          
  BEGIN                                                                 00294500          
    XEXPLODE;        %[0]                                               00294600          
    ZCATCH;          %[1]                                               00294700          
    XLENGTHC;        %[2]                                               00294800          
    XGENSYM;         %[3]                                               00294900          
    XSETMOD;         %[4]                                               00295000          
    XCOMPRESS;       %[5]                                               00295100          
    XCRECIP;         %[6]                                               00295200          
    XCMOD;           %[7]                                               00295300          
    XCPLUS;          %[8]                                               00295400          
    XCTIMES;         %[9]                                               00295500          
    XCDIF;           %[10]                                              00295600          
    XREMOB;          %[11]                                              00295700          
    XRCONS;          %[12]                                              00295800          
    XNCONS;          %[13]                                              00295900          
    XCONS;           %[14]                                              00296000          
    XRPLACA;         %[15]                                              00296100          
    XRPLACD;         %[16]                                              00296200          
    XTERPRI;         %[17]                                              00296300          
    XPRINC;          %[18]                                              00296400          
    XTHROW;          %[19]                                              00296500          
    XINTERN;         %[20]                                              00296600          
    XREADCH;         %[21]                                              00296700          
    XLAMBIND;        %[22]                                              00296800          
    XQUIT;           %[23]                                              00296900          
    XPATOM;          %[24]                                              00297000          
    XPATOM2;         %[25]                                              00297100          
    XEQ;             %[26]                                              00297200          
    XEQN;            %[27]                                              00297300          
    XRECLAIM;        %[28]                                              00297400          
    XPLUS2;          %[29]                                              00297500          
    XTIMES2;         %[30]                                              00297600          
    XDIFFERENCE;     %[31]                                              00297700          
    XQUOTIENT;       %[32]                                              00297800          
    XGREATERP;       %[33]                                              00297900          
    XLESSP;          %[34]                                              00298000          
    XSCAN;           %[35]                                              00298100          
    XREMAINDER;      %[36]                                              00298200          
    ZUNSTACK;        %[37]                                              00298300          
    XCLOSE;          %[38]                                              00298400          
    XEJECT;          %[39]                                              00298500          
    XAPPLY;          %[40]                                              00298600          
    XOPEN;           %[41]                                              00298700          
    XPOSN;           %[42]                                              00298800          
    XRDS;            %[43]                                              00298900          
    XWRS;            %[44]                                              00299000          
    ;                %[45]                                              00299100          
    XGETV;           %[46]                                              00299200          
    XMKVECT;         %[47]                                              00299300          
    XPUTV;           %[48]                                              00299400          
    XUPLIM;          %[49]                                              00299500          
    XTIME;           %[50]                                              00299600          
    XPUTPROP;        %[51]                                              00299700          
    XGETPROP;        %[52]                                              00299800          
    XPUTG;           %[53]                                              00299900          
    XGETG;           %[54]                                              00300000          
    XDUMP;           %[55]                                              00300100          
    XORDERP;         %[56]                                              00300200          
    XCHKPOINT;       %[57]                                              00300300          
    XCONSTANTP;      %[58]                                              00300400          
    XVECTORP;        %[59]                                              00300500          
    XSETPCHAR;       %[60]                                              00300600          
    XEXPT;           %[61]                                              00300700          
    XEQUAL;          %[62]                                              00300800          
    XLENGTH;         %[63]                                              00300900          
    XREVERSIP;       %[64]                                              00301000          
    XMEMQ;           %[65]                                              00301100          
    XMEMBER;         %[66]                                              00301200          
    XLITER;          %[67]                                              00301300          
    XDIGIT;          %[68]                                              00301400          
    XGET;            %[69]                                              00301500          
    XGETD;           %[70]                                              00301600          
    XGLOBALP;        %[71]                                              00301700          
    XFLUIDP;         %[72]                                              00301800          
    XGLOBAL;         %[73]                                              00301900          
    XFLUID;          %[74]                                              00302000          
    XUNFLUID;        %[75]                                              00302100          
    XPUTD;           %[76]                                              00302200          
    ;                %[77]                                              00302300          
    ;                %[78]                                              00302400          
    XATOM;           %[79]                                              00302500          
    ZLIST;           %[80]                                              00302600          
    XQUOTE;          %[81]                                              00302700          
    XCAR;            %[82]                                              00302800          
    XCDR;            %[83]                                              00302900          
    XNULL;           %[84]                                              00303000          
    XCODEP;          %[85]                                              00303010          
    XIDP;            %[86]                                              00303020          
    XNUMBERP;        %[87]                                              00303030          
    XPAIRP;          %[88]                                              00303040          
    XSTRINGP;        %[89]                                              00303050          
  END CASE;                                                             00303100          
                                                                        00303200          
END ALGOLPRIMATIVE#;                                                    00303300          
                                                                        00303400          
$PAGE                                                                   00303500          
%SEGMENT(B.MANAGEMENT);                                                 00303600          
                                                                        00303700          
                                                                        00303800          
                                                                        00303900          
                                                                        00304000          
$PAGE                                                                   00304100          
                                                                        00304200          
DEFINE ZEVAL =                                                          00304300          
    BEGIN                                                               00304400          
         IF NOT MCONSTANTP(ARG1) THEN                                   00304500          
         IF MIDP(ARG1) THEN                                             00304600          
         BEGIN                                                          00304700          
              MTEMP := ARG1;                                            00304800          
              ARG1 := ISPVALUE[MTEMP.FIELD];                            00304900          
              IF ARG1 = UNBOUND THEN                                    00305000          
              BEGIN                                                     00305100          
                   MLIST(ERRS[18],MTEMP);                               00305200          
                   ZERROR(100,ARG1);                                    00305300          
              END;                                                      00305400          
         END                                                            00305500          
         ELSE YEVAL;                                                    00305600          
    END ZEVAL#;                                                         00305700          
                                                                        00305800          
DEFINE XFSUBR =                                                         00305900          
    BEGIN                                                               00306000          
         PRIMTRACE(77);                                                 00306100          
         STOPCOUNT;                                                     00306200          
         ZCALL(ARG2);                                                   00306300          
         STARTCOUNT;                                                    00306400          
    END XFSUBR#;                                                        00306500          
                                                                        00306600          
DEFINE XSUBR =                                                          00306700          
    BEGIN                                                               00306800          
         PRIMTRACE(78);                                                 00306900          
         STOPCOUNT;                                                     00307000          
         ZGET1 := ZSUBR;                                                00307100          
         STARTCOUNT;                                                    00307200          
         MICROBUMP((13+5*MTEMP));                                       00307300          
         STOPCOUNT;                                                     00307400          
         ZCALL(ZGET1);                                                  00307500          
         STARTCOUNT;                                                    00307600          
    END XSUBR#;                                                         00307700          
                                                                        00307800          
REAL PROCEDURE ZSUBR;                                                   00307900          
    BEGIN REAL N,L;                                                     00308000          
         LABEL L1,L2,L3,L4,L5,L6,L7,L8,L9,L10,L11,L12,L13,L14;          00308100          
         SWITCH S := L1,L2,L3,L4,L5,L6,L7,L8,L9,L10,L11,L12,L13,L14;    00308200          
         MICROBUMP((MTEMP:=-1));                                        00308300          
         ZSUBR := ARG1;                                                 00308400          
         L := ARG2;                                                     00308500          
         IF L NEQ NIL THEN                                              00308600          
         BEGIN                                                          00308700          
              IF ES+16>ESPMAX THEN                                      00308800          
                   RESIZE(ESP,ESPMAX:=ESPMAX+PAGESIZE,RETAIN);          00308900          
              ESP[ES:=ES+1] := L;        %PROTECT L                     00309000          
              N:=ES;                                                    00309100          
              DO BEGIN                                                  00309200          
                   ARG1 := MCAR[L];                                     00309300          
                   ZEVAL;                                               00309400          
                   ESP[ES:=ES+1] := ARG1;                               00309500          
                   L := MCDR[L];                                        00309600          
              END UNTIL L=NIL;                                          00309700          
              L := ES-N;                                                00309800          
              ES := N;                                                  00309900          
              GO TO S[L];                                               00310000          
         L14: ARG14 := ESP[ES+14];                                      00310100          
         L13: ARG13 := ESP[ES+13];                                      00310200          
         L12: ARG12 := ESP[ES+12];                                      00310300          
         L11: ARG11 := ESP[ES+11];                                      00310400          
         L10: ARG10 := ESP[ES+10];                                      00310500          
         L9:  ARG9 := ESP[ES+9];                                        00310600          
         L8:  ARG8 := ESP[ES+8];                                        00310700          
         L7:  ARG7 := ESP[ES+7];                                        00310800          
         L6:  ARG6 := ESP[ES+6];                                        00310900          
         L5:  ARG5 := ESP[ES+5];                                        00311000          
         L4:  ARG4 := ESP[ES+4];                                        00311100          
         L3:  ARG3 := ESP[ES+3];                                        00311200          
         L2:  ARG2 := ESP[ES+2];                                        00311300          
         L1:  ARG1 := ESP[ES+1];                                        00311400          
              ES := ES-1;                                               00311500          
              MICROBUMP((MTEMP:=L));                                    00311600          
         END;                                                           00311700          
    END ZSUBR;                                                          00311800          
                                                                        00311900          
PROCEDURE ZLIST;                                                        00312000          
    BEGIN REAL Y,U;                                                     00312100          
         DECLAREANDWEIGH;                                               00312200          
         U := ARG1;                                                     00312400          
         IF U NEQ NIL THEN                                              00312500          
         BEGIN                                                          00312600          
              ESP[ES:=ES+1] := U;                                       00312700          
              ARG1 := MCAR[U];                                          00312800          
              STOPCOUNT; ZEVAL; STARTCOUNT;                             00312900          
              Y := ZCONS(ARG1,NIL);                                     00313000          
              ESP[ES:=ES+1] := Y;                                       00313100          
              WHILE (U:=MCDR[U]) NEQ NIL DO                             00313200          
              BEGIN                                                     00313300          
                   ARG1 := MCAR[U];                                     00313400          
                   STOPCOUNT; ZEVAL; STARTCOUNT;                        00313500          
                   Y := MCDR[Y] := ZCONS(ARG1,NIL);                     00313600          
                   MICROBUMP(3);                                        00313700          
              END;                                                      00313800          
              ARG1 := ESP[ES];                                          00313900          
              ES := ES-2;                                               00314000          
              MICROBUMP(7);                                             00314100          
         END;                                                           00314200          
         MICROBUMP(5);                                                  00314300          
         PRIMCOUNTER(80);                                               00314400          
         STOPCOUNT;                                                     00314500          
         MICROBUMP((MTEMP:=-C));                                        00314600          
    END ZLIST;                                                          00314700          
                                                                        00314800          
DEFINE XLIST =                                                          00314900          
    BEGIN                                                               00315000          
         STOPCOUNT;                                                     00315100          
         ZLIST;                                                         00315200          
         STARTCOUNT;                                                    00315300          
         MICROBUMP((-MTEMP));                                           00315400          
    END XLIST#;                                                         00315500          
$PAGE                                                                   00315600          
                                                                        00500100          
                                                                        00500200          
                                                                        00500300          
                                                                        00500400          
%     HERE ARE THE DEFINITIONS WHICH MAKE LISP ==> ALGOL WORK           00500500          
                                                                        00500600          
DEFINE                                                                  00500700          
                                                                        00500800          
 GLOBAL[N]         = ISPVALUE[QSP[QNUM+N].FIELD]#,                      00500900          
 QUOTE[N]          = QSP[QNUM+N]#,                                      00501000          
 FLUID[N]          = ISPVALUE[QSP[QNUM+N].FIELD]#;                      00501100          
                                                                        00501500          
PROCEDURE MPROGBIND(Q); VALUE Q; REAL Q;                                00501600          
BEGIN REAL CNT,TPTR,I;                                                  00501700          
DECLAREANDWEIGH;                                                        00501750          
TPTR := TSPPTR;                    %BACK CHAIN POINTER.                 00501800          
CNT := ZEXTEND(QSP[Q]);                                                 00501900          
CHECKSTACK(CNT*2+2);                                                    00502000          
MICROBUMP(9);                                                           00502100          
WHILE I<CNT DO                      %BUILD THE A FRAME.                 00502500          
BEGIN                                                                   00502600          
  MICROBUMP(4);                                                         00502700          
  ZPUSH(ISPVALUE[QSP[Q:=Q+1].FIELD]);                                   00502800          
  ISPVALUE[QSP[Q].FIELD] := NIL;                                        00502900          
  ZPUSH(QSP[Q]);           %VARIABLE NAME FROM Q SPACE.                 00503000          
  I:=I+1;                                                               00503100          
END BUILDAFRAME;                                                        00503200          
ZPUSH(GLAMBDA);                    %THIS IS WHERE BINDINGS OCCUR.       00503300          
ZPUSH(TPTR);                       %BACKWARDS LINK.                     00503400          
PRIMCOUNTER(92);                                                        00503450          
END MPROGBIND;                                                          00503500          
                                                                        00503600          
PROCEDURE MLAMBIND(Q); VALUE Q; REAL Q;                                 00503700          
BEGIN REAL CNT,TPTR,I,X;                                                00503800          
DECLAREANDWEIGH;                                                        00503850          
TPTR := TSPPTR;                   %BACK CHAIN POINTER.                  00503900          
CNT := ZEXTEND(QSP[Q]);                                                 00504000          
CHECKSTACK(CNT*2+2);                                                    00504100          
MICROBUMP(9);                                                           00504200          
WHILE I<CNT DO                                                          00504600          
BEGIN                                                                   00504700          
  MICROBUMP(5);                                                         00504800          
  X := (ARGS[ZEXTEND(QSP[Q:=*+1])]);           %VALUE IN REGISTER       00504900          
  ZPUSH(ISPVALUE[QSP[Q:=Q+1].FIELD]);                                   00505000          
  ISPVALUE[QSP[Q].FIELD] := X;                                          00505100          
  ZPUSH(QSP[Q]);            %VARIABLE NAME.                             00505200          
  I:=I+1;                                                               00505300          
END BUILDAFRAME;                                                        00505400          
ZPUSH(GLAMBDA);                    %AN A FRAME IS HERE.                 00505500          
ZPUSH(TPTR);                       %BACK CHAIN POINTER.                 00505600          
PRIMCOUNTER(93);                                                        00505650          
END MLAMBIND;                                                           00505700          
                                                                        00505800          
                                                                        00505900          
REAL PROCEDURE MLINK(Q,N); VALUE Q,N; REAL Q,N;                         00506000          
BEGIN REAL FN;                                                          00506100          
LABEL EXIT;                                                             00506200          
PRIMTRACE(103);                                                         00506400          
FN := ISPVALUE[Q.FIELD];                                                00507900          
IF MPAIRP(FN) THEN           %ONLY WORKS IF DEFINED FUNCTION.           00508000          
  IF MCAR[FN] = GEXPR OR MCAR[FN] = GFEXPR OR                           00508100          
     MCAR[FN] = GMACRO THEN BEGIN   %MOVE REGISTERS TO LIST THEN        00508200          
    ARG2 := ZREGLIST(N);                                                00508300          
    ARG1 := MCDR[FN];                                                   00508400          
    MLINK:=MCDR[ISPVALUE[GAPPLY.FIELD]].FIELD;  %APPLY ARGS             00508500          
    GO TO EXIT;                                                         00508600          
    END                                                                 00508700          
  ELSE IF MCAR[FN] = GFSUBR OR MCAR[FN] = GSUBR THEN                    00508800          
       BEGIN                                                            00508900          
            MLINK := MCDR[FN].FIELD;                                    00509000          
            GO TO EXIT;                                                 00509100          
       END;                                                             00509200          
MLIST(Q, ERRS[2]);      %UNDEFINED FUNCITON.                            00509300          
ZERROR(102, ARG1);                                                      00509400          
EXIT:                                                                   00509500          
END MLINK;                                                              00509600          
                                                                        00509700          
                                                                        00509800          
 $ SET OMIT = SLOWSTACK OR COUNT                                        00509900          
                                                                        00510000          
DEFINE MALLOC(L,Q) = #, MDEALLOC = #,                                   00510100          
       XDEALLOC = #, KDEALLOC = #;                                      00510110          
                                                                        00510200          
 $ POP OMIT SET OMIT = NOT SLOWSTACK AND NOT COUNT                      00511200          
                                                                        00511300          
PROCEDURE MALLOC(L,Q); VALUE L,Q; REAL L,Q;                             00511400          
BEGIN REAL TPTR;                                                        00511500          
L:=L.[6:7];                                                             00511600          
CHECKSTACK(L+5);                                                        00511700          
COUNT(90);                                                              00511800          
TPTR := TSPPTR;                %BACK CHAIN POINTER.                     00511900          
ZPUSH(CURQPROGPTR);            %Q-SPACE BASE OF PREVIOUS ENTRY.         00512000          
CURQPROGPTR := Q;                                                       00512100          
ZPUSH(0);                                                               00512200          
ZPUSH(CURSTACKBASE);                                                    00512300          
CURSTACKBASE := TSPPTR;        %NEW STACK BASE.                         00512400          
                               %PUSH WWWWWWWW NILS ONTO THE STACK.      00512500          
MICROBUMP(1);                                                           00512600          
REPLACE TSP[TSPPTR] BY NIL FOR L WORDS;                                 00513300          
TSPPTR:=*+L;                                                            00513400          
ZPUSH(GBPROG);                 %!$BPROG IS SPECIAL FRAME NAME.          00513500          
ZPUSH(TPTR);                   %BACK CHAIN POINTER.                     00513600          
END MALLOC;                                                             00513700          
                                                                        00513800          
DEFINE MDEALLOC =                                                       00513900          
BEGIN                                                                   00514000          
TSPPTR := TSP[TSPPTR-1];                                                00514100          
CURQPROGPTR := TSP[TSPPTR];                                             00514200          
CURSTACKBASE := TSP[TSPPTR + 2];                                        00514300          
END MDEALLOC#;                                                          00514400          
                                                                        00514500          
DECLARE(XDEALLOC,91,MDEALLOC);                                          00514510          
DEFINE KDEALLOC = ENDCOUNT; XDEALLOC#;                                  00514520          
                                                                        00514530          
 $ POP OMIT                                                             00514600          
                                                                        00514700          
                                                                        00514800          
 $ SET OMIT = FASTLINK                                                  00515200          
                                                                        00515300          
  DEFINE CORRECTLINK(Q,N) =                                             00515400          
         IF QSP[Q] < 0 THEN                                             00515500          
         BEGIN                                                          00515600          
              XCALL(MLINK(QSP[Q],N));                                   00515700          
              GO TO EXIT;                                               00515800          
         END#;                                                          00515900          
                                                                        00516000          
 $ POP OMIT SET OMIT = NOT FASTLINK                                     00516100          
                                                                        00516200          
  DEFINE CORRECTLINK(Q,N) = #;                                          00516300          
                                                                        00516400          
 $ POP OMIT                                                             00516500          
                                                                        00516600          
                                                                        00516700          
DEFINE                                                                  00516800          
 KPROGBIND(Q)  = MPROGBIND(QNUM+Q)#,                                    00516900          
 KLAMBIND(Q)   = MLAMBIND(QNUM+Q)#,                                     00517000          
 KFREERST      = ZUNSTACK#,                                             00517100          
 XUNSTACK      = ZUNSTACK#;                                             00518100          
                                                                        00518200          
                                                                        00518300          
 $ SET OMIT = NOT SLOWSTACK AND NOT COUNT                               00518400          
                                                                        00518500          
 DEFINE KALLOC(L,Q,N) =                                                 00518600          
              DECLARECOUNT;                                             00518700          
              'LET QNUM := Q;                                           00518800          
              CORRECTLINK(Q,N);                                         00518900          
              MALLOC(L,Q);                                              00519000          
              BEGINCOUNT#,                                              00519100          
        LOCAL[N]   = TSP[CURSTACKBASE+N]#;                              00519200          
                                                                        00519300          
 $ POP OMIT SET OMIT = SLOWSTACK OR COUNT                               00519400          
                                                                        00519500          
 DEFINE KALLOC(L,Q,N) =                                                 00519700          
         'LET SNUM := (L).[6:7];                                        00519800          
         'IF SNUM>0 THEN                                                00519900          
         'BEGIN REAL V; 'END;                                           00520000          
         'FOR NUM:=1 STEP 1 UNTIL SNUM DO                               00520100          
         'BEGIN REAL V'NUM; 'END;                                       00520200          
         'IF SNUM>0 THEN                                                00520400          
          'BEGIN V:="LOCAL " & SNUM [6:7]; 'END;                        00520500          
         'LET QNUM := Q;                                                00520600          
         CORRECTLINK(Q,N)#,                                             00520700          
        LOCAL[N] = 'LET SNUM:=N+1; V'SNUM#;                             00521000          
                                                                        00521100          
 $POP OMIT                                                              00521200          
                                                                        00521300          
 $ SET OMIT = COUNT                                                     00521900          
                                                                        00521910          
DEFINE                                                                  00522000          
 KLOAD(R,E)    = R := E#,                                               00522100          
 KSTORE(G,R)   = GLOBAL[G] := R#,                                       00522300          
 KSET(S,R)     = LOCAL[S] := R#,                                        00522400          
                                                                        00522405          
 KLINK(N,F)    = F#,                                                    00522410          
 KGOTO(L)      = GO TO L#,                                              00522420          
                                                                        00522430          
 KJUMPNIL(L)   = IF ARG1=NIL THEN GO TO L#,                             00522440          
 KJUMPT(L)     = IF ARG1 NEQ NIL THEN GO TO L#,                         00522450          
                                                                        00522460          
 IFTRUE(L,B)   = IF B THEN GO TO L#,                                    00522470          
 IFNOT(L,B)    = IF NOT B THEN GO TO L#;                                00522480          
                                                                        00522600          
                                                                        00522700          
 $ POP OMIT SET OMIT = NOT COUNT                                        00522800          
                                                                        00522810          
DEFINE                                                                  00522900          
 KLOAD(R,E)    = R := CT(E,100)#,                                       00523000          
 KSTORE(G,R)   = GLOBAL[G] := CT(R,94)#;                                00523100          
                                                                        00523400          
PROCEDURE KSET(R,S); VALUE R,S; REAL R,S;                               00524700          
    BEGIN                                                               00524800          
         LOCAL[R] := S;                                                 00524900          
         PRIMTRACE(96);                                                 00525000          
    END;                                                                00525100          
                                                                        00525200          
DEFINE                                                                  00525300          
 KLINK(N,F)    = PRIMTRACE(101); STOPCOUNT; F; STARTCOUNT#,             00525310          
 KGOTO(L)      = PRIMTRACE(98); GO TO L#,                               00525320          
                                                                        00525330          
 KJUMPNIL(L)   = IF JUMP(ARG1=NIL) THEN GO TO L#,                       00525340          
 KJUMPT(L)     = IF JUMP(ARG1 NEQ NIL) THEN GO TO L#,                   00525350          
                                                                        00525360          
 IFTRUE(L,B)   = IF JUMP(B) THEN GO TO L#,                              00525370          
 IFNOT(L,B)    = IF JUMP(NOT B) THEN GO TO L#;                          00525380          
                                                                        00525400          
 $ POP OMIT                                                             00525900          
                                                                        00526000          
DEFINE KUNDEFINED(S,N) =                                                00526100          
    BEGIN REAL I,J;                                                     00526200          
         DEFINE A=EXPCOMARRAY#;                                         00526300          
         REPLACE A BY S;                                                00526400          
         SCAN A FOR I:80 UNTIL =".";                                    00526500          
         J := ARG1; ARG1 := ZADDTOSTRINGS(A,80-I);                      00526600          
         XINTERN;                                                       00526700          
         I := ARG1; ARG1 :=J;                                           00526800          
         XCALL(MLINK(I,N));                                             00526900          
    END#;                                                               00527000          
                                                                        00527100          
$PAGE                                                                   08000100          
                                                                        08000200          
                                                                        08000300          
                                                                        08000600          
PROCEDURE XCALL(N); VALUE N; REAL N;                                    08000700          
    BEGIN LABEL EXIT;                                                   08000800          
         COUNT(102);                                                    08001100          
         IF N<255 THEN                                                  08001200          
              ALGOLPRIMATIVE(N)                                         08001300          
         ELSE                                                           08001400          
              BEGIN                                                     08001500          
                   CASE N-256 OF                                        08001600          
                   BEGIN LISTOFPROCCALLS END;                           08001700          
              END;                                                      08002300          
EXIT:                                                                   08002400          
    END OF XCALL;                                                       08002500          
                                                                        08002600          
                                                                        08002700          
                                                                        08002800          
COMMENT PROCEDURE (FOR TRACE BACK);                                     08999999          
                                                                        09000100          
                                                                        09000200          
    INITIALIZE;      %GET THINGS SET UP.                                09000300          
    YSTANDARDQ11LISP;                                                   09000700          
                                                                        09000800          
THU:                                                                    09001300          
                                                                        09001400          
% END OF IT.                                                            09999999          
%                                                                       10000100          
%*********************************************************************  10000200          
%**                                                                 **  10000300          
%**         COMMENTS ON THE PATCHES WRITTEN BY MONTREAL PPD         **  10000400          
%**                                                                 **  10000500          
%*********************************************************************  10000600          
%                                                                       10000700          
%PPDMTL01               08/12/85                       L. SANS CARTIER  10000800          
%THIS PATCH WILL CHANGE THE ACCESS TO THE LISP LIBRARY. UP TO NOW, IT   10000900          
%WAS IMPLEMENTED AS A SIMPLE OBJECT LIBRARY; IT WILL BE NOW A "SUPPORT  10001000          
%LIBRARY".                                                              10001100          
%                                                                       10001200          
%PPDMTL02               08/23/85                       L. SANS CARTIER  10001300          
%THIS WILL ADD AN ERROR MESSAGE IN THE CASE THAT AN IDENTIFIER HAVING   10001400          
%MORE THAN 24 CHARACTERS IS USED. (--LISP--)                            10001500          
%                                                                       10001600          
%PPDMTL04               08/23/85                       L. SANS CARTIER  10002100          
%THIS WILL DETECT THE CASE WHEN A CODE FILE IS GIVEN TO THE INPUT       10002200          
%COMMAND "IN". (--REDUCE--)                                             10002300          
%                                                                       10002400          
%PPDMTL05               08/23/85                       L. SANS CARTIER  10002500          
%LINES 148900 AND 149000 HAD BEEN MOVED RIGHT AFTER LINE 148600 IN      10002600          
%ORDER TO REMOVE THE "STACK UNDERFLOW" ERROR THAT OCCURED WHEN A CALL   10002700          
%WITH EITHER TOO FEW OR TOO MUCH ARGUMENTS. (--LISP-- AND --REDUCE--)   10002800          
%                                                                       10002900          
%PPDMTL06               08/23/85                       L. SANS CARTIER  10003000          
%THIS IS TO CREATE OUTPUT DISK FILES AS SMALL AS POSSIBLE ("CRUNCH").   10003100          
%(--LISP-- AND --REDUCE--)                                              10003200          
%                                                                       10003300          
%PPDMTL07               08/23/85                       L. SANS CARTIER  10003400          
%THE FUNCTION "DIGIT" WASN'T WORKING AT ALL. THIS WILL CORRECT IT.      10003500          
%(--LISP--)                                                             10003600          
%                                                                       10003700          
%PPDMTL08               08/23/85                       L. SANS CARTIER  10003800          
%AN ERROR SHOULD BE DETECTED WHEN THE PRINTER IS OPENED IN INPUT MODE.  10003900          
%(--LISP--)                                                             10004000          
%                                                                       10004100          
%PPDMTL09               08/23/85                       L. SANS CARTIER  10004200          
%WHEN THE USER TRIES TO WRITE ON A DISK FILE THAT ALREADY EXISTS, A     10004300          
%WARNING SHOULD BE GIVEN. (--LISP--)                                    10004400          
%                                                                       10004500          
%PPDMTL10               08/23/85                       L. SANS CARTIER  10004600          
%THIS WILL ALLOW THE USER TO CONTINUE AFTER A "FATAL ERROR" IS GIVEN.   10004700          
%UP TO NOW, THE NEXT COMMAND ALWAYS PRODUCED A "SEG ARRAY ERROR" AND    10004800          
%THEN DS-ED.                                                            10004900          
%    **************** IMPORTANT NOTE TO THE USER *****************      10005000          
%    * AFTER THE FATAL ERROR MESSAGE IS GIVEN, THE PROGRAM WILL  *      10005100          
%    * WAIT FOR ANOTHER COMMAND (BUT WITHOUT GIVING THE PROMPT). *      10005200          
%    * THE NEXT COMMAND WILL BE A DUMMY ONE AND WILL ONLY MAKE   *      10005300          
%    * THE PROGRAM GIVE THE PROMPT. THE USER WILL THEN BE ABLE   *      10005400          
%    * TO CONTINUE NORMALLY.                                     *      10005500          
%    *************************************************************      10005600          
%YOU MAY WISH TO REMOVE THIS PATCH IF THE FORMER RESULTS WERE MORE      10005700          
%SUITED TO YOUR SPECIFIC NEEDS.                                         10005800          
%                                                                       10005900          
%PPDMTL11               08/23/85                       L. SANS CARTIER  10006000          
%THIS PATCH WILL ENABLE LISP TO RETURN NIL (INSTEAD OF AN INVALID       10006100          
%INDEX) WHENEVER "CDR NIL" IS ASKED FOR. (--LISP--)                     10006200          
%                                                                       10006300          
%PPDMTL19               01/08/86                       L. SANS CARTIER  10006310          
%THIS PATCH WILL ENABLE LISP TO WORK ON A9 MACHINES. BECAUSE THE A9 DO  10006320          
%NOT NORMALIZE FLOATING POINT NUMBERS IN THE SAME WAY THAN THE A3 DOES, 10006330          
%THE OVERFLOW TEST DIDN'T ALWAYS GIVE THE SAME RESULTS ON THE 2 MACHINES10006340          
%EVENTHOUGH ACTUALLY THE VALUE WAS THE SAME.                            10006350          
%                                                                       10006360          
%PPDMTL12               08/23/85                       L. SANS CARTIER  10006400          
%THE END-OF-LINE ("EOL") WAS NOT RECOGNIZED BY READCH. (--LISP--)       10006500          
« May 2024 »
Su Mo Tu We Th Fr Sa
1 2 3 4
5 6 7 8 9 10 11
12 13 14 15 16 17 18
19 20 21 22 23 24 25
26 27 28 29 30 31
 

Powered by Plone CMS, the Open Source Content Management System

This site conforms to the following standards: