From 2237be992309c89ae6add7fd8d95c13b227d891f Mon Sep 17 00:00:00 2001 From: Paul Kimpel Date: Sat, 5 Apr 2014 20:29:26 +0000 Subject: [PATCH] Commit original transcription of Nicklaus Wirth's EULER IV translator and interpreter, prepared and generously donated to the project by James Fehlinger, as of 2014-03-24. --- source/EULER/EULERIV.alg_m | 1183 ++++++++++++++++++++++++++++++++++++ source/EULER/GRAMMAR.card | 242 ++++++++ source/EULER/SAMPLE.card | 24 + source/EULER/SYNTAX.alg_m | 433 +++++++++++++ 4 files changed, 1882 insertions(+) create mode 100644 source/EULER/EULERIV.alg_m create mode 100644 source/EULER/GRAMMAR.card create mode 100644 source/EULER/SAMPLE.card create mode 100644 source/EULER/SYNTAX.alg_m diff --git a/source/EULER/EULERIV.alg_m b/source/EULER/EULERIV.alg_m new file mode 100644 index 0000000..e0b9830 --- /dev/null +++ b/source/EULER/EULERIV.alg_m @@ -0,0 +1,1183 @@ +?COMPILE EULER/DISK WITH ALGOL +?ALGOL STACK = 5000 +?DATA CARD +$ CARD LIST SINGLE XREF +BEGIN COMMENT E U L E R IV S Y S T E M MARCH 1965; + FILE IN CARDFIL (1,10); FILE PRINFIL 1 (1,15); + INTEGER FT, LT; COMMENT INDEX OF FIRST AND LAST BASIC SYMBOL; + INTEGER LP; COMMENT LENGTH OF PRODUCTION TABLE; + ARRAY PROGRAM[0:1022]; + DEFINE AFIELD =[39:9]#, BFIELD =[9:30]#, CFIELD =[1:8]#; + LABEL EXIT; + FT ~ 45; LT ~ 119; LP ~ 465; COMMENT DATA GENERATED BY SY-PR.; + +BEGIN COMMENT E U L E R IV TRANSLATOR N.WIRTH; + DEFINE MARK = 119#, IDSYM = 63#, REFSYM = 59#, LABSYM = 62#; + DEFINE VALSYM = 56#, CALLSYM = 55#, UNDEF = 0#, NEWSYM = 60#; + DEFINE UNARYMINUS = 116#, NUMSYM = 68#, BOOLSYM = 64#; + DEFINE LISTSYM = 102#, SYMSYM = 113#, FORSYM = 61#; + DEFINE NAME = V[0]#; + INTEGER I,J,K,M,N,R,T,T1,SCALE; BOOLEAN ERRORFLAG; + INTEGER BN, ON; COMMENT BLOCK- AND ORDER-NUMBER; + INTEGER NP; COMMENT NAME LIST POINTER; + INTEGER MP; COMMENT MARK-POINTER OF NAME-LIST; + INTEGER PRP; COMMENT PROGRAM POINTER; + INTEGER WC, CC; COMMENT INPUT POINTERS; + ALPHA ARRAY READBUFFER, WRITEBUFFER [0:14]; + ALPHA ARRAY SYTB[0:LT]; COMMENT TABLE OF BASIC SYMBOLS; + INTEGER ARRAY F, G [0:LT]; COMMENT PRIORITY FUNCTIONS; + INTEGER ARRAY MTB[0:LT]; COMMENT SYNTAX MASTER TABLE; + INTEGER ARRAY PRTB[0:LP]; COMMENT PRODUCTION TABLE; + INTEGER ARRAY S[0:127]; COMMENT STACK; + REAL ARRAY V[0:127]; COMMENT VALUE STACK; + ALPHA ARRAY NL1[0:63]; COMMENT NAME LIST; + INTEGER ARRAY NL2, NL3, NL4 [0:63]; + LABEL A0,A1,A2,A3,A4,A5,A6,A7,A8,A9; + LABEL L0, L1131, NAMEFOUND, + L1,L2,L3,L4,L5,L6,L7,L8,L9,L10,L11,L12,L13,L14,L15,L16,L17,L18,L19, + L20,L21,L22,L23,L24,L25,L26,L27,L28,L29,L30,L31,L32,L33,L34, + L35,L36,L37,L38,L39,L40,L41,L42,L43,L44,L45,L46,L47,L48,L49,L50,L51, + L52,L53,L54,L55,L56,L57,L58,L59,L60,L61,L62,L63,L64,L65,L66,L67,L68, + L69,L70,L71,L72,L73,L74,L75,L76,L77,L78,L79,L80,L81,L82,L83,L84,L85, + L86,L87,L88,L89,L90,L91,L92,L93,L94,L95,L96,L97,L98,L99,L100,L101, + L102,L103,L104,L105,L106,L107,L108,L109,L110,L111,L112,L113,L114, + L115,L116,L117,L118,L119,L120; + SWITCH BRANCH ~ + L1,L2,L3,L4,L5,L6,L7,L8,L9,L10,L11,L12,L13,L14,L15,L16,L17,L18,L19, + L20,L21,L22,L23,L24,L25,L26,L27,L28,L29,L30,L31,L32,L33,L34, + L35,L36,L37,L38,L39,L40,L41,L42,L43,L44,L45,L46,L47,L48,L49,L50,L51, + L52,L53,L54,L55,L56,L57,L58,L59,L60,L61,L62,L63,L64,L65,L66,L67,L68, + L69,L70,L71,L72,L73,L74,L75,L76,L77,L78,L79,L80,L81,L82,L83,L84,L85, + L86,L87,L88,L89,L90,L91,L92,L93,L94,L95,L96,L97,L98,L99,L100,L101, + L102,L103,L104,L105,L106,L107,L108,L109,L110,L111,L112,L113,L114, + L115,L116,L117,L118,L119,L120; + +STREAM PROCEDURE ZERO(D); + BEGIN DI ~ D; DS ~ 8 LIT "0"; + END; +STREAM PROCEDURE CLEAR(D); + BEGIN DI ~ D; DS ~ 8 LIT " "; SI ~ D; DS ~ 14 WDS + END; +STREAM PROCEDURE MOVE(S,D); + BEGIN SI ~ S; DI ~ D; DS ~ WDS; + END; +BOOLEAN STREAM PROCEDURE EQUAL(X,Y); + BEGIN TALLY ~ 1; SI ~ X; DI ~ Y; IF 8 SC = DC THEN EQUAL ~ TALLY; + END; + +INTEGER PROCEDURE INSYMBOL; + COMMENT "INSYMBOL" READS THE NEXT EULER-SYMBOL FROM INPUT. + STRINGS OF LETTERS AND DIGITS ARE RECOGNIZED AS IDENTIFIERS, IF + THEY ARE NOT EQUAL TO AN EULER-IVWORD-DELIMITER. + A CHARACTER-SEQUENCE ENCLOSED IN " IS RECOGNIZED AS A SYMBOL; + BEGIN INTEGER I; LABEL A,B,C,D,E; +STREAM PROCEDURE TRCH(S,M,D,N); VALUE M,N; + BEGIN SI ~ S; SI ~ SI+M; DI ~ D; DI ~ DI+N; DS ~ CHR + END; +BOOLEAN STREAM PROCEDURE BLANK(S,N); VALUE N; + BEGIN TALLY ~ 1; SI ~ S; SI ~ SI+N; IF SC = " " THEN BLANK ~ TALLY + END; +STREAM PROCEDURE BLANKOUT(D); + BEGIN DI ~ D; DS ~ 8 LIT " "; + END; +BOOLEAN STREAM PROCEDURE QUOTE(S,N); VALUE N; + BEGIN TALLY ~ 1; SI ~ S; SI ~ SI+N; IF SC = """ THEN QUOTE ~ TALLY + END; +BOOLEAN STREAM PROCEDURE LETTER(S,N); VALUE N; + BEGIN TALLY ~ 1; SI ~ S; SI ~ SI+N; + IF SC = ALPHA THEN + BEGIN IF SC < "0" THEN LETTER ~ TALLY END + END; +BOOLEAN STREAM PROCEDURE LETTERORDIGIT(S,N); VALUE N; + BEGIN TALLY ~ 1; SI ~ S; SI ~ SI+N; + IF SC = ALPHA THEN LETTERORDIGIT ~ TALLY + END; +STREAM PROCEDURE EDIT(N,S,D); VALUE N; + BEGIN SI ~ LOC N; DI ~ D; DS ~ 3 DEC; + SI ~ S; DI ~ DI + 13; DS ~ 10 WDS + END; +PROCEDURE ADVANCE; + COMMENT ADVANCES THE INPUT POINTER BY 1 CHARACTER POSITION; + BEGIN IF CC = 7 THEN + BEGIN IF WC = 8 THEN + BEGIN READ (CARDFIL, 10, READBUFFER[*]) [EXIT]; + EDIT(PRP+1, READBUFFER[0], WRITEBUFFER[0]); + WRITE (PRINFIL, 15, WRITEBUFFER[*]); WC ~ 0 + END ELSE WC ~ WC+1; + CC ~ 0; + END + ELSE CC ~ CC+1; + END ADVANCE; + + BLANKOUT(NAME); +A: IF BLANK(READBUFFER[WC], CC) THEN + BEGIN ADVANCE; GO TO A END; + IF LETTER(READBUFFER[WC], CC) THEN + BEGIN FOR I ~ 0 STEP 1 UNTIL 7 DO + BEGIN TRCH(READBUFFER[WC], CC, NAME, I); ADVANCE; + IF NOT LETTERORDIGIT(READBUFFER[WC], CC) THEN GO TO C + END; +B: ADVANCE; + IF LETTERORDIGIT(READBUFFER[WC], CC) THEN GO TO B; +C: END + ELSE IF QUOTE(READBUFFER[WC], CC) THEN + BEGIN ADVANCE; ZERO(NAME); NAME ~ " "; +E: TRCH(READBUFFER[WC], CC, I, 7); ADVANCE; + IF I ! """ THEN + BEGIN NAME ~ I.[42:6] & NAME [18:24:24]; GO TO E END + ELSE I ~ SYMSYM; GO TO D + END + ELSE + BEGIN TRCH(READBUFFER[WC], CC, NAME, 0); ADVANCE + END; + FOR I ~ FT STEP 1 UNTIL LT DO + IF EQUAL(SYTB[I], NAME) THEN BEGIN ZERO(NAME); GO TO D END; + I ~ IDSYM; +D: INSYMBOL ~ I + END INSYMBOL; + +PROCEDURE P1(X); VALUE X; INTEGER X; + BEGIN PRP ~ PRP+1; PROGRAM[PRP] ~ X + END; +PROCEDURE P2(X,Y); VALUE X,Y; INTEGER X; REAL Y; + BEGIN PRP ~ PRP+1; PROGRAM[PRP] ~ X; PROGRAM[PRP].BFIELD ~ Y; + END; +PROCEDURE P3(X,Y,Z); VALUE X,Y,Z; INTEGER X,Y,Z; + BEGIN PRP ~ PRP+1; PROGRAM[PRP] ~ X; PROGRAM[PRP].BFIELD ~ Y; + PROGRAM[PRP].CFIELD ~ Z + END; +PROCEDURE FIXUP(I,X); VALUE I,X; INTEGER I,X; + PROGRAM[I].BFIELD ~ X; +PROCEDURE ERROR(N); VALUE N; INTEGER N; + BEGIN SWITCH FORMAT ERR ~ + ("UNDECLARED IDENTIFIER"), + ("NUMBER TOO LARGE"), + ("LABEL IS DEFINED TWICE"), + ("A LABEL IS NOT DECLARED"), + ("LABEL DECLARED BUT NOT DEFINED"), + ("PROGRAM SYNTACTICALLY INCORRECT"); + ERRORFLAG ~ TRUE; + WRITE (PRINFIL [NO], ERR[N]); WRITE (PRINFIL, , + WC|8 + CC + 1) + END ERROR; + +PROCEDURE PROGRAMDUMP; + BEGIN REAL T; INTEGER I; LABEL L; +STREAM PROCEDURE NUM(N,D); VALUE N; + BEGIN DI ~ D; SI ~ LOC N; DS ~ 3 DEC + END; + + READ (CARDFIL, , T) [L]; IF T ! "DUMP" THEN GO TO L; + WRITE (PRINFIL, ); + FOR I ~ 1 STEP 1 UNTIL PRP DO + BEGIN CLEAR(WRITEBUFFER[0]); + T ~ PROGRAM[I]; NUM(I, WRITEBUFFER[0]); + MOVE(SYTB[T.AFIELD], WRITEBUFFER[1]); + IF T.BFIELD ! 0 THEN NUM(T.BFIELD, WRITEBUFFER[2]); + IF T.CFIELD ! 0 THEN NUM(T.CFIELD, WRITEBUFFER[3]); + IF T.AFIELD = NUMSYM THEN + BEGIN I ~ I+1; + WRITE (PRINFIL [NO], , PROGRAM[I]) + END; + WRITE (PRINFIL, 15, WRITEBUFFER[*]); + END; +L: END PROGRAMDUMP; + + COMMENT INITIALISE THE SYMBOLTABLE, THE PRIORITY FUNCTIONS AND THE + PRODUCTION TABLES WITH DATA GENERATED BY THE SYNTAX-PROCESSOR; + FILL SYTB[*] WITH 0, + "PROGRAM ","BLOCK ","BLOKHEAD","BLOKBODY","LABDEF ","STAT ", + "STAT- ","EXPR ","EXPR- ","IFCLAUSE","TRUEPART","CATENA ", + "DISJ ","DISJHEAD","CONJ ","CONJ- ","CONJHEAD","NEGATION", + "RELATION","CHOICE ","CHOICE- ","SUM ","SUM- ","TERM ", + "TERM- ","FACTOR ","FACTOR- ","PRIMARY ","PROCDEF ","PROCHEAD", + "LIST* ","LISTHEAD","REFERENC","NUMBER ","REAL* ","INTEGER*", + "INTEGER-","DIGIT ","LOGVAL ","VAR ","VAR- ","VARDECL ", + "FORDECL ","LABDECL ","0 ","1 ","2 ","3 ", + "4 ","5 ","6 ","7 ","8 ","9 ", + ", ",". ","; ",": ","@ ","NEW ", + "FORMAL ","LABEL ","IDENT* ","[ ","] ","BEGIN ", + "END ","( ",") ","LQ ","RQ ","GOTO ", + "OUT ","~ ","IF ","THEN ","ELSE ","& ", + "OR ","AND ","NOT ","= ","! ","< ", + "{ ","} ","> ","MIN ","MAX ","+ ", + "- ","| ","/ ","% ","MOD ","* ", + "ABS ","LENGTH ","INTEGER ","REAL ","LOGICAL ","LIST ", + "TAIL ","IN ","ISB ","ISN ","ISR ","ISL ", + "ISLI ","ISY ","ISP ","ISU ","SYMBOL* ","UNDEFINE", + "TEN ","# ","TRUE ","FALSE ","$ "; + FILL F[*] WITH 0, + 1, 4, 19, 1, 2, 1, 2, 3, 4, 1, 4, 4, + 5, 5, 5, 6, 6, 6, 7, 7, 8, 9, 10, 11, + 11, 12, 12, 13, 13, 3, 13, 3, 13, 13, 13, 15, + 17, 19, 13, 13, 15, 1, 1, 1, 19, 19, 19, 19, + 19, 19, 19, 19, 19, 19, 19, 16, 21, 19, 13, 14, + 14, 14, 16, 3, 16, 21, 5, 19, 13, 19, 13, 12, + 4, 4, 3, 19, 19, 12, 19, 19, 7, 8, 8, 8, + 8, 8, 8, 9, 9, 10, 10, 11, 11, 11, 11, 12, + 12, 13, 12, 12, 12, 12, 12, 13, 13, 13, 13, 13, + 13, 13, 13, 13, 13, 13, 16, 16, 13, 13, 5; + FILL G[*] WITH 0, + 1, 5, 6, 6, 3, 1, 2, 3, 4, 5, 1, 5, + 5, 6, 6, 6, 7, 7, 7, 8, 9, 9, 10, 10, + 11, 11, 12, 12, 13, 13, 13, 14, 13, 13, 13, 16, + 17, 17, 13, 13, 14, 19, 3, 19, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 3, 15, 1, 16, 13, 20, + 4, 20, 14, 15, 3, 6, 1, 14, 3, 13, 3, 5, + 5, 13, 5, 3, 3, 4, 5, 6, 7, 7, 7, 7, + 7, 7, 7, 8, 8, 10, 10, 11, 11, 11, 11, 12, + 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, + 13, 13, 13, 13, 13, 13, 13, 16, 13, 13, 4; + FILL MTB[*] WITH 0, + 1, 2, 5, 16, 25, 29, 30, 33, 39, 42, 47, 48, + 55, 58, 62, 68, 71, 75, 81, 84, 111, 122, 125, 136, + 139, 158, 161, 168, 171, 174, 183, 186, 198, 201, 204, 216, + 223, 229, 232, 235, 245, 256, 257, 258, 259, 262, 265, 268, + 271, 274, 277, 280, 283, 286, 289, 290, 291, 292, 293, 297, + 301, 305, 309, 315, 320, 321, 324, 325, 328, 329, 332, 333, + 337, 341, 342, 347, 348, 349, 350, 351, 352, 356, 357, 358, + 359, 360, 361, 362, 363, 364, 368, 372, 373, 374, 375, 376, + 377, 381, 385, 389, 393, 397, 401, 405, 408, 412, 416, 420, + 424, 428, 432, 436, 440, 443, 446, 454, 455, 458, 461; + FILL PRTB[*] WITH 0, + 0,-103, 9, 0, 42, 57,-115, 3, 44, 57,-116, 3, + -117, 4, 0, 6, 57,-118, 4, 6, 67,-119, 2, 0, + 7,-110, 7, 0, 0,-112, 6, 0, 77,-101, 11,-111, + 7, 0,-109, 8, 0, 11, 9,-104, 9, 0, 0, 78, + 28, -99, 12,-108, 9, 0,-100, 12, 0, 13, -97, 13, + 0, 79, -96, 14, -98, 13, 0, -95, 15, 0, 16, -93, + 16, 0, 80, -92, 17, -94, 16, 0, -90, 18, 0, -83, + 19, 82, 20, -84, 19, 83, 20, -85, 19, 84, 20, -86, + 19, 85, 20, -87, 19, 86, 20, -88, 19, 87, 20, -89, + 19, 0, 88, 22, -80, 21, 89, 22, -81, 21, -82, 20, + 0, -79, 21, 0, 90, 24, -76, 23, 91, 24, -77, 23, + -78, 22, 0, -73, 23, 0, 92, 26, -68, 25, 93, 26, + -69, 25, 94, 26, -70, 25, 95, 26, -71, 25, -72, 24, + 0, -67, 25, 0, 96, 28, -65, 27, -66, 26, 0, -64, + 27, 0, -46, 28, 0, 43, 57, -35, 30, 8, 71, -37, + 29, 0, -44, 28, 0, 8, 55, -31, 32, 8, 69, -33, + 31, 69, -34, 31, 0, -43, 28, 0, -41, 28, 0, -25, + 34, 115, 36, -26, 34, 115, 116, 36, -27, 34, 0, 56, + 36, -23, 35, -24, 35, 0, 38, -21, 37, -22, 36, 0, + -20, 37, 0, -40, 28, 0, -38, 28, 31, -39, 28, 74, + 9,-105, 9, 0, 64, 8, 65, -5, 41, 56, -6, 41, + -7, 40, 0, 0, 0, 0, -10, 38, 0, -11, 38, 0, + -12, 38, 0, -13, 38, 0, -14, 38, 0, -15, 38, 0, + -16, 38, 0, -17, 38, 0, -18, 38, 0, -19, 38, 0, + 0, 0, 0, 0, 40, -30, 33, 0, 63, -1, 42, 0, + 63, -2, 43, 0, 63, -3, 44, 0, -4, 41, 58,-113, + 5, 0, 8, 65, -48, 28, 0, 0,-114, 3, 0, 0, + -32, 32, 0, 0, -36, 30, 0, 0, 28,-106, 9, 0, + 9,-107, 9, 0, 0, 8, 76,-102, 10, 0, 0, 0, + 0, 0, 0, 19, -91, 18, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 24, -74, 23, 0, 24, -75, 23, 0, 0, + 0, 0, 0, 0, 28, -58, 28, 0, 40, -59, 28, 0, + 28, -60, 28, 0, 28, -61, 28, 0, 28, -62, 28, 0, + 28, -63, 28, 0, 28, -45, 28, 0, -49, 28, 0, 40, + -50, 28, 0, 40, -51, 28, 0, 40, -52, 28, 0, 40, + -53, 28, 0, 40, -54, 28, 0, 40, -55, 28, 0, 40, + -56, 28, 0, 40, -57, 28, 0, -42, 28, 0, -47, 28, + 0, 36, -28, 34, 116, 36, -29, 34, 0, 0, -8, 39, + 0, -9, 39, 0, 2, 119,-120, 1, 0; + + WC ~ 8; CC ~ 7; CLEAR(WRITEBUFFER[0]); CLEAR(READBUFFER[0]); + S[0] ~ MARK; ERRORFLAG ~ FALSE; + I ~ J ~ BN ~ ON ~ NP ~ PRP ~ 0; + + COMMENT ALGORITHM FOR SYNTACTIC ANALYSIS: + COMPARE THE PRIORITIES OF THE SYMBOL R AND OF THE + SYMBOL ON TOP OF THE STACK S. IF S[J]...S[I] CONSTITUTE A RIGHT- + PART OF A PRODUCTION, THEN REPLACE THIS SEQUENCE BY THE + CORRESPONDING LEFT-PART AND BRANCH TO THE INTERPRETATION-RULE + BELONGING TO THE PERFORMED PRODUCTION; +A0: R ~ INSYMBOL; +A1: IF F[S[I]] > G[R] THEN GO TO A2; + IF R = MARK THEN GO TO A9; + I ~ J ~ I+1; S[I] ~ R; MOVE(NAME, V[I]); GO TO A0; +A2: IF F[S[J-1]] = G[S[J]] THEN BEGIN J ~ J-1; GO TO A2 END; + M ~ MTB[S[J]]; +A3: IF PRTB[M] = 0 THEN BEGIN ERROR(5); GO TO EXIT END; + N ~ J; +A4: N ~ N+1; + IF PRTB[M] < 0 THEN GO TO A8; + IF N { I THEN GO TO A7; +A5: M ~ M+1; + IF PRTB[M] } 0 THEN GO TO A5; +A6: M ~ M+2; GO TO A3; +A7: IF PRTB[M] ! S[N] THEN GO TO A5; + M ~ M+1; GO TO A4; +A8: IF N { I THEN GO TO A6; + GO TO BRANCH[-PRTB[M]]; +L0: S[J] ~ PRTB[M+1]; I ~ J; GO TO A1; + + COMMENT THE FOLLOWING ARE THE INTERPRETATION-RULES; +L1: +L2: P1(S[J]); NP ~ NP+1; MOVE(V[I], NL1[NP]); ZERO(V[I]); + NL2[NP] ~ BN; NL3[NP] ~ ON ~ ON+1; NL4[NP] ~ S[J]; GO TO L0; +L3: NP ~ NP+1; MOVE(V[I], NL1[NP]); ZERO(V[I]); + NL2[NP] ~ BN; NL3[NP] ~ NL4[NP] ~ UNDEF; GO TO L0; +L4: FOR T ~ NP STEP -1 UNTIL 1 DO + IF EQUAL(NL1[T], V[I]) THEN GO TO NAMEFOUND; + ERROR(0); GO TO L0; +NAMEFOUND: + IF NL4[T] = NEWSYM THEN + P3(REFSYM, NL3[T], NL2[T]) + ELSE IF NL4[T] = LABSYM THEN + P3(LABSYM, NL3[T], NL2[T]) + ELSE IF NL4[T] = FORSYM THEN + BEGIN P3(REFSYM, NL3[T], NL2[T]); P1(VALSYM) END + ELSE + BEGIN P3(LABSYM, NL3[T], NL2[T]); NL3[T] ~ PRP END; + GO TO L0; +L5: P1(S[I]); GO TO L0; +L6: P1(VALSYM); GO TO L0; +L10: +L9: V[J] ~ 0; GO TO L0; +L11: +L8: V[J] ~ 1; GO TO L0; +L12:V[J] ~ 2; GO TO L0; +L13:V[J] ~ 3; GO TO L0; +L14:V[J] ~ 4; GO TO L0; +L15:V[J] ~ 5; GO TO L0; +L16:V[J] ~ 6; GO TO L0; +L17:V[J] ~ 7; GO TO L0; +L18:V[J] ~ 8; GO TO L0; +L19:V[J] ~ 9; GO TO L0; +L20:SCALE ~ 1; GO TO L0; +L21:V[J] ~ V[J] | 10 + V[I]; SCALE ~ SCALE+1; + IF SCALE > 11 THEN ERROR(1); GO TO L0; +L23:V[J] ~ V[I] | 10 * (-SCALE) + V[J]; GO TO L0; +L26:V[J] ~ V[J] | 10 * V[I]; GO TO L0; +L27:V[J] ~ V[J] | .1 * V[I]; GO TO L0; +L28:V[J] ~ 10 * V[I]; GO TO L0; +L29:V[J] ~ .1 * V[I]; GO TO L0; +L31:V[J] ~ V[J]+1; GO TO L0; +L32:V[J] ~ 0; GO TO L0; +L33:P2(S[I], V[J]+1); GO TO L0; +L34:P2(S[I], V[J]); GO TO L0; +L36:BN ~ BN+1; ON ~ 0; P2(S[J], UNDEF); V[J] ~ PRP; + NP ~ NP+1; ZERO(NL1[NP]); NL2[NP] ~ MP; MP ~ NP; GO TO L0; +L37:P1(S[I]); FIXUP(V[J], PRP+1); NP ~ MP-1; MP ~ NL2[MP]; + BN ~ BN-1; GO TO L0; +L38:P1(VALSYM); GO TO L0; +L39:P1(CALLSYM); GO TO L0; +L40:P2(BOOLSYM, V[I]); GO TO L0; +L41:P1(NUMSYM); PRP ~ PRP+1; PROGRAM[PRP] ~ V[I]; GO TO L0; +L42:P2(S[I], V[I]); GO TO L0; +L75:P1(UNARYMINUS); GO TO L0; +L92: +L96: +L101: +L102:P2(S[I], UNDEF); V[J] ~ PRP; GO TO L0; +L93: +L97: FIXUP(V[J], PRP+1); GO TO L0; +L104:FIXUP(V[J], V[J+1]+1); FIXUP(V[J+1], PRP+1); GO TO L0; +L113:FOR T ~ NP STEP -1 UNTIL MP+1 DO + IF EQUAL(NL1[T], V[J]) THEN + BEGIN IF NL4[T] ! UNDEF THEN ERROR(2); + T1 ~ NL3[T]; NL3[T] ~ PRP+1; NL4[T] ~ LABSYM; ZERO(V[J]); +L1131: IF T1 ! UNDEF THEN + BEGIN T ~ PROGRAM[T1].BFIELD; FIXUP(T1, PRP+1); + T1 ~ T; GO TO L1131 + END; GO TO L0; + END; + ERROR(3); GO TO L0; +L114:BN ~ BN+1; ON ~ 0; P1(S[I]); + NP ~ NP+1; ZERO(NL1[NP]); NL2[NP] ~ MP; MP ~ NP; GO TO L0; +L118:P1(S[I]); GO TO L0; +L119:FOR T ~ MP+1 STEP 1 UNTIL NP DO IF NL4[T] = UNDEF THEN ERROR(4); + NP ~ MP-1; MP ~ NL2[MP]; P1(S[I]); BN ~ BN-1; GO TO L0; + +L45: +L47: +L49: +L50: +L51: +L52: +L53: +L54: +L55: +L56: +L57: +L58: +L59: +L60: +L61: +L62: +L63: +L91: +L106: +L107:P1(S[J]); GO TO L0; + +L65: +L68: +L69: +L70: +L71: +L76: +L77: +L80: +L81: +L84: +L85: +L86: +L87: +L88: +L89: +L99: +L105:P1(S[J+1]); GO TO L0; + +L7: +L22: +L24: +L25: +L30: +L35: +L43: +L44: +L46: +L48: +L64: +L66: +L67: +L72: +L73: +L74: +L78: +L79: +L82: +L83: +L90: +L94: +L95: +L98: +L100: +L103: +L108: +L109: +L110: +L111: +L112: +L115: +L116: +L117: +L120:GO TO L0; + +A9: P1(MARK); PROGRAMDUMP; IF ERRORFLAG THEN GO TO EXIT +END * ; + +BEGIN COMMENT E U L E R IV INTERPRETER MCKEEMAN & WIRTH; + REAL ARRAY S, SI, F, FI[0:1022]; COMMENT STACK; + INTEGER I1, I2, LVL, FORMALCOUNT; + INTEGER SP; COMMENT TOP-STACK POINTER; + INTEGER FP; COMMENT FREE STORAGE SPACE POINTER; + INTEGER MP; COMMENT BLOCK- OR PROCEDURE-MARK POINTER; + INTEGER PP; COMMENT PROGRAM POINTER; + LABEL ADD, SUB, MUL, DIVIDE, IDIV, REMAINDER, POWER, NEG, ABSV, + INTEGERIZE, REALL, LOGICAL, MIN, MAX, EQL, NEQ, LSS, LEQ, GEQ, GTR, + LENGTH, ISLOGICAL, ISNUMBER, ISREFERENCE, ISLABEL, ISSYMBOL, + ISLIST, ISPROCEDURE, ISUNDEFINED, LAND, LOR, LNOT, LEFTQUOTE, + RIGHTQUOTE, RIGHTPAREN, REFERENCE, PROCEDURECALL, VALUEOPERATOR, + GOTO, NEW, FORMAL, BEGINV, ENDV, STORE, THENV, ELSEV, NUMBER, LOGVAL, + LABELL, SUBSCRIPT, SEMICOLON, UNDEFIND, OUTPUT, INPUT, TAIL, + CATENATE, LISTT, SYMBOL, DONE, UNDEFINEDOPERATOR, NEXT, TRANSFER; + +COMMENT SI AND FI FIELD DEFINITIONS + 1-4 8-17 18-27 28-37 38-47 48-97 +NUMBER TYPE VALUE +BOOLEAN TYPE VALUE +SYMBOL TYPE VALUE +UNDEFINED TYPE +LIST TYPE LENGTH ADDRESS +REFERENCE TYPE MARK ADDRESS +LABEL TYPE MARK ADDRESS +BLOCKMARK TYPE DYNAMIC BLOCK NO. STATIC ADDRESS LIST; + + DEFINE TYPE=[1:4]#, + WCT=[28:10]#, + ADDRESS=[38:10]#, + STATIC=[28:10]#, + DYNAMIC=[8:10]#, + BLN=[18:10]#, + NSA=[18:10]#; COMMENT NEW STARTING ADDRESS FOR FREE; + DEFINE UNDEFINED=0#, + NUMBERTYPE=1#, + SYMBOLTYPE=2#, + BOOLEANTYPE=3#, + LABELTYPE=4#, + REFERENCETYPE=5#, + PROCEDURETYPE=6#, + LISTTYPE=7#, + BLOCKMARK=8#; + +STREAM PROCEDURE MOVE(F1, T1, W); + BEGIN LOCAL R1, R2; + SI ~ W; SI ~ SI + 6; + DI ~ LOC R1; DI ~ DI + 7; DS ~ CHR; + DI ~ LOC R2; DI ~ DI + 7; DS ~ CHR; + SI ~ F1; DI ~ T1; + R1(2(DS ~ 32 WDS)); DS ~ R2 WDS; + END; + +PROCEDURE DUMPOUT(XI, X); VALUE XI, X; REAL XI, X; + BEGIN INTEGER T, I; + +PROCEDURE LISTOUT(XI); VALUE XI; REAL XI; + BEGIN COMMENT RECURSIVE LIST OUTPUT; + INTEGER I, N; + SWITCH FORMAT LPAR ~ + ("("), (".("), ("..("),("...("), ("....("), (".....("), ("......("); + SWITCH FORMAT RPAR ~ + (")"), (".)"), ("..)"),("...)"), ("....)"), (".....)"), ("......)"); + WRITE (PRINFIL, , XI.ADDRESS); + WRITE (PRINFIL [NO], LPAR[LVL]); + LVL ~ LVL + 1; N ~ XI.ADDRESS + XI.WCT - 1; + FOR I ~ XI.ADDRESS STEP 1 UNTIL N DO DUMPOUT(FI[I], F[I]); + LVL ~ LVL - 1; WRITE (PRINFIL, RPAR[LVL]); + END LISTOUT; + + T ~ XI.TYPE; + IF T = UNDEFINED THEN + WRITE (PRINFIL, ) + ELSE IF T = NUMBERTYPE THEN + BEGIN + IF X ! ENTIER(X) THEN + WRITE (PRINFIL, , X) + ELSE + WRITE (PRINFIL, , X) + END + ELSE IF T = BOOLEANTYPE THEN +WRITE (PRINFIL, , BOOLEAN(X)) + ELSE IF T = LISTTYPE THEN LISTOUT(XI) + ELSE IF T = LABELTYPE THEN +WRITE (PRINFIL, , X) + END DUMPOUT; + +PROCEDURE ERROR(N); VALUE N; INTEGER N; + BEGIN INTEGER I; + SWITCH FORMAT ER ~ + ("ILLEGAL INSTRUCTION ENCOUNTERED"), + ("IMPROPER OPERAND TYPE"), + ("CANNOT DIVIDE BY 0"), + ("CALL OPERATOR DID NOT FIND A PROCEDURE"), + ("REFERENCE OR LABEL OUT OF SCOPE"), + ("OUT OF SCOPE ASSIGNMENT OF A LABEL OR A REFERENCE"), + ("SUBSCRIPT IS NOT A NUMBER"), + ("SUBSCRIPT NOT APPLIED TO A VARIABLE"), + ("SUBSCRIPTED VARIABLE IS NOT A LIST"), + ("SUBSCRIPT IS OUT OF BOUNDS"), + ("CANNOT TAKE TAIL OF A NULL LIST"), + ("STACK OVERFLOW"), + ("STACK OVERFLOW DURING GARBAGE COLLECTION"), + ("ASSIGNMENT TO A NON-VARIABLE ATTEMPTED"), + ("FREE STORAGE AREA IS TOO SMALL"); + WRITE (PRINFIL [DBL], ER[N]); +WRITE (PRINFIL, + , + SP, FP, PP, MP, PROGRAM[PP].AFIELD); + FOR I ~ 1 STEP 1 UNTIL SP DO + BEGIN WRITE(PRINFIL [NO], , I); + DUMPOUT(SI[I], S[I]) + END; + GO TO DONE + END ERROR; + +PROCEDURE FREE(NEED); VALUE NEED; INTEGER NEED; + COMMENT "FREE" IS A "GARBAGE COLLECTION" PROCEDURE. IT IS CALLED + WHEN FREE STORAGE F IS USED UP, AND MORE SPACE IS NEEDED. + GARBAGE COLLECTION TAKES THE FOLLOWING STEPS: + 1. ALL BLOCKMARKS, LIST DESCRIPTORS AND REFERENCES IN STACK + POINT TO VALID INFORMATION IN FREE STORAGE. LIKEWISE, ALL + LIST DESCRIPTORS AND REFERENCES THAT ARE POINTED TO ARE VALID, + ENTER INTO THE STACK ALL SUCH ENTITIES. + 2. THE GARBAGE COLLECTOR MUST KNOW IN WHICH ORDER TO COLLAPSE THE + FREE STORAGE. THUS SORT THE LIST BY FREE STORAGE ADDRESS. + 3. MOVE EACH BLOCK DOWN IF NECESSARY. + 4. NOW THE ADDRESSES ARE WRONG--MAKE ONE MORE PASS THROUGH THE + SORTED LIST TO UPDATE ALL ADDRESSES; + BEGIN OWN INTEGER G, H, I, J; OWN REAL T; + +INTEGER PROCEDURE FIND(W); VALUE W; REAL W; + BEGIN COMMENT BINARY SEARCH THROUGH ORDERED TABLE; + INTEGER T, N, B, KEY, K; + LABEL FOUND, BINARY; + T ~ G+1; B ~ SP + 1; + KEY ~ W.ADDRESS; +BINARY: N ~ (B+T) DIV 2; + K ~ SI[N].ADDRESS; + IF K = KEY THEN GO TO FOUND; + IF K < KEY THEN B ~ N ELSE T ~ N; + GO TO BINARY; +FOUND: FIND ~ SI[N].NSA + END FIND; + +PROCEDURE RESET(W, Z); REAL W, Z; + BEGIN INTEGER TY; + TY ~ W.TYPE; + IF TY = REFERENCETYPE OR TY = LISTTYPE THEN + W.ADDRESS ~ FIND(W) + ELSE IF TY = BLOCKMARK THEN + Z.ADDRESS ~ FIND(Z) + END RESET; + +PROCEDURE VALIDATE(P); VALUE P; REAL P; + BEGIN COMMENT TREE SEARCH FOR ACTIVE LIST STORAGE; + INTEGER I, U; + G ~ G + 1; + IF G > 1022 THEN ERROR(12); + SI[G] ~ P; + U ~ P.ADDRESS + P.WCT - 1; + IF P.TYPE = LISTTYPE THEN + FOR I ~ P.ADDRESS STEP 1 UNTIL U DO + IF FI[I].TYPE = LISTTYPE OR FI[I].TYPE = REFERENCETYPE THEN + VALIDATE(FI[I]); + END VALIDATION; + +PROCEDURE SORT(LB, UB); VALUE LB, UB; INTEGER LB, UB; + BEGIN COMMENT BINARY SORT; + INTEGER M; + +PROCEDURE MERGE(LB, M, UB); VALUE LB, M, UB; INTEGER LB, M, UB; + BEGIN INTEGER K,L,U,K1,K2; LABEL A, B; + K ~ UB - LB; + MOVE(SI[LB], S[LB], K); + L ~ K ~ LB; U ~ M; GO TO B; +A: K1 ~ S[L].ADDRESS; K2 ~ S[U].ADDRESS; + IF K1 < K2 OR (K1 = K2 AND S[L].TYPE = LISTTYPE) THEN + BEGIN SI[K] ~ S[L]; L ~ L+1 END + ELSE + BEGIN SI[K] ~ S[U]; U ~ U+1 END; + K ~ K + 1; +B: IF L = M THEN + ELSE IF U = UB THEN + BEGIN K ~ M-L; MOVE(S[L], SI[UB-K], K) END + ELSE + GO TO A + END MERGE; + + IF LB < UB THEN + BEGIN M ~ (LB+UB) DIV 2; + SORT(LB, M); SORT(M+1, UB); MERGE(LB, M+1, UB+1) + END + END SORT; + + INTEGER LLA, LLW; + G ~ SP; + FOR H ~ 1 STEP 1 UNTIL SP DO + BEGIN COMMENT LOCATE ALL ACTIVE LISTS AND REFERENCES; + IF SI[H].TYPE = LISTTYPE OR SI[H].TYPE = REFERENCETYPE THEN + VALIDATE(SI[H]) + ELSE IF SI[H].TYPE = BLOCKMARK THEN + VALIDATE(S[H]); + END + COMMENT SORT THEM IN ORDER OF INCREASING ADDRESS; + SORT(SP+1, G); + I ~ 1; COMMENT COLLAPSE THE FREE STORAGE; + FOR J ~ SP+1 STEP 1 UNTIL G DO + IF SI[J].TYPE = LISTTYPE THEN + BEGIN COMMENT IF G.C. OCCURS DURING "COPY" THEN WE MUST AVOID + THE CREATION OF DOUBLE LIST ENTRIES FROM DUPLICATED DESCRIPTORS; + IF SI[J] = SI[J+1] THEN SI[J+1].TYPE ~ UNDEFINED; + LLA ~ SI[J].ADDRESS; LLW ~ SI[J].WCT; + IF LLA ! I THEN + BEGIN + MOVE(F[LLA], F[I], LLW); + MOVE(FI[LLA], FI[I], LLW); + END; + SI[J].NSA ~ I; + I ~ I + LLW; + END + ELSE + SI[J].NSA ~ I - LLW + SI[J].ADDRESS - LLA; + FP ~ I; + + COMMENT RESET ALL AFFECTED ADDRESSES; + FOR I ~ 1 STEP 1 UNTIL SP DO RESET(SI[I], S[I]); + FOR I ~ 1 STEP 1 UNTIL FP-1 DO RESET(FI[I], F[I]); + IF FP + NEED > 1022 THEN ERROR(14); + END FREE; + +PROCEDURE MOVESEG(LD); REAL LD; + BEGIN COMMENT MOVE ONE LIST SEGMENT; + INTEGER W, X; + W ~ LD.WCT; + IF FP + W > 1022 THEN FREE(W); + X ~ LD.ADDRESS; + MOVE(F[X], F[FP], W); + MOVE(FI[X], FI[FP], W); + LD.ADDRESS ~ FP; + FP ~ FP + W; + END MOVE SEGMENT; + +PROCEDURE COPY(LD); REAL LD; + BEGIN INTEGER I, J; COMMENT RECURSIVE LIST COPY; + MOVESEG(LD); + J ~ LD.WCT - 1; + FOR I ~ 0 STEP 1 UNTIL J DO + IF FI[I+LD.ADDRESS].TYPE = LISTTYPE THEN COPY(FI[I+LD.ADDRESS]) + END COPY; + +PROCEDURE BOOLTEST; IF SI[SP].TYPE ! BOOLEANTYPE THEN ERROR(1); + +INTEGER PROCEDURE ROUND(X); VALUE X; REAL X; ROUND ~ X; + +PROCEDURE BARITH; + BEGIN + IF SI[SP].TYPE ! NUMBERTYPE OR SI[SP-1].TYPE ! NUMBERTYPE THEN + ERROR(1) + ELSE + SP ~ SP-1; + END BARITH; + +PROCEDURE FETCH; + BEGIN INTEGER I; + IF SI[SP].TYPE = REFERENCETYPE THEN + BEGIN I ~ SI[SP].ADDRESS; SI[SP] ~ FI[I]; S[SP] ~ F[I] END + END FETCH; + +INTEGER PROCEDURE MARKINDEX(BL); VALUE BL; INTEGER BL; + BEGIN COMMENT MARKINDEX IS THE INDEX OF THE MARK WITH BLOCKNUMBER BL; + LABEL U1; INTEGER I; + I ~ MP; +U1: IF SI[I].BLN > BL THEN + BEGIN I ~ SI[I].STATIC; GO TO U1 END; + IF SI[I].BLN < BL THEN ERROR(4); + MARKINDEX ~ I + END MARKINDEX; + +PROCEDURE LEVELCHECK(X, Y); VALUE Y; INTEGER Y; REAL X; + BEGIN INTEGER T, I, L, U; T ~ X.TYPE; + IF T = REFERENCETYPE OR T = LABELTYPE THEN + BEGIN IF X.STATIC > Y THEN ERROR(5) END + ELSE IF T = PROCEDURETYPE THEN + X.STATIC ~ Y + ELSE IF T = LISTTYPE THEN + BEGIN + L ~ X.ADDRESS; U ~ L + X.WCT - 1; + FOR I ~ L STEP 1 UNTIL U DO LEVELCHECK(FI[I], Y) + END + END LEVEL CHECK; + +PROCEDURE SPUP; IF SP } 1022 THEN ERROR(11) ELSE SP ~ SP + 1; + +PROCEDURE SETIS(V); VALUE V; INTEGER V; + BEGIN + FETCH; + S[SP] ~ REAL(SI[SP].TYPE = V); + SI[SP].TYPE ~ BOOLEANTYPE; + END SET IS; + + SWITCH EXECUTE ~ + PROCEDURECALL, VALUEOPERATOR, SEMICOLON, UNDEFINEDOPERATOR, + REFERENCE, NEW, FORMAL, LABELL, UNDEFINEDOPERATOR, LOGVAL, + SUBSCRIPT, BEGINV, ENDV, NUMBER, RIGHTPAREN, LEFTQUOTE, RIGHTQUOTE, + GOTO, OUTPUT, STORE, UNDEFINEDOPERATOR, THENV, ELSEV, CATENATE, + LOR, LAND, LNOT, EQL, NEQ, LSS, LEQ, GEQ, GTR, MIN, MAX, + ADD, SUB, MUL, DIVIDE, IDIV, REMAINDER, POWER, ABSV, LENGTH, + INTEGERIZE, REALL, LOGICAL, LISTT, TAIL, INPUT, + ISLOGICAL, ISNUMBER, ISREFERENCE, ISLABEL, ISLIST, ISSYMBOL, + ISPROCEDURE, ISUNDEFINED, SYMBOL, UNDEFIND, UNDEFINEDOPERATOR, NEG, + UNDEFINEDOPERATOR, UNDEFINEDOPERATOR, DONE; + + WRITE (PRINFIL [PAGE]); + SP ~ MP ~ PP ~ 0; FP ~ 1; LVL ~ 0; FT ~ FT+9; + +NEXT: + PP ~ PP+1; +TRANSFER: + GO TO EXECUTE[PROGRAM[PP].AFIELD - FT]; + +UNDEFINEDOPERATOR: + ERROR(0); +SEMICOLON: + SP ~ SP - 1; + GO TO NEXT; +UNDEFIND: + SPUP; + SI[SP].TYPE ~ UNDEFINED; + GO TO NEXT; +NUMBER: + PP ~ PP + 1; + SPUP; + SI[SP].TYPE ~ NUMBERTYPE; + S[SP] ~ PROGRAM[PP]; + GO TO NEXT; +SYMBOL: + SPUP; + SI[SP].TYPE ~ SYMBOLTYPE; + S[SP] ~ PROGRAM[PP].BFIELD; + GO TO NEXT; +LOGVAL: + SPUP; + SI[SP].TYPE ~ BOOLEANTYPE; + S[SP] ~ PROGRAM[PP].BFIELD; + GO TO NEXT; +REFERENCE: + SPUP; + SI[SP] ~ 0; + SI[SP].TYPE ~ REFERENCETYPE; + SI[SP].STATIC ~ I1 ~ MARKINDEX(PROGRAM[PP].CFIELD); + SI[SP].ADDRESS ~ S[I1].ADDRESS + PROGRAM[PP].BFIELD - 1; + GO TO NEXT; +LABELL: + SPUP; + SI[SP].TYPE ~ LABELTYPE; + SI[SP].STATIC ~ MARKINDEX(PROGRAM[PP].CFIELD); + SI[SP].ADDRESS ~ PROGRAM[PP].BFIELD; + GO TO NEXT; +CATENATE: + IF SI[SP].TYPE ! LISTTYPE OR SI[SP-1].TYPE ! LISTTYPE THEN ERROR(1); + IF SI[SP-1].ADDRESS + SI[SP-1].WCT ! SI[SP].ADDRESS THEN + BEGIN COMMENT MUST HAVE CONTIGUOUS LISTS; + MOVESEG(SI[SP-1]); + MOVESEG(SI[SP]); + END; + SP ~ SP - 1; + SI[SP].WCT ~ SI[SP].WCT + SI[SP+1].WCT; + GO TO NEXT; +LOR: + BOOLTEST; + IF NOT BOOLEAN(S[SP]) THEN + BEGIN + SP ~ SP - 1; + GO TO NEXT + END; + PP ~ PROGRAM[PP].BFIELD; + GO TO TRANSFER; +LAND: + BOOLTEST; + IF BOOLEAN(S[SP]) THEN + BEGIN + SP ~ SP - 1; + GO TO NEXT + END; + PP ~ PROGRAM[PP].BFIELD; + GO TO TRANSFER; +LNOT: + BOOLTEST; + S[SP] ~ REAL(NOT BOOLEAN(S[SP])); + GO TO NEXT; +LSS: + BARITH; + S[SP] ~ REAL(S[SP] < S[SP+1]); + SI[SP].TYPE ~ BOOLEANTYPE; + GO TO NEXT; +LEQ: + BARITH; + S[SP] ~ REAL(S[SP] { S[SP+1]); + SI[SP].TYPE ~ BOOLEANTYPE; + GO TO NEXT; +EQL: + BARITH; + S[SP] ~ REAL(S[SP] = S[SP+1]); + SI[SP].TYPE ~ BOOLEANTYPE; + GO TO NEXT; +NEQ: + BARITH; + S[SP] ~ REAL(S[SP] ! S[SP+1]); + SI[SP].TYPE ~ BOOLEANTYPE; + GO TO NEXT; +GEQ: + BARITH; + S[SP] ~ REAL(S[SP] } S[SP+1]); + SI[SP].TYPE ~ BOOLEANTYPE; + GO TO NEXT; +GTR: + BARITH; + S[SP] ~ REAL(S[SP] > S[SP+1]); + SI[SP].TYPE ~ BOOLEANTYPE; + GO TO NEXT; +MIN: + BARITH; + IF S[SP+1] < S[SP] THEN S[SP] ~ S[SP+1]; + GO TO NEXT; +MAX: + BARITH; + IF S[SP+1] > S[SP] THEN S[SP] ~ S[SP+1]; + GO TO NEXT; +ADD: + BARITH; + S[SP] ~ S[SP] + S[SP+1]; + GO TO NEXT; +SUB: + BARITH; + S[SP] ~ S[SP] - S[SP+1]; + GO TO NEXT; +NEG: + IF SI[SP].TYPE ! NUMBERTYPE THEN ERROR(1); + S[SP] ~ -S[SP]; + GO TO NEXT; +MUL: + BARITH; + S[SP] ~ S[SP] | S[SP+1]; + GO TO NEXT; +DIVIDE: + BARITH; + IF S[SP+1] = 0 THEN ERROR(2); + S[SP] ~ S[SP] / S[SP+1]; + GO TO NEXT; +IDIV: + BARITH; + IF ROUND(S[SP+1]) = 0 THEN ERROR(2); + S[SP] ~ ROUND(S[SP]) DIV ROUND(S[SP+1]); + GO TO NEXT; +REMAINDER: + BARITH; + IF S[SP+1] = 0 THEN ERROR(2); + S[SP] ~ S[SP] MOD S[SP+1]; + GO TO NEXT; +POWER: + BARITH; + S[SP] ~ S[SP] * S[SP+1]; + GO TO NEXT; +ABSV: + IF SI[SP].TYPE ! NUMBERTYPE THEN ERROR(1); + S[SP] ~ ABS(S[SP]); + GO TO NEXT; +REALL: + IF SI[SP].TYPE > BOOLEANTYPE THEN ERROR(1); + SI[SP].TYPE ~ NUMBERTYPE; + GO TO NEXT; +LOGICAL: + IF SI[SP].TYPE ! NUMBERTYPE THEN ERROR(1); + IF S[SP] = 0 OR S[SP] = 1 THEN + SI[SP].TYPE ~ BOOLEANTYPE + ELSE + SI[SP].TYPE ~ UNDEFINED; + GO TO NEXT; +LISTT: + IF SI[SP].TYPE ! NUMBERTYPE THEN ERROR(1); + I2 ~ S[SP]; + IF I2 + FP > 1022 THEN FREE(I2); + FOR I1 ~ FP STEP 1 UNTIL FP+I2-1 DO + FI[I1].TYPE ~ UNDEFINED; + SI[SP].TYPE ~ LISTTYPE; + SI[SP].WCT ~ I2; + SI[SP].ADDRESS ~ FP; + FP ~ FP + I2; + GO TO NEXT; + +ISLOGICAL: + SETIS(BOOLEANTYPE); + GO TO NEXT; +ISNUMBER: + SETIS(NUMBERTYPE); + GO TO NEXT; +ISREFERENCE: + SETIS(REFERENCETYPE); + GO TO NEXT; +ISLABEL: + SETIS(LABELTYPE); + GO TO NEXT; +ISLIST: + SETIS(LISTTYPE); + GO TO NEXT; +ISSYMBOL: + SETIS(SYMBOLTYPE); + GO TO NEXT; +ISPROCEDURE: + SETIS(PROCEDURETYPE); + GO TO NEXT; +ISUNDEFINED: + SETIS(UNDEFINED); + GO TO NEXT; + +TAIL: + IF SI[SP].TYPE ! LISTTYPE THEN ERROR(1); + IF SI[SP].WCT = 0 THEN ERROR(10); + SI[SP].WCT ~ SI[SP].WCT - 1; + SI[SP].ADDRESS ~ SI[SP].ADDRESS + 1; + GO TO NEXT; +THENV: + BOOLTEST; + SP ~ SP - 1; + IF BOOLEAN(S[SP+1]) THEN + GO TO NEXT; + PP ~ PROGRAM[PP].BFIELD; + GO TO TRANSFER; +ELSEV: + PP ~ PROGRAM[PP].BFIELD; + GO TO TRANSFER; +LENGTH: + FETCH; + IF SI[SP].TYPE ! LISTTYPE THEN ERROR(1); + SI[SP].TYPE ~ NUMBERTYPE; + S[SP] ~ SI[SP].WCT; + GO TO NEXT; +GOTO: + IF SI[SP].TYPE ! LABELTYPE THEN ERROR(1); + MP ~ SI[SP].STATIC; + COMMENT WE MUST RETURN TO THE BLOCK WHERE THE LABEL IS DEFINED; + PP ~ SI[SP].ADDRESS; + SP ~ MP; + GO TO TRANSFER; +FORMAL: + FORMALCOUNT ~ FORMALCOUNT + 1; + IF FORMALCOUNT { S[MP].WCT THEN + GO TO NEXT + ELSE + GO TO NEW; +NEW: + S[MP].WCT ~ S[MP].WCT + 1; + FI[FP].TYPE ~ UNDEFINED; + FP ~ FP + 1; + IF FP > 1022 THEN FREE(1); + GO TO NEXT; +STORE: + IF SI[SP-1].TYPE ! REFERENCETYPE THEN ERROR(13); + LEVELCHECK(SI[SP], SI[SP-1].STATIC); + SP ~ SP - 1; COMMENT NON-DESTRUCTIVE STORE; + I1 ~ SI[SP].ADDRESS; + S[SP] ~ F[I1] ~ S[SP+1]; + SI[SP] ~ FI[I1] ~ SI[SP+1]; + COMMENT THE NON-DESTRUCTIVE STORE IS NOT APPLICABLE TO LISTS; + IF SI[SP].TYPE = LISTTYPE THEN SI[SP].TYPE ~ UNDEFINED; + GO TO NEXT; +SUBSCRIPT: + IF SI[SP].TYPE ! NUMBERTYPE THEN ERROR(6); + SP ~ SP - 1; + IF SI[SP].TYPE ! REFERENCETYPE THEN ERROR(7); + I1 ~ SI[SP].STATIC; SI[SP] ~ FI[SI[SP].ADDRESS]; + IF SI[SP].TYPE ! LISTTYPE THEN ERROR(8); + IF S[SP+1] < 1 OR S[SP+1] > SI[SP].WCT THEN ERROR(9); + SI[SP].ADDRESS ~ SI[SP].ADDRESS + S[SP+1] - 1; + SI[SP].TYPE ~ REFERENCETYPE; COMMENT MUST CREATE A REFERENCE; + SI[SP].STATIC ~ I1; GO TO NEXT; +BEGINV: + SPUP; + SI[SP] ~ 0; + SI[SP].TYPE ~ BLOCKMARK; + SI[SP].BLN ~ SI[MP].BLN + 1; + SI[SP].DYNAMIC ~ MP; + SI[SP].STATIC ~ MP; + S[SP].TYPE ~ LISTTYPE; + S[SP].ADDRESS ~ FP; + S[SP].WCT ~ 0; COMMENT A NULL LIST; + MP ~ SP; + GO TO NEXT; +ENDV: + I1 ~ SI[MP].DYNAMIC; + LEVELCHECK(SI[SP], SI[MP].STATIC); + SI[MP] ~ SI[SP]; + S[MP] ~ S[SP]; + SP ~ MP; + MP ~ I1; + GO TO NEXT; +LEFTQUOTE: COMMENT PROCEDURE DECLARATION; + SPUP; + SI[SP].TYPE ~ PROCEDURETYPE; + SI[SP].ADDRESS ~ PP; + COMMENT THE PROCEDURE DESCRIPTOR MUST SAVE ITS OWN LEXICOGRAPHICAL + LEVEL AS WELL AS THE STACK MARKER FOR UPLEVEL ADDRESSED VARIABLES; + SI[SP].BLN ~ SI[MP].BLN + 1; + SI[SP].STATIC ~ MP; + PP ~ PROGRAM[PP].BFIELD; + GO TO TRANSFER; +RIGHTQUOTE: + PP ~ SI[MP].ADDRESS; COMMENT A PROCEDURE RETURN; + I1 ~ SI[MP].DYNAMIC; + LEVELCHECK(SI[SP], SI[MP].STATIC); + SI[MP] ~ SI[SP]; + S[MP] ~ S[SP]; + SP ~ MP; + MP ~ I1; + GO TO NEXT; +VALUEOPERATOR: + IF SI[SP].TYPE = LISTTYPE THEN + GO TO NEXT; + FETCH; + IF SI[SP].TYPE = PROCEDURETYPE THEN + BEGIN + FORMALCOUNT ~ 0; + I1 ~ SI[SP].ADDRESS; + SI[SP].TYPE ~ BLOCKMARK; + SI[SP].ADDRESS ~ PP; + SI[SP].DYNAMIC ~ MP; + S[SP].TYPE ~ LISTTYPE; + S[SP].WCT ~ 0; + MP ~ SP; + PP ~ I1; + END + ELSE IF SI[SP].TYPE = LISTTYPE THEN + COPY(SI[SP]); + GO TO NEXT; +PROCEDURECALL: + SP ~ SP - 1; + FETCH; + IF SI[SP].TYPE ! PROCEDURETYPE THEN ERROR(3); + FORMALCOUNT ~ 0; + I1 ~ SI[SP].ADDRESS; + SI[SP].TYPE ~ BLOCKMARK; + SI[SP].ADDRESS ~ PP; + SI[SP].DYNAMIC ~ MP; + S[SP] ~ SI[SP+1]; COMMENT THE LIST DESC. FOR PARAMETERS; + MP ~ SP; + PP ~ I1; + GO TO NEXT; +RIGHTPAREN: + I1 ~ PROGRAM[PP].BFIELD; + IF I1 + FP > 1022 THEN FREE(I1); + SP ~ SP - I1 + 1; + MOVE(S[SP], F[FP], I1); + MOVE(SI[SP], FI[FP], I1); + SI[SP].TYPE ~ LISTTYPE; + SI[SP].WCT ~ I1; + SI[SP].ADDRESS ~ FP; + FP ~ FP + I1; + GO TO NEXT; +INPUT: + SPUP; + READ (CARDFIL, /, S[SP]) [EXIT]; + SI[SP].TYPE ~ NUMBERTYPE; + GO TO NEXT; +OUTPUT: + DUMPOUT(SI[SP], S[SP]); + GO TO NEXT; +INTEGERIZE: + GO TO NEXT; +DONE: + END INTERPRETER; + +EXIT: +END. +?DATA CARDFIL +BEGIN NEW FOR; NEW MAKE; NEW T; NEW A; +FOR ~ LQ FORMAL CV; FORMAL LB; FORMAL STEP; + FORMAL UB; FORMAL S; +BEGIN + LABEL L; LABEL K; + CV ~ LB; + K: IF CV { UB THEN S ELSE GOTO L; + CV ~ CV + STEP; + GOTO K; + L: 0 +END RQ; + +MAKE ~ LQ FORMAL B; FORMAL X; +BEGIN NEW T; NEW I; NEW F; NEW L; + L ~ B; T ~ LIST L[1]; + F ~ IF LENGTH L ! 1 THEN MAKE(TAIL L, X) ELSE X; + FOR (@I, 1, 1, L[1], LQ T[I] ~ F RQ); + T +END RQ; + + A ~ (); + FOR (@T, 1, 1, 4, LQ BEGIN A ~ A & (T); + OUT MAKE(@A,T) END RQ) +END $ +DUMP +?END diff --git a/source/EULER/GRAMMAR.card b/source/EULER/GRAMMAR.card new file mode 100644 index 0000000..fb208c4 --- /dev/null +++ b/source/EULER/GRAMMAR.card @@ -0,0 +1,242 @@ + PROGRAM + BLOCK + BLOKHEAD + BLOKBODY + LABDEF + STAT + STAT- + EXPR + EXPR- + IFCLAUSE + TRUEPART + CATENA + DISJ + DISJHEAD + CONJ + CONJ- + CONJHEAD + NEGATION + RELATION + CHOICE + CHOICE- + SUM + SUM- + TERM + TERM- + FACTOR + FACTOR- + PRIMARY + PROCDEF + PROCHEAD + LIST* + LISTHEAD + REFERENC + NUMBER + REAL* + INTEGER* + INTEGER- + DIGIT + LOGVAL + VAR + VAR- + VARDECL + FORDECL + LABDECL +* + 0 + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + , + . + ; + : + @ + NEW + FORMAL + LABEL + IDENT* + [ + ] + BEGIN + END + ( + ) + LQ + RQ + GOTO + OUT + ~ + IF + THEN + ELSE + & + OR + AND + NOT + = + ! + < + { + } + > + MIN + MAX + + + - + | + / + % + MOD + * + ABS + LENGTH + INTEGER + REAL + LOGICAL + LIST + TAIL + IN + ISB + ISN + ISR + ISL + ISLI + ISY + ISP + ISU + SYMBOL* + UNDEFINE + TEN + # + TRUE + FALSE + $ +* + VARDECL NEW IDENT* 001 + FORDECL FORMAL IDENT* 002 + LABDECL LABEL IDENT* 003 + VAR- IDENT* 004 + VAR- VAR- [ EXPR ] 005 + VAR- VAR- . 006 + VAR VAR- 007 + LOGVAL TRUE 010 + LOGVAL FALSE 011 + DIGIT 0 012 + DIGIT 1 013 + DIGIT 2 014 + DIGIT 3 015 + DIGIT 4 016 + DIGIT 5 017 + DIGIT 6 020 + DIGIT 7 021 + DIGIT 8 022 + DIGIT 9 023 + INTEGER- DIGIT 024 + INTEGER- INTEGER- DIGIT 025 + INTEGER* INTEGER- 026 + REAL* INTEGER* . INTEGER* 027 + REAL* INTEGER* 030 + NUMBER REAL* 031 + NUMBER REAL* TEN INTEGER* 032 + NUMBER REAL* TEN # INTEGER* 033 + NUMBER TEN INTEGER* 034 + NUMBER TEN # INTEGER* 035 + REFERENC @ VAR 036 + LISTHEAD LISTHEAD EXPR , 037 + LISTHEAD ( 040 + LIST* LISTHEAD EXPR ) 041 + LIST* LISTHEAD ) 042 + PROCHEAD PROCHEAD FORDECL ; 043 + PROCHEAD LQ 044 + PROCDEF PROCHEAD EXPR RQ 045 + PRIMARY VAR 046 + PRIMARY VAR LIST* 047 + PRIMARY LOGVAL 050 + PRIMARY NUMBER 051 + PRIMARY SYMBOL* 052 + PRIMARY REFERENC 053 + PRIMARY LIST* 054 + PRIMARY TAIL PRIMARY 055 + PRIMARY PROCDEF 056 + PRIMARY UNDEFINE 057 + PRIMARY [ EXPR ] 060 + PRIMARY IN 061 + PRIMARY ISB VAR 062 + PRIMARY ISN VAR 063 + PRIMARY ISR VAR 064 + PRIMARY ISL VAR 065 + PRIMARY ISLI VAR 066 + PRIMARY ISY VAR 067 + PRIMARY ISP VAR 070 + PRIMARY ISU VAR 071 + PRIMARY ABS PRIMARY 072 + PRIMARY LENGTH VAR 073 + PRIMARY INTEGER PRIMARY 074 + PRIMARY REAL PRIMARY 075 + PRIMARY LOGICAL PRIMARY 076 + PRIMARY LIST PRIMARY 077 + FACTOR- PRIMARY 100 + FACTOR- FACTOR- * PRIMARY 101 + FACTOR FACTOR- 102 + TERM- FACTOR 103 + TERM- TERM- | FACTOR 104 + TERM- TERM- / FACTOR 105 + TERM- TERM- % FACTOR 106 + TERM- TERM- MOD FACTOR 107 + TERM TERM- 110 + SUM- TERM 111 + SUM- + TERM 112 + SUM- - TERM 113 + SUM- SUM- + TERM 114 + SUM- SUM- - TERM 115 + SUM SUM- 116 + CHOICE- SUM 117 + CHOICE- CHOICE- MIN SUM 120 + CHOICE- CHOICE- MAX SUM 121 + CHOICE CHOICE- 122 + RELATION CHOICE 123 + RELATION CHOICE = CHOICE 124 + RELATION CHOICE ! CHOICE 125 + RELATION CHOICE < CHOICE 126 + RELATION CHOICE { CHOICE 127 + RELATION CHOICE } CHOICE 130 + RELATION CHOICE > CHOICE 131 + NEGATION RELATION 132 + NEGATION NOT RELATION 133 + CONJHEAD NEGATION AND 134 + CONJ- CONJHEAD CONJ- 135 + CONJ- NEGATION 136 + CONJ CONJ- 137 + DISJHEAD CONJ OR 140 + DISJ DISJHEAD DISJ 141 + DISJ CONJ 142 + CATENA CATENA & PRIMARY 143 + CATENA DISJ 144 + TRUEPART EXPR ELSE 145 + IFCLAUSE IF EXPR THEN 146 + EXPR- BLOCK 147 + EXPR- IFCLAUSE TRUEPART EXPR- 150 + EXPR- VAR ~ EXPR- 151 + EXPR- GOTO PRIMARY 152 + EXPR- OUT EXPR- 153 + EXPR- CATENA 154 + EXPR EXPR- 155 + STAT- LABDEF STAT- 156 + STAT- EXPR 157 + STAT STAT- 160 + LABDEF IDENT* : 161 + BLOKHEAD BEGIN 162 + BLOKHEAD BLOKHEAD VARDECL ; 163 + BLOKHEAD BLOKHEAD LABDECL ; 164 + BLOKBODY BLOKHEAD 165 + BLOKBODY BLOKBODY STAT ; 166 + BLOCK BLOKBODY STAT END 167 + PROGRAM $ BLOCK $ 170 +* diff --git a/source/EULER/SAMPLE.card b/source/EULER/SAMPLE.card new file mode 100644 index 0000000..572ddd8 --- /dev/null +++ b/source/EULER/SAMPLE.card @@ -0,0 +1,24 @@ + +BEGIN NEW FOR; NEW MAKE; NEW T; NEW A; +FOR ~ LQ FORMAL CV; FORMAL LB; FORMAL STEP; FORMAL UB; FORMAL S; +BEGIN + LABEL L; LABEL K; + CV ~ LB; + K: IF CV { UB THEN S ELSE GOTO L; + CV ~ CV + STEP; + GOTO K; + L: 0 +END RQ; + +MAKE ~ LQ FORMAL B; FORMAL X; +BEGIN NEW T; NEW I; NEW F; NEW L; + L ~ B; T ~ LIST L[1]; + F ~ IF LENGTH L ! 1 THEN MAKE(TAIL L, X) ELSE X; + FOR (@I, 1, 1, L[1], LQ T[I] ~ F RQ); + T +END RQ; + + A ~ (); + FOR (@T, 1, 1, 4, LQ BEGIN A ~ A & (T); OUT MAKE(@A,T) END RQ) +END $ +DUMP diff --git a/source/EULER/SYNTAX.alg_m b/source/EULER/SYNTAX.alg_m new file mode 100644 index 0000000..0d353ae --- /dev/null +++ b/source/EULER/SYNTAX.alg_m @@ -0,0 +1,433 @@ +BEGIN COMMENT SYNTAX-PROCESSOR. NIKLAUS WIRTH DEC.1964; + DEFINE NSY =150#; COMMENT MAX. NO. OF SYMBOLS; + DEFINE NPR =150#; COMMENT MAX. NO. OF PRODUCTIONS; + DEFINE UPTO = STEP 1 UNTIL #; + DEFINE LS = "<" #, EQ = "=" #, GR = ">" #, NULL = "" #; + FILE OUT PCH 0 (2,10); COMMENT PUNCH FILE; + INTEGER LT; COMMENT NUMBER OF LAST NONBASIC SYMBOL; + INTEGER K,M,N, MAX, OLDN; BOOLEAN ERRORFLAG; + ALPHA ARRAY READBUFFER[0:9], WRITEBUFFER[0:14]; + ALPHA ARRAY TEXT[0:11]; COMMENT AUXILIARY TEXT ARRAY; + ALPHA ARRAY SYTB[0:NSY]; COMMENT SYMBOLTABLE; + INTEGER ARRAY REF[0:NPR,0:5]; COMMENT SYNTAX REFERENCE TABLE; + LABEL START,EXIT; + LABEL A,B,C,E,F,G; + +STREAM PROCEDURE CLEAR(D,N); VALUE N; + BEGIN DI ~ D; DS ~ 8 LIT " "; SI ~ D; DS ~ N WDS + END; +STREAM PROCEDURE MARK(D,S); VALUE S; + BEGIN DI ~ D; SI ~ LOC S; SI ~ SI+7; DS ~ CHR + END; +BOOLEAN STREAM PROCEDURE FINIS(S); + BEGIN TALLY ~ 1; SI ~ S; IF SC = "*" THEN FINIS ~ TALLY + END; +STREAM PROCEDURE EDIT(S,D,N); + BEGIN DI ~ D; SI ~ N; DS ~ 3 DEC; SI ~ S; DS ~ 9 WDS; + END; +STREAM PROCEDURE MOVE(S,D); + BEGIN SI ~ S; DI ~ D; DS ~ WDS; + END; +STREAM PROCEDURE MOVETEXT(S,D,N); VALUE N; + BEGIN DI ~ D; SI ~ S; DS ~ N WDS; + END; +BOOLEAN STREAM PROCEDURE EQUAL(S,D); + BEGIN SI ~ S; DI ~ D; TALLY ~ 1; IF 8 SC = DC THEN EQUAL ~ TALLY; + END; +STREAM PROCEDURE SCAN(S,DD,N); + BEGIN LABEL A,B,C,D,E; + SI ~ S; DI ~ DD; DS ~ 48 LIT "0"; DI ~ DD; SI ~ SI+1; + IF SC = " " THEN DI ~ DI+8; + A: IF SC = " " THEN BEGIN SI ~ SI+1; GO TO A END; + IF SC > "9" THEN GO TO D; + 8 (IF SC = " " THEN BEGIN DS ~ LIT " "; GO TO E END; DS ~ CHR; E:); + B: IF SC ! " " THEN BEGIN SI ~ SI+1; GO TO B END; + C: SI ~ SI+1; GO TO A; + D: DI ~ N; SI ~ SI+5; DS ~ 3 OCT + END; +STREAM PROCEDURE EDITTEXT(S,D,N); VALUE N; + BEGIN SI ~ S; DI ~ D; DI ~ DI+10; N(DI ~ DI+2; DS ~ 8 CHR) + END; +STREAM PROCEDURE SETTEXT(A,B,C,D,E,Z); + BEGIN DI ~ Z; DI ~ DI+8; SI ~ A; DS ~ 3 DEC; SI ~ B; DS ~ WDS; + DI ~ DI+5; SI ~ C; DS ~ 3 DEC; DI ~ DI+3; SI ~ D; DS ~ 3 DEC; + DI ~ DI+3; SI ~ E; DS ~ 3 DEC; + END; +STREAM PROCEDURE PCHTX(S,D,N); VALUE N; + BEGIN SI ~ S; DI ~ D; DI ~ DI+4; + N(DS ~ LIT """; DS ~ 8 CHR; DS ~ LIT """; DS ~ LIT ","); + END; +PROCEDURE INPUT; + READ (CARDFIL, 10, READBUFFER[*]) [EXIT]; +PROCEDURE OUTPUT; + BEGIN WRITE (PRINTFIL, 15, WRITEBUFFER[*]); + CLEAR(WRITEBUFFER[0], 14); + END; +INTEGER PROCEDURE INX(X); REAL X; + BEGIN INTEGER I; LABEL F; + FOR I ~ 0 UPTO M DO + IF EQUAL(SYTB[I], X) THEN GO TO F; + WRITE (<"UNDEFINED SYMBOL">); ERRORFLAG ~ TRUE; + F: INX ~ I; + END; + +START: + FOR N ~ 0 UPTO 5 DO + FOR M ~ 0 UPTO NPR DO REF[M,N] ~ 0; + M ~ N ~ MAX ~ OLDN ~ 0; ERRORFLAG ~ FALSE; + CLEAR(WRITEBUFFER[0],14); + COMMENT READ LIST OF SYMBOLS, ONE SYMBOL MUST APPEAR PER CARD, + STARTING IN COL.9 (8 CHARS. ARE SIGNIFICANT), THE LIST OF NON- + BASIC SYMBOLS IS FOLLOWED BY AN ENDCARD ("*" IN COL.1). THEN + FOLLOWS THE LIST OF BASIC SYMBOLS AND AGAIN AN ENDCARD; + WRITE (< "NONBASIC SYMBOLS:">); +A: INPUT; + IF FINIS(READBUFFER[0]) THEN GO TO E; + M ~ M+1; + MOVE(READBUFFER[1], SYTB[M]); + EDIT(READBUFFER[0], WRITEBUFFER[1], M); + OUTPUT; GO TO A; +E: WRITE (); LT ~ M; +F: INPUT; + IF FINIS(READBUFFER[0]) THEN GO TO G; + M ~ M + 1; + MOVE(READBUFFER[1], SYTB[M]); + EDIT(READBUFFER[0], WRITEBUFFER[1], M); + OUTPUT; GO TO F; + + COMMENT READ THE LIST OF PRODUCTIONS, ONE PER CARD. THE LEFTPART + IS A NONBASIC SYMBOL STARTING IN COL.2. NO FORMAT IS PRESCRIBED + FOR THE RIGHT PART. ONE OR MORE BLANKS ACT AS SYMBOL SEPARATORS. + IF COL.2 IS BLANK, THE SAME LEFTPART AS IN THE PREVIOUS PRODUCTION + IS SUBSTITUTED. THE MAX. LENGTH OF A PRODUCTION IS 6 SYMBOLS; +G: WRITE (); +B: INPUT; + IF FINIS(READBUFFER[0]) THEN GO TO C; + MOVETEXT(READBUFFER[0], WRITEBUFFER[1], 10); OUTPUT; + MARK(READBUFFER[9], 12); SCAN(READBUFFER[0],TEXT[0],N); + IF N { 0 OR N > NPR OR REF[N,0] ! 0 THEN + BEGIN WRITE (<"UNACCEPTABLE TAG">); ERRORFLAG ~ TRUE; GO TO B + END; + IF N > MAX THEN MAX ~ N; + COMMENT THE SYNTAX IS STORED IN REF, EACH SYMBOL REPRESENTED BY + ITS INDEX IN THE SYMBOL-TABLE; + FOR K ~ 0 UPTO 5 DO REF[N,K] ~ INX(TEXT[K]); + IF REF[N,0] = 0 THEN REF[N,0] ~ REF[OLDN,0] ELSE + IF REF[N,0] > LT THEN + BEGIN WRITE (<"ILLEGAL PRODUCTION">); ERRORFLAG ~ TRUE END; + OLDN ~ N; GO TO B; +C: IF ERRORFLAG THEN GO TO EXIT; + N ~ MAX; + COMMENT M IS THE LENGTH OF THE SYMBOL-TABLE, N OF THE REF-TABLE; + +BEGIN COMMENT BLOCK A; + INTEGER ARRAY H[0:M, 0:M]; COMMENT PRECEDENCE MATRIX; + INTEGER ARRAY F, G [0:M]; COMMENT PRECEDENCE FUNCTIONS; +BEGIN COMMENT BLOCK B1; + INTEGER ARRAY LINX, RINX [0:LT]; COMMENT LEFT / RIGHT INDICES; + INTEGER ARRAY LEFTLIST, RIGHTLIST[0:1022]; +BEGIN COMMENT BLOCK C1, BUILD LEFT- AND RIGHT-SYMBOL LISTS; + INTEGER I,J; + INTEGER SP, RSP; COMMENT STACK- AND RECURSTACK-POINTERS; + INTEGER LP, RP; COMMENT LEFT/RIGHT LIST POINTERS; + INTEGER ARRAY INSTACK[0:M]; + BOOLEAN ARRAY DONE, ACTIVE [0:LT]; + INTEGER ARRAY RECURSTACK, STACKMARK [0:LT+1]; + INTEGER ARRAY STACK[0:1022]; COMMENT HERE THE LISTS ARE BUILT; + +PROCEDURE PRINTLIST(LX,L); ARRAY LX, L [0]; + BEGIN INTEGER I,J,K; + FOR I ~ 1 UPTO LT DO IF DONE[I] THEN + BEGIN K ~ 0; MOVE(SYTB[I], WRITEBUFFER[0]); + FOR J ~ LX[I],J+1 WHILE L[J] ! 0 DO + BEGIN MOVE(SYTB[L[J]], TEXT[K]); K ~ K+1; + IF K } 10 THEN + BEGIN EDITTEXT(TEXT[0], WRITEBUFFER[0],10); OUTPUT; + K ~ 0; + END; + END; + IF K > 0 THEN + BEGIN EDITTEXT(TEXT[0], WRITEBUFFER[0], K); OUTPUT END; + END + END; +PROCEDURE DUMPIT; + BEGIN INTEGER I,J; WRITE ([PAGE]); + WRITE (); + WRITE (<5I6>, FOR I ~ 1 UPTO LT DO + [I, DONE[I], ACTIVE[I], LINX[I], RINX[I]]); + WRITE (, SP); + WRITE (, FOR I ~ 0 STEP 10 UNTIL SP DO + [I, FOR J ~ I UPTO I+9 DO STACK[J]]); + WRITE (); + WRITE (<3I6>, FOR I ~ 1 UPTO RSP DO + [I, RECURSTACK[I], STACKMARK[I]]); + END; +PROCEDURE RESET(X); VALUE X; INTEGER X; + BEGIN INTEGER I; + FOR I ~ X UPTO RSP DO STACKMARK[I] ~ STACKMARK[X]; + END; +PROCEDURE PUTINTOSTACK(X); VALUE X; INTEGER X; + COMMENT X IS PUT INTO THE WORKSTACK. DUPLICATION IS AVOIDED! + BEGIN IF INSTACK[X] = 0 THEN + BEGIN SP ~ SP+1; STACK[SP] ~ X; INSTACK[X] ~ SP END + ELSE IF INSTACK[X] < STACKMARK[RSP] THEN + BEGIN SP ~ SP+1; STACK[SP] ~ X; + STACK[INSTACK[X]] ~ 0; INSTACK[X] ~ SP; + END; + IF SP > 1020 THEN + BEGIN WRITE (); DUMPIT; GO TO EXIT END; + END; +PROCEDURE COPYLEFTSYMBOLS(X); VALUE X; INTEGER X; + COMMENT COPY THE LIST OF LEFTSYMBOLS OF X INTO THE STACK; + BEGIN FOR X ~ LINX[X], X+1 WHILE LEFTLIST[X] ! 0 DO + PUTINTOSTACK(LEFTLIST[X]); + END; +PROCEDURE COPYRIGHTSYMBOLS(X); VALUE X; INTEGER X; + COMMENT COPY THE LIST OF RIGHTSYMBOLS OF X INTO THE STACK; + BEGIN FOR X ~ RINX[X], X+1 WHILE RIGHTLIST[X] ! 0 DO + PUTINTOSTACK(RIGHTLIST[X]); + END; +PROCEDURE SAVELEFTSYMBOLS(X); VALUE X; INTEGER X; + COMMENT THE LEFTSYMBOLLISTS OF ALL SYMBOLS IN THE RECURSTACK + WITH INDEX > X HAVE BEEN BUILT AND MUST NOW BE REMOVED, THEY ARE + COPIED INTO "LEFTLIST" AND THE SYMBOLS ARE MARKED "DONE"; + BEGIN INTEGER I,J,U; LABEL L,EX; + L: IF STACKMARK[X] = STACKMARK[X+1] THEN + BEGIN X ~ X+1; IF X < RSP THEN GO TO L ELSE GO TO EX END; + STACKMARK[RSP+1] ~ SP+1; + FOR I ~ X+1 UPTO RSP DO + BEGIN LINX[RECURSTACK[I]] ~ LP+1; + ACTIVE[RECURSTACK[I]] ~ FALSE; DONE[RECURSTACK[I]] ~ TRUE; + FOR J ~ STACKMARK[I] UPTO STACKMARK[I+1]-1 DO + IF STACK[J] ! 0 THEN + BEGIN LP ~ LP+1; LEFTLIST[LP] ~ STACK[J]; + IF LP > 1020 THEN + BEGIN WRITE (); DUMPIT; + PRINTLIST(LINX, LEFTLIST); GO TO EXIT + END; + END + END; + LP ~ LP+1; LEFTLIST[LP] ~ 0; + EX: RSP ~ X; + END; +PROCEDURE SAVERIGHTSYMBOLS(X); VALUE X; INTEGER X; + COMMENT ANALOG TO "SAVELEFTSYMBOLS"; + BEGIN INTEGER I,J; LABEL L,EX; + L: IF STACKMARK[X] = STACKMARK[X+1] THEN + BEGIN X ~ X+1; IF X < RSP THEN GO TO L ELSE GO TO EX END; + STACKMARK[RSP+1] ~ SP+1; + FOR I ~ X+1 UPTO RSP DO + BEGIN RINX[RECURSTACK[I]] ~ RP+1; + ACTIVE[RECURSTACK[I]] ~ FALSE; DONE[RECURSTACK[I]] ~ TRUE; + FOR J ~ STACKMARK[I] UPTO STACKMARK[I+1]-1 DO + IF STACK[J] ! 0 THEN + BEGIN RP ~ RP+1; RIGHTLIST[RP] ~ STACK[J]; + IF RP > 1020 THEN + BEGIN WRITE (); DUMPIT; + PRINTLIST(RINX,RIGHTLIST); GO TO EXIT + END; + END + END; + RP ~ RP+1; RIGHTLIST[RP] ~ 0; + EX: RSP ~ X; + END; +PROCEDURE BUILDLEFTLIST(X); VALUE X; INTEGER X; + COMMENT THE LEFTLIST OF THE SYMBOL X IS BUILT BY SCANNING THE + SYNTAX FOR PRODUCTIONS WITH LEFTPART = X. THE LEFTMOST SYMBOL IN + THE RIGHTPART IS THEN INSPECTED: IF IT IS NONBASIC AND NOT MARKED + DONE, ITS LEFTLIST IS BUILT FIRST. WHILE A SYMBOL IS BEING INSPECTED + IT IS MARKED ACTIVE; + BEGIN INTEGER I,R,OWNRSP; + ACTIVE[X] ~ TRUE; + RSP ~ OWNRSP ~ LINX[X] ~ RSP+1; + RECURSTACK[RSP] ~ X; STACKMARK[RSP] ~ SP+1; + FOR I ~ 1 UPTO N DO + IF REF[I,0] = X THEN + BEGIN IF OWNRSP < RSP THEN SAVELEFTSYMBOLS(OWNRSP); + R ~ REF[I,1]; PUTINTOSTACK(R); + IF R { LT THEN + BEGIN IF DONE[R] THEN COPYLEFTSYMBOLS(R) ELSE + IF ACTIVE[R] THEN RESET(LINX[R]) ELSE + BUILDLEFTLIST(R); + END + END; + END; +PROCEDURE BUILDRIGHTLIST(X); VALUE X; INTEGER X; + COMMENT ANALOG TO "BUILDLEFTLIST"; + BEGIN INTEGER I,R,OWNRSP; LABEL QQ; + ACTIVE[X] ~ TRUE; + RSP ~ OWNRSP ~ RINX[X] ~ RSP+1; + RECURSTACK[RSP] ~ X; STACKMARK[RSP] ~ SP+1; + FOR I ~ 1 UPTO N DO + IF REF[I,0] = X THEN + BEGIN IF OWNRSP < RSP THEN SAVERIGHTSYMBOLS(OWNRSP); + FOR R ~ 2,3,4,5 DO IF REF[I,R] = 0 THEN GO TO QQ; + QQ: R ~ REF[I,R-1]; PUTINTOSTACK(R); + IF R { LT THEN + BEGIN IF DONE[R] THEN COPYRIGHTSYMBOLS(R) ELSE + IF ACTIVE[R] THEN RESET(RINX[R]) ELSE + BUILDRIGHTLIST(R); + END + END + END; + + SP ~ RSP ~ LP ~ 0; + FOR I ~ 1 UPTO LT DO DONE[I] ~ FALSE; + FOR I ~ 1 UPTO LT DO IF NOT DONE[I] THEN + BEGIN SP ~ RSP ~ 0; + FOR J ~ 1 UPTO M DO INSTACK[J] ~ 0; + BUILDLEFTLIST(I); SAVELEFTSYMBOLS(0); + END; + WRITE ([PAGE]); WRITE (); + PRINTLIST(LINX, LEFTLIST); + SP ~ RSP ~ RP ~ 0; + FOR I ~ 1 UPTO LT DO DONE[I] ~ FALSE; + FOR I ~ 1 UPTO LT DO IF NOT DONE[I] THEN + BEGIN SP ~ RSP ~ 0; + FOR J ~ 1 UPTO M DO INSTACK[J] ~ 0; + BUILDRIGHTLIST(I); SAVERIGHTSYMBOLS(0); + END; + WRITE ([3]); WRITE (); + PRINTLIST(RINX, RIGHTLIST); +END BLOCK C1; + + +BEGIN COMMENT BLOCK C2, BUILD PRECEDENCE RELATIONS; + INTEGER J,K,P,Q,R,L,T; + LABEL NEXTPRODUCTION; +PROCEDURE ENTER(X,Y,S); VALUE X,Y,S; INTEGER X,Y,S; + COMMENT ENTER THE RELATION S INTO POSITION [X,Y]. CHECK FOR DOUBLE- + OCCUPATION OF THIS POSITION; + BEGIN T ~ H[X,Y]; IF T ! NULL AND T ! S THEN + BEGIN ERRORFLAG ~ TRUE; + WRITE (<"PRECEDENCE VIOLATED BY ",2A1," FOR PAIR",2I4, + " BY PRODUCTION",I4>, T, S, X, Y, J); + END; + H[X,Y] ~ S; + END; + WRITE ([PAGE]); + FOR K ~ 1 UPTO M DO + FOR J ~ 1 UPTO M DO H[K,J] ~ NULL; + FOR J ~ 1 UPTO N DO + BEGIN FOR K ~ 2,3,4,5 DO IF REF[J,K] ! 0 THEN + BEGIN P ~ REF[J,K-1]; Q ~ REF[J,K]; + ENTER(P,Q,EQ); + IF P { LT THEN + BEGIN FOR R ~ RINX[P],R+1 WHILE RIGHTLIST[R] ! 0 DO + ENTER(RIGHTLIST[R],Q,GR); + IF Q { LT THEN + FOR L ~ LINX[Q],L+1 WHILE LEFTLIST[L] ! 0 DO + BEGIN ENTER(P, LEFTLIST[L], LS); + FOR R ~ RINX[P],R+1 WHILE RIGHTLIST[R] ! 0 DO + ENTER(RIGHTLIST[R],LEFTLIST[L],GR) + END + END + ELSE IF Q { LT THEN + FOR L ~ LINX[Q],L+1 WHILE LEFTLIST[L] ! 0 DO + ENTER(P, LEFTLIST[L], LS); + END + ELSE GO TO NEXTPRODUCTION; + NEXTPRODUCTION: END J; + WRITE (, FOR J ~ 1 UPTO M DO J); + FOR K ~ 1 STEP 1 UNTIL M DO + WRITE (, FOR J ~ 1 UPTO M DO H[K,J]); +END BLOCK C2; +END BLOCK B1; + IF ERRORFLAG THEN GO TO EXIT; + WRITE (); + + +BEGIN COMMENT BLOCK B2. BUILD F AND G PRECEDENCE FUNCTIONS; + INTEGER I, J, K,K1, N, FMIN, GMIN, T; +PROCEDURE THRU(I,J,X); VALUE I,J,X; INTEGER I,J,X; + BEGIN WRITE (, I,J,X); + GO TO EXIT + END; +PROCEDURE FIXUPCOL(L,J,X); VALUE L,J,X; INTEGER L,J,X; FORWARD; +PROCEDURE FIXUPROW(I,L,X); VALUE I,L,X; INTEGER I,L,X; + BEGIN INTEGER J; F[I] ~ G[L] + X; + IF K1 = K THEN + BEGIN IF H[I,K]= EQ AND F[I] ! G[K] THEN THRU(I,K,0) ELSE + IF H[I,K]= LS AND F[I] } G[K] THEN THRU(I,K,0) + END; + FOR J ~ K1 STEP -1 UNTIL 1 DO + IF H[I,J]= EQ AND F[I] ! G[J] THEN FIXUPCOL(I,J,0) ELSE + IF H[I,J]= LS AND F[I] } G[J] THEN FIXUPCOL(I,J,1); + END; +PROCEDURE FIXUPCOL(L,J,X); VALUE L,J,X; INTEGER L,J,X; + BEGIN INTEGER I; G[J] ~ F[L] + X; + IF K1 ! K THEN + BEGIN IF H[K,J] = EQ AND F[K] ! G[J] THEN THRU(K,J,1) ELSE + IF H[K,J] = GR AND F[K] { G[J] THEN THRU(K,J,1) + END; + FOR I ~ K STEP -1 UNTIL 1 DO + IF H[I,J] = EQ AND F[I] ! G[J] THEN FIXUPROW(I,J,0) ELSE + IF H[I,J] = GR AND F[I] { G[J] THEN FIXUPROW(I,J,1); + END; + K1 ~ 0; + FOR K ~ 1 UPTO M DO + BEGIN FMIN ~ 1; + FOR J ~ 1 UPTO K1 DO + IF H[K,J] = EQ AND FMIN < G[J] THEN FMIN ~ G[J] ELSE + IF H[K,J] = GR AND FMIN { G[J] THEN FMIN ~ G[J]+1; + F[K] ~ FMIN; + FOR J ~ K1 STEP -1 UNTIL 1 DO + IF H[K,J] = EQ AND FMIN > G[J] THEN FIXUPCOL(K,J,0) ELSE + IF H[K,J] = LS AND FMIN } G[J] THEN FIXUPCOL(K,J,1); + K1 ~ K1+1; GMIN ~ 1; + FOR I ~ 1 UPTO K DO + IF H[I,K]= EQ AND F[I] > GMIN THEN GMIN ~ F[I] ELSE + IF H[I,K]= LS AND F[I] } GMIN THEN GMIN ~ F[I]+1; + G[K] ~ GMIN; + FOR I ~ K STEP -1 UNTIL 1 DO + IF H[I,K] = EQ AND F[I] < GMIN THEN FIXUPROW(I,K,0) ELSE + IF H[I,K] = GR AND F[I] { GMIN THEN FIXUPROW(I,K,1); + END K; +END BLOCK B2; + WRITE ([PAGE]); + + +BEGIN COMMENT BLOCK B3. BUILD TABLES OF PRODUCTION REFERENCES; + INTEGER I,J,K,L; + INTEGER ARRAY MTB[0:M]; COMMENT MASTER TABLE; + INTEGER ARRAY PRTB[0:1022]; COMMENT PRODUCTION TABLE; + L ~ 0; + FOR I ~ 1 UPTO M DO + BEGIN MTB[I] ~ L+1; + FOR J ~ 1 UPTO N DO + IF REF[J,1] = I THEN + BEGIN FOR K ~ 2,3,4,5 DO + IF REF[J,K] ! 0 THEN + BEGIN L ~ L+1; PRTB[L] ~ REF[J,K] + END; + L ~ L+1; PRTB[L] ~ -J; L ~ L+1; PRTB[L] ~ REF[J,0]; + END; + L ~ L+1; PRTB[L] ~ 0 + END; + COMMENT PRINT AND PUNCH THE RESULTS: + SYMBOLTABLE, PRECEDENCE FUNCTIONS, SYNTAX REFERENCE TABLES; + WRITE (); + FOR I ~ 1 UPTO M DO + BEGIN SETTEXT(I,SYTB[I],F[I],G[I], MTB[I], WRITEBUFFER[0]); + OUTPUT + END; + WRITE (); + FOR I ~ 0 STEP 10 UNTIL L DO + WRITE (, FOR I ~ 0 STEP 10 UNTIL L DO + [I, FOR J ~ I UPTO I+9 DO PRTB[J]]); + WRITE (, TIME(0)); + WRITE (PCH, ,LT+1,M,L); + FOR I ~ 1 STEP 6 UNTIL M DO + BEGIN PCHTX(SYTB[I], WRITEBUFFER[0], IF M-I } 6 THEN 6 ELSE M-I+1); + WRITE (PCH,10,WRITEBUFFER[*]); CLEAR(WRITEBUFFER[0],9) + END; + WRITE (PCH, , FOR I ~ 1 UPTO M DO F[I]); + WRITE (PCH, , FOR I ~ 1 UPTO M DO G[I]); + WRITE (PCH, , FOR I ~ 1 UPTO M DO MTB[I]); + WRITE (PCH, , FOR I ~ 1 UPTO L DO PRTB[I]); +END BLOCK B3 +END BLOCK A; + +EXIT: +END. +