<> <> <> <> <> DIRECTORY Atom, CD, CDApplications, CDDirectory, CDEvents, CDIO, CDOps USING [CreateDesign], CDPrivate, CDProperties, CDRects, CDValue, FileNames, FS, IO, List, ProcessProps, Rope, RuntimeError USING [UNCAUGHT], TerminalIO, TokenIO; CDIn: CEDAR MONITOR IMPORTS Atom, CD, CDApplications, CDDirectory, CDEvents, CDIO, CDOps, CDPrivate, CDProperties, CDRects, CDValue, FileNames, FS, IO, List, ProcessProps, Rope, RuntimeError, TerminalIO, TokenIO EXPORTS CDIO SHARES CDDirectory = BEGIN xChipndaleFile: INT = 12121983; xVersion: INT = 4; <<-- global vars>> versionKey: PUBLIC INT; designInReadOperation: PUBLIC CD.Design _ NIL; binfile: IO.STREAM; IndexTable: TYPE = RECORD[table: SEQUENCE max: CARDINAL OF CD.ObPtr]; TableTable: TYPE = RECORD[tt: SEQUENCE max: CARDINAL OF REF IndexTable]; fileName: Rope.ROPE; indexTable: REF IndexTable _ NIL; tableTable: REF TableTable _ NIL; maxTableSize: INT = 32000; GetTableEntry: PROC[i: INT] RETURNS [CD.ObPtr] = INLINE BEGIN RETURN[indexTable.table[i]]; <> <> END; SetTableEntry: PROC[i: INT, ob: CD.ObPtr] = INLINE BEGIN indexTable.table[i] _ ob; <> <> END; AllocateTables: PROC[i: INT] = BEGIN indexTable _ NEW[IndexTable[MIN[i, maxTableSize]]]; IF i>=maxTableSize THEN { TerminalIO.WriteRope["****design to big\n"]; ERROR }; <=maxTableSize THEN {>> <> <> <> <> <<};>> END; ReadProperties: PUBLIC PROC [] RETURNS [props: CD.Properties_NIL] = BEGIN PropertyProblem: PROC [] = { TerminalIO.WriteRope["**property not readable \n"]; ERROR TokenIO.EncodingError; }; key: ATOM; propProcs: CDProperties.PropertyProcs; token: TokenIO.Token; DO token _ TokenIO.ReadToken[]; IF token.ref#$Property THEN { TokenIO.ReadAgain[]; RETURN [props]; }; key _ TokenIO.ReadPushFlag[]; propProcs _ CDProperties.FetchProcs[key]; IF propProcs#NIL AND propProcs.internalRead#NIL THEN { props _ Atom.PutPropOnList[propList: props, prop: key, val: propProcs.internalRead[key]]; } ELSE { token _ TokenIO.ReadToken[]; IF token.kind=rope OR token.kind=atom OR token.kind=int THEN props _ Atom.PutPropOnList[propList: props, prop: key, val: token.ref] ELSE IF token.kind=popFlag THEN { TokenIO.ReadAgain[]; props _ Atom.PutPropOnList[propList: props, prop: key, val: key] } ELSE IF token.kind=pushFlag AND token.ref=NIL THEN { propertieProps: CD.Properties _ ReadProperties[]; props _ Atom.PutPropOnList[propList: props, prop: key, val: propertieProps]; token _ TokenIO.ReadToken[]; IF token.kind#popFlag THEN PropertyProblem[] } ELSE PropertyProblem[] }; TokenIO.ReadPopFlag[]; ENDLOOP; END; SkipThrough: PROC [] = BEGIN token: TokenIO.Token; level: INT _ 0; DO token _ TokenIO.ReadToken[]; IF token.kind=pushFlag THEN level _ level+1 ELSE IF token.kind=popFlag THEN level _ level-1; IF level<0 THEN EXIT; ENDLOOP; END; SetName: PROC[me: CD.ObPtr, r: Rope.ROPE] ~ INLINE { IF me.p.inDirectory THEN CDDirectory.ObToDirectoryProcs[me].setName[me, r] }; SetKey: PROC[me: CD.ObPtr, r: Rope.ROPE] ~ INLINE { IF me.p.inDirectory THEN CDDirectory.ObToDirectoryProcs[me].setKey[me, r] }; ReadObjectDefinition: PROC [] RETURNS [obj: CD.ObPtr_NIL] = BEGIN token: TokenIO.Token; atom: ATOM = TokenIO.ReadPushFlag[]; p: REF READONLY CD.ObjectProcs _ CD.FetchObjectProcs[atom, designInReadOperation.technology]; IF p=NIL OR p.internalRead=NIL THEN { TerminalIO.WriteRope["unknown object "]; TerminalIO.WriteRope[Atom.GetPName[atom]]; TerminalIO.WriteLn[]; SkipThrough[]; obj _ CDRects.CreateBareRect[[10, 10], CD.highLightError]; } ELSE { obj _ p.internalRead[]; IF obj=NIL THEN obj _ CDRects.CreateBareRect[[10, 10], CD.highLightError]; IF versionKey>0 THEN { IF p.inDirectory THEN { name: Rope.ROPE _ TokenIO.ReadRope[]; key: Rope.ROPE _ TokenIO.ReadRope[]; SetName[obj, name]; SetKey[obj, key]; }; }; token _ TokenIO.ReadToken[]; IF token.kind#popFlag THEN { TokenIO.ReadAgain[]; obj.properties _ ReadProperties[]; TokenIO.ReadPopFlag[]; } } END; ReadObject: PUBLIC PROC [] RETURNS [CD.ObPtr] = BEGIN t: TokenIO.Token = TokenIO.ReadToken[]; IF t.kind=int THEN { -- instance ins: INT _ NARROW[t.ref, REF INT]^; RETURN [GetTableEntry[ins]] }; TokenIO.ReadAgain; RETURN [ReadObjectDefinition[]] END; ReadApplicationPtr: PUBLIC PROC [] RETURNS [CD.ApplicationPtr] = BEGIN RelativeMode: PROC [] RETURNS [BOOL] = INLINE { RETURN [versionKey>=3] }; ap: CD.ApplicationPtr; location: CD.DesignPosition _ ReadPosition[]; orientation: CD.Orientation _ CDIO.ReadOrientation[]; properties: CD.Properties _ ReadProperties[]; ob: CD.ObPtr _ ReadObject[]; IF RelativeMode[] THEN ap _ CDApplications.NewApplicationI[ob: ob, location: location, orientation: orientation, properties: properties] ELSE ap _ NEW[CD.Application _ [location: location, orientation: orientation, properties: properties, ob: ob, selected: FALSE]]; RETURN [ap]; END; ReadApplicationList: PUBLIC PROC [] RETURNS [list: CD.ApplicationList_NIL] = BEGIN num: INT = TokenIO.ReadInt[]; THROUGH [0..num) DO list _ CONS[ReadApplicationPtr[], list]; ENDLOOP END; ReadPushRec: PROC [] RETURNS [pr: CD.PushRec] = BEGIN token: TokenIO.Token _ TokenIO.ReadToken[]; dummy: CD.ObPtr; IF token.ref=$Nil THEN pr.mightReplace_NIL ELSE { TokenIO.ReadAgain[]; pr.mightReplace _ ReadApplicationPtr[]; }; dummy _ ReadObjectDefinition[]; pr.changed _ pr.indirectlyChanged _ TRUE; pr.specific _ NARROW[dummy.specificRef, CD.CellPtr]; pr.dummyCell _ CDApplications.NewApplicationI[ob: dummy]; END; ReadPosition: PROC [] RETURNS [pos: CD.DesignPosition] = BEGIN pos.x _ TokenIO.ReadInt[]; pos.y _ TokenIO.ReadInt[]; END; ReadLevel: PUBLIC PROC [] RETURNS [CD.Level] = BEGIN key: ATOM = TokenIO.ReadAtom[]; RETURN [CD.FetchLevel[designInReadOperation.technology, key]]; END; ReadDesignData: PROC [] = BEGIN index, directoryCount: INT; token: TokenIO.Token; obj: CD.ObPtr; directoryCount _ TokenIO.ReadInt[]; AllocateTables[directoryCount+1]; -- ??? FOR n: INT IN [1..directoryCount] DO index _ TokenIO.ReadInt[]; obj _ ReadObjectDefinition[]; SetTableEntry[index, obj]; IF versionKey=0 THEN { token _ TokenIO.ReadToken[]; WHILE token.kind=rope DO name: Rope.ROPE = NARROW[token.ref]; obx: INT = TokenIO.ReadInt[]; [] _ CDDirectory.Include[designInReadOperation, GetTableEntry[obx], name]; token _ TokenIO.ReadToken[]; ENDLOOP; TokenIO.ReadAgain[]; } ELSE IF obj.p.inDirectory THEN { name: Rope.ROPE = CDDirectory.Name[obj]; [] _ CDDirectory.Include[designInReadOperation, obj, name]; } ENDLOOP; designInReadOperation.properties _ ReadProperties[]; designInReadOperation.actual _ NIL; DO token _ TokenIO.ReadToken[]; IF token.ref#$Push THEN { TokenIO.ReadAgain[]; EXIT; }; designInReadOperation.actual _ CONS[ReadPushRec[], designInReadOperation.actual]; ENDLOOP; token _ TokenIO.ReadToken[]; IF token.ref#$EndOfDesign THEN ERROR TokenIO.EncodingError; END; ReadDesign: PUBLIC ENTRY PROC [from: REF_NIL, check: PROC [CD.Design] RETURNS [BOOL] _ NIL] RETURNS [CD.Design] = <<--from is either a IO.STREAM, a Rope.ROPE, or NIL>> <<--check: (called if non NIL), is called after technology and design-name is initialized>> <<-- read proceeds only if check returns TRUE >> <<--returns NIL if design not read in successfully>> <<--viewer is not opened>> BEGIN ENABLE UNWIND => { indexTable _ NIL; tableTable _ NIL; designInReadOperation _ NIL; }; design: CD.Design; -- is initialized before return only <<-- all internal routines use designInReadOperation in place of design>> DoReadDesign: INTERNAL PROC [check: PROC [CD.Design] RETURNS [BOOL]] = <<-- result design returned in designInReadOperation>> <<-- handles all the TokenIO business>> BEGIN ENABLE { CDPrivate.DebugCall => REJECT; RuntimeError.UNCAUGHT => { designInReadOperation _ NIL; TerminalIO.WriteRope["unknown problem while reading; it is ok to abort\n"]; CDPrivate.Debug["unknown error in reading"]; GOTO DoReturn; }; TokenIO.EncodingError => { designInReadOperation _ NIL; TerminalIO.WriteRope["TokenIO encoding problem; it is ok to abort\n"]; CDPrivate.Debug["read error in encoding"]; GOTO DoReturn; }; }; DoWhileAttached: INTERNAL PROC [] = <<--and always Release>> BEGIN ENABLE UNWIND => { designInReadOperation _ NIL; TokenIO.ReleaseReader[]; }; TechnologyCheck: INTERNAL PROC [] = <<--Side-effect: if bad, designInReadOperation is set to NIL>> BEGIN ENABLE UNWIND => {designInReadOperation _ NIL}; dont: BOOL _ CDEvents.ProcessEvent[ ev: readEvent, design: designInReadOperation, x: NIL, listenToDont: TRUE ].dont; IF dont THEN { designInReadOperation _ NIL; TerminalIO.WriteRope["Technology rejects read\n"]; } END; VersionAndSealCheck: INTERNAL PROC [] = BEGIN <<--chipndale check>> IF TokenIO.ReadInt[]#xChipndaleFile THEN { TerminalIO.WriteRope["File is not a chipndale design\n"]; ERROR TokenIO.Error[other, "chipndale filekey"]; }; <<--version check>> versionKey _ TokenIO.ReadInt[]; IF versionKey#xVersion THEN { IF versionKey>xVersion THEN { -- too new TerminalIO.WriteRope["design was written with newer chipndaleversion\n"]; TerminalIO.WriteRope["get a new chipndale version\n"]; ERROR TokenIO.Error[other, "chipndale versionkey"]; } ELSE IF versionKey IN [2..xVersion] THEN { -- not new but dont tell it NULL } ELSE IF versionKey IN [1..xVersion] THEN { -- not new but everything ok TerminalIO.WriteRope["design was written with older chipndaleversion\n"]; } ELSE IF versionKey IN [0..xVersion] THEN { -- not new but please convert TerminalIO.WriteRope["design was written with older chipndaleversion\n"]; TerminalIO.WriteRope["Please convert also your other designs\n"]; } ELSE { -- too old TerminalIO.WriteRope["design was written with older chipndaleversion\n"]; TerminalIO.WriteRope["This version is no more supported\n"]; ERROR TokenIO.Error[other, "chipndale versionkey"]; }; }; <<--seal check>> IF versionKey>0 THEN { IF TokenIO.ReadInt[]#-1 THEN { TerminalIO.WriteRope["File had not been properly closed; has bad seal\n"]; ERROR TokenIO.Error[other, "file had not been properly closed"]; }; }; END; <<-- DoWhileAttached>> VersionAndSealCheck[]; technologyKey _ TokenIO.ReadAtom[]; technologyName _ TokenIO.ReadRope[]; technology _ CD.FetchTechnology[technologyKey]; IF technology=NIL THEN { TerminalIO.WriteRope["technology '"]; TerminalIO.WriteRope[technologyName]; TerminalIO.WriteRope["' not loded\n"]; GOTO NotDoneAndRelease }; designInReadOperation _ CDOps.CreateDesign[technology]; TechnologyCheck[]; IF designInReadOperation=NIL THEN GOTO NotDoneAndRelease; designInReadOperation.name _ TokenIO.ReadRope[]; IF Rope.IsEmpty[designInReadOperation.name] THEN designInReadOperation.name _ fileName; IF check#NIL THEN { IF NOT check[designInReadOperation] THEN GOTO NotDoneAndRelease; }; ReadDesignData[]; TokenIO.ReleaseReader[]; CDValue.Store[boundTo: designInReadOperation, key: $CDxFromFile, value: fileName]; EXITS NotDoneAndRelease => { designInReadOperation _ NIL; TokenIO.ReleaseReader[]; }; END; <<-- DoReadDesign>> technology: CD.Technology; technologyKey: ATOM; technologyName: Rope.ROPE; designInReadOperation _ NIL; TokenIO.AttachReader[binfile ! TokenIO.Error => { r: Rope.ROPE _ "bad explanation"; IF ISTYPE[explanation, Rope.ROPE] THEN r_NARROW[explanation]; TerminalIO.WriteRope[r]; TerminalIO.WriteRope["... not attached\n"]; GOTO NotAttached } ]; DoWhileAttached[]; EXITS NotAttached, DoReturn => RETURN END; ReadName: PROC [] RETURNS [name: Rope.ROPE] = BEGIN wDir: Rope.ROPE _ FileNames.CurrentWorkingDirectory[]; TerminalIO.WriteRope[" input file"]; IF wDir#NIL THEN { TerminalIO.WriteRope[" ("]; TerminalIO.WriteRope[wDir]; TerminalIO.WriteRope[")"]; }; name _ TerminalIO.RequestRope[" > "]; END; <<>> <<-- begin ReadDesign>> iDidTheOpen: BOOL _ FALSE; name: Rope.ROPE; <<>> <<-- open file; assign fileName and binfile>> IF from#NIL AND ISTYPE[from, IO.STREAM] THEN { fileName _ NIL; binfile _ NARROW[from, IO.STREAM] } ELSE { IF from=NIL THEN name _ ReadName[] ELSE IF ISTYPE[from, Rope.ROPE] THEN { name _ NARROW[from, Rope.ROPE]; IF Rope.IsEmpty[name] THEN name _ ReadName[]; } ELSE { TerminalIO.WriteRope["ReadDesign does not support type of 'from' parameter\n"]; GOTO NotOpened; }; fileName _ MakeName[name, "dale"]; binfile _ FS.StreamOpen[fileName ! FS.Error => IF error.group # bug THEN { TerminalIO.WriteRope[fileName]; TerminalIO.WriteRope[" not opened: "]; TerminalIO.WriteRope[error.explanation]; TerminalIO.WriteLn[]; GOTO NotOpened; }]; iDidTheOpen _ TRUE; TerminalIO.WriteRope[fileName]; TerminalIO.WriteRope[" opened \n"]; }; <<-- do the actual work>> DoReadDesign[check]; design _ designInReadOperation; <<-- finalize>> designInReadOperation _ NIL; indexTable _ NIL; tableTable _ NIL; IF iDidTheOpen THEN IO.Close[binfile]; RETURN [design]; EXITS NotOpened => { indexTable _ NIL; tableTable _ NIL; designInReadOperation _ NIL; TerminalIO.WriteRope["Read not done\n"]; RETURN [NIL]; } END; ReadOrientation: PUBLIC PROC [] RETURNS [orientation: CD.Orientation] = BEGIN i: INT = TokenIO.ReadInt[]; IF versionKey<=3 THEN { IF i IN [0..15] THEN orientation _ i/4*2 + i MOD 2 ELSE ERROR TokenIO.EncodingError; } ELSE IF i IN [0..7] THEN orientation _ i ELSE ERROR TokenIO.EncodingError END; <<>> <<-- Working directories ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~>> CheckWorkingDirectory: PROC [wDir: Rope.ROPE] RETURNS [slashWDir: Rope.ROPE] = <<--if wDir is a directory, assign it to slashWDir>> <<--else slashWDir _ nil>> INLINE BEGIN IF FileNames.IsADirectory[wDir] AND NOT FileNames.IsAPattern[wDir] THEN { length: INT; slashWDir _ FileNames.ConvertToSlashFormat[wDir]; length _ slashWDir.Length[]; IF slashWDir = wDir AND length > 0 AND slashWDir.Fetch[length - 1] = '/ THEN { RETURN [slashWDir]; } }; RETURN [NIL] END; SetWorkingDirectory: PUBLIC PROC [design: REF, wDir: Rope.ROPE] = BEGIN wDir _ CheckWorkingDirectory[wDir].slashWDir; CDValue.Store[boundTo: design, key: $WorkingDirectory, value: wDir]; END; GetWorkingDirectory: PUBLIC PROC [design: REF] RETURNS [wDir: Rope.ROPE_NIL] = BEGIN WITH CDValue.Fetch[boundTo: design, key: $WorkingDirectory, propagation: global] SELECT FROM r: Rope.ROPE => RETURN [CheckWorkingDirectory[r].slashWDir]; ENDCASE => RETURN [NIL] END; UseWorkingDirectory: PUBLIC PROC [design: REF] RETURNS [wDir: Rope.ROPE] = <<--set's it for the running process>> <<--return's it>> BEGIN wDir _ GetWorkingDirectory[design]; IF wDir#NIL THEN { [] _ List.PutAssoc[key: $WorkingDirectory, val: wDir, aList: ProcessProps.GetPropList[]]; RETURN [wDir]; }; RETURN [FileNames.CurrentWorkingDirectory[]] END; TrailingChar: PROC [base: Rope.ROPE, char: CHAR] RETURNS [INT] = { <<--position of last "char", only before '!, '], '>, '/ considered >> len: INT _ Rope.Length[base]; pos: INT _ len; WHILE pos > 0 DO SELECT Rope.Fetch[base, pos _ pos - 1] FROM char => RETURN [pos]; '!, '], '>, '/ => EXIT; ENDCASE; ENDLOOP; RETURN [len]; }; MakeName: PUBLIC PROC [base: Rope.ROPE, ext: Rope.ROPE_NIL, wDir: Rope.ROPE_NIL, modifier: Rope.ROPE_NIL] RETURNS [Rope.ROPE] = BEGIN bang: INT = TrailingChar[base, '!]; <<--remove version number>> r: Rope.ROPE _ base.Substr[len: bang]; dot: INT _ TrailingChar[r, '.]; <<--include modifier>> IF ~modifier.IsEmpty[] THEN r _ r.Concat[modifier]; <<--include extension>> IF ~ext.IsEmpty[] AND (dot >= r.Length[]) THEN { dot2: INT _ TrailingChar[ext, '.]; IF dot2 >= ext.Length[] THEN r _ r.Cat[".", ext] ELSE r _ r.Concat[ext.Substr[dot2]] }; <<--include working directory>> IF wDir#NIL THEN { IF r.IsEmpty[] OR (r.Fetch[]#'/ AND r.Fetch[]#'[) THEN r _ FileNames.Directory[wDir].Concat[r] }; <<--put version number back>> IF bang < Rope.Length[base] THEN { r _ r.Concat[base.Substr[bang]] }; RETURN [r] END; NewDesignHasBeenCreated: CDEvents.EventProc = <<-- PROC [event: REF, design: CD.Design, x: REF] -- >> <<--repaint captions and sometimes the contents>> BEGIN SetWorkingDirectory[design, FileNames.CurrentWorkingDirectory[]]; END; <<>> <<-- Module Initialization ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~>> readEvent: CDEvents.EventRegistration = CDEvents.RegisterEventType[$ReadTechnologyPrivate]; CDValue.EnregisterKey[key: $WorkingDirectory]; CDEvents.RegisterEventProc[$CreateNewDesign, NewDesignHasBeenCreated]; END. <> <> <> <> <> <<>>