integrated Raymond Wiker's patches to port RUN-PROGRAM from CMU CL and
authorWilliam Harold Newman <william.newman@airmail.net>
Mon, 25 Sep 2000 00:11:06 +0000 (00:11 +0000)
committerWilliam Harold Newman <william.newman@airmail.net>
Mon, 25 Sep 2000 00:11:06 +0000 (00:11 +0000)
to generalize dlopen()-ish stuff from Linux to FreeBSD

23 files changed:
CREDITS
NEWS
make.sh
package-data-list.lisp-expr
src/code/cold-init.lisp
src/code/defstruct.lisp
src/code/foreign.lisp
src/code/run-program.lisp
src/code/target-load.lisp
src/code/target-random.lisp
src/code/unix.lisp
src/cold/warm.lisp
src/compiler/generic/genesis.lisp
src/compiler/globaldb.lisp
src/compiler/x86/parms.lisp
src/pcl/gray-streams-class.lisp
src/pcl/gray-streams.lisp
src/runtime/Config.x86-bsd
src/runtime/GNUmakefile
src/runtime/bsd-os.c
src/runtime/undefineds.h
src/runtime/x86-validate.h
version.lisp-expr

diff --git a/CREDITS b/CREDITS
index ecb2ffd..8c9cba4 100644 (file)
--- a/CREDITS
+++ b/CREDITS
@@ -477,20 +477,30 @@ whenever I got stuck.
 
 CREDITS SINCE THE RELEASE OF SBCL
 
 
 CREDITS SINCE THE RELEASE OF SBCL
 
-The PSXHASH code used to implement EQUALP hash tables was originally
-copyright (C) 2000 by Cadabra, Inc., then released into the public
-domain.
-
-Daniel Barlow contributed sblisp.lisp, a set of patches to make SBCL
-play nicely with ILISP. (Those patches have since disappeared from the
-SBCL distribution because ILISP has since been patched to play nicely
-with SBCL.) He also figured out how to get the CMU CL dynamic object
-file loading code to work under SBCL.
-
-Raymond Wiker ported sbcl-0.6.3 back to FreeBSD, restoring the
-ancestral CMU CL support for FreeBSD and updating it for the changes
-made from FreeBSD version 3 to FreeBSD version 4.
-
-Colin Walters' O(N) implementation of the general case of MAP on the
-cmucl-imp@cons.org mailing list was the inspiration for similar MAP
-code in sbcl-0.6.8.
+Daniel Barlow:
+  He contributed sblisp.lisp, a set of patches to make SBCL
+  play nicely with ILISP. (Those patches have since disappeared from the
+  SBCL distribution because ILISP has since been patched to play nicely
+  with SBCL.) He also figured out how to get the CMU CL dynamic object
+  file loading code to work under SBCL.
+
+Cadabra, Inc.:
+  They hired William Newman to do some consulting for them,
+  including the implementation of EQUALP hash tables for CMU CL;
+  then agreed to release the EQUALP code into the public domain,
+  giving SBCL, and CMU CL, EQUALP hash tables.
+
+Peter Van Eynde:
+  He wrestled the CLISP test suite into a portable test suite which 
+  can be used on SBCL, and submitted many other bug reports as well.
+
+Colin Walters:
+  His O(N) implementation of the general case of MAP, posted on the
+  cmucl-imp@cons.org mailing list, was the inspiration for similar MAP
+  code added in sbcl-0.6.8.
+
+Raymond Wiker:
+  He ported sbcl-0.6.3 back to FreeBSD, restoring the ancestral
+  CMU CL support for FreeBSD and updating it for the changes made
+  from FreeBSD version 3 to FreeBSD version 4. He also ported the
+  CMU CL extension RUN-PROGRAM, and related code, to SBCL.
diff --git a/NEWS b/NEWS
index f504316..241d001 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -487,10 +487,18 @@ changes in sbcl-0.6.8 relative to sbcl-0.6.7:
   single sequence argument). (The old non-inline implementation
   of the general M-argument sequence-of-length-N case required
   O(M*N*N) time when any of the sequence arguments were LISTs.)
   single sequence argument). (The old non-inline implementation
   of the general M-argument sequence-of-length-N case required
   O(M*N*N) time when any of the sequence arguments were LISTs.)
-?? Raymond Wiker's port of CMU CL's RUN-PROGRAM has been added.
-(?? Don't forget to mention Raymond Wiker in the CREDITS file.)
+* The QUIT :UNIX-CODE keyword argument has been renamed to 
+  QUIT :UNIX-STATUS. (The old name still works, but is deprecated.)
+* Raymond Wiker's port of CMU CL's RUN-PROGRAM has been added.
+  ?? What about the undefined symbols in run-program.lisp?
+     SB-UNIX:UNIX-DUP
+     SB-UNIX:UNIX-IOCTL
+     SB-UNIX:UNIX-PIPE
 ?? The debugger now flushes standard output streams before it begins
   its output ("debugger invoked" and so forth).
 ?? The debugger now flushes standard output streams before it begins
   its output ("debugger invoked" and so forth).
+?? FINISH-OUTPUT now works better than it did before. (It used to 
+  have trouble with characters which weren't followed by a linefeed.)
+  ?? Remember to remove this from BUGS.
 ?? The patch for the SUBSEQ bug reported on the cmucl-imp mailing
   list 12 September 2000 has been applied to SBCL.
 ?? Martin Atzmueller's versions of two CMU CL patches, as posted on 
 ?? The patch for the SUBSEQ bug reported on the cmucl-imp mailing
   list 12 September 2000 has been applied to SBCL.
 ?? Martin Atzmueller's versions of two CMU CL patches, as posted on 
@@ -502,6 +510,5 @@ changes in sbcl-0.6.8 relative to sbcl-0.6.7:
 ?? The signal handling bug reported by Martin Atzmueller on 
   sbcl-devel 13 September 2000, which caused the debugger to 
   get confused after a Ctrl-C interrupt under ILISP, has been fixed.
 ?? The signal handling bug reported by Martin Atzmueller on 
   sbcl-devel 13 September 2000, which caused the debugger to 
   get confused after a Ctrl-C interrupt under ILISP, has been fixed.
-?? The QUIT :UNIX-CODE keyword argument has been renamed to 
-  QUIT :UNIX-STATUS. (The old name is still supported, but 
-  deprecated.)
+?? added enough DEFTRANSFORMs to allow (SXHASH 'FOO) to be optimized
+  away by constant folding
diff --git a/make.sh b/make.sh
index e8d0044..426075e 100755 (executable)
--- a/make.sh
+++ b/make.sh
@@ -49,17 +49,16 @@ echo //SBCL_XC_HOST=\"$SBCL_XC_HOST\"
 # and target machines.
 sh make-config.sh || exit 1
 
 # and target machines.
 sh make-config.sh || exit 1
 
-# The foo-host-bar.sh scripts are run on the cross-compilation host,
-# and the foo-target-bar.sh scripts are run on the target machine. In
+# The make-host-*.sh scripts are run on the cross-compilation host,
+# and the make-target-*.sh scripts are run on the target machine. In
 # ordinary compilation, we just do these phases consecutively on the
 # same machine, but if you wanted to cross-compile from one machine
 # ordinary compilation, we just do these phases consecutively on the
 # same machine, but if you wanted to cross-compile from one machine
-# which supports Common Lisp to another which does not (yet) support
-# Lisp, you could do something like this:
-#   Create copies of the source tree on both host and target.
-#   Create links from "target" to "x86" in "src/compiler/" and
-#     in "src/assembly/", on both the host and the target. (That
-#     would ordinarily be done by the make.sh code above; if we're
-#     doing make.sh stuff by hand, we need to do this by hand, too.)
+# which supports Common Lisp to another which does not (yet:-) support
+# Common Lisp, you could do something like this:
+#   Create copies of the source tree on both the host and the target.
+#   Read the make-config.sh script carefully and emulate it by hand
+#     on both machines (e.g. creating "target"-named symlinks to
+#     identify the target architecture).
 #   On the host system:
 #     SBCL_XC_HOST=<whatever> sh make-host-1.sh
 #   Copy src/runtime/sbcl.h from the host system to the target system.
 #   On the host system:
 #     SBCL_XC_HOST=<whatever> sh make-host-1.sh
 #   Copy src/runtime/sbcl.h from the host system to the target system.
index 2b16cf6..321664b 100644 (file)
@@ -576,9 +576,19 @@ like *STACK-TOP-HINT*"
              ;; miscellaneous useful supported extensions
              "QUIT"
 
              ;; miscellaneous useful supported extensions
              "QUIT"
 
-             ;; running a Unix program from Lisp, not quite working
-             ;; in sbcl-0.6.6, but maybe soon..
-             "RUN-PROGRAM"))
+             ;; RUN-PROGRAM is not only useful for users, but also
+             ;; useful to implement parts of SBCL itself, so we're
+             ;; going to have to implement it anyway, so we might
+             ;; as well support it. And then once we're committed
+             ;; to implementing RUN-PROGRAM, it's nice to have it
+             ;; return a PROCESS object with operations defined on
+             ;; that object.
+             "RUN-PROGRAM"
+             "PROCESS-ALIVE-P" "PROCESS-CLOSE"
+             "PROCESS-CORE-DUMPED" "PROCESS-ERROR" "PROCESS-EXIT-CODE"
+             "PROCESS-INPUT" "PROCESS-KILL" "PROCESS-OUTPUT" "PROCESS-P"
+             "PROCESS-PID" "PROCESS-PLIST" "PROCESS-PTY" "PROCESS-STATUS"
+             "PROCESS-STATUS-HOOK" "PROCESS-WAIT"))
 
  #s(sb-cold:package-data
     :name "SB!FORMAT"
 
  #s(sb-cold:package-data
     :name "SB!FORMAT"
@@ -739,14 +749,6 @@ retained, possibly temporariliy, because it might be used internally."
              ;; used for FORMAT tilde paren
              "MAKE-CASE-FROB-STREAM"
 
              ;; used for FORMAT tilde paren
              "MAKE-CASE-FROB-STREAM"
 
