-- file PGSTab.mesa
-- last modified by Satterthwaite, July 14, 1980 1:18 PM
DIRECTORY
PGScondefs: FROM "pgscondefs";
PGSTab: PROGRAM
IMPORTS PGScondefs
EXPORTS PGScondefs =
BEGIN OPEN PGScondefs;
linewidth, hashval,lastntstate, vocabspace, nlim, tlim: CARDINAL;
hashtab: Hashtab;
ttab: Ttab;
ntab: Ntab;
statedata: Statedata;
ntdefaults: Ntdefaults;
column: Column;
renumber: Renumber;
vocabindex: Vocabindex;
scantab: ARRAY [40B..177B] OF CARDINAL;
tabgen: PUBLIC PROC RETURNS [BOOLEAN] =
BEGIN success: BOOLEAN ← TRUE;
error: PROC [sel: CARDINAL] =
BEGIN outeol[1];
outstring[SELECT sel FROM
1 => "FAIL - more than 255 terminal symbols"L,
2 => "FAIL - more than 254 nonterminal symbols"L,
3 => "FAIL - more than 2047 states or productions"L,
4 => "FAIL - more than 15 symbols in a production right part"L,
ENDCASE => ""];
outeol[1]; success ← FALSE;
END;
IF eofile > 255 THEN error[1];
IF totaltokens-eofile+1 > 255 THEN error[2];
IF psslim > 2047 THEN error[3];
IF rhslim > 15 THEN error[4];
IF ~success THEN RETURN [success];
ntab ← LOOPHOLE[makearray[ntentries, SIZE[tabrec]]];
ttab ← LOOPHOLE[makearray[tentries, SIZE[tabrec]]];
statedata ← LOOPHOLE[makearray[slim, SIZE[statedatarec]]];
ntdefaults ← LOOPHOLE[makearray[totaltokens-eofile+2, SIZE[ntdefaultrec]]];
column ← LOOPHOLE[makearray[ntentries+1, SIZE[columnrec]]];
tablesetup[]; closewordstream[]; squashntab[];
outeol[1]; outstring["Parse Table Data"L]; outeol[1];
IF flags[printlalr] THEN {printndef[]; tableoverlays[]};
vocabindex ← LOOPHOLE[makearray[eofile+1, SIZE[CARDINAL]]];
hashval ← 3*eofile/2;
hashval ← MIN[251, IF hashval MOD 2 = 0 THEN hashval+1 ELSE hashval];
hashtab ← LOOPHOLE[makearray[hashval+1, SIZE[hashtabrec]]];
hashtabsetup[];
-- output scanner tables
openwordstream[scratch:FALSE];
outblock[BASE[hashtab], hashval+1];
outblock[BASE[scantab], 96];
outword[vocabspace]; outword[vocabspace];
outblock[BASE[symtab], (vocabspace+cpw-1)/cpw];
outblock[BASE[vocabindex], eofile+1];
FreeSegment[BASE[hashtab]]; FreeSegment[BASE[vocabindex]];
FreeSegment[BASE[syminfo]];
renumber ← LOOPHOLE[makearray[slim, SIZE[CARDINAL]]];
staterenumber[]; --now output parser tables
outarray[1,numprod ,proddataitem];
outarray[1,lastntstate ,nstateitem];
outarray[1,lastntstate ,nlenitem];
outarray[0,nlim-1 ,nsymitem];
outarray[0,nlim-1 ,nactionitem];
outarray[2,totaltokens-eofile+1 ,ntdefaultitem];
outarray[1,slim-1 ,tstateitem];
outarray[1,slim-1 ,tlenitem];
outarray[0,tlim-1 ,tsymitem];
outarray[0,tlim-1 ,tactionitem];
FreeSegment[BASE[prodinfo]]; FreeSegment[BASE[ntab]];
FreeSegment[BASE[ntdefaults]]; FreeSegment[BASE[renumber]];
FreeSegment[BASE[statedata]]; FreeSegment[BASE[ttab]];
RETURN [success];
END;
tablesetup: PROC =
BEGIN defaultitem, item:itemrec;
defaultprod, i, j, k, symbol, ttix, ntix, six, index, ptr: CARDINAL;
columnentry: PROC =
BEGIN j: INTEGER; lastptr: CARDINAL;
lastptr ← 0; ptr ← ntdefaults[symbol].count;
DO IF ptr=0 THEN GOTO insert;
j ← item.jf-column[ptr].item.jf; IF j=0 THEN j ← item.pss-column[ptr].item.pss;
IF j=0 THEN GOTO countup;
IF j<0 THEN GOTO insert;
lastptr ← ptr; ptr ← column[ptr].link;
REPEAT
countup => column[ptr].count ← column[ptr].count+1;
insert =>
BEGIN column[index].item ← item;
IF lastptr=0 THEN --head of list for column "symbol"
BEGIN column[index].link ← ntdefaults[symbol].count;
ntdefaults[symbol].count ← index;
END
ELSE
BEGIN column[index].link ← column[lastptr].link;
column[lastptr].link ← index;
END;
index ← index+1;
END;
ENDLOOP;
END;
ntix ← ttix ← 0; index ← 1; statedata[1] ← [0,0,0,0];
FOR six IN [1..slim)
DO defaultprod ← inword[]; statedata[six] ← [ttix,ntix,0,0];
THROUGH [1..inword[]] --set up entries for state six in ttab and ntab
DO symbol ← inword[]; k ← inword[];
item ← [k MOD 4, k/4, inword[]];
IF item.tag=2 AND item.pss=defaultprod THEN defaultitem ← item ELSE
IF symbol<=eofile THEN {ttab[ttix] ← [symbol, item]; ttix ← ttix+1}
ELSE
BEGIN symbol ← symbol-eofile+1; ntab[ntix] ← [symbol, item]; ntix ← ntix+1;
columnentry[];
END;
ENDLOOP;
IF defaultprod # 0 THEN
{ttab[ttix] ← [defaultmarker, defaultitem]; ttix ← ttix+1};
statedata[six].tlink ← ttix-statedata[six].tindex; --length
statedata[six].ntlink ← ntix-statedata[six].ntindex; --length
-- now see if these terminal entries match those of an existing state
FOR i IN [1..six)
DO k ← statedata[six].tindex-statedata[i].tindex;
IF statedata[six].tlink=statedata[i].tlink THEN -- same length
FOR j IN [statedata[i].tindex..statedata[i].tindex+statedata[i].tlink)
DO IF ttab[j]#ttab[j+k] THEN EXIT;
REPEAT FINISHED => --there is a matching set of entries
BEGIN statedata[six].tlink ← -i; -- point state six at state i
ttix ← statedata[six].tindex; -- back up index
EXIT;
END;
ENDLOOP;
ENDLOOP;
ENDLOOP;
tlim ← ttix;
--ttab contains terminal entries; statedata[i].tindex indexes state i entries if
--statedata[i].link>0, otherwise statedata[-statedata[i].link].tindex indexes them.
--the following code leaves the most frequently occurring item in column "symbol"
--of the lalr tables in the appropriate entry of ntdefaults
FOR symbol IN [0..totaltokens-eofile+1]
DO IF (ptr ← ntdefaults[symbol].count)=0 THEN LOOP;
k ← 0; ntdefaults[symbol].item ← column[ptr].item;
WHILE ptr#0
DO IF column[ptr].count>k THEN
{k ← column[ptr].count; ntdefaults[symbol].item ← column[ptr].item};
ptr ← column[ptr].link;
ENDLOOP;
ntdefaults[symbol].count ← k;
ENDLOOP;
END;
squashntab: PROC =
BEGIN i, j, k, six, ntix: CARDINAL;
nlim ← 0;
FOR six IN [1..slim)
DO k← nlim;
FOR ntix IN [statedata[six].ntindex..statedata[six].ntindex+statedata[six].ntlink)
DO IF ntab[ntix].item # ntdefaults[ntab[ntix].symbol].item THEN
{ntab[nlim] ← ntab[ntix]; nlim ← nlim+1};
ENDLOOP;
statedata[six].ntindex ← k; k ← nlim-k; statedata[six].ntlink ← k;
IF k#0 THEN FOR i IN [1..six) --do these entries match those of an existing state
DO k ← statedata[six].ntindex-statedata[i].ntindex;
IF statedata[six].ntlink=statedata[i].ntlink THEN -- same length
FOR j IN [statedata[i].ntindex..statedata[i].ntindex+statedata[i].ntlink)
DO IF ntab[j]#ntab[j+k] THEN EXIT;
REPEAT FINISHED => --there is a matching set of entries
BEGIN statedata[six].ntlink ← -i; -- point state six at state i
nlim ← statedata[six].ntindex; -- back up index
EXIT;
END;
ENDLOOP;
ENDLOOP;
ENDLOOP;
END;
printndef: PROC =
BEGIN i, j:CARDINAL; item:itemrec;
outeol[1]; outstring["Nonterminal Default Actions"L]; outeol[1]; linewidth ← 0; j ← 0;
FOR i IN [2..totaltokens-eofile+1]
DO IF (linewidth ← linewidth+tokensize+8)>outbuflim THEN
{outeol[1]; linewidth ← tokensize+8};
item ← ntdefaults[i].item; j ← j+ntdefaults[i].count;
outnum[IF item.tag=0 THEN item.pss ELSE -item.pss, 5]; outchar[' ,1];
outchar[' , tokensize+2-outtoken[i+eofile-1]];
ENDLOOP;
outeol[1]; outstring["Entries removed = "L]; outnum[j,5]; outeol[1];
END;
tableoverlays: PROC =
BEGIN i:CARDINAL; j, k:INTEGER;
outeol[1]; outstring["Table Overlays"L]; outeol[1];
outstring[" row ttab ntab"L]; outeol[1];
FOR i IN [1..slim)
DO j ← statedata[i].tlink; k ← statedata[i].ntlink;
IF j<0 OR k<0 THEN
BEGIN outnum[i,4];
IF j<0 THEN outnum[-j, 5] ELSE outchar[' ,5];
IF k<0 THEN outnum[-k, 5];
outeol[1];
END;
ENDLOOP;
END;
hashtabsetup: PROC =
BEGIN i, j, k, h, p, count, freeptr, code:CARDINAL;
null:CHARACTER = 0C;
outeol[1];
outstring["Scanner hashtable probe counts (terminal symbol, probecount, hashcode)"L];
outeol[1];
vocabspace ← vocabindex[0] ← 0; freeptr ← hashval; linewidth ← 0;
FOR i IN [40B..177B] DO scantab[i]←0 ENDLOOP;
FOR i IN [1..eofile] -- strip quotes, repack, build vocabindex, scantab and hashtab
DO p ← i*tokensize; k ← syminfo[i].length;
IF k=2 AND symtab[p]='' THEN {p ← p+1; k ← 1}
ELSE IF k>2 AND symtab[p]='" AND symtab[p+k-1]='" THEN {p←p+1; k←k-2};
IF k=1 AND symtab[p] ~IN ['a..'z] AND symtab[p] ~IN ['A..'Z] THEN
BEGIN scantab[CARDINAL[symtab[p]-null]] ← i;
-- the next two statements are redundant, they keep the new tables identical to the old
symtab[vocabspace] ← symtab[p]; vocabspace ← vocabspace+1;
vocabindex[i] ← vocabspace;
END
ELSE
BEGIN
FOR j IN [0..k)
DO symtab[vocabspace] ← symtab[p+j]; vocabspace ← vocabspace+1;
ENDLOOP;
vocabindex[i] ← vocabspace;
IF i=eofile THEN LOOP;
count ← 1;
code ← h ← (((symtab[p]-null)*127+(symtab[p+k-1]-null)) MOD hashval) + 1;
IF hashtab[h].symptr#0 THEN
BEGIN WHILE h#0
DO j ← h; h ← hashtab[h].link; count ← count+1 ENDLOOP;
WHILE hashtab[freeptr].symptr#0 DO freeptr ← freeptr-1 ENDLOOP;
hashtab[j].link ← h ← freeptr;
END;
hashtab[h].symptr ← i;
IF (linewidth ← linewidth+tokensize+8)>outbuflim THEN
{outeol[1]; linewidth ← tokensize+8};
FOR j IN [vocabindex[i-1]..vocabindex[i]) DO outchar[symtab[j],1] ENDLOOP;
outchar[' ,tokensize-k]; outnum[count,2];
outnum[code,4]; outchar[' ,2];
END;
ENDLOOP;
IF (j ← vocabspace MOD cpw)#0 THEN THROUGH [j..cpw) -- pad to word boundary
DO symtab[vocabspace] ← null ENDLOOP;
outeol[1];
END;
staterenumber: PROC =
BEGIN i, j: CARDINAL; k: INTEGER;
swaprec: statedatarec;
i←2; j←slim-1;
DO
WHILE statedata[j].ntlink=0 AND i<=j DO j←j-1 ENDLOOP; -- leaves j indexing an ntstate
WHILE statedata[i].ntlink#0 AND i<j DO i←i+1 ENDLOOP; -- i indexes a tstate unless i>=j
IF i>=j THEN EXIT ELSE
BEGIN renumber[i]←j; renumber[j]←i; i←i+1; j←j-1;
-- if j<i now, j indexes the renumbered nstate
END;
ENDLOOP;
lastntstate←j;
-- renumber the transition entries
FOR i IN [0..tlim)
DO IF ttab[i].item.tag=0 AND (j←renumber[ttab[i].item.pss])#0 THEN
ttab[i].item.pss←j;
ENDLOOP;
FOR i IN [0..nlim)
DO IF ntab[i].item.tag=0 AND (j←renumber[ntab[i].item.pss])#0 THEN
ntab[i].item.pss←j;
ENDLOOP;
FOR i IN [2..totaltokens-eofile+1]
DO IF ntdefaults[i].item.tag=0 AND (j←renumber[ntdefaults[i].item.pss])#0 THEN
ntdefaults[i].item.pss←j;
ENDLOOP;
-- remove links and renumber states
FOR i IN [1..slim)
DO k ← statedata[i].tlink;
IF k<0 THEN
BEGIN statedata[i].tlink ← statedata[-k].tlink;
statedata[i].tindex ← statedata[-k].tindex;
END;
k ← statedata[i].ntlink;
IF k<0 THEN
BEGIN statedata[i].ntlink ← statedata[-k].ntlink;
statedata[i].ntindex ← statedata[-k].ntindex;
END;
ENDLOOP;
FOR i IN [2..lastntstate]
DO IF (j←renumber[i])#0 THEN
BEGIN swaprec ← statedata[i]; statedata[i] ← statedata[j]; statedata[j] ← swaprec;
END;
ENDLOOP;
IF flags[printlalr] THEN
BEGIN outeol[1]; outstring["Renumbered States"L]; outeol[1];
FOR i IN [2..lastntstate]
DO IF renumber[i]#0 THEN
BEGIN outnum[i,4]; outstring[" swapped with"L]; outnum[renumber[i],4]; outeol[1];
END;
ENDLOOP;
END;
END;
outmodule: PUBLIC PROC [typename, modfname: STRING] =
BEGIN i,j,k: CARDINAL;
outrange: PROC [id,cover: STRING, ulim: CARDINAL] =
BEGIN
outchar[' ,2]; outstring[id]; outstring[": TYPE = "L]; outstring[cover];
outstring["[0.."L]; outnum[ulim,3]; outstring["];"L]; outeol[1];
END;
outstring["-- file "L]; outstring[modfname]; outeol[1];
outstring["-- created by PGS from "L]; outstring[sourceName];
outstring[", "L]; outtime[]; outeol[2];
outstring[typename]; outstring[": DEFINITIONS = "L]; outeol[1];
outstring[" BEGIN"L];
outeol[2];
outrange["Symbol"L,"",maxcharcode];
outrange["TSymbol"L,"Symbol "L,eofile];
outrange["NTSymbol"L,"Symbol "L,totaltokens-eofile+1];
outeol[1];
outstring["-- token indices for the scanner and parser"L]; outeol[1];
FOR i IN [0..nextalias)
DO outchar[' ,2]; k ← aliases[i].alias*tokensize;
FOR j IN [k..k+tokensize) WHILE symtab[j]#0C DO outchar[symtab[j],1] ENDLOOP;
outstring[": TSymbol ="L]; outnum[aliases[i].terminal,3]; outchar[';,1]; outeol[1];
ENDLOOP;
FreeSegment[BASE[symtab]]; FreeSegment[BASE[aliases]];
outeol[1];
outstring[" Default"L];
outstring["Marker: TSymbol ="L]; outstring[" FIRST"L];
outstring["[TSymbol];"L]; outeol[1];
outstring[" End"L];
outstring["Marker: TSymbol ="L]; outstring[" LAST"L];
outstring["[TSymbol];"L]; outeol[2];
outrange["HashIndex"L,"",hashval]; outrange["VIndex"L,"",vocabspace-1];
outstring["
VocabHashEntry: TYPE = MACHINE DEPENDENT RECORD [
symbol: [0..377B], -- symbol index (TSymbol)
link: [0..377B]]; -- link to next entry (HashIndex)"L];
outeol[2];
outrange["State"L,"",slim-1];
outrange["NTState"L,"State "L,lastntstate];
outrange["TIndex"L,"",tlim-1];
outrange["NTIndex"L,"",nlim-1];
outrange["Production"L,"",numprod]; outeol[1];
outstring[" Initial"L];
outstring["State: State = "L]; outnum[1,1]; outchar[';,1]; outeol[1];
outstring[" Final"L];
outstring["State: State = "L]; outnum[0,1]; outchar[';,1]; outeol[1];
outstring["
ActionTag: TYPE = MACHINE DEPENDENT RECORD [
reduce: BOOLEAN, -- TRUE iff reduce entry
pLength: [0..17B]]; -- number of symbols in production rhs
ActionEntry: TYPE = MACHINE DEPENDENT RECORD [
tag: ActionTag, -- [FALSE,0] if a shift entry
transition: [0..3777B]]; -- production number / next state
ProductionInfo: TYPE = MACHINE DEPENDENT RECORD [
rule: [0..377B], -- reduction rule
lhs: Symbol]; -- production lhs symbol (NTSymbol)
Table: TYPE = MACHINE DEPENDENT RECORD [
scanTable: RECORD[
hashTab: ARRAY HashIndex OF VocabHashEntry,
scanTab: ARRAY CHARACTER [40C..177C] OF TSymbol,
vocabBody: RECORD [ -- a string body
length, maxlength: CARDINAL,
text: PACKED ARRAY VIndex OF CHARACTER],
vocabIndex: ARRAY TSymbol OF CARDINAL],
parseTable: RECORD[
prodData: ARRAY Production OF ProductionInfo,
nStart: ARRAY NTState OF NTIndex,
nLength: ARRAY NTState OF CARDINAL,
nSymbol: ARRAY NTIndex OF NTSymbol,
nAction: ARRAY NTIndex OF ActionEntry,
ntDefaults: ARRAY NTSymbol OF ActionEntry,
tStart: ARRAY State OF TIndex,
tLength: ARRAY State OF CARDINAL,
tSymbol: ARRAY TIndex OF TSymbol,
tAction: ARRAY TIndex OF ActionEntry]];
Handle: TYPE = POINTER TO Table;"L];
outeol[2]; outstring[" END."L]; outeol[1];
END;
proc: TYPE = PROC [index:CARDINAL];
outarray: PROC [llim,ulim: CARDINAL, p: proc] =
BEGIN i: CARDINAL;
THROUGH [0..llim) DO outword[0] ENDLOOP;
FOR i IN [llim..ulim] DO p[i] ENDLOOP;
END;
proddataitem: proc =
{outword[prodinfo[index].rule*256+(prodinfo[index].lhs-eofile+1)]};
nstateitem: proc = {outword[statedata[index].ntindex]};
nlenitem: proc = {outword[statedata[index].ntlink]};
nsymitem: proc = {outword[ntab[index].symbol]};
nactionitem: proc = {repack[ntab[index].item]};
ntdefaultitem: proc = {repack[ntdefaults[index].item]};
tstateitem: proc = {outword[statedata[index].tindex]};
tlenitem: proc = {outword[statedata[index].tlink]};
tsymitem: proc = {outword[ttab[index].symbol]};
tactionitem: proc = {repack[ttab[index].item]};
repack: PROC [item: itemrec] =
BEGIN SELECT item.tag FROM
0 => outword[item.pss];
1 => outword[item.jf*2048+item.pss];
2 => outword[(16+item.jf)*2048+item.pss];
ENDCASE;
END;
END.