DIRECTORY RefQueue USING [New, Dequeue, IsEmpty], SafeStorage USING [GetCanonicalType, FinalizationQueue, maxNPackageRefs, Type], RTTypesBasicPrivate USING [RTypeExtension, PTypeExtension, TypeExtension, PTypeDesc, MapTiTd]; TypesBasicExtensionImpl: MONITOR -- protects list of type extensions IMPORTS RefQueue, SafeStorage, RTTypesBasicPrivate EXPORTS SafeStorage = BEGIN OPEN SafeStorage, RTTypesBasicPrivate; CantEstablishFinalization: PUBLIC ERROR [type: Type] = CODE; typeExtensions: RTypeExtension _ NIL; EstablishFinalization: PUBLIC ENTRY SAFE PROC [type: Type, npr: [0..maxNPackageRefs], fq: FinalizationQueue] = TRUSTED { ENABLE UNWIND => NULL; cType: Type = GetCanonicalType[type]; ptd: PTypeDesc _ MapTiTd[cType]; IF ptd.extension = NIL THEN MapTiTd[type].extension _ ptd.extension _ CreateTypeExtension[]; IF (NOT npr IN [0..maxNPackageRefs]) OR ptd.extension.finalizationSet # NIL THEN RETURN WITH ERROR CantEstablishFinalization[type]; MapTiTd[cType].numberPackageRefs _ npr; MapTiTd[type].numberPackageRefs _ npr; LOOPHOLE[ptd.extension, RTypeExtension].finalizationSet _ LOOPHOLE[fq]; }; ReEstablishFinalization: PUBLIC ENTRY SAFE PROC [type: Type, npr: [0..maxNPackageRefs], fq: FinalizationQueue] = TRUSTED { ENABLE UNWIND => NULL; cType: Type = GetCanonicalType[type]; ptd: PTypeDesc _ MapTiTd[cType]; IF ptd.extension = NIL THEN RETURN WITH ERROR CantEstablishFinalization[type]; IF npr # ptd.numberPackageRefs OR npr # MapTiTd[type].numberPackageRefs OR ptd.extension.finalizationSet = NIL THEN RETURN WITH ERROR CantEstablishFinalization[type]; LOOPHOLE[ptd.extension, RTypeExtension].finalizationSet _ LOOPHOLE[fq]; }; NewFQ: PUBLIC SAFE PROC[length: CARDINAL _ 10--refs--] RETURNS[FinalizationQueue] = TRUSTED { RETURN[[RefQueue.New[length]]]}; FQNext: PUBLIC SAFE PROC[fq: FinalizationQueue] RETURNS[REF ANY] = TRUSTED { RETURN[RefQueue.Dequeue[LOOPHOLE[fq]]]}; -- WAITs till there is one if necessary FQEmpty: PUBLIC SAFE PROC[fq: FinalizationQueue] RETURNS[BOOL] = TRUSTED { RETURN[RefQueue.IsEmpty[LOOPHOLE[fq]]]}; PutTypeAttachment: PUBLIC ENTRY SAFE PROC[type: Type, attachment: REF ANY] = TRUSTED { ENABLE UNWIND => NULL; ptd: PTypeDesc = MapTiTd[GetCanonicalType[type]]; IF ptd.extension = NIL THEN { MapTiTd[type].extension _ ptd.extension _ CreateTypeExtension[]}; LOOPHOLE[ptd.extension, RTypeExtension].attachment _ attachment; }; GetTypeAttachment: PUBLIC ENTRY SAFE PROC [type: Type] RETURNS[REF ANY] = TRUSTED { ENABLE UNWIND => NULL; ptd: PTypeDesc = MapTiTd[GetCanonicalType[type]]; IF ptd.extension = NIL THEN RETURN[NIL] ELSE RETURN[LOOPHOLE[ptd.extension, RTypeExtension].attachment]; }; CreateTypeExtension: INTERNAL PROC RETURNS[PTypeExtension] = { ENABLE UNWIND => NULL; rte: RTypeExtension = NEW[TypeExtension _ [next: typeExtensions]]; typeExtensions _ rte; RETURN[LOOPHOLE[rte, PTypeExtension]]}; END. TypesBasicExtensionImpl.mesa Copyright c 1985 by Xerox Corporation. All rights reserved. Paul Rovner December 6, 1983 10:25 pm Richard Koo July 2, 1984 8:49:46 pm PDT Russ Atkinson (RRA) August 22, 1985 6:11:01 pm PDT PUBLIC ERROR Private variables PUBLIC procedures Finalization of collectible objects; type attachments NOTE beware of LOOPHOLED sharing!! NOTE beware of LOOPHOLED sharing!! NOTE beware of LOOPHOLED sharing!! NOTE beware of LOOPHOLED sharing!! PRIVATE procedures BEWARE NOTE this will be shared, and not w/ REFs Κ˜codešœ™Kšœ Οmœ1™˜OKšœžœE˜^K˜—šœžœΟc#˜EKšžœ+˜2Kšžœ˜Kšœžœžœ"˜.K˜—šœ ™ Kšœžœžœžœ˜Kšžœžœžœ˜Kšœžœ)˜BKšœ˜šžœžœ˜'Kšœ0™0—K˜Kšžœ˜K˜——…— <r