-             ;; Some of these are probably still used for Unix-y processes.
-             ;; -- WHN 19991206
-             "PROCESS-CLOSE"
-             "PROCESS-CORE-DUMPED" "PROCESS-ERROR" "PROCESS-EXIT-CODE"
-             "PROCESS-INPUT" "PROCESS-KILL" "PROCESS-OUTPUT" "PROCESS-P"
-             "PROCESS-PID" "PROCESS-PLIST" "PROCESS-PTY" "PROCESS-STATUS"
-             "PROCESS-STATUS-HOOK" "PROCESS-WAIT"
-
              ;; debuggers' little helpers
              #!+sb-show "*/SHOW*"
              "/SHOW"  "/NOSHOW"
              ;; debuggers' little helpers
              #!+sb-show "*/SHOW*"
              "/SHOW"  "/NOSHOW"
index 79872d9..f50db9e 100644 (file)
   (show-and-call !random-cold-init)
 
   ;; All sorts of things need INFO and/or (SETF INFO).
   (show-and-call !random-cold-init)
 
   ;; All sorts of things need INFO and/or (SETF INFO).
+  (/show0 "about to SHOW-AND-CALL !GLOBALDB-COLD-INIT")
   (show-and-call !globaldb-cold-init)
 
   ;; This needs to be done early, but needs to be after INFO is
   (show-and-call !globaldb-cold-init)
 
   ;; This needs to be done early, but needs to be after INFO is
index 62b9bd2..ca7e467 100644 (file)
 ;;; type declarations. Values are the values for the slots (in order.)
 ;;;
 ;;; This is split four ways because:
 ;;; type declarations. Values are the values for the slots (in order.)
 ;;;
 ;;; This is split four ways because:
-;;; 1] list & vector structures need "name" symbols stuck in at various weird
-;;;    places, whereas STRUCTURE structures have a LAYOUT slot.
+;;; 1] list & vector structures need "name" symbols stuck in at
+;;;    various weird places, whereas STRUCTURE structures have
+;;;    a LAYOUT slot.
 ;;; 2] We really want to use LIST to make list structures, instead of
 ;;;    MAKE-LIST/(SETF ELT).
 ;;; 2] We really want to use LIST to make list structures, instead of
 ;;;    MAKE-LIST/(SETF ELT).
