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

⟦c46dd2e67⟧ Ada Source

    Length: 10240 (0x2800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Names, seg_02ba43

Derivation

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

with Random;
with Time_Utilities;
with Directory_Tools;
with String_Utilities;
with System_Utilities;
with Misc_String_Utilities;
package body Names is

    Null_String : constant String := "";

    Underscore : constant Character := '_';

    Exclamation_Point : constant Character := '!';

    function Is_Null (This_String : in String) return Boolean is
    begin  
        return This_String = Null_String;
    end Is_Null;

    function Is_Non_Null (This_String : in String) return Boolean is
    begin
        return This_String /= Null_String;
    end Is_Non_Null;

    function Has_No_Leading_Underscore
                (This_String : in String) return Boolean is
    begin
        return This_String (This_String'First) /= Underscore;
    end Has_No_Leading_Underscore;

    function Has_No_Trailing_Underscore
                (This_String : in String) return Boolean is
    begin
        return This_String (This_String'Last) /= Underscore;
    end Has_No_Trailing_Underscore;

    function First_Character_Is_Letter
                (The_String : in String) return Boolean is
    begin
        case The_String (The_String'First) is
            when 'A' .. 'Z' | 'a' .. 'z' =>
                return True;
            when others =>
                return False;
        end case;
    end First_Character_Is_Letter;

    function Contains_No_Forbidden_Characters
                (This_String : in String) return Boolean is
    begin
        for Index in This_String'Range loop
            case This_String (Index) is
                when  
                   Ascii.Nul .. '/' |  
                   ':' .. '@' |  
                   '[' .. '^' |  
                   '{' .. Ascii.Del |  
                   '`' =>
                    return False;
                when others =>
                    null;
            end case;
        end loop;
        return True;
    end Contains_No_Forbidden_Characters;

    function Contains_No_Double_Underscores
                (This_String : in String) return Boolean is

        Found_Underscore : Boolean := False;

    begin
        for Index in This_String'Range loop
            if This_String (Index) = Underscore then
                if Found_Underscore then
                    return False;
                else
                    Found_Underscore := True;
                end if;
            else
                Found_Underscore := False;
            end if;
            return True;
        end loop;
    end Contains_No_Double_Underscores;

    function Is_Simple_Ada_Name (This_String : in String) return Boolean is
    begin
        if Is_Non_Null (This_String) and then
           Has_No_Leading_Underscore (This_String) and then
           Has_No_Trailing_Underscore (This_String) and then
           First_Character_Is_Letter (This_String) and then
           Contains_No_Forbidden_Characters (This_String) and then
           Contains_No_Double_Underscores (This_String) then
            return True;
        else
            return False;
        end if;

    exception
        when others =>
            return False;

    end Is_Simple_Ada_Name;

    function Is_Dotted_Ada_Name (This_String : in String) return Boolean is

        Dot : constant Character := '.';

        Start_Of_Segment : Integer := This_String'First;
        End_Of_Segment : Integer := This_String'First;

    begin  
        loop
            while End_Of_Segment <= This_String'Last and then
                     This_String (End_Of_Segment) /= Dot loop
                End_Of_Segment := End_Of_Segment + 1;
            end loop;  
            if not Names.Is_Simple_Ada_Name
                      (This_String (Start_Of_Segment ..
                                       (End_Of_Segment - 1))) then
                return False;
            else
                Start_Of_Segment := End_Of_Segment + 1;
                End_Of_Segment := End_Of_Segment + 1;
                if Start_Of_Segment > This_String'Last then
                    return True;
                end if;
            end if;  
        end loop;

    exception
        when others =>
            return False;

    end Is_Dotted_Ada_Name;

    function Is_Ada_Name (This_String : in String) return Boolean is
    begin
        return Is_Simple_Ada_Name (This_String) or else
                  Is_Dotted_Ada_Name (This_String);
    end Is_Ada_Name;

    function Is_Pathname (This_String : in String) return Boolean is
    begin
        if This_String /= Misc_String_Utilities.Continuous (This_String) then
            return False;
        end if;
        if Is_Null (This_String) then
            return False;
        end if;
        if not Directory_Tools.Naming.Is_Well_Formed (This_String) then
            return False;
        end if;
        return True;

    exception
        when others =>
            return False;

    end Is_Pathname;

    function First_Character_Is_Not_Exclamation_Point
                (This_String : in String) return Boolean is
    begin
        return This_String (This_String'First) /= Exclamation_Point;
    end First_Character_Is_Not_Exclamation_Point;

    function Is_Fully_Qualified_Pathname
                (This_String : in String) return Boolean is
    begin
        if Is_Null (This_String) then
            return False;
        end if;
        if First_Character_Is_Not_Exclamation_Point (This_String) then
            return False;
        end if;  
        return Is_Dotted_Ada_Name
                  (This_String ((This_String'First + 1) .. This_String'Last));
    exception
        when others =>
            return False;

    end Is_Fully_Qualified_Pathname;

    function Is_User_Name (This_String : in String) return Boolean is
    begin
        return Is_Simple_Ada_Name (This_String);
    end Is_User_Name;

    function Random_Number_Image return String is

        Random_Handle : Random.Handle;

        Random_Number : Natural;

    begin
        Random.Initialize (Random_Handle);
        Random_Number := Random.Natural_Value
                            (Random_Handle, Max => Natural'Last);
        return String_Utilities.Strip (Natural'Image (Random_Number));
    end Random_Number_Image;

    function Unique_Temporary_File_Name return String is

        Prefix : constant String := "!MACHINE.TEMPORARY.UNIQUE_TEMPORARY_FILE_";

        User_Name : constant String := System_Utilities.User_Name;

        Session_Name : constant String := System_Utilities.Session_Name;

        Time_Stamp : constant String := Time_Utilities.Image
                                           (Date => Time_Utilities.Get_Time,
                                            Date_Style => Time_Utilities.Ada,
                                            Time_Style => Time_Utilities.Ada,
                                            Contents => Time_Utilities.Both);
    begin
        return Prefix & User_Name & "_" & Session_Name & "_" &
                  Time_Stamp & "_" & Random_Number_Image;
    end Unique_Temporary_File_Name;

    function Indirect_File_Name_For
                (This_File_Name : in String) return String is
    begin
        return "_" & String_Utilities.Upper_Case (This_File_Name);
    end Indirect_File_Name_For;

    function All_Objects_In (This_Library : in String;
                             Include_Object_Itself : in Boolean;
                             Transitive : in Boolean) return String is
    begin  
        if Transitive then
            if Include_Object_Itself then
                return String_Utilities.Upper_Case (This_Library) & "??";
            else
                return String_Utilities.Upper_Case (This_Library) & ".@??";
            end if;
        else
            if Include_Object_Itself then
                return "[" & String_Utilities.Upper_Case (This_Library) & "," &
                          String_Utilities.Upper_Case (This_Library) & ".@]";
            else
                return String_Utilities.Upper_Case (This_Library) & ".@";
            end if;
        end if;
    end All_Objects_In;

end Names;

    nblk1=9
    nid=0
    hdr6=12
        [0x00] rec0=23 rec1=00 rec2=01 rec3=074
        [0x01] rec0=1f rec1=00 rec2=02 rec3=038
        [0x02] rec0=1c rec1=00 rec2=03 rec3=05a
        [0x03] rec0=1f rec1=00 rec2=04 rec3=032
        [0x04] rec0=1f rec1=00 rec2=05 rec3=022
        [0x05] rec0=21 rec1=00 rec2=06 rec3=01e
        [0x06] rec0=1b rec1=00 rec2=07 rec3=022
        [0x07] rec0=16 rec1=00 rec2=08 rec3=026
        [0x08] rec0=0c rec1=00 rec2=09 rec3=000
    tail 0x2172481a883f07919aedd 0x42a00088462060003