[movitz-cvs] CVS update: movitz/losp/muerte/io-port.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Tue Feb 3 10:03:00 UTC 2004
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 at 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)))))))
- )))))))
More information about the Movitz-cvs
mailing list