Новые призраки

// LazyGhost — синглтон, создаваемый при первом обращении и уничтожаемый с задержкой, когда в нём пропадает необходимость.
//
// Например:
// — DLL, удерживаемая в памяти, пока существует хотя бы один работающий с ней объект,
//   и затем висящая ещё 1 минуту на случай, если снова кому-то понадобится.
//
// type
//     LuaScriptState = record
//         state: lua_State;
//         lib: LuaLibAnchor;
//
//         procedure Init;
//         begin
//             LuaLibGhost.Summon(lib);
//             ...
//         end;
//     end;
//
// — Вычисляемые лукап-таблицы, такие как в CRC-алгоритмах.
//
//     function CRC32(data: pointer; size: SizeUint): uint32;
//     var
//         table: CRC32TableAnchor;
//     begin
//         CRC32TableGhost.Summon(table);
//         ...
//     end;
//
// Доработка 1.
// Была неоднозначная багофича с рекурсивными призраками.
// Например, плагины BASS требуют, и удерживают призрак, самой BASS.
// Поэтому если отпустить плагин, то сначала запускался таймер самоуничтожения плагина, по истечении которого плагин выгружался,
// в ходе выгрузки отпускал BASS, и только тогда запускался таймер самоуничтожения BASS.
// Если тот и другая имели таймер выгрузки 30 секунд, то BASS в результате выгружалась через 30+30 вместо ожидаемых 30.
//
// Это не сильно критично, но всё равно неприятно.
// Чтобы этого избежать, теперь запоминается lastTouch — время последнего Summon'а или НЕРЕКУРСИВНОГО Unsummon'а,
// и при рекурсивном Unsummon — UnsummonRecursive, таймер уменьшается на время, прошедшее с lastTouch.
//
// UnsummonRecursive нужно вызывать явно вместо обычного Unsummon, вызываемого автоматически. Например, призраки плагинов вызывают его в деструкторах.
// Если этого не сделать, потенциально будет получено старое поведение с полным сложением таймеров самоуничтожения.
//
// ***
//
// Доработка 2. Предыдущая версия:
// — Работала через статические глобальные переменные.
//   Они приводили к проблемам с призраками, которым необходимо существовать дольше финализации —
//   это и призраки, один из которых зависит от другого, и призраки, используемые fire-and-forget задачами.
//   В зависимости от прихоти компилятора, Session.Finalize с ожиданием этих задач может выполняться после финализации глобальных переменных.
//   В этом случае призраки, статически хранящиеся в глобальных переменных, финализируются из-под носа у всё ещё использующих их потоков.
//
// — Предполагала вызвать в ходе инициализации модуля LazyGhost.Init(MyGhostControl), где MyGhostControl — тип-наследник LazyGhost.InstanceBase.
//   Из-за этого линкер принципиально не мог выбросить неиспользуемых призраков.
//
// Теперь состояние призрака создаётся лениво и с подсчётом ссылок на себя из глобальной нычки и из коллективного бессознательного всех призвавших,
// а MyGhostControl передаётся прямо в Summon.

{$include opts.inc}
unit Framework.LazyGhosts;

{$include non_copyable.inc} {$include logging.inc}

interface

uses
    Framework.Chrono, Framework.Threads, Framework.Exceptions, Framework.Intrinsics, Framework.Strings, Framework.Memory;

