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 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 ERROR CantEstablishFinalization[type]; IF npr # ptd.numberPackageRefs OR npr # MapTiTd[type].numberPackageRefs OR ptd.extension.finalizationSet = NIL THEN 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 Last Modified On December 6, 1983 10:25 pm by Paul Rovner Last Modified On July 2, 1984 8:49:46 pm PDT by Richard Koo 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 Ê3˜šœ™Jšœ:™:Jšœ;™;—J˜šÏk ˜ Jšœ œ˜'Jšœ œ>˜OJšœœE˜^—šœœÏc#˜EJ˜—šœ+˜2J˜—šœ˜J˜—šœœœ"˜.J˜—šœ ™ Jšœœœœ˜Jšœœœ˜Jšœœ)˜BJšœ˜šœœ˜'Jšœ0™0—J˜Jšœ˜J˜——…—