source: trunk/ccl/lisp-kernel/x86-exceptions.c @ 6220

Last change on this file since 6220 was 6220, checked in by gb, 13 years ago

Handle signals on the altstack if not Darwin.
In Darwin, evactuate off of the lisp stack while interrupts are
still disabled.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 73.1 KB
Line 
1/*
2   Copyright (C) 2005 Clozure Associates
3   This file is part of OpenMCL. 
4
5   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
6   License , known as the LLGPL and distributed with OpenMCL as the
7   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
8   which is distributed with OpenMCL as the file "LGPL".  Where these
9   conflict, the preamble takes precedence. 
10
11   OpenMCL is referenced in the preamble as the "LIBRARY."
12
13   The LLGPL is also available online at
14   http://opensource.franz.com/preamble.html
15*/
16
17#include "lisp.h"
18#include "lisp-exceptions.h"
19#include "lisp_globals.h"
20#include "Threads.h"
21#include <ctype.h>
22#include <stdio.h>
23#include <stddef.h>
24#include <string.h>
25#include <stdarg.h>
26#include <errno.h>
27#include <stdio.h>
28#ifdef LINUX
29#include <strings.h>
30#include <sys/mman.h>
31#include <fpu_control.h>
32#include <linux/prctl.h>
33#endif
34#ifdef DARWIN
35#include <sysexits.h>
36#endif
37#include <sys/syslog.h>
38
39
40int
41page_size = 4096;
42
43int
44log2_page_size = 12;
45
46
47void
48update_bytes_allocated(TCR* tcr, void *cur_allocptr)
49{
50  BytePtr
51    last = (BytePtr) tcr->last_allocptr, 
52    current = (BytePtr) cur_allocptr;
53  if (last && (tcr->save_allocbase != ((void *)VOID_ALLOCPTR))) {
54    tcr->bytes_allocated += last-current;
55  }
56  tcr->last_allocptr = 0;
57}
58
59
60
61//  This doesn't GC; it returns true if it made enough room, false
62//  otherwise.
63//  If "extend" is true, it can try to extend the dynamic area to
64//  satisfy the request.
65
66
67Boolean
68new_heap_segment(ExceptionInformation *xp, natural need, Boolean extend, TCR *tcr)
69{
70  area *a;
71  natural newlimit, oldlimit;
72  natural log2_allocation_quantum = tcr->log2_allocation_quantum;
73
74  a  = active_dynamic_area;
75  oldlimit = (natural) a->active;
76  newlimit = (align_to_power_of_2(oldlimit, log2_allocation_quantum) +
77              align_to_power_of_2(need, log2_allocation_quantum));
78  if (newlimit > (natural) (a->high)) {
79    if (extend) {
80      if (! resize_dynamic_heap(a->active, (newlimit-oldlimit)+lisp_heap_gc_threshold)) {
81        return false;
82      }
83    } else {
84      return false;
85    }
86  }
87  a->active = (BytePtr) newlimit;
88  tcr->last_allocptr = (void *)newlimit;
89  tcr->save_allocptr = (void *)newlimit;
90  xpGPR(xp,Iallocptr) = (LispObj) newlimit;
91  tcr->save_allocbase = (void *) oldlimit;
92
93  while (HeapHighWaterMark < (BytePtr)newlimit) {
94    zero_page(HeapHighWaterMark);
95    HeapHighWaterMark+=page_size;
96  }
97  return true;
98}
99
100Boolean
101allocate_object(ExceptionInformation *xp,
102                natural bytes_needed, 
103                signed_natural disp_from_allocptr,
104                TCR *tcr)
105{
106  area *a = active_dynamic_area;
107
108  /* Maybe do an EGC */
109  if (a->older && lisp_global(OLDEST_EPHEMERAL)) {
110    if (((a->active)-(a->low)) >= a->threshold) {
111      gc_from_xp(xp, 0L);
112    }
113  }
114
115  /* Life is pretty simple if we can simply grab a segment
116     without extending the heap.
117  */
118  if (new_heap_segment(xp, bytes_needed, false, tcr)) {
119    xpGPR(xp, Iallocptr) -= disp_from_allocptr;
120    tcr->save_allocptr = (void *) (xpGPR(xp, Iallocptr));
121    return true;
122  }
123 
124  /* It doesn't make sense to try a full GC if the object
125     we're trying to allocate is larger than everything
126     allocated so far.
127  */
128  if ((lisp_global(HEAP_END)-lisp_global(HEAP_START)) > bytes_needed) {
129    untenure_from_area(tenured_area); /* force a full GC */
130    gc_from_xp(xp, 0L);
131  }
132 
133  /* Try again, growing the heap if necessary */
134  if (new_heap_segment(xp, bytes_needed, true, tcr)) {
135    xpGPR(xp, Iallocptr) -= disp_from_allocptr;
136    tcr->save_allocptr = (void *) (xpGPR(xp, Iallocptr));
137    return true;
138  }
139 
140  return false;
141}
142
143natural gc_deferred = 0, full_gc_deferred = 0;
144
145Boolean
146handle_gc_trap(ExceptionInformation *xp, TCR *tcr)
147{
148  LispObj
149    selector = xpGPR(xp,Iimm0), 
150    arg = xpGPR(xp,Iimm1);
151  area *a = active_dynamic_area;
152  Boolean egc_was_enabled = (a->older != NULL);
153  natural gc_previously_deferred = gc_deferred;
154
155  switch (selector) {
156  case GC_TRAP_FUNCTION_EGC_CONTROL:
157    egc_control(arg != 0, a->active);
158    xpGPR(xp,Iarg_z) = lisp_nil + (egc_was_enabled ? t_offset : 0);
159    break;
160
161  case GC_TRAP_FUNCTION_CONFIGURE_EGC:
162    a->threshold = unbox_fixnum(xpGPR(xp, Iarg_x));
163    g1_area->threshold = unbox_fixnum(xpGPR(xp, Iarg_y));
164    g2_area->threshold = unbox_fixnum(xpGPR(xp, Iarg_z));
165    xpGPR(xp,Iarg_z) = lisp_nil+t_offset;
166    break;
167
168  case GC_TRAP_FUNCTION_SET_LISP_HEAP_THRESHOLD:
169    if (((signed_natural) arg) > 0) {
170      lisp_heap_gc_threshold = 
171        align_to_power_of_2((arg-1) +
172                            (heap_segment_size - 1),
173                            log2_heap_segment_size);
174    }
175    /* fall through */
176  case GC_TRAP_FUNCTION_GET_LISP_HEAP_THRESHOLD:
177    xpGPR(xp, Iimm0) = lisp_heap_gc_threshold;
178    break;
179
180  case GC_TRAP_FUNCTION_USE_LISP_HEAP_THRESHOLD:
181    /*  Try to put the current threshold in effect.  This may
182        need to disable/reenable the EGC. */
183    untenure_from_area(tenured_area);
184    resize_dynamic_heap(a->active,lisp_heap_gc_threshold);
185    if (egc_was_enabled) {
186      if ((a->high - a->active) >= a->threshold) {
187        tenure_to_area(tenured_area);
188      }
189    }
190    xpGPR(xp, Iimm0) = lisp_heap_gc_threshold;
191    break;
192
193  default:
194    update_bytes_allocated(tcr, (void *) tcr->save_allocptr);
195
196    if (selector == GC_TRAP_FUNCTION_IMMEDIATE_GC) {
197      if (!full_gc_deferred) {
198        gc_from_xp(xp, 0L);
199        break;
200      }
201      /* Tried to do a full GC when gc was disabled.  That failed,
202         so try full GC now */
203      selector = GC_TRAP_FUNCTION_GC;
204    }
205   
206    if (egc_was_enabled) {
207      egc_control(false, (BytePtr) a->active);
208    }
209    gc_from_xp(xp, 0L);
210    if (gc_deferred > gc_previously_deferred) {
211      full_gc_deferred = 1;
212    } else {
213      full_gc_deferred = 0;
214    }
215    if (selector & GC_TRAP_FUNCTION_PURIFY) {
216      purify_from_xp(xp, 0L);
217      gc_from_xp(xp, 0L);
218    }
219    if (selector & GC_TRAP_FUNCTION_SAVE_APPLICATION) {
220      OSErr err;
221      extern OSErr save_application(unsigned);
222      area *vsarea = tcr->vs_area;
223       
224      nrs_TOPLFUNC.vcell = *((LispObj *)(vsarea->high)-1);
225      err = save_application(arg);
226      if (err == noErr) {
227        _exit(0);
228      }
229      fatal_oserr(": save_application", err);
230    }
231    if (selector == GC_TRAP_FUNCTION_SET_HONS_AREA_SIZE) {
232      LispObj aligned_arg = align_to_power_of_2(arg, log2_nbits_in_word);
233      signed_natural
234        delta_dnodes = ((signed_natural) aligned_arg) - 
235        ((signed_natural) tenured_area->static_dnodes);
236      change_hons_area_size_from_xp(xp, delta_dnodes*dnode_size);
237      xpGPR(xp, Iimm0) = tenured_area->static_dnodes;
238    }
239    if (egc_was_enabled) {
240      egc_control(true, NULL);
241    }
242    break;
243  }
244  return true;
245}
246
247 
248
249
250
251void
252push_on_lisp_stack(ExceptionInformation *xp, LispObj value)
253{
254  LispObj *vsp = (LispObj *)xpGPR(xp,Isp);
255  *--vsp = value;
256  xpGPR(xp,Isp) = (LispObj)vsp;
257}
258
259
260/* Hard to know if or whether this is necessary in general.  For now,
261   do it when we get a "wrong number of arguments" trap.
262*/
263void
264finish_function_entry(ExceptionInformation *xp)
265{
266  natural nargs = (xpGPR(xp,Inargs)&0xffff)>> fixnumshift;
267  signed_natural disp = nargs-3;
268  LispObj *vsp =  (LispObj *) xpGPR(xp,Isp);
269   
270 
271  if (disp > 0) {               /* implies that nargs > 3 */
272    vsp[disp] = xpGPR(xp,Irbp);
273    vsp[disp+1] = xpGPR(xp,Ira0);
274    xpGPR(xp,Irbp) = (LispObj)(vsp+disp);
275    push_on_lisp_stack(xp,xpGPR(xp,Iarg_x));
276    push_on_lisp_stack(xp,xpGPR(xp,Iarg_y));
277    push_on_lisp_stack(xp,xpGPR(xp,Iarg_z));
278  } else {
279    push_on_lisp_stack(xp,xpGPR(xp,Ira0));
280    push_on_lisp_stack(xp,xpGPR(xp,Irbp));
281    xpGPR(xp,Irbp) = xpGPR(xp,Isp);
282    if (nargs == 3) {
283      push_on_lisp_stack(xp,xpGPR(xp,Iarg_x));
284    }
285    if (nargs >= 2) {
286      push_on_lisp_stack(xp,xpGPR(xp,Iarg_y));
287    }
288    if (nargs >= 1) {
289      push_on_lisp_stack(xp,xpGPR(xp,Iarg_z));
290    }
291  }
292}
293
294Boolean
295object_contains_pc(LispObj container, LispObj addr)
296{
297  if (fulltag_of(container) >= fulltag_misc) {
298    natural elements = header_element_count(header_of(container));
299    if ((addr >= container) &&
300        (addr < ((LispObj)&(deref(container,1+elements))))) {
301      return true;
302    }
303  }
304  return false;
305}
306
307LispObj
308create_exception_callback_frame(ExceptionInformation *xp)
309{
310  LispObj containing_uvector = 0, 
311    relative_pc, 
312    nominal_function = lisp_nil, 
313    f, tra, tra_f = 0, abs_pc;
314
315  f = xpGPR(xp,Ifn);
316  tra = xpGPR(xp,Ira0);
317  if (tag_of(tra) == tag_tra) {
318    tra_f = tra - ((int *)tra)[-1];
319    if (fulltag_of(tra_f) != fulltag_function) {
320      tra_f = 0;
321    }
322  }
323
324  abs_pc = (LispObj)xpPC(xp);
325
326  if (fulltag_of(f) == fulltag_function) {
327    nominal_function = f;
328  } else {
329    if (tra_f) {
330      nominal_function = tra_f;
331    }
332  }
333 
334  f = xpGPR(xp,Ifn);
335  if (object_contains_pc(f, abs_pc)) {
336    containing_uvector = untag(f)+fulltag_misc;
337  } else {
338    f = xpGPR(xp,Ixfn);
339    if (object_contains_pc(f, abs_pc)) {
340      containing_uvector = untag(f)+fulltag_misc;
341    } else {
342      if (tra_f) {
343        f = tra_f;
344        if (object_contains_pc(f, abs_pc)) {
345          containing_uvector = untag(f)+fulltag_misc;
346          relative_pc = (abs_pc - f) << fixnumshift;
347        }
348      }
349    }
350  }
351  if (containing_uvector) {
352    relative_pc = (abs_pc - (LispObj)&(deref(containing_uvector,1))) << fixnumshift;
353  } else {
354    containing_uvector = lisp_nil;
355    relative_pc = abs_pc << fixnumshift;
356  }
357 
358  push_on_lisp_stack(xp,tra);
359  push_on_lisp_stack(xp,(LispObj)xp);
360  push_on_lisp_stack(xp,containing_uvector); 
361  push_on_lisp_stack(xp,relative_pc);
362  push_on_lisp_stack(xp,nominal_function);
363  push_on_lisp_stack(xp,0);
364  push_on_lisp_stack(xp,xpGPR(xp,Irbp));
365  xpGPR(xp,Irbp) = xpGPR(xp,Isp);
366  return xpGPR(xp,Isp);
367}
368
369#ifndef XMEMFULL
370#define XMEMFULL (76)
371#endif
372
373Boolean
374handle_alloc_trap(ExceptionInformation *xp, TCR *tcr)
375{
376  natural cur_allocptr, bytes_needed;
377  unsigned allocptr_tag;
378  signed_natural disp;
379 
380  cur_allocptr = xpGPR(xp,Iallocptr);
381  allocptr_tag = fulltag_of(cur_allocptr);
382  if (allocptr_tag == fulltag_misc) {
383    disp = xpGPR(xp,Iimm1);
384  } else {
385    disp = dnode_size-fulltag_cons;
386  }
387  bytes_needed = disp+allocptr_tag;
388
389  update_bytes_allocated(tcr,((BytePtr)(cur_allocptr+disp)));
390  if (allocate_object(xp, bytes_needed, disp, tcr)) {
391    return true;
392  }
393 
394  {
395    LispObj xcf = create_exception_callback_frame(xp),
396      cmain = nrs_CMAIN.vcell;
397    int skip;
398   
399    tcr->save_allocptr = tcr->save_allocbase = (void *)VOID_ALLOCPTR;
400    xpGPR(xp,Iallocptr) = VOID_ALLOCPTR;
401
402    skip = callback_to_lisp(tcr, cmain, xp, xcf, -1, XMEMFULL, 0, 0);
403    xpPC(xp) += skip;
404  }
405
406  return true;
407}
408
409extern unsigned get_mxcsr();
410extern void set_mxcsr(unsigned);
411 
412int
413callback_to_lisp (TCR * tcr, LispObj callback_macptr, ExceptionInformation *xp,
414                  natural arg1, natural arg2, natural arg3, natural arg4, natural arg5)
415{
416  sigset_t mask;
417  natural  callback_ptr, i;
418  int delta;
419  unsigned old_mxcsr = get_mxcsr();
420
421  set_mxcsr(0x1f80);
422
423  /* Put the active stack pointers where .SPcallback expects them */
424  tcr->save_vsp = (LispObj *) xpGPR(xp, Isp);
425  tcr->save_rbp = (LispObj *) xpGPR(xp, Irbp);
426
427
428  /* Call back.  The caller of this function may have modified stack/frame
429     pointers (and at least should have called prepare_for_callback()).
430  */
431  callback_ptr = ((macptr *)ptr_from_lispobj(untag(callback_macptr)))->address;
432  UNLOCK(lisp_global(EXCEPTION_LOCK), tcr);
433  delta = ((int (*)())callback_ptr) (xp, arg1, arg2, arg3, arg4, arg5);
434  LOCK(lisp_global(EXCEPTION_LOCK), tcr);
435  set_mxcsr(old_mxcsr);
436  return delta;
437}
438
439void
440callback_for_interrupt(TCR *tcr, ExceptionInformation *xp)
441{
442  LispObj save_rbp = xpGPR(xp,Irbp),
443    *save_vsp = (LispObj *)xpGPR(xp,Isp),
444    word_beyond_vsp = save_vsp[-1],
445    xcf = create_exception_callback_frame(xp);
446  int save_errno = errno;
447 
448  callback_to_lisp(tcr, nrs_CMAIN.vcell,xp, xcf, 0, 0, 0, 0);
449  xpGPR(xp,Irbp) = save_rbp;
450  xpGPR(xp,Isp) = (LispObj)save_vsp;
451  save_vsp[-1] = word_beyond_vsp;
452  errno = save_errno;
453}
454
455Boolean
456handle_error(TCR *tcr, ExceptionInformation *xp)
457{
458  pc program_counter = (pc)xpPC(xp);
459  unsigned char op0 = program_counter[0], op1 = program_counter[1];
460  LispObj rpc = (LispObj) program_counter, errdisp = nrs_ERRDISP.vcell,
461    save_rbp = xpGPR(xp,Irbp), save_vsp = xpGPR(xp,Isp), xcf;
462  int skip;
463
464  if ((fulltag_of(errdisp) == fulltag_misc) &&
465      (header_subtag(header_of(errdisp)) == subtag_macptr)) {
466
467    if ((op0 == 0xcd) && (op1 >= 0xc0) && (op1 <= 0xc2)) {
468      finish_function_entry(xp);
469    }
470    xcf = create_exception_callback_frame(xp);
471    skip = callback_to_lisp(tcr, errdisp, xp, xcf, 0, 0, 0, 0);
472    xpGPR(xp,Irbp) = save_rbp;
473    xpGPR(xp,Isp) = save_vsp;
474    xpPC(xp) += skip;
475    return true;
476  } else {
477    return false;
478  }
479}
480
481
482protection_handler
483* protection_handlers[] = {
484  do_spurious_wp_fault,
485  do_soft_stack_overflow,
486  do_soft_stack_overflow,
487  do_soft_stack_overflow,
488  do_hard_stack_overflow,   
489  do_hard_stack_overflow,
490  do_hard_stack_overflow,
491};
492
493
494/* Maybe this'll work someday.  We may have to do something to
495   make the thread look like it's not handling an exception */
496void
497reset_lisp_process(ExceptionInformation *xp)
498{
499}
500
501Boolean
502do_hard_stack_overflow(ExceptionInformation *xp, protected_area_ptr area, BytePtr addr)
503{
504  reset_lisp_process(xp);
505  return false;
506}
507
508
509Boolean
510do_spurious_wp_fault(ExceptionInformation *xp, protected_area_ptr area, BytePtr addr)
511{
512
513  return false;
514}
515
516Boolean
517do_soft_stack_overflow(ExceptionInformation *xp, protected_area_ptr prot_area, BytePtr addr)
518{
519  /* Trying to write into a guard page on the vstack or tstack.
520     Allocate a new stack segment, emulate stwu and stwux for the TSP, and
521     signal an error_stack_overflow condition.
522      */
523  lisp_protection_kind which = prot_area->why;
524  Boolean on_TSP = (which == kTSPsoftguard);
525  LispObj save_rbp = xpGPR(xp,Irbp), 
526    save_vsp = xpGPR(xp,Isp), 
527    xcf,
528    cmain = nrs_CMAIN.vcell;
529  area *a;
530  protected_area_ptr soft;
531  TCR *tcr = get_tcr(false);
532  int skip;
533
534  if ((fulltag_of(cmain) == fulltag_misc) &&
535      (header_subtag(header_of(cmain)) == subtag_macptr)) {
536    if (on_TSP) {
537      a = tcr->ts_area;
538    } else {
539      a = tcr->vs_area;
540    }
541    soft = a->softprot;
542    unprotect_area(soft);
543    xcf = create_exception_callback_frame(xp);
544    skip = callback_to_lisp(tcr, nrs_CMAIN.vcell, xp, xcf, SIGSEGV, on_TSP, 0, 0);
545    xpGPR(xp,Irbp) = save_rbp;
546    xpGPR(xp,Isp) = save_vsp;
547    xpPC(xp) += skip;
548    return true;
549  }
550  return false;
551}
552
553Boolean
554handle_fault(TCR *tcr, ExceptionInformation *xp, siginfo_t *info)
555{
556#ifdef FREEBSD
557  BytePtr addr = (BytePtr) xp->uc_mcontext.mc_addr;
558#else
559  BytePtr addr = (BytePtr) info->si_addr;
560#endif
561
562  if (addr && (addr == tcr->safe_ref_address)) {
563    xpGPR(xp,Iimm0) = 0;
564    xpPC(xp) = xpGPR(xp,Ira0);
565    return true;
566  } else {
567    protected_area *a = find_protected_area(addr);
568    protection_handler *handler;
569
570    if (a) {
571      handler = protection_handlers[a->why];
572      return handler(xp, a, addr);
573    }
574  }
575  return false;
576}
577
578Boolean
579handle_floating_point_exception(TCR *tcr, ExceptionInformation *xp, siginfo_t *info)
580{
581  int code = info->si_code, rfn = 0, skip;
582  pc program_counter = (pc)xpPC(xp);
583  LispObj rpc = (LispObj) program_counter, xcf, cmain = nrs_CMAIN.vcell,
584
585    save_rbp = xpGPR(xp,Irbp), save_vsp = xpGPR(xp,Isp);
586
587  if ((fulltag_of(cmain) == fulltag_misc) &&
588      (header_subtag(header_of(cmain)) == subtag_macptr)) {
589    xcf = create_exception_callback_frame(xp);
590    skip = callback_to_lisp(tcr, cmain, xp, xcf, SIGFPE, code, 0, 0);
591    xpPC(xp) += skip;
592    xpGPR(xp,Irbp) = save_rbp;
593    xpGPR(xp,Isp) = save_vsp;
594    return true;
595  } else {
596    return false;
597  }
598}
599
600Boolean
601extend_tcr_tlb(TCR *tcr, ExceptionInformation *xp)
602{
603  LispObj index, old_limit = tcr->tlb_limit, new_limit, new_bytes;
604  LispObj *old_tlb = tcr->tlb_pointer, *new_tlb, *work, *tos;
605
606  tos = (LispObj*)(xpGPR(xp,Isp));
607  index = *tos++;
608  (xpGPR(xp,Isp))=(LispObj)tos;
609 
610  new_limit = align_to_power_of_2(index+1,12);
611  new_bytes = new_limit-old_limit;
612  new_tlb = realloc(old_tlb, new_limit);
613
614  if (new_tlb == NULL) {
615    return false;
616  }
617  work = (LispObj *) ((BytePtr)new_tlb+old_limit);
618
619  while (new_bytes) {
620    *work++ = no_thread_local_binding_marker;
621    new_bytes -= sizeof(LispObj);
622  }
623  tcr->tlb_pointer = new_tlb;
624  tcr->tlb_limit = new_limit;
625  return true;
626}
627
628
629#if defined(FREEBSD) || defined(DARWIN)
630static
631char mxcsr_bit_to_fpe_code[] = {
632  FPE_FLTINV,                   /* ie */
633  0,                            /* de */
634  FPE_FLTDIV,                   /* ze */
635  FPE_FLTOVF,                   /* oe */
636  FPE_FLTUND,                   /* ue */
637  FPE_FLTRES                    /* pe */
638};
639
640void
641decode_vector_fp_exception(siginfo_t *info, uint32_t mxcsr)
642{
643  /* If the exception appears to be an XMM FP exception, try to
644     determine what it was by looking at bits in the mxcsr.
645  */
646  int xbit, maskbit;
647 
648  for (xbit = 0, maskbit = MXCSR_IM_BIT; xbit < 6; xbit++, maskbit++) {
649    if ((mxcsr & (1 << xbit)) &&
650        !(mxcsr & (1 << maskbit))) {
651      info->si_code = mxcsr_bit_to_fpe_code[xbit];
652      return;
653    }
654  }
655}
656
657#ifdef FREEBSD
658void
659freebsd_decode_vector_fp_exception(siginfo_t *info, ExceptionInformation *xp)
660{
661  if (info->si_code == 0) {
662    struct savefpu *fpu = (struct savefpu *) &(xp->uc_mcontext.mc_fpstate);
663    uint32_t mxcsr = fpu->sv_env.en_mxcsr;
664
665    decode_vector_fp_exception(info, mxcsr);
666  }
667}
668#endif
669
670#ifdef DARWIN
671void
672darwin_decode_vector_fp_exception(siginfo_t *info, ExceptionInformation *xp)
673{
674  if (info->si_code == EXC_I386_SSEEXTERR) {
675    uint32_t mxcsr = UC_MCONTEXT(xp)->__fs.__fpu_mxcsr;
676
677    decode_vector_fp_exception(info, mxcsr);
678  }
679}
680
681#endif
682
683#endif
684
685void
686get_lisp_string(LispObj lisp_string, char *c_string, natural max)
687{
688  lisp_char_code *src = (lisp_char_code *)  (ptr_from_lispobj(lisp_string + misc_data_offset));
689  natural i, n = header_element_count(header_of(lisp_string));
690
691  if (n > max) {
692    n = max;
693  }
694
695  for (i = 0; i < n; i++) {
696    c_string[i] = 0xff & (src[i]);
697  }
698  c_string[n] = 0;
699}
700
701Boolean
702handle_exception(int signum, siginfo_t *info, ExceptionInformation  *context, TCR *tcr)
703{
704  pc program_counter = (pc)xpPC(context);
705
706  switch (signum) {
707  case SIGNUM_FOR_INTN_TRAP:
708    if (IS_MAYBE_INT_TRAP(info,context)) {
709      /* Something mapped to SIGSEGV/SIGBUS that has nothing to do with
710         a memory fault.  On x86, an "int n" instruction that's
711         not otherwise implemented causes a "protecton fault".  Of
712         course that has nothing to do with accessing protected
713         memory; of course, most Unices act as if it did.*/
714      if (*program_counter == INTN_OPCODE) {
715        program_counter++;
716        switch (*program_counter) {
717        case UUO_ALLOC_TRAP:
718          if (handle_alloc_trap(context, tcr)) {
719            xpPC(context) += 2; /* we might have GCed. */
720            return true;
721          }
722          break;
723        case UUO_GC_TRAP:
724          if (handle_gc_trap(context, tcr)) {
725            xpPC(context) += 2;
726            return true;
727          }
728          break;
729         
730        case UUO_DEBUG_TRAP:
731          xpPC(context) = (natural) (program_counter+1);
732          lisp_Debugger(context, info, debug_entry_dbg, "Lisp Breakpoint");
733          return true;
734
735        case UUO_DEBUG_TRAP_WITH_STRING:
736          xpPC(context) = (natural) (program_counter+1);
737          {
738            char msg[512];
739
740            get_lisp_string(xpGPR(context,Iarg_z),msg, sizeof(msg)-1);
741            lisp_Debugger(context, info, debug_entry_dbg, msg);
742          }
743          return true;
744         
745        default:
746          return handle_error(tcr, context);
747        }
748      } else {
749        return false;
750      }
751
752    } else {
753      return handle_fault(tcr, context, info);
754    }
755    break;
756
757  case SIGNAL_FOR_PROCESS_INTERRUPT:
758    tcr->interrupt_pending = 0;
759    callback_for_interrupt(tcr, context);
760    return true;
761    break;
762
763
764  case SIGILL:
765    if ((program_counter[0] == XUUO_OPCODE_0) &&
766        (program_counter[1] == XUUO_OPCODE_1)) {
767      switch (program_counter[2]) {
768      case XUUO_TLB_TOO_SMALL:
769        if (extend_tcr_tlb(tcr,context)) {
770          xpPC(context)+=3;
771          return true;
772        }
773        break;
774       
775      case XUUO_INTERRUPT_NOW:
776        callback_for_interrupt(tcr,context);
777        xpPC(context)+=3;
778        return true;
779       
780      default:
781        return false;
782      }
783    } else {
784      return false;
785    }
786    break;
787   
788  case SIGFPE:
789#ifdef FREEBSD
790    /* As of 6.1, FreeBSD/AMD64 doesn't seem real comfortable
791       with this newfangled XMM business (and therefore info->si_code
792       is often 0 on an XMM FP exception.
793       Try to figure out what really happened by decoding mxcsr
794       bits.
795    */
796    freebsd_decode_vector_fp_exception(info,context);
797#endif
798#ifdef DARWIN
799    /* Same general problem with Darwin as of 8.7.2 */
800    darwin_decode_vector_fp_exception(info,context);
801#endif
802
803    return handle_floating_point_exception(tcr, context, info);
804
805#if SIGBUS != SIGNUM_FOR_INTN_TRAP
806  case SIGBUS:
807    return handle_fault(tcr, context, info);
808#endif
809   
810#if SIGSEGV != SIGNUM_FOR_INTN_TRAP
811  case SIGSEGV:
812    return handle_fault(tcr, context, info);
813#endif   
814   
815  default:
816    return false;
817  }
818}
819
820
821/*
822   Current thread has all signals masked.  Before unmasking them,
823   make it appear that the current thread has been suspended.
824   (This is to handle the case where another thread is trying
825   to GC before this thread is able to seize the exception lock.)
826*/
827int
828prepare_to_wait_for_exception_lock(TCR *tcr, ExceptionInformation *context)
829{
830  int old_valence = tcr->valence;
831
832  tcr->pending_exception_context = context;
833  tcr->valence = TCR_STATE_EXCEPTION_WAIT;
834
835  ALLOW_EXCEPTIONS(context);
836  return old_valence;
837} 
838
839void
840wait_for_exception_lock_in_handler(TCR *tcr, 
841                                   ExceptionInformation *context,
842                                   xframe_list *xf)
843{
844
845  LOCK(lisp_global(EXCEPTION_LOCK), tcr);
846#if 0
847  fprintf(stderr, "0x%x has exception lock\n", tcr);
848#endif
849  xf->curr = context;
850  xf->prev = tcr->xframe;
851  tcr->xframe =  xf;
852  tcr->pending_exception_context = NULL;
853  tcr->valence = TCR_STATE_FOREIGN; 
854}
855
856void
857unlock_exception_lock_in_handler(TCR *tcr)
858{
859  tcr->pending_exception_context = tcr->xframe->curr;
860  tcr->xframe = tcr->xframe->prev;
861  tcr->valence = TCR_STATE_EXCEPTION_RETURN;
862  UNLOCK(lisp_global(EXCEPTION_LOCK),tcr);
863#if 0
864  fprintf(stderr, "0x%x released exception lock\n", tcr);
865#endif
866}
867
868/*
869   If an interrupt is pending on exception exit, try to ensure
870   that the thread sees it as soon as it's able to run.
871*/
872void
873raise_pending_interrupt(TCR *tcr)
874{
875  if (TCR_INTERRUPT_LEVEL(tcr) > 0) {
876    pthread_kill((pthread_t)(tcr->osid), SIGNAL_FOR_PROCESS_INTERRUPT);
877  }
878}
879
880void
881exit_signal_handler(TCR *tcr, int old_valence)
882{
883  sigset_t mask;
884  sigfillset(&mask);
885 
886  pthread_sigmask(SIG_SETMASK,&mask, NULL);
887  tcr->valence = old_valence;
888  tcr->pending_exception_context = NULL;
889}
890
891void
892signal_handler(int signum, siginfo_t *info, ExceptionInformation  *context, TCR *tcr, int old_valence)
893{
894#ifdef DARWIN_GS_HACK
895  Boolean gs_was_tcr = ensure_gs_pthread();
896#endif
897  xframe_list xframe_link;
898#ifndef DARWIN
899  tcr = get_tcr(false);
900
901  old_valence = prepare_to_wait_for_exception_lock(tcr, context);
902#endif
903  wait_for_exception_lock_in_handler(tcr,context, &xframe_link);
904
905
906  if (! handle_exception(signum, info, context, tcr)) {
907    char msg[512];
908
909    snprintf(msg, sizeof(msg), "Unhandled exception %d at 0x%lx, context->regs at #x%lx", signum, xpPC(context), (natural)xpGPRvector(context));
910   
911    if (lisp_Debugger(context, info, signum, msg)) {
912      SET_TCR_FLAG(tcr,TCR_FLAG_BIT_PROPAGATE_EXCEPTION);
913    }
914  }
915  unlock_exception_lock_in_handler(tcr);
916#ifndef DARWIN_USE_PSEUDO_SIGRETURN
917  exit_signal_handler(tcr, old_valence);
918#endif
919  /* raise_pending_interrupt(tcr); */
920#ifdef DARWIN_GS_HACK
921  if (gs_was_tcr) {
922    set_gs_address(tcr);
923  }
924#endif
925#ifndef DARWIN_USE_PSEUDO_SIGRETURN
926  SIGRETURN(context);
927#endif
928}
929
930#ifdef DARWIN
931void
932pseudo_signal_handler(int signum, siginfo_t *info, ExceptionInformation  *context, TCR *tcr, int old_valence)
933{
934  sigset_t mask;
935
936  sigfillset(&mask);
937
938  pthread_sigmask(SIG_SETMASK,&mask,&(context->uc_sigmask));
939  signal_handler(signum, info, context, tcr, old_valence);
940}
941#endif
942
943
944
945#ifdef LINUX
946LispObj *
947copy_fpregs(ExceptionInformation *xp, LispObj *current, fpregset_t *destptr)
948{
949  fpregset_t src = xp->uc_mcontext.fpregs, dest;
950 
951  if (src) {
952    dest = ((fpregset_t)current)-1;
953    *dest = *src;
954    *destptr = dest;
955    current = (LispObj *) dest;
956  }
957  return current;
958}
959#endif
960
961#ifdef DARWIN
962LispObj *
963copy_darwin_mcontext(MCONTEXT_T context, 
964                     LispObj *current, 
965                     MCONTEXT_T *out)
966{
967  MCONTEXT_T dest = ((MCONTEXT_T)current)-1;
968  dest = (MCONTEXT_T) (((LispObj)dest) & ~15);
969
970  *dest = *context;
971  *out = dest;
972  return (LispObj *)dest;
973}
974#endif
975
976LispObj *
977copy_siginfo(siginfo_t *info, LispObj *current)
978{
979  siginfo_t *dest = ((siginfo_t *)current) - 1;
980  dest = (siginfo_t *) (((LispObj)dest)&~15);
981  *dest = *info;
982  return (LispObj *)dest;
983}
984
985#ifdef LINUX
986typedef fpregset_t copy_ucontext_last_arg_t;
987#else
988typedef void * copy_ucontext_last_arg_t;
989#endif
990
991LispObj *
992copy_ucontext(ExceptionInformation *context, LispObj *current, copy_ucontext_last_arg_t fp)
993{
994  ExceptionInformation *dest = ((ExceptionInformation *)current)-1;
995  dest = (ExceptionInformation *) (((LispObj)dest) & ~15);
996
997  *dest = *context;
998  /* Fix it up a little; where's the signal mask allocated, if indeed
999     it is "allocated" ? */
1000#ifdef LINUX
1001  dest->uc_mcontext.fpregs = fp;
1002#endif
1003  dest->uc_stack.ss_sp = 0;
1004  dest->uc_stack.ss_size = 0;
1005  dest->uc_stack.ss_flags = 0;
1006  dest->uc_link = NULL;
1007  return (LispObj *)dest;
1008}
1009
1010LispObj *
1011find_foreign_rsp(LispObj rsp, area *foreign_area, TCR *tcr)
1012{
1013
1014  if (((BytePtr)rsp < foreign_area->low) ||
1015      ((BytePtr)rsp > foreign_area->high)) {
1016    rsp = (LispObj)(tcr->foreign_sp);
1017  }
1018  return (LispObj *) ((rsp-128 & ~15));
1019}
1020
1021
1022#ifdef DARWIN
1023/*
1024   There seems to be a problem with thread-level exception handling;
1025   Mach seems (under some cirumstances) to conclude that there's
1026   no thread-level handler and exceptions get passed up to a
1027   handler that raises Un*x signals.  Ignore those signals so that
1028   the exception will repropagate and eventually get caught by
1029   catch_exception_raise() at the thread level.
1030
1031   Mach sucks, but no one understands how.
1032*/
1033void
1034bogus_signal_handler()
1035{
1036  /* This does nothing, but does it with signals masked */
1037}
1038#endif
1039
1040void
1041handle_signal_on_foreign_stack(TCR *tcr,
1042                               void *handler, 
1043                               int signum, 
1044                               siginfo_t *info, 
1045                               ExceptionInformation *context,
1046                               LispObj return_address
1047#ifdef DARWIN_GS_HACK
1048                               , Boolean gs_was_tcr
1049#endif
1050                               )
1051{
1052#ifdef LINUX
1053  fpregset_t fpregs = NULL;
1054#else
1055  void *fpregs = NULL;
1056#endif
1057#ifdef DARWIN
1058  MCONTEXT_T mcontextp = NULL;
1059#endif
1060  siginfo_t *info_copy = NULL;
1061  ExceptionInformation *xp = NULL;
1062  LispObj *foreign_rsp = find_foreign_rsp(xpGPR(context,Isp), tcr->cs_area, tcr);
1063
1064#ifdef LINUX
1065  foreign_rsp = copy_fpregs(context, foreign_rsp, &fpregs);
1066#endif
1067#ifdef DARWIN
1068  foreign_rsp = copy_darwin_mcontext(UC_MCONTEXT(context), foreign_rsp, &mcontextp);
1069#endif
1070  foreign_rsp = copy_siginfo(info, foreign_rsp);
1071  info_copy = (siginfo_t *)foreign_rsp;
1072  foreign_rsp = copy_ucontext(context, foreign_rsp, fpregs);
1073  xp = (ExceptionInformation *)foreign_rsp;
1074#ifdef DARWIN
1075  UC_MCONTEXT(xp) = mcontextp;
1076#endif
1077  *--foreign_rsp = return_address;
1078#ifdef DARWIN_GS_HACK
1079  if (gs_was_tcr) {
1080    set_gs_address(tcr);
1081  }
1082#endif
1083  switch_to_foreign_stack(foreign_rsp,handler,signum,info_copy,xp);
1084}
1085
1086
1087void
1088altstack_signal_handler(int signum, siginfo_t *info, ExceptionInformation  *context)
1089{
1090  TCR* tcr = get_tcr(true);
1091#if 1
1092  if (tcr->valence != TCR_STATE_LISP) {
1093    Bug(context, "exception in foreign context");
1094  }
1095#endif
1096  handle_signal_on_foreign_stack(tcr,signal_handler,signum,info,context,(LispObj)__builtin_return_address(0)
1097#ifdef DARWIN_GS_HACK
1098                                 , false
1099#endif
1100);
1101}
1102
1103void
1104interrupt_handler (int signum, siginfo_t *info, ExceptionInformation *context)
1105{
1106#ifdef DARWIN_GS_HACK
1107  Boolean gs_was_tcr = ensure_gs_pthread();
1108#endif
1109  TCR *tcr = get_interrupt_tcr(false);
1110  if (tcr) {
1111    if ((TCR_INTERRUPT_LEVEL(tcr) < 0) ||
1112        (tcr->valence != TCR_STATE_LISP) ||
1113        (tcr->unwinding != 0)) {
1114      tcr->interrupt_pending = (1L << (nbits_in_word - 1L));
1115    } else {
1116      LispObj cmain = nrs_CMAIN.vcell;
1117
1118      if ((fulltag_of(cmain) == fulltag_misc) &&
1119          (header_subtag(header_of(cmain)) == subtag_macptr)) {
1120        /*
1121           This thread can (allegedly) take an interrupt now.
1122        */
1123
1124        xframe_list xframe_link;
1125        int old_valence;
1126        signed_natural alloc_displacement = 0;
1127        LispObj
1128          *next_tsp = tcr->next_tsp,
1129          *save_tsp = tcr->save_tsp,
1130          *p,
1131          q;
1132           
1133        if (next_tsp != save_tsp) {
1134          tcr->next_tsp = save_tsp;
1135        } else {
1136          next_tsp = NULL;
1137        }
1138        /* have to do this before allowing interrupts */
1139        pc_luser_xp(context, tcr, &alloc_displacement);
1140        old_valence = prepare_to_wait_for_exception_lock(tcr, context);
1141        wait_for_exception_lock_in_handler(tcr, context, &xframe_link);
1142        handle_exception(signum, info, context, tcr);
1143        if (alloc_displacement) {
1144          tcr->save_allocptr -= alloc_displacement;
1145        }
1146        if (next_tsp) {
1147          tcr->next_tsp = next_tsp;
1148          p = next_tsp;
1149          while (p != save_tsp) {
1150            *p++ = 0;
1151          }
1152          q = (LispObj)save_tsp;
1153          *next_tsp = q;
1154        }
1155        unlock_exception_lock_in_handler(tcr);
1156        exit_signal_handler(tcr, old_valence);
1157      }
1158    }
1159  }
1160#ifdef DARWIN_GS_HACK
1161  if (gs_was_tcr) {
1162    set_gs_address(tcr);
1163  }
1164#endif
1165  SIGRETURN(context);
1166}
1167
1168#ifndef USE_SIGALTSTACK
1169void
1170arbstack_interrupt_handler (int signum, siginfo_t *info, ExceptionInformation *context)
1171{
1172#ifdef DARWIN_GS_HACK
1173  Boolean gs_was_tcr = ensure_gs_pthread();
1174#endif
1175  TCR *tcr = get_interrupt_tcr(false);
1176  area *vs = tcr->vs_area;
1177  BytePtr current_sp = (BytePtr) current_stack_pointer();
1178
1179  if ((current_sp >= vs->low) &&
1180      (current_sp < vs->high)) {
1181    handle_signal_on_foreign_stack(tcr,
1182                                   interrupt_handler,
1183                                   signum,
1184                                   info,
1185                                   context,
1186                                   (LispObj)__builtin_return_address(0)
1187#ifdef DARWIN_GS_HACK
1188                                   ,gs_was_tcr
1189#endif
1190                                   );
1191  } else {
1192    /* If we're not on the value stack, we pretty much have to be on
1193       the C stack.  Just run the handler. */
1194#ifdef DARWIN_GS_HACK
1195    if (gs_was_tcr) {
1196      set_gs_address(tcr);
1197    }
1198#endif
1199    interrupt_handler(signum, info, context);
1200  }
1201}
1202
1203#else /* altstack works */
1204 
1205void
1206altstack_interrupt_handler (int signum, siginfo_t *info, ExceptionInformation *context)
1207{
1208#ifdef DARWIN_GS_HACK
1209  Boolean gs_was_tcr = ensure_gs_pthread();
1210#endif
1211  TCR *tcr = get_interrupt_tcr(false);
1212  handle_signal_on_foreign_stack(tcr,interrupt_handler,signum,info,context,(LispObj)__builtin_return_address(0)
1213#ifdef DARWIN_GS_HACK
1214                                 ,gs_was_tcr
1215#endif
1216                                 );
1217}
1218
1219#endif
1220
1221
1222void
1223install_signal_handler(int signo, void * handler)
1224{
1225  struct sigaction sa;
1226 
1227  sa.sa_sigaction = (void *)handler;
1228  sigfillset(&sa.sa_mask);
1229#ifdef FREEBSD
1230  /* Strange FreeBSD behavior wrt synchronous signals */
1231  sigdelset(&sa.sa_mask,SIGNUM_FOR_INTN_TRAP);
1232  sigdelset(&sa.sa_mask,SIGTRAP);  /* let GDB work */
1233  sigdelset(&sa.sa_mask,SIGILL);
1234  sigdelset(&sa.sa_mask,SIGFPE);
1235  sigdelset(&sa.sa_mask,SIGSEGV);
1236#endif
1237  sa.sa_flags = 
1238    SA_RESTART
1239#ifdef USE_SIGALTSTACK
1240    | SA_ONSTACK
1241#endif
1242    | SA_SIGINFO;
1243
1244  sigaction(signo, &sa, NULL);
1245}
1246
1247
1248void
1249install_pmcl_exception_handlers()
1250{
1251#ifndef DARWIN 
1252  install_signal_handler(SIGILL, altstack_signal_handler);
1253 
1254  install_signal_handler(SIGBUS, altstack_signal_handler);
1255  install_signal_handler(SIGSEGV,altstack_signal_handler);
1256  install_signal_handler(SIGFPE, altstack_signal_handler);
1257#else
1258  install_signal_handler(SIGTRAP,bogus_signal_handler);
1259  install_signal_handler(SIGILL, bogus_signal_handler);
1260 
1261  install_signal_handler(SIGBUS, bogus_signal_handler);
1262  install_signal_handler(SIGSEGV,bogus_signal_handler);
1263  install_signal_handler(SIGFPE, bogus_signal_handler);
1264#endif
1265 
1266  install_signal_handler(SIGNAL_FOR_PROCESS_INTERRUPT,
1267#ifdef USE_SIGALTSTACK
1268                         altstack_interrupt_handler
1269#else
1270                         arbstack_interrupt_handler
1271#endif
1272);
1273  signal(SIGPIPE, SIG_IGN);
1274}
1275
1276#ifndef USE_SIGALTSTACK
1277void
1278arbstack_suspend_resume_handler(int signum, siginfo_t *info, ExceptionInformation  *context)
1279{
1280#ifdef DARWIN_GS_HACK
1281  Boolean gs_was_tcr = ensure_gs_pthread();
1282#endif
1283  TCR *tcr = get_interrupt_tcr(false);
1284  area *vs = tcr->vs_area;
1285  BytePtr current_sp = (BytePtr) current_stack_pointer();
1286
1287  if ((current_sp >= vs->low) &&
1288      (current_sp < vs->high)) {
1289    handle_signal_on_foreign_stack(tcr,
1290                                   suspend_resume_handler,
1291                                   signum,
1292                                   info,
1293                                   context,
1294                                   (LispObj)__builtin_return_address(0)
1295#ifdef DARWIN_GS_HACK
1296                                   ,gs_was_tcr
1297#endif
1298                                   );
1299  } else {
1300    /* If we're not on the value stack, we pretty much have to be on
1301       the C stack.  Just run the handler. */
1302#ifdef DARWIN_GS_HACK
1303    if (gs_was_tcr) {
1304      set_gs_address(tcr);
1305    }
1306#endif
1307    suspend_resume_handler(signum, info, context);
1308  }
1309}
1310
1311
1312#else /* altstack works */
1313void
1314altstack_suspend_resume_handler(int signum, siginfo_t *info, ExceptionInformation  *context)
1315{
1316#ifdef DARWIN_GS_HACK
1317  Boolean gs_was_tcr = ensure_gs_pthread();
1318#endif
1319  TCR* tcr = get_tcr(true);
1320  handle_signal_on_foreign_stack(tcr,
1321                                 suspend_resume_handler,
1322                                 signum,
1323                                 info,
1324                                 context,
1325                                 (LispObj)__builtin_return_address(0)
1326#ifdef DARWIN_GS_HACK
1327                                 ,gs_was_tcr
1328#endif
1329                                 );
1330}
1331
1332#endif
1333
1334void
1335quit_handler(int signum, siginfo_t *info, ExceptionInformation *xp)
1336{
1337  TCR *tcr = get_tcr(false);
1338  area *a;
1339  sigset_t mask;
1340 
1341  sigemptyset(&mask);
1342
1343
1344  if (tcr) {
1345    tcr->valence = TCR_STATE_FOREIGN;
1346    a = tcr->vs_area;
1347    if (a) {
1348      a->active = a->high;
1349    }
1350    a = tcr->ts_area;
1351    if (a) {
1352      a->active = a->high;
1353    }
1354    a = tcr->cs_area;
1355    if (a) {
1356      a->active = a->high;
1357    }
1358  }
1359 
1360  pthread_sigmask(SIG_SETMASK,&mask,NULL);
1361  pthread_exit(NULL);
1362}
1363
1364#ifndef USE_SIGALTSTACK
1365arbstack_quit_handler(int signum, siginfo_t *info, ExceptionInformation *context)
1366{
1367#ifdef DARWIN_GS_HACK
1368  Boolean gs_was_tcr = ensure_gs_pthread();
1369#endif
1370  TCR *tcr = get_interrupt_tcr(false);
1371  area *vs = tcr->vs_area;
1372  BytePtr current_sp = (BytePtr) current_stack_pointer();
1373
1374  if ((current_sp >= vs->low) &&
1375      (current_sp < vs->high)) {
1376    handle_signal_on_foreign_stack(tcr,
1377                                   quit_handler,
1378                                   signum,
1379                                   info,
1380                                   context,
1381                                   (LispObj)__builtin_return_address(0)
1382#ifdef DARWIN_GS_HACK
1383                                   ,gs_was_tcr
1384#endif
1385                                   );
1386  } else {
1387    /* If we're not on the value stack, we pretty much have to be on
1388       the C stack.  Just run the handler. */
1389#ifdef DARWIN_GS_HACK
1390    if (gs_was_tcr) {
1391      set_gs_address(tcr);
1392    }
1393#endif
1394    quit_handler(signum, info, context);
1395  }
1396}
1397
1398
1399#else
1400void
1401altstack_quit_handler(int signum, siginfo_t *info, ExceptionInformation *context)
1402{
1403#ifdef DARWIN_GS_HACK
1404  Boolean gs_was_tcr = ensure_gs_pthread();
1405#endif
1406  TCR* tcr = get_tcr(true);
1407  handle_signal_on_foreign_stack(tcr,
1408                                 quit_handler,
1409                                 signum,
1410                                 info,
1411                                 context,
1412                                 (LispObj)__builtin_return_address(0)
1413#ifdef DARWIN_GS_HACK
1414                                 ,gs_was_tcr
1415#endif
1416                                 );
1417}
1418#endif
1419
1420#ifdef USE_SIGALTSTACK
1421#define SUSPEND_RESUME_HANDLER altstack_suspend_resume_handler
1422#define QUIT_HANDLER altstack_quit_handler
1423#else
1424#define SUSPEND_RESUME_HANDLER arbstack_suspend_resume_handler
1425#define QUIT_HANDLER arbstack_quit_handler
1426#endif
1427
1428void
1429thread_signal_setup()
1430{
1431  thread_suspend_signal = SIG_SUSPEND_THREAD;
1432  thread_resume_signal = SIG_RESUME_THREAD;
1433
1434  install_signal_handler(thread_suspend_signal, (void *)SUSPEND_RESUME_HANDLER);
1435  install_signal_handler(thread_resume_signal, (void *)SUSPEND_RESUME_HANDLER);
1436  install_signal_handler(SIGQUIT, (void *)QUIT_HANDLER);
1437}
1438
1439
1440void
1441enable_fp_exceptions()
1442{
1443}
1444
1445void
1446exception_init()
1447{
1448  install_pmcl_exception_handlers();
1449}
1450
1451void
1452adjust_exception_pc(ExceptionInformation *xp, int delta)
1453{
1454  xpPC(xp) += delta;
1455}
1456
1457/*
1458  Lower (move toward 0) the "end" of the soft protected area associated
1459  with a by a page, if we can.
1460*/
1461
1462void
1463
1464adjust_soft_protection_limit(area *a)
1465{
1466  char *proposed_new_soft_limit = a->softlimit - 4096;
1467  protected_area_ptr p = a->softprot;
1468 
1469  if (proposed_new_soft_limit >= (p->start+16384)) {
1470    p->end = proposed_new_soft_limit;
1471    p->protsize = p->end-p->start;
1472    a->softlimit = proposed_new_soft_limit;
1473  }
1474  protect_area(p);
1475}
1476
1477void
1478restore_soft_stack_limit(unsigned restore_tsp)
1479{
1480  TCR *tcr = get_tcr(false);
1481  area *a;
1482 
1483  if (restore_tsp) {
1484    a = tcr->ts_area;
1485  } else {
1486    a = tcr->vs_area;
1487  }
1488  adjust_soft_protection_limit(a);
1489}
1490
1491
1492#ifdef USE_SIGALTSTACK
1493void
1494setup_sigaltstack(area *a)
1495{
1496  stack_t stack;
1497  stack.ss_sp = a->low;
1498  a->low += 8192;
1499  stack.ss_size = 8192;
1500  stack.ss_flags = 0;
1501  mmap(stack.ss_sp,stack.ss_size, PROT_READ|PROT_WRITE|PROT_EXEC,MAP_FIXED|MAP_ANON|MAP_PRIVATE,-1,0);
1502  if (sigaltstack(&stack, NULL) != 0) {
1503    perror("sigaltstack");
1504    exit(-1);
1505  }
1506}
1507#endif
1508
1509extern opcode egc_write_barrier_start, egc_write_barrier_end,
1510  egc_store_node_conditional_success_test,egc_store_node_conditional,
1511  egc_set_hash_key, egc_gvset, egc_rplacd;
1512
1513/* We use (extremely) rigidly defined instruction sequences for consing,
1514   mostly so that 'pc_luser_xp()' knows what to do if a thread is interrupted
1515   while consing.
1516
1517   Note that we can usually identify which of these instructions is about
1518   to be executed by a stopped thread without comparing all of the bytes
1519   to those at the stopped program counter, but we generally need to
1520   know the sizes of each of these instructions.
1521*/
1522
1523opcode load_allocptr_reg_from_tcr_save_allocptr_instruction[] =
1524  {0x65,0x48,0x8b,0x1c,0x25,0xd8,0x00,0x00,0x00};
1525opcode compare_allocptr_reg_to_tcr_save_allocbase_instruction[] =
1526  {0x65,0x48,0x3b,0x1c,0x25,0xe0,0x00,0x00,0x00};
1527opcode branch_around_alloc_trap_instruction[] =
1528  {0x7f,0x02};
1529opcode alloc_trap_instruction[] =
1530  {0xcd,0xc5};
1531opcode clear_tcr_save_allocptr_tag_instruction[] =
1532  {0x65,0x80,0x24,0x25,0xd8,0x00,0x00,0x00,0xf0};
1533opcode set_allocptr_header_instruction[] =
1534  {0x48,0x89,0x43,0xf3};
1535
1536
1537alloc_instruction_id
1538recognize_alloc_instruction(pc program_counter)
1539{
1540  switch(program_counter[0]) {
1541  case 0xcd: return ID_alloc_trap_instruction;
1542  case 0x7f: return ID_branch_around_alloc_trap_instruction;
1543  case 0x48: return ID_set_allocptr_header_instruction;
1544  case 0x65: 
1545    switch(program_counter[1]) {
1546    case 0x80: return ID_clear_tcr_save_allocptr_tag_instruction;
1547    case 0x48:
1548      switch(program_counter[2]) {
1549      case 0x3b: return ID_compare_allocptr_reg_to_tcr_save_allocbase_instruction;
1550      case 0x8b: return ID_load_allocptr_reg_from_tcr_save_allocptr_instruction;
1551      }
1552    }
1553  }
1554  return ID_unrecognized_alloc_instruction;
1555}
1556     
1557 
1558void
1559pc_luser_xp(ExceptionInformation *xp, TCR *tcr, signed_natural *interrupt_displacement)
1560{
1561  pc program_counter = (pc)xpPC(xp);
1562  int allocptr_tag = fulltag_of((LispObj)(tcr->save_allocptr));
1563
1564  if (allocptr_tag != 0) {
1565    alloc_instruction_id state = recognize_alloc_instruction(program_counter);
1566    signed_natural
1567      disp = (allocptr_tag == fulltag_cons) ?
1568      sizeof(cons) - fulltag_cons :
1569      xpGPR(xp,Iimm1);
1570    LispObj new_vector;
1571
1572    if ((state == ID_unrecognized_alloc_instruction) ||
1573        ((state == ID_set_allocptr_header_instruction) &&
1574         (allocptr_tag != fulltag_misc))) {
1575      Bug(xp, "Can't determine state of thread 0x%lx, interrupted during memory allocation", tcr);
1576    }
1577    switch(state) {
1578    case ID_set_allocptr_header_instruction:
1579      /* We were consing a vector and we won.  Set the header of the new vector
1580         (in the allocptr register) to the header in %rax and skip over this
1581         instruction, then fall into the next case. */
1582      new_vector = xpGPR(xp,Iallocptr);
1583      deref(new_vector,0) = xpGPR(xp,Iimm0);
1584
1585      xpPC(xp) += sizeof(set_allocptr_header_instruction);
1586      /* Fall thru */
1587    case ID_clear_tcr_save_allocptr_tag_instruction:
1588      tcr->save_allocptr = (void *)(((LispObj)tcr->save_allocptr) & ~fulltagmask);
1589      xpPC(xp) += sizeof(clear_tcr_save_allocptr_tag_instruction);
1590      break;
1591    case ID_alloc_trap_instruction:
1592      /* If we're looking at another thread, we're pretty much committed to
1593         taking the trap.  We don't want the allocptr register to be pointing
1594         into the heap, so make it point to (- VOID_ALLOCPTR disp), where 'disp'
1595         was determined above.
1596      */
1597      if (interrupt_displacement == NULL) {
1598        xpGPR(xp,Iallocptr) = VOID_ALLOCPTR - disp;
1599        tcr->save_allocptr = (void *)(VOID_ALLOCPTR - disp);
1600      } else {
1601        /* Back out, and tell the caller how to resume the allocation attempt */
1602        *interrupt_displacement = disp;
1603        xpGPR(xp,Iallocptr) = VOID_ALLOCPTR;
1604        tcr->save_allocptr += disp;
1605        xpPC(xp) -= (sizeof(branch_around_alloc_trap_instruction)+
1606                     sizeof(compare_allocptr_reg_to_tcr_save_allocbase_instruction) +
1607                     sizeof(load_allocptr_reg_from_tcr_save_allocptr_instruction));
1608      }
1609      break;
1610    case ID_branch_around_alloc_trap_instruction:
1611      /* If we'd take the branch - which is a 'jg" - around the alloc trap,
1612         we might as well finish the allocation.  Otherwise, back out of the
1613         attempt. */
1614      {
1615        int flags = (int)xpGPR(xp,Iflags);
1616       
1617        if ((!(flags & (1 << X86_ZERO_FLAG_BIT))) &&
1618            ((flags & (1 << X86_SIGN_FLAG_BIT)) ==
1619             (flags & (1 << X86_CARRY_FLAG_BIT)))) {
1620          /* The branch (jg) would have been taken.  Emulate taking it. */
1621          xpPC(xp) += (sizeof(branch_around_alloc_trap_instruction)+
1622                       sizeof(alloc_trap_instruction));
1623          if (allocptr_tag == fulltag_misc) {
1624            /* Slap the header on the new uvector */
1625            new_vector = xpGPR(xp,Iallocptr);
1626            deref(new_vector,0) = xpGPR(xp,Iimm0);
1627            xpPC(xp) += sizeof(set_allocptr_header_instruction);
1628          }
1629          tcr->save_allocptr = (void *)(((LispObj)tcr->save_allocptr) & ~fulltagmask);
1630          xpPC(xp) += sizeof(clear_tcr_save_allocptr_tag_instruction);
1631        } else {
1632          /* Back up */
1633          xpPC(xp) -= (sizeof(compare_allocptr_reg_to_tcr_save_allocbase_instruction) +
1634                       sizeof(load_allocptr_reg_from_tcr_save_allocptr_instruction));
1635          xpGPR(xp,Iallocptr) = VOID_ALLOCPTR;
1636          if (interrupt_displacement) {
1637            *interrupt_displacement = disp;
1638            tcr->save_allocptr += disp;
1639          } else {
1640            tcr->save_allocptr = (void *)(VOID_ALLOCPTR-disp);
1641          }
1642        }
1643      }
1644      break;
1645    case ID_compare_allocptr_reg_to_tcr_save_allocbase_instruction:
1646      xpGPR(xp,Iallocptr) = VOID_ALLOCPTR;
1647      xpPC(xp) -= sizeof(load_allocptr_reg_from_tcr_save_allocptr_instruction);
1648      /* Fall through */
1649    case ID_load_allocptr_reg_from_tcr_save_allocptr_instruction:
1650      if (interrupt_displacement) {
1651        tcr->save_allocptr += disp;
1652        *interrupt_displacement = disp;
1653      } else {
1654        tcr->save_allocptr = (void *)(VOID_ALLOCPTR-disp);
1655      }
1656      break;
1657    }
1658    return;
1659  }
1660  if ((program_counter >= &egc_write_barrier_start) &&
1661      (program_counter < &egc_write_barrier_end)) {
1662    LispObj *ea = 0, val, root;
1663    bitvector refbits = (bitvector)(lisp_global(REFBITS));
1664    Boolean need_store = true, need_check_memo = true, need_memoize_root = false;
1665
1666    if (program_counter >= &egc_store_node_conditional) {
1667      if ((program_counter < &egc_store_node_conditional_success_test) ||
1668          ((program_counter == &egc_store_node_conditional_success_test) &&
1669           !(xpGPR(xp, Iflags) & (1 << X86_ZERO_FLAG_BIT)))) {
1670        /* Back up the PC, try again */
1671        xpPC(xp) = (LispObj) &egc_store_node_conditional;
1672        return;
1673      }
1674      /* The conditional store succeeded.  Set the refbit, return to ra0 */
1675      val = xpGPR(xp,Iarg_z);
1676      ea = (LispObj*)(xpGPR(xp,Iarg_x) + (unbox_fixnum((signed_natural)
1677                                                       xpGPR(xp,Itemp0))));
1678      xpGPR(xp,Iarg_z) = t_value;
1679      need_store = false;
1680    } else if (program_counter >= &egc_set_hash_key) {
1681      root = xpGPR(xp,Iarg_x);
1682      ea = (LispObj *) (root+xpGPR(xp,Iarg_y)+misc_data_offset);
1683      val = xpGPR(xp,Iarg_z);
1684      need_memoize_root = true;
1685    } else if (program_counter >= &egc_gvset) {
1686      ea = (LispObj *) (xpGPR(xp,Iarg_x)+xpGPR(xp,Iarg_y)+misc_data_offset);
1687      val = xpGPR(xp,Iarg_z);
1688    } else if (program_counter >= &egc_rplacd) {
1689      ea = (LispObj *) untag(xpGPR(xp,Iarg_y));
1690      val = xpGPR(xp,Iarg_z);
1691    } else {                      /* egc_rplaca */
1692      ea =  ((LispObj *) untag(xpGPR(xp,Iarg_y)))+1;
1693      val = xpGPR(xp,Iarg_z);
1694    }
1695    if (need_store) {
1696      *ea = val;
1697    }
1698    if (need_check_memo) {
1699      natural  bitnumber = area_dnode(ea, lisp_global(HEAP_START));
1700      if ((bitnumber < lisp_global(OLDSPACE_DNODE_COUNT)) &&
1701          ((LispObj)ea < val)) {
1702        atomic_set_bit(refbits, bitnumber);
1703        if (need_memoize_root) {
1704          bitnumber = area_dnode(root, lisp_global(HEAP_START));
1705          atomic_set_bit(refbits, bitnumber);
1706        }
1707      }
1708    }
1709    xpPC(xp) = xpGPR(xp,Ira0);
1710    return;
1711  }
1712}
1713
1714void
1715normalize_tcr(ExceptionInformation *xp, TCR *tcr, Boolean is_other_tcr)
1716{
1717  void *cur_allocptr = (void *)(tcr->save_allocptr);
1718  LispObj lisprsp, lisptsp;
1719  area *a;
1720
1721  if (xp) {
1722    if (is_other_tcr) {
1723      pc_luser_xp(xp, tcr, NULL);
1724    }
1725    a = tcr->vs_area;
1726    lisprsp = xpGPR(xp, Isp);
1727    if (((BytePtr)lisprsp >= a->low) &&
1728        ((BytePtr)lisprsp < a->high)) {
1729      a->active = (BytePtr)lisprsp;
1730    } else {
1731      a->active = (BytePtr) tcr->save_vsp;
1732    }
1733    a = tcr->ts_area;
1734    a->active = (BytePtr) tcr->save_tsp;
1735  } else {
1736    /* In ff-call; get area active pointers from tcr */
1737    tcr->vs_area->active = (BytePtr) tcr->save_vsp;
1738    tcr->ts_area->active = (BytePtr) tcr->save_tsp;
1739  }
1740  if (cur_allocptr) {
1741    update_bytes_allocated(tcr, cur_allocptr);
1742  }
1743  tcr->save_allocbase = (void *)VOID_ALLOCPTR;
1744  if (fulltag_of((LispObj)(tcr->save_allocptr)) == 0) {
1745    tcr->save_allocptr = (void *)VOID_ALLOCPTR;
1746  }
1747}
1748
1749
1750/* Suspend and "normalize" other tcrs, then call a gc-like function
1751   in that context.  Resume the other tcrs, then return what the
1752   function returned */
1753
1754TCR *gc_tcr = NULL;
1755
1756
1757int
1758gc_like_from_xp(ExceptionInformation *xp, 
1759                int(*fun)(TCR *, signed_natural), 
1760                signed_natural param)
1761{
1762  TCR *tcr = get_tcr(false), *other_tcr;
1763  ExceptionInformation* other_xp;
1764  int result;
1765  signed_natural inhibit;
1766
1767  suspend_other_threads(true);
1768  inhibit = (signed_natural)(lisp_global(GC_INHIBIT_COUNT));
1769  if (inhibit != 0) {
1770    if (inhibit > 0) {
1771      lisp_global(GC_INHIBIT_COUNT) = (LispObj)(-inhibit);
1772    }
1773    resume_other_threads(true);
1774    gc_deferred++;
1775    return 0;
1776  }
1777  gc_deferred = 0;
1778
1779  gc_tcr = tcr;
1780
1781  /* This is generally necessary if the current thread invoked the GC
1782     via an alloc trap, and harmless if the GC was invoked via a GC
1783     trap.  (It's necessary in the first case because the "allocptr"
1784     register - %rbx - may be pointing into the middle of something
1785     below tcr->save_allocbase, and we wouldn't want the GC to see
1786     that bogus pointer.) */
1787  xpGPR(xp, Iallocptr) = VOID_ALLOCPTR; 
1788
1789  normalize_tcr(xp, tcr, false);
1790
1791
1792  for (other_tcr = tcr->next; other_tcr != tcr; other_tcr = other_tcr->next) {
1793    if (other_tcr->pending_exception_context) {
1794      other_tcr->gc_context = other_tcr->pending_exception_context;
1795    } else if (other_tcr->valence == TCR_STATE_LISP) {
1796      other_tcr->gc_context = other_tcr->suspend_context;
1797    } else {
1798      /* no pending exception, didn't suspend in lisp state:
1799         must have executed a synchronous ff-call.
1800      */
1801      other_tcr->gc_context = NULL;
1802    }
1803    normalize_tcr(other_tcr->gc_context, other_tcr, true);
1804  }
1805   
1806
1807
1808  result = fun(tcr, param);
1809
1810  other_tcr = tcr;
1811  do {
1812    other_tcr->gc_context = NULL;
1813    other_tcr = other_tcr->next;
1814  } while (other_tcr != tcr);
1815
1816  gc_tcr = NULL;
1817
1818  resume_other_threads(true);
1819
1820  return result;
1821
1822}
1823
1824int
1825change_hons_area_size_from_xp(ExceptionInformation *xp, signed_natural delta_in_bytes)
1826{
1827  return gc_like_from_xp(xp, change_hons_area_size, delta_in_bytes);
1828}
1829
1830int
1831purify_from_xp(ExceptionInformation *xp, signed_natural param)
1832{
1833  return gc_like_from_xp(xp, purify, param);
1834}
1835
1836int
1837impurify_from_xp(ExceptionInformation *xp, signed_natural param)
1838{
1839  return gc_like_from_xp(xp, impurify, param);
1840}
1841
1842/* Returns #bytes freed by invoking GC */
1843
1844int
1845gc_from_tcr(TCR *tcr, signed_natural param)
1846{
1847  area *a;
1848  BytePtr oldfree, newfree;
1849  BytePtr oldend, newend;
1850
1851#if 0
1852  fprintf(stderr, "Start GC  in 0x%lx\n", tcr);
1853#endif
1854  a = active_dynamic_area;
1855  oldend = a->high;
1856  oldfree = a->active;
1857  gc(tcr, param);
1858  newfree = a->active;
1859  newend = a->high;
1860#if 0
1861  fprintf(stderr, "End GC  in 0x%lx\n", tcr);
1862#endif
1863  return ((oldfree-newfree)+(newend-oldend));
1864}
1865
1866int
1867gc_from_xp(ExceptionInformation *xp, signed_natural param)
1868{
1869  int status = gc_like_from_xp(xp, gc_from_tcr, param);
1870
1871  freeGCptrs();
1872  return status;
1873}
1874
1875#ifdef DARWIN
1876
1877#define TCR_FROM_EXCEPTION_PORT(p) ((TCR *)((natural)p))
1878#define TCR_TO_EXCEPTION_PORT(tcr) ((mach_port_t)((natural)(tcr)))
1879
1880pthread_mutex_t _mach_exception_lock, *mach_exception_lock;
1881extern void pseudo_sigreturn(void);
1882
1883
1884
1885#define LISP_EXCEPTIONS_HANDLED_MASK \
1886 (EXC_MASK_SOFTWARE | EXC_MASK_BAD_ACCESS | EXC_MASK_BAD_INSTRUCTION | EXC_MASK_ARITHMETIC)
1887
1888/* (logcount LISP_EXCEPTIONS_HANDLED_MASK) */
1889#define NUM_LISP_EXCEPTIONS_HANDLED 4
1890
1891typedef struct {
1892  int foreign_exception_port_count;
1893  exception_mask_t         masks[NUM_LISP_EXCEPTIONS_HANDLED];
1894  mach_port_t              ports[NUM_LISP_EXCEPTIONS_HANDLED];
1895  exception_behavior_t behaviors[NUM_LISP_EXCEPTIONS_HANDLED];
1896  thread_state_flavor_t  flavors[NUM_LISP_EXCEPTIONS_HANDLED];
1897} MACH_foreign_exception_state;
1898
1899
1900
1901
1902/*
1903  Mach's exception mechanism works a little better than its signal
1904  mechanism (and, not incidentally, it gets along with GDB a lot
1905  better.
1906
1907  Initially, we install an exception handler to handle each native
1908  thread's exceptions.  This process involves creating a distinguished
1909  thread which listens for kernel exception messages on a set of
1910  0 or more thread exception ports.  As threads are created, they're
1911  added to that port set; a thread's exception port is destroyed
1912  (and therefore removed from the port set) when the thread exits.
1913
1914  A few exceptions can be handled directly in the handler thread;
1915  others require that we resume the user thread (and that the
1916  exception thread resumes listening for exceptions.)  The user
1917  thread might eventually want to return to the original context
1918  (possibly modified somewhat.)
1919
1920  As it turns out, the simplest way to force the faulting user
1921  thread to handle its own exceptions is to do pretty much what
1922  signal() does: the exception handlng thread sets up a sigcontext
1923  on the user thread's stack and forces the user thread to resume
1924  execution as if a signal handler had been called with that
1925  context as an argument.  We can use a distinguished UUO at a
1926  distinguished address to do something like sigreturn(); that'll
1927  have the effect of resuming the user thread's execution in
1928  the (pseudo-) signal context.
1929
1930  Since:
1931    a) we have miles of code in C and in Lisp that knows how to
1932    deal with Linux sigcontexts
1933    b) Linux sigcontexts contain a little more useful information
1934    (the DAR, DSISR, etc.) than their Darwin counterparts
1935    c) we have to create a sigcontext ourselves when calling out
1936    to the user thread: we aren't really generating a signal, just
1937    leveraging existing signal-handling code.
1938
1939  we create a Linux sigcontext struct.
1940
1941  Simple ?  Hopefully from the outside it is ...
1942
1943  We want the process of passing a thread's own context to it to
1944  appear to be atomic: in particular, we don't want the GC to suspend
1945  a thread that's had an exception but has not yet had its user-level
1946  exception handler called, and we don't want the thread's exception
1947  context to be modified by a GC while the Mach handler thread is
1948  copying it around.  On Linux (and on Jaguar), we avoid this issue
1949  because (a) the kernel sets up the user-level signal handler and
1950  (b) the signal handler blocks signals (including the signal used
1951  by the GC to suspend threads) until tcr->xframe is set up.
1952
1953  The GC and the Mach server thread therefore contend for the lock
1954  "mach_exception_lock".  The Mach server thread holds the lock
1955  when copying exception information between the kernel and the
1956  user thread; the GC holds this lock during most of its execution
1957  (delaying exception processing until it can be done without
1958  GC interference.)
1959
1960*/
1961
1962#ifdef PPC64
1963#define C_REDZONE_LEN           320
1964#define C_STK_ALIGN             32
1965#else
1966#define C_REDZONE_LEN           224
1967#define C_STK_ALIGN             16
1968#endif
1969#define C_PARAMSAVE_LEN         64
1970#define C_LINKAGE_LEN           48
1971
1972#define TRUNC_DOWN(a,b,c)  (((((natural)a)-(b))/(c)) * (c))
1973
1974void
1975fatal_mach_error(char *format, ...);
1976
1977#define MACH_CHECK_ERROR(context,x) if (x != KERN_SUCCESS) {fatal_mach_error("Mach error while %s : %d", context, x);}
1978
1979
1980void
1981restore_mach_thread_state(mach_port_t thread, ExceptionInformation *pseudosigcontext)
1982{
1983  int i, j;
1984  kern_return_t kret;
1985#if WORD_SIZE == 64
1986  MCONTEXT_T mc = UC_MCONTEXT(pseudosigcontext);
1987#else
1988  struct mcontext * mc = UC_MCONTEXT(pseudosigcontext);
1989#endif
1990
1991  /* Set the thread's FP state from the pseudosigcontext */
1992  kret = thread_set_state(thread,
1993                          x86_FLOAT_STATE64,
1994                          (thread_state_t)&(mc->__fs),
1995                          x86_FLOAT_STATE64_COUNT);
1996
1997  MACH_CHECK_ERROR("setting thread FP state", kret);
1998
1999  /* The thread'll be as good as new ... */
2000#if WORD_SIZE == 64
2001  kret = thread_set_state(thread,
2002                          x86_THREAD_STATE64,
2003                          (thread_state_t)&(mc->__ss),
2004                          x86_THREAD_STATE64_COUNT);
2005#else
2006  kret = thread_set_state(thread, 
2007                          x86_THREAD_STATE32,
2008                          (thread_state_t)&(mc->__ss),
2009                          x86_THREAD_STATE32_COUNT);
2010#endif
2011  MACH_CHECK_ERROR("setting thread state", kret);
2012} 
2013
2014/* This code runs in the exception handling thread, in response
2015   to an attempt to execute the UU0 at "pseudo_sigreturn" (e.g.,
2016   in response to a call to pseudo_sigreturn() from the specified
2017   user thread.
2018   Find that context (the user thread's R3 points to it), then
2019   use that context to set the user thread's state.  When this
2020   function's caller returns, the Mach kernel will resume the
2021   user thread.
2022*/
2023
2024kern_return_t
2025do_pseudo_sigreturn(mach_port_t thread, TCR *tcr)
2026{
2027  ExceptionInformation *xp;
2028
2029#ifdef DEBUG_MACH_EXCEPTIONS
2030  fprintf(stderr, "doing pseudo_sigreturn for 0x%x\n",tcr);
2031#endif
2032  xp = tcr->pending_exception_context;
2033  if (xp) {
2034    tcr->pending_exception_context = NULL;
2035    tcr->valence = TCR_STATE_LISP;
2036    restore_mach_thread_state(thread, xp);
2037    raise_pending_interrupt(tcr);
2038  } else {
2039    Bug(NULL, "no xp here!\n");
2040  }
2041#ifdef DEBUG_MACH_EXCEPTIONS
2042  fprintf(stderr, "did pseudo_sigreturn for 0x%x\n",tcr);
2043#endif
2044  return KERN_SUCCESS;
2045} 
2046
2047ExceptionInformation *
2048create_thread_context_frame(mach_port_t thread, 
2049                            natural *new_stack_top,
2050                            siginfo_t **info_ptr,
2051                            TCR *tcr,
2052#ifdef X8664
2053                            x86_thread_state64_t *ts
2054#else
2055                            x86_thread_state_t *ts
2056#endif
2057                            )
2058{
2059  mach_msg_type_number_t thread_state_count;
2060  kern_return_t result;
2061  int i,j;
2062  ExceptionInformation *pseudosigcontext;
2063#ifdef X8664
2064  MCONTEXT_T mc;
2065#else
2066  struct mcontext *mc;
2067#endif
2068  natural stackp, backlink;
2069
2070 
2071  stackp = (LispObj) find_foreign_rsp(ts->__rsp,tcr->cs_area,tcr);
2072  stackp = TRUNC_DOWN(stackp, C_REDZONE_LEN, C_STK_ALIGN);
2073  stackp = TRUNC_DOWN(stackp, sizeof(siginfo_t), C_STK_ALIGN);
2074  if (info_ptr) {
2075    *info_ptr = (siginfo_t *)stackp;
2076  }
2077  stackp = TRUNC_DOWN(stackp,sizeof(*pseudosigcontext), C_STK_ALIGN);
2078  pseudosigcontext = (ExceptionInformation *) ptr_from_lispobj(stackp);
2079
2080  stackp = TRUNC_DOWN(stackp, sizeof(*mc), C_STK_ALIGN);
2081#ifdef X8664
2082  mc = (MCONTEXT_T) ptr_from_lispobj(stackp);
2083#else
2084  mc = (struct mcontext *) ptr_from_lispobj(stackp);
2085#endif
2086 
2087  bcopy(ts,&(mc->__ss),sizeof(*ts));
2088
2089  thread_state_count = x86_FLOAT_STATE64_COUNT;
2090  thread_get_state(thread,
2091                   x86_FLOAT_STATE64,
2092                   (thread_state_t)&(mc->__fs),
2093                   &thread_state_count);
2094
2095
2096#ifdef X8664
2097  thread_state_count = x86_EXCEPTION_STATE64_COUNT;
2098#else
2099  thread_state_count = x86_EXCEPTION_STATE_COUNT;
2100#endif
2101  thread_get_state(thread,
2102#ifdef X8664
2103                   x86_EXCEPTION_STATE64,
2104#else
2105                   x86_EXCEPTION_STATE,
2106#endif
2107                   (thread_state_t)&(mc->__es),
2108                   &thread_state_count);
2109
2110
2111  UC_MCONTEXT(pseudosigcontext) = mc;
2112  if (new_stack_top) {
2113    *new_stack_top = stackp;
2114  }
2115  return pseudosigcontext;
2116}
2117
2118/*
2119  This code sets up the user thread so that it executes a "pseudo-signal
2120  handler" function when it resumes.  Create a fake ucontext struct
2121  on the thread's stack and pass it as an argument to the pseudo-signal
2122  handler.
2123
2124  Things are set up so that the handler "returns to" pseudo_sigreturn(),
2125  which will restore the thread's context.
2126
2127  If the handler invokes code that throws (or otherwise never sigreturn()'s
2128  to the context), that's fine.
2129
2130  Actually, check that: throw (and variants) may need to be careful and
2131  pop the tcr's xframe list until it's younger than any frame being
2132  entered.
2133*/
2134
2135int
2136setup_signal_frame(mach_port_t thread,
2137                   void *handler_address,
2138                   int signum,
2139                   int code,
2140                   TCR *tcr,
2141#ifdef X8664
2142                   x86_thread_state64_t *ts
2143#else
2144                   x86_thread_state_t *ts
2145#endif
2146                   )
2147{
2148#ifdef X8664
2149  x86_thread_state64_t new_ts;
2150#else
2151  x86_thread_state_t new_ts;
2152#endif
2153  ExceptionInformation *pseudosigcontext;
2154  int i, j, old_valence = tcr->valence;
2155  kern_return_t result;
2156  natural stackp, *stackpp;
2157  siginfo_t *info;
2158
2159#ifdef DEBUG_MACH_EXCEPTIONS
2160  fprintf(stderr,"Setting up exception handling for 0x%x\n", tcr);
2161#endif
2162  pseudosigcontext = create_thread_context_frame(thread, &stackp, &info, tcr,  ts);
2163  bzero(info, sizeof(*info));
2164  info->si_code = code;
2165  info->si_addr = (void *)(UC_MCONTEXT(pseudosigcontext)->__es.__faultvaddr);
2166  info->si_signo = signum;
2167  pseudosigcontext->uc_onstack = 0;
2168  pseudosigcontext->uc_sigmask = (sigset_t) 0;
2169  pseudosigcontext->uc_stack.ss_sp = 0;
2170  pseudosigcontext->uc_stack.ss_size = 0;
2171  pseudosigcontext->uc_stack.ss_flags = 0;
2172  pseudosigcontext->uc_link = NULL;
2173  pseudosigcontext->uc_mcsize = sizeof(*UC_MCONTEXT(pseudosigcontext));
2174  tcr->pending_exception_context = pseudosigcontext;
2175  tcr->valence = TCR_STATE_EXCEPTION_WAIT;
2176 
2177
2178  /*
2179     It seems like we've created a  sigcontext on the thread's
2180     stack.  Set things up so that we call the handler (with appropriate
2181     args) when the thread's resumed.
2182  */
2183
2184  new_ts.__rip = (natural) handler_address;
2185  stackpp = (natural *)stackp;
2186  *--stackpp = (natural)pseudo_sigreturn;
2187  stackp = (natural)stackpp;
2188  new_ts.__rdi = signum;
2189  new_ts.__rsi = (natural)info;
2190  new_ts.__rdx = (natural)pseudosigcontext;
2191  new_ts.__rcx = (natural)tcr;
2192  new_ts.__r8 = (natural)old_valence;
2193  new_ts.__rsp = stackp;
2194  new_ts.__rflags = ts->__rflags;
2195
2196
2197#ifdef X8664
2198  thread_set_state(thread,
2199                   x86_THREAD_STATE64,
2200                   (thread_state_t)&new_ts,
2201                   x86_THREAD_STATE64_COUNT);
2202#else
2203  thread_set_state(thread, 
2204                   x86_THREAD_STATE,
2205                   (thread_state_t)&new_ts,
2206                   x86_THREAD_STATE_COUNT);
2207#endif
2208#ifdef DEBUG_MACH_EXCEPTIONS
2209  fprintf(stderr,"Set up exception context for 0x%x at 0x%x\n", tcr, tcr->pending_exception_context);
2210#endif
2211  return 0;
2212}
2213
2214
2215
2216
2217
2218
2219/*
2220  This function runs in the exception handling thread.  It's
2221  called (by this precise name) from the library function "exc_server()"
2222  when the thread's exception ports are set up.  (exc_server() is called
2223  via mach_msg_server(), which is a function that waits for and dispatches
2224  on exception messages from the Mach kernel.)
2225
2226  This checks to see if the exception was caused by a pseudo_sigreturn()
2227  UUO; if so, it arranges for the thread to have its state restored
2228  from the specified context.
2229
2230  Otherwise, it tries to map the exception to a signal number and
2231  arranges that the thread run a "pseudo signal handler" to handle
2232  the exception.
2233
2234  Some exceptions could and should be handled here directly.
2235*/
2236
2237/* We need the thread's state earlier on x86_64 than we did on PPC;
2238   the PC won't fit in code_vector[1].  We shouldn't try to get it
2239   lazily (via catch_exception_raise_state()); until we own the
2240   exception lock, we shouldn't have it in userspace (since a GCing
2241   thread wouldn't know that we had our hands on it.)
2242*/
2243
2244#ifdef X8664
2245#define ts_pc(t) t.__rip
2246#else
2247#define ts_pc(t) t.eip
2248#endif
2249
2250#ifdef DARWIN_USE_PSEUDO_SIGRETURN
2251#define DARWIN_EXCEPTION_HANDLER signal_handler
2252#else
2253#define DARWIN_EXCEPTION_HANDLER pseudo_signal_handler
2254#endif
2255
2256kern_return_t
2257catch_exception_raise(mach_port_t exception_port,
2258                      mach_port_t thread,
2259                      mach_port_t task, 
2260                      exception_type_t exception,
2261                      exception_data_t code_vector,
2262                      mach_msg_type_number_t code_count)
2263{
2264  int signum = 0, code = *code_vector, code1;
2265  TCR *tcr = TCR_FROM_EXCEPTION_PORT(exception_port);
2266  kern_return_t kret, call_kret;
2267#ifdef X8664
2268  x86_thread_state64_t ts;
2269#else
2270  x86_thread_state_t ts;
2271#endif
2272  mach_msg_type_number_t thread_state_count;
2273
2274
2275#ifdef DEBUG_MACH_EXCEPTIONS
2276  fprintf(stderr, "obtaining Mach exception lock in exception thread\n");
2277#endif
2278
2279
2280  if (pthread_mutex_trylock(mach_exception_lock) == 0) {
2281#ifdef X8664
2282    thread_state_count = x86_THREAD_STATE64_COUNT;
2283    call_kret = thread_get_state(thread,
2284                                 x86_THREAD_STATE64,
2285                                 (thread_state_t)&ts,
2286                     &thread_state_count);
2287  MACH_CHECK_ERROR("getting thread state",call_kret);
2288#else
2289    thread_state_count = x86_THREAD_STATE_COUNT;
2290    thread_get_state(thread,
2291                     x86_THREAD_STATE,
2292                     (thread_state_t)&ts,
2293                     &thread_state_count);
2294#endif
2295    if (tcr->flags & (1<<TCR_FLAG_BIT_PENDING_EXCEPTION)) {
2296      CLR_TCR_FLAG(tcr,TCR_FLAG_BIT_PENDING_EXCEPTION);
2297    } 
2298    if ((code == EXC_I386_GPFLT) &&
2299        ((natural)(ts_pc(ts)) == (natural)pseudo_sigreturn)) {
2300      kret = do_pseudo_sigreturn(thread, tcr);
2301#if 0
2302      fprintf(stderr, "Exception return in 0x%x\n",tcr);
2303#endif
2304    } else if (tcr->flags & (1<<TCR_FLAG_BIT_PROPAGATE_EXCEPTION)) {
2305      CLR_TCR_FLAG(tcr,TCR_FLAG_BIT_PROPAGATE_EXCEPTION);
2306      kret = 17;
2307    } else {
2308      switch (exception) {
2309      case EXC_BAD_ACCESS:
2310        if (code == EXC_I386_GPFLT) {
2311          signum = SIGSEGV;
2312        } else {
2313          signum = SIGBUS;
2314        }
2315        break;
2316       
2317      case EXC_BAD_INSTRUCTION:
2318        if (code == EXC_I386_GPFLT) {
2319          signum = SIGSEGV;
2320        } else {
2321          signum = SIGILL;
2322        }
2323        break;
2324     
2325      case EXC_SOFTWARE:
2326          signum = SIGILL;
2327        break;
2328     
2329      case EXC_ARITHMETIC:
2330        signum = SIGFPE;
2331        break;
2332
2333      default:
2334        break;
2335      }
2336      if (signum) {
2337        kret = setup_signal_frame(thread,
2338                                  (void *)DARWIN_EXCEPTION_HANDLER,
2339                                  signum,
2340                                  code,
2341                                  tcr, 
2342                                  &ts);
2343#if 0
2344      fprintf(stderr, "Setup pseudosignal handling in 0x%x\n",tcr);
2345#endif
2346
2347      } else {
2348        kret = 17;
2349      }
2350    }
2351#ifdef DEBUG_MACH_EXCEPTIONS
2352    fprintf(stderr, "releasing Mach exception lock in exception thread\n");
2353#endif
2354    pthread_mutex_unlock(mach_exception_lock);
2355  } else {
2356    SET_TCR_FLAG(tcr,TCR_FLAG_BIT_PENDING_EXCEPTION);
2357     
2358#if 0
2359    fprintf(stderr, "deferring pending exception in 0x%x\n", tcr);
2360#endif
2361    kret = 0;
2362    if (tcr == gc_tcr) {
2363      int i;
2364      write(1, "exception in GC thread. Sleeping for 60 seconds\n",sizeof("exception in GC thread.  Sleeping for 60 seconds\n"));
2365      for (i = 0; i < 60; i++) {
2366        sleep(1);
2367      }
2368      _exit(EX_SOFTWARE);
2369    }
2370  }
2371  return kret;
2372}
2373
2374
2375
2376
2377static mach_port_t mach_exception_thread = (mach_port_t)0;
2378
2379
2380/*
2381  The initial function for an exception-handling thread.
2382*/
2383
2384void *
2385exception_handler_proc(void *arg)
2386{
2387  extern boolean_t exc_server();
2388  mach_port_t p = TCR_TO_EXCEPTION_PORT(arg);
2389
2390  mach_exception_thread = pthread_mach_thread_np(pthread_self());
2391  mach_msg_server(exc_server, 256, p, 0);
2392  /* Should never return. */
2393  abort();
2394}
2395
2396
2397
2398void
2399mach_exception_thread_shutdown()
2400{
2401  kern_return_t kret;
2402
2403  fprintf(stderr, "terminating Mach exception thread, 'cause exit can't\n");
2404  kret = thread_terminate(mach_exception_thread);
2405  if (kret != KERN_SUCCESS) {
2406    fprintf(stderr, "Couldn't terminate exception thread, kret = %d\n",kret);
2407  }
2408}
2409
2410
2411mach_port_t
2412mach_exception_port_set()
2413{
2414  static mach_port_t __exception_port_set = MACH_PORT_NULL;
2415  kern_return_t kret; 
2416  if (__exception_port_set == MACH_PORT_NULL) {
2417    mach_exception_lock = &_mach_exception_lock;
2418    pthread_mutex_init(mach_exception_lock, NULL);
2419
2420    kret = mach_port_allocate(mach_task_self(),
2421                              MACH_PORT_RIGHT_PORT_SET,
2422                              &__exception_port_set);
2423    MACH_CHECK_ERROR("allocating thread exception_ports",kret);
2424    create_system_thread(0,
2425                         NULL,
2426                         exception_handler_proc, 
2427                         (void *)((natural)__exception_port_set));
2428  }
2429  return __exception_port_set;
2430}
2431
2432/*
2433  Setup a new thread to handle those exceptions specified by
2434  the mask "which".  This involves creating a special Mach
2435  message port, telling the Mach kernel to send exception
2436  messages for the calling thread to that port, and setting
2437  up a handler thread which listens for and responds to
2438  those messages.
2439
2440*/
2441
2442/*
2443  Establish the lisp thread's TCR as its exception port, and determine
2444  whether any other ports have been established by foreign code for
2445  exceptions that lisp cares about.
2446
2447  If this happens at all, it should happen on return from foreign
2448  code and on entry to lisp code via a callback.
2449
2450  This is a lot of trouble (and overhead) to support Java, or other
2451  embeddable systems that clobber their caller's thread exception ports.
2452 
2453*/
2454kern_return_t
2455tcr_establish_exception_port(TCR *tcr, mach_port_t thread)
2456{
2457  kern_return_t kret;
2458  MACH_foreign_exception_state *fxs = (MACH_foreign_exception_state *)tcr->native_thread_info;
2459  int i;
2460  unsigned n = NUM_LISP_EXCEPTIONS_HANDLED;
2461  mach_port_t lisp_port = TCR_TO_EXCEPTION_PORT(tcr), foreign_port;
2462  exception_mask_t mask = 0;
2463
2464  kret = thread_swap_exception_ports(thread,
2465                                     LISP_EXCEPTIONS_HANDLED_MASK,
2466                                     lisp_port,
2467                                     EXCEPTION_DEFAULT,
2468                                     THREAD_STATE_NONE,
2469                                     fxs->masks,
2470                                     &n,
2471                                     fxs->ports,
2472                                     fxs->behaviors,
2473                                     fxs->flavors);
2474  if (kret == KERN_SUCCESS) {
2475    fxs->foreign_exception_port_count = n;
2476    for (i = 0; i < n; i ++) {
2477      foreign_port = fxs->ports[i];
2478
2479      if ((foreign_port != lisp_port) &&
2480          (foreign_port != MACH_PORT_NULL)) {
2481        mask |= fxs->masks[i];
2482      }
2483    }
2484    tcr->foreign_exception_status = (int) mask;
2485  }
2486  return kret;
2487}
2488
2489kern_return_t
2490tcr_establish_lisp_exception_port(TCR *tcr)
2491{
2492  return tcr_establish_exception_port(tcr, (mach_port_t)((natural)tcr->native_thread_id));
2493}
2494
2495/*
2496  Do this when calling out to or returning from foreign code, if
2497  any conflicting foreign exception ports were established when we
2498  last entered lisp code.
2499*/
2500kern_return_t
2501restore_foreign_exception_ports(TCR *tcr)
2502{
2503  exception_mask_t m = (exception_mask_t) tcr->foreign_exception_status;
2504 
2505  if (m) {
2506    MACH_foreign_exception_state *fxs  = 
2507      (MACH_foreign_exception_state *) tcr->native_thread_info;
2508    int i, n = fxs->foreign_exception_port_count;
2509    exception_mask_t tm;
2510
2511    for (i = 0; i < n; i++) {
2512      if ((tm = fxs->masks[i]) & m) {
2513        thread_set_exception_ports((mach_port_t)((natural)tcr->native_thread_id),
2514                                   tm,
2515                                   fxs->ports[i],
2516                                   fxs->behaviors[i],
2517                                   fxs->flavors[i]);
2518      }
2519    }
2520  }
2521}
2522                                   
2523
2524/*
2525  This assumes that a Mach port (to be used as the thread's exception port) whose
2526  "name" matches the TCR's 32-bit address has already been allocated.
2527*/
2528
2529kern_return_t
2530setup_mach_exception_handling(TCR *tcr)
2531{
2532  mach_port_t
2533    thread_exception_port = TCR_TO_EXCEPTION_PORT(tcr),
2534    target_thread = pthread_mach_thread_np((pthread_t)ptr_from_lispobj(tcr->osid)),
2535    task_self = mach_task_self();
2536  kern_return_t kret;
2537
2538  kret = mach_port_insert_right(task_self,
2539                                thread_exception_port,
2540                                thread_exception_port,
2541                                MACH_MSG_TYPE_MAKE_SEND);
2542  MACH_CHECK_ERROR("adding send right to exception_port",kret);
2543
2544  kret = tcr_establish_exception_port(tcr, (mach_port_t)((natural) tcr->native_thread_id));
2545  if (kret == KERN_SUCCESS) {
2546    mach_port_t exception_port_set = mach_exception_port_set();
2547
2548    kret = mach_port_move_member(task_self,
2549                                 thread_exception_port,
2550                                 exception_port_set);
2551  }
2552  return kret;
2553}
2554
2555void
2556darwin_exception_init(TCR *tcr)
2557{
2558  void tcr_monitor_exception_handling(TCR*, Boolean);
2559  kern_return_t kret;
2560  MACH_foreign_exception_state *fxs = 
2561    calloc(1, sizeof(MACH_foreign_exception_state));
2562 
2563  tcr->native_thread_info = (void *) fxs;
2564
2565  if ((kret = setup_mach_exception_handling(tcr))
2566      != KERN_SUCCESS) {
2567    fprintf(stderr, "Couldn't setup exception handler - error = %d\n", kret);
2568    terminate_lisp();
2569  }
2570  lisp_global(LISP_EXIT_HOOK) = (LispObj) restore_foreign_exception_ports;
2571  lisp_global(LISP_RETURN_HOOK) = (LispObj) tcr_establish_lisp_exception_port;
2572}
2573
2574/*
2575  The tcr is the "name" of the corresponding thread's exception port.
2576  Destroying the port should remove it from all port sets of which it's
2577  a member (notably, the exception port set.)
2578*/
2579void
2580darwin_exception_cleanup(TCR *tcr)
2581{
2582  void *fxs = tcr->native_thread_info;
2583  extern Boolean use_mach_exception_handling;
2584
2585  if (fxs) {
2586    tcr->native_thread_info = NULL;
2587    free(fxs);
2588  }
2589  if (use_mach_exception_handling) {
2590    mach_port_deallocate(mach_task_self(),TCR_TO_EXCEPTION_PORT(tcr));
2591    mach_port_destroy(mach_task_self(),TCR_TO_EXCEPTION_PORT(tcr));
2592  }
2593}
2594
2595
2596Boolean
2597suspend_mach_thread(mach_port_t mach_thread)
2598{
2599  kern_return_t status;
2600  Boolean aborted = false;
2601 
2602  do {
2603    aborted = false;
2604    status = thread_suspend(mach_thread);
2605    if (status == KERN_SUCCESS) {
2606      status = thread_abort_safely(mach_thread);
2607      if (status == KERN_SUCCESS) {
2608        aborted = true;
2609      } else {
2610        fprintf(stderr, "abort failed on thread = 0x%x\n",mach_thread);
2611        thread_resume(mach_thread);
2612      }
2613    } else {
2614      return false;
2615    }
2616  } while (! aborted);
2617  return true;
2618}
2619
2620/*
2621  Only do this if pthread_kill indicated that the pthread isn't
2622  listening to signals anymore, as can happen as soon as pthread_exit()
2623  is called on Darwin.  The thread could still call out to lisp as it
2624  is exiting, so we need another way to suspend it in this case.
2625*/
2626Boolean
2627mach_suspend_tcr(TCR *tcr)
2628{
2629  mach_port_t mach_thread = (mach_port_t)((natural)( tcr->native_thread_id));
2630  ExceptionInformation *pseudosigcontext;
2631  Boolean result = false;
2632 
2633  result = suspend_mach_thread(mach_thread);
2634  if (result) {
2635    mach_msg_type_number_t thread_state_count;
2636#ifdef X8664
2637    x86_thread_state64_t ts;
2638    thread_state_count = x86_THREAD_STATE64_COUNT;
2639    thread_get_state(mach_thread,
2640                     x86_THREAD_STATE64,
2641                     (thread_state_t)&ts,
2642                     &thread_state_count);
2643#else
2644    x86_thread_state_t ts;
2645    thread_state_count = x86_THREAD_STATE_COUNT;
2646    thread_get_state(mach_thread,
2647                     x86_THREAD_STATE,
2648                     (thread_state_t)&ts,
2649                     &thread_state_count);
2650#endif
2651
2652    pseudosigcontext = create_thread_context_frame(mach_thread, NULL, NULL,tcr, &ts);
2653    pseudosigcontext->uc_onstack = 0;
2654    pseudosigcontext->uc_sigmask = (sigset_t) 0;
2655    tcr->suspend_context = pseudosigcontext;
2656  }
2657  return result;
2658}
2659
2660void
2661mach_resume_tcr(TCR *tcr)
2662{
2663  ExceptionInformation *xp;
2664  mach_port_t mach_thread = (mach_port_t)((natural)(tcr->native_thread_id));
2665 
2666  xp = tcr->suspend_context;
2667#ifdef DEBUG_MACH_EXCEPTIONS
2668  fprintf(stderr, "resuming TCR 0x%x, pending_exception_context = 0x%x\n",
2669          tcr, tcr->pending_exception_context);
2670#endif
2671  tcr->suspend_context = NULL;
2672  restore_mach_thread_state(mach_thread, xp);
2673#ifdef DEBUG_MACH_EXCEPTIONS
2674  fprintf(stderr, "restored state in TCR 0x%x, pending_exception_context = 0x%x\n",
2675          tcr, tcr->pending_exception_context);
2676#endif
2677  thread_resume(mach_thread);
2678}
2679
2680void
2681fatal_mach_error(char *format, ...)
2682{
2683  va_list args;
2684  char s[512];
2685 
2686
2687  va_start(args, format);
2688  vsnprintf(s, sizeof(s),format, args);
2689  va_end(args);
2690
2691  Fatal("Mach error", s);
2692}
2693
2694
2695
2696
2697#endif
Note: See TracBrowser for help on using the repository browser.