<> <> <> <> <<>> 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_0; 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^> 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_0]]; CDProperties.PutProp[h.properties, $SimpleCount, NEW[INT_0]]; 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.