-- file PGSLALR.mesa
-- last modified by Satterthwaite, 21-Jan-80 9:55

DIRECTORY
PGScondefs: FROM "pgscondefs";

PGSLALR: PROGRAM
IMPORTS PGScondefs
EXPORTS PGScondefs =
BEGIN OPEN PGScondefs;
stateinfo:Stateinfo;
table:Table;

linewidth:CARDINAL;
lalrsuccess:BOOLEAN;
entrylim:CARDINAL; -- index into table
six:CARDINAL; -- six, the current state; slim in PGScon the next state number allocated
hashhead:DESCRIPTOR FOR ARRAY [0..60] OF CARDINAL;

-- variables of the lookahead set calculation
top, rlim:CARDINAL; -- global to all incarnations of the recursive procedure context
predstate, symbol:CARDINAL; -- local variables of context shared by all incarnations

backchain:Backchain;
stack:Stack;
chainstack:Chainstack;
bitsinfo:Bitsinfo;
bitstring:Bitstring;
firstbits:Firstbits;

lalrgen:PUBLIC PROCEDURE RETURNS [BOOLEAN] =
BEGIN i, j, k, totalshifts, totalreduces, oldentries, firstorcount:CARDINAL;
redentries, maxredentries, defaultprod:CARDINAL;
conflictflag, reduceflag, messageflag:BOOLEAN;
conflicts:Table;

printheader:PROCEDURE =
BEGIN i, j, p:CARDINAL;
outeol[2];
FOR i DECREASING IN (stateinfo[six+1].nucleus..stateinfo[six].nucleus]
DO [,j,p] ← table[i];
IF linewidth = 0 THEN
BEGIN outnum[six,4]; outchar[’ ,1]; linewidth ← tokensize+5;
IF p>0 THEN outchar[’ ,tokensize-outtoken[rhschar[prodinfo[p].index+j-1]]];
END;
IF linewidth+9 > outbuflim THEN
BEGIN outeol[1]; outchar[’ ,linewidth ← tokensize+5];
END;
outnum[p,4]; outnum[j,3]; outchar[’/,1]; outchar[’ ,1];
ENDLOOP;
outeol[1];
END;

printentry:PROCEDURE [item:itemrec, symmark:CARDINAL] =
BEGIN i:INTEGER; p, j:CARDINAL;
IF item.tag = 2 THEN
BEGIN outstring[" Reduce with "L]; outnum[item.pss,5]; outeol[1];
END
ELSE
BEGIN i ← item.pss; IF item.tag # 0 THEN i ← -i;
IF symmark = 0 THEN
BEGIN [,j,p] ← IF item.tag=0 THEN table[stateinfo[item.pss].nucleus] ELSE item;
symmark ← rhschar[prodinfo[p].index+j-1];
END;
linewidth ← linewidth+tokensize+8;
IF linewidth > outbuflim THEN
BEGIN outeol[1]; linewidth ← tokensize+8;
END;
outnum[i,5]; outchar[’ ,1]; outchar[’ ,tokensize+2-outtoken[symmark]];
END;
END;

printstate:PROCEDURE =
BEGIN i, j, k:CARDINAL;
linewidth ← 0; printheader[]; linewidth ← 0;
i ← stateinfo[six].entries; WHILE i <stateinfo[six+1].entries
DO IF table[i].tag # 3 THEN
BEGIN printentry[table[i],0]; i ← i+1;
END
ELSE
BEGIN FOR j ← i+1, j+1 WHILE table[j].tag = 3 DO NULL ENDLOOP;
FOR k IN [i..j) DO printentry[table[j], table[k].pss] ENDLOOP;
i ← j+1;
END;
ENDLOOP;
END;

lalrheader:PROCEDURE =
BEGIN IF ~messageflag THEN
BEGIN messageflag ← TRUE; seterrstream[]; outeol[1];
outstring["LALR(1) Tables"L]; outeol[1];
END;
IF ~conflictflag THEN
BEGIN conflictflag ← TRUE; linewidth ← 0; printheader[];
END;
END;

