
<<SMBcdImpl.mesa>>
<<Copyright  1985 by Xerox Corporation.  All rights reserved.>>
<<last edit by Satterthwaite, May 13, 1986 8:58:47 am PDT>>

<<code to produce and read .modelBcd files>>

DIRECTORY
BasicTime: TYPE USING [GMT],
Convert: TYPE USING [CardFromRope],
CS: TYPE USING [
EndsIn, GMTFromRope, RopeFromGMT, RopeFromStamp, RootName, ShortName,
StampFromRope],
FS: TYPE USING [StreamOpen],
IO: TYPE USING [
card, Close, EndOf, GetChar, GetIndex, PutF, PutRope, RIS, rope, SetIndex,
STREAM],
Rope: TYPE USING [Concat, Equal, Fetch, Flatten, FromProc, Length, ROPE, Substr],
SMBcd: TYPE USING [],
SMCommentTableOps: TYPE USING [CommentM],
SMEval: TYPE USING [Eval],
SMFI: TYPE USING [BcdFileInfo, SrcFileInfo],
SMFIOps: TYPE USING [FindBcd, FindSource],
SMOps: TYPE USING [MS],
SMProj: TYPE USING [Proj, Analyzed, Find],
SMTree: TYPE Tree USING [ApplOp, Handle, Link],
SMTreeOps: TYPE TreeOps USING [GetExt, OpName, Scan, ScanSons],
SMUtil: TYPE USING [ParseStream, PrettyPrint],
TimeStamp: TYPE USING [Stamp];

