⟦7ad1bb138⟧

TextFile

with Io_Exceptions;

package Basic_Io is

    type Count is range 0 .. Integer'Last;

    subtype Positive_Count is Count range 1 .. Count'Last;

    function Get_Integer return String;

    -- Skips any leading blanks, line terminators or page
    -- terminators.  Then reads a plus or a minus sign if
    -- present, then reads according to the syntax of an
    -- integer literal, which may be based.  Stores in item
    -- a string containing an optional sign and an integer
    -- literal.
    --
    -- The exception DATA_ERROR is raised if the sequence
    -- of characters does not correspond to the syntax
    -- escribed above.
    --
    -- The exception END_ERROR is raised if the file terminator
    -- is read.  This means that the starting sequence of an
    -- integer has not been met.
    --
    -- Note that the character terminating the operation must
    -- be available for the next get operation.
    --

    function Get_Real return String;

    -- Corresponds to get_integer except that it reads according
    -- to the syntax of a real literal, which may be based.


    function Get_Enumeration return String;

    -- Corresponds to get_integer except that it reads according
    -- to the syntax of an identifier, where upper and lower
    -- case letters are equivalent to a character literal
    -- including the apostrophes.

    function Get_Item (Length : in Integer) return String;

    -- Reads a string from the current line and stores it in
    -- item.  If the remaining number of characters on the
    -- current line is less than the length then only these
    -- characters are returned.  The line terminator is not
    -- skipped.


    procedure Put_Item (Item : in String);

    -- If the length of the string is greater than the current
    -- maximum line (linelength), the exception LAYOUT_ERROR
    -- is raised.
    --
    -- If the string does not fit on the current line a line
    -- terminator is output, then the item is output.


    -- Line and page lengths - ARM 14.3.3.
    --

    procedure Set_Line_Length (To : in Count);


    procedure Set_Page_Length (To : in Count);


    function Line_Length return Count;


    function Page_Length return Count;


    -- Operations oncolumns, lines and pages - ARM 14.3.4.
    --

    procedure New_Line;


    procedure Skip_Line;


    function End_Of_Line return Boolean;


    procedure New_Page;


    procedure Skip_Page;


    function End_Of_Page return Boolean;


    function End_Of_File return Boolean;


    procedure Set_Col (To : in Positive_Count);


    procedure Set_Line (To : in Positive_Count);


    function Col return Positive_Count;


    function Line return Positive_Count;


    function Page return Positive_Count;



    -- Character and string procedures defined is ARM 14.3.6.
    --

    procedure Get_Character (Item : out Character);


    procedure Get_String (Item : out String);


    procedure Get_Line (Item : out String; Last : out Natural);


    procedure Put_Character (Item : in Character);


    procedure Put_String (Item : in String);


    procedure Put_Line (Item : in String);



    -- exceptions:

    Use_Error : exception renames Io_Exceptions.Use_Error;
    Device_Error : exception renames Io_Exceptions.Device_Error;
    End_Error : exception renames Io_Exceptions.End_Error;
    Data_Error : exception renames Io_Exceptions.Data_Error;
    Layout_Error : exception renames Io_Exceptions.Layout_Error;

end Basic_Io;with Io_Exceptions;

generic
    type Element_Type is private;
package Direct_Io is

    type File_Type is limited private;

    type File_Mode is (In_File, Inout_File, Out_File);
    type Count is new Integer range 0 .. Integer'Last / Element_Type'Size;
    subtype Positive_Count is Count range 1 .. Count'Last;


    -- File management


    procedure Create (File : in out File_Type;
                      Mode : File_Mode := Inout_File;
                      Name : String := "";
                      Form : String := "");

    procedure Open (File : in out File_Type;
                    Mode : File_Mode;
                    Name : String;
                    Form : String := "");

    procedure Close (File : in out File_Type);
    procedure Delete (File : in out File_Type);
    procedure Reset (File : in out File_Type; Mode : File_Mode);
    procedure Reset (File : in out File_Type);

    function Mode (File : File_Type) return File_Mode;
    function Name (File : File_Type) return String;
    function Form (File : File_Type) return String;

    function Is_Open (File : File_Type) return Boolean;

    -- Input and output operations

    procedure Read (File : File_Type;
                    Item : out Element_Type;
                    From : Positive_Count);
    procedure Read (File : File_Type; Item : out Element_Type);

    procedure Write (File : File_Type;
                     Item : Element_Type;
                     To : Positive_Count);
    procedure Write (File : File_Type; Item : Element_Type);

    procedure Set_Index (File : File_Type; To : Positive_Count);

    function Index (File : File_Type) return Positive_Count;
    function Size (File : File_Type) return Count;

    function End_Of_File (File : File_Type) return Boolean;


    -- Exceptions

    Status_Error : exception renames Io_Exceptions.Status_Error;
    Mode_Error : exception renames Io_Exceptions.Mode_Error;
    Name_Error : exception renames Io_Exceptions.Name_Error;
    Use_Error : exception renames Io_Exceptions.Use_Error;
    Device_Error : exception renames Io_Exceptions.Device_Error;
    End_Error : exception renames Io_Exceptions.End_Error;
    Data_Error : exception renames Io_Exceptions.Data_Error;

