-- file PGSFormat.mesa -- last modified by Satterthwaite, January 10, 1983 4:30 pm DIRECTORY PGSConDefs: TYPE USING [ query, cpw, maxProd, maxRhsSymbols, symTabSize, tokenSize, sourceName, zone, Expand, FreeArray, inchar, MakeArray, outchar, outeol, outnum, outstring, outtime, PGSFail], PGSTypes: TYPE USING [ HashHeads, HashHeadsRef, RhsChar, PInfo, PInfoRec, SymTab, SInfo, SInfoRec], Strings: TYPE USING [String]; PGSFormat: PROGRAM IMPORTS PGSConDefs EXPORTS PGSConDefs = { OPEN PGSConDefs; -- shared global state (set by Format, used by PrintGrammar) sInfIndex: CARDINAL; aliasIndex, lastTerminal: CARDINAL; symString, aliasText: PGSTypes.SymTab; sInfo: PGSTypes.SInfo; pInfo: PGSTypes.PInfo; rhsText: PGSTypes.RhsChar; -- grammar extraction and source rewriting leftIndex, symIndex, nextProd, nextRhsChar, topSymbol: CARDINAL; rule, nextRule: CARDINAL; KeyWord: TYPE = {table, type, export, goal, terminals, aliases, productions}; text: STRING = "TABLETYPEEXPORTSGOALTERMINALSALIASESPRODUCTIONS"; textKeys: ARRAY KeyWord OF RECORD [index, len: CARDINAL] = [[0,5], [5,4], [9,7], [16,4], [20,9], [29,7], [36,11]]; Error: PROC = { FreeArray[rhsText]; FreeArray[sInfo]; FreeArray[pInfo]; FreeArray[LOOPHOLE[symString]]; FreeArray[LOOPHOLE[aliasText]]; ERROR PGSFail[]}; Directive: PROC [key: KeyWord] RETURNS [BOOL] = { IF symIndex-leftIndex-1 # textKeys[key].len OR symString[symIndex-1] # ': THEN RETURN [FALSE]; FOR i: CARDINAL IN [0..textKeys[key].len) DO IF symString[leftIndex+i] # text[textKeys[key].index+i] THEN RETURN [FALSE] ENDLOOP; RETURN [TRUE]}; ExtractKeyItem: PROC [key: KeyWord, value: Strings.String] RETURNS [BOOL] = { i,j: CARDINAL; IF ~Directive[key] THEN RETURN [FALSE] ELSE { GetText[]; j _ 0; FOR i IN [leftIndex..symIndex) DO value[j] _ symString[i]; j _ j+1 ENDLOOP}; value.length _ j; RETURN [TRUE]}; hashChain: PGSTypes.HashHeadsRef; FindText: PROC RETURNS [CARDINAL] = { h, i, j, k: CARDINAL; h _ (256*(symIndex-leftIndex)+symString[leftIndex].ORD) MOD hashChain^.LENGTH; j _ hashChain[h]; WHILE j#0 DO IF symIndex-leftIndex = sInfo[j+1].symPtr-sInfo[j].symPtr THEN { -- same length 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}; 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=sInfo.LENGTH THEN sInfo _ LOOPHOLE[Expand[sInfo,PGSTypes.SInfoRec.SIZE,sInfo.LENGTH/8]]; RETURN [sInfIndex-1]}; Formatter: PROC [tableId, typeId, exportId: Strings.String] = { chain: BOOL; outstring["-- file "L]; outstring[sourceName]; outstring[" rewritten by PGS, "L]; outtime[]; outeol[1]; ScanInit[]; DO GetText[]; SELECT TRUE FROM ExtractKeyItem[table, tableId] => NULL; ExtractKeyItem[type, typeId] => NULL; ExtractKeyItem[export, exportId] => NULL; ENDCASE => EXIT; ENDLOOP; IF ~Directive[goal] THEN Error[] ELSE { symIndex _ 0; GetText[]; sInfIndex _ 1; [] _ FindText[]}; GetText[]; IF Directive[terminals] THEN { symIndex _ leftIndex; DO GetText[]; IF symString[symIndex-1] = ': AND (Directive[aliases] OR Directive[productions]) THEN EXIT; [] _ FindText[]; ENDLOOP}; lastTerminal _ sInfIndex-1; aliasIndex _ 0; IF Directive[aliases] THEN { symIndex _ leftIndex; DO GetText[]; IF Directive[productions] THEN EXIT; FOR i: CARDINAL IN [leftIndex..symIndex) DO IF aliasIndex=CARDINAL[cpw]*aliasText.LENGTH THEN aliasText _ LOOPHOLE[ Expand[LOOPHOLE[aliasText],CARDINAL.SIZE,aliasText.LENGTH/8]]; aliasText[aliasIndex] _ symString[i]; aliasIndex _ aliasIndex+1; ENDLOOP; aliasText[aliasIndex] _ ' ; aliasIndex _ aliasIndex+1; symIndex _ leftIndex; GetText[]; FOR i: CARDINAL IN [leftIndex..symIndex) DO IF aliasIndex=CARDINAL[cpw]*aliasText.LENGTH THEN aliasText _ LOOPHOLE[ Expand[LOOPHOLE[aliasText],CARDINAL.SIZE,aliasText.LENGTH/8]]; aliasText[aliasIndex] _ symString[i]; aliasIndex _ aliasIndex+1; ENDLOOP; aliasText[aliasIndex] _ ' ; aliasIndex _ aliasIndex+1; symIndex _ leftIndex; ENDLOOP}; 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 { i, oldi: CARDINAL _ 0; 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 { WHILE i#0 DO oldi _ i; i _ pInfo[i].link ENDLOOP; pInfo[oldi].link _ nextProd}; nextProd _ nextProd+1; IF nextProd=pInfo.LENGTH THEN pInfo _ LOOPHOLE[Expand[pInfo,PGSTypes.PInfoRec.SIZE,pInfo.LENGTH/8]]; topSymbol _ 0; GetText[]; topSymbol _ FindText[]; LOOP EXITS notlhs => NULL}; rhsText[nextRhsChar] _ topSymbol; nextRhsChar _ nextRhsChar+1; IF nextRhsChar = rhsText.LENGTH THEN rhsText _ LOOPHOLE[Expand[rhsText, CARDINAL.SIZE, rhsText.LENGTH/8] ]; topSymbol _ FindText[]; ENDLOOP}; Format: PUBLIC PROC [table, type, export: Strings.String] = { nextRule _ 0; symIndex _ 0; hashChain _ zone.NEW[PGSTypes.HashHeads _ ALL[0]]; rhsText _ LOOPHOLE[MakeArray[maxRhsSymbols+1,CARDINAL.SIZE]]; sInfo _ LOOPHOLE[MakeArray[symTabSize+1,PGSTypes.SInfoRec.SIZE]]; pInfo _ LOOPHOLE[MakeArray[maxProd+1,PGSTypes.PInfoRec.SIZE]]; symString _ LOOPHOLE[MakeArray[500,CARDINAL.SIZE]]; aliasText _ LOOPHOLE[MakeArray[100,CARDINAL.SIZE]]; Formatter[table, type, export ! EndOfFile => {CONTINUE}; -- always returns via catchphrase UNWIND => {zone.FREE[@hashChain]}]; zone.FREE[@hashChain]; IF topSymbol#0 THEN { rhsText[nextRhsChar] _ topSymbol; nextRhsChar _ nextRhsChar+1}; sInfo[sInfIndex].symPtr _ symIndex; pInfo[nextProd].rhsPtr _ nextRhsChar}; -- text input routines char: CHAR; -- current (most recently scanned) character EndOfFile: SIGNAL = CODE; GetText: PROC = { c: CHAR; WHILE char IN ['\000..' ] DO IF char='\032--^Z-- THEN WHILE char#'\n DO outchar[char,1]; NextChar[]; ENDLOOP; outchar[char,1]; IF char='\n THEN { WHILE char IN ['\000..' ] DO NextChar[]; outchar[char,1] ENDLOOP; c _ char; NextChar[]; outchar[char,1]; IF c#char OR c#'- THEN {NextChar[]; FindHeader[]}}; NextChar[]; ENDLOOP; leftIndex _ symIndex; WHILE char NOT IN ['\000..' ] DO outchar[char,1]; IF symIndex=CARDINAL[cpw]*symString.LENGTH THEN symString _ LOOPHOLE[ Expand[LOOPHOLE[symString],CARDINAL.SIZE,symString.LENGTH/8]]; symString[symIndex] _ char; symIndex _ symIndex+1; NextChar[]; ENDLOOP}; FindHeader: PROC = { bIndex, i, k: CARDINAL; buffer: STRING = [2000]; -- line assembly area BufferOverflow: ERROR = CODE; PutChar: PROC = { IF bIndex = buffer.maxlength THEN ERROR BufferOverflow; buffer[bIndex] _ char; bIndex _ bIndex+1; NextChar[]}; DO { bIndex _ 0; WHILE char IN ['\000..' ] DO IF char = '\n OR char = '\032 --^Z-- THEN GOTO copyline; PutChar[]; ENDLOOP; IF char NOT IN ['0..'9] AND char # query THEN GOTO copyline; PutChar[]; WHILE char IN ['0..'9] DO PutChar[] ENDLOOP; WHILE char IN ['\000..' ] DO IF char='\n OR char='\032 --^Z-- THEN GOTO copyline; PutChar[]; ENDLOOP; IF char # '= THEN GOTO copyline; PutChar[]; IF char # '> THEN GOTO copyline; PutChar[]; WHILE char IN ['\000..' ] DO IF char='\n OR char='\032 --^Z-- 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: CARDINAL IN [0..i) DO k _ IF buffer[j] = '\t THEN k+8 ELSE k+1 ENDLOOP; outnum[nextRule,k-2]; rule _ nextRule; nextRule _ nextRule+1; outchar[' ,2]; FOR j: CARDINAL IN [i..bIndex) DO outchar[buffer[j],1] ENDLOOP; outchar['-,1]; RETURN EXITS copyline => { FOR i: CARDINAL IN [0..bIndex) DO outchar[buffer[i],1] ENDLOOP; outchar[char,1]; WHILE char # '\n DO NextChar[]; outchar[char,1] ENDLOOP; NextChar[]}}; ENDLOOP}; NextChar: PROC = { ended: BOOL; [char, ended] _ inchar[]; IF ended THEN SIGNAL EndOfFile[]}; ScanInit: PROC = { [char, ] _ inchar[]; FindHeader[]; NextChar[]}; -- grammar output PrintGrammar: PUBLIC PROC = { i, p, s, listIndex: CARDINAL; list: PGSTypes.SInfo; PrintToken: PROC [i: CARDINAL] RETURNS [length: CARDINAL_0] = { FOR j: CARDINAL IN [sInfo[i].symPtr..sInfo[i+1].symPtr) DO outchar[symString[j],1]; length _ length+1 ENDLOOP; RETURN}; PrintSymbol: PROC [i: CARDINAL] = { outnum[s, 3]; s _ s+1; outchar[' , 2]; [] _ PrintToken[i]; outeol[1]}; PrintProd: PROC [i, p: CARDINAL, first: BOOL] = { outnum[s,3]; s _ s+1; outstring[IF pInfo[p].chain THEN " C "L ELSE " "L]; outnum[pInfo[p].rule,3]; outchar[' ,2]; outchar[' ,tokenSize-(IF first THEN PrintToken[i] ELSE 0)]; outstring[IF first THEN " ::= "L ELSE " | "L]; FOR j: CARDINAL IN [pInfo[p].rhsPtr..pInfo[p+1].rhsPtr) DO [] _ PrintToken[rhsText[j]]; outchar[' , 1] ENDLOOP; outeol[1]}; outstring["-- grammar extracted from "L]; outstring[sourceName]; outstring[" by PGS, "L]; outtime[]; outeol[2]; outstring["||CHAIN ||LISTS\n\n"L]; outstring["||TABLE1\n"L]; s _ 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; outnum[s, 3]; s _ s+1; outstring[" eof\n\n"L]; outstring["||TABLE2\n"L]; 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 { state: {init, id1, sp, id2} _ init; nc: CARDINAL _ 0; outstring["\n\n||TABLE3\n"L]; FOR i IN [0..aliasIndex) DO c: CHAR = aliasText[i]; IF c # ' THEN { outchar[c, 1]; nc _ nc+1; state _ SELECT state FROM init => id1, sp => id2, ENDCASE => state} ELSE SELECT state FROM id1 => {outchar[' , tokenSize-nc]; nc _ 0; state _ sp}; id2 => {outeol[1]; nc _ 0; state _ init}; ENDCASE; ENDLOOP; IF state # init THEN outeol[1]}; outstring["\n\n||TABLE4\n\n"L]; s _ 1; list _ MakeArray[p,PGSTypes.SInfoRec.SIZE]; 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..list.LENGTH) DO noSwap: BOOL _ TRUE; FOR p IN [0..i) DO IF list[p].link>list[p+1].link THEN { t: PGSTypes.SInfoRec _ list[p]; list[p] _ list[p+1]; list[p+1] _ t; noSwap _ FALSE}; ENDLOOP; IF noSwap THEN EXIT; ENDLOOP; FOR i IN [0..list.LENGTH) 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; outeol[1]; ENDLOOP; FreeArray[list]; FreeArray[rhsText]; FreeArray[sInfo]; FreeArray[pInfo]; FreeArray[LOOPHOLE[symString]]; FreeArray[LOOPHOLE[aliasText]]}; }.