From 68f3431bf3447b7f98ea24c3802cd2483d273dd3 Mon Sep 17 00:00:00 2001 From: Stelian Ionescu Date: Tue, 15 Jul 2008 11:09:29 +0200 Subject: [PATCH] More code cleanup. Signed-off-by: Stelian Ionescu --- io.streams/zeta/buffer.lisp | 24 ++++++++++++------------ io.streams/zeta/device.lisp | 40 ++++++++++++++++++++-------------------- io.streams/zeta/iobuf.lisp | 32 +++++++++++++++++--------------- io.streams/zeta/misc.lisp | 2 +- io.streams/zeta/types.lisp | 16 +++++++++++----- io.zeta-streams.asd | 2 +- 6 files changed, 62 insertions(+), 54 deletions(-) diff --git a/io.streams/zeta/buffer.lisp b/io.streams/zeta/buffer.lisp index 76d807d..211187c 100644 --- a/io.streams/zeta/buffer.lisp +++ b/io.streams/zeta/buffer.lisp @@ -31,7 +31,7 @@ ;;;----------------------------------------------------------------------------- -;;; Buffer Generic functions +;;; Buffer Generic Functions ;;;----------------------------------------------------------------------------- (defgeneric buffer-clear-input (buffer)) @@ -42,16 +42,16 @@ ;;;----------------------------------------------------------------------------- -;;; Buffered DEVICE-READ +;;; Buffer DEVICE-READ ;;;----------------------------------------------------------------------------- (defmethod device-read ((device buffer) buffer start end &optional timeout) (when (= start end) (return-from device-read 0)) - (read-octets/buffered (input-handle-of device) buffer start end timeout)) + (read-octets/buffered device buffer start end timeout)) -(defun read-octets/buffered (buffer array start end timeout) +(defun read-octets/buffered (buffer vector start end timeout) (declare (type buffer buffer) - (type iobuf-data-array array) + (type ub8-simple-vector vector) (type iobuf-index start end) (type device-timeout timeout)) (with-accessors ((input-handle input-handle-of) @@ -62,9 +62,9 @@ (let ((nbytes (fill-input-buffer input-handle input-buffer timeout))) (if (iobuf-empty-p input-buffer) (if (eql :eof nbytes) :eof 0) - (iobuf->array input-buffer array start end)))) + (iobuf->vector input-buffer vector start end)))) (t - (iobuf->array input-buffer array start end))))) + (iobuf->vector input-buffer vector start end))))) (defun fill-input-buffer (input-handle input-buffer timeout) (multiple-value-bind (data start end) @@ -73,22 +73,22 @@ ;;;----------------------------------------------------------------------------- -;;; Buffered DEVICE-WRITE +;;; Buffer DEVICE-WRITE ;;;----------------------------------------------------------------------------- (defmethod device-write ((device buffer) buffer start end &optional timeout) (when (= start end) (return-from device-write 0)) - (write-octets/buffered (output-handle-of device) buffer start end timeout)) + (write-octets/buffered device buffer start end timeout)) -(defun write-octets/buffered (buffer array start end timeout) +(defun write-octets/buffered (buffer vector start end timeout) (declare (type buffer buffer) - (type iobuf-data-array array) + (type ub8-simple-vector vector) (type iobuf-index start end) (type device-timeout timeout)) (with-accessors ((output-handle output-handle-of) (output-buffer output-buffer-of)) buffer - (array->iobuf output-buffer array start end) + (vector->iobuf output-buffer vector start end) (when (iobuf-full-p output-buffer) (flush-output-buffer output-handle output-buffer timeout)))) diff --git a/io.streams/zeta/device.lisp b/io.streams/zeta/device.lisp index 52b7e89..a3a6c5d 100644 --- a/io.streams/zeta/device.lisp +++ b/io.streams/zeta/device.lisp @@ -44,9 +44,9 @@ (defgeneric device-close (device)) -(defgeneric device-read (device array start end &optional timeout)) +(defgeneric device-read (device vector start end &optional timeout)) -(defgeneric device-write (device array start end &optional timeout)) +(defgeneric device-write (device vector start end &optional timeout)) (defgeneric device-position (device)) @@ -92,22 +92,22 @@ ;;; Default DEVICE-READ ;;;----------------------------------------------------------------------------- -(defmethod device-read ((device device) array start end &optional timeout) +(defmethod device-read ((device device) vector start end &optional timeout) (when (= start end) (return-from device-read 0)) (let ((nbytes (if (and timeout (zerop timeout)) - (read-octets/non-blocking (input-handle-of device) array start end) - (read-octets/timeout (input-handle-of device) array start end timeout)))) + (read-octets/non-blocking (input-handle-of device) vector start end) + (read-octets/timeout (input-handle-of device) vector start end timeout)))) (cond ((eql :eof nbytes) (return-from device-read :eof)) ((and (plusp nbytes) (typep device 'single-channel-device)) (incf (device-position device) nbytes))) (values nbytes))) -(defun read-octets/non-blocking (input-handle array start end) +(defun read-octets/non-blocking (input-handle vector start end) (declare (type unsigned-byte input-handle) - (type iobuf-data-array array) + (type ub8-simple-vector vector) (type iobuf-index start end)) - (with-pointer-to-vector-data (buf array) + (with-pointer-to-vector-data (buf vector) (handler-case (nix:repeat-upon-eintr (nix:read input-handle (inc-pointer buf start) (- end start))) @@ -115,12 +115,12 @@ (:no-error (nbytes) (if (zerop nbytes) :eof nbytes))))) -(defun read-octets/timeout (input-handle array start end timeout) +(defun read-octets/timeout (input-handle vector start end timeout) (declare (type unsigned-byte input-handle) - (type iobuf-data-array array) + (type ub8-simple-vector vector) (type iobuf-index start end) (type device-timeout timeout)) - (with-pointer-to-vector-data (buf array) + (with-pointer-to-vector-data (buf vector) (nix:repeat-decreasing-timeout (remaining timeout :rloop) (flet ((check-timeout () (if (plusp remaining) @@ -138,34 +138,34 @@ ;;; Default DEVICE-WRITE ;;;----------------------------------------------------------------------------- -(defmethod device-write ((device device) array start end &optional timeout) +(defmethod device-write ((device device) vector start end &optional timeout) (when (= start end) (return-from device-write 0)) (let ((nbytes (if (and timeout (zerop timeout)) - (write-octets/non-blocking (output-handle-of device) array start end) - (write-octets/timeout (output-handle-of device) array start end timeout)))) + (write-octets/non-blocking (output-handle-of device) vector start end) + (write-octets/timeout (output-handle-of device) vector start end timeout)))) (cond ((eql :eof nbytes) (return-from device-write :eof)) ((and (plusp nbytes) (typep device 'single-channel-device)) (incf (device-position device) nbytes))) (values nbytes))) -(defun write-octets/non-blocking (output-handle array start end) +(defun write-octets/non-blocking (output-handle vector start end) (declare (type unsigned-byte output-handle) - (type iobuf-data-array array) + (type ub8-simple-vector vector) (type iobuf-index start end)) - (with-pointer-to-vector-data (buf array) + (with-pointer-to-vector-data (buf vector) (handler-case (osicat-posix:repeat-upon-eintr (nix:write output-handle (inc-pointer buf start) (- end start))) (nix:ewouldblock () 0) (nix:epipe () :eof)))) -(defun write-octets/timeout (output-handle array start end timeout) +(defun write-octets/timeout (output-handle vector start end timeout) (declare (type unsigned-byte output-handle) - (type iobuf-data-array array) + (type ub8-simple-vector vector) (type iobuf-index start end) (type device-timeout timeout)) - (with-pointer-to-vector-data (buf array) + (with-pointer-to-vector-data (buf vector) (nix:repeat-decreasing-timeout (remaining timeout :rloop) (flet ((check-timeout () (if (plusp remaining) diff --git a/io.streams/zeta/iobuf.lisp b/io.streams/zeta/iobuf.lisp index 7582057..e3a5cfe 100644 --- a/io.streams/zeta/iobuf.lisp +++ b/io.streams/zeta/iobuf.lisp @@ -16,21 +16,23 @@ (deftype iobuf-index () '(unsigned-byte 27)) (deftype iobuf-length () '(integer 0 #.(expt 2 27))) -(deftype iobuf-data-array () 'ub8-sarray) +(deftype iobuf-data-vector () 'ub8-simple-vector) -(defparameter *empty-array* (make-array 0 :element-type 'ub8)) +(defparameter *empty-vector* (make-array 0 :element-type 'ub8)) (defstruct (iobuf (:constructor %make-iobuf ())) - (data *empty-array* :type iobuf-data-array) + (data *empty-vector* :type iobuf-data-vector) (start 0 :type iobuf-index) (end 0 :type iobuf-index)) +(defun make-iobuf-data-vector (size) + (declare (type iobuf-index size)) + (make-array size :element-type 'ub8 :initial-element 0)) + (defun make-iobuf (&optional size) (declare (type (or null iobuf-index) size)) (let ((b (%make-iobuf))) - (setf (iobuf-data b) (make-array (or size +default-iobuf-size+) - :element-type 'ub8 - :initial-element 0)) + (setf (iobuf-data b) (make-iobuf-data-vector (or size +default-iobuf-size+))) (values b))) (defun iobuf-size (iobuf) @@ -98,7 +100,7 @@ (incf (iobuf-end iobuf))))) (defun replace-ub8 (destination source start1 end1 start2 end2) - (declare (type iobuf-data-array destination source) + (declare (type ub8-simple-vector destination source) (type iobuf-index start1 start2 end1 end2)) (let ((nbytes (min (- end1 start1) (- end2 start2)))) @@ -107,28 +109,28 @@ :start2 start2 :end2 end2) (values destination nbytes))) -(defun iobuf->array (iobuf array start end) - (declare (type iobuf-data-array array) - (type iobuf iobuf) +(defun iobuf->vector (iobuf vector start end) + (declare (type iobuf iobuf) + (type ub8-simple-vector vector) (type iobuf-index start end)) (when (iobuf-empty-p iobuf) (iobuf-reset iobuf)) (let ((nbytes - (nth-value 1 (replace-ub8 array (iobuf-data iobuf) + (nth-value 1 (replace-ub8 vector (iobuf-data iobuf) start end (iobuf-start iobuf) (iobuf-end iobuf))))) (incf (iobuf-start iobuf) nbytes) (values nbytes))) -(defun array->iobuf (iobuf array start end) - (declare (type iobuf-data-array array) - (type iobuf iobuf) +(defun vector->iobuf (iobuf vector start end) + (declare (type iobuf iobuf) + (type ub8-simple-vector vector) (type iobuf-index start end)) (when (iobuf-empty-p iobuf) (iobuf-reset iobuf)) (let ((nbytes - (nth-value 1 (replace-ub8 (iobuf-data iobuf) array + (nth-value 1 (replace-ub8 (iobuf-data iobuf) vector (iobuf-start iobuf) (iobuf-end iobuf) start end)))) diff --git a/io.streams/zeta/misc.lisp b/io.streams/zeta/misc.lisp index c157422..e6555de 100644 --- a/io.streams/zeta/misc.lisp +++ b/io.streams/zeta/misc.lisp @@ -5,7 +5,7 @@ (device-write device octets 0 (length octets)))) (defun device-terpri (device) - (device-write device #.(coerce #(#xA) 'ub8-sarray) 0 1)) + (device-write device #.(coerce #(#xA) 'ub8-simple-vector) 0 1)) (defun device-write-line (device string) (device-write-string device string) diff --git a/io.streams/zeta/types.lisp b/io.streams/zeta/types.lisp index bb3a1e3..37d4ee1 100644 --- a/io.streams/zeta/types.lisp +++ b/io.streams/zeta/types.lisp @@ -9,17 +9,23 @@ ;;; Types ;;;----------------------------------------------------------------------------- -(deftype ub8 () '(unsigned-byte 8)) +(deftype ub8 () '(unsigned-byte 8)) (deftype ub16 () '(unsigned-byte 16)) (deftype ub32 () '(unsigned-byte 32)) -(deftype sb8 () '(signed-byte 8)) +(deftype ub64 () '(unsigned-byte 64)) +(deftype sb8 () '(signed-byte 8)) (deftype sb16 () '(signed-byte 16)) (deftype sb32 () '(signed-byte 32)) +(deftype sb64 () '(signed-byte 64)) -(deftype ub8-sarray (&optional (size '*)) +(deftype ub8-vector (&optional (size '*)) + `(array ub8 (,size))) + +(deftype ub8-simple-vector (&optional (size '*)) `(simple-array ub8 (,size))) -(deftype ub8-vector () '(vector ub8)) +(deftype ub16-vector (&optional (size '*)) + `(array ub16 (,size))) -(deftype ub16-sarray (&optional (size '*)) +(deftype ub16-simple-vector (&optional (size '*)) `(simple-array ub16 (,size))) diff --git a/io.zeta-streams.asd b/io.zeta-streams.asd index 01ea573..aadae08 100644 --- a/io.zeta-streams.asd +++ b/io.zeta-streams.asd @@ -14,7 +14,7 @@ :components ((:file "pkgdcl") (:file "types" :depends-on ("pkgdcl")) - (:file "conditions" :depends-on ("pkgdcl" "types")) + (:file "conditions" :depends-on ("pkgdcl")) (:file "device" :depends-on ("pkgdcl" "types" "conditions")) ;; Devices -- 2.11.4.GIT