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

⟦7ce0518a2⟧ Ada Source

    Length: 15360 (0x3c00)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Profile_Parser_Defs, seg_02676b, seg_026d17

Derivation

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

with String_Utilities;
with Text_Io;
with Umps_Defs;
with Umps_Utilities;

package body Profile_Parser_Defs is

----- Declaration -----

    Temporary_File_Name : constant String := Default_Profile_File & "_temp";
    -- Temporary_File_Name : constant String := "";  UNUSABLE because of File_Copy

    subtype Line_Id is Natural;

    Empty_Field : constant String := "";


----- About Default_Profile_File -----

    function Get_Default_Profile_File return String is
    begin
        return Default_Profile_File;
    end Get_Default_Profile_File;


    procedure Set_Default_Profile_File (File : in String) is
    begin
        Default_Profile_File := Umps_Utilities.Normalize
                                   (File, Profile_File_Length);
    end Set_Default_Profile_File;


----- File -----

    procedure Create_File (File : in out Text_Io.File_Type;
                           File_Name : in String := Default_Profile_File) is
    begin
        Text_Io.Create (File, Text_Io.Out_File, File_Name);
    exception
        when Text_Io.Status_Error =>
            Text_Io.Put_Line ("File " & File_Name & " is already open !");
        when Text_Io.Name_Error =>
            Text_Io.Put_Line ("File " & File_Name & " undefined !");
        when Text_Io.Use_Error =>
            Text_Io.Put_Line ("File " & File_Name & " unable to be created !");
        when others =>
            Text_Io.Put_Line
               ("Exception OTHERS : in Profile_Parser.Create_File");
    end Create_File;


    procedure Open_File (File : in out Text_Io.File_Type;
                         File_Name : in String := Default_Profile_File;
                         Mode : Text_Io.File_Mode;
                         File_Created : out Boolean) is
    begin
        if not Text_Io.Is_Open (File) then
            Text_Io.Open (File, Mode, File_Name);
        else
            Text_Io.Put_Line ("File " & File_Name & " is already open !");
        end if;
        File_Created := False;
    exception
        when Text_Io.Status_Error =>
            Text_Io.Put_Line ("File " & File_Name & " is already open !");
        when Text_Io.Name_Error =>
            Text_Io.Create (File, Text_Io.Out_File, File_Name);
            -- same as the above Create_File procedure
            File_Created := True;
            Text_Io.Put_Line ("File " & File_Name & " has been created !");
        when others =>
            Text_Io.Put_Line ("Exception OTHERS : in Profile_Parser.Open_File");
    end Open_File;


    procedure Close_File (File : in out Text_Io.File_Type;
                          File_Name : in String := Default_Profile_File) is
    begin  
        Text_Io.Close (File);
    exception
        when Text_Io.Status_Error =>
            Text_Io.Put_Line ("File " & File_Name & " Is not Open !");
        when others =>
            Text_Io.Put_Line
               ("Exception OTHERS : in Profile_Parser.Close_File");
    end Close_File;


    procedure Delete_File (File : in out Text_Io.File_Type;
                           File_Name : in String := Default_Profile_File) is
    begin  
        Text_Io.Delete (File);
    exception
        when Text_Io.Status_Error =>
            Text_Io.Put_Line ("File " & File_Name & " is open !");
        when Text_Io.Use_Error =>
            Text_Io.Put_Line ("File " & File_Name & " unable to be deleted !");
        when others =>
            Text_Io.Put_Line
               ("Exception OTHERS : in Profile_Parser.Delete_File");
    end Delete_File;


----- Iterator -----

    function Open (File : in Text_Io.File_Type) return Line_Id is
    begin
        return Line_Id'First;
    end Open;

    procedure Value (File : in out Text_Io.File_Type;
                     Line : in Line_Id;
                     The_Value : out String;
                     Last : out Natural) is
        S : String (1 .. 256);
        L : Natural;
    begin
        Text_Io.Get_Line (File, S, L);
        The_Value (1 .. L) := S (1 .. L);
        Last := L;
    end Value;

    procedure Next (File : in out Text_Io.File_Type; Line : in out Line_Id) is
    begin
        Line := Line_Id'Succ (Line);  
    end Next;

    function Done (File : in Text_Io.File_Type; Line : in Line_Id)
                  return Boolean is
    begin
        return Text_Io.End_Of_File (File);
    end Done;


