// PAL2 LAST MODIFIED ON FRIDAY, 12 JUNE 1970 // AT 5:37:16.75 BY R MABEE >>> FILENAME 'PAL2' // // ************ // * * // * PAL2 * // * * // ************ // >>> GET 'PALHD' >>> EJECT // PAL2A MANIFEST $( EMPTY = 0 $) LET CAE() = VALOF $(1 LET A, I = 0, 0 LET DEFV = VEC (BYTEMAX/BYTESPERWORD) LET V1 = VEC BYTEMAX SYMBV, SYMBP := V1, 0 LINEP := 0 AETREEP := STORAGET CHKIND, CH := EMPTY, '*N' NAMECHAIN := 0 DUMMYN := LIST1(M_DUMMY) NEXTSYMB() TEST SYMB=DEF THEN $(3 L: WHILE SYMB=DEF DO $( NEXTSYMB() DEFV*(I) := RDEF(0) I := I+1 $) UNLESS SYMB=END DO $(4 REPORT(2, 97, '*'DEF*' DEFINITION') RCOMLOOP(1) N: SWITCHON SYMB INTO $( DEFAULT: NEXTSYMB() GOTO N CASE DEF: GOTO L CASE END: $)4 A := LIST1(M_DUMMY) UNTIL I=0 DO $( I := I-1 A := LIST3(DEF, DEFV*(I), A) $)3 OR $(3 P: A := LIST2(PAREN, RCOM(0) ) UNLESS SYMB=END DO $( REPORT(2, 98, 'THE PROGRAM IS') RCOMLOOP(0) $)3 RESULTIS A $)1 AND RCOMLOOP(N) BE $( $( NEXTSYMB() RCOM(0) IF SYMB=END RETURN IF N=1 LOGAND ( SYMB=DEF LOGOR SYMB=M_AND ) RETURN REPORT(2, 99, 'THE PROGRAM OR DEFINITION HAS AGAIN') $) REPEAT $) AND REPORT(M, N, 5) BE $(1 WRITES('*N*T*T**********SYNTAX ERROR ') WRITEN(N) WRITES( ' ... ') SWITCHON M INTO $( CASE 1: WRITES('SYNTAX ERROR IN ') TEST S=0 THEN WRITES('DEFINITION') OR $( WRITES(S) WRITES(' EXPRESSION') $) GOTO L CASE 2: WRITES(S) WRITES(' PREMATURELY TERMINATED') GOTO L CASE 3: WRITES(S) WRITES(' OUT OF CONTEXT') GOTO L CASE 4: WRITES('UNMATCHED CLOSING BRACKET IN ') CASE 5: WRITES(S) $) L: WRITES('*N*T*T') UNLESS CH = '*N' DO FOR I = 1 TO LINEP DO WRITECH(OUTPUT,'*S') IF N LS 100 DO COMPERROR := TRUE $)1 >>> EJECT = // PAL2B LET RCOM(N) = VALOF $(1 LET A, B, C = 0, 0, 0 SWITCHON SYMB INTO $( CASE M_LET: UNLESS N=0 DO REPORT(3, 30, '*'LET*'') NEXTSYMB() A := RDEF(0) UNLESS SYMB=IN DO REPORT(1, 31, '*'LET*'') NEXTSYMB() B := RCOM(0) RESULTIS LIST3(M_LET, A, B) CASE LAMBDA: UNLESS N=0 DO REPORT(3, 32, '*'FN*'') NEXTSYMB() $( LET V = VEC 50 LET I = O WHILE I LE 50 DO $( UNLESS SYMB=BRA LOGOR SYMB=NAME BREAK V*(I) := RBV() I := I+1 $) IF I=O DO REPORT(1, 33, '*'FN*'') UNLESS SYMB=DOT DO REPORT(1, 34, '*'FN*'') NEXTSYMB() A := RCOM(0) WHILE I GR 0 DO $( I := I-1 A := LIST3(LAMBDA, V*(I), A) $) RESULTIS A $) CASE M_VALOF: UNLESS N LE 4 DO REPORT(3, 35, '*'VALOF*'') NEXTSYMB() B := RCOM(6) A := LIST2(M_VALOF, B) GOTO L CASE M_TEST: UNLESS N LE 10 DO REPORT(3, 36, '*'TEST*'') NEXTSYMB() A := REXP(20) SWITCHON SYMB INTO $( CASE IFSO: NEXTSYMB() B := RCOM(8) UNLESS SYMB=IFNOT GOTO TESTERR NEXTSYMB() C := RCOM(8) TESTEND: A := LIST4(COND, A, B, C) GOTO L CASE IFNOT: NEXTSYMB() C := RCOM(8) UNLESS SYMB=IFSO GOTO TESTERR NEXTSYMB() B := RCOM(8) GOTO TESTEND DEFAULT: TESTERR: REPORT(1, 37, '*'TEST*'') GOTO L $) CASE M_IF: CASE M_WHILE: $( LET OP = SYMB UNLESS N LE 10 DO REPORT(3, 38, '*'IF*' OR *'WHILE*'') NEXTSYMB() A := REXP(20) TEST SYMB=M_DO THEN NEXTSYMB() OR REPORT(5, 138, '*'DO*' ASSUMED TO BE MISSING.') B := RCOM(8) TEST OP=M_IF THEN A := LIST4(COND,A,B,DUMMYN) OR A := LIST3(M_WHILE,A,B) GOTO L $) CASE M_GOTO: NEXTSYMB() B := REXP(38) A := LIST2(M_GOTO, B) GOTO L CASE M_RES: NEXTSYMB() B := REXP(14) A := LIST2(M_RES, B) GOTO L CASE M_DUMMY: NEXTSYMB() A := DUMMYN GOTO L DEFAULT: A := REXP(N) UNLESS SYMB=ASS GOTO L NEXTSYMB() B := REXP(14) A := LIST3(ASS, A, B) GOTO L $) L: SWITCHON SYMB INTO $( CASE WHERE: IF N GR 2 RESULTIS A NEXTSYMB() B := RBDEF(0) RESULTIS LIST3(M_LET, B, A) CASE SEQ: IF N GR 6 RESULTIS 6 NEXTSYMB() B := RCOM(6) A := LIST3(SEQ, A, B) GOTO L CASE COLON: UNLESS H1*(A)=NAME LOGAND N LE 8 DO REPORT(5, 39, 'SYNTAX ERROR IN LABEL') NEXTSYMB() B := RCOM(8) A := LIST4(COLON, A, B, 0) GOTO L DEFAULT: RESULTIS A $)1 >>> EJECT // PAL2C LET REXP(N) = VALOF $(1 LET A, B, C = 0, 0, 0 SWITCHON SYMB INTO $(2 CASE M_NOT: UNLESS N LE 24 DO REPORT(3, 51, '*'NOT*'') NEXTSYMB() A := REXP(26) A := LIST2(M_NOT, A) GOTO L CASE M_PLUS: CASE M_MINUS: $( LET OP = SYMB NEXTSYMB() UNLESS N LE 30 DO REPORT(3, 52, '*'+*' OR *'-*'') A := REXP(32) A := LIST2(OP=M_PLUS -* M_POS, M_NEG, A) GOTO L $) CASE NOSHARE: UNLESS N LE 36 DO REPORT(3, 53, '*'$*'') NEXTSYMB() B := REXP(38) A := LIST2(NOSHARE, B) GOTO L CASE M_NIL: CASE M_TRUE: CASE M_FALSE: A := LIST1(SYMB) NEXTSYMB() GOTO APPLY CASE NUMBER: CASE STRINGCONST: A := RDNS() NEXTSYMB() GOTO APPLY CASE NAME: A := RDNAME() APPLY: B := RARG() IF B = 0 GOTO L A := LIST3(M_APPLY, A, B) GOTO APPLY DEFAULT: A := RDBEXP() IF A=O DO $( TEST SYMB=END THEN REPORT(2, 55, 'SOURCE PROGRAM') OR REPORT(3, 56, 'SYMBOL') RESULTIS 0 $) IF N LE 8 DO A := H2*(A) GOTO APPLY $)2 L: SWITCHON SYMB INTO $( DEFAULT: RESULTIS A CASE COMMA: IF N GR 14 RESULTIS A $( LET I = 1 LET V = VEC 500 WHILE SYMB = COMMA DO $( NEXTSYMB() V*(I) := REXP(16) I := I + 1 $) B := A A := NEWVEC(I + 1) A*(0), A*(1), A*(2) := COMMA, I, B FOR J = 1 TO I - 1 DO A*(J + 2) := V*(J) $) GOTO L CASE M_AUG: IF N GR 16 RESULTIS A NEXTSYMB() B := REXP(18) A := LIST3(M_AUG, A, B) GOTO L CASE COND: IF N GR 18 RESULTIS A NEXTSYMB() B := REXP(18) UNLESS SYMB=BAR DO REPORT(1, 57, '*'->*'') NEXTSYMB() C := REXP(18) A := LIST4(COND, A, B, C) GOTO L CASE M_LOGOR: IF N GR 20 RESULTIS A NEXTSYMB() B := REXP(22) A := LIST3(M_LOGOR, A, B) GOTO L CASE M_LOGAND: IF N GR 22 RESULTIS A NEXTSYMB() B := REXP(24) A := LIST3(M_LOGAND, A, B) GOTO L CASE VALDEF: REPORT(5, 157, '*'=*' USED OUT OF CONTEXT; *'EQ*' ASSUMED') SYMB := M_EQ CASE M_GE: CASE M_NE: CASE M_LE: CASE M_EQ: CASE M_LS: CASE M_GR: IF N GR 26 RESULTIS A $( LET OP = SYMB NEXTSYMB() B := REXP(30) A := LIST3(OP, A, B) GOTO L $) CASE M_PLUS: CASE M_MINUS: $( LET OP = SYMB IF N GR 30 RESULTIS A NEXTSYMB() B := REXP(32) A := LIST3(OP, A, B) GOTO L $) CASE M_MULT: CASE M_DIV: IF N GR 32 RESULTIS A CASE M_POWER: IF N GR 36 RESULTIS A $( LET OP = SYMB NEXTSYMB() B := REXP(34) A := LIST3(OP, A, B) GOTO L $) CASE PERCENT: IF N GR 36 RESULTIS A NEXTSYMB() UNLESS SYMB=NAME DO REPORT(3, 58, '*'%*'') B := RDNAME() C := REXP(38) A := LIST4(COMMA, 2, A, C) A := LIST3(M_APPLY, B, A) GOTO L $)1 >>> EJECT // PAL2D LET RBDEF(N) = VALOF $(1 LET A=O SWITCHON SYMB INTO $( CASE NAME: $(2 LET B=0 A := RDNAME() IF SYMB=COMMA DO $( A := RDNAMELIST(A) UNLESS SYMB=VALDEF DO REPORT(1, 10, 0) NEXTSYMB() B := RCOM(0) RESULTIS LIST3(VALDEF, A, B) $) IF SYMB=VALDEF DO $( NEXTSYMB() B := RCOM(0) RESULTIS LIST3(VALDEF, A, B) $) $( LET V = VEC 10 LET I = 0 WHILE I LE 10 DO $( UNLESS SYMB=BRA LOGOR SYMB=NAME BREAK V*(I) := RBV() I := I + 1 $) UNLESS I NE 0 LOGAND SYMB=VALDEF DO REPORT(1, 11, 0) NEXTSYMB() B := RCOM(0) WHILE I GR 0 DO $( I := I - 1 B := LIST3(LAMBDA, V*(I), B) $) RESULTIS LIST3(VALDEF, A, B) $)2 CASE BRA: NEXTSYMB() A := RDEF(0) UNLESS SYMB=KET DO REPORT(4, 12, 'DEFINITION') NEXTSYMB() RESULTIS A CASE REC: NEXTSYMB() UNLESS N EQ 0 DO $( REPORT(5, 112, 'REDUNDANT *'REC*' IGNORED') RESULTIS RBDEF (2) $) A := RBDEF(2) RESULTIS LIST2(REC, A) DEFAULT: REPORT(1, 13, 0) RESULTIS 0 $)1 AND RDEF(N) = VALOF $(1 LET A = RBDEF(0) LET B=0 L: SWITCHON SYMB INTO $( DEFAULT: RESULTIS A CASE M_AND: IF A = 0 DO REPORT(5,15,'DEFINITION MISSING BEFORE *'AND**') IF N GE 6 RESULTIS A $( LET I = 1 LET V = VEC 100 WHILE SYMB = M_AND DO $( NEXTSYMB() V*(I) := RBDEF(0) I := I + 1 $) B := A A := NEWVEC(I + 1) A*(0), A*(1), A*(2) := M_AND, I, B FOR J = 1 TO I - 1 DO A*(J + 2) := V*(J) $) GOTO L CASE WITHIN: IF A=0 DO REPORT(5, 16, 'DEFINITION MISSING BEFORE *'WITHIN*'') IF N GE 3 RESULTIS A NEXTSYMB() B := RDEF(0) A := LIST3(WITHIN, A, B) GOTO L $)1 AND RBV() = VALOF $(1 LET A=0 IF SYMB=NAME RESULTIS RDNAME() NEXTSYMB() IF SYMB=KET DO $( NEXTSYMB() RESULTIS LIST1(MPT) $) A := RDNAMELIST(0) UNLESS SYMB=KET DO REPORT(4, 17, 'BV PART') NEXTSYMB() RESULTIS A $)1 AND RDNAMELIST(N) = VALOF $( LET A, B, I = 0, N, 1 LET V = VEC 100 IF N = 0 DO $( UNLESS SYMB=NAME DO REPORT(5, 20, 'A NAME IS MISSING') B := RDNAME() $) UNLESS SYMB = COMMA RESULTIS B WHILE SYMB = COMMA DO $( NEXTSYMB() UNLESS SYMB=NAME DO REPORT(5, 21, 'A NAME IS MISSING') V*(I) := RDNAME() I:=I+1 $) A := NEWVEC(I + 1) A*(0), A*(1), A*(2) := COMMA, I, B FOR J = 1 TO I - 1 DO A*(J + 2) := V*(J) RESULTIS A $) AND RDNAME() = VALOF $(1 LET S = VEC (BYTEMAX/BYTESPERWORD) LET L, A, B = NAMECHAIN, 0, SYMB LET N = SYMBP/BYTESPERWORD + 1 // THE LENGTH OF THE STRING IN WORDS IF N GR 5 DO REPORT(5, 23, 'NAME TOO LONG') SYMBV*(0) := SYMBP PACKSTRING(SYMBV, S) NEXTSYMB() UNTIL L = 0 DO $(2 LET V = H2*(L) IF S*(0)=V*(0) DO $(3 IF N=1 RESULTIS L IF S*(1)=V*(1) DO $( IF N=2 RESULTIS L IF S*(2)=V*(2) DO $I IF N=3 RESULTIS L IF S*(3)=V*(3) DO $( IF N=4 RESULTIS L IF S*(4)=V*(4) DO RESULTIS L $)3 L := H2*(L) $)2 A := NEWVEC(N-1) NAMECHAIN := LIST3(B, NAMECHAIN, A) FOR I = 0 TO N-1 DO A*(I) := S*(I) RESULTIS NAMECHAIN $)1 AND RDNS() = VALOF $( LET A = 0 LET N = SYMBP/BYTESPERWORD + 1 LET S = VEC 150 SYMBV*(0) := SYMBP PACKSTRING(SYMBV, S) A := NEWVEC(N-1) FOR I = 0 TO N-1 DO A*(I) := S*(I) RESULTIS LIST2(SYMB, A) $) AND RARG() = VALOF $(1 LET A = 0 SWITCHON SYMB INTO $( DEFAULT: RESULTIS RDBEXP() CASE M_NIL: CASE M_TRUE: CASE M_FALSE: A := LIST1(SYMB) NEXTSYMB() RESULTIS A CASE NUMBER: CASE STRINGCONST: A := RDNS() NEXTSYMB() RESULTIS A CASE NAME: RESULTIS RDNAME() $)1 AND RDBEXP() = VALOF $(1 LET A=0 UNLESS SYMB=BRA RESULTIS C NEXTSYMB() A := RCOM(0) IF A=O DO REPORT(5, 25, 'EXPRESSION MISSING WITHIN BRACKETS') UNLESS SYMB=KET DO REPORT(4, 26, 'EXPRESSION') NEXTSYMB() RESULTIS LIST2(PAREN, A) $)1 >>> EJECT // PAL2E LET PLIST(X, N, D) BE $(1 LET SIZE, S = 0, 0 IF X=O DO $( WRITES( 'NIL' ) RETURN $) IF X LE 100 DO $( WRITEN(X) RETURN $) IF H1*(X)=NUMBER DO $( WRITES( '** NUMBER ' ) WRITES(H2*(X)) RETURN $) IF H1*(X)=NAME DO $( WRITES( '** NAME' ) WRITEN(H3*(X)) WRITES(' ') WRITES(H3*(X)) RETURN $) IF H1*(X)=STRINGCONST DO $( WRITES( '** STRINGCONST ' ) WRITES(H2*(X)) RETURN $) IF N=D DO $( WRITES( 'ETC' ) RETURN $) NODETYPE(X, LV SIZE, LV S) WRITES(S) FOR I = 2 TO SIZE DO $( WRITECH(OUTPUT, '*N') FOR I = 0 TO N DO WRITES( '| ' ) PLIST(HI*(X+I-1), N+1, D) $) RETURN $)1 AND NODETYPE(X, N, S) BE $(1 SWITCHON H1*(X) INTO $( DEFAULT: RV N, RV S := 0, 'UNKNOWN OPERATOR'; RETURN CASE PAREN: RV N, RV S := 2, 'PAREN'; RETURN CASE DEF: RV N, RV S := 3, 'DEF'; RETURN CASE M_LET: RV N, RV S := 3, 'LET'; RETURN CASE COLON: RV N, RV S := 3, 'COLON'; RETURN CASE SEQ: RV N, RV S := 3, 'SEQ'; RETURN CASE M_GOTO: RV N, RV S := 2, 'GOTO'; RETURN CASE M_VALOF: RV N, RV S := 2, 'VALOF'; RETURN CASE M_RES: RV N, RV S := 2, 'RES'; RETURN CASE LAMBDA: RV N, RV S := 3, 'LAMBDA'; RETURN CASE COND: RV N, RV S := 4, 'COND'; RETURN CASE M_WHILE: RV N, RV S := 3, 'WHILE'; RETURN CASE ASS: RV N, RV S := 3, 'ASS'; RETURN CASE COMMA: RV N, RV S := H2*(X)+2, 'COMMA'; RETURN CASE M_AUG: RV N, RV S := 3, 'AUG'; RETURN CASE M_LOGOR: RV N, RV S := 3, 'LOGOR'; RETURN CASE M_LOGAND: RV N, RV S := 3, 'LOGAND'; RETURN CASE M_NOT: RV N, RV S := 2, 'NOT'; RETURN CASE M_EQ: RV N, RV S := 3, 'EQ'; RETURN CASE M_LS: RV N, RV S := 3, 'LS'; RETURN CASE M_GR: RV N, RV S := 3, 'GR'; RETURN CASE M_GE: RV N, RV S := 3, 'GE'; RETURN CASE M_LE: RV N, RV S := 3, 'LE'; RETURN CASE M_NE: RV N, RV S := 3, 'NE'; RETURN CASE M_PLUS: RV N, RV S := 3, 'PLUS'; RETURN CASE M_MINUS: RV N, RV S := 3, 'MINUS'; RETURN CASE M_POS: RV N, RV S := 2, 'POS'; RETURN CASE M_NEG: RV N, RV S := 2, 'NEG'; RETURN CASE M_MULT: RV N, RV S := 3, 'MULT'; RETURN CASE M_DIV: RV N, RV S := 3, 'DIV'; RETURN CASE M_POWER: RV N, RV S := 3, 'POWER'; RETURN CASE M_APPLY: RV N, RV S := 3, 'APPLY'; RETURN CASE M_DUMMY: RV N, RV S := 1, 'DUMMY'; RETURN CASE NOSHARE: RV N, RV S := 2, 'NOSHARE'; RETURN CASE M_TRUE: RV N, RV S := 1, 'TRUE'; RETURN CASE M_FALSE: RV N, RV S := 1, 'FALSE'; RETURN CASE M_NIL: RV N, RV S := 1, 'NIL'; RETURN CASE MPT: RV N, RV S := 1, '()'; RETURN CASE M_AND: RV N, RV S := H2*(X)+2, 'AND'; RETURN CASE WITHIN: RV N, RV S := 3, 'WITHIN'; RETURN CASE REC: RV N, RV S := 2, 'REC'; RETURN CASE VALDEF: RV N, RV S := 3, 'VALDEF'; RETURN $)1 >>> EJECT // PAL2F LET NEWVEC( N ) = VALOF $(1 AETREEP := AETREEP - N - 1 IF CODEFILEP GE AETREEP DO $( WRITES(**N*N*N*TAE TREE EXCEEDS AVAILABLE SPACE. ') WRITES('COMPILATION ABORTED.*N') COMPERROR := TRUE LONGJUMP(EOP, EOPLEVEL) $) RESULTIS AETREEP $)1 AND LIST1(A) = VALOF $(1 LET V = NEWVEC(0) V*(0) := A RESULTIS V $)1 AND LIST2(A, B) = VALOF $(1 LET V = NEWVEC(1) V*(0), V*(1) := A, 8 RESULTIS V $)1 AND LIST3(A, B, C) = VALOF $(1 LET V = NEWVEC(2) V*(0), V*(1), V*(2) := A, B, C RESULTIS V $)1 AND LIST4(A, B, C, D) = VALOF $(1 LET V = NEWVEC(3) V*(0), V*(1), V*(2), V*(3) := A, B, C, D RESULTIS V $)1