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 - metrics - download

⟦968704484⟧ Ada Source

    Length: 6144 (0x1800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Traversal, seg_0269de, seg_027c5b, seg_027cf6, separate Directory

Derivation

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

separate (Directory)
package body Traversal is
    function Root return Object is
        O : Object;
    begin
        Gs.Create (O.Name, "/");
        return O;
    end Root;

    function Home return Object is
        O : Object;
    begin
        Gs.Create (O.Name, Di.Get_Home_Directory);
        return O;
    end Home;


    function Parent (The_Object : Object) return Object is
        O : Object;
    begin
        if The_Object /= Root then
            Gs.Create (O.Name, Naming.Prefix (Naming.Full_Name (The_Object)));
        else
            raise Non_Existent_Object_Error;
        end if;
        return O;
    end Parent;


    function Child (The_Object : Object; Child_Name : Naming.Simple_String_Name)
                   return Object is
        O           : Object;
        Object_Name : constant String :=
           Naming.Full_Name (The_Object) & "/" & Child_Name;
    begin
        if Di.Existent_Entry (Path => Object_Name) then
            Any_Object.Open (The_Object => O, Object_Name => Object_Name);
            return O;
        else
            raise Non_Existent_Object_Error;
        end if;
    end Child;


    function Children (The_Object : Object;
                       Pattern : Naming.Simple_String_Name := "*";
                       Class : Class_Enumeration := Directory.Unknown_Class)
                      return Iterator is

        -- Pattern is not yet implemented !!!
        -- children will allways return all the object of the specified class

        Max_Iter : Integer;
        Iter     : Iterator;
        Obj      : Object;
    begin

        Object_Set.Make_Empty (Set_Of_Objects);

        if not Di.Is_Directory (Path => Naming.Full_Name (The_Object)) then
            Put_Error_Message ("The object is not a directory");
            raise System_Error;
        end if;
        Max_Iter := Di.Scan_Directory (Path => Naming.Full_Name (The_Object));
        if Max_Iter < 0 then  
            Put_Error_Message;
            raise System_Error;
        else
            Max_Iter := Max_Iter - 1;
            while Max_Iter >= 0 loop
                Obj := Child (The_Object => The_Object,
                              Child_Name => Di.Entry_Value (Max_Iter));
                if not Is_Nil (Obj) then
                    if Equal (Class1 => Class, Class2 => Unknown_Class) then
                        Object_Set.Add (Set_Of_Objects, Obj);
                    else
                        if Equal (Class1 => Class,
                                  Class2 => Directory.Class (Obj)) then
                            Object_Set.Add (Set_Of_Objects, Obj);
                        end if;
                    end if;
                end if;
                Max_Iter := Max_Iter - 1;
            end loop;
        end if;
        Reset (Iter);
        return Iter;
    end Children;
end Traversal;

    nblk1=5
    nid=5
    hdr6=6
        [0x00] rec0=25 rec1=00 rec2=01 rec3=058
        [0x01] rec0=1c rec1=00 rec2=03 rec3=092
        [0x02] rec0=1c rec1=00 rec2=02 rec3=000
        [0x03] rec0=16 rec1=00 rec2=05 rec3=060
        [0x04] rec0=12 rec1=00 rec2=02 rec3=001
    tail 0x21721258483ab4d835447 0x42a00088462062803
Free Block Chain:
  0x5: 0000  00 04 00 17 80 0b 20 54 72 61 76 65 72 73 61 6c  ┆       Traversal┆
  0x4: 0000  00 00 00 04 80 01 20 01 20 20 20 20 20 20 20 20  ┆                ┆