DIRECTORY Atom, HashTable, PropertyLists, SafeStorage, Values; ValuesImpl: CEDAR MONITOR IMPORTS Atom, PropertyLists, SafeStorage, HashTable EXPORTS Values SHARES HashTable = BEGIN StoreProc: TYPE = Values.StoreProc; FetchProc: TYPE = Values.FetchProc; InsertProc: TYPE = Values.InsertProc; PropagateProc: TYPE = Values.PropagateProc; TypeTab: TYPE = PACKED ARRAY SafeStorage.TypeIndex OF REF; typeTab: REF TypeTab _ SafeStorage.GetPermanentZone[].NEW[TypeTab_ALL[NIL]]; keyTab: HashTable.Table ~ HashTable.Create[51]; NotRegisteredType: PUBLIC SIGNAL = CODE; ReRegistration: PUBLIC ERROR = CODE; Reg: TYPE = REF RegRec; RegRec: TYPE = RECORD [ store: StoreProc _ NilStore, fetch: FetchProc _ NilFetch, insert: InsertProc _ DefaultInsert, propagate: PropagateProc _ NilPropagate, occupied: BOOL _ FALSE, registrationKey: REF _ NIL, prop: PropertyLists.PropList _ NIL ]; NilStore: StoreProc = {}; NilFetch: FetchProc = {}; NilPropagate: PropagateProc = {}; retry: CONDITION; Enter: ENTRY PROC [r: Reg] = { ENABLE UNWIND => NULL; WHILE r.occupied DO WAIT retry ENDLOOP; r.occupied _ TRUE }; Leave: ENTRY PROC [r: Reg] = { ENABLE UNWIND => NULL; r.occupied _ FALSE; BROADCAST retry }; DefaultInsert: InsertProc = { r: Reg _ GetReg[onto]; IF r=NIL THEN SIGNAL NotRegisteredType ELSE { ENABLE UNWIND => Leave[r]; Enter[r]; IF done _ r.fetch[onto, key]=NIL THEN r.store[onto, key, val]; Leave[r]; } }; GetReg: PROC [from: REF] RETURNS [Reg] = INLINE { WITH typeTab[SafeStorage.GetCanonicalReferentType[from]] SELECT FROM r: Reg => RETURN [r]; ENDCASE => RETURN [NIL]; }; Store: PUBLIC PROC [onto: REF, key: REF, val: REF_NIL] = { r: Reg _ GetReg[onto]; IF r=NIL THEN SIGNAL NotRegisteredType ELSE r.store[onto, key, val] }; Insert: PUBLIC PROC [onto: REF, key: REF, val: REF] RETURNS [done: BOOL_FALSE] = { r: Reg _ GetReg[onto]; IF r=NIL THEN SIGNAL NotRegisteredType ELSE done _ r.insert[onto, key, val] }; Fetch: PUBLIC PROC [from: REF, key: REF, propagate: BOOL_TRUE] RETURNS [val: REF_NIL] = { DO r: Reg _ GetReg[from]; IF r=NIL THEN {propagate_FALSE; SIGNAL NotRegisteredType} ELSE val _ r.fetch[from, key]; IF val#NIL OR ~propagate THEN RETURN; from _ r.propagate[from]; IF from=NIL THEN RETURN ENDLOOP }; Propagate: PUBLIC PROC [from: REF] RETURNS [to: REF_NIL] = { r: Reg _ GetReg[from]; IF r=NIL OR from=NIL THEN SIGNAL NotRegisteredType ELSE to _ r.propagate[from] }; RegisterKey: PUBLIC ENTRY PROC [key: REF, registrationKey: REF _ NIL] = { ENABLE UNWIND => NULL; x: REF _ keyTab.Fetch[key].value; IF registrationKey=NIL THEN registrationKey _ keyTab; IF x=NIL THEN [] _ keyTab.Store[key, registrationKey] ELSE IF x=registrationKey THEN RETURN WITH ERROR ReRegistration }; RegisterType: PUBLIC ENTRY PROC [referentType: SafeStorage.Type, store: StoreProc _ NIL, fetch: FetchProc _ NIL, insert: InsertProc _ NIL, propagate: PropagateProc _ NIL, registrationKey: REF _ NIL] = { ENABLE UNWIND => NULL; r: Reg_NIL; pl: PropertyLists.PropList_NIL; referentType _ SafeStorage.GetCanonicalType[referentType]; WITH typeTab[referentType] SELECT FROM rr: Reg => r _ rr; rpl: PropertyLists.PropList => pl _ rpl ENDCASE; IF r=NIL THEN r _ typeTab[referentType] _ NEW[RegRec_[registrationKey: registrationKey, prop: pl]] ELSE IF registrationKey=NIL OR registrationKey#r.registrationKey THEN RETURN WITH ERROR ReRegistration; IF store#NIL THEN r.store _ store; IF fetch#NIL THEN r.fetch _ fetch; IF insert#NIL THEN r.insert _ insert; IF propagate#NIL THEN r.propagate _ propagate; }; ErrStore: StoreProc = {ERROR}; ErrFetch: FetchProc = {ERROR}; ErrInsert: InsertProc = {ERROR}; RPLFetch: FetchProc = { pl: PropertyLists.PropList _ NARROW[from]; val _ PropertyLists.GetProp[pl, key]; }; PLFetch: FetchProc = { val _ PropertyLists.GetProp[NARROW[from], key]; }; APLFetch: FetchProc = { val _ Atom.GetPropFromList[NARROW[from], key]; }; HStore: StoreProc = { IF val#NIL THEN [] _ HashTable.Store[NARROW[onto], key, val] ELSE [] _ HashTable.Delete[NARROW[onto], key] }; HFetch: FetchProc = { val _ HashTable.Fetch[NARROW[from], key].value; }; HInsert: InsertProc = { IF val#NIL THEN [done] _ HashTable.Insert[NARROW[onto], key, val] }; atomTab: HashTable.Table ~ HashTable.Create[17]; AStore: ENTRY StoreProc = { ENABLE UNWIND => NULL; pl, npl: PropertyLists.PropList; pl _ NARROW[atomTab.Fetch[onto].value]; --no crash: proc is not called if onto not atom npl _ PropertyLists.PutProp[pl, key, val]; IF pl#npl THEN [] _ atomTab.Store[onto, npl] }; AInsert: ENTRY InsertProc = { ENABLE UNWIND => NULL; pl, npl: PropertyLists.PropList; pl _ NARROW[atomTab.Fetch[onto].value]; IF done _ PropertyLists.GetProp[pl, key]=NIL THEN { npl _ PropertyLists.PutProp[pl, key, val]; IF pl#npl THEN [] _ atomTab.Store[onto, npl] } }; AFetch: FetchProc = { pl: PropertyLists.PropList ~ NARROW[atomTab.Fetch[from].value]; val _ PropertyLists.GetProp[pl, key]; }; TStore: ENTRY StoreProc = { ENABLE UNWIND => NULL; tr: SafeStorage.Type; tr _ NARROW[onto, REF SafeStorage.Type]^; --no crash: proc is not called if onto wrong type WITH typeTab[tr] SELECT FROM pl: PropertyLists.PropList => typeTab[tr] _ PropertyLists.PutProp[pl, key, val]; r: Reg => r.prop _ PropertyLists.PutProp[r.prop, key, val]; ENDCASE => typeTab[tr] _ PropertyLists.PutProp[NIL, key, val]; }; TInsert: ENTRY InsertProc = { ENABLE UNWIND => NULL; tr: SafeStorage.Type; tr _ NARROW[onto, REF SafeStorage.Type]^; WITH typeTab[tr] SELECT FROM pl: PropertyLists.PropList => IF done _ PropertyLists.GetProp[pl, key]=NIL THEN typeTab[tr] _ PropertyLists.PutProp[pl, key, val]; r: Reg => IF done _ PropertyLists.GetProp[r.prop, key]=NIL THEN r.prop _ PropertyLists.PutProp[r.prop, key, val]; ENDCASE => typeTab[tr] _ PropertyLists.PutProp[NIL, key, val]; }; TFetch: FetchProc = { WITH typeTab[NARROW[from, REF SafeStorage.Type]^] SELECT FROM pl: PropertyLists.PropList => val _ PropertyLists.GetProp[pl, key]; rr: Reg => val _ PropertyLists.GetProp[rr.prop, key]; ENDCASE => NULL }; RegisterType[SafeStorage.nullType, ErrStore, ErrFetch, ErrInsert]; RegisterType[SafeStorage.GetCanonicalReferentType[$a], AStore, AFetch, AInsert]; RegisterType[CODE[SafeStorage.Type], TStore, TFetch, TInsert]; RegisterType[CODE[HashTable.TableRec], HStore, HFetch, HInsert]; RegisterType[SafeStorage.GetCanonicalReferentType[PropertyLists.PutProp[NIL, $a, $a]], ErrStore, PLFetch, ErrInsert]; RegisterType[CODE[PropertyLists.PropList], ErrStore, RPLFetch, ErrInsert]; RegisterType[SafeStorage.GetCanonicalReferentType[Atom.PutPropOnList[NIL, $a, $a]], ErrStore, APLFetch, ErrInsert]; END. €ValuesImpl.mesa Copyright c 1986 by Xerox Corporation. All rights reserved. Created by Christian Jacobi, July 25, 1986 3:47:50 pm PDT Last Edited by: Jacobi July 28, 1986 1:02:21 pm PDT MONITOR invariants Never crash inside monitor [not even if unwind is used], because we want allow independent clients to make calls on different types Fetch, Store, Insert, Propagate, DefaultInsert are not monitored; Otherwise, a client could cause a wedge by recursively using Values again. --some pre-registered clients --they all don't propagate --Catch usage of NIL --PropertyLists --only fetch is allowed; supported only for nice propagations --HashTables --must not be monitored, since could crash in HashTable client code --Atoms --use of own mechanism to guarantee uniqueness of registered keys --Types --the main reason why types are included, is to make better use of the huge --array declared anyway for the registrations Κ 1˜codešœ™Kšœ Οmœ1™Kšœ ˜ K˜—K˜—K˜š  œžœžœžœ žœ˜1šžœ5žœž˜DKšœ žœ˜Kšžœžœžœ˜—Kšœ˜—K˜š  œž œžœžœžœžœ˜:Kšœ˜Kšžœžœžœžœ˜&Kšžœ˜Kšœ˜K˜—š œž œžœžœžœžœžœžœ˜RKšœ˜Kšžœžœžœžœ˜&Kšžœ ˜$Kšœ˜K˜—š œž œžœžœ žœžœžœžœžœ˜Yšž˜Kšœ˜Kš žœžœžœ žœžœ˜9Kšžœ˜Kš žœžœžœ žœžœ˜%Kšœ˜Kšžœžœžœž˜Kšž˜—K˜K˜—š   œž œžœžœžœžœ˜Kšœ žœ/˜@KšœHžœ*˜uKšœ žœ9˜JKšœEžœ+˜sKšžœ˜J˜—…—¦'{