[Indigo]<Cedar>SafeStorage>TypesBasicExtensionImpl.mesa!1

TypesBasicExtensionImpl.mesa

Last Modified On December 6, 1983 10:25 pm by Paul Rovner

DIRECTORY

RefQueue USING [New, Dequeue, IsEmpty],

SafeStorage USING [GetCanonicalType, FinalizationQueue, maxNPackageRefs, Type],

RTTypesBasicPrivate USING

[RTypeExtension, PTypeExtension, PTypeDesc, MapTiTd, TypeExtension];

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.