Kill the unix-try macro.

Instead, export sys-* functions which do the right thing.  Fix safely to
match.

diff --git a/safely.lisp b/safely.lisp
index 5eddef3..f62420c 100644 (file)
--- a/safely.lisp
+++ b/safely.lisp
@@ -68,13 +68,13 @@ Other OPEN-ARGS are passed to open."
 (defun delete-file-without-moaning (file)
   "Delete the FILE, ignoring errors."
   (when (probe-file file)
 (defun delete-file-without-moaning (file)
   "Delete the FILE, ignoring errors."
   (when (probe-file file)

-    (unix-try unlink file)))
+    (sys-unlink file)))

 
 (defun rename-file-without-moaning (old new)
   "Rename OLD to NEW, ignoring errors, and without doing any stupid name
 mangling."
   (when (probe-file old)
 
 (defun rename-file-without-moaning (old new)
   "Rename OLD to NEW, ignoring errors, and without doing any stupid name
 mangling."
   (when (probe-file old)

-    (unix-try rename old new)))
+    (sys-rename old new)))

 
 (defun safely-unwind (trail)
   "Roll back the TRAIL of operations."
 
 (defun safely-unwind (trail)
   "Roll back the TRAIL of operations."


@@ -131,11 +131,11 @@ changes are made."
                                  (copy-file file old)
                                  (push `(:revert ,old ,file) revert))
                                (push `(:rmtmp ,file) revert))
                                  (copy-file file old)
                                  (push `(:revert ,old ,file) revert))
                                (push `(:rmtmp ,file) revert))

-                           (unix-try rename new file)))
+                           (sys-rename new file)))

                  (:delete (destructuring-bind (tag file old) job
                             (declare (ignore tag))
                             (push `(:revert ,old ,file) revert)
                  (:delete (destructuring-bind (tag file old) job
                             (declare (ignore tag))
                             (push `(:revert ,old ,file) revert)

-                            (unix-try rename file old)
+                            (sys-rename file old)

                             (push `(:rmtmp old) cleanup))))))
          (setf revert nil))
       (safely-unwind trail)
                             (push `(:rmtmp old) cleanup))))))
          (setf revert nil))
       (safely-unwind trail)

diff --git a/unix.lisp b/unix.lisp
index 8f9cd3e..3a01dd2 100644 (file)
--- a/unix.lisp
+++ b/unix.lisp
@@ -26,8 +26,12 @@
 (defpackage #:mdw.unix
   (:use #:common-lisp #:mdw.base #:mdw.collect)
   (:export #:unix-error #:errno-value #:with-errno-handlers
 (defpackage #:mdw.unix
   (:use #:common-lisp #:mdw.base #:mdw.collect)
   (:export #:unix-error #:errno-value #:with-errno-handlers

-          #:unix-try-func #:unix-try
-          #:stat
+          #:syscall #:syscall*
+          #:stat #:sys-stat
+          #:sys-open #:sys-close #:sys-read #:sys-write
+          #:sys-chown #:sys-fchown #:sys-chmod #:sys-fchmod
+          #:sys-utimes #:sys-unlink #:sys-rename
+          #:sys-gettimeofday #:sys-gethostname

           #:with-unix-open #:copy-file))
 (in-package #:mdw.unix)
 
           #:with-unix-open #:copy-file))
 (in-package #:mdw.unix)
 


@@ -42,6 +46,7 @@ buffer of LEN bytes."
             (setf ,var (system:allocate-system-memory ,lenvar))
             ,@body)
         (when ,var (system:deallocate-system-memory ,var ,lenvar))))))
             (setf ,var (system:allocate-system-memory ,lenvar))
             ,@body)
         (when ,var (system:deallocate-system-memory ,var ,lenvar))))))

