1.0.24.17: grab-bag of fixes to make hpux-os smile

 * Patch by Larry Valkama.

diff --git a/src/code/foreign-load.lisp b/src/code/foreign-load.lisp
index 02b2776..dc39be2 100644 (file)
--- a/src/code/foreign-load.lisp
+++ b/src/code/foreign-load.lisp
@@ -103,7 +103,7 @@ Experimental."
                        :key #'shared-object-pathname
                        :test #'equal)))
         (when old
-          (dlclose-or-lose old)
+          #!-hpux (dlclose-or-lose old)
           (setf *shared-objects* (remove old *shared-objects*))
           #!+(and linkage-table (not win32))
           (update-linkage-table))))))
@@ -152,11 +152,11 @@ Experimental."
 (defun close-shared-objects ()
   (let (saved)
     (dolist (obj (reverse *shared-objects*))
-      (dlclose-or-lose obj)
+      #!-hpux (dlclose-or-lose obj)
       (unless (shared-object-dont-save obj)
         (push obj saved)))
     (setf *shared-objects* saved))
-  #!-win32
+  #!-(or win32 hpux)
   (dlclose-or-lose))
 
 (let ((symbols (make-hash-table :test #'equal))

diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp
index 12751a3..5e2c8d0 100644 (file)
--- a/src/code/irrat.lisp
+++ b/src/code/irrat.lisp
@@ -120,7 +120,7 @@
 #!-win32(def-math-rtn "pow" 2)
 #!-(or x86 x86-64) (def-math-rtn "sqrt" 1)
 #!-win32 (def-math-rtn "hypot" 2)
-#!-(or hpux x86) (def-math-rtn "log1p" 1)
+#!-x86 (def-math-rtn "log1p" 1)
 
 #!+win32
 (progn
@@ -636,18 +636,6 @@
     ((complex)
      (complex-atanh number))))
 
-;;; HP-UX does not supply a C version of log1p, so use the definition.
-;;;
-;;; FIXME: This is really not a good definition. As per Raymond Toy
-;;; working on CMU CL, "The definition really loses big-time in
-;;; roundoff as x gets small."
-#!+hpux
-#!-sb-fluid (declaim (inline %log1p))
-#!+hpux
-(defun %log1p (number)
-  (declare (double-float number)
-           (optimize (speed 3) (safety 0)))
-  (the double-float (log (the (double-float 0d0) (+ number 1d0)))))
 \f
 ;;;; not-OLD-SPECFUN stuff
 ;;;;

diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp
index d223e77..f8a36a1 100644 (file)
--- a/src/code/run-program.lisp
+++ b/src/code/run-program.lisp
@@ -249,7 +249,7 @@ PROCESS."
       (sb-sys:serve-all-events 1))
   process)
 
-#-(or hpux win32)
+#-win32
 ;;; Find the current foreground process group id.
 (defun find-current-foreground-process (proc)
   (with-alien ((result sb-alien:int))
@@ -274,18 +274,11 @@ PROCESS."
                ((:pid :process-group)
                 (process-pid process))
                (:pty-process-group
-                #-hpux
                 (find-current-foreground-process process)))))
     (multiple-value-bind
           (okay errno)
         (case whom
-          #+hpux
-          (:pty-process-group
-           (sb-unix:unix-ioctl (sb-sys:fd-stream-fd (process-pty process))
-                               sb-unix:TIOCSIGSEND
-                               (sb-sys:int-sap
-                                signal)))
-          ((:process-group #-hpux :pty-process-group)
+          ((:process-group)
            (sb-unix:unix-killpg pid signal))
           (t
            (sb-unix:unix-kill pid signal)))

diff --git a/src/code/target-signal.lisp b/src/code/target-signal.lisp
index 8c0f486..76ffddc 100644 (file)
--- a/src/code/target-signal.lisp
+++ b/src/code/target-signal.lisp
@@ -185,6 +185,7 @@
   (enable-interrupt sigsys #'sigsys-handler)
   (ignore-interrupt sigpipe)
   (enable-interrupt sigalrm #'sigalrm-handler)
+  #!+hpux (ignore-interrupt sigxcpu)
   (sb!unix::reset-signal-mask)
   (values))
 \f

diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index 0a25f7b..9959ae4 100644 (file)
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -395,15 +395,15 @@ corresponds to NAME, or NIL if there is none."
   ;; comma not inside a backquote. This error has absolutely nothing
   ;; to do with the actual meaning of the error (and little to do with
   ;; its location, either).
-  #!-(or linux openbsd freebsd netbsd sunos osf1 darwin win32) (,stub,)
-  #!+(or linux openbsd freebsd netbsd sunos osf1 darwin win32)
+  #!-(or linux openbsd freebsd netbsd sunos osf1 darwin hpux win32) (,stub,)
+  #!+(or linux openbsd freebsd netbsd sunos osf1 darwin hpux win32)
   (or (newcharstar-string (alien-funcall (extern-alien "getcwd"
                                                        (function (* char)
                                                                  (* char)
                                                                  size-t))
                                          nil
                                          #!+(or linux openbsd freebsd netbsd darwin win32) 0
-                                         #!+(or sunos osf1) 1025))
+                                         #!+(or sunos osf1 hpux) 1025))
       (simple-perror "getcwd")))
 
 ;;; Return the Unix current directory as a SIMPLE-STRING terminated

diff --git a/version.lisp-expr b/version.lisp-expr
index f53f1cb..8b0fec1 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".)
-"1.0.24.16"
+"1.0.24.17"