DataMuseum.dk

top - metrics - download

    Length: 6442 (0x192a)
    Types: TextFile
    Names: »VMS_BODY«

└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
    └─⟦5cb1d1d7f⟧ »DATA« 
        └─⟦3b1ee7bd8⟧ 
            └─⟦this⟧ 

TextFile

with Starlet;
with System;
with Tasking_Services;
with Condition_Handling;
with Unchecked_Conversion;
with Text_Io;

package body Vms is

    function Image (Iosb : Vms.Iosb_Type) return String is
    begin
        return "(status " & Vms.Image (Vms.Cond_Value_Type (Iosb.Status)) &
                  ", count" &
                  System.Unsigned_Word'Image (Iosb.Count) & ", info" &
                  System.Unsigned_Longword'Image (Iosb.Dev_Info) & ")";
    end Image;

    function Image (Status : Cond_Value_Type) return String is

        function Severity return String is
            Answer : Unsigned_Longword;
        begin
            Answer := Condition_Handling.Severity (Status);

            case Answer is
                when Starlet.Sts_K_Success =>
                    return "success";
                when Starlet.Sts_K_Warning =>
                    return "warning";
                when Starlet.Sts_K_Error =>
                    return "error";
                when Starlet.Sts_K_Info =>
                    return "info";
                when Starlet.Sts_K_Severe =>
                    return "severe";
                when others =>
                    return "severity" & Unsigned_Longword'Image (Answer);
            end case;
        end Severity;

        function Message return String is
        begin
            return ", msg" & Unsigned_Longword'Image
                                (Condition_Handling.Msg_No (Status));
        end Message;

        function Fac_No return String is
            Answer : Unsigned_Longword;
        begin
            Answer := Condition_Handling.Fac_No (Status);

            if Vms."=" (Answer, 0) then
                return "";
            else
                return ", facility" & Unsigned_Longword'Image (Answer);
            end if;
        end Fac_No;

    begin
        return "(" & Severity & Fac_No & Message & ")";
    end Image;

    function Success (Status : Cond_Value_Type) return Boolean is
    begin
        return Condition_Handling.Success (Status);
    end Success;

    function Message_Number (Status : Cond_Value_Type) return Integer is
    begin
        return Integer (Condition_Handling.Code (Status));
    end Message_Number;

    procedure Qiow (Status : out Cond_Value_Type;
                    Efn : in Ef_Number_Type := Ef_Number_Zero;
                    Chan : in Channel_Type;
                    Func : in Function_Code_Type;
                    Iosb : in Address := Address_Zero;
                    P1 : in Unsigned_Longword := 0;
                    P2 : in Unsigned_Longword := 0;
                    P3 : in Unsigned_Longword := 0;
                    P4 : in Unsigned_Longword := 0;
                    P5 : in Unsigned_Longword := 0;
                    P6 : in Unsigned_Longword := 0) is
    begin
        Tasking_Services.Task_Qiow
           (Status, Efn, Chan, Func, Iosb, P1, P2, P3, P4, P5, P6);
    end Qiow;

    procedure Assign (Status : out Cond_Value_Type;
                      Devnam : in Device_Name_Type;
                      Chan : out Channel_Type) is
    begin
        Starlet.Assign (Status, Devnam, Chan);
    end Assign;

    procedure Assign (Status : out Cond_Value_Type;
                      Devnam : in Device_Name_Type;
                      Chan : out Channel_Type;
                      Acmode : in Access_Mode_Type) is
    begin
        Starlet.Assign (Status, Devnam, Chan, Acmode);
    end Assign;

    procedure Assign (Status : out Cond_Value_Type;
                      Devnam : in Device_Name_Type;
                      Chan : out Channel_Type;
                      Mbxnam : in Device_Name_Type) is
    begin
        Starlet.Assign (Status, Devnam, Chan, Mbxnam => Mbxnam);
    end Assign;

    procedure Assign (Status : out Cond_Value_Type;
                      Devnam : in Device_Name_Type;
                      Chan : out Channel_Type;
                      Acmode : in Access_Mode_Type;
                      Mbxnam : in Device_Name_Type) is
    begin
        Starlet.Assign (Status, Devnam, Chan, Acmode, Mbxnam);
    end Assign;

    procedure Dassgn (Status : out Cond_Value_Type;  -- return value
                      Chan : in Channel_Type) is
    begin
        Starlet.Dassgn (Status, Chan);
    end Dassgn;

    procedure Putmsg (Status : out Cond_Value_Type;         -- return value
                      Msgvec : in Unsigned_Longword_Array;
                      Actrtn : in Address := Address_Zero;
                      Facnam : in String := "";
                      Actprm : in User_Arg_Type := User_Arg_Zero) is
    begin
        Starlet.Putmsg (Status, Msgvec, Actrtn, Facnam, Actprm);
    end Putmsg;

    function To_Byte_Count (Size : Vms.Unsigned_Longword)
                           return Vms.Unsigned_Longword is
    begin
        return System."/" (Size, Unsigned_Longword (System.Storage_Unit));
    end To_Byte_Count;

    procedure Put_Msg (Status : out Cond_Value_Type;
                       Descriptors : Unsigned_Longword_Array;
                       Include_Message_Text : Boolean := True;
                       Include_Mnemonic_Name : Boolean := True;
                       Include_Severity_Level : Boolean := True;
                       Include_Facility_Prefix : Boolean := True;
                       Actrtn : in Address := Address_Zero;
                       Facnam : in String := "";
                       Actprm : in User_Arg_Type := User_Arg_Zero) is
        Msgvec : Unsigned_Longword_Array (0 .. Descriptors'Length);
    begin
        Msgvec (0) := Descriptors'Length;

        if Include_Message_Text then
            Msgvec (0) := Msgvec (0) + 2 ** 16;
        end if;

        if Include_Mnemonic_Name then
            Msgvec (0) := Msgvec (0) + 2 ** 17;
        end if;

        if Include_Severity_Level then
            Msgvec (0) := Msgvec (0) + 2 ** 18;
        end if;

        if Include_Facility_Prefix then
            Msgvec (0) := Msgvec (0) + 2 ** 19;
        end if;

        Msgvec (1 .. Msgvec'Last) := Descriptors;
        Putmsg (Status, Msgvec, Actrtn, Facnam, Actprm);
        Text_Io.Put_Line ("");
    end Put_Msg;

    procedure Put_Msg (Status : Cond_Value_Type) is
        Descriptors : Unsigned_Longword_Array (1 .. 1);
        Dont_Care : Cond_Value_Type;
    begin
        Descriptors (1) := Unsigned_Longword (Status);
        Put_Msg (Dont_Care, Descriptors => Descriptors);
    end Put_Msg;

end Vms;