DIRECTORY
Basics: TYPE USING [BITOR, bytesPerWord, DivMod],
BasicTime: TYPE USING [GMT, Now, ToPupTime],
CommandUtil: TYPE USING [KeyValue, ListLength, PairList, SetExtension],
FS: TYPE USING [ComponentPositions, Error, ExpandName, GetInfo, OpenFileFromStream, StreamOpen],
IO: TYPE USING [Close, EndOf, EndOfStream, GetChar, GetIndex, Put, PutChar, PutRope, SetIndex, STREAM, time, UnsafeGetBlock, UnsafePutBlock],
OSMiscOps: TYPE USING [GenerateUniqueId],
P1: TYPE USING [InstallParseTable, Parse],
PGSConDefs:
TYPE
USING [
FixupBcdHeader, Format, LALRGen, OutModule, PrintGrammar,
TabGen, WriteBcdHeader],
PGSOps: TYPE USING [PGSPhase],
PGSParseData: TYPE,
PGSTypes: TYPE,
PrincOpsUtils: TYPE USING [Codebase],
Rope: TYPE USING [Concat, Equal, Fetch, Length, Replace, ROPE, Substr],
TimeStamp: TYPE USING [Stamp];
PGSControl:
PROGRAM
IMPORTS Basics, BasicTime, CommandUtil, FS, IO, OSMiscOps, P1, PGSConDefs, PGSParseData, PrincOpsUtils, Rope
EXPORTS PGSConDefs, PGSOps = { OPEN PGSTypes;
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]-INTEGER[digits]-INTEGER[sign]];
IF sign#0 THEN outStream.PutChar[signChar];
UNTIL power < 1
DO
[i,num] ← Basics.DivMod[num,power]; outStream.PutChar[VAL['0.ORD+i]];
power ← power/10;
ENDLOOP
startTime: BasicTime.GMT;
outtime: PUBLIC PROC = {outStream.Put[IO.time[startTime]]};
MakeSymTab:
PUBLIC
PROC[length:
CARDINAL]
RETURNS[new: SymTab] ~ {
new ← NEW[SymTabSeq[length]];
FOR i: CARDINAL IN[0..length) DO new[i] ← '\000 ENDLOOP};
MakeSymInfo:
PUBLIC
PROC[length:
CARDINAL]
RETURNS[new: SymInfo] ~ {
new ← NEW[SymInfoSeq[length]];
FOR i: CARDINAL IN[0..length) DO new[i] ← nullSymTabEntry ENDLOOP};
MakeAliases:
PUBLIC
PROC[length:
CARDINAL]
RETURNS[new: Aliases] ~ {
new ← NEW[AliasesSeq[length]];
FOR i: CARDINAL IN[0..length) DO new[i] ← nullAliasEntry ENDLOOP};
MakeTokenInfo:
PUBLIC
PROC[length:
CARDINAL]
RETURNS[new: TokenInfo] ~ {
new ← NEW[TokenInfoSeq[length]];
FOR i: CARDINAL IN[0..length) DO new[i] ← nullTokenEntry ENDLOOP};
MakeProdInfo:
PUBLIC
PROC[length:
CARDINAL]
RETURNS[new: ProdInfo] ~ {
new ← NEW[ProdInfoSeq[length]];
FOR i: CARDINAL IN[0..length) DO new[i] ← nullProdEntry ENDLOOP};
MakeCardinals:
PROC[length:
CARDINAL]
RETURNS[new: Cardinals] ~ {
new ← NEW[CardinalsSeq[length]];
FOR i: CARDINAL IN[0..length) DO new[i] ← 0 ENDLOOP};
MakeRhsChar:
PUBLIC
PROC[length:
CARDINAL]
RETURNS[new: RhsChar] ~ {
new ← MakeCardinals[length]};
MakeStateInfo:
PUBLIC
PROC[length:
CARDINAL]
RETURNS[new: StateInfo] ~ {
new ← NEW[StateInfoSeq[length]];
FOR i: CARDINAL IN[0..length) DO new[i] ← nullStateInfoRec ENDLOOP};
MakeTable:
PUBLIC
PROC[length:
CARDINAL]
RETURNS[new: Table] ~ {
new ← NEW[TableSeq[length]];
FOR i: CARDINAL IN[0..length) DO new[i] ← nullItemRec ENDLOOP};
MakeBackChain:
PUBLIC
PROC[length:
CARDINAL]
RETURNS[new: BackChain] ~ {
new ← NEW[BackChainSeq[length]];
FOR i: CARDINAL IN[0..length) DO new[i] ← nullChainRec ENDLOOP};
MakeStack:
PUBLIC
PROC[length:
CARDINAL]
RETURNS[new: Stack] ~ {
new ← MakeCardinals[length]};
MakeBitsInfo:
PUBLIC
PROC[length:
CARDINAL]
RETURNS[new: BitsInfo] ~ {
new ← NEW[BitsInfoSeq[length]];
FOR i: CARDINAL IN[0..length) DO new[i] ← nullContextRec ENDLOOP};
MakeBitString:
PUBLIC
PROC[length, width:
CARDINAL]
RETURNS[new: BitString] ~ {
size: CARDINAL ~ length*width;
new ← NEW[BitStringSeq[size] ← [length: length, width: width, seq: ]];
FOR i: CARDINAL IN[0..size) DO new[i] ← 0 ENDLOOP};
MakeAttrVec:
PUBLIC
PROC[length:
CARDINAL]
RETURNS[new: AttrVec] ~ {
new ← MakeCardinals[length]};
MakeHashTab:
PUBLIC
PROC[length:
CARDINAL]
RETURNS[new: HashTab] ~ {
new ← NEW[HashTabSeq[length]];
FOR i: CARDINAL IN[0..length) DO new[i] ← nullHashTabRec ENDLOOP};
MakeTab:
PUBLIC
PROC[length:
CARDINAL]
RETURNS[new: Tab] ~ {
new ← NEW[TabSeq[length]];
FOR i: CARDINAL IN[0..length) DO new[i] ← nullTabRec ENDLOOP};
MakeColumn:
PUBLIC
PROC[length:
CARDINAL]
RETURNS[new: Column] ~ {
new ← NEW[ColumnSeq[length]];
FOR i: CARDINAL IN[0..length) DO new[i] ← nullColumnRec ENDLOOP};
MakeStateData:
PUBLIC
PROC[length:
CARDINAL]
RETURNS[new: StateData] ~ {
new ← NEW[StateDataSeq[length]];
FOR i: CARDINAL IN[0..length) DO new[i] ← nullStateDataRec ENDLOOP};
MakeNTDefaults:
PUBLIC
PROC[length:
CARDINAL]
RETURNS[new: NTDefaults] ~ {
new ← NEW[NTDefaultsSeq[length]];
FOR i: CARDINAL IN[0..length) DO new[i] ← nullNTDefaultRec ENDLOOP};
MakeRenumber:
PUBLIC
PROC[length:
CARDINAL]
RETURNS[new: Renumber] ~ {
new ← MakeCardinals[length]};
MakeVocabIndex:
PUBLIC
PROC[length:
CARDINAL]
RETURNS[new: VocabIndex] ~ {
new ← MakeCardinals[length]};
MakeSInfo:
PUBLIC
PROC[length:
CARDINAL]
RETURNS[new: SInfo] ~ {
new ← NEW[SInfoSeq[length]];
FOR i: CARDINAL IN[0..length) DO new[i] ← nullSInfoRec ENDLOOP};
MakePInfo:
PUBLIC
PROC[length:
CARDINAL]
RETURNS[new: PInfo] ~ {
new ← NEW[PInfoSeq[length]];
FOR i: CARDINAL IN[0..length) DO new[i] ← nullPInfoRec ENDLOOP};
ExpandSymTab:
PUBLIC
PROC[old: SymTab, ext:
CARDINAL]
RETURNS[new: SymTab] ~ {
new ← NEW[SymTabSeq[old.length+ext]];
FOR i: CARDINAL IN [0..old.length) DO new[i] ← old[i] ENDLOOP;
FOR i: CARDINAL IN [old.length..new.length) DO new[i] ← '\000 ENDLOOP};
ExpandSymInfo:
PUBLIC
PROC[old: SymInfo, ext:
CARDINAL]
RETURNS[new: SymInfo] ~ {
new ← NEW[SymInfoSeq[old.length+ext]];
FOR i: CARDINAL IN [0..old.length) DO new[i] ← old[i] ENDLOOP;
FOR i: CARDINAL IN [old.length..new.length) DO new[i] ← nullSymTabEntry ENDLOOP};
ExpandAliases:
PUBLIC
PROC[old: Aliases, ext:
CARDINAL]
RETURNS[new: Aliases] ~ {
new ← NEW[AliasesSeq[old.length+ext]];
FOR i: CARDINAL IN [0..old.length) DO new[i] ← old[i] ENDLOOP;
FOR i: CARDINAL IN [old.length..new.length) DO new[i] ← nullAliasEntry ENDLOOP};
ExpandProdInfo:
PUBLIC
PROC[old: ProdInfo, ext:
CARDINAL]
RETURNS[new: ProdInfo] ~ {
new ← NEW[ProdInfoSeq[old.length+ext]];
FOR i: CARDINAL IN [0..old.length) DO new[i] ← old[i] ENDLOOP;
FOR i: CARDINAL IN [old.length..new.length) DO new[i] ← nullProdEntry ENDLOOP};
ExpandCardinals:
PROC[old: Cardinals, ext:
CARDINAL]
RETURNS[new: Cardinals] ~ {
new ← NEW[CardinalsSeq[old.length+ext]];
FOR i: CARDINAL IN [0..old.length) DO new[i] ← old[i] ENDLOOP;
FOR i: CARDINAL IN [old.length..new.length) DO new[i] ← 0 ENDLOOP};
ExpandRhsChar:
PUBLIC
PROC[old: RhsChar, ext:
CARDINAL]
RETURNS[new: RhsChar] ~ {
new ← ExpandCardinals[old, ext]};
ExpandStateInfo:
PUBLIC
PROC[old: StateInfo, ext:
CARDINAL]
RETURNS[new: StateInfo] ~ {
new ← NEW[StateInfoSeq[old.length+ext]];
FOR i: CARDINAL IN [0..old.length) DO new[i] ← old[i] ENDLOOP;
FOR i: CARDINAL IN [old.length..new.length) DO new[i] ← nullStateInfoRec ENDLOOP};
ExpandStack:
PUBLIC
PROC[old: Stack, ext:
CARDINAL]
RETURNS[new: Stack] ~ {
new ← ExpandCardinals[old, ext]};
ExpandBitsInfo:
PUBLIC
PROC[old: BitsInfo, ext:
CARDINAL]
RETURNS[new: BitsInfo] ~ {
new ← NEW[BitsInfoSeq[old.length+ext]];
FOR i: CARDINAL IN [0..old.length) DO new[i] ← old[i] ENDLOOP;
FOR i: CARDINAL IN [old.length..new.length) DO new[i] ← nullContextRec ENDLOOP};
ExpandBitString:
PUBLIC
PROC[old: BitString, ext:
CARDINAL]
RETURNS[new: BitString] ~ {
size: CARDINAL ~ (old.length+ext)*old.width;
new ← NEW[BitStringSeq[size] ← [length: old.length+ext, width: old.width, seq: ]];
FOR i: CARDINAL IN [0..old.size) DO new[i] ← old[i] ENDLOOP;
FOR i: CARDINAL IN [old.size..new.size) DO new[i] ← 0 ENDLOOP};
ExpandSInfo:
PUBLIC
PROC[old: SInfo, ext:
CARDINAL]
RETURNS[new: SInfo] ~ {
new ← NEW[SInfoSeq[old.length+ext]];
FOR i: CARDINAL IN [0..old.length) DO new[i] ← old[i] ENDLOOP;
FOR i: CARDINAL IN [old.length..new.length) DO new[i] ← nullSInfoRec ENDLOOP};
ExpandPInfo:
PUBLIC
PROC[old: PInfo, ext:
CARDINAL]
RETURNS[new: PInfo] ~ {
new ← NEW[PInfoSeq[old.length+ext]];
FOR i: CARDINAL IN [0..old.length) DO new[i] ← old[i] ENDLOOP;
FOR i: CARDINAL IN [old.length..new.length) DO new[i] ← nullPInfoRec ENDLOOP};
orCount: PUBLIC CARDINAL ← 0;
OrBits:
PUBLIC
PROC[source: BitString, sourceI:
CARDINAL, sink: BitString, sinkI:
CARDINAL] = {
sourceBase: CARDINAL ~ sourceI*source.width;
sinkBase: CARDINAL ~ sinkI*sink.width;
IF source.width#sink.width THEN ERROR;
FOR i:
CARDINAL
IN [0..source.width)
DO
sink[sinkBase+i] ← Basics.BITOR[sink[sinkBase+i], source[sourceBase+i]];
ENDLOOP;
orCount ← orCount+1};
sourcestr, outstr, errstr: IO.STREAM ← NIL;
inputFile, tempFile: FS.OpenFile ← FS.nullOpenFile;
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;
CreateTime:
PROC [s:
IO.
STREAM]
RETURNS [
LONG
CARDINAL] = {
RETURN[BasicTime.ToPupTime[FS.GetInfo[FS.OpenFileFromStream[s]].created]]};
getstream:
PROC [dotstring: Rope.
ROPE]
RETURNS [
IO.
STREAM] = {
RETURN [FS.StreamOpen[Rope.Concat[rootName, dotstring], $create]]};
seterrstream:
PUBLIC
PROC = {
IF errstr =
NIL
THEN {
outStream ← errstr ← getstream[".errlog"];
outstring["Cedar PGS of "]; outtime[];
outstring[" -- "]; outstring[rootName]; outstring[".errlog"]; outeol[2];
}
ELSE outStream ← errstr};
closeerrstream:
PROC = {
IF errstr #
NIL
THEN {
IO.Close[errstr]; errstr ←
NIL}};
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 ← FS.StreamOpen[objectName, $create]};
closewordstream:
PUBLIC
PROC = {closeoutstream[]};
bpw: NAT ~ Basics.bytesPerWord;
inword:
PUBLIC
PROC
RETURNS[n:
CARDINAL] = {
-- note: reads from outstr!
base: LONG POINTER ~ @n;
IF outstr.UnsafeGetBlock[[base: base, count: bpw]]=bpw THEN RETURN[n]
ELSE ERROR IO.EndOfStream[outstr]
outword:
PUBLIC
PROC [n:
CARDINAL] = {
base: LONG POINTER ~ @n;
outstr.UnsafePutBlock[[base: base, count: bpw]]};
outblock:
PUBLIC
PROC [address:
LONG
POINTER, words:
CARDINAL, offset:
CARDINAL𡤀] = {
outstr.UnsafePutBlock[[base: address, startIndex: offset*bpw, count: words*bpw]]};
inchar:
PUBLIC
PROC
RETURNS [c:
CHAR, end:
BOOL] = {
IF (end ← sourcestr.EndOf[]) THEN c ← '\000 ELSE c ← sourcestr.GetChar[]};
rootName: Rope.ROPE ← NIL;
GetRoot:
PROC[fileName: Rope.
ROPE]
RETURNS[Rope.
ROPE] ~ {
fullFName: Rope.ROPE; cp: FS.ComponentPositions;
[fullFName: fullFName, cp: cp] ← FS.ExpandName[name: fileName];
RETURN[fullFName.Substr[cp.base.start, cp.base.length]]};
SetRoot:
PROC [s: Rope.
ROPE] = {rootName ← GetRoot[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] = {
fullFName, ext: Rope.ROPE; cp: FS.ComponentPositions;
[fullFName: fullFName, cp: cp] ← FS.ExpandName[name: fileName];
ext ← fullFName.Substr[cp.ext.start, cp.ext.length];
RETURN[Rope.Equal[ext, extension, FALSE]]};
ReplaceExtension:
PROC[fileName, extension: Rope.
ROPE]
RETURNS[Rope.
ROPE] = {
fullFName: Rope.ROPE; cp: FS.ComponentPositions;
[fullFName: fullFName, cp: cp] ← FS.ExpandName[name: fileName];
RETURN[fullFName.Replace[cp.ext.start, cp.ext.length, extension]]};
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];
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, tableId, exportId: Rope.ROPE ← NIL;
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, "pgs"];
IF sourceName.Fetch[sourceName.Length[]-1] = '.
THEN sourceName ← Rope.Substr[sourceName, 0, sourceName.Length[]-1];
IF TestExtension[sourceName, "pgs"]
THEN {
inputName: Rope.ROPE ~ sourceName;
sourceName ← Rope.Concat[GetRoot[inputName], ".mesa"];
[] ← startPhase[$format];
sourcestr ←
FS.StreamOpen[inputName, $read !
FS.Error => IF error.group=lock THEN GOTO lockedSource ELSE GOTO noSource];
outStream ← outstr ← FS.StreamOpen[sourceName, $create];
[table: tableId, type: typeId, export: exportId] ← PGSConDefs.Format[
! PGSFail => {GOTO formatFailed}];
input from inputName (sourcestr), modified input to sourceName (outstr),
sets up data for PrintGrammar
sourceVersion ← [0, 0, CreateTime[outstr]];
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 ← FS.StreamOpen[gfName, $create];
PGSConDefs.PrintGrammar[];
closeoutstream[];
IF ~printGrammar THEN scratchExists ← TRUE;
connect pgs.scratch to input stream and fix sourceNames
sourcestr ← FS.StreamOpen[gfName, $read];
derive missing type id (compatibility feature)
IF typeId.Length[] = 0
AND defsName #
NIL
THEN
typeId ← GetRoot[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 ← FS.StreamOpen[sourceName, $read ! FS.Error => {GO TO noSource}];
sourceVersion ← [0, 0, CreateTime[sourcestr]];
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];