<> <> 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; <> 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 [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]; <> 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]; }; <> 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]]; <> 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]; }; <> <> 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]]; }; <> CreateTypeExtension: INTERNAL PROC RETURNS[PTypeExtension] = { ENABLE UNWIND => NULL; rte: RTypeExtension = NEW[TypeExtension _ [next: typeExtensions]]; typeExtensions _ rte; RETURN[LOOPHOLE[rte, PTypeExtension]]}; <> END.