From 5e1fcdac979db9a6aebe69531229355def8c0f90 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Fri, 3 Dec 2004 17:50:05 +0000 Subject: [PATCH] 0.8.17.19: Late resolution for foreign symbols &co * If a foreign symbol is unknown, use an address on a protected page for it: all accesses there are trapped, and signal UNDEFINED-ALIEN-ERROR. (Currently the error doesn't reveal the name of the alien that was accessed.) * Make GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS keep track of both undefined aliens and dynamic foreign symbols in general. * Fix linkage-table reinitialization bug on threaded platforms, reported by Sean Ross. * Better restarts for realoding shared objects, and CONTINUE restarts for *save-hooks* and *init-hooks*. * Accurate alien warning for SAVE-LISP-AND-DIE on non-linkage-table platforms. HEALTH WARNING: Tested on x86/FreeBSD only, but "should be fine". --- NEWS | 7 +++ package-data-list.lisp-expr | 1 + src/code/cold-init.lisp | 16 ++++-- src/code/condition.lisp | 6 +++ src/code/foreign-load.lisp | 77 +++++++++++++++++++++-------- src/code/foreign.lisp | 14 +++--- src/code/interr.lisp | 4 +- src/code/linkage-table.lisp | 31 +++++------- src/code/save.lisp | 8 +-- src/code/toplevel.lisp | 5 +- src/compiler/alpha/parms.lisp | 1 + src/compiler/generic/genesis.lisp | 1 + src/compiler/hppa/parms.lisp | 1 + src/compiler/mips/parms.lisp | 1 + src/compiler/ppc/parms.lisp | 1 + src/compiler/sparc/parms.lisp | 1 + src/compiler/x86/parms.lisp | 1 + src/runtime/bsd-os.c | 4 +- src/runtime/interrupt.c | 9 +++- src/runtime/interrupt.h | 2 +- src/runtime/linux-os.c | 4 +- src/runtime/os.h | 2 + src/runtime/osf1-os.c | 2 +- src/runtime/sunos-os.c | 2 +- src/runtime/validate.c | 23 ++++++++- src/runtime/validate.h | 1 + tests/foreign.test.sh | 98 ++++++++++++++++++++++++++++++------- version.lisp-expr | 2 +- 28 files changed, 238 insertions(+), 87 deletions(-) diff --git a/NEWS b/NEWS index bf75bd5..508496d 100644 --- a/NEWS +++ b/NEWS @@ -1,6 +1,10 @@ changes in sbcl-0.8.18 relative to sbcl-0.8.17: * new feature: reloading changed shared object files with LOAD-SHARED-OBJECT now causes the new definitions to take effect. + * new feature: references to foreign variables and functions + can now be compiled and loaded before the corresponding shared + object file is loaded, as long as the foreign definitions are + available at runtime. * Solaris 10 (aka SunOS 5.10) on the SPARC platform is now supported. (thanks to Dan Debertin) * fixed bug #331: structure-class instances corresponding to @@ -16,6 +20,9 @@ changes in sbcl-0.8.18 relative to sbcl-0.8.17: * bug fix: RANDOM can be compiled when the compiler derives the type of its numeric argument as a disjoint set of small integers. (reported by Paul Dietz) + * bug fix: starting a core saved with shared objects loaded when + those objects are not available no longer causes threaded SBCL to + hang. (reported by Sean Ross) * fixed some bugs related to Unicode integration: ** RUN-PROGRAM can allow its child to take input from a Lisp stream. (reported by Stefan Scholl) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index ea8878b..85678e5 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -61,6 +61,7 @@ of SBCL which maintained the CMU-CL-style split into two packages.)" "MAKE-ALIEN" "NULL-ALIEN" "SAP-ALIEN" "SHORT" "SIGNED" "SLOT" "STRUCT" + "UNDEFINED-ALIEN-ERROR" "UNSIGNED" "UNSIGNED-CHAR" "UNSIGNED-INT" "UNSIGNED-LONG" "UNSIGNED-SHORT" "UTF8-STRING" diff --git a/src/code/cold-init.lisp b/src/code/cold-init.lisp index f09f8cd..f3217e6 100644 --- a/src/code/cold-init.lisp +++ b/src/code/cold-init.lisp @@ -259,7 +259,8 @@ ;; The show is on. (terpri) (/show0 "going into toplevel loop") - (handling-end-of-the-world + (handling-end-of-the-world + (thread-init-or-reinit) (toplevel-init) (critically-unreachable "after TOPLEVEL-INIT"))) @@ -277,10 +278,14 @@ UNIX-like systems, UNIX-STATUS is used as the status code." ;;;; initialization functions +(defun thread-init-or-reinit () + (sb!thread::init-job-control) + (sb!thread::get-foreground)) + (defun reinit () (without-interrupts (without-gcing - (os-cold-init-or-reinit) + (os-cold-init-or-reinit) (stream-reinit) (signal-cold-init-or-reinit) (setf (sb!alien:extern-alien "internal_errors_enabled" boolean) t) @@ -294,11 +299,14 @@ UNIX-like systems, UNIX-STATUS is used as the status code." (set-floating-point-modes :traps '(:overflow #!-netbsd :invalid :divide-by-zero)) (sb!thread::maybe-install-futex-functions))) - (foreign-reinit) + (thread-init-or-reinit) (gc-reinit) ;; make sure TIME works correctly from saved cores (setf *internal-real-time-base-seconds* nil) - (mapc #'funcall *init-hooks*)) + (foreign-reinit) + (dolist (hook *init-hooks*) + (with-simple-restart (continue "Skip this initialization hook.") + (funcall hook)))) ;;;; some support for any hapless wretches who end up debugging cold ;;;; init code diff --git a/src/code/condition.lisp b/src/code/condition.lisp index 2000871..ecd3766 100644 --- a/src/code/condition.lisp +++ b/src/code/condition.lisp @@ -936,6 +936,12 @@ symbol that caused the violation is accessed by the function SB-EXT:PACKAGE-LOCKED-ERROR-SYMBOL.")) ) ; progn + +(define-condition undefined-alien-error (error) () + (:report + (lambda (condition stream) + (declare (ignore condition)) + (format stream "Attempt to access an undefined alien value.")))) ;;;; various other (not specified by ANSI) CONDITIONs ;;;; diff --git a/src/code/foreign-load.lisp b/src/code/foreign-load.lisp index fae0fb4..d8723f2 100644 --- a/src/code/foreign-load.lisp +++ b/src/code/foreign-load.lisp @@ -39,6 +39,8 @@ (handle system-area-pointer) (symbol c-string)) +(define-alien-variable undefined-alien-address unsigned-long) + (defvar *runtime-dlhandle*) (defvar *shared-objects*) @@ -48,12 +50,12 @@ (when objp (dlclose-or-lose obj)) (dlerror) ; clear errors - (let* ((file (when obj (shared-object-file obj))) + (let* ((file (and obj (shared-object-file obj))) (sap (dlopen file (logior rtld-global rtld-now)))) (aver (or (not objp) file)) (when (zerop (sap-int sap)) (if objp - (setf (shared-object-sap obj) *runtime-dlhandle*) + (setf (shared-object-sap obj) nil) (setf *runtime-dlhandle* nil)) (error "Could not open ~:[runtime~;~:*shared object ~S~]: ~A" obj (dlerror))) @@ -96,17 +98,33 @@ SB-EXT:SAVE-LISP-AND-DIE for details." (setf *shared-objects* (append (remove obj *shared-objects*) (list obj))) #!+linkage-table - (when old + (when (or old (undefined-foreign-symbols)) (update-linkage-table)) (pathname filename)))) (defun try-reopen-shared-object (obj) - (with-simple-restart (skip "~@") - (dlopen-or-lose obj) - obj)) + (declare (type shared-object obj)) + (tagbody :dlopen + (restart-case + (dlopen-or-lose obj) + (continue () + :report "Skip this shared object and continue." + (setf (shared-object-sap obj) nil)) + (retry () + :report "Retry loading this shared object." + (go :dlopen)) + (load-other () + :report "Specify an alternate shared object file to load." + (setf (shared-object-file obj) + (tagbody :query + (format *query-io* "~&Enter pathname (evaluated):~%") + (force-output *query-io*) + (let ((pathname (ignore-errors (pathname (read *query-io*))))) + (unless (pathnamep pathname) + (format *query-io* "~&Error: invalid pathname.~%") + (go :query)) + (unix-namestring pathname))))))) + obj) ;;; Open libraries in *SHARED-OBJECTS* and the runtime. Called during ;;; initialization. @@ -121,14 +139,33 @@ SB-EXT:SAVE-LISP-AND-DIE for details." (mapc #'dlclose-or-lose (reverse *shared-objects*)) (dlclose-or-lose)) -(defun get-dynamic-foreign-symbol-address (symbol) - (dlerror) ; clear old errors - (let ((result (sap-int (dlsym *runtime-dlhandle* symbol))) - (err (dlerror))) - (if (or (not (zerop result)) (not err)) - result - (dolist (obj *shared-objects*) - (setf result (sap-int (dlsym (shared-object-sap obj) symbol)) - err (dlerror)) - (when (or (not (zerop result)) (not err)) - (return result)))))) +(let ((symbols ()) + (undefineds ())) + (defun get-dynamic-foreign-symbol-address (symbol) + (dlerror) ; clear old errors + (unless *runtime-dlhandle* + (bug "Cannot resolve foreign symbol: lost *runtime-dlhandle*")) + (let* ((result (sap-int (dlsym *runtime-dlhandle* symbol))) + (err (dlerror)) + (addr (if (or (not (zerop result)) (not err)) + result + (dolist (obj *shared-objects*) + (let ((sap (shared-object-sap obj))) + (when sap + (setf result (sap-int (dlsym sap symbol)) + err (dlerror)) + (when (or (not (zerop result)) (not err)) + (return result)))))))) + (cond ((not addr) + (style-warn "Undefined alien: ~S" symbol) + (pushnew symbol undefineds :test #'equal) + (remove symbol symbols :test #'equal) + undefined-alien-address) + (addr + (pushnew symbol symbols :test #'equal) + (remove symbol undefineds :test #'equal) + addr)))) + (defun dynamic-foreign-symbols () + symbols) + (defun undefined-foreign-symbols () + undefineds)) diff --git a/src/code/foreign.lisp b/src/code/foreign.lisp index d80955b..5e23aa0 100644 --- a/src/code/foreign.lisp +++ b/src/code/foreign.lisp @@ -71,12 +71,14 @@ ;; get dynamic symbols thru the runtime as well, so cheking the ;; list of *shared-objects* is not enough. Eugh & blech. #!+(and os-provides-dlopen (not linkage-table)) - (warn "~@") + (when (dynamic-foreign-symbols) + (warn "~@" (dynamic-foreign-symbols))) #!+os-provides-dlopen (close-shared-objects)) diff --git a/src/code/interr.lisp b/src/code/interr.lisp index 0d6ceeb..d14bdc0 100644 --- a/src/code/interr.lisp +++ b/src/code/interr.lisp @@ -456,5 +456,5 @@ "Control stack guard page temporarily disabled: proceed with caution~%") (error 'control-stack-exhausted)))) - - +(defun undefined-alien-error () + (error 'undefined-alien-error)) diff --git a/src/code/linkage-table.lisp b/src/code/linkage-table.lisp index 31d561d..74e461d 100644 --- a/src/code/linkage-table.lisp +++ b/src/code/linkage-table.lisp @@ -49,14 +49,14 @@ sb!vm:linkage-table-entry-size) sb!vm:linkage-table-space-start)) (real-address (get-dynamic-foreign-symbol-address name))) - (when real-address - (unless (< table-address sb!vm:linkage-table-space-end) - (error "Linkage-table full (~D entries): cannot link ~S." - (hash-table-count *linkage-info*) - name)) - (write-linkage-table-entry table-address real-address datap) - (setf (gethash name *linkage-info*) - (make-linkage-info :address table-address :datap datap))))) + (aver real-address) + (unless (< table-address sb!vm:linkage-table-space-end) + (error "Linkage-table full (~D entries): cannot link ~S." + (hash-table-count *linkage-info*) + name)) + (write-linkage-table-entry table-address real-address datap) + (setf (gethash name *linkage-info*) + (make-linkage-info :address table-address :datap datap)))) ;;; Add a foreign linkage entry if none exists, return the address ;;; in the linkage table. @@ -77,15 +77,8 @@ (let ((datap (linkage-info-datap info)) (table-address (linkage-info-address info)) (real-address (get-dynamic-foreign-symbol-address name))) - (cond (real-address - (write-linkage-table-entry table-address - real-address - datap)) - (t - (/show0 "oops") - (cerror "Ignore. Attempts to access this foreign symbol ~ - will lead to badness characterized by ~ - segfaults, and potential corruption." - "Could not resolve foreign function ~S for ~ - linkage-table." name))))) + (aver (and table-address real-address)) + (write-linkage-table-entry table-address + real-address + datap))) *linkage-info*)) diff --git a/src/code/save.lisp b/src/code/save.lisp index 739e3ea..5351515 100644 --- a/src/code/save.lisp +++ b/src/code/save.lisp @@ -103,8 +103,8 @@ sufficiently motivated to do lengthy fixes." #-gencgc (gc) #+gencgc (gc :full t)) (flet ((restart-lisp () (handling-end-of-the-world - (reinit) - (funcall toplevel)))) + (reinit) + (funcall toplevel)))) ;; FIXME: Perhaps WITHOUT-GCING should be wrapped around the ;; LET as well, to avoid the off chance of an interrupt triggering ;; GC and making our saved RESTART-LISP address invalid? @@ -113,7 +113,9 @@ sufficiently motivated to do lengthy fixes." (get-lisp-obj-address #'restart-lisp))))) (defun deinit () - (mapc #'funcall *save-hooks*) + (dolist (hook *save-hooks*) + (with-simple-restart (continue "Skip this save hook.") + (funcall hook))) (when (fboundp 'cancel-finalization) (cancel-finalization sb!sys:*tty*)) (profile-deinit) diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp index b8cc3a7..4f3d0f2 100644 --- a/src/code/toplevel.lisp +++ b/src/code/toplevel.lisp @@ -306,10 +306,7 @@ steppers to maintain contextual information.") ;;; the default system top level function (defun toplevel-init () - - (/show0 "entering TOPLEVEL-INIT") - (sb!thread::init-job-control) - (sb!thread::get-foreground) + (/show0 "entering TOPLEVEL-INIT") (let (;; value of --sysinit option (sysinit nil) ;; value of --userinit option diff --git a/src/compiler/alpha/parms.lisp b/src/compiler/alpha/parms.lisp index a19fc93..5e511ef 100644 --- a/src/compiler/alpha/parms.lisp +++ b/src/compiler/alpha/parms.lisp @@ -184,6 +184,7 @@ sub-gc sb!kernel::internal-error sb!kernel::control-stack-exhausted-error + sb!kernel::undefined-alien-error sb!di::handle-breakpoint sb!di::handle-fun-end-breakpoint diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index b1dee69..fdfa848 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -1263,6 +1263,7 @@ core and return a descriptor to it." (frob sub-gc) (frob internal-error) (frob sb!kernel::control-stack-exhausted-error) + (frob sb!kernel::undefined-alien-error) (frob sb!di::handle-breakpoint) (frob sb!di::handle-fun-end-breakpoint) (frob sb!thread::handle-thread-exit)) diff --git a/src/compiler/hppa/parms.lisp b/src/compiler/hppa/parms.lisp index 53bc314..31e80d1 100644 --- a/src/compiler/hppa/parms.lisp +++ b/src/compiler/hppa/parms.lisp @@ -124,6 +124,7 @@ sb!impl::sub-gc sb!kernel::internal-error sb!kernel::control-stack-exhausted-error + sb!kernel::undefined-alien-error sb!di::handle-breakpoint sb!impl::fdefinition-object diff --git a/src/compiler/mips/parms.lisp b/src/compiler/mips/parms.lisp index 6095c53..7943eac 100644 --- a/src/compiler/mips/parms.lisp +++ b/src/compiler/mips/parms.lisp @@ -113,6 +113,7 @@ sb!impl::sub-gc sb!kernel::internal-error sb!kernel::control-stack-exhausted-error + sb!kernel::undefined-alien-error sb!di::handle-breakpoint sb!impl::fdefinition-object diff --git a/src/compiler/ppc/parms.lisp b/src/compiler/ppc/parms.lisp index e55c4c0..2b7db4f 100644 --- a/src/compiler/ppc/parms.lisp +++ b/src/compiler/ppc/parms.lisp @@ -149,6 +149,7 @@ sb!impl::sub-gc sb!kernel::internal-error sb!kernel::control-stack-exhausted-error + sb!kernel::undefined-alien-error sb!di::handle-breakpoint sb!impl::fdefinition-object diff --git a/src/compiler/sparc/parms.lisp b/src/compiler/sparc/parms.lisp index 63576d7..cd388a8 100644 --- a/src/compiler/sparc/parms.lisp +++ b/src/compiler/sparc/parms.lisp @@ -181,6 +181,7 @@ sub-gc sb!kernel::internal-error sb!kernel::control-stack-exhausted-error + sb!kernel::undefined-alien-error sb!di::handle-breakpoint sb!di::handle-fun-end-breakpoint diff --git a/src/compiler/x86/parms.lisp b/src/compiler/x86/parms.lisp index f1328b6..3d49ed2 100644 --- a/src/compiler/x86/parms.lisp +++ b/src/compiler/x86/parms.lisp @@ -269,6 +269,7 @@ sub-gc sb!kernel::internal-error sb!kernel::control-stack-exhausted-error + sb!kernel::undefined-alien-error sb!di::handle-breakpoint fdefinition-object #!+sb-thread sb!thread::handle-thread-exit diff --git a/src/runtime/bsd-os.c b/src/runtime/bsd-os.c index 0bca439..63b28ef 100644 --- a/src/runtime/bsd-os.c +++ b/src/runtime/bsd-os.c @@ -187,7 +187,7 @@ memory_fault_handler(int signal, siginfo_t *siginfo, void *void_context) os_context_t *context = arch_os_get_context(&void_context); if (!gencgc_handle_wp_violation(fault_addr)) - if(!handle_control_stack_guard_triggered(context,fault_addr)) + if(!handle_guard_page_triggered(context,fault_addr)) /* FIXME is this context or void_context? not that it */ /* makes a difference currently except on linux/sparc */ interrupt_handle_now(signal, siginfo, void_context); @@ -212,7 +212,7 @@ sigsegv_handler(int signal, siginfo_t *info, void* void_context) addr = arch_get_bad_addr(signal,info,context); if(!interrupt_maybe_gc(signal, info, context)) - if(!handle_control_stack_guard_triggered(context,addr)) + if(!handle_guard_page_triggered(context,addr)) interrupt_handle_now(signal, info, context); /* Work around G5 bug; fix courtesy gbyers */ sigreturn(void_context); diff --git a/src/runtime/interrupt.c b/src/runtime/interrupt.c index 1dcc462..0067a10 100644 --- a/src/runtime/interrupt.c +++ b/src/runtime/interrupt.c @@ -720,11 +720,10 @@ void thread_exit_handler(int num, siginfo_t *info, void *v_context) { /* called when a child thread exits */ mark_dead_threads(); } - #endif -boolean handle_control_stack_guard_triggered(os_context_t *context,void *addr){ +boolean handle_guard_page_triggered(os_context_t *context,void *addr){ struct thread *th=arch_os_get_current_thread(); /* note the os_context hackery here. When the signal handler returns, @@ -752,6 +751,12 @@ boolean handle_control_stack_guard_triggered(os_context_t *context,void *addr){ protect_control_stack_return_guard_page(th->pid,0); return 1; } + else if (addr >= undefined_alien_address && + addr < undefined_alien_address + os_vm_page_size) { + arrange_return_to_lisp_function + (context, SymbolFunction(UNDEFINED_ALIEN_ERROR)); + return 1; + } else return 0; } diff --git a/src/runtime/interrupt.h b/src/runtime/interrupt.h index cb71475..ba0a6bd 100644 --- a/src/runtime/interrupt.h +++ b/src/runtime/interrupt.h @@ -48,7 +48,7 @@ extern void interrupt_handle_now(int, siginfo_t*, void*); extern void interrupt_handle_pending(os_context_t*); extern void interrupt_internal_error(int, siginfo_t*, os_context_t*, boolean continuable); -extern boolean handle_control_stack_guard_triggered(os_context_t *,void *); +extern boolean handle_guard_page_triggered(os_context_t *,void *); extern boolean interrupt_maybe_gc(int, siginfo_t*, void*); #ifdef LISP_FEATURE_SB_THREAD extern void interrupt_thread_handler(int, siginfo_t*, void*); diff --git a/src/runtime/linux-os.c b/src/runtime/linux-os.c index eb1a5a0..a30ab80 100644 --- a/src/runtime/linux-os.c +++ b/src/runtime/linux-os.c @@ -224,7 +224,7 @@ sigsegv_handler(int signal, siginfo_t *info, void* void_context) os_context_t *context = arch_os_get_context(&void_context); void* fault_addr = (void*)info->si_addr; if (!gencgc_handle_wp_violation(fault_addr)) - if(!handle_control_stack_guard_triggered(context,fault_addr)) + if(!handle_guard_page_triggered(context,fault_addr)) interrupt_handle_now(signal, info, void_context); } @@ -254,7 +254,7 @@ sigsegv_handler(int signal, siginfo_t *info, void* void_context) interrupt_handle_pending(context); } else { if(!interrupt_maybe_gc(signal, info, context)) - if(!handle_control_stack_guard_triggered(context,addr)) + if(!handle_guard_page_triggered(context,addr)) interrupt_handle_now(signal, info, context); } } diff --git a/src/runtime/os.h b/src/runtime/os.h index 145f2e1..3d1e61c 100644 --- a/src/runtime/os.h +++ b/src/runtime/os.h @@ -44,6 +44,8 @@ #define OS_VM_PROT_ALL \ (OS_VM_PROT_READ | OS_VM_PROT_WRITE | OS_VM_PROT_EXECUTE) +#define OS_VM_PROT_NONE (!OS_VM_PROT_ALL) + extern os_vm_size_t os_vm_page_size; /* Do anything we need to do when starting up the runtime environment diff --git a/src/runtime/osf1-os.c b/src/runtime/osf1-os.c index b5b96ac..8a61667 100644 --- a/src/runtime/osf1-os.c +++ b/src/runtime/osf1-os.c @@ -133,7 +133,7 @@ sigsegv_handler(int signal, siginfo_t *info, void* void_context) *os_context_register_addr(context,reg_ALLOC) -= (1L<<63); interrupt_handle_pending(context); } else if (!interrupt_maybe_gc(signal, info, context)) { - if(!handle_control_stack_guard_triggered(context,addr)) + if(!handle_guard_page_triggered(context,addr)) interrupt_handle_now(signal, info, context); } } diff --git a/src/runtime/sunos-os.c b/src/runtime/sunos-os.c index cb2e526..fdf5a08 100644 --- a/src/runtime/sunos-os.c +++ b/src/runtime/sunos-os.c @@ -183,7 +183,7 @@ sigsegv_handler(int signal, siginfo_t *info, void* void_context) addr = arch_get_bad_addr(signal, info, context); if(!interrupt_maybe_gc(signal, info, context)) { - if(!handle_control_stack_guard_triggered(context,addr)) + if(!handle_guard_page_triggered(context,addr)) interrupt_handle_now(signal, info, context); } } diff --git a/src/runtime/validate.c b/src/runtime/validate.c index 2c01436..f4c8bfe 100644 --- a/src/runtime/validate.c +++ b/src/runtime/validate.c @@ -36,6 +36,19 @@ ensure_space(lispobj *start, unsigned long size) } } +os_vm_address_t undefined_alien_address = 0; + +static void +ensure_undefined_alien(void) { + os_vm_address_t start = os_validate(NULL, os_vm_page_size); + if (start) { + os_protect(start, os_vm_page_size, OS_VM_PROT_NONE); + undefined_alien_address = start; + } else { + lose("could not allocate guard page for undefined alien"); + } +} + void validate(void) { @@ -56,20 +69,26 @@ validate(void) #ifdef LISP_FEATURE_LINKAGE_TABLE ensure_space( (lispobj *)LINKAGE_TABLE_SPACE_START, LINKAGE_TABLE_SPACE_SIZE); #endif + +#ifdef LISP_FEATURE_OS_PROVIDES_DLOPEN + ensure_undefined_alien(); +#endif #ifdef PRINTNOISE printf(" done.\n"); #endif } -void protect_control_stack_guard_page(pid_t t_id, int protect_p) { +void +protect_control_stack_guard_page(pid_t t_id, int protect_p) { struct thread *th = find_thread_by_pid(t_id); os_protect(CONTROL_STACK_GUARD_PAGE(th), os_vm_page_size,protect_p ? (OS_VM_PROT_READ|OS_VM_PROT_EXECUTE) : OS_VM_PROT_ALL); } -void protect_control_stack_return_guard_page(pid_t t_id, int protect_p) { +void +protect_control_stack_return_guard_page(pid_t t_id, int protect_p) { struct thread *th = find_thread_by_pid(t_id); os_protect(CONTROL_STACK_RETURN_GUARD_PAGE(th), os_vm_page_size,protect_p ? diff --git a/src/runtime/validate.h b/src/runtime/validate.h index bc7ca14..478f321 100644 --- a/src/runtime/validate.h +++ b/src/runtime/validate.h @@ -36,6 +36,7 @@ extern void validate(void); extern void protect_control_stack_guard_page(pid_t t_id, int protect_p); extern void protect_control_stack_return_guard_page(pid_t t_id, int protect_p); +extern os_vm_address_t undefined_alien_address; #endif /* note for anyone trying to port an architecture's support files diff --git a/tests/foreign.test.sh b/tests/foreign.test.sh index aac8a70..7d207b4 100644 --- a/tests/foreign.test.sh +++ b/tests/foreign.test.sh @@ -25,21 +25,28 @@ testfilestem=${TMPDIR:-/tmp}/sbcl-foreign-test-$$ ## Make a little shared object files to test with. +build_so() { + echo building $1.so + cc -c $1.c -o $1.o + ld -shared -o $1.so $1.o +} + echo 'int summish(int x, int y) { return 1 + x + y; }' > $testfilestem.c echo 'int numberish = 42;' >> $testfilestem.c echo 'int nummish(int x) { return numberish + x; }' >> $testfilestem.c -cc -c $testfilestem.c -o $testfilestem.o -ld -shared -o $testfilestem.so $testfilestem.o +build_so $testfilestem -echo 'int foo = 13;' > $testfilestem-foobar.c -echo 'int bar() { return 42; }' >> $testfilestem-foobar.c -cc -c $testfilestem-foobar.c -o $testfilestem-foobar.o -ld -shared -o $testfilestem-foobar.so $testfilestem-foobar.o +echo 'int foo = 13;' > $testfilestem-b.c +echo 'int bar() { return 42; }' >> $testfilestem-b.c +build_so $testfilestem-b -echo 'int foo = 42;' > $testfilestem-foobar2.c -echo 'int bar() { return 13; }' >> $testfilestem-foobar2.c -cc -c $testfilestem-foobar2.c -o $testfilestem-foobar2.o -ld -shared -o $testfilestem-foobar2.so $testfilestem-foobar2.o +echo 'int foo = 42;' > $testfilestem-b2.c +echo 'int bar() { return 13; }' >> $testfilestem-b2.c +build_so $testfilestem-b2 + +echo 'int late_foo = 43;' > $testfilestem-c.c +echo 'int late_bar() { return 14; }' >> $testfilestem-c.c +build_so $testfilestem-c ## Foreign definitions & load @@ -50,7 +57,7 @@ cat > $testfilestem.def.lisp < $testfilestem.def.lisp < $testfilestem.test.lisp <