|
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 - download
Length: 13340 (0x341c)
Types: TextFile
Names: »PROCS.S«
└─⟦e0c43619c⟧ Bits:30005797 CR80 Disc pack ( Vol:FNJ1 861029/EC CR80 S/W Package II+III+IV+V+VII )
└─ ⟦this⟧ »CSP004_V0801.D!CSS210.D!PROCS.S«
"-----------------------------------------------------------------------
,
,
, MODULE NAME: BOTTOM UP PARSER PROCEDURES
, MODULE ID NMB: CSS/210
, MODULE VERSION: 0601
, MODULE TYPE: MERGE FILE
, MERGE FILES: -
,
, SPECIFICATIONS: -
, AUTHOR/DATE: LKN/800627 PHF/850510/860602
,
, DELIVERABLE: YES
, SOURCE LANGUAGE: PASCAL
, COMPILE COMPUTER: CR80
, TARGET COMPUTER: CR80
, OPER. SYSTEM: -
,
,-----------------------------------------------------------------------
,
, CHANGE RECORD
,
, VERSION AUTHOR/DATE DESCRIPTION OF CHANGE
, ------- ----------- ---------------------
V0201 HVE/831201 SUPPORT OF PARSERGEN VERSION: V0201
THE MAXIMUM NUMBERS OF RECOVERSYMBOLS
IS INCREASED FROM 128 TO 256.
SUPPORT OF PRODUCTION THAT SHOULD NOT
CALL SEMANTICS ON REDUCE.
SCANNING OF LEFT PARANTESES
WITHIN A COMMENT IS NOW HANDLED CORRECTLY
V0202 HVE/840120 TWO STRINGS WITHOUT THE '&' CHARACTER BETWEEN
THEM ARE NOW HANDLED CORRECTLY.
V0203 PHF/850510 Overflow might occur when collecting hex
V0301 PHF/860602 Delimiters are not skipped when an unknown
symbol is met during delimiter scan.
V0601 PBI/860904 A new set of char introduced to contain
the ESCAPE symbols. If a character is met
on the input, in this set the value is
returned in the attribute parameter.
,
,-----------------------------------------------------------------------"
%PAGE
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_IGNORE:= PRS_IGNORE - [CHR(10)];
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;
FOR I := 0 TO 1 DO
PRS_RECOVERSYMBOLS[ I ] := [ ];
FOR I:= 1 TO RECOVERSYMBOLCOUNT DO
BEGIN
NEXT_TABLE_WORD(J);
PRS_RECOVERSYMBOLS[ J DIV 128 ]:= PRS_RECOVERSYMBOLS[ J DIV 128 ] OR [CHR(J MOD 128)];
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;
STOP_STRING: BOOLEAN;
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);
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
"REMOVED IN VERSION 3.1
WHILE PRS_CH IN PRS_DELIMITER DO IN_BYTE(PRS_CH);
BY PHF/860602"
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
STOP_STRING := FALSE;
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
ELSE BEGIN
SEMANTICS(PRS_ERRORSYM, PRS_STRINGSYNTAX, PRS_STACKPTR );
STRINGSTATE := INSTRING;
END;
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
ELSE
STOP_STRING := TRUE;
END;
END;
UNTIL ( PRS_CH <> '''' ) OR STOP_STRING;
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')) AND (ORD(PRS_CH) >= ORD('A'))
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:= IOR(LEFTSHIFT(PRS_ATTRIBUTE,4),I); "PHF"
END;
UNTIL I < 0;
SYMNO:= PRS_CONSTSYM;
END ELSE
IF PRS_CH = '%' THEN
BEGIN
SYMNO:= -1;
SEMANTICS(PRS_ESCAPESYM,ORD(PRS_CH),PRS_STACKPTR);
PRS_CH:=PRS_IGNORE_CH;
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 MOD 128) IN PRS_RECOVERSYMBOLS[ PRS_WINDOW2 DIV 128 ] 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;
PRS_REDUCENOSEM:
BEGIN
PRS_STACKPTR:= PRS_STACKPTR-OBJECT MOD 16;
PRS_WINDOW1:= OBJECT DIV 16;
PRS_INDEX:= PRS_STACK[PRS_STACKPTR];
END
END;
UNTIL PRS_FINISH;
END;