X-Git-Url: https://git.distorted.org.uk/~mdw/lisp/blobdiff_plain/287fd2e6b9ff8d33434595d8e6b6b61fc4a7f9cc..0eed4749891adf0a7be89e786b8968ee805a8d41:/unix.lisp diff --git a/unix.lisp b/unix.lisp index adf95ff..be823f0 100644 --- a/unix.lisp +++ b/unix.lisp @@ -1,4 +1,4 @@ -;;; -*-lisp-*0 +;;; -*-lisp-*- ;;; ;;; $Id$ ;;; @@ -13,18 +13,18 @@ ;;; it under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 2 of the License, or ;;; (at your option) any later version. -;;; +;;; ;;; This program is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. -;;; +;;; ;;; You should have received a copy of the GNU General Public License ;;; along with this program; if not, write to the Free Software Foundation, ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (defpackage #:mdw.unix - (:use #:common-lisp #:mdw.base #:mdw.collect) + (:use #:common-lisp #:mdw.base #:collect) (:export #:unix-error #:errno-value #:with-errno-handlers #:syscall #:syscall* #:stat #:sys-stat @@ -37,12 +37,12 @@ (defmacro with-buffer ((var len) &body body) "Evaluate BODY with VAR bound to a pointer (a SAP, if you must know) to a -buffer of LEN bytes." + buffer of LEN bytes." (with-gensyms lenvar `(let ((,lenvar ,len) (,var nil)) (unwind-protect - (progn + (progn (setf ,var (system:allocate-system-memory ,lenvar)) ,@body) (when ,var (system:deallocate-system-memory ,var ,lenvar)))))) @@ -69,8 +69,8 @@ buffer of LEN bytes." errstring) form &rest clauses) "Evaluate FORM but trap Unix errors according to CLAUSES. Each clause has -the form of a `case' clause, but may contain symbolic errno names as well as -numbers." + the form of a `case' clause, but may contain symbolic errno names as well + as numbers." (flet ((fix (sw) (cond ((eq sw t) 't) ((atom sw) (list (errno-value sw))) @@ -111,7 +111,7 @@ numbers." (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." + signal the unix-error condition, with NAME and ARGS." (multiple-value-call (lambda (rc &rest stuff) (unless rc (error 'unix-error @@ -122,22 +122,23 @@ signal the unix-error condition, with NAME and ARGS." (apply func args))) (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)) + 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)) - ,doc - ,@slots))) + ,doc + ,@slots))) (doit - "Structure representing all the useful information `stat' returns about -a file." + "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 values." (multiple-value-call (lambda (rc &rest results) (unless rc @@ -154,7 +155,7 @@ multiple values." (apply #'syscall* ',sysname #',unixname args)))) (macrolet ((defsys (&rest names) - `(progn ,@(mapcar (lambda (name) + `(progn ,@(mapcar (lambda (name) `(defsyscall ,name)) names)))) (defsys open close read write @@ -164,8 +165,8 @@ multiple values." (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 -when BODY is done." + `open' syscall with arguments FILE, HOW and MODE. Close the file + descriptor when BODY is done." `(let (,fd) (unwind-protect (progn @@ -175,15 +176,15 @@ when BODY is done." (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." + and timestamps (except for ctime) and attempts to have the same owner and + group as the original." (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) (logand (st-mode st) #o777)) - (sys-fchmod out (st-mode st)) + (sys-fchmod out (st-mode st)) (sys-utimes to (st-atime st) 0 (st-mtime st) 0) (with-errno-handlers () (sys-fchown out (st-uid st) (st-gid st))