-- 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.