Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv32327
Modified Files:
io-port.lisp
Log Message:
Numerous fixes for stack discipline, and also bugs in
io-port-read/write-succession for odd-sized memory blocks.
Date: Wed Sep 22 19:43:35 2004
Author: ffjeld
Index: movitz/losp/muerte/io-port.lisp
diff -u movitz/losp/muerte/io-port.lisp:1.11 movitz/losp/muerte/io-port.lisp:1.12
--- movitz/losp/muerte/io-port.lisp:1.11 Wed Apr 14 18:45:52 2004
+++ movitz/losp/muerte/io-port.lisp Wed Sep 22 19:43:35 2004
@@ -10,7 +10,7 @@
;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org>
;;;; Created at: Wed Mar 21 22:14:08 2001
;;;;
-;;;; $Id: io-port.lisp,v 1.11 2004/04/14 16:45:52 ffjeld Exp $
+;;;; $Id: io-port.lisp,v 1.12 2004/09/22 17:43:35 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -44,12 +44,13 @@
(:xorl :eax :eax)
(:inw :dx :ax)
(:shll ,movitz:+movitz-fixnum-shift+ :eax)
- (:movl :edi :edx)))
+ (:movl :edi :edx)
+ (:cld)))
(:character
`(with-inline-assembly (:returns :eax)
(:compile-form (:result-mode :edx) ,port)
(:std)
- (:shrl #.movitz::+movitz-fixnum-shift+ :edx)
+ (:shrl ,movitz:+movitz-fixnum-shift+ :edx)
(:xorl :eax :eax)
(:inb :dx :al)
(:shll 8 :eax)
@@ -79,142 +80,98 @@
(ecase the-type
(:unsigned-byte8
`(let ((,value-var ,value))
- (with-inline-assembly-case ()
- (do-case (:ignore :nothing)
- (:std)
- (:compile-form (:result-mode :untagged-fixnum-eax) ,value-var)
- (:outb :al ,the-port)
- (:movl :edi :eax)
- (:cld))
- (do-case (t :eax)
- (:std)
- (:compile-form (:result-mode :untagged-fixnum-eax) ,value-var)
- (:outb :al ,the-port)
- (:compile-form (:result-mode :eax) ,value-var)
- (:cld)))))
+ (with-inline-assembly (:returns :nothing)
+ (:load-lexical (:lexical-binding ,value-var) :eax)
+ (:std)
+ (:shrl ,movitz:+movitz-fixnum-shift+ :eax)
+ (:outb :al ,the-port)
+ (:movl :edi :eax)
+ (:movl :edi :edx)
+ (:cld))
+ ,value-var))
(:unsigned-byte16
`(let ((,value-var ,value))
- (with-inline-assembly-case ()
- (do-case (:ignore :nothing)
- (:std)
- (:compile-form (:result-mode :untagged-fixnum-eax) ,value-var)
- (:outw :ax ,the-port)
- (:movl :edi :eax)
- (:cld))
- (do-case (t :eax)
- (:std)
- (:compile-form (:result-mode :untagged-fixnum-eax) ,value-var)
- (:outw :ax ,the-port)
- (:compile-form (:result-mode :eax) ,value-var)
- (:cld)))))))
+ (with-inline-assembly (:returns :nothing)
+ (:load-lexical (:lexical-binding ,value-var) :eax)
+ (:std)
+ (:shrl ,movitz:+movitz-fixnum-shift+ :eax)
+ (:outw :ax ,the-port)
+ (:movl :edi :eax)
+ (:movl :edi :edx)
+ (:cld))
+ ,value-var))))
((unsigned-byte 16) ; indirect (by DX) form of outb must be used
(ecase the-type
(:unsigned-byte8
`(let ((,value-var ,value))
- (with-inline-assembly-case ()
- (do-case (:ignore :nothing)
- (:std)
- (:compile-form (:result-mode :untagged-fixnum-eax) ,value-var)
- ,@(movitz::make-immediate-move the-port :edx)
- (:outb :al :dx)
- ,@(unless (= 0 (mod the-port 4))
- `((:movl :edi :edx)))
- (:movl :edi :eax)
- (:cld))
- (do-case (t :eax)
- (:std)
- (:compile-form (:result-mode :untagged-fixnum-eax) ,value-var)
- ,@(movitz::make-immediate-move the-port :edx)
- (:outb :al :dx)
- ,@(unless (= 0 (mod the-port 4))
- `((:movl :edi :edx)))
- (:compile-form (:result-mode :eax) ,value-var)
- (:cld)))))
+ (with-inline-assembly (:returns :nothing)
+ (:load-lexical (:lexical-binding ,value-var) :eax)
+ (:std)
+ ,@(movitz::make-immediate-move the-port :edx)
+ (:shrl ,movitz:+movitz-fixnum-shift+ :eax)
+ (:outb :al :dx)
+ ,@(unless (= 0 (mod the-port 4))
+ `((:movl :edi :edx)))
+ (:movl :edi :eax)
+ (:cld))
+ ,value-var))
(:unsigned-byte16
`(let ((,value-var ,value))
- (with-inline-assembly-case ()
- (do-case (:ignore :nothing)
- (:std)
- (:compile-form (:result-mode :untagged-fixnum-eax) ,value-var)
- ,@(movitz::make-immediate-move the-port :edx)
- (:outw :ax :dx)
- ,@(unless (= 0 (mod the-port 4))
- `((:movl :edi :edx)))
- (:movl :edi :eax)
- (:cld))
- (do-case (t :eax)
- (:std)
- (:compile-form (:result-mode :untagged-fixnum-eax) ,value-var)
- ,@(movitz::make-immediate-move the-port :edx)
- (:outw :ax :dx)
- ,@(unless (= 0 (mod the-port 4))
- `((:movl :edi :edx)))
- (:compile-form (:result-mode :eax) ,value-var)
- (:cld))))))))))
+ (with-inline-assembly (:returns :nothing)
+ (:load-lexical (:lexical-binding ,value-var) :eax)
+ (:std)
+ ,@(movitz::make-immediate-move the-port :edx)
+ (:shrl ,movitz:+movitz-fixnum-shift+ :eax)
+ (:outw :ax :dx)
+ ,@(unless (= 0 (mod the-port 4))
+ `((:movl :edi :edx)))
+ (:movl :edi :eax)
+ (:cld)))))))))
((movitz:movitz-constantp type env)
(ecase (movitz:movitz-eval type env)
(:unsigned-byte8
`(let ((,value-var ,value)
(,port-var ,port))
- (with-inline-assembly-case ()
- (do-case (:ignore :nothing)
- (:std)
- (:compile-two-forms (:untagged-fixnum-eax :edx) ,value-var ,port-var)
- (:shrl #.movitz::+movitz-fixnum-shift+ :edx)
- (:outb :al :dx)
- (:movl :edi :edx)
- (:movl :edi :eax)
- (:cld))
- (do-case (t :eax)
- (:std)
- (:compile-two-forms (:untagged-fixnum-eax :edx) ,value-var ,port-var)
- (:shrl #.movitz::+movitz-fixnum-shift+ :edx)
- (:outb :al :dx)
- (:movl :edi :edx)
- (:compile-form (:result-mode :eax) ,value-var)
- (:cld)))))
+ (with-inline-assembly (:returns :nothing)
+ (:load-lexical (:lexical-binding ,port-var) :edx)
+ (:load-lexical (:lexical-binding ,value-var) :eax)
+ (:std)
+ (:shrl ,movitz::+movitz-fixnum-shift+ :edx)
+ (:shrl ,movitz::+movitz-fixnum-shift+ :eax)
+ (:outb :al :dx)
+ (:movl :edi :edx)
+ (:movl :edi :eax)
+ (:cld))
+ ,value-var))
(:unsigned-byte16
`(let ((,value-var ,value)
(,port-var ,port))
- (with-inline-assembly-case ()
- (do-case (:ignore :nothing)
- (:std)
- (:compile-two-forms (:untagged-fixnum-eax :edx) ,value-var ,port-var)
- (:shrl #.movitz::+movitz-fixnum-shift+ :edx)
- (:outw :ax :dx)
- (:movl :edi :edx)
- (:movl :edi :eax)
- (:cld))
- (do-case (t :eax)
- (:std)
- (:compile-two-forms (:untagged-fixnum-eax :edx) ,value-var ,port-var)
- (:shrl #.movitz::+movitz-fixnum-shift+ :edx)
- (:outw :ax :dx)
- (:movl :edi :edx)
- (:compile-form (:result-mode :eax) ,value-var)
- (:cld)))))
+ (with-inline-assembly (:returns :nothing)
+ (:load-lexical (:lexical-binding ,port-var) :edx)
+ (:load-lexical (:lexical-binding ,value-var) :eax)
+ (:std)
+ (:shrl ,movitz::+movitz-fixnum-shift+ :edx)
+ (:shrl ,movitz::+movitz-fixnum-shift+ :eax)
+ (:outw :ax :dx)
+ (:movl :edi :edx)
+ (:movl :edi :eax)
+ (:cld))
+ ,value-var))
(:character
`(let ((,value-var ,value)
(,port-var ,port))
- (with-inline-assembly-case ()
- (do-case (:ignore :nothing)
- (:std)
- (:compile-two-forms (:untagged-fixnum-eax :edx) ,value-var ,port-var)
- (:shrl #.movitz::+movitz-fixnum-shift+ :edx)
- (:shrl 8 :eax)
- (:outb :al :dx)
- (:movl :edi :edx)
- (:movl :edi :eax)
- (:cld))
- (do-case (t :eax)
- (:std)
- (:compile-two-forms (:untagged-fixnum-eax :edx) ,value-var ,port-var)
- (:shrl #.movitz::+movitz-fixnum-shift+ :edx)
- (:shrl 8 :eax)
- (:outb :al :dx)
- (:movl :edi :edx)
- (:compile-form (:result-mode :eax) ,value-var)
- (:cld)))))))
+ (with-inline-assembly (:returns :nothing)
+ (:load-lexical (:lexical-binding ,port-var) :edx)
+ (:load-lexical (:lexical-binding ,value-var) :eax)
+ (:std)
+ (:shrl ,movitz::+movitz-fixnum-shift+ :edx)
+ (:shrl ,movitz::+movitz-fixnum-shift+ :eax)
+ (:shrl 8 :eax)
+ (:outb :al :dx)
+ (:movl :edi :edx)
+ (:movl :edi :eax)
+ (:cld))
+ ,value-var))))
(t form))))
(defun (setf io-port) (value port type)
@@ -301,8 +258,8 @@
(,object-var ,object))
(with-inline-assembly-case ()
(do-case (t :eax)
- (:std)
(:compile-two-forms (:edx :ebx) ,port-var ,object-var)
+ (:std)
(:shrl ,movitz::+movitz-fixnum-shift+ :edx)
,@(loop for i from start below end
appending
@@ -315,22 +272,22 @@
(,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)
+ (:std)
(: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))
+ (:cmpl :ecx ,(cl:* movitz::+movitz-fixnum-factor+ end))
(: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))))))
+ (:movl :edi :edx)
+ (:movl :edi :eax)
+ (:cld)
+ (:movl :ebx :eax))))))
(:16-bit
(assert (= 4 movitz:+movitz-fixnum-factor+))
(if (and t (<= 1 count 20))
@@ -386,19 +343,20 @@
(:compile-two-forms (:ecx :eax) ,start-var ,end-var)
(:subl :ecx :eax) ; EAX = length
(:jna 'zero-length)
+ (:movl :eax :esi)
(: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))
+ (:subl ,movitz:+movitz-fixnum-factor+ :esi)
(:movb :al (:ebx ,(+ offset -1) (:ecx 1)))
- (:jnz 'io-read-loop)
- (:popl :edx) ; increment :esp, and put a lispval in :edx.
+ (:ja 'io-read-loop)
zero-length
- (:movl :ebx :eax)
- (:cld)))))
+ (:movl :edi :edx)
+ (:movl :edi :eax)
+ (:cld)
+ (:movl :ebx :eax)))))
(:16-bit
(assert (= 4 movitz:+movitz-fixnum-factor+))
`(let ((,port-var ,port)
@@ -410,21 +368,23 @@
(: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
+ (:subl :ecx :eax)
(:jna 'zero-length)
+ (:movl :eax :esi) ; ESI = 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.
+ (:subl ,(* 2 movitz:+movitz-fixnum-factor+) :esi)
+ (:ja 'io-read-loop)
zero-length
+ (:movl :edi :edx) ; safe value
+ (:movl :edi :eax)
+ (:cld)
(:movl :ebx :eax)
- (:cld)))))
+ (:movl (:ebp -4) :esi)))))
(:32-bit
(assert (= 4 movitz:+movitz-fixnum-factor+))
`(let ((,port-var ,port)
@@ -558,21 +518,23 @@
(:std)
(:compile-two-forms (:edx :ebx) ,port-var ,object-var)
(:compile-two-forms (:ecx :eax) ,start-var ,end-var)
- (:subl :ecx :eax) ; EAX = length
+ (:subl :ecx :eax)
(:jna 'zero-length)
+ (:movl :eax :esi) ; ESI = 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.
+ (:subl ,(* 2 movitz:+movitz-fixnum-factor+) :esi)
+ (:ja 'io-read-loop)
zero-length
+ (:movl :edi :edx)
+ (:movl :edi :eax)
+ (:cld)
(:movl :ebx :eax)
- (:cld)))))
+ (:movl (:ebp -4) :esi)))))
(:32-bit
(assert (= 4 movitz:+movitz-fixnum-factor+))
`(let ((,port-var ,port)
