RTTypesBasicExtensionImpl.mesa
Last Modified On August 8, 1983 10:23 am by Paul Rovner
DIRECTORY
RTQueue USING
[New, Dequeue, Empty, Q, qNil, Enqueue],
SafeStorage USING
[GetCanonicalType, FinalizationQueue, maxNPackageRefs, CantEstablishFinalization, Type],
RTTypesBasicPrivate USING
[RTypeExtension, PTypeExtension, PTypeDesc, MapTiTd, TypeExtension];
RTTypesBasicExtensionImpl: MONITOR -- protects list of type extensions
IMPORTS RTQueue, SafeStorage, RTTypesBasicPrivate
EXPORTS SafeStorage, RTTypesBasicPrivate
= BEGIN OPEN SafeStorage, RTTypesBasicPrivate;
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 [1..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];
};
Use this to arm the finalization mechanism for the specified object after establishing its package refs.
EnableFinalization: PUBLIC SAFE PROC[ref: REF ANY] = TRUSTED{NULL};
NewFQ: PUBLIC SAFE PROC[length: CARDINAL ← 10--refs--] RETURNS[FinalizationQueue] =
TRUSTED {RETURN[LOOPHOLE[RTQueue.New[length]]]};
FQNext: PUBLIC SAFE PROC[fq: FinalizationQueue] RETURNS[REF ANY] =
TRUSTED {RETURN[RTQueue.Dequeue[LOOPHOLE[fq]]]}; -- WAITs till there is one if necessary
FQEmpty: PUBLIC SAFE PROC[fq: FinalizationQueue] RETURNS[BOOLEAN] =
TRUSTED {RETURN[RTQueue.Empty[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];
};
called only by the collector. NOTE this does no RC operations
because if PutForFinalization succeeds the count is already correct
PutForFinalization: PUBLIC PROC[type: Type, ref: REF ANY] RETURNS[done: BOOLEAN] = {
ptd: PTypeDesc = MapTiTd[type];
q: RTQueue.Q;
IF ptd = NIL
OR ptd.extension = NIL
OR (q ← LOOPHOLE[ptd.extension.finalizationSet]) = RTQueue.qNil
THEN ERROR;
RETURN[NOT RTQueue.Enqueue[q: q, ref: ref]];
};
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.