private

    type File_Type is access Integer;

end Direct_Io;package Io_Exceptions is

    Status_Error : exception;
    Mode_Error : exception;
    Name_Error : exception;
    Use_Error : exception;
    Device_Error : exception;
    End_Error : exception;
    Data_Error : exception;
    Layout_Error : exception;

end Io_Exceptions;-- Source code for SEQUENTIAL_IO

pragma Page;

with Io_Exceptions;

generic

    type Element_Type is private;

package Sequential_Io is

    type File_Type is limited private;

    type File_Mode is (In_File, Out_File);

    pragma Page;
    -- File management

    procedure Create (File : in out File_Type;  
                      Mode : in File_Mode := Out_File;  
                      Name : in String := "";  
                      Form : in String := "");

    procedure Open (File : in out File_Type;  
                    Mode : in File_Mode;  
                    Name : in String;  
                    Form : in String := "");

    procedure Close (File : in out File_Type);

    procedure Delete (File : in out File_Type);

    procedure Reset (File : in out File_Type; Mode : in File_Mode);

    procedure Reset (File : in out File_Type);

    function Mode (File : in File_Type) return File_Mode;

    function Name (File : in File_Type) return String;

    function Form (File : in File_Type) return String;

    function Is_Open (File : in File_Type) return Boolean;

    pragma Page;
    -- Input and output operations

    procedure Read (File : in File_Type; Item : out Element_Type);


    procedure Write (File : in File_Type; Item : in Element_Type);


    function End_Of_File (File : in File_Type) return Boolean;

    pragma Page;
    -- Exceptions

    Status_Error : exception renames Io_Exceptions.Status_Error;  
    Mode_Error : exception renames Io_Exceptions.Mode_Error;  
    Name_Error : exception renames Io_Exceptions.Name_Error;  
    Use_Error : exception renames Io_Exceptions.Use_Error;  
    Device_Error : exception renames Io_Exceptions.Device_Error;  
    End_Error : exception renames Io_Exceptions.End_Error;  
    Data_Error : exception renames Io_Exceptions.Data_Error;

    pragma Page;
private

    type File_Type is new Integer;

