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@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)