message

16 files changed, 94 insertions, 32 deletions

diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index 5cae13392..a29c02b5d 100644
--- a/src/code/condition.lisp
+++ b/src/code/condition.lisp
@@ -956,11 +956,20 @@ SB-EXT:PACKAGE-LOCKED-ERROR-SYMBOL."))
 
 ) ; progn
 
-(define-condition undefined-alien-error (error) ()
+(define-condition undefined-alien-error (error) ())
+
+(define-condition undefined-alien-variable-error (undefined-alien-error) ()
+  (:report
+   (lambda (condition stream)
+     (declare (ignore condition))
+     (format stream "Attempt to access an undefined alien variable."))))
+
+(define-condition undefined-alien-function-error (undefined-alien-error) ()
   (:report
    (lambda (condition stream)
      (declare (ignore condition))
-     (format stream "Attempt to access an undefined alien value."))))
+     (format stream "Attempt to call an undefined alien function."))))
+
 
 ;;;; various other (not specified by ANSI) CONDITIONs
 ;;;;
diff --git a/src/code/foreign-load.lisp b/src/code/foreign-load.lisp
index 4a8d2d12a..694fc2771 100644
--- a/src/code/foreign-load.lisp
+++ b/src/code/foreign-load.lisp
@@ -141,7 +141,7 @@ SB-EXT:SAVE-LISP-AND-DIE for details."
 
 (let ((symbols ())
       (undefineds ()))
-  (defun get-dynamic-foreign-symbol-address (symbol)
+  (defun get-dynamic-foreign-symbol-address (symbol &optional datap)
     (dlerror)				; clear old errors
     (unless *runtime-dlhandle*
       (bug "Cannot resolve foreign symbol: lost *runtime-dlhandle*"))
@@ -160,7 +160,10 @@ SB-EXT:SAVE-LISP-AND-DIE for details."
               (style-warn "Undefined alien: ~S" symbol)
               (pushnew symbol undefineds :test #'equal)
               (remove symbol symbols :test #'equal)
-              undefined-alien-address)
+	      (if datap
+		  undefined-alien-address
+		  (foreign-symbol-address-as-integer 
+		   (sb!vm:extern-alien-name "undefined_alien_function"))))
              (addr
               (pushnew symbol symbols :test #'equal)
               (remove symbol undefineds :test #'equal)
diff --git a/src/code/foreign.lisp b/src/code/foreign.lisp
index 4daef08ec..d3837548d 100644
--- a/src/code/foreign.lisp
+++ b/src/code/foreign.lisp
@@ -30,7 +30,7 @@
       (progn
         #-sb-xc-host
         (values #!-linkage-table
-                (get-dynamic-foreign-symbol-address name)
+                (get-dynamic-foreign-symbol-address name datap)
                 #!+linkage-table
                 (ensure-foreign-symbol-linkage name datap)
                 t))))
diff --git a/src/code/interr.lisp b/src/code/interr.lisp
index d14bdc0c8..b3ea6a1c0 100644
--- a/src/code/interr.lisp
+++ b/src/code/interr.lisp
@@ -456,5 +456,8 @@
 	     "Control stack guard page temporarily disabled: proceed with caution~%")
      (error 'control-stack-exhausted))))
 
-(defun undefined-alien-error ()
-  (error 'undefined-alien-error))
+(defun undefined-alien-variable-error ()
+  (error 'undefined-alien-variable-error))
+
+(defun undefined-alien-function-error ()
+  (error 'undefined-alien-function-error))
diff --git a/src/code/linkage-table.lisp b/src/code/linkage-table.lisp
index 74e461daf..3ccfb4c1d 100644
--- a/src/code/linkage-table.lisp
+++ b/src/code/linkage-table.lisp
@@ -48,7 +48,7 @@
   (let ((table-address (+ (* (hash-table-count *linkage-info*)
 			     sb!vm:linkage-table-entry-size)
 			  sb!vm:linkage-table-space-start))
-	(real-address (get-dynamic-foreign-symbol-address name)))
+	(real-address (get-dynamic-foreign-symbol-address name datap)))
     (aver real-address)
     (unless (< table-address sb!vm:linkage-table-space-end)
       (error "Linkage-table full (~D entries): cannot link ~S."
@@ -74,9 +74,10 @@
 (defun update-linkage-table ()
   ;; Doesn't take care of it's own locking -- callers are responsible
   (maphash (lambda (name info)
-             (let ((datap (linkage-info-datap info))
-                   (table-address (linkage-info-address info))
-                   (real-address (get-dynamic-foreign-symbol-address name)))
+             (let* ((datap (linkage-info-datap info))
+		    (table-address (linkage-info-address info))
+		    (real-address 
+		     (get-dynamic-foreign-symbol-address name datap)))
 	       (aver (and table-address real-address))
 	       (write-linkage-table-entry table-address
 					  real-address
diff --git a/src/code/print.lisp b/src/code/print.lisp
index d327a3d9a..7da9efefc 100644
--- a/src/code/print.lisp
+++ b/src/code/print.lisp
@@ -1104,18 +1104,43 @@
      (schar "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" r) 
      stream)))
 
+;; Algorithm by Harald Hanche-Olsen, sbcl-devel 2005-02-05
 (defun %output-bignum-in-base (n base stream)
-  (labels ((bisect (n power)
-             (if (fixnump n)
-                 (%output-fixnum-in-base n base stream)
-                 (let ((k (truncate power 2)))
-                   (multiple-value-bind (q r) (truncate n (expt base k))
-                     (bisect q (- power k))
-                     (let ((npower (if (zerop r) 0 (truncate (log r base)))))
-                       (dotimes (z (- k npower 1))
-                         (write-char #\0 stream))
-                       (bisect r npower)))))))
-    (bisect n (truncate (log n base)))))
+  (declare (type bignum n) (type fixnum base))
+  (let ((power (make-array 10 :adjustable t :fill-pointer 0)))
+    ;; Here there be the bottleneck for big bignums, in the (* p p).
+    ;; A special purpose SQUARE-BIGNUM might help a bit. See eg: Dan
+    ;; Zuras, "On Squaring and Multiplying Large Integers", ARITH-11:
+    ;; IEEE Symposium on Computer Arithmetic, 1993, pp. 260 to 271.
+    ;; Reprinted as "More on Multiplying and Squaring Large Integers",
+    ;; IEEE Transactions on Computers, volume 43, number 8, August
+    ;; 1994, pp. 899-908.
+    (do ((p base (* p p)))
+	((> p n))
+      (vector-push-extend p power))
+    ;; (aref power k) == (expt base (expt 2 k))
+    (labels ((bisect (n k exactp)
+	       (declare (fixnum k))
+	       ;; N is the number to bisect
+	       ;; K on initial entry BASE^(2^K) > N 
+	       ;; EXACTP is true if 2^K is the exact number of digits
+	       (cond ((zerop n)
+		      (when exactp
+			(loop repeat (ash 1 k) do (write-char #\0 stream))))
+		     ((zerop k)
+		      (write-char 
+		       (schar "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" n)
+		       stream))
+		     (t
+		      (setf k (1- k))
+		      (multiple-value-bind (q r) (truncate n (aref power k))
+			;; EXACTP is NIL only at the head of the
+			;; initial number, as we don't know the number
+			;; of digits there, but we do know that it
+			;; doesn't get any leading zeros.
+			(bisect q k exactp)
+			(bisect r k (or exactp (plusp q))))))))
+      (bisect n (fill-pointer power) nil))))
 
 (defun %output-integer-in-base (integer base stream)
   (when (minusp integer)
diff --git a/src/compiler/alpha/parms.lisp b/src/compiler/alpha/parms.lisp
index 5e511efd3..9fbee3ca4 100644
--- a/src/compiler/alpha/parms.lisp
+++ b/src/compiler/alpha/parms.lisp
@@ -184,7 +184,8 @@
     sub-gc
     sb!kernel::internal-error
     sb!kernel::control-stack-exhausted-error
-    sb!kernel::undefined-alien-error
+    sb!kernel::undefined-alien-variable-error
+    sb!kernel::undefined-alien-function-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 9b059d44a..98c35ff4c 100644
--- a/src/compiler/generic/genesis.lisp
+++ b/src/compiler/generic/genesis.lisp
@@ -1249,7 +1249,8 @@ 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!kernel::undefined-alien-variable-error)
+    (frob sb!kernel::undefined-alien-function-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 31e80d18d..f53d7b420 100644
--- a/src/compiler/hppa/parms.lisp
+++ b/src/compiler/hppa/parms.lisp
@@ -124,7 +124,8 @@
     sb!impl::sub-gc
     sb!kernel::internal-error
     sb!kernel::control-stack-exhausted-error
-    sb!kernel::undefined-alien-error
+    sb!kernel::undefined-alien-variable-error
+    sb!kernel::undefined-alien-function-error
     sb!di::handle-breakpoint
     sb!impl::fdefinition-object
 
diff --git a/src/compiler/mips/parms.lisp b/src/compiler/mips/parms.lisp
index 7943eac73..375d413fb 100644
--- a/src/compiler/mips/parms.lisp
+++ b/src/compiler/mips/parms.lisp
@@ -113,7 +113,8 @@
     sb!impl::sub-gc
     sb!kernel::internal-error
     sb!kernel::control-stack-exhausted-error
-    sb!kernel::undefined-alien-error
+    sb!kernel::undefined-alien-variable-error
+    sb!kernel::undefined-alien-function-error
     sb!di::handle-breakpoint
     sb!impl::fdefinition-object
 
diff --git a/src/compiler/ppc/parms.lisp b/src/compiler/ppc/parms.lisp
index aaebb5385..a782cc8ea 100644
--- a/src/compiler/ppc/parms.lisp
+++ b/src/compiler/ppc/parms.lisp
@@ -153,7 +153,8 @@
     sb!impl::sub-gc
     sb!kernel::internal-error
     sb!kernel::control-stack-exhausted-error
-    sb!kernel::undefined-alien-error
+    sb!kernel::undefined-alien-variable-error
+    sb!kernel::undefined-alien-function-error
     sb!di::handle-breakpoint
     sb!impl::fdefinition-object
 
diff --git a/src/compiler/sparc/parms.lisp b/src/compiler/sparc/parms.lisp
index cd388a8a1..a4821ee7d 100644
--- a/src/compiler/sparc/parms.lisp
+++ b/src/compiler/sparc/parms.lisp
@@ -181,7 +181,8 @@
     sub-gc
     sb!kernel::internal-error
     sb!kernel::control-stack-exhausted-error
-    sb!kernel::undefined-alien-error
+    sb!kernel::undefined-alien-variable-error
+    sb!kernel::undefined-alien-function-error
     sb!di::handle-breakpoint
     sb!di::handle-fun-end-breakpoint
 
diff --git a/src/compiler/x86-64/parms.lisp b/src/compiler/x86-64/parms.lisp
index 60d9d83b0..15276a0c1 100644
--- a/src/compiler/x86-64/parms.lisp
+++ b/src/compiler/x86-64/parms.lisp
@@ -161,6 +161,9 @@
 
 ;;; FIXME: !COLD-INIT probably doesn't need
 ;;; to be in the static symbols table any more.
+;;;
+;;; FIXME: some of these symbols are shared by all backends,
+;;; and should be factored out into a common file.
 (defparameter *static-symbols*
   '(t
 
@@ -172,7 +175,8 @@
     sub-gc
     sb!kernel::internal-error
     sb!kernel::control-stack-exhausted-error
-    sb!kernel::undefined-alien-error
+    sb!kernel::undefined-alien-variable-error
+    sb!kernel::undefined-alien-function-error
     sb!di::handle-breakpoint
     fdefinition-object
     #!+sb-thread sb!thread::handle-thread-exit
diff --git a/src/compiler/x86/parms.lisp b/src/compiler/x86/parms.lisp
index 3d49ed2b7..f12d2930b 100644
--- a/src/compiler/x86/parms.lisp
+++ b/src/compiler/x86/parms.lisp
@@ -269,7 +269,8 @@
     sub-gc
     sb!kernel::internal-error
     sb!kernel::control-stack-exhausted-error
-    sb!kernel::undefined-alien-error
+    sb!kernel::undefined-alien-variable-error
+    sb!kernel::undefined-alien-function-error
     sb!di::handle-breakpoint
     fdefinition-object
     #!+sb-thread sb!thread::handle-thread-exit
diff --git a/src/runtime/interrupt.c b/src/runtime/interrupt.c
index 9071caeaa..65f50bf41 100644
--- a/src/runtime/interrupt.c
+++ b/src/runtime/interrupt.c
@@ -754,6 +754,16 @@ void thread_exit_handler(int num, siginfo_t *info, void *v_context)
 	
 #endif
 
+/* KLUDGE: Theoretically the approach we use for undefined alien
+ * variables should work for functions as well, but on PPC/Darwin
+ * we get bus error at bogus addresses instead, hence this workaround,
+ * that has the added benefit of automatically discriminating between
+ * functions and variables. 
+ */
+void undefined_alien_function() {
+    funcall0(SymbolFunction(UNDEFINED_ALIEN_FUNCTION_ERROR));
+}
+
 boolean handle_guard_page_triggered(os_context_t *context,void *addr){
     struct thread *th=arch_os_get_current_thread();
     
@@ -785,7 +795,7 @@ boolean handle_guard_page_triggered(os_context_t *context,void *addr){
     else if (addr >= undefined_alien_address &&
 	     addr < undefined_alien_address + os_vm_page_size) {
 	arrange_return_to_lisp_function
-          (context, SymbolFunction(UNDEFINED_ALIEN_ERROR));
+          (context, SymbolFunction(UNDEFINED_ALIEN_VARIABLE_ERROR));
 	return 1;
     }
     else return 0;
diff --git a/src/runtime/os.h b/src/runtime/os.h
index 3d1e61c8c..584af23ad 100644
--- a/src/runtime/os.h
+++ b/src/runtime/os.h
@@ -44,7 +44,7 @@
 #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)
+#define OS_VM_PROT_NONE 0
 
 extern os_vm_size_t os_vm_page_size;