<> <> <> <> DIRECTORY CD, CDGenerate, CDGenerateBackdoor, CDDirectory, CDEvents, CDIO, CDProperties, CDRemote, CDValue, RefTab, Rope, SymTab, TerminalIO; CDRemoteImpl: CEDAR PROGRAM IMPORTS CDGenerate, CDGenerateBackdoor, CDDirectory, CDEvents, CDIO, CDProperties, CDValue, RefTab, Rope, SymTab, TerminalIO EXPORTS CDRemote = BEGIN <<--implements two methods of generator tables>> <<--tables as exported from CDRemote: selecting an object from one specific remote design>> <<--table "INCLUDE": generator key is designName.objectName; for any designName>> dummy: CDGenerate.Table _ CDGenerate.Create[]; tableToName: RefTab.Ref _ RefTab.Create[]; -- table ==> remote design name <<-- entries of type REF NameRec>> NameRec: TYPE = RECORD [name: Rope.ROPE, key: REF]; nameToTable: SymTab.Ref _ SymTab.Create[]; -- remote design name ==> table UnspecSelector: CDGenerateBackdoor.SelectorProc = { key _ TerminalIO.RequestRope[" include [design.oject] >"]; }; Selector: CDGenerateBackdoor.SelectorProc = { dName: Rope.ROPE = DesignName[table]; key _ TerminalIO.RequestRope[Rope.Cat[label, " include oject from ", dName, " >"]]; }; UnspecRemoteIGenerator: CDGenerateBackdoor.IGeneratorProc = <<--this one even does not know what design to use>> BEGIN dot: INT = TrailingDot[key]; remoteName: Rope.ROPE_NIL; objectName: Rope.ROPE_NIL; table: CDGenerate.Table; IF dot < Rope.Length[key] THEN { objectName _ Rope.Substr[key, dot+1]; remoteName _ Rope.Substr[key, 0, dot] }; IF ~Rope.IsEmpty[remoteName] AND ~Rope.IsEmpty[objectName] THEN { table _ GetTable[remoteName]; ob _ CDGenerate.FetchNCall[table, design, objectName]; } ELSE TerminalIO.WriteRope["**tried to access remote with bad syntax\n"]; END; TrailingDot: PROC [base: Rope.ROPE] RETURNS [INT] = { <<--position of last dot>> len: INT _ Rope.Length[base]; pos: INT _ len; WHILE pos > 0 DO SELECT Rope.Fetch[base, pos _ pos - 1] FROM '. => RETURN [pos]; '!, '], '>, '/ => EXIT; ENDCASE; ENDLOOP; RETURN [len]; }; GetTable: PUBLIC PROC [remoteDesign: Rope.ROPE] RETURNS [table: CDGenerate.Table_NIL] = TRUSTED BEGIN IF Rope.IsEmpty[remoteDesign] THEN ERROR; WITH nameToTable.Fetch[remoteDesign].val SELECT FROM t: CDGenerate.Table => RETURN [t] ENDCASE => NULL; table _ CDGenerateBackdoor.CreateIndirect[onTopOf: dummy, iGenerator: RemoteIGenerator, selector: Selector, cache: TRUE, flushThrough: FALSE, clearThrough: FALSE, registerThrough: FALSE]; [] _ tableToName.Insert[LOOPHOLE[table], NEW[NameRec _ [name: remoteDesign, key: NEW[INT]] ] ]; IF nameToTable.Insert[remoteDesign, LOOPHOLE[table]] THEN RETURN; RETURN [GetTable[remoteDesign]] --indirection for concurrency problems END; ioFailed: PUBLIC SIGNAL = CODE; GetTableUsingFile: PUBLIC PROC [for: CD.Design, remoteDesign: Rope.ROPE, remoteFile: Rope.ROPE _ NIL, reload: BOOL _ FALSE] RETURNS [CDGenerate.Table] = <<--Creates a generator table, "generating" = fetching an object from the remote design. >> <<--Reads remoteDesign if necessary or reload>> <<-- remoteFile defaults to remoteDesign>> <<-- re-reading may cause children objects to be duplicated>> BEGIN remote: CD.Design _ NIL; IF ~reload THEN remote _ FetchDesign[for, remoteDesign]; IF remote=NIL THEN { remote _ DoLoad[importer: for, remoteName: remoteDesign, fileName: remoteFile]; IF remote#NIL THEN CacheDesign[for, remote] ELSE SIGNAL ioFailed; }; RETURN [ GetTable[remoteDesign] ]; END; Get: PUBLIC PROC [for: CD.Design, remoteDesign: Rope.ROPE, object: Rope.ROPE] RETURNS [ob: CD.Object] = BEGIN table: CDGenerate.Table = GetTable[remoteDesign]; ob _ CDGenerate.FetchNCall[table, for, object]; END; RemoteInfo: PROC [table: CDGenerate.Table] RETURNS [r: REF NameRec_NIL] = TRUSTED BEGIN WITH tableToName.Fetch[LOOPHOLE[table]].val SELECT FROM rn: REF NameRec => RETURN [rn]; ENDCASE => { table _ CDGenerateBackdoor.Indiretee[table]; IF table#NIL THEN RETURN[RemoteInfo[table]] }; END; DesignName: PUBLIC PROC [table: CDGenerate.Table] RETURNS [r: Rope.ROPE_NIL] = BEGIN rn: REF NameRec _ RemoteInfo[table]; IF rn#NIL THEN RETURN [rn.name] END; RemoteIGenerator: CDGenerateBackdoor.IGeneratorProc = BEGIN replaceList: CDDirectory.ReplaceList _ NIL; GetOrLoad: PROC [importer: CD.Design, remoteInfo: REF NameRec] RETURNS [design: CD.Design_NIL] = BEGIN IF remoteInfo=NIL OR Rope.IsEmpty[remoteInfo.name] THEN { TerminalIO.WriteRope["**generate with bad remote name\n"]; RETURN }; WITH CDValue.Fetch[boundTo: importer, key: remoteInfo.key] SELECT FROM d: CD.Design => design _ d; ENDCASE => NULL; IF design=NIL THEN { design _ DoLoad[importer, remoteInfo.name]; CDValue.Store[boundTo: importer, key: remoteInfo.key, value: design]; }; END; EachChild: CDDirectory.EnumerateObjectsProc = -- PROC [me: CD.Object, x: REF] -- BEGIN IF me.class.inDirectory THEN { name: Rope.ROPE _ CDDirectory.Name[me]; ob1: CD.Object _ CDGenerate.FetchNCall[realTable, design, name];--will be cached! replaceRec: REF CDDirectory.ReplaceRec _ NEW[CDDirectory.ReplaceRec _ [ old: me, oldSize: me.size, new: ob1, newSize: ob1.size, off: [0, 0] ]]; replaceList _ CONS[replaceRec, replaceList]; } END; remoteInfo: REF NameRec _ RemoteInfo[passTable]; remoteDesign: CD.Design _ GetOrLoad[design, remoteInfo]; IF remoteDesign#NIL THEN { rob: CD.Object _ CDDirectory.Fetch[remoteDesign, key].object; IF rob#NIL THEN { ob _ CDDirectory.Another[me: rob, from: remoteDesign, to: design]; CDProperties.PutPropOnObject[ob, $CameFrom, remoteDesign.name]; CDProperties.PutPropOnObject[ob, $OriginalName, key]; CDDirectory.EnumerateChildObjects[me: ob, p: EachChild]; IF replaceList#NIL THEN [] _ CDDirectory.DoReplaceDirectChild[me: ob, design: design, replace: replaceList]; }; }; END; CacheDesign: PUBLIC PROC [for: CD.Design, remote: CD.Design] = <<--caller MUST guarantee: remote will NEVER be changed>> <<-- (but a different design with the same name might be cached later...)>> <<--CDRemote guarantees: it will never change remote >> BEGIN rn: REF NameRec; IF for.technology#remote.technology THEN ERROR; rn _ RemoteInfo[GetTable[remote.name]]; IF rn#NIL THEN CDValue.Store[boundTo: for, key: rn.key, value: remote] ELSE TerminalIO.WriteRope["**CacheRemoteDesign failed; debugging is appropriate\n"]; END; FetchDesign: PUBLIC PROC [for: CD.Design, name: Rope.ROPE] RETURNS [remote: CD.Design _ NIL] = BEGIN rn: REF NameRec _ RemoteInfo[GetTable[name]]; WITH CDValue.Fetch[boundTo: for, key: rn.key, propagation: design] SELECT FROM d: CD.Design => remote _ d ENDCASE => NULL; END; DoLoad: PROC [importer: CD.Design, remoteName: Rope.ROPE, fileName: Rope.ROPE_NIL] RETURNS [design: CD.Design_NIL] = BEGIN Check: PROC [design: CD.Design] RETURNS [ok: BOOL] = BEGIN ok _ design.technology=importer.technology; IF NOT ok THEN { TerminalIO.WriteRopes["Technology missmatch: remote design is ", design.technology.name, "\n"]; RETURN }; ok _ Rope.Equal[remoteName, CDIO.DesignInReadOperation[].name]; IF NOT ok THEN { TerminalIO.WriteRope[Rope.Cat["file """, fileName, """ has different design: """, CDIO.DesignInReadOperation[].name, """\n"]]; }; END; wDir: Rope.ROPE _ CDIO.GetWorkingDirectory[importer]; TerminalIO.WriteRope["load a remote design\n"]; IF Rope.IsEmpty[fileName] THEN fileName _ remoteName; design _ CDIO.ReadDesign[CDIO.MakeName[base: fileName, ext: "dale", wDir: wDir], Check]; TerminalIO.WriteRope["loading remote design "]; TerminalIO.WriteRope[(IF design#NIL THEN "done\n" ELSE "not done\n")]; END; ObChanged: CDEvents.EventProc = BEGIN ENABLE UNWIND => NULL; WITH x SELECT FROM ob: CD.Object => { CDProperties.PutPropOnObject[ob, $CameFrom, NIL]; CDProperties.PutPropOnObject[ob, $OriginalName, NIL]; }; ENDCASE => NULL; END; unspecRemoteTable: CDGenerate.Table _ CDGenerateBackdoor.CreateIndirect[ onTopOf: dummy, iGenerator: UnspecRemoteIGenerator, selector: UnspecSelector ]; TRUSTED { [] _ SymTab.Insert[CDGenerateBackdoor.publicTables, "INCLUDE", LOOPHOLE[unspecRemoteTable]]; }; CDEvents.RegisterEventProc[$AfterChange, ObChanged]; [] _ CDProperties.RegisterProperty[$CameFrom]; [] _ CDProperties.RegisterProperty[$OriginalName]; END.