// XPAL1 LAST MODIFIED ON FRIDAY, 12 JUNE 1970 // AT 5:37:27.45 BY R MABEE >>> FILENAME 'XPAL1' // // *********** // * * // * XPAL1 * // * * // *********** // >>> GET 'XPALHD' >>> EJECT // XPAL1A LET LOAD() BE $(1 LET CH, A, P = 0, 0, CODEFILE LET V = VEC BYTEMAX REFP := 0 GOTO L M: CODEP*(0), CODEP := A, CODEP+1 L: CH, P := P*(0), P+1 SWITCHON CH INTO $( DEFAULT: UNLESS CH=ENDOFSTREAMCH DO $( WRITES('ILLEGAL SYMBOL IN LOADER ') WRITEN(CH) WRITECH(OUTPUT, '*N*) GOTO L $) SETPARAMS() RETURN CASE NAME: CASE STRINGCONST: $( LET L, N, S = NAMECHAIN, 0,0 CH, P := P*(O), P+1 V*(O) := CH FOR I = 1 TO CH DO V*(I), P := P*(0), P+1 N := CH/BYTESPERWORD + 1 S := STRP - N PACKSTRING(V, S) UNTIL L=0 DO $(2 LET V = L*(1) IF S*(0)=V*(0) DO $(3 IF N=1 BREAK IF S*(1)=V*(1) DO $( IF N=2 BREAK IF S*(2)=V*(2) DO $( IF N=3 BREAK IF S*(3)=V*(3) DO $( IF N=4 BREAK IF S*(4)=V*(4) DO $( IF N=5 BREAK $)3 L := L*(0) $)2 UNLESS L=0 DO $( A := L*(1) GOTO M $) STRP := S - 2 IF STRPREFT DO $( WRITES('*N*N*N*TTABLE OVERFLOW IN XPAL *C *LOADER. NO EXECUTION.*N') LONGJUMP(XPEND, XPENDLEVEL) $) A := 0 GOTO M CASE EQU: A, CH, P := P*(0), P*(1), P+2 PARV*(A) := CH GOTO L CASE M_SETLABES:A := SETLABES; GOTO M CASE M_RESTOREE1:A := RESTOREE1; GOTO M CASE M_FORMRVALUE:A := FORMRVALUE; GOTO M CASE M_FORMLVALUE:A := FORMLVALUE; GOTO M CASE M_TUPLE: A := TUPLE; GOTO M CASE M_MEMBERS: A := MEMBERS; GOTO M CASE M_LOADGUESS:A := LOADGUESS; GOTO M CASE M_TRUE: A := R_TRUE; GOTO M CASE M_FALSE: A := R_FALSE; GOTO M CASE M_LOSE1: A := LOSE1; GOTO M CASE M_MULT: A := MULT; GOTO M CASE M_DIV: A := DIV; GOTO M CASE M_PLUS: A := PLUS; GOTO M CASE M_MINUS: A := MINUS; GOTO M CASE M_POS: A := POS; GOTO M CASE M_NEG: A := NEG; GOTO M CASE M_EQ: A := R_EQ; GOTO M CASE M_LS: A := R_LS; GOTO M CASE M_GR: A := R_GR; GOTO M CASE M_LE: A := R_LE; GOTO M CASE M_NE: A := R_NE; GOTO M CASE M_GE: A := R_GE; GOTO M CASE M_LOGAND: A := R_LOGAND; GOTO M CASE M_LOGOR: A := R_LOGOR; GOTO M CASE M_SAVE: A := SAVE; GOTO M CASE M_APPLY: A := APPLY; GOTO M CASE M_NOT: A := R_NOT; GOTO M CASE JJ: A := LOADJ; GOTO M CASE M_UPDATE: A := UPDATE; GOTO M CASE M_RES: A := RESULT; GOTO M CASE M_GOTO: A := R_GOTO; GOTO M CASE M_LOADR: A := LOADR; GOTO M CASE M_LOADL: A := LOADL; GOTO M CASE M_LOADS: A := LOADS; GOTO M CASE M_LOADN: A := LOADN; GOTO M CASE M_LOADE: A := LOADE; GOTO M CASE M_TESTEMPTY:A := TESTEMPTY; GOTO M CASE M_DECLNAME:A := DECLNAME; GOTO M CASE M_DECLNAMES:A := DECLNAMES; GOTO M CASE M_INITNAME:A := INITNAME; GOTO M CASE M_INITNAMES:A := INITNAMES; GOTO M CASE M_FORMCLOSURE:A := FORMCLOSURE; GOTO M CASE M_JUMPF: A := JUMPF; GOTO M CASE M_JUMP: A := JUMP; GOTO M CASE M_DECLLABEL:A := DECLLABEL; GOTO M CASE M_RETURN: A := R_RETURN; GOTO M CASE M_BLOCKLINK:A := BLOCKLINK; GOTO M CASE M_RESLINK: A := RESLINK; GOTO M CASE M_POWER: A := POWER; GOTO M CASE M_NIL: A := NIL; GOTO M CASE M_DUMMY: A := DUMMY; GOTO M CASE M_AUG: A := AUG; GOTO M CASE M_SETUP: SETPARAMS() A := SETUP; GOTO M $)1 AND SETPARAMS() BE $(1 LET I = 0 UNTIL I=REFP DO $( RV REFV*(I+1) := PARV*(REFV*(I)) I := I + 2 $) REFP := 0 $)1 >>> EJECT // XPAL1B LET MAPLIBLIST(F) BE $( F('PRINT', PRINT) F('PAGE', USERPAGE) F('STEM', STEM) F('STERN', STERN) F('CONC', CONC) F|'ATOM', ATOM) F('NULL', NULL) F('ORDER', LENGTH) F('ISTRUTHVALUE', ISTRUTHVALUE) F|'ISINTEGER', ISNUMBER) F|'ISREAL', ISREAL) F('ISSTRING', ISSTRING) F('ISFUNCTION', ISFUNCTION) F('ISLABEL', ISLABEL) F('ISTUPLE', ISTUPLE) F('ISDUMMY', ISDUMMY) F('ISENVIROMENT', ISENVIROMENT) F('FINISH', R_FINISH) F('SHARE', SHARE) F('STOI', STON) F('CTOI', CTON) F('ITOC', ITOC) f('RTOI', RTON) F('ITOR', NTOR) F('READCH', RDCHAR) F('DIAGNOSE', DIAGNOSE) F('LASTFN', LASTFN) F('TABLE', R_TABLE) F('LOOKUPINE', LOOKUPINE) F('SAVEENV', SAVEENV) $) AND LIBNAME(X, Y) BE $( STRP := STRP - 2 IF STRP