? COMPILE LISP/LISP WITH XALGOL LIBRARY                                 
? XALGOL STACK = 1000                                                   
?LABEL  0       0CARD                                                   
$ CARD LIST SINGLE                                                      
 BEGIN %8 SEPTEMBER 1969                                                00001000
  %                                                                     00002000
  %  CONSTANT DEFINES                                                   00003000
  %                                                                     00004000
  FILE DATA REMOTE(2,10);                                               00005000
 DEFINE MEMORYROWS = 127#,NOOFPROCESSOPS=44#,STKSZ=2#;                  00006000
REAL LASTUSEDSPACE,XADDR,LINKTONIL,CARADDR,NEXTTOKEN;                   00007000
  REAL HASH,PRIORITY,TKNO,LABTAB,T,XX1,XX2;                             00008000
POINTER CP;ARRAY JUNKARRAY[0:0],STACK[0:STKSZ,0:511];                   00009000
DEFINE CHR=JUNKARRAY[0]#,LEXTREE=HASH#;                                 00010000
REAL LASTRPID,STACKPOSITION;                                            00011000
BOOLEAN TRACE;                                                          00012000
REAL ATOMUNDEF,NULLIST,AT0,AT1,AT2,AT3,AT4,AT5,AT6,AT7,RC1,RC9;         00013000
 ARRAY SYSMARRAY[0:2],  TYPEARRAY[0:15];                                00014000
ARRAY PROCESSARRAY[0:NOOFPROCESSOPS];                                   00015000
  ARRAY MEMORY[0:MEMORYROWS, 0:511];                                    00016000
 ARRAY C1[0:0], C2[0:0],C3[0:0],C4[0:0],C5[0:0],C6[0:0];                00016050
 REAL CURROW;                                                           00016060
 DEFINE TYPE = [22:4]#,                                                 00017000
  ADDR=[18:19]#;                                                        00018000
 DEFINE TYPEGARBAGE =0#,                                                00019000
  TYPECONS=1#,                                                          00020000
  TYPELIST=2#,                                                          00021000
TYPEAREA=3#,                                                            00022000
  TYPEFIELD=4#,                                                         00023000
  TYPESYMB=5#,                                                          00024000
  TYPELOGIC=6#,                                                         00025000
 TYPELINK =7#,                                                          00026000
  TYPEPROCESS=8#,                                                       00027000
 TYPEMONITOR=9#,                                                        00028000
 TYPEGENERAL=10#,                                                       00029000
TYPETOKEN=11#,                                                          00030000
 TYPECODE=11#;                                                          00031000
%                                                                       00032000
% TOKEN ASSIGNMENTS                                                     00033000
%                                                                       00034000
%    1 TO 30= ALGOL RETURN LABELS                                       00035000
%  100 = ASGN                                                           00036000
%  101 = REF                                                            00037000
%  102 = CAR                                                            00038000
%  103 = CDR                                                            00039000
%  104 = CONS                                                           00040000
%  105 = NEWSYMB                                                        00041000
%  106 = AMTSPACE                                                       00042000
%  107 = MAKE                                                           00043000
%  108 = PRINT                                                          00044000
%  109 = INLEX                                                          00045000
%  110 = GCL                                                            00046000
%  111 = CREATE                                                         00047000
%  112 = DELETE                                                         00048000
%  113 = SUSPEND                                                        00049000
%  114 = RESUME                                                         00050000
%  115 = RETURN                                                         00051000
%  116 = IDENTITY                                                       00052000
%  117 = HALT                                                           00053000
%  118 =                                                                00054000
%  119 =                                                                00055000
%  120 = TRACE                                                          00056000
%  121 = EQLIST                                                         00057000
%  122 = QUOTE                                                          00058000
%  123 = ASGNENV                                                        00059000
%  124 = REFENV                                                         00060000
%  125 = EXE                                                            00061000
%  126 = DEBUG                                                          00062000
%  127 = LDMODE                                                         00063000
%  128 = CONSTRUCT                                                      00064000
%  129 = AREA                                                           00065000
%  130 = TOKEN                                                          00066000
%  131 = SINGLESTEP                                                     00067000
%  132 = UP                                                             00068000
%  133 = DP                                                             00069000
%  134 = READ                                                           00070000
%  135 =                                                                00071000
%  136 = LIST                                                           00072000
%  137 = COND                                                           00073000
%  138 = EQ                                                             00074000
%  139 = ATOM                                                           00075000
%  140 = BLOCKOP                                                        00076000
%  141 = NEQ                                                            00077000
%  142 = IF                                                             00078000
%  143 = NONTERM                                                        00079000
  %144=USERL                                                            00079010
  %145=LTAB                                                             00079020
 %146=COPY                                                              00079030
 %147=ADD                                                               00079035
 %148=SUB                                                               00079040
 %149=MUL                                                               00079045
 %150 =DIV                                                              00079050
 %151=EX                                                                00079055
 %152=NEG                                                               00079060
%                                                                       00080000
%  512 TO 576 = SPECIAL CHARACTERS                                      00081000
%                                                                       00082000
%  118 = ALTERNATIVE OP IN BNF INTERPRETERS                             00083000
% 1000 = RESULT VARIABLE FOR BASE LANGUAGE                              00084000
% 1001 = LIST FORMAL PARAMETER                                          00085000
% 1002 = QUOTED FORMAL PARAMETER                                        00086000
% 1003 = QUOTED LIST FORMAL PARAMETER                                   00087000
% 1004 = BASE LANGUAGE INTERPRETER                                      00088000
% 1005 = BNF INTERPRETER                                                00089000
% 1006 = STRING VARIABLE FOR BNF                                        00090000
% 1007 = QUOTED SYMBOL IN SCANNER                                       00091000
% 1008 = SINGLE STEP VARIABLE                                           00092000
% 1009 = TRACE VARIABLE                                                 00093000
% 1010 = REMOTE TERMINAL DEVICE                                         00094000
% 1011 = DISK DEVICE                                                    00095000
% 1012 = # IN BNF ALTERNATIVE                                           00096000
% 1013 = LEXUNIT                                                        00097000
% 1014 = ID                                                             00098000
% 1015 = INT                                                            00099000
% 1016 = SPCHAR                                                         00100000
% 1017 = CODE GENERATOR INTERPRETER                                     00101000
% 1018 = TREE VARIABLE IN BNF INTERPRETER                               00102000
% 1019 = N VARIABLE IN BNF INTERPRETER                                  00103000
 %1020 = NUMBER                                                         00103010
%                                                                       00104000
%  2000 TO 10000 = IDENTIFIERS                                          00105000
%                                                                       00106000
% 262144 TO 524287 = USER TOKENS                                        00107000
%                                                                       00108000
%  DEFINED SUBROUTINES                                                  00109000
%                                                                       00110000
DEFINE FNS(FNS1)=PSCAN(1,FNS1,F)#,STATS=PSCAN(0,0,V1)#;                 00111000
DEFINE M[M1]=(IF BOOLEAN(M1)THEN                                        00112000
MEMORY[(M1).[18:9],(M1).[9:9]].[22:23] ELSE                             00113000
MEMORY[(M1).[18:9],(M1).[9:9]].[45:23])#,                               00114000
STEPSPACE=(LASTUSEDSPACE:=LASTUSEDSPACE+1)#,                            00115000
AT(AT1)=(AT0+AT1)#,                                                     00116000
TOKEN(TOKEN1)=(TKNO+TOKEN1)#,                                           00117000
ATOM(ATOM1)=((T:=ATOM1.TYPE)=TYPELOGIC OR T=TYPESYMB OR T=TYPETOKEN)#,  00118000
DELETE(DELETE1)=BEGIN ASGN(AT2,DELETE1,ATOMDELETED)END#,                00119000
SUSPEND(SUSPEND1)=BEGIN IF REF(AT2,SUSPEND1) NEQ ATOMRESUMED THEN       00120000
PRIMERROR("SPND",SUSPEND1)ELSE ASGN(AT2,SUSPEND1,ATOMSUSPENDED)END#,    00121000
AMTSPACE=((0&(MEMORYROWS+1)[18:8:9])-LASTUSEDSPACE-1)#,                 00122000
ATOMUND=ATOMUNDEF#,                                                     00123000
ATOMCAR=AT1#,                                                           00124000
ATOMCDR=AT0#,                                                           00125000
ATOMASSO=AT0#,                                                          00126000
ATOMPRIORITY=AT1#,                                                      00127000
ATOMSUSPENDED=AT1#,                                                     00128000
ATOMRESUMED=AT2#,                                                       00129000
ATOMDELETED=AT3#,                                                       00130000
LOGIC(LOGIC1)=MAKE(TYPELOGIC,LOGIC1)#,                                  00131000
DEC(DEC1)=(DEC1-1)#,                                                    00132000
 MAKE(MAKE1,MAKE2)=((MAKE2)&(MAKE1)[22:3:4])#,                          00133000
QQ(QQ1)=QU(1,QQ1)#,                                                     00134000
UQ=QU(2,0)#,                                                            00135000
 INQ(INQ1)=QU(3,INQ1)#,                                                 00136000
  GCL=QU(4,0)#;                                                         00137000
DEFINE SMEM(SMEM1)=QU(6," "&SMEM1[41:35:36])#;                          00138000
DEFINE LMEM(LMEM1)=QU(7," "&LMEM1[41:35:36])#;                          00139000
  DEFINE INLEX(INLEX1)=IL(1,0,0,INLEX1)#,INTLX=IL(0,0,0,0)#,            00140000
  LOADMODE(LOADMODE1,LOADMODE2)=IL(2,LOADMODE1,LOADMODE2,0)#;           00141000
DEFINE ID(ID1)=(ID1.TYPE=TYPECODE AND ID1.ADDR LSS 10000                00142000
  AND ID1.ADDR GEQ 2000)#,                                              00143000
INT(INT1)=(INT1.TYPE=TYPELOGIC)#,                                       00144000
 NBR(NBR1)=(NBR1.TYPE=TYPELOGIC OR (IF NBR1.TYPE=TYPEAREA               00144010
 THEN (IF REF(AT0,NBR1).ADDR EQL 3 THEN TRUE ELSE FALSE)ELSE FALSE))#,  00144020
SPCHAR(SPCHAR1)=(SPCHAR1.TYPE=TYPECODE AND SPCHAR1.ADDR                 00145000
  LEQ 576 AND SPCHAR1.ADDR GEQ 512)#;                                   00146000
  %                                                                     00147000
  %  FORWARD PROCEDURE DECLARATIONS                                     00148000
  %                                                                     00149000
REAL PROCEDURE TAIL(STRING); VALUE STRING; REAL STRING; FORWARD;        00150000
  REAL PROCEDURE USERS(F);REAL F  ;FORWARD;                             00151000
  REAL PROCEDURE USERL(X);REAL X  ;FORWARD;                             00152000
  REAL PROCEDURE PSCAN(IJ,X,F);REAL X,F;INTEGER IJ;FORWARD;             00153000
  REAL PROCEDURE BNFTREE(F);REAL F  ;FORWARD;                           00154000
 PROCEDURE MEMSAVE(X,N,Y);                                              00155000
VALUE N,Y;ARRAY X[0];REAL N,Y; FORWARD;                                 00156000
 PROCEDURE UNSAVE(X,N,FID);                                             00157000
VALUE FID;ARRAY X[0];REAL N,FID;FORWARD;                                00158000
PROCEDURE GARBAGECOLLECT(QMEM,N);                                       00159000
 VALUE N;ARRAY QMEM[0];REAL N;                                          00160000
  FORWARD;                                                              00161000
REAL PROCEDURE COPY(X);VALUE X;REAL X;FORWARD;                          00162000
PROCEDURE DOTRACE(PROCESS);VALUE PROCESS;REAL PROCESS;FORWARD;          00163000
PROCEDURE EQLIST(X,Y);VALUE X,Y;REAL X,Y;FORWARD;                       00164000
PROCEDURE PRINT(X);VALUE X;REAL X;FORWARD;                              00165000
PROCEDURE UREAD(FIL,BUF);VALUE FIL;REAL FIL;ARRAY BUF[0];FORWARD;       00166000
 BOOLEAN PROCEDURE EQ(X,Y);VALUE X,Y;REAL X,Y;FORWARD;                  00167000
REAL PROCEDURE LEXFIND;FORWARD;                                         00168000
REAL PROCEDURE QU(P,Y);                                                 00169000
VALUE P,Y;INTEGER P;REAL Y;                                             00170000
  FORWARD;                                                              00171000
  PROCEDURE PRIMERROR(A,V);                                             00172000
VALUE A,V;REAL A,V;FORWARD;                                             00173000
REAL PROCEDURE CONS(X,Y);VALUE X,Y;REAL X,Y;FORWARD;                    00174000
 REAL PROCEDURE CAR(X);VALUE X;REAL X; FORWARD;                         00175000
 REAL PROCEDURE CDR(X);VALUE X;REAL X; FORWARD;                         00176000
PROCEDURE MASGN(A,V);VALUE A,V;REAL A,V;FORWARD;                        00177000
PROCEDURE RESUME(PROCESS);VALUE PROCESS;REAL PROCESS;FORWARD;           00178000
PROCEDURE RETURN(PROCESS,VAL);                                          00179000
   VALUE PROCESS,VAL;REAL PROCESS,VAL;FORWARD;                          00180000
PROCEDURE DEBUG;FORWARD;                                                00181000
PROCEDURE INTERP;FORWARD;                                               00182000
PROCEDURE SYSM;FORWARD;                                                 00183000
REAL PROCEDURE CREATE(START,ENV,INTERPRETER,PROCESS);                   00184000
 VALUE START,ENV,INTERPRETER,PROCESS;                                   00185000
 REAL START,ENV,INTERPRETER,PROCESS;FORWARD;                            00186000
PROCEDURE ASGN(X,Y,Z);VALUE X,Y,Z;REAL X,Y,Z;FORWARD;                   00187000
REAL PROCEDURE NEWSYMB(ASSO);VALUE ASSO;REAL ASSO;FORWARD;              00188000
REAL PROCEDURE REF(X,Y);VALUE X,Y;REAL X,Y;                             00189000
FORWARD;                                                                00190000
  REAL PROCEDURE HANGON (X,Y);                                          00191000
  VALUE X,Y; REAL X,Y;FORWARD;                                          00192000
  REAL PROCEDURE IL(M,C,CM,F);                                          00193000
 INTEGER M; REAL C,CM,F; FORWARD;                                       00194000
  REAL PROCEDURE CHAR(P,N);                                             00195000
  POINTER P; INTEGER N; FORWARD;                                        00196000
REAL PROCEDURE PMAKE(T,N);VALUE T,N;REAL T,N;FORWARD;                   00197000
 REAL PROCEDURE DA(X);VALUE X;REAL X;FORWARD;                           00197010
 REAL PROCEDURE AD(X);VALUE X;REAL X;FORWARD;                           00197020
 REAL PROCEDURE AR(X,Y,Z);VALUE X,Y,Z;REAL X,Y,Z;FORWARD;               00197030
 PROCEDURE APLPNT(X);VALUE X;REAL X;FORWARD;                            00197040