lalrsuccess ← TRUE; orcount ← 0;
-- make arrays with all entries zeroed
stateinfo ← LOOPHOLE[makearray[maxstatenum+2,SIZE[stateinforec]]];
table ← LOOPHOLE[makearray[maxtabentries+1,SIZE[itemrec]]];
hashhead ← DESCRIPTOR[AllocateSegment[61],61];
FOR i IN [0..60] DO hashhead[i] ← 0 ENDLOOP;
stateinfo[0].nucleus←maxtabentries; table[maxtabentries] ← [0,1,0]; --final state
stateinfo[1].nucleus←maxtabentries-1; table[maxtabentries-1] ← [0,0,0];--initial state
stateinfo[2].nucleus←maxtabentries-2; slim ← 2;
-- the sets of p,j components defining the LR(0) states are built at the end of table;
-- the nucleus field of each state indexes the appropriate set.
-- the entries for states 1,2,... are built at the beginning of table
stateinfo[1].entries ← entrylim ← totalshifts ← totalreduces ← 0;
IF flags[printlr] THEN
BEGIN setoutstream[".lr"L]; outeol[1]; outstring["LR(0) TABLES"];
END;
FOR six ← 1, six+1 WHILE six < slim
DO processstate[]; stateinfo[six+1].entries ← entrylim;
IF flags[printlr] THEN printstate[]; -- LR(0) tables are only a testing aid
FOR i IN [stateinfo[six].entries..stateinfo[six+1].entries)
DO SELECT table[i].tag FROM
0 => totalshifts ← totalshifts+1;
2 => totalreduces ← totalreduces+1;
ENDCASE;
ENDLOOP
ENDLOOP;
IF flags[printlr] THEN outeol[1];
closeoutstream[];
IF ~flags[lists] AND ~flags[printlalr] THEN RETURN[FALSE];

-- now form inverse of shift transitions for the lookahead sets caculation
backchain ← LOOPHOLE[makearray[totalshifts+1, SIZE[chainrec]]];
FOR six IN [0..slim) DO stateinfo[six].link ← 0 ENDLOOP;
k ← 1;
FOR six IN [1..slim)
DO FOR i IN [stateinfo[six].entries..stateinfo[six+1].entries)
DO IF table[i].tag = 0 THEN -- transition from six to table[i].pss
BEGIN backchain[k].state ← six;
backchain[k].link ← stateinfo[table[i].pss].link;
stateinfo[table[i].pss].link ← k; k ← k+1;
END;
ENDLOOP;
ENDLOOP;

-- LALR(1) calculation begins here
bitstrsize ← (eofile+wordlength-1)/wordlength;
firstbits ← LOOPHOLE[makearray[totaltokens-eofile+1,bitstrsize]];
firstset[]; firstorcount ← orcount;
FOR i IN [0..60] DO hashhead[i] ← 0 ENDLOOP; -- used by find
bitsinfo ← LOOPHOLE[makearray[maxcontexts, SIZE[contextrec]]]; rlim ← 1;
bitstring ← LOOPHOLE[makearray[maxcontexts, bitstrsize]];
stack ← LOOPHOLE[makearray[30,SIZE[CARDINAL]]]; top ← 0;
chainstack ← LOOPHOLE[makearray[90,SIZE[CARDINAL]]];
conflicts ← LOOPHOLE[makearray[totaltokens+1,SIZE[itemrec]]];
messageflag ← FALSE;
tentries ← ntentries ← oldentries ← 0;
IF flags[lists] THEN openwordstream[];

FOR six IN [1..slim)
DO FOR i IN [1..totaltokens] DO conflicts[i] ← [0,0,0] ENDLOOP;
i ← stateinfo[six].entries; WHILE i < stateinfo[six+1].entries
DO -- insert scan and scan reduce entries in conflicts array
SELECT table[i].tag FROM
0 => BEGIN j, p:CARDINAL;
[,j,p] ← table[stateinfo[table[i].pss].nucleus];
conflicts[rhschar[prodinfo[p].index+j-1]] ← table[i]; i ← i+1;
tentries ← tentries+1;
END;
1 => BEGIN j, p:CARDINAL;
[,j,p] ← table[i];
conflicts[rhschar[prodinfo[p].index+j-1]] ← table[i]; i ← i+1;
tentries ← tentries+1;
END;
2 => i ← i+1;
3 => BEGIN conflicts[table[i].pss] ← table[i+1]; i ← i+2;
ntentries ← ntentries+1;
END;
ENDCASE;
ENDLOOP;