+

 (define-condition unix-error (error)
   ((func :initform 'unknown :initarg :func :reader unix-error-func)
    (args :initform nil :initarg :args :reader unix-error-args)
 (define-condition unix-error (error)
   ((func :initform 'unknown :initarg :func :reader unix-error-func)
    (args :initform nil :initarg :args :reader unix-error-args)


@@ -52,11 +57,13 @@ buffer of LEN bytes."
                     (unix:get-unix-error-msg (unix-error-errno c))
                     (unix-error-errno c))))
   (:documentation "Reports an error from a Unix system call."))
                     (unix:get-unix-error-msg (unix-error-errno c))
                     (unix-error-errno c))))
   (:documentation "Reports an error from a Unix system call."))

+

 (compile-time-defun errno-value (err)
     "Returns the numeric value corresponding to an errno name."
     (etypecase err
       (integer err)
       (symbol (symbol-value (intern (symbol-name err) :unix)))))
 (compile-time-defun errno-value (err)
     "Returns the numeric value corresponding to an errno name."
     (etypecase err
       (integer err)
       (symbol (symbol-value (intern (symbol-name err) :unix)))))

+

 (defmacro with-errno-handlers ((&key cond
                                     (errno (gensym))
                                     errstring)
 (defmacro with-errno-handlers ((&key cond
                                     (errno (gensym))
                                     errstring)


@@ -101,7 +108,8 @@ numbers."
                                       (progn ,@(cdr cl)))))
                         clauses
                         labels)))))))))
                                       (progn ,@(cdr cl)))))
                         clauses
                         labels)))))))))

-(defun unix-try-func (name func &rest args)
+
+(defun syscall* (name func &rest args)

   "Call Unix system call FUNC, passing it ARGS.  If it returns an error,
 signal the unix-error condition, with NAME and ARGS."
   (multiple-value-call (lambda (rc &rest stuff)
   "Call Unix system call FUNC, passing it ARGS.  If it returns an error,
 signal the unix-error condition, with NAME and ARGS."
   (multiple-value-call (lambda (rc &rest stuff)


@@ -112,29 +120,48 @@ signal the unix-error condition, with NAME and ARGS."
                                  :errno (car stuff)))
                         (apply #'values rc stuff))
                       (apply func args)))
                                  :errno (car stuff)))
                         (apply #'values rc stuff))
                       (apply func args)))

