DataMuseum.dk

Presents historical artifacts from the history of:

CR80 Hard and Floppy Disks

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about CR80 Hard and Floppy Disks

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦9ec83a3d7⟧ TextFile

    Length: 14656 (0x3940)
    Types: TextFile
    Names: »PARSER.S«

Derivation

└─⟦b8af24a88⟧ Bits:30005796 CR80 Disc Pack ( MINICAMPS )
    └─ ⟦this⟧ »GENS.D!D_PARSE.D!PARSER.S« 

TextFile

"-----------------------------------------------------------------------
"
"
"  MODULE NAME:      BOTTOM UP PARSER
"  MODULE ID NMB:    CSS/210
"  MODULE VERSION:   1
"  MODULE TYPE:      LINK (SUB)MODULE
"  MERGE  FILES:     @**GENS.D*PARSE.D*CHARCLASSTABLE.I
"
"  SPECIFICATIONS:   -
"  AUTHOR/DATE:      LKN/810102
"
"  DELIVERABLE:      YES
"  SOURCE LANGUAGE:  SWELL
"  COMPILE COMPUTER: CR80
"  TARGET COMPUTER:  CR80
"  OPER. SYSTEM:     AMOS
"
"-----------------------------------------------------------------------
"
"  CHANGE RECORD
"
"  VERSION    AUTHOR/DATE    DESCRIPTION OF CHANGE
"  -------    -----------    ---------------------
"
"-----------------------------------------------------------------------
"PAGE«ff»
SUBMODULE BOTTOM_UP_PARSER;


"**********************************************************************"
"                                                                      "
"  THIS MODULE IS A GENERAL TOOL FOR TABLE DRIVEN BOTTOM UP PARSING.   "
"                                                                      "
"  THE TABLES MAY BE GENERATED BY AN AUTOMATIC PARSE TABLE GENERATOR,  "
"  USING SLR1 OR OTHER TECHNIQUES, REQUIRING A SINGLE LOOKAHEAD SYM-   "
"  BOL, AND USING THE ACTIONS:  REDUCE, SHIFT/STACK, FAULT AND JUMP.   "
"                                                                      "
"**********************************************************************"


%SOURCE CHARCLASSTABLE.I

CONST
  MAXSYMBOLLENGTH = 132;
  SP =               32;


TYPE
  PARSE_ERRORS =
    ( UNKNOWN_SYMBOL,
      CONST_OVERFLOW,
      UNEXPECTED_SYMBOL,
      STRING_SYNTAX,
      STRING_SIZE,
      PARSESTACKFULL,
      UNRECOVERABLE );
  SYMBOLTYPE =
    ( EMPTY,
      NAME,
      CONSTANT,
      STRING,
      ERRORSYM );
  ACTIONTYPE =
    ( REDUCE,
      SHIFT,
      FAULT,
      JUMP );
  STRINGSTATES =
    ( INSTRING,
      AFTERLEFTPAR,
      INCHARVALUE,
      BEFORERIGHTPAR );

  TABLEHEAD =
    RECORD
      SAVEREGS: ARRAY [0..6] OF INTEGER;
      TABLELINK, ITEMSIZE, STACKLIMIT, RECOVERING, WINDOW1, WINDOW2,
      PRODUCTIONS, ACTIONS, SCANENTRIES, RECOVERSYMBOLS: INTEGER;
    END;
  STACKENTRY =
    RECORD
      ACTION: INTEGER;
    END;
  SCANENTRY =
    RECORD
      CH, SYMBOL, ALTERNATIVE, NEXT: INTEGER;
    END;
  ACTIONENTRY =
    RECORD
      SYMBACTION, OBJECT: INTEGER;
    END;
  PRODUCTIONENTRY =
    RECORD
      SYMBLENGTH: INTEGER;
    END;


VAR
  TABLEPTR,           "POINTER TO PARSE TABLE HEADER (TABLEHEAD)
  CURRCHAR,           "LAST SCANNED CHARACTER
  CURRCLASS:          "CLASS OF LAST SCANNED CHARACTER
            INTEGER;