type
    pLazyGhost = ^LazyGhost;
    LazyGhost = record
    type
        InstanceBase = class
        protected
            class function NameFancySrc: Noun; virtual;
            constructor CreateGhost; virtual; abstract;
            class function Timeout: umsec; virtual;
            class function ErrorTimeout: umsec; virtual;
        end;
        InstanceClass = class of InstanceBase;

        Anchor = record
            procedure SetMove(var anch: Anchor);
            procedure UnsummonRecursive;
        private
            state: {pState} pointer;
            class operator Initialize(var self: Anchor);
            class operator Finalize(var self: Anchor);
        {$define typ := Anchor} non_copyable
        end;

        function Summon(var anch: Anchor; ctl: InstanceClass): InstanceBase;

    const
        SmallTimeout = umsec(5 * 1000);
        QuiteATimeout = umsec(36 * 1000);

    private const
        CreationFailed = pointer(1);
        LastFakeInstance = CreationFailed;
        StateDestroyed = pointer(1);
        MinTimeout = umsec(100);

    type
        // stateRefcount управляет жизнью State.
        // При создании stateRefcount = 1. При завершении приложения stateRefcount уменьшается на 1.
        //
        // ghostRefcount управляет состоянием призрака. При создании ghostRefcount = 0.
        // Чтобы постоянно не дёргать 2 атомика вместо 1, stateRefcount увеличивается на 1 только при увеличении ghostRefcount с 0 до 1,
        // и stateRefcount уменьшается на 1 только при уменьшении ghostRefcount с 1 до 0.
        //
        // Таким образом, возможные длящиеся значения stateRefcount — только 1 и 2.
        // stateRefcount = 1, ghostRefcount = 0: призрака нет, либо он не имеет ссылок и взведён таймер уничтожения.
        // stateRefcount = 2, ghostRefcount > 0: призрак жив и имеет ссылки.
        // stateRefcount = 1, ghostRefcount > 0: призрак жив и имеет ссылки, но приложение завершается.
        //
        // Возможно специальное состояние instance = CreationFailed.
        // Это либо кэшированная ошибка, либо состояние в ходе перевыбрасывания ошибки всем ожидающим.
        // Например, если призрак создаётся секунду, и за эту секунду его успели ещё 6 раз призвать из разных потоков — ошибка перевыбросится им всем,
        // и затем может быть кэширована на ErrorTimeout, если он задан.
        //
        // Вообще-то кэшировать ошибки нежелательно:
        //
        // «Кеширование создано для того, чтобы сократить время выполнения одной и той же функциональности.
        // Это имеет смысл, когда эта функциональность действительно выполняется многократно.
        // Если пользователь постоянно вызывает одну и ту же функциональность, результатом которой является ошибка,
        // то делает он это не от хорошей жизни. Скорее всего он пытается устранить ошибку, меняя какие-то внешние параметры
        // каждый раз перед вызовом этой функциональности».
        //
        // Но ситуация, когда тяжёлый и часто используемый призрак проваливается в конце своего создания и тем самым генерирует миллион сообщений об ошибках,
        // может быть не менее неприятной.
        // Поэтому по умолчанию ошибки кэшируются (благо это не требует особенных усилий), но максимум на SmallTimeout.

        pState = ^StateRec;
        StateRec = record
            // Защищён lock, но чтение иногда выполняется оптимистично —
            // например, если после InterlockedIncrement(ghostRefcount) > 1 оказывается ещё и instance > LastFakeInstance, то его явно можно использовать сразу.
            instance: InstanceBase;

            lock: ThreadLock;
            hey: ThreadCV; // Сигнализируется при записи instance.
            stateRefcount, ghostRefcount: SizeInt; // Атомарны.
            delayedDestroy: ThreadTimer; // Защищён lock, но внешний Close вызывается без блокировки, иначе дедлокнется Close в TimerCallback.

            // Защищён lock, используется для определения того, должен обработчик таймера выполнить свою работу (delayedDestroyWorking = yes)
            // или тихо выйти (delayedDestroyWorking = no).
            // После выставления таймера нужно выставить delayedDestroyWorking = yes, а перед Close — delayedDestroyWorking = no.
            //
            // В случае instance > LastFakeInstance означает, что работает таймер самоуничтожения.
            // В случае instance = CreationFailed означает, что работает таймер кэширования ошибки.
            delayedDestroyWorking: boolean;

            err: Exception; // Защищена lock.

            // По-хорошему должна быть защищена lock, но иногда ради скорости блокировка опускается —
            // неточности и даже ошибки со временем освобождения не критичны.
            lastTouch: Ticks;

            ctl: InstanceClass; // Только чтение.
            doneBinding: Reference; // Для Session.BindOnDone.
            g: pLazyGhost; // Только чтение; используется только для зануления LazyGhost.state при уничтожении StateRec.

            function Summon(out anch: Anchor): InstanceBase;
            procedure Unsummon;
            procedure UnsummonRecursive;
            procedure HandleZeroRefCount(recursive: boolean);
            procedure Unref;
            class procedure UnrefStatic(param: pointer); static;
            class procedure TimerCallback(param: pointer; var ci: ThreadTimer.CallbackInstance); static;
            class operator Initialize(var self: StateRec);
            class operator Finalize(var self: StateRec);
        end;

    var
        state: pState;

        function CreateState(ctl: InstanceClass): pState;
    {$define typ := LazyGhost} non_copyable
    end;

