0.8.13.78: Birds of Feather

            * Fix dladdr bogosities: test if dladdr is supported on
               the platform, and add an ldso_stub for it if so. This
               so that SBCL isn't dependant on the dladdr being at the
               same location at runtime as it was on the build-host.
               Move the dummy definition for FOREIGN-SYMBOL-IN-ADDRESS
               to target-load, so that backtraces on target will work
               before foreign.lisp is built. Clean up the real F-S-I-A
               definition to use the :os-provides-dladdr feature.
            * Fix manual bogosities: generate functions signalling
               UNSUPPORTED-OPERATOR-ERROR for SB-BSD-SOCKETS
               platform-dependant sockopts on platforms where they're
               not supported; make these functions have the normal
               doctrings. This so that manual building will work on
               non-Linux as well. Also clean up the .sbclrc examples
               slightly.

diff --git a/contrib/sb-bsd-sockets/defpackage.lisp b/contrib/sb-bsd-sockets/defpackage.lisp
index 71d04f8..6779880 100644 (file)
--- a/contrib/sb-bsd-sockets/defpackage.lisp
+++ b/contrib/sb-bsd-sockets/defpackage.lisp
@@ -3,7 +3,6 @@
   (:shadow close listen)
   #+cmu (:shadowing-import-from "CL" with-array-data)
   #+sbcl (:shadowing-import-from "SB-KERNEL" with-array-data)
-
   #+cmu (:use "COMMON-LISP" "ALIEN" "SYSTEM" "EXT" "C-CALL")
   #+sbcl (:use "COMMON-LISP" "SB-ALIEN" #+nil "SB-SYSTEM" "SB-EXT" "SB-C-CALL"))
 
@@ -64,6 +63,7 @@
            non-blocking-mode
            )
   (:use "COMMON-LISP" "SB-BSD-SOCKETS-INTERNAL")
+  (:import-from "SB-INT" "UNSUPPORTED-OPERATOR" "FEATUREP")
   (:documentation
    "
 

diff --git a/contrib/sb-bsd-sockets/sockopt.lisp b/contrib/sb-bsd-sockets/sockopt.lisp
index 33ecabd..3eb9398 100644 (file)
--- a/contrib/sb-bsd-sockets/sockopt.lisp
+++ b/contrib/sb-bsd-sockets/sockopt.lisp
@@ -37,35 +37,42 @@ Code for options that not every system has should be conditionalised:
 
 (defmacro define-socket-option
     (lisp-name documentation
-     level number buffer-type mangle-arg mangle-return mangle-setf-buffer)
+     level number buffer-type mangle-arg mangle-return mangle-setf-buffer
+     &optional features info)
   (let ((find-level
         (if (numberp (eval level))
             level
-            `(get-protocol-by-name ,(string-downcase (symbol-name level))))))
+            `(get-protocol-by-name ,(string-downcase (symbol-name level)))))
+       (supportedp (or (null features) (featurep features))))
     `(progn
       (export ',lisp-name)
-      (defun ,lisp-name (socket &aux (fd (socket-file-descriptor socket)))
-       ,@(when documentation (list documentation))
-       (sb-alien:with-alien ((size sb-alien:integer)
-                             (buffer ,buffer-type))
-         (setf size (sb-alien:alien-size ,buffer-type :bytes))
-         (if (= -1 (sockint::getsockopt fd ,find-level ,number
-                                        (sb-alien:addr buffer)
-                                        (sb-alien:addr size)))
-             (socket-error "getsockopt")
-             (,mangle-return buffer size))))
-      (defun (setf ,lisp-name) (new-val socket
-                               &aux (fd (socket-file-descriptor socket)))
-       (sb-alien:with-alien ((buffer ,buffer-type))
-         (setf buffer ,(if mangle-arg
-                           `(,mangle-arg new-val)
-                           `new-val))
-         (when (= -1 (sockint::setsockopt fd ,find-level ,number
-                                          (,mangle-setf-buffer buffer)
-                                          ,(if (eql buffer-type 'sb-alien:c-string)
-                                               `(length new-val)
-                                               `(sb-alien:alien-size ,buffer-type :bytes))))
-           (socket-error "setsockopt")))))))
+      (defun ,lisp-name (socket)
+       ,@(when documentation (list (concatenate 'string documentation " " info)))
+       ,(if supportedp
+            `(sb-alien:with-alien ((size sb-alien:integer)
+                                     (buffer ,buffer-type))
+                 (setf size (sb-alien:alien-size ,buffer-type :bytes))
+                 (if (= -1 (sockint::getsockopt (socket-file-descriptor socket)
+                                                ,find-level ,number
+                                                (sb-alien:addr buffer)
+                                                (sb-alien:addr size)))
+                     (socket-error "getsockopt")
+                     (,mangle-return buffer size)))
+            `(error 'unsupported-operator :name ',lisp-name)))
+      (defun (setf ,lisp-name) (new-val socket)
+       ,(if supportedp
+            `(sb-alien:with-alien ((buffer ,buffer-type))
+                 (setf buffer ,(if mangle-arg
+                                   `(,mangle-arg new-val)
+                                   `new-val))
+                 (when (= -1 (sockint::setsockopt (socket-file-descriptor socket)
+                                                  ,find-level ,number
+                                                  (,mangle-setf-buffer buffer)
+                                                  ,(if (eql buffer-type 'sb-alien:c-string)
+                                                       `(length new-val)
+                                                       `(sb-alien:alien-size ,buffer-type :bytes))))
+                   (socket-error "setsockopt")))
+            `(error 'unsupported-operator :name `(setf ,lisp-name)))))))
 
 ;;; sockopts that have integer arguments
 