EXPORT VAR
  SYMBOLBUF: ARRAY [0..MAXSYMBOLLENGTH+6] OF CHAR;

INIT
  CURRCLASS = IGNORE;



IMPORT PROCEDURE IN_BYTE
"====================="
               (R3;  "CHARACTER VALUE (RETURN)
                R6); "LINK



PROCEDURE GETCHAR
"==============="
               (R0;  "CHARACTER VALUE (RETURN)
                R7;  "CHARACTER CLASS (RETURN)
                R6); "LINK
VAR
  SAVER3, SAVER4, SAVER6: INTEGER;
BEGIN
  R3=>SAVER3;
  R4=>SAVER4;
  R6=>SAVER6;
  REPEAT
    IN_BYTE(R3, R6);
    R3 EXTRACT 7;
    CHARCLASSTABLE[R3=>R7]=>R0=>R7;
  UNTIL R7 <> SKIP;
  R7=>CURRCLASS;
  R3=>R0=>CURRCHAR;
  SAVER3=>R3;
  SAVER4=>R4;
  EXIT(SAVER6);
END;



PROCEDURE SEMANTICS
"================="
               (R1;  "SEMANTIC ACTION NO
                R2;  "ATTRIBUTE
                R5;  "PARSE STACK POINTER
                R6); "LINK
                     "R4 IS DESTROYED AT RETURN
BEGIN
  TABLEPTR=>R4;
  EXIT(R4@TABLEHEAD.SAVEREGS[4]);
END;



PROCEDURE NEXTSYMBOL
"=================="
               (R1;  "SYMBOL NUMBER (RETURN)
                R2;  "ATTRIBUTE (RETURN)
                R6); "LINK
LABEL NEWSYMBOL;
VAR
  ATTRIBUTE: LONG;
  SAVER0, SAVER3, SAVER4, SAVER5, SAVER6, SAVER7: INTEGER;
  STRINGSTATE, STRINGPOS: INTEGER;
BEGIN
  R0=>SAVER0;
  R3=>SAVER3;
  R4=>SAVER4;
  R5=>SAVER5;
  R6=>SAVER6;
  R7=>SAVER7;
  CURRCHAR=>R0;
  CURRCLASS=>R7;
