DataMuseum.dk

top - download

    Length: 4353 (0x1101)
    Types: TextFile
    Names: »B«

└─⟦afbc8121e⟧ Bits:30000532 8mm tape, Rational 1000, MC68020_OS2000 7_2_2
    └─ ⟦77aa8350c⟧ »DATA« 
        └─⟦f794ecd1d⟧ 
            └─⟦24d1ddd49⟧ 
                └─⟦this⟧ 

TextFile

--    The use of this system is subject to the software license terms and
--    conditions agreed upon between Rational and the Customer.
--
--                Copyright 1988 by Rational.
--
--                          RESTRICTED RIGHTS LEGEND
--
--    Use, duplication, or disclosure by the Government is subject to
--    restrictions as set forth in subdivision (b)(3)(ii) of the Rights in
--    Technical Data and Computer Software clause at 52.227-7013.
--
--
--                Rational
--                3320 Scott Boulevard
--                Santa Clara, California 95054-3197
--
--   PROPRIETARY AND CONFIDENTIAL INFORMATION OF RATIONAL;
--   USE OR COPYING WITHOUT EXPRESS WRITTEN AUTHORIZATION
--   IS STRICTLY PROHIBITED.  THIS MATERIAL IS PROTECTED AS
--   AN UNPUBLISHED WORK UNDER THE U.S. COPYRIGHT ACT OF
--   1976.  CREATED 1988.  ALL RIGHTS RESERVED.
--
--

separate (Task_Management)
package body Runtime_Exceptions is

    pragma Suppress_All;

    procedure Raise_Exception is
        pragma Routine_Number (Runtime_Ids.Internal);
    begin
        Release_Lock;
        Exceptions.Raise_Exception;
    end Raise_Exception;


    procedure Raise_Runtime_Error (Caller       : String;
                                   Msg          : String;
                                   Error        : Runtime_Error.Fatal_Error;
                                   Current_Task : Task_Id) is
        pragma Routine_Number (Runtime_Ids.Internal);
    begin
        Runtime_Error.Report (Error);

        if Debug_Mode then
            Debugging.Put_Message ("Task_Management." & Caller &
                                   " raising Runtime_Error: " & Msg);
        end if;

        Release_Lock;

        raise Exceptions.Runtime_Error;
    end Raise_Runtime_Error;


    procedure Raise_Abnormal_Task_Error (Current_Task : Task_Id) is
        pragma Routine_Number (Runtime_Ids.Internal);
    begin
        if Debug_Mode then
            Debugging.Put_Message ("Raising Abnormal_Task_Error");
        end if;

        Current_Task.Exception_Id := null;
        Release_Lock;
        Exceptions.Raise_Exception;
    end Raise_Abnormal_Task_Error;


    procedure Check_For_Abnormality (Current_Task : Task_Id) is
        pragma Routine_Number (Runtime_Ids.Internal);
    begin
        if Current_Task.Action_State (Abnormal) then
            Raise_Abnormal_Task_Error (Current_Task => Current_Task);
        end if;
    end Check_For_Abnormality;


    procedure Raise_Tasking_Error is
        pragma Routine_Number (Runtime_Ids.Internal);
    begin
        if Debug_Mode then
            Debugging.Put_Message ("Raising Tasking_Error");
        end if;

        Release_Lock;

        raise Tasking_Error;
    end Raise_Tasking_Error;


    procedure Raise_Storage_Error is
        pragma Routine_Number (Runtime_Ids.Internal);
    begin
        if Debug_Mode then
            Debugging.Put_Message ("Raising Storage_Error");
        end if;

        Release_Lock;

        raise Storage_Error;
    end Raise_Storage_Error;


    procedure Raise_Program_Error is
        pragma Routine_Number (Runtime_Ids.Internal);
    begin
        if Debug_Mode then
            Debugging.Put_Message ("Raising Program_Error");
        end if;

        Release_Lock;

        raise Program_Error;
    end Raise_Program_Error;


    procedure Raise_Force_Term_Error (Current_Task : Task_Id) is
        pragma Routine_Number (Runtime_Ids.Internal);
    begin
        if Debug_Mode then
            Debugging.Put_Message ("Raising Force_Term_Error");
        end if;

        Current_Task.Exception_Id := null;
        Release_Lock;
        Exceptions.Raise_Exception;
    end Raise_Force_Term_Error;


    procedure Check_For_Pending_Exception (Current_Task : Task_Id) is
        pragma Routine_Number (Runtime_Ids.Internal);
    begin
        Check_For_Abnormality (Current_Task => Current_Task);
        if Current_Task.Action_State (Exception_Pending) then
            if Debug_Mode then
                Debugging.Put_Message ("Reraising exception");
            end if;

            Release_Lock;
            Exceptions.Raise_Exception;
        end if;
    end Check_For_Pending_Exception;

end Runtime_Exceptions;
pragma Runtime_Unit (Unit_Number         => Runtime_Ids.Runtime_Compunit,
                     Elab_Routine_Number => Runtime_Ids.Internal);