// XPAL2 LAST MODIFIED ON FRIDAY, 12 JUNE 1970 // AT 5:37:29.37 BY R MABEE >>> FILENAME 'XPAL2' // // *********** // * * // * XPAL2 * // * * // *********** // >>> GET 'XPALHD' >>> EJECT // XPAL2A LET LOADL() BE $(1 C := C+1 A := LVOFNAME(C*(0), E) TEST A=NILRV THEN $( A := LIST(3, LVALUE, A) ERROKDBG() $) OR NEXT11() $)1 AND LOADR() BE $(1 C := C+1 A := LVOFNAME(C*(0), E) TEST A=NILRV THEN ERRDBG() OR $( A := H3*(A) NEXT11() $)1 AND LOADJ() BE $( A := LIST(5, JJ, H4*(S), H5*(S), H6*(S) ) NEXT11() $) AND LOADE() BE $( A := E NEXT11() $) AND LOADS() BE $( LET V = VEC 200 LET I = 0 UNPACKSTRING(C*(1), V) I := V*(0) A := NILSRV WHILE I GR 0 DO $( A := LIST(4, STRING, A, V*(I)) I:=I-1 $) C := C+1 NEXT11() $) AND LOADN() BE $( A := LIST(3, C*(1), C*(2) ) C := C+2 NEXT11() $) AND RESTOREE1() BE $( E := S*(STACKP-2) STACKP := STACKP-1 S*(STACKP-1) := S*(STACKP) C := C + 1 $) AND R_TRUE() BE $( A := TRUERV NEXT11() $) AND R_FALSE() BE $( A := FALSERV NEXT11() $) AND LOADGUESS() BE $( A := GUESSRV NEXTLV11() $) AND NIL() BE $( A := NILRV NEXT11() $) AND DUMMY() BE $( A := DUMMYRV NEXT11() $) AND FORMCLOSURE() BE $( A := LIST(4, CLOSURE, E, C*(1) ) C := C+1 NEXT11() $) AND FORMLVALUE() BE $( A := LIST(3, LVALUE, S*(STACKP-1)) S*(STACKP-1) := A C := C+1 $) AND NEXTLV11() BE $( A := LIST(3, LVALUE, A) NEXT11() $) AND NEXT11() BE $( S*(STACKP) := A STACKP := STACKP+1 C := C + 1 $) AND FORMRVALUE() BE $( S*(STACKP-1) := H3*(S*(STACKP-1)) C := C+1 $) AND TUPLE() BE $( LET N = C*(1) A := NODE(N+3) A*(0), A*(1), A*(2) := N+3, M_TUPLE, N FOR I = 3 TO N+2 DO STACKP, A*(I) := STACKP-1, S*(STACKP) C := C+1 NEXT11() $) AND MEMBERS() BE $( LET N = C*(1) SPLIT1() B := H3*(A) FOR I = -2 TO N-3 DO $( S*(STACKP) := B*(N-I) STACKP := STACKP+1 $) C := C+2 $) AND R_NOT() BE $(1 SPLIT1() IF H2*(A)=M_FALSE DO $( A := TRUERV NEXT11() RETURN $) TEST H2*(A)=M_TRUE THEN $( A := FALSERV NEXT11() $) OR $( ERROR1('NOT', A, 0) ERRDBG() $)1 AND R_LOGAND() BE $(1 SPLIT2() TEST TESTBOOLS2() THEN $( A := H2*(A)=M_TRUE -* B, FALSERV NEXT11() $) OR $( ERROR1("&", A, B) A := FALSERV ERRDBG() $)1 AND R_LOGOR() BE $(1 SPLIT2() TEST TESTBOOLS2() THEN $( A := H2*(A)=M_FALSE -* B, TRUERV NEXT11() $) OR $( ERROR1('OR', A, B) A := FALSERV ERRDBG() $)1 AND AUG() BE $(1 SPLIT2() UNLESS H2*(A)=M_TUPLE DO $( ERROR1('AUG', A, B) A := NILRV ERRDBG() RETURN $) $( LET N = H3*(A) LET T = NODE(N+4) T*(0), T*(1), T*(2), T*(N+3) := N+4, M_TUPLE, N+1, B FOR I = 3 TO N+2 DO T*(I) := A*(I) A := T NEXT11() $)1 AND RESULT() BE $(1 A := LVOFNAME(NAMERES, E) IF A=NILRV DO $( A := LIST(3, LVALUE, A) GOTO RESERR $) A := H3*(A) UNLESS H2*(A)=JJ DO RESERR: $( ERROR('INCORRECT USE OF RES', 0, 0, 0) ERROKDBG() RETURN $) H4*(S), H5*(S), H6*(S) := H3*(A), H4*(A), H5*(A) R_RETURN() $)1 >>> EJECT // XPAL2B LET MULT() BE $(1 LET T = A SPLIT2() IF TESTNUMBS2()=NUMBER DO $( A := LIST(3, NUMBER, H3*(A)*H3*(B) ) NEXT11() RETURN $) IF TESTNUMBS2()=REAL DO $( A := LIST(3, REAL, FMULT(H3*(A), H3*(B)) ) IF FLOTERR DO $( WRITES('*NOVERFLOW:') FLOTERR := FALSE GOTO FMUERR $) NEXT11() RETURN $) A := LIST(3, NUMBER, 0) FMUERR: ERROR1("**", T, B) ERRDBG() $)1 AND DIV() BE $(1 LET T = A SPLIT2() IF TESTNUMBS2()=NUMBER DO $( IF H3*(B)=0 GOTO DERR A := LIST(3, NUMBER, H3*(A)/H3*(B) ) NEXT11() RETURN $) IF TESTNUMBS2()=REAL DO $( A := LIST(3, REAL, FDIV(H3*(A), H3*(B)) ) IF FLOTERR DO $( UNLESS FEQ(H3*(B), 0) DO WRITES('*NOVERFLOW:') FLOTERR := FALSE GOTO DERR $) NEXT11() RETURN $) DERR: A := LIST(3, NUMBER, 0) ERROR1("/", T, B) ERRDBG() $)1 AND PLUS() BE $(1 LET T = A SPLIT2() IF TESTNUMBS2()=NUMBER DO $( A := LIST(3, NUMBER, H3*(A)+H3*(B) ) NEXT11() RETURN $) IF TESTNUMBS2()=REAL DO $( A := LIST(3, REAL, FADD(H3*(A), H3*(B)) ) IF FLOTERR DO $( WRITES('*NOVERFLOW:') FLOTERR := FALSE GOTO FPERR $) NEXT11() RETURN $) A := LIST(3, NUMBER, 0) FPERR: ERROR1("+", T, B) ERRDBG() $)1 AND MINUS() BE $(1 LET T = A SPLIT2() IF TESTNUMBS2()=NUMBER DO $( A := LIST(3, NUMBER, H3*(A)-H3*(B) ) NEXT11() RETURN $) IF TESTNUMBS2()=REAL DO $( A := LIST(3, REAL, FSUB(H3*(A), H3*(B)) ) IF FLOTERR DO $( WRITES('*NOVERFLOW:') FLOTERR := FALSE GOTO FMERR $) NEXT11() RETURN $) A := LIST(3, NUMBER, 0) FMERR: ERROR1("-", T, B) ERRDBG() $)1 AND POWER() BE $(1 LET T = A SPLIT2() UNLESS H2*(B)=NUMBER GOTO PWERR IF H2*(A)=NUMBER DO $( LET BASE, EXP, R = H3*(A), H3*(B), 1 TEST EXP LE O THEN $( IF BASE=0 GOTO PWERR R := ABS BASE = 1 -> ((-EXP & 1)=0 -> 1, BASE), 0 $) OR UNTIL EXP=0 DO $( UNLESS (EXP & 1)=0 DO R := R * BASE BASE := BASE * BASE EXP := EXP RSHIFT 1 $) A := LIST(3, NUMBER, R) NEXT11() RETURN $) IF H2*(A)=REAL DO $( A := LIST(3, REAL, FPOWER(H3*(A), H3*(B)) ) IF FLOTERR DO $( WRITES('*NOVERFLOW:') FLOTERR := FALSE GOTO PWERR $) NEXT11() RETURN $) PWERR: A := LIST(3, NUMBER, 0) ERROR1('****', T, B) ERRDBG() $)1 AND POS() BE $(1 SPLIT1() TEST H2*(A)=NUMBER LOGOR H2*(A)=REAL THEN $( A := LIST(3, H2*(A), H3*(A) ) NEXT11() $) OR $( ERROR1("+", A, 0) A := LIST(3, NUMBER, 0) ERRDBG() $)1 AND NEG() BE $(1 LET T=A SPLIT1() IF H2*(A)=NUMBER DO $( A := LIST(3, NUMBER, -H3*(A) ) NEXT11() RETURN $) IF H2*(A)=REAL DO $( A := LIST(3, REAL, FUMIN(H3*(A)) ) ) NEXT11() RETURN $) A := LIST(3, NUMBER, 0) ERROR1("-", T, 0) ERRDBG() $)1 AND R_EQ() BE $(1 LET T=A SPLIT2() A := EQUAL(A, B) -* TRUERV, FALSERV TEST ERRFLAG THEN $( ERROR1('EQ', T, B) ERRFLAG := FALSE ERRDBG() $) OR NEXT11() $)1 AND R_NE() BE $(1 LET T=A SPLIT2() A := EQUAL(A, B) -* FALSERV, TRUERV TEST ERRFLAG THEN $( ERROR1('NE', T, B) A := FALSERV ERRFLAG := FALSE ERRDBG() $) OR NEXT11() $)1 AND R_LS() BE $( SPLIT2() IF TESTNUMBS2()=NUMBER DO $( A := H3*(A) LS H3*(B) -* TRUERV, FALSERV NEXT11() RETURN $) IF TESTNUMBS2()=REAL DO $( A := FLS(H3*(A), H3*(B)) -* TRUERV, FALSERV NEXT11() RETURN $) ERROR1('LS', A, B) A := FALSERV ERRDBG() $) AND R_LE() BE $( SPLIT2() IF TESTNUMBS2()=NUMBER DO $( A := H3*(A) LE H3*(B) -* TRUERV, FALSERV NEXT11() RETURN $) IF TESTNUMBS2()=REAL DO $( A := FLE(H3*(A), H3*(B)) -* TRUERV, FALSERV NEXT11() RETURN $) ERROR1('LE', A, B) A := FALSERV ERRDBG() $) AND R_GE() BE $( SPLIT2() IF TESTNUMBS2()=NUMBER DO $( A := H3*(A) GE H3*(B) -* TRUERV, FALSERV NEXT11() RETURN $) IF TESTNUMBS2()=REAL DO $( A := FGE(H3*(A), H3*(B)) -* TRUERV, FALSERV NEXT11() RETURN $) ERROR1('GE', A, B) A := FALSERV ERRDBG() $) AND R_GR() BE $( SPLIT2() IF TESTNUMBS2()=NUMBER DO $( A := H3*(A) GR H3*(B) -* TRUERV, FALSERV NEXT11() RETURN $) IF TESTNUMBS2()=REAL DO $( A := FGR(H3*(A), H3*(B)) -* TRUERV, FALSERV NEXT11() RETURN $) ERROR1('GR', A, B) A := FALSERV ERRDBG() $) >>> EJECT // XPAL2C LET JUMP() BE $( C := C*(1) $) AND JUMPF() BE $(1 SPLIT1() IF H2*(A) = M_FALSE DO $( C := C*(1) RETURN $) IF H2*(A) = M_TRUE DO $( C := C+2 RETURN $) ERROR('NOT A TRUTHVALUE: ', A, 0, 0) C := C*(1) - 1 EDBG() $)1 AND EDBG() BE $(1 RESTARTC := C+1 C := LV RESTART A := LIST(3, LVALUE, NILRV) COMDBG() $)1 AND ERRDBG() BE $( RESTARTC := C+1 C := LV RVRESTART A := LIST(3, LVALUE, A) COMDBG() $) AND ERRLVDBG() BE $( A := LIST(3, LVALUE, A) ERROKDBG() $) AND ERROKDBG() BE $( RESTARTC := C+1 C := LV OKRESTART COMDBG() $) AND COMDBG() BE $(1 H3*(S) := STACKP B := NODE(8) H1*(B), H2*(B) := 8, STACK H4*(B), H5*(B) := RESTARTC, S H6*(B), H7*(B) := E, A S := B B := H3*(ERRORLV) STACKP := 7 ERRCT := ERRCT + 1 IF ERRCT GE MAXERR DO C := LV NORESTART UNLESS H2*(B) = CLOSURE LOGOR H2*(B)=BASICFN DO $( UNLESS ERRCT GE MAXERR DO WRITES('EXECUTION RESUMED*N*N') RETURN $) TEST H2*(B)=CLOSURE THEN $( S*(STACKP) := ERRORLV STACKP := STACKP+1 A := B OLDC, C := C, H4*(B) $) OR $( C := C-3 NIL() FORMLVALUE() (H3*(B))() $) RESTARTC := 0 $)1 AND OKRESTART() BE $( A := S*(STACKP-1) RESTART() S*(STACKP) := A STACKP := STACKP+1 $) AND RVRESTART() BE $( A := S*(STACKP-1) RESTART() S*(STACKP) := H3*(A) STACKP := STACKP+1 $) AND NORESTART() BE $( WRITES('*NMAXIMUM NUMBER OF RUN-TIME ERRORS REACHED*N') TERMINATE1() $) AND APPLY() BE $(1 SPLIT1() A := H3*(A) SWITCHON H2*(A) INTO $( CASE CLOSURE: STACKP := STACKP+1 OLDC, C := C+1, H4*(A) RETURN CASE M_TUPLE: STACKP, B := STACKP-1, S*(STACKP) B := H3*(B) UNLESS H2*(B)=NUMBER DO $( ERROR(0, A, ' APPLIED TO ', B) UNLESS H3*(A)=0 DO A := H4*(A) ERRLVDBG() RETURN $) $( LET N = H3*(B) TEST 1 LE N LE H3*(A) THEN $( A := A*(N+2) NEXT11() $) OR $( ERROR(0, A, ' APPLIED TO ', B) UNLESS H3*(A)=0 DO TEST N GE 1 THEN A := A*(H3*(A)+2) OR A := H4*(A) ERRLVDBG() $) RETURN $) CASE BASICFN: (H3*(A))() RETURN DEFAULT: ERROR('ATTEMPT TO APPLY ',A,' TO ',S*(STACKP-1)) EDBG() $)1 AND SAVE() BE $( B := NODE(C*(1)+6) H1*(B), H2*(B) := C*(1)+6, STACK H3*(S) := STACKP H4*(B), H5*(B) := OLDC, S H6*(B), H7*(B) := E, S*(STACKP-2) E := H3*(A) STACKP, S := 7, B C := C+2 $) AND R_RETURN() BE $( A := S*(STACKP-1) RESTART() STACKP := STACKP-1 S*(STACKP-1) := A $) AND TESTEMPTY() BE $(1 SPLIT1() TEST H3*(A)=NILRV THEN C := C+1 OR $( ERROR1('FUNCTION OF NO ARGUMENTS', A, 0) EDBG() $)1 AND LOSE1() BE $( SPLIT1() C := C+1 $) AND R_GOTO() BE $(1 SPLIT1() UNLESS H2*(A)=LABEL DO $( ERROR('CANNOT GO TO ', A, 0, 0) A := DUMMYRV ERRDBG() RETURN $) C, E := H4*(A), H6*(A) S := NODE(H3*(A)) STACKP := 6 H1*(S), H2*(S) := H3*(A), STACK A := H5*(A) H4*(S), H5*(S), H6*(S) := H4*(A), H5*(A), H6*(A) $)1 AND UPDATE() BE $(1 LET N = C*(1) SPLIT2() TEST N = 1 THEN H3*(B) := A OR $( UNLESS H2*(A) = M_TUPLE & H3*(A) = N DO $( ERROR('CONFORMALITY ERROR IN ASSIGNMENT',0,0,0) WRITES('THE VALUE OF THE RHS IS: ') PRINTA(A, TUPLEDEPTH) WRITECH(OUTPUT, '*N') WRITES('THE NUMBER OF VARIABLES ON THE LHS IS: ') WRITEN(N) WRITECH(OUTPUT, '*N') C := C + 1 A := DUMMYRV ERRDBG() RETURN $) B := H3*(B) $( LET V = VEC 100 FOR I=3 TO N+2 DO V*(I) := H3*(A*(I)) FOR I=3 TO N+2 DO H3*(B*(I)) := V*(I) $) $) A := DUMMYRV C := C+1 NEXT11() $)1 >>> EJECT // XPAL2D MANIFEST $( LFIELD=$8177777; NDIST=24 $) LET ERROR(MS1, DB1, MS2, DB2) BE $( WRITES('*N*NRUN TIME ERROR: ') UNLESS MS1 = 0 DO WRITES(MS1) UNLESS DB1 = D DO PRINTA(DB1, TUPLEDEPTH) UNLESS MS2 = 0 DO WRITES(MS2) UNLESS DB2 = 0 DO PRINTA(DB2, TUPLEDEPTH) WRITECH(OUTPUT, '*N') $) AND ERROR1(OP, ARG1, ARG2) BE $( WRITES('*N*NRUN TIME ERROR: ') WRITES(OP) WRITES(' APPLIED TO ') PRINTA(ARG1, TUPLEDEPTH) UNLESS ARG2=0 DO $( WRITES(' AND ') PRINTA(ARG2, TUPLEDEPTH) $) WRITECH(OUTPUT,'*N') $) AND PRINTB(X) BE $(1 IF X=0 RETURN SWITCHON H2*(X) INTO $( CASE NUMBER: WRITEN(H3*(X)); RETURN CASE REAL:$( LET V = VEC 3 FTOS(H3*(X), V) WRITES(V) RETURN $) CASE STRING: WRITECH(OUTPUT, H4*(X)) PRINTB(H3*(X)) CASE NILS: RETURN CASE M_TUPLE:$( LET N = H3*(X) IF N = 0 DO $( WRITES('NIL') RETURN $) IF LV X GR STACKWARNING DO $( WRITES('( ETC )') RETURN $) WRITECH(OUTPUT, '(') FOR I = 3 TO N+1 DO $( PRINTB(X*(I)) WRITES(', ') $) PRINTB(X*(N+2)) WRITECH(OUTPUT, ')') RETURN $) CASE M_TRUE: WRITES('TRUE'); RETURN CASE M_FALSE: WRITES('FALSE'); RETURN CASE LVALUE: PRINTB(H3*(X)); RETURN CASE CLOSURE: CASE BASICFN: WRITES('$FUNCTION$'); RETURN CASE LABEL: WRITES('$LABEL$'); RETURN CASE JJ: WRITES('$ENVIRONMENT$'); RETURN CASE M_DUMMY: WRITES('$DUMMY$'); RETURN DEFAULT: WRITES('$$$') $)1 AND PRINTA(X, N) BE $(1 IF X=0 RETURN IF N LE 0 DO $( WRITES(' ETC '); RETURN $) SWITCHON H2*(X) INTO $( CASE STRING: CASE NILS: WRITECH(OUTPUT, '*'') PRINTB(X) WRITECH(OUTPUT, '*'') RETURN CASE M_TUPLE:$( LET M = H3*(X) IF M=0 DO $( WRITES(' NIL ') RETURN $) WRITECH(OUTPUT, '(') FOR I = 3 TO M+1 DO $( PRINTA(X*(I), N-1) WRITECH(OUTPUT, ',') $) PRINTA(X*(M+2), N-1) WRITECH(OUTPUT, ')') RETURN $) CASE LVALUE: PRINTA(H3*(X), N) RETURN DEFAULT: WRITECH(OUTPUT, ' ') PRINTB(X) WRITECH(OUTPUT, ' ') RETURN $)1 AND EQUAL(A,B) = VALOF $( LET BTAG = H2*(B) SWITCHON BTAG INTO $(1 CASE M_TRUE: CASE M_FALSE: CASE NUMBER: CASE REAL: CASE STRING: CASE NILS: SWITCHON H2*(A) INTO $( CASE M_TRUE: IF BTAG=M_TRUE RESULTIS TRUE RESULTIS FALSE CASE M_FALSE: IF BTAG=M_FALSE RESULTIS TRUE RESULTIS FALSE CASE NUMBER: IF BTAG=NUMBER & H3*(A)=H3*(B) DO RESULTIS TRUE RESULTIS FALSE CASE REAL: IF BTAG=REAL & H3*(A)=H3*(B) DO RESULTIS TRUE RESULTIS FALSE CASE STRING: IF BTAG=STRING & H4*(A)=H4*(B) DO RESULTIS EQUAL(H3*(A),H3*(B)) RESULTIS FALSE CASE NILS: IF BTAG=NILS RESULTIS TRUE RESULTIS FALSE $)1 ERRFLAG := TRUE RESULTIS FALSE $) AND TESTNUMBS2() = H2*(A)=NUMBER & H2*(B)=NUMBER -* NUMBER, H2*(A)=REAL & H2*(B)=REAL -* REAL, M_FALSE AND TESTBOOLS2() = ( H2*(A)=M_TRUE LOGOR H2*(A)=M_FALSE ) LOGAND ( H2*(B)=M_TRUE LOGOR H2*(B)=M_FALSE ) AND LVOFNAME(N, P) = VALOF $( H3*(LOOKUPNO) := H3*(LOOKUPNO) + 1 UNTIL P = 0 DO $( IF H4*(P) = N RESULTIS H5*(P) P := H3*(P) $) UNLESS N=NAMERES DO ERROR('UNDECLARED NAME ', 0, N, 0) RESULTIS NILRV $) AND NAMEOFLV(L, P) = VALOF $( UNTIL P=0 DO $( IF H5*(P)=L RESULTIS H4*(P) P := H3*(P) $) RESULTIS 0 $) AND RESTART() BE $( C, B, E := H4*(S), H5*(S), H6*(S) S := NODE(H1*(B) & LFIELD) STACKP := H3*(B) FOR I = 0 TO STACKP-1 DO S*(I) := B*(I) $) AND TERMINATE() BE $( LISTT := LISTT + 6 // CREATE EXTRA SPACE FOR FINAL DIAGNOSE DIAGNOSE() TERMINATE1() $) AND TERMINATE1() BE $( CONTROL(OUTPUT, 2) WRITEN(H3*(LOOKUPNO)) WRITES(' LOOKUPS *T') WRITEN(COUNT) WRITES(' CYCLES*N') GCMARK := GCMARK RSHIFT 16 WRITEN(GCMARK) WRITES(' GARBAGE COLLECTIONS*N') LONGJUMP(XPEND, XPENDLEVEL) $) AND LASTFN1(P) = VALOF $(1 LET NAME, ARG = 0, 0 LET Y, N = 0, 0 IF H6*(Q)=0 RESULTIS FALSE $( Y := H5*(Q) N := H3*(Y) TEST N>6 THEN $(2 NAME := Y*(N-1) UNLESS NAME=NILRV DO $( NAME == NAMEOFLV(NAME, H6*(Q)) IF NAME=O DO NAME := 'ANONYMOUS' ARG := Y*(N-2) $)2 OR NAME := NILRV Q := Y IF P=0 RESULTIS TRUE IF H6*(Q)=0 RESULTIS FALSE $) REPEATWHILE NAME=NILRV WRITES('AT THIS TIME, THE FUNCTION BEING EXECUTED IS: ') WRITES(NAME) WRITES('*NTHE ARGUMENT TO WHICH IT IS BEING APPLIED IS: ') PRINTA(ARG, TUPLEDEPTH) WRITECH(OUTPUT, '*N') RESULTIS TRUE $)1 AND WRITENODE(N) BE $( WRITEN(N RSHIFT NDIST) WRITECH(OUTPUT, '*T') WRITES(H4*(A)) WRITECH(OUTPUT, '*T') PRINTA(H5*(A), TUPLEDEPTH) WRITECH(OUTPUT, '*N') $) >>> EJECT // XPAL2E MANIFEST $( LFIELD=$8177777; MFIELD=$877600000; GC1=$8200000 $) LET NODE(N) = VALOF $( IF LISTP+N GE LISTL DO NEXTAREA(N) LISTP := LISTP+N RESULTIS LISTP-N $) AND NEXTAREA(N) BE $(1 LET B = FALSE IF GCDBG DO WRITES('*N*NNEXTAREA RECLAIMATION PHASE*N') $( UNLESS LISTP=LISTL DO H1*(LISTP) := LISTL - LISTP IF LISTL=LISTT DO $( IF B DO $( WRITES('*N*NRUN TIME SPACE EXHAUSTED*N') TERMINATE() $) MARK() IF GCDBG DO WRITES('*NMARKLIST PREFORMED*N') LISTL, B := LISTV, TRUE $) H1*(LISTT) := 0 WHILE ( H1*(LISTL) & MFIELD ) = GCMARK DO LISTL := LISTL + ( H1*(LISTL) & LFIELD ) LISTP := LISTL H1*(LISTT) := GCMARK UNTIL ( H1*(LISTL) & MFIELD ) = GCMARK DO LISTL := LISTL + ( H1*(LISTL) & LFIELD ) IF GCDBG DO $( WRITES('*S*S'); WRITEN(LISTL-LISTP) $) $) REPEATWHILE LISTP+N GE LISTL IF GCDBG DO WRITES('*S*N') RETURN $)1 AND MARKLIST(X) BE $(1 L: IF LV X GR STACKWARNING DO $( WRITES('*N*NMAXIMUM NODE DEPTH EXCEEDED*N') TERMINATE() $) IF X=0 RETURN IF ( H1*(X) & MFIELD ) = GCMARK RETURN H1*(X) := H1*(X) & LFIELD LOGOR GCMARK SWITCHON H2*(X) INTO $( DEFAULT: WRITES('*N*NMARKLIST ERROR*N') WRITEX(X); WRITES(' H1*(X)='); WRITEX(H1*(X)) WRITES(' NODE TYPE IS '); WRITEN(H2*(X)) WRITES('*S*N') RETURN CASE M_TUPLE: FOR I = 1 TO H3*(X) DO MARKLIST(X*(I+2)) RETURN CASE ENV: MARKLIST(H5*(X)) X := (H3*(X)) GOTO L CASE STACK: FOR I = 4 TO H3*(X)-1 DO MARKLIST(X*(I)) RETURN CASE JJ: MARKLIST(H5*(X)) X := (H4*(X)) GOTO L CASE LABEL: MARKLIST(H6*(X)) X := (H5*(X)) GOTO L CASE LVALUE:CASE CLOSURE:CASE STRING: X := (H3*(X)) GOTO L CASE NUMBER:CASE M_TRUE:CASE M_FALSE:CASE M_NIL: CASE NILS:CASE BASICFN:CASE GUESS: CASE M_DUMMY:CASE REAL: RETURN $)1 AND MARK() BE $( GCMARK := GCMARK + GC1 NSET := FALSE IF ( GCMARK & MFIELD ) = 0 DO $( WRITES('*N*NMAXIMUM NUMBER OF ') WRITES('GARBAGE COLLECTIONS PERFORMED*N') TERMINATE() $) MARKLIST(E) H3*(S) := STACKP MARKLIST(S) MARKLIST(A) MARKLIST(B) RETURN $) AND LIST(N, A, B, C, D, E, F) = VALOF $(1 F := LV N $( LET P = NODE(N) SWITCHON N INTO $( CASE 7: P*(6) := F CASE 6: P*(5) := E CASE 5: P*(4) := D CASE 4: P*(3) := C CASE 3: P*(2) := B CASE 2: P*(1) := A CASE 1: P*(0) := N $) F := 0 RESULTIS P $)1 >>> EJECT // XPAL2F MANIFEST $( LFIELD=$8177777 $) LET SPLIT1() BE $( STACKP, A := STACKP-1, S*(STACKP) $) AND SPLIT2() BE $( STACKP, A, B := STACKP-2, S*(STACKP+1), S*(STACKP) $) AND DECLNAME() BE $( E := LIST(5, ENV, E, C*(1), S*(STACKP-1)) STACKP := STACKP-1 C := C + 2 $) AND DECLNAMES() BE $( LET N = C*(1) SPLIT1(); A := H3*(A) UNLESS H2*(A)=M_TUPLE & H3*(A)=N DO $( ERROR('CONFORMALITY ERROR IN DEFINITION', 0, 0, 0) NAMEERROR(N,1) RETURN $) FOR I = 2 TO N+1 DO R_NAME(I,1) C := C+2+N $) AND INITNAME() BE $( STACKP := STACKP-1 R_NAME(1,7) C := C+2 $) AND INITNAMES() BE $( LET N = C*(1) SPLIT1(); A := H3*(A) UNLESS H2*(A)=M_TUPLE & H3*(A)=N DO $( ERROR('CONFORMALITY ERROR IN RECURSIVE DEFINITION',0,0,0) NAMEERROR(N,4) RETURN $) FOR I = 2 TO N+1 DO R_NAME(I,4) C := C+2+N $) AND R_NAME(I,P) BE $(1 TEST P LE 3 THEN E := LIST(5, ENV, E, C*(I), P=1 -* A*(I+1), LIST(3, LVALUE, (P=2 -* A, NILRV)) ) OR $( B := LVOFNAME(C*(I), E) IF B=NILRV DO B := LIST(3, LVALUE, B) SWITCHON P INTO $( CASE 4: H3*(B) := H3*(A*(I+1)); RETURN CASE 5: H3*(B) := A; RETURN CASE 6: H3*(B) := NILRV; RETURN CASE 7: H3*(B) := H3*(S*(STACKP)); RETURN $)1 AND NAMEERROR(N,P) BE $(1 WRITES('THE NAMES BEING DECLARED ARE:*N') FOR I = 2 TO N+1 DO $( WRITES(C*(I)) WRITECH(OUTPUT, '*N') $) WRITES('THE VALUE(S) PROVIDED ARE: ') PRINTA(A, TUPLEDEPTH) WRTTECH(OUTPUT, '*N') TEST H2*(A)=M_TUPLE THEN $( LET M=N IF M>H3*(A) DO M := H3*(A) FOR I = 2 TO M+1 DO R_NAME(I,P) FOR I = M+2 TO N+1 DO R_NAME(I,P+2) $) OR $( R_NAME(2,P+1) FOR I = 3 TO N+1 DO R_NAME(I,P+2) $) C := C+N+1 EDBG() $)1 AND DECLLABEL() BE $( A := LIST(6, STACK, 6, H4*(S), H5*(S), H6*(S)) A := LIST(6, LABEL* H1*(S)&LFIELD, C*(2), A, E) A := LIST(3, LVALUE, A) E := LIST(5, ENV, E, C*(1), A) C := C + 3 $) AND SETLABES() BE $( A := E FOR I = 1 TO C*(1) DO $( H6*(H3*(H5*(A))) := E A := H3*(A) $) C := C + 2 $) AND BLOCKLINK() BE $( S*(STACKP) := NILRV STACKP := STACKP+1 OLDC := C*(1) A := LIST(3, LVALUE, E) C := C+2 $) AND RESLINK() BE $( S*(STACKP) := LIST(3, LVALUE, NILRV) STACKP := STACKP+1 BLOCKLINK() $) AND SETUP() BE $( OLDC := LV R_FINISH S := LIST(5, STACK, 4, DUMMYRV, 0) A := LIST(3, LVALUE, E) E := 0 STACKP := 5 SAVE() SPLIT1() $)