DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦c1dcbf5e5⟧ Ada Source

    Length: 17408 (0x4400)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Library, seg_027ad1, seg_027c65, seg_027d00, separate Object_Management_System

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦cfc2e13cd⟧ »Space Info Vol 2« 
        └─⟦this⟧ 

E3 Source Code



with Directory;  
with Calendar;
separate (Object_Management_System)
package body Library is

    function Kind (The_Library : Library_Object) return Library_Kind is
    begin
        if The_Library.Subclass = Library_Subclass then
            return The_Library.Kind;
        else
            return Not_A_Library;
        end if;
    end Kind;

    function Image (The_Kind : Library_Kind) return String is
    begin
        case The_Kind is
            when A_Directory =>
                return "Directory";
            when Subsystem_Spec =>
                return "Sub_Spec ";
            when Subsystem_Body =>
                return "Sub_Body ";
            when Not_A_Library =>
                return "         ";
        end case;
    end Image;



    function Is_Directory (The_Library : Library_Object) return Boolean is
    begin
        return Kind (The_Library) = A_Directory;
    end Is_Directory;


    function Is_Subsystem_Spec (The_Library : Library_Object) return Boolean is
    begin
        return Kind (The_Library) = Subsystem_Spec;
    end Is_Subsystem_Spec;


    function Is_Subsystem_Body (The_Library : Library_Object) return Boolean is
    begin
        return Kind (The_Library) = Subsystem_Body;
    end Is_Subsystem_Body;


    function Root return Library_Object is
    begin
        return Library_Object'(Subclass => Library_Subclass,
                               Name => Gs.Value ("/"),
                               Unix_Library => Directory.Traversal.Root,
                               Kind => A_Directory);
    end Root;


    function Home return Library_Object is
        Obj : Directory.Object;
    begin
        Obj := Directory.Traversal.Home;
        return Library_Object'
                  (Subclass => Library_Subclass,
                   Name => Gs.Value (Directory.Naming.Full_Name (Obj)),
                   Unix_Library => Obj,
                   Kind => A_Directory);
    end Home;


    function Enclosing_Library return Library_Object is
        Obj : Directory.Object;
    begin
        Obj := Directory.Traversal.Parent (Set_Of_Object.Parent.Unix_Library);
        return Library_Object'
                  (Subclass => Library_Subclass,
                   Name => Gs.Value (Directory.Naming.Simple_Name (Obj)),
                   Unix_Library => Obj,
                   Kind => Library.A_Directory);
    exception
        when Directory.Non_Existent_Object_Error =>
            return Nil;
    end Enclosing_Library;

    procedure Create (The_Library : in out Library_Object;
                      Name : String;
                      Kind : Library_Kind) is
        Obj : Directory.Object;
    begin
        Directory.Any_Object.Create
           (The_Object => Obj,
            Object_Name => Name,
            Object_Class => Directory.Directory_Class,
            Object_Owner_Permissions => Directory.Statistics.R_W_X_Permission);
        The_Library := Library_Object'(Subclass => Library_Subclass,
                                       Name => Gs.Value (Name),
                                       Unix_Library => Obj,
                                       Kind => Kind);
    exception
        when Directory.Already_Existent_Object_Error =>
            The_Library := Nil;
        when Directory.System_Error =>
            The_Library := Nil;
    end Create;


    function Child (The_Library : Library_Object; Child_Name : String)
                   return Library_Object is
        Obj : Directory.Object := Directory.Traversal.Child
                                     (The_Object => The_Library.Unix_Library,
                                      Child_Name => Child_Name);
    begin
        case Directory.Class (Obj) is
            when Directory.Directory_Class =>
                return Library_Object'
                          (Subclass => Library_Subclass,
                           Name => Gs.Value (Child_Name),
                           Unix_Library =>
                              Directory.Traversal.Child
                                 (The_Object => The_Library.Unix_Library,
                                  Child_Name => Child_Name),
                           Kind => Library.A_Directory);
            when others =>
                return Library_Object'
                          (Subclass => Unix_File_Subclass,
                           Name => Gs.Value (Child_Name),
                           Unix_File => Directory.Traversal.Child
                                           (The_Object =>
                                               The_Library.Unix_Library,
                                            Child_Name => Child_Name));
        end case;
    end Child;


    function Children (The_Library : Library_Object;
                       Subclass : Subclass_Enumeration :=
                          Object_Management_System.Unknown_Subclass)
                      return Iterator is
        It : Iterator;
        Iter : Directory.Iterator;
        Obj : Directory.Object;
        Lo : Library_Object;
        Add : Boolean;
    begin
        Set_Of_Object.Length := 0;
        Directory.Naming.Set_Default_Context
           (The_Context => The_Library.Unix_Library);
        Iter := Directory.Traversal.Children
                   (The_Object => The_Library.Unix_Library);
        while not Directory.Done (Iter) loop
            Obj := Directory.Value (Iter);
            Add := False;
            case Directory.Class (Obj) is
                when Directory.Directory_Class =>
                    Lo := Library_Object'
                             (Subclass => Library_Subclass,
                              Name => Gs.Value
                                         (Directory.Naming.Simple_Name (Obj)),
                              Kind => A_Directory,
                              Unix_Library => Obj);
                    Add := True;
                when Directory.File_Class =>
                    declare
                        Ext : constant String :=
                           Directory.Naming.Extension
                              (Directory.Naming.Simple_Name (Obj));
                        Name : constant String :=
                           Directory.Naming.Simple_Name_Without_Extension (Obj);
                    begin
                        if Ext = "c" then
                            Lo := Library_Object'(Subclass => C_Unit_Subclass,
                                                  Name => Gs.Value (Name),
                                                  C_Kind => C_Unit.C_Body,
                                                  C_State => C_Unit.Source,
                                                  Source_File => Obj,
                                                  Object_File => Directory.Nil,
                                                  Exec_File => Directory.Nil);
                            Add := True;
                        elsif Ext = "h" then
                            Lo := Library_Object'(Subclass => C_Unit_Subclass,
                                                  Name => Gs.Value (Name),
                                                  C_Kind => C_Unit.C_Spec,
                                                  C_State => C_Unit.Source,
                                                  Source_File => Obj,
                                                  Object_File => Directory.Nil,
                                                  Exec_File => Directory.Nil);
                            Add := True;
                        elsif Ext = "o" then
                            Reset (It);
                            while not Done (It) loop
                                Lo := Value (It);
                                if Gs.Image (Lo.Name) = Name and then
                                   not C_Unit.Is_Spec (Lo) then
                                    Set_Of_Object.Element (It).Object_File :=
                                       Obj;
                                    if C_Unit.Is_Main (Lo) and then
                                       C_Unit.Is_Linked (Lo) and then
                                       Calendar.">"
                                          (Directory.Statistics.
                                           Time_Of_Last_Update (Obj),
                                           Directory.Statistics.
                                              Time_Of_Last_Update
                                              (Set_Of_Object.Element (It).
                                               Exec_File)) then
                                        Set_Of_Object.Element (It).C_State :=
                                           C_Unit.Compiled;
                                    else
                                        if C_Unit.Is_Body (Lo) and then
                                           Calendar.">"
                                              (Directory.Statistics.
                                               Time_Of_Last_Update (Obj),
                                               Directory.Statistics.
                                                  Time_Of_Last_Update
                                                  (Set_Of_Object.Element (It).
                                                   Source_File)) then
                                            Set_Of_Object.Element (It).
                                               C_State := C_Unit.Compiled;
                                        end if;
                                    end if;
                                    exit;
                                end if;  
                                Next (It);
                            end loop;
                            if Done (It) then
                                Lo := Library_Object'
                                         (Subclass => Unix_File_Subclass,
                                          Name => Gs.Value (Directory.Naming.
                                                            Simple_Name (Obj)),
                                          Unix_File => Obj);
                                Add := True;
                            end if;
                        elsif Ext = "exe" then
                            Reset (It);
                            while not Done (It) loop
                                Lo := Value (It);
                                if Gs.Image (Lo.Name) = Name and then
                                   not C_Unit.Is_Spec (Lo) then
                                    Set_Of_Object.Element (It).Exec_File := Obj;
                                    Set_Of_Object.Element (It).C_Kind :=
                                       C_Unit.C_Main;
                                    if Calendar.">"
                                          (Directory.Statistics.
                                           Time_Of_Last_Update (Obj),
                                           Directory.Statistics.
                                              Time_Of_Last_Update
                                              (Set_Of_Object.Element (It).
                                               Source_File)) then
                                        Set_Of_Object.Element (It).C_State :=
                                           C_Unit.Linked;
                                    end if;
                                    exit;
                                end if;  
                                Next (It);
                            end loop;
                            if Done (It) then
                                Lo := Library_Object'
                                         (Subclass => Unix_File_Subclass,
                                          Name => Gs.Value (Directory.Naming.
                                                            Simple_Name (Obj)),
                                          Unix_File => Obj);
                                Add := True;
                            end if;
                        else
                            Lo := Library_Object'
                                     (Subclass => Unix_File_Subclass,
                                      Name =>
                                         Gs.Value (Directory.Naming.Simple_Name
                                                      (Obj)),
                                      Unix_File => Obj);
                            Add := True;
                        end if;
                    end;
                when others =>
                    Lo := Library_Object'
                             (Subclass => Unix_File_Subclass,
                              Name => Gs.Value
                                         (Directory.Naming.Simple_Name (Obj)),
                              Unix_File => Obj);
                    Add := True;
            end case;
            if Add then
                Set_Of_Object.Length := Set_Of_Object.Length + 1;
                Set_Of_Object.Element (Set_Of_Object.Length) := Lo;
            end if;
            Directory.Next (Iter);
        end loop;  
        Set_Of_Object.Parent := The_Library;
        Reset (It);
        return It;
    end Children;
