
    <<FQImpl.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Paul Rovner, November 9, 1983 10:09 am>>
        <<Richard Koo, July 2, 1984 8:36:22 pm PDT>>
    <<Russ Atkinson (RRA) January 23, 1986 4:29:16 am PST>>

    DIRECTORY
        Allocator USING [NHeaderP],
        AllocatorOps USING [REFToNHP, NHPToREF],
        RCMicrocodeOps USING [ZCTFull],
        RefQueue USING [Queue, IsFull, Enqueue],
        RTTypesBasicPrivate USING [MapTiTd, PTypeDesc, PTypeExtension],
        SafeStorage USING [InvalidType],    -- EXPORT of ClearFinalizedFlag
        ZCT USING [DoEnableFinalization, DisableFinalization, ExpandZCT];

    FQImpl: MONITOR  -- protects nhp.f
        IMPORTS AllocatorOps, RCMicrocodeOps, RefQueue, RTTypesBasicPrivate, SafeStorage, ZCT
        EXPORTS SafeStorage, ZCT
        = BEGIN OPEN Allocator, AllocatorOps, RefQueue, RTTypesBasicPrivate;

    <<Statistics>>
        Count: TYPE = INT;
        takingStatistics: BOOL = TRUE;
        Bump: PROC[p: POINTER TO Count, delta: Count _ 1] =
            <<usage: Bump[@stats.nHandleRCUnderflow];>>
            INLINE {IF takingStatistics THEN p^ _ p^+delta};

        StatsRec: TYPE = RECORD [
            nEnableFinalization: Count _ 0,
            nIsFinalizationEnabled: Count _ 0,
            nTryToQItForFinalization: Count _ 0,
            nZCTFull: Count _ 0,
            nQueueFull: Count _ 0,
            nAlreadyEnabled: Count _ 0
            ];
        stats: StatsRec _ [];  -- the one and only

    EnableFinalization: PUBLIC ENTRY SAFE PROC[ref: REF] = TRUSTED{
        ENABLE UNWIND => NULL;
        Bump[@stats.nEnableFinalization];
        IF ref # NIL THEN {
            nhp: NHeaderP = REFToNHP[ref];
            DO
                IF nhp.f
                    THEN Bump[@stats.nAlreadyEnabled]
                    ELSE {
                        ptd: RTTypesBasicPrivate.PTypeDesc _ MapTiTd[nhp.type];
                        ext: RTTypesBasicPrivate.PTypeExtension = ptd.extension;
                        IF ext = NIL THEN RETURN WITH ERROR SafeStorage.InvalidType[nhp.type];
                        ZCT.DoEnableFinalization[ptd.numberPackageRefs, nhp
                            ! RCMicrocodeOps.ZCTFull => GOTO zctFull];
                        EXITS zctFull => {Bump[@stats.nZCTFull]; ZCT.ExpandZCT[]; LOOP};
                        };
                RETURN;
                ENDLOOP;
            };
        };


    IsFinalizationEnabled: PUBLIC ENTRY SAFE PROC[ref: REF] RETURNS[BOOL] = TRUSTED{
        ENABLE UNWIND => NULL;
        Bump[@stats.nIsFinalizationEnabled];
        RETURN[REFToNHP[ref].f];
        };

    TryToQItForFinalization: PUBLIC ENTRY PROC[nhp: NHeaderP] RETURNS[success: BOOL _ TRUE] = {
        ENABLE UNWIND => NULL;
        ptd: RTTypesBasicPrivate.PTypeDesc _ MapTiTd[nhp.type];
        ext: RTTypesBasicPrivate.PTypeExtension = ptd.extension;
        IF ext # NIL THEN {
            q: Queue = LOOPHOLE[ext.finalizationSet];
            Bump[@stats.nTryToQItForFinalization];
            IF q.IsFull[] THEN {Bump[@stats.nQueueFull]; RETURN[FALSE]};
            ZCT.DisableFinalization[ptd.numberPackageRefs, nhp];
            IF q.Enqueue[NHPToREF[nhp]].full THEN ERROR;
            };
        };

    END.