\f
(defmacro-mundanely with-hash-table-iterator ((function hash-table) &body body)
#!+sb-doc
- "WITH-HASH-TABLE-ITERATOR ((function hash-table) &body body)
+ "WITH-HASH-TABLE-ITERATOR ((function hash-table) &body body)
Provides a method of manually looping over the elements of a hash-table.
FUNCTION is bound to a generator-macro that, within the scope of the
(#.fun-end-breakpoint-trap
(nt "Function end breakpoint trap"))
(#.object-not-instance-trap
- (nt "Object not instance trap"))
- )))
+ (nt "Object not instance trap")))))
(eval-when (:compile-toplevel :execute)
#ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
lisp_memory_fault_error(context, fault_addr);
#else
- if (!interrupt_maybe_gc_int(signal, siginfo, context)) {
+ if (!maybe_gc(context)) {
interrupt_handle_now(signal, siginfo, context);
}
#if defined(LISP_FEATURE_DARWIN)
unsigned int pc = (unsigned int *)(*os_context_pc_addr(context));
os_vm_address_t addr;
- addr = arch_get_bad_addr(signal,info,context);
- if(!interrupt_maybe_gc(signal, info, context))
- if(!handle_guard_page_triggered(context,addr))
+ addr = arch_get_bad_addr(signal, info, context);
+ if (!cheneygc_handle_wp_violation(context, addr))
+ if (!handle_guard_page_triggered(context, addr))
interrupt_handle_now(signal, info, context);
/* Work around G5 bug; fix courtesy gbyers */
DARWIN_FIX_CONTEXT(context);
#endif
+extern boolean cheneygc_handle_wp_violation(os_context_t*, void*);
static void scavenge_newspace(void);
-extern unsigned long bytes_consed_between_gcs;
-
\f
/* collecting garbage */
current_auto_gc_trigger = NULL;
}
+
+static boolean
+gc_trigger_hit(void *addr)
+{
+ if (current_auto_gc_trigger == NULL)
+ return 0;
+ else{
+ return (addr >= (void *)current_auto_gc_trigger &&
+ addr <((void *)current_dynamic_space + dynamic_space_size));
+ }
+}
+
+boolean
+cheneygc_handle_wp_violation(os_context_t *context, void *addr)
+{
+ if(!foreign_function_call_active && gc_trigger_hit(addr)){
+ struct thread *thread=arch_os_get_current_thread();
+ clear_auto_gc_trigger();
+ /* Don't flood the system with interrupts if the need to gc is
+ * already noted. This can happen for example when SUB-GC
+ * allocates or after a gc triggered in a WITHOUT-GCING. */
+ if (SymbolValue(GC_PENDING,thread) == NIL) {
+ if (SymbolValue(GC_INHIBIT,thread) == NIL) {
+ if (arch_pseudo_atomic_atomic(context)) {
+ /* set things up so that GC happens when we finish
+ * the PA section */
+ SetSymbolValue(GC_PENDING,T,thread);
+ arch_set_pseudo_atomic_interrupted(context);
+ } else {
+ maybe_gc(context);
+ }
+ } else {
+ SetSymbolValue(GC_PENDING,T,thread);
+ }
+ }
+ return 1;
+ }
+ return 0;
+}
}
return (NULL);
}
+
+boolean
+maybe_gc(os_context_t *context)
+{
+#ifndef LISP_FEATURE_WIN32
+ struct thread *thread = arch_os_get_current_thread();
+#endif
+
+ fake_foreign_function_call(context);
+ /* SUB-GC may return without GCing if *GC-INHIBIT* is set, in
+ * which case we will be running with no gc trigger barrier
+ * thing for a while. But it shouldn't be long until the end
+ * of WITHOUT-GCING.
+ *
+ * FIXME: It would be good to protect the end of dynamic space for
+ * CheneyGC and signal a storage condition from there.
+ */
+
+ /* Restore the signal mask from the interrupted context before
+ * calling into Lisp if interrupts are enabled. Why not always?
+ *
+ * Suppose there is a WITHOUT-INTERRUPTS block far, far out. If an
+ * interrupt hits while in SUB-GC, it is deferred and the
+ * os_context_sigmask of that interrupt is set to block further
+ * deferrable interrupts (until the first one is
+ * handled). Unfortunately, that context refers to this place and
+ * when we return from here the signals will not be blocked.
+ *
+ * A kludgy alternative is to propagate the sigmask change to the
+ * outer context.
+ */
+#ifndef LISP_FEATURE_WIN32
+ if(SymbolValue(INTERRUPTS_ENABLED,thread)!=NIL) {
+ thread_sigmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
+ check_gc_signals_unblocked_or_lose();
+ }
+ else
+ unblock_gc_signals();
+#endif
+ funcall0(SymbolFunction(SUB_GC));
+ undo_fake_foreign_function_call(context);
+ return 1;
+}
extern void set_auto_gc_trigger(os_vm_size_t usage);
extern void clear_auto_gc_trigger(void);
-extern int maybe_gc_pending;
-
#include "fixnump.h"
#include "pseudo-atomic.h"
+extern boolean maybe_gc(os_context_t *context);
+
+extern unsigned long bytes_consed_between_gcs;
+
#endif /* _GC_H_ */
/* the total bytes allocated. These are seen by Lisp DYNAMIC-USAGE. */
unsigned long bytes_allocated = 0;
-extern unsigned long bytes_consed_between_gcs; /* gc-common.c */
unsigned long auto_gc_trigger = 0;
/* the source and destination generations. These are set before a GC starts
#include "globals.h"
#include "validate.h"
+#ifdef FOREIGN_FUNCTION_CALL_FLAG
int foreign_function_call_active;
+#endif
lispobj *current_control_stack_pointer;
lispobj *current_control_frame_pointer;
current_auto_gc_trigger = NULL;
#endif
- /* Set foreign function call active. */
+#ifdef FOREIGN_FUNCTION_CALL_FLAG
foreign_function_call_active = 1;
-#if defined(LISP_FEATURE_SB_THREAD)
+#endif
+
+#ifdef LISP_FEATURE_SB_THREAD
pthread_key_create(&specials,0);
#endif
}
#include "sbcl.h"
+/* Currently threads live only on x86oid platforms, but this thing
+ * cannot ever work with threads, so... */
+#if !defined(LISP_FEATURE_SB_THREAD) && !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
+#define FOREIGN_FUNCTION_CALL_FLAG
+#endif
+
#ifndef LANGUAGE_ASSEMBLY
+
+#ifdef FOREIGN_FUNCTION_CALL_FLAG
extern int foreign_function_call_active;
+#endif
+
extern size_t dynamic_space_size;
#ifdef LISP_FEATURE_WIN32
# define POINTERSIZE 4
# endif
+#ifdef FOREIGN_FUNCTION_CALL_FLAG
EXTERN(foreign_function_call_active, 4)
+#endif
EXTERN(current_control_stack_pointer, POINTERSIZE)
EXTERN(current_control_frame_pointer, POINTERSIZE)
void *handler, int signal,
siginfo_t *info,
os_context_t *context);
-boolean interrupt_maybe_gc_int(int signal, siginfo_t *info, void *v_context);
void
sigaddset_deferrable(sigset_t *s)
if (SymbolValue(INTERRUPTS_ENABLED,thread) == NIL)
lose("interrupts not enabled\n");
if (
-#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
+#ifdef FOREIGN_FUNCTION_CALL_FLAG
(!foreign_function_call_active) &&
#endif
arch_pseudo_atomic_atomic(context))
thread->interrupt_contexts[context_index] = context;
- /* no longer in Lisp now */
+#ifdef FOREIGN_FUNCTION_CALL_FLAG
foreign_function_call_active = 1;
+#endif
}
/* blocks all blockable signals. If you are calling from a signal handler,
/* Block all blockable signals. */
block_blockable_signals();
- /* going back into Lisp */
+#ifdef FOREIGN_FUNCTION_CALL_FLAG
foreign_function_call_active = 0;
+#endif
/* Undo dynamic binding of FREE_INTERRUPT_CONTEXT_INDEX */
unbind(thread);
/* GC_PENDING is cleared in SUB-GC, or if another thread
* is doing a gc already we will get a SIG_STOP_FOR_GC and
* that will clear it. */
- interrupt_maybe_gc_int(0,NULL,context);
+ maybe_gc(context);
}
check_blockables_blocked_or_lose();
}
* enabled run the pending handler */
if (!((SymbolValue(INTERRUPTS_ENABLED,thread) == NIL) ||
(
-#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
+#ifdef FOREIGN_FUNCTION_CALL_FLAG
(!foreign_function_call_active) &&
#endif
arch_pseudo_atomic_atomic(context)))) {
interrupt_handle_now(int signal, siginfo_t *info, void *void_context)
{
os_context_t *context = (os_context_t*)void_context;
-#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
+#ifndef LISP_FEATURE_SB_THREAD
boolean were_in_lisp;
#endif
union interrupt_handler handler;
return;
}
-#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
+#ifdef FOREIGN_FUNCTION_CALL_FLAG
were_in_lisp = !foreign_function_call_active;
if (were_in_lisp)
#endif
* actually use its argument for anything on x86, so this branch
* may succeed even when context is null (gencgc alloc()) */
if (
-#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
+#ifdef FOREIGN_FUNCTION_CALL_FLAG
/* FIXME: this foreign_function_call_active test is dubious at
* best. If a foreign call is made in a pseudo atomic section
* (?) or more likely a pseudo atomic section is in a foreign
*/
#ifndef LISP_FEATURE_GENCGC
-/* since GENCGC has its own way to record trigger */
-static boolean
-gc_trigger_hit(int signal, siginfo_t *info, os_context_t *context)
-{
- if (current_auto_gc_trigger == NULL)
- return 0;
- else{
- void *badaddr=arch_get_bad_addr(signal,info,context);
- return (badaddr >= (void *)current_auto_gc_trigger &&
- badaddr <((void *)current_dynamic_space + dynamic_space_size));
- }
-}
#endif
/* manipulate the signal context and stack such that when the handler
}
else return 0;
}
-
-#ifndef LISP_FEATURE_GENCGC
-/* This function gets called from the SIGSEGV (for e.g. Linux, NetBSD, &
- * OpenBSD) or SIGBUS (for e.g. FreeBSD) handler. Here we check
- * whether the signal was due to treading on the mprotect()ed zone -
- * and if so, arrange for a GC to happen. */
-extern unsigned long bytes_consed_between_gcs; /* gc-common.c */
-
-boolean
-interrupt_maybe_gc(int signal, siginfo_t *info, void *void_context)
-{
- os_context_t *context=(os_context_t *) void_context;
-
- if(!foreign_function_call_active && gc_trigger_hit(signal, info, context)){
- struct thread *thread=arch_os_get_current_thread();
- clear_auto_gc_trigger();
- /* Don't flood the system with interrupts if the need to gc is
- * already noted. This can happen for example when SUB-GC
- * allocates or after a gc triggered in a WITHOUT-GCING. */
- if (SymbolValue(GC_PENDING,thread) == NIL) {
- if (SymbolValue(GC_INHIBIT,thread) == NIL) {
- if (arch_pseudo_atomic_atomic(context)) {
- /* set things up so that GC happens when we finish
- * the PA section */
- SetSymbolValue(GC_PENDING,T,thread);
- arch_set_pseudo_atomic_interrupted(context);
- } else {
- interrupt_maybe_gc_int(signal,info,void_context);
- }
- } else {
- SetSymbolValue(GC_PENDING,T,thread);
- }
- }
- return 1;
- }
- return 0;
-}
-
-#endif
-
-/* this is also used by gencgc, in alloc() */
-boolean
-interrupt_maybe_gc_int(int signal, siginfo_t *info, void *void_context)
-{
- os_context_t *context=(os_context_t *) void_context;
-#ifndef LISP_FEATURE_WIN32
- struct thread *thread=arch_os_get_current_thread();
-#endif
-
- fake_foreign_function_call(context);
-
- /* SUB-GC may return without GCing if *GC-INHIBIT* is set, in
- * which case we will be running with no gc trigger barrier
- * thing for a while. But it shouldn't be long until the end
- * of WITHOUT-GCING.
- *
- * FIXME: It would be good to protect the end of dynamic space
- * and signal a storage condition from there.
- */
-
- /* Restore the signal mask from the interrupted context before
- * calling into Lisp if interrupts are enabled. Why not always?
- *
- * Suppose there is a WITHOUT-INTERRUPTS block far, far out. If an
- * interrupt hits while in SUB-GC, it is deferred and the
- * os_context_sigmask of that interrupt is set to block further
- * deferrable interrupts (until the first one is
- * handled). Unfortunately, that context refers to this place and
- * when we return from here the signals will not be blocked.
- *
- * A kludgy alternative is to propagate the sigmask change to the
- * outer context.
- */
-#ifndef LISP_FEATURE_WIN32
- if(SymbolValue(INTERRUPTS_ENABLED,thread)!=NIL) {
- thread_sigmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
- check_gc_signals_unblocked_or_lose();
- }
- else
- unblock_gc_signals();
-#endif
- funcall0(SymbolFunction(SUB_GC));
- undo_fake_foreign_function_call(context);
- return 1;
-}
-
\f
/*
* noise to install handlers
extern void interrupt_handle_pending(os_context_t*);
extern void interrupt_internal_error(os_context_t*, boolean continuable);
extern boolean handle_guard_page_triggered(os_context_t *,os_vm_address_t);
-extern boolean interrupt_maybe_gc(int, siginfo_t*, void*);
-extern boolean interrupt_maybe_gc_int(int, siginfo_t *, void *);
extern boolean maybe_defer_handler(void *handler, struct interrupt_data *data,
int signal, siginfo_t *info,
os_context_t *context);
#ifdef LISP_FEATURE_GENCGC
if (!gencgc_handle_wp_violation(addr))
#else
- if (!interrupt_maybe_gc(signal, info, context))
+ if (!cheneygc_handle_wp_violation(context, addr))
#endif
if (!handle_guard_page_triggered(context, addr))
#ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
/* this is lifted from linux-os.c, so violates OOAO */
*os_context_register_addr(context,reg_ALLOC) -= (1L<<63);
interrupt_handle_pending(context);
- } else if (!interrupt_maybe_gc(signal, info, context)) {
+ } else if (!cheneygc_handle_wp_violation(context, addr)) {
if(!handle_guard_page_triggered(context,addr))
interrupt_handle_now(signal, info, context);
}
*os_context_register_addr(context,reg_ALLOC) &= ~1;
}
-unsigned int
+unsigned int
arch_install_breakpoint(void *pc)
{
unsigned int *ptr = (unsigned int *)pc;
static sigset_t orig_sigmask;
void
-arch_do_displaced_inst(os_context_t *context,unsigned int orig_inst)
+arch_do_displaced_inst(os_context_t *context, unsigned int orig_inst)
{
- /* not sure how we ensure that we get the breakpoint reinstalled
+ /* not sure how we ensure that we get the breakpoint reinstalled
* after doing this -dan */
unsigned int *pc = (unsigned int *)(*os_context_pc_addr(context));
*pc = orig_inst;
os_flush_icache((os_vm_address_t) pc, sizeof(unsigned int));
skipped_break_addr = pc;
+
+ /* FIXME: we should apparently be installing the after-breakpoint
+ * here, but would need to find the next instruction address for
+ * it first. alpha-arch.c shows how to do it. --NS 2007-04-02 */
}
#ifdef LISP_FEATURE_GENCGC
fprintf(stderr, "In handle_allocation_trap\n");
#endif
- /*
- * I don't think it's possible for us NOT to be in lisp when we get
- * here. Remove this later?
- */
+ /* I don't think it's possible for us NOT to be in lisp when we get
+ * here. Remove this later? */
were_in_lisp = !foreign_function_call_active;
if (were_in_lisp) {
=(int)handle_fun_end_breakpoint(context);
}
-/* FIXME: AFTER-BREAKPOINT-TRAP is defined for PPC, but never
- * emitted as far as I can see. Should it be emitted, do removed
- * entirely? */
void
arch_handle_after_breakpoint(os_context_t *context)
{
#define PRINTNOISE
-extern unsigned long bytes_consed_between_gcs;
-
static lispobj *dynamic_space_purify_pointer;
\f
sigsegv_handler(int signal, siginfo_t *info, void* void_context)
{
os_context_t *context = arch_os_get_context(&void_context);
- os_vm_address_t addr;
+ os_vm_address_t addr = arch_get_bad_addr(signal, info, context);
- addr = arch_get_bad_addr(signal, info, context);
- if(!interrupt_maybe_gc(signal, info, context)) {
- if(!handle_guard_page_triggered(context,addr))
+ if (!cheneygc_handle_wp_violation(context, addr)) {
+ if (!handle_guard_page_triggered(context,addr))
interrupt_handle_now(signal, info, context);
}
}
#endif
.text
- .globl GNAME(foreign_function_call_active)
.globl GNAME(all_threads)
\f
/*
.globl GNAME(call_into_c)
TYPE(GNAME(call_into_c))
GNAME(call_into_c):
- movl $1,GNAME(foreign_function_call_active)
-
/* Save the return Lisp address in ebx. */
popl %ebx
/* Restore the return value. */
movl %ecx,%eax # maybe return value
- movl $0,GNAME(foreign_function_call_active)
/* Return. */
jmp *%ebx
/* We don't need to restore eax, because the result is in st(0). */
- movl $0,GNAME(foreign_function_call_active)
/* Return. */
jmp *%ebx
xorl %esi,%esi # third arg
/* no longer in function call */
- movl %eax, GNAME(foreign_function_call_active)
-
movl %esp,%ebx # remember current stack
pushl %ebx # Save entry stack on (maybe) new stack.
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.4.15"
+"1.0.4.16"
projects / sbcl.git / commitdiff