end Sequential_Io;with Basic_Io;
with Io_Exceptions;
package Text_Io is

    type File_Type is limited private;

    type File_Mode is (In_File, Out_File);

    type Count is range 0 .. 16_384;
    subtype Positive_Count is Count range 1 .. Count'Last;
    Unbounded : constant Count := 0; -- line and page length

    -- max. size of an integer output field 2#....#;
    subtype Field is Integer range 0 .. 1000;

    subtype Number_Base is Integer range 2 .. 16;

    type Type_Set is (Lower_Case, Upper_Case);

    -- File management

    procedure Create (File : in out File_Type;
                      Mode : in File_Mode := Out_File;
                      Name : in String := "";
                      Form : in String := "");

    procedure Open (File : in out File_Type;
                    Mode : in File_Mode;
                    Name : in String;
                    Form : in String := "");

    procedure Close (File : in out File_Type);
    procedure Delete (File : in out File_Type);
    procedure Reset (File : in out File_Type; Mode : in File_Mode);
    procedure Reset (File : in out File_Type);

    function Mode (File : in File_Type) return File_Mode;
    function Name (File : in File_Type) return String;
    function Form (File : in File_Type) return String;

    function Is_Open (File : in File_Type) return Boolean;


    --control of default input and output files

    procedure Set_Input (File : in File_Type);
    procedure Set_Output (File : in File_Type);

    function Standard_Input return File_Type;
    function Standard_Output return File_Type;

    function Current_Input return File_Type;
    function Current_Output return File_Type;


    -- specification of line and page lengths

    procedure Set_Line_Length (File : in File_Type; To : in Count);
    procedure Set_Line_Length (To : in Count);

    procedure Set_Page_Length (File : in File_Type; To : in Count);

    procedure Set_Page_Length (To : in Count);

    function Line_Length (File : in File_Type) return Count;

    function Line_Length return Count;

    function Page_Length (File : in File_Type) return Count;

    function Page_Length return Count;



    --Column, Line, and Page control

    procedure New_Line (File : in File_Type; Spacing : in Positive_Count := 1);
    procedure New_Line (Spacing : in Positive_Count := 1);

    procedure Skip_Line (File : in File_Type; Spacing : in Positive_Count := 1);
    procedure Skip_Line (Spacing : in Positive_Count := 1);

    function End_Of_Line (File : in File_Type) return Boolean;
    function End_Of_Line return Boolean;

    procedure New_Page (File : in File_Type);
    procedure New_Page;

    procedure Skip_Page (File : in File_Type);
    procedure Skip_Page;

    function End_Of_Page (File : in File_Type) return Boolean;
    function End_Of_Page return Boolean;

    function End_Of_File (File : in File_Type) return Boolean;
    function End_Of_File return Boolean;

    procedure Set_Col (File : in File_Type; To : in Positive_Count);
    procedure Set_Col (To : in Positive_Count);

    procedure Set_Line (File : in File_Type; To : in Positive_Count);
    procedure Set_Line (To : in Positive_Count);

    function Col (File : in File_Type) return Positive_Count;
    function Col return Positive_Count;

    function Line (File : in File_Type) return Positive_Count;
    function Line return Positive_Count;

    function Page (File : in File_Type) return Positive_Count;
    function Page return Positive_Count;


    -- Character Input-Output

    procedure Get (File : in File_Type; Item : out Character);
    procedure Get (Item : out Character);
    procedure Put (File : in File_Type; Item : in Character);
    procedure Put (Item : in Character);

    -- String Input-Output

    procedure Get (File : in File_Type; Item : out String);
    procedure Get (Item : out String);
    procedure Put (File : in File_Type; Item : in String);
    procedure Put (Item : in String);

    procedure Get_Line
                 (File : in File_Type; Item : out String; Last : out Natural);

    procedure Get_Line (Item : out String; Last : out Natural);

    procedure Put_Line (File : in File_Type; Item : in String);
    procedure Put_Line (Item : in String);


    -- Generic Package for Input-Output of Intger Types

    generic
        type Num is range <>;
    package Integer_Io is

        Default_Width : Field := Num'Width;
        Default_Base : Number_Base := 10;

        procedure Get (File : in File_Type;
                       Item : out Num;
                       Width : in Field := 0);
        procedure Get (Item : out Num; Width : in Field := 0);

        procedure Put (File : in File_Type;
                       Item : in Num;
                       Width : in Field := 0;
                       Base : in Number_Base := Default_Base);
        procedure Put (Item : in Num;
                       Width : in Field := 0;
                       Base : in Number_Base := Default_Base);

        procedure Get (From : in String; Item : out Num; Last : out Positive);

        procedure Put (To : out String;
                       Item : in Num;
                       Base : in Number_Base := Default_Base);
    end Integer_Io;




    -- Generic Packages for Input-Output of Real Types

    generic
        type Num is digits <>;
    package Float_Io is

        Default_Fore : Field := 2;
        Default_Aft : Field := Num'Digits - 1;
        Default_Exp : Field := 3;

        procedure Get (File : in File_Type;
                       Item : out Num;
                       Width : in Field := 0);
        procedure Get (Item : out Num; Width : in Field := 0);

        procedure Put (File : in File_Type;
                       Item : in Num;
                       Fore : in Field := Default_Fore;
                       Aft : in Field := Default_Aft;
                       Exp : in Field := Default_Exp);
        procedure Put (Item : in Num;
                       Fore : in Field := Default_Fore;
                       Aft : in Field := Default_Aft;
                       Exp : in Field := Default_Exp);

        procedure Get (From : in String; Item : out Num; Last : out Positive);
        procedure Put (To : out String;
                       Item : in Num;
                       Aft : in Field := Default_Aft;
                       Exp : in Field := Default_Exp);

    end Float_Io;




    generic
        type Num is delta <>;
    package Fixed_Io is

        Default_Fore : Field := Num'Fore;
        Default_Aft : Field := Num'Aft;
        Default_Exp : Field := 0;

        procedure Get (File : in File_Type;
                       Item : out Num;
                       Width : in Field := 0);
        procedure Get (Item : out Num; Width : in Field := 0);

        procedure Put (File : in File_Type;
                       Item : in Num;
                       Fore : in Field := Default_Fore;
                       Aft : in Field := Default_Aft;
                       Exp : in Field := Default_Exp);

        procedure Put (Item : in Num;
                       Fore : in Field := Default_Fore;
                       Aft : in Field := Default_Aft;
                       Exp : in Field := Default_Exp);

        procedure Get (From : in String; Item : out Num; Last : out Positive);

        procedure Put (To : out String;
                       Item : in Num;
                       Aft : in Field := Default_Aft;
                       Exp : in Field := Default_Exp);
    end Fixed_Io;




    -- Generic Package for Input-Output of enumeration Types

    generic
        type Enum is (<>);
    package Enumeration_Io is

        Default_Width : Field := 0;
        Default_Setting : Type_Set := Upper_Case;

        procedure Get (File : in File_Type; Item : out Enum);
        procedure Get (Item : out Enum);

        procedure Put (File : File_Type;
                       Item : in Enum;
                       Width : in Field := Default_Width;
                       Set : in Type_Set := Default_Setting);
        procedure Put (Item : in Enum;
                       Width : in Field := Default_Width;
                       Set : in Type_Set := Default_Setting);

        procedure Get (From : in String; Item : out Enum; Last : out Positive);

        procedure Put (To : out String;
                       Item : in Enum;
                       Set : in Type_Set := Default_Setting);
    end Enumeration_Io;



    -- Exceptions

    Status_Error : exception renames Io_Exceptions.Status_Error;
    Mode_Error : exception renames Io_Exceptions.Mode_Error;
    Name_Error : exception renames Io_Exceptions.Name_Error;
    Use_Error : exception renames Io_Exceptions.Use_Error;
    Device_Error : exception renames Io_Exceptions.Device_Error;
    End_Error : exception renames Io_Exceptions.End_Error;
    Data_Error : exception renames Io_Exceptions.Data_Error;
    Layout_Error : exception renames Io_Exceptions.Layout_Error;


