<> <> <> <<>> DIRECTORY BasicTime: TYPE USING [GMT, Now], CommandUtil: TYPE USING [GetRootName, KeyValue, ListLength, PairList, SetExtension], FileIO: TYPE USING [Open, OpenFailed], FS: TYPE USING [FileInfo], IO: TYPE USING [Close, EndOf, GetChar, GetIndex, Put, PutChar, PutRope, SetIndex, STREAM, time, UnsafeGetBlock, UnsafePutBlock], OSMiscOps: TYPE USING [GenerateUniqueId, RenameFile], P1: TYPE USING [InstallParseTable, Parse], PGSConDefs: TYPE USING [ FixupBcdHeader, Format, LALRGen, OutModule, PrintGrammar, TabGen, WriteBcdHeader, zone], PGSOps: TYPE USING [PGSPhase], PGSParseData: TYPE, PGSTypes: TYPE USING [ Aliases, LongDes, LongPointer, Options, ProdInfo, RhsChar, SymTab, SymInfo, TokenInfo], PrincOps: TYPE USING [bytesPerWord], PrincOpsUtils: TYPE USING [BITOR, CodeBase, DIVMOD], Rope: TYPE USING [Concat, Equal, Fetch, Find, FromChar, Length, ROPE, Substr], TimeStamp: TYPE USING [Stamp]; PGSControl: PROGRAM IMPORTS BasicTime, CommandUtil, FileIO, FS, IO, OSMiscOps, P1, PGSConDefs, PGSParseData, PrincOpsUtils, Rope EXPORTS PGSConDefs, PGSOps = { eofMark: PUBLIC CARDINAL; totalTokens, numProd, numRules, nextAlias: PUBLIC CARDINAL; warningsLogged: PUBLIC BOOL; flags: PUBLIC ARRAY PGSTypes.Options OF BOOL; symTab: PUBLIC PGSTypes.SymTab; symInfo: PUBLIC PGSTypes.SymInfo; aliases: PUBLIC PGSTypes.Aliases; tokenInfo: PUBLIC PGSTypes.TokenInfo; prodInfo: PUBLIC PGSTypes.ProdInfo; rhsChar: PUBLIC PGSTypes.RhsChar; sLim, tEntries, ntEntries: PUBLIC CARDINAL; bitstrSize: PUBLIC CARDINAL; PGSFail: PUBLIC ERROR = CODE; outStream: IO.STREAM; outeol: PUBLIC PROC [n: INTEGER] = { THROUGH [1..n] DO outStream.PutChar['\n] ENDLOOP}; outchar: PUBLIC PROC [c: CHAR, n: INTEGER] = { THROUGH [1..n] DO outStream.PutChar[c] ENDLOOP}; outstring: PUBLIC PROC [string: Rope.ROPE] = { outStream.PutRope[string]}; outtab: PUBLIC PROC = {outStream.PutChar['\t]}; outnum: PUBLIC PROC [val: INTEGER, cols: NAT, signChar: CHAR_'-] = { i: CARDINAL; power, digits: CARDINAL _ 1; num: CARDINAL _ ABS[val]; sign: CARDINAL = IF val<0 THEN 1 ELSE 0; WHILE (i_power*10)<=num DO power _ i; digits _ digits+1 ENDLOOP; outchar[' , INTEGER[cols-digits-sign]]; IF sign#0 THEN outStream.PutChar[signChar]; UNTIL power < 1 DO [i,num] _ PrincOpsUtils.DIVMOD[num,power]; outStream.PutChar[VAL['0.ORD+i]]; power _ power/10; ENDLOOP}; startTime: BasicTime.GMT; outtime: PUBLIC PROC = {outStream.Put[IO.time[startTime]]}; <> LongDes: TYPE = PGSTypes.LongDes; LongPointer: TYPE = PGSTypes.LongPointer; <> <> <> <> <> <<>> <> <> <> <> <> <> <> <> <> <<>> <> <> <> <<>> <<>> orCount: PUBLIC CARDINAL; OrBits: PUBLIC PROC [source, sink: LongPointer] = { FOR i: CARDINAL IN [0..bitstrSize) DO (sink+i)^ _ PrincOpsUtils.BITOR[(sink+i)^,(source+i)^] ENDLOOP; orCount _ orCount+1}; <> sourcestr, outstr, errstr: IO.STREAM _ NIL; sourceName: PUBLIC Rope.ROPE _ NIL; sourceVersion: PUBLIC TimeStamp.Stamp; objectName: Rope.ROPE _ NIL; objectVersion: PUBLIC TimeStamp.Stamp; defsName: Rope.ROPE _ NIL; gfName: Rope.ROPE _ NIL; getstream: PROC [dotstring: Rope.ROPE] RETURNS [IO.STREAM] = { RETURN [FileIO.Open[Rope.Concat[rootName, dotstring], write]]}; geterrstream: PROC RETURNS [IO.STREAM] = { IF errstr = NIL THEN { savestr: IO.STREAM = outStream; outStream _ errstr _ getstream[".errlog"]; outstring["Mesa PGS of "]; outtime[]; outstring[" -- "]; outstring[rootName]; outstring[".errlog\n\n"]; outStream _ savestr}; RETURN [errstr]}; closeerrstream: PROC = {IF errstr # NIL THEN {IO.Close[errstr]; errstr _ NIL}}; seterrstream: PUBLIC PROC = {outStream _ geterrstream[]}; setoutstream: PUBLIC PROC [dotstring: Rope.ROPE] = {outStream _ outstr _ getstream[dotstring]}; resetoutstream: PUBLIC PROC = {outStream _ outstr}; closeoutstream: PUBLIC PROC = {IF outstr # NIL THEN {IO.Close[outstr]; outstr _ NIL}}; cleanupstreams: PUBLIC PROC = {NULL}; -- used for checkout openwordstream: PUBLIC PROC [scratch: BOOL] = { outstr _ FileIO.Open[objectName, write]}; closewordstream: PUBLIC PROC = {closeoutstream[]}; <> Logger: PROC [proc: PROC [log: IO.STREAM]] = { seterrstream[]; proc[outStream]; resetoutstream[]}; <> StreamIndex: TYPE = INT; -- FileStream.FileByteIndex sourceOrigin: StreamIndex; inchar: PUBLIC PROC RETURNS [c: CHAR, end: BOOL] = { IF (end _ IO.EndOf[sourcestr]) THEN c _ '\000 ELSE c _ sourcestr.GetChar[]; RETURN}; getindex: PUBLIC PROC RETURNS [CARDINAL] = { RETURN [IO.GetIndex[sourcestr]-sourceOrigin]}; setindex: PUBLIC PROC [index: CARDINAL] = { IO.SetIndex[sourcestr, sourceOrigin+index]}; inword: PUBLIC PROC RETURNS [word: CARDINAL] = { [] _ outstr.UnsafeGetBlock[[@word, 0, 1]]}; outword: PUBLIC PROC [n: CARDINAL] = {outstr.UnsafePutBlock[[@n, 0, 1]]}; outblock: PUBLIC PROC [address: LongPointer, words: CARDINAL] = { outstr.UnsafePutBlock[[address, 0, words*PrincOps.bytesPerWord]]}; <> rootName: Rope.ROPE _ NIL; SetRoot: PROC [s: Rope.ROPE] = {rootName _ CommandUtil.GetRootName[s]}; SetFileName: PROC [fileName, default, extension: Rope.ROPE] RETURNS [Rope.ROPE] = { root: Rope.ROPE = IF fileName = NIL THEN default ELSE fileName; RETURN [CommandUtil.SetExtension[root, extension]]}; TestExtension: PROC [fileName, extension: Rope.ROPE] RETURNS [BOOL] = { ext: Rope.ROPE; dotIndex: INT _ Rope.Find[fileName, "."]; IF dotIndex < 0 THEN RETURN[FALSE]; ext _ Rope.Substr[fileName, dotIndex+1, fileName.Length[]-dotIndex-1]; RETURN[Rope.Equal[ext, extension, FALSE]]}; KeyVal: PROC [list: CommandUtil.PairList, key: Rope.ROPE, delete: BOOL _ TRUE] RETURNS [Rope.ROPE] = INLINE {RETURN [CommandUtil.KeyValue[key, list, delete]]}; pgsVersion: PUBLIC TimeStamp.Stamp _ [net: 'c.ORD, host: 'p.ORD, time: 000F0003h]; <<* * * * * * HERE IT BEGINS * * * * * *>> NoSource: PUBLIC ERROR = CODE; LockedSource: PUBLIC ERROR = CODE; BadSemantics: PUBLIC ERROR = CODE; Generate: PUBLIC PROC [ source: Rope.ROPE, args, results: CommandUtil.PairList, switches: Rope.ROPE, startPhase: PROC [PGSOps.PGSPhase] RETURNS [BOOL], princOps: BOOL] RETURNS [success, warnings: BOOL] = { alto: BOOL _ ~princOps; long: BOOL_ princOps; printGrammar: BOOL _ TRUE; bcd: BOOL _ FALSE; scratchExists: BOOL _ FALSE; typeId: Rope.ROPE; tableId: Rope.ROPE; exportId: Rope.ROPE; sourceName _ source; objectName _ gfName _ NIL; <> BEGIN nR: CARDINAL _ CommandUtil.ListLength[results]; IF (defsName _ KeyVal[results, "defs"]) # NIL THEN nR _ nR - 1; SELECT TRUE FROM (objectName _ KeyVal[results, "bcd"]) # NIL => {bcd _ TRUE; nR _ nR - 1}; (objectName _ KeyVal[results, "binary"]) # NIL => {bcd _ FALSE; nR _ nR - 1}; ENDCASE; IF (gfName _ KeyVal[results, "grammar"]) # NIL THEN nR _ nR - 1; IF nR # 0 THEN GO TO badSemantics; END; SetRoot[IF objectName # NIL THEN objectName ELSE sourceName]; IF switches # NIL THEN { sense: BOOL _ TRUE; FOR i: INT IN [0 .. switches.Length[]) DO SELECT switches.Fetch[i] FROM '-, '~ => sense _ ~sense; 'a, 'A => {alto _ sense; sense _ TRUE}; 'l, 'L => {long _ sense; sense _ TRUE}; 'g, 'G => {printGrammar _ sense; sense _ TRUE}; ENDCASE; ENDLOOP}; startTime _ BasicTime.Now[]; warningsLogged _ warnings _ FALSE; sourceName _ CommandUtil.SetExtension[sourceName, "mesa"]; IF sourceName.Fetch[sourceName.Length[]-1] = '. THEN sourceName _ Rope.Substr[sourceName, 0, sourceName.Length[]-1]; IF TestExtension[sourceName, "mesa"] THEN { [] _ startPhase[$format]; <> sourcestr _ FileIO.Open[sourceName, read ! FileIO.OpenFailed => {GO TO noSource}]; OSMiscOps.RenameFile[ newName: Rope.Concat[sourceName, Rope.FromChar['$]], oldName: sourceName]; outStream _ outstr _ FileIO.Open[objectName, write]; tableId _ typeId _ exportId _ NIL; PGSConDefs.Format[tableId, typeId, exportId ! PGSFail => {GOTO formatFailed}]; <> <> sourceVersion _ [0, 0, LOOPHOLE[FS.FileInfo[sourceName].created]]; closeoutstream[]; IO.Close[sourcestr]; sourcestr _ NIL; <

> gfName _ IF printGrammar THEN SetFileName[gfName, IF tableId.Length[] # 0 THEN tableId ELSE rootName, "grammar"] ELSE "pgs.scratch$"; outStream _ outstr _ FileIO.Open[gfName, write]; PGSConDefs.PrintGrammar[]; closeoutstream[]; IF ~printGrammar THEN scratchExists _ TRUE; <> sourcestr _ FileIO.Open[gfName, read]; <> IF typeId.Length[] = 0 AND defsName # NIL THEN typeId _ CommandUtil.GetRootName[defsName]; IF objectName = NIL THEN { bcd _ TRUE; IF tableId.Length[] # 0 THEN objectName _ tableId ELSE objectName _ Rope.Concat[rootName, "PGSTable"]} EXITS formatFailed => { closeoutstream[]; closeerrstream[]; seterrstream[]; outstring["\nDirectives incorrect or out of sequence\n"]; GO TO fail}} ELSE { sourcestr _ FileIO.Open[sourceName, read ! FileIO.OpenFailed => {GO TO noSource}]; sourceVersion _ [0, 0, LOOPHOLE[FS.FileInfo[sourceName].created]]; IF objectName = NIL THEN objectName _ rootName; <> typeId _ Rope.Concat[rootName, "PGSTable"]}; IF defsName = NIL THEN { IF typeId.Length[] # 0 THEN defsName _ typeId ELSE defsName _ Rope.Concat[rootName, "PGSTableType"]}; defsName _ CommandUtil.SetExtension[defsName, "mesa"]; objectName _ CommandUtil.SetExtension[objectName, IF bcd THEN "bcd" ELSE "binary"]; outstr _ errstr _ NIL; sourceOrigin _ IO.GetIndex[sourcestr]; <> [] _ startPhase[$lalr]; objectVersion _ OSMiscOps.GenerateUniqueId[]; success _ P1.Parse[sourcestr, PGSConDefs.zone, Logger].nErrors = 0; IO.Close[sourcestr]; closeoutstream[]; <> <> IF success AND (flags[lists] OR flags[printLALR] OR flags[printLR]) THEN { success _ PGSConDefs.LALRGen[ ! PGSFail => {success _ FALSE; CONTINUE}]; IF success AND flags[lists] THEN { InitBcd: PROC = { PGSConDefs.WriteBcdHeader[ outstr, tableId, objectName, IF Rope.Equal[exportId, "SELF"] THEN NIL ELSE exportId, KeyVal[args, exportId, FALSE], alto]}; closeoutstream[]; -- flush output from LALRGen outstr _ FileIO.Open[objectName]; -- for reinput success _ IF exportId.Length[] # 0 THEN PGSConDefs.TabGen[prefix:InitBcd, suffix:PGSConDefs.FixupBcdHeader] ELSE PGSConDefs.TabGen[NIL, NIL]; IF ~success THEN closewordstream[] ELSE { closeoutstream[]; -- flush tabgen output outStream _ outstr _ FileIO.Open[defsName, write]; PGSConDefs.OutModule[typeId, defsName, long]; closeoutstream[]}}}; closeerrstream[]; warnings _ warningsLogged; EXITS badSemantics => ERROR BadSemantics; noSource => ERROR NoSource; < ERROR LockedSource;>> fail => {closeerrstream[]; success _ FALSE}}; <> P1.InstallParseTable[PrincOpsUtils.CodeBase[LOOPHOLE[PGSParseData]]]; }.