end Library;


E3 Meta Data

    nblk1=10
    nid=8
    hdr6=1e
        [0x00] rec0=26 rec1=00 rec2=01 rec3=030
        [0x01] rec0=1d rec1=00 rec2=04 rec3=018
        [0x02] rec0=1b rec1=00 rec2=06 rec3=052
        [0x03] rec0=0e rec1=00 rec2=03 rec3=012
        [0x04] rec0=13 rec1=00 rec2=0a rec3=026
        [0x05] rec0=18 rec1=00 rec2=02 rec3=034
        [0x06] rec0=11 rec1=00 rec2=09 rec3=07c
        [0x07] rec0=0f rec1=00 rec2=07 rec3=066
        [0x08] rec0=10 rec1=00 rec2=0d rec3=070
        [0x09] rec0=0f rec1=00 rec2=10 rec3=062
        [0x0a] rec0=10 rec1=00 rec2=05 rec3=040
        [0x0b] rec0=11 rec1=00 rec2=0f rec3=012
        [0x0c] rec0=05 rec1=00 rec2=0e rec3=018
        [0x0d] rec0=12 rec1=00 rec2=0b rec3=004
        [0x0e] rec0=18 rec1=00 rec2=0c rec3=001
        [0x0f] rec0=00 rec1=00 rec2=00 rec3=000
    tail 0x21721d3d683ad37d8f04f 0x42a00088462060003
Free Block Chain:
  0x8: 0000  00 00 00 3e 80 2f 5f 4c 69 62 72 61 72 79 20 3a  ┆   > /_Library :┆