SMBcdImpl: CEDAR PROGRAM
IMPORTS Convert, CS, FS, IO, Rope, SMEval, SMFIOps, SMProj, SMTreeOps, SMUtil
EXPORTS SMBcd ~ {
OPEN Tree~~SMTree, TreeOps~~SMTreeOps;

SrcFIList: TYPE~LIST OF SMFI.SrcFileInfo;
BcdFIList: TYPE~LIST OF SMFI.BcdFileInfo;
ProjList: TYPE~LIST OF SMProj.Proj;

<<making .modelBcd files>>

WriteModelBcd: PUBLIC PROC[ms: SMOps.MS, t: Tree.Link, bcdFileName: Rope.ROPE] ~ {
ENABLE UNWIND => {NULL};
srcFIList: SrcFIList _ NIL;
bcdFIList: BcdFIList _ NIL;

AddSrcFi: PROC[fiSrc: SMFI.SrcFileInfo] ~ {
FOR l: SrcFIList _ srcFIList, l.rest UNTIL l = NIL DO
IF fiSrc = l.first THEN RETURN;
ENDLOOP;
srcFIList _ (ms.z).CONS[fiSrc, srcFIList]};

AddBcdFi: PROC[fiBcd: SMFI.BcdFileInfo] ~ {
FOR l: BcdFIList _ bcdFIList, l.rest UNTIL l = NIL DO
IF fiBcd = l.first THEN RETURN;
ENDLOOP;
bcdFIList _ (ms.z).CONS[fiBcd, bcdFIList]};

projList: ProjList _ NIL;

AddProj: PROC[proj: SMProj.Proj] ~ {
FOR l: ProjList _ projList, l.rest UNTIL l = NIL DO
IF proj = l.first THEN RETURN;
ENDLOOP;
projList _ (ms.z).CONS[proj, projList]};

FindFiles: TreeOps.Scan ~ {
WITH t SELECT FROM
node: Tree.Handle => {
TreeOps.ScanSons[node, FindFiles];
IF TreeOps.OpName[node] IN Tree.ApplOp THEN
WITH TreeOps.GetExt[node] SELECT FROM
proj: SMProj.Proj => AddProj[proj];
ENDCASE;
};
fiSrc: SMFI.SrcFileInfo => AddSrcFi[fiSrc];
fiBcd: SMFI.BcdFileInfo => AddBcdFi[fiBcd];
ENDCASE => NULL;
};

outName: Rope.ROPE ~ (IF CS.EndsIn[bcdFileName, ".modelBcd"]
THEN bcdFileName ELSE CS.RootName[bcdFileName].Concat[".modelBcd"]);
output: IO.STREAM;
FindFiles[t];
output _ FS.StreamOpen[fileName~outName, accessOptions~$create, wDir~ms.wDir];
BuildTypeTables[output, srcFIList, bcdFIList];
BuildProjTable[output, projList];
SMUtil.PrettyPrint[out~output, root~ms.tree, comments~NIL];
output.Close[];
ms.out.PutF["modelBcd file written on %g\n", IO.rope[outName]]};

BuildTypeTables: PROC[output: IO.STREAM, srcFIList: SrcFIList, bcdFIList: BcdFIList] ~ {
FOR l: SrcFIList _ srcFIList, l.rest UNTIL l = NIL DO
fiSrc: SMFI.SrcFileInfo ~ l.first;
output.PutF["%g %g\n",
IO.rope[CS.RopeFromGMT[fiSrc.create]], IO.rope[fiSrc.fName]];
SMUtil.PrettyPrint[out~output, root~fiSrc.type, comments~NIL];
output.PutRope[".\n"];
ENDLOOP;
output.PutRope[".\n"];
FOR l: BcdFIList _ bcdFIList, l.rest UNTIL l = NIL DO
fiBcd: SMFI.BcdFileInfo ~ l.first;
output.PutF["%g %g %g\n",
IO.rope[CS.RopeFromGMT[fiBcd.create]],
IO.rope[fiBcd.fName],
IO.rope[CS.RopeFromStamp[fiBcd.stamp]]];
SMUtil.PrettyPrint[out~output, root~fiBcd.type, comments~NIL];
output.PutRope[".\n"];
ENDLOOP;
output.PutRope[".\n"]};

BuildProjTable: PROC[output: IO.STREAM, projList: ProjList] ~ {
FOR l: ProjList _ projList, l.rest UNTIL l = NIL DO
proj: SMProj.Proj ~ l.first;
output.PutF["%g %g",
IO.rope[CS.RopeFromStamp[proj.stamp]], IO.rope[proj.localName]];
output.PutRope[IF proj.interface THEN " T " ELSE " F "];
output.PutF["%d %d\n",
IO.card[proj.symbolPages.base], IO.card[proj.symbolPages.pages]];
ENDLOOP;
output.PutRope[".\n"]};

<<reading .modelBcd files>>

GetLine: PROC[input: IO.STREAM] RETURNS[line: Rope.ROPE] ~ {
start: INT ~ input.GetIndex;
n: INT _ 0;

EachChar: PROC RETURNS[CHAR] ~ {
RETURN[input.GetChar]};

UNTIL input.GetChar = '\n DO n _ n+1 ENDLOOP;
input.SetIndex[start];
line _ Rope.FromProc[n+1, EachChar]};    -- include '\n

ReadModelBcdPrefix: PUBLIC PROC[ms: SMOps.MS, input: IO.STREAM] ~ {
ENABLE UNWIND => {NULL};
<<reconstruct the type table>>
ended: BOOL;
header, line: Rope.ROPE;
typeRope: Rope.ROPE;
WHILE ~input.EndOf DO
<<first line has the filename and create time (or terminator)>>
header _ GetLine[input];
typeRope _ NIL;
IF header.Equal[".\n"] THEN EXIT;
ended _ input.EndOf;
WHILE ~ended DO
line _ GetLine[input];
IF line.Equal[".\n"] THEN ended _ TRUE
ELSE typeRope _ typeRope.Concat[line];
ENDLOOP;
AddSrcFI[ms, header, typeRope];
ENDLOOP;
WHILE ~input.EndOf DO
<<first line has the filename and version stamp (or terminator)>>
header _ GetLine[input];
typeRope _ NIL;
IF header.Equal[".\n"] THEN EXIT;
ended _ input.EndOf;
WHILE ~ended DO
line _ GetLine[input];
IF line.Equal[".\n"] THEN ended _ TRUE
ELSE typeRope _ typeRope.Concat[line];
ENDLOOP;
AddBcdFI[ms, header, typeRope];
ENDLOOP;
WHILE ~input.EndOf DO
<<first line has the filename and create time (or terminator)>>
line _ GetLine[input];
IF line.Equal[".\n"] THEN EXIT;
AddProj[ms, line];
ENDLOOP;
};

AddSrcFI: PROC[ms: SMOps.MS, header, typeRope: Rope.ROPE] ~ {
createTime: BasicTime.GMT;
fiSrc: SMFI.SrcFileInfo;
start, next: INT _ 0;
length: INT ~ header.Length-1;

NextToken: PROC ~ {
WHILE next < length AND header.Fetch[next] = '  DO next _ next+1 ENDLOOP;
start _ next;
WHILE next < length AND header.Fetch[next] # '  DO next _ next+1 ENDLOOP};

NextToken[];
createTime _ CS.GMTFromRope[header.Substr[start, next-start]];
fiSrc _ SMFIOps.FindSource[createTime];
IF fiSrc.state < $analyzed THEN {    -- move to SMFIImpl
NextToken[];
fiSrc.fName _ header.Flatten[start, next-start];
fiSrc.simpleName _ CS.ShortName[fiSrc.fName];
fiSrc.localName _ fiSrc.fName;  fiSrc.wDir _ ms.wDir;  fiSrc.new _ FALSE;
fiSrc.type _ SMEval.Eval[ms, SMUtil.ParseStream[ms, IO.RIS[typeRope]], NIL];
fiSrc.state _ $analyzed};
};

AddBcdFI: PROC[ms: SMOps.MS, header, typeRope: Rope.ROPE] ~ {
createTime: BasicTime.GMT;
fiBcd: SMFI.BcdFileInfo;
start, next: INT _ 0;
length: INT ~ header.Length-1;

NextToken: PROC ~ {
WHILE next < length AND header.Fetch[next] = '  DO next _ next+1 ENDLOOP;
start _ next;
WHILE next < length AND header.Fetch[next] # '  DO next _ next+1 ENDLOOP};

NextToken[];
createTime _ CS.GMTFromRope[header.Substr[start, next-start]];
fiBcd _ SMFIOps.FindBcd[createTime];
IF fiBcd.state < $analyzed THEN {    -- move to SMFIImpl
NextToken[];
fiBcd.fName _ header.Flatten[start, next-start];
fiBcd.simpleName _ CS.ShortName[fiBcd.localName];
fiBcd.localName _ fiBcd.fName;  fiBcd.wDir _ ms.wDir;
NextToken[];
fiBcd.stamp _ CS.StampFromRope[header.Substr[start, next-start]];
fiBcd.type _ SMEval.Eval[ms, SMUtil.ParseStream[ms, IO.RIS[typeRope]], NIL];
fiBcd.state _ $analyzed};
};


AddProj: PROC[ms: SMOps.MS, line: Rope.ROPE] ~ {
stamp: TimeStamp.Stamp;
proj: SMProj.Proj;
start, next: INT _ 0;
length: INT ~ line.Length-1;

NextToken: PROC ~ {
WHILE next < length AND line.Fetch[next] = '  DO next _ next+1 ENDLOOP;
start _ next;
WHILE next < length AND line.Fetch[next] # '  DO next _ next+1 ENDLOOP};

NextToken[];
stamp _ CS.StampFromRope[line.Substr[start, next-start]];
proj _ SMProj.Find[stamp];
IF ~proj.Analyzed THEN {    -- move to SMProjImpl
NextToken[];
proj.localName _ line.Flatten[start, next-start];  proj.wDir _ ms.wDir;
proj.fName _ NIL;
NextToken[];
proj.interface _ (line.Fetch[start] = 'T);
NextToken[];
proj.symbolPages.base _ Convert.CardFromRope[line.Substr[start, next-start]];
NextToken[];
proj.symbolPages.pages _ Convert.CardFromRope[line.Substr[start, next-start]];
proj.state _ $analyzed};
};

}.