-(defmacro unix-try (syscall &rest args)
-  "Wrapper for unix-try-func.  Call Unix system-call SYSCALL (without the
-`unix-' prefix or other stuff), passing it ARGS."
-  (let ((func (intern (format nil "UNIX-~A" (symbol-name syscall)) :unix)))
-    `(unix-try-func ',syscall #',func ,@args)))
-(macrolet ((doit (slots)
+(defmacro syscall (func &rest args)
+  "Call Unix system call FUNC, passing it ARGS.  If it returns an error,
+signal the unix-error condition, with FUNC and ARGS."
+  `(syscall* ',func ,func ,@args))
+
+(macrolet ((doit (doc slots)

             `(defstruct (stat (:predicate statp)
                               (:conc-name st-)
                               (:constructor %make-stat-boa ,slots))
             `(defstruct (stat (:predicate statp)
                               (:conc-name st-)
                               (:constructor %make-stat-boa ,slots))

-               "Structure representing all the useful information `stat'
-returns about a file."
-               ,@slots)))
-  (doit (dev ino mode nlink uid gid rdev size
-        atime mtime ctime blksize blocks)))
-(defun stat (file)
+               ,doc
+               ,@slots)))
+  (doit
+   "Structure representing all the useful information `stat' returns about
+a file."
+   (dev ino mode nlink uid gid rdev size atime mtime ctime blksize blocks)))
+(defun sys-stat (file)

   "Return information about FILE in a structure rather than as inconvenient
 multiple values."
   "Return information about FILE in a structure rather than as inconvenient
 multiple values."

-  (multiple-value-call (lambda (rc &rest results)
-                        (unless rc
-                          (error 'unix-error :func 'stat :args (list file)
-                                 :error (car results)))
-                        (apply #'%make-stat-boa results))
-                      (unix:unix-stat file)))
+  (multiple-value-call
+      (lambda (rc &rest results)
+       (unless rc
+         (error 'unix-error
+                :func 'sys-stat :args (list file)
+                :error (car results)))
+       (apply #'%make-stat-boa results))
+    (unix:unix-stat file)))
+
+(defmacro defsyscall (name)
+  (let ((sysname (intern (format nil "SYS-~:@(~A~)" name)))
+       (unixname (intern (format nil "UNIX-~:@(~A~)" name) :unix)))
+    `(defun ,sysname (&rest args)
+       (apply #'syscall* ',sysname #',unixname args))))
+
+(macrolet ((defsys (&rest names)
+            `(progn ,@(mapcar (lambda (name) 
+                                `(defsyscall ,name))
+                              names))))
+  (defsys open close read write
+         chown fchown chmod fchmod utimes
+         unlink rename
+         gethostname gettimeofday))
+

 (defmacro with-unix-open ((fd file how &optional (mode #o666)) &body body)
   "Evaluate BODY with FD bound to a file descriptor obtained from a Unix
 `open' syscall with arguments FILE, HOW and MODE.  Close the file descriptor
 (defmacro with-unix-open ((fd file how &optional (mode #o666)) &body body)
   "Evaluate BODY with FD bound to a file descriptor obtained from a Unix
 `open' syscall with arguments FILE, HOW and MODE.  Close the file descriptor


@@ -142,29 +169,30 @@ when BODY is done."
   `(let (,fd)
      (unwind-protect
         (progn
   `(let (,fd)
      (unwind-protect
         (progn

-          (setf ,fd (unix-try open ,file ,how ,mode))
+          (setf ,fd (sys-open ,file ,how ,mode))

           ,@body)
           ,@body)

-       (when ,fd (unix-try close ,fd)))))
+       (when ,fd (sys-close ,fd)))))
+

 (defun copy-file (from to &optional (how 0))
   "Make a copy of the file FROM called TO.  The copy has the same permissions
 and timestamps (except for ctime) and attempts to have the same owner and
 group as the original."
 (defun copy-file (from to &optional (how 0))
   "Make a copy of the file FROM called TO.  The copy has the same permissions
 and timestamps (except for ctime) and attempts to have the same owner and
 group as the original."

-  (let ((st (stat from)))
-    (with-unix-open (in from unix:o_rdonly)
+  (let ((st (sys-stat from)))
+    (with-unix-open (in from unix:O_RDONLY)

       (with-unix-open (out
                       to
       (with-unix-open (out
                       to

-                      (logior unix:o_wronly unix:o_creat how)
+                      (logior unix:O_WRONLY unix:O_CREAT how)

                       (logand (st-mode st) #o777))
                       (logand (st-mode st) #o777))

-        (unix-try fchmod out (st-mode st))
-       (unix-try utimes to (st-atime st) 0 (st-mtime st) 0)
+        (sys-fchmod out (st-mode st))
+       (sys-utimes to (st-atime st) 0 (st-mtime st) 0)

        (with-errno-handlers ()
        (with-errno-handlers ()

-         (unix-try fchown out (st-uid st) (st-gid st))
+         (sys-fchown out (st-uid st) (st-gid st))

          (eperm nil))
        (with-buffer (buf 16384)
          (loop
          (eperm nil))
        (with-buffer (buf 16384)
          (loop

-           (let ((n (unix-try read in buf 16384)))
+           (let ((n (sys-read in buf 16384)))

              (when (zerop n)
                (return))
              (when (zerop n)
                (return))

-             (unix-try write out buf 0 n))))))))
+             (sys-write out buf 0 n))))))))

 
 ;;;----- That's all, folks --------------------------------------------------
 
 ;;;----- That's all, folks --------------------------------------------------