Better support for NetBSD/current
authorChristophe Rhodes <csr21@cantab.net>
Thu, 22 Aug 2013 12:39:10 +0000 (13:39 +0100)
committerChristophe Rhodes <csr21@cantab.net>
Thu, 22 Aug 2013 12:39:10 +0000 (13:39 +0100)
Wrap more syscalls to defend against linker rewriting (patch from Robert
Swindells sbcl-devel 2013-07-12, encouragement from NetBSD users on #sbcl
IRC).

NEWS
src/code/unix.lisp
src/runtime/wrap.c

diff --git a/NEWS b/NEWS
index 793d4a0..5b6ac81 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -4,21 +4,21 @@ changes relative to sbcl-1.1.10
     (lp#1189146)
   * enhancement: Windows builds no longer display the "Kitten of Death" message.
     A warning is instead appended to the regular banner, and may be muted with
-    --noinform.
+    --noinform.  (lp#728247)
+  * enhancement: support building under new linker handling of syscalls under
+    NetBSD.  (thanks to Robert Swindells)
   * bug fix: undefined function errors are now properly reported on PPC and MIPS.
     (regression since 1.1.9)
   * bug fix: (funcall (function X junk)) didn't causes an error when X had a
-    compiler macro.
-    Patch by Douglas Katzman.
+    compiler macro.  (thanks to Douglas Katzman).
   * bug fix: signal a warning when defining a setf-function when a
-    setf-expander is already present.
-    Patch by Douglas Katzman.
-  * bug fix: improved threading on PPC.
-  * bug fix: ROOM works again on Windows.
+    setf-expander is already present.  (thanks to Douglas Katzman).
+  * bug fix: improved threading on PPC.  
+  * bug fix: ROOM works again on Windows.  (lp#1206456)
   * bug fix: Streams were flushed even when there was one byte still left in
     the buffer. (lp#910213)
   * bug fix: OPEN handles correctly when :if-exists and :if-does-not-exist are
-    either NIL or :ERROR.
+    either NIL or :ERROR.  (reported by Jan Moringen)
 
 changes in sbcl-1.1.10 relative to sbcl-1.1.9:
   * enhancement: ASDF has been updated to 3.0.2.
index 0856069..1f0f562 100644 (file)
@@ -537,10 +537,10 @@ avoiding atexit(3) hooks, etc. Otherwise exit(2) is called."
 #!-win32
 (defun unix-fast-getrusage (who)
   (declare (values (member t)
-                   (unsigned-byte 31) (integer 0 1000000)
-                   (unsigned-byte 31) (integer 0 1000000)))
+                   unsigned-byte fixnum
+                   unsigned-byte fixnum))
   (with-alien ((usage (struct rusage)))
-    (syscall* ("getrusage" int (* (struct rusage)))
+    (syscall* ("sb_getrusage" int (* (struct rusage)))
               (values t
                       (slot (slot usage 'ru-utime) 'tv-sec)
                       (slot (slot usage 'ru-utime) 'tv-usec)
@@ -556,7 +556,7 @@ avoiding atexit(3) hooks, etc. Otherwise exit(2) is called."
 #!-win32
 (defun unix-getrusage (who)
   (with-alien ((usage (struct rusage)))
-    (syscall ("getrusage" int (* (struct rusage)))
+    (syscall ("sb_getrusage" int (* (struct rusage)))
               (values t
                       (+ (* (slot (slot usage 'ru-utime) 'tv-sec) 1000000)
                          (slot (slot usage 'ru-utime) 'tv-usec))
@@ -654,7 +654,7 @@ avoiding atexit(3) hooks, etc. Otherwise exit(2) is called."
            (type (or null (unsigned-byte 31)) timeout-secs timeout-usecs))
   (with-fd-setsize (num-descriptors)
     (flet ((select (tv-sap)
-             (int-syscall ("select" int (* (struct fd-set)) (* (struct fd-set))
+             (int-syscall ("sb_select" int (* (struct fd-set)) (* (struct fd-set))
                                     (* (struct fd-set)) (* (struct timeval)))
                           num-descriptors read-fds write-fds exception-fds
                           tv-sap)))
@@ -719,7 +719,7 @@ avoiding atexit(3) hooks, etc. Otherwise exit(2) is called."
                    `(if (zerop ,lispvar)
                         (int-sap 0)
                         (alien-sap (addr ,alienvar)))))
-        (syscall ("select" int (* (struct fd-set)) (* (struct fd-set))
+        (syscall ("sb_select" int (* (struct fd-set)) (* (struct fd-set))
                            (* (struct fd-set)) (* (struct timeval)))
                  (values result
                          (fd-set-to-num nfds rdf)
@@ -938,7 +938,7 @@ avoiding atexit(3) hooks, etc. Otherwise exit(2) is called."
           (slot req 'tv-nsec) nsecs)
     (loop while (and (eql sb!unix:eintr
                           (nth-value 1
-                                     (int-syscall ("nanosleep" (* (struct timespec))
+                                     (int-syscall ("sb_nanosleep" (* (struct timespec))
                                                                (* (struct timespec)))
                                                   (addr req) (addr rem))))
                      ;; KLUDGE: On Darwin, if an interrupt cases nanosleep to
@@ -1001,14 +1001,14 @@ avoiding atexit(3) hooks, etc. Otherwise exit(2) is called."
    T, it-interval-secs, it-interval-usec, it-value-secs, it-value-usec."
   (declare (type (member :real :virtual :profile) which)
            (values t
-                   (unsigned-byte 29) (mod 1000000)
-                   (unsigned-byte 29) (mod 1000000)))
+                   unsigned-byte (mod 1000000)
+                   unsigned-byte (mod 1000000)))
   (let ((which (ecase which
                  (:real itimer-real)
                  (:virtual itimer-virtual)
                  (:profile itimer-prof))))
     (with-alien ((itv (struct itimerval)))
-      (syscall* ("getitimer" int (* (struct itimerval)))
+      (syscall* ("sb_getitimer" int (* (struct itimerval)))
                 (values t
                         (slot (slot itv 'it-interval) 'tv-sec)
                         (slot (slot itv 'it-interval) 'tv-usec)
@@ -1027,11 +1027,11 @@ avoiding atexit(3) hooks, etc. Otherwise exit(2) is called."
    unix-setitimer returns the old contents of the INTERVAL and VALUE
    slots as in unix-getitimer."
   (declare (type (member :real :virtual :profile) which)
-           (type (unsigned-byte 29) int-secs val-secs)
+           (type unsigned-byte int-secs val-secs)
            (type (integer 0 (1000000)) int-usec val-usec)
            (values t
-                   (unsigned-byte 29) (mod 1000000)
-                   (unsigned-byte 29) (mod 1000000)))
+                   unsigned-byte (mod 1000000)
+                   unsigned-byte (mod 1000000)))
   (let ((which (ecase which
                  (:real itimer-real)
                  (:virtual itimer-virtual)
@@ -1042,7 +1042,7 @@ avoiding atexit(3) hooks, etc. Otherwise exit(2) is called."
             (slot (slot itvn 'it-interval) 'tv-usec) int-usec
             (slot (slot itvn 'it-value   ) 'tv-sec ) val-secs
             (slot (slot itvn 'it-value   ) 'tv-usec) val-usec)
-      (syscall* ("setitimer" int (* (struct timeval))(* (struct timeval)))
+      (syscall* ("sb_setitimer" int (* (struct timeval))(* (struct timeval)))
                 (values t
                         (slot (slot itvo 'it-interval) 'tv-sec)
                         (slot (slot itvo 'it-interval) 'tv-usec)
@@ -1070,23 +1070,23 @@ avoiding atexit(3) hooks, etc. Otherwise exit(2) is called."
   (defun get-time-of-day ()
     "Return the number of seconds and microseconds since the beginning of
 the UNIX epoch (January 1st 1970.)"
-    #!+darwin
+    #!+(or darwin netbsd)
     (with-alien ((tv (struct timeval)))
       ;; CLH: FIXME! This seems to be a MacOS bug, but on x86-64/darwin,
       ;; gettimeofday occasionally fails. passing in a null pointer for the
       ;; timezone struct seems to work around the problem. NS notes: Darwin
       ;; manpage says the timezone is not used anymore in their implementation
       ;; at all.
-      (syscall* ("gettimeofday" (* (struct timeval))
+      (syscall* ("sb_gettimeofday" (* (struct timeval))
                                 (* (struct timezone)))
                 (values (slot tv 'tv-sec)
                         (slot tv 'tv-usec))
                 (addr tv)
                 nil))
-    #!-(and x86-64 darwin)
+    #!-(or darwin netbsd)
     (with-alien ((tv (struct timeval))
                  (tz (struct timezone)))
-      (syscall* ("gettimeofday" (* (struct timeval))
+      (syscall* ("sb_gettimeofday" (* (struct timeval))
                                 (* (struct timezone)))
                 (values (slot tv 'tv-sec)
                         (slot tv 'tv-usec))
@@ -1098,7 +1098,7 @@ the UNIX epoch (January 1st 1970.)"
 
   (defun system-real-time-values ()
     (multiple-value-bind (sec usec) (get-time-of-day)
-      (declare (type (unsigned-byte 32) sec usec))
+      (declare (type unsigned-byte sec) (type (unsigned-byte 31) usec))
       (values sec (truncate usec micro-seconds-per-internal-time-unit))))
 
   ;; There are two optimizations here that actually matter (on 32-bit
@@ -1123,7 +1123,7 @@ the UNIX epoch (January 1st 1970.)"
         (c-sec 0)
         (c-msec 0)
         (now 0))
-    (declare (type (unsigned-byte 32) e-sec c-sec)
+    (declare (type unsigned-byte e-sec c-sec)
              (type fixnum e-msec c-msec)
              (type unsigned-byte now))
     (defun reinit-internal-real-time ()
@@ -1159,12 +1159,12 @@ the UNIX epoch (January 1st 1970.)"
     (multiple-value-bind (ignore utime-sec utime-usec stime-sec stime-usec)
         (unix-fast-getrusage rusage_self)
       (declare (ignore ignore)
-               (type (unsigned-byte 31) utime-sec stime-sec)
+               (type unsigned-byte utime-sec stime-sec)
                ;; (Classic CMU CL had these (MOD 1000000) instead, but
                ;; at least in Linux 2.2.12, the type doesn't seem to
                ;; be documented anywhere and the observed behavior is
                ;; to sometimes return 1000000 exactly.)
-               (type (integer 0 1000000) utime-usec stime-usec))
+               (type fixnum utime-usec stime-usec))
       (let ((result (+ (* (+ utime-sec stime-sec)
                           sb!xc:internal-time-units-per-second)
                        (floor (+ utime-usec
index 3f174f3..7c88568 100644 (file)
@@ -38,7 +38,9 @@
 
 #ifndef LISP_FEATURE_WIN32
 #include <pwd.h>
+#include <time.h>
 #include <sys/wait.h>
+#include <sys/resource.h>
 #include <netdb.h>
 #endif
 #include <stdio.h>
@@ -376,7 +378,7 @@ wrapped_environ()
  * faked-up implementation of select(). Right now just enough to get through
  * second genesis.
  */
-int select(int top_fd, DWORD *read_set, DWORD *write_set, DWORD *except_set, time_t *timeout)
+int sb_select(int top_fd, DWORD *read_set, DWORD *write_set, DWORD *except_set, time_t *timeout)
 {
     /*
      * FIXME: Going forward, we may want to use MsgWaitForMultipleObjects
@@ -425,7 +427,7 @@ int select(int top_fd, DWORD *read_set, DWORD *write_set, DWORD *except_set, tim
  */
 #define UNIX_EPOCH_FILETIME 116444736000000000ULL
 
-int gettimeofday(long *timeval, long *timezone)
+int sb_gettimeofday(long *timeval, long *timezone)
 {
     FILETIME ft;
     ULARGE_INTEGER uft;
@@ -512,3 +514,37 @@ int s_issock(mode_t mode)
 #endif
 }
 #endif /* !LISP_FEATURE_WIN32 */
+
+#ifndef LISP_FEATURE_WIN32
+int sb_getrusage(int who, struct rusage *rusage)
+{
+        return getrusage(who, rusage);
+}
+
+int sb_gettimeofday(struct timeval *tp, void *tzp)
+{
+        return gettimeofday(tp, tzp);
+}
+
+int sb_nanosleep(struct timespec *rqtp, struct timespec *rmtp)
+{
+        return nanosleep(rqtp, rmtp);
+}
+
+int sb_select(int nfds, fd_set *readfds, fd_set *writefds, fd_set *exceptfds,
+    struct timeval *timeout)
+{
+        return select(nfds, readfds, writefds, exceptfds, timeout);
+}
+
+int sb_getitimer(int which, struct itimerval *value)
+{
+        return getitimer(which, value);
+}
+
+int sb_setitimer(int which, struct itimerval *value, struct itimerval *ovalue)
+{
+        return setitimer(which, value, ovalue);
+}
+#endif /* !LISP_FEATURE_WIN32 */
+