From: Juho Snellman Date: Sun, 12 Nov 2006 23:04:57 +0000 (+0000) Subject: 0.9.18.46: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=46e428110e302636b345928f6f052b8a282c64fa;p=sbcl.git 0.9.18.46: Support files >2GB on Linux/x86. * Compile the runtime (and the C type grovelers) with various flags to enable a 64-bit off_t. * Add C-side wrappers for various POSIX functions, so that we can reliably get the largefile versions of them from Lisp-side. --- diff --git a/NEWS b/NEWS index 18bb7e8..3c4f8f1 100644 --- a/NEWS +++ b/NEWS @@ -10,10 +10,12 @@ changes in sbcl-0.9.19 (1.0.0?) relative to sbcl-0.9.18: threads are not running after *SAVE-HOOKS* have run. * improvement: writes to CLOS instance slots are type-checked in code compiled with (SAFETY 3) - * improvement: floating-point exception handling should work on all - POSIX platforms (thanks to NIIMI Satoshi) + * improvement: floating-point exception handling on FreeBSD (thanks to + NIIMI Satoshi) * improvement: SB-POSIX supports time(2), utime(2) and utimes(2) (thanks to Zach Beane) + * improvement: support for files larger than 2GB for CL streams and SB-POSIX + on Linux/x86 * improvement: added support for the Shift-JIS external format. (contributed by NIIMI Satoshi) * bug fix: compiler bug triggered by a (non-standard) VALUES diff --git a/base-target-features.lisp-expr b/base-target-features.lisp-expr index 1859218..93066ab 100644 --- a/base-target-features.lisp-expr +++ b/base-target-features.lisp-expr @@ -234,6 +234,16 @@ ;; again, if anyone's sufficiently motivated. ; :long-float + ;; Some platforms don't use a 32-bit off_t by default, and thus can't + ;; handle files larger than 2GB. This feature will control whether + ;; we'll try to use platform-specific compilation options to enable a + ;; 64-bit off_t. The intent is for this feature to be automatically + ;; enabled by make-config.sh on platforms where it's needed and known + ;; to work, you shouldn't be enabling it manually. You might however + ;; want to disable it, if you need to pass file descriptors to + ;; foreign code that uses a 32-bit off_t. + ; :largefile + ;; ;; miscellaneous notes on other things which could have special significance ;; in the *FEATURES* list diff --git a/contrib/sb-grovel/def-to-lisp.lisp b/contrib/sb-grovel/def-to-lisp.lisp index 1356609..c5a6241 100644 --- a/contrib/sb-grovel/def-to-lisp.lisp +++ b/contrib/sb-grovel/def-to-lisp.lisp @@ -185,9 +185,13 @@ code: filename tmp-c-source (constants-package component)) (let ((code (sb-ext:process-exit-code (sb-ext:run-program - "gcc" + (sb-ext:posix-getenv "CC") (append (split-cflags (sb-ext:posix-getenv "EXTRA_CFLAGS")) + #+(and linux largefile) + '("-D_LARGEFILE_SOURCE" + "-D_LARGEFILE64_SOURCE" + "-D_FILE_OFFSET_BITS=64") (list "-o" (namestring tmp-a-dot-out) (namestring tmp-c-source))) diff --git a/contrib/sb-posix/interface.lisp b/contrib/sb-posix/interface.lisp index a5c7ace..e718b0c 100644 --- a/contrib/sb-posix/interface.lisp +++ b/contrib/sb-posix/interface.lisp @@ -83,8 +83,9 @@ (define-call* "dup" int minusp (oldfd file-descriptor)) (define-call* "dup2" int minusp (oldfd file-descriptor) (newfd file-descriptor)) -(define-call* "lseek" off-t minusp (fd file-descriptor) (offset off-t) - (whence int)) +(define-call* ("lseek" :largefile) + off-t minusp (fd file-descriptor) (offset off-t) + (whence int)) (define-call* "mkdir" int minusp (pathname filename) (mode mode-t)) (macrolet ((def (x) `(progn @@ -123,7 +124,8 @@ (define-call "fchown" int minusp (fd file-descriptor) (owner uid-t) (group gid-t)) (define-call "fdatasync" int minusp (fd file-descriptor)) - (define-call "ftruncate" int minusp (fd file-descriptor) (length off-t)) + (define-call ("ftruncate" :largefile) + int minusp (fd file-descriptor) (length off-t)) (define-call "fsync" int minusp (fd file-descriptor)) (define-call "lchown" int minusp (pathname filename) (owner uid-t) (group gid-t)) @@ -131,7 +133,8 @@ (define-call "mkfifo" int minusp (pathname filename) (mode mode-t)) (define-call "symlink" int minusp (oldpath filename) (newpath filename)) (define-call "sync" void never-fails) - (define-call "truncate" int minusp (pathname filename) (length off-t)) + (define-call ("truncate" :largefile) + int minusp (pathname filename) (length off-t)) ;; FIXME: Windows does have _mktemp, which has a slightlty different ;; interface (define-call "mkstemp" int minusp (template c-string)) @@ -238,7 +241,7 @@ ;;; mmap, msync #-win32 (progn - (define-call "mmap" sb-sys:system-area-pointer + (define-call ("mmap" :largefile) sb-sys:system-area-pointer (lambda (res) (= (sb-sys:sap-int res) #.(1- (expt 2 sb-vm::n-machine-word-bits)))) (addr sap-or-nil) (length unsigned) (prot unsigned) @@ -305,7 +308,7 @@ (declare (type (or null (sb-alien:alien (* alien-stat))) stat)) (with-alien-stat a-stat () (let ((r (alien-funcall - (extern-alien ,name ,type) + (extern-alien ,(real-c-name (list name :largefile)) ,type) (,designator-fun ,arg) a-stat))) (when (minusp r) @@ -320,7 +323,8 @@ (function int c-string (* alien-stat))) #-win32 -(define-stat-call #-netbsd "lstat" #+netbsd "_lstat" pathname filename +(define-stat-call #-netbsd "lstat" #+netbsd "_lstat" + pathname filename (function int c-string (* alien-stat))) ;;; No symbolic links on Windows, so use stat #+win32 diff --git a/contrib/sb-posix/macros.lisp b/contrib/sb-posix/macros.lisp index 02855f8..8540837 100644 --- a/contrib/sb-posix/macros.lisp +++ b/contrib/sb-posix/macros.lisp @@ -17,9 +17,26 @@ (null (sb-alien:sap-alien (sb-sys:int-sap 0) (* t))) ((alien (* t)) alien-pointer-to-anything-or-nil)) -(defun lisp-for-c-symbol (s) - (let ((root (if (eql #\_ (char s 0)) (subseq s 1) s))) - (intern (substitute #\- #\_ (string-upcase root)) :sb-posix))) +(defun lisp-for-c-symbol (name) + (etypecase name + (list + (lisp-for-c-symbol (car name))) + (string + (let ((root (if (eql #\_ (char name 0)) (subseq name 1) name))) + (intern (substitute #\- #\_ (string-upcase root)) :sb-posix))))) + +(defun real-c-name (name) + (etypecase name + (list + (destructuring-bind (name &rest options) name + + (cond #+largefile + ((member :largefile options) + (format nil "~a_largefile" name)) + (t + name)))) + (string + name))) (defmacro define-call-internally (lisp-name c-name return-type error-predicate &rest arguments) @@ -50,11 +67,12 @@ `(sb-int:style-warn "Didn't find definition for ~S" ,c-name))) (defmacro define-call (name return-type error-predicate &rest arguments) - (let ((lisp-name (lisp-for-c-symbol name))) + (let ((lisp-name (lisp-for-c-symbol name)) + (real-c-name (real-c-name name))) `(progn (export ',lisp-name :sb-posix) (define-call-internally ,lisp-name - ,name + ,real-c-name ,return-type ,error-predicate ,@arguments)))) diff --git a/make-config.sh b/make-config.sh index 0e57022..911fa24 100644 --- a/make-config.sh +++ b/make-config.sh @@ -161,6 +161,13 @@ case "$sbcl_os" in linux) printf ' :elf' >> $ltf printf ' :linux' >> $ltf + + # If you add other platforms here, don't forget to edit + # src/runtime/Config.foo-linux too. + if [ $sbcl_arch = "x86" ]; then + printf ' :largefile' >> $ltf + fi + if [ $sbcl_arch = "x86-64" ]; then link_or_copy Config.x86_64-linux Config else diff --git a/src/code/unix.lisp b/src/code/unix.lisp index 09146ab..94bf062 100644 --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -167,7 +167,12 @@ SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted." (declare (type unix-pathname path) (type fixnum flags) (type unix-file-mode mode)) - (int-syscall ("open" c-string int int) path (logior #!+win32 o_binary flags) mode)) + (int-syscall ("open" c-string int int) + path + (logior #!+win32 o_binary + #!+largefile o_largefile + flags) + mode)) ;;; UNIX-CLOSE accepts a file descriptor and attempts to close the file ;;; associated with it. @@ -257,7 +262,9 @@ SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted." " (declare (type unix-fd fd) (type (integer 0 2) whence)) - (let ((result (alien-funcall (extern-alien "lseek" (function off-t int off-t int)) + (let ((result (alien-funcall (extern-alien #!-largefile "lseek" + #!+largefile "lseek_largefile" + (function off-t int off-t int)) fd offset whence))) (if (minusp result ) (values nil (get-errno)) @@ -614,23 +621,19 @@ SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted." ;;; longer than 32 bits anyway, right?":-| (define-alien-type nil (struct wrapped_stat - #!-mips - (st-dev unsigned-int) ; would be dev-t in a real stat - #!+mips - (st-dev unsigned-long) ; this is _not_ a dev-t on mips + (st-dev #!-(or mips largefile) unsigned-int + #!+mips unsigned-long + #!+largefile dev-t) (st-ino ino-t) (st-mode mode-t) (st-nlink nlink-t) (st-uid uid-t) (st-gid gid-t) - #!-mips - (st-rdev unsigned-int) ; would be dev-t in a real stat - #!+mips - (st-rdev unsigned-long) ; this is _not_ a dev-t on mips - #!-mips - (st-size unsigned-int) ; would be off-t in a real stat - #!+mips - (st-size off-t) + (st-rdev #!-(or mips largefile) unsigned-int + #!+mips unsigned-long + #!+largefile dev-t) + (st-size #!-(or mips largefile) unsigned-int + #!+(or mips largefile) off-t) (st-blksize unsigned-long) (st-blocks unsigned-long) (st-atime time-t) diff --git a/src/runtime/Config.x86-linux b/src/runtime/Config.x86-linux index 693cd74..28ab484 100644 --- a/src/runtime/Config.x86-linux +++ b/src/runtime/Config.x86-linux @@ -30,6 +30,11 @@ OS_SRC = linux-os.c x86-linux-os.c LINKFLAGS += -Wl,--export-dynamic OS_LIBS = -ldl +CFLAGS += $(shell if grep LISP_FEATURE_LARGEFILE genesis/config.h \ + > /dev/null 2>&1; \ + then echo "-D_LARGEFILE_SOURCE -D_LARGEFILE64_SOURCE \ + -D_FILE_OFFSET_BITS=64"; fi) + OS_LIBS += $(shell if grep LISP_FEATURE_SB_THREAD genesis/config.h \ > /dev/null 2>&1; \ then echo "-lpthread"; fi) diff --git a/src/runtime/GNUmakefile b/src/runtime/GNUmakefile index e74b5af..fa764d4 100644 --- a/src/runtime/GNUmakefile +++ b/src/runtime/GNUmakefile @@ -37,7 +37,7 @@ include Config COMMON_SRC = alloc.c backtrace.c breakpoint.c coreparse.c \ - dynbind.c gc-common.c globals.c interr.c interrupt.c \ + dynbind.c gc-common.c globals.c interr.c interrupt.c largefile.c \ monitor.c os-common.c parse.c print.c purify.c pthread-lutex.c \ regnames.c run-program.c runtime.c save.c search.c \ thread.c time.c util.c validate.c vars.c wrap.c diff --git a/src/runtime/largefile.c b/src/runtime/largefile.c new file mode 100644 index 0000000..bd4cbc1 --- /dev/null +++ b/src/runtime/largefile.c @@ -0,0 +1,63 @@ +/* + * Wrapper functions for SUSv2 large file support. Linux defaults to a + * 32-bit off_t and hides the largefile-capable versions of the + * syscalls behind preprocessor magic, rather than making them + * reliably available using dlsym. + */ + +/* + * This software is part of the SBCL system. See the README file for + * more information. + * + * This software is derived from the CMU CL system, which was + * written at Carnegie Mellon University and released into the + * public domain. The software is in the public domain and is + * provided with absolutely no warranty. See the COPYING and CREDITS + * files for more information. + */ + +#include + +#ifdef LISP_FEATURE_LARGEFILE + +#include +#include +#include +#include + +off_t +lseek_largefile(int fildes, off_t offset, int whence) { + return lseek(fildes, offset, whence); +} + +int +truncate_largefile(const char *path, off_t length) { + return truncate(path, length); +} + +int +ftruncate_largefile(int fd, off_t length) { + return ftruncate(fd, length); +} + +void* +mmap_largefile(void *start, size_t length, int prot, int flags, int fd, off_t offset) { + mmap(start, length, prot, flags, fd, offset); +} + +int +stat_largefile(const char *file_name, struct stat *buf) { + return stat(file_name, buf); +} + +int +fstat_largefile(int filedes, struct stat *buf) { + return fstat(filedes, buf); +} + +int +lstat_largefile(const char *file_name, struct stat *buf) { + return lstat(file_name, buf); +} + +#endif diff --git a/src/runtime/wrap.c b/src/runtime/wrap.c index 0b715c7..f0e5746 100644 --- a/src/runtime/wrap.c +++ b/src/runtime/wrap.c @@ -167,7 +167,10 @@ wrapped_readlink(char *path) * * Some motivated spark fixed MIPS. -- ths, 2005-10-06 */ -#ifdef LISP_FEATURE_MIPS +#if defined (LISP_FEATURE_LARGEFILE) +typedef dev_t ffi_dev_t; +typedef off_t ffi_off_t; +#elif defined(LISP_FEATURE_MIPS) typedef unsigned long ffi_dev_t; /* Linux/MIPS struct stat doesn't use dev_t */ typedef off_t ffi_off_t; #else diff --git a/tools-for-build/grovel-headers.c b/tools-for-build/grovel-headers.c index a9fe11d..53412dd 100644 --- a/tools-for-build/grovel-headers.c +++ b/tools-for-build/grovel-headers.c @@ -249,6 +249,10 @@ main(int argc, char *argv[]) defconstant("o_noctty", O_NOCTTY); defconstant("o_trunc", O_TRUNC); defconstant("o_append", O_APPEND); +#ifdef LISP_FEATURE_LARGEFILE + defconstant("o_largefile", O_LARGEFILE); +#endif + printf(";;;\n"); defconstant("s-ifmt", S_IFMT); defconstant("s-ififo", S_IFIFO); diff --git a/version.lisp-expr b/version.lisp-expr index 19e5c78..664b379 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.9.18.45" +"0.9.18.46"