Commit 8eee0d3a authored by Nikodemus Siivola's avatar Nikodemus Siivola
Browse files

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

 * Patch by Larry Valkama.
parent cea1ec65

src/code/foreign-load.lisp

+3 −3
Original line number Diff line number Diff line
@@ -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))

src/code/irrat.lisp

+1 −13
Original line number Diff line number Diff line
@@ -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)))))



;;;; not-OLD-SPECFUN stuff

;;;;

src/code/run-program.lisp

+2 −9
Original line number Diff line number Diff line
@@ -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)))

src/code/target-signal.lisp

+1 −0
Original line number Diff line number Diff line
@@ -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))

src/code/unix.lisp

+3 −3
Original line number Diff line number Diff line
@@ -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