[cmucl-imp] time
Robert Swindells
rjs at fdy2.co.uk
Fri Oct 24 14:27:06 UTC 2014
Below is my diffs to time stuff in CMUCL to handle 64-bit time_t on
NetBSD.
I think it should be ok for other platforms but it would be good if
people could test it.
Robert Swindells
diff --git a/src/code/time.lisp b/src/code/time.lisp
index e6fb0c0..51457f5 100644
--- a/src/code/time.lisp
+++ b/src/code/time.lisp
@@ -105,7 +105,7 @@
;;; - T if daylight savings is in effect, NIL if not.
;;;
(alien:def-alien-routine get-timezone c-call:void
- (when c-call:long :in)
+ (when unix:time-t :in)
(minutes-west c-call:int :out)
(daylight-savings-p alien:boolean :out))
diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index 2d595d4..bc178f2 100644
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -215,7 +215,8 @@
(def-alien-type caddr-t (* char))
(def-alien-type ino-t
- #-alpha unsigned-long
+ #+(or linux (and bsd (not netbsd))) unsigned-long
+ #+netbsd u-int64-t
#+alpha unsigned-int)
(def-alien-type swblk-t long)
@@ -228,14 +229,16 @@
(def-alien-type time-t
#-(or bsd linux alpha) unsigned-long
#+linux long
- #+bsd long
+ #+(and bsd (not netbsd)) long
+ #+(and bsd netbsd) int64-t
#+alpha unsigned-int)
(def-alien-type dev-t
#-(or alpha svr4 bsd linux) short
#+linux unsigned-short
+ #+netbsd u-int64-t
#+alpha int
- #+(and (not linux) (or bsd svr4)) unsigned-long)
+ #+(and (not linux) (not netbsd) (or bsd svr4)) unsigned-long)
#-BSD
(progn
@@ -286,7 +289,8 @@
#+svr4 unsigned-long)
(def-alien-type nlink-t
- #-svr4 unsigned-short
+ #-(or svr4 netbsd) unsigned-short
+ #+netbsd unsigned-long
#+svr4 unsigned-long)
(defconstant FD-SETSIZE
@@ -335,7 +339,7 @@
(def-alien-type nil
(struct timeval
(tv-sec #-linux time-t #+linux int) ; seconds
- (tv-usec #-linux time-t #+linux int))) ; and microseconds
+ (tv-usec int))) ; and microseconds
(def-alien-type nil
(struct timezone
@@ -359,7 +363,7 @@
#+(or linux BSD)
(def-alien-type nil
(struct timespec-t
- (ts-sec long)
+ (ts-sec time-t)
(ts-nsec long)))
;;; From ioctl.h
@@ -466,7 +470,7 @@
(d-namlen unsigned-short) ; length of string in d-name
(d-name (array char 256)))) ; name must be no longer than this
-#+bsd
+#+(and bsd (not netbsd))
(def-alien-type nil
(struct direct
(d-fileno unsigned-long)
@@ -475,6 +479,15 @@
(d-namlen unsigned-char) ; length of string in d-name
(d-name (array char 256)))) ; name must be no longer than this
+#+netbsd
+(def-alien-type nil
+ (struct direct
+ (d-fileno ino-t)
+ (d-reclen unsigned-short)
+ (d-namlen unsigned-short)
+ (d-type unsigned-char)
+ (d-name (array char 512))))
+
;;; The 64-bit version of struct dirent.
#+solaris
(def-alien-type nil
@@ -509,7 +522,7 @@
(st-blocks #-alpha long #+alpha int)
(st-spare4 (array long 2))))
-#+bsd
+#+(and bsd (not netbsd))
(def-alien-type nil
(struct stat
(st-dev dev-t)
@@ -530,6 +543,27 @@
(st-lspare long)
(st-qspare (array long 4))))
+#+netbsd
+(def-alien-type nil
+ (struct stat
+ (st-dev dev-t)
+ (st-mode mode-t)
+ (st-ino ino-t)
+ (st-nlink nlink-t)
+ (st-uid uid-t)
+ (st-gid gid-t)
+ (st-rdev dev-t)
+ (st-atime (struct timespec-t))
+ (st-mtime (struct timespec-t))
+ (st-ctime (struct timespec-t))
+ (st-birthtime (struct timespec-t))
+ (st-size off-t)
+ (st-blocks off-t)
+ (st-blksize long)
+ (st-flags unsigned-long)
+ (st-gen unsigned-long)
+ (st-spare (array unsigned-long 2))))
+
#+(or linux svr4)
(def-alien-type nil
(struct stat
@@ -1597,7 +1631,7 @@
(when timeout-secs
(setf (slot tv 'tv-sec) timeout-secs)
(setf (slot tv 'tv-usec) ,timeout-usecs))
- (int-syscall ("select" int (* (struct fd-set)) (* (struct fd-set))
+ (int-syscall (#-netbsd "select" #+netbsd "__select50" int (* (struct fd-set)) (* (struct fd-set))
(* (struct fd-set)) (* (struct timeval)))
,num-descriptors ,read-fds ,write-fds ,exception-fds
(if timeout-secs (alien-sap (addr tv)) (int-sap 0))))))
@@ -1647,7 +1681,7 @@
`(if (zerop ,lispvar)
(int-sap 0)
(alien-sap (addr ,alienvar)))))
- (syscall ("select" int (* (struct fd-set)) (* (struct fd-set))
+ (syscall (#-netbsd "select" #+netbsd "__select50" int (* (struct fd-set)) (* (struct fd-set))
(* (struct fd-set)) (* (struct timeval)))
(values result
(fd-set-to-num nfds rdf)
@@ -2137,6 +2171,7 @@
#-(or svr4 BSD) (slot ,buf 'st-ctime)
#+svr4 (slot (slot ,buf 'st-ctime) 'tv-sec)
#+BSD(slot (slot ,buf 'st-ctime) 'ts-sec)
+ #+netbsd (slot (slot ,buf 'st-birthtime) 'ts-sec)
(slot ,buf 'st-blksize)
(slot ,buf 'st-blocks)))
@@ -2152,7 +2187,7 @@
(when (string= name "")
(setf name "."))
(with-alien ((buf (struct stat)))
- (syscall ("stat" c-string (* (struct stat)))
+ (syscall (#-netbsd "stat" #+netbsd "__stat50" c-string (* (struct stat)))
(extract-stat-results buf)
(%name->file name) (addr buf))))
@@ -2161,7 +2196,7 @@
file must be a symbolic link."
(declare (type unix-pathname name))
(with-alien ((buf (struct stat)))
- (syscall ("lstat" c-string (* (struct stat)))
+ (syscall (#-netbsd "lstat" #+netbsd "__lstat50" c-string (* (struct stat)))
(extract-stat-results buf)
(%name->file name) (addr buf))))
@@ -2170,7 +2205,7 @@
by the file descriptor fd."
(declare (type unix-fd fd))
(with-alien ((buf (struct stat)))
- (syscall ("fstat" int (* (struct stat)))
+ (syscall (#-netbsd "fstat" #+netbsd "__fstat50" int (* (struct stat)))
(extract-stat-results buf)
fd (addr buf))))
)
@@ -2223,7 +2258,7 @@
(unsigned-byte 31) (mod 1000000)
(unsigned-byte 31) (mod 1000000)))
(with-alien ((usage (struct rusage)))
- (syscall* ("getrusage" int (* (struct rusage)))
+ (syscall* (#-netbsd "getrusage" #+netbsd "__getrusage50" int (* (struct rusage)))
(values t
(slot (slot usage 'ru-utime) 'tv-sec)
(slot (slot usage 'ru-utime) 'tv-usec)
@@ -2238,7 +2273,7 @@
child processes (rusage_children). NIL and an error number
is returned if the call fails."
(with-alien ((usage (struct rusage)))
- (syscall ("getrusage" int (* (struct rusage)))
+ (syscall (#-netbsd "getrusage" #+netbsd "__getrusage50" int (* (struct rusage)))
(values t
(+ (* (slot (slot usage 'ru-utime) 'tv-sec) 1000000)
(slot (slot usage 'ru-utime) 'tv-usec))
@@ -2327,18 +2362,18 @@
of Greenwich), and a daylight-savings flag. If it doesn't work, it
returns NIL and the errno."
(with-alien ((tv (struct timeval))
- #-svr4 (tz (struct timezone)))
- (syscall* ("gettimeofday" (* (struct timeval)) #-svr4 (* (struct timezone)))
+ #-(or svr4 netbsd) (tz (struct timezone)))
+ (syscall* (#+netbsd #-netbsd "gettimeofday" "__gettimeofday50" (* (struct timeval)) #-svr4 (* (struct timezone)))
(values T
(slot tv 'tv-sec)
(slot tv 'tv-usec)
- #-svr4 (slot tz 'tz-minuteswest)
+ #-(or svr4 netbsd) (slot tz 'tz-minuteswest)
#+svr4 (unix-get-minutes-west (slot tv 'tv-sec))
- #-svr4 (slot tz 'tz-dsttime)
+ #-(or svr4 netbsd) (slot tz 'tz-dsttime)
#+svr4 (unix-get-timezone (slot tv 'tv-sec))
)
(addr tv)
- #-svr4 (addr tz))))
+ #-(or svr4 netbsd) (addr tz) #+netbsd nil)))
;;; Unix-utimes changes the accessed and updated times on UNIX
;;; files. The first argument is the filename (a string) and
@@ -2359,7 +2394,7 @@
(setf (slot (deref tvp 0) 'tv-usec) atime-usec)
(setf (slot (deref tvp 1) 'tv-sec) mtime-sec)
(setf (slot (deref tvp 1) 'tv-usec) mtime-usec)
- (void-syscall ("utimes" c-string (* (struct timeval)))
+ (void-syscall (#-netbsd "utimes" #+netbsd "__utimes50" c-string (* (struct timeval)))
file
(cast tvp (* (struct timeval))))))
@@ -2592,8 +2627,8 @@
(with-alien ((direct (* (struct direct)) daddr))
(let ((nlen (slot direct 'd-namlen))
(fino (slot direct 'd-fileno)))
- (declare (type (unsigned-byte 8) nlen)
- (type (unsigned-byte 32) fino))
+ (declare (type (unsigned-byte #+netbsd 16 #-netbsd 8) nlen)
+ (type (unsigned-byte #+netbsd 64 #-netbsd 32) fino))
(let ((string (make-string nlen)))
#-unicode
(kernel:copy-from-system-area
@@ -3089,14 +3124,16 @@
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)))
+ #+netbsd (unsigned-byte 63) #-netbsd (unsigned-byte 29)
+ (mod 1000000)
+ #+netbsd (unsigned-byte 63) #-netbsd (unsigned-byte 29)
+ (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* (#-netbsd "getitimer" #+netbsd "__getitimer50" int (* (struct itimerval)))
(values T
(slot (slot itv 'it-interval) 'tv-sec)
(slot (slot itv 'it-interval) 'tv-usec)
@@ -3117,8 +3154,10 @@
(type (unsigned-byte 29) 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 29)
+ (mod 1000000)
+ (unsigned-byte 29)
+ (mod 1000000)))
(let ((which (ecase which
(:real ITIMER-REAL)
(:virtual ITIMER-VIRTUAL)
@@ -3129,7 +3168,7 @@
(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* (#-netbsd "setitimer" #+netbsd "__setitimer50" int (* (struct timeval))(* (struct timeval)))
(values T
(slot (slot itvo 'it-interval) 'tv-sec)
(slot (slot itvo 'it-interval) 'tv-usec)
diff --git a/src/lisp/NetBSD-os.c b/src/lisp/NetBSD-os.c
index 1b01bb6..5c5a8bf 100644
--- a/src/lisp/NetBSD-os.c
+++ b/src/lisp/NetBSD-os.c
@@ -21,8 +21,12 @@
#include <stdio.h>
#include <stdlib.h>
#include <sys/param.h>
+#include <sys/types.h>
#include <sys/file.h>
+#include <sys/proc.h>
+#include <sys/sysctl.h>
#include <errno.h>
+
#include "os.h"
#include "arch.h"
#include "globals.h"
@@ -30,12 +34,8 @@
#include "lispregs.h"
#include "internals.h"
-#include <sys/types.h>
#include <signal.h>
-/* #include <sys/sysinfo.h> */
-#include <sys/proc.h>
#include <dlfcn.h>
-#include <sys/sysctl.h>
#include "validate.h"
size_t os_vm_page_size;
@@ -94,7 +94,7 @@ os_sigcontext_fpu_reg(ucontext_t *scp, int index)
unsigned char *reg = NULL;
DPRINTF(0, (stderr, "fpu reg index = %d\n", index));
-
+
if (scp->uc_flags & _UC_FPU) {
if (scp->uc_flags & _UC_FXSAVE) {
/*
diff --git a/src/lisp/NetBSD-os.h b/src/lisp/NetBSD-os.h
index e2a8fe8..b9d846a 100644
--- a/src/lisp/NetBSD-os.h
+++ b/src/lisp/NetBSD-os.h
@@ -12,6 +12,7 @@
#include <sys/types.h>
#include <sys/mman.h>
#include <sys/signal.h>
+#include <sys/stat.h>
#include <ucontext.h>
#include <string.h>
#include <unistd.h>
diff --git a/src/motif/server/Config.NetBSD b/src/motif/server/Config.NetBSD
index 83591ac..a5d3233 100644
--- a/src/motif/server/Config.NetBSD
+++ b/src/motif/server/Config.NetBSD
@@ -1,6 +1,6 @@
CFLAGS = -O2 -I/usr/pkg/include -I/usr/X11R7/include -I. -I$(VPATH)
LDFLAGS = -R/usr/X11R7/lib -L/usr/X11R7/lib -R/usr/pkg/lib -L/usr/pkg/lib
-LIBS = -lXm -lXt -lXext -lX11 -lSM -lICE -lXp
+LIBS = -lXm -lXt -lXext -lX11 -lSM -lICE
# This def assumes you are building in the same or parallel
# tree to the CVS souce layout. Sites may need to customize
# this path.
diff --git a/src/motif/server/main.c b/src/motif/server/main.c
index c5e42ba..4a3f2cc 100644
--- a/src/motif/server/main.c
+++ b/src/motif/server/main.c
@@ -12,6 +12,7 @@
#include <ctype.h>
#include <sys/types.h>
#include <sys/socket.h>
+#include <sys/select.h>
#include <sys/un.h>
#include <netinet/in.h>
#include <netdb.h>
More information about the cmucl-imp
mailing list