[Git][cmucl/cmucl][issue-125-unix-stat-wrong] 3 commits: 64-bit support and clean up times
Raymond Toy (@rtoy)
gitlab at common-lisp.net
Wed Aug 3 18:26:52 UTC 2022
Raymond Toy pushed to branch issue-125-unix-stat-wrong at cmucl / cmucl
Commits:
55140c71 by Raymond Toy at 2022-08-03T09:52:06-07:00
64-bit support and clean up times
In unix.c define _LARGEFILE_SOURCE and _FILE_OFFSET_BITS so that we
can the 64-bit versions of stat and friends. Also, for compatibility,
we don't return a struct timespec, but a long for the number of
seconds. We ignore the nanosec part.
In unix.lisp, change the definition of dev-t on linux to be u-int64-t
since it seems we support the 64-bit integer type.
- - - - -
97f6a14c by Raymond Toy at 2022-08-03T10:00:45-07:00
Use time_t/time-t instead of long
For the time fields, use time_t on the C side and time-t on the Lisp
side.
- - - - -
8dd3f6ae by Raymond Toy at 2022-08-03T11:26:29-07:00
Simplify implementation of unix-stat and friends
Since the body of unix-stat and friends are almost identical and only
differ in the arg and type of the first arg to stat, we use a macro to
handle the call to stat.
- - - - -
2 changed files:
- src/code/unix.lisp
- src/lisp/unix.c
Changes:
=====================================
src/code/unix.lisp
=====================================
@@ -74,8 +74,7 @@
(def-alien-type dev-t
#-(or alpha svr4 bsd linux) short
- #+(and linux (not amd64)) uquad-t
- #+(and linux amd64) u-int64-t
+ #+linux u-int64-t
#+netbsd u-int64-t
#+alpha int
#+(and (not linux) (not netbsd) (or bsd svr4)) unsigned-long)
@@ -1573,207 +1572,96 @@
;;
;; This should be updated so that all OSes do this.
#+linux
-(progn
-(defun unix-stat (name)
- _N"Unix-stat retrieves information about the specified
+(macrolet
+ ((call-stat (c-func-name first-arg-type first-arg)
+ ;; Call the stat function named C-FUNC-NAME. The type of the
+ ;; first arg is FIRST-ARG_TYPE and FIRST-ARG is the first arg
+ ;; to the stat function. fstat is different from stat and
+ ;; lstat since it takes an fd for the first arg instead of
+ ;; string.
+ `(with-alien ((dev dev-t)
+ (ino ino64-t)
+ (mode mode-t)
+ (nlink nlink-t)
+ (uid uid-t)
+ (gid gid-t)
+ (rdev dev-t)
+ (size off-t)
+ (atime time-t)
+ (mtime time-t)
+ (ctime time-t)
+ (blksize c-call:long)
+ (blocks off-t))
+ (let ((result
+ (alien-funcall
+ (extern-alien ,c-func-name
+ (function int
+ ,first-arg-type
+ (* dev-t)
+ (* ino64-t)
+ (* mode-t)
+ (* nlink-t)
+ (* uid-t)
+ (* gid-t)
+ (* dev-t)
+ (* off-t)
+ (* time-t)
+ (* time-t)
+ (* time-t)
+ (* c-call:long)
+ (* off-t)))
+ ,first-arg
+ (addr dev)
+ (addr ino)
+ (addr mode)
+ (addr nlink)
+ (addr uid)
+ (addr gid)
+ (addr rdev)
+ (addr size)
+ (addr atime)
+ (addr mtime)
+ (addr ctime)
+ (addr blksize)
+ (addr blocks))))
+ (if (eql -1 result)
+ (values nil (unix-errno))
+ (values t
+ dev
+ ino
+ mode
+ nlink
+ uid
+ gid
+ rdev
+ size
+ atime
+ mtime
+ ctime
+ blksize
+ blocks))))))
+ (defun unix-stat (name)
+ _N"Unix-stat retrieves information about the specified
file returning them in the form of multiple values.
See the UNIX Programmer's Manual for a description
of the values returned. If the call fails, then NIL
and an error number is returned instead."
- (declare (type unix-pathname name))
- (when (string= name "")
- (setf name "."))
- (with-alien ((dev dev-t)
- (ino ino64-t)
- (mode mode-t)
- (nlink nlink-t)
- (uid uid-t)
- (gid gid-t)
- (rdev dev-t)
- (size off-t)
- (atime (struct timespec-t))
- (mtime (struct timespec-t))
- (ctime (struct timespec-t))
- (blksize off-t)
- (blocks off-t))
- (let ((result
- (alien-funcall
- (extern-alien "unix_stat"
- (function int
- c-call::c-string
- (* dev-t)
- (* ino64-t)
- (* mode-t)
- (* nlink-t)
- (* uid-t)
- (* gid-t)
- (* dev-t)
- (* off-t)
- (* (struct timespec-t))
- (* (struct timespec-t))
- (* (struct timespec-t))
- (* off-t)
- (* off-t)))
- (%name->file name)
- (addr dev)
- (addr ino)
- (addr mode)
- (addr nlink)
- (addr uid)
- (addr gid)
- (addr rdev)
- (addr size)
- (addr atime)
- (addr mtime)
- (addr ctime)
- (addr blksize)
- (addr blocks))))
- (if (eql -1 result)
- (values nil (unix-errno))
- (flet ((make-64bit (x)
- (+ (alien:deref x 0)
- (ash (alien:deref x 1) 32)))
- (make-time (x)
- (alien:slot x 'unix::ts-sec)))
- (values t
- (make-64bit dev) ino mode nlink uid gid
- (make-64bit rdev)
- size
- (make-time atime)
- (make-time mtime)
- (make-time ctime)
- blksize blocks))))))
+ (declare (type unix-pathname name))
+ (when (string= name "")
+ (setf name "."))
+ (call-stat "unix_stat" c-call:c-string (%name->file name)))
-(defun unix-lstat (name)
- "Unix-lstat is similar to unix-stat except the specified
+ (defun unix-lstat (name)
+ "Unix-lstat is similar to unix-stat except the specified
file must be a symbolic link."
- (declare (type unix-pathname name))
- (with-alien ((dev dev-t)
- (ino ino64-t)
- (mode mode-t)
- (nlink nlink-t)
- (uid uid-t)
- (gid gid-t)
- (rdev dev-t)
- (size off-t)
- (atime (struct timespec-t))
- (mtime (struct timespec-t))
- (ctime (struct timespec-t))
- (blksize off-t)
- (blocks off-t))
- (let ((result
- (alien-funcall
- (extern-alien "unix_lstat"
- (function int
- c-call::c-string
- (* dev-t)
- (* ino64-t)
- (* mode-t)
- (* nlink-t)
- (* uid-t)
- (* gid-t)
- (* dev-t)
- (* off-t)
- (* (struct timespec-t))
- (* (struct timespec-t))
- (* (struct timespec-t))
- (* off-t)
- (* off-t)))
- (%name->file name)
- (addr dev)
- (addr ino)
- (addr mode)
- (addr nlink)
- (addr uid)
- (addr gid)
- (addr rdev)
- (addr size)
- (addr atime)
- (addr mtime)
- (addr ctime)
- (addr blksize)
- (addr blocks))))
- (if (eql -1 result)
- (values nil (unix-errno))
- (flet ((make-64bit (x)
- (+ (alien:deref x 0)
- (ash (alien:deref x 1) 32)))
- (make-time (x)
- (alien:slot x 'unix::ts-sec)))
- (values t
- (make-64bit dev) ino mode nlink uid gid
- (make-64bit rdev)
- size
- (make-time atime)
- (make-time mtime)
- (make-time ctime)
- blksize blocks))))))
+ (declare (type unix-pathname name))
+ (call-stat "unix_lstat" c-call:c-string (%name->file name)))
-(defun unix-fstat (fd)
- _N"Unix-fstat is similar to unix-stat except the file is specified
+ (defun unix-fstat (fd)
+ _N"Unix-fstat is similar to unix-stat except the file is specified
by the file descriptor fd."
- (declare (type unix-fd fd))
- (with-alien ((dev dev-t)
- (ino ino64-t)
- (mode mode-t)
- (nlink nlink-t)
- (uid uid-t)
- (gid gid-t)
- (rdev dev-t)
- (size off-t)
- (atime (struct timespec-t))
- (mtime (struct timespec-t))
- (ctime (struct timespec-t))
- (blksize off-t)
- (blocks off-t))
- (let ((result
- (alien-funcall
- (extern-alien "unix_fstat"
- (function int
- int
- (* dev-t)
- (* ino64-t)
- (* mode-t)
- (* nlink-t)
- (* uid-t)
- (* gid-t)
- (* dev-t)
- (* off-t)
- (* (struct timespec-t))
- (* (struct timespec-t))
- (* (struct timespec-t))
- (* off-t)
- (* off-t)))
- fd
- (addr dev)
- (addr ino)
- (addr mode)
- (addr nlink)
- (addr uid)
- (addr gid)
- (addr rdev)
- (addr size)
- (addr atime)
- (addr mtime)
- (addr ctime)
- (addr blksize)
- (addr blocks))))
- (if (eql -1 result)
- (values nil (unix-errno))
- (flet ((make-64bit (x)
- (+ (alien:deref x 0)
- (ash (alien:deref x 1) 32)))
- (make-time (x)
- (alien:slot x 'unix::ts-sec)))
- (values t
- (make-64bit dev) ino mode nlink uid gid
- (make-64bit rdev)
- size
- (make-time atime)
- (make-time mtime)
- (make-time ctime)
- blksize blocks))))))
-)
+ (declare (type unix-fd fd))
+ (call-stat "unix_fstat" int fd)))
;;; 64-bit versions of stat and friends
#+solaris
=====================================
src/lisp/unix.c
=====================================
@@ -2,13 +2,18 @@
* C interfaces to unix syscalls
*/
+/* We want to support large files */
+
+#define _LARGEFILE_SOURCE
+#define _FILE_OFFSET_BITS 64
+
#include <stdio.h>
#include <sys/stat.h>
int unix_stat(const char* path, dev_t *dev, ino_t *ino, mode_t *mode, nlink_t *nlink,
uid_t *uid, gid_t *gid, dev_t *rdev, off_t *size,
- struct timespec *atime, struct timespec *mtime, struct timespec *ctime,
- long *blksize, long *blocks)
+ time_t *atime, time_t *mtime, time_t *ctime,
+ long *blksize, off_t *blocks)
{
int rc;
struct stat buf;
@@ -38,9 +43,9 @@ int unix_stat(const char* path, dev_t *dev, ino_t *ino, mode_t *mode, nlink_t *n
*gid = buf.st_gid;
*rdev = buf.st_rdev;
*size = buf.st_size;
- *atime = buf.st_atim;
- *mtime = buf.st_mtim;
- *ctime = buf.st_ctim;
+ *atime = buf.st_atime;
+ *mtime = buf.st_mtime;
+ *ctime = buf.st_ctime;
*blksize = buf.st_blksize;
*blocks = buf.st_blocks;
@@ -49,8 +54,8 @@ int unix_stat(const char* path, dev_t *dev, ino_t *ino, mode_t *mode, nlink_t *n
int unix_fstat(int fd, dev_t *dev, ino_t *ino, mode_t *mode, nlink_t *nlink,
uid_t *uid, gid_t *gid, dev_t *rdev, off_t *size,
- struct timespec *atime, struct timespec *mtime, struct timespec *ctime,
- long *blksize, long *blocks)
+ time_t *atime, time_t *mtime, time_t *ctime,
+ long *blksize, off_t *blocks)
{
int rc;
struct stat buf;
@@ -65,9 +70,9 @@ int unix_fstat(int fd, dev_t *dev, ino_t *ino, mode_t *mode, nlink_t *nlink,
*gid = buf.st_gid;
*rdev = buf.st_rdev;
*size = buf.st_size;
- *atime = buf.st_atim;
- *mtime = buf.st_mtim;
- *ctime = buf.st_ctim;
+ *atime = buf.st_atime;
+ *mtime = buf.st_mtime;
+ *ctime = buf.st_ctime;
*blksize = buf.st_blksize;
*blocks = buf.st_blocks;
@@ -76,8 +81,8 @@ int unix_fstat(int fd, dev_t *dev, ino_t *ino, mode_t *mode, nlink_t *nlink,
int unix_lstat(const char* path, dev_t *dev, ino_t *ino, mode_t *mode, nlink_t *nlink,
uid_t *uid, gid_t *gid, dev_t *rdev, off_t *size,
- struct timespec *atime, struct timespec *mtime, struct timespec *ctime,
- long *blksize, long *blocks)
+ time_t *atime, time_t *mtime, time_t *ctime,
+ long *blksize, off_t *blocks)
{
int rc;
struct stat buf;
@@ -92,9 +97,9 @@ int unix_lstat(const char* path, dev_t *dev, ino_t *ino, mode_t *mode, nlink_t *
*gid = buf.st_gid;
*rdev = buf.st_rdev;
*size = buf.st_size;
- *atime = buf.st_atim;
- *mtime = buf.st_mtim;
- *ctime = buf.st_ctim;
+ *atime = buf.st_atime;
+ *mtime = buf.st_mtime;
+ *ctime = buf.st_ctime;
*blksize = buf.st_blksize;
*blocks = buf.st_blocks;
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/6a38637e8653785b23e24911322005d1a83c3842...8dd3f6ae29fb0f72a8998440b3034b6646bb3b07
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/6a38637e8653785b23e24911322005d1a83c3842...8dd3f6ae29fb0f72a8998440b3034b6646bb3b07
You're receiving this email because of your account on gitlab.common-lisp.net.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20220803/59facba9/attachment-0001.html>
More information about the cmucl-cvs
mailing list