Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv5989

Modified Files: io-port.lisp Log Message: Removed old io-port-read/write-sequence.

Date: Tue Feb 3 05:02:59 2004 Author: ffjeld

Index: movitz/losp/muerte/io-port.lisp diff -u movitz/losp/muerte/io-port.lisp:1.6 movitz/losp/muerte/io-port.lisp:1.7 --- movitz/losp/muerte/io-port.lisp:1.6 Sun Feb 1 17:16:26 2004 +++ movitz/losp/muerte/io-port.lisp Tue Feb 3 05:02:59 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld frodef@acm.org ;;;; Created at: Wed Mar 21 22:14:08 2001 ;;;; -;;;; $Id: io-port.lisp,v 1.6 2004/02/01 22:16:26 ffjeld Exp $ +;;;; $Id: io-port.lisp,v 1.7 2004/02/03 10:02:59 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -480,203 +480,4 @@ (:32-bit (%io-port-write-succession port object 2 start end :32-bit)) (t (error "Unknown byte-size ~S." byte-size)))) - - -(defun io-port-read-sequence (sequence port type transfer-unit &key (start 0) end) - (etypecase sequence - ((or string muerte::vector-u8) - (unless end (setf end (length sequence))) - (let ((size (- end start))) - (assert (<= 0 start end (length sequence)) (start end) - "io-port-read-sequence out of bounds: ~D - ~D into ~D / ~D" start end (length sequence) (array-dimension sequence 0)) - (ecase type - (:unsigned-byte8 - (ecase transfer-unit - (:8-bits - ;; one-to-one - (with-inline-assembly (:returns :nothing) - (:compile-form (:result-mode :edx) port) - (:shrl #.movitz::+movitz-fixnum-shift+ :edx) - (:compile-form (:result-mode :ecx) start) - (:compile-form (:result-mode :ebx) sequence) - (:shrl #.movitz::+movitz-fixnum-shift+ :ecx) - (:addl #.(bt:slot-offset 'movitz::movitz-vector 'movitz::data) :ebx) - (:addl :ecx :ebx) - (:compile-form (:result-mode :ecx) size) - (:shrl #.movitz::+movitz-fixnum-shift+ :ecx) - (:xorl :eax :eax) - (:jecxz 'read8-done) - read8-loop - (:inb :dx :al) - (:movb :al (:ebx)) - (:incl :ebx) - (:decl :ecx) - (:jnz 'read8-loop) - read8-done)) - (:16-bits - ;; each 16-bits IOW maps to two u2 - (with-inline-assembly (:returns :nothing) - (:compile-form (:result-mode :edx) port) - (:shrl #.movitz::+movitz-fixnum-shift+ :edx) - (:compile-form (:result-mode :ecx) start) - (:compile-form (:result-mode :ebx) sequence) - (:shrl #.movitz::+movitz-fixnum-shift+ :ecx) - (:addl #.(bt:slot-offset 'movitz::movitz-vector 'movitz::data) :ebx) - (:addl :ecx :ebx) - (:compile-form (:result-mode :ecx) size) - (:shrl #.(cl:1+ movitz::+movitz-fixnum-shift+) :ecx) - (:xorl :eax :eax) - (:jecxz 'read16-done) - read16-loop - (:inw :dx :ax) - (:movw :ax (:ebx)) - (:addl 2 :ebx) - (:decl :ecx) - (:jnz 'read16-loop) - read16-done)))) - (:unsigned-byte16 - (ecase transfer-unit - (:16-bits - ;; 16-bit io-port squeezed into 8 bits.. - (with-inline-assembly (:returns :nothing) - (:compile-form (:result-mode :edx) port) - (:shrl #.movitz::+movitz-fixnum-shift+ :edx) - (:compile-form (:result-mode :ebx) sequence) - (:addl #.(bt:slot-offset 'movitz::movitz-vector 'movitz::data) :ebx) - (:compile-form (:result-mode :ecx) start) - (:shrl #.movitz::+movitz-fixnum-shift+ :ecx) - (:addl :ecx :ebx) - (:compile-form (:result-mode :ecx) size) - (:shrl #.movitz::+movitz-fixnum-shift+ :ecx) - (:xorl :eax :eax) - (:jecxz 'read16-8-done) - read16-8-loop - (:inw :dx :ax) - (:movb :al (:ebx)) - (:incl :ebx) - (:decl :ecx) - (:jnz 'read16-8-loop) - read16-8-done))))))) - (vector - (unless end (setf end (length sequence))) - (let ((size (- end start))) - (assert (<= 0 start end (length sequence)) (start end) - "io-port-read-sequence out of bounds.") - (ecase type - (:unsigned-byte8 - (ecase transfer-unit - (:8-bits - (dotimes (i size) - (setf (aref sequence (+ start i)) - (io-port port :unsigned-byte8)))) - (:16-bits - (dotimes (i (truncate size 2)) - (let ((byte (io-port port :unsigned-byte16))) - (setf (aref sequence (+ start (* 2 i))) (ldb (byte 8 0) byte) ; little endian.. - (aref sequence (+ start (* 2 i) 1)) (ldb (byte 8 8) byte)))))))))) - (list - (when sequence - (let ((start-cons (nthcdr start sequence))) - (assert start-cons (sequence) - "Sequence start ~D out of range: ~S" start sequence) - (ecase type - (:unsigned-byte8 - (ecase transfer-unit - (:8-bits - (if (not end) - (loop for p on start-cons - do (setf (car p) (io-port port :unsigned-byte8))) - (loop for i upfrom start below end as p on (nthcdr start sequence) - do (setf (car p) (io-port port :unsigned-byte8)) - finally (assert (= i end) (end) - "Sequence end ~D out of range: ~S" end sequence)))) - (:16-bits - (if (not end) - (loop for p on start-cons by #'cddr - do (let ((byte (io-port port :unsigned-byte16))) - (setf (car p) (ldb (byte 8 0) byte) ; little endian.. - (cadr p) (ldb (byte 8 8) byte)))) - (loop for i upfrom start below end by 2 as p on (nthcdr start sequence) by #'cddr - do (let ((byte (io-port port :unsigned-byte16))) - (setf (car p) (ldb (byte 8 0) byte) ; little endian.. - (cadr p) (ldb (byte 8 8) byte))) - finally (assert (= i end) (end) - "Sequence end ~D out of range: ~S" end sequence))))))))))) - sequence) - -(defun io-port-write-sequence (sequence port type transfer-unit &key (start 0) end) - (etypecase sequence - ((or string muerte::vector-u8) - (unless end (setf end (length sequence))) - (let ((size (- end start))) - (assert (<= 0 start end (length sequence)) (start end) - "io-port-write-sequence out of bounds.") - (ecase type - ((:unsigned-byte8) - (ecase (or transfer-unit :8-bits) - (:8-bits - ;; one-to-one - (with-inline-assembly (:returns :nothing) - (:compile-form (:result-mode :edx) port) - (:shrl #.movitz::+movitz-fixnum-shift+ :edx) - (:compile-form (:result-mode :ebx) sequence) - (:compile-form (:result-mode :ecx) start) - (:addl #.(bt:slot-offset 'movitz::movitz-vector 'movitz::data) :ebx) - (:shrl #.movitz::+movitz-fixnum-shift+ :ecx) - (:addl :ecx :ebx) - (:compile-form (:result-mode :ecx) size) - (:xorl :eax :eax) - (:shrl #.movitz::+movitz-fixnum-shift+ :ecx) - (:align :code :loop) - write8-loop - (:movb (:ebx) :al) - (:outb :al :dx) - (:incl :ebx) - (:decl :ecx) - (:jnz 'write8-loop))) - (:16-bits - ;; each 16-bits IOW maps to two u2 - (with-inline-assembly (:returns :nothing) - (:compile-form (:result-mode :edx) port) - (:shrl #.movitz::+movitz-fixnum-shift+ :edx) - (:compile-form (:result-mode :ebx) sequence) - (:compile-form (:result-mode :ecx) start) - (:addl #.(bt:slot-offset 'movitz::movitz-vector 'movitz::data) :ebx) - (:shrl #.movitz::+movitz-fixnum-shift+ :ecx) - (:addl :ecx :ebx) - (:compile-form (:result-mode :ecx) size) - (:xorl :eax :eax) - (:shrl #.(cl:1+ movitz::+movitz-fixnum-shift+) :ecx) - (:align :code :loop) - write16-loop - (:movw (:ebx) :ax) - (:outw :ax :dx) - (:addl 2 :ebx) - (:decl :ecx) - (:jnz 'write16-loop)))))))) - (vector - (unless end (setf end (length sequence))) - (let ((size (- end start))) - (ecase type - (:character - (ecase (or transfer-unit :8-bits) - (:8-bits - (dotimes (i size) - (setf (io-port port :character) - (char sequence (+ start i))))))) - (:unsigned-byte8 - (ecase (or transfer-unit :8-bits) - (:8-bits - ;; one-to-one 8 bits - (dotimes (i size) - (setf (io-port port :unsigned-byte8) - (aref sequence (+ start i))))) - (:16-bits - ;; two by two (8-bit) array elements into each 16-bit io-port - (dotimes (i (truncate size 2)) - (setf (io-port port :unsigned-byte16) - (dpb (aref sequence (+ start (* 2 i) 1)) ; little endian.. - (byte 8 8) - (aref sequence (+ start (* 2 i))))))) - )))))))