NEWSYMBOL:
  WHILE R7 = IGNORE DO GETCHAR(R0, R7, R6);

  CASE R7:CHARCLASS OF

  ALFA:
    BEGIN
      TABLEPTR=>R4;
      R4+R4@TABLEHEAD.SCANENTRIES+SIZE(SCANENTRY);
      IF R0 >= 'a' LOGAND R0 < ('z'+1) THEN
        R0 - ('a' - 'A');
      WHILE R4@SCANENTRY.CH <> R0 LOGAND R4@SCANENTRY.CH <> 0 DO
        R4+R4@SCANENTRY.ALTERNATIVE;
      R0=>SYMBOLBUF[0=>R5];
      GETCHAR(R0, R7, R6);
      WHILE R7 < DELIMITER DO
      BEGIN
        R4+R4@SCANENTRY.NEXT;
        IF R0 >= 'a' LOGAND R0 < ('z'+1) THEN
          R0 - ('a' - 'A');
        IF R5 < MAXSYMBOLLENGTH THEN R0=>SYMBOLBUF[R5+1];
        WHILE R4@SCANENTRY.CH <> R0 LOGAND R4@SCANENTRY.CH <> 0 DO
          R4+R4@SCANENTRY.ALTERNATIVE;
        GETCHAR(R0, R7, R6);
      END;
      R4@SCANENTRY.SYMBOL=>R1;
      IF R1 = 0 LOGOR R1 = ERRORSYM THEN
      BEGIN
        NAME=>R1;
        0=>R2;
        R2=>SYMBOLBUF[R5+1];
        R2=>SYMBOLBUF[R5+1];
      END;
    END;

  NUMERIC:
    BEGIN
      ADDRESS(ATTRIBUTE)=>R5;
      0=>R5@INTEGER;
      10=>R1;
      REPEAT
        IF R5@INTEGER >= 6554 LOGOR
          R5@INTEGER >= 6553 LOGAND R0 >= '6'
        THEN SEMANTICS(ERRORSYM=>R1, CONST_OVERFLOW=>R2, R5, R6) ELSE
        BEGIN
          R5@LONG*R1;
          R5@INTEGER+(R0-'0');
        END;
        GETCHAR(R0, R7, R6);
      UNTIL R7 <> NUMERIC;
      CONSTANT=>R1;
      R5@INTEGER=>R2;
    END;

  DELIMITER:
    BEGIN
      TABLEPTR=>R4;
      R4+R4@TABLEHEAD.SCANENTRIES+SIZE(SCANENTRY);
      WHILE R4@SCANENTRY.CH <> R0 LOGAND R4@SCANENTRY.CH <> 0 DO
        R4+R4@SCANENTRY.ALTERNATIVE;
      R4=>R5;
      IF R4@SCANENTRY.NEXT=>R6 < 0 THEN IGNORE=>R7=>CURRCLASS ELSE
      GETCHAR(R0, R7, R6);
      WHILE R7 = DELIMITER LOGAND R4@SCANENTRY.CH <> 0 DO
      BEGIN
        R4=>R5;
        R4+R4@SCANENTRY.NEXT;
        WHILE R4@SCANENTRY.CH <> R0 LOGAND R4@SCANENTRY.CH <> 0 DO
          R4+R4@SCANENTRY.ALTERNATIVE;
        IF R4@SCANENTRY.CH <> 0 THEN
        BEGIN
          R4=>R5;
          IF R4@SCANENTRY.NEXT=>R6 < 0 THEN IGNORE=>R7=>CURRCLASS ELSE
          GETCHAR(R0, R7, R6);
        END;
      END;
      R5@SCANENTRY.SYMBOL=>R1;
      IF R1 = 0 THEN
      BEGIN
        ERRORSYM=>R1;
        SEMANTICS(R1, UNKNOWN_SYMBOL=>R2, R5, R6);
      END;
    END;

  COMMENTCHAR:
    BEGIN
      REPEAT
        GETCHAR(R0, R7, R6);
      UNTIL R7 = COMMENTCHAR LOGOR R0 < SP;
      IGNORE=>R7;
      GOTO NEWSYMBOL;
    END;

  STRINGCHAR:
    BEGIN
      -1=>R5;
      INSTRING=>R6=>STRINGSTATE;
      REPEAT
        GETCHAR(R0, R7, R6);
        WHILE R7 <> STRINGCHAR LOGAND R0 >= SP DO
        BEGIN
          R0=>SYMBOLBUF[R5+1];
          IF R5 >= MAXSYMBOLLENGTH THEN
          BEGIN
            SEMANTICS(ERRORSYM=>R1, STRING_SIZE=>R2, R5, R6);
            -1=>R5;
          END;
          CASE STRINGSTATE=>R6 OF
          INSTRING:
            IF R0 = '(' THEN
            BEGIN
              R5=>STRINGPOS;
              AFTERLEFTPAR=>R6=>STRINGSTATE;
            END;
          AFTERLEFTPAR:
            IF R0 = ':' THEN
            BEGIN
              ADDRESS(ATTRIBUTE)=>R2;
              0=>R2@INTEGER;
              10=>R1;
              INCHARVALUE=>R6=>STRINGSTATE;
            END ELSE
            IF R0 <> '(' THEN INSTRING=>R6=>STRINGSTATE;
          INCHARVALUE:
            BEGIN
              IF R7 = NUMERIC THEN
              BEGIN
                R2@LONG*R1;
                R2@INTEGER+(R0-'0');
                IF R2@INTEGER >= 128 THEN INSTRING=>R6;
              END ELSE
              IF R0 = ':' THEN BEFORERIGHTPAR=>R6;
              R6=>STRINGSTATE;
            END;
          BEFORERIGHTPAR:
            BEGIN
              IF R0 = ')' THEN R2@INTEGER=>R2=>SYMBOLBUF[STRINGPOS=>R5];
              INSTRING=>R6=>STRINGSTATE;
            END;
          END;
          GETCHAR(R0, R7, R6);
        END;
        IF R7 <> STRINGCHAR
        THEN SEMANTICS(ERRORSYM=>R1, STRING_SYNTAX=>R2, R5, R6) ELSE
        BEGIN
          GETCHAR(R0, R7, R6);
          IF R5 >= MAXSYMBOLLENGTH THEN
          BEGIN
            SEMANTICS(ERRORSYM=>R1, STRING_SIZE=>R2, R5, R6);
            -1=>R5;
          END ELSE
          IF R7 = STRINGCHAR THEN R0=>SYMBOLBUF[R5+1] ELSE
          BEGIN
            WHILE R7 = IGNORE DO GETCHAR(R0, R7, R6);
            IF R0 = '&' THEN
            BEGIN
              REPEAT GETCHAR(R0, R7, R6) UNTIL R7 <> IGNORE;
              IF R7 <> STRINGCHAR
              THEN SEMANTICS(ERRORSYM=>R1, STRING_SYNTAX=>R2, R5, R6);
            END;
          END;
        END;
      UNTIL R7 <> STRINGCHAR;
      STRING=>R1;
      0=>R0=>SYMBOLBUF[R5+1];
      R5=>R2;
      R0=>SYMBOLBUF[R5+1];
    END;

  HEXCHAR:
    BEGIN
      GETCHAR(R0, R7, R6);
      0=>R2;
      WHILE R7 < DELIMITER LOGAND R0 < 'G' DO
      BEGIN
        IF R7 = NUMERIC THEN R0-'0' ELSE R0-('A'-10);
        IF R2 >= #1000 THEN SEMANTICS(ERRORSYM=>R1, CONST_OVERFLOW=>R2, R5, R6)
        ELSE R2 SHIFTLL 4 + R0;
        GETCHAR(R0, R7, R6);
      END;
      CONSTANT=>R1;
    END;

  ESCAPE:
    BEGIN
      EMPTY=>R1;
      IGNORE=>R7=>CURRCLASS;
    END;


  END; "CASE"

  SAVER0=>R0;
  SAVER3=>R3;
  SAVER4=>R4;
  SAVER5=>R5;
  SAVER6=>R6;
  SAVER7=>R7;
  SAVER6=>R6;
  EXIT(R6);
