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)
-    (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)
-    (unix-try rename old new)))
+    (sys-rename old new)))
 
 (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))
-                           (unix-try rename new file)))
+                           (sys-rename new file)))
                  (: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)

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
-          #: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)
 
@@ -42,6 +46,7 @@ buffer of LEN bytes."
             (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)
@@ -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."))
+
 (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)
@@ -101,7 +108,8 @@ numbers."
                                       (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)
@@ -112,29 +120,48 @@ signal the unix-error condition, with NAME and 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))
-               "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."
-  (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
@@ -142,29 +169,30 @@ when BODY is done."
   `(let (,fd)
      (unwind-protect
         (progn
-          (setf ,fd (unix-try open ,file ,how ,mode))
+          (setf ,fd (sys-open ,file ,how ,mode))
           ,@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."
-  (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
-                      (logior unix:o_wronly unix:o_creat how)
+                      (logior unix:O_WRONLY unix:O_CREAT how)
                       (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 ()
-         (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
-           (let ((n (unix-try read in buf 16384)))
+           (let ((n (sys-read in buf 16384)))
              (when (zerop n)
                (return))
-             (unix-try write out buf 0 n))))))))
+             (sys-write out buf 0 n))))))))
 
 ;;;----- That's all, folks --------------------------------------------------