REAL PROCEDURE TAIL(STRING);VALUE STRING;REAL STRING;                   00198000
 BEGIN REAL X;                                                          00198010
 IF CAR(TAIL:=X:=CDR(STRING)).TYPE=TYPEAREA AND NOT NBR(CAR(X)) THEN    00199000
 ASGN(AT0,STRING,(TAIL:=CONS(USERS(CAR(X)),X)))  END;                   00200000
REAL PROCEDURE QU(P,Y);                                                 00201000
VALUE P,Y;INTEGER P;REAL Y;                                             00202000
   BEGIN OWN INTEGER N;REAL V;                                          00203000
DEFINE PR(PR1)=(PR1.[41:19])#;                                          00204000
FORMAT F1(I4,": ",A4,I6,", ",A4,I6);                                    00205000
  INTEGER L,LP; ALPHA A;                                                00206000
   LABEL B1,B2,BB,BB1;                                                  00207000
  SWITCH PSW:=B1,B2,BB,B2,B2,B2,B2,B2;                                  00208000
   GO TO PSW[P];                                                        00209000
   BB:N:=0;                                                             00210000
  V:=MAKE(TYPELOGIC,0);                                                 00211000
Y:=CONS(LABTAB,CONS(Y,NULLIST));                                        00212000
 P:=8;                                                                  00213000
GO TO BB1;                                                              00214000
B1:QU:=ATOMUND;                                                         00215000
V:=REF(ATOMPRIORITY,Y);                                                 00216000
  BB1:N:=N+1;                                                           00217000
A:=Y&V[45:22:23];                                                       00218000
  B2: BEGIN OWN ALPHA ARRAY X[0:N];                                     00219000
   LABEL B3,B4,B5,B6,B7,B8,B9;                                          00220000
  LABEL B10,QDUMP,MEMDP,MEMLD,QIN,QSET;                                 00221000
   INTEGER I,K,IS;                                                      00222000
   ALPHA XS;                                                            00223000
  SWITCH SW:=B3,B4,B5,B10,QDUMP,MEMDP,MEMLD,QIN,QSET;                   00224000
   GO TO SW[P];                                                         00225000
  QSET:K:=LASTUSEDSPACE.[18:18]+2;                                      00225010
  FOR I:=0 STEP 1 UNTIL N DO                                            00225020
  X[I]:=MEMORY[(K+I).[17:9],(K+I).[8:9]];                               00225030
  LABTAB:=CAR(X[0].[45:23]);HASH:=CAR(CDR(X[0].[45:23]));               00225031
  GO TO B9;                                                             00225040
 QIN: X[0]:=Y&Y[45:22:23];                                              00226000
 GO TO B3;                                                              00227000
QDUMP:FOR P:=0 STEP 1 UNTIL N DO                                        00228000
WRITE(DATA,F1,P,TYPEARRAY[X[P].[45:4]],X[P].[41:19],                    00229000
   TYPEARRAY[X[P].TYPE],X[P].ADDR);                                     00230000
GO TO B9;                                                               00231000
 MEMDP:MEMSAVE(X,N,Y); GO TO B9;                                        00232000
 MEMLD:UNSAVE(X,N,Y);P:=9;GO TO B2;                                     00233000
  B10:GARBAGECOLLECT(X,N);                                              00234000
LABTAB:=CAR(X[0].[45:23]);                                              00235000
HASH:=CAR(CDR(X[0].[45:23]));GO TO B9;                                  00236000
   B3:X[N]:=A;                                                          00237000
   ;                                                                    00238000
   I:=N;                                                                00239000
   B6:IS:=I DIV 2;                                                      00240000
    IF I LSS 2 THEN GO TO B9                                            00241000
    ELSE IF PR(X[I]) GTR PR(X[IS]) THEN                                 00242000
    BEGIN XS:=X[IS];                                                    00243000
    X[IS]:=X[I];                                                        00244000
    X[I]:=XS;                                                           00245000
    I:=IS; GO TO B6 END                                                 00246000
    ELSE GO TO B9;                                                      00247000
  B4:QU:=X[1].[22:23];                                                  00248000
   X[0]:=X[0]&X[1][22:22:23];                                           00249000
                                                                        00250000
   I:=1                                                                 00251000
   ;                                                                    00252000
   IS:= 2|I;                                                            00253000
   WHILE IS LSS N DO BEGIN                                              00254000
   IF PR(X[IS]) GTR PR(X[IS+1])                                         00255000
   THEN BEGIN X[I]:=X[IS];                                              00256000
   I:=IS END                                                            00257000
   ELSE BEGIN X[I]:=X[IS+1];                                            00258000
   I:=IS+1 END;                                                         00259000
   IS:=2|I END                                                          00260000
   ;                                                                    00261000
   IF IS GTR N THEN BEGIN                                               00262000
   N:=N-1                                                               00263000
   ;                                                                    00264000
   FOR K:=I STEP 1 UNTIL N DO                                           00265000
   X[K]:=X[K+1];                                                        00266000
   IF N EQL 0 THEN BEGIN                                                00267000
   N:=N+1; GO TO B9 END END                                             00268000
ELSE BEGIN N:=N-1;X[I]:=X[IS]END;                                       00269000
   P:=3; GO TO B2;                                                      00270000
   B5:P:=2;                                                             00271000
  B9: PRIORITY:=X[1].[45:23] END                                        00272000
END QU;                                                                 00273000
  PROCEDURE PRIMERROR (A,V);                                            00274000
 VALUE A,V;REAL A,V;                                                    00275000
BEGIN FORMAT F1("SERR:",A4,X1,A4,I6);                                   00276000
WRITE(DATA,F1,A,TYPEARRAY[V.TYPE],V.ADDR);                              00277000
 A:=0/0;                                                                00278000