private

    type File_Type is
        record
            Ft : Integer := -1;
        end record;
    -- Unfortunately, we don't know what this is.

end Text_Io;package Calendar is

    type Time is private;

    subtype Year_Number is Integer range 1901 .. 2099;
    subtype Month_Number is Integer range 1 .. 12;
    subtype Day_Number is Integer range 1 .. 31;
    subtype Day_Duration is Duration range 0.0 .. 86_400.0;

    function Clock return Time;

    function Year (Date : Time) return Year_Number;
    function Month (Date : Time) return Month_Number;
    function Day (Date : Time) return Day_Number;
    function Seconds (Date : Time) return Day_Duration;

    procedure Split (Date : Time;
                     Year : out Year_Number;
                     Month : out Month_Number;
                     Day : out Day_Number;
                     Seconds : out Day_Duration);

    function Time_Of (Year : Year_Number;
                      Month : Month_Number;
                      Day : Day_Number;
                      Seconds : Day_Duration := 0.0) return Time;

    function "+" (Left : Time; Right : Duration) return Time;
    function "+" (Left : Duration; Right : Time) return Time;
    function "-" (Left : Time; Right : Duration) return Time;
    function "-" (Left : Time; Right : Time) return Duration;

    function "<" (Left, Right : Time) return Boolean;
    function "<=" (Left, Right : Time) return Boolean;
    function ">" (Left, Right : Time) return Boolean;
    function ">=" (Left, Right : Time) return Boolean;

    Time_Error : exception;  -- can be raised by TIME_OF, "+" and "-"

private
    type Time is
        record
            I : Integer;
        end record;
end Calendar;package Machine_Code is
end Machine_Code;package System is

    -- for integer'size use 32;

    type Address is access Integer;
    -- for address'size use 4*storage_unit;

    type Name is (Aix_6000);

    System_Name : constant Name := Aix_6000;

    Storage_Unit : constant := 8;

    Memory_Size : constant := 1024 * 1024 * 256;
    -- 256 Mb.

    -- System-Dependent Named Numbers:

    Min_Int : constant := -(2 ** 31);
    Max_Int : constant := (2 ** 31) - 1;
    Max_Digits : constant := 15;
    Max_Mantissa : constant := 31;
    Fine_Delta : constant := 1.0 / (2 ** Max_Mantissa);
    Tick : constant := 0.00006;


    -- Other System-dependent Declarations

    subtype Priority is Integer range 0 .. 255;


    Max_Object_Size : constant := (32 * 1024) - 1;
    Max_Record_Count : constant := (32 * 1024) - 1;
    Max_Text_Io_Count : constant := 16 * 1024;
    Max_Text_Io_Field : constant := 1000;

