[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