END PRIMERROR;                                                          00279000
%                                                                       00280000
%   B A S E     L A N G U A G E     I N T E R P R E T E R               00281000
%                                                                       00282000
%ROUTINE INTERPRET(PROCESS)=                                            00283000
%  [ INT1: WHEN STATUS/PROCESS NEQ "SUSPENDED";                         00284000
%  IF STATUS/PROCESS NEQ "RESUMED" THEN DELETE(SELF);                   00285000
%  INSTVAL(PROCESS);                                                    00286000
%  GO TO INT1 ];                                                        00287000
%                                                                       00288000
%ROUTINE INSTVAL(PROCESS)=                                              00289000
%  [ INST:= INST/NEXT/PROCESS;                                          00290000
%  NEXT/PROCESS:= SUCCESSOR/NEXT/PROCESS;                               00291000
%  ARGVAL(INST, PROCESS);                                               00292000
%  RETURN(CALLER/SELF); DELETE(SELF) ];                                 00293000
%                                                                       00294000
%ROUTINE ARGVAL(ARG,PROCESS)=                                           00295000
%  [ IF ATOM(ARG) THEN ARG:= I(ARG)/ENV/PROCESS ELSE                    00296000
%  ARG:= APPLY(OPVAL(AP/ARG,PROCESS),ARGLIST/ARG,PROCESS);              00297000
%  RETURN(CALLER/SELF,ARG); DELETE(SELF)];                              00298000
%                                                                       00299000
%ROUTINE OPVAL(OP,PROCESS)=                                             00300000
%  [ IF NOT ATOM(OP) THEN OP:= ARGVAL(OP,PROCESS);                      00301000
%  IF ATOM OP THEN OP:= I(OP)/MACHINE;                                  00302000
%  RETURN(CALLER/SELF,OP); DELETE(SELF) ];                              00303000
%                                                                       00304000
%ROUTINE APPLY(ROUTINE,ARGLIST,PROCESS)=                                00305000
%  IF ATOM(ROUTINE) THEN                                                00306000
%  [RETURN(CALLER/SELG, PRIMVAL(ROUTINE,                                00307000
%    LISTVAL(ARGLIST,PROCESS),PROCESS)); DELETE(SELF)];                 00308000
%  ENV:=PARAPASS(FPARA/ROUTINE,MAKE("CONSTRUCT"),                       00309000
%                  ARGLIST,PROCESS);                                    00310000
%  RETURN(CALLER/SELF, CALL(ROUTINE,ENV,PROCESS));                      00311000
%  DELETE(SELF) ];                                                      00312000
%                                                                       00313000
%ROUTINE CALL(ROUTINE,ENV,PROCESS)=                                     00314000
%  [ RESUME(CREATE(START/ROUTINE,ENV,INTERPRETER/ROUTINE,               00315000
%                  PROCESS));                                           00316000
%  DELETE(SELF) ];                                                      00317000
%                                                                       00318000
%ROUTINE PARAPASS(FPARA,ENV,ARGLIST,PROCESS)=                           00319000
%  [ IF FPARA NEQ "NIL" AND ARGLIST NEQ "NIL" THEN                      00320000
%  IF CAR(FPARA) = "UNDEF" THEN                                         00321000
%  CAR(CDR(FPARA))/ENV:= LISTVAL(ARGLIST,PROCESS) ELSE                  00322000
%  [ CAR(FPARA)/ENV:= ARGVAL(CAR(ARGLIST),PROCESS);                     00323000
%  ENV:= PARAPASS(CDR(FPARA),ENV,CDR(ARGLIST),PROCESS) ];               00324000
%  RETURN(CALLER/SELF,ENV) ];                                           00325000
%                                                                       00326000
%ROUTINE LISTVAL(ARGLIST,PROCESS)=                                      00327000
%  [ IF ARGLIST="NIL" THEN                                              00328000
%  RETURN(CALLER/SELF,"NIL") ELSE                                       00329000
%  RETURN(CALLER/SELF,CONS(ARGVAL(CAR(ARGLIST),PROCESS),                00330000
%                          LISTVAL(CDR(ARGLIST),PROCESS)) ];            00331000
%                                                                       00332000
PROCEDURE INTERP;                                                       00333000
BEGIN REAL ARG,ARGLIST,STRING,OP,ENV,FPARA,SAV,T,PROCESS;               00334000
DEFINE ROUTINE=OP#;                                                     00335000
DEFINE GET1=CAR(ARG)#,GET=CAR((ARG:=CDR(ARG)))#;                        00336000
DEFINE STACK(STACK1)=SAV:=CONS(STACK1,SAV)#,                            00337000
EXIT=BEGIN T:=CAR(SAV);SAV:=CDR(SAV);                                   00338000
 IF T.TYPE NEQ TYPECODE THEN PRIMERROR("EXIT",T);                       00339000
 GO TO RETSW[T.ADDR]END#;                                               00340000
LABEL INTERPRET,INSTVAL,ARGVAL,APPLY,CALL,OPVAL,PARAPASS,               00341000
LISTVAL,PRIMVAL,RETURNVAL,INT1,OP1,L1,                                  00342000
R1,R2,R3,R4,R5,R6,R7,R8,R9,R10,R11,R12,R13,R14,R15,                     00343000
R16,R17,R18,R19,R20,R21,R22,R23,R24,R25,R26,R27,R28,R29,R30,R31,        00344000
 R32,R33,R34,R35,R36,R37,R38,R39,R40,R41,R42,R43,R44,R45,               00345000
R46,LEND,R47,R48,R49,R50,R51,R52,R53,R54,R55,R56,R57;                   00346000
SWITCH RETSW:=R1,R2,R3,R4,R5,R6,R7,R8,R9,R10,R11,R12,R13,R14,R15,       00347000
R16,R17,R18,R19,R20,R21,R22,R23,R24,R25,R26,R27,R28,R29,R30,R31,        00348000
  R32,R33,R34,R35,R36,R37,R38,R39,R40,R41,R42,R43,R44,R45,R46,R47,R48,  00349000
  R49,R50,R51,R52,R53,R54,R55,R56,R57;                                  00350000
REAL RC2,RC3,RC4,RC5,RC6,RC7,RC8,RC10;                                  00350001
REAL PROCEDURE UNSTCK(SAV);REAL SAV;                                    00351000
BEGIN UNSTCK:=CAR(SAV);SAV:=CDR(SAV)END;                                00352000
DEFINE LV(LV1)=BEGIN STACK(MAKE(TYPECODE,LV1));                         00353000
   GO TO LISTVAL;END#;                                                  00354000
DEFINE UNSTACK=UNSTCK(SAV)#;                                            00355000
LABEL BNFINSTVAL,BNFEXITVAL,BNFTERMVAL,BNFRETURNVAL,                    00356000
BNFNONTERMVAL,WAITRETURN,BNFL1,BNFL2,BNFL3;                             00357000
REAL INST,X,VAL;                                                        00358000
DEFINE STR=CODE(1006)#,SLEXUNIT=CODE(1013)#,                            00359000
SID=CODE(1014)#,SINT=CODE(1015)#,                                       00360000
SSPCHAR=CODE(1016)#,SQUOTE=CODE(122)#,                                  00361000
SCGINT=CODE(1017)#,TREE=CODE(1018)#,                                    00362000
N=CODE(1019)#,CODE(CODE1)=TOKEN(CODE1)#;                                00363000
 DEFINE SNBR=CODE(1020)#;                                               00364000
 BOOLEAN PROCEDURE LOOK1(X,Y);VALUE X,Y;REAL X,Y;                       00364010
 IF(X=SLEXUNIT)OR(X=SID AND ID(Y)) OR(X=SINT AND INT(Y))                00364020
 OR(X=SNBR AND NBR(Y))OR(X=SSPCHAR AND SPCHAR(Y))                       00364030
 OR(X=Y)OR(X.TYPE EQL TYPELIST)                                         00364040
 OR(X=CODE(1012)) THEN LOOK1:=TRUE ELSE LOOK1:=FALSE;                   00364050
PROCESS:=UQ;                                                            00364060
SAV:=REF(AT7,PROCESS);                                                  00365000
RC2:=MAKE(TYPECODE,2);                                                  00366000
RC3:=MAKE(TYPECODE,3);                                                  00367000
RC4:=MAKE(TYPECODE,4);                                                  00368000
RC5:=MAKE(TYPECODE,5);                                                  00369000
RC6:=MAKE(TYPECODE,6);                                                  00370000
RC7:=MAKE(TYPECODE,7);                                                  00371000
RC8:=MAKE(TYPECODE,8);                                                  00372000
RC10:=MAKE(TYPECODE,10);                                                00373000
EXIT;                                                                   00374000
INTERPRET:R1: %(PROCESS)                                                00375000
 IF REF(AT2,PROCESS) NEQ ATOMRESUMED THEN GO TO INT1;                   00376000
 IF REF(AT1,PROCESS) LSS PRIORITY THEN                                  00377000
 BEGIN STACK(RC1);T:=QQ(PROCESS);                                       00378000
 INT1:ASGN(AT7,PROCESS,SAV);                                            00379000
 PROCESS:=UQ;SAV:=REF(AT7,PROCESS); EXIT END;                           00380000
 IF TRACE THEN BEGIN ASGN(AT7,PROCESS,SAV);                             00381000
  DOTRACE(PROCESS) END;                                                 00382000
 STACK(RC1);                                                            00383000
 IF (OP:=REF(AT5,PROCESS))=TOKEN(1004) THEN GO TO INSTVAL;              00384000
IF OP=TOKEN(1005) THEN GO TO BNFINSTVAL;                                00385000
IF OP=TOKEN(1017) THEN GO TO INSTVAL;                                   00386000
 ASGN(AT1,(ENV:=PMAKE(TYPECONS,0)),PROCESS);                            00387000
 GO TO CALL;                                                            00388000
INSTVAL: %(PROCESS)=ARG                                                 00389000
 ARG:=REF(AT3,PROCESS);                                                 00390000
 ASGN(AT3,PROCESS,CDR(ARG));                                            00391000
 IF ARG=NULLIST THEN GO TO RETURNVAL;                                   00392000
 ARG:=CAR(ARG);                                                         00393000
 STACK(TOKEN(27)); GO TO ARGVAL;R27:                                    00394000
 ASGN(TOKEN(1000),REF(AT4,PROCESS),ARG);                                00395000
 EXIT;                                                                  00396000
ARGVAL: %(ARG,PROCESS)=ARG                                              00397000
 IF ATOM(ARG) THEN ARG:=REF(ARG,REF(AT4,PROCESS)) ELSE                  00398000
 BEGIN STACK(CDR(ARG));                                                 00399000
 OP:=CAR(ARG);                                                          00400000
 STACK(RC2); GO TO OPVAL;R2:                                            00401000
 ARGLIST:=UNSTACK;                                                      00402000
 GO TO APPLY END; EXIT;                                                 00403000
APPLY: %(OP,ARGLIST,PROCESS)=ARG                                        00404000
 IF ROUTINE.TYPE=TYPECODE THEN GO TO PRIMVAL;                           00405000
 FPARA:=REF(AT1,ROUTINE);                                               00406000
 ENV:=PMAKE(TYPECONS,0);                                                00407000
 STACK(ROUTINE);                                                        00408000
 STACK(RC3);GO TO PARAPASS; R3:                                         00409000
 ROUTINE:=UNSTACK;                                                      00410000
 %GO TO CALL;                                                           00411000
CALL: %(OP,ENV,PROCESS)=ARG                                             00412000
 ASGN(AT7,PROCESS,SAV);                                                 00413000
 PROCESS:=CREATE(REF(AT2,ROUTINE),ENV,REF(AT3,ROUTINE),PROCESS);        00413010
 R39:ASGN(AT2,PROCESS,ATOMRESUMED);                                     00414000
 GO TO INTERPRET;                                                       00415000
 R9:IF REF(AT5,PROCESS)=CODE(1005) THEN %BNFINT                         00416000
 BEGIN VAL:=UNSTACK;GO TO BNFRETURNVAL END;                             00417000
 ARG:=UNSTACK;                                                          00418000
 EXIT;                                                                  00419000
OPVAL: %(OP,PROCESS)=ARG                                                00420000
 IF ATOM(OP) THEN GO TO OP1;                                            00421000
 BEGIN                                                                  00422000
 ARG:=OP;                                                               00423000
 STACK(RC4); GO TO ARGVAL;R4:                                           00424000
 OP:=ARG END;                                                           00425000
 OP1:EXIT;                                                              00426000
PARAPASS: %(FPARA,ENV,ARGLIST,PROCESS)=ENV                              00427000
 IF FPARA NEQ NULLIST THEN IF ARGLIST NEQ NULLIST THEN                  00428000
 IF CAR(FPARA)=ATOMUNDEF THEN                                           00429000
 BEGIN STACK(ENV);STACK(CAR(CDR(FPARA)));                               00430000
 STACK(RC5);GO TO LISTVAL;R5:                                           00431000
 ASGN(UNSTACK,UNSTACK,ARG)END ELSE                                      00432000
 BEGIN STACK(FPARA);STACK(ENV);STACK(CDR(ARGLIST));                     00433000
 ARG:=CAR(ARGLIST);                                                     00434000
 STACK(RC6);GO TO ARGVAL;R6:                                            00435000
 ARGLIST:=UNSTACK;ENV:=UNSTACK;FPARA:=UNSTACK;                          00436000
 ASGN(CAR(FPARA),ENV,ARG);                                              00437000
 FPARA:=CDR(FPARA);GO TO PARAPASS;END;                                  00438000
 EXIT;                                                                  00439000
LISTVAL: %(ARGLIST,PROCESS)=ARG                                         00440000
 IF ARGLIST NEQ NULLIST THEN                                            00441000
 BEGIN STACK(CDR(ARGLIST));ARG:=CAR(ARGLIST);                           00442000
 STACK(RC7);GO TO ARGVAL;R7:                                            00443000
 ARGLIST:=UNSTACK;STACK(ARG);                                           00444000
 STACK(RC8);GO TO LISTVAL;R8:                                           00445000
 ARG:=CONS(UNSTACK,ARG);                                                00446000
 END ELSE ARG:=ARGLIST; EXIT;                                           00447000
RETURNVAL: %(PROCESS)                                                   00448000
 IF(OP:=REF(AT6,PROCESS))NEQ ATOMUNDEF THEN                             00449000
 BEGIN ARG:=REF(TOKEN(1000),REF(AT4,PROCESS));                          00450000
 RETURN(OP,ARG)END;                                                     00451000
  DELETE(PROCESS);GO TO INT1 ;                                          00452000
BNFINSTVAL: %(PROCESS)                                                  00453000
 ASGN(AT3,PROCESS,CDR((INST:=REF(AT3,PROCESS))));                       00454000
 IF INST=NULLIST THEN GO TO BNFEXITVAL ELSE                             00455000
 IF ATOM((ARG:=CAR(INST))) THEN GO TO BNFTERMVAL ELSE                   00456000
 GO TO BNFNONTERMVAL;                                                   00457000
                                                                        00458000
BNFEXITVAL: %(PROCESS)                                                  00459000
 SUSPEND(PROCESS); RETURN(COPY(REF(AT6,PROCESS)),PROCESS);              00460000
 ASGN(AT5,PROCESS,SCGINT); EXIT;                                        00461000
                                                                        00462000
BNFTERMVAL: %(ARG,PROCESS)                                              00463000
 X:=CAR((STRING:=REF(STR,(ENV:=REF(AT4,PROCESS)))));                    00464000
 IF ARG=SLEXUNIT THEN GO TO BNFL1;                                      00465000
 IF ARG=SID THEN GO TO (IF ID(X) THEN BNFL1 ELSE BNFL2);                00466000
 IF ARG=SINT THEN GO TO (IF INT(X) THEN BNFL1 ELSE BNFL2);              00467000
 IF ARG=SSPCHAR THEN GO TO (IF SPCHAR(X) THEN BNFL1 ELSE BNFL2);        00468000
 IF ARG=SNBR THEN GO TO(IF NBR(X) THEN BNFL1 ELSE BNFL2);               00469000
 IF ARG=(OP:=CODE(117)) THEN GO TO PRIMVAL;                             00469010
 IF ARG=CODE(1012) THEN GO TO BNFEXITVAL;                               00470000
 IF X=ARG THEN                                                          00471000
 ASGN(STR,ENV,TAIL(STRING)) ELSE GO TO BNFL2;                           00472000
  EXIT;                                                                 00473000
 BNFL1: INST:=CONS(SQUOTE,CONS(X,NULLIST));                             00474000
 X:=CREATE(CONS(INST,NULLIST),PMAKE(TYPECONS,0),SCGINT,PROCESS);        00475000
 ASGN(STR,ENV,TAIL(STRING));                                            00476000
 ASGN(TREE,ENV,CONS(X,REF(TREE,ENV)));                                  00477000
 ASGN(N,ENV,REF(N,ENV)+1);EXIT;                                         00478000
 BNFL2:DELETE(PROCESS); EXIT;                                           00479000
                                                                        00480000
BNFRETURNVAL: %(PROCESS,VAL)                                            00481000
 ASGN(AT4,PROCESS,ENV:=COPY(REF(AT4,PROCESS)));                         00482000
 ASGN(TREE,ENV,CONS(VAL,REF(TREE,ENV)));                                00483000
 ASGN(STR,ENV,REF(STR,REF(AT4,VAL)));                                   00484000
 ASGN(N,ENV,REF(N,ENV)+1); EXIT;                                        00485000
                                                                        00486000
BNFNONTERMVAL: %(ARG,PROCESS)                                           00487000
 IF CAR(ARG) NEQ CODE(118) THEN PRIMERROR("BNF ",ARG);                  00488000
 X:=NULLIST;ENV:=REF(AT4,PROCESS);                                      00489000
ARGLIST:=CDR(ARG);                                                      00490000
 WHILE ARGLIST NEQ NULLIST DO                                           00491000
 IF LOOK1(CAR(CAR(ARGLIST)),CAR(REF(STR,ENV))) THEN                     00492000
 BEGIN ENV:=COPY(ENV);                                                  00493000
 ASGN(TREE,ENV,NULLIST);                                                00493010
 ASGN(N,ENV,AT0);                                                       00494000
 X:=CONS(CREATE(CAR(ARGLIST),ENV,CODE(1005),PROCESS),X);                00495000
 ARGLIST:=CDR(ARGLIST) END ELSE ARGLIST:=CDR(ARGLIST) ;                 00496000
GO TO WAITRETURN;                                                       00497000
WAITRETURN: %(X)                                                        00498000
 WHILE X NEQ NULLIST DO                                                 00499000
  BEGIN RESUME(CAR(X)); X:=CDR(X) END;                                  00500000
 GO TO INT1;                                                            00501000
PRIMVAL: %(OP,ARGLIST,PROCESS)=ARG                                      00502000
CASE ROUTINE.ADDR-100 OF BEGIN                                          00503000
 IF ATOM(CAR(ARGLIST)) THEN  % ASGN=CODE 100                            00504000
  BEGIN STACK(CAR(ARGLIST)); ARGLIST:=CDR(ARGLIST);                     00505000
  LV(41);R41:ASGN(UNSTACK,GET1,ARG:=GET) END ELSE                       00506000
BEGIN LV(11);R11:ASGN(GET1,GET,(ARG:=GET))END; %ASGN=CODE100            00507000
 IF ATOM(CAR(ARGLIST)) THEN  % REF=CODE 101                             00508000
 BEGIN STACK(CAR(ARGLIST));ARGLIST:=CDR(ARGLIST);                       00509000
  LV(42);R42:ARG:=REF(UNSTACK,GET1) END ELSE                            00510000
BEGIN LV(12);R12:ARG:=REF(GET1,GET)END; %REF=CODE101                    00511000
BEGIN LV(13);R13:ARG:=CAR(GET1)END; %CAR=CODE 102                       00512000
BEGIN LV(14);R14:ARG:=CDR(GET1)END; %CDR=CODE103                        00513000
BEGIN LV(15);R15:ARG:=CONS(GET1,GET)END; %CONS=CODE 104                 00514000
BEGIN LV(16);R16:ARG:=NEWSYMB(GET1)END;                    %NEWSYMB     00515000
ARG:=AMTSPACE;                   %AMTSPACE                              00516000
BEGIN LV(17);R17:ARG:=PMAKE(GET1.TYPE,GET)END;            %MAKE         00517000
BEGIN LV(18);R18:PRINT((ARG:=GET1))END;                   %PRINT        00518000
BEGIN LV(19);R19:ARG:=INLEX(GET1)END;                     %INLEX        00519000
 BEGIN SUSPEND(PROCESS);RESUME(PROCESS);GCL;                            00520000
 PROCESS:=UQ;ARG:=AMTSPACE END;       % GCL                             00521000
BEGIN LV(20);R20:ARG:=CREATE(GET1,GET,GET,GET)END;        %CREATE       00522000
BEGIN LV(21);R21: DELETE(GET1);ARG:=ATOMUNDEF END;%DELETE               00522010
BEGIN LV(22);R22: ARG:=GET1;SUSPEND(ARG)END;      %SUSPEND              00523000
BEGIN LV(23);R23:RESUME((ARG:=GET1))END;                  %RESUME       00524000
BEGIN LV(24);R24:RETURN(GET1,(ARG:=GET))END; %RETURN=CODE115            00525000
BEGIN LV(25);R25:ARG:=GET1 END; %IDENTITY=CODE116                       00526000
  BEGIN SUSPEND(PROCESS);SMEM("RERUN1") ; GO TO LEND END;%HALT = CODE 1100527000
PRIMERROR("C118",PROCESS);%RESERVED FOR CODE118                         00528000
PRIMERROR("C119",PROCESS);%RESERVED FOR CODE119                         00529000
BEGIN LV(33);R33:ASGN(TOKEN(1009),REF(AT4,PROCESS),                     00530000
  (ARG:=GET))END; % TRACE=CODE120                                       00531000
BEGIN LV(26);R26:EQLIST(GET1,(ARG:=GET))END; %EQLIST                    00532000
ARG:=CAR(ARGLIST); %QUOTE=CODE122                                       00533000
 IF ATOM(CAR(ARGLIST)) THEN  % ASGNENV=CODE 123                         00534000
  BEGIN STACK(CAR(ARGLIST)); ARGLIST:=CDR(ARGLIST);                     00535000
   LV(43);R43:ASGN(UNSTACK,REF(AT4,PROCESS),(ARG:=GET1)) END ELSE       00536000
BEGIN LV(28);R28:ASGN(GET1,REF(AT4,PROCESS),(ARG:=GET))END;%ASGNENV=CODE00537000
 IF ATOM(CAR(ARGLIST)) THEN  %REFENV=CODE 124                           00538000
  BEGIN STACK(CAR(ARGLIST)); ARGLIST:=CDR(ARGLIST);                     00539000
   LV(44);R44:ARG:=REF(UNSTACK,REF(AT4,PROCESS)) END ELSE               00540000
BEGIN LV(29);R29:ARG:=REF(GET1,REF(AT4,PROCESS))END; %REFENV=CODE124    00541000
BEGIN LV(30);R30:ARG:=GET1;GO TO ARGVAL END; %EXE=CODE125               00542000
DEBUG; %DEBUG=CODE126                                                   00543000
  BEGIN LV(49);R49:ARG:=LOADMODE(GET1,GET) END; %LDMODE=127             00544000
ARG:=PMAKE(TYPECONS,0); %CONSTRUCT=CODE128                              00545000
BEGIN LV(31);R31:ARG:=PMAKE(TYPEAREA,GET1)END;                          00546000
  %AREA = CODE129                                                       00547000
  BEGIN LV(48);R48:ARG:=TOKEN(GET1.ADDR) END;%TOKEN=CODE 130            00548000
BEGIN LV(32);R32:ASGN(TOKEN(1008),REF(AT4,PROCESS),                     00549000
  (ARG:=GET1))END; % SINGLESTEP=CODE131                                 00550000
BEGIN ASGN(AT1,PROCESS,REF(AT1,PROCESS)+1);                             00551000
  ARG:=ATOMUNDEF END; %UP=CODE132                                       00552000
BEGIN ASGN(AT1,PROCESS,REF(AT1,PROCESS)-1);                             00553000
  ARG:=ATOMUNDEF END; %DP=CODE133                                       00554000
;%BEGIN LV(34);R34:UREAD((ARG:=GET1))END; %READ=CODE134                 00555000
;% RESERVED FOR CODE 135                                                00556000
 GO TO LISTVAL;  % LIST=CODE 136                                        00557000
 BEGIN STACK(CDR(ARGLIST)); ARG:=CAR(ARGLIST); %COND=CODE 137           00558000
  STACK(TOKEN(36));GO TO ARGVAL;R36:ARGLIST:=UNSTACK;                   00559000
  IF ARG.TYPE=TYPELOGIC THEN                                            00560000
  BEGIN ARG:=(IF BOOLEAN(ARG) THEN CAR(ARGLIST) ELSE REF(AT2,ARGLIST)); 00561000
   GO TO ARGVAL END ELSE ARG:=ATOMUNDEF END;                            00562000
  BEGIN LV(37);R37:ARG:=(IF EQ(GET1,GET) THEN AT(524287)                00563000
     ELSE AT0) END; % EQ=CODE 138                                       00564000
 BEGIN LV(38);R38:ARG:=GET1;  % ATOM=CODE 139                           00565000
 ARG:=(IF ATOM(ARG) THEN AT(524287) ELSE AT0) END;                      00566000
 BEGIN PROCESS:=CREATE(ARGLIST,REF(AT4,PROCESS),REF(AT5,                00567000
        PROCESS),PROCESS);                                              00568000
  GO TO R29 END  ; % BLOCKOP=CODE 140                                   00569000
 BEGIN LV(40);R40:ARG:=(IF EQ(GET1,GET) THEN AT0                        00570000
     ELSE AT(524287)) END;  % NEG=CODE 141                              00571000
BEGIN STACK(CAR(CDR(ARGLIST))); ARG:=CAR(ARGLIST);%IF=CODE 142          00572000
 STACK(TOKEN(45));GO TO ARGVAL;R45:ARGLIST:=UNSTACK;                    00573000
 IF BOOLEAN(ARG) THEN ASGN(AT3,PROCESS,ARGLIST) END;                    00574000
BEGIN ENV:=REF(AT4,PROCESS);%NONTERM=CODE143                            00575000
  ASGN(STR,ENV,AT0);                                                    00576000
 BNFL3:IF (ARG:=REF(N,ENV)).ADDR GTR 0 THEN                             00577000
  BEGIN ASGN(N,ENV,ARG-1);ASGN(STR,ENV,REF(STR,ENV)+1);                 00577050
  ASGN(AT6,ARG:=REF(ARG,REF(TREE,ENV)),PROCESS);                        00578000
  STACK(CODE(46));RESUME(ARG);                                          00579000
 GO TO INT1;R46:                                                        00579050
 ENV:=REF(AT4,PROCESS);                                                 00580000
  ASGN(REF(STR,ENV),ENV,ARG);GO TO BNFL3 END;                           00581000
  ARG:=REF(AT1,ENV);                                                    00582000
 ASGN(TREE,ENV,ATOMUNDEF);                                              00583000
 ASGN(STR,ENV,ATOMUNDEF);                                               00583050
 ASGN(N,ENV,ATOMUNDEF) END NONTERM;                                     00584000
  BEGIN LV(47);R47:ARG:=USERL(GET1) END;%USERL=CODE 144                 00585000
  ARG:=LABTAB;  %LTAB=CODE 145                                          00586000
 BEGIN LV(50);R50:ARG:=COPY(GET1) END; %COPY=CODE 146                   00586010
 BEGIN LV(51);R51:ARG:=AR(0,GET1,GET) END; %ADD=CODE 147                00586020
 BEGIN LV(52);R52:ARG:=AR(1,GET1,GET) END; %SUB=CODE 148                00586030
 BEGIN LV(53);R53:ARG:=AR(2,GET1,GET) END; %MUL=CODE 149                00586035
 BEGIN LV(54);R54:ARG:=AR(3,GET1,GET) END; %DIV=CODE 150                00586040
 BEGIN LV(55);R55:ARG:=AR(4,GET1,GET) END; %EX=CODE 151                 00586045
 BEGIN LV(56);R56:ARG:=AR(2,GET1,AD(-1)) END; %NEG=CODE 152             00586050
 BEGIN LV(57);R57:ARG:=IF LOOK1(GET1,GET) THEN AT(524287)               00586055
 ELSE AT0 END                           % LOOK1=CODE 153                00586060
END CASE STATEMENT;                                                     00586070
EXIT;                                                                   00586080
L1:ASGN(AT7,PROCESS,SAV);DOTRACE(PROCESS);                              00587000
R10:R35:R34: % THESE ARE TO BE LATER MOVED                              00588000
LEND:XX1:=PROCESS; END INTERP;                                          00589000
PROCEDURE GARBAGECOLLECT(QMEM,N);                                       00590000
VALUE N;ARRAY QMEM[0];REAL N;                                           00591000
BEGIN REAL RP,WP,X,XADDR,BASE,TYP,I;                                    00592000
LABEL L1,L2,L3,L4,L5,L6;                                                00593000
ARRAY TMEM[0:MEMORYROWS,0:511];                                         00594000
DEFINE   CP(CP1,CP2)=%CONSTRUCT PROCESSING                              00595000
BEGIN IF (X:=M[XADDR]).TYPE NEQ TYPEGARBAGE THEN                        00596000
BEGIN TMASGN((WP:=WP+1),X);                                             00597000
MASGN(XADDR,MAKE(TYPEGARBAGE,WP));                                      00598000
CP1(RP,MAKE(XADDR.TYPE,WP),CP2)END ELSE                                 00599000
CP1(RP,MAKE(XADDR.TYPE,X),CP2)END#;                                     00600000
DEFINE LP(LP1,LP2)=                                                     00601000
BEGIN IF (X:=CAR(XADDR)).TYPE = TYPEGARBAGE THEN                        00602000
LP1(RP,MAKE(TYPELIST,X),LP2)ELSE                                        00603000
IF CARADDR=NULLIST THEN LP1(RP,NULLIST,LP2)ELSE                         00604000
BEGIN LP1(RP,MAKE(TYPELIST,(WP:=WP+1)),LP2)#,                           00605000
LLP(LLP1)=TMASGN(WP,X);                                                 00606000
MASGN(CARADDR,MAKE(TYPEGARBAGE,WP));                                    00607000
XADDR:=CDR(XADDR);                                                      00608000
IF (X:=CAR(XADDR)).TYPE NEQ TYPEGARBAGE THEN                            00609000
IF CARADDR NEQ NULLIST THEN                                             00610000
BEGIN WP:=WP+1;GO TO LLP1 END ELSE                                      00611000
TMASGN((WP:=WP+1),LINKTONIL)ELSE                                        00612000
TMASGN((WP:=WP+1),MAKE(TYPELINK,X))END END #;                           00613000
DEFINE TM[TM1]=(IF BOOLEAN(TM1) THEN                                    00614000
TMEM[(TM1).[18:9],(TM1).[9:9]].[22:23]ELSE                              00615000
TMEM[(TM1).[18:9],(TM1).[9:9]].[45:23])#,                               00616000
Q[Q1]=(IF BOOLEAN(Q1) THEN QMEM[Q1.[10:10]].[22:23] ELSE                00617000
       QMEM[Q1.[10:10]].[45:23])#,                                      00618000
TMASGN(TMASGN1,TMASGN2)=TA(TMASGN1,TMASGN2,TMEM)#,                      00619000
QASGN(QASGN1,QASGN2)=QA(QASGN1,QASGN2,QMEM)#;                           00620000
PROCEDURE TA(A,V,M);VALUE A,V;REAL A,V;ARRAY M[0,0];                    00621000
IF BOOLEAN(A) THEN M[A.[18:9],A.[9:9]].[22:23]:=V ELSE                  00622000
M[A.[18:9],A.[9:9]].[45:23]:=V;                                         00623000
PROCEDURE QA(A,V,M);VALUE A,V;REAL A,V;ARRAY M[0];                      00624000
IF BOOLEAN(A) THEN M[A.[10:10]].[22:23]:=V ELSE                         00625000
M[A.[10:10]].[45:23]:=V;                                                00626000
FORMAT F1("GCL:",I6," WORDS RECOVERED.",I6," WORDS IN USE.");           00627000
WP:=0;                                                                  00628000
% COPY FROM M TO TM UPSIDE DOWN USING Q                                 00629000
FOR RP:=N+N+1 STEP -1 UNTIL 0 DO                                        00630000
CASE (XADDR:=Q[RP]).TYPE OF                                             00631000
BEGIN PRIMERROR("GCL1",XADDR);%GARBAGE                                  00632000
L1:CP(QA,QMEM); %CONSTRUCT                                              00633000
LP(QA,QMEM);L2:LLP(L2);%LIST                                            00634000
L5:IF (X:=M[XADDR]).TYPE=TYPEGARBAGE THEN %AREA                         00635000
QASGN(RP,MAKE(XADDR.TYPE,X))ELSE                                        00636000
BEGIN WP:=WP+1;                                                         00637000
FOR I:=X.ADDR STEP -1 UNTIL 0 DO                                        00638000
TMASGN(WP+I,M[XADDR-I]);                                                00639000
QASGN(RP,MAKE(XADDR.TYPE,WP));                                          00640000
MASGN(XADDR,MAKE(TYPEGARBAGE,WP));                                      00641000
WP:=WP+X.ADDR END;                                                      00642000
PRIMERROR("GCL2",XADDR); %FIELD                                         00643000
IF XADDR NEQ ATOMUNDEF THEN GO TO L1; %SYMBOL                           00644000
; %LOGIC                                                                00645000
PRIMERROR("GCL3",XADDR); %LINK                                          00646000
GO TO L5; %PROCESS                                                      00647000
GO TO L5; %MONITOR                                                      00648000
GO TO L5; %GENERAL                                                      00649000
; %TOKEN                                                                00650000
PRIMERROR("GCL4",XADDR); %TP12                                          00651000
PRIMERROR("GCL5",XADDR); %TP13                                          00652000
PRIMERROR("GCL6",XADDR); %TP14                                          00653000
PRIMERROR("GCL7",XADDR); %TP15                                          00654000
END CASE STATEMENT;                                                     00655000
%COPY FROM M TO TM UPSIDE DOWN USING TM                                 00656000
FOR RP:=1 STEP 1 UNTIL WP DO                                            00657000
CASE (XADDR:=TM[RP]).TYPE OF BEGIN                                      00658000
PRIMERROR("GCL8",XADDR); %GARBAGE                                       00659000
L3:CP(TA,TMEM); %CONSTRUCT                                              00660000
LP(TA,TMEM);L4:LLP(L4);%LIST                                            00661000
L6:IF (X:=M[XADDR]).TYPE=TYPEGARBAGE THEN %AREA                         00662000
TMASGN(RP,MAKE(XADDR.TYPE,X))ELSE                                       00663000
BEGIN WP:=WP+1;                                                         00664000
FOR I:=X.ADDR STEP -1 UNTIL 0 DO                                        00665000
TMASGN(WP+I,M[XADDR-I]);                                                00666000
TMASGN(RP,MAKE(XADDR.TYPE,WP));                                         00667000
MASGN(XADDR,MAKE(TYPEGARBAGE,WP));                                      00668000
WP:=WP+X.ADDR END;                                                      00669000
PRIMERROR("GCL9",XADDR); %FIELD                                         00670000
IF XADDR NEQ ATOMUNDEF THEN GO TO L3; %SYMBOL                           00671000
; %LOGIC                                                                00672000
; %LINK                                                                 00673000
GO TO L6; %PROCESS                                                      00674000
GO TO L6; %MONITOR                                                      00675000
GO TO L6; %GENERAL                                                      00676000
; %TOKEN                                                                00677000
END CASE STATEMENT;                                                     00678000
% COPY FROM TM TO M AND INVERT                                          00679000
BASE:=WP+1;                                                             00680000
LASTUSEDSPACE:=0;                                                       00681000
FOR RP:=WP STEP -1 UNTIL 1 DO                                           00682000
BEGIN X:=TM[RP];                                                        00683000
IF (TYP:=X.TYPE) NEQ TYPELOGIC THEN                                     00684000
IF TYP NEQ TYPECODE THEN                                                00685000
IF X.ADDR NEQ 524287 THEN                                               00686000
X:=MAKE(TYP,BASE-X.ADDR);                                               00687000
MASGN(STEPSPACE,X) END;                                                 00688000
% FIX ADDRESSES IN Q                                                    00689000
FOR RP:=N+N+1 STEP -1 UNTIL 0 DO                                        00690000
IF (TYP:=Q[RP].TYPE) NEQ TYPELOGIC THEN                                 00691000
IF TYP NEQ TYPECODE THEN                                                00692000
IF Q[RP].ADDR NEQ 524287 THEN                                           00693000
QASGN(RP,MAKE(TYP,BASE-Q[RP].ADDR));                                    00694000
WRITE(DATA,F1,AMTSPACE,LASTUSEDSPACE);                                  00695000
END GARBAGE COLLECT;                                                    00696000
REAL PROCEDURE COPY(X);VALUE X;REAL X;                                  00697000
BEGIN LABEL L1,L2;REAL I;                                               00698000
CASE X.TYPE OF BEGIN                                                    00699000
L1:PRIMERROR("COPY",X); %GARBAGE                                        00700000
MASGN((COPY:=PMAKE(X.TYPE,0)),COPY(M[X]));%CONSTRUCT                    00701000
COPY:=(IF X=NULLIST THEN NULLIST ELSE CONS(CAR(X),COPY(CDR              00702000
   (X)))); %LIST                                                        00703000
L2:BEGIN FOR I:=M[X].ADDR STEP -1 UNTIL 0 DO %AREA                      00704000
MASGN(STEPSPACE, M[X-I]);                                               00705000
COPY:=MAKE(X.TYPE,LASTUSEDSPACE)END;                                    00706000
GO TO L1; %FIELD                                                        00707000
COPY:=X; %SYMBOL                                                        00708000
COPY:=X; %LOGIC                                                         00709000
GO TO L1; %LINK                                                         00710000
GO TO L2; %PROCESS                                                      00711000
GO TO L2; %MONITOR                                                      00712000
GO TO L2; %GENERAL                                                      00713000
COPY:=X; %TOKEN                                                         00714000
END CASE STATEMENT;                                                     00715000
END COPY;                                                               00716000
BOOLEAN PROCEDURE EQ(X,Y);VALUE X,Y; REAL X,Y;                          00717000
 IF X=Y THEN EQ:=TRUE ELSE                                              00718000
 IF X.TYPE NEQ Y.TYPE THEN EQ:= FALSE ELSE                              00719000
 IF X.TYPE NEQ TYPELIST THEN EQ := FALSE ELSE                           00720000
BEGIN X:=CAR(X); X:=CARADDR;                                            00721000
      Y:=CAR(Y);EQ:=X=CARADDR                                           00722000
 END OF EQ;                                                             00723000
REAL PROCEDURE CAR(Y);VALUE Y;REAL Y;                                   00724000
BEGIN LABEL L1,L2;                                                      00725000
IF Y.TYPE NEQ TYPELIST THEN                                             00726000
 IF Y.TYPE NEQ TYPELINK THEN PRIMERROR("CAR ",Y);                       00727000
IF Y=NULLIST THEN GO TO L2;                                             00728000
L1:CARADDR:=Y;                                                          00729000
IF (Y:=M[Y]).TYPE=TYPELINK THEN                                         00730000
IF Y NEQ LINKTONIL THEN GO TO L1 ELSE                                   00731000
L2:BEGIN CAR:=ATOMUNDEF;                                                00732000
CARADDR:=NULLIST END ELSE                                               00733000
CAR:=Y END CAR;                                                         00734000
REAL PROCEDURE CDR(Y);VALUE Y;REAL Y;                                   00735000
BEGIN Y:=CAR(Y);                                                        00736000
IF CARADDR NEQ NULLIST THEN Y:=CAR(MAKE(TYPELIST,DEC(CARADDR)));        00737000
CDR:=MAKE(TYPELIST,CARADDR);                                            00738000
END CDR;                                                                00739000
PROCEDURE EQLIST(X,Y);VALUE X,Y;REAL X,Y;                               00740000
BEGIN REAL T1,T2;LABEL LEND;                                            00741000
T1:=CAR(Y);T1:=CARADDR;T2:=CAR(X);                                      00742000
IF T1=CARADDR THEN GO TO LEND;                                          00743000
IF CARADDR=NULLIST THEN PRIMERROR("EQL2",X);                            00744000
MASGN(X,MAKE(TYPELINK,T1));                                             00745000
LEND:END EQLIST;                                                        00746000
REAL PROCEDURE CONS(X,Y);VALUE X,Y;REAL X,Y;                            00747000
BEGIN IF Y.TYPE NEQ TYPELIST THEN PRIMERROR("CONS",Y);                  00748000
IF Y.ADDR NEQ LASTUSEDSPACE THEN MASGN(STEPSPACE,MAKE(TYPELINK,Y));     00749000
MASGN(STEPSPACE,X);                                                     00750000
CONS:=MAKE(TYPELIST,LASTUSEDSPACE)END CONS;                             00751000
REAL PROCEDURE REF(X,Y);VALUE X,Y;REAL X,Y;                             00752000
BEGIN LABEL L1,L2,L3,L4;REAL T1,T2;                                     00753000
CASE Y.TYPE OF                                                          00754000
BEGIN PRIMERROR("REF1",Y);%GARBAGE                                      00755000
L1:BEGIN T1:=M[Y];%CONSTRUCT                                            00756000
L2:IF CAR(T1) NEQ ATOMUNDEF THEN                                        00757000
IF CAR(T1) NEQ X THEN                                                   00758000
BEGIN T1:=CDR(T1)-1;GO TO L2 END ELSE                                   00759000
REF:=CAR(CDR(T1))ELSE                                                   00760000
REF:=ATOMUNDEF END;                                                     00761000
IF X=ATOMCAR THEN REF:=CAR(Y) ELSE%LIST                                 00762000
IF X=ATOMCDR THEN REF:=CDR(Y) ELSE                                      00763000
IF X.TYPE NEQ TYPELOGIC THEN REF:=ATOMUNDEF ELSE                        00764000
BEGIN FOR X:=X.ADDR STEP -1 UNTIL 2 DO Y:=CDR(Y);                       00765000
REF:=CAR(Y) END;                                                        00766000
L3:BEGIN IF X.TYPE=TYPELOGIC THEN %AREA                                 00767000
IF X.ADDR LEQ M[Y].ADDR THEN                                            00768000
BEGIN REF:=M[Y-X.ADDR];GO TO L4 END;                                    00769000
REF:=ATOMUNDEF;                                                         00770000
L4:END;                                                                 00771000
PRIMERROR("REF4",Y);%FIELD                                              00772000
IF X=ATOMASSO THEN %SYMBOL                                              00773000
REF:=(IF Y=ATOMUNDEF THEN Y ELSE M[Y])ELSE                              00774000
PRIMERROR("REF5",Y);                                                    00775000
PRIMERROR("REF6",Y);%LOGIC                                              00776000
PRIMERROR("REF7",Y);%LINK                                               00777000
GO TO L3; %PROCESS                                                      00778000
GO TO L3;%MONITOR                                                       00779000
PRIMERROR("REF8",Y);%GENERAL                                            00780000
PRIMERROR("REF9",Y);%CODE                                               00781000
END CASE STATEMENT;                                                     00782000
END REF;                                                                00783000
PROCEDURE ASGN(X,Y,Z);VALUE X,Y,Z;REAL X,Y,Z;                           00784000
BEGIN LABEL L1,L2,L3;REAL T1,T2;                                        00785000
CASE Y.TYPE OF                                                          00786000
BEGIN PRIMERROR("ASG1",Y);%GARBAGE                                      00787000
L1:BEGIN T1:=M[Y];%CONSTRUCT                                            00788000
IF X=ATOMUNDEF THEN PRIMERROR("ASGD",Y);                                00789000
L2:IF CAR(T1) NEQ ATOMUNDEF THEN                                        00790000
IF CAR(T1) NEQ X THEN                                                   00791000
BEGIN T1:=DEC(CDR(T1));GO TO L2 END ELSE                                00792000
IF Z NEQ ATOMUNDEF THEN                                                 00793000
MASGN(CDR(T1),Z) ELSE                                                   00794000
IF T1=M[Y] THEN MASGN(Y,CDR(CDR(T1)))ELSE                               00795000
MASGN(T1,MAKE(TYPELINK,CDR(CDR(T1))))ELSE                               00796000
IF Z NEQ ATOMUNDEF THEN MASGN(Y,CONS(X,CONS(Z,M[Y])))END;               00797000
BEGIN T1:=CAR(Y);%LIST                                                  00798000
IF CARADDR=NULLIST THEN PRIMERROR("ASG0",Y);                            00799000
IF X=ATOMCAR THEN MASGN(CARADDR,Z)ELSE                                  00800000
IF X=ATOMCDR THEN                                                       00801000
IF Z.TYPE NEQ TYPELIST THEN PRIMERROR("ASGC",Z)ELSE                     00802000
MASGN(CARADDR,MAKE(TYPELINK,CONS(M[CARADDR],Z)))ELSE                    00803000
IF X.TYPE NEQ TYPELOGIC THEN PRIMERROR("ASG2",X ) ELSE                  00804000
BEGIN T1:=CARADDR;                                                      00805000
FOR X:=X.ADDR STEP -1 UNTIL 2 DO                                        00806000
 BEGIN IF (Y:=CDR(Y))=NULLIST THEN MASGN(T1-1,(Y:=MAKE(TYPELINK,        00807000
CONS(ATOMUNDEF,NULLIST))));                                             00808000
T1:=Y END;                                                              00809000
MASGN(Y,Z) END END;                                                     00810000
L3:BEGIN IF X.TYPE NEQ TYPELOGIC THEN PRIMERROR("ASG3",X);%AREA         00811000
IF (X:=X.ADDR) GTR M[Y].ADDR THEN PRIMERROR("ASGA",Y);                  00812000
IF X=0 THEN                                                             00813000
IF X.TYPE NEQ TYPELOGIC OR X GTR M[Y] THEN PRIMERROR("ASGB",Z);         00814000
MASGN(Y-X,Z)END;                                                        00815000
PRIMERROR("ASG4",Y);%FIELD                                              00816000
IF X=ATOMASSO AND Y NEQ ATOMUNDEF THEN MASGN(Y,Z)ELSE%SYMBOL            00817000
PRIMERROR("ASG5",Y);                                                    00818000
PRIMERROR("ASG6",Y);%LOGIC                                              00819000
PRIMERROR("ASG7",Y);%LINK                                               00820000
 GO TO L3; %PROCESS                                                     00821000
GO TO L3;%MONITOR                                                       00822000
PRIMERROR("ASG8",Y);%GENERAL                                            00823000
PRIMERROR("ASG9",Y);%CODE                                               00824000
END CASE STATEMENT;                                                     00825000
END ASGN;                                                               00826000
REAL PROCEDURE PMAKE(T,N);VALUE T,N;REAL T,N;                           00827000
BEGIN LABEL L1,L2,L3; REAL I;                                           00828000
CASE T OF BEGIN                                                         00829000
L1:PRIMERROR("MK1 ",T); %GARBAGE                                        00830000
L2:BEGIN MASGN(STEPSPACE,NULLIST); %CONSTRUCT                           00831000
PMAKE:=MAKE(T,LASTUSEDSPACE)END;                                        00832000
PMAKE:= NULLIST; %LIST                                                  00833000
L3:IF N.TYPE NEQ TYPELOGIC THEN PRIMERROR("MK2 ",N)ELSE%AREA            00834000
BEGIN FOR I:=N.ADDR STEP -1 UNTIL 1 DO                                  00835000
MASGN(STEPSPACE,ATOMUNDEF);                                             00836000
MASGN(STEPSPACE,N);                                                     00837000
PMAKE:=MAKE(T,LASTUSEDSPACE)END;                                        00838000
GO TO L1; %FIELD                                                        00839000
PMAKE:=NEWSYMB(N); %SYMBOL                                              00840000
PMAKE:=AT0; %LOGIC                                                      00841000
GO TO L1; %LINK                                                         00842000
GO TO L3; %PROCESS                                                      00843000
GO TO L3; %MONITOR                                                      00844000
GO TO L3;%GENERAL                                                       00845000
PMAKE:=NEXTTOKEN:=NEXTTOKEN+1; %TOKEN                                   00846000
END CASE STATEMENT;                                                     00847000
END PMAKE;                                                              00848000
REAL PROCEDURE NEWSYMB(ASSO);VALUE ASSO;REAL ASSO;                      00849000
BEGIN MASGN(STEPSPACE,ASSO);                                            00850000
NEWSYMB:=MAKE(TYPESYMB,LASTUSEDSPACE)END NEWSYMB;                       00851000
 REAL PROCEDURE CHAR(P,N);                                              00852000
 POINTER P; INTEGER N;                                                  00853000
 BEGIN REAL ARRAY X[0:0];                                               00854000
 X[0]:=0;                                                               00855000
 IF N LSS 8 AND N GTR 0 THEN                                            00856000
 REPLACE POINTER(X)+(8-N) BY P FOR N;                                   00857000
 CHAR:=X[0] END; % END OF CHAR                                          00858000
 REAL PROCEDURE HANGON (X,Y);                                           00859000
 VALUE X,Y; REAL X,Y;                                                   00860000
 BEGIN LABEL L1,L2;                                                     00861000
 POINTER P;REAL ARRAY XD[0:0],X1[0:0];REAL Z                            00862000
 ;                                                                      00863000
P:=POINTER(STACK[STACKPOSITION.[18:7],*])+STACKPOSITION.[11:12];        00864000
 X1[0]:=1;Z:=NULLIST;                                                   00865000
 WHILE Y NEQ NULLIST DO                                                 00866000
 BEGIN Z:=CONS(CAR(Y),Z);Y:=CDR(Y)END;                                  00867000
WHILE Z NEQ NULLIST DO                                                  00868000
 BEGIN                                                                  00869000
 XD[0]:=CAR(Z);                                                         00870000
 REPLACE P:=P+1 BY POINTER(XD)+7 FOR 1;                                 00871000
 X1[0]:=X1[0]+1;                                                        00872000
 Z:=CDR(Z) END;                                                         00873000
 REPLACE POINTER(STACK[STACKPOSITION.[18:7],*])+                        00874000
 STACKPOSITION.[11:12] BY POINTER(X1)+7 FOR 1;                          00875000
 IF X1[0] EQL 2 THEN BEGIN                                              00876000
 X1[0]:=LOADMODE(XD[0],X1[0]).ADDR;                                     00877000
 IF X1[0] EQL 2 OR X1[0] EQL 66 THEN BEGIN                              00878000
 HANGON:=TOKEN(XD[0].ADDR+512);X1[0]:=LOADMODE(XD[0],X1[0]);            00879000
 GO TO L2 END;                                                          00880000
 X1[0]:=LOADMODE(XD[0],X1[0]) END;                                      00881000
 HANGON:=LEXFIND;                                                       00882000
 L2:END OF HANGON;                                                      00883000
 REAL PROCEDURE IL(M,C,CM,F);                                           00884000
INTEGER M; REAL C,CM,F;                                                 00885000
 BEGIN % PROCEDURE BLOCK;                                               00886000
 DEFINE N=72#, NCPW=8#;                                                 00887000
 DEFINE FILIN=DATA#,                                                    00888000
 LAST="$"#;                                                             00889000
 DEFINE TOTCHAR = 64#;                                                  00890000
 DEFINE X=LEXTREE#;                                                     00891000
 BEGIN % OWN BLOCK;                                                     00892000
 OWN ALPHA ARRAY D[0:N DIV NCPW];                                       00893000
 OWN REAL ARRAY MODE [0:TOTCHAR];                                       00894000
 OWN INTEGER COUNT;                                                     00895000
OWN POINTER P;                                                          00896000
OWN REAL ARRAY SS[0:63];                                                00897000
  CASE M OF BEGIN                                                       00898000
 BEGIN INTEGER I; % M IS 0;                                             00898050
 I:=0;                                                                  00899000
 WHILE I LEQ 9 DO                                                       00900000
 BEGIN MODE[I]:=1;I:=I+1 END;                                           00901000
 WHILE I LEQ 63 DO                                                      00902000
 BEGIN MODE[I]:=0; I:=I+1 END;                                          00903000
 MODE[" "] := 3;                                                        00904000
 MODE[I]:=68;                                                           00905000
FILL SS[*] WITH ".","[","(","&","$","*",")",";",                        00906000
""","/",",","%","=","]",""","#","@",":","+","?","|" ;                   00907000
FOR I:=0 STEP 1 UNTIL 20 DO MODE[SS[I]]:=2 ;                            00907050
 COUNT:=0 END ; % E0 M0                                                 00907060
 BEGIN % M IS 1;                                                        00907080
 LABEL L1,L2,L3,L4,L5,L6;                                               00908000
 INTEGER I,J,IE;REAL IL1;                                               00909000
 BOOLEAN EOL,IE1;                                                       00910000
 REAL E;                                                                00911000
 REAL Y;                                                                00912000
 I:=0;                                                                  00913000
 L4: IF COUNT EQL 0 THEN                                                00914000
 BEGIN                                                                  00915000
UREAD(F,D[*]);                                                          00916000
 P:=POINTER(D);                                                         00917000
 GO TO L6;                                                              00918000
 END                                                                    00919000
 ELSE IF COUNT EQL N                                                    00920000
 THEN BEGIN                                                             00921000
 E:=MAKE(TYPELOGIC,LAST);                                               00922000
 J:=MODE[TOTCHAR].[5:6];                                                00923000
 EOL:=TRUE END                                                          00924000
 ELSE L6:BEGIN                                                          00925000
 E:=MAKE(TYPELOGIC,CHAR(P,1));                                          00926000
 J:=MODE[CHAR(P,1)];P:=P+1;                                             00927000
 EOL:=BOOLEAN(J.[6:1]);                                                 00928000
 J:=J.[5:6] END;                                                        00929000
 L5:  CASE J OF BEGIN                                                   00930000
 BEGIN % -J IS 0;                                                       00931000
   CASE I OF BEGIN                                                      00932000
 BEGIN % I IS 0;                                                        00933000
 Y:=CONS(E,NULLIST);                                                    00934000
 I:=1;                                                                  00935000
 GO TO L1 END; % E0 I0                                                  00936000
 BEGIN % I IS 1;                                                        00937000
 Y:=CONS(E,Y);                                                          00938000
 GO TO L1 END; % E0 I1;                                                 00939000
 BEGIN %I IS 2                                                          00940000
 J:=2;GO TO L5 END % E0 I2                                              00941000
 END % CASE OF I;                                                       00942000
 END; % E0 -J0                                                          00943000
 BEGIN % -J IS 1;                                                       00944000
   CASE I OF BEGIN                                                      00945000
 BEGIN % I IS 0;                                                        00946000
 IL1:=E.ADDR; I:=2;IE1:=FALSE;                                          00947000
 GO TO L1 END; % E0 I0;                                                 00948000
 BEGIN % I IS 1;                                                        00949000
 Y:=CONS(E,Y);                                                          00950000
 GO TO L1 END; % EQ I1;                                                 00951000
 BEGIN % I IS 2;                                                        00952000
IF IE1 THEN                                                             00953000
IL1:=IL1+E.ADDR/10|(IE:=IE+1) ELSE                                      00954000
 IL1:=IL1|10+E.ADDR;                                                    00954010
 GO TO L1 END % E0 I2;                                                  00954020
 END % CASES OF I;                                                      00955000
 END; % E0 -J1;                                                         00956000
 BEGIN % -J IS 2 SPECIAL;                                               00957000
    CASE I OF BEGIN                                                     00958000
 BEGIN % I IS 0;                                                        00959000
 IL:=HANGON(X,CONS(E,NULLIST));                                         00960000
 GO TO L3 END; % E0 I0;                                                 00961000
 BEGIN % I IS 1;                                                        00962000
 IL:=HANGON(X,Y);                                                       00963000
 P:=P-1;                                                                00964000
 GO TO L2 END; % E0 I1;                                                 00965000
 BEGIN % I IS 2;                                                        00966000
IF E.ADDR EQL "." THEN                                                  00967000
BEGIN IE:=0;IE1:=TRUE;GO TO L1 END;                                     00968000
IL:=AD(IL1);IE1:=FALSE;                                                 00968010
 P:=P-1; GO TO L2 END % E0 I2;                                          00968020
 END % CASES OF I;                                                      00969000
 END;% E0 -J2;                                                          00970000
 BEGIN % -J IS 3 SPACE;                                                 00971000
    CASE I OF BEGIN                                                     00972000
 BEGIN % I IS 0;                                                        00973000
 GO TO L1 END; % E0 I0;                                                 00974000
 BEGIN % I IS 1;                                                        00975000
 IL:=HANGON(X,Y);                                                       00976000
 GO TO L3 END; % E0 I1;                                                 00977000
 BEGIN % I IS 2;                                                        00978000
IL:=AD(IL1);IE1:=FALSE;                                                 00979000
 GO TO L3 END % E0 I2;                                                  00980000
 END % CASES OF I;                                                      00981000
 END; % E0 -J3;                                                         00982000
                                                                        00983000
 BEGIN % -J IS 4 IGNORE;                                                00984000
 GO TO L1 END   % E0-J4;                                                00985000
 END;% CASES OF -J;                                                     00986000
 L1: IF EOL THEN COUNT:=0                                               00987000
 ELSE COUNT:=COUNT+1;                                                   00988000
 GO TO L4;                                                              00989000
 L3: IF EOL THEN COUNT:=0                                               00990000
 ELSE COUNT:=COUNT+1;                                                   00991000
 L2: END; % E0 M1                                                       00992000
 BEGIN %  M IS 2;                                                       00993000
 IL:=MAKE(TYPELOGIC,MODE[C.ADDR]);                                      00994000
MODE[ C.ADDR]:=CM.ADDR;                                                 00995000
END % E0 M2;                                                            00996000
 END % CASES OF M;                                                      00997000
 END % OWN BLOCK;                                                       00998000
 END;% PROCEDURE BLOCK   *** END OF INLEX ***                           00999000
REAL PROCEDURE LEXFIND;                                                 01000000
BEGIN INTEGER T1,T,T2,T3;                                               01001000
DEFINE X=STACKPOSITION#,                                                01002000
P(P1)=POINTER(STACK[(P1.[18:7]),*])+P1.[11:12]#;                        01003000
LABEL LEND;                                                             01004000
CHR:=0;                                                                 01005000
REPLACE CP BY P(X) FOR 1;                                               01006000
T1:=CHR;                                                                01007000
REPLACE CP-5 BY P(X) FOR (IF T1 LSS 6 THEN T1 ELSE 6);                  01008000
T:=T3:=REF((T2:=AT(CHR MOD 127 )+1), HASH);                             01009000
WHILE T NEQ NULLIST DO                                                  01010000
IF P(X) NEQ P((CAR(T)-2000)) FOR T1 THEN                                01011000
T:=CDR(T) ELSE                                                          01012000
BEGIN LEXFIND:=CAR(T); GO TO LEND END;                                  01013000
ASGN(T2,HASH,CONS(LEXFIND:=TOKEN(X+2000),T3));                          01014000
X:=X+T1;                                                                01015000
LEND:END LEXFIND;                                                       01016000
PROCEDURE UREAD(FIL,BUF); VALUE FIL; REAL FIL; ARRAY BUF[0];            01017000
BEGIN                                                                   01018000
FILE IN DISKFIL DISK RANDOM (1,10,150,SAVE 999);                        01019000
POINTER PX;                                                             01020000
LABEL REM, L1,EOF;                                                      01021000
REAL MFID,FID,N,X;                                                      01022000
IF REF(AT6,FIL)=TOKEN(1010)THEN GO TO REM; %REMOTE DEVICE               01023000
 IF REF(AT6,FIL)=TOKEN(1011)THEN  %DISK                                 01024000
 BEGIN CHR:=0;                                                          01025000
 X:= REF(AT2,FIL)-2000;                                                 01026000
 PX:=POINTER(STACK[(X.[18:7]),*])+(X.[11:12]);                          01027000
 REPLACE CP BY PX:PX FOR 1;                                             01028000
 N:=(IF CHR GTR 7 THEN 7 ELSE (CHR-1));                                 01029000
 REPLACE CP-5 BY " " FOR 6;                                             01030000
 REPLACE CP-6 BY PX:PX FOR N;                                           01031000
 MFID:=CHR;                                                             01032000
 CHR:=0;                                                                01033000
 X:= REF(AT3,FIL)-2000;                                                 01034000
 PX:=POINTER(STACK[(X.[18:7]),*])+(X.[11:12]);                          01035000
 REPLACE CP BY PX:PX FOR 1;                                             01036000
 N:=(IF CHR GTR 7 THEN 7 ELSE (CHR-1));                                 01037000
 REPLACE CP-5 BY "  " FOR 6;                                            01038000
 REPLACE CP-6 BY PX:PX FOR N;                                           01039000
 FID:=CHR;                                                              01040000
 FILL DISKFIL WITH MFID, FID;                                           01041000
 READ(DISKFIL [REF(AT1,FIL).ADDR],10,BUF[*])[EOF];                      01042000
 WRITE(DATA,10,BUF[*]);                                                 01043000
 ASGN(AT1,FIL,REF(AT1,FIL)+1);                                          01043010
 GO TO L1 END;                                                          01044000
 EOF: PRIMERROR("URED",FIL);                                            01045000
 REM: READ(DATA,9,BUF[*]);                                              01046000
 L1: END UREAD;                                                         01047000
 PROCEDURE MEMSAVE(X,N,Y);                                              01048000
VALUE N,Y;ARRAY X[0];REAL N,Y;                                          01049000
 BEGIN INTEGER I,K;REAL M00;                                            01050000
 SAVE FILE MEMFL DISK SERIAL[20:25] (2,512,512,SAVE 999);               01051000
 FILL MEMFL WITH Y,TIME(-1);                                            01052000
 K:=LASTUSEDSPACE.[18:18]+1;                                            01053000
 MEMORY[K.[17:9],K.[8:9]]:=M00:=MEMORY[0,0];                            01054000
 MEMORY[0,0]:=N&LASTUSEDSPACE[45:22:23];                                01055000
 FOR I:=0 STEP 1 UNTIL N DO BEGIN                                       01056000
 K:=K+1; MEMORY[K.[17:9],K.[8:9]]:=X[I] END;                            01057000
 FOR I:=0 STEP 1 UNTIL K.[17:9] DO                                      01058000
 WRITE (MEMFL,512,MEMORY[I,*]);                                         01059000
  STACK[0,0]:=STACKPOSITION; I:=-1;                                     01060000
 WHILE I:=I+1 LEQ STACKPOSITION.[18:7] DO                               01061000
  WRITE (MEMFL,512,STACK[I,*]);                                         01062000
LOCK(MEMFL);                                                            01063000
  MEMORY[0,0]:=M00;END OF SAVE;                                         01064000
 PROCEDURE UNSAVE(X,N,FID);                                             01065000
VALUE FID;ARRAY X[0];REAL N,FID;                                        01066000
 BEGIN INTEGER I,K;                                                     01067000
  SAVE FILE MEMFL DISK SERIAL(1,512,512);                               01068000
 IF BOOLEAN(XX1)THEN FILL MEMFL WITH FID,TIME(-1)ELSE                   01069000
  FILL MEMFL WITH FID, XX2 & "B0005"[41:29:30];                         01070000
  READ (MEMFL,512,MEMORY[0,*]);                                         01071000
  LASTUSEDSPACE:=M[0].ADDR; N:=M[1].ADDR;                               01072000
  K:=LASTUSEDSPACE.[18:18]+N+2;                                         01073000
  FOR I:=1 STEP 1 UNTIL K.[17:9] DO                                     01074000
  READ (MEMFL,512,MEMORY[I,*]); K:=K-N;                                 01075000
   READ (MEMFL,512,STACK[0,*]);                                         01076000
   STACKPOSITION:=STACK[0,0];  I:=0;                                    01077000
   WHILE I:=I+1 LEQ STACKPOSITION.[18:7] DO                             01078000
   READ (MEMFL,512,STACK[I,*]);                                         01079000
  MEMORY[0,0]:=MEMORY[(K-1).[17:9],(K-1).[8:9]                          01080000
   ] END OF UNSAVE;                                                     01081000
   REAL PROCEDURE BNFTREE(F);                                           01082000
   REAL F;                                                              01083000
   BEGIN INTEGER I;                                                     01084000
   REAL X,Y,Y1,Z,Z1;                                                    01085000
   LABEL L1,L2,L3,L4,L5,L6,L7;                                          01086000
   REAL ARRAY SS[0:5];                                                  01087000
    PROCEDURE ERR(I);INTEGER I;                                         01088000
   BEGIN                                                                01089000
   FORMAT F1(X3,"$ ON LHS");                                            01090000
   FORMAT F2(X3,"NON-TERMINAL IS TYPE LOGIC");                          01091000
   CASE I OF BEGIN;                                                     01092000
  WRITE(DATA,F1);                                                       01093000
   WRITE(DATA,F2);                                                      01094000
   END END OF ERR;                                                      01095000
   SWITCH SW :=L5,L6,L4;                                                01096000
   FILL SS[*] WITH "=",";","$",":","@","#";                             01097000
   FOR I:= 0 STEP 1 UNTIL 5 DO BEGIN                                    01098000
   X:=LOADMODE(SS[I],2);                                                01099000
   X:=CONS(MAKE(TYPELOGIC,SS[I]),NULLIST);                              01100000
   SS[I]:=HANGON(X,X) END;                                              01101000
   X:=LOADMODE("%",68);                                                 01102000
   L6:Z:=CONS(MAKE(TYPECODE,118),NULLIST);                              01103000
   Y1:=CONS(ATOMUNDEF,NULLIST);                                         01104000
 WHILE (X:=USERS(F)) NEQ SS[0] DO BEGIN                                 01105000
  IF X EQL SS[2] THEN BEGIN ERR(1);GO TO L4 END; %$ ON LHS              01106000
  IF X.TYPE EQL TYPELOGIC THEN BEGIN ERR(2); GO TO L4 END;  % LOGIC ON L01107000
  EQLIST(Y1,(Y1:=USERL(X))) END;                                        01108000
  IF(X:=USERS(F)) EQL SS[4] AND CAR(Y1) NEQ ATOMUNDEF                   01109000
  THEN BEGIN EQLIST(Z,Y1); GO TO L5 END                                 01110000
  ELSE BEGIN EQLIST(Y1,Z); Y1:=Y:=CONS(MAKE(TYPECODE,119),NULLIST);     01111000
  GO TO L7 END;                                                         01112000
  L5:Y1:=Y:=CONS(MAKE(TYPECODE,119),NULLIST);                           01113000
  L2:X:=USERS(F);                                                       01114000
  L7:IF X EQL SS[2] THEN BEGIN                                          01115000
  ASGN(ATOMCDR,Y1,(Y1:=CONS(USERS(F),NULLIST)));                        01116000
  GO TO L2 END; % TERMINAL                                              01117000
   IF X EQL SS[4] THEN                                                  01118000
  BEGIN I:=1; GO TO L3 END; % @                                         01119000
  IF X EQL SS[5] THEN                                                   01120000
 BEGIN                                                                  01121000
 ASGN(ATOMCDR,Y1,(Y1:=CONS(USERL(X),NULLIST)));                         01122000
 ASGN(ATOMCDR,Y1,FNS(X));                                               01123000
  GO TO L7 END;                                                         01124000
  IF X EQL SS[1] THEN                                                   01125000
  BEGIN I:=2; GO TO L3 END; % SEMICOLON                                 01126000
  IF X EQL SS[3] THEN                                                   01127000
  BEGIN I:=3; GO TO L3 END; %  COLON                                    01128000
  IF X.TYPE EQL TYPELOGIC THEN BEGIN ERR(2); GO TO L4 END; % NON-TERMINA01129000
  ASGN(ATOMCDR,Y1,(Y1:=CONS(USERL(X),NULLIST)));                        01130000
  GO TO L2;                                                             01131000
  L3:ASGN(ATOMCDR,Z,CONS(CDR(Y),CDR(Z)));                               01132000
  GO TO SW[I];                                                          01133000
  L4:BNFTREE:=LABTAB                                                    01134000
  END;  % END OF BNFTREE                                                01135000
 REAL PROCEDURE DA(X);VALUE X;REAL X;                                   01136000
 BEGIN IF X.TYPE EQL TYPELOGIC THEN                                     01137000
 DA:=X.ADDR ELSE                                                        01138000
 IF X.TYPE EQL TYPEAREA                                                 01138010
 THEN DA:=0&REF(AT1,X)[46:8:9]&REF(AT2,X)[37:18:19]                     01138011
 &REF(AT3,X)[18:18:19]ELSE PRIMERROR("DA",X) END;                       01138012
 REAL PROCEDURE AD(X);VALUE X;REAL X;IF X GTR 0 AND                     01138013
  X.[38:39] LSS 524288 THEN AD:=MAKE(TYPELOGIC,X)                       01138014
 ELSE BEGIN REAL AD1;AD1:=AD:=PMAKE(TYPEAREA,MAKE(TYPELOGIC,3));        01138015
 ASGN(AT1,AD1,MAKE(TYPELOGIC,X.[46:9]));                                01138016
 ASGN(AT2,AD1,MAKE(TYPELOGIC,X.[37:19]));                               01138017
 ASGN(AT3,AD1,MAKE(TYPELOGIC,X.[18:19]))END ;                           01138018
 REAL PROCEDURE AR(X,Y,Z);VALUE X,Y,Z;REAL X,Y,Z;                       01138019
 BEGIN REAL AR1,AR2;                                                    01138020
 REAL PROCEDURE FN(I,J,K);VALUE I,J,K;REAL I,J,K;                       01138021
 BEGIN REAL F;CASE I OF BEGIN                                           01138030
 F:=J+K;F:=J-K;F:=J|K;F:=J/K;F:=J*K END; %END OF CASE                   01138035
 FN:=AD(F) END;                                                         01138040
 IF Y.TYPE EQL TYPELIST THEN                                            01138045
 BEGIN AR2:=AR1:=CONS(ATOMUNDEF,NULLIST);                               01138050
 IF Z.TYPE EQL TYPELIST THEN                                            01138055
 BEGIN WHILE Y NEQ NULLIST AND Z NEQ NULLIST DO                         01138060
 BEGIN ASGN(AT0,AR1,AR1:=CONS(FN(X,DA(CAR(Y)),DA(CAR(Z))),              01138065
 NULLIST));Y:=CDR(Y);Z:=CDR(Z) END;                                     01138070
 IF Y NEQ Z THEN PRIMERROR("AR",Y) ELSE AR:=CDR(AR2) END                01138080
 ELSE BEGIN Z:=DA(Z);                                                   01138085
 WHILE Y NEQ NULLIST DO BEGIN                                           01138090
 ASGN(AT0,AR1,AR1:=CONS(FN(X,DA(CAR(Y)),Z),NULLIST));                   01138100
 Y:=CDR(Y) END; AR:=CDR(AR2) END                                        01138105
  END ELSE IF Z.TYPE EQL TYPELIST THEN                                  01138110
 BEGIN Y:=DA(Y);AR2:=AR1:=CONS(ATOMUNDEF,NULLIST);                      01138115
 WHILE Z NEQ NULLIST DO BEGIN                                           01138120
 ASGN(AT0,AR1,AR1:=CONS(FN(X,Y,DA(CAR(Z))),NULLIST));                   01138125
 Z:=CDR(Z) END; AR:=CDR(AR2) END                                        01138130
 ELSE AR:=FN(X,DA(Y),DA(Z)) END;                                        01138140
PROCEDURE RETURN(PROCESS,VAL);VALUE PROCESS,VAL;                        01138145
 REAL PROCESS,VAL;                                                      01139000
BEGIN IF PROCESS.TYPE NEQ TYPEPROCESS THEN PRIMERROR("RTRN",            01140000
   PROCESS);                                                            01141000
ASGN(AT7,PROCESS,CONS(RC9,CONS(VAL,REF(AT7,PROCESS))));                 01142000
PROCESS:=QQ(PROCESS)END RETURN;                                         01143000
PROCEDURE RESUME(PROCESS);VALUE PROCESS; REAL PROCESS;                  01144000
BEGIN IF PROCESS.TYPE NEQ TYPEPROCESS THEN                              01145000
PRIMERROR("RSM1",PROCESS);                                              01146000
IF REF(AT2,PROCESS) NEQ ATOMSUSPENDED THEN                              01147000
PRIMERROR("RSM2",PROCESS);                                              01148000
ASGN(AT2,PROCESS,ATOMRESUMED);                                          01149000
ASGN(AT7,PROCESS,CONS(RC1,REF(AT7,PROCESS)));                           01150000
PROCESS:=QQ(PROCESS) END RESUME;                                        01151000
REAL PROCEDURE CREATE(START,ENV,INTERPRETER,PROCESS);                   01152000
VALUE START,ENV,INTERPRETER,PROCESS;                                    01153000
REAL START,ENV,INTERPRETER,PROCESS;                                     01154000
BEGIN REAL Y;                                                           01155000
Y:=PMAKE(TYPEPROCESS,LOGIC(7));                                         01156000
ASGN(AT1,Y,REF(AT1,PROCESS));                                           01157000
ASGN(AT2,Y,ATOMSUSPENDED);                                              01158000
ASGN(AT3,Y,START);                                                      01159000
ASGN(AT4,Y,ENV);                                                        01160000
ASGN(AT5,Y,INTERPRETER);                                                01161000
ASGN(AT6,Y,PROCESS);                                                    01162000
ASGN(AT7,Y,NULLIST);                                                    01163000
CREATE:=Y END CREATE;                                                   01164000
PROCEDURE DEBUG;                                                        01165000
BEGIN FORMAT F1(8U),F2(A4,I6),F3(I6,":",A4,I6),                         01166000
NOTE1("DEBUG?"),                                                        01167000
NOTE2("INVALID PROCESS OPERATION"),                                     01168000
NOTE3("INVALID TYPE ON FIRST PARAMETER"),                               01169000
NOTE4("INVALID TYPE ON SECOND PARAMETER"),                              01170000
NOTE5("INVALID TYPE ON THIRD PARAMETER"),                               01171000
NOTE7("SYSTEM SAVE AS FILE--",A6),                                      01172000
NOTE8("SYSTEM LOADED FROM FILE--",A6),                                  01173000
NOTE9("#"),                                                             01174000
NOTE10("SYSTEM LOADED FROM FILE--",A6,X1,A2),                           01175000
NOTE6("NO PREVIOUS EXECUTE");                                           01176000
FORMAT FMTLUSP("AMTSPACE=",I6,", LASTUSEDSPACE=",I6);                   01177000
REAL OP,T1,V1,T2,V2,T3,V3,I,JUNK,J;                                     01178000
  REAL ENV,PROCESS,X;                                                   01179000
 BOOLEAN APLI;REAL APLENV,AP1,AP2,AP3,AP4;                              01180000
LABEL L1,L2,L3,L4,L5,L6,LEND;                                           01180010
 MONITOR ZERO;                                                          01181000
DEFINE PP(PP1,PP2,PP3)=J:=0;WHILE TYPEARRAY[J] NEQ PP1 DO               01182000
IF J NEQ 15 THEN J:=J+1 ELSE                                            01183000
BEGIN WRITE(DATA,PP2);GO TO L2 END;                                     01184000
PP3:=MAKE(J,PP3)#,                                                      01185000
P1=BEGIN PP(T1,NOTE3,V1)END#,                                           01186000
P2=BEGIN P1;PP(T2,NOTE4,V2)END#,                                        01187000
P3=BEGIN P2;PP(T3,NOTE5,V3)END#;                                        01188000
 ZERO:=L2;                                                              01189000
L1:WRITE(DATA,NOTE1);                                                   01190000
L2:T1:=T2:=T3:="SYMB";                                                  01191000
V1:=V2:=V3:=524287;                                                     01192000
READ(DATA[STOP],F1,OP,T1,V1,T2,V2,T3,V3,JUNK);                          01193000
FOR I:=0 STEP 1 UNTIL NOOFPROCESSOPS DO                                 01194000
IF OP=PROCESSARRAY[I] THEN GO TO L3;                                    01195000
WRITE(DATA,NOTE2);GO TO L2;                                             01196000
L3:CASE I OF BEGIN                                                      01197000
GO TO LEND; % E N D                                                     01198000
BEGIN P3;ASGN(V1,V2,(V1:=V3))END; %ASGN                                 01199000
BEGIN P2; V1:=REF(V1,V2) END; %REF                                      01200000
BEGIN P1;V1:=QQ(V1);GO TO L2 END; %QQ                                   01201000
V1:=UQ; %UQ                                                             01202000
BEGIN P1;V1:=CAR(V1) END; %CAR                                          01203000
BEGIN P1;V1:=CDR(V1) END; %CDR                                          01204000
BEGIN P2;V1:=CONS(V1,V2) END; %CONS                                     01205000
BEGIN P1;V1:=NEWSYMB(V1)END; %NEWSYMB                                   01206000
BEGIN WRITE(DATA,FMTLUSP,AMTSPACE,LASTUSEDSPACE);GO TO L2 END;%AMTSP    01207000
BEGIN P2;V1:=PMAKE(V1.TYPE,V2)END; %MAKE                                01208000
BEGIN P1;PRINT(V1);WRITE(DATA,NOTE9);GO TO L2 END; %PRINT               01209000
;%BEGIN P3;V1:=LOADMODE(V1,V2,V3)END; %LDMODE                           01210000
BEGIN GCL;GO TO L2 END;%GCL                                             01211000
BEGIN P1;IF V1 NEQ ATOMUNDEF THEN %INTERP                               01212000
 RESUME(V1);INTERP;GO TO L2 END;                                        01213000
 V1:=LABTAB;                                                            01214000
  V1:=LEXTREE;                                                          01215000
 BEGIN P1;V1:=USERS(V1) END; % USERS                                    01216000
BEGIN SMEM(T1);WRITE(DATA,NOTE7,T1);GO TO L2 END;%SMEM                  01217000
BEGIN XX1:=1;LMEM(T1); %LMEM                                            01218000
 APLI:=FALSE;                                                           01219000
 WRITE(DATA,NOTE8,T1);                                                  01219010
 I:=41;T1:="LIST";V1:=REF(AT2,REF(TOKEN(2742),LABTAB)).ADDR;            01220000
 T2:="AREA";V2:=REF(TOKEN(2608),LABTAB);GO TO L3 END;                   01221000
 BEGIN P1;V1:=STATS END;% PSCAN                                         01222000
 BEGIN P1;V1:=BNFTREE(V1) END; % BNFTRE                                 01223000
 BEGIN P2;V2:=USERS(V2);ASGN(V2,LABTAB,V1)END; % INCODE                 01224000
BEGIN V1:=QU(5,0);WRITE(DATA,NOTE9);GO TO L2 END; %QDUMP                01225000
BEGIN FOR I:=T1 STEP 1 UNTIL V1 DO %DUMP                                01226000
WRITE(DATA,F3,I,TYPEARRAY[M[I].TYPE],M[I].ADDR);                        01227000
WRITE(DATA,NOTE9);GO TO L2 END;                                         01228000
BEGIN P1;PRIMERROR(T2,V1);GO TO L2 END;                                 01229000
BEGIN P1;MASGN(T2,V1) END; %MASGN                                       01230000
BEGIN P1; XX1:=V1;XX2:=T2;V1:=QU(5,1);GO TO L2 END;%QASGN               01231000
V1:=M[T1]; %M                                                           01232000
BEGIN XX2:=T1;V1:=QU(5,2)END; %Q                                        01233000
 BEGIN P1;ENV:=IF APLI THEN APLENV                                      01233010
 ELSE PMAKE(TYPECONS,0);              % EXE                             01234000
 LOADMODE("$",2);                                                       01235000
  PROCESS:= CREATE(NULLIST,ENV,TOKEN(1004),CONS(AT(262144),NULLIST));   01236000
ASGN(AT6,PROCESS,ATOMUNDEF);                                            01237000
L4:ASGN(AT2,PROCESS,ATOMSUSPENDED);                                     01238000
  ASGN(AT3,PROCESS,(X:=V1));                                            01239000
  WHILE CDR(X) NEQ NULLIST DO X:=CDR(X);                                01240000
  ASGN(AT0,X,CONS(CONS(TOKEN(117),NULLIST),NULLIST));                   01241000
  RESUME (PROCESS);                                                     01242000
  INTERP;                                                               01243000
 ENV:=REF(AT4,PROCESS:=XX1);                                            01244000
ASGN(AT7,PROCESS,NULLIST);                                              01244010
 V1:=REF(TOKEN(1000),ENV);                                              01244020
 IF APLI THEN BEGIN APLPNT(V1); APLENV:=ENV;                            01244025
 I:=36;T1:="LIST";T2:="AREA";V1:=REF(TOKEN(5003),LABTAB);               01244030
 V2:=REF(AT2,V1).ADDR;V1:=REF(AT1,V1).ADDR;                             01245000
 GO TO L3 END ;                                                         01247000
  END;                                                                  01248000
  IF PROCESS.TYPE EQL TYPEPROCESS THEN GO TO L4 %CEXE                   01249000
 ELSE BEGIN WRITE(DATA,NOTE6);GO TO L2 END;                             01250000
 BEGIN XX1:=0;XX2:="       ";                                           01251000
 LMEM(T1);WRITE(DATA,NOTE10,T1);GO TO L2 END;                           01252000
BEGIN ARRAY X[0:9]; %READ                                               01253000
  P1; UREAD(V1,X);                                                      01254000
  WRITE(DATA,9,X[*]); GO TO L2 END;                                     01255000
  BEGIN POINTER SP,XP;   % DSTACK                                       01256000
  REAL N;  ARRAY X[0:8];                                                01257000
 XP:=POINTER(X); SP:=POINTER(STACK[0,*]);                               01258000
  CHR:=N:=8;                                                            01259000
WHILE N LSS STACKPOSITION DO                                            01260000
   BEGIN REPLACE XP BY " " FOR 72;                                      01261000
  REPLACE CP BY SP+N FOR 1;                                             01262000
  REPLACE XP BY N+2000 FOR 4 DIGITS;                                    01263000
  REPLACE XP+6 BY SP+N+1 FOR CHR-1;                                     01264000
  N:=N+CHR;                                                             01265000
  WRITE(DATA,9,X[*]) END;                                               01266000
  WRITE(DATA,NOTE9);GO TO L2 END DSTACK;                                01267000
BEGIN P1;X:=V1; % MODELD                                                01268000
L6:V1:=ATOMUNDEF;T1:=3;T2:=T3:=0;                                       01269000
READ(DATA,F1,V1,T1,T2,T3,V2,V3,OP,JUNK);                                01270000
IF V1=ATOMUNDEF THEN GO TO L2;                                          01271000
V1:=AT(V1+1);T1:=T1&T2[14:3:4]&T3[18:3:4];                              01272000
ASGN(V1,X,AT(T1));GO TO L6 END;                                         01273000
BEGIN P2;ENV:=PMAKE(TYPECONS,0); %PARSE                                 01274000
 ASGN(TOKEN(1018),ENV,NULLIST);                                         01275000
 ASGN(TOKEN(1019),ENV,AT0);                                             01276000
 ASGN(TOKEN(1006),ENV,CONS(USERS(V2),CONS(V2,NULLIST)));                01277000
 PROCESS:=CREATE(NULLIST,ENV,TOKEN(1005),CONS(AT(262144),NULLIST));     01278000
 ASGN(AT6,PROCESS,ATOMUNDEF);                                           01279000
 ASGN(AT3,PROCESS,CONS(V1,CONS(TOKEN(117),NULLIST)));                   01280000
 ASGN(AT7,PROCESS,NULLIST);                                             01281000
 RESUME(PROCESS); INTERP;                                               01281010
 IF APLI THEN                                                           01281020
 BEGIN T1:="PRCS";V1:=XX1.ADDR;                                         01281030
 I:=37;GO TO L3 END;                                                    01282000
 V1:=XX1 END PARSE;                                                     01283000
 BEGIN P1;WHILE PRIORITY.ADDR GTR 0 DO JUNK:=UQ;%TRANS                  01284000
 ASGN(AT3,V1,CONS(CONS(TOKEN(143),NULLIST),CONS(                        01284001
  CONS(TOKEN(117),NULLIST),NULLIST)));                                  01284050
  ASGN(AT7,V1,NULLIST);ASGN(AT5,V1,TOKEN(1017));                        01284060
  RESUME(V1);                                                           01285000
 INTERP;                                                                01286000
 V1:=REF(AT1,REF(AT4,XX1));                                             01286010
 IF APLI THEN                                                           01286020
 BEGIN T1:="LIST";V1:=V1.ADDR;                                          01286030
 I:=30;GO TO L3 END END TRANS ;                                         01287000
BEGIN TRACE:=NOT TRACE; GO TO L2 END;%TRACE                             01288000
BEGIN PRINT(HASH);GO TO L2 END; %HASH                                   01288010
 BEGIN INTERP;V1:=XX1;END;%RSTART                                       01288020
 BEGIN APLI:=TRUE;I:=36;                                                01288030
 ASGN(TOKEN(5003),LABTAB,CONS(MAKE(TYPELIST,V1),                        01288035
  CONS(MAKE(TYPEAREA,V2),NULLIST)));                                    01288040
  APLENV:=PMAKE(TYPECONS,0); GO TO L3 END; %APL                         01288050
  BEGIN XX1:=1;LMEM(T1);APLI:=FALSE;                                    01288060
  WRITE(DATA,NOTE8,T1);GO TO L2 END; % LSTRT                            01289000
 END CASE STATEMENT;                                                    01290000
 L5:WRITE(DATA,F2,TYPEARRAY[V1.TYPE],V1.ADDR);                          01291000
 GO TO L2;                                                              01292000
 LEND:END DEBUG;                                                        01293000
 PROCEDURE DOTRACE(PROCESS);VALUE PROCESS;REAL PROCESS;                 01294000
 BEGIN PRINT(PROCESS);                                                  01295000
 PRINT(REF(AT3,PROCESS));                                               01296000
 PRINT(REF(AT4,PROCESS));                                               01297000
 PRINT(REF(AT7,PROCESS))END DOTRACE;                                    01298000
 PROCEDURE MASGN(A,V);VALUE A,V;REAL A,V;                               01299000
 BEGIN IF BOOLEAN(A) THEN                                               01300000
 MEMORY[A.[18:9],A.[9:9]].[22:23]:=V ELSE                               01301000
 MEMORY[A.[18:9],A.[9:9]].[45:23]:=V END MASGN;                         01302000
 PROCEDURE PRINT(X);VALUE X;REAL X;                                     01303000
 BEGIN REAL I;                                                          01304000
 LABEL L1,L2;                                                           01305000
 FORMAT F1(":",A4,I6),                                                  01306000
 F2(X3,A4,I6,"=",A4,I6),                                                01307000
 F3(X3,I4,"=",A4,I6),                                                   01308000
 F4(X3,I4,"=NIL");                                                      01309000
 WRITE(DATA,F1,TYPEARRAY[X.TYPE],X.ADDR);                               01310000
 CASE X.TYPE OF BEGIN                                                   01311000
 ; %GARBAGE                                                             01312000
 L1:BEGIN X:=M[X]; %CONS                                                01313000
 WHILE X NEQ NULLIST DO                                                 01314000
 BEGIN WRITE(DATA,F2,TYPEARRAY[CAR(X).TYPE],CAR(X).ADDR,                01315000
 TYPEARRAY[CAR((X:=CDR(X))).TYPE],CAR(X).ADDR);                         01316000
 X:=CDR(X)END END;                                                      01317000
 BEGIN I:=1; WHILE X NEQ NULLIST DO %LIST                               01318000
 BEGIN WRITE(DATA,F3,I,TYPEARRAY[CAR(X).TYPE],CAR(X).ADDR);             01319000
 I:=I+1;X:=CDR(X) END;                                                  01320000
 WRITE(DATA,F4)END;                                                     01321000
 L2:FOR I:=0 STEP 1 UNTIL M[X].ADDR DO %AREA                            01322000
 WRITE(DATA,F3,I,TYPEARRAY[M[X-I].TYPE],M[X-I].ADDR);                   01323000
 ;%FIELD                                                                01324000
 ;%SYMBOL                                                               01325000
 ;%LOGIC                                                                01326000
 ;%LINK                                                                 01327000
 GO TO L2; %PROCESS                                                     01328000
 GO TO L2; %MONITOR                                                     01329000
 GO TO L2;%GENERAL                                                      01330000
 END CASE STATEMENT;                                                    01331000
 END PRINT;                                                             01331010
  PROCEDURE APLPNT(X);VALUE X;REAL X;                                   01331015
  BEGIN REAL I;FORMAT F1(X2,R12.5),F2(A4,I6);                           01331020
  I:=0;                                                                 01331025
  IF X.TYPE EQL TYPELIST THEN BEGIN                                     01331030
  WHILE X NEQ NULLIST DO BEGIN                                          01331035
  IF NBR(CAR(X)) THEN                                                   01331040
  BEGIN IF I MOD 4 EQL 3 THEN WRITE(DATA,F1,DA(CAR(X)))                 01331045
  ELSE WRITE(DATA[STOP],F1,DA(CAR(X)));                                 01331050
  I:=I+1;X:=CDR(X) END ELSE BEGIN                                       01331060
  WRITE(DATA,F2,TYPEARRAY[X.TYPE],X.ADDR);                              01331065
  X:=NULLIST END END;WRITE (DATA) END                                   01331070
  ELSE IF NBR(X) THEN WRITE(DATA,F1,DA(X))                              01331075
  ELSE WRITE(DATA,F2,TYPEARRAY[X.TYPE],X.ADDR) END;                     01332000
PROCEDURE SYSM;                                                         01333000
BEGIN FORMAT F1(5U),                                                    01334000
NOTE1("SYSTEM?"),                                                       01335000
NOTE2("INVALID OPERATION"),                                             01336000
 NOTE3("CANDE?");                                                       01337000
ARRAY X[0:4];INTEGER I;                                                 01338000
DEFINE LA=X[0],X[1],X[2],X[3],X[4]#;                                    01339000
LABEL L1,L2,L3,LEND;                                                    01340000
LASTUSEDSPACE:=0;CURROW:= 0 ;                                           01341000
NEXTTOKEN:=TOKEN(2000);                                                 01342000
TRACE:=FALSE;                                                           01343000
CP:=POINTER(JUNKARRAY)+7;                                               01344000
HASH:=PMAKE(TYPEAREA,AT(127));                                          01345000
FOR I:=AT1 STEP 1 UNTIL AT(127)DO ASGN(I,HASH,NULLIST);                 01346000
  STACKPOSITION:=8;                                                     01347000
 MASGN (0,LINKTONIL);                                                   01348000
  LABTAB:=PMAKE(TYPECONS,0);                                            01349000
   INQ(HASH);                                                           01350000
   INTLX;                                                               01358000
  DEBUG;                                                                01361000
  LEND:END SYSM;                                                        01362000
   REAL PROCEDURE USERS(F);                                             01363000
   REAL F;                                                              01364000
  BEGIN  REAL X,X1;                                                     01365000
   USERS:=INLEX(F)                                                      01366000
   END OF USERS;                                                        01367000
   REAL PROCEDURE USERL(X);                                             01368000
   REAL X;                                                              01369000
   BEGIN                                                                01370000
  IF (USERL:=REF(X,LABTAB)) EQL ATOMUNDEF THEN                          01371000
  ASGN(X,LABTAB,(USERL:=CONS(ATOMUNDEF,NULLIST)));                      01372000
   END OF USERL;                                                        01373000
   REAL PROCEDURE PSCAN(IJ,X,F);REAL X,F;INTEGER IJ;                    01374000
   BEGIN OWN REAL ARRAY SS[0:11];                                       01375000
   REAL Y;                                                              01376000
   PROCEDURE ERR;                                                       01377000
   BEGIN                                                                01378000
   FORMAT F1(X3,"ARG MISSING");                                         01379000
   WRITE(DATA,F1) END;                                                  01380000
   REAL PROCEDURE QT(X);VALUE X;REAL X;                                 01381000
  IF REF(X,LABTAB) NEQ ATOMUNDEF THEN BEGIN                             01382000
   IF (X:=USERL(X)) EQL TOKEN(1007) THEN                                01383000
   QT:=CONS(TOKEN(122),CONS(QT(USERS(F)),NULLIST))                      01384000
  ELSE QT:=X END ELSE QT:=X;                                            01385000
        REAL PROCEDURE FSCAN(X,Y,F);VALUE X; REAL X,Y,F;                01386000
BEGIN REAL FSTK,F1,FN;                                                  01387000
LABEL L1,L2,L3,L4,L5,L6,LEND;                                           01388000
FSTK:=NULLIST;                                                          01389000
 L1: IF Y NEQ SS[0] THEN BEGIN FSCAN:=X; GO TO LEND END;                01390000
F1:=FN:=CONS(X,NULLIST);                                                01391000
L2: IF (X:=USERS(F)) EQL SS[4] THEN                                     01392000
BEGIN X:=ATOMUNDEF; GO TO L4 END; %DUMMY ARG                            01393000
IF X EQL SS[1] THEN                                                     01394000
BEGIN X:=ATOMUNDEF; GO TO L5 END; % DUMMY ARG LIST                      01395000
 L6:X:=QT(X);                                                           01396000
 IF (Y:=USERS(F)) EQL SS[4] THEN                                        01397000
L4: BEGIN ASGN (ATOMCDR,FN,(FN:=CONS(X,NULLIST)));                      01398000
GO TO L2 END; % COMMA                                                   01399000
IF Y EQL SS[1] THEN                                                     01400000
    BEGIN ASGN (ATOMCDR,FN,CONS(X,NULLIST));                            01401000
 L5:X:=FN:=F1;                                                          01402000
IF CAR(FSTK) EQL ATOMUNDEF THEN                                         01403000
 BEGIN Y:=USERS(F);GO TO L1 END;                                        01404000
; F1:=CAR(FSTK); FSTK:=CDR(FSTK);                                       01405000
FN:=CAR(FSTK);                                                          01406000
FSTK:=CDR(FSTK);                                                        01407000
GO TO L6 END; % RPAREN                                                  01408000
IF X EQL QT(SS[8]) THEN                                                 01409000
BEGIN X:=USERL(Y); GO TO L6 END; % LABEL                                01410000
FSTK:=CONS(FN,FSTK);                                                    01411000
FSTK:=CONS(F1,FSTK);                                                    01412000
GO TO L1;                                                               01413000
LEND: END OF FSCAN;                                                     01414000
REAL PROCEDURE SSCAN(F);                                                01415000
REAL F;                                                                 01416000
BEGIN REAL X,Y,Z,S1,S2;                                                 01417000
LABEL L1,L2,L3,L4,L5,LEND,L6;                                           01418000
SSCAN:=Z:=CONS(ATOMUNDEF,NULLIST);                                      01419000
GO TO L1;                                                               01420000
L3:Z:=CONS(ATOMUNDEF,NULLIST);                                          01421000
L2:L1: IF (X:=USERS(F)) EQL SS[10] OR X EQL SS[1] THEN                  01422000
L6:BEGIN                                                                01423000
GO TO LEND END % END                                                    01424000
ELSE L5: IF X EQL SS[5] THEN                                            01425000
GO TO L1; % SEMICOLON                                                   01426000
 IF (Y:=USERS(F)) EQL SS[6] THEN                                        01427000
BEGIN EQLIST(USERL(X),Z);                                               01428000
GO TO L1 END % COLON                                                    01429000
ELSE ASGN(ATOMCAR,Z,FSCAN(QT(X),Y,F));                                  01430000
 IF ATOM(CAR(Z)) THEN BEGIN ERR;GO TO L2 END;                           01431000
IF (X:=Y) EQL SS[5] THEN                                                01432000
BEGIN ASGN(ATOMCDR,Z,(Z:=CONS(ATOMUNDEF,NULLIST)));                     01433000
GO TO L2 END % NO SUCCESSOR GIVEN                                       01434000
 ;IF X EQL SS[10] THEN GO TO L6                                         01435000
; IF X EQL SS[1] THEN GO TO LEND                                        01436000
 ELSE ASGN(ATOMCDR,Z,CONS(ATOMUNDEF,NULLIST)); EQLIST(REF(AT0,Z),USERL( 01437000
 X));                                                                   01438000
 GO TO L3; % SUCCESSOR GIVEN                                            01439000
 LEND: END OF SSCAN;                                                    01440000
 PROCEDURE LDSS; BEGIN INTEGER I,J,K,KK; REAL STK;                      01441000
 FILL SS[*] WITH "E","N","D","R","O","U","T","I","N","E";               01442000
 K:=2;KK:=0; FOR J:=0 STEP 1 UNTIL 1 DO                                 01443000
 BEGIN STK:=NULLIST;                                                    01444000
 FOR I:=KK STEP 1 UNTIL K DO                                            01445000
 STK:=CONS(MAKE(TYPELOGIC,SS[I]),STK);                                  01446000
  SS[J+10]:=HANGON(STK,STK);                                            01447000
 K:=9;KK:=3 END;                                                        01448000
 FILL SS[*] WITH "(",")","[","]",",",";",":","*","#";                   01449000
 FOR I:=0 STEP 1 UNTIL 8 DO                                             01450000
 BEGIN K:=LOADMODE(SS[I],2);                                            01451000
 STK:=CONS(MAKE(TYPELOGIC,SS[I]),NULLIST);                              01452000
  SS[I]:=HANGON(STK,STK) END;                                           01453000
 K:=LOADMODE("%",68)                                                    01454000
 END OF LDSS;                                                           01455000
  LDSS;                                                                 01456000
  CASE IJ OF BEGIN                                                      01457000
  PSCAN:=SSCAN(F);                                                      01458000
 IF (Y:=QT(USERS(F))) EQL SS[0]                                         01459000
  THEN BEGIN PSCAN:=SSCAN(F);                                           01460000
 X:= USERS(F) END ELSE                                                  01461000
  BEGIN X:= USERS(F); PSCAN:=CONS(FSCAN(Y,X,F),NULLIST)                 01462000
 END END END OF PSCAN;                                                  01463000
AT0:=LOGIC(0);                                                          01464000
AT1:=LOGIC(1);                                                          01465000
AT2:=LOGIC(2);                                                          01466000
AT3:=LOGIC(3);                                                          01467000
AT4:=LOGIC(4);                                                          01468000
AT5:=LOGIC(5);                                                          01469000
AT6:=LOGIC(6);                                                          01470000
AT7:=LOGIC(7);                                                          01471000
TKNO:=MAKE(TYPETOKEN,0);                                                01472000
RC1:=MAKE(TYPECODE,1);                                                  01473000
RC9:=MAKE(TYPECODE,9);                                                  01474000
ATOMUNDEF:=MAKE(TYPESYMB+1,0)-1;                                        01475000
LINKTONIL:=MAKE(TYPELINK+1,0)-1;                                        01476000
NULLIST:=MAKE(TYPELIST+1,0)-1;                                          01477000
FILL SYSMARRAY[*] WITH "END","DEBUG";                                   01478000
FILL PROCESSARRAY[*] WITH "END","ASGN","REF","QQ","UQ","CAR",           01479000
"CDR","CONS","NEWSYM","AMTSP","MAKE","PRINT",                           01480000
 "LDMODE","GCL","INTERP","LABEL","NODES",                               01481000
 "USERS","SMEM","LMEM","PSCAN","BNFTRE","INCODE","QDUMP",               01482000
 "DUMP","PERROR","MAASGN","QASGN","M","Q","EXE","CEXE","LOAD",          01483000
 "READ","DSTACK","MODELD","PARSE","TRANS","TRACE","HASH","RSTART",      01483010
 "APL","PARLD";                                                         01484000
FILL TYPEARRAY[*] WITH "GRBG","CONS","LIST","AREA",                     01485000
 "BITS","SYMB","LGIC","LINK",                                           01486000
 "PRCS","MNTR","GNRL","CODE",                                           01487000
 "TP12","TP13","TP14","TP15";                                           01488000
 SYSM;                                                                  01489000
 END. END PROGRAM                                                       01490000
? END                                                                   