end System;generic
    type Source is limited private;
    type Target is limited private;
function Unchecked_Conversion (S : Source) return Target;generic
    type Object is limited private;
    type Name is access Object;
procedure Unchecked_Deallocation (X : in out Name);package Math_Pack is

--======================================================================
--              Mathematical Constants
--======================================================================

    Pi : constant := 3.1415_92653_58979_32384_62643_38327_95029;
    E : constant := 2.7182_81828_45904_52353_60287_47135_26625;

--======================================================================
--         Miscellaneous Mathematical Functions
--======================================================================

    function Sqrt (X : Float) return Float;
    function Sqrt (X : Long_Float) return Long_Float;

    -- Computes square root of X.
    -- X >= 0.0;

--======================================================================
--              Logarithmic functions
--======================================================================

    function Ln (X : Float) return Float;
    function Ln (X : Long_Float) return Long_Float;

    -- Computes the natural logarithm (base e) of x.
    -- X > 0.0

    function Log (X : Float; Base : Float := 10.0) return Float;

    function Log (X : Long_Float; Base : Long_Float := 10.0) return Float;

    -- Computes logarithm of X with respect to an arbitrary
    -- base  (default is 10).
    -- X > 0.0
    -- BASE real, but not 0.0

    function Exp (X : Float; Base : Float := E) return Float;

    function Exp (X : Long_Float; Base : Long_Float := E) return Long_Float;

    -- Computes BASE raised to power of X.  The base defaults
    -- to "e".
    -- X real
    -- BASE real, but not 0.0

--======================================================================
--                      Trigonometric Functions
--======================================================================

    function Sin (X : Float) return Float;
    function Sin (X : Long_Float) return Long_Float;

    -- Computes sine of X in radians.
    -- X real

    function Cos (X : Float) return Float;
    function Cos (X : Long_Float) return Long_Float;

    -- Computes cosine of X in radians.
    -- X real

    function Tan (X : Float) return Float;
    function Tan (X : Long_Float) return Long_Float;

    -- Computes tangent of X in radians.
    -- X real

    function Arc_Sin (X : Float) return Float;
    function Arc_Sin (X : Long_Float) return Long_Float;

    -- Computes the arc sine of X and produces a result
    -- in radians.
    -- -1.0 <= X <= 1.0

    function Arc_Cos (X : Float) return Float;
    function Arc_Cos (X : Long_Float) return Long_Float;

    -- Computes the arc cosine of X and produces a result
    -- in radians.
    -- -1.0 <= X <= 1.0

    function Arc_Tan (Y : Float; X : Float := 1.0) return Float;
    function Arc_Tan (Y : Long_Float; X : Long_Float := 1.0) return Long_Float;

    -- If X = 1.0 (default), the arc tangent of Y is
    -- computed.  The result is in radians and lies in the
    -- interval: -PI/2 <= arc tan <= PI/2.  If X /= 1.0,
    -- the arc tangent of Y/X is returned.  The result
    -- is in radians and lies in the following intervals
    -- depending of the sign of Y:
    --
    --      Y >= 0, X >  0:  0      <=  arc tan <   PI/2
    --      Y >  0, X <= 0:  PI/2   <=  arc tan <   PI
    --      Y <  0, X >= 0:  0      >   arc tan >= -PI/2
    --      Y <= 0, X <  0: -PI/2   >   arc tan >= -PI



    function Sinh (X : Float) return Float;
    function Sinh (X : Long_Float) return Long_Float;

    -- Computes the hyperbolic sine of X.
    -- X real

    function Cosh (X : Float) return Float;
    function Cosh (X : Long_Float) return Long_Float;

    -- Computes the hyperbolic cosine of X.
    -- X real

    function Tanh (X : Float) return Float;
    function Tanh (X : Long_Float) return Long_Float;

    -- Computes the hyperbolic tangent of X.

    function Arc_Tanh (X : Float) return Float;
    function Arc_Tanh (X : Long_Float) return Long_Float;

    -- Computes the hyperbolic arctangent of X.
    -- -1.0 < X < 1.0

--======================================================================
--                          Exceptions
--======================================================================

    -- NOTE:    The exception NUMERIC_ERROR is raised if any
    --          function in this package is called with an argument
    --          which has a value which is not in the valid range of
    --          values for that argument.  The user may provide an
    --          exception handler for this exception.

--======================================================================

