home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / ada / gnat-3.05- / gnat-3 / gnat-3.05-i486-linux-elf-bin / rts / 2acemasp.adb < prev    next >
Encoding:
Text File  |  1996-06-07  |  6.9 KB  |  163 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                 GNU ADA RUNTIME LIBRARY (GNARL) COMPONENTS               --
  4. --                                                                          --
  5. -- 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--
  6. --                                                                          --
  7. --                                  B o d y                                 --
  8. --                                                                          --
  9. --                             $Revision: 1.1 $                             --
  10. --                                                                          --
  11. --   Copyright (C) 1991,1992,1993,1994,1995,1996 Florida State University   --
  12. --                                                                          --
  13. -- GNARL is free software; you can  redistribute it  and/or modify it under --
  14. -- terms of the  GNU General Public License as published  by the Free Soft- --
  15. -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16. -- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
  17. -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18. -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19. -- for  more details.  You should have  received  a copy of the GNU General --
  20. -- Public License  distributed with GNARL; see file COPYING.  If not, write --
  21. -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  22. -- MA 02111-1307, USA.                                                      --
  23. --                                                                          --
  24. -- As a special exception,  if other files  instantiate  generics from this --
  25. -- unit, or you link  this unit with other files  to produce an executable, --
  26. -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  27. -- covered  by the  GNU  General  Public  License.  This exception does not --
  28. -- however invalidate  any other reasons why  the executable file  might be --
  29. -- covered by the  GNU Public License.                                      --
  30. --                                                                          --
  31. -- GNARL was developed by the GNARL team at Florida State University. It is --
  32. -- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
  33. -- State University (http://www.gnat.com).                                  --
  34. --                                                                          --
  35. ------------------------------------------------------------------------------
  36.  
  37. --  This is the DEC Unix version of this package.
  38.  
  39. --  This file performs the system-dependent translation between machine
  40. --  exceptions and the Ada exceptions, if any, that should be raised when
  41. --  they occur.  This version works for the i486 running linux.
  42.  
  43. --  ??? This should not be part of tasking, since it is needed whether tasking
  44. --      is used or not.  This file will eventually go away or be incorporated
  45. --      into the non-tasking runtime.
  46.  
  47. with Interfaces.C; use Interfaces.C;
  48.  
  49. with Interfaces.C.POSIX_RTE;
  50.  
  51. package body System.Compiler_Exceptions.Machine_Specifics is
  52.  
  53.    package RTE renames Interfaces.C.POSIX_RTE;
  54.  
  55.    ------------------------
  56.    -- Identify_Exception --
  57.    ------------------------
  58.  
  59.    --  This function identifies the Ada exception to be raised using
  60.    --  the information when the system received a synchronous signal.
  61.    --  Since this function is machine and OS dependent, different code
  62.    --  has to be provided for different target.
  63.  
  64.    --  Following code is intended for DEC Alpha
  65.  
  66.    function Identify_Exception
  67.      (Which              : System.Task_Primitives.Machine_Exceptions;
  68.       Info               : System.Task_Primitives.Error_Information;
  69.       Modified_Registers : Pre_Call_State) return Ada.Exceptions.Exception_Id
  70.    is
  71.  
  72.       type regs_array is array (int range 1 .. 32) of long;
  73.  
  74.       type sigcontext is record
  75.         sc_onstack    : long;
  76.         sc_mask       : long;
  77.         sc_pc         : long;
  78.         sc_ps         : long;
  79.         sc_regs       : regs_array;
  80.         sc_ownedfp    : long;
  81.         sc_fpregs     : regs_array;
  82.         sc_fpcr       : unsigned_long;
  83.         sc_fp_control : unsigned_long;
  84.       end record;
  85.  
  86.       type sigcontext_ptr is access sigcontext;
  87.  
  88.       --  The above operations will be available as predefined operations on
  89.       --  the modula Address type in GNARL, since this package is a child of
  90.       --  System.
  91.  
  92.       FPE_INTOVF_TRAP         : constant int := 16#1#;
  93.       FPE_INTDIV_TRAP         : constant int := 16#2#;
  94.       FPE_FLTOVF_TRAP         : constant int := 16#3#;
  95.       FPE_FLTDIV_TRAP         : constant int := 16#4#;
  96.       FPE_FLTUND_TRAP         : constant int := 16#5#;
  97.       FPE_DECOVF_TRAP         : constant int := 16#6#;
  98.       FPE_SUBRNG_TRAP         : constant int := 16#7#;
  99.       FPE_FLTOVF_FAULT        : constant int := 16#8#;
  100.       FPE_FLTDIV_FAULT        : constant int := 16#9#;
  101.       FPE_FLTUND_FAULT        : constant int := 16#a#;
  102.       FPE_UNIMP_FAULT         : constant int := 16#b#;
  103.       FPE_INVALID_FAULT       : constant int := 16#c#;
  104.       FPE_INEXACT_FAULT       : constant int := 16#d#;
  105.       FPE_HPARITH_TRAP        : constant int := 16#e#;
  106.       FPE_INTOVF_FAULT        : constant int := 16#f#;
  107.       FPE_ILLEGAL_SHADOW_TRAP : constant int := 16#10#;
  108.       FPE_GENTRAP             : constant int := 16#11#;
  109.  
  110.       function Pre_Call_To_Context is new
  111.         Unchecked_Conversion (Pre_Call_State, sigcontext_ptr);
  112.  
  113.  
  114.       Current_Exception : Ada.Exceptions.Exception_Id;
  115.  
  116.       context : sigcontext_ptr :=
  117.                   Pre_Call_To_Context (Modified_Registers);
  118.  
  119.       sig     : RTE.Signal := RTE.Signal (Which);
  120.  
  121.    begin
  122.  
  123.       --  As long as we are using a longjmp to return control to the
  124.       --  exception handler on the runtime stack, we are safe. The original
  125.       --  signal mask (the one we had before coming into this signal catching
  126.       --  function) will be restored by the longjmp. Therefore, raising
  127.       --  an exception in this handler should be a safe operation.
  128.  
  129.       case sig is
  130.  
  131.          when RTE.SIGFPE =>
  132.  
  133.             Current_Exception := Constraint_Error_Id;
  134.  
  135.          when RTE.SIGILL =>
  136.  
  137.             case Info.si_code is
  138.  
  139.                when others =>
  140.  
  141.                   pragma Assert (false, "Unexpected SIGILL signal");
  142.                   null;
  143.             end case;
  144.  
  145.          when RTE.SIGSEGV =>
  146.  
  147.             Current_Exception := Storage_Error_Id;
  148.  
  149.          --  If the address that caused the error was in the first page, this
  150.          --  was caused by accessing a null pointer.
  151.  
  152.          when others =>
  153.  
  154.             pragma Assert (false, "Unexpected signal");
  155.             null;
  156.       end case;
  157.  
  158.       return Current_Exception;
  159.  
  160.    end Identify_Exception;
  161.  
  162. end System.Compiler_Exceptions.Machine_Specifics;
  163.