@@ -73,9 +80,9 @@ Code for options that not every system has should be conditionalised:
   (assert (= size (sb-alien:alien-size sb-alien:integer :bytes)))
   buffer)
 
-(defmacro define-socket-option-int (name level number)
+(defmacro define-socket-option-int (name level number &optional features (info ""))
   `(define-socket-option ,name nil ,level ,number
-     sb-alien:integer nil foreign-int-to-integer sb-alien:addr))
+     sb-alien:integer nil foreign-int-to-integer sb-alien:addr ,features ,info))
 
 (define-socket-option-int
   sockopt-receive-low-water sockint::sol-socket sockint::so-rcvlowat)
@@ -87,8 +94,9 @@ Code for options that not every system has should be conditionalised:
   sockopt-send-buffer sockint::sol-socket sockint::so-sndbuf)
 (define-socket-option-int
   sockopt-receive-buffer sockint::sol-socket sockint::so-rcvbuf)
-#+linux(define-socket-option-int
-  sockopt-priority sockint::sol-socket sockint::so-priority)
+(define-socket-option-int
+  sockopt-priority sockint::sol-socket sockint::so-priority :linux
+  "Available only on Linux.")
 
 ;;; boolean options are integers really
 
@@ -100,11 +108,14 @@ Code for options that not every system has should be conditionalised:
 (defun bool-to-foreign-int (val)
   (if val 1 0))
 
-(defmacro define-socket-option-bool (name level c-name)
+(defmacro define-socket-option-bool (name level c-name &optional features (info ""))
   `(define-socket-option ,name
-    ,(format nil "Return the value of the ~A socket option for SOCKET.  This can also be updated with SETF." (symbol-name c-name))
+    ,(format nil "~@<Return the value of the ~A socket option for SOCKET. ~
+                 This can also be updated with SETF.~:@>"
+            (symbol-name c-name))
     ,level ,c-name
-     sb-alien:integer bool-to-foreign-int foreign-int-to-bool sb-alien:addr))
+    sb-alien:integer bool-to-foreign-int foreign-int-to-bool sb-alien:addr
+    ,features ,info))
 
 (define-socket-option-bool
   sockopt-reuse-address sockint::sol-socket sockint::so-reuseaddr)
@@ -112,10 +123,12 @@ Code for options that not every system has should be conditionalised:
   sockopt-keep-alive sockint::sol-socket sockint::so-keepalive)
 (define-socket-option-bool
   sockopt-oob-inline sockint::sol-socket sockint::so-oobinline)
-#+linux(define-socket-option-bool
-  sockopt-bsd-compatible sockint::sol-socket sockint::so-bsdcompat)
-#+linux(define-socket-option-bool
-  sockopt-pass-credentials sockint::sol-socket sockint::so-passcred)
+(define-socket-option-bool
+  sockopt-bsd-compatible sockint::sol-socket sockint::so-bsdcompat :linux
+  "Available only on Linux.")
+(define-socket-option-bool
+  sockopt-pass-credentials sockint::sol-socket sockint::so-passcred :linux
+  "Available only on Linux.")
 (define-socket-option-bool
   sockopt-debug sockint::sol-socket sockint::so-debug)
 (define-socket-option-bool
@@ -129,8 +142,9 @@ Code for options that not every system has should be conditionalised:
   (declare (ignore args))
   x)
 
