-- ali files, showing whether a restriction pragma exists anywhere, and
-- accumulating the aggregate knowledge of violations.
+ Stack_Check_Switch_Set : Boolean := False;
+ -- Set to True if at least one ALI file contains '-fstack-check' in its
+ -- argument list.
+
Static_Elaboration_Model_Used : Boolean := False;
-- Set to False by Initialize_ALI. Set to True if any ALI file for a
-- non-internal unit compiled with the static elaboration model is
* *
* C Header File *
* *
- * Copyright (C) 1992-2006, Free Software Foundation, Inc. *
+ * Copyright (C) 1992-2007, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
#define No_Exception_Handlers_Set restrict__no_exception_handlers_set
#define Check_No_Implicit_Heap_Alloc restrict__check_no_implicit_heap_alloc
#define Check_Elaboration_Code_Allowed restrict__check_elaboration_code_allowed
+#define Check_Implicit_Dynamic_Code_Allowed restrict__check_implicit_dynamic_code_allowed
extern Boolean No_Exception_Handlers_Set (void);
extern void Check_No_Implicit_Heap_Alloc (Node_Id);
extern void Check_Elaboration_Code_Allowed (Node_Id);
+extern void Check_Implicit_Dynamic_Code_Allowed (Node_Id);
/* sem_elim: */
/* targparm: */
#define Stack_Check_Probes_On_Target targparm__stack_check_probes_on_target
+#define Stack_Check_Limits_On_Target targparm__stack_check_limits_on_target
extern Boolean Stack_Check_Probes_On_Target;
+extern Boolean Stack_Check_Limits_On_Target;
msg = "SIGBUS: possible stack overflow";
break;
#else
+#ifdef __RTP__
+ /* In RTP mode a SIGSEGV is most likely due to a stack overflow,
+ since stack checking uses the probing mechanism. */
case SIGILL:
exception = &constraint_error;
msg = "SIGILL";
break;
-/* In RTP mode a SIGSEGV is most likely due to a stack overflow. This is not
- the case in kernel mode where stack overflow detection uses a comparison
- method instead of memory probes. */
-#ifdef __RTP__
case SIGSEGV:
exception = &storage_error;
msg = "SIGSEGV: possible stack overflow";
break;
#else
+ /* In kernel mode a SIGILL is most likely due to a stack overflow,
+ since stack checking uses the stack limit mechanism. */
+ case SIGILL:
+ exception = &storage_error;
+ msg = "SIGILL: possible stack overflow";
+ break;
case SIGSEGV:
exception = &program_error;
msg = "SIGSEGV";
#endif
}
+/* This subprogram is called by System.Task_Primitives.Operations.Enter_Task
+ (if not null) when a new task is created. It is initialized by
+ System.Stack_Checking.Operations.Initialize_Stack_Limit.
+ The use of a hook avoids to drag stack checking subprograms if stack
+ checking is not used. */
+void (*__gnat_set_stack_limit_hook)(void) = (void (*)(void))0;
+
+
/******************/
/* NetBSD Section */
/******************/
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
+-- --
+-- S Y S T E M . S T A C K _ C H E C K I N G . O P E R A T I O N S --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1999-2007, Free Software Foundation, Inc. --
+-- --
+-- GNARL is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNARL; see file COPYING. If not, write --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- however invalidate any other reasons why the executable file might be --
+-- covered by the GNU Public License. --
+-- --
+-- GNARL was developed by the GNARL team at Florida State University. --
+-- Extensive contributions were provided by Ada Core Technologies, Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This version of this package is for implementations which use
+-- the stack limit approach (the limit of the stack is stored into a per
+-- thread variable).
+
+pragma Restrictions (No_Elaboration_Code);
+-- We want to guarantee the absence of elaboration code because the binder
+-- does not handle references to this package.
+
+pragma Polling (Off);
+-- Turn off polling, we do not want polling to take place during stack
+-- checking operations. It causes infinite loops and other problems.
+
+package System.Stack_Checking.Operations is
+ pragma Preelaborate;
+
+ procedure Initialize_Stack_Limit;
+ pragma Export (C, Initialize_Stack_Limit,
+ "__gnat_initialize_stack_limit");
+ -- This procedure is called before elaboration to setup the stack limit
+ -- for the environment task and to register the hook to be called at
+ -- task creation.
+end System.Stack_Checking.Operations;
-- We want to guarantee the absence of elaboration code because the
-- binder does not handle references to this package.
-with Ada.Exceptions;
-
with System.Storage_Elements; use System.Storage_Elements;
with System.Parameters; use System.Parameters;
-with System.Soft_Links;
with Interfaces.C;
package body System.Stack_Checking.Operations is
-- * selecting INCLUDE_TASK_SHOW when using the Tornado project
-- facility.
- function Set_Stack_Info
- (Stack : not null access Stack_Access) return Stack_Access;
-
- -- The function Set_Stack_Info is the actual function that updates the
- -- cache containing a pointer to the Stack_Info. It may also be used for
- -- detecting asynchronous abort in combination with Invalidate_Self_Cache.
-
- -- Set_Stack_Info should do the following things in order:
- -- 1) Get the Stack_Access value for the current task
- -- 2) Set Stack.all to the value obtained in 1)
- -- 3) Optionally Poll to check for asynchronous abort
-
- -- This order is important because if at any time a write to the stack
- -- cache is pending, that write should be followed by a Poll to prevent
- -- loosing signals.
-
- -- Note: This function must be compiled with Polling turned off
-
- -- Note: on systems like VxWorks and Linux with real thread-local storage,
- -- Set_Stack_Info should return an access value for such local
- -- storage. In those cases the cache will always be up-to-date.
-
- -- The following constants should be imported from some system-specific
- -- constants package. The constants must be static for performance reasons.
-
- ----------------------------
- -- Invalidate_Stack_Cache --
- ----------------------------
-
- procedure Invalidate_Stack_Cache (Any_Stack : Stack_Access) is
- pragma Warnings (Off, Any_Stack);
- begin
- Cache := Null_Stack;
- end Invalidate_Stack_Cache;
+ Stack_Limit : Address :=
+ Boolean'Pos (Stack_Grows_Down) * Address'First
+ + Boolean'Pos (not Stack_Grows_Down) * Address'Last;
+ pragma Export (C, Stack_Limit, "__gnat_stack_limit");
+ -- Stack_Limit contains the limit of the stack. This variable is later made
+ -- a task variable (by calling taskVarAdd) and then correctly set to the
+ -- stack limit of the task. Before being so initialized its value must be
+ -- valid so that any subprogram with stack checking enabled will run. We
+ -- use extreme values according to the direction of the stack.
+
+ type Set_Stack_Limit_Proc_Acc is access procedure;
+ pragma Convention (C, Set_Stack_Limit_Proc_Acc);
+
+ Set_Stack_Limit_Hook : Set_Stack_Limit_Proc_Acc;
+ pragma Import (C, Set_Stack_Limit_Hook, "__gnat_set_stack_limit_hook");
+ -- Procedure to be called when a task is created to set stack
+ -- limit.
+
+ procedure Set_Stack_Limit_For_Current_Task;
+ pragma Convention (C, Set_Stack_Limit_For_Current_Task);
+ -- Register Initial_SP as the initial stack pointer value for the current
+ -- task when it starts and Size as the associated stack area size. This
+ -- should be called once, after the soft-links have been initialized?
-----------------------------
- -- Notify_Stack_Attributes --
+ -- Initialize_Stack_Limit --
-----------------------------
- procedure Notify_Stack_Attributes
- (Initial_SP : System.Address;
- Size : System.Storage_Elements.Storage_Offset)
- is
- -- We retrieve the attributes directly from Set_Stack_Info below, so
- -- this implementation has nothing to do.
+ procedure Initialize_Stack_Limit is
+ begin
+ -- For the environment task.
+ Set_Stack_Limit_For_Current_Task;
- pragma Unreferenced (Initial_SP);
- pragma Unreferenced (Size);
+ -- Will be called by every created task.
+ Set_Stack_Limit_Hook := Set_Stack_Limit_For_Current_Task'Access;
+ end Initialize_Stack_Limit;
- begin
- null;
- end Notify_Stack_Attributes;
+ --------------------------------------
+ -- Set_Stack_Limit_For_Current_Task --
+ --------------------------------------
+
+ procedure Set_Stack_Limit_For_Current_Task is
+ use Interfaces.C;
- --------------------
- -- Set_Stack_Info --
- --------------------
+ -- Import from VxWorks.
+ function Task_Var_Add (Tid : Interfaces.C.int; Var : Address)
+ return Interfaces.C.int;
+ pragma Import (C, Task_Var_Add, "taskVarAdd");
- function Set_Stack_Info
- (Stack : not null access Stack_Access) return Stack_Access
- is
type OS_Stack_Info is record
Size : Interfaces.C.int;
Base : System.Address;
-- Procedure that fills the stack information associated to the
-- currently executing task.
- My_Stack : Stack_Access;
- Task_Info : aliased OS_Stack_Info;
+ Stack_Info : aliased OS_Stack_Info;
+ Limit : System.Address;
begin
- -- The order of steps 1 .. 3 is important, see specification
-
- -- 1) Get the Stack_Access value for the current task
-
- My_Stack := Soft_Links.Get_Stack_Info.all;
-
- if My_Stack.Base = Null_Address then
-
- -- First invocation. Ask the VxWorks kernel about stack values
-
- Get_Stack_Info (Task_Info'Access);
-
- My_Stack.Size := Storage_Elements.Storage_Offset (Task_Info.Size);
- My_Stack.Base := Task_Info.Base;
- My_Stack.Limit := Task_Info.Limit;
+ -- Get stack bounds from VxWorks.
+ Get_Stack_Info (Stack_Info'Access);
+ if Stack_Grows_Down then
+ Limit := Stack_Info.Base - Storage_Offset (Stack_Info.Size);
+ else
+ Limit := Stack_Info.Base + Storage_Offset (Stack_Info.Size);
end if;
- -- 2) Set Stack.all to the value obtained in 1)
-
- Stack.all := My_Stack;
-
- -- 3) Optionally Poll to check for asynchronous abort
-
- if Soft_Links.Check_Abort_Status.all /= 0 then
- raise Standard'Abort_Signal;
- end if;
-
- -- Never trust the cached value, return local copy!
-
- return My_Stack;
- end Set_Stack_Info;
-
- -----------------
- -- Stack_Check --
- -----------------
-
- function Stack_Check
- (Stack_Address : System.Address) return Stack_Access
- is
- type Frame_Marker is null record;
-
- Marker : Frame_Marker;
- Cached_Stack : constant Stack_Access := Cache;
- Frame_Address : constant System.Address := Marker'Address;
-
- begin
- -- The parameter may have wrapped around in System.Address arithmetics.
- -- In that case, we have no other choices than raising the exception.
-
- if (Stack_Grows_Down and then Stack_Address > Frame_Address)
- or else (not Stack_Grows_Down and then Stack_Address < Frame_Address)
- then
- Ada.Exceptions.Raise_Exception
- (E => Storage_Error'Identity,
- Message => "stack overflow detected");
- end if;
-
- -- This function first does a "cheap" check which is correct if it
- -- succeeds. In case of failure, the full check is done. Ideally the
- -- cheap check should be done in an optimized manner, or be inlined.
-
- if (Stack_Grows_Down
- and then Frame_Address <= Cached_Stack.Base
- and then Stack_Address > Cached_Stack.Limit)
- or else (not Stack_Grows_Down
- and then Frame_Address >= Cached_Stack.Base
- and then Stack_Address < Cached_Stack.Limit)
- then
- -- Cached_Stack is valid as it passed the stack check
-
- return Cached_Stack;
- end if;
-
- Full_Check :
- declare
- My_Stack : constant Stack_Access := Set_Stack_Info (Cache'Access);
- -- At this point Stack.all might already be invalid, so it is
- -- essential to use our local copy of Stack!
-
- begin
- if (Stack_Grows_Down
- and then Stack_Address < My_Stack.Limit)
- or else (not Stack_Grows_Down
- and then Stack_Address > My_Stack.Limit)
- then
- Ada.Exceptions.Raise_Exception
- (E => Storage_Error'Identity,
- Message => "stack overflow detected");
- end if;
-
- return My_Stack;
- end Full_Check;
- end Stack_Check;
-
- ------------------------
- -- Update_Stack_Cache --
- ------------------------
-
- procedure Update_Stack_Cache (Stack : Stack_Access) is
- begin
- if not Multi_Processor then
- Cache := Stack;
+ -- Note: taskVarAdd implicitly calls taskVarInit if required.
+ if Task_Var_Add (0, Stack_Limit'Address) = 0 then
+ Stack_Limit := Limit;
end if;
- end Update_Stack_Cache;
+ end Set_Stack_Limit_For_Current_Task;
end System.Stack_Checking.Operations;
-- Set the stack cache for the current task. Note that this is only for
-- optimization purposes, nothing can be assumed about the contents of the
-- cache at any time, see Set_Stack_Info.
+ --
+ -- The stack cache should contain the bounds of the current task. But
+ -- because the RTS is not aware of task switches, the stack cache may be
+ -- incorrect. So when the stack pointer is not within the bounds of the
+ -- stack cache, Stack_Check first update the cache (which is a costly
+ -- operation hence the need of a cache).
procedure Invalidate_Stack_Cache (Any_Stack : Stack_Access);
-- Invalidate cache entries for the task T that owns Any_Stack. This causes
Foreign_Task_Elaborated : aliased Boolean := True;
-- Used to identified fake tasks (i.e., non-Ada Threads)
+ type Set_Stack_Limit_Proc_Acc is access procedure;
+ pragma Convention (C, Set_Stack_Limit_Proc_Acc);
+
+ Set_Stack_Limit_Hook : Set_Stack_Limit_Proc_Acc;
+ pragma Import (C, Set_Stack_Limit_Hook, "__gnat_set_stack_limit_hook");
+ -- Procedure to be called when a task is created to set stack
+ -- limit.
+
--------------------
-- Local Packages --
--------------------
end loop;
Unlock_RTS;
+
+ -- If stack checking is enabled set the stack limit for this task.
+ if Set_Stack_Limit_Hook /= null then
+ Set_Stack_Limit_Hook.all;
+ end if;
end Enter_Task;
--------------
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := False;
Stack_Check_Probes : constant Boolean := True;
+ Stack_Check_Limits : constant Boolean := False;
Support_64_Bit_Divides : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;
+ Always_Compatible_Rep : constant Boolean := True;
+ Dynamic_Trampolines_Used : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False;
ZCX_By_Default : constant Boolean := False;
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := False;
Stack_Check_Probes : constant Boolean := False;
+ Stack_Check_Limits : constant Boolean := False;
Support_64_Bit_Divides : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;
+ Always_Compatible_Rep : constant Boolean := True;
+ Dynamic_Trampolines_Used : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False;
ZCX_By_Default : constant Boolean := True;
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := False;
Stack_Check_Probes : constant Boolean := False;
+ Stack_Check_Limits : constant Boolean := False;
Support_64_Bit_Divides : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;
+ Always_Compatible_Rep : constant Boolean := True;
+ Dynamic_Trampolines_Used : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False;
ZCX_By_Default : constant Boolean := True;
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := False;
Stack_Check_Probes : constant Boolean := True;
+ Stack_Check_Limits : constant Boolean := False;
Support_64_Bit_Divides : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;
+ Always_Compatible_Rep : constant Boolean := True;
+ Dynamic_Trampolines_Used : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False;
ZCX_By_Default : constant Boolean := True;
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := False;
Stack_Check_Probes : constant Boolean := True;
+ Stack_Check_Limits : constant Boolean := False;
Support_64_Bit_Divides : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;
+ Always_Compatible_Rep : constant Boolean := True;
+ Dynamic_Trampolines_Used : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False;
ZCX_By_Default : constant Boolean := False;
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := False;
Stack_Check_Probes : constant Boolean := True;
+ Stack_Check_Limits : constant Boolean := False;
Support_64_Bit_Divides : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;
+ Always_Compatible_Rep : constant Boolean := True;
+ Dynamic_Trampolines_Used : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False;
ZCX_By_Default : constant Boolean := True;
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := False;
Stack_Check_Probes : constant Boolean := True;
+ Stack_Check_Limits : constant Boolean := False;
Support_64_Bit_Divides : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;
+ Always_Compatible_Rep : constant Boolean := True;
+ Dynamic_Trampolines_Used : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False;
ZCX_By_Default : constant Boolean := True;
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := False;
Stack_Check_Probes : constant Boolean := True;
+ Stack_Check_Limits : constant Boolean := False;
Support_64_Bit_Divides : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;
+ Always_Compatible_Rep : constant Boolean := True;
+ Dynamic_Trampolines_Used : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False;
ZCX_By_Default : constant Boolean := True;
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := False;
Stack_Check_Probes : constant Boolean := False;
+ Stack_Check_Limits : constant Boolean := False;
Support_64_Bit_Divides : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;
+ Always_Compatible_Rep : constant Boolean := True;
+ Dynamic_Trampolines_Used : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False;
ZCX_By_Default : constant Boolean := True;
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := False;
Stack_Check_Probes : constant Boolean := True;
+ Stack_Check_Limits : constant Boolean := False;
Support_64_Bit_Divides : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;
+ Always_Compatible_Rep : constant Boolean := True;
+ Dynamic_Trampolines_Used : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False;
ZCX_By_Default : constant Boolean := True;
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := False;
Stack_Check_Probes : constant Boolean := False;
+ Stack_Check_Limits : constant Boolean := False;
Support_64_Bit_Divides : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;
+ Always_Compatible_Rep : constant Boolean := True;
+ Dynamic_Trampolines_Used : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False;
ZCX_By_Default : constant Boolean := True;
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := False;
Stack_Check_Probes : constant Boolean := False;
+ Stack_Check_Limits : constant Boolean := False;
Support_64_Bit_Divides : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;
+ Always_Compatible_Rep : constant Boolean := True;
+ Dynamic_Trampolines_Used : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False;
ZCX_By_Default : constant Boolean := True;
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := False;
Stack_Check_Probes : constant Boolean := False;
+ Stack_Check_Limits : constant Boolean := False;
Support_64_Bit_Divides : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;
+ Always_Compatible_Rep : constant Boolean := True;
+ Dynamic_Trampolines_Used : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False;
ZCX_By_Default : constant Boolean := True;
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := False;
Stack_Check_Probes : constant Boolean := False;
+ Stack_Check_Limits : constant Boolean := False;
Support_64_Bit_Divides : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;
+ Always_Compatible_Rep : constant Boolean := True;
+ Dynamic_Trampolines_Used : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False;
ZCX_By_Default : constant Boolean := False;
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := False;
Stack_Check_Probes : constant Boolean := False;
+ Stack_Check_Limits : constant Boolean := False;
Support_64_Bit_Divides : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;
+ Always_Compatible_Rep : constant Boolean := True;
+ Dynamic_Trampolines_Used : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False;
ZCX_By_Default : constant Boolean := False;
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := False;
Stack_Check_Probes : constant Boolean := True;
+ Stack_Check_Limits : constant Boolean := False;
Support_64_Bit_Divides : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;
+ Always_Compatible_Rep : constant Boolean := True;
+ Dynamic_Trampolines_Used : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False;
ZCX_By_Default : constant Boolean := False;
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := False;
Stack_Check_Probes : constant Boolean := True;
+ Stack_Check_Limits : constant Boolean := False;
Support_64_Bit_Divides : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;
+ Always_Compatible_Rep : constant Boolean := True;
+ Dynamic_Trampolines_Used : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False;
ZCX_By_Default : constant Boolean := True;
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := False;
Stack_Check_Probes : constant Boolean := True;
+ Stack_Check_Limits : constant Boolean := False;
Support_64_Bit_Divides : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;
+ Always_Compatible_Rep : constant Boolean := True;
+ Dynamic_Trampolines_Used : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False;
ZCX_By_Default : constant Boolean := True;
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := False;
Stack_Check_Probes : constant Boolean := True;
+ Stack_Check_Limits : constant Boolean := False;
Support_64_Bit_Divides : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;
+ Always_Compatible_Rep : constant Boolean := True;
+ Dynamic_Trampolines_Used : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False;
ZCX_By_Default : constant Boolean := True;
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := True;
Stack_Check_Probes : constant Boolean := True;
+ Stack_Check_Limits : constant Boolean := False;
Support_64_Bit_Divides : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;
+ Always_Compatible_Rep : constant Boolean := True;
+ Dynamic_Trampolines_Used : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False;
ZCX_By_Default : constant Boolean := True;
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := True;
Stack_Check_Probes : constant Boolean := True;
+ Stack_Check_Limits : constant Boolean := False;
Support_64_Bit_Divides : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;
+ Always_Compatible_Rep : constant Boolean := True;
+ Dynamic_Trampolines_Used : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False;
ZCX_By_Default : constant Boolean := True;
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := True;
Stack_Check_Probes : constant Boolean := True;
+ Stack_Check_Limits : constant Boolean := False;
Support_64_Bit_Divides : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;
+ Always_Compatible_Rep : constant Boolean := True;
+ Dynamic_Trampolines_Used : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False;
ZCX_By_Default : constant Boolean := True;
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := True;
Stack_Check_Probes : constant Boolean := True;
+ Stack_Check_Limits : constant Boolean := False;
Support_64_Bit_Divides : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;
+ Always_Compatible_Rep : constant Boolean := True;
+ Dynamic_Trampolines_Used : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False;
ZCX_By_Default : constant Boolean := True;
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := True;
Stack_Check_Probes : constant Boolean := True;
+ Stack_Check_Limits : constant Boolean := False;
Support_64_Bit_Divides : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;
+ Always_Compatible_Rep : constant Boolean := True;
+ Dynamic_Trampolines_Used : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False;
ZCX_By_Default : constant Boolean := True;
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := False;
Stack_Check_Probes : constant Boolean := False;
+ Stack_Check_Limits : constant Boolean := True;
Support_64_Bit_Divides : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;
+ Always_Compatible_Rep : constant Boolean := True;
+ Dynamic_Trampolines_Used : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := True;
ZCX_By_Default : constant Boolean := False;
Signed_Zeros : constant Boolean := False;
Stack_Check_Default : constant Boolean := False;
Stack_Check_Probes : constant Boolean := False;
+ Stack_Check_Limits : constant Boolean := True;
Support_64_Bit_Divides : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;
+ Always_Compatible_Rep : constant Boolean := True;
+ Dynamic_Trampolines_Used : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := True;
ZCX_By_Default : constant Boolean := False;
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := False;
Stack_Check_Probes : constant Boolean := False;
+ Stack_Check_Limits : constant Boolean := True;
Support_64_Bit_Divides : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;
+ Always_Compatible_Rep : constant Boolean := True;
+ Dynamic_Trampolines_Used : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := True;
ZCX_By_Default : constant Boolean := False;
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := False;
Stack_Check_Probes : constant Boolean := False;
+ Stack_Check_Limits : constant Boolean := True;
Support_64_Bit_Divides : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;
+ Always_Compatible_Rep : constant Boolean := True;
+ Dynamic_Trampolines_Used : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := True;
ZCX_By_Default : constant Boolean := False;
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := False;
Stack_Check_Probes : constant Boolean := False;
+ Stack_Check_Limits : constant Boolean := True;
Support_64_Bit_Divides : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;
+ Always_Compatible_Rep : constant Boolean := True;
+ Dynamic_Trampolines_Used : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := True;
ZCX_By_Default : constant Boolean := False;
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := False;
Stack_Check_Probes : constant Boolean := False;
+ Stack_Check_Limits : constant Boolean := True;
Support_64_Bit_Divides : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;
+ Always_Compatible_Rep : constant Boolean := True;
+ Dynamic_Trampolines_Used : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := True;
ZCX_By_Default : constant Boolean := False;
-- --
------------------------------------------------------------------------------
--- This version of System is a generic version that is used in building
--- the compiler. Right now, we have a host/target problem if we try to
--- use the "proper" System, and since the compiler itself does not care
--- about most System parameters, this generic version works fine.
+-- This version of System is a generic version that is used in building the
+-- compiler. Right now, we have a host/target problem if we try to use the
+-- "proper" System, and since the compiler itself does not care about most
+-- System parameters, this generic version works fine.
+
+pragma Restrictions (No_Implicit_Dynamic_Code);
+-- We want to avoid trampolines in the compiler, so it can be used in systems
+-- which prevent execution of code on the stack, e.g. in windows environments
+-- with DEP (Data Execution Protection) enabled.
package System is
pragma Pure;
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := False;
Stack_Check_Probes : constant Boolean := False;
+ Stack_Check_Limits : constant Boolean := False;
Support_64_Bit_Divides : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;
+ Always_Compatible_Rep : constant Boolean := True;
+ Dynamic_Trampolines_Used : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False;
ZCX_By_Default : constant Boolean := False;
type Targparm_Tags is
(AAM, -- AAMP
+ ACR, -- Always_Compatible_Rep
BDC, -- Backend_Divide_Checks
BOC, -- Backend_Overflow_Checks
CLA, -- Command_Line_Args
CRT, -- Configurable_Run_Times
D32, -- Duration_32_Bits
DEN, -- Denorm
+ DTU, -- Dynamic_Trampolines_Used
EXS, -- Exit_Status_Supported
FEL, -- Frontend_Layout
FFO, -- Fractional_Fixed_Ops
SCA, -- Support_Composite_Assign
SCC, -- Support_Composite_Compare
SCD, -- Stack_Check_Default
+ SCL, -- Stack_Check_Limits
SCP, -- Stack_Check_Probes
SLS, -- Support_Long_Shifts
SNZ, -- Signed_Zeros
-- The following list of string constants gives the parameter names
AAM_Str : aliased constant Source_Buffer := "AAMP";
+ ACR_Str : aliased constant Source_Buffer := "Always_Compatible_Rep";
BDC_Str : aliased constant Source_Buffer := "Backend_Divide_Checks";
BOC_Str : aliased constant Source_Buffer := "Backend_Overflow_Checks";
CLA_Str : aliased constant Source_Buffer := "Command_Line_Args";
CRT_Str : aliased constant Source_Buffer := "Configurable_Run_Time";
D32_Str : aliased constant Source_Buffer := "Duration_32_Bits";
DEN_Str : aliased constant Source_Buffer := "Denorm";
+ DTU_Str : aliased constant Source_Buffer := "Dynamic_Trampolines_Used";
EXS_Str : aliased constant Source_Buffer := "Exit_Status_Supported";
FEL_Str : aliased constant Source_Buffer := "Frontend_Layout";
FFO_Str : aliased constant Source_Buffer := "Fractional_Fixed_Ops";
SCA_Str : aliased constant Source_Buffer := "Support_Composite_Assign";
SCC_Str : aliased constant Source_Buffer := "Support_Composite_Compare";
SCD_Str : aliased constant Source_Buffer := "Stack_Check_Default";
+ SCL_Str : aliased constant Source_Buffer := "Stack_Check_Limits";
SCP_Str : aliased constant Source_Buffer := "Stack_Check_Probes";
SLS_Str : aliased constant Source_Buffer := "Support_Long_Shifts";
SNZ_Str : aliased constant Source_Buffer := "Signed_Zeros";
type Buffer_Ptr is access constant Source_Buffer;
Targparm_Str : constant array (Targparm_Tags) of Buffer_Ptr :=
(AAM_Str'Access,
+ ACR_Str'Access,
BDC_Str'Access,
BOC_Str'Access,
CLA_Str'Access,
CRT_Str'Access,
D32_Str'Access,
DEN_Str'Access,
+ DTU_Str'Access,
EXS_Str'Access,
FEL_Str'Access,
FFO_Str'Access,
SCA_Str'Access,
SCC_Str'Access,
SCD_Str'Access,
+ SCL_Str'Access,
SCP_Str'Access,
SLS_Str'Access,
SNZ_Str'Access,
raise Unrecoverable_Error;
end if;
- Targparm.Get_Target_Parameters
+ Get_Target_Parameters
(System_Text => Text,
Source_First => 0,
Source_Last => Hi);
case K is
when AAM => AAMP_On_Target := Result;
+ when ACR => Always_Compatible_Rep_On_Target := Result;
when BDC => Backend_Divide_Checks_On_Target := Result;
when BOC => Backend_Overflow_Checks_On_Target := Result;
when CLA => Command_Line_Args_On_Target := Result;
when CRT => Configurable_Run_Time_On_Target := Result;
when D32 => Duration_32_Bits_On_Target := Result;
when DEN => Denorm_On_Target := Result;
+ when DTU => Dynamic_Trampolines_Used_On_Target := Result;
when EXS => Exit_Status_Supported_On_Target := Result;
when FEL => Frontend_Layout_On_Target := Result;
when FFO => Fractional_Fixed_Ops_On_Target := Result;
when SCA => Support_Composite_Assign_On_Target := Result;
when SCC => Support_Composite_Compare_On_Target := Result;
when SCD => Stack_Check_Default_On_Target := Result;
+ when SCL => Stack_Check_Limits_On_Target := Result;
when SCP => Stack_Check_Probes_On_Target := Result;
when SLS => Support_Long_Shifts_On_Target := Result;
when SSL => Suppress_Standard_Library_On_Target := Result;
-- Here we are seeing a parameter we do not understand. We
-- simply ignore this (will happen when an old compiler is
-- used to compile a newer version of GNAT which does not
- -- support the
+ -- support the parameter).
end if;
end loop Config_Param_Loop;
end if;
-- --
------------------------------------------------------------------------------
--- This package obtains parameters from the target runtime version of
--- System, to indicate parameters relevant to the target environment.
+-- This package obtains parameters from the target runtime version of System,
+-- to indicate parameters relevant to the target environment.
+
+-- Is it right for this to be modified GPL???
-- Conceptually, these parameters could be obtained using rtsfind, but
-- we do not do this for four reasons:
-- The following parameters correspond to the variables defined in the
-- private part of System (without the terminating _On_Target). Note
-- that it is required that all parameters defined here be specified
- -- in the target specific version of system.ads (there are no defaults).
-
- -- All these parameters should be regarded as read only by all clients
- -- of the package. The only way they get modified is by calling the
- -- Get_Target_Parameters routine which reads the values from a provided
- -- text buffer containing the source of the system package.
+ -- in the target specific version of system.ads. Thus, to add a new
+ -- parameter, add it to all system*.ads files. (There is a defaulting
+ -- mechanism, but we don't normally take advantage of it, as explained
+ -- below.)
-- The default values here are used if no value is found in system.ads.
-- This should normally happen if the special version of system.ads used
-- sources, as well as avoiding duplicating values in all system-*.ads
-- files for flags that are used on a few platforms only.
+ -- All these parameters should be regarded as read only by all clients
+ -- of the package. The only way they get modified is by calling the
+ -- Get_Target_Parameters routine which reads the values from a provided
+ -- text buffer containing the source of the system package.
+
----------------------------
-- Special Target Control --
----------------------------
-- the source program may not contain explicit 64-bit shifts. In addition,
-- the code generated for packed arrays will avoid the use of long shifts.
+ --------------------
+ -- Indirect Calls --
+ --------------------
+
+ Always_Compatible_Rep_On_Target : Boolean := True;
+ -- If True, the Can_Use_Internal_Rep flag (see Einfo) is set to False in
+ -- all cases. This corresponds to the traditional code generation
+ -- strategy. False allows the front end to choose a policy that partly or
+ -- entirely eliminates dynamically generated trampolines.
+
+ Dynamic_Trampolines_Used_On_Target : Boolean := True;
+ -- True if the back end uses dynamically generated trampolines to implement
+ -- '[Unrestricted_]Access of nested subprograms when Can_Use_Internal_Rep
+ -- is False for the access type. (Can_Use_Internal_Rep = True forbids the
+ -- use of such trampolines.) Used in the implementation of pragma
+ -- Restrictions (No_Implicit_Dynamic_Code).
+
-------------------------------
-- Control of Stack Checking --
-------------------------------
-- size for the environment task depends on the operating
-- system and cannot be set in a system-independent way.
+ -- GCC Stack-limit Mechanism
+
+ -- This approach uses the GCC stack limits mechanism.
+ -- It relies on comparing the stack pointer with the
+ -- values of a global symbol. If the check fails, a
+ -- trap is explicitly generated. The advantage is
+ -- that the mechanism requires no memory protection,
+ -- but operating system and run-time support are
+ -- needed to manage the per-task values of the symbol.
+ -- This is the default method after probing where it
+ -- is available.
+
-- GNAT Stack-limit Checking
-- This method relies on comparing the stack pointer
-- that the method requires no extra system dependent
-- runtime support and can be used on systems without
-- memory protection as well, but at the cost of more
- -- overhead for doing the check. This method is the
- -- default on systems that lack complete support for
- -- probing.
+ -- overhead for doing the check. This is the fallback
+ -- method if the above two are not supported.
Stack_Check_Probes_On_Target : Boolean := False;
- -- Indicates if stack check probes are used, as opposed to the standard
- -- target independent comparison method.
+ -- Indicates if the GCC probing mechanism is used
+
+ Stack_Check_Limits_On_Target : Boolean := False;
+ -- Indicates if the GCC stack-limit mechanism is used
+
+ -- Both flags cannot be simultaneously set to True. If neither
+ -- is, the target independent fallback method is used.
Stack_Check_Default_On_Target : Boolean := False;
-- Indicates if stack checking is on by default