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
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;
PUBLIC ERROR
CantEstablishFinalization: PUBLIC ERROR [type: Type] = CODE;
Private variables
typeExtensions: RTypeExtension ← NIL;
PUBLIC procedures
Finalization of collectible objects; type attachments
EstablishFinalization: PUBLIC ENTRY SAFE PROC
[type: Type, npr: [0..maxNPackageRefs], fq: FinalizationQueue] =
TRUSTED {
ENABLE UNWIND => NULL;
cType: Type = GetCanonicalType[type];
ptd: PTypeDesc ← MapTiTd[cType];
NOTE beware of LOOPHOLED sharing!!
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];
NOTE beware of LOOPHOLED sharing!!
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]];
NOTE beware of LOOPHOLED sharing!!
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]];
NOTE beware of LOOPHOLED sharing!!
IF ptd.extension = NIL
THEN RETURN[NIL]
ELSE RETURN[LOOPHOLE[ptd.extension, RTypeExtension].attachment];
};
PRIVATE procedures
CreateTypeExtension: INTERNAL PROC RETURNS[PTypeExtension] = {
ENABLE UNWIND => NULL;
rte: RTypeExtension = NEW[TypeExtension ← [next: typeExtensions]];
typeExtensions ← rte;
RETURN[LOOPHOLE[rte, PTypeExtension]]};
BEWARE NOTE this will be shared, and not w/ REFs
END.