⟦aae5b11cb⟧

E3 Source Code



with Io;
with Daemon;
with Program;
with Error_Reporting;
with Debug_Tools;
with Disk_Daemon;
with Time_Utilities;
use Time_Utilities;

procedure Initialize_Daemons is

    function "=" (L, R : Disk_Daemon.Threshold_Kinds) return Boolean
        renames Disk_Daemon."=";

    subtype Volume_Number is Disk_Daemon.Volume_Number;
    subtype Bytes is Natural;
    Kbyte : constant Bytes := 1024;
    Mbyte : constant Bytes := 1024 * 1024;
    subtype Threshold is Disk_Daemon.Percentage; -- eg, 10 means 10%
    subtype Threshold_Kinds is Disk_Daemon.Threshold_Kinds;
    type Threshold_Array is array (Threshold_Kinds) of Threshold;

    function Min (Volume : Volume_Number) return Bytes is
    begin
        if Volume = 1 then
            return (10 + 25) * Mbyte;
        else
            return 10 * Mbyte;
        end if;

        -- A Suspend threshold corresponding to 1 block is clearly worthless,
        -- regardless of the size of the disk. Thus, you would expect there
        -- to be some minimum absolute number of disk blocks to be included in
        -- the suspend threshold. Assuming you recover from hitting the
        -- suspend threshold by rebooting and elaborating just DDC, the
        -- minimum needs to be higher than 10 Mbytes. You need to account for
        -- swap space for the environment on volume 1.
    end Min;

    function New_Garbage (Consumed : Bytes) return Bytes is
    begin
        return (2 * Consumed) / 100; -- 2% of Consumed

        -- GC has some tables whose size is a linear function of capacity. GC
        -- produces new garbage while it is collecting the old garbage. The
        -- amount of the new garbage is a linear function of capacity. We
        -- assume that GC will produce 2% new garbage for the garbage that it
        -- reclaims.

    end New_Garbage;

    function Suspend (Volume : Volume_Number;  
                      Capacity : Bytes) return Bytes is

        Fixed : constant Bytes := Min (Volume);
        Variable : constant Bytes := 2 * New_Garbage (Capacity);
    begin
        return Fixed + Variable;

        -- Assuming all of Capacity is garbage is clearly pessimistic.  We
        -- leave twice as much space as should be required because (1) failure
        -- to leave enough space results in a restore from backup, and (2) the
        -- procedure for recovering from hitting Suspend is very unfriendly
        -- causing people to end up trying it 2 or 3 times, each wasted
        -- attempt producing more garbage.
    end Suspend;

    function Get_Threshold (Kind : Threshold_Kinds;
                            Volume : Volume_Number;
                            Capacity : Bytes) return Bytes is
    begin
        if Kind = Disk_Daemon.Suspend_System then
            return Suspend (Volume, Capacity);
        else
            declare
                Next_Kind : constant Threshold_Kinds :=
                   Threshold_Kinds'Succ (Kind);
                Next_Amount : constant Bytes :=
                   Get_Threshold (Next_Kind, Volume, Capacity);
                Headroom : constant Bytes := Capacity - Next_Amount;
            begin
                return Next_Amount + New_Garbage (Headroom);

                -- We assume that the headroom is ALL garbage when GC starts,
                -- which is clearly pessimistic.  The formula leaves enough
                -- space for a complete GC cycle started AFTER the threshold
                -- is reached.
            end;
        end if;
    end Get_Threshold;

    function To_Percent (Value : Bytes;  
                         Capacity : Bytes) return Threshold is
    begin
        return Threshold ((Value * 100) / Capacity);
    end To_Percent;

    procedure Set (Volume : Volume_Number;  
                   Capacity : Bytes) is

        Thresholds : Threshold_Array;
        Next_Threshold : Threshold := 0;
    begin
        -- Compute theoretical Thresholds

        for K in Thresholds'Range loop
            Thresholds (K) :=
               To_Percent (Get_Threshold (K, Volume, Capacity), Capacity);
        end loop;

        -- Adjust for at least a 1% difference between thresholds

        for K in reverse Thresholds'Range loop
            if Next_Threshold >= Thresholds (K) then
                Thresholds (K) := Next_Threshold + 1;
            end if;

            Next_Threshold := Thresholds (K);
        end loop;

        -- Preset thresholds to known, legal values

        for K in reverse Thresholds'Range loop
            Disk_Daemon.Set_Threshold
               (Volume, K, 1 + Threshold_Kinds'Pos (Threshold_Kinds'Last) -
                              Threshold_Kinds'Pos (K));
        end loop;

        for K in Thresholds'Range loop
            Disk_Daemon.Set_Threshold (Volume, K, Thresholds (K));
        end loop;
    end Set;
begin
    -- Set Disk Daemon thresholds based on disk capacities

    for Vol in 1 .. 4 loop
        if Disk_Daemon.Exists (Vol) then
            Set (Vol, Disk_Daemon.Capacity (Vol) * Kbyte);
        end if;
    end loop;

    -- Snapshot parameters
    Daemon.Snapshot_Warning_Message (20.0);
    Daemon.Snapshot_Start_Message (False);
    Daemon.Schedule ("Snapshot", 30 * Minute, 15 * Minute);

    -- note that daemons are scheduled by default

    Daemon.Set_Access_List_Compaction;

    begin
        Program.Run_Job
           (S => Program.Current  
                    (Subsystem => "!Commands.System_Maintenance",
                     Unit => "Smooth_Snapshots",
                     Parameters => "",
                     Activity => "!Machine.Release.Current.Activity"),
            Debug => False,
            Context => "$",
            After => 0.0,
            Options => "Name => (Smooth Snapshots)",
            Response => "<PROFILE>");  
    exception
        when others =>
            Error_Reporting.Report_Error
               (Caller => "!Machine.Initialize_Daemons.Smooth_Snapshots",
                Reason => Error_Reporting.Create_Condition_Name
                             ("Unhandled_Exception", Error_Reporting.Problem),
                Explanation => Debug_Tools.Get_Exception_Name (True, True));
    end;
end Initialize_Daemons;
DataMuseum.dk

Rational R1000/400

⟦aae5b11cb⟧ Ada Source

Derivation

E3 Source Code

E3 Meta Data
