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.
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
;; 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
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)))
(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
(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))
(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))
;;; 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)
(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)
(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
(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)
`(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))))
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
(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.
"
(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))
;;; 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)
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)
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
--- /dev/null
+/*
+ * 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 <genesis/config.h>
+
+#ifdef LISP_FEATURE_LARGEFILE
+
+#include <sys/mman.h>
+#include <sys/types.h>
+#include <unistd.h>
+#include <sys/stat.h>
+
+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
*
* 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
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);
;;; 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"
projects / sbcl.git / commitdiff