-- file PGSLALR.mesa
-- last modified by Satterthwaite, January 10, 1983 4:19 pm 

DIRECTORY
  PGSConDefs: TYPE USING [
    maxContexts, maxTabEntries, maxStateNum, outbufLim, pssLim,
    stateExt, tabExt, tokenSize, wordLength,
    bitstrSize, eofMark, flags, ntEntries, orCount, prodInfo, rhsChar,
    sLim, tEntries, tokenInfo, totalTokens, warningsLogged, zone,
    closeoutstream, closewordstream, Expand, FindBit,
    FreeArray, InsertBit, MakeArray, openwordstream, OrBits,
    outchar, outeol, outnum, outstring, OutToken, outword,
    seterrstream, setoutstream, PGSFail],
  PGSTypes: TYPE USING [
    AttrVec, BackChain, BitsInfo, BitString, ChainRec, ChainStack, ContextRec,
    FirstBits, HashHeads, HashHeadsRef, ItemRec, LongDes, ProdEntry, Stack,
    StateInfo, StateInfoRec, Table, TokenEntry];

PGSLALR: PROGRAM
    IMPORTS PGSConDefs 
    EXPORTS PGSConDefs = {
  OPEN PGSConDefs;

  stateInfo: PGSTypes.StateInfo;
  table: PGSTypes.Table;

  lineWidth: CARDINAL;
  lalrSuccess: BOOL;
  entryLim: CARDINAL; -- index into table
  six: CARDINAL; -- six, the current state; sLim in PGScon the next state number allocated
  hashHead: PGSTypes.HashHeadsRef;

  -- 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: PGSTypes.BackChain;
  stack: PGSTypes.Stack;
  chainStack: PGSTypes.ChainStack;
  bitsInfo: PGSTypes.BitsInfo;
  bitString: PGSTypes.BitString;
  firstBits: PGSTypes.FirstBits;

  LALRGen: PUBLIC PROC RETURNS [BOOL] = {
    i, j, k, totalShifts, totalReduces, oldEntries, firstOrCount: CARDINAL;
    redEntries, maxRedEntries, defaultProd: CARDINAL;
    conflictFlag, reduceFlag, messageFlag: BOOL;
    conflicts: PGSTypes.Table;

    PrintHeader: PROC = {
      j, p: CARDINAL;
      outeol[2];
      FOR i: CARDINAL DECREASING IN (stateInfo[six+1].nucleus..stateInfo[six].nucleus] DO
        [,j,p] _ table[i];
        IF lineWidth = 0 THEN {
          outnum[six,4]; outchar[' ,1]; lineWidth _ tokenSize+5;
          IF p>0 THEN outchar[' ,tokenSize-OutToken[rhsChar[prodInfo[p].index+j-1]]]};
        IF lineWidth+9 > outbufLim THEN {outeol[1]; outchar[' ,lineWidth _ tokenSize+5]};
        outnum[p,4]; outnum[j,3]; outchar['/,1]; outchar[' ,1];
        ENDLOOP;
      outeol[1]};

    PrintEntry: PROC [
	item: PGSTypes.ItemRec, symmark: CARDINAL, sign: CHAR_'-] = {
      i: INTEGER;  p, j: CARDINAL;
      IF item.tag = 2 THEN {
	outstring["    Reduce with "L]; outnum[item.pss,5,sign]; outeol[1]}
      ELSE {
        i _ item.pss; IF item.tag # 0 THEN i _ -i;
        IF symmark = 0 THEN {
          [,j,p] _ IF item.tag=0 THEN table[stateInfo[item.pss].nucleus] ELSE item;
          symmark _ rhsChar[prodInfo[p].index+j-1]};
        lineWidth _ lineWidth+tokenSize+8;
        IF lineWidth > outbufLim THEN {outeol[1]; lineWidth _ tokenSize+8};
        outnum[i,5,sign]; outchar[' ,1]; outchar[' ,tokenSize+2-OutToken[symmark]]}};

    PrintState: PROC = {
      i, j: CARDINAL;
      lineWidth _ 0; PrintHeader[]; lineWidth _ 0;
      i _ stateInfo[six].entries; WHILE i <stateInfo[six+1].entries
      DO
	IF table[i].tag # 3 THEN {PrintEntry[table[i],0]; i _ i+1}
	ELSE {
	  FOR j _ i+1, j+1 WHILE table[j].tag = 3 DO NULL ENDLOOP;
	  FOR k: CARDINAL IN [i..j) DO PrintEntry[table[j], table[k].pss] ENDLOOP;
	  i _ j+1};
        ENDLOOP};

    LalrHeader: PROC = {
      IF ~messageFlag THEN {
	messageFlag _ TRUE; seterrstream[]; outstring["\nLALR(1) Tables\n"L];};
      IF ~conflictFlag THEN {conflictFlag _ TRUE; lineWidth _ 0; PrintHeader[]}};

    lalrSuccess _ TRUE; orCount _ 0;
  -- make arrays with all entries zeroed
    stateInfo _ LOOPHOLE[MakeArray[maxStateNum+2,PGSTypes.StateInfoRec.SIZE]];
    table _ LOOPHOLE[MakeArray[maxTabEntries+1,PGSTypes.ItemRec.SIZE]];
    hashHead _ zone.NEW[PGSTypes.HashHeads _ ALL[0]];
    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 {setoutstream[".lr"L]; outstring["\nLR(0) TABLES"L]};
    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, PGSTypes.ChainRec.SIZE]];
    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
          backChain[k].state _ six;  backChain[k].link _ stateInfo[table[i].pss].link;
          stateInfo[table[i].pss].link _ k; k _ k+1};
        ENDLOOP;
      ENDLOOP;

    -- LALR(1) calculation begins here
    bitstrSize _ (eofMark+wordLength-1)/wordLength;
    firstBits _ LOOPHOLE[MakeArray[totalTokens-eofMark+1,bitstrSize]];
    FirstSet[]; firstOrCount _ orCount;
    hashHead^ _ ALL[0]; -- used by find
    bitsInfo _ LOOPHOLE[MakeArray[maxContexts, PGSTypes.ContextRec.SIZE]]; rlim _ 1;
    bitString _ LOOPHOLE[MakeArray[maxContexts, bitstrSize]];
    stack _ LOOPHOLE[MakeArray[30,CARDINAL.SIZE]]; top _ 0;
    chainStack _ LOOPHOLE[MakeArray[90,CARDINAL.SIZE]];
    conflicts _ LOOPHOLE[MakeArray[totalTokens+1,PGSTypes.ItemRec.SIZE]];
    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 => {
	    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};
          1 => {
	    j, p: CARDINAL;
	    [,j,p] _ table[i];
	    conflicts[rhsChar[prodInfo[p].index+j-1]] _ table[i]; i _ i+1;
	    tEntries _ tEntries+1};
          2 => i _ i+1;
          3 => {conflicts[table[i].pss] _ table[i+1]; i _ i+2;  ntEntries _ ntEntries+1};
          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 {
          rlim _ rlim +1; Context[k,1]};
        k _ k*bitstrSize; -- @bitString[k] points at the LALR(1) lookahead for this reduce
        reduceFlag _ FALSE; redEntries _ 0;
        FOR j IN [1..eofMark] DO
	  IF FindBit[j,@bitString[k]] THEN {
	    IF conflicts[j] = [0,0,0] THEN {
	      conflicts[j] _ table[i]; tEntries _ tEntries+1;  redEntries _ redEntries+1}
	    ELSE { --we have conflicts
	      LalrHeader[];
	      IF ~reduceFlag THEN {
		reduceFlag _ TRUE; outstring["    REDUCE with "L];
		outnum[table[i].pss,4]; outstring[" conflicts with "L]; outchar[' ,40];
		outchar['*,10]; lineWidth _ outbufLim};
	      IF (lineWidth _ lineWidth+tokenSize+7) > outbufLim THEN {
		outeol[1]; outchar[' ,4]; lineWidth _ tokenSize+11};
	      outchar[' ,tokenSize-OutToken[j]];
	      IF conflicts[j].tag # 2 THEN {
		outstring[" SCAN/ "L]; warningsLogged _ TRUE}
	      ELSE {
		outnum[conflicts[j].pss,5]; outstring["/ "L]; lalrSuccess _ FALSE;
		IF flags[lists] THEN { -- turn off binary output
		  flags[lists] _ FALSE; closewordstream[]}}}};
	  ENDLOOP;
        IF reduceFlag THEN outeol[1];
        IF redEntries > maxRedEntries THEN {
	  maxRedEntries _ redEntries; defaultProd _ table[i].pss};
        ENDLOOP;

      IF flags[printLALR] THEN LalrHeader[];
      IF flags[lists] THEN {
        outword[defaultProd]; outword[tEntries+ntEntries-oldEntries];
        oldEntries _ tEntries+ntEntries};
      lineWidth _ 0;
      FOR j IN [1..totalTokens] DO
        IF conflicts[j] # [0,0,0] THEN {
          item: PGSTypes.ItemRec _ conflicts[j];
          -- grab entries for tabgen here
          IF flags[lists] THEN {
            outword[j];
            outword[IF item.tag=0 THEN 0 ELSE 4*item.jf+item.tag]; outword[item.pss]};
          IF flags[printLALR] OR conflictFlag THEN {
            IF item.tag = 2 THEN {item.tag _ 1; PrintEntry[item,j,'*]}
            ELSE PrintEntry[item,j]}};
        ENDLOOP;
      ENDLOOP;

    seterrstream[]; outstring["\nLALR(1) Statistics"L];
    outstring["\nStates ="L]; outnum[sLim-1, 4];
    outstring["\nTerminal entries ="L]; outnum[tEntries, 5];
    outstring["\nNonterminal entries ="L]; outnum[ntEntries, 5];
    outstring["\nFirst OR operation count ="L]; outnum[firstOrCount, 5];
    outstring["\nTotal OR operation count ="L]; outnum[orCount, 5];
    outstring["\nMaximum number of contexts ="L]; outnum[rlim-1, 5];
    outeol[1];

    FreeArray[conflicts]; FreeArray[chainStack];
    FreeArray[stack]; FreeArray[bitString];
    FreeArray[bitsInfo]; FreeArray[firstBits];
    FreeArray[backChain];
    FreeArray[table]; FreeArray[stateInfo];
    FreeArray[rhsChar]; FreeArray[tokenInfo];
    zone.FREE[@hashHead];
    RETURN [lalrSuccess]};

  ProcessState: PROC = {
    k1, k2, nmark, entrymark: CARDINAL; -- indexes into table
    p, j, n: CARDINAL;
    sym, nsym: CARDINAL;
    
    -- procedures called by ProcessState

    Sort: PROC [index: CARDINAL] = {
      k1, k2: CARDINAL; item: PGSTypes.ItemRec; noswap: BOOL;

      Compare: PROC RETURNS [BOOL] = INLINE {
        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)]};

      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 {
	   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};
	 ENDLOOP;
        IF noswap THEN RETURN;
        ENDLOOP};

    ExpandTable: PROC = {
      i: CARDINAL; new: PGSTypes.LongDes;
      new _ LOOPHOLE[MakeArray[table.LENGTH+tabExt,PGSTypes.ItemRec.SIZE]];
      FOR i IN [0..entryLim) DO new[i] _ table[i] ENDLOOP;
      FOR i IN (stateInfo[sLim].nucleus..table.LENGTH) DO
        new[i+tabExt] _ table[i] ENDLOOP;
      FOR i IN [1..sLim] DO stateInfo[i].nucleus _ stateInfo[i].nucleus+tabExt ENDLOOP;
      FreeArray[table]; table _ new};

    LocateState: PROC [index, n: CARDINAL] RETURNS [CARDINAL] = {
      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 hashHead^.LENGTH;
      FOR i _ hashHead[r], stateInfo[i].link WHILE i # 0 DO
        IF n = 2*(stateInfo[i].nucleus-stateInfo[i+1].nucleus) THEN {
	 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};
        ENDLOOP;
      -- a new state
      IF hashHead[r] # 0 THEN stateInfo[sLim].link _ hashHead[r]; hashHead[r] _ sLim;
      IF sLim+1 = stateInfo.LENGTH THEN
        stateInfo _ LOOPHOLE[Expand[stateInfo, PGSTypes.StateInfoRec.SIZE, 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 {
        seterrstream[];
        outstring["\n\nERROR - Internal field will overflow - increase PSSLIM\n"L];
        ERROR PGSFail[]}};

    -- 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
        sym _ rhsChar[prodInfo[p].index+j]; table[k2].pss _ sym;
        IF sym>eofMark THEN { -- nonterminal scan
          t: PGSTypes.TokenEntry = tokenInfo[sym-eofMark];
          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 => {
	       IF entryLim+2 > stateInfo[sLim].nucleus THEN ExpandTable[];
	       table[entryLim+1] _ [0,0,p]; entryLim _ entryLim+2};
	     ENDLOOP;
	   ENDLOOP}};
      ENDLOOP;
    Sort[stateInfo[six].entries];

    IF flags[chain] THEN {  -- extend closure
      k2 _ stateInfo[six].entries;
      WHILE k2 < entryLim AND table[k2].pss <= eofMark DO k2 _ k2+2 ENDLOOP;
      IF k2 < entryLim THEN {
        entrymark _ k2; --first nonterminal entry
        WHILE k2 < entryLim DO
          p _ table[k2+1].pss;
          IF prodInfo[p].chain THEN {
            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 {
                IF entryLim+2 > stateInfo[sLim].nucleus THEN ExpandTable[];
                table[entryLim].pss _ sym; table[entryLim+1] _ table[k1+1];
                entryLim _ entryLim+2};
              ENDLOOP};
          k2 _ k2+2;
          ENDLOOP;
        Sort[entrymark]}};

    -- 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 > eofMark THEN { -- insert symbol
        IF nmark = 0 THEN nmark _ k1;
        table[k1] _ [3,0,table[entrymark].pss]; k1 _ k1+1};
      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

  FirstSet: PROC = {
    i, j, top, listindex: CARDINAL;
    discrim, vertices: PGSTypes.AttrVec;
    t: PGSTypes.TokenEntry;
    p: PGSTypes.ProdEntry;

    First: PROC [nonterm: CARDINAL] = {
      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 <= eofMark THEN {InsertBit[w,@firstBits[nonterm*bitstrSize]]; EXIT};
          w _ w-eofMark; 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 {
        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}};

    discrim _ LOOPHOLE[MakeArray[totalTokens-eofMark+1, CARDINAL.SIZE]];
    vertices _ LOOPHOLE[MakeArray[totalTokens-eofMark+1, CARDINAL.SIZE]];
    listindex _ totalTokens-eofMark+1; top _ 0; -- initialise stack and list of heads
    FOR i IN [1..totalTokens-eofMark] DO IF discrim[i] = 0 THEN First[i] ENDLOOP;
    FOR i IN [1..totalTokens-eofMark] DO  -- copy head bitStrings to other scc vertices
      IF i # vertices[discrim[i]] THEN
        OrBits[@firstBits[vertices[discrim[i]]*bitstrSize], @firstBits[i*bitstrSize]];
      ENDLOOP;
    FreeArray[discrim]; FreeArray[vertices];
    IF flags[first] THEN {
      setoutstream[".first"L]; outstring["\nFIRST SETS\n\n"L];
      FOR i IN [1..totalTokens-eofMark] DO
        [] _ OutToken[i+eofMark]; lineWidth _ outbufLim;
        FOR j  IN [1..eofMark] DO
          IF FindBit[j,@firstBits[i*bitstrSize]] THEN {
            IF (lineWidth _ lineWidth+tokenSize+1) > outbufLim THEN {
              outeol[1]; outchar[' ,4]; lineWidth _ tokenSize+5};
            outchar[' ,tokenSize+1-OutToken[j]]};
          ENDLOOP;
        outeol[2];
        ENDLOOP;
      closeoutstream[]}};

  Find: PROC [state: CARDINAL, item: PGSTypes.ItemRec] RETURNS [CARDINAL] = {
    i, r: CARDINAL;
    r _ (state + LOOPHOLE[item,CARDINAL]) MOD hashHead^.LENGTH; 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>=bitsInfo.LENGTH THEN {
      bitsInfo _ LOOPHOLE[Expand[bitsInfo,PGSTypes.ContextRec.SIZE,bitsInfo.LENGTH/8]];
      bitString _ LOOPHOLE[Expand[bitString,bitstrSize,bitString.LENGTH/8]]};
    IF hashHead[r] # 0 THEN bitsInfo[rlim].link _ hashHead[r];
    hashHead[r] _ rlim;
    bitsInfo[rlim].state _ state; bitsInfo[rlim].item _ item;
    RETURN [rlim]};

  Context: PROC [index, base: CARDINAL] = {
    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 = stack.LENGTH THEN stack _ LOOPHOLE[Expand[stack,CARDINAL.SIZE,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] >= chainStack.LENGTH THEN
      chainStack _ LOOPHOLE[Expand[chainStack,CARDINAL.SIZE,45]];
    cj _ 1; chainStack[base+cj] _ stateInfo[bitsInfo[index].state].link; --index 1st predec
    DO -- for each jth predecessor state
      IF j=0 THEN {
	predState _ bitsInfo[index].state; -- zeroth predecessor
	j _ 1; chainStack[base+cj] _ 0}  --ensure no more zeroth predecessors
      ELSE
	DO
	  IF chainStack[base+cj] = 0 THEN {
	    IF (cj _ cj-1) =0 THEN GOTO quit} -- no more jth predecessors
	  ELSE {
	    [predState, chainStack[base+cj]] _ backChain[chainStack[base+cj]];
	    IF cj=j THEN EXIT;
	    cj _ cj+1; chainStack[base+cj] _ stateInfo[predState].link};
	  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 {
	k _ stateInfo[table[i].pss+1].nucleus; i _ stateInfo[table[i].pss].nucleus};
      FOR i DECREASING IN (k..i] DO --select each (q,k+1) s.t. X[q,k+1] = A[p]
	FOR k IN [table[i].jf..prodInfo[table[i].pss].count) DO --all v s.t. k+2<=v<= n[q]
	  IF (symbol _ rhsChar[prodInfo[table[i].pss].index+k]) <= eofMark THEN {
	      -- X[q.v]<=eofMark
	    InsertBit[symbol, @bitString[index*bitstrSize] ]; EXIT}
	  ELSE {
	    symbol _ symbol-eofMark;
	    OrBits[ @firstBits[symbol*bitstrSize], @bitString[index*bitstrSize] ];
	    IF ~tokenInfo[symbol].empty THEN EXIT};
	  -- now the core of the transitive closure algorithm
	  REPEAT FINISHED => {
	    IF (k _ Find[predState, [0,table[i].jf-1,table[i].pss]]) = rlim THEN {
	      rlim _ rlim+1; Context[k,base+j]};
	    IF bitsInfo[k].status <= top THEN
	      bitsInfo[index].status _ MIN[bitsInfo[index].status,bitsInfo[k].status]
	    ELSE OrBits[ @bitString[k*bitstrSize], @bitString[index*bitstrSize] ]};
	  ENDLOOP;
	ENDLOOP;
      REPEAT quit => NULL
      ENDLOOP;
    IF index = stack[bitsInfo[index].status] THEN { --scc head
      k _ top; i _ stack[top]; bitsInfo[i].status _ CARDINAL.LAST;
      FOR top _ top-1, top-1 WHILE i#index DO
        OrBits[ @bitString[i*bitstrSize], @bitString[index*bitstrSize] ];
        i _ stack[top]; bitsInfo[i].status _ CARDINAL.LAST;
        ENDLOOP;
      FOR k IN [top+2..k] DO
	OrBits[ @bitString[index*bitstrSize], @bitString[stack[k]*bitstrSize] ];
        ENDLOOP}};

  }.