----- string utilities -----

    function Uncomment (The_String : in String;
                        With_The_Comment_Pattern : in String :=
                           Profile_Parser_Defs.Default_Comment_Pattern)
                       return String is
        P : Integer := String_Utilities.Locate
                          (With_The_Comment_Pattern, The_String);
    begin
        if P = 0 then
            return The_String;
        else
            return The_String (The_String'First .. P - 1);
        end if;
    end Uncomment;


    function Get_Parameter_Field
                (From : in String;
                 With_The_Affectation_Operator : in String :=
                    Profile_Parser_Defs.Default_Affectation_Operator)
                return String is
        P : Integer := String_Utilities.Locate
                          (With_The_Affectation_Operator, From);
    begin
        if P = 0 or P = 1 then
            Text_Io.Put_Line ("Empty parameter field of " & From); -- DEBUG
            return Empty_Field;
        else
            return From (1 .. P - 1);
        end if;
    end Get_Parameter_Field;


    function Get_Value_Field
                (From : in String;
                 With_The_Affectation_Operator : in String :=
                    Profile_Parser_Defs.Default_Affectation_Operator)
                return String is
        P : Integer := String_Utilities.Locate
                          (With_The_Affectation_Operator, From);
    begin
        if P = 0 or P = 1 then
            Text_Io.Put_Line ("Empty value field of " & From); -- DEBUG
            return Empty_Field;
        else
            return Uncomment
                      (From (P + Profile_Parser_Defs.
                                    Default_Affectation_Operator'Length ..
                                From'Last));
        end if;
    end Get_Value_Field;


    function Contain_At_The_Beginning_Of
                (The_Line : in String; The_Pattern : in String)
                return Boolean is
    begin
        return String_Utilities.Locate
                  (The_Pattern, String_Utilities.Strip_Leading (The_Line)) = 1;  
    end Contain_At_The_Beginning_Of;


    function Affect (The_Parameter : in String;
                     At_The_Value : in String;
                     With_The_Affectation_Operator : in String :=
                        Profile_Parser_Defs.Default_Affectation_Operator)
                    return String is
    begin
        return (The_Parameter & ' ' &
                With_The_Affectation_Operator & ' ' & At_The_Value);
    end Affect;


----- Spec's body -----

    procedure Set (The_Parameter : in String;
                   At_The_Value : in Object;
                   In_The_File : in String := Default_Profile_File) is
        Param_File : Text_Io.File_Type;
        Temp_File : Text_Io.File_Type;
        File_Created : Boolean;
        Unused_Flag : Boolean;
        S : String (1 .. 256);
        Last : Natural;
        Found : Boolean := False;
        Line : Line_Id;
    begin
        Open_File (Param_File, In_The_File, Text_Io.In_File, File_Created);
        Open_File (Temp_File, Temporary_File_Name,
                   Text_Io.Out_File, Unused_Flag);
        if not File_Created then
            Line := Open (Param_File);
            while not Done (Param_File, Line) loop
                Value (Param_File, Line, S, Last);
                if Contain_At_The_Beginning_Of
                      (S (1 .. Last), The_Parameter) then
                    Text_Io.Put_Line (Temp_File,
                                      Affect (The_Parameter,
                                              Object_Image (At_The_Value)));
                    -- & ' ' & Default_Comment_Pattern);
                    Found := True;
                else
                    Text_Io.Put_Line (Temp_File, S (1 .. Last));
                end if;
                Next (Param_File, Line);
            end loop;
        end if;
        if not Found then
            Text_Io.Put (Temp_File,
                         Affect (The_Parameter, Object_Image (At_The_Value)));
        end if;
        Close_File (Param_File, In_The_File);
        Close_File (Temp_File, Temporary_File_Name);
        Umps_Utilities.Text_File_Copy (Temporary_File_Name, In_The_File);
        -- exception
        --    when others =>
        --        Text_Io.Put_Line ("Exception OTHERS in Profile_Parser_Defs.Set");
    end Set;


    procedure Get (Of_The_Parameter : in String;
                   The_Value : out Object;
                   Success : out Boolean;
                   In_The_File : in String := Default_Profile_File) is
        Param_File : Text_Io.File_Type;
        File_Created : Boolean;
        S : String (1 .. 256);
        Last : Natural;
        Found : Boolean := False;
        Line : Line_Id;
    begin
        The_Value := Undefined_Object;
        Open_File (Param_File, In_The_File, Text_Io.In_File, File_Created);
        if not File_Created then
            Line := Open (Param_File);
            while not Found and then not Done (Param_File, Line) loop
                Value (Param_File, Line, S, Last);
                if Contain_At_The_Beginning_Of
                      (S (1 .. Last), Of_The_Parameter) then
                    The_Value := Object_Value (Get_Value_Field (S (1 .. Last)));
                    Found := True;
                end if;
                Next (Param_File, Line);
            end loop;
        end if;
        Close_File (Param_File, In_The_File);
        Success := Found;
        -- exception
        --     when Constraint_Error => -- the transformation Image->Value failed
        --         Text_Io.Put_Line
        --            ("Exception CONSTRAINT_ERROR in Profile_Parser_Defs.Get");
        --         Success := False;
        --     when Numeric_Error =>
        --         Text_Io.Put_Line
        --            ("Exception NUMERIC_ERROR in Profile_Parser_Defs.Get");
        --         Success := False;
        --     when others =>
        --         Text_Io.Put_Line ("Exception OTHERS in Profile_Parser_Defs.Get");
        --         Success := False;
    end Get;

end Profile_Parser_Defs;

    nblk1=e
    nid=3
    hdr6=18
        [0x00] rec0=26 rec1=00 rec2=01 rec3=00e
        [0x01] rec0=01 rec1=00 rec2=02 rec3=04a
        [0x02] rec0=18 rec1=00 rec2=0d rec3=01c
        [0x03] rec0=18 rec1=00 rec2=0a rec3=024
        [0x04] rec0=20 rec1=00 rec2=09 rec3=00a
        [0x05] rec0=1f rec1=00 rec2=0c rec3=016
        [0x06] rec0=1c rec1=00 rec2=08 rec3=010
        [0x07] rec0=19 rec1=00 rec2=07 rec3=048
        [0x08] rec0=1c rec1=00 rec2=06 rec3=030
        [0x09] rec0=16 rec1=00 rec2=05 rec3=058
        [0x0a] rec0=18 rec1=00 rec2=04 rec3=022
        [0x0b] rec0=16 rec1=00 rec2=0b rec3=000
        [0x0c] rec0=18 rec1=00 rec2=0b rec3=00c
        [0x0d] rec0=03 rec1=00 rec2=03 rec3=000
    tail 0x215204a1c83aa89218a93 0x42a00088462060003
Free Block Chain:
  0x3: 0000  00 0e 00 04 80 01 6f 01 47 65 74 3b 06 00 00 00  ┆      o Get;    ┆
  0xe: 0000  00 00 00 09 80 06 29 20 6c 6f 6f 70 06 22 29 3b  ┆      ) loop ");┆