file PGSControl.mesa
last modified by Satterthwaite, January 10, 1983 4:17 pm
Last Edited by: Maxwell, August 9, 1983 9:14 am
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]]};
storage allocation for PGSscan, PGSlalr, PGStab
LongDes: TYPE = PGSTypes.LongDes;
LongPointer: TYPE = PGSTypes.LongPointer;
MakeArray: PUBLIC PROC [length, width: CARDINAL] RETURNS [LongDes] = {
n: CARDINAL = length*width;
new: LongPointer = Spaces.Words[n];
FOR i: CARDINAL IN [0..n) DO (new+i)^ ← 0 ENDLOOP;
RETURN [DESCRIPTOR[new, length]]};
Expand: PUBLIC PROC [des: LongDes, width, ext: CARDINAL] RETURNS [LongDes] = {
new, old: LongPointer;
i: CARDINAL;
new ← Spaces.Words[(des.LENGTH+ext)*width];
old ← des.BASE;
FOR i IN [0..des.LENGTH*width) DO (new+i)^ ← (old+i)^ ENDLOOP;
FOR i IN [des.LENGTH*width..(des.LENGTH+ext)*width) DO (new+i)^ ← 0 ENDLOOP;
IF old # NIL THEN Spaces.FreeWords[old];
RETURN [DESCRIPTOR[new, des.LENGTH+ext]]};
FreeArray: PUBLIC PROC [des: LongDes] = {
base: LongPointer ← des.BASE;
IF base # NIL THEN Spaces.FreeWords[base]};
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};
streams and files
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[]};
message logging
Logger:
PROC [proc:
PROC [log:
IO.
STREAM]] = {
seterrstream[]; proc[outStream]; resetoutstream[]};
I/O operations
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]]};
processing options
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;
collect output specifications
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];
IF ~Segments.ModifyFile[sourceName] THEN GO TO lockedSource;
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}];
input from sourceName$ (errstr), modified input to sourceName (outstr),
sets up data for PrintGrammar
sourceVersion ← [0, 0, LOOPHOLE[FS.FileInfo[sourceName].created]];
closeoutstream[]; IO.Close[sourcestr]; sourcestr ← NIL;
output grammar to summary file (or scratch)
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;
connect pgs.scratch to input stream and fix sourceNames
sourcestr ← FileIO.Open[gfName, read];
derive missing type id (compatibility feature)
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;
derive type name
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];
load table and call first pass here
[] ← startPhase[$lalr];
objectVersion ← OSMiscOps.GenerateUniqueId[];
success ← P1.Parse[sourcestr, PGSConDefs.zone, Logger].nErrors = 0;
IO.Close[sourcestr]; closeoutstream[];
IF scratchExists THEN inputFile ← FS.nullOpenFile;
now if no errors generate the tables then package them on request
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;
lockedSource => ERROR LockedSource;
fail => {closeerrstream[]; success ←
FALSE}};
start code
P1.InstallParseTable[PrincOpsUtils.CodeBase[LOOPHOLE[PGSParseData]]];
}.