home *** CD-ROM | disk | FTP | other *** search
- -----------------------------------------------------------------------------
- -- --
- -- GNU ADA RUNTIME LIBRARY (GNARL) COMPONENTS --
- -- --
- -- C O M P I L E R _ E X C E P T I O N S . M A C H I N E _ S P E C I F I C S--
- -- --
- -- B o d y --
- -- --
- -- $Revision: 1.4 $ --
- -- --
- -- Copyright (c) 1991,1992,1993,1994, FSU, All Rights Reserved --
- -- --
- -- GNARL is free software; you can redistribute it and/or modify it under --
- -- terms of the GNU Library General Public License as published by the --
- -- Free Software Foundation; either version 2, or (at your option) any --
- -- later version. GNARL is distributed in the hope that it will be use- --
- -- ful, but but WITHOUT ANY WARRANTY; without even the implied warranty of --
- -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Gen- --
- -- eral Library Public License for more details. You should have received --
- -- a copy of the GNU Library General Public License along with GNARL; see --
- -- file COPYING.LIB. If not, write to the Free Software Foundation, 675 --
- -- Mass Ave, Cambridge, MA 02139, USA. --
- -- --
- ------------------------------------------------------------------------------
-
- with Interfaces.C; use Interfaces.C;
-
- with Interfaces.C.POSIX_RTE;
-
- package body System.Compiler_Exceptions.Machine_Specifics is
-
- package RTE renames Interfaces.C.POSIX_RTE;
-
- ------------------------
- -- Identify_Exception --
- ------------------------
-
- -- This function identifies the Ada exception to be raised using
- -- the information when the system received a synchronous signal.
- -- Since this function is machine and OS dependent, different code
- -- has to be provided for different target.
-
- -- Following code is intended for SunOS on Sparcstation.
-
- function Identify_Exception
- (Which : System.Task_Primitives.Machine_Exceptions;
- Info : System.Task_Primitives.Error_Information;
- Modified_Registers : Pre_Call_State) return Exception_ID is
-
- SPARC_MAXREGWINDOW : constant := 31;
-
- type sc_spbuf_t is array (1 .. SPARC_MAXREGWINDOW) of System.Address;
-
- type sc_wbuf_t is array (1 .. SPARC_MAXREGWINDOW, 1 .. 16) of int;
-
- type sigcontext is record
- sc_onstack : int; -- sigstack state to restore
- sc_mask : int; -- signal mask to restore
- sc_sp : System.Address; -- sp to restore
- sc_pc : System.Address; -- pc to restore
- sc_npc : System.Address; -- next pc to restore
- sc_psr : int; -- psr to restore
- sc_g1 : int; -- register that must be restored
- sc_o0 : int;
- sc_wbcnt : int; -- number of outstanding windows
- sc_spbuf : sc_spbuf_t; -- sp's for each wbuf (in C is char *)
- sc_wbuf : sc_wbuf_t; -- window save buf
- end record;
-
- type sigcontext_ptr is access sigcontext;
-
- -- The above operations will be available as predefined operations on
- -- the modula Address type in GNARL, since this package is a child of
- -- System.
-
- FPE_INTOVF_TRAP : constant int := 16#1#; -- Int overflow
- FPE_STARTSIG_TRAP : constant int := 16#2#; -- process using fp
- FPE_INTDIV_TRAP : constant int := 16#14#; -- Int divide by zero
- FPE_FLTINEX_TRAP : constant int := 16#c4#; -- floating inexact result
- FPE_FLTDIV_TRAP : constant int := 16#c8#; -- floating divide by zero
- FPE_FLTUND_TRAP : constant int := 16#cc#; -- floating underflow
- FPE_FLTOPERR_TRAP : constant int := 16#d0#; -- floating operand error
- FPE_FLTOVF_TRAP : constant int := 16#d4#; -- floating overflow
-
- -- Following is SIGILL generated by trap 5 instruction
-
- ILL_CHECK_TRAP : constant int := 16#80# + 16#05#;
-
- function Pre_Call_To_Context is new
- Unchecked_Conversion (Pre_Call_State, sigcontext_ptr);
-
-
- Current_Exception : Exception_ID;
-
- context : sigcontext_ptr :=
- Pre_Call_To_Context (Modified_Registers);
-
- sig : RTE.Signal := RTE.Signal (Which);
-
- begin
-
- -- As long as we are using a longjmp to return control to the
- -- exception handler on the runtime stack, we are safe. The original
- -- signal mask (the one we had before coming into this signal catching
- -- function) will be restored by the longjmp. Therefore, raising
- -- an exception in this handler should be a safe operation.
-
- case sig is
-
- when RTE.SIGFPE =>
-
- case Info.si_code is
-
- when FPE_INTDIV_TRAP | FPE_FLTINEX_TRAP |
- FPE_FLTDIV_TRAP | FPE_FLTUND_TRAP |
- FPE_FLTOVF_TRAP =>
- Current_Exception := Numeric_Error_ID;
-
- when FPE_FLTOPERR_TRAP =>
- Current_Exception := Constraint_Error_ID;
-
- when FPE_INTOVF_TRAP =>
- Current_Exception := Constraint_Error_ID;
-
- when others =>
-
- pragma Assert (false, "Unexpected SIGFPE signal");
- null;
- end case;
-
- when RTE.SIGILL =>
-
- case Info.si_code is
-
- when ILL_CHECK_TRAP =>
- Current_Exception := Constraint_Error_ID;
-
- when others =>
-
- pragma Assert (false, "Unexpected SIGILL signal");
- null;
- end case;
-
- when RTE.SIGSEGV =>
-
- -- If the address that caused the error was in the first page, this
- -- was caused by accessing a null pointer.
-
- if context.sc_o0 >= 0 and context.sc_o0 < 16#2000# then
- Current_Exception := Constraint_Error_ID;
-
- else
- Current_Exception := Storage_Error_ID;
- end if;
-
- when others =>
-
- pragma Assert (false, "Unexpected signal");
- null;
- end case;
-
- return Current_Exception;
-
- end Identify_Exception;
-
- end System.Compiler_Exceptions.Machine_Specifics;
-