// PAL3 LAST MODIFIED ON FRIDAY, 12 JUNE 1970 // AT 5:37:22.18 BY R MABEE >>> FILENAME 'PAL3' // // ************ // * * // * PAL3 * // * * // ************ // >>> GET 'PALHD' >>> EJECT // PAL3A LET TRANS(X, MODE) BE $(1 IF TIME_EXCEEDED DO TIMEOVFL() IF X=0 DO $( WRITES( '*N*N*T******EXPRESSION MISSING*N' ) COMPERROR := TRUE OUTOP(M_NIL) UPSSP(1) RETURN $) $( LET OP = H1*(X) SWITCHON OP INTO $( CASE M_LET: $( LET L = NEXTPARAM() LET N = NEXTPARAM() TRANSRHS(H2*(X)) OUTOP(M_BLOCKLINK); OUTP(L) IF SSP=MSP DO MSP := SSP+1 TRANSSCOPE(X, N, MODE) COMPLAB(L) RETURN $) CASE DEF: TRANSRHS(H2*(X)) C_DECLNAMES(H2*(X)) TRANSLABELS(H3*(X)) TRANS(H3*(X)= VAL) RETURN CASE M_MULT:CASE M_DIV:CASE M_PLUS:CASE M_MINUS:CASE M_POWER: CASE M_EQ:CASE M_LS:CASE M_GR: CASE M_GE:CASE M_LE:CASE M_NE: CASE M_LOGAND:CASE M_LOGOR: TRANS(H3*(X), VAL) TRANS(H2*(X), VAL) OUTOP(OP) SSP := SSP-1 IF MODE=REF DO OUTOP(M_FORMLVALUE) RETURN CASE M_AUG: TRANS(H3*(X), REF) TRANS(H2*(X), VAL) OUTOP(M_AUG) SSP := SSP-1 IF MODE=REF DO OUTOP(M_FORMLVALUE) RETURN CASE M_APPLY: TRANS(H3*(X), REF) TRANS(H2*(X), REF) OUTOP(M_APPLY) SSP := SSP-1 IF MODE=VAL DO OUTOP(M_FORMRVALUE) RETURN CASE M_POS:CASE M_NEG:CASE M_NOT: TRANS(H2*(X), VAL) OUTOP(OP) IF MODE=REF DO OUTOP(M_FORMLVALUE) RETURN CASE NOSHARE: TRANS(H2*(X), VAL) IF MODE=REF DO OUTOP(M_FORMLVALUE) RETURN CASE COMMA: $( LET R(X) BE $( TRANS(X, REF) $) MAPB(R, X) OUTOP(M_TUPLE); OUTN(C_LENGTH(X)) SSP := SSP - C_LENGTH(X) + 1 IF MODE=REF DO OUTOP(M_FORMLVALUE) RETURN $) CASE LAMBDA: $( LET L, M = NEXTPARAM(), NEXTPARAM() LET U = NEXTPARAM() OUTOP(M_FORMCLOSURE); OUTP(L) UPSSP(1) OUTOP(M_JUMP); OUTP(M) //FOR THE JUMP ROUND THE BODY COMPLAB(L) TRANSSCOPE(X, N, REF) COMPLAB(M) IF MODE=REF DO OUTOP(M_FORMLVALUE) RETURN $) CASE COLON: IF H4*(X)=0 DO $( WRITES('*N*N*T******LABEL ') WRITES(H3*(H2*(X))) WRITES(' IMPROPERLY USED*N') COMPERROR := TRUE $) COMPLAB(H4*(X)) TRANS(H3*(X), MODE) RETURN CASE SEQ: TRANS(H2*(X), VAL) OUTOP(M_LOSE1) SSP := SSP-1 TRANS(H3*(X), NODE) RETURN CASE M_VALOF: $( LET L = NEXTPARAM() LET N = NEXTPARAM() OUTOP(M_RESLINK); OUTP(L) SSP := SSP+1 IF SSP GE MSP DO MSP := SSP+1 $( LET A, B = SSP, MSP SSP, MSP := 0, 1 OUTOP(M_SAVE); OUTP(N) OUTOP(M_TESTEMPTY) OUTOP(JJ) OUTOP(M_FORMLVALUE) OUTOP(M_DECLNAME) OUTNAME(LIST3(NAME, 0, '**RES**')) TRANSLABELS(H2*(X)) TRANS(H2*(X), REF) OUTOP(M_RETURN) UNLESS SSP=1 DO WRITES('*N*N*T****** SSP ERROR*N') OUTPSOP(N, EQU, MSP) SSP, MSP := A, B $) COMPLAB(L) IF NODE=VAL DO OUTOP(M_FORMRVALUE) RETURN $) CASE M_RES: TRANS(H2*(X), REF) OUTOP(M_RES) RETURN CASE M_GOTO: TRANS(H2*(X), VAL) OUTOP(M_GOTO) RETURN CASE COND: $( LET L, M = NEXTPARAM(), NEXTPARAM() TRANS(H2*(X), VAL) OUTOP(M_JUMPF); OUTP(L) SSP := SSP-1 TRANS(H3*(X), NODE) OUTOP(M_JUMP); OUTP(M) COMPLAB(L) SSP := SSP-1 TRANS(H4*(X)* NODE) COMPLAB(M) RETURN $) CASE M_WHILE: $( LET L, M = NEXTPARAM(), NEXTPARAM() COMPLAB(M) TRANS(H2*(X), VAL) OUTOP(M_JUMPF); OUTP(L) SSP := SSP - 1 TRANS(H3*(X), VAL) OUTOP(M_LOSE1) OUTOP(M_JUMP); OUTP(M) COMPLAB(L) OUTOP(M_DUMMY) IF MODE=REF DO OUTOP(M_FORMLVALUE) RETURN $) CASE ASS: TRANS(H2*(X), REF) TRANS(H3*(X), VAL) OUTOP(M_UPDATE); OUTN(C_LENGTH(H2*(X))) SSP := SSP-1 IF MODE=REF DO OUTOP(M_FORMLVALUE) RETURN CASE PAREN: TRANSLABELS(H2*(X)) TRANS(H2*(X), MODE) RETURN CASE M_NIL: CASE M_DUMMY: CASE M_TRUE: CASE M_FALSE: OUTOP(OP) UPSSP(1) IF MODE=REF DO OUTOP(M_FORMLVALUE) RETURN CASE NAME: OUTOP( MODE=VAL -* M_LOADR, M_LOADL); OUTNAME(X) UPSSP(1) RETURN CASE NUMBER: OUTOP(M_LOADN); OUTNUMBER(X) UPSSP(1) IF MODE=REF DO OUTOP(M_FORMLVALUE) RETURN CASE STRINGCONST: OUTOP(M_LOADS); OUTSTRING(X) UPSSP(1) IF MODE=REF DO OUTOP(M_FORMLVALUE) RETURN $)1 AND FINDLABELS(X) = VALOF $(1 IF X=0 RESULTIS 0 SWITCHON H1*(X) INTO $( DEFAULT: RESULTIS 0 CASE COLON: $( LET L = NEXTPARAM() H4*(X) := L OUTOP(M_DECLLABEL); OUTNAME(H2*(X)); OUTP(L) RESULTIS 1 + FINDLABELS(H3*(X)) $) CASE PAREN: RESULTIS FINDLABELS(H2*(X)) CASE COND: RESULTIS FINDLABELS(H3*(X))+FINDLABELS(H4*(X)) CASE M_WHILE: RESULTIS FINDLABELS(H3*(X)) CASE SEQ: RESULTIS FINDLABELS(H2*(X))+FINDLABELS(H3*(X)) $)1 AND TRANSLABELS(X) BE $( LET N = FINDLABELS(X) IF N NE 0 DO $( OUTOP(M_SETLABES); OUTN(N) $) $) >>> EJECT // PAL3B LET TRANSRHS(X) BE $(1 IF X=0 RETURN SWITCHON H1*(X) INTO $( CASE M_AND: MAPB(TRANSRHS, X) OUTOP(M_TUPLE); OUTN(C_LENGTH(X)) SSP := SSP - C_LENGTH(X) + 1 OUTOP(M_FORMLVALUE) RETURN CASE VALDEF: TRANS(H3*(X), REF) RETURN CASE REC: OUTOP(M_LOADE) UPSSP(1) DECLGUESSES(H2*(X)) TRANSRHS(H2*(X)) C_INITNAMES(H2*(X)) LOADDEFINEE(H2*(X)) OUTOP(M_RESTOREE1) SSP := SSP-1 RETURN CASE WITHIN: $( LET L = NEXTPARAM() LET N = NEXTPARAM() TRANSRHS(H2*(X)) OUTOP(M_BLOCKLINK); OUTP(L) IF SSP=MSP DO MSP := SSP+1 $( LET A, B = SSP, MSP SSP, MSP := 1, 1 OUTOP(M_SAVE); OUTP(N) C_DECLNAMES(H2*(X)) TRANSRHS(H3*(X)) OUTOP(M_RETURN) UNLESS SSP=1 DO WRITES('*N*N*T****** SSP ERROR*N') OUTPSOP(N, EQU, MSP) SSP, MSP := A, B $) COMPLAB(L) $)1 AND C_DECLNAMES(X) BE $(1 IF X=O RETURN SWITCHON H1*(X) INTO $( CASE NAME: OUTOP(M_DECLNAME); OUTNAME(X) SSP := SSP-1 RETURN CASE COMMA: OUTOP(M_DECLNAMES); OUTN(C_LENGTH(X)) SSP := SSP-1 MAPF(OUTNAME, X) RETURN CASE M_AND: OUTOP(M_MEMBERS); OUTN(C_LENGTH(X)) UPSSP(C_LENGTH(X)-1) MAPF(C_DECLNAMES, X) RETURN CASE REC: CASE VALDEF: C_DECLNAMES(H2*(X)) RETURN CASE WITHIN: C_DECLNAMES(H3*(X)) RETURN CASE MPT: OUTOP(M_TESTEMPTY) SSP := SSP-1 RETURN $)1 AND LOADDEFINEE(X) BE $(1 IF X=0 RETURN SWITCHON H1*(X) INTO $( CASE NAME: OUTOP(M_LOADR); OUTNAME(X) UPSSP(1) OUTOP(M_FORMLVALUE) RETURN CASE M_AND: CASE COMMA: MAPB(LOADDEFINEE, X) OUTOP(M_TUPLE); OUTN(C_LENGTH(X)) SSP := SSP - C_LENGTH(X) + 1 OUTOP(M_FORMLVALUE) RETURN CASE REC: CASE VALDEF: LOADDEFINEE(H2*(X)) RETURN CASE WITHIN: LOADDEFINEE(H3*(X)) RETURN $)1 AND DECLGUESSES(X) BE $(1 IF X=0 RETURN SWITCHON H1*(X) INTO $( CASE NAME: OUTOP(M_LOADGUESS) IF SSP=MSP DO MSP := SSP+1 OUTOP(M_DECLNAME); OUTNAME(N) RETURN CASE M_AND: CASE COMMA: MAPF(DECLGUESSES, X) RETURN CASE REC: CASE VALDEF: DECLGUESSES(H2*(X)) RETURN CASE WITHIN: DECLGUESSES(H3*(X)) RETURN $)1 AND C_INITNAMES(X) BE $(1 IF X=0 RETURN SWITCHON H1*(X) INTO $( CASE NAME: OUTOP(M_INITNAME); OUTNAME(X) SSP := SSP-1 RETURN CASE M_AND: OUTOP(M_MEMBERS); OUTN(C_LENGTH(X)) UPSSP(C_LENGTH(X)-1) MAPF(C_INITNAMES, X) RETURN CASE COMMA: OUTOP(M_INITNAMES); OUTN(C_LENGTH(X)) SSP := SSP-1 MAPF(OUTNAME, X) RETURN CASE REC: CASE VALDEF: C_INITNAMES(H2*(X)) RETURN CASE WITHIN: C_INITNAMES(H3*(X)) RETURN $)1 AND TRANSSCOPE(X, A, MODE) BE $( LET A,B = SSP, MSP SSP, MSP := 1,1 OUTOP(M_SAVE); OUTP(N) C_DECLNAMES(H2*(X)) TRANSLABELS(H3*(X)) TRANS(H3*(X), MODE) OUTOP(M_RETURN) UNLESS SSP=1 DO WRITES('*N*N*T****** SSP ERROR*N') OUTPSOP(N, EQU, MSP) SSP, MSP := A, B $) >>> EJECT // PAL3C LET MAPF(R, X) BE $( LET J = H2*(X) FOR I = 1 TO J DO R(X*(I + 1)) $) AND MAPB(R, X) BE $( LET J = H2*(X) FOR I = 1 TO J DO R(X*(J - I + 2)) $) AND C_LENGTH(X) = H1*(X)=M_AND LOGOR H1*(X)=COMMA -* H2*(X), 1 AND NEXTPARAM() = VALOF $( PARAMNUMBER := PARAMNUMBER + 1 RESULTIS PARAMNUMBER $) AND UPSSP(X) BE $( SSP := SSP + X IF SSP GR MSP DO MSP := SSP $) >>> EJECT // PALBD LET COMPLAB(N) BE $( OUT2(LAB, N) UNLESS LISTING RETURN WRITES('*N*NL') WRITEN(N) $) AND OUTOP(OP) BE $(1 OUT1(OP) UNLESS LISTING RETURN $( LET S = VALOF $(1 SWITCHON OP INTO $( DEFAULT: RESULTIS 'ERROR' CASE M_RESTOREE1: RESULTIS 'RESTOREE1' CASE M_FORMRVALUE: RESULTIS 'FORMRVALUE' CASE M_FORMLVALUE: RESULTIS 'FORMLVALUE' CASE M_TUPLE: RESULTIS 'TUPLE' CASE M_MEMBERS: RESULTIS 'MEMBERS' CASE M_LOADGUESS: RESULTIS 'LOADGUESS' CASE M_TRUE: RESULTIS 'TRUE' CASE M_FALSE: RESULTIS 'FALSE' CASE M_NIL: RESULTIS 'NIL' CASE M_DUMMY: RESULTIS 'DUMMY' CASE JJ: RESULTIS 'LOADJ' CASE M_LOSE1: RESULTIS 'LOSE1' CASE M_MULT: RESULTIS 'MULT' CASE M_DIV: RESULTIS 'DIV' CASE M_POWER: RESULTIS 'POWER' CASE M_PLUS: RESULTIS 'PLUS' CASE M_MINUS: RESULTIS 'MINUS' CASE M_POS: RESULTIS 'POS' CASE M_NEG: RESULTIS 'NEG' CASE M_EQ: RESULTIS 'EQ' CASE M_LS: RESULTIS 'LS' CASE M_GR: RESULTIS 'GR' CASE M_LE: RESULTIS 'LE' CASE M_GE: RESULTIS 'GE' CASE M_NE: RESULTIS 'NE' CASE M_LOGAND: RESULTIS 'LOGAND' CASE M_LOGOR: RESULTIS 'LOGOR' CASE M_AUG: RESULTIS 'AUG' CASE M_APPLY: RESULTIS 'APPLY' CASE M_SAVE: RESULTIS 'SAVE' CASE M_NOT: RESULTIS 'NOT' CASE M_GOTO: RESULTIS 'GOTO' CASE M_RES: RESULTIS 'RESULT' CASE M_UPDATE: RESULTIS 'UPDATE' CASE M_RETURN: RESULTIS 'RETURN' CASE M_TESTEMPTY: RESULTIS 'TESTEMPTY' CASE M_LOADR: RESULTIS 'LOADR' CASE M_LOADL: RESULTIS 'LOADL' CASE M_LOADN: RESULTIS 'LOADN' CASE M_LOADS: RESULTIS 'LOADS' CASE M_LOADE: RESULTIS 'LOADE' CASE M_DECLNAME: RESULTIS 'DECLNAME' CASE M_DECLNAMES: RESULTIS 'DECLNAMES' CASE M_INITNAME: RESULTIS 'INITNAME' CASE M_INITNAMES: RESULTIS 'INITNAMES' CASE M_SETLABES: RESULTIS 'SETLABES' CASE M_FORMCLOSURE:RESULTIS 'FORMCLOSR' CASE M_JUMPF: RESULTIS 'JUMPF' CASE M_JUMP: RESULTIS 'JUMP' CASE M_BLOCKLINK: RESULTIS 'BLOCKLINK' CASE M_RESLINK: RESULTIS 'RESLINK' CASE M_SETUP: RESULTIS 'SETUP' CASE M_DECLLABEL: RESULTIS 'DECLLABEL' $)1 WRITES('*N*T') WRITES(S) $)1 AND OUTN(N) BE $( OUT2(INTEGER, N) UNLESS LISTING RETURN WRITECH(OUTPUT, '*T') WRITEN(N) $) AND OUTP(N) BE $( OUT2(PARAM, N) UNLESS LISTING RETURN WRITES('*TL') WRITEN(N) $) AND OUTNAME(N) BE $( LET V = VEC BYTEMAX UNPACKSTRING(H3*(N), V) OUT1(NAME) FOR I = 0 TO V*(0) DO OUT1(V*(I)) UNLESS LISTING RETURN WRITECH(OUTPUT, '*T') FOR I = 1 TO V*(0) DO WRITECH(OUTPUT, V*(I)) $) AND OUTNUMBER(N) BE $( LET V = VEC BYTEMAX UNPACKSTRING(H2*(N), V) OUT1(NUMBER) FOR I = 0 TO V*(0) DO OUT1(V*(I)) UNLESS LISTING RETURN WRITECH(OUTPUT, '*T') FOR I = 1 TO V*(0) DO WRITECH(OUTPUT, V*(I)) $) AND OUTSTRING(S) BE $( LET V = VEC BYTEMAX UNPACKSTRING(H2*(S), V) OUT1(STRINGCONST) FOR I = 0 TO V*(0) DO OUT1(V*(I)) UNLESS LISTING RETURN WRITECH(OUTPUT, '*T') FOR I = 1 TO V*(0) DO WRITECH(OUTPUT, V*(I)) $) AND OUTPSOP(L, OP, N) BE $(1 OUT1(OP) OUT2(L, N) UNLESS LISTING RETURN WRITES('*N*NL') WRITEN(L) WRITECH(OUTPUT, '*T') WRITES(OP EQ EQU -* 'EQU', 'ERROR') WRITECH(OUTPUT, '*T') WRITEN(N) $)1 AND OUT1(X) BE $( RV CODEFILEP := X CODEFILEP := CODEFILEP + I IF CODEFILEP GE AETREEP DO OVERFLOW() $) AND OUT2(X, Y) BE $( CODEFILEP*(0) := X CODEFILEP*(1) := Y CODEFILEP := CODEFILEP + 2 IF CODEFILEP GE AETREEP DO OVERFLOW() $) AND OVERFLOW() BE $( WRITES('*N*T****** POCODE STORAGE AREA OVERFLOW. ') WRITES('COMPILATION TERMINATED.*N*N') COMPERROR := TRUE LONGJUMP(EOP, EOPLEVEL) $)