implementation

uses
    Framework.System;

    class function LazyGhost.InstanceBase.NameFancySrc: Noun;
    var
        s: StringView;
    begin
        s := ViewClassName(ClassType).CutSuffix('Ghost').CutSuffix('.');
        result := Noun.Parse(s.ToString);
    end;

    class function LazyGhost.InstanceBase.Timeout: umsec;
    begin
        result := {$ifdef Debug} SmallTimeout {$else} QuiteATimeout {$endif};
    end;

    class function LazyGhost.InstanceBase.ErrorTimeout: umsec;
    begin
        result := min(Timeout, SmallTimeout);
    end;

    procedure LazyGhost.Anchor.SetMove(var anch: Anchor);
    var
        state: pState;
    begin
        state := self.state;
        if Assigned(state) then state^.Unsummon;
        self.state := Exchange(anch.state, nil);
    end;

    procedure LazyGhost.Anchor.UnsummonRecursive;
    var
        state: pState;
    begin
        state := Exchange(self.state, nil);
        if Assigned(state) then state^.UnsummonRecursive;
    end;

    class operator LazyGhost.Anchor.Initialize(var self: Anchor);
    begin
        self.state := nil;
    end;

    class operator LazyGhost.Anchor.Finalize(var self: Anchor);
    var
        state: pState;
    begin
        state := Exchange(self.state, nil);
        if Assigned(state) then state^.Unsummon;
    end;
{$define typ := LazyGhost.Anchor} non_copyable_impl

    function LazyGhost.Summon(var anch: Anchor; ctl: InstanceClass): InstanceBase;
    var
        state: pState;
    begin
        state := self.state;
        Assert(state <> StateDestroyed, 'LazyGhost уже финализирован');
        if not Assigned(state) then state := CreateState(ctl);
        result := state^.Summon(anch);
    end;

    function LazyGhost.StateRec.Summon(out anch: Anchor): InstanceBase;

        procedure TraceErrorCached(time: umsec);
        begin
            log_trace('Ошибка кэширована на {}.', ftime(time / 1000).ToString);
        end;

    var
        errTimeout: umsec;
        firstSummon: boolean;
    begin
        firstSummon := InterlockedIncrement(ghostRefcount) = 1;
        if firstSummon then InterlockedIncrement(stateRefcount);

        // Точек выхода несколько, в каждой при успехе предполагается выставить anch.state. Так что он выставляется безусловно, а при провале (тьфу-тьфу)
        // зануляется в ходе ансаммона.
        anch.state := @self;
        try
            if firstSummon then
            begin
                // Первый саммон. Варианты:
                // (1) Инстанса вообще не существует, и нужно создать новый.
                // (2) Взведён таймер уничтожения, и нужно попытаться вырвать старый инстанс из его лап.
                // (3) Кэширована ошибка.
                // (4) Произошла гонка с Unsummon, инстанс существует.
                //
                // В случаях (1) и (2) instance = nil, и, видя это, остальные потоки, которые пойдут по ветке refcount > 1, будут ждать, пока этот что-то придумает.
                // В случае (3) instance = CreationFailed.
                // В случае (4) instance > LastFakeInstance.
                //
                // Если создание инстанса провалилось, инстанс выставляется в CreationFailed и запоминается исключение в err, возможно, с кэшированием ошибки.

                lock.Enter;
                try
                    lastTouch := Ticks.Get;

                    // Несмотря на firstSummon, нужна перепроверка на instance > LastFakeInstance (случай 4) на случай, если перед InterlockedIncrement'ом
                    // начинал исполняться Unsummon, но после него заметил, что refcount > 0, и отменился, оставив инстанс в живых.
                    result := instance;
                    if pointer(result) > LastFakeInstance then
                    begin
                        if not delayedDestroyWorking then exit;
                        // При delayedDestroyWorking — идти дальше. Инстанс будет отобран у таймера уничтожения, если он взведён,
                        // так что если он начал срабатывать, то сработает вхолостую.
                        // А даже если это был отголосок отработавшего таймера (таймер не зануляет delayedDestroyWorking), ничего страшного :D.
                        // В идеале в случае, когда это был таймер кэшированной ошибки, можно было бы доуничтожить err, чтобы не висела в памяти почём зря.
                    end
                    // Перевыбросить кэшированную ошибку? (Acquire не проваливается, поэтому ситуация not Assigned(err) здесь невозможна.)
                    else if pointer(result) = CreationFailed then
                        raise err.Clone;
                finally
                    lock.Leave;
                end;

                // Здесь могут быть разные случаи, но отпускание блокировки необходимо в каждом из них:
                //
                // (1) если таймера не существовало, в том числе если он успел сработать, уничтожил инстанс и уничтожился сам,
                //     то нужно отпустить блокировку, чтобы создать инстанс с нуля.
                //
                // (2) если таймер начал срабатывать, то Close будет ждать завершения обработчика таймера, поэтому под блокировкой дедлокнется.
                //
                // Если таймер взведён, но ещё НЕ начал срабатывать, то Close отменит его без ожидания и блокировку отпускать было необязательно,
                // но отличить этот случай без гонки, наверное, невозможно.

                delayedDestroyWorking := no;
                delayedDestroy.Close; // реальная работа в случае (2), или дешёвый no-op, если таймер не работает.
                if not Assigned(result) then
                    try
                        result := ctl.CreateGhost; // реальная работа в случае (1)
                        Assert(pointer(result) > LastFakeInstance);
                    except
                        // Сохранить ошибку для потенциально ждущих её, и/или для кэширования. При кэшировании также выставить таймер её уничтожения.
                        //
                        // При отсутствии кэширования и если ждущих нет, можно было бы ничего не сохранять, но это бесполезная оптимизация,
                        // которая усложнит код — случай «ждущих нет» проверяется по InterlockedDecrement = 0, который выполняется в наружном except. (*no_waiters)
                        lock.Enter;
                        try
                            pointer(instance) := CreationFailed;
                            err.Free(err); // Поскольку err не доуничтожается при отмене таймера кэшированной ошибки, это нужно сделать здесь.
                            err := Exception.Acquire;
                            hey.WakeAll;
                            errTimeout := ctl.ErrorTimeout;
                            if errTimeout > MinTimeout then
                            begin
                                delayedDestroy.Start(@TimerCallback, @self, errTimeout, 0, ctl.NameFancySrc, [ThreadTimer.NonCritical]);
                                delayedDestroyWorking := yes;
                                TraceErrorCached(errTimeout);
                            end;
                        finally
                            lock.Leave;
                        end;
                        raise;
                    end;

                lock.Enter;
                try
                    instance := result;
                    hey.WakeAll;
                    lastTouch := Ticks.Get; // Если создание длилось долго, это будет лучше, чем считать lastTouch'ем начало
                finally
                    lock.Leave;
                end;
            end else
            begin
                // Не первый саммон. Варианты:
                // (1) Инстанс существует (> LastFakeInstance) и читается без блокировки — можно сразу его вернуть.
                // (2) Создание инстанса провалилось, и ошибка запомнена в err. Перевыбросить её.
                // (3) Инстанса ещё не существует — значит, его созданием занимается тот, кому достался первый саммон. Подождать результата.
                lastTouch := Ticks.Get;

                result := instance;
                if pointer(result) > LastFakeInstance then exit;

                lock.Enter;
                try
                    repeat
                        result := instance;
                        if Assigned(result) then break;
                        hey.Wait(lock);
                    until no;

                    if pointer(result) > LastFakeInstance then exit;

                    // Ранее использовалась оптимизация, когда некэшированная ошибка не клонировалась последним ожидающим, а перевыбрасывалась непосредственно,
                    // с занулением поля err. Но это бесполезно, когда ошибка кэшируется, и усложнит код, см. (*no_waiters).
                    Assert(pointer(result) = CreationFailed);
                    raise err.Clone;
                finally
                    lock.Leave;
                end;
            end;
        except
            Finalize(anch);
            raise;
        end;
    end;

    procedure LazyGhost.StateRec.Unsummon;
    begin
        if InterlockedDecrement(ghostRefcount) = 0 then HandleZeroRefCount(no) else lastTouch := Ticks.Get;
    end;

    procedure LazyGhost.StateRec.UnsummonRecursive;
    begin
        if InterlockedDecrement(ghostRefcount) = 0 then HandleZeroRefCount(yes);
    end;

    procedure LazyGhost.StateRec.HandleZeroRefCount(recursive: boolean);
        procedure TraceInstantUnload(var self: StateRec; recursive: boolean);
        begin
            log.Trace('Немедленная выгрузка {M}{}.', IfThen(recursive, ' (рекурсивно)'), {M} FancyString.Parse(self.ctl.NameFancySrc.ToGen));
        end;
    var
        t: TObject;
        timeout: umsec;
    begin
        t := nil;
        lock.Enter;
        try
            // Здесь нужна перепроверка на ghostRefcount = 0, потому что после InterlockedDecrement'а и перед захватом блокировки мог исполниться Summon.
            if ghostRefcount = 0 then
                if pointer(instance) > LastFakeInstance then
                begin
                    Assert(not delayedDestroyWorking);
                    timeout := ctl.timeout;
                    if recursive then timeout := umsecBaseType(timeout).SatSub((Ticks.Get - lastTouch).ToUmsecClamp);
                    if timeout < MinTimeout then
                    begin
                        if log.NeedTrace then TraceInstantUnload(self, recursive);
                        pointer(t) := Exchange(pointer(instance), nil);
                    end else
                        try
                            delayedDestroy.Start(@TimerCallback, @self, timeout, 0, ctl.NameFancySrc, [ThreadTimer.NonCritical]);
                            delayedDestroyWorking := yes;
                        except
                            pointer(t) := Exchange(pointer(instance), nil);
                            raise;
                        end;
                end
                else if pointer(instance) = CreationFailed then
                begin
                    // Сбросить некэшированную ошибку.
                    if not delayedDestroyWorking then
                    begin
                        instance := nil;
                        pointer(t) := Exchange(pointer(err), nil);
                    end;
                end;
        finally
            lock.Leave;
            Unref;
            if Assigned(t) then t.Destroy;
        end;
    end;

    procedure LazyGhost.StateRec.Unref;
    begin
        if InterlockedDecrement(stateRefcount) = 0 then
        begin
            g^.state := StateDestroyed; // Только для ассерта на обращение к финализированному состоянию.
            dispose(@self);
        end;
    end;

    class procedure LazyGhost.StateRec.UnrefStatic(param: pointer);
    begin
        pState(param)^.Unref;
    end;

    class procedure LazyGhost.StateRec.TimerCallback(param: pointer; var ci: ThreadTimer.CallbackInstance);
    var
        state: pState absolute param;
        t: TObject;
    begin
        t := nil;
        state^.lock.Enter;
        try
            if not state^.delayedDestroyWorking then exit;
            pointer(t) := Exchange(pointer(state^.instance), nil);
            if pointer(t) = CreationFailed then pointer(t) := Exchange(pointer(state^.err), nil);
            // Для красоты можно сделать state^.delayedDestroyWorking := no, но не обязательно.
            ci.Close;
        finally
            state^.lock.Leave;
            t.Destroy;
        end;
    end;

    class operator LazyGhost.StateRec.Initialize(var self: StateRec);
    begin
        self.instance := nil;
        self.stateRefcount := 1;
        self.ghostRefcount := 0;
        self.delayedDestroyWorking := no;
        self.err := nil;
    end;

    class operator LazyGhost.StateRec.Finalize(var self: StateRec);
    begin
        self.delayedDestroyWorking := no;
        self.delayedDestroy.Close;
        if pointer(self.instance) > LastFakeInstance then self.instance.Free(self.instance);
        self.err.Free(self.err);
    end;

    function LazyGhost.CreateState(ctl: InstanceClass): pState;
    var
        prev: pState;
    begin
        new(result);
        try
            result^.lock.Init;
            result^.hey.Init;
            result^.ctl := ctl;
            result^.g := @self;
            Session.BindOnDone(result^.doneBinding, @StateRec.UnrefStatic, result);
        except
            dispose(result);
            raise;
        end;
        prev := InterlockedCompareExchange(state, result, nil);
        if Assigned(prev) then
        begin
            dispose(result);
            result := prev;
        end;
    end;
{$define typ := LazyGhost} non_copyable_impl

end.