-- compute lookaheads, insert reduce entries and output as necessary
conflictflag ← FALSE; maxredentries ← defaultprod ← 0;
FOR i IN [stateinfo[six].entries..stateinfo[six+1].entries) WHILE table[i].tag = 2
DO IF (k ← find[six,[0,table[i].jf,table[i].pss]]) = rlim THEN
BEGIN rlim ← rlim +1; context[k,1];
END;
k ← k*bitstrsize; -- @bitstring[k] points at the LALR(1) lookahead for this reduce
reduceflag ← FALSE; redentries ← 0;
FOR j IN [1..eofile]
DO IF findbit[j,@bitstring[k]] THEN
BEGIN IF conflicts[j] = [0,0,0] THEN
BEGIN conflicts[j] ← table[i]; tentries ← tentries+1;
redentries ← redentries+1;
END
ELSE
BEGIN --we have conflicts
lalrheader[];
IF ~reduceflag THEN
BEGIN reduceflag ← TRUE; outstring[" REDUCE with "L];
outnum[table[i].pss,4]; outstring[" conflicts with "L]; outchar[’ ,40];
outchar[’*,10]; linewidth ← outbuflim;
END;
IF (linewidth ← linewidth+tokensize+7) > outbuflim THEN
BEGIN outeol[1]; outchar[’ ,4]; linewidth ← tokensize+11;
END;
outchar[’ ,tokensize-outtoken[j]];
IF conflicts[j].tag # 2 THEN
BEGIN outstring[" SCAN/ "L]; warningslogged ← TRUE;
END
ELSE
BEGIN outnum[conflicts[j].pss,5]; outstring["/ "L]; lalrsuccess ← FALSE;
IF flags[lists] THEN -- turn off binary output
BEGIN flags[lists] ← FALSE; closewordstream[];
END;
END;
END;
END;
ENDLOOP;
IF reduceflag THEN outeol[1];
IF redentries > maxredentries THEN
BEGIN maxredentries ← redentries; defaultprod ← table[i].pss;
END;
ENDLOOP;

IF flags[printlalr] THEN lalrheader[];
IF flags[lists] THEN
BEGIN outword[defaultprod]; outword[tentries+ntentries-oldentries];
oldentries ← tentries+ntentries;
END;
linewidth ← 0;
FOR j IN [1..totaltokens]
DO IF conflicts[j] # [0,0,0] THEN
BEGIN item:itemrec ← conflicts[j];
-- grab entries for tabgen here
IF flags[lists] THEN
BEGIN outword[j];
outword[IF item.tag=0 THEN 0 ELSE 4*item.jf+item.tag]; outword[item.pss];
END;
IF flags[printlalr] OR conflictflag THEN
BEGIN IF item.tag = 2 THEN
BEGIN signchar ← ’*; item.tag ←1;
END;
printentry[item,j]; signchar ← ’-;
END;
END;
ENDLOOP;
ENDLOOP;

seterrstream[];outeol[2]; outstring["LALR(1) Statistics"L]; outeol[1];
outstring["States ="L]; outnum[slim-1, 4]; outeol[1];
outstring["Terminal entries ="L]; outnum[tentries, 5]; outeol[1];
outstring["Nonterminal entries ="L]; outnum[ntentries, 5]; outeol[1];
outstring["First OR operation count ="L]; outnum[firstorcount, 5]; outeol[1];
outstring["Total OR operation count ="L]; outnum[orcount, 5]; outeol[1];
outstring["Maximum number of contexts ="L]; outnum[rlim-1, 5]; outeol[1];

FreeSegment[BASE[conflicts]]; FreeSegment[BASE[chainstack]];
FreeSegment[BASE[stack]]; FreeSegment[BASE[bitstring]];
FreeSegment[BASE[bitsinfo]]; FreeSegment[BASE[firstbits]];
FreeSegment[BASE[backchain]]; FreeSegment[BASE[hashhead]];
FreeSegment[BASE[table]]; FreeSegment[BASE[stateinfo]];
FreeSegment[BASE[rhschar]]; FreeSegment[BASE[tokeninfo]];
RETURN[lalrsuccess];
END;