-;;; 3] STRUCTURE structures can have raw slots that must also be allocated and
-;;;    indirectly referenced. We use SLOT-ACCESSOR-FORM to compute how to set
-;;;    the slots, which deals with raw slots.
-;;; 4] funcallable structures are weird.
+;;; 3] STRUCTURE structures can have raw slots that must also be
+;;;    allocated and indirectly referenced. We use SLOT-ACCESSOR-FORM
+;;;    to compute how to set the slots, which deals with raw slots.
+;;; 4] Funcallable structures are weird.
 (defun create-vector-constructor
        (defstruct cons-name arglist vars types values)
   (let ((temp (gensym))
 (defun create-vector-constructor
        (defstruct cons-name arglist vars types values)
   (let ((temp (gensym))
index 6f4b782..da50eac 100644 (file)
@@ -63,7 +63,7 @@
 
 ;;; Linux implementation of GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS
 ;;; and functions (e.g. LOAD-FOREIGN) which affect it
 
 ;;; Linux implementation of GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS
 ;;; and functions (e.g. LOAD-FOREIGN) which affect it
-#+linux
+#+(or linux FreeBSD)
 (progn
 
 ;;; flags for dlopen()
 (progn
 
 ;;; flags for dlopen()
index aadfe81..d704435 100644 (file)
@@ -1,20 +1,5 @@
-.. not working .. not working .. not working .. not working ..
-
-KLUDGE: This is CMU CL code which needs more porting before it can
-work on SBCL. At the very least:
-  * Package references need to be renamed from the CMU CL "SYSTEM" style
-    to the SBCL "SB-SYS" style. Possibly some referenced symbols have
-    moved to new packages or been renamed, as well.
-  * The environment-handling needs to be updated to read directly from
-    the Unix environment, since SBCL, unlike CMU CL, doesn't maintain
-    its own local copy.
-  * The DEFCONSTANT #+SVR4 stuff needs to be checked and cleaned up for
-    currently supported OSes, since SBCL doesn't use the :SVR4 feature.
-  * The conditional code for other stuff not supported by SBCL (e.g.
-    HPUX) should probably go away.
--- WHN 20000825
-
-;;;; support for running Unix programs from inside Lisp
+;;;; RUN-PROGRAM and friends, a facility for running Unix programs
+;;;; from inside SBCL
 
 ;;;; This software is part of the SBCL system. See the README file for
 ;;;; more information.
 
 ;;;; This software is part of the SBCL system. See the README file for
 ;;;; more information.
@@ -32,10 +17,10 @@ work on SBCL. At the very least:
 \f
 ;;;; Import wait3(2) from Unix.
 
 \f
 ;;;; Import wait3(2) from Unix.
 
-(alien:def-alien-routine ("wait3" c-wait3) c-call:int
-  (status c-call:int :out)
-  (options c-call:int)
-  (rusage c-call:int))
+(sb-alien:def-alien-routine ("wait3" c-wait3) sb-c-call:int
+  (status sb-c-call:int :out)
+  (options sb-c-call:int)
+  (rusage sb-c-call:int))
 
 (eval-when (load eval compile)
   (defconstant wait-wnohang #-svr4 1 #+svr4 #o100)
 
 (eval-when (load eval compile)
   (defconstant wait-wnohang #-svr4 1 #+svr4 #o100)
@@ -43,15 +28,15 @@ work on SBCL. At the very least:
   (defconstant wait-wstopped #-svr4 #o177 #+svr4 wait-wuntraced))
 
 (defun wait3 (&optional do-not-hang check-for-stopped)
   (defconstant wait-wstopped #-svr4 #o177 #+svr4 wait-wuntraced))
 
 (defun wait3 (&optional do-not-hang check-for-stopped)
-  "Return any available status information on child process."
+  "Return any available status information on child process. "
   (multiple-value-bind (pid status)
   (multiple-value-bind (pid status)
-                      (c-wait3 (logior (if do-not-hang
-                                           wait-wnohang
-                                           0)
-                                       (if check-for-stopped
-                                           wait-wuntraced
-                                           0))
-                               0)
+      (c-wait3 (logior (if do-not-hang
+                          wait-wnohang
+                          0)
+                      (if check-for-stopped
+                          wait-wuntraced
+                          0))
+              0)
     (cond ((or (minusp pid)
               (zerop pid))
           nil)
     (cond ((or (minusp pid)
               (zerop pid))
           nil)
@@ -67,39 +52,40 @@ work on SBCL. At the very least:
          (t
           (let ((signal (ldb (byte 7 0) status)))
             (values pid
          (t
           (let ((signal (ldb (byte 7 0) status)))
             (values pid
-                    (if (or (eql signal unix:sigstop)
-                            (eql signal unix:sigtstp)
-                            (eql signal unix:sigttin)
-                            (eql signal unix:sigttou))
-                      :stopped
-                      :signaled)
+                    (if (or (eql signal sb-unix:sigstop)
+                            (eql signal sb-unix:sigtstp)
+                            (eql signal sb-unix:sigttin)
+                            (eql signal sb-unix:sigttou))
+                        :stopped
+                        :signaled)
                     signal
                     (not (zerop (ldb (byte 1 7) status)))))))))
 \f
                     signal
                     (not (zerop (ldb (byte 1 7) status)))))))))
 \f
-;;;; stuff for process control
+;;;; process control stuff
 
 (defvar *active-processes* nil
   "List of process structures for all active processes.")
 
 
 (defvar *active-processes* nil
   "List of process structures for all active processes.")
 
-(defstruct (process (:print-function %print-process))
-  pid                      ; PID of child process
-  %status                  ; either :RUNNING, :STOPPED, :EXITED, or :SIGNALED
-  exit-code                ; either exit code or signal
-  core-dumped              ; T if a core image was dumped
-  pty                      ; stream to child's pty, or NIL
-  input                            ; stream to child's input, or NIL
-  output                   ; stream from child's output, or NIL
-  error                            ; stream from child's error output, or NIL
-  status-hook              ; closure to call when PROC changes status
-  plist                            ; a place for clients to stash things
-  cookie                   ; list of the number of pipes from the subprocess
-  )
-
-(defun %print-process (proc stream depth)
-  (declare (ignore depth))
-  (format stream "#<PROCESS ~D ~S>"
-         (process-pid proc)
-         (process-status proc)))
+(defstruct (process)
+  pid                ; PID of child process
+  %status             ; either :RUNNING, :STOPPED, :EXITED, or :SIGNALED
+  exit-code          ; either exit code or signal
+  core-dumped        ; T if a core image was dumped
+  pty                ; stream to child's pty, or NIL
+  input                      ; stream to child's input, or NIL
+  output             ; stream from child's output, or NIL
+  error                      ; stream from child's error output, or NIL
+  status-hook        ; closure to call when PROC changes status
+  plist                      ; a place for clients to stash things
+  cookie)             ; list of the number of pipes from the subproc
+
+(defmethod print-object ((process process) stream)
+  (print-unreadable-object (process stream :type t)
+    (format stream
+           "~D ~S"
+           (process-pid process)
+           (process-status process)))
+  process)
 
 (defun process-status (proc)
   "Return the current status of process.  The result is one of :RUNNING,
 
 (defun process-status (proc)
   "Return the current status of process.  The result is one of :RUNNING,
@@ -110,36 +96,37 @@ work on SBCL. At the very least:
 (defun process-wait (proc &optional check-for-stopped)
   "Wait for PROC to quit running for some reason.  Returns PROC."
   (loop
 (defun process-wait (proc &optional check-for-stopped)
   "Wait for PROC to quit running for some reason.  Returns PROC."
   (loop
-    (case (process-status proc)
-      (:running)
-      (:stopped
-       (when check-for-stopped
-        (return)))
-      (t
-       (when (zerop (car (process-cookie proc)))
-        (return))))
-    (system:serve-all-events 1))
+      (case (process-status proc)
+       (:running)
+       (:stopped
+        (when check-for-stopped
+          (return)))
+       (t
+        (when (zerop (car (process-cookie proc)))
+          (return))))
+      (sb-sys:serve-all-events 1))
   proc)
 
   proc)
 
+#-hpux
 ;;; Find the current foreground process group id.
 (defun find-current-foreground-process (proc)
 ;;; Find the current foreground process group id.
 (defun find-current-foreground-process (proc)
-  (alien:with-alien ((result c-call:int))
+  (sb-alien:with-alien ((result sb-c-call:int))
     (multiple-value-bind
     (multiple-value-bind
-       (wonp error)
-       (unix:unix-ioctl (system:fd-stream-fd (ext:process-pty proc))
-                        unix:TIOCGPGRP
-                        (alien:alien-sap (alien:addr result)))
+         (wonp error)
+       (sb-unix:unix-ioctl (sb-sys:fd-stream-fd (process-pty proc))
+                           sb-unix:TIOCGPGRP
+                           (sb-alien:alien-sap (sb-alien:addr result)))
       (unless wonp
        (error "TIOCPGRP ioctl failed: ~S"
       (unless wonp
        (error "TIOCPGRP ioctl failed: ~S"
-              (unix:get-unix-error-msg error)))
+              (sb-unix:get-unix-error-msg error)))
       result))
   (process-pid proc))
 
 (defun process-kill (proc signal &optional (whom :pid))
       result))
   (process-pid proc))
 
 (defun process-kill (proc signal &optional (whom :pid))
-  "Send SIGNAL to PROC.  If WHOM is :PID, then use the kill(2) Unix system
-   call. If WHOM is :PROCESS-GROUP, use the killpg(2) Unix system call.
-   If WHOM is :PTY-PROCESS-GROUP, then deliver the signal to whichever
-   process group is currently in the foreground."
+  "Hand SIGNAL to PROC.  If whom is :pid, use the kill Unix system call.  If
+   whom is :process-group, use the killpg Unix system call.  If whom is
+   :pty-process-group deliver the signal to whichever process group is currently
+   in the foreground."
   (let ((pid (ecase whom
               ((:pid :process-group)
                (process-pid proc))
   (let ((pid (ecase whom
               ((:pid :process-group)
                (process-pid proc))
@@ -147,22 +134,22 @@ work on SBCL. At the very least:
                #-hpux
                (find-current-foreground-process proc)))))
     (multiple-value-bind
                #-hpux
                (find-current-foreground-process proc)))))
     (multiple-value-bind
-       (okay errno)
+         (okay errno)
        (case whom
          #+hpux
          (:pty-process-group
        (case whom
          #+hpux
          (:pty-process-group
-          (unix:unix-ioctl (system:fd-stream-fd (process-pty proc))
-                           unix:TIOCSIGSEND
-                           (system:int-sap
-                            (unix:unix-signal-number signal))))
+          (sb-unix:unix-ioctl (sb-sys:fd-stream-fd (process-pty proc))
+                              sb-unix:TIOCSIGSEND
+                              (sb-sys:int-sap
+                               (sb-unix:unix-signal-number signal))))
          ((:process-group #-hpux :pty-process-group)
          ((:process-group #-hpux :pty-process-group)
-          (unix:unix-killpg pid signal))
+          (sb-unix:unix-killpg pid signal))
          (t
          (t
-          (unix:unix-kill pid signal)))
+          (sb-unix:unix-kill pid signal)))
       (cond ((not okay)
             (values nil errno))
            ((and (eql pid (process-pid proc))
       (cond ((not okay)
             (values nil errno))
            ((and (eql pid (process-pid proc))
-                 (= (unix:unix-signal-number signal) unix:sigcont))
+                 (= (sb-unix:unix-signal-number signal) sb-unix:sigcont))
             (setf (process-%status proc) :running)
             (setf (process-exit-code proc) nil)
             (when (process-status-hook proc)
             (setf (process-%status proc) :running)
             (setf (process-exit-code proc) nil)
             (when (process-status-hook proc)
@@ -176,8 +163,8 @@ work on SBCL. At the very least:
   (let ((status (process-status proc)))
     (if (or (eq status :running)
            (eq status :stopped))
   (let ((status (process-status proc)))
     (if (or (eq status :running)
            (eq status :stopped))
-      t
-      nil)))
+       t
+       nil)))
 
 (defun process-close (proc)
   "Close all streams connected to PROC and stop maintaining the status slot."
 
 (defun process-close (proc)
   "Close all streams connected to PROC and stop maintaining the status slot."
@@ -187,33 +174,33 @@ work on SBCL. At the very least:
     (frob (process-input  proc)   t) ; .. 'cause it will generate SIGPIPE.
     (frob (process-output proc) nil)
     (frob (process-error  proc) nil))
     (frob (process-input  proc)   t) ; .. 'cause it will generate SIGPIPE.
     (frob (process-output proc) nil)
     (frob (process-error  proc) nil))
-  (system:without-interrupts
+  (sb-sys:without-interrupts
    (setf *active-processes* (delete proc *active-processes*)))
   proc)
 
    (setf *active-processes* (delete proc *active-processes*)))
   proc)
 
-;;; the handler for SIGCHLD signals that RUN-PROGRAM establishes
+;;; the handler for sigchld signals that RUN-PROGRAM establishes
 (defun sigchld-handler (ignore1 ignore2 ignore3)
   (declare (ignore ignore1 ignore2 ignore3))
   (get-processes-status-changes))
 
 (defun get-processes-status-changes ()
   (loop
 (defun sigchld-handler (ignore1 ignore2 ignore3)
   (declare (ignore ignore1 ignore2 ignore3))
   (get-processes-status-changes))
 
 (defun get-processes-status-changes ()
   (loop
-    (multiple-value-bind (pid what code core)
-                        (wait3 t t)
-      (unless pid
-       (return))
-      (let ((proc (find pid *active-processes* :key #'process-pid)))
-       (when proc
-         (setf (process-%status proc) what)
-         (setf (process-exit-code proc) code)
-         (setf (process-core-dumped proc) core)
-         (when (process-status-hook proc)
-           (funcall (process-status-hook proc) proc))
-         (when (or (eq what :exited)
-                   (eq what :signaled))
-           (system:without-interrupts
-             (setf *active-processes*
-                   (delete proc *active-processes*)))))))))
+      (multiple-value-bind (pid what code core)
+         (wait3 t t)
+       (unless pid
+         (return))
+       (let ((proc (find pid *active-processes* :key #'process-pid)))
+         (when proc
+           (setf (process-%status proc) what)
+           (setf (process-exit-code proc) code)
+           (setf (process-core-dumped proc) core)
+           (when (process-status-hook proc)
+             (funcall (process-status-hook proc) proc))
+           (when (or (eq what :exited)
+                     (eq what :signaled))
+             (sb-sys:without-interrupts
+              (setf *active-processes*
+                    (delete proc *active-processes*)))))))))
 \f
 ;;;; RUN-PROGRAM and close friends
 
 \f
 ;;;; RUN-PROGRAM and close friends
 
@@ -224,59 +211,69 @@ work on SBCL. At the very least:
 (defvar *handlers-installed* nil
   "List of handlers installed by RUN-PROGRAM.")
 
 (defvar *handlers-installed* nil
   "List of handlers installed by RUN-PROGRAM.")
 
-;;; Find a pty that is not in use. Returns three values: the file
+#+FreeBSD
+(def-alien-type nil
+    (struct sgttyb
+           (sg-ispeed sb-c-call:char)  ; input speed
+           (sg-ospeed sb-c-call:char)  ; output speed
+           (sg-erase sb-c-call:char)   ; erase character
+           (sg-kill sb-c-call:char)    ; kill character
+           (sg-flags sb-c-call:short)  ; mode flags
+           ))
+
+;;; Find a pty that is not in use. Return three values: the file
 ;;; descriptor for the master side of the pty, the file descriptor for
 ;;; the slave side of the pty, and the name of the tty device for the
 ;;; slave side.
 (defun find-a-pty ()
 ;;; descriptor for the master side of the pty, the file descriptor for
 ;;; the slave side of the pty, and the name of the tty device for the
 ;;; slave side.
 (defun find-a-pty ()
-  "Returns the master fd, the slave fd, and the name of the tty"
   (dolist (char '(#\p #\q))
     (dotimes (digit 16)
       (let* ((master-name (format nil "/dev/pty~C~X" char digit))
   (dolist (char '(#\p #\q))
     (dotimes (digit 16)
       (let* ((master-name (format nil "/dev/pty~C~X" char digit))
-            (master-fd (unix:unix-open master-name
-                                       unix:o_rdwr
-                                       #o666)))
+            (master-fd (sb-unix:unix-open master-name
+                                          sb-unix:o_rdwr
+                                          #o666)))
        (when master-fd
          (let* ((slave-name (format nil "/dev/tty~C~X" char digit))
        (when master-fd
          (let* ((slave-name (format nil "/dev/tty~C~X" char digit))
-                (slave-fd (unix:unix-open slave-name
-                                          unix:o_rdwr
-                                          #o666)))
+                (slave-fd (sb-unix:unix-open slave-name
+                                             sb-unix:o_rdwr
+                                             #o666)))
            (when slave-fd
            (when slave-fd
-             ; Maybe put a vhangup here?
-              #-glibc2
-             (alien:with-alien ((stuff (alien:struct unix:sgttyb)))
-               (let ((sap (alien:alien-sap stuff)))
-                 (unix:unix-ioctl slave-fd unix:TIOCGETP sap)
-                 (setf (alien:slot stuff 'unix:sg-flags) #o300) ; EVENP|ODDP
-                 (unix:unix-ioctl slave-fd unix:TIOCSETP sap)
-                 (unix:unix-ioctl master-fd unix:TIOCGETP sap)
-                 (setf (alien:slot stuff 'unix:sg-flags)
-                       (logand (alien:slot stuff 'unix:sg-flags)
+                                       ; Maybe put a vhangup here?
+              #-linux
+             (sb-alien:with-alien ((stuff (sb-alien:struct sgttyb)))
+               (let ((sap (sb-alien:alien-sap stuff)))
+                 (sb-unix:unix-ioctl slave-fd sb-unix:TIOCGETP sap)
+                 (setf (sb-alien:slot stuff 'sg-flags)
+                       #o300)          ; EVENP|ODDP
+                 (sb-unix:unix-ioctl slave-fd sb-unix:TIOCSETP sap)
+                 (sb-unix:unix-ioctl master-fd sb-unix:TIOCGETP sap)
+                 (setf (sb-alien:slot stuff 'sg-flags)
+                       (logand (sb-alien:slot stuff 'sg-flags)
                                (lognot 8))) ; ~ECHO
                                (lognot 8))) ; ~ECHO
-                 (unix:unix-ioctl master-fd unix:TIOCSETP sap)))
+                 (sb-unix:unix-ioctl master-fd sb-unix:TIOCSETP sap)))
              (return-from find-a-pty
              (return-from find-a-pty
-                          (values master-fd
-                                  slave-fd
-                                  slave-name)))
-         (unix:unix-close master-fd))))))
+               (values master-fd
+                       slave-fd
+                       slave-name)))
+           (sb-unix:unix-close master-fd))))))
   (error "could not find a pty"))
 
 (defun open-pty (pty cookie)
   (when pty
     (multiple-value-bind
   (error "could not find a pty"))
 
 (defun open-pty (pty cookie)
   (when pty
     (multiple-value-bind
-       (master slave name)
+         (master slave name)
        (find-a-pty)
       (push master *close-on-error*)
       (push slave *close-in-parent*)
       (when (streamp pty)
        (find-a-pty)
       (push master *close-on-error*)
       (push slave *close-in-parent*)
       (when (streamp pty)
-       (multiple-value-bind (new-fd errno) (unix:unix-dup master)
+       (multiple-value-bind (new-fd errno) (sb-unix:unix-dup master)
          (unless new-fd
          (unless new-fd
-           (error "could not UNIX:UNIX-DUP ~D: ~A"
-                  master (unix:get-unix-error-msg errno)))
+           (error "could not SB-UNIX:UNIX-DUP ~D: ~S"
+                  master (sb-unix:get-unix-error-msg errno)))
          (push new-fd *close-on-error*)
          (copy-descriptor-to-stream new-fd pty cookie)))
       (values name
          (push new-fd *close-on-error*)
          (copy-descriptor-to-stream new-fd pty cookie)))
       (values name
-             (system:make-fd-stream master :input t :output t)))))
+             (sb-sys:make-fd-stream master :input t :output t)))))
 
 (defmacro round-bytes-to-words (n)
   `(logand (the fixnum (+ (the fixnum ,n) 3)) (lognot 3)))
 
 (defmacro round-bytes-to-words (n)
   `(logand (the fixnum (+ (the fixnum ,n) 3)) (lognot 3)))
@@ -294,19 +291,20 @@ work on SBCL. At the very least:
       (incf string-bytes (round-bytes-to-words (1+ (length s)))))
     ;; Now allocate the memory and fill it in.
     (let* ((total-bytes (+ string-bytes vec-bytes))
       (incf string-bytes (round-bytes-to-words (1+ (length s)))))
     ;; Now allocate the memory and fill it in.
     (let* ((total-bytes (+ string-bytes vec-bytes))
-          (vec-sap (system:allocate-system-memory total-bytes))
+          (vec-sap (sb-sys:allocate-system-memory total-bytes))
           (string-sap (sap+ vec-sap vec-bytes))
           (i #-alpha 4 #+alpha 8))
       (declare (type (and unsigned-byte fixnum) total-bytes i)
           (string-sap (sap+ vec-sap vec-bytes))
           (i #-alpha 4 #+alpha 8))
       (declare (type (and unsigned-byte fixnum) total-bytes i)
-              (type system:system-area-pointer vec-sap string-sap))
+              (type sb-sys:system-area-pointer vec-sap string-sap))
       (dolist (s string-list)
        (declare (simple-string s))
        (let ((n (length s)))
          ;; Blast the string into place.
       (dolist (s string-list)
        (declare (simple-string s))
        (let ((n (length s)))
          ;; Blast the string into place.
-         (kernel:copy-to-system-area (the simple-string s)
-                                     (* vm:vector-data-offset vm:word-bits)
-                                     string-sap 0
-                                     (* (1+ n) vm:byte-bits))
+         (sb-kernel:copy-to-system-area (the simple-string s)
+                                        (* sb-vm:vector-data-offset
+                                           sb-vm:word-bits)
+                                        string-sap 0
+                                        (* (1+ n) sb-vm:byte-bits))
          ;; Blast the pointer to the string into place.
          (setf (sap-ref-sap vec-sap i) string-sap)
          (setf string-sap (sap+ string-sap (round-bytes-to-words (1+ n))))
          ;; Blast the pointer to the string into place.
          (setf (sap-ref-sap vec-sap i) string-sap)
          (setf string-sap (sap+ string-sap (round-bytes-to-words (1+ n))))
@@ -319,71 +317,66 @@ work on SBCL. At the very least:
   (let ((sap (gensym "SAP-"))
        (size (gensym "SIZE-")))
     `(multiple-value-bind
   (let ((sap (gensym "SAP-"))
        (size (gensym "SIZE-")))
     `(multiple-value-bind
-        (,sap ,var ,size)
-        (string-list-to-c-strvec ,str-list)
-       (unwind-protect
+      (,sap ,var ,size)
+      (string-list-to-c-strvec ,str-list)
+      (unwind-protect
           (progn
             ,@body)
           (progn
             ,@body)
-        (system:deallocate-system-memory ,sap ,size)))))
+       (sb-sys:deallocate-system-memory ,sap ,size)))))
 
 
-(alien:def-alien-routine spawn c-call:int
-  (program c-call:c-string)
-  (argv (* c-call:c-string))
-  (envp (* c-call:c-string))
-  (pty-name c-call:c-string)
-  (stdin c-call:int)
-  (stdout c-call:int)
-  (stderr c-call:int))
+(sb-alien:def-alien-routine spawn sb-c-call:int
+  (program sb-c-call:c-string)
+  (argv (* sb-c-call:c-string))
+  (envp (* sb-c-call:c-string))
+  (pty-name sb-c-call:c-string)
+  (stdin sb-c-call:int)
+  (stdout sb-c-call:int)
+  (stderr sb-c-call:int))
 
 ;;; RUN-PROGRAM uses fork and execve to run a different program.
 ;;; Strange stuff happens to keep the unix state of the world
 ;;; coherent.
 ;;;
 
 ;;; RUN-PROGRAM uses fork and execve to run a different program.
 ;;; Strange stuff happens to keep the unix state of the world
 ;;; coherent.
 ;;;
-;;; The child process needs to get it's input from somewhere, and send it's
-;;; output (both standard and error) to somewhere. We have to do different
-;;; things depending on where these somewheres really are.
+;;; The child process needs to get it's input from somewhere, and send
+;;; its output (both standard and error) to somewhere. We have to do
+;;; different things depending on where these somewheres really are.
 ;;;
 ;;; For input, there are five options:
 ;;;
 ;;; For input, there are five options:
-;;; - T: Just leave fd 0 alone. Pretty simple.
-;;; - "file": Read from the file. We need to open the file and pull the
-;;; descriptor out of the stream. The parent should close this stream after
-;;; the child is up and running to free any storage used in the parent.
-;;; - NIL: Same as "file", but use "/dev/null" as the file.
-;;; - :STREAM: Use unix-pipe to create two descriptors. Use system:make-fd-stream
-;;; to create the output stream on the writeable descriptor, and pass the
-;;; readable descriptor to the child. The parent must close the readable
-;;; descriptor for EOF to be passed up correctly.
-;;; - a stream: If it's a fd-stream, just pull the descriptor out of it.
-;;; Otherwise make a pipe as in :STREAM, and copy everything across.
+;;;  -- T: Just leave fd 0 alone. Pretty simple.
+;;;  -- "file": Read from the file. We need to open the file and
+;;;     pull the descriptor out of the stream. The parent should close
+;;;     this stream after the child is up and running to free any 
+;;;     storage used in the parent.
+;;;  -- NIL: Same as "file", but use "/dev/null" as the file.
+;;;  -- :STREAM: Use unix-pipe to create two descriptors. Use
+;;;     sb-sys:make-fd-stream to create the output stream on the
+;;;     writeable descriptor, and pass the readable descriptor to
+;;;     the child. The parent must close the readable descriptor for
+;;;     EOF to be passed up correctly.
+;;;  -- a stream: If it's a fd-stream, just pull the descriptor out
+;;;     of it. Otherwise make a pipe as in :STREAM, and copy 
+;;;     everything across.
 ;;;
 ;;;
-;;; For output, there are n options:
-;;; - T: Leave descriptor 1 alone.
-;;; - "file": dump output to the file.
-;;; - NIL: dump output to /dev/null.
-;;; - :STREAM: return a stream that can be read from.
-;;; - a stream: if it's a fd-stream, use the descriptor in it. Otherwise, copy
-;;; stuff from output to stream.
+;;; For output, there are five options:
+;;;  -- T: Leave descriptor 1 alone.
+;;;  -- "file": dump output to the file.
+;;;  -- NIL: dump output to /dev/null.
+;;;  -- :STREAM: return a stream that can be read from.
+;;;  -- a stream: if it's a fd-stream, use the descriptor in it.
+;;;     Otherwise, copy stuff from output to stream.
 ;;;
 ;;; For error, there are all the same options as output plus:
 ;;;
 ;;; For error, there are all the same options as output plus:
-;;; - :OUTPUT: redirect to the same place as output.
+;;;  -- :OUTPUT: redirect to the same place as output.
 ;;;
 ;;;
-;;; RUN-PROGRAM returns a process struct for the process if the fork
-;;; worked, and NIL if it did not.
+;;; RUN-PROGRAM returns a PROCESS structure for the process if
+;;; the fork worked, and NIL if it did not.
 (defun run-program (program args
 (defun run-program (program args
-                   &key
-                   (env *environment-list*)
-                   (wait t)
-                   pty
-                   input
-                   if-input-does-not-exist
-                   output
-                   (if-output-exists :error)
-                   (error :output)
-                   (if-error-exists :error)
-                   status-hook)
-  "RUN-PROGRAM creates a new process and runs the unix program in the
-   file specified by PROGRAM (a SIMPLE-STRING).  ARGS are the standard
-   arguments that can be passed to a Unix program; for no arguments
+                   &key env (wait t) pty input
+                   if-input-does-not-exist output (if-output-exists :error)
+                   (error :output) (if-error-exists :error) status-hook)
+  "RUN-PROGRAM creates a new process and runs the unix progam in the
+   file specified by the simple-string program.  Args are the standard
+   arguments that can be passed to a Unix program, for no arguments
    use NIL (which means just the name of the program is passed as arg 0).
 
    RUN-PROGRAM will either return NIL or a PROCESS structure.  See the CMU
    use NIL (which means just the name of the program is passed as arg 0).
 
    RUN-PROGRAM will either return NIL or a PROCESS structure.  See the CMU
@@ -391,7 +384,7 @@ work on SBCL. At the very least:
 
    The keyword arguments have the following meanings:
      :env -
 
    The keyword arguments have the following meanings:
      :env -
-        An alist mapping keyword environment variables to SIMPLE-STRING
+        An A-LIST mapping keyword environment variables to simple-string
        values.
      :wait -
         If non-NIL (default), wait until the created process finishes.  If
        values.
      :wait -
         If non-NIL (default), wait until the created process finishes.  If
@@ -434,65 +427,58 @@ work on SBCL. At the very least:
         This is a function the system calls whenever the status of the
         process changes.  The function takes the process as an argument."
 
         This is a function the system calls whenever the status of the
         process changes.  The function takes the process as an argument."
 
-  ;; Make sure that the interrupt handler is installed.
-  (system:enable-interrupt unix:sigchld #'sigchld-handler)
-  ;; Make sure that all the args are okay.
+  ;; Make sure the interrupt handler is installed.
+  (sb-sys:enable-interrupt sb-unix:sigchld #'sigchld-handler)
+  ;; Make sure all the args are okay.
   (unless (every #'simple-string-p args)
   (unless (every #'simple-string-p args)
-    ;; FIXME: should be some sort of TYPE-ERROR? or perhaps we should
-    ;; just be nice and call (COERCE FOO 'SIMPLE-STRING) on each of
-    ;; our arguments, since it's reasonable for the user to pass in
-    ;; (at least) non-SIMPLE STRING values.
-    (error "All args to program must be simple strings: ~S." args))
-  ;; Prepend the program to the argument list.
+    (error "All arguments to program must be simple strings: ~S" args))
+  ;; Pre-pend the program to the argument list.
   (push (namestring program) args)
   ;; Clear various specials used by GET-DESCRIPTOR-FOR to communicate
   (push (namestring program) args)
   ;; Clear various specials used by GET-DESCRIPTOR-FOR to communicate
-  ;; cleanup info. Also, establish proc at this level so that we can
+  ;; cleanup info.  Also, establish proc at this level so we can
   ;; return it.
   (let (*close-on-error* *close-in-parent* *handlers-installed* proc)
     (unwind-protect
   ;; return it.
   (let (*close-on-error* *close-in-parent* *handlers-installed* proc)
     (unwind-protect
-       (let ((pfile (unix-namestring (merge-pathnames program "path:") t t))
-             (cookie (list 0)))
-         (unless pfile
-           (error "no such program: ~S" program))
-         (multiple-value-bind
-             (stdin input-stream)
-             (get-descriptor-for input cookie
-                                 :direction :input
-                                 :if-does-not-exist if-input-does-not-exist)
-           (multiple-value-bind
-               (stdout output-stream)
-               (get-descriptor-for output cookie
-                                   :direction :output
-                                   :if-exists if-output-exists)
-             (multiple-value-bind
-                 (stderr error-stream)
-                 (if (eq error :output)
-                     (values stdout output-stream)
-                     (get-descriptor-for error cookie
-                                         :direction :output
-                                         :if-exists if-error-exists))
-               (multiple-value-bind (pty-name pty-stream)
-                                    (open-pty pty cookie)
-                 ;; Make sure we are not notified about the child
-                 ;; death before we have installed the process struct
-                 ;; in *ACTIVE-PROCESSES*.
-                 (system:without-interrupts
+        (let ((pfile (unix-namestring (merge-pathnames program "path:") t t))
+              (cookie (list 0)))
+          (unless pfile
+            (error "no such program: ~S" program))
+          (multiple-value-bind
+                (stdin input-stream)
+              (get-descriptor-for input cookie :direction :input
+                                  :if-does-not-exist if-input-does-not-exist)
+            (multiple-value-bind
+                  (stdout output-stream)
+                (get-descriptor-for output cookie :direction :output
+                                    :if-exists if-output-exists)
+              (multiple-value-bind
+                    (stderr error-stream)
+                  (if (eq error :output)
+                      (values stdout output-stream)
+                      (get-descriptor-for error cookie :direction :output
+                                          :if-exists if-error-exists))
+                (multiple-value-bind (pty-name pty-stream)
+                    (open-pty pty cookie)
+                  ;; Make sure we are not notified about the child
+                  ;; death before we have installed the PROCESS
+                  ;; structure in *ACTIVE-PROCESSES*.
+                  (sb-sys:without-interrupts
                    (with-c-strvec (argv args)
                      (with-c-strvec
                    (with-c-strvec (argv args)
                      (with-c-strvec
-                         (envp (mapcar (lambda (entry)
-                                         (concatenate
-                                          'string
-                                          (symbol-name (car entry))
-                                          "="
-                                          (cdr entry)))
+                         (envp (mapcar #'(lambda (entry)
+                                           (concatenate
+                                            'string
+                                            (symbol-name (car entry))
+                                            "="
+                                            (cdr entry)))
                                        env))
                        (let ((child-pid
                               (without-gcing
                                (spawn pfile argv envp pty-name
                                       stdin stdout stderr))))
                          (when (< child-pid 0)
                                        env))
                        (let ((child-pid
                               (without-gcing
                                (spawn pfile argv envp pty-name
                                       stdin stdout stderr))))
                          (when (< child-pid 0)
-                           (error "could not fork child process: ~A"
-                                  (unix:get-unix-error-msg)))
+                           (error "could not fork child process: ~S"
+                                  (sb-unix:get-unix-error-msg)))
                          (setf proc (make-process :pid child-pid
                                                   :%status :running
                                                   :pty pty-stream
                          (setf proc (make-process :pid child-pid
                                                   :%status :running
                                                   :pty pty-stream
@@ -501,68 +487,79 @@ work on SBCL. At the very least:
                                                   :error error-stream
                                                   :status-hook status-hook
                                                   :cookie cookie))
                                                   :error error-stream
                                                   :status-hook status-hook
                                                   :cookie cookie))
-                            (push proc *active-processes*))))))))))
+                         (push proc *active-processes*))))))))))
       (dolist (fd *close-in-parent*)
       (dolist (fd *close-in-parent*)
-       (unix:unix-close fd))
+       (sb-unix:unix-close fd))
       (unless proc
        (dolist (fd *close-on-error*)
       (unless proc
        (dolist (fd *close-on-error*)
-         (unix:unix-close fd))
+         (sb-unix:unix-close fd))
        (dolist (handler *handlers-installed*)
        (dolist (handler *handlers-installed*)
-         (system:remove-fd-handler handler))))
+         (sb-sys:remove-fd-handler handler))))
     (when (and wait proc)
       (process-wait proc))
     proc))
 
     (when (and wait proc)
       (process-wait proc))
     proc))
 
-;;; Install a handler for any input that shows up on the file
-;;; descriptor. The handler reads the data and writes it to the stream.
+;;; COPY-DESCRIPTOR-TO-STREAM -- internal
+;;;
+;;;   Installs a handler for any input that shows up on the file descriptor.
+;;; The handler reads the data and writes it to the stream.
+;;; 
 (defun copy-descriptor-to-stream (descriptor stream cookie)
   (incf (car cookie))
   (let ((string (make-string 256))
        handler)
     (setf handler
 (defun copy-descriptor-to-stream (descriptor stream cookie)
   (incf (car cookie))
   (let ((string (make-string 256))
        handler)
     (setf handler
-         (system:add-fd-handler descriptor :input
-           #'(lambda (fd)
-               (declare (ignore fd))
-               (loop
-                 (unless handler
-                   (return))
-                 (multiple-value-bind
-                     (result readable/errno)
-                     (unix:unix-select (1+ descriptor) (ash 1 descriptor)
-                                       0 0 0)
-                   (cond ((null result)
-                          (error "could not select on sub-process: ~A"
-                                 (unix:get-unix-error-msg readable/errno)))
-                         ((zerop result)
-                          (return))))
-                 (alien:with-alien ((buf (alien:array c-call:char 256)))
-                   (multiple-value-bind
-                       (count errno)
-                       (unix:unix-read descriptor (alien-sap buf) 256)
-                     (cond ((or (and (null count)
-                                     (eql errno unix:eio))
-                                (eql count 0))
-                            (system:remove-fd-handler handler)
-                            (setf handler nil)
-                            (decf (car cookie))
-                            (unix:unix-close descriptor)
-                            (return))
-                           ((null count)
-                            (system:remove-fd-handler handler)
-                            (setf handler nil)
-                            (decf (car cookie))
-                            (error "could not read input from sub-process: ~A"
-                                   (unix:get-unix-error-msg errno)))
-                           (t
-                            (kernel:copy-from-system-area
-                             (alien-sap buf) 0
-                             string (* vm:vector-data-offset vm:word-bits)
-                             (* count vm:byte-bits))
-                            (write-string string stream
-                                          :end count)))))))))))
+         (sb-sys:add-fd-handler
+          descriptor
+          :input #'(lambda (fd)
+                     (declare (ignore fd))
+                     (loop
+                         (unless handler
+                           (return))
+                         (multiple-value-bind
+                               (result readable/errno)
+                             (sb-unix:unix-select (1+ descriptor)
+                                                  (ash 1 descriptor)
+                                                  0 0 0)
+                           (cond ((null result)
+                                  (error "could not select on sub-process: ~S"
+                                         (sb-unix:get-unix-error-msg
+                                          readable/errno)))
+                                 ((zerop result)
+                                  (return))))
+                       (sb-alien:with-alien ((buf (sb-alien:array
+                                                   sb-c-call:char
+                                                   256)))
+                         (multiple-value-bind
+                               (count errno)
+                             (sb-unix:unix-read descriptor
+                                                (alien-sap buf)
+                                                256)
+                           (cond ((or (and (null count)
+                                           (eql errno sb-unix:eio))
+                                      (eql count 0))
+                                  (sb-sys:remove-fd-handler handler)
+                                  (setf handler nil)
+                                  (decf (car cookie))
+                                  (sb-unix:unix-close descriptor)
+                                  (return))
+                                 ((null count)
+                                  (sb-sys:remove-fd-handler handler)
+                                  (setf handler nil)
+                                  (decf (car cookie))
+                                  (error "could not read input from sub-process: ~S"
+                                         (sb-unix:get-unix-error-msg errno)))
+                                 (t
+                                  (sb-kernel:copy-from-system-area
+                                   (alien-sap buf) 0
+                                   string (* sb-vm:vector-data-offset
+                                             sb-vm:word-bits)
+                                   (* count sb-vm:byte-bits))
+                                  (write-string string stream
+                                                :end count)))))))))))
 
 ;;; Find a file descriptor to use for object given the direction.
 
 ;;; Find a file descriptor to use for object given the direction.
-;;; Return the descriptor. If object is :STREAM, return the created
+;;; Returns the descriptor. If object is :STREAM, returns the created
 ;;; stream as the second value.
 (defun get-descriptor-for (object
                           cookie
 ;;; stream as the second value.
 (defun get-descriptor-for (object
                           cookie
@@ -575,88 +572,90 @@ work on SBCL. At the very least:
        ((eq object nil)
         ;; Use /dev/null.
         (multiple-value-bind
        ((eq object nil)
         ;; Use /dev/null.
         (multiple-value-bind
-            (fd errno)
-            (unix:unix-open "/dev/null"
-                            (case direction
-                              (:input unix:o_rdonly)
-                              (:output unix:o_wronly)
-                              (t unix:o_rdwr))
-                            #o666)
+              (fd errno)
+            (sb-unix:unix-open "/dev/null"
+                               (case direction
+                                 (:input sb-unix:o_rdonly)
+                                 (:output sb-unix:o_wronly)
+                                 (t sb-unix:o_rdwr))
+                               #o666)
           (unless fd
           (unless fd
-            (error "could not open \"/dev/null\": ~A"
-                   (unix:get-unix-error-msg errno)))
+            (error "could not open \"/dev/null\": ~S"
+                   (sb-unix:get-unix-error-msg errno)))
           (push fd *close-in-parent*)
           (values fd nil)))
        ((eq object :stream)
         (multiple-value-bind
           (push fd *close-in-parent*)
           (values fd nil)))
        ((eq object :stream)
         (multiple-value-bind
-            (read-fd write-fd)
-            (unix:unix-pipe)
+              (read-fd write-fd)
+            (sb-unix:unix-pipe)
           (unless read-fd
           (unless read-fd
-            (error "could not create pipe: ~A"
-                   (unix:get-unix-error-msg write-fd)))
+            (error "could not create pipe: ~S"
+                   (sb-unix:get-unix-error-msg write-fd)))
           (case direction
             (:input
              (push read-fd *close-in-parent*)
              (push write-fd *close-on-error*)
           (case direction
             (:input
              (push read-fd *close-in-parent*)
              (push write-fd *close-on-error*)
-             (let ((stream (system:make-fd-stream write-fd :output t)))
+             (let ((stream (sb-sys:make-fd-stream write-fd :output t)))
                (values read-fd stream)))
             (:output
              (push read-fd *close-on-error*)
              (push write-fd *close-in-parent*)
                (values read-fd stream)))
             (:output
              (push read-fd *close-on-error*)
              (push write-fd *close-in-parent*)
-             (let ((stream (system:make-fd-stream read-fd :input t)))
+             (let ((stream (sb-sys:make-fd-stream read-fd :input t)))
                (values write-fd stream)))
             (t
                (values write-fd stream)))
             (t
-             (unix:unix-close read-fd)
-             (unix:unix-close write-fd)
-             (error "direction must be either :INPUT or :OUTPUT, not ~S"
+             (sb-unix:unix-close read-fd)
+             (sb-unix:unix-close write-fd)
+             (error "Direction must be either :INPUT or :OUTPUT, not ~S."
                     direction)))))
        ((or (pathnamep object) (stringp object))
         (with-open-stream (file (apply #'open object keys))
           (multiple-value-bind
                     direction)))))
        ((or (pathnamep object) (stringp object))
         (with-open-stream (file (apply #'open object keys))
           (multiple-value-bind
-              (fd errno)
-              (unix:unix-dup (system:fd-stream-fd file))
+                (fd errno)
+              (sb-unix:unix-dup (sb-sys:fd-stream-fd file))
             (cond (fd
                    (push fd *close-in-parent*)
                    (values fd nil))
                   (t
             (cond (fd
                    (push fd *close-in-parent*)
                    (values fd nil))
                   (t
-                   (error "could not duplicate file descriptor: ~A"
-                          (unix:get-unix-error-msg errno)))))))
-       ((system:fd-stream-p object)
-        (values (system:fd-stream-fd object) nil))
+                   (error "could not duplicate file descriptor: ~S"
+                          (sb-unix:get-unix-error-msg errno)))))))
+       ((sb-sys:fd-stream-p object)
+        (values (sb-sys:fd-stream-fd object) nil))
        ((streamp object)
         (ecase direction
           (:input
        ((streamp object)
         (ecase direction
           (:input
+           ;; FIXME: We could use a better way of setting up
+           ;; temporary files, both here and in LOAD-FOREIGN.
            (dotimes (count
            (dotimes (count
-                     256
+                      256
                      (error "could not open a temporary file in /tmp"))
              (let* ((name (format nil "/tmp/.run-program-~D" count))
                      (error "could not open a temporary file in /tmp"))
              (let* ((name (format nil "/tmp/.run-program-~D" count))
-                    (fd (unix:unix-open name
-                                        (logior unix:o_rdwr
-                                                unix:o_creat
-                                                unix:o_excl)
-                                        #o666)))
-               (unix:unix-unlink name)
+                    (fd (sb-unix:unix-open name
+                                           (logior sb-unix:o_rdwr
+                                                   sb-unix:o_creat
+                                                   sb-unix:o_excl)
+                                           #o666)))
+               (sb-unix:unix-unlink name)
                (when fd
                  (let ((newline (string #\Newline)))
                    (loop
                (when fd
                  (let ((newline (string #\Newline)))
                    (loop
-                     (multiple-value-bind
-                         (line no-cr)
-                         (read-line object nil nil)
-                       (unless line
-                         (return))
-                       (unix:unix-write fd line 0 (length line))
-                       (if no-cr
-                         (return)
-                         (unix:unix-write fd newline 0 1)))))
-                 (unix:unix-lseek fd 0 unix:l_set)
+                       (multiple-value-bind
+                             (line no-cr)
+                           (read-line object nil nil)
+                         (unless line
+                           (return))
+                         (sb-unix:unix-write fd line 0 (length line))
+                         (if no-cr
+                             (return)
+                             (sb-unix:unix-write fd newline 0 1)))))
+                 (sb-unix:unix-lseek fd 0 sb-unix:l_set)
                  (push fd *close-in-parent*)
                  (return (values fd nil))))))
           (:output
            (multiple-value-bind (read-fd write-fd)
                  (push fd *close-in-parent*)
                  (return (values fd nil))))))
           (:output
            (multiple-value-bind (read-fd write-fd)
-                                (unix:unix-pipe)
+               (sb-unix:unix-pipe)
              (unless read-fd
              (unless read-fd
-               (error "could not create pipe: ~A"
-                      (unix:get-unix-error-msg write-fd)))
+               (error "could not create pipe: ~S"
+                      (sb-unix:get-unix-error-msg write-fd)))
              (copy-descriptor-to-stream read-fd object cookie)
              (push read-fd *close-on-error*)
              (push write-fd *close-in-parent*)
              (copy-descriptor-to-stream read-fd object cookie)
              (push read-fd *close-on-error*)
              (push write-fd *close-in-parent*)
index ddfb683..8f8a1f0 100644 (file)
       (gethash (concatenate 'simple-string
                            #!+linux "ldso_stub__"
                            #!+openbsd "_"
       (gethash (concatenate 'simple-string
                            #!+linux "ldso_stub__"
                            #!+openbsd "_"
-                           #!+freebsd ""
+                           #!+freebsd "ldso_stub__"
                            foreign-symbol)
               *static-foreign-symbols*)
       (sb!sys:get-dynamic-foreign-symbol-address foreign-symbol)
                            foreign-symbol)
               *static-foreign-symbols*)
       (sb!sys:get-dynamic-foreign-symbol-address foreign-symbol)
index 31dbe9d..42e1a58 100644 (file)
@@ -54,7 +54,9 @@
 
 (defvar *random-state*)
 (defun !random-cold-init ()
 
 (defvar *random-state*)
 (defun !random-cold-init ()
-  (setf *random-state* (%make-random-state)))
+  (/show0 "entering !RANDOM-COLD-INIT")
+  (setf *random-state* (%make-random-state))
+  (/show0 "returning from !RANDOM-COLD-INIT"))
 
 (defun make-random-state (&optional state)
   #!+sb-doc
 
 (defun make-random-state (&optional state)
   #!+sb-doc
index 477c728..ce25a36 100644 (file)
            (tm-gmtoff long)    ;  Seconds east of UTC.
            (tm-zone c-string)))        ; Timezone abbreviation.
 
            (tm-gmtoff long)    ;  Seconds east of UTC.
            (tm-zone c-string)))        ; Timezone abbreviation.
 
-(def-alien-variable ("tzname" unix-tzname) (array c-string 2))
-
 (def-alien-routine get-timezone sb!c-call:void
   (when sb!c-call:long :in)
   (minutes-west sb!c-call:int :out)
 (def-alien-routine get-timezone sb!c-call:void
   (when sb!c-call:long :in)
   (minutes-west sb!c-call:int :out)
   (multiple-value-bind (ignore minutes dst) (get-timezone secs)
     (declare (ignore ignore) (ignore minutes))
     (values (deref unix-tzname (if dst 1 0)))))
   (multiple-value-bind (ignore minutes dst) (get-timezone secs)
     (declare (ignore ignore) (ignore minutes))
     (values (deref unix-tzname (if dst 1 0)))))
+
 \f
 ;;;; sys/time.h
 
 \f
 ;;;; sys/time.h
 
 (def-unix-error ENOENT 2 "No such file or directory")
 #|
 (def-unix-error ESRCH 3 "No such process")
 (def-unix-error ENOENT 2 "No such file or directory")
 #|
 (def-unix-error ESRCH 3 "No such process")
+|#
 (def-unix-error EINTR 4 "Interrupted system call")
 (def-unix-error EINTR 4 "Interrupted system call")
+#|
 (def-unix-error EIO 5 "I/O error")
 (def-unix-error ENXIO 6 "No such device or address")
 (def-unix-error E2BIG 7 "Arg list too long")
 (def-unix-error EIO 5 "I/O error")
 (def-unix-error ENXIO 6 "No such device or address")
 (def-unix-error E2BIG 7 "Arg list too long")
index de0abbc..8efbc69 100644 (file)
                "src/code/inspect" ; FIXME: should be byte compiled
                "src/code/profile"
                "src/code/ntrace"
                "src/code/inspect" ; FIXME: should be byte compiled
                "src/code/profile"
                "src/code/ntrace"
-               #+nil "src/code/run-program" ; not working as of 0.6.7
                "src/code/foreign"
                "src/code/foreign"
+               "src/code/run-program"
                ;; Code derived from PCL's pre-ANSI DESCRIBE-OBJECT
                ;; facility is still used in our ANSI DESCRIBE
                ;; facility, and should be compiled and loaded after
                ;; Code derived from PCL's pre-ANSI DESCRIBE-OBJECT
                ;; facility is still used in our ANSI DESCRIBE
                ;; facility, and should be compiled and loaded after
index 06015e4..566ba54 100644 (file)
                    ;; ..and the fifth seems to match most
                    ;; actual symbols, at least in RedHat 6.2.
                    "")
                    ;; ..and the fifth seems to match most
                    ;; actual symbols, at least in RedHat 6.2.
                    "")
-        #!+freebsd #("")
+        #!+freebsd #("" "ldso_stub__")
         #!+openbsd #("_")))
     (or (some (lambda (prefix)
                (gethash (concatenate 'string prefix name)
         #!+openbsd #("_")))
     (or (some (lambda (prefix)
                (gethash (concatenate 'string prefix name)
index a158013..9245d14 100644 (file)
@@ -28,6 +28,7 @@
   "$Header$")
 
 (!begin-collecting-cold-init-forms)
   "$Header$")
 
 (!begin-collecting-cold-init-forms)
+#!+sb-show (!cold-init-forms (/show0 "early in globaldb.lisp cold init"))
 
 ;;; The DEFVAR for this appears later.
 ;;; FIXME: centralize
 
 ;;; The DEFVAR for this appears later.
 ;;; FIXME: centralize
index bf89e76..29b4dfe 100644 (file)
 ;;;
 ;;; FIXME: Couldn't/shouldn't these be DEFCONSTANT instead of DEFPARAMETER?
 #!-linux (defparameter *target-read-only-space-start* #x10000000)
 ;;;
 ;;; FIXME: Couldn't/shouldn't these be DEFCONSTANT instead of DEFPARAMETER?
 #!-linux (defparameter *target-read-only-space-start* #x10000000)
-#!-linux (defparameter *target-static-space-start*    #x28000000)
+#!-linux (defparameter *target-static-space-start*
+                       ;; FIXME: was #x28000000 until RAW's RUN-PROGRAM
+                       ;; patches, why the change?
+                       #x30000000)
 #!-linux (defparameter *target-dynamic-space-start*   #x48000000)
 #!+linux (defparameter *target-read-only-space-start* #x01000000)
 #!+linux (defparameter *target-static-space-start*    #x05000000)
 #!+linux (defparameter *target-dynamic-space-start*   #x09000000)
 
 #!-linux (defparameter *target-dynamic-space-start*   #x48000000)
 #!+linux (defparameter *target-read-only-space-start* #x01000000)
 #!+linux (defparameter *target-static-space-start*    #x05000000)
 #!+linux (defparameter *target-dynamic-space-start*   #x09000000)
 
-;;; Given that NIL is the first things allocated in static space, we
+;;; Given that NIL is the first thing allocated in static space, we
 ;;; know its value at compile time:
 ;;; know its value at compile time:
-;;;
-;;; FIXME: Couldn't/shouldn't this be a DEFCONSTANT, and shouldn't it be
-;;; calculated from TARGET-STATIC-SPACE-START instead of assigned
-;;; separately?
-#!-linux (defparameter *nil-value* #x2800000B)
-#!+linux (defparameter *nil-value* #x0500000B)
+(defparameter *nil-value* (+ *target-static-space-start* #xb))
 \f
 ;;;; other miscellaneous constants
 
 \f
 ;;;; other miscellaneous constants
 
index ac627fc..58301b5 100644 (file)
     (:documentation "the base class for all CLOS streams")))
 
 ;;; Define the stream classes.
     (:documentation "the base class for all CLOS streams")))
 
 ;;; Define the stream classes.
-(defclass fundamental-input-stream (fundamental-stream))
+(defclass fundamental-input-stream (fundamental-stream) nil)
 
 
-(defclass fundamental-output-stream (fundamental-stream))
+(defclass fundamental-output-stream (fundamental-stream) nil)
 
 
-(defclass fundamental-character-stream (fundamental-stream))
+(defclass fundamental-character-stream (fundamental-stream) nil)
 
 
-(defclass fundamental-binary-stream (fundamental-stream))
+(defclass fundamental-binary-stream (fundamental-stream) nil)
 
 (defclass fundamental-character-input-stream
 
 (defclass fundamental-character-input-stream
-    (fundamental-input-stream fundamental-character-stream))
+    (fundamental-input-stream fundamental-character-stream) nil)
 
 (defclass fundamental-character-output-stream
 
 (defclass fundamental-character-output-stream
-    (fundamental-output-stream fundamental-character-stream))
+    (fundamental-output-stream fundamental-character-stream) nil)
 
 (defclass fundamental-binary-input-stream
 
 (defclass fundamental-binary-input-stream
-    (fundamental-input-stream fundamental-binary-stream))
+    (fundamental-input-stream fundamental-binary-stream) nil)
 
 (defclass fundamental-binary-output-stream
 
 (defclass fundamental-binary-output-stream
-    (fundamental-output-stream fundamental-binary-stream))
+    (fundamental-output-stream fundamental-binary-stream) nil)
 \f
 ;;; example character input and output streams
 
 \f
 ;;; example character input and output streams
 
index f34ebbb..f279a72 100644 (file)
@@ -36,7 +36,7 @@
   called on the stream."))
 
 (defmethod pcl-open-stream-p ((stream lisp-stream))
   called on the stream."))
 
 (defmethod pcl-open-stream-p ((stream lisp-stream))
-  (not (eq (lisp-stream-in stream) #'closed-flame)))
+  (not (eq (sb-impl::lisp-stream-in stream) #'sb-impl::closed-flame)))
 
 (defmethod pcl-open-stream-p ((stream fundamental-stream))
   nil)
 
 (defmethod pcl-open-stream-p ((stream fundamental-stream))
   nil)
@@ -66,8 +66,8 @@
   (:documentation "Returns non-nil if the given Stream can perform input operations."))
 
 (defmethod input-stream-p ((stream lisp-stream))
   (:documentation "Returns non-nil if the given Stream can perform input operations."))
 
 (defmethod input-stream-p ((stream lisp-stream))
-  (and (not (eq (lisp-stream-in stream) #'closed-flame))
-       (or (not (eq (lisp-stream-in stream) #'ill-in))
+  (and (not (eq (sb-impl::lisp-stream-in stream) #'sb-impl::closed-flame))
+       (or (not (eq (sb-impl::lisp-stream-in stream) #'ill-in))
           (not (eq (lisp-stream-bin stream) #'ill-bin)))))
 
 (defmethod input-stream-p ((stream fundamental-input-stream))
           (not (eq (lisp-stream-bin stream) #'ill-bin)))))
 
 (defmethod input-stream-p ((stream fundamental-input-stream))
@@ -80,7 +80,7 @@
   (:documentation "Returns non-nil if the given Stream can perform output operations."))
 
 (defmethod output-stream-p ((stream lisp-stream))
   (:documentation "Returns non-nil if the given Stream can perform output operations."))
 
 (defmethod output-stream-p ((stream lisp-stream))
-  (and (not (eq (lisp-stream-in stream) #'closed-flame))
+  (and (not (eq (sb-impl::lisp-stream-in stream) #'sb-impl::closed-flame))
        (or (not (eq (lisp-stream-out stream) #'ill-out))
           (not (eq (lisp-stream-bout stream) #'ill-bout)))))
 
        (or (not (eq (lisp-stream-out stream) #'ill-out))
           (not (eq (lisp-stream-bout stream) #'ill-bout)))))
 
index 170aab8..49d74b6 100644 (file)
@@ -12,7 +12,11 @@ ASSEM_SRC = x86-assem.S
 ARCH_SRC = x86-arch.c
 
 OS_SRC = bsd-os.c os-common.c undefineds.c
 ARCH_SRC = x86-arch.c
 
 OS_SRC = bsd-os.c os-common.c undefineds.c
-OS_LINK_FLAGS=-static
+# Until version 0.6.7.3, we used "OS_LINK_FLAGS=-static" here, which
+# worked fine for most things, but LOAD-FOREIGN & friends require
+# dlopen() etc., which in turn depend on dynamic linking of the
+# runtime.
+OS_LINK_FLAGS=-dynamic -export-dynamic
 OS_LIBS=-lm # -ldl
 
 GC_SRC= gencgc.c
 OS_LIBS=-lm # -ldl
 
 GC_SRC= gencgc.c
index dbdef41..a8c4e79 100644 (file)
@@ -25,7 +25,7 @@ include Config
 SRCS = alloc.c backtrace.c breakpoint.c coreparse.c \
        dynbind.c globals.c interr.c interrupt.c \
        monitor.c parse.c print.c purify.c \
 SRCS = alloc.c backtrace.c breakpoint.c coreparse.c \
        dynbind.c globals.c interr.c interrupt.c \
        monitor.c parse.c print.c purify.c \
-       regnames.c runtime.c save.c search.c \
+       regnames.c runprog.c runtime.c save.c search.c \
        time.c validate.c vars.c \
        ${ARCH_SRC} ${ASSEM_SRC} ${OS_SRC} ${GC_SRC}
 
        time.c validate.c vars.c \
        ${ARCH_SRC} ${ASSEM_SRC} ${OS_SRC} ${GC_SRC}
 
index 1560173..44b5a05 100644 (file)
@@ -1,5 +1,5 @@
 /*
 /*
- * OS-dependent routines for FreeBSD (and could maybe be extended to all BSD?)
+ * OS-dependent routines for BSD-ish systems
  *
  * This file (along with os.h) exports an OS-independent interface to
  * the operating system VM facilities. This interface looks a lot like
  *
  * This file (along with os.h) exports an OS-independent interface to
  * the operating system VM facilities. This interface looks a lot like
@@ -245,3 +245,271 @@ os_install_interrupt_handlers(void)
 }
 
 #endif /* !defined GENCGC */
 }
 
 #endif /* !defined GENCGC */
+
+/* feh!
+ *
+ * DL_WORKAROUND enables "stubbing" of various functions from libc et
+ * al. This is necessary when using dynamic linking in FreeBSD, as the
+ * symbols in the dynamic libraries will not have known addresses (in
+ * sbcl.nm).
+ *
+ * FIXME: This flag should be set in Config.bsd */
+#define DL_WORKAROUND 1
+
+#if DL_WORKAROUND
+#include <unistd.h>
+#include <dlfcn.h>
+#include <math.h>
+#include <sys/types.h>
+#include <dirent.h>
+#include <stdlib.h>
+#include <sys/stat.h>
+#include <time.h>
+#include <sys/resource.h>
+#include <signal.h>
+#include <fcntl.h>
+
+void *ldso_stub__dlopen(const char *path, int mode)
+{
+  return dlopen(path, mode);
+}
+
+void *ldso_stub__dlsym(void *handle, const char *symbol)
+{
+  return dlsym(handle, symbol);
+}
+
+const char *ldso_stub__dlerror(void)
+{
+  return dlerror();
+}
+int ldso_stub__access(const char *path, int mode)
+{
+  return access(path, mode);
+}
+
+double ldso_stub__acos(double x)
+{
+  return acos(x);
+}
+
+double ldso_stub__acosh(double x)
+{
+  return acosh(x);
+}
+
+double ldso_stub__asin(double x)
+{
+  return asin(x);
+}
+
+double ldso_stub__asinh(double x)
+{
+  return asin(x);
+}
+
+double ldso_stub__atanh(double x)
+{
+  return atanh(x);
+}
+
+
+int ldso_stub__chdir(const char *path)
+{
+  return chdir(path);
+}
+
+int ldso_stub__close(int d)
+{
+  return close(d);
+}
+
+int ldso_stub__closedir(DIR *dirp)
+{
+  return closedir(dirp);
+}
+
+double ldso_stub__cosh(double x)
+{
+  return cosh(x);
+}
+
+void ldso_stub__exit(int status)
+{
+  exit(status);
+}
+
+void ldso_stub__free(void *ptr)
+{
+  free(ptr);
+}
+
+int ldso_stub__fstat(int fd, struct stat *sb)
+{
+  return fstat(fd, sb);
+}
+
+int ldso_stub__fsync(int fd)
+{
+  return fsync(fd);
+}
+
+char *ldso_stub__getenv(const char *name)
+{
+  return getenv(name);
+}
+
+int ldso_stub__gethostname(char *name, int namelen)
+{
+  return gethostname(name, namelen);
+}
+
+pid_t ldso_stub__getpid(void)
+{
+  return getpid();
+}
+
+int ldso_stub__getrusage(int who, struct rusage *rusage)
+{
+  return getrusage(who, rusage);
+}
+
+int ldso_stub__gettimeofday(struct timeval *tp, struct timezone *tzp)
+{
+  return gettimeofday(tp, tzp);
+}
+
+uid_t ldso_stub__getuid(void)
+{
+  return getuid();
+}
+
+char *ldso_stub__getwd(char *buf)
+{
+  return getwd(buf);
+}
+
+double ldso_stub__hypot(double x, double y)
+{
+  return hypot(x, y);
+}
+
+int ldso_stub__kill(pid_t pid, int sig)
+{
+  return kill(pid, sig);
+}
+
+int ldso_stub__killpg(pid_t pgrp, int sig)
+{
+  return killpg(pgrp, sig);
+}
+
+off_t ldso_stub__lseek(int fildes, off_t offset, int whence)
+{
+  return lseek(fildes, offset, whence);
+}
+
+int ldso_stub__lstat(const char *path, struct stat *sb)
+{
+  return lstat(path, sb);
+}
+
+void *ldso_stub__malloc(size_t size)
+{
+  return malloc(size);
+}
+
+int ldso_stub__mkdir(const char *path, mode_t mode)
+{
+  return mkdir(path, mode);
+}
+
+int ldso_stub__open(const char *path, int flags, mode_t mode)
+{
+  return open(path, flags, mode);
+}
+
+DIR *ldso_stub__opendir(const char *filename)
+{
+  return opendir(filename);
+}
+
+double ldso_stub__pow(double x, double y)
+{
+  return pow(x, y);
+}
+
+ssize_t ldso_stub__read(int d, void *buf, size_t nbytes)
+{
+  return read(d, buf, nbytes);
+}
+
+struct dirent *ldso_stub__readdir(DIR *dirp)
+{
+  return readdir(dirp);
+}
+
+int ldso_stub__readlink(const char *path, char *buf, int bufsiz)
+{
+  return readlink(path, buf, bufsiz);
+}
+
+int ldso_stub__rename(const char *from, const char *to)
+{
+  return rename(from, to);
+}
+
+int ldso_stub__select(int nfds, fd_set *readfs, fd_set *writefds, 
+                     fd_set *exceptfds, struct timeval *timeout)
+{
+  return select(nfds, readfs, writefds, exceptfds, timeout);
+}
+
+int ldso_stub__sigblock(int mask)
+{
+  return sigblock(mask);
+}
+
+int ldso_stub__sigpause(int sigmask)
+{
+  return sigpause(sigmask);
+}
+
+int ldso_stub__sigsetmask(int mask)
+{
+  return sigsetmask(mask);
+}
+
+double ldso_stub__sinh(double x)
+{
+  return sin(x);
+}
+
+int ldso_stub__stat(const char *path, struct stat *sb)
+{
+  return stat(path, sb);
+}
+
+double ldso_stub__tanh(double x)
+{
+  return tanh(x);
+}
+
+/* tzname */
+
+int ldso_stub__unlink(const char *path)
+{
+  return unlink(path);
+}
+
+ssize_t ldso_stub__write(int d, const void *buf, size_t nbytes)
+{
+  return write(d, buf, nbytes);
+}
+
+pid_t ldso_stub__wait3(int *status, int options, struct rusage *rusage)
+{
+  return wait3(status, options, rusage);
+}
+
+#endif /* DL_WORKAROUND */
index 0826b59..acbf329 100644 (file)
@@ -257,12 +257,14 @@ F(gethostbyname)
 F(gethostbyaddr)
 
 /* Other miscellaneous things. */
 F(gethostbyaddr)
 
 /* Other miscellaneous things. */
-#if defined(SVR4)
+#if defined(SVR4) || defined(__FreeBSD__)
 F(setpgid)
 F(getpgid)
 D(timezone)
 F(setpgid)
 F(getpgid)
 D(timezone)
+#if !defined(__FreeBSD__)
 D(altzone)
 D(daylight)
 D(altzone)
 D(daylight)
+#endif
 D(tzname)
 F(dlopen)
 F(dlsym)
 D(tzname)
 F(dlopen)
 F(dlsym)
index f9fcde2..2fdf41e 100644 (file)
  */
 \f
 /*
  */
 \f
 /*
- * Address map:
+ * address map:
  *
  *  FreeBSD:
  *     0x00000000->0x0E000000 224M C program and memory allocation.
  *     0x0E000000->0x10000000  32M Foreign segment.
  *     0x10000000->0x20000000 256M Read-Only Space.
  *
  *  FreeBSD:
  *     0x00000000->0x0E000000 224M C program and memory allocation.
  *     0x0E000000->0x10000000  32M Foreign segment.
  *     0x10000000->0x20000000 256M Read-Only Space.
- *     0x20000000->0x28000000 128M Reserved for shared libraries.
- *     0x28000000->0x38000000 256M Static Space.
+ *     0x20000000->0x30000000 256M Reserved for shared libraries.
+ *     0x30000000->0x38000000 128M Static Space.
  *     0x38000000->0x40000000 128M Binding stack growing up.
  *     0x40000000->0x48000000 128M Control stack growing down.
  *     0x48000000->0xC8000000 2GB  Dynamic Space.
  *     0x38000000->0x40000000 128M Binding stack growing up.
  *     0x40000000->0x48000000 128M Control stack growing down.
  *     0x48000000->0xC8000000 2GB  Dynamic Space.
  *
  * FIXME: There's something wrong with addressing maps which are so
  * brittle that they can be commented as fixed addresses. Try to
  *
  * FIXME: There's something wrong with addressing maps which are so
  * brittle that they can be commented as fixed addresses. Try to
- * parameterize these so they can be set at build time. */
+ * parameterize these so they can be set at build time.
+ */
 
 #if defined(__FreeBSD__) || defined(__OpenBSD__)
 #define READ_ONLY_SPACE_START   (0x10000000)
 #define READ_ONLY_SPACE_SIZE    (0x0ffff000) /* 256MB - 1 page */
 
 
 #if defined(__FreeBSD__) || defined(__OpenBSD__)
 #define READ_ONLY_SPACE_START   (0x10000000)
 #define READ_ONLY_SPACE_SIZE    (0x0ffff000) /* 256MB - 1 page */
 
-#define STATIC_SPACE_START     (0x28000000)
-#define STATIC_SPACE_SIZE      (0x0ffff000) /* 256MB - 1 page */
+#define STATIC_SPACE_START     (0x30000000)
+#define STATIC_SPACE_SIZE      (0x07fff000) /* 128M - 1 page */
 
 #define BINDING_STACK_START    (0x38000000)
 #define BINDING_STACK_SIZE     (0x07fff000) /* 128MB - 1 page */
 
 #define BINDING_STACK_START    (0x38000000)
 #define BINDING_STACK_SIZE     (0x07fff000) /* 128MB - 1 page */
index 90f18f6..7205a7a 100644 (file)
@@ -15,4 +15,4 @@
 ;;; versions, and a string a la "0.6.5.12" is used for versions which
 ;;; aren't released but correspond only to CVS tags or snapshots.
 
 ;;; versions, and a string a la "0.6.5.12" is used for versions which
 ;;; aren't released but correspond only to CVS tags or snapshots.
 
-"0.6.7.3"
+"0.6.7.4"