<> <> <> <> DIRECTORY CDProperties, CDPropertyTools, CD, CDPrivate, Atom, Commander, CommandTool, HashTable, List, PropertyLists, Rope, RopeList, RuntimeError USING [UNCAUGHT], TokenIO, UserProfile USING [Boolean], ViewerTools USING [TiogaContents, TiogaContentsRec]; CDPropertiesImpl: CEDAR MONITOR IMPORTS CD, CDPrivate, CDProperties, Atom, Commander, CommandTool, HashTable, List, PropertyLists, Rope, RopeList, RuntimeError, TokenIO, UserProfile EXPORTS CDProperties, CDPropertyTools = BEGIN PropList: TYPE = CD.PropList; PropertyProcs: TYPE = CDProperties.PropertyProcs; PropertyProcsRec: TYPE = CDProperties.PropertyProcsRec; atomTab: HashTable.Table = HashTable.Create[33]; -- contains atoms [maybe in future ref's] where properties hang <<--Registration>> propertyNameTab: HashTable.Table = HashTable.Create[33]; -- key: propertynames; value: PropertyProcs registrationTab: HashTable.Table = HashTable.Create[33]; -- contains registrationKeys RegisterProperty: PUBLIC ENTRY PROC [prop: REF, registrationKey: REF_NIL] RETURNS [first: BOOL_TRUE] = { val: HashTable.Value; found: BOOL; [found, val] _ HashTable.Fetch[registrationTab, prop]; -- returns a registration key IF found THEN { IF registrationKey#NIL AND registrationKey=val THEN RETURN [FALSE]; RETURN WITH ERROR CD.Error[doubleRegistration] } ELSE { pp: PropertyProcs _ NEW[PropertyProcsRec]; pp.key _ prop; [] _ HashTable.Insert[propertyNameTab, prop, pp]; -- procs [] _ HashTable.Insert[registrationTab, prop, registrationKey]; -- registration }; }; <<--Usage>> Err: ERROR = CODE; PutProp: PUBLIC PROC [onto: REF, prop: REF, val: REF] = { WITH onto SELECT FROM a: CD.Instance => PutInstanceProp[a, prop, val]; o: CD.Object => PutObjectProp[o, prop, val]; pr: CD.PropRef => PutPRefProp[pr, prop, val]; d: CD.Design => PutDesignProp[d, prop, val]; t: CD.Technology => PutTechnologyProp[t, prop, val]; at: ATOM => PutAtomProp[at, prop, val]; class: CD.ObjectClass => PutObjectClassProp[class, prop, val]; pp: PropertyProcs => PutPropertyClassProp[pp, prop, val]; pl: PropertyLists.PropList => RETURN WITH ERROR Err; --explicitely forbidden ENDCASE => RETURN WITH ERROR Err }; GetProp: PUBLIC ENTRY PROC [from: REF, prop: REF] RETURNS [REF] = { ENABLE UNWIND => NULL; WITH from SELECT FROM a: CD.Instance => RETURN[PropertyLists.GetProp[a.properties, prop]]; o: CD.Object => RETURN[PropertyLists.GetProp[o.properties, prop]]; pr: CD.PropRef => RETURN[PropertyLists.GetProp[pr^, prop]]; pl: CD.PropList => RETURN[PropertyLists.GetProp[pl, prop]]; at: ATOM => RETURN[GetRefAnyPropf[at, prop]]; d: CD.Design => RETURN[PropertyLists.GetProp[d.properties^, prop]]; t: CD.Technology => RETURN[PropertyLists.GetProp[t.properties^, prop]]; class: CD.ObjectClass => RETURN[PropertyLists.GetProp[class.properties^, prop]]; pp: PropertyProcs => RETURN[PropertyLists.GetProp[pp.properties, prop]]; ENDCASE => RETURN WITH ERROR Err; }; GetListProp: PUBLIC ENTRY PROC [propList: PropList, prop: REF] RETURNS [REF] = { ENABLE UNWIND => NULL; RETURN [PropertyLists.GetProp[propList, prop]] }; <<--speed ups >> PutPRefProp: PUBLIC ENTRY PROC [onto: CD.PropRef, prop: REF, val: REF] = { ENABLE UNWIND => NULL; IF onto=NIL THEN RETURN WITH ERROR CD.Error[other, "nil property field"]; onto^ _ PropertyLists.PutProp[onto^, prop, val] }; PutObjectProp: PUBLIC ENTRY PROC [onto: CD.Object, prop: REF, val: REF] = { ENABLE UNWIND => NULL; IF onto=NIL THEN RETURN WITH ERROR CD.Error[other, "NIL Object"]; onto.properties _ PropertyLists.PutProp[onto.properties, prop, val] }; PutInstanceProp: PUBLIC ENTRY PROC[onto: CD.Instance, prop: REF, val: REF] = { ENABLE UNWIND => NULL; IF onto=NIL THEN RETURN WITH ERROR CD.Error[other, "NIL Instance"]; onto.properties _ PropertyLists.PutProp[onto.properties, prop, val] }; PutDesignProp: PUBLIC ENTRY PROC [onto: CD.Design, prop: REF, val: REF] = { ENABLE UNWIND => NULL; IF onto=NIL OR onto.properties=NIL THEN RETURN WITH ERROR CD.Error[other, "NIL property field"]; onto.properties^ _ PropertyLists.PutProp[onto.properties^, prop, val] }; PutTechnologyProp: PUBLIC ENTRY PROC[onto: CD.Technology, prop: REF, val: REF] = { ENABLE UNWIND => NULL; IF onto=NIL OR onto.properties=NIL THEN RETURN WITH ERROR CD.Error[other, "nil property field"]; onto.properties^ _ PropertyLists.PutProp[onto.properties^, prop, val] }; PutObjectClassProp: ENTRY PROC[onto: CD.ObjectClass, prop: REF, val: REF] = { ENABLE UNWIND => NULL; IF onto=NIL OR onto.properties=NIL THEN RETURN WITH ERROR CD.Error[other, "nil property field"]; onto.properties^ _ PropertyLists.PutProp[onto.properties^, prop, val] }; PutAtomProp: PUBLIC PROC[onto: ATOM, prop: REF, val: REF] = { PutPropOnRef[onto: onto, prop: prop, val: val] }; PutLayerProp: PUBLIC ENTRY PROC[onto: CD.Layer, prop: REF, val: REF] = { ENABLE UNWIND => NULL; CDPrivate.layers[onto].properties^ _ PropertyLists.PutProp[CDPrivate.layers[onto].properties^, prop, val] }; PutPropertyClassProp: ENTRY PROC[onto: PropertyProcs, prop: REF, val: REF] = { ENABLE UNWIND => NULL; IF onto=NIL OR onto.properties=NIL THEN RETURN WITH ERROR CD.Error[other, "nil PropertyProcs"]; onto.properties _ PropertyLists.PutProp[onto.properties, prop, val] }; PutPropOnRef: ENTRY PROC[onto: REF, prop: REF, val: REF] = { <<--a NIL val removes the property>> <<--here onto MUST NOT be a ChipNDale ref pointing to a record with properties,>> <<--since then the properties must be used, not the hash table>> x: REF; found: BOOL; pp: REF CD.PropList; [found, x] _ HashTable.Fetch[atomTab, onto]; IF found THEN pp _ NARROW[x, REF CD.PropList] ELSE { IF prop=NIL THEN RETURN; pp _ NEW[CD.PropList_NIL]; [] _ HashTable.Store[atomTab, onto, pp]; }; pp^ _ PropertyLists.PutProp[pp^, prop, val]; IF pp^=NIL THEN [] _ HashTable.Delete[atomTab, onto]; }; GetRefAnyPropf: PROC [from: REF, prop: REF] RETURNS [REF] = INLINE { <<--NIL if prop is not found>> <<--here from MUST NOT be a ChipNDale ref pointing to a record with properties,>> <<--since then the properties must be used, not the hash table>> x: REF; found: BOOL; pp: REF CD.PropList; [found, x] _ HashTable.Fetch[atomTab, from]; IF NOT found THEN RETURN[NIL]; pp _ NARROW[x, REF CD.PropList]; RETURN [PropertyLists.GetProp[pp^, prop]] }; GetObjectProp: PUBLIC PROC [from: CD.Object, prop: REF] RETURNS [REF] = { ENABLE UNWIND => NULL; RETURN[PropertyLists.GetProp[from.properties, prop]] }; GetInstanceProp: PUBLIC PROC [from: CD.Instance, prop: REF] RETURNS [REF] = { ENABLE UNWIND => NULL; RETURN[PropertyLists.GetProp[from.properties, prop]] }; GetDesignProp: PUBLIC PROC [from: CD.Design, prop: REF] RETURNS [REF] = { ENABLE UNWIND => NULL; RETURN[PropertyLists.GetProp[from.properties^, prop]] }; GetTechnologyProp: PUBLIC PROC [from: CD.Technology, prop: REF] RETURNS [REF] = { ENABLE UNWIND => NULL; RETURN[PropertyLists.GetProp[from.properties^, prop]] }; GetLayerProp: PUBLIC PROC [from: CD.Layer, prop: REF] RETURNS [REF] = { ENABLE UNWIND => NULL; RETURN[PropertyLists.GetProp[CDPrivate.layers[from].properties^, prop]] }; GetAtomProp: PUBLIC ENTRY PROC [from: ATOM, prop: REF] RETURNS [REF] = { ENABLE UNWIND => NULL; RETURN[GetRefAnyPropf[from: from, prop: prop]]; }; <<--property procedures>> Register: PUBLIC PROC [prop: ATOM, procs: PropertyProcsRec, registrationKey: REF] RETURNS [sameProp: ATOM] = { [] _ RegisterProperty[prop, registrationKey]; InstallProcs[prop, procs]; sameProp _ prop; }; InstallProcs: PUBLIC ENTRY PROC [prop: REF, procs: PropertyProcsRec] = { ENABLE UNWIND => NULL; pp: PropertyProcs; IF (pp _ FetchProcs[prop])#NIL THEN { IF procs.exclusive THEN pp.exclusive_TRUE; IF procs.autoRem THEN pp.autoRem_TRUE; IF procs.reserved THEN pp.reserved_TRUE; IF procs.makeCopy#NIL THEN pp.makeCopy _ procs.makeCopy; IF procs.internalWrite#NIL THEN pp.internalWrite _ procs.internalWrite; IF procs.internalRead#NIL THEN pp.internalRead _ procs.internalRead; IF procs.properties#NIL THEN FOR l: PropList _ procs.properties, l.rest WHILE l#NIL DO pp.properties _ PropertyLists.PutProp[pp.properties, l.first.key, l.first.val]; ENDLOOP; } }; FetchProcs: PUBLIC PROC [prop: REF] RETURNS [pp: PropertyProcs] = { pp _ NARROW[HashTable.Fetch[propertyNameTab, prop].value]; }; CopyVal: PUBLIC PROC [prop: REF, val: REF, purpose: REF] RETURNS [valCopy: REF] = { valCopy _ val; }; DontCopy: PUBLIC PROC [prop: REF, val: REF, purpose: REF] RETURNS [nil: REF_NIL] = { }; PutOn: PROC [putOnto: REF, propList: PropList] = { <<--dangerous procedure; might crash>> WITH putOnto SELECT FROM a: CD.Instance => a.properties _ propList; o: CD.Object => o.properties _ propList; pr: CD.PropRef => pr^ _ propList; d: CD.Design => d.properties^ _ propList; t: CD.Technology => t.properties^ _ propList; class: REF CD.ObjectClass => class.properties^ _ propList; pp: PropertyProcs => pp.properties _ propList; at: ATOM => ERROR; ENDCASE => ERROR Err }; CopyProps: PUBLIC ENTRY PROC [propList: PropList, putOnto: REF, purpose: REF_NIL] = { ENABLE UNWIND => NULL; PutOn[putOnto, InternalDangerousCopyProps[propList, purpose] ! RuntimeError.UNCAUGHT => GOTO crashed]; EXITS crashed => RETURN WITH ERROR Err }; AppendProps: PUBLIC ENTRY PROC [winner, looser: PropList_NIL, putOnto: REF, purpose: REF_NIL] = { ENABLE UNWIND => NULL; PutOn[putOnto, InternalDangerousAppendProps[winner, looser, purpose] ! RuntimeError.UNCAUGHT => GOTO crashed] EXITS crashed => RETURN WITH ERROR Err }; <<>> DCopyProps: PUBLIC ENTRY PROC [propList: PropList, purpose: REF] RETURNS [copy: PropList_NIL] = { ENABLE UNWIND => NULL; copy _ InternalDangerousCopyProps[propList, purpose] }; DAppendProps: PUBLIC ENTRY PROC [winner, looser: CDProperties.PropList, purpose: REF] RETURNS [copy: CDProperties.PropList] = { ENABLE UNWIND => NULL; copy _ InternalDangerousAppendProps[winner, looser, purpose] }; InternalDangerousCopyProps: PROC [propList: PropList, purpose: REF] RETURNS [copy: PropList_NIL] = { FOR l: PropList _ propList, l.rest WHILE l#NIL DO copy _ InternalCopyItem[copy, l.first, purpose] ENDLOOP; }; InternalDangerousAppendProps: PROC [winner, looser: CDProperties.PropList, purpose: REF] RETURNS [copy: CDProperties.PropList] = { copy _ InternalDangerousCopyProps[looser, purpose]; FOR l: PropList _ winner, l.rest WHILE l#NIL DO copy _ InternalCopyItem[copy, l.first, purpose] ENDLOOP; }; InternalCopyItem: PROC[list: CDProperties.PropList, item: PropertyLists.KeyVal, purpose: REF] RETURNS [newList: CDProperties.PropList] = { class: CDProperties.PropertyProcs = FetchProcs[item.key]; IF class#NIL AND class.makeCopy#NIL THEN { newVal: REF = class.makeCopy[prop: item.key, val: item.val, purpose: purpose]; IF newVal=NIL THEN newList _ list ELSE newList _ PropertyLists.PutProp[list, item.key, newVal]; } ELSE IF ISTYPE[item.key, ATOM] AND item.val#NIL THEN WITH item.val SELECT FROM r: Rope.ROPE => newList _ PropertyLists.PutProp[list, item.key, r]; at: ATOM => newList _ PropertyLists.PutProp[list, item.key, at]; ri: REF INT => newList _ PropertyLists.PutProp[list, item.key, NEW[INT_ri^]]; pl: CD.PropList => newList _ PropertyLists.PutProp[list, item.key, InternalDangerousCopyProps[pl, purpose]]; rl: LIST OF Rope.ROPE => newList _ PropertyLists.PutProp[list, item.key, RopeList.CopyTopList[rl]]; ENDCASE => newList _ list ELSE newList _ list; }; DoWithinLock: PUBLIC ENTRY PROC [p: PROC] = { ENABLE { UNWIND => NULL; RuntimeError.UNCAUGHT => IF UserProfile.Boolean["ChipNDale.CatchLowLevelErrors", TRUE] THEN CONTINUE; }; IF p#NIL THEN p[]; }; <<>> RopePWrite: PUBLIC PROC [h: TokenIO.Handle, prop: REF, val: REF] = { WITH val SELECT FROM r: Rope.ROPE => TokenIO.WriteRope[h, r]; at: ATOM => TokenIO.WriteRope[h, Atom.GetPName[at]]; ENDCASE => TokenIO.WriteRope[h, "bad property value"]; }; AtomPWrite: PUBLIC PROC [h: TokenIO.Handle, prop: REF, val: REF] = { WITH val SELECT FROM at: ATOM => TokenIO.WriteAtom[h, at]; r: Rope.ROPE => TokenIO.WriteAtom[h, Atom.MakeAtom[r]]; ENDCASE => TokenIO.WriteAtom[h, $Bad]; }; IntPWrite: PUBLIC PROC [h: TokenIO.Handle, prop: REF, val: REF] = { WITH val SELECT FROM ri: REF INT => TokenIO.WriteInt[h, ri^]; rc: REF CARDINAL => TokenIO.WriteInt[h, rc^]; rn: REF NAT => TokenIO.WriteInt[h, rn^]; ENDCASE => TokenIO.WriteInt[h, 0]; }; SomePWrite: PUBLIC PROC [h: TokenIO.Handle, prop: REF, val: REF] = { WITH val SELECT FROM at: ATOM => TokenIO.WriteAtom[h, at]; r: Rope.ROPE => TokenIO.WriteRope[h, r]; ri: REF INT => TokenIO.WriteInt[h, ri^]; rc: REF CARDINAL => TokenIO.WriteInt[h, rc^]; rn: REF NAT => TokenIO.WriteInt[h, rn^]; ENDCASE => TokenIO.WriteAtom[h, $Unknown]; }; RopePRead: PUBLIC PROC [h: TokenIO.Handle, prop: ATOM] RETURNS [val: REF] = { val _ TokenIO.ReadRope[h] }; AtomPRead: PUBLIC PROC [h: TokenIO.Handle, prop: ATOM] RETURNS [val: REF] = { val _ TokenIO.ReadAtom[h] }; IntPRead: PUBLIC PROC [h: TokenIO.Handle, prop: ATOM] RETURNS [val: REF] = { val _ NEW[INT_TokenIO.ReadInt[h]] }; SomePRead: PUBLIC PROC [h: TokenIO.Handle, prop: ATOM] RETURNS [val: REF] = { t: TokenIO.Token _ TokenIO.Read[h]; WITH t SELECT FROM int: TokenIO.Token.int => val _ NEW[INT_int.value]; rope: TokenIO.Token.rope => val _ rope.value; atom: TokenIO.Token.atom => val _ atom.value; ENDCASE => val _ $Error; }; <<-------------------------->> GetPropProp: PUBLIC PROC [from: REF, key1, key2: REF_] RETURNS [REF] = { WITH GetProp[from, key1] SELECT FROM pl: PropertyLists.PropList => RETURN [PropertyLists.GetProp[pl, key2]]; ENDCASE => RETURN [NIL]; }; PutPropProp: PUBLIC PROC [onto: REF, key1, key2: REF_, val: REF_NIL] = { WITH GetProp[onto, key1] SELECT FROM pl: CD.PropList => { pl1: PropertyLists.PropList _ PropertyLists.PutProp[pl, key2, val]; IF pl1#pl THEN PutProp[onto, key1, pl1]; } ENDCASE => PutProp[onto, key1, PropertyLists.PutProp[NIL, key2, val]] }; <<>> <<-------------------------->> <<--now some special properties>> TiogaPCopy: PROC [prop: REF, val: REF, purpose: REF] RETURNS [copy: REF] = { contents, formatting: Rope.ROPE _ NIL; WITH val SELECT FROM t: ViewerTools.TiogaContents => {contents _ t.contents; formatting _ t.formatting}; r: Rope.ROPE => contents _ r; ENDCASE => contents _ "$Error"; copy _ NEW[ViewerTools.TiogaContentsRec_[contents: contents, formatting: formatting]] }; TiogaPWrite: PROC [h: TokenIO.Handle, prop: REF, val: REF] = { contents, formatting: Rope.ROPE _ NIL; WITH val SELECT FROM t: ViewerTools.TiogaContents => {contents _ t.contents; formatting _ t.formatting}; r: Rope.ROPE => contents _ r; ENDCASE => NULL; TokenIO.WriteRope[h, contents]; TokenIO.WriteRope[h, formatting]; }; TiogaPRead: PROC [h: TokenIO.Handle, prop: ATOM] RETURNS [val: REF] = { contents: Rope.ROPE _ TokenIO.ReadRope[h]; formatting: Rope.ROPE _ TokenIO.ReadRope[h]; val _ NEW[ViewerTools.TiogaContentsRec_[contents: contents, formatting: formatting]] }; <<>> Atomize: PROC [r: Rope.ROPE] RETURNS [ATOM_NIL] = { IF Rope.Length[r]>1 AND Rope.Fetch[r]='$ THEN r _ Rope.Substr[r, 1, Rope.Length[r]-1]; IF ~Rope.IsEmpty[r] THEN RETURN [Atom.MakeAtom[r]] }; IsExclusive: PUBLIC PROC [key: REF] RETURNS [BOOL_TRUE] = { pType: CDProperties.PropertyProcs ~ CDProperties.FetchProcs[key]; RETURN [pType#NIL AND pType.exclusive] }; associationRoot: CDProperties.PropRef _ CDProperties.InitPropRef[]; RemoveProperties: PUBLIC PROC[key: ATOM] = { <<--not entry!>> RemovePropFromRegistrations: PROC [atom: ATOM] = { WITH GetProp[associationRoot, atom] SELECT FROM lora: LIST OF REF ANY => { FOR l: LIST OF REF ANY _ lora, l.rest WHILE l#NIL DO WITH l.first SELECT FROM a: ATOM => { IF ~IsExclusive[a] THEN PutAtomProp[atom, a, NIL]; PutAtomProp[a, atom, NIL]; } ENDCASE => NULL; ENDLOOP; }; ENDCASE => NULL; }; RemovePropFromLayers: PROC [atom: ATOM] = { FOR l: CD.Layer IN CD.Layer DO reg: ATOM _ CD.LayerKey[l]; IF reg#NIL THEN { PutAtomProp[atom, reg, NIL]; PutAtomProp[reg, atom, NIL]; }; PutLayerProp[l, atom, NIL]; ENDLOOP; }; IF ~IsExclusive[key] THEN { PutAtomProp[key, key, NIL]; RemovePropFromRegistrations[key]; RemovePropFromLayers[key]; }; }; RemovePropCommand: Commander.CommandProc = { <<--Allows to do un-registration from commandfiles which may run>> <<--before the tool they are un-registrating >> <<--This command is handy for lots of tools which set op their parameters with command file >> FOR rl: LIST OF Rope.ROPE _ CommandTool.ParseToList[cmd].list, rl.rest WHILE rl#NIL DO atom: ATOM _ Atomize[rl.first]; --this atoms registrations should be removed IF IsExclusive[atom] THEN msg _ Rope.Cat[msg, " ", rl.first, " not removed (no or exclusive atom)\n"] ELSE RemoveProperties[atom]; ENDLOOP; }; Associate: PUBLIC PROC [key, a: ATOM] = { <<--not entry!>> IF ~IsExclusive[a] AND ~IsExclusive[key] THEN { list: LIST OF REF ANY _ WITH GetProp[associationRoot, key] SELECT FROM lora: LIST OF REF ANY => lora, ENDCASE => NIL; IF ~List.Memb[a, list] THEN { new: LIST OF REF ANY _ List.Nconc1[list, a]; IF new#list THEN PutProp[associationRoot, key, new]; }; }; }; AssociatePropCommand: Commander.CommandProc = { key: ATOM _ NIL; rl: LIST OF Rope.ROPE _ CommandTool.ParseToList[cmd].list; IF rl=NIL OR IsExclusive[key_Atomize[rl.first]] THEN { msg _ "no or exclusive key\n"; result _ $Failure; RETURN }; IF rl.rest=NIL THEN { msg _ "no properties to associate with key\n"; result _ $Failure; RETURN }; FOR l: LIST OF Rope.ROPE _ rl.rest, l.rest WHILE l#NIL DO a: ATOM _ Atomize[l.first]; IF IsExclusive[a] THEN msg _ Rope.Cat[msg, l.first, " not allowed\n"] ELSE Associate[key, a]; ENDLOOP; }; Commander.Register[ key: "///ChipNDale/CDRemoveRegistration", --used by ChipNDale command files only proc: RemovePropCommand, doc: "removes properties from all ChipNDale layers" ]; Commander.Register[ key: "///ChipNDale/CDAssociateRegistration", --used by ChipNDale command files only proc: AssociatePropCommand, doc: "associate ChipNDale properties for removal" ]; <<--does not really belong into this module>> [] _ CDProperties.RegisterProperty[$SignalName]; [] _ CDProperties.RegisterProperty[$InstanceName]; [] _ CDProperties.RegisterProperty[$Tioga]; CDProperties.InstallProcs[prop: $SignalName, procs: CDProperties.PropertyProcsRec[ makeCopy: CDProperties.CopyVal, internalWrite: CDProperties.RopePWrite, internalRead: CDProperties.RopePRead ]]; CDProperties.InstallProcs[prop: $InstanceName, procs: CDProperties.PropertyProcsRec[ makeCopy: CDProperties.CopyVal, internalWrite: CDProperties.RopePWrite, internalRead: CDProperties.RopePRead ]]; CDProperties.InstallProcs[prop: $Tioga, procs: CDProperties.PropertyProcsRec[ makeCopy: TiogaPCopy, internalWrite: TiogaPWrite, internalRead: TiogaPRead ]]; END.