processstate:PROCEDURE =
BEGIN k1, k2, nmark, entrymark:CARDINAL; -- indexes into table
p, j, n:CARDINAL;
sym, nsym:CARDINAL;

-- procedures called by processstate

sort:PROCEDURE[index:CARDINAL] =
BEGIN k1, k2:CARDINAL; item:itemrec; noswap:BOOLEAN;

compare:PROCEDURE RETURNS [BOOLEAN] =
BEGIN RETURN[ table[k1+1].pss > table[k1+3].pss OR
(table[k1+1].pss = table[k1+3].pss AND table[k1+1].jf > table[k1+3].jf)];
END;

FOR k2 ← entrylim-2, k2-2 WHILE k2>=index
DO noswap ← TRUE;
FOR k1 ← index, k1+2 WHILE k1<k2
DO IF (table[k1].pss > table[k1+2].pss OR
table[k1].pss = table[k1+2].pss AND compare[])
THEN
BEGIN item ← table[k1]; table[k1] ← table[k1+2]; table[k1+2] ← item;
item ← table[k1+1]; table[k1+1] ← table[k1+3]; table[k1+3] ← item;
noswap ← FALSE;
END;
ENDLOOP;
IF noswap THEN RETURN;
ENDLOOP;
END;

expandtable:PROCEDURE =
BEGIN i:CARDINAL; new:LongDes;
new ← LOOPHOLE[makearray[LENGTH[table]+tabext,SIZE[itemrec]]];
FOR i IN [0..entrylim) DO new[i] ← table[i] ENDLOOP;
FOR i IN (stateinfo[slim].nucleus..LENGTH[table])
DO new[i+tabext] ← table[i]
ENDLOOP;
FOR i IN [1..slim]
DO stateinfo[i].nucleus ← stateinfo[i].nucleus+tabext;
ENDLOOP;
FreeSegment[BASE[table]]; table ← new;
END;

locatestate:PROCEDURE[index, n:CARDINAL] RETURNS [CARDINAL] =
BEGIN i, j, k, r:CARDINAL;
IF table[index+1] = [0,1,0] THEN RETURN[0]; -- final state, n=2 in this case
r ← (63*n+LOOPHOLE[table[index+1],CARDINAL]) MOD 61;
i ← hashhead[r];
WHILE i # 0
DO IF n = 2*(stateinfo[i].nucleus-stateinfo[i+1].nucleus) THEN
BEGIN k ← index+1;
FOR j DECREASING IN (stateinfo[i+1].nucleus..stateinfo[i].nucleus]
DO IF table[j] # table[k] THEN EXIT; k ← k+2;
REPEAT FINISHED => RETURN[i]
ENDLOOP;
END;
i ← stateinfo[i].link;
ENDLOOP;
-- a new state
IF hashhead[r] # 0 THEN stateinfo[slim].link ← hashhead[r]; hashhead[r] ← slim;
IF slim+1 = LENGTH[stateinfo] THEN
stateinfo ← LOOPHOLE[expand[stateinfo, SIZE[stateinforec], stateext]];
IF entrylim+n/2 > stateinfo[slim].nucleus THEN expandtable[];
-- insert new nucleus
r ← stateinfo[slim].nucleus;
FOR i ← index+1, i+2 WHILE i<index+n
DO table[r] ← table[i]; r ← r-1;
ENDLOOP;
slim ← slim+1; stateinfo[slim].nucleus ← r;
IF slim <= psslim+1 THEN RETURN[slim-1] ELSE
BEGIN seterrstream[]; outeol[2];
outstring["ERROR - Internal field will overflow - increase PSSLIM"L]; outeol[1];
ERROR PGSfail[];
END;
END;

-- end of local procedures

k1 ← stateinfo[six].nucleus;
IF (k1-stateinfo[six+1].nucleus)*2 > stateinfo[slim].nucleus-entrylim+1
THEN expandtable[];
-- copy nucleus to entries
FOR k1 DECREASING IN (stateinfo[six+1].nucleus..k1]
DO table[entrylim+1] ← table[k1]; entrylim ← entrylim+2;
ENDLOOP;

