DIRECTORY CDIO, CD, CDDirectory, CDEvents, CDExtras, CDInline, CDIOExtras, CDOrient, CDPrivate, CDProperties, CDValue, FileNames, FS, IO, Process, Rope, TerminalIO, TokenIO; CDOut: CEDAR PROGRAM --monitored by TokenIO IMPORTS CDIO, CDIOExtras, CD, CDDirectory, CDEvents, CDExtras, CDInline, CDOrient, CDPrivate, CDProperties, CDValue, FileNames, FS, IO, Process, Rope, TerminalIO, TokenIO EXPORTS CDIO SHARES CDProperties = BEGIN xChipndaleFile: INT = 12121983; xVersion: INT = 3; designToWrite: CD.Design; directoryNum: INT; directoryMark: TokenIO.Mark; outputKey: REF _ NEW[INT]; thisTime: REF; lastTime: REF; WriteLevel: PUBLIC PROC [l: CD.Level] = BEGIN TokenIO.WriteAtom[CD.LevelKey[l]]; END; WriteProperties: PROC [properties: CD.Properties] = BEGIN FOR l: CD.Properties _ properties, l.rest WHILE l#NIL DO pp: CDProperties.PropertyProcs; IF NOT ISTYPE[l.first.key, ATOM] THEN LOOP; pp _ CDProperties.FetchProcs[l.first.key]; IF pp#NIL AND pp.internalWrite#NIL THEN { TokenIO.WriteAtom[$Property]; TokenIO.WritePushFlag[NARROW[l.first.key, ATOM]]; pp.internalWrite[l.first.key, l.first.val]; TokenIO.WritePopFlag[]; } ELSE WITH l.first.val SELECT FROM r: Rope.ROPE => { TokenIO.WriteAtom[$Property]; TokenIO.WritePushFlag[NARROW[l.first.key, ATOM]]; TokenIO.WriteRope[r]; TokenIO.WritePopFlag[]; }; at: ATOM => { TokenIO.WriteAtom[$Property]; TokenIO.WritePushFlag[NARROW[l.first.key, ATOM]]; TokenIO.WriteAtom[at]; TokenIO.WritePopFlag[]; } ENDCASE => NULL; ENDLOOP; END; WriteApplicationPtr: PUBLIC PROC [ap: CD.ApplicationPtr] = BEGIN loc: CD.DesignPosition; IF xVersion<=2 THEN loc _ ap.location ELSE { AppLocation: PROC [aptr: CD.ApplicationPtr] RETURNS [CD.DesignPosition] = BEGIN inr: CD.DesignRect _ aptr.ob.p.insideRect[aptr.ob]; off: CD.DesignPosition _ CDOrient.MapPosition[ itemInCell: inr, cellSize: aptr.ob.size, cellInstOrient: aptr.orientation, cellInstPos: [0, 0] ]; RETURN [CDInline.AddPoints[aptr.location, off]] END; loc _ AppLocation[ap] }; TokenIO.WriteInt[loc.x]; TokenIO.WriteInt[loc.y]; CDIO.WriteOrientation[ap.orientation]; WriteProperties[ap.properties]; WriteObject[ap.ob]; END; WriteApplicationList: PUBLIC PROC [list: CD.ApplicationList] = BEGIN count: INT _ 0; FOR l: CD.ApplicationList _ list, l.rest WHILE l#NIL DO count _ count+1; ENDLOOP; TokenIO.WriteInt[count]; FOR l: CD.ApplicationList _ list, l.rest WHILE l#NIL DO WriteApplicationPtr[l.first]; ENDLOOP; END; WriteObject: PUBLIC PROC [ob: CD.ObPtr] = BEGIN xx: REF = CDProperties.GetPropFromObject[from: ob, prop: thisTime]; IF xx#NIL AND ISTYPE[xx, REF INT] THEN { TerminalIO.WriteRope["."]; TokenIO.WriteInt[NARROW[xx, REF INT]^]; RETURN }; TerminalIO.WriteRope["x"]; DoWriteObject[ob] END; DoWriteObject: PROC [ob: CD.ObPtr] = --INLINE-- BEGIN IF ob.p.internalWrite=NIL THEN { TokenIO.WritePushFlag[$Unknown]; TokenIO.WritePopFlag[]; TerminalIO.WriteRope["unknown object\n"]; RETURN }; TokenIO.WritePushFlag[NARROW[ob.p.objectType, ATOM]]; ob.p.internalWrite[ob]; IF ob.p.hasChildren THEN { TokenIO.WriteRope[CDDirectory.Name[ob]]; TokenIO.WriteRope[CDDirectory.Key[ob]]; }; WriteProperties[ob.properties]; CDProperties.PutPropOnObject[onto: ob, prop: lastTime, val: NIL]; TokenIO.WritePopFlag[]; END; WritePushLevel: PROC [pl: LIST OF CD.PushRec] = BEGIN IF pl=NIL THEN RETURN; IF pl.rest#NIL THEN WritePushLevel[pl.rest]; TokenIO.WriteAtom[$Push]; IF pl.first.mightReplace#NIL THEN WriteApplicationPtr[pl.first.mightReplace] ELSE TokenIO.WriteAtom[$Nil]; WriteObject[pl.first.dummyCell.ob] END; EachChildren: CDDirectory.EnumerateObjectsProc --PROC [me: ObPtr, x: REF]-- = BEGIN xx: REF = CDProperties.GetPropFromObject[from: me, prop: thisTime]; IF xx#NIL THEN RETURN; -- it and its children are already out IF me.p.hasChildren THEN CDDirectory.EnumerateChildObjects[me: me, p: EachChildren, x: x]; directoryNum _ directoryNum+1; TokenIO.WriteInt[directoryNum]; DoWriteObject[me]; CDProperties.PutPropOnObject[onto: me, prop: thisTime, val: NEW[INT_directoryNum]]; END; EachDirectoryEntry: CDDirectory.EachEntryAction --[name: Rope.ROPE, ob: CD.ObPtr] RETURNS [quit: BOOL_FALSE]-- = BEGIN EachChildren[ob, NIL]; END; DoWriteDesign: PROC [] = BEGIN thisTime _ NEW[INT]; lastTime _ CDValue.Fetch[boundTo: designToWrite, key: outputKey, propagation: design]; IF lastTime=NIL THEN {lastTime_NEW[INT]}; CDValue.Store[boundTo: designToWrite, key: outputKey, value: thisTime]; directoryNum_0; IF Rope.Length[designToWrite.name]<=0 OR Rope.Fetch[designToWrite.name]='/ OR Rope.Fetch[designToWrite.name]='[ THEN TokenIO.WriteRope[NIL] ELSE TokenIO.WriteRope[designToWrite.name]; directoryMark _ TokenIO.MarkAndWriteInt[directoryNum]; -- number of entries in directory [] _ CDDirectory.Enumerate[design: designToWrite, action: EachDirectoryEntry]; WriteProperties[designToWrite.properties]; WritePushLevel[designToWrite.actual]; TokenIO.UpdateMark[mark: directoryMark, value: directoryNum]; TokenIO.WriteAtom[$EndOfDesign]; END; DontOverWrite: ERROR = CODE; WriteDesign: PUBLIC PROC [design: CD.Design, to: REF_NIL, emergency: BOOL_FALSE] RETURNS [done: BOOL_FALSE] = BEGIN ENABLE DontOverWrite => GOTO NotOpened; DoAttach: PROC [] RETURNS [done: BOOL] = BEGIN DoRealAttach: PROC [] RETURNS [done: BOOL_FALSE] = BEGIN TokenIO.AttachWriter[binFile ! TokenIO.Error => GOTO AttachProblem]; done _ TRUE; EXITS AttachProblem => RETURN END; count: NAT _ 0; done _ DoRealAttach[]; WHILE NOT done AND emergency DO TokenIO.StopWriting[]; Process.Pause[Process.SecondsToTicks[1]]; TokenIO.StopWriting[]; Process.Pause[Process.SecondsToTicks[2]]; count _ count+1; IO.Reset[binFile]; TerminalIO.WriteRope["TRIES TO BREAK THE LOCK\n"]; TokenIO.ReleaseWriter[]; -- XXXXXXX DANGEROUS Process.Pause[Process.SecondsToTicks[1]]; done _ DoRealAttach[]; IF NOT done AND count>5 THEN { count_0; SIGNAL CDPrivate.DebugCall[what: "cannot attach"]; }; ENDLOOP END; InName: PROC [wDir: Rope.ROPE_NIL] RETURNS [name: Rope.ROPE] = BEGIN CheckExistance: PROC [name: Rope.ROPE] = BEGIN temfile: IO.STREAM _ FS.StreamOpen[name ! FS.Error => IF error.group#bug THEN GOTO NotFound]; TerminalIO.WriteRope["File "]; TerminalIO.WriteRope[name]; TerminalIO.WriteRope[" exists already; "]; IF ~TerminalIO.UserSaysYes[label: "overwrite? ", text: "overwrite?", default: FALSE] THEN ERROR DontOverWrite; TerminalIO.WriteRope[" yes\n"]; EXITS NotFound => { --this is the "normal" case of an not yet existing file NULL } END; IF emergency THEN name _ "emergency.dale" ELSE { TerminalIO.WriteRope["output file name"]; IF ~Rope.IsEmpty[wDir] THEN { TerminalIO.WriteRope[" ("]; TerminalIO.WriteRope[wDir]; TerminalIO.WriteRope[")"]; }; name _ TerminalIO.RequestRope[" > "]; name _ CDExtras.AppendExt[name, "dale"]; IF ~Rope.IsEmpty[wDir] THEN name _ FS.ExpandName[name, wDir].fullFName; CheckExistance[name]; } END; Help: PROC [] = BEGIN TerminalIO.WriteRope[" first, try it again; if it still does not work,\n"]; TerminalIO.WriteRope[" for emergency output, hack\n"]; TerminalIO.WriteRope[" _ %CDIO.WriteDesign[CDDebug.xdesign, ""foo.dale"", TRUE] \n"]; TerminalIO.WriteRope[" to an interpreter tool\n"]; TerminalIO.WriteRope[" (this would try to output 20 times, then it signals)\n"]; END; iMadeTheOpen: BOOL_FALSE; binFile: IO.STREAM; sealMark: TokenIO.Mark; name, fileName: Rope.ROPE; wDir: Rope.ROPE _ CDIOExtras.GetDesignsWorkingDirectory[design]; IF Rope.IsEmpty[wDir] THEN wDir _ FileNames.CurrentWorkingDirectory[]; designToWrite _ design; IF to#NIL AND ISTYPE[to, IO.STREAM] THEN { binFile _ NARROW[to, IO.STREAM] } ELSE { IF to=NIL THEN { name _ InName[wDir]; } ELSE IF ISTYPE[to, Rope.ROPE] THEN { name _ NARROW[to, Rope.ROPE]; IF Rope.IsEmpty[name] THEN name _ InName[wDir]; } ELSE { TerminalIO.WriteRope["WriteDesign does not support type of 'to' parameter\n"]; GOTO NotOpened; }; fileName _ FS.ExpandName[CDExtras.AppendExt[name, "dale"], wDir].fullFName; binFile _ FS.StreamOpen[fileName, $create ! FS.Error => IF error.group#bug THEN { binFile_NIL; GOTO NotOpened } ]; iMadeTheOpen _ TRUE; }; IF NOT DoAttach[] THEN { TerminalIO.WriteRope["not attached, locks are hold\n"]; Help[]; RETURN }; TokenIO.WriteInt[xChipndaleFile]; TokenIO.WriteInt[xVersion]; sealMark _ TokenIO.MarkAndWriteInt[0]; -- this is a bad seal TokenIO.WriteAtom[designToWrite.technology.key]; TokenIO.WriteRope[designToWrite.technology.name]; IF CDEvents.ProcessEvent[ev: writeEvent, design: designToWrite, x: NIL, listenToDont: TRUE].dont THEN { TerminalIO.WriteRope["write not done\n"]; TokenIO.ReleaseWriter[]; IO.Close[binFile]; RETURN }; DoWriteDesign[]; TokenIO.UpdateMark[sealMark, -1]; -- validate seal TokenIO.ReleaseWriter[]; IF iMadeTheOpen THEN IO.Close[binFile]; TerminalIO.WriteRope[designToWrite.name]; TerminalIO.WriteRope[" written on file "]; IF iMadeTheOpen THEN TerminalIO.WriteRope[fileName]; TerminalIO.WriteLn[]; done _ TRUE; EXITS NotOpened => { TerminalIO.WriteRope["File not created\n"]; }; END; writeEvent: CDEvents.EventRegistration = CDEvents.RegisterEventType[$WriteTechnologyPrivate]; END. * CDOut.mesa by Ch. Jacobi, December 12, 1983 2:02 pm some code from Kim Rachmeler Last Edited by: Jacobi, April 4, 1984 5:25:45 pm PST -- global variables; are protected by the requirement of attaching Tokenio -- correct by beeing inverse of CDApplications.NewApplication --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 --Errors DontOverWrite if necessary --file exists already --WriteDesign -- Module initialization ‌تŒکJڑœ™JڑœF™FJڑœ5™5J™ڑدk ک Jڑ‌œکJڑ‌œکJڑœکJڑœ ک Jڑœ ک Jک JکJک Jک Jک JکJڑœ ‌ک Jڑ‌œکJڑ‌œکJکJکJکJک—Jکڑدbœ‌œ‌œدcک+Jڑ ‌œ‌œ‌œb‌œ‌œ$کھJڑ‌œ‌کJڑ‌œک—Jڑ‌کJکJڑœ‌œکJڑœ ‌œکJکJڑœJ™JJڑœ‌œکJڑœ‌œکJڑœکJڑœ‌œ‌œ‌œکJڑœ ‌œکJڑœ ‌œکJکcodeڑدn œ‌œ‌œ ک'Kڑ‌کJڑœ‌œک"Jڑ‌œک—Jکڑ œ‌œ‌œک3Jڑ‌کڑ ‌œ‌œ!‌œ‌œ‌ک8JڑœکJڑ‌œ‌œ‌œ‌œ‌œ‌œک+Jڑœ*ک*ڑ‌œ‌œ‌œ‌œک)JکJڑœ‌œ‌œک1Jڑœ+ک+JڑœکJک—ڑ‌کڑ‌œ ‌œ‌کڑœ‌œکJکJڑœ‌œ‌œک1JڑœکJڑœکJک—ڑœ‌œک JکJڑœ‌œ‌œک1JڑœکJڑœکJک—Jڑ‌œ‌œک——Jڑ‌œک—Jڑ‌œک—Jکڑ œ‌œ‌œ‌œک:Jڑ‌کJکJڑ‌œ ‌œک%ڑ‌œکڑ œ‌œ‌œ‌œ‌œکIJڑœ=™=Jڑ‌کJڑœ‌œ,ک3ڑœ‌œ'ک.JکJڑœکJڑœ!ک!JکJک—Jڑ‌œ)ک/Jڑ‌œک—JڑœکJک—JکJکJڑ‌œ"ک&JکJکJڑ‌œکJک—ڑ œ‌œ‌œک>Jڑ‌کJڑœ‌œکڑ ‌œ‌œ ‌œ‌œ‌ک7JکJڑ‌œک—Jکڑ ‌œ‌œ ‌œ‌œ‌ک7JڑœکJڑ‌œک—Jڑ‌œک—Jکڑ œ‌œ‌œ ک)Jڑ‌کJڑœ‌œ<کCڑ‌œ‌œ‌œ‌œ‌œ‌œ‌œک(JڑœکJڑœ‌œ‌œک'Jڑ‌کJڑœک—JڑœکJڑœکJڑ‌œک—Jکڑ œ‌œ‌œ ں ک/Jڑ‌کڑ‌œ‌œ‌œک Jڑœ ک JڑœکJک)Jڑ‌کJڑœک—Jڑœ‌œ‌œک5Jڑœکڑ‌œ‌œکJڑœ(ک(Jڑœ'ک'Jک—JڑœکJڑœ<‌œکAJڑœکJڑ‌œک—Jکڑ œ‌œ‌œ‌œ‌œک/Jڑ‌کJڑ‌œ‌œ‌œ‌œکJڑ‌œ ‌œ‌œک,JڑœکJڑ‌œ‌œ‌œ+کLJڑ‌œکJڑœ"ک"Jڑ‌œک—Jکڑ œ#ںœکMJڑ‌کJڑœ‌œ<کCJڑ ‌œ‌œ‌œ‌œں&ک=ڑ‌œ‌œکJڑœAکA—JڑœکJڑœکJڑœکJڑœ<‌œ‌œکSJڑ‌œک—Jکڑ œں>œکpJڑ‌کJڑœ‌œکJڑ‌œک—Jکڑ œ‌œکJڑ‌کJڑœ‌œ‌œکJڑœVکVJڑ ‌œ ‌œ‌œ‌œ‌œک)JڑœGکGJڑœکڑ‌œ$ک&Jڑ‌œ#ک%Jڑ‌œ#‌œ‌œک@—Jڑ‌œ'ک+Jڑœ7ں!کXJڑœNکNJڑœ*ک*Jڑœ%ک%Jڑœ=ک=Jڑœ ک Jڑ‌œک—JکJڑœ‌œ‌œکJکڑ œ‌œ ‌œ ‌œ‌œ ‌œ‌œ‌œ‌œ‌œکmJ™/JڑœQ™QJڑœ,™,Kڑ‌کKڑ‌œ!ک'Kکڑ œ‌œ‌œ‌œک(Kڑ‌کڑ œ‌œ‌œ‌œ‌œک2Kڑ‌کKڑœ0‌œکDKڑœ‌œکڑ‌کKڑœ‌ک—Kڑ‌œک—Kڑœ‌œکKڑœکڑ‌œ‌œ‌œ‌کKڑœکKڑœ)ک)KڑœکKڑœ)ک)KڑœکKڑ‌œکKک2Kڑœںک-Kڑœ)ک)Kڑœکڑ‌œ‌œ‌œ ‌œکKڑœکKڑ‌œ,ک2Kڑœک—Kڑ‌ک—Kڑ‌œکKکڑ œ‌œ ‌œ‌œ‌œ ‌œک>Kڑ‌کKکڑ œ‌œ ‌œک(Kڑœ#™#Kڑ‌کJڑœ ‌œ‌œ‌œ‌œ ‌œ‌œ‌œک]Jڑœ™JڑœکJڑœکJڑœ*ک*Jڑ‌œL‌œ‌œ‌œکnJڑœکڑ‌کڑœں7کEJڑ‌کJڑœک——Kڑ‌œک—KکKڑ‌œ‌œک)ڑ‌œکJڑœ)ک)ڑ‌œ‌œکJڑœکJڑœکJڑœکJک—Kڑœ'ک'Kڑœ(ک(Kڑ‌œ‌œ‌œ"کGKڑœکKک—Kڑ‌œک——Jکڑ œ‌œکJڑ‌کJڑœLکLJڑœ7ک7JڑœXکXJڑœ3ک3JڑœQکQJڑ‌œک—KکKڑں ™ Kڑœ‌ œکKڑœ ‌œ‌œکKڑœکKڑœ‌œکKڑœ‌œ1ک@Kڑ‌œ‌œ,کFKڑœکڑ‌œ‌œ‌œ‌œ‌œ‌œ‌œک*Kڑœ‌ œ‌œ‌œکKڑœک—ڑ‌œکڑ‌œ‌œ‌œکKڑœکKک—ڑ ‌œ‌œ‌œ ‌œ‌œک$Jڑœ‌œ ‌œکJڑ‌œ‌œک/Jک—ڑ‌œکJڑœNکNJڑ‌œکJک—Jڑœ‌œ>کKڑœ ‌œ ک,ڑ‌œ ‌œ‌œک%Kڑœ‌œک Kڑ‌œ کKڑœک—Kڑœک—Kڑœ‌œکJک—ڑ‌œ‌œ‌œکKڑœ7ک7JکKڑ‌کKک—Kڑœ!ک!KڑœکKڑœ'ںک