END;  "NEXTSYMBOL"



PROCEDURE TESTACCEPT
"=================="
               (R1;  "SYMBOL NO (CALL)
                     "LEGAL FOLLOWERSYMBOL (RETURN)
                R0;  "FOLLOWERCOUNT (RETURN)
                R3;  "FOUND (RETURN),  0 = FALSE
                R4;  "PARSE STATE
                R6); "LINK
VAR
  SAVER4, SAVER5, SAVER6, SAVER7: INTEGER;
BEGIN
  R4=>SAVER4;
  R5=>SAVER5;
  R6=>SAVER6;
  R7=>SAVER7;
  0=>R3;  "SYMBOL NOT FOUND"
  0=>R7;  "NO FOLLOWER SYMBOL"
  0=>R0;  "LEGAL FOLLOWER COUNT"
  REPEAT
    R4@ACTIONENTRY.SYMBACTION=>R6 SHIFTRL 4;  "SYMBOL NO"
    R4@ACTIONENTRY.SYMBACTION=>R5 EXTRACT 4;  "ACTION"
    IF R6 = 0 THEN
    BEGIN
      IF R5 = JUMP THEN R4+R4@ACTIONENTRY.OBJECT ELSE 0=>R4;
    END ELSE
    BEGIN
      IF R6 = R1 THEN R1=>R3; "SYMBOL FOUND"
      R6=>R7;
      R0+1;
      R4+SIZE(ACTIONENTRY);
    END;
  UNTIL R4 = 0;
  R7=>R1;  "FOLLOWER SYMBOL"
  SAVER4=>R4;
  SAVER5=>R5;
  SAVER6=>R6;
  SAVER7=>R7;
  EXIT(R6);
END;



