[movitz-cvs] CVS update: movitz/losp/muerte/io-port.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Wed Apr 14 16:38:47 UTC 2004
Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv13405
Modified Files:
io-port.lisp
Log Message:
Fixed up %io-port-read-succession and %io-port-write-succession
substantially, so as to observe the register discipline.
Date: Wed Apr 14 12:38:47 2004
Author: ffjeld
Index: movitz/losp/muerte/io-port.lisp
diff -u movitz/losp/muerte/io-port.lisp:1.9 movitz/losp/muerte/io-port.lisp:1.10
--- movitz/losp/muerte/io-port.lisp:1.9 Wed Apr 14 10:39:18 2004
+++ movitz/losp/muerte/io-port.lisp Wed Apr 14 12:38:47 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.9 2004/04/14 14:39:18 ffjeld Exp $
+;;;; $Id: io-port.lisp,v 1.10 2004/04/14 16:38:47 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -68,14 +68,7 @@
(define-compiler-macro (setf io-port) (&whole form value port type)
(let ((value-var (gensym "(setf io-port)-value-"))
- (port-var (gensym "(setf io-port)-port-"))
- #+ignore
- (value-eax-code (if (not (movitz:movitz-constantp value))
- `((:compile-form (:result-mode :untagged-fixnum-eax) ,value))
- (let ((port-value (movitz:movitz-eval value)))
- (check-type port-value (unsigned-byte 16))
- (movitz::make-immediate-move port-value :eax)))))
- ;; value-code will put VALUE in eax.
+ (port-var (gensym "(setf io-port)-port-")))
(cond
((and (movitz:movitz-constantp type)
(movitz:movitz-constantp port))
@@ -288,7 +281,9 @@
&environment env)
(if (not (movitz:movitz-constantp byte-size env))
form
- (let ((byte-size (movitz:movitz-eval byte-size env)))
+ (let ((port-var (gensym "port-var-"))
+ (object-var (gensym "object-var-"))
+ (byte-size (movitz:movitz-eval byte-size env)))
(cond
((and (movitz:movitz-constantp offset env)
(movitz:movitz-constantp start env)
@@ -302,136 +297,158 @@
(:32-bit
(assert (= 4 movitz:+movitz-fixnum-factor+))
(if (<= 1 count 20)
- `(with-inline-assembly-case ()
- (do-case (t :eax)
- (:compile-two-forms (:edx :ebx) ,port ,object)
- (:andl ,(cl:* #xffff movitz::+movitz-fixnum-factor+) :edx)
+ `(let ((,port-var ,port)
+ (,object-var ,object))
+ (with-inline-assembly-case ()
+ (do-case (t :eax)
+ (:std)
+ (:compile-two-forms (:edx :ebx) ,port-var ,object-var)
+ (:shrl ,movitz::+movitz-fixnum-shift+ :edx)
+ ,@(loop for i from start below end
+ appending
+ `((:inl :dx :eax)
+ (:movl :eax (:ebx ,(+ offset (* 4 i))))))
+ (:movl :edi :edx)
+ (:movl :ebx :eax)
+ (:cld))))
+ `(let ((,port-var ,port)
+ (,object-var ,object))
+ (with-inline-assembly-case ()
+ (do-case (t :eax :labels (io-read-loop end-io-read-loop not-fixnum))
+ (:std)
+ (:compile-two-forms (:edx :ebx) ,port-var ,object-var)
(:shrl ,movitz::+movitz-fixnum-shift+ :edx)
- ,@(loop for i from start below end
- appending
- `((:inl :dx :eax)
- (:movl :eax (:ebx ,(+ offset (* 4 i))))))
- (:movl :ebx :eax)))
- `(with-inline-assembly-case ()
- (do-case (t :ebx :labels (io-read-loop end-io-read-loop not-fixnum))
- (:compile-two-forms (:edx :ebx) ,port ,object)
- (:andl ,(cl:* #xffff movitz::+movitz-fixnum-factor+) :edx)
- (:shrl ,movitz::+movitz-fixnum-shift+ :edx)
- (:pushl ,(cl:* movitz::+movitz-fixnum-factor+ end)) ; keep end in (:esp)
- (:movl ,(cl:* movitz::+movitz-fixnum-factor+ start) :ecx)
- io-read-loop
- (:cmpl :ecx (:esp))
- (:jbe 'end-io-read-loop)
- (:addl 4 :ecx)
- (:inl :dx :eax)
- (:movl :eax (:ebx ,(+ offset -4) :ecx))
- (:jmp 'io-read-loop)
- (:popl :eax) ; increment :esp, and put a lispval in :eax.
- end-io-read-loop))))
+ (:pushl ,(cl:* movitz::+movitz-fixnum-factor+ end)) ; keep end in (:esp)
+ (:movl ,(cl:* movitz::+movitz-fixnum-factor+ start) :ecx)
+ io-read-loop
+ (:cmpl :ecx (:esp))
+ (:jbe 'end-io-read-loop)
+ (:addl 4 :ecx)
+ (:inl :dx :eax)
+ (:movl :eax (:ebx ,(+ offset -4) :ecx))
+ (:jmp 'io-read-loop)
+ end-io-read-loop
+ (:popl :edx) ; increment :esp, and put a lispval in :edx.
+ (:movl :ebx :eax)
+ (:cld))))))
(:16-bit
(assert (= 4 movitz:+movitz-fixnum-factor+))
(if (and t (<= 1 count 20))
- `(with-inline-assembly-case ()
- (do-case (t :ebx)
- (:compile-two-forms (:edx :ebx) ,port ,object)
- (:andl ,(cl:* #xffff movitz::+movitz-fixnum-factor+) :edx)
+ `(let ((,port-var ,port)
+ (,object-var ,object))
+ (with-inline-assembly-case ()
+ (do-case (t :eax)
+ (:std)
+ (:compile-two-forms (:edx :ebx) ,port-var ,object-var)
+ (:shrl ,movitz::+movitz-fixnum-shift+ :edx)
+ ,@(loop for i from start below end
+ appending
+ `((:inw :dx :ax)
+ (:movw :ax (:ebx ,(+ offset (* 2 i))))))
+ (:movl :edi :edx)
+ (:movl :ebx :eax)
+ (:cld))))
+ `(let ((,port-var ,port)
+ (,object-var ,object))
+ (with-inline-assembly-case ()
+ (do-case (t :eax :labels (io-read-loop end-io-read-loop not-fixnum))
+ (:std)
+ (:compile-two-forms (:edx :ebx) ,port-var ,object-var)
(:shrl ,movitz::+movitz-fixnum-shift+ :edx)
- (:xorl :eax :eax)
- ,@(loop for i from start below end
- appending
- `((:inw :dx :ax)
- (:movw :ax (:ebx ,(+ offset (* 2 i))))))))
- `(with-inline-assembly-case ()
- (do-case (t :ebx :labels (io-read-loop end-io-read-loop not-fixnum))
- (:compile-two-forms (:edx :ebx) ,port ,object)
- (:andl ,(cl:* #xffff movitz::+movitz-fixnum-factor+) :edx)
- (:shrl ,movitz::+movitz-fixnum-shift+ :edx)
- ;; (:pushl ,(cl:* movitz::+movitz-fixnum-factor+ end)) ; keep end in (:esp)
- (:movl ,(cl:* 1 start) :ecx)
- (:xorl :eax :eax)
- io-read-loop
- (:cmpl ,end :ecx)
- (:ja 'end-io-read-loop)
- (:addl 1 :ecx)
- (:inw :dx :ax)
- (:movw :ax (:ebx ,(+ offset -2) (:ecx 2)))
- (:jmp 'io-read-loop)
- end-io-read-loop))))
+ (:movl ,(cl:* 1 start) :ecx)
+ io-read-loop
+ (:cmpl ,end :ecx)
+ (:ja 'end-io-read-loop)
+ (:addl 1 :ecx)
+ (:inw :dx :ax)
+ (:movw :ax (:ebx ,(+ offset -2) (:ecx 2)))
+ (:jmp 'io-read-loop)
+ end-io-read-loop
+ (:movl :edi :edx)
+ (:movl :ebx :eax)
+ (:cld))))))
(t (error "~S byte-size ~S not implemented." (car form) byte-size)))))
((and (movitz:movitz-constantp offset env))
- (let ((offset (movitz:movitz-eval offset env)))
+ (let ((start-var (gensym "start-"))
+ (end-var (gensym "end-"))
+ (offset (movitz:movitz-eval offset env)))
(case byte-size
(:8-bit
(assert (= 4 movitz:+movitz-fixnum-factor+))
- `(with-inline-assembly-case ()
- (do-case (t :ebx :labels (io-read-loop end-io-read-loop not-fixnum))
- (:compile-form (:result-mode :push) ,port)
- (:compile-form (:result-mode :push) ,object)
- (:compile-two-forms (:ecx :eax) ,start ,end)
- (:popl :ebx) ; object
- (:popl :edx) ; port
- (:andl #.(cl:* #xffff movitz::+movitz-fixnum-factor+) :edx)
- (:andl #.(cl:* #xffff movitz::+movitz-fixnum-factor+) :eax)
- (:andl #.(cl:* #xffff movitz::+movitz-fixnum-factor+) :ecx)
- (:shrl #.movitz::+movitz-fixnum-shift+ :edx)
- (:shrl #.movitz::+movitz-fixnum-shift+ :eax)
- (:shrl #.movitz::+movitz-fixnum-shift+ :ecx)
- (:pushl :eax) ; keep end in (:esp)
- io-read-loop
- (:cmpl :ecx (:esp))
- (:jbe 'end-io-read-loop)
- (:inb :dx :al)
- (:addl 1 :ecx)
- (:movb :al (:ebx ,(+ offset -1) (:ecx 1)))
- (:jmp 'io-read-loop)
- (:popl :eax) ; increment :esp, and put a lispval in :eax.
- end-io-read-loop)))
+ `(let ((,port-var ,port)
+ (,object-var ,object)
+ (,start-var ,start)
+ (,end-var ,end))
+ (with-inline-assembly-case ()
+ (do-case (t :eax :labels (io-read-loop not-fixnum zero-length))
+ (:std)
+ (:compile-two-forms (:edx :ebx) ,port-var ,object-var)
+ (:compile-two-forms (:ecx :eax) ,start-var ,end-var)
+ (:subl :ecx :eax) ; EAX = length
+ (:jna 'zero-length)
+ (:shrl ,movitz::+movitz-fixnum-shift+ :edx)
+ (:shrl ,movitz::+movitz-fixnum-shift+ :ecx)
+ (:pushl :eax) ; keep length in (:esp)
+ io-read-loop
+ (:inb :dx :al)
+ (:addl 1 :ecx)
+ (:subl ,movitz:+movitz-fixnum-factor+ (:esp))
+ (:movb :al (:ebx ,(+ offset -1) (:ecx 1)))
+ (:jnz 'io-read-loop)
+ (:popl :edx) ; increment :esp, and put a lispval in :edx.
+ zero-length
+ (:movl :ebx :eax)
+ (:cld)))))
(:16-bit
(assert (= 4 movitz:+movitz-fixnum-factor+))
- `(with-inline-assembly-case ()
- (do-case (t :ebx :labels (io-read-loop end-io-read-loop not-fixnum))
- (:compile-form (:result-mode :push) ,port)
- (:compile-form (:result-mode :push) ,object)
- (:compile-two-forms (:ecx :eax) ,start ,end)
- (:popl :ebx) ; object
- (:popl :edx) ; port
- (:andl #.(cl:* #xffff movitz::+movitz-fixnum-factor+) :edx)
- (:andl #.(cl:* #xffff movitz::+movitz-fixnum-factor+) :eax)
- (:andl #.(cl:* #xffff movitz::+movitz-fixnum-factor+) :ecx)
- (:shrl #.movitz::+movitz-fixnum-shift+ :edx)
- (:shrl #.movitz::+movitz-fixnum-shift+ :eax)
- (:shrl #.movitz::+movitz-fixnum-shift+ :ecx)
- (:pushl :eax) ; keep end in (:esp)
- io-read-loop
- (:cmpl :ecx (:esp))
- (:jbe 'end-io-read-loop)
- (:inw :dx :ax)
- (:addl 2 :ecx)
- (:movw :ax (:ebx ,(+ offset -2) :ecx))
- (:jmp 'io-read-loop)
- (:popl :eax) ; increment :esp, and put a lispval in :eax.
- end-io-read-loop)))
+ `(let ((,port-var ,port)
+ (,object-var ,object)
+ (,start-var ,start)
+ (,end-var ,end))
+ (with-inline-assembly-case ()
+ (do-case (t :eax :labels (io-read-loop not-fixnum zero-length))
+ (:std) ; only EBX is GC root now
+ (:compile-two-forms (:edx :ebx) ,port-var ,object-var)
+ (:compile-two-forms (:ecx :eax) ,start-var ,end-var)
+ (:subl :ecx :eax) ; EAX = length
+ (:jna 'zero-length)
+ (:shrl ,movitz::+movitz-fixnum-shift+ :edx)
+ (:shrl ,movitz::+movitz-fixnum-shift+ :ecx)
+ (:pushl :eax) ; keep end in (:esp)
+ io-read-loop
+ (:inw :dx :ax)
+ (:addl 2 :ecx)
+ (:subl ,(* 2 movitz:+movitz-fixnum-factor+) (:esp))
+ (:movw :ax (:ebx ,(+ offset -2) (:ecx 1)))
+ (:jnz 'io-read-loop)
+ (:popl :edx) ; increment :esp, and put a lispval in :edx.
+ zero-length
+ (:movl :ebx :eax)
+ (:cld)))))
(:32-bit
(assert (= 4 movitz:+movitz-fixnum-factor+))
- `(with-inline-assembly-case ()
- (do-case (t :ebx :labels (io-read-loop end-io-read-loop not-fixnum))
- (:compile-form (:result-mode :push) ,port)
- (:compile-form (:result-mode :push) ,object)
- (:compile-two-forms (:ecx :eax) ,start ,end)
- (:popl :ebx) ; object
- (:popl :edx) ; port
- (:andl #.(cl:* #xffff movitz::+movitz-fixnum-factor+) :edx)
- (:shrl #.movitz::+movitz-fixnum-shift+ :edx)
- (:pushl :eax) ; keep end in (:esp)
- io-read-loop
- (:cmpl :ecx (:esp))
- (:jbe 'end-io-read-loop)
- (:inl :dx :eax)
- (:addl 4 :ecx)
- (:movl :eax (:ebx ,(+ offset -4) :ecx))
- (:jmp 'io-read-loop)
- (:popl :eax) ; increment :esp, and put a lispval in :eax.
- end-io-read-loop)))
+ `(let ((,port-var ,port)
+ (,object-var ,object)
+ (,start-var ,start)
+ (,end-var ,end))
+ (with-inline-assembly-case ()
+ (do-case (t :eax :labels (io-read-loop end-io-read-loop not-fixnum))
+ (:std) ; only EBX is GC root now
+ (:compile-two-forms (:edx :ebx) ,port-var ,object-var)
+ (:compile-two-forms (:ecx :eax) ,start-var ,end-var)
+ (:shrl ,movitz::+movitz-fixnum-shift+ :edx)
+ (:pushl :eax) ; keep end in (:esp)
+ io-read-loop
+ (:cmpl :ecx (:esp))
+ (:jbe 'end-io-read-loop)
+ (:inw :dx :ax)
+ (:addl 4 :ecx)
+ (:movw :ax (:ebx ,(+ offset -4) :ecx))
+ (:jmp 'io-read-loop)
+ end-io-read-loop
+ (:popl :edx) ; increment :esp, and put a lispval in :edx.
+ (:movl :ebx :eax)
+ (:cld)))))
(t (error "~S byte-size ~S not implemented." (car form) byte-size)))))
(t (error "Variable offset not implemented."))))))
@@ -451,7 +468,9 @@
&environment env)
(if (not (movitz:movitz-constantp byte-size env))
form
- (let ((byte-size (movitz:movitz-eval byte-size env)))
+ (let ((port-var (gensym "port-var-"))
+ (object-var (gensym "object-var-"))
+ (byte-size (movitz:movitz-eval byte-size env)))
(cond
((and (movitz:movitz-constantp offset env)
(movitz:movitz-constantp start env)
@@ -465,107 +484,120 @@
(:32-bit
(assert (= 4 movitz:+movitz-fixnum-factor+))
(if (<= 1 count 20)
- `(with-inline-assembly-case ()
- (do-case (t :eax)
- (:compile-two-forms (:edx :ebx) ,port ,object)
- (:andl ,(cl:* #xffff movitz::+movitz-fixnum-factor+) :edx)
+ `(let ((,port-var ,port)
+ (,object-var ,object))
+ (with-inline-assembly-case ()
+ (do-case (t :eax)
+ (:std)
+ (:compile-two-forms (:edx :ebx) ,port-var ,object-var)
+ (:shrl ,movitz::+movitz-fixnum-shift+ :edx)
+ ,@(loop for i from start below end
+ appending
+ `((:movl (:ebx ,(+ offset (* 4 i))) :eax)
+ (:outl :eax :dx)))
+ (:movl :edi :edx)
+ (:movl :ebx :eax)
+ (:cld))))
+ `(let ((,port-var ,port)
+ (,object-var ,object))
+ (with-inline-assembly-case ()
+ (do-case (t :eax :labels (io-read-loop end-io-read-loop not-fixnum))
+ (:std)
+ (:compile-two-forms (:edx :ebx) ,port-var ,object-var)
(:shrl ,movitz::+movitz-fixnum-shift+ :edx)
- ,@(loop for i from start below end
- appending
- `((:movl (:ebx ,(+ offset (* 4 i))) :eax)
- (:outl :eax :dx)))
- (:movl :ebx :eax)))
- `(with-inline-assembly-case ()
- (do-case (t :ebx :labels (io-read-loop end-io-read-loop not-fixnum))
- (:compile-two-forms (:edx :ebx) ,port ,object)
- (:andl ,(cl:* #xffff movitz::+movitz-fixnum-factor+) :edx)
- (:shrl ,movitz::+movitz-fixnum-shift+ :edx)
- (:pushl ,(cl:* movitz::+movitz-fixnum-factor+ end)) ; keep end in (:esp)
- (:movl ,(cl:* movitz::+movitz-fixnum-factor+ start) :ecx)
- io-read-loop
- (:cmpl :ecx (:esp))
- (:jbe 'end-io-read-loop)
- (:addl 4 :ecx)
- (:movl (:ebx ,(+ offset -4) :ecx) :eax)
- (:outl :eax :dx)
- (:jmp 'io-read-loop)
- (:popl :eax) ; increment :esp, and put a lispval in :eax.
- end-io-read-loop))))
+ (:movl ,(cl:* movitz::+movitz-fixnum-factor+ start) :ecx)
+ io-read-loop
+ (:cmpl :ecx ,(cl:* movitz::+movitz-fixnum-factor+ end)) ; XXX
+ (:jbe 'end-io-read-loop)
+ (:addl 4 :ecx)
+ (:movl (:ebx ,(+ offset -4) :ecx) :eax)
+ (:outl :eax :dx)
+ (:jmp 'io-read-loop)
+ end-io-read-loop
+ (:movl :edi :edx)
+ (:movl :ebx :eax)
+ (:cld))))))
(t (error "~S byte-size ~S not implemented." (car form) byte-size)))))
((and (movitz:movitz-constantp offset env))
- (let ((offset (movitz:movitz-eval offset env)))
+ (let ((start-var (gensym "start-"))
+ (end-var (gensym "end-"))
+ (offset (movitz:movitz-eval offset env)))
(case byte-size
(:8-bit
- (assert (= 4 movitz:+movitz-fixnum-factor+))
- `(with-inline-assembly-case ()
- (do-case (t :ebx :labels (io-read-loop end-io-read-loop not-fixnum))
- (:compile-form (:result-mode :push) ,port)
- (:compile-form (:result-mode :push) ,object)
- (:compile-two-forms (:ecx :eax) ,start ,end)
- (:popl :ebx) ; object
- (:popl :edx) ; port
- (:andl #.(cl:* #xffff movitz::+movitz-fixnum-factor+) :edx)
- (:andl #.(cl:* #xffff movitz::+movitz-fixnum-factor+) :eax)
- (:andl #.(cl:* #xffff movitz::+movitz-fixnum-factor+) :ecx)
- (:shrl #.movitz::+movitz-fixnum-shift+ :edx)
- (:shrl #.movitz::+movitz-fixnum-shift+ :eax)
- (:shrl #.movitz::+movitz-fixnum-shift+ :ecx)
- (:pushl :eax) ; keep end in (:esp)
- io-read-loop
- (:cmpl :ecx (:esp))
- (:jbe 'end-io-read-loop)
- (:addl 1 :ecx)
- (:movb (:ebx ,(+ offset -1) (:ecx 1)) :al)
- (:outb :al :dx)
- (:jmp 'io-read-loop)
- (:popl :eax) ; increment :esp, and put a lispval in :eax.
- end-io-read-loop)))
+ `(let ((,port-var ,port)
+ (,object-var ,object)
+ (,start-var ,start)
+ (,end-var ,end))
+ (with-inline-assembly-case ()
+ (do-case (t :eax :labels (io-read-loop not-fixnum zero-length))
+ (:std)
+ (:compile-two-forms (:edx :ebx) ,port-var ,object-var)
+ (:compile-two-forms (:ecx :eax) ,start-var ,end-var)
+ (:subl :ecx :eax) ; EAX = length
+ (:jna 'zero-length)
+ (:shrl ,movitz::+movitz-fixnum-shift+ :edx)
+ (:shrl ,movitz::+movitz-fixnum-shift+ :ecx)
+ (:pushl :eax) ; keep end in (:esp)
+ io-read-loop
+ (:addl 1 :ecx)
+ (:subl ,movitz:+movitz-fixnum-factor+ (:esp))
+ (:movb (:ebx ,(+ offset -1) (:ecx 1)) :al)
+ (:outb :al :dx)
+ (:jnz 'io-read-loop)
+ (:popl :edx) ; increment :esp, and put a lispval in :edx.
+ zero-length
+ (:movl :ebx :eax)
+ (:cld)))))
(:16-bit
- (assert (= 4 movitz:+movitz-fixnum-factor+))
- `(with-inline-assembly-case ()
- (do-case (t :ebx :labels (io-read-loop end-io-read-loop not-fixnum))
- (:compile-form (:result-mode :push) ,port)
- (:compile-form (:result-mode :push) ,object)
- (:compile-two-forms (:ecx :eax) ,start ,end)
- (:popl :ebx) ; object
- (:popl :edx) ; port
- (:andl #.(cl:* #xffff movitz::+movitz-fixnum-factor+) :edx)
- (:andl #.(cl:* #xffff movitz::+movitz-fixnum-factor+) :eax)
- (:andl #.(cl:* #xffff movitz::+movitz-fixnum-factor+) :ecx)
- (:shrl #.movitz::+movitz-fixnum-shift+ :edx)
- (:shrl #.movitz::+movitz-fixnum-shift+ :eax)
- (:shrl #.movitz::+movitz-fixnum-shift+ :ecx)
- (:pushl :eax) ; keep end in (:esp)
- io-read-loop
- (:cmpl :ecx (:esp))
- (:jbe 'end-io-read-loop)
- (:addl 2 :ecx)
- (:movw (:ebx ,(+ offset -2) :ecx) :ax)
- (:outw :ax :dx)
- (:jmp 'io-read-loop)
- (:popl :eax) ; increment :esp, and put a lispval in :eax.
- end-io-read-loop)))
+ `(let ((,port-var ,port)
+ (,object-var ,object)
+ (,start-var ,start)
+ (,end-var ,end))
+ (with-inline-assembly-case ()
+ (do-case (t :eax :labels (io-read-loop not-fixnum zero-length))
+ (:std)
+ (:compile-two-forms (:edx :ebx) ,port-var ,object-var)
+ (:compile-two-forms (:ecx :eax) ,start-var ,end-var)
+ (:subl :ecx :eax) ; EAX = length
+ (:jna 'zero-length)
+ (:shrl ,movitz::+movitz-fixnum-shift+ :edx)
+ (:shrl ,movitz::+movitz-fixnum-shift+ :ecx)
+ (:pushl :eax) ; keep end in (:esp)
+ io-read-loop
+ (:addl 2 :ecx)
+ (:subl ,(* 2 movitz:+movitz-fixnum-factor+) (:esp))
+ (:movw (:ebx ,(+ offset -2) (:ecx 1)) :ax)
+ (:outw :ax :dx)
+ (:jnz 'io-read-loop)
+ (:popl :edx) ; increment :esp, and put a lispval in :edx.
+ zero-length
+ (:movl :ebx :eax)
+ (:cld)))))
(:32-bit
(assert (= 4 movitz:+movitz-fixnum-factor+))
- `(with-inline-assembly-case ()
- (do-case (t :ebx :labels (io-read-loop end-io-read-loop not-fixnum))
- (:compile-form (:result-mode :push) ,port)
- (:compile-form (:result-mode :push) ,object)
- (:compile-two-forms (:ecx :eax) ,start ,end)
- (:popl :ebx) ; object
- (:popl :edx) ; port
- (:andl #.(cl:* #xffff movitz::+movitz-fixnum-factor+) :edx)
- (:shrl #.movitz::+movitz-fixnum-shift+ :edx)
- (:pushl :eax) ; keep end in (:esp)
- io-read-loop
- (:cmpl :ecx (:esp))
- (:jbe 'end-io-read-loop)
- (:addl 4 :ecx)
- (:movl (:ebx ,(+ offset -4) :ecx) :eax)
- (:outl :eax :dx)
- (:jmp 'io-read-loop)
- (:popl :eax) ; increment :esp, and put a lispval in :eax.
- end-io-read-loop)))
+ `(let ((,port-var ,port)
+ (,object-var ,object)
+ (,start-var ,start)
+ (,end-var ,end))
+ (with-inline-assembly-case ()
+ (do-case (t :eax :labels (io-read-loop not-fixnum end-io-read-loop))
+ (:std)
+ (:compile-two-forms (:edx :ebx) ,port-var ,object-var)
+ (:compile-two-forms (:ecx :eax) ,start-var ,end-var)
+ (:shrl ,movitz::+movitz-fixnum-shift+ :edx)
+ (:shrl ,movitz::+movitz-fixnum-shift+ :ecx)
+ (:pushl :eax) ; keep end in (:esp)
+ io-read-loop
+ (:cmpl :ecx (:esp))
+ (:jbe 'end-io-read-loop)
+ (:addl 4 :ecx)
+ (:movl (:ebx ,(+ offset -4) (:ecx 1)) :eax)
+ (:outl :eax :dx)
+ (:jmp 'io-read-loop)
+ end-io-read-loop
+ (:popl :edx) ; increment :esp, and put a lispval in :edx.
+ (:movl :ebx :eax)
+ (:cld)))))
(t (error "~S byte-size ~S not implemented." (car form) byte-size)))))
(t (error "Variable offset not implemented."))))))
More information about the Movitz-cvs
mailing list