-- compute closure
entrymark ← entrylim;
FOR k2 ← stateinfo[six].entries, k2+2 WHILE k2<entrylim
DO p ← table[k2+1].pss; j ← table[k2+1].jf; table[k2] ← [0,0,0];
IF j # prodinfo[p].count THEN --not a reduce
BEGIN sym ← rhschar[prodinfo[p].index+j]; table[k2].pss ← sym;
IF sym>eofile THEN -- nonterminal scan
BEGIN t:tokenrecord ← tokeninfo[sym-eofile];
FOR p IN [t.index..t.index+t.count)
DO FOR k1 ← entrymark, k1+2 WHILE k1<entrylim
DO IF table[k1+1] = [0,0,p] THEN EXIT
REPEAT FINISHED =>
BEGIN IF entrylim+2 > stateinfo[slim].nucleus THEN expandtable[];
table[entrylim+1] ← [0,0,p]; entrylim ← entrylim+2;
END;
ENDLOOP;
ENDLOOP;
END;
END;
ENDLOOP;
sort[stateinfo[six].entries];

IF flags[chain] THEN -- extend closure
BEGIN k2 ← stateinfo[six].entries;
WHILE k2 < entrylim AND table[k2].pss <= eofile DO k2 ← k2+2 ENDLOOP;
IF k2 < entrylim THEN
BEGIN entrymark ← k2; --first nonterminal entry
WHILE k2 < entrylim
DO p ← table[k2+1].pss;
IF prodinfo[p].chain THEN
BEGIN sym ← table[k2].pss; nsym ← prodinfo[p].lhs; -- now search for lhs entry
k1 ← entrymark; WHILE nsym # table[k1].pss DO k1 ← k1+2 ENDLOOP;
-- now overwrite chain entry with first chained entry
table[k2+1] ← table[k1+1];
k2 ← k2-2; -- back up k2 in case first chained entry is also a chain entry
-- now append the other chained entries
FOR k1 ← k1+2, k1+2 WHILE k1 < entrylim
DO IF nsym = table[k1].pss THEN
BEGIN IF entrylim+2 > stateinfo[slim].nucleus THEN expandtable[];
table[entrylim].pss ← sym; table[entrylim+1] ← table[k1+1];
entrylim ← entrylim+2;
END;
ENDLOOP;
END;
k2 ← k2+2;
ENDLOOP;
sort[entrymark];
END;
END;

-- pack up reduce entries
k1 ← k2 ← stateinfo[six].entries;
WHILE k2 < entrylim AND table[k2].pss = 0
DO table[k1] ← table[k2+1]; table[k1].tag ← 2; k1 ← k1+1; k2 ← k2+2;
ENDLOOP;

-- form new states and pack up entries
entrymark ← k2; nmark ← 0;
WHILE entrymark < entrylim
DO k2 ← entrymark+2;
WHILE k2 < entrylim AND table[k2].pss = table[entrymark].pss
DO table[k2+1].jf ← table[k2+1].jf+1; k2 ← k2+2;
ENDLOOP;
table[entrymark+1].jf ← table[entrymark+1].jf+1;
n ← k2-entrymark; -- 2*number of elements in this state
IF n#2 OR table[entrymark+1].jf # prodinfo[table[entrymark+1].pss].count THEN
table[entrymark+1] ← [0,1,locatestate[entrymark,n]] -- make shift
ELSE table[entrymark+1].tag ← 1; -- make scan reduce
IF table[entrymark].pss > eofile THEN -- insert symbol
BEGIN IF nmark = 0 THEN nmark ← k1;
table[k1] ← [3,0,table[entrymark].pss]; k1 ← k1+1;
END;
table[k1] ← table[entrymark+1]; k1 ← k1+1; --insert shift or scan reduce
entrymark ← k2;
ENDLOOP;
entrylim ← k1; -- entrylim-1 => last entry, nmark => first nonterminal entry or is 0
END;