PROCEDURE RECOVER
"==============="
               (R4;  "PARSE STATE
                R5;  "PARSE STACK POINTER
                R6); "LINK
VAR
  SAVER0, SAVER1, SAVER2, SAVER3, SAVER5, SAVER6, SAVER7: INTEGER;
BEGIN
  R0=>SAVER0;
  R1=>SAVER1;
  R2=>SAVER2;
  R3=>SAVER3;
  R5=>SAVER5;
  R6=>SAVER6;
  R7=>SAVER7;
  TABLEPTR=>R7;
  SEMANTICS(ERRORSYM=>R1, UNEXPECTED_SYMBOL=>R2, R5, R6);
  IF R7@TABLEHEAD.WINDOW2=>R1 = 0
  LOGOR R1 = R7@TABLEHEAD.WINDOW1 THEN
  BEGIN
    NEXTSYMBOL(R1, R2, R6);
    R1=>R7@TABLEHEAD.WINDOW2;
  END;
  ERRORSYM=>R0=>R7@TABLEHEAD.WINDOW1;
  R7=>R6+R7@TABLEHEAD.RECOVERSYMBOLS=>R4;
  WHILE R6@INTEGER <> R1 LOGAND R6@INTEGER <> 0 DO R6+1;
  IF R6 <> R4 LOGOR R6@INTEGER <> 0  " RECOVER SYMBOLS PRESENT " THEN
  WHILE R6@INTEGER <> R1 DO
  BEGIN
    NEXTSYMBOL(R1, R2, R6);
    R7=>R6+R7@TABLEHEAD.RECOVERSYMBOLS;
    WHILE R6@INTEGER <> R1 LOGAND R6@INTEGER <> 0 DO R6+1;
  END;
  R1=>R7@TABLEHEAD.WINDOW2;
  R5+R7@TABLEHEAD.ITEMSIZE;
  REPEAT
    R5-(R7@TABLEHEAD.ITEMSIZE=>R4)=>SAVER5;
    IF R5 >= R7@TABLEHEAD.SAVEREGS[5] THEN
    BEGIN
      R5@STACKENTRY.ACTION=>R4;
      TESTACCEPT(ERRORSYM=>R1, R0, R3, R4, R6);
    END ELSE
    BEGIN
      SEMANTICS(ERRORSYM=>R1, UNRECOVERABLE=>R2, R5, R6);
      0=>R5=>SAVER5;  "TERMINATE
    END;
  UNTIL R3 <> 0 LOGOR R5 = 0;
  SAVER0=>R0;
  SAVER1=>R1;
  SAVER2=>R2;
  SAVER3=>R3;
  R5@STACKENTRY.ACTION=>R4;
  SAVER5=>R5;
  SAVER6=>R6;
  SAVER7=>R7;
  EXIT(R6);
END;



EXPORT PROCEDURE PARSE
"===================="
              (STACKITEMSIZE, MAXSTACKITEMS: INTEGER;
               R4;  "ENTRY POINT OF SEMANTICS PROCEDURE
               R5;  "PARSE STACK BASE
               R7;  "PARSE TABLE PTR
               R6); "LINK
