-- file PGSFormat.mesa
-- last modified by Satterthwaite, July 14, 1980  12:47 PM

DIRECTORY
  PGScondefs;

PGSFormat: PROGRAM
    IMPORTS PGScondefs
    EXPORTS PGScondefs =
  BEGIN OPEN PGScondefs;
  leftindex, symindex, nextprod, sinfindex, nextrhschar, topsymbol:CARDINAL;
  rule, nextrule, aliasindex, lastterminal:CARDINAL;
  symstring, aliastext: Symtab;
  sinfo:Sinfo;
  pinfo:Pinfo;
  rhstext:Rhschar;

  KeyWord: TYPE =
    {binary, type, interface, module, goal, terminals, aliases, productions};

  text: STRING = "BINARYTYPEINTERFACEMODULEGOALTERMINALSALIASESPRODUCTIONS";
  textKeys: ARRAY KeyWord OF RECORD [index, len: CARDINAL] =
    [[0,6], [6,4], [10,9], [19,6], [25,4], [29,9], [38,7], [45,11]];

  error: PROC =
    BEGIN FreeSegment[hashChain]; FreeSegment[BASE[rhstext]];
    FreeSegment[BASE[sinfo]]; FreeSegment[BASE[pinfo]];
    FreeSegment[BASE[symstring]]; FreeSegment[BASE[aliastext]];
    ERROR PGSfail[]
    END;

  Directive: PROC [key: KeyWord] RETURNS [BOOLEAN] =
    BEGIN i:CARDINAL;
    IF symindex-leftindex-1 # textKeys[key].len OR symstring[symindex-1] # ':
      THEN RETURN [FALSE];
    FOR i IN [0..textKeys[key].len)
      DO
      IF symstring[leftindex+i] # text[textKeys[key].index+i]
	THEN RETURN [FALSE]
      ENDLOOP;
    RETURN [TRUE];
    END;

  ExtractKeyItem: PROC [key: KeyWord, value: STRING] RETURNS [BOOLEAN] =
    BEGIN i,j:CARDINAL;
    IF ~Directive[key] THEN RETURN [FALSE] ELSE
      BEGIN gettext[]; j _ 0;
      FOR i IN [leftindex..symindex) DO value[j] _ symstring[i]; j _ j+1 ENDLOOP;
      END;
    value.length _ j; RETURN [TRUE];
    END;

  hashChain: POINTER TO ARRAY [1..61] OF CARDINAL;

  findtext: PROC RETURNS [CARDINAL] =
    BEGIN h,i,j,k:CARDINAL;
    h _ (256*(symindex-leftindex)+LOOPHOLE[symstring[leftindex],CARDINAL]) MOD 61 +1;
    j _ hashChain[h];
    WHILE j#0
      DO IF symindex-leftindex = sinfo[j+1].symptr-sinfo[j].symptr THEN -- same length
        BEGIN i _ sinfo[j].symptr;
        FOR k IN [leftindex..symindex)
          DO IF symstring[k]#symstring[i] THEN EXIT;
          i _ i+1;
          REPEAT
	    FINISHED => {symindex _ leftindex; RETURN [j]};
          ENDLOOP;
        END;
      j _ sinfo[j].link;
      ENDLOOP;
    -- new symbol
    sinfo[sinfindex] _ [leftindex,hashChain[h],0]; 
    hashChain[h] _ sinfindex; sinfindex _ sinfindex+1;
    sinfo[sinfindex].symptr _ symindex; 
    IF sinfindex=LENGTH[sinfo] THEN
        sinfo _ LOOPHOLE[expand[sinfo,SIZE[sinforec],LENGTH[sinfo]/8]];
    RETURN [sinfindex-1];
    END;

  Formatter: PROC [binaryFile, typeId, moduleFile, interfaceFile: STRING] =
    BEGIN i:CARDINAL;
    chain:BOOLEAN;

    outstring["-- file "L];  outstring[sourceName];
    outstring[" rewritten by PGS, "L];  outtime[];  outeol[1];
    ScanInit[]; 

    DO gettext[];
    SELECT TRUE FROM
      ExtractKeyItem[binary, binaryFile] => NULL;
      ExtractKeyItem[module, moduleFile] => NULL;
      ExtractKeyItem[type, typeId] => NULL;
      ExtractKeyItem[interface, interfaceFile] => NULL;
      ENDCASE => EXIT;
    ENDLOOP;

    IF ~Directive[goal] THEN error[] ELSE
      {symindex _ 0; gettext[]; sinfindex _ 1; [] _ findtext[]};
    gettext[];

    IF Directive[terminals] THEN
      BEGIN symindex _ leftindex;
        DO gettext[];
        IF symstring[symindex-1] = ': AND (Directive[aliases] OR Directive[productions]) THEN EXIT;
        [] _ findtext[];
        ENDLOOP;
      END;
    lastterminal _ sinfindex-1;

    aliasindex _ 0;
    IF Directive[aliases] THEN
      BEGIN symindex _ leftindex;
        DO gettext[];
        IF Directive[productions] THEN EXIT;
        FOR i IN [leftindex..symindex)
          DO IF aliasindex=CARDINAL[cpw]*LENGTH[aliastext] THEN aliastext _ LOOPHOLE[
		expand[LOOPHOLE[aliastext],SIZE[CARDINAL],LENGTH[aliastext]/8]];
          aliastext[aliasindex] _ symstring[i]; aliasindex _ aliasindex+1; 
          ENDLOOP;
        aliastext[aliasindex] _ ' ; aliasindex _ aliasindex+1; symindex _ leftindex;
        gettext[];
        FOR i IN [leftindex..symindex)
          DO IF aliasindex=CARDINAL[cpw]*LENGTH[aliastext] THEN aliastext _ LOOPHOLE[
		expand[LOOPHOLE[aliastext],SIZE[CARDINAL],LENGTH[aliastext]/8]];
          aliastext[aliasindex] _ symstring[i]; aliasindex _ aliasindex+1; 
          ENDLOOP;
        aliastext[aliasindex] _ ' ; aliasindex _ aliasindex+1; symindex _ leftindex;
        ENDLOOP;
      END;

    IF ~Directive[productions] THEN error[];
    symindex _ leftindex; nextprod _ 1; nextrhschar _ 0;
    gettext[]; topsymbol _ findtext[];
    DO -- exit from this loop on EndOfFIle, topsymbol distinguishes cases
    gettext[];
    IF symstring[leftindex] = ': AND symstring[leftindex+1] = ':
        AND symstring[leftindex+2] = '= THEN
      BEGIN IF symindex-leftindex=4 AND symstring[leftindex+3]='C THEN chain _ TRUE
        ELSE IF symindex-leftindex=3 THEN chain _ FALSE ELSE GOTO notlhs;
      symindex _ leftindex;
      pinfo[nextprod] _ [rule,chain,0,nextrhschar];
      IF (i _ sinfo[topsymbol].lhshead)=0 THEN sinfo[topsymbol].lhshead _ nextprod ELSE
        BEGIN oldi:CARDINAL _ 0;
        WHILE i#0 DO oldi _ i; i _ pinfo[i].link ENDLOOP;
        pinfo[oldi].link _ nextprod;
        END;
      nextprod _ nextprod+1;
      IF nextprod=LENGTH[pinfo] THEN
          pinfo _ LOOPHOLE[expand[pinfo,SIZE[pinforec],LENGTH[pinfo]/8]];
      topsymbol _0; gettext[]; topsymbol _ findtext[];
      LOOP;
      EXITS notlhs => NULL;
      END;
    rhstext[nextrhschar] _ topsymbol; nextrhschar _ nextrhschar+1;
    IF nextrhschar = LENGTH[rhstext] THEN
      rhstext _ LOOPHOLE[ expand[rhstext, SIZE[CARDINAL], LENGTH[rhstext]/8] ];
    topsymbol _ findtext[];
    ENDLOOP;
    END;

  Format: PUBLIC PROC [binary, type, module, interface: STRING] =
    BEGIN i:CARDINAL;
    nextrule _ 0; symindex _ 0;
    hashChain _ AllocateSegment[61];
    FOR i IN [0..61] DO hashChain[i] _ 0 ENDLOOP;
    rhstext _ LOOPHOLE[makearray[maxrhssymbols+1,SIZE[CARDINAL]]];
    sinfo _ LOOPHOLE[makearray[symtabsize+1,SIZE[sinforec]]];
    pinfo _ LOOPHOLE[makearray[maxprod+1,SIZE[pinforec]]];
    symstring _ LOOPHOLE[makearray[500,SIZE[CARDINAL]]];
    aliastext _ LOOPHOLE[makearray[100,SIZE[CARDINAL]]];
    Formatter[binary, type, module, interface
      ! EndOfFile => CONTINUE]; -- always returns via catchphrase
    FreeSegment[hashChain];
    IF topsymbol#0 THEN
      {rhstext[nextrhschar] _ topsymbol; nextrhschar _ nextrhschar+1};
    sinfo[sinfindex].symptr _ symindex;
    pinfo[nextprod].rhsptr _ nextrhschar;
    END;

  PrintGrammar: PUBLIC PROC =
    BEGIN i, p, listindex:CARDINAL;
    list:Sinfo;
    rec:sinforec;
    noswap:BOOLEAN;

    printsymbol: PROC [i: CARDINAL] =
      BEGIN j:CARDINAL;
      outchar[' ,1];
      FOR j IN [sinfo[i].symptr..sinfo[i+1].symptr) DO outchar[symstring[j],1] ENDLOOP;
      END;
    printprod: PROC [i,p: CARDINAL, first:BOOLEAN] =
      BEGIN j:CARDINAL;
      IF pinfo[p].chain THEN outstring["C "L]; outnum[pinfo[p].rule,3];
      IF ~first THEN outstring[" |"L]  ELSE
        {printsymbol[i]; outstring[" ::="L]};
      FOR j IN [pinfo[p].rhsptr..pinfo[p+1].rhsptr) DO printsymbol[rhstext[j]] ENDLOOP;
      outeol[1];
      END;

    outstring["||INPUT ||CHAIN ||LISTS ||TABLE1"L]; outeol[1];
    IF lastterminal=1 THEN
      FOR i IN [2..sinfindex) DO IF sinfo[i].lhshead=0 THEN printsymbol[i] ENDLOOP
    ELSE FOR i IN [2..lastterminal] DO printsymbol[i] ENDLOOP;
    outstring[" eof"L]; outeol[1];
    outstring["||TABLE2"L]; outeol[1]; printsymbol[1]; p _ 1;
    FOR i IN (lastterminal..sinfindex)
      DO IF sinfo[i].lhshead#0 THEN {printsymbol[i]; p _ p+1} ENDLOOP;
    IF aliasindex#0 THEN
      BEGIN outeol[1]; outstring["||TABLE3"L]; outeol[1];
      FOR i IN [0..aliasindex) DO outchar[aliastext[i],1] ENDLOOP;
      END;

    outeol[1]; outstring["||TABLE4"L]; outeol[1];
    list _ makearray[p,SIZE[sinforec]];
    p _ sinfo[1].lhshead; list[0] _ [1,pinfo[p].rule,p]; listindex _ 1;
    FOR i IN (lastterminal..sinfindex)
      DO IF (p _ sinfo[i].lhshead)#0 THEN
        {list[listindex] _ [i,pinfo[p].rule,p]; listindex _ listindex+1};
      ENDLOOP;
    FOR i DECREASING IN [0..LENGTH[list])
      DO noswap _ TRUE;
      FOR p IN [0..i)
        DO IF list[p].link>list[p+1].link THEN
          {rec _ list[p]; list[p] _ list[p+1]; list[p+1] _ rec; noswap _ FALSE};
        ENDLOOP;
      IF noswap THEN EXIT;
      ENDLOOP;
    FOR i IN [0..LENGTH[list])
      DO p _ list[i].lhshead; printprod[list[i].symptr,p,TRUE]; p _ pinfo[p].link;
      WHILE p#0 DO  printprod[0,p,FALSE]; p _ pinfo[p].link ENDLOOP;
      ENDLOOP;
    FreeSegment[BASE[list]]; FreeSegment[BASE[rhstext]];
    FreeSegment[BASE[sinfo]]; FreeSegment[BASE[pinfo]];
    FreeSegment[BASE[symstring]]; FreeSegment[BASE[aliastext]];
    END;

-- text input routines

  char: CHARACTER;	-- current (most recently scanned) character
  EndOfFile: SIGNAL = CODE;

  gettext: PROC =
    BEGIN c:CHARACTER;
    WHILE char IN [0C..' ]
      DO IF char=ControlZ THEN
        WHILE char#CR DO outchar[char,1]; nextchar[]; ENDLOOP;
      outchar[char,1];
      IF char=CR THEN
        BEGIN WHILE char IN [0C..' ] DO nextchar[]; outchar[char,1] ENDLOOP;
        c _ char; nextchar[]; outchar[char,1];
        IF c#char OR c#'- THEN {nextchar[]; findheader[]};
        END;
      nextchar[];
      ENDLOOP;
    leftindex _ symindex;
    WHILE char ~IN [0C..' ]
      DO outchar[char,1];
      IF symindex=CARDINAL[cpw]*LENGTH[symstring] THEN symstring _ LOOPHOLE[
	expand[LOOPHOLE[symstring],SIZE[CARDINAL],LENGTH[symstring]/8]];
      symstring[symindex] _ char; symindex _ symindex+1; nextchar[];
      ENDLOOP;
    END;

  findheader: PROC =
    BEGIN bindex,i,j:CARDINAL; k:INTEGER;
    buffer: STRING = [2000];  -- line assembly area
    BufferOverflow:ERROR = CODE;

    putchar: PROC =
      BEGIN IF bindex = buffer.maxlength THEN ERROR BufferOverflow;
      buffer[bindex] _ char; bindex _ bindex+1; nextchar[];
      END;

    DO
      BEGIN bindex _ 0;
      WHILE char IN [0C..' ]
        DO IF char=CR OR char=ControlZ THEN GOTO copyline; putchar[];
        ENDLOOP;
      IF char ~IN ['0..'9] AND char#query THEN GOTO copyline; putchar[];
      WHILE char IN ['0..'9] DO putchar[] ENDLOOP;
      WHILE char IN [0C..' ]
        DO IF char=CR OR char=ControlZ THEN GOTO copyline; putchar[];
        ENDLOOP;
      IF char#'= THEN GOTO copyline; putchar[];
      IF char#'> THEN GOTO copyline; putchar[];
      WHILE char IN [0C..' ]
        DO IF char=CR OR char=ControlZ THEN GOTO copyline; putchar[];
        ENDLOOP;
      IF char#'- THEN GOTO copyline; putchar[];
      IF char#'- THEN GOTO copyline;
      FOR i _ bindex-1, i-1 WHILE buffer[i]#'= DO NULL ENDLOOP;
      k _ 0;
      FOR j IN [0..i) DO k _ IF buffer[j]=TAB THEN k+8 ELSE k+1 ENDLOOP;
      outnum[nextrule,k-2]; rule _ nextrule; nextrule _ nextrule+1;
      outchar[' ,2]; FOR j IN [i..bindex) DO outchar[buffer[j],1] ENDLOOP;
      outchar['-,1];
      RETURN;
      EXITS
      copyline =>
        BEGIN FOR i IN [0..bindex) DO outchar[buffer[i],1] ENDLOOP;
        outchar[char,1];
        WHILE char#CR DO nextchar[]; outchar[char,1] ENDLOOP;
        nextchar[];
        END;
      END;
    ENDLOOP;
    END;

  tB: POINTER TO PACKED ARRAY OF CHARACTER;
  tI, tMax: [0..TextChars];
  tOrigin, tLimit: CARDINAL;
  tEnded: BOOLEAN;


  nextchar: PROC =
    BEGIN IF (tI_tI+1) = tMax THEN
      {IF tEnded THEN SIGNAL EndOfFile[]; FillTextBuffer[]};
    char _ tB[tI];
    END;

  ScanInit: PROC =
    BEGIN tLimit _ tMax _ 0; tEnded _ FALSE; FillTextBuffer[];
    char _ tB[tI]; findheader[]; nextchar[];
    END;

  FillTextBuffer: PROC =
    BEGIN tOrigin _ tLimit;
    IF tEnded THEN  tMax _ 0 ELSE
	{[tB, tMax, tEnded] _ nextbuffer[]; tLimit _ tOrigin + tMax};
    IF tMax = 0 THEN {tB[0] _ 0C;  tMax _ 1};
    tI _ 0;
    END;

 END.