end Math_Pack;*** 527 ***
!RC.MAIN_PROGRAMS.REV4_WORKING.UNITS.RELEASES.[!TARGETS.RS6000_AIX_IBM,!TARGETS.IMPLEMENTATION.RELEASE_RS6000_AIX_IBM_1_1_0.INSTALL_ACTIVITY]
!TARGETS.RS6000_AIX_IBM
W||| 5/15/91 20:37:32|WORLD|||
ANETWORK_PUBLIC=>RCOD|DNETWORK_PUBLIC=>RW|TRS6000_AIX_IBM|
!TARGETS.RS6000_AIX_IBM.IO
N||| 5/15/91 20:37:04|DIRECTORY|||

!TARGETS.RS6000_AIX_IBM.IO.SWITCHES
H||| 3/16/90 19:27:18|SWITCH||1|
ANETWORK_PUBLIC=>RW|


!TARGETS.RS6000_AIX_IBM.IO
K

!TARGETS.RS6000_AIX_IBM.IO.SWITCHES
!TARGETS.RS6000_AIX_IBM.IO.BASIC_IO'SPEC
V|-3475|4| 5/10/90 12:39:57|PACKAGE_SPEC||1|
ANETWORK_PUBLIC=>RW|
!TARGETS.RS6000_AIX_IBM.IO.DIRECT_IO'SPEC
V3475|-2284|4| 8/21/90 13:00:24|GENERIC_PACKAGE||1|
ANETWORK_PUBLIC=>RW|
!TARGETS.RS6000_AIX_IBM.IO.IO_EXCEPTIONS'SPEC
V5759|-273|4| 5/07/90 14:57:13|PACKAGE_SPEC||1|
ANETWORK_PUBLIC=>RW|
!TARGETS.RS6000_AIX_IBM.IO.SEQUENTIAL_IO'SPEC
V6032|-1902|4| 5/07/90 15:51:22|GENERIC_PACKAGE||1|
ANETWORK_PUBLIC=>RW|
!TARGETS.RS6000_AIX_IBM.IO.TEXT_IO'SPEC
V7934|-9113|4| 5/31/90 20:24:44|PACKAGE_SPEC||1|
ANETWORK_PUBLIC=>RW|
!TARGETS.RS6000_AIX_IBM.LRM
N||| 5/15/91 20:37:17|DIRECTORY|||

!TARGETS.RS6000_AIX_IBM.LRM.SWITCHES
H||| 2/21/90 15:47:03|SWITCH||1|
ANETWORK_PUBLIC=>RW|


!TARGETS.RS6000_AIX_IBM.LRM
K

!TARGETS.RS6000_AIX_IBM.LRM.SWITCHES
!TARGETS.RS6000_AIX_IBM.LRM.CALENDAR'SPEC
V17047|-1560|4| 7/26/90 11:14:32|PACKAGE_SPEC||1|
ANETWORK_PUBLIC=>RW|
!TARGETS.RS6000_AIX_IBM.LRM.MACHINE_CODE'SPEC
V18607|-41|4| 5/08/90 23:40:59|PACKAGE_SPEC||1|
ANETWORK_PUBLIC=>RW|
!TARGETS.RS6000_AIX_IBM.LRM.SYSTEM'SPEC
V18648|-884|4| 8/09/90 13:18:09|PACKAGE_SPEC||1|
ANETWORK_PUBLIC=>RW|
!TARGETS.RS6000_AIX_IBM.LRM.UNCHECKED_CONVERSION'SPEC
V19532|-137|4| 5/08/90 23:41:16|GENERIC_FUNCTION||1|
ANETWORK_PUBLIC=>RW|
!TARGETS.RS6000_AIX_IBM.LRM.UNCHECKED_DEALLOCATION'SPEC
V19669|-127|4| 5/08/90 23:41:28|GENERIC_PROCEDURE||1|
ANETWORK_PUBLIC=>RW|
!TARGETS.RS6000_AIX_IBM.REUSABLE_COMPONENTS
N||| 5/15/91 20:37:29|DIRECTORY|||

!TARGETS.RS6000_AIX_IBM.REUSABLE_COMPONENTS.SWITCHES
H||| 2/21/90 15:47:05|SWITCH||1|
ANETWORK_PUBLIC=>RW|


!TARGETS.RS6000_AIX_IBM.REUSABLE_COMPONENTS
K

!TARGETS.RS6000_AIX_IBM.REUSABLE_COMPONENTS.SWITCHES
!TARGETS.RS6000_AIX_IBM.REUSABLE_COMPONENTS.MATH_PACK'SPEC
V19796|-4563|4| 5/07/90 18:42:25|PACKAGE_SPEC||1|
ANETWORK_PUBLIC=>RW|
!TARGETS.RS6000_AIX_IBM.SWITCHES
H||| 2/08/90 13:41:30|SWITCH|||
ANETWORK_PUBLIC=>RW|


