-- file PGSFormat.mesa
-- last modified by Satterthwaite, July 14, 1980 12:47 PM
DIRECTORY
PGScondefs;
PGSFormat: PROGRAM
IMPORTS PGScondefs
EXPORTS PGScondefs =
BEGIN OPEN PGScondefs;
leftindex, symindex, nextprod, sinfindex, nextrhschar, topsymbol:CARDINAL;
rule, nextrule, aliasindex, lastterminal:CARDINAL;
symstring, aliastext: Symtab;
sinfo:Sinfo;
pinfo:Pinfo;
rhstext:Rhschar;
KeyWord: TYPE =
{binary, type, interface, module, goal, terminals, aliases, productions};
text: STRING = "BINARYTYPEINTERFACEMODULEGOALTERMINALSALIASESPRODUCTIONS";
textKeys: ARRAY KeyWord OF RECORD [index, len: CARDINAL] =
[[0,6], [6,4], [10,9], [19,6], [25,4], [29,9], [38,7], [45,11]];
error: PROC =
BEGIN FreeSegment[hashChain]; FreeSegment[BASE[rhstext]];
FreeSegment[BASE[sinfo]]; FreeSegment[BASE[pinfo]];
FreeSegment[BASE[symstring]]; FreeSegment[BASE[aliastext]];
ERROR PGSfail[]
END;
Directive: PROC [key: KeyWord] RETURNS [BOOLEAN] =
BEGIN i:CARDINAL;
IF symindex-leftindex-1 # textKeys[key].len OR symstring[symindex-1] # ':
THEN RETURN [FALSE];
FOR i IN [0..textKeys[key].len)
DO
IF symstring[leftindex+i] # text[textKeys[key].index+i]
THEN RETURN [FALSE]
ENDLOOP;
RETURN [TRUE];
END;
ExtractKeyItem: PROC [key: KeyWord, value: STRING] RETURNS [BOOLEAN] =
BEGIN i,j:CARDINAL;
IF ~Directive[key] THEN RETURN [FALSE] ELSE
BEGIN gettext[]; j ← 0;
FOR i IN [leftindex..symindex) DO value[j] ← symstring[i]; j ← j+1 ENDLOOP;
END;
value.length ← j; RETURN [TRUE];
END;
hashChain: POINTER TO ARRAY [1..61] OF CARDINAL;
findtext: PROC RETURNS [CARDINAL] =
BEGIN h,i,j,k:CARDINAL;
h ← (256*(symindex-leftindex)+LOOPHOLE[symstring[leftindex],CARDINAL]) MOD 61 +1;
j ← hashChain[h];
WHILE j#0
DO IF symindex-leftindex = sinfo[j+1].symptr-sinfo[j].symptr THEN -- same length
BEGIN i ← sinfo[j].symptr;
FOR k IN [leftindex..symindex)
DO IF symstring[k]#symstring[i] THEN EXIT;
i ← i+1;
REPEAT
FINISHED => {symindex ← leftindex; RETURN [j]};
ENDLOOP;
END;
j ← sinfo[j].link;
ENDLOOP;
-- new symbol
sinfo[sinfindex] ← [leftindex,hashChain[h],0];
hashChain[h] ← sinfindex; sinfindex ← sinfindex+1;
sinfo[sinfindex].symptr ← symindex;
IF sinfindex=LENGTH[sinfo] THEN
sinfo ← LOOPHOLE[expand[sinfo,SIZE[sinforec],LENGTH[sinfo]/8]];
RETURN [sinfindex-1];
END;
Formatter: PROC [binaryFile, typeId, moduleFile, interfaceFile: STRING] =
BEGIN i:CARDINAL;
chain:BOOLEAN;
outstring["-- file "L]; outstring[sourceName];
outstring[" rewritten by PGS, "L]; outtime[]; outeol[1];
ScanInit[];
DO gettext[];
SELECT TRUE FROM
ExtractKeyItem[binary, binaryFile] => NULL;
ExtractKeyItem[module, moduleFile] => NULL;
ExtractKeyItem[type, typeId] => NULL;
ExtractKeyItem[interface, interfaceFile] => NULL;
ENDCASE => EXIT;
ENDLOOP;
IF ~Directive[goal] THEN error[] ELSE
{symindex ← 0; gettext[]; sinfindex ← 1; [] ← findtext[]};
gettext[];
IF Directive[terminals] THEN
BEGIN symindex ← leftindex;
DO gettext[];
IF symstring[symindex-1] = ': AND (Directive[aliases] OR Directive[productions]) THEN EXIT;
[] ← findtext[];
ENDLOOP;
END;
lastterminal ← sinfindex-1;
aliasindex ← 0;
IF Directive[aliases] THEN
BEGIN symindex ← leftindex;
DO gettext[];
IF Directive[productions] THEN EXIT;
FOR i IN [leftindex..symindex)
DO IF aliasindex=CARDINAL[cpw]*LENGTH[aliastext] THEN aliastext ← LOOPHOLE[
expand[LOOPHOLE[aliastext],SIZE[CARDINAL],LENGTH[aliastext]/8]];
aliastext[aliasindex] ← symstring[i]; aliasindex ← aliasindex+1;
ENDLOOP;
aliastext[aliasindex] ← ' ; aliasindex ← aliasindex+1; symindex ← leftindex;
gettext[];
FOR i IN [leftindex..symindex)
DO IF aliasindex=CARDINAL[cpw]*LENGTH[aliastext] THEN aliastext ← LOOPHOLE[
expand[LOOPHOLE[aliastext],SIZE[CARDINAL],LENGTH[aliastext]/8]];
aliastext[aliasindex] ← symstring[i]; aliasindex ← aliasindex+1;
ENDLOOP;
aliastext[aliasindex] ← ' ; aliasindex ← aliasindex+1; symindex ← leftindex;
ENDLOOP;
END;
IF ~Directive[productions] THEN error[];
symindex ← leftindex; nextprod ← 1; nextrhschar ← 0;
gettext[]; topsymbol ← findtext[];
DO -- exit from this loop on EndOfFIle, topsymbol distinguishes cases
gettext[];
IF symstring[leftindex] = ': AND symstring[leftindex+1] = ':
AND symstring[leftindex+2] = '= THEN
BEGIN IF symindex-leftindex=4 AND symstring[leftindex+3]='C THEN chain ← TRUE
ELSE IF symindex-leftindex=3 THEN chain ← FALSE ELSE GOTO notlhs;
symindex ← leftindex;
pinfo[nextprod] ← [rule,chain,0,nextrhschar];
IF (i ← sinfo[topsymbol].lhshead)=0 THEN sinfo[topsymbol].lhshead ← nextprod ELSE
BEGIN oldi:CARDINAL ← 0;
WHILE i#0 DO oldi ← i; i ← pinfo[i].link ENDLOOP;
pinfo[oldi].link ← nextprod;
END;
nextprod ← nextprod+1;
IF nextprod=LENGTH[pinfo] THEN
pinfo ← LOOPHOLE[expand[pinfo,SIZE[pinforec],LENGTH[pinfo]/8]];
topsymbol ←0; gettext[]; topsymbol ← findtext[];
LOOP;
EXITS notlhs => NULL;
END;
rhstext[nextrhschar] ← topsymbol; nextrhschar ← nextrhschar+1;
IF nextrhschar = LENGTH[rhstext] THEN
rhstext ← LOOPHOLE[ expand[rhstext, SIZE[CARDINAL], LENGTH[rhstext]/8] ];
topsymbol ← findtext[];
ENDLOOP;
END;
Format: PUBLIC PROC [binary, type, module, interface: STRING] =
BEGIN i:CARDINAL;
nextrule ← 0; symindex ← 0;
hashChain ← AllocateSegment[61];
FOR i IN [0..61] DO hashChain[i] ← 0 ENDLOOP;
rhstext ← LOOPHOLE[makearray[maxrhssymbols+1,SIZE[CARDINAL]]];
sinfo ← LOOPHOLE[makearray[symtabsize+1,SIZE[sinforec]]];
pinfo ← LOOPHOLE[makearray[maxprod+1,SIZE[pinforec]]];
symstring ← LOOPHOLE[makearray[500,SIZE[CARDINAL]]];
aliastext ← LOOPHOLE[makearray[100,SIZE[CARDINAL]]];
Formatter[binary, type, module, interface
! EndOfFile => CONTINUE]; -- always returns via catchphrase
FreeSegment[hashChain];
IF topsymbol#0 THEN
{rhstext[nextrhschar] ← topsymbol; nextrhschar ← nextrhschar+1};
sinfo[sinfindex].symptr ← symindex;
pinfo[nextprod].rhsptr ← nextrhschar;
END;
PrintGrammar: PUBLIC PROC =
BEGIN i, p, listindex:CARDINAL;
list:Sinfo;
rec:sinforec;
noswap:BOOLEAN;
printsymbol: PROC [i: CARDINAL] =
BEGIN j:CARDINAL;
outchar[' ,1];
FOR j IN [sinfo[i].symptr..sinfo[i+1].symptr) DO outchar[symstring[j],1] ENDLOOP;
END;
printprod: PROC [i,p: CARDINAL, first:BOOLEAN] =
BEGIN j:CARDINAL;
IF pinfo[p].chain THEN outstring["C "L]; outnum[pinfo[p].rule,3];
IF ~first THEN outstring[" |"L] ELSE
{printsymbol[i]; outstring[" ::="L]};
FOR j IN [pinfo[p].rhsptr..pinfo[p+1].rhsptr) DO printsymbol[rhstext[j]] ENDLOOP;
outeol[1];
END;
outstring["||INPUT ||CHAIN ||LISTS ||TABLE1"L]; outeol[1];
IF lastterminal=1 THEN
FOR i IN [2..sinfindex) DO IF sinfo[i].lhshead=0 THEN printsymbol[i] ENDLOOP
ELSE FOR i IN [2..lastterminal] DO printsymbol[i] ENDLOOP;
outstring[" eof"L]; outeol[1];
outstring["||TABLE2"L]; outeol[1]; printsymbol[1]; p ← 1;
FOR i IN (lastterminal..sinfindex)
DO IF sinfo[i].lhshead#0 THEN {printsymbol[i]; p ← p+1} ENDLOOP;
IF aliasindex#0 THEN
BEGIN outeol[1]; outstring["||TABLE3"L]; outeol[1];
FOR i IN [0..aliasindex) DO outchar[aliastext[i],1] ENDLOOP;
END;
outeol[1]; outstring["||TABLE4"L]; outeol[1];
list ← makearray[p,SIZE[sinforec]];
p ← sinfo[1].lhshead; list[0] ← [1,pinfo[p].rule,p]; listindex ← 1;
FOR i IN (lastterminal..sinfindex)
DO IF (p ← sinfo[i].lhshead)#0 THEN
{list[listindex] ← [i,pinfo[p].rule,p]; listindex ← listindex+1};
ENDLOOP;
FOR i DECREASING IN [0..LENGTH[list])
DO noswap ← TRUE;
FOR p IN [0..i)
DO IF list[p].link>list[p+1].link THEN
{rec ← list[p]; list[p] ← list[p+1]; list[p+1] ← rec; noswap ← FALSE};
ENDLOOP;
IF noswap THEN EXIT;
ENDLOOP;
FOR i IN [0..LENGTH[list])
DO p ← list[i].lhshead; printprod[list[i].symptr,p,TRUE]; p ← pinfo[p].link;
WHILE p#0 DO printprod[0,p,FALSE]; p ← pinfo[p].link ENDLOOP;
ENDLOOP;
FreeSegment[BASE[list]]; FreeSegment[BASE[rhstext]];
FreeSegment[BASE[sinfo]]; FreeSegment[BASE[pinfo]];
FreeSegment[BASE[symstring]]; FreeSegment[BASE[aliastext]];
END;
-- text input routines
char: CHARACTER; -- current (most recently scanned) character
EndOfFile: SIGNAL = CODE;
gettext: PROC =
BEGIN c:CHARACTER;
WHILE char IN [0C..' ]
DO IF char=ControlZ THEN
WHILE char#CR DO outchar[char,1]; nextchar[]; ENDLOOP;
outchar[char,1];
IF char=CR THEN
BEGIN WHILE char IN [0C..' ] DO nextchar[]; outchar[char,1] ENDLOOP;
c ← char; nextchar[]; outchar[char,1];
IF c#char OR c#'- THEN {nextchar[]; findheader[]};
END;
nextchar[];
ENDLOOP;
leftindex ← symindex;
WHILE char ~IN [0C..' ]
DO outchar[char,1];
IF symindex=CARDINAL[cpw]*LENGTH[symstring] THEN symstring ← LOOPHOLE[
expand[LOOPHOLE[symstring],SIZE[CARDINAL],LENGTH[symstring]/8]];
symstring[symindex] ← char; symindex ← symindex+1; nextchar[];
ENDLOOP;
END;
findheader: PROC =
BEGIN bindex,i,j:CARDINAL; k:INTEGER;
buffer: STRING = [2000]; -- line assembly area
BufferOverflow:ERROR = CODE;
putchar: PROC =
BEGIN IF bindex = buffer.maxlength THEN ERROR BufferOverflow;
buffer[bindex] ← char; bindex ← bindex+1; nextchar[];
END;
DO
BEGIN bindex ← 0;
WHILE char IN [0C..' ]
DO IF char=CR OR char=ControlZ THEN GOTO copyline; putchar[];
ENDLOOP;
IF char ~IN ['0..'9] AND char#query THEN GOTO copyline; putchar[];
WHILE char IN ['0..'9] DO putchar[] ENDLOOP;
WHILE char IN [0C..' ]
DO IF char=CR OR char=ControlZ THEN GOTO copyline; putchar[];
ENDLOOP;
IF char#'= THEN GOTO copyline; putchar[];
IF char#'> THEN GOTO copyline; putchar[];
WHILE char IN [0C..' ]
DO IF char=CR OR char=ControlZ THEN GOTO copyline; putchar[];
ENDLOOP;
IF char#'- THEN GOTO copyline; putchar[];
IF char#'- THEN GOTO copyline;
FOR i ← bindex-1, i-1 WHILE buffer[i]#'= DO NULL ENDLOOP;
k ← 0;
FOR j IN [0..i) DO k ← IF buffer[j]=TAB THEN k+8 ELSE k+1 ENDLOOP;
outnum[nextrule,k-2]; rule ← nextrule; nextrule ← nextrule+1;
outchar[' ,2]; FOR j IN [i..bindex) DO outchar[buffer[j],1] ENDLOOP;
outchar['-,1];
RETURN;
EXITS
copyline =>
BEGIN FOR i IN [0..bindex) DO outchar[buffer[i],1] ENDLOOP;
outchar[char,1];
WHILE char#CR DO nextchar[]; outchar[char,1] ENDLOOP;
nextchar[];
END;
END;
ENDLOOP;
END;
tB: POINTER TO PACKED ARRAY OF CHARACTER;
tI, tMax: [0..TextChars];
tOrigin, tLimit: CARDINAL;
tEnded: BOOLEAN;
nextchar: PROC =
BEGIN IF (tI←tI+1) = tMax THEN
{IF tEnded THEN SIGNAL EndOfFile[]; FillTextBuffer[]};
char ← tB[tI];
END;
ScanInit: PROC =
BEGIN tLimit ← tMax ← 0; tEnded ← FALSE; FillTextBuffer[];
char ← tB[tI]; findheader[]; nextchar[];
END;
FillTextBuffer: PROC =
BEGIN tOrigin ← tLimit;
IF tEnded THEN tMax ← 0 ELSE
{[tB, tMax, tEnded] ← nextbuffer[]; tLimit ← tOrigin + tMax};
IF tMax = 0 THEN {tB[0] ← 0C; tMax ← 1};
tI ← 0;
END;
END.