⟦2de599fd0⟧

E3 Source Code



package Disk_Space is

    type Acceptable is (Any_Space, Any_Permanent_Space,
                        Committed_Permanent_Spaces,
                        Undeleted_Committed_Permanent_Spaces);

    type Traversals is (Poly_File_Space, Directory_Space, Eedb_Space,
                        Constant_Space, Moribund_Space, Backup_Database_Space);

    type Traversing is array (Traversals) of Boolean;

    All_Traversals : constant Traversing := Traversing'(others => True);
    Directory_Only : constant Traversing :=
       Traversing'(Directory_Space => True, others => False);
    No_Traversals  : constant Traversing := Traversing'(others => False);


    -- Possible decodings of a space.
    -- Class (R1000_Native_Code .. R1000_Cross_Code) are instruction spaces.
    -- Class (R1000_Import) is any import space.
    -- Class (Diana_Tree .. Other) are module spaces.
    -- Class (Diana_Tree .. Seg_Heap_Other) are all segmented heaps.
    -- Class (Poly_Text .. oly_Other) are all Polymorphic_Io creations.
    -- Class (Backup_Master .. Backup_Tape) are Backup database spaces.
    -- Class (Garbage) is a garbage collected (by the Disk_Cleaner) space.

    type Class is (R1000_Native_Code, R1000_Cross_Code, R1000_Import,
                   Diana_Tree, Text_File, Image, Link_Pack,
                   Poly_Text, Poly_Object_Id, Poly_State, Poly_Other,
                   Backup_Id, Backup_Backup, Backup_Processor,
                   Backup_Disk, Backup_Tape, Backup_Master,
                   Configuration, Seg_Heap_Other, Garbage, Other);

    type Classes is array (Class) of Boolean;

    All_Classes     : constant Classes := Classes'(others => True);
    Module_Classes  : constant Classes := Classes'(R1000_Native_Code => False,
                                                   R1000_Cross_Code  => False,
                                                   R1000_Import      => False,
                                                   others            => True);
    Matching_Class  : constant Classes := Classes'(others => False);
    Unknown_Classes : constant Classes := Classes'(Poly_Other     => True,
                                                   Seg_Heap_Other => True,
                                                   Other          => True,
                                                   others         => False);


    type Space_Kind is (Instruction, Import, Module);
    Data : constant Space_Kind := Module;


    -- Examine_Spaces locates all spaces known to the kernel and discards
    -- any that are either unacceptable or can be reached through one of
    -- the traversals.
    -- The Summarize booleans cause listings of the space counts / sizes to
    -- be printed.  List_Lost causes Space_Information for the unreachable
    -- spaces to be printed.

    procedure Examine_Spaces
                 (Examine        : Traversing := Disk_Space.All_Traversals;
                  Filter        : Acceptable :=
                     Disk_Space.Undeleted_Committed_Permanent_Spaces;
                  Permit         : Classes    := Disk_Space.All_Classes;
                  Summarize_All  : Boolean    := False;
                  Summarize_Lost : Boolean    := True;
                  List_Lost      : Boolean    := False;
                  Verbose        : Boolean    := True);


    -- Attempts to find the name of the object which contains the space
    -- specified, and prints that name.  If the null space is specified
    -- (the default values), then the names of all spaces are printed.
    -- If the directory system is being searched, Vol_Hint /= 0 will
    -- cause the search to attempt to avoid looking on the wrong volume.
    -- Root_Name specifies where the directory system search should begin.

    procedure Name_Space (Vp        : Natural    := 0;
                          Kind      : Space_Kind := Disk_Space.Instruction;
                          Segment   : Natural    := 0;
                          Vol_Hint  : Natural    := 0;
                          Root_Name : String     := "!";
                          Search    : Traversing := Disk_Space.All_Traversals;
                          Verbose   : Boolean    := True);


    -- Searches just as with Name_Space, but will search for any space
    -- with the same Family_Id as the space specified.

    procedure Name_Family (Vp        : Natural    := 0;
                           Kind      : Space_Kind := Disk_Space.Instruction;
                           Segment   : Natural    := 0;
                           Vol_Hint  : Natural    := 0;
                           Root_Name : String     := "!";
                           Search    : Traversing := Disk_Space.All_Traversals;
                           Verbose   : Boolean    := True);


    -- Interpret page 0 of the data segment in various ways.
    -- Instruction spaces don't have data segments, so only useful for Modules.

    procedure Decode_Space (Vp      : Natural    := 0;
                            Kind    : Space_Kind := Disk_Space.Module;
                            Segment : Natural    := 0;
                            Match   : Classes    := Disk_Space.Matching_Class;
                            Verbose : Boolean    := True);



    -- *********************************************************************
    -- Do not use the following commands unless you know what you are doing.
    -- *********************************************************************

    type Mark_Type     is new Natural range 0 .. 1023;
    type Volume_Number is new Natural range 0 .. 31;
    type Block_Number  is new Natural range 0 .. 2 ** 24 - 1;

    type Usage_Array_Type is array (Mark_Type) of Natural;

    type Vol_Bit_Map_Array  is array (Block_Number range <>) of Boolean;
    type Vol_Usage_Array    is array (Block_Number range <>) of Mark_Type;
    type System_Usage_Array is
       array (Volume_Number range <>) of Usage_Array_Type;

    Unable_To_Acquire_Backup_Lock : exception;
    Garbage_Collection_Is_Running : exception;

    function First_Volume return Volume_Number;
    function Last_Volume  return Volume_Number;

    function Find_Storage_Consumed return System_Usage_Array;

    procedure Clean_Cache;

    function Get_Bit_Map (Volume : Volume_Number) return Vol_Bit_Map_Array;

    function Find_Current_Usage (Volume : Volume_Number) return Vol_Usage_Array;

    pragma Subsystem (Commands);
    pragma Module_Name (4, 3935);
end Disk_Space;
DataMuseum.dk

Rational R1000/400

⟦2de599fd0⟧ Ada Source

Derivation

E3 Source Code

E3 Meta Data