-#+linux(define-socket-option sockopt-bind-to-device nil sockint::sol-socket
-  sockint::so-bindtodevice sb-alien:c-string identity identity-1 identity)
+(define-socket-option sockopt-bind-to-device nil sockint::sol-socket
+  sockint::so-bindtodevice sb-alien:c-string identity identity-1 identity
+  :linux "Available only on Linux")
 
 ;;; other kinds of socket option
 

diff --git a/doc/manual/start-stop.texinfo b/doc/manual/start-stop.texinfo
index 8e9df47..53f34d1 100644 (file)
--- a/doc/manual/start-stop.texinfo
+++ b/doc/manual/start-stop.texinfo
@@ -301,20 +301,20 @@ initialization file does the trick:
 @lisp
 ;;; If the first user-processable command-line argument is a filename,
 ;;; disable the debugger, load the file handling shebang-line and quit.
-(let ((script (and (second sb-ext:*posix-argv*)
-                   (probe-file (second sb-ext:*posix-argv*)))))
+(let ((script (and (second *posix-argv*) (probe-file (second *posix-argv*)))))
   (when script
-    ;; Handle the possible shebang-line
+    ;; Handle shebang-line
     (set-dispatch-macro-character #\# #\!
                                  (lambda (stream char arg)
                                    (declare (ignore char arg))
                                    (read-line stream)))
     ;; Disable debugger
-    (setf sb-ext:*invoke-debugger-hook* 
-          (lambda (condition hook)
-            (declare (ignore hook))
-            (format *error-output* "Error: ~A~%" condition)
-            (quit :unix-status 1)))
+    (setf *invoke-debugger-hook* (lambda (condition hook)
+                                  (declare (ignore hook))
+                                   ;; Uncomment to get backtraces on errors
+                                  ;; (sb-debug:backtrace 20)
+                                  (format *error-output* "Error: ~A~%" condition)
+                                  (quit)))
     (load script)
     (quit)))
 @end lisp
@@ -364,7 +364,8 @@ handles recompilation automatically for ASDF-based systems.
 ;;; If a fasl was stale, try to recompile and load (once). 
 (defmethod asdf:perform :around ((o asdf:load-op) (c asdf:cl-source-file))
   (handler-case (call-next-method o c)
-    (sb-ext:invalid-fasl error ()
-     (asdf:perform (make-instance 'asdf:compile-op) c)
-     (call-next-method))))
+    ;; If a fasl was stale, try to recompile and load (once).
+    (sb-ext:invalid-fasl ()
+      (asdf:perform (make-instance 'asdf:compile-op) c)
+      (call-next-method))))
 @end lisp

diff --git a/make-config.sh b/make-config.sh
index 3f58b71..aba3e2a 100644 (file)
--- a/make-config.sh
+++ b/make-config.sh
@@ -201,6 +201,8 @@ else
     echo > /dev/null
 fi
 
+sh tools-for-build/grovel-features.sh >> $ltf
+
 echo //finishing $ltf
 echo ')' >> $ltf
 

diff --git a/src/code/foreign.lisp b/src/code/foreign.lisp
index 5e1fc57..3102c08 100644 (file)
--- a/src/code/foreign.lisp
+++ b/src/code/foreign.lisp
@@ -26,10 +26,10 @@
 ;;; It also works on OpenBSD, which isn't ELF, but is otherwise modern
 ;;; enough to have a fairly well working dlopen/dlsym implementation.
 (macrolet ((define-unsupported-fun (fun-name &optional (error-message "unsupported on this system"))
-            `(defun ,fun-name (&rest rest)
-               ,error-message
-                (declare (ignore rest))
-               (error 'unsupported-operator :name ',fun-name))))
+              `(defun ,fun-name (&rest rest)
+                ,error-message
+                (declare (ignore rest))
+                (error 'unsupported-operator :name ',fun-name))))
   #-(or linux sunos FreeBSD OpenBSD NetBSD darwin)
   (define-unsupported-fun load-shared-object)
   #+(or linux sunos FreeBSD OpenBSD NetBSD darwin)
@@ -136,32 +136,26 @@
          (unless (zerop possible-result)
            (return possible-result)))))
 
+    #+os-provides-dladdr
+    ;;; Override the early definition in target-load.lisp
     (defun foreign-symbol-in-address (sap)
-      (declare (ignore sap)))
-
-    (when (ignore-errors (foreign-symbol-address "dladdr"))
-      (setf (symbol-function 'foreign-symbol-in-address)
-           ;; KLUDGE: This COMPILE trick is to avoid trying to
-           ;; compile a reference to dladdr on platforms without it.
-           (compile nil
-            '(lambda (sap)
-              (let ((addr (sap-int sap)))
-                (with-alien ((info
-                              (struct dl-info
-                                      (filename c-string)
-                                      (base unsigned)
-                                      (symbol c-string)
-                                      (symbol-address unsigned)))
-                             (dladdr
-                              (function unsigned
-                                        unsigned (* (struct dl-info)))
-                              :extern "dladdr"))
-                  (let ((err (alien-funcall dladdr addr (addr info))))
-                    (if (zerop err)
-                        nil
-                        (values (slot info 'symbol)
-                                (slot info 'filename)
-                                addr
-                                (- addr (slot info 'symbol-address)))))))))))
+      (let ((addr (sap-int sap)))
+       (with-alien ((info
+                     (struct dl-info
+                             (filename c-string)
+                             (base unsigned)
+                             (symbol c-string)
+                             (symbol-address unsigned)))
+                    (dladdr
+                     (function unsigned
+                               unsigned (* (struct dl-info)))
+                     :extern "dladdr"))
+         (let ((err (alien-funcall dladdr addr (addr info))))
+           (if (zerop err)
+               nil
+               (values (slot info 'symbol)
+                       (slot info 'filename)
+                       addr
+                       (- addr (slot info 'symbol-address))))))))
     
     ))                                 ; PROGN, MACROLET

diff --git a/src/code/target-load.lisp b/src/code/target-load.lisp
index 560ba0e..c16eaba 100644 (file)
--- a/src/code/target-load.lisp
+++ b/src/code/target-load.lisp
@@ -309,3 +309,7 @@
 (defun foreign-symbol-address (symbol)
   (int-sap (foreign-symbol-address-as-integer
            (sb!vm:extern-alien-name symbol))))
+
+;;; Overridden in foreign.lisp once we're running on target
+(defun foreign-symbol-in-address (sap)
+  (declare (ignore sap)))

diff --git a/tools-for-build/grovel-features.sh b/tools-for-build/grovel-features.sh
new file mode 100644 (file)
index 0000000..0931c18
--- /dev/null
+++ b/tools-for-build/grovel-features.sh
@@ -0,0 +1,25 @@
+# Automated platform feature testing 
+
+DIR=tools-for-build
+
+# FIXME: Use this to test for dlopen presence and hence
+# load-shared-object buildability
+
+# $1 feature
+# $2 additional flags
+#
+# Assumes the presence of $1-test.c, which when built and
+# run should return with 104 if the feature is present.
+#
+featurep() {
+    bin="$DIR/$1-test"
+    rm -f $bin
+    cc $DIR/$1-test.c $2 -o $bin 2>&1 > /dev/null && $bin 2>&1 /dev/null
+    if [ "$?" = 104 ]
+    then
+       printf " :$1"
+    fi
+    rm -f $bin
+}
+
+featurep os-provides-dladdr -ldl

diff --git a/tools-for-build/ldso-stubs.lisp b/tools-for-build/ldso-stubs.lisp
index 00cc8de..bf5b04e 100644 (file)
--- a/tools-for-build/ldso-stubs.lisp
+++ b/tools-for-build/ldso-stubs.lisp
@@ -258,6 +258,8 @@ ldso_stub__ ## fct: ;                           \\
                    "dlerror"
                    "dlopen"
                    "dlsym")
+                #!+os-provides-dladdr 
+                '("dladdr")
                  #!-(and sparc sunos) ;; !defined(SVR4)
                  '("sigsetmask")))
 

diff --git a/tools-for-build/os-provides-dladdr-test.c b/tools-for-build/os-provides-dladdr-test.c
new file mode 100644 (file)
index 0000000..4b0f472
--- /dev/null
+++ b/tools-for-build/os-provides-dladdr-test.c
@@ -0,0 +1,20 @@
+/* test to build and run so that we know if we have dladdr 
+ */
+
+/* bloody FSF dlcfn.h won't give us dladdr without this */
+#define _GNU_SOURCE
+
+#include <dlfcn.h>
+
+int main ()
+{
+   void * handle = dlopen((void*)0, RTLD_GLOBAL | RTLD_NOW);
+   void * addr = dlsym(handle, "printf");
+   Dl_info * info = (Dl_info*) malloc(sizeof(Dl_info));
+   dladdr(addr, info);
+   if (strcmp(info->dli_sname, "printf")) {
+       return 1;
+   } else {
+       return 104;
+   }
+}

diff --git a/version.lisp-expr b/version.lisp-expr
index bf049a5..b5b3395 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; 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".)
-"0.8.13.77"
+"0.8.13.78"