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. tRTTypesBasicExtensionImpl.mesa Last Modified On August 8, 1983 10:23 am by Paul Rovner private variables PUBLIC procedures Finalization of collectible objects; type attachments NOTE beware of LOOPHOLED sharing!! NOTE beware of LOOPHOLED sharing!! Use this to arm the finalization mechanism for the specified object after establishing its package refs. NOTE beware of LOOPHOLED sharing!! NOTE beware of LOOPHOLED sharing!! called only by the collector. NOTE this does no RC operations because if PutForFinalization succeeds the count is already correct PRIVATE procedures BEWARE NOTE this will be shared, and not w/ REFs ÊߘJšœ™šœ8™8J˜šÏk ˜ šœ˜ Jšœœ˜(—šœ ˜JšœX˜X—šœ˜JšœD˜D——J˜JšœœÏc#˜GJ˜Jšœ*˜1J˜Jšœ#˜*J˜Jšœœœ"˜.J˜šœ™Jšœ!œ˜%—J˜Jšœ™J˜šœ5™5š Ïnœœœœ˜-Jšœ@˜@—šœ˜ Jšœœœ˜Jšœ%˜%Jšœ ˜ Jšœ"™"šœ˜JšœA˜E—š œœœœ!˜KJšœœ!˜+—JšœN˜NJšœ2œ˜GJšœ˜—J˜š Ÿœœœœ˜/Jšœ@˜@—šœ˜ Jšœœœ˜Jšœ%˜%Jšœ ˜ Jšœ"™"šœ˜Jšœœ!˜+—J˜šœ˜Jšœ&˜(Jšœ!˜&—Jšœœ!˜+J˜Jšœ2œ˜GJšœ˜—˜Jšœh™h—šŸœœœœœœœœ˜CJ™—JšŸœœœœ œžœœ˜SJšœœœ˜0J˜JšŸœœœœœœœ˜BJšœœœ ž'˜YJ˜Jš Ÿœœœœœœ˜CJšœœœ˜.J˜JšŸœœœœœœœ˜Lšœ˜ Jšœœœ˜Jšœ1˜1Jšœ"™"šœœ˜JšœD˜H—Jšœ8˜@Jšœ˜—J˜JšŸœœœœœœœœ˜Išœ˜ Jšœœœ˜Jšœ1˜1Jšœ"™"šœ˜Jšœœœ˜Jšœœœ,˜@—Jšœ˜—J˜Jšœ=™=JšœC™CšŸœœœœœœœ˜TJšœ˜Jšœ œ˜ šœ˜ Jšœ˜Jšœœ/˜?Jšœœ˜ —Jšœœ"˜,Jšœ˜—J˜Jšœ™šŸœœœœ˜>Jšœœœ˜Jšœœ)˜BJšœ˜šœœ˜'Jšœ0™0———J˜Jšœ˜J˜——…— ˆÛ