DataMuseum.dk

top - download

    Length: 11612 (0x2d5c)
    Types: TextFile
    Names: »PROCS.S«

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

TextFile

"-----------------------------------------------------------------------
,
,
,  MODULE NAME:      BOTTOM UP PARSER PROCEDURES
,  MODULE ID NMB:    CSS/210
,  MODULE VERSION:   1
,  MODULE TYPE:      MERGE FILE
,  MERGE  FILES:     -
,  
,  SPECIFICATIONS:   -
,  AUTHOR/DATE:      LKN/810102
,
,  DELIVERABLE:      YES
,  SOURCE LANGUAGE:  PASCAL
,  COMPILE COMPUTER: CR80
,  TARGET COMPUTER:  CR80
,  OPER. SYSTEM:     -
,
,-----------------------------------------------------------------------
,
,  CHANGE RECORD
,
,  VERSION    AUTHOR/DATE    DESCRIPTION OF CHANGE
,  -------    -----------    ---------------------
,
,-----------------------------------------------------------------------
,PAGE"«ff»



PROCEDURE INIT_PARSE;
"==================="
VAR
  I, J, PRODUCTIONS, ACTIONS, DELIM_TUPLES, RECOVERSYMBOLCOUNT: INTEGER;
BEGIN

  " INITIALIZE CHARACTER SETS (FOR SCANNING) "
  PRS_IGNORE:= [ ];
  FOR I:= 1 TO 32 DO PRS_IGNORE:= PRS_IGNORE OR [CHR(I)];
  PRS_ALFA:= ['_'];
  FOR PRS_CH:= 'A' TO 'Z' DO PRS_ALFA:= PRS_ALFA OR [PRS_CH];
  PRS_NUMERIC:= ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9'];
  PRS_ALFANUMERIC:= PRS_ALFA OR PRS_NUMERIC;
  FOR PRS_CH:= '(:0:)' TO '(:127:)' DO PRS_DELIMITER:= PRS_DELIMITER OR [PRS_CH];
  PRS_DELIMITER:= PRS_DELIMITER - PRS_IGNORE - PRS_ALFANUMERIC - ['''', '"', '#'];

  " INITIALIZE PARSE TABLES WITH VALUES FROM TABLE FILE "
  NEXT_TABLE_WORD(PRODUCTIONS);
  NEXT_TABLE_WORD(ACTIONS);
  NEXT_TABLE_WORD(DELIM_TUPLES);
  NEXT_TABLE_WORD(RECOVERSYMBOLCOUNT);
  IF (PRODUCTIONS > MAXPRODUCTION)
  OR (ACTIONS > MAXACTION)
  OR (DELIM_TUPLES > MAXSCANENTRY)
  THEN SEMANTICS(PRS_ERRORSYM, PRS_TABLEOVERFLOW, 1);
  FOR I:= 1 TO PRODUCTIONS DO
  WITH PRS_PRODUCTION[I] DO
    NEXT_TABLE_WORD(SYMBLENGTH);
  FOR I:= 1 TO ACTIONS DO
  WITH PRS_ACTION[I] DO
  BEGIN
    NEXT_TABLE_WORD(SYMBACTION);
    NEXT_TABLE_WORD(OBJECT);
  END;
  WITH PRS_SCANENTRY[0] DO
  BEGIN
    NEXT:= 0;
    ALTERNATIVE:= 0;
    SYMBOL:= PRS_ERRORSYM;
  END;
  FOR I:= 1 TO DELIM_TUPLES DO
  WITH PRS_SCANENTRY[I] DO
  BEGIN
    NEXT_TABLE_WORD(CH);
    NEXT_TABLE_WORD(SYMBOL);
    NEXT_TABLE_WORD(ALTERNATIVE);
    NEXT_TABLE_WORD(NEXT);
  END;
  FOR I:=0 TO 127 DO PRS_SCANENTRYPTR[I]:= 0;
  I:= PRS_SCANENTRY[1].NEXT;
  WHILE I <> 0 DO
  WITH PRS_SCANENTRY[I] DO
  BEGIN
    PRS_SCANENTRYPTR[CH]:= I;
    I:= ALTERNATIVE;
  END;

  PRS_RECOVERSYMBOLS:= [ ];
  FOR I:= 1 TO RECOVERSYMBOLCOUNT DO
  BEGIN
    NEXT_TABLE_WORD(J);
    PRS_RECOVERSYMBOLS:= PRS_RECOVERSYMBOLS OR [CHR(J)];
  END;

  " INITIALIZE PARSE VARIABLES "
  I:= 0;
  REPEAT I:= SUCC(I) UNTIL CHR(I) IN PRS_IGNORE;
  PRS_IGNORE_CH:= CHR(I);
  PRS_CH:= PRS_IGNORE_CH;
  PRS_INDEX:= 1;
  PRS_STACKPTR:= 1;
  PRS_STACK[1]:= 1;
  PRS_WINDOW1:= 0;
  PRS_WINDOW2:= 0;
  PRS_RECOVERING:= FALSE;
  PRS_FINISH:= FALSE;

END;



PROCEDURE PRS_NEXTSYMBOL(VAR SYMNO: INTEGER);
"==========================================="
TYPE
  STRINGSTATES = (INSTRING, AFTERLEFTPAR, INCHARVALUE, BEFORERIGHTPAR);
VAR
  I, J, STRINGPOS: INTEGER;
  STRINGSTATE: STRINGSTATES;
BEGIN
  REPEAT
    WHILE PRS_CH IN PRS_IGNORE DO IN_BYTE(PRS_CH);

    IF PRS_CH IN PRS_ALFA THEN
    BEGIN
      J:= 0;
      SYMBOLBUF[J]:= PRS_CH;
      I:= PRS_SCANENTRYPTR[ORD(PRS_CH)];
      IN_BYTE(PRS_CH);
      WHILE PRS_CH IN PRS_ALFANUMERIC DO
      BEGIN
        I:= PRS_SCANENTRY[I].NEXT;
        J:= SUCC(J);
        PRS_SCANENTRY[0].CH:= ORD(PRS_CH);
        IF J <= MAXSYMBOLLENGTH THEN SYMBOLBUF[J]:= PRS_CH;
        WHILE PRS_SCANENTRY[I].CH <> ORD(PRS_CH) DO I:= PRS_SCANENTRY[I].ALTERNATIVE;
        IN_BYTE(PRS_CH);
      END;
      SYMNO:= PRS_SCANENTRY[I].SYMBOL;
      IF (SYMNO = 0) OR (SYMNO = PRS_ERRORSYM) THEN
      BEGIN
        SYMNO:= PRS_NAMESYM;
        J:= SUCC(J);
        IF J > MAXSYMBOLLENGTH THEN J:= MAXSYMBOLLENGTH;
        SYMBOLBUF[J]:= '(:0:)';
        PRS_ATTRIBUTE:= J;
      END;
    END ELSE

    IF PRS_CH IN PRS_DELIMITER THEN
    BEGIN
      I:= 1;
      J:= PRS_SCANENTRYPTR[ORD(PRS_CH)];
      IF PRS_SCANENTRY[J].NEXT = 0 THEN PRS_CH:= PRS_IGNORE_CH ELSE
      IN_BYTE(PRS_CH);
      WHILE (PRS_CH IN PRS_DELIMITER) AND (I <> 0) DO
      BEGIN
        I:= J;
        PRS_SCANENTRY[0].CH:= ORD(PRS_CH);
        I:= PRS_SCANENTRY[I].NEXT;
        WHILE PRS_SCANENTRY[I].CH <> ORD(PRS_CH) DO I:= PRS_SCANENTRY[I].ALTERNATIVE;
        IF I <> 0 THEN
        BEGIN
          J:= I;
          IF PRS_SCANENTRY[J].NEXT = 0 THEN PRS_CH:= PRS_IGNORE_CH ELSE
          IN_BYTE(PRS_CH);
        END;
      END;
      IF PRS_SCANENTRY[J].SYMBOL = 0 THEN J:= 0;
      SYMNO:= PRS_SCANENTRY[J].SYMBOL;
      IF SYMNO = PRS_ERRORSYM THEN
      BEGIN
        SEMANTICS(PRS_ERRORSYM, PRS_UNKNOWN, PRS_STACKPTR);
        WHILE PRS_CH IN PRS_DELIMITER DO IN_BYTE(PRS_CH);
      END;
    END ELSE

    IF PRS_CH IN PRS_NUMERIC THEN
    BEGIN
      PRS_ATTRIBUTE:= 0;
      REPEAT
        IF (PRS_ATTRIBUTE > 3276) OR
          ((PRS_ATTRIBUTE >= 3276) AND (ORD(PRS_CH)-ORD('0') > 7)) THEN
        BEGIN
          SEMANTICS(PRS_ERRORSYM, PRS_OVERFLOW, PRS_STACKPTR);
          PRS_ATTRIBUTE:= 0;
        END ELSE
        PRS_ATTRIBUTE:= PRS_ATTRIBUTE*10+ORD(PRS_CH)-ORD('0');
        IN_BYTE(PRS_CH);
      UNTIL NOT (PRS_CH IN PRS_NUMERIC);
      SYMNO:= PRS_CONSTSYM;
    END ELSE

    IF PRS_CH = '''' THEN
    BEGIN
      I:= -1;
      STRINGSTATE:= INSTRING;
      REPEAT
        IN_BYTE(PRS_CH);
        WHILE (PRS_CH <> '''') AND (ORD(PRS_CH) >= 32) DO
        BEGIN
          I:= SUCC(I);
          SYMBOLBUF[I]:= PRS_CH;
          IF I > MAXSYMBOLLENGTH THEN
          BEGIN
            SEMANTICS(PRS_ERRORSYM, PRS_STRINGSIZE, PRS_STACKPTR);
            I:= 0;
          END;
          CASE STRINGSTATE OF
          INSTRING:
            IF PRS_CH = '(' THEN
            BEGIN
              STRINGPOS:= I;
              STRINGSTATE:= AFTERLEFTPAR;
            END;
          AFTERLEFTPAR:
            IF PRS_CH = ':' THEN
            BEGIN
              PRS_ATTRIBUTE:= 0;
              STRINGSTATE:= INCHARVALUE;
            END ELSE
            IF PRS_CH = '(' THEN STRINGPOS:= I
            ELSE STRINGSTATE:= INSTRING;
          INCHARVALUE:
            IF PRS_CH IN PRS_NUMERIC THEN
            BEGIN
              PRS_ATTRIBUTE:= PRS_ATTRIBUTE*10+ORD(PRS_CH)-ORD('0');
              IF PRS_ATTRIBUTE > 127 THEN STRINGSTATE:= INSTRING;
            END ELSE
            IF PRS_CH = ':' THEN STRINGSTATE:= BEFORERIGHTPAR;
          BEFORERIGHTPAR:
            BEGIN
              IF PRS_CH = ')' THEN
              BEGIN
                I:= STRINGPOS;
                SYMBOLBUF[I]:= CHR(PRS_ATTRIBUTE);
              END;
              STRINGSTATE:= INSTRING;
            END
          END;
          IN_BYTE(PRS_CH);
        END;
        IF PRS_CH <> ''''
        THEN SEMANTICS(PRS_ERRORSYM, PRS_STRINGSYNTAX, PRS_STACKPTR) ELSE
        BEGIN
          IN_BYTE(PRS_CH);
          IF I >= MAXSYMBOLLENGTH THEN
          BEGIN
            SEMANTICS(PRS_ERRORSYM, PRS_STRINGSIZE, PRS_STACKPTR);
            I:= 0;
          END ELSE
          IF PRS_CH = '''' THEN
          BEGIN
            I:= SUCC(I);
            SYMBOLBUF[I]:= PRS_CH;
          END ELSE
          BEGIN
            WHILE PRS_CH IN PRS_IGNORE DO IN_BYTE(PRS_CH);
            IF PRS_CH = '&' THEN
            BEGIN
              REPEAT IN_BYTE(PRS_CH) UNTIL NOT (PRS_CH IN PRS_IGNORE);
              IF PRS_CH <> ''''
              THEN SEMANTICS(PRS_ERRORSYM, PRS_STRINGSYNTAX, PRS_STACKPTR);
            END;
          END;
        END;
      UNTIL PRS_CH <> '''';
      SYMNO:= PRS_STRINGSYM;
      I:= SUCC(I);
      PRS_ATTRIBUTE:= I;
    END ELSE

    IF PRS_CH = '"' THEN
    BEGIN
      REPEAT IN_BYTE(PRS_CH) UNTIL (ORD(PRS_CH) < 32) OR (PRS_CH = '"');
      IN_BYTE(PRS_CH);
      SYMNO:= -1;
    END ELSE

    IF PRS_CH = '#' THEN
    BEGIN
      PRS_ATTRIBUTE:= 0;
      REPEAT
        IN_BYTE(PRS_CH);
        IF PRS_CH IN PRS_NUMERIC THEN I:= ORD(PRS_CH)-ORD('0') ELSE
        IF (PRS_CH IN PRS_ALFA) AND (ORD(PRS_CH) <= ORD('F')) THEN I:= ORD(PRS_CH)-ORD('A')+10
        ELSE I:= -1;
        IF I>= 0 THEN
        BEGIN
          IF PRS_ATTRIBUTE > #0FFF THEN
          BEGIN
            SEMANTICS(PRS_ERRORSYM, PRS_OVERFLOW, PRS_STACKPTR);
            PRS_ATTRIBUTE:= 0;
          END
          ELSE PRS_ATTRIBUTE:= LEFTSHIFT(PRS_ATTRIBUTE, 4)+I;
        END;
      UNTIL I < 0;
      SYMNO:= PRS_CONSTSYM;
    END ELSE

    IF PRS_CH = '%' THEN
    BEGIN
      SYMNO:= PRS_ESCAPESYM;
      PRS_CH:= '(:10:)';
    END;

  UNTIL SYMNO >= 0;
END;



PROCEDURE PRS_TESTNEXT(INPUTSYM: INTEGER;
"====================" VAR FOLLOWERSYM, COUNT: INTEGER;
                     VAR FOUND: BOOLEAN);
VAR
  SYMBOL, ACTION: INTEGER;
  STOP: BOOLEAN;
  LOCALPRS_INDEX: INTEGER;
BEGIN
  LOCALPRS_INDEX:= PRS_INDEX;
  FOUND:= FALSE;
  STOP:= FALSE;
  COUNT:= 0;
  REPEAT
    WITH PRS_ACTION[LOCALPRS_INDEX] DO
    BEGIN
      SYMBOL:= SYMBACTION DIV 16;
      ACTION:= SYMBACTION MOD 16;
      IF SYMBOL = 0 THEN
      BEGIN
        IF ACTION = PRS_JUMP THEN LOCALPRS_INDEX:= OBJECT
                              ELSE STOP:= TRUE;
      END ELSE
      BEGIN
        IF SYMBOL = INPUTSYM THEN FOUND:= TRUE;
        COUNT:= SUCC(COUNT);
        FOLLOWERSYM:= SYMBOL;
        LOCALPRS_INDEX:= SUCC(LOCALPRS_INDEX);
      END;
    END;
  UNTIL STOP;
END;



PROCEDURE PRS_RECOVER;
"===================="
VAR
  I, FOLLOWERSYM, ACCEPTCOUNT: INTEGER;
  OK: BOOLEAN;
BEGIN
  SEMANTICS(PRS_ERRORSYM, PRS_ILLEGAL, PRS_STACKPTR);
  IF (PRS_WINDOW2 = 0) OR (PRS_WINDOW1 = PRS_WINDOW2)
  THEN PRS_NEXTSYMBOL(PRS_WINDOW2);
  PRS_WINDOW1:= PRS_ERRORSYM;
  OK:= FALSE;
  REPEAT
    IF CHR(PRS_WINDOW2) IN PRS_RECOVERSYMBOLS THEN OK:= TRUE
    ELSE PRS_NEXTSYMBOL(PRS_WINDOW2);
  UNTIL OK;
  PRS_STACKPTR:= SUCC(PRS_STACKPTR);
  REPEAT
    PRS_STACKPTR:= PRS_STACKPTR-1;
    IF PRS_STACKPTR >= 1 THEN
    BEGIN
      PRS_INDEX:= PRS_STACK[PRS_STACKPTR];
      PRS_TESTNEXT(PRS_ERRORSYM, FOLLOWERSYM, ACCEPTCOUNT, OK);
    END ELSE
    BEGIN
      SEMANTICS(PRS_ERRORSYM, PRS_UNRECOVERABLE, PRS_STACKPTR);
      PRS_FINISH:= TRUE;
    END;
  UNTIL PRS_FINISH OR OK;
END;



PROCEDURE PARSE;
"=============="
VAR
  CURRSYMB: INTEGER;
BEGIN
  REPEAT
    IF (PRS_WINDOW1 = 0) THEN
    IF PRS_ACTION[PRS_INDEX].SYMBACTION DIV 16 <> 0 THEN
    BEGIN
      PRS_NEXTSYMBOL(PRS_WINDOW2);
      PRS_WINDOW1:= PRS_WINDOW2;
    END;
    REPEAT WITH PRS_ACTION[PRS_INDEX] DO
      CURRSYMB:= SYMBACTION DIV 16;
      PRS_INDEX:= SUCC(PRS_INDEX);
    UNTIL (CURRSYMB = PRS_WINDOW1) OR (CURRSYMB = 0);
    PRS_INDEX:= PRED(PRS_INDEX);
    WITH PRS_ACTION[PRS_INDEX] DO
    CASE SYMBACTION MOD 16 OF
      PRS_REDUCE:
        WITH PRS_PRODUCTION[OBJECT] DO
        BEGIN
          PRS_STACKPTR:= PRS_STACKPTR-SYMBLENGTH MOD 16;
          PRS_WINDOW1:= SYMBLENGTH DIV 16;
          SEMANTICS(OBJECT+4, PRS_ATTRIBUTE, PRS_STACKPTR+1);
          IF OBJECT = 1 THEN PRS_FINISH:= TRUE;
          PRS_INDEX:= PRS_STACK[PRS_STACKPTR];
        END;
      PRS_SHIFT:
        BEGIN
          PRS_STACKPTR:= SUCC(PRS_STACKPTR);
          PRS_INDEX:= OBJECT;
          PRS_STACK[PRS_STACKPTR]:= PRS_INDEX;
          IF PRS_WINDOW1 < 4 THEN SEMANTICS(PRS_WINDOW1, PRS_ATTRIBUTE, PRS_STACKPTR);
          IF PRS_WINDOW1 = PRS_WINDOW2 THEN PRS_WINDOW2:= 0;
          IF PRS_WINDOW1 = PRS_ERRORSYM THEN PRS_RECOVERING:= TRUE ELSE PRS_RECOVERING:= FALSE;
          PRS_WINDOW1:= PRS_WINDOW2;
        END;
      PRS_JUMP:
        BEGIN
          PRS_INDEX:= OBJECT;
        END;
      PRS_FAULT:
        BEGIN
          IF NOT PRS_FINISH THEN PRS_RECOVER;
        END
    END;
  UNTIL PRS_FINISH;
END; «a5»