1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- 4-- -- 5-- 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 -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1999-2009, Free Software Foundation, Inc. -- 10-- -- 11-- GNARL is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. -- 17-- -- 18-- As a special exception under Section 7 of GPL version 3, you are granted -- 19-- additional permissions described in the GCC Runtime Library Exception, -- 20-- version 3.1, as published by the Free Software Foundation. -- 21-- -- 22-- You should have received a copy of the GNU General Public License and -- 23-- a copy of the GCC Runtime Library Exception along with this program; -- 24-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25-- <http://www.gnu.org/licenses/>. -- 26-- -- 27-- GNARL was developed by the GNARL team at Florida State University. -- 28-- Extensive contributions were provided by Ada Core Technologies, Inc. -- 29-- -- 30------------------------------------------------------------------------------ 31 32-- This is the RTEMS version of this package. 33-- This file should be kept synchronized with the general implementation 34-- provided by s-stchop.adb. 35 36pragma Restrictions (No_Elaboration_Code); 37-- We want to guarantee the absence of elaboration code because the 38-- binder does not handle references to this package. 39 40with Ada.Exceptions; 41 42with Interfaces.C; use Interfaces.C; 43 44package body System.Stack_Checking.Operations is 45 46 ---------------------------- 47 -- Invalidate_Stack_Cache -- 48 ---------------------------- 49 50 procedure Invalidate_Stack_Cache (Any_Stack : Stack_Access) is 51 pragma Warnings (Off, Any_Stack); 52 begin 53 Cache := Null_Stack; 54 end Invalidate_Stack_Cache; 55 56 ----------------------------- 57 -- Notify_Stack_Attributes -- 58 ----------------------------- 59 60 procedure Notify_Stack_Attributes 61 (Initial_SP : System.Address; 62 Size : System.Storage_Elements.Storage_Offset) 63 is 64 65 -- RTEMS keeps all the information we need. 66 67 pragma Unreferenced (Size); 68 pragma Unreferenced (Initial_SP); 69 70 begin 71 null; 72 end Notify_Stack_Attributes; 73 74 ----------------- 75 -- Stack_Check -- 76 ----------------- 77 78 function Stack_Check 79 (Stack_Address : System.Address) return Stack_Access 80 is 81 pragma Unreferenced (Stack_Address); 82 83 -- RTEMS has a routine to check if the stack is blown. 84 -- It returns a C99 bool. 85 function rtems_stack_checker_is_blown return Interfaces.C.unsigned_char; 86 pragma Import (C, 87 rtems_stack_checker_is_blown, "rtems_stack_checker_is_blown"); 88 89 begin 90 -- RTEMS has a routine to check this. So use it. 91 92 if rtems_stack_checker_is_blown /= 0 then 93 Ada.Exceptions.Raise_Exception 94 (E => Storage_Error'Identity, 95 Message => "stack overflow detected"); 96 end if; 97 98 return null; 99 100 end Stack_Check; 101 102 ------------------------ 103 -- Update_Stack_Cache -- 104 ------------------------ 105 106 procedure Update_Stack_Cache (Stack : Stack_Access) is 107 begin 108 if not Multi_Processor then 109 Cache := Stack; 110 end if; 111 end Update_Stack_Cache; 112 113end System.Stack_Checking.Operations; 114