BEGIN
  STC(6, R7+7);
  TABLEPTR=>R0=>R7@TABLEHEAD.TABLELINK;
  R7=>TABLEPTR;
  R6@PARSE.STACKITEMSIZE=>R0=>R7@TABLEHEAD.ITEMSIZE;
  R6@PARSE.MAXSTACKITEMS=>R1;
  R5=>R3;
  WHILE R1-1 >= 0 DO R3+R0;
  R3=>R7@TABLEHEAD.STACKLIMIT;
  R7=>R4+R7@TABLEHEAD.ACTIONS+SIZE(ACTIONENTRY);
  R4=>R5@STACKENTRY.ACTION;
  0=>R1=>R7@TABLEHEAD.WINDOW1;
  R1=>R7@TABLEHEAD.WINDOW2;
  R1=>R7@TABLEHEAD.RECOVERING;
  REPEAT
    R7@TABLEHEAD.WINDOW1=>R1;
    R4@ACTIONENTRY.SYMBACTION=>R3 SHIFTRL 4;
    WHILE R3 <> 0 LOGAND R1 = 0 DO
    BEGIN
      NEXTSYMBOL(R1, R2, R6);
      IF R1 = EMPTY THEN  "ESCAPE"
      BEGIN
        R4=>R2;  "SAVE R4
        SEMANTICS(R1, R2, R5+R7@TABLEHEAD.ITEMSIZE, R6);
        R2=>R4;  "REESTABLISH R4;
        (TABLEPTR=>R7)@TABLEHEAD.ITEMSIZE=>R0;
        R5-R0;
      END;
      R1=>R7@TABLEHEAD.WINDOW1;
      R1=>R7@TABLEHEAD.WINDOW2;
    END;
    WHILE R3 <> R1 LOGAND R3 <> 0 DO
    BEGIN
      R4+SIZE(ACTIONENTRY);
      R4@ACTIONENTRY.SYMBACTION=>R3 SHIFTRL 4;
    END;

    TABLEPTR=>R7;
    R4@ACTIONENTRY.SYMBACTION=>R6 EXTRACT 4;
    CASE R6:ACTIONTYPE OF

    REDUCE:
      BEGIN
        R4@ACTIONENTRY.OBJECT=>R6;  "TAKE PRODUCTION NUMBER"
        R6+R7+R7@TABLEHEAD.PRODUCTIONS;  "TAKE PRODUCTION TABLE ENTRY"
        R6@PRODUCTIONENTRY.SYMBLENGTH=>R0 EXTRACT 4;
        R7@TABLEHEAD.ITEMSIZE=>R1;
        WHILE R0-1 <> 0 DO R5-R1;  "UPDATE PARSE STACK POINTER
        R6@PRODUCTIONENTRY.SYMBLENGTH=>R0 SHIFTRL 4;
        R0=>R7@TABLEHEAD.WINDOW1;
        R4@ACTIONENTRY.OBJECT=>R1;  "PRODUCTION NO"
        R1+4;  "SEMANTIC ACTION NO"
        SEMANTICS(R1, R2, R5, R6);
        TABLEPTR=>R7;
        IF R1 = 5  " FINAL REDUCTION "  THEN 0=>R5
        ELSE R5-(R7@TABLEHEAD.ITEMSIZE=>R0);
        R5@STACKENTRY.ACTION=>R4;
      END;

    SHIFT:
      BEGIN
        IF R5+R7@TABLEHEAD.ITEMSIZE >= R7@TABLEHEAD.STACKLIMIT THEN
        BEGIN
          SEMANTICS(ERRORSYM=>R1, PARSESTACKFULL=>R2, R5, R6);
          0=>R5;  "TERMINATE
        END ELSE
        BEGIN
          R4+R4@ACTIONENTRY.OBJECT;  "NEXT ACTION"
          R4=>R5@STACKENTRY.ACTION;
          IF R1 < ERRORSYM THEN SEMANTICS(R1, R2, R5, R6);
          R5@STACKENTRY.ACTION=>R4;
          IF R7@TABLEHEAD.WINDOW2=>R0 = R7@TABLEHEAD.WINDOW1=>R1
          THEN 0=>R0=>R7@TABLEHEAD.WINDOW2;
          IF R1 = ERRORSYM THEN 1=>R0 ELSE 0=>R0;
          R0=>R7@TABLEHEAD.RECOVERING;  "SET RECOVERING (TRUE OR FALSE = 1/0)"
          R7@TABLEHEAD.WINDOW2=>R0=>R7@TABLEHEAD.WINDOW1;
        END;
      END;

    JUMP:
      BEGIN
        R4+R4@ACTIONENTRY.OBJECT;
      END;

    FAULT:
      BEGIN
        RECOVER(R4, R5, R6);
      END;

    END;  "CASE"
  UNTIL R5 = 0;
  TABLEPTR=>R7;
  R7@TABLEHEAD.TABLELINK=>R0=>TABLEPTR;
  UNS(6, R7);
  R7-7;
  EXIT(R6, SIZE(PARSE));
END;  "PARSE"


ENDMODULE