!TARGETS.RS6000_AIX_IBM.TARGET_INTERFACE
N||| 5/15/91 20:37:35|DIRECTORY|||

!TARGETS.RS6000_AIX_IBM.TARGET_INTERFACE.SWITCHES
H||| 2/21/90 15:47:04|SWITCH||1|
ANETWORK_PUBLIC=>RW|


!TARGETS.RS6000_AIX_IBM.TARGET_INTERFACE
K

!TARGETS.RS6000_AIX_IBM.TARGET_INTERFACE.SWITCHES
!TARGETS.RS6000_AIX_IBM
Y


!TARGETS.RS6000_AIX_IBM.SWITCHES
!TARGETS.IMPLEMENTATION.RELEASE_RS6000_AIX_IBM_1_1_0.INSTALL_ACTIVITY
A||| 1/10/92 09:00:51|ACTIVITY||2|
ANETWORK_PUBLIC=>RW|
!TARGETS.IMPLEMENTATION.RCF_CUSTOMIZATION.RS6000_AIX_IBM
!TARGETS.IMPLEMENTATION.RCF_CUSTOMIZATION.RS6000_AIX_IBM.REV1_1_SPEC
!TARGETS.IMPLEMENTATION.RCF_CUSTOMIZATION.RS6000_AIX_IBM.REV1_1_0


procedure Install_Customization (Target_Key : String := "<DEFAULT>";
                                 Release_Number : String := "<DEFAULT>";
                                 Version : String := "<DEFAULT>");with Activity;
with Archive;
with Debug_Tools;  
with Directory_Tools;
with Log;
with Links;
with Profile;
with Program;
with String_Utilities;

