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

Last change on this file since 3697 was 3697, checked in by gb, 15 years ago

Actually handle something (uuo_alloc()), since we can't do much without it.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 7.3 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
35int
36page_size = 4096;
37
38int
39log2_page_size = 12;
40
41
42
43
44int
45gc_from_xp(ExceptionInformation *xp, signed_natural param)
46{
47  Bug(xp, "GC ?  Not yet ...");
48
49}
50
51void
52update_bytes_allocated(TCR* tcr, void *cur_allocptr)
53{
54  BytePtr
55    last = (BytePtr) tcr->last_allocptr, 
56    current = (BytePtr) cur_allocptr;
57  if (last && (cur_allocptr != ((void *)VOID_ALLOCPTR))) {
58    tcr->bytes_allocated += last-current;
59  }
60  tcr->last_allocptr = 0;
61}
62
63
64/*
65  This doesn't GC; it returns true if it made enough room, false
66  otherwise.
67  If "extend" is true, it can try to extend the dynamic area to
68  satisfy the request.
69*/
70
71Boolean
72new_heap_segment(ExceptionInformation *xp, natural need, Boolean extend, TCR *tcr)
73{
74  area *a;
75  natural newlimit, oldlimit;
76  natural log2_allocation_quantum = tcr->log2_allocation_quantum;
77
78  a  = active_dynamic_area;
79  oldlimit = (natural) a->active;
80  newlimit = (align_to_power_of_2(oldlimit, log2_allocation_quantum) +
81              align_to_power_of_2(need, log2_allocation_quantum));
82  if (newlimit > (natural) (a->high)) {
83    if (extend) {
84      if (! resize_dynamic_heap(a->active, (newlimit-oldlimit)+lisp_heap_gc_threshold)) {
85        return false;
86      }
87    } else {
88      return false;
89    }
90  }
91  a->active = (BytePtr) newlimit;
92  tcr->last_allocptr = (void *)newlimit;
93  tcr->save_allocptr = (void *)newlimit;
94  xpGPR(xp,Iallocptr) = (LispObj) newlimit;
95  tcr->save_allocbase = (void *) oldlimit;
96
97  while (HeapHighWaterMark < (BytePtr)newlimit) {
98    zero_page(HeapHighWaterMark);
99    HeapHighWaterMark+=page_size;
100  }
101  return true;
102}
103
104Boolean
105allocate_object(ExceptionInformation *xp,
106                natural bytes_needed, 
107                signed_natural disp_from_allocptr,
108                TCR *tcr)
109{
110  area *a = active_dynamic_area;
111
112  /* Maybe do an EGC */
113  if (a->older && lisp_global(OLDEST_EPHEMERAL)) {
114    if (((a->active)-(a->low)) >= a->threshold) {
115      gc_from_xp(xp, 0L);
116    }
117  }
118
119  /* Life is pretty simple if we can simply grab a segment
120     without extending the heap.
121  */
122  if (new_heap_segment(xp, bytes_needed, false, tcr)) {
123    xpGPR(xp, Iallocptr) -= disp_from_allocptr;
124    return true;
125  }
126 
127  /* It doesn't make sense to try a full GC if the object
128     we're trying to allocate is larger than everything
129     allocated so far.
130  */
131  if ((lisp_global(HEAP_END)-lisp_global(HEAP_START)) > bytes_needed) {
132    untenure_from_area(tenured_area); /* force a full GC */
133    gc_from_xp(xp, 0L);
134  }
135 
136  /* Try again, growing the heap if necessary */
137  if (new_heap_segment(xp, bytes_needed, true, tcr)) {
138    xpGPR(xp, Iallocptr) -= disp_from_allocptr;
139    return true;
140  }
141 
142  return false;
143}
144
145Boolean
146handle_alloc_trap(ExceptionInformation *xp, TCR *tcr)
147{
148  natural cur_allocptr, bytes_needed;
149  unsigned allocptr_tag;
150  signed_natural disp;
151 
152  cur_allocptr = xpGPR(xp,Iallocptr);
153  allocptr_tag = fulltag_of(cur_allocptr);
154  if (allocptr_tag == fulltag_misc) {
155    disp = xpGPR(xp,Iimm1);
156  } else {
157    disp = dnode_size-fulltag_cons;
158  }
159  bytes_needed = disp+allocptr_tag;
160
161  update_bytes_allocated(tcr,((BytePtr)(cur_allocptr-disp)));
162  if (allocate_object(xp, bytes_needed, disp, tcr)) {
163    return true;
164  }
165
166  return false;
167}
168
169Boolean
170handle_exception(int signum, siginfo_t *info, ExceptionInformation  *context, TCR *tcr)
171{
172  pc program_counter = (pc)xpPC(context);
173
174  if (signum == SIGSEGV) {
175    if ((info->si_addr) == 0) {
176      /* Something mapped to SIGSEGV that has nothing to do with
177         a memory fault */
178      if (*program_counter == 0xcd) {   /* an int instruction */
179        program_counter++;
180        if (*program_counter == 0xc5) {
181          if (handle_alloc_trap(context, tcr)) {
182            xpPC(context) = (natural) (program_counter+1);
183            return true;
184          }
185        }
186      }
187    }
188  }
189  return false;
190}
191
192void
193signal_handler(int signum, siginfo_t *info, ExceptionInformation  *context)
194{
195  xframe_list xframe_link;
196  int old_valence;
197  TCR* tcr = get_tcr(false);
198
199  if (! handle_exception(signum, info, context, tcr)) {
200    char msg[512];
201    snprintf(msg, sizeof(msg), "Unhandled exception %d at 0x%lx, context->regs at #x%lx", signum, xpPC(context), (natural)xpGPRvector(context));
202    if (lisp_Debugger(context, info, signum, msg)) {
203      SET_TCR_FLAG(tcr,TCR_FLAG_BIT_PROPAGATE_EXCEPTION);
204    }
205  }
206}
207
208void
209interrupt_handler (int signum, siginfo_t *info, ExceptionInformation *context)
210{
211  TCR *tcr = get_interrupt_tcr(false);
212#ifdef NOTYET
213  if (tcr) {
214    if (TCR_INTERRUPT_LEVEL(tcr) < 0) {
215      tcr->interrupt_pending = 1 << fixnumshift;
216    } else {
217      LispObj cmain = nrs_CMAIN.vcell;
218
219      if ((fulltag_of(cmain) == fulltag_misc) &&
220          (header_subtag(header_of(cmain)) == subtag_macptr)) {
221        /*
222           This thread can (allegedly) take an interrupt now.
223           It's tricky to do that if we're executing
224           foreign code (especially Linuxthreads code, much
225           of which isn't reentrant.)
226           If we're unwinding the stack, we also want to defer
227           the interrupt.
228        */
229        if ((tcr->valence != TCR_STATE_LISP) ||
230            (tcr->unwinding != 0)) {
231          TCR_INTERRUPT_LEVEL(tcr) = (1 << fixnumshift);
232        } else {
233          xframe_list xframe_link;
234          int old_valence;
235         
236          pc_luser_xp(context, NULL);
237          old_valence = prepare_to_wait_for_exception_lock(tcr, context);
238          wait_for_exception_lock_in_handler(tcr, context, &xframe_link);
239          PMCL_exception_handler(signum, context, tcr, info);
240          unlock_exception_lock_in_handler(tcr);
241          exit_signal_handler(tcr, old_valence);
242        }
243      }
244    }
245  }
246#endif
247}
248
249void
250install_signal_handler(int signo, __sighandler_t handler)
251{
252  struct sigaction sa;
253 
254  sa.sa_sigaction = (void *)handler;
255  sigfillset(&sa.sa_mask);
256  sa.sa_flags = 
257    SA_RESTART
258    | SA_SIGINFO;
259
260  sigaction(signo, &sa, NULL);
261}
262
263
264void
265install_pmcl_exception_handlers()
266{
267 
268  install_signal_handler(SIGILL, (__sighandler_t)signal_handler);
269 
270  install_signal_handler(SIGBUS,  (__sighandler_t)signal_handler);
271  install_signal_handler(SIGSEGV, (__sighandler_t)signal_handler);
272  install_signal_handler(SIGFPE, (__sighandler_t)signal_handler);
273
274 
275  install_signal_handler(SIGNAL_FOR_PROCESS_INTERRUPT,
276                         (__sighandler_t)interrupt_handler);
277  signal(SIGPIPE, SIG_IGN);
278}
279
280void
281enable_fp_exceptions()
282{
283}
284
285void
286exception_init()
287{
288  install_pmcl_exception_handlers();
289}
290
291void
292adjust_exception_pc(ExceptionInformation *xp, int delta)
293{
294  xpPC(xp) += delta;
295}
296
297void
298restore_soft_stack_limit(unsigned stkreg)
299{
300}
301
302/* Maybe this'll work someday.  We may have to do something to
303   make the thread look like it's not handling an exception */
304void
305reset_lisp_process(ExceptionInformation *xp)
306{
307}
Note: See TracBrowser for help on using the repository browser.