firstset:PROCEDURE=
BEGIN i, j, top, listindex:CARDINAL;
discrim, vertices:DESCRIPTOR FOR ARRAY OF CARDINAL;
t:tokenrecord; p:prodrecord;

first:PROCEDURE[nonterm:CARDINAL]=
BEGIN prix, chix, w:CARDINAL;
discrim[nonterm] ← top ← top+1; vertices[top] ← nonterm;
t ← tokeninfo[nonterm];
FOR prix IN [t.index..t.index+t.count)
DO p ← prodinfo[prix];
FOR chix IN [p.index..p.index+p.count)
DO w ← rhschar[chix];
IF w <= eofile THEN
BEGIN insertbit[w,@firstbits[nonterm*bitstrsize]]; EXIT;
END;
w ← w-eofile; IF discrim[w] = 0 THEN first[w];
IF discrim[w] <= top THEN discrim[nonterm] ← MIN[discrim[nonterm], discrim[w]]
ELSE orbits[@firstbits[vertices[discrim[w]]*bitstrsize],
@firstbits[nonterm*bitstrsize]];
IF ~tokeninfo[w].empty THEN EXIT;
ENDLOOP;
ENDLOOP;
IF nonterm = vertices[discrim[nonterm]] THEN
BEGIN listindex ← listindex-1;
w ← vertices[top]; top ← top-1; discrim[w] ← listindex;
WHILE w # nonterm
DO orbits[@firstbits[w*bitstrsize], @firstbits[nonterm*bitstrsize]];
w ← vertices[top]; top ← top-1; discrim[w] ← listindex;
ENDLOOP;
vertices[listindex] ← nonterm;
END;
END;

discrim ← LOOPHOLE[makearray[totaltokens-eofile+1, SIZE[CARDINAL]]];
vertices ← LOOPHOLE[makearray[totaltokens-eofile+1, SIZE[CARDINAL]]];
listindex ← totaltokens-eofile+1; top ← 0; -- initialise stack and list of heads
FOR i IN [1..totaltokens-eofile] DO IF discrim[i] = 0 THEN first[i] ENDLOOP;
FOR i IN [1..totaltokens-eofile] -- copy head bitstrings to other scc vertices
DO IF i # vertices[discrim[i]] THEN
orbits[@firstbits[vertices[discrim[i]]*bitstrsize], @firstbits[i*bitstrsize]];
ENDLOOP;
FreeSegment[BASE[discrim]]; FreeSegment[BASE[vertices]];
IF flags[first] THEN
BEGIN setoutstream[".first"L]; outeol[1]; outstring["FIRST SETS"L]; outeol[2];
FOR i IN [1..totaltokens-eofile]
DO [] ← outtoken[i+eofile]; linewidth ← outbuflim;
FOR j IN [1..eofile]
DO IF findbit[j,@firstbits[i*bitstrsize]] THEN
BEGIN IF (linewidth ← linewidth+tokensize+1) > outbuflim THEN
BEGIN outeol[1]; outchar[’ ,4]; linewidth ← tokensize+5;
END;
outchar[’ ,tokensize+1-outtoken[j]];
END;
ENDLOOP;
outeol[2];
ENDLOOP;
closeoutstream[];
END;
END;

find:PROCEDURE[state:CARDINAL, item:itemrec] RETURNS [CARDINAL]=
BEGIN i, r:CARDINAL;
r ← (state + LOOPHOLE[item,CARDINAL]) MOD 61; i ← hashhead[r];
WHILE i # 0
DO IF state = bitsinfo[i].state AND item = bitsinfo[i].item THEN RETURN[i];
i ← bitsinfo[i].link;
ENDLOOP;
-- new context
IF rlim>=LENGTH[bitsinfo] THEN
BEGIN bitsinfo ← LOOPHOLE[expand[bitsinfo,SIZE[contextrec],LENGTH[bitsinfo]/8]];
bitstring ← LOOPHOLE[expand[bitstring,bitstrsize,LENGTH[bitstring]/8]];
END;
IF hashhead[r] # 0 THEN bitsinfo[rlim].link ← hashhead[r];
hashhead[r] ← rlim;
bitsinfo[rlim].state ← state; bitsinfo[rlim].item ← item;
RETURN[rlim];
END;

