Menu
▾
▴
[Sbcl-commits] master: Better support for NetBSD/current
|
From: Christophe R. <cr...@us...> - 2013-08-22 12:40:31
|
The branch "master" has been updated in SBCL:
via 9304704f68a18894fa8eb985b387465e5d25e1d5 (commit)
from f7c047cafd84b556398014c4932c90dba55a5c0d (commit)
- Log -----------------------------------------------------------------
commit 9304704f68a18894fa8eb985b387465e5d25e1d5
Author: Christophe Rhodes <cs...@ca...>
Date: Thu Aug 22 13:39:10 2013 +0100
Better support for NetBSD/current
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 | 16 ++++++++--------
src/code/unix.lisp | 44 ++++++++++++++++++++++----------------------
src/runtime/wrap.c | 40 ++++++++++++++++++++++++++++++++++++++--
3 files changed, 68 insertions(+), 32 deletions(-)
diff --git a/NEWS b/NEWS
index 793d4a0..5b6ac81 100644
--- 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.
diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index 0856069..1f0f562 100644
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -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
diff --git a/src/runtime/wrap.c b/src/runtime/wrap.c
index 3f174f3..7c88568 100644
--- a/src/runtime/wrap.c
+++ b/src/runtime/wrap.c
@@ -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 */
+
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL
|