1 /* -*-C-*-
2
3 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
4 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
5 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Massachusetts
6 Institute of Technology
7
8 This file is part of MIT/GNU Scheme.
9
10 MIT/GNU Scheme is free software; you can redistribute it and/or modify
11 it under the terms of the GNU General Public License as published by
12 the Free Software Foundation; either version 2 of the License, or (at
13 your option) any later version.
14
15 MIT/GNU Scheme is distributed in the hope that it will be useful, but
16 WITHOUT ANY WARRANTY; without even the implied warranty of
17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 General Public License for more details.
19
20 You should have received a copy of the GNU General Public License
21 along with MIT/GNU Scheme; if not, write to the Free Software
22 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
23 USA.
24
25 */
26
27 #include "scheme.h"
28 #include "history.h"
29 #include "ux.h"
30 #include "uxtrap.h"
31 #include "uxutil.h"
32 #include "option.h"
33 #include "ostop.h"
34 #include "gccode.h"
35
36 #ifdef HAVE_SIGCONTEXT
37 # define ENABLE_TRAP_RECOVERY 1
38 #endif
39
40 /* FIXME: Support these architectures. */
41 #ifdef __ppc__
42 # undef ENABLE_TRAP_RECOVERY
43 #endif
44 #ifdef __ppc64__
45 # undef ENABLE_TRAP_RECOVERY
46 #endif
47 #ifdef __ia64__
48 # undef ENABLE_TRAP_RECOVERY
49 #endif
50
51 extern const char * find_signal_name (int);
52 extern void UX_dump_core (void);
53 extern void * initial_C_stack_pointer;
54
55 struct ux_sig_code_desc
56 {
57 int signo;
58 unsigned long code_mask;
59 unsigned long code_value;
60 const char * name;
61 };
62
63 static struct ux_sig_code_desc ux_signal_codes [64];
64
65 #define DECLARE_UX_SIGNAL_CODE(s, m, v, n) \
66 { \
67 ((ux_signal_codes [i]) . signo) = (s); \
68 ((ux_signal_codes [i]) . code_mask) = (m); \
69 ((ux_signal_codes [i]) . code_value) = (v); \
70 ((ux_signal_codes [i]) . name) = (n); \
71 i += 1; \
72 }
73
74 #define DECLARE_GENERIC_SIGNAL_CODE(v, n) \
75 DECLARE_UX_SIGNAL_CODE ((-1), (~ 0L), v, n)
76
77 enum pc_location
78 {
79 pcl_heap,
80 pcl_constant,
81 pcl_builtin,
82 pcl_utility,
83 pcl_primitive,
84 pcl_unknown
85 };
86
87 #ifdef TC_POSITIVE_FIXNUM
88 # define FIXNUM_MARKER TC_POSITIVE_FIXNUM
89 #else
90 # define FIXNUM_MARKER TC_FIXNUM
91 #endif
92
93 #ifndef SPECIAL_SIGNAL_CODE_NAMES
94 # define SPECIAL_SIGNAL_CODE_NAMES()
95 #endif
96
97 static enum trap_state trap_state;
98 static enum trap_state user_trap_state;
99 static enum trap_state saved_trap_state;
100 static int saved_signo;
101 static SIGINFO_T saved_info;
102 static SIGCONTEXT_T * saved_scp;
103
104 static void continue_from_trap
105 (int, SIGINFO_T, SIGCONTEXT_T *);
106
107 #ifdef CC_SUPPORT_P
108 static SCHEME_OBJECT * find_heap_address (unsigned long);
109 static SCHEME_OBJECT * find_constant_address (unsigned long);
110 # ifdef ENABLE_TRAP_RECOVERY
111 static SCHEME_OBJECT * find_block_address (unsigned long, SCHEME_OBJECT *);
112 # endif
113 #endif
114
115 static void setup_trap_frame
116 (int,
117 SIGINFO_T,
118 SIGCONTEXT_T *,
119 struct trap_recovery_info *,
120 SCHEME_OBJECT *);
121
122 static void initialize_ux_signal_codes (void);
123 static SCHEME_OBJECT find_signal_code_name (int, SIGINFO_T, SIGCONTEXT_T *);
124
125 static enum pc_location classify_pc
126 (unsigned long, SCHEME_OBJECT **, unsigned int *);
127
128 static void trap_normal_termination (void);
129 static void trap_immediate_termination (void);
130 static void trap_dump_core (void);
131 static void trap_recover (void);
132
133 void
UX_initialize_trap_recovery(void)134 UX_initialize_trap_recovery (void)
135 {
136 trap_state = trap_state_recover;
137 user_trap_state = trap_state_recover;
138 initialize_ux_signal_codes ();
139 }
140
141 enum trap_state
OS_set_trap_state(enum trap_state state)142 OS_set_trap_state (enum trap_state state)
143 {
144 enum trap_state old_trap_state = user_trap_state;
145 user_trap_state = state;
146 trap_state = state;
147 return (old_trap_state);
148 }
149
150 void
hard_reset(SIGCONTEXT_T * scp)151 hard_reset (SIGCONTEXT_T * scp)
152 {
153 /* 0 is an invalid signal, it means a user requested reset. */
154 continue_from_trap (0, 0, scp);
155 }
156
157 void
soft_reset(void)158 soft_reset (void)
159 {
160 /* Called synchronously. */
161 struct trap_recovery_info trinfo;
162 SCHEME_OBJECT * new_stack_pointer
163 = ((SP_OK_P (stack_pointer)) ? stack_pointer : 0);
164 if (GET_PRIMITIVE != SHARP_F)
165 {
166 (trinfo . state) = STATE_PRIMITIVE;
167 (trinfo . pc_info_1) = GET_PRIMITIVE;
168 (trinfo . pc_info_2) = (ULONG_TO_FIXNUM (GET_LEXPR_ACTUALS));
169 (trinfo . extra_trap_info) = SHARP_F;
170 }
171 else
172 {
173 (trinfo . state) = STATE_UNKNOWN;
174 (trinfo . pc_info_1) = SHARP_F;
175 (trinfo . pc_info_2) = SHARP_F;
176 (trinfo . extra_trap_info) = SHARP_F;
177 }
178 if (!ADDRESS_IN_HEAP_P (Free))
179 Free = heap_alloc_limit; /* Let's hope this works. */
180 setup_trap_frame (0, 0, 0, (&trinfo), new_stack_pointer);
181 }
182
183 #ifdef CC_SUPPORT_P
184 SCHEME_OBJECT
find_ccblock(unsigned long pc)185 find_ccblock (unsigned long pc)
186 {
187 SCHEME_OBJECT * block_addr;
188 unsigned int index;
189
190 block_addr = 0;
191 classify_pc (pc, (&block_addr), (&index));
192 return ((block_addr != 0) ? (MAKE_CC_BLOCK (block_addr)) : SHARP_F);
193 }
194 #endif
195
196 void
trap_handler(const char * message,int signo,SIGINFO_T info,SIGCONTEXT_T * scp)197 trap_handler (const char * message,
198 int signo,
199 SIGINFO_T info,
200 SIGCONTEXT_T * scp)
201 {
202 int code = ((SIGINFO_VALID_P (info)) ? (SIGINFO_CODE (info)) : 0);
203 bool stack_overflowed_p = (STACK_OVERFLOWED_P ());
204 enum trap_state old_trap_state = trap_state;
205
206 if (old_trap_state == trap_state_exitting_hard)
207 _exit (1);
208 if (old_trap_state == trap_state_exitting_soft)
209 trap_immediate_termination ();
210 trap_state = trap_state_trapped;
211
212 if (WITHIN_CRITICAL_SECTION_P ())
213 {
214 fprintf (stdout,
215 "\n>> A %s has occurred within critical section \"%s\".\n",
216 message, (CRITICAL_SECTION_NAME ()));
217 fprintf (stdout, ">> [signal %d (%s), code %d]\n",
218 signo, (find_signal_name (signo)), code);
219 }
220 else if (stack_overflowed_p || (old_trap_state != trap_state_recover))
221 {
222 fprintf (stdout, "\n>> A %s has occurred.\n", message);
223 fprintf (stdout, ">> [signal %d (%s), code %d]\n",
224 signo, (find_signal_name (signo)), code);
225 }
226 if (stack_overflowed_p)
227 {
228 fputs (">> The stack has overflowed overwriting adjacent memory.\n",
229 stdout);
230 fputs (">> This was probably caused by a runaway recursion.\n", stdout);
231 }
232 fflush (stdout);
233
234 switch (old_trap_state)
235 {
236 case trap_state_trapped:
237 if ((saved_trap_state == trap_state_recover)
238 || (saved_trap_state == trap_state_query))
239 {
240 fprintf (stdout,
241 ">> The trap occurred while processing an earlier trap.\n");
242 fprintf (stdout,
243 ">> [The earlier trap raised signal %d (%s), code %d.]\n",
244 saved_signo,
245 (find_signal_name (saved_signo)),
246 ((SIGINFO_VALID_P (saved_info))
247 ? (SIGINFO_CODE (saved_info))
248 : 0));
249 fprintf (stdout, ">> Successful recovery is %sunlikely.\n",
250 ((WITHIN_CRITICAL_SECTION_P ()) ? "extremely " : ""));
251 }
252 else
253 trap_immediate_termination ();
254 break;
255
256 case trap_state_recover:
257 if ((WITHIN_CRITICAL_SECTION_P ()) || stack_overflowed_p)
258 fprintf (stdout, ">> Successful recovery is unlikely.\n");
259 else
260 {
261 saved_trap_state = old_trap_state;
262 saved_signo = signo;
263 saved_info = info;
264 saved_scp = scp;
265 trap_recover ();
266 }
267 break;
268
269 case trap_state_exit:
270 termination_trap ();
271 break;
272
273 default:
274 break;
275 }
276
277 fflush (stdout);
278 saved_trap_state = old_trap_state;
279 saved_signo = signo;
280 saved_info = info;
281 saved_scp = scp;
282
283 while (1)
284 {
285 static const char * trap_query_choices[] =
286 {
287 "D = dump core",
288 "I = terminate immediately",
289 "N = terminate normally",
290 "R = attempt recovery",
291 "Q = terminate normally",
292 0
293 };
294 switch (userio_choose_option
295 ("Choose one of the following actions:",
296 "Action -> ",
297 trap_query_choices))
298 {
299 case 'I':
300 trap_immediate_termination ();
301 break;
302 case 'D':
303 trap_dump_core ();
304 break;
305 case '\0':
306 /* Error in IO. Assume everything scrod. */
307 case 'N':
308 case 'Q':
309 trap_normal_termination ();
310 break;
311 case 'R':
312 trap_recover ();
313 break;
314 }
315 }
316 }
317
318 #ifdef ENABLE_TRAP_RECOVERY
319
320 /* Heuristic recovery from Unix signals (traps).
321
322 continue_from_trap attempts to:
323
324 1) validate the trap information (pc and sp);
325 2) determine whether compiled code was executing, a primitive was
326 executing, or execution was in the interpreter;
327 3) guess what C global state is still valid; and
328 4) set up a recovery frame for the interpreter so that debuggers can
329 display more information. */
330
331 #define SCHEME_ALIGNMENT_MASK ((sizeof (SCHEME_OBJECT)) - 1)
332
333 #define ALIGNED_P(addr) \
334 ((((unsigned long) (addr)) & SCHEME_ALIGNMENT_MASK) == 0)
335
336 #define SET_RECOVERY_INFO(s, arg1, arg2) do \
337 { \
338 (recovery_info . state) = s; \
339 (recovery_info . pc_info_1) = arg1; \
340 (recovery_info . pc_info_2) = arg2; \
341 } while (0)
342
343 static void
continue_from_trap(int signo,SIGINFO_T info,SIGCONTEXT_T * scp)344 continue_from_trap (int signo, SIGINFO_T info, SIGCONTEXT_T * scp)
345 {
346 unsigned long pc = (SIGCONTEXT_PC (scp));
347 SCHEME_OBJECT primitive = GET_PRIMITIVE;
348 SCHEME_OBJECT * block_addr;
349 unsigned int index;
350 SCHEME_OBJECT * new_sp = 0;
351 struct trap_recovery_info recovery_info;
352
353 #ifdef PC_VALUE_MASK
354 pc &= PC_VALUE_MASK;
355 #endif
356
357 /* Choose new SP and encode location data. */
358 switch (classify_pc (pc, (&block_addr), (&index)))
359 {
360 case pcl_primitive:
361 new_sp = stack_pointer;
362 SET_RECOVERY_INFO
363 (STATE_PRIMITIVE, primitive, (ULONG_TO_FIXNUM (GET_LEXPR_ACTUALS)));
364 break;
365
366 case pcl_heap:
367 case pcl_constant:
368 #ifdef CC_SUPPORT_P
369 new_sp = ((SCHEME_OBJECT *) (SIGCONTEXT_SCHSP (scp)));
370 Free = ((SCHEME_OBJECT *) (SIGCONTEXT_RFREE (scp)));
371 SET_RECOVERY_INFO
372 (STATE_COMPILED_CODE,
373 (MAKE_CC_BLOCK (block_addr)),
374 (LONG_TO_UNSIGNED_FIXNUM (pc - ((unsigned long) block_addr))));
375 break;
376 #endif
377
378 case pcl_utility:
379 #ifdef CC_SUPPORT_P
380 new_sp = stack_pointer;
381 SET_RECOVERY_INFO (STATE_UTILITY, (ULONG_TO_FIXNUM (index)), UNSPECIFIC);
382 break;
383 #endif
384
385 case pcl_builtin:
386 #ifdef CC_SUPPORT_P
387 new_sp = ((SCHEME_OBJECT *) (SIGCONTEXT_SCHSP (scp)));
388 Free = ((SCHEME_OBJECT *) (SIGCONTEXT_RFREE (scp)));
389 SET_RECOVERY_INFO (STATE_BUILTIN, (ULONG_TO_FIXNUM (index)), UNSPECIFIC);
390 break;
391 #endif
392
393 case pcl_unknown:
394 new_sp = 0;
395 SET_RECOVERY_INFO
396 (STATE_UNKNOWN,
397 (LONG_TO_UNSIGNED_FIXNUM (pc)),
398 UNSPECIFIC);
399 break;
400 }
401
402 /* Sanity-check the new SP. */
403 if (! ((ADDRESS_IN_STACK_P (new_sp)) && (ALIGNED_P (new_sp))))
404 new_sp = 0;
405
406 /* Sanity-check Free. */
407 if (!((new_sp != 0)
408 && (ADDRESS_IN_HEAP_P (Free))
409 && (ALIGNED_P (Free))))
410 {
411 #ifdef ENABLE_DEBUGGING_TOOLS
412 outf_error ("Resetting bogus Free in continue_from_trap.\n");
413 outf_flush_error ();
414 #endif
415 Free = heap_alloc_limit;
416 }
417
418 /* Encode the registers. */
419 (recovery_info . extra_trap_info) =
420 (MAKE_POINTER_OBJECT (TC_NON_MARKED_VECTOR, Free));
421 (*Free++) =
422 (MAKE_OBJECT (TC_MANIFEST_NM_VECTOR, (2 + SIGCONTEXT_NREGS)));
423 (*Free++) = ((SCHEME_OBJECT) pc);
424 (*Free++) = ((SCHEME_OBJECT) (SIGCONTEXT_SP (scp)));
425 {
426 unsigned long * scan
427 = ((unsigned long *) (SIGCONTEXT_FIRST_REG (scp)));
428 unsigned long * end = (scan + SIGCONTEXT_NREGS);
429 while (scan < end)
430 (*Free++) = ((SCHEME_OBJECT) (*scan++));
431 }
432
433 setup_trap_frame (signo, info, scp, (&recovery_info), new_sp);
434 }
435
436 /* Find the compiled code block in area that contains `pc'. */
437
438 #ifdef CC_SUPPORT_P
439
440 static SCHEME_OBJECT *
find_heap_address(unsigned long pc)441 find_heap_address (unsigned long pc)
442 {
443 return (find_block_address (pc, heap_start));
444 }
445
446 static SCHEME_OBJECT *
find_constant_address(unsigned long pc)447 find_constant_address (unsigned long pc)
448 {
449 return (find_block_address (pc, constant_start));
450 }
451
452 /* Find the compiled code block in area that contains `pc_value',
453 by scanning sequentially the complete area.
454 For the time being, skip over manifest closures and linkage sections. */
455
456 static SCHEME_OBJECT *
find_block_address(unsigned long pc,SCHEME_OBJECT * area_start)457 find_block_address (unsigned long pc, SCHEME_OBJECT * area_start)
458 {
459 SCHEME_OBJECT * pcp = ((SCHEME_OBJECT *) (pc &~ SCHEME_ALIGNMENT_MASK));
460 SCHEME_OBJECT * first_valid = area_start;
461 SCHEME_OBJECT * area = area_start;
462
463 while (area < pcp)
464 {
465 SCHEME_OBJECT object = (*area);
466 switch (OBJECT_TYPE (object))
467 {
468 case TC_LINKAGE_SECTION:
469 {
470 unsigned long count = (linkage_section_count (object));
471 area += 1;
472 switch (linkage_section_type (object))
473 {
474 case LINKAGE_SECTION_TYPE_GLOBAL_OPERATOR:
475 case LINKAGE_SECTION_TYPE_OPERATOR:
476 area += (count * UUO_LINK_SIZE);
477 break;
478
479 default:
480 area += count;
481 break;
482 }
483 }
484 break;
485
486 case TC_MANIFEST_CLOSURE:
487 area = (compiled_closure_objects (area + 1));
488 break;
489
490 case TC_MANIFEST_NM_VECTOR:
491 {
492 unsigned long count = (OBJECT_DATUM (object));
493 if ((area + (count + 1)) < pcp)
494 {
495 area += (count + 1);
496 first_valid = area;
497 }
498 else
499 {
500 SCHEME_OBJECT * block = (area - 1);
501 return
502 (((area != first_valid)
503 && (((OBJECT_TYPE (*block)) == TC_MANIFEST_VECTOR)
504 || ((OBJECT_TYPE (*block)) == FIXNUM_MARKER))
505 && ((OBJECT_DATUM (*block)) >= (count + 1))
506 && (plausible_cc_block_p (block)))
507 ? block
508 : 0);
509 }
510 }
511 break;
512
513 default:
514 area += 1;
515 break;
516 }
517 }
518 return (0);
519 }
520 #endif /* CC_SUPPORT_P */
521
522 #else /* not ENABLE_TRAP_RECOVERY */
523
524 static struct trap_recovery_info dummy_recovery_info =
525 {
526 STATE_UNKNOWN,
527 SHARP_F,
528 SHARP_F,
529 SHARP_F
530 };
531
532 static void
continue_from_trap(int signo,SIGINFO_T info,SIGCONTEXT_T * scp)533 continue_from_trap (int signo, SIGINFO_T info, SIGCONTEXT_T * scp)
534 {
535 if (Free < heap_alloc_limit)
536 Free = heap_alloc_limit;
537 setup_trap_frame (signo, info, scp, (&dummy_recovery_info), 0);
538 }
539
540 #ifdef CC_SUPPORT_P
541
542 static SCHEME_OBJECT *
find_heap_address(unsigned long pc)543 find_heap_address (unsigned long pc)
544 {
545 return (0);
546 }
547
548 static SCHEME_OBJECT *
find_constant_address(unsigned long pc)549 find_constant_address (unsigned long pc)
550 {
551 return (0);
552 }
553
554 #endif /* CC_SUPPORT_P */
555 #endif /* not ENABLE_TRAP_RECOVERY */
556
557 static void
setup_trap_frame(int signo,SIGINFO_T info,SIGCONTEXT_T * scp,struct trap_recovery_info * trinfo,SCHEME_OBJECT * new_stack_pointer)558 setup_trap_frame (int signo,
559 SIGINFO_T info,
560 SIGCONTEXT_T * scp,
561 struct trap_recovery_info * trinfo,
562 SCHEME_OBJECT * new_stack_pointer)
563 {
564 unsigned long saved_mask = GET_INT_MASK;
565 SCHEME_OBJECT handler;
566 SCHEME_OBJECT signal_name;
567
568 SET_INTERRUPT_MASK (0); /* To prevent GC for now. */
569
570 handler
571 = ((VECTOR_P (fixed_objects))
572 ? (VECTOR_REF (fixed_objects, TRAP_HANDLER))
573 : SHARP_F);
574 if (!INTERPRETER_APPLICABLE_P (handler))
575 {
576 fprintf (stderr, "There is no trap handler for recovery!\n");
577 fflush (stderr);
578 termination_trap ();
579 }
580
581 signal_name =
582 ((signo != 0)
583 ? (char_pointer_to_string (find_signal_name (signo)))
584 : SHARP_F);
585
586 if (!FREE_OK_P (Free))
587 REQUEST_GC (0);
588
589 if (new_stack_pointer != 0)
590 stack_pointer = new_stack_pointer;
591 else
592 {
593 INITIALIZE_STACK ();
594 Will_Push (CONTINUATION_SIZE);
595 SET_RC (RC_END_OF_COMPUTATION);
596 SET_EXP (SHARP_F);
597 SAVE_CONT ();
598 Pushed ();
599 }
600
601 Will_Push (7 + CONTINUATION_SIZE);
602 STACK_PUSH (trinfo -> extra_trap_info);
603 STACK_PUSH (trinfo -> pc_info_2);
604 STACK_PUSH (trinfo -> pc_info_1);
605 STACK_PUSH (trinfo -> state);
606 STACK_PUSH (BOOLEAN_TO_OBJECT (new_stack_pointer != 0));
607 STACK_PUSH (find_signal_code_name (signo, info, scp));
608 STACK_PUSH (signal_name);
609 SET_RC (RC_HARDWARE_TRAP);
610 SET_EXP (long_to_integer (signo));
611 SAVE_CONT ();
612 Pushed ();
613
614 if ((new_stack_pointer != 0)
615 /* This may want to do it in other cases, but this may be enough. */
616 && ((trinfo -> state) == STATE_COMPILED_CODE))
617 stop_history ();
618 history_register = (make_dummy_history ());
619
620 Will_Push (STACK_ENV_EXTRA_SLOTS + 2);
621 STACK_PUSH (signal_name);
622 STACK_PUSH (handler);
623 PUSH_APPLY_FRAME_HEADER (1);
624 Pushed ();
625
626 SET_INTERRUPT_MASK (saved_mask);
627 abort_to_interpreter (PRIM_APPLY);
628 }
629
630 static void
initialize_ux_signal_codes(void)631 initialize_ux_signal_codes (void)
632 {
633 unsigned int i = 0;
634 INITIALIZE_UX_SIGNAL_CODES ();
635
636 #ifdef _POSIX_REALTIME_SIGNALS
637 DECLARE_GENERIC_SIGNAL_CODE
638 (SI_USER, "signal sent by kill");
639 DECLARE_GENERIC_SIGNAL_CODE
640 (SI_QUEUE, "signal sent by sigqueue");
641 DECLARE_GENERIC_SIGNAL_CODE
642 (SI_TIMER, "signal generated by timer expiration");
643 DECLARE_GENERIC_SIGNAL_CODE
644 (SI_ASYNCIO, "signal generated by asynchronous I/O completion");
645 DECLARE_GENERIC_SIGNAL_CODE
646 (SI_MESGQ, "signal generated by message queue arrival");
647 #endif /* _POSIX_REALTIME_SIGNALS */
648
649 DECLARE_UX_SIGNAL_CODE (0, 0, 0, 0);
650 }
651
652 static SCHEME_OBJECT
find_signal_code_name(int signo,SIGINFO_T info,SIGCONTEXT_T * scp)653 find_signal_code_name (int signo, SIGINFO_T info, SIGCONTEXT_T * scp)
654 {
655 unsigned long code = 0;
656 const char * name = 0;
657 if (SIGINFO_VALID_P (info))
658 {
659 code = (SIGINFO_CODE (info));
660 SPECIAL_SIGNAL_CODE_NAMES ();
661 if (name == 0)
662 {
663 struct ux_sig_code_desc * entry = (& (ux_signal_codes[0]));
664 while ((entry -> signo) != 0)
665 if ((((entry -> signo) < 0) || ((entry -> signo) == signo))
666 && (((entry -> code_mask) & code) == (entry -> code_value)))
667 {
668 name = (entry -> name);
669 break;
670 }
671 else
672 entry += 1;
673 }
674 }
675 return
676 (cons ((ulong_to_integer (code)),
677 ((name == 0)
678 ? SHARP_F
679 : (char_pointer_to_string (name)))));
680 }
681
682 static enum pc_location
classify_pc(unsigned long pc,SCHEME_OBJECT ** r_block_addr,unsigned int * r_index)683 classify_pc (unsigned long pc,
684 SCHEME_OBJECT ** r_block_addr,
685 unsigned int * r_index)
686 {
687 #ifdef CC_SUPPORT_P
688 if (PC_ALIGNED_P (pc))
689 {
690 if (HEAP_ADDRESS_P ((SCHEME_OBJECT *) pc))
691 {
692 SCHEME_OBJECT * block_addr = (find_heap_address (pc));
693 if (block_addr == 0)
694 return (pcl_unknown);
695 if (r_block_addr != 0)
696 (*r_block_addr) = block_addr;
697 return (pcl_heap);
698 }
699 if (ADDRESS_IN_CONSTANT_P ((SCHEME_OBJECT *) pc))
700 {
701 SCHEME_OBJECT * block_addr = (find_constant_address (pc));
702 if (block_addr == 0)
703 return (pcl_unknown);
704 if (r_block_addr != 0)
705 (*r_block_addr) = block_addr;
706 return (pcl_constant);
707 }
708 if (ADDRESS_UCODE_P (pc))
709 {
710 int index = (pc_to_builtin_index (pc));
711 if (index >= 0)
712 {
713 if (r_index != 0)
714 (*r_index) = index;
715 return (pcl_builtin);
716 }
717 index = (pc_to_utility_index (pc));
718 if (index >= 0)
719 {
720 if (r_index != 0)
721 (*r_index) = index;
722 return (pcl_utility);
723 }
724 if ((OBJECT_TYPE (GET_PRIMITIVE)) == TC_PRIMITIVE)
725 return (pcl_primitive);
726 }
727 }
728 #else
729 if ((ADDRESS_UCODE_P (pc))
730 && ((OBJECT_TYPE (GET_PRIMITIVE)) == TC_PRIMITIVE))
731 return (pcl_primitive);
732 #endif
733 return (pcl_unknown);
734 }
735
736 static void
trap_normal_termination(void)737 trap_normal_termination (void)
738 {
739 trap_state = trap_state_exitting_soft;
740 termination_trap ();
741 }
742
743 static void
trap_immediate_termination(void)744 trap_immediate_termination (void)
745 {
746 trap_state = trap_state_exitting_hard;
747 OS_restore_external_state ();
748 exit (1);
749 }
750
751 static void
trap_dump_core(void)752 trap_dump_core (void)
753 {
754 if (! (option_disable_core_dump))
755 UX_dump_core ();
756 else
757 {
758 fputs (">> Core dumps are disabled - Terminating normally.\n", stdout);
759 fflush (stdout);
760 termination_trap ();
761 }
762 }
763
764 static void
trap_recover(void)765 trap_recover (void)
766 {
767 if (WITHIN_CRITICAL_SECTION_P ())
768 {
769 CLEAR_CRITICAL_SECTION_HOOK ();
770 EXIT_CRITICAL_SECTION ({});
771 }
772 reset_interruptable_extent ();
773 continue_from_trap (saved_signo, saved_info, saved_scp);
774 }
775