context:PROCEDURE[index,base:CARDINAL] =
BEGIN cj,j:CARDINAL; -- displacements relative to base into chainstack
i:CARDINAL; -- used locally but also indexes current (q,k+1) across recursive calls
k:CARDINAL; -- used locally but also indexes current state across recursive calls

top ← top+1;
IF top = LENGTH[stack] THEN stack ← LOOPHOLE[expand[stack,SIZE[CARDINAL],15]];
bitsinfo[index].status ← top; stack[top] ← index; -- initialise for transitive closure
j ← bitsinfo[index].item.jf; -- want the jth predecessor state
IF base+MAX[1,j] >= LENGTH[chainstack] THEN
chainstack ← LOOPHOLE[expand[chainstack,SIZE[CARDINAL],45]];
cj ←1; chainstack[base+cj] ← stateinfo[bitsinfo[index].state].link; --index 1st predec
DO -- for each jth predecessor state
IF j=0 THEN
BEGIN predstate ← bitsinfo[index].state; -- zeroth predecessor
j ← 1; chainstack[base+cj] ← 0; --ensure no more zeroth predecessors
END
ELSE
DO IF chainstack[base+cj] = 0 THEN
BEGIN IF (cj ← cj-1) =0 THEN GOTO quit; -- no more jth predecessors
END
ELSE
BEGIN [predstate,chainstack[base+cj]] ← backchain[chainstack[base+cj]];
IF cj=j THEN EXIT;
cj ← cj+1; chainstack[base+cj] ← stateinfo[predstate].link;
END;
ENDLOOP;
-- locate the (q,k+1) in each jth predecessor state
FOR i IN [stateinfo[predstate].entries..stateinfo[predstate+1].entries)
DO IF table[i] = [3,0,prodinfo[bitsinfo[index].item.pss].lhs] THEN EXIT;
REPEAT FINISHED => ERROR -- nonterminal not found
ENDLOOP;
i ← i+1; -- index the associated item
IF table[i].tag # 0 THEN k ← i-1 ELSE
BEGIN k ← stateinfo[table[i].pss+1].nucleus; i ← stateinfo[table[i].pss].nucleus;
END;
FOR i DECREASING IN (k..i] --select each (q,k+1) s.t. X[q,k+1] = A[p]
DO FOR k IN [table[i].jf..prodinfo[table[i].pss].count) --all v s.t. k+2<=v<= n[q]
DO IF (symbol ← rhschar[prodinfo[table[i].pss].index+k]) <= eofile THEN
BEGIN --X[q.v]<=eofile
insertbit[symbol, @bitstring[index*bitstrsize] ];
EXIT;
END
ELSE
BEGIN symbol ← symbol-eofile;
orbits[ @firstbits[symbol*bitstrsize], @bitstring[index*bitstrsize] ];
IF ~tokeninfo[symbol].empty THEN EXIT;
END;
-- now the core of the transitive closure algorithm
REPEAT FINISHED =>
BEGIN IF (k ← find[predstate, [0,table[i].jf-1,table[i].pss]]) = rlim THEN
BEGIN rlim ← rlim+1; context[k,base+j];
END;
IF bitsinfo[k].status <= top THEN
bitsinfo[index].status ← MIN[bitsinfo[index].status,bitsinfo[k].status]
ELSE
BEGIN orbits[ @bitstring[k*bitstrsize], @bitstring[index*bitstrsize] ];
END;
END;
ENDLOOP;
ENDLOOP;
REPEAT quit => NULL
ENDLOOP;
IF index = stack[bitsinfo[index].status] THEN --scc head
BEGIN k ← top; i ← stack[top]; bitsinfo[i].status ← LAST[CARDINAL];
FOR top ← top-1, top-1 WHILE i #index
DO orbits[ @bitstring[i*bitstrsize], @bitstring[index*bitstrsize] ];
i ← stack[top]; bitsinfo[i].status ← LAST[CARDINAL];
ENDLOOP;
FOR k IN [top+2..k]
DO orbits[ @bitstring[index*bitstrsize], @bitstring[stack[k]*bitstrsize] ];
ENDLOOP;
END;
END;

END.