1 /**************************************************************************/
2 /* */
3 /* OCaml */
4 /* */
5 /* Xavier Leroy, projet Gallium, INRIA Rocquencourt */
6 /* */
7 /* Copyright 2007 Institut National de Recherche en Informatique et */
8 /* en Automatique. */
9 /* */
10 /* All rights reserved. This file is distributed under the terms of */
11 /* the GNU Lesser General Public License version 2.1, with the */
12 /* special exception on linking described in the file LICENSE. */
13 /* */
14 /**************************************************************************/
15
16 #define CAML_INTERNALS
17
18 /* Signal handling, code specific to the native-code compiler */
19
20 #if defined(TARGET_amd64) && defined (SYS_linux)
21 #define _GNU_SOURCE
22 #endif
23 #include <signal.h>
24 #include <errno.h>
25 #include <stdio.h>
26 #include "caml/fail.h"
27 #include "caml/memory.h"
28 #include "caml/osdeps.h"
29 #include "caml/signals.h"
30 #include "caml/signals_machdep.h"
31 #include "signals_osdep.h"
32 #include "caml/stack.h"
33 #include "caml/spacetime.h"
34 #include "caml/memprof.h"
35 #include "caml/finalise.h"
36
37 #ifndef NSIG
38 #define NSIG 64
39 #endif
40
41 typedef void (*signal_handler)(int signo);
42
43 #ifdef _WIN32
44 extern signal_handler caml_win32_signal(int sig, signal_handler action);
45 #define signal(sig,act) caml_win32_signal(sig,act)
46 extern void caml_win32_overflow_detection();
47 #endif
48
49 extern char * caml_code_area_start, * caml_code_area_end;
50 extern char caml_system__code_begin, caml_system__code_end;
51
52 /* Do not use the macro from address_class.h here. */
53 #undef Is_in_code_area
54 #define Is_in_code_area(pc) \
55 ( ((char *)(pc) >= caml_code_area_start && \
56 (char *)(pc) <= caml_code_area_end) \
57 || ((char *)(pc) >= &caml_system__code_begin && \
58 (char *)(pc) <= &caml_system__code_end) \
59 || (Classify_addr(pc) & In_code_area) )
60
61 /* This routine is the common entry point for garbage collection
62 and signal handling. It can trigger a callback to OCaml code.
63 With system threads, this callback can cause a context switch.
64 Hence [caml_garbage_collection] must not be called from regular C code
65 (e.g. the [caml_alloc] function) because the context of the call
66 (e.g. [intern_val]) may not allow context switching.
67 Only generated assembly code can call [caml_garbage_collection],
68 via the caml_call_gc assembly stubs. */
69
70 void caml_garbage_collection(void)
71 {
72 /* TEMPORARY: if we have just sampled an allocation in native mode,
73 we simply renew the sample to ignore it. Otherwise, renewing now
74 will not have any effect on the sampling distribution, because of
75 the memorylessness of the Bernoulli process.
76
77 FIXME: if the sampling rate is 1, this leads to infinite loop,
78 because we are using a binomial distribution in [memprof.c]. This
79 will go away when the sampling of natively allocated blocks will
80 be correctly implemented.
81 */
82 caml_memprof_renew_minor_sample();
83 if (Caml_state->requested_major_slice || Caml_state->requested_minor_gc ||
84 Caml_state->young_ptr - Caml_state->young_trigger < Max_young_whsize){
85 caml_gc_dispatch ();
86 }
87
88 #ifdef WITH_SPACETIME
89 if (Caml_state->young_ptr == Caml_state->young_alloc_end) {
90 caml_spacetime_automatic_snapshot();
91 }
92 #endif
93
94 caml_raise_if_exception(caml_do_pending_actions_exn());
95 }
96
97 DECLARE_SIGNAL_HANDLER(handle_signal)
98 {
99 int saved_errno;
100 /* Save the value of errno (PR#5982). */
101 saved_errno = errno;
102 #if !defined(POSIX_SIGNALS) && !defined(BSD_SIGNALS)
103 signal(sig, handle_signal);
104 #endif
105 if (sig < 0 || sig >= NSIG) return;
106 if (caml_try_leave_blocking_section_hook ()) {
107 caml_raise_if_exception(caml_execute_signal_exn(sig, 1));
108 caml_enter_blocking_section_hook();
109 } else {
110 caml_record_signal(sig);
111 /* Some ports cache [Caml_state->young_limit] in a register.
112 Use the signal context to modify that register too, but only if
113 we are inside OCaml code (not inside C code). */
114 #if defined(CONTEXT_PC) && defined(CONTEXT_YOUNG_LIMIT)
115 if (Is_in_code_area(CONTEXT_PC))
116 CONTEXT_YOUNG_LIMIT = (context_reg) Caml_state->young_limit;
117 #endif
118 }
119 errno = saved_errno;
120 }
121
122 int caml_set_signal_action(int signo, int action)
123 {
124 signal_handler oldact;
125 #ifdef POSIX_SIGNALS
126 struct sigaction sigact, oldsigact;
127 #else
128 signal_handler act;
129 #endif
130
131 #ifdef POSIX_SIGNALS
132 switch(action) {
133 case 0:
134 sigact.sa_handler = SIG_DFL;
135 sigact.sa_flags = 0;
136 break;
137 case 1:
138 sigact.sa_handler = SIG_IGN;
139 sigact.sa_flags = 0;
140 break;
141 default:
142 SET_SIGACT(sigact, handle_signal);
143 break;
144 }
145 sigemptyset(&sigact.sa_mask);
146 if (sigaction(signo, &sigact, &oldsigact) == -1) return -1;
147 oldact = oldsigact.sa_handler;
148 #else
149 switch(action) {
150 case 0: act = SIG_DFL; break;
151 case 1: act = SIG_IGN; break;
152 default: act = handle_signal; break;
153 }
154 oldact = signal(signo, act);
155 if (oldact == SIG_ERR) return -1;
156 #endif
157 if (oldact == (signal_handler) handle_signal)
158 return 2;
159 else if (oldact == SIG_IGN)
160 return 1;
161 else
162 return 0;
163 }
164
165 /* Machine- and OS-dependent handling of bound check trap */
166
167 #if defined(TARGET_power) \
168 || defined(TARGET_s390x)
169 DECLARE_SIGNAL_HANDLER(trap_handler)
170 {
171 #if defined(SYS_rhapsody)
172 /* Unblock SIGTRAP */
173 { sigset_t mask;
174 sigemptyset(&mask);
175 sigaddset(&mask, SIGTRAP);
176 caml_sigmask_hook(SIG_UNBLOCK, &mask, NULL);
177 }
178 #endif
179 Caml_state->exception_pointer = (char *) CONTEXT_EXCEPTION_POINTER;
180 Caml_state->young_ptr = (value *) CONTEXT_YOUNG_PTR;
181 Caml_state->bottom_of_stack = (char *) CONTEXT_SP;
182 Caml_state->last_return_address = (uintnat) CONTEXT_PC;
183 caml_array_bound_error();
184 }
185 #endif
186
187 /* Machine- and OS-dependent handling of stack overflow */
188
189 #ifdef HAS_STACK_OVERFLOW_DETECTION
190 #ifndef CONTEXT_SP
191 #error "CONTEXT_SP is required if HAS_STACK_OVERFLOW_DETECTION is defined"
192 #endif
193
194 static char sig_alt_stack[SIGSTKSZ];
195
196 /* Code compiled with ocamlopt never accesses more than
197 EXTRA_STACK bytes below the stack pointer. */
198 #define EXTRA_STACK 256
199
200 #ifdef RETURN_AFTER_STACK_OVERFLOW
201 extern void caml_stack_overflow(caml_domain_state*);
202 #endif
203
204 /* Address sanitizer is confused when running the stack overflow
205 handler in an alternate stack. We deactivate it for all the
206 functions used by the stack overflow handler. */
207 CAMLno_asan
208 DECLARE_SIGNAL_HANDLER(segv_handler)
209 {
210 struct sigaction act;
211 char * fault_addr;
212
213 /* Sanity checks:
214 - faulting address is word-aligned
215 - faulting address is on the stack, or within EXTRA_STACK of it
216 - we are in OCaml code */
217 fault_addr = CONTEXT_FAULTING_ADDRESS;
218 if (((uintnat) fault_addr & (sizeof(intnat) - 1)) == 0
219 && fault_addr < Caml_state->top_of_stack
220 && (uintnat)fault_addr >= CONTEXT_SP - EXTRA_STACK
221 #ifdef CONTEXT_PC
222 && Is_in_code_area(CONTEXT_PC)
223 #endif
224 ) {
225 #ifdef RETURN_AFTER_STACK_OVERFLOW
226 /* Tweak the PC part of the context so that on return from this
227 handler, we jump to the asm function [caml_stack_overflow]
228 (from $ARCH.S). */
229 #ifdef CONTEXT_PC
230 CONTEXT_C_ARG_1 = (context_reg) Caml_state;
231 CONTEXT_PC = (context_reg) &caml_stack_overflow;
232 #else
233 #error "CONTEXT_PC must be defined if RETURN_AFTER_STACK_OVERFLOW is"
234 #endif
235 #else
236 /* Raise a Stack_overflow exception straight from this signal handler */
237 #if defined(CONTEXT_YOUNG_PTR) && defined(CONTEXT_EXCEPTION_POINTER)
238 Caml_state->exception_pointer == (char *) CONTEXT_EXCEPTION_POINTER;
239 Caml_state->young_ptr = (value *) CONTEXT_YOUNG_PTR;
240 #endif
241 caml_raise_stack_overflow();
242 #endif
243 } else {
244 /* Otherwise, deactivate our exception handler and return,
245 causing fatal signal to be generated at point of error. */
246 act.sa_handler = SIG_DFL;
247 act.sa_flags = 0;
248 sigemptyset(&act.sa_mask);
249 sigaction(SIGSEGV, &act, NULL);
250 }
251 }
252
253 #endif
254
255 /* Initialization of signal stuff */
256
257 void caml_init_signals(void)
258 {
259 /* Bound-check trap handling */
260
261 #if defined(TARGET_power)
262 { struct sigaction act;
263 sigemptyset(&act.sa_mask);
264 SET_SIGACT(act, trap_handler);
265 #if !defined(SYS_rhapsody)
266 act.sa_flags |= SA_NODEFER;
267 #endif
268 sigaction(SIGTRAP, &act, NULL);
269 }
270 #endif
271
272 #if defined(TARGET_s390x)
273 { struct sigaction act;
274 sigemptyset(&act.sa_mask);
275 SET_SIGACT(act, trap_handler);
276 sigaction(SIGFPE, &act, NULL);
277 }
278 #endif
279
280 #ifdef HAS_STACK_OVERFLOW_DETECTION
281 {
282 stack_t stk;
283 struct sigaction act;
284 stk.ss_sp = sig_alt_stack;
285 stk.ss_size = SIGSTKSZ;
286 stk.ss_flags = 0;
287 SET_SIGACT(act, segv_handler);
288 act.sa_flags |= SA_ONSTACK | SA_NODEFER;
289 sigemptyset(&act.sa_mask);
290 if (sigaltstack(&stk, NULL) == 0) { sigaction(SIGSEGV, &act, NULL); }
291 }
292 #endif
293 }
294
295 void caml_setup_stack_overflow_detection(void)
296 {
297 #ifdef HAS_STACK_OVERFLOW_DETECTION
298 stack_t stk;
299 stk.ss_sp = malloc(SIGSTKSZ);
300 stk.ss_size = SIGSTKSZ;
301 stk.ss_flags = 0;
302 if (stk.ss_sp)
303 sigaltstack(&stk, NULL);
304 #endif
305 }
306