procedure Install_Customization (Target_Key : String := "<DEFAULT>";
                                 Release_Number : String := "<DEFAULT>";
                                 Version : String := "<DEFAULT>") is
    Bad_Current_Context : exception;

    Def_Con : constant String := Directory_Tools.Naming.Default_Context;

    Install_World_Prefix : constant String := "!Targets.Implementation.Release";

    function Default_Release_Suffix return String is
    begin
        if Install_World_Prefix'Length < Def_Con'Length and then
           String_Utilities.Equal
              (Install_World_Prefix,
               Def_Con (Def_Con'First ..
                           Def_Con'First + Install_World_Prefix'Length - 1),
               Ignore_Case => True) then
            return Def_Con (Def_Con'First + Install_World_Prefix'Length ..
                               Def_Con'Last);

        else

            raise Bad_Current_Context;

        end if;
    end Default_Release_Suffix;

    function Get_Target_Key return String is
    begin
        if String_Utilities.Equal
              (Release_Number, "<DEFAULT>", Ignore_Case => True) then
            declare
                Release_Suffix : constant String := Default_Release_Suffix;
                Last_Underscore : constant Integer :=
                   String_Utilities.Reverse_Locate
                      (Fragment => "_", Within => Release_Suffix);
                Second_To_Last_Underscore : constant Integer :=
                   String_Utilities.Reverse_Locate
                      (Fragment => "_",
                       Within => Release_Suffix (Release_Suffix'First ..
                                                    Last_Underscore - 1));


                Third_To_Last_Underscore : constant Integer :=
                   String_Utilities.Reverse_Locate
                      (Fragment => "_",
                       Within => Release_Suffix
                                    (Release_Suffix'First ..
                                        Second_To_Last_Underscore - 1));


            begin
                if Third_To_Last_Underscore > Release_Suffix'First then
                    return Release_Suffix (Release_Suffix'First + 1 ..
                                              Third_To_Last_Underscore - 1);
                else
                    raise Bad_Current_Context;
                end if;
            end;
        else
            return Release_Number;
        end if;
    end Get_Target_Key;

    function Get_Release_Number return String is
    begin
        if String_Utilities.Equal
              (Release_Number, "<DEFAULT>", Ignore_Case => True) then
            declare
                Release_Suffix : constant String := Default_Release_Suffix;
                Last_Underscore : constant Integer :=
                   String_Utilities.Reverse_Locate
                      (Fragment => "_", Within => Release_Suffix);
                Second_To_Last_Underscore : constant Integer :=
                   String_Utilities.Reverse_Locate
                      (Fragment => "_",
                       Within => Release_Suffix (Release_Suffix'First ..
                                                    Last_Underscore - 1));
                Third_To_Last_Underscore : constant Integer :=
                   String_Utilities.Reverse_Locate
                      (Fragment => "_",
                       Within => Release_Suffix
                                    (Release_Suffix'First ..
                                        Second_To_Last_Underscore - 1));

            begin
                if Third_To_Last_Underscore > Release_Suffix'First then
                    return Release_Suffix (Third_To_Last_Underscore + 1 ..
                                              Last_Underscore - 1);
                else
                    raise Bad_Current_Context;
                end if;
            end;
        else
            return Release_Number;
        end if;
    end Get_Release_Number;

    function Get_Version return String is
    begin
        if String_Utilities.Equal
              (Version, "<DEFAULT>", Ignore_Case => True) then
            declare
                Release_Suffix : constant String := Default_Release_Suffix;
                Last_Underscore : constant Integer :=
                   String_Utilities.Reverse_Locate
                      (Fragment => "_", Within => Release_Suffix);
            begin
                if Last_Underscore > Release_Suffix'First then
                    return Release_Suffix
                              (Last_Underscore .. Release_Suffix'Last);
                else
                    raise Bad_Current_Context;
                end if;
            end;
        else
            return Version;
        end if;
    end Get_Version;

    function Release_World return String is
    begin
        return "!targets.implementation.release_" & Get_Target_Key &
                  "_" & Get_Release_Number & Get_Version;
    end Release_World;

    procedure Restore_Predefined is
    begin
        Log.Put_Line ("Restoring predefined world");
        Archive.Restore (Objects => "[?,~!Targets." & Get_Target_Key & "]",
                         Use_Prefix => "*",
                         For_Prefix => "*",
                         Options => "changed_objects replace",
                         Device => Release_World & ".predefined_archive",
                         Response => "<PROFILE>");
        Log.Put_Line ("Successfully restored predefined world");
    exception
        when others =>
            Log.Put_Line (Debug_Tools.Get_Exception_Name &
                          " raised in Restore_Predefined",
                          Kind => Profile.Error_Msg);  
            raise;
    end Restore_Predefined;


    procedure Merge_Activities is
    begin
        Log.Put_Line
           ("Merging " & Release_World &
            ".install_activity into !machine.release.current.activity");
        Activity.Merge (Source => Release_World & ".install_activity",
                        Subsystem => "?",
                        Spec_View => "?",
                        Load_View => "?",
                        Mode => Activity.Exact_Copy,
                        Target => "!machine.release.current.activity",
                        Response => "<PROFILE>");  
        Log.Put_Line ("Successfully merged activities");
    exception
        when others =>
            Log.Put_Line (Debug_Tools.Get_Exception_Name &
                          " raised in Merge_Activities",
                          Kind => Profile.Error_Msg);
            raise;
    end Merge_Activities;


    procedure Replace_Links is
        Key : constant String := Get_Target_Key;
    begin
        Log.Put_Line ("Replacing link to " & Key);
        Links.Replace (Source => "!targets.implementation.Rcf_customization." &
                                    Key & "'spec_view.units." & Key,
                       Link => "#",
                       World => "!machine.release.current.commands",
                       Response => "<PROFILE>");
        Log.Put_Line ("Successfully replaced link");
    exception
        when others =>
            Log.Put_Line (Message => "Unable to define link to " & Key,
                          Kind => Profile.Warning_Msg);
            Log.Put_Line (Debug_Tools.Get_Exception_Name &
                          " raised in Replace_Links");
    end Replace_Links;

    procedure Register_Target is  
        Key : constant String := Get_Target_Key;
    begin
        Log.Put_Line ("Registering target " & Key);
        Program.Run_Job (Key & ".register");
        Log.Put_Line ("Successfully registered target " & Key);
    exception
        when others =>
            Log.Put_Line (Debug_Tools.Get_Exception_Name &
                          " raised in Register_Target");
            raise;
    end Register_Target;

begin
    Restore_Predefined;
    Merge_Activities;
    Replace_Links;
    --Register_Target;
exception
    when Bad_Current_Context =>
        Log.Put_Line ("Unable to install " & Target_Key &
                      " due to unhandled exception " &
                      Debug_Tools.Get_Exception_Name, Profile.Negative_Msg);
    when others =>
        Log.Put_Line ("Unable to install " & Get_Target_Key &
                      " due to unhandled exception " &
                      Debug_Tools.Get_Exception_Name, Profile.Negative_Msg);
end Install_Customization;
DataMuseum.dk

Rational R1000/400

⟦7ad1bb138⟧ TextFile

Derivation

TextFile
