<> <> <> <> <> <> <<>> DIRECTORY PGSConDefs: TYPE, PGSTypes: TYPE; 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; <> 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.BitString; 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 "]; 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 _ MakeStateInfo[maxStateNum+2]; table _ MakeTable[maxTabEntries+1]; hashHead _ 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; <> <> <> stateInfo[1].entries _ entryLim _ totalShifts _ totalReduces _ 0; IF flags[printLR] THEN {setoutstream[".lr"]; outstring["\nLR(0) TABLES"]}; 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]; <> backChain _ MakeBackChain[totalShifts+1]; 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; <> bitstrSize _ (eofMark+wordLength-1)/wordLength; firstBits _ MakeBitString[(totalTokens-eofMark+1), bitstrSize]; FirstSet[]; firstOrCount _ orCount; hashHead^ _ ALL[0]; -- used by find bitsInfo _ MakeBitsInfo[maxContexts]; rlim _ 1; bitString _ MakeBitString[maxContexts, bitstrSize]; stack _ MakeStack[30]; top _ 0; chainStack _ MakeStack[90]; conflicts _ MakeTable[totalTokens+1]; 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 <> 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; <> 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]}; <> reduceFlag _ FALSE; redEntries _ 0; FOR j IN [1..eofMark] DO IF FindBit[bitString,k,j] 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 "]; outnum[table[i].pss,4]; outstring[" conflicts with "]; 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/ "]; warningsLogged _ TRUE} ELSE { outnum[conflicts[j].pss,5]; outstring["/ "]; 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]; <> 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"]; outstring["\nStates ="]; outnum[sLim-1, 4]; outstring["\nTerminal entries ="]; outnum[tEntries, 5]; outstring["\nNonterminal entries ="]; outnum[ntEntries, 5]; outstring["\nFirst OR operation count ="]; outnum[firstOrCount, 5]; outstring["\nTotal OR operation count ="]; outnum[orCount, 5]; outstring["\nMaximum number of contexts ="]; outnum[rlim-1, 5]; outeol[1]; conflicts _ NIL; chainStack _ NIL; stack _ NIL; bitString _ NIL; bitsInfo _ NIL; firstBits _ NIL; backChain _ NIL; table _ NIL; stateInfo _ NIL; rhsChar _ NIL; tokenInfo _ NIL; hashHead _ NIL; RETURN[lalrSuccess]}; ProcessState: PROC = { k1, k2, nmark, entrymark: CARDINAL; -- indexes into table p, j, n: CARDINAL; sym, nsym: CARDINAL; <> 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 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 = { new: PGSTypes.Table ~ MakeTable[table.length+tabExt]; FOR i: CARDINAL IN [0..entryLim) DO new[i] _ table[i] ENDLOOP; FOR i: CARDINAL IN (stateInfo[sLim].nucleus..table.length) DO new[i+tabExt] _ table[i] ENDLOOP; FOR i: CARDINAL IN [1..sLim] DO stateInfo[i].nucleus _ stateInfo[i].nucleus+tabExt ENDLOOP; 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; <> IF hashHead[r] # 0 THEN stateInfo[sLim].link _ hashHead[r]; hashHead[r] _ sLim; IF sLim+1 = stateInfo.length THEN stateInfo _ ExpandStateInfo[stateInfo, stateExt]; IF entryLim+n/2 > stateInfo[sLim].nucleus THEN ExpandTable[]; <> r _ stateInfo[sLim].nucleus; FOR i _ index+1, i+2 WHILE i> k1 _ stateInfo[six].nucleus; IF (k1-stateInfo[six+1].nucleus)*2 > stateInfo[sLim].nucleus-entryLim+1 THEN ExpandTable[]; <> FOR k1 DECREASING IN (stateInfo[six+1].nucleus..k1] DO table[entryLim+1] _ table[k1]; entryLim _ entryLim+2 ENDLOOP; <> entrymark _ entryLim; FOR k2 _ stateInfo[six].entries, k2+2 WHILE k2eofMark 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 { 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; <> table[k2+1] _ table[k1+1]; k2 _ k2-2; -- back up k2 in case first chained entry is also a chain entry <> 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]}}; <> 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; <

> 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[firstBits, nonterm, w]; 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]], firstBits, nonterm]; 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, firstBits, nonterm]; w _ vertices[top]; top _ top-1; discrim[w] _ listindex; ENDLOOP; vertices[listindex] _ nonterm} }; discrim _ MakeAttrVec[totalTokens-eofMark+1]; vertices _ MakeAttrVec[totalTokens-eofMark+1]; 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]], firstBits, i]; ENDLOOP; discrim _ NIL; vertices _ NIL; IF flags[first] THEN { setoutstream[".first"]; outstring["\nFIRST SETS\n\n"]; FOR i IN [1..totalTokens-eofMark] DO [] _ OutToken[i+eofMark]; lineWidth _ outbufLim; FOR j IN [1..eofMark] DO IF FindBit[firstBits,i,j] 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; <> IF rlim>=bitsInfo.length THEN { bitsInfo _ ExpandBitsInfo[bitsInfo, bitsInfo.length/8]; bitString _ ExpandBitString[bitString, 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 _ ExpandStack[stack, 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 _ ExpandStack[chainStack, 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; <> 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 { <> InsertBit[bitString, index, symbol]; EXIT} ELSE { symbol _ symbol-eofMark; OrBits[firstBits, symbol, bitString, index]; IF ~tokenInfo[symbol].empty THEN EXIT}; <> 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, bitString, index]}; 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, bitString, index]; i _ stack[top]; bitsInfo[i].status _ CARDINAL.LAST; ENDLOOP; FOR k IN [top+2..k] DO OrBits[bitString, index, bitString, stack[k]]; ENDLOOP } }; }.