CDOut.mesa
Copyright © 1983, 1987 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, December 12, 1983 2:02 pm
Last Edited by: Christian Jacobi, November 20, 1987 4:01:56 pm PST
DIRECTORY
BasicTime,
CDIO,
CD,
CDDirectory,
CDDirectoryOps,
CDEnvironment,
CDEvents,
CDPrivate,
CDProperties,
CDSequencer,
CDValue,
Convert,
FileNames,
FS,
IO,
Process,
Properties,
Rope,
TerminalIO,
TokenIO;
CDOut:
CEDAR
PROGRAM
IMPORTS BasicTime, CD, CDIO, CDDirectory, CDDirectoryOps, CDEnvironment, CDEvents, CDProperties, CDSequencer, CDValue, Convert, FileNames, FS, IO, Process, Properties, Rope, TerminalIO, TokenIO
EXPORTS CDIO
SHARES CDDirectory, CDProperties =
BEGIN
xChipndaleFile: INT = 12121983;
xVersion: INT = 18;
simpleObjectsInTableMax: INT ← 10000;
spaceCnt: INT ← 0; --not exact, it's mainly to pacify user
dotCnt: INT ← 0; --not exact, it's mainly to pacify user
colCnt: INT ← 0; --not exact, it's mainly to pacify user
FileExists:
PROC [name: Rope.
ROPE]
RETURNS [found:
BOOL←
TRUE] = {
[] ←
FS.FileInfo[name: name, remoteCheck:
FALSE
! FS.Error => IF error.group#bug THEN {found ← FALSE; CONTINUE}
];
};
GetNameInteractively:
PROC [wDir: Rope.
ROPE←
NIL]
RETURNS [name: Rope.
ROPE] = {
--may raise TerminalIO.UserAbort
TerminalIO.PutRope["file name:"];
IF ~Rope.IsEmpty[wDir] THEN TerminalIO.PutRopes[" (", wDir, ")"];
name ← TerminalIO.RequestRope[" > "];
name ← CDIO.MakeName[name, "dale", wDir];
IF FileExists[name]
THEN {
TerminalIO.PutRopes["File ", name, " exists "];
IF ~TerminalIO.Confirm["overwrite file"] THEN ERROR TerminalIO.UserAbort;
};
};
WriteIfNoisy:
PROC [h: TokenIO.Handle, r: Rope.
ROPE] =
INLINE {
--write onto Terminal
IF Properties.GetProp[h.properties^, $Noisy]#NIL THEN TerminalIO.PutRope[r];
};
WriteLayer:
PUBLIC
PROC [h: TokenIO.Handle, l:
CD.Layer] = {
TokenIO.WriteAtom[h, CD.LayerKey[l]];
};
WritePos:
PUBLIC
PROC [h: TokenIO.Handle, p:
CD.Position] = {
TokenIO.WriteInt[h, p.x];
TokenIO.WriteInt[h, p.y];
};
WriteRect:
PUBLIC
PROC[h: TokenIO.Handle, r:
CD.Rect] = {
TokenIO.WriteInt[h, r.x1];
TokenIO.WriteInt[h, r.y1];
TokenIO.WriteInt[h, r.x2];
TokenIO.WriteInt[h, r.y2];
};
WriteProperties:
PUBLIC
PROC [h: TokenIO.Handle, props:
CD.PropList] = {
WITH h.clientData
SELECT
FROM
d: CD.Design => CDSequencer.CheckAborted[d];
ENDCASE => ERROR;
Process.Yield[]; --should make output slower than redraw
--Properties guarantees properties are not reordered; going through list is ok
FOR l:
CD.PropList ← props, l.rest
WHILE l#
NIL
DO
WITH l.first.key
SELECT
FROM
a:
ATOM => {
pp: CDProperties.PropertyProcs = CDProperties.FetchProcs[a];
IF pp#
NIL
AND pp.internalWrite#
NIL
THEN {
IF h.truth AND pp.supressTruth THEN LOOP;
IF pp.internalWrite=CDProperties.DontPWrite THEN LOOP;
TokenIO.WriteAtom[h, $Property];
TokenIO.WritePush2[h, a];
pp.internalWrite[h, a, l.first.val];
TokenIO.WritePop[h];
}
ELSE
WITH l.first.val
SELECT
FROM
r: Rope.
ROPE => {
TokenIO.WriteAtom[h, $DefaultProperty];
TokenIO.WriteAtom[h, a];
TokenIO.WriteRope[h, r];
};
at:
ATOM => {
TokenIO.WriteAtom[h, $DefaultProperty];
TokenIO.WriteAtom[h, a];
TokenIO.WriteAtom[h, at];
};
ri:
REF
INT => {
TokenIO.WriteAtom[h, $DefaultProperty];
TokenIO.WriteAtom[h, a];
TokenIO.WriteInt[h, ri^];
};
pl: CDPrivate.LayerRef => {
TokenIO.WriteAtom[h, $DefaultProperty];
TokenIO.WritePush2[h, a];
TokenIO.WriteAtom[h, $layer]; -- now comes a property list
WriteLayer[h, pl.number];
TokenIO.WritePop[h];
};
pl:
CD.PropList => {
TokenIO.WriteAtom[h, $DefaultProperty];
TokenIO.WritePush2[h, a];
TokenIO.WriteAtom[h, $properties]; -- now comes a property list
WriteProperties[h, pl];
TokenIO.WritePop[h];
};
rl:
LIST
OF Rope.
ROPE => {
TokenIO.WriteAtom[h, $DefaultProperty];
TokenIO.WritePush2[h, a];
TokenIO.WriteAtom[h, $ropeList]; -- now comes a rope list
FOR l:
LIST
OF Rope.
ROPE ← rl, l.rest
WHILE l#
NIL
DO
TokenIO.WriteRope[h, l.first];
ENDLOOP;
TokenIO.WritePop[h];
};
ENDCASE => NULL;
};
ra: REF ATOM => IF ra^=$MayBeRemoved THEN KillThisProp[h, ra];
ENDCASE => NULL;
ENDLOOP;
};
WriteOrientation:
PUBLIC
PROC [h: TokenIO.Handle, orientation:
CD.Orientation] = {
TokenIO.WriteInt[h, ORD[orientation]];
};
WriteInstance:
PUBLIC
PROC [h: TokenIO.Handle, inst:
CD.Instance] = {
TokenIO.WriteInt[h, inst.trans.off.x];
TokenIO.WriteInt[h, inst.trans.off.y];
TokenIO.WriteInt[h, ORD[inst.trans.orient]];
WriteProperties[h, inst.properties];
WriteObject[h, inst.ob];
};
WriteObject:
PUBLIC
PROC [h: TokenIO.Handle, ob:
CD.Object] = {
WITH CDProperties.GetObjectProp[from: ob, prop: h.clientKey]
SELECT
FROM
key:
REF
INT => {
IF key^<0 THEN {TerminalIO.PutRope["**** circular object dependency\n"]; ERROR};
IF (dotCnt ← dotCnt+1) >= 80
THEN {
dotCnt ← 0; WriteIfNoisy[h, "."];
IF (spaceCnt ← spaceCnt+1) >= 30 THEN {spaceCnt𡤀 WriteIfNoisy[h, " "]}
};
TokenIO.WriteInt[h, key^];
};
ENDCASE => WriteObjectDefinition[h, ob]
};
WriteObjectDefinition:
PROC [h: TokenIO.Handle, ob:
CD.Object] = {
key: REF INT ← NIL;
WriteTableKey:
PROC[h: TokenIO.Handle, ob:
CD.Object] =
INLINE {
num: REF INT ← NARROW[CDProperties.GetProp[h.properties, $DirectoryCount]];
num^ ← num^+1;
key ← NEW[INT ← -num^]; --a negative key is not yet finished
TokenIO.WriteInt[h, num^];
CDProperties.PutObjectProp[onto: ob, prop: h.clientKey, val: key];
};
design: CD.Design ← DesignInReadOperation[h];
IF (colCnt ← colCnt+1) >= 30
THEN {
colCnt ← 0; WriteIfNoisy[h, ":"];
};
IF ob.class.internalWrite=
NIL
OR (h.truth
AND ob.class.supressTruth)
THEN {
ob1: CD.Object ← CDDirectory.Expand1[ob, design].new;
IF ob1=NIL THEN ob1 ← CDDirectory.Expand1ByDraw[ob, CDDirectory.LeaveNextLevel].new;
IF ob1=
NIL
THEN {
TokenIO.WritePush[h, $Unknown];
TokenIO.WritePop[h];
WriteIfNoisy[h, "*object not written\n"];
}
ELSE {
IF h.truth THEN WriteIfNoisy[h, "*"];
WriteObject[h, ob1];
CDProperties.PutObjectProp[onto: ob, prop: h.clientKey, val: CDProperties.GetObjectProp[ob1, h.clientKey]];
};
}
ELSE {
--object has internalWrite proc
name: Rope.ROPE ← CDDirectory.Name[ob, design];
IF ob.class.atomicOb
THEN TokenIO.WritePush[h, $Atomic]
ELSE TokenIO.WritePush[h, ob.class.objectType];
IF ob.layer=CD.errorLayer THEN CDProperties.PutPRefProp[h.properties, $errorObject, ob];
IF ob.class.composed
THEN {
IF name#NIL THEN TokenIO.WriteRope[h, name];
WriteTableKey[h, ob];
}
ELSE
IF name#
NIL
THEN {
TokenIO.WriteAtom[h, $CDIOUseDir];
TokenIO.WriteRope[h, name];
WriteTableKey[h, ob];
}
ELSE {
num: REF INT ← NARROW[CDProperties.GetProp[h.properties, $SimpleCount]];
IF num^<simpleObjectsInTableMax
OR name#
NIL THEN {
num^ ← num^+1;
TokenIO.WriteAtom[h, $CDIOUseTable];
WriteTableKey[h, ob];
};
};
ob.class.internalWrite[h, ob];
WriteProperties[h, ob.properties];
TokenIO.WritePop[h];
IF key#NIL THEN key^ ← -key^; --finished: make key positive
};
};
WritePushLevel:
PROC [h: TokenIO.Handle, pl:
LIST
OF
CD.PushRec] = {
IF pl=NIL THEN RETURN;
WriteIfNoisy[h, "!"];
IF pl.rest#NIL THEN WritePushLevel[h, pl.rest];
TokenIO.WriteAtom[h, $Push];
IF pl.first.mightReplace#
NIL
THEN WriteInstance[h, pl.first.mightReplace]
ELSE TokenIO.WriteAtom[h, $Nil];
WriteObjectDefinition[h, pl.first.dummyCell.ob];
TokenIO.WriteAtom[h, (IF pl.first.specific.changed THEN $T ELSE $F)];
};
EachChildInDir: CDDirectory.EachObjectProc = {
h: TokenIO.Handle ← NARROW[data];
IF me.class.composed
OR
NARROW[CDProperties.GetProp[h.properties, $SimpleCount],
REF
INT]^<simpleObjectsInTableMax
THEN {
xx: REF ← CDProperties.GetObjectProp[from: me, prop: h.clientKey];
IF xx#NIL THEN RETURN; -- it and its children are already written
IF me.class.composed
THEN
[] ← CDDirectory.EnumerateChildObjects[me, EachChildInDir, data];
--if due to funny recursion me is now written out: this will write a reference
WriteObject[h, me];
};
};
KillThisProp:
PROC [h: TokenIO.Handle, ra:
REF
ATOM] = {
RemoveOldProperties:
PROC[design:
CD.Design, key:
REF] = {
--at this place we know that CDDirectoryOps will fork and will set the priority down
CDDirectoryOps.RemoveProperties[design, key];
};
IF CDProperties.GetPropProp[h.properties, $RemoveAlso, ra] =
NIL
THEN {
CDProperties.PutPropProp[h.properties, $RemoveAlso, ra, $yes];
WITH h.clientData
SELECT
FROM
d: CD.Design => RemoveOldProperties[d, ra];
ENDCASE => {};
};
};
KillOldProps:
PROC [h: TokenIO.Handle] = {
WITH h.clientKey
SELECT
FROM
ra:
REF
ATOM => {
ra^ ← $MayBeRemoved;
KillThisProp[h, ra]
};
ENDCASE => NULL;
};
DesignNameForFile:
PROC [d:
CD.Design]
RETURNS [Rope.
ROPE←NIL] = {
IF Rope.Length[d.name]>0
AND Rope.Fetch[d.name]#'/
AND Rope.Fetch[d.name]#'[
THEN
RETURN [d.name];
};
TimeStamp:
PROC []
RETURNS [Rope.
ROPE] = {
RETURN [Convert.RopeFromTime[from: BasicTime.Now[], end: seconds]];
};
OpenStream:
PROC [design:
CD.Design, to:
REF, emergency, quiet:
BOOL]
RETURNS [stream:
IO.
STREAM←
NIL, mustClose:
BOOL←
TRUE, name: Rope.
ROPE←
NIL, created: BasicTime.
GMT← BasicTime.nullGMT] = {
--Opens the file but does not do any output to it yet
--Makes the messages on failure
file: FS.OpenFile ← FS.nullOpenFile;
wDir: Rope.ROPE ← CDIO.GetWorkingDirectory[design];
IF Rope.IsEmpty[wDir] THEN wDir ← FileNames.CurrentWorkingDirectory[];
WITH to
SELECT
FROM
s: IO.STREAM => RETURN [stream←s, mustClose←FALSE, name←NIL];
r: Rope.ROPE => name ← r;
ENDCASE =>
IF to#
NIL
THEN {
TerminalIO.PutRope["bad file parameter in WriteDesign\n"]; to ← NIL;
};
--from now on just create a named file...
IF Rope.IsEmpty[name]
THEN {
IF emergency
OR quiet
THEN name ← "///temp/ChipNDale/saved/temporary/temp"
ELSE name ← GetNameInteractively[wDir];
};
name ← CDIO.MakeName[FileNames.StripVersionNumber[name], "dale", wDir];
file ←
FS.Create[name: name, keep: 2, wDir: wDir !
FS.Error => {
mustClose ← FALSE; file ← FS.nullOpenFile;
IF ~quiet THEN TerminalIO.PutRopes["file not created: ", error.explanation, "\n"];
IF error.group#bug THEN CONTINUE;
}
];
IF file#
FS.nullOpenFile
THEN {
--we want a keep of 2 or larger
name ← FS.GetName[file].fullFName;
IF FS.GetInfo[file].keep=1 THEN FS.SetKeep[FileNames.StripVersionNumber[name], 2];
stream ← FS.StreamFromOpenFile[openFile: file, accessRights: $write, streamOptions: FS.binaryStreamOptions];
created ← FS.GetInfo[file].created;
};
IF stream=NIL AND ~quiet THEN TerminalIO.PutRope["file not created\n"];
};
WriteDesign:
PUBLIC
PROC [design:
CD.Design, to:
REF, quiet:
BOOL, emergency:
BOOL, stop:
REF
BOOL ←
NIL, truth:
BOOL ←
TRUE]
RETURNS [done:
BOOL←
FALSE] = {
--to is either a IO.STREAM, a Rope.ROPE, or NIL
--if emergency, some locks are ignored, interactive input is skipped; you better
--roll back after an emergency write is done
InnerWriteDesign:
PROC [h: TokenIO.Handle, design:
CD.Design] = {
ENABLE UNWIND => KillOldProps[h];
EachDirectoryEntry: CDDirectory.EachObjectProc = {
IF me.class.composed THEN [] ← EachChildInDir[me, h];
};
directoryMark: TokenIO.Mark;
TokenIO.WriteRope[h, DesignNameForFile[design]];
TokenIO.WriteRope[h, TimeStamp[]];
directoryMark ← TokenIO.MarkAndWriteInt[h, 0]; -- number of entries in directory
[] ← CDDirectory.EnumerateDesign[design: design, proc: EachDirectoryEntry];
WriteProperties[h, design.properties^];
WritePushLevel[h, design.actual];
TokenIO.UpdateMark[
h: h,
mark: directoryMark,
value: NARROW[CDProperties.GetProp[h.properties, $DirectoryCount], REF INT]^
];
TokenIO.WriteAtom[h, $EndOfDesign];
KillOldProps[h];
};
h: TokenIO.Handle; hadErrors: BOOL;
mustClose: BOOL ← FALSE; created: BasicTime.GMT;
binFile: IO.STREAM; fileName: Rope.ROPE; sealMark: TokenIO.Mark;
[binFile, mustClose, fileName, created] ← OpenStream[design, to, emergency, quiet];
IF binFile=NIL THEN RETURN;
IF stop=NIL THEN stop ← NEW[BOOL←FALSE];
truth ← truth OR emergency;
h ← TokenIO.CreateWriter[binFile, stop, truth];
h.clientData ← design;
h.clientKey ← NEW[ATOM ← $UsedForIO];
CDProperties.PutProp[h.properties, $DirectoryCount, NEW[INT𡤀]];
CDProperties.PutProp[h.properties, $SimpleCount, NEW[INT𡤀]];
CDProperties.PutProp[h.properties, $RemoveAlso, NIL];
CDProperties.PutProp[h.properties, $Noisy, IF quiet THEN NIL ELSE $TRUE];
[] ← CDEvents.ProcessEvent[eventRegistration: beforeOutputEvent, design: design, x: h, listenToDont: FALSE];
TokenIO.WriteInt[h, xChipndaleFile];
TokenIO.WriteInt[h, (IF CDEnvironment.preRelease THEN -xVersion ELSE xVersion)];
sealMark ← TokenIO.MarkAndWriteInt[h, 0]; -- invalid seal; it will be fixed at the end
TokenIO.WriteAtom[h, design.technology.key];
TokenIO.WriteRope[h, design.technology.name];
IF CDEvents.ProcessEvent[eventRegistration: writeEvent, design: design, x: h, listenToDont:
TRUE].dont
THEN {
WriteIfNoisy[h, "output not done\n"];
RETURN
};
InnerWriteDesign[h, design];
TokenIO.UpdateMark[h, sealMark, IF truth THEN -1 ELSE -2]; -- validate seal
WriteIfNoisy[h, "\n"];
hadErrors ← CDProperties.GetPRefProp[h.properties, $errorObject]#NIL;
TokenIO.Close[h, mustClose];
IF to=
NIL
AND mustClose
THEN {
IF emergency
OR quiet
THEN {
goodName: Rope.
ROPE ←
IO.PutFR["///temp/ChipNDale/%01g/%01g.dale",
IO.rope[IF emergency THEN "ShiftShiftSwat" ELSE "Background"],
IO.rope[CDIO.MakeShortName[design]]
];
FS.Rename[from: fileName, to: goodName, wantedCreatedTime: created !
FS.Error => {goodName ← fileName; CONTINUE}
];
fileName ← goodName;
};
};
TerminalIO.PutF["%ldesign %g written on file %g%g%l\n",
IO.rope[(IF quiet THEN "i" ELSE IF emergency THEN "b" ELSE " ")],
IO.rope[CD.DesignName[design]],
IO.rope[fileName],
IO.rope[IF truth THEN "" ELSE " cache only"],
IO.rope[" "]
];
IF ~quiet
THEN {
CDValue.Store[boundTo: design, key: $CDxLastFile, value: fileName];
[] ← CDEvents.ProcessEvent[afterOutputEvent, design];
IF hadErrors THEN TerminalIO.PutRope[" output includes some error message(s)\n"];
};
IF mustClose THEN design.changedSinceSaving ← FALSE;
done ← TRUE;
};
DesignInReadOperation:
PUBLIC PROC [h: TokenIO.Handle]
RETURNS [
CD.Design] = {
RETURN [NARROW[h.clientData]]
};
writeEvent: CDEvents.EventRegistration = CDEvents.RegisterEventType[$WriteTechnologyPrivate];
beforeOutputEvent: CDEvents.EventRegistration = CDEvents.RegisterEventType[$BeforeOutput];
afterOutputEvent: CDEvents.EventRegistration = CDEvents.RegisterEventType[$AfterOutput];
END.