|
DataMuseum.dkPresents historical artifacts from the history of: CR80 Hard and Floppy Disks |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CR80 Hard and Floppy Disks Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 14656 (0x3940)
Types: TextFile
Names: »PARSER.S«
└─⟦b8af24a88⟧ Bits:30005796 CR80 Disc Pack ( MINICAMPS )
└─⟦this⟧ »GENS.D!D_PARSE.D!PARSER.S«
"-----------------------------------------------------------------------
"
"
" 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