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

Last change on this file since 10598 was 10598, checked in by gb, 12 years ago

Gak.

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