<> <> <> <> <> 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.