X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=io.lisp;h=ba68048739c57e4ff55b4138d8e48e6308af95cc;hp=61298add617fceb73802eaba82e48457f7dd411b;hb=1b7f506ec98bd5b885203a3250c52603b943cee9;hpb=e9927af19ebf762b2311f296643c00e3aa9cbb00 diff --git a/io.lisp b/io.lisp index 61298ad..ba68048 100644 --- a/io.lisp +++ b/io.lisp @@ -178,25 +178,10 @@ -#+openmcl -(defun open-device-stream (path direction) - (let* ((mode (ecase direction - (:input #.(read-from-string "#$O_RDONLY")) - (:output #.(read-from-string "#$O_WRONLY")) - (:io #.(read-from-string "#$O_RDWR")))) - (fd (ccl::fd-open (ccl::native-translated-namestring path) mode))) - (if (< fd 0) - (ccl::signal-file-error fd path) - (ccl::make-fd-stream fd :direction direction)))) - (defun null-output-stream () - #-openmcl - (when (probe-file #p"/dev/null") - (open #p"/dev/null" :direction :output :if-exists :overwrite)) - #+openmcl (when (probe-file #p"/dev/null") - (open-device-stream #p"/dev/null" :output)) + (open #p"/dev/null" :direction :output :if-exists :overwrite)) ) @@ -326,4 +311,9 @@ (write-char #\: stream) (write-string (aref +datetime-number-strings+ minute) stream))) +(defun copy-binary-stream (in out) + (do* ((buf (make-array 4096 :element-type '(unsigned-byte 8))) + (pos (read-sequence buf in) (read-sequence buf in))) + ((zerop pos)) + (write-sequence buf out :end pos)))