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

Modified Files: io-port.lisp Log Message: Much changed io-port and (setf io-port), so as to observe the register discipline.

Date: Wed Apr 14 10:39:18 2004 Author: ffjeld

Index: movitz/losp/muerte/io-port.lisp diff -u movitz/losp/muerte/io-port.lisp:1.8 movitz/losp/muerte/io-port.lisp:1.9 --- movitz/losp/muerte/io-port.lisp:1.8 Thu Feb 26 06:18:29 2004 +++ movitz/losp/muerte/io-port.lisp Wed Apr 14 10:39:18 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.8 2004/02/26 11:18:29 ffjeld Exp $ +;;;; $Id: io-port.lisp,v 1.9 2004/04/14 14:39:18 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -25,30 +25,37 @@ (define-compiler-macro io-port (&whole form port type &environment env) (if (not (movitz:movitz-constantp type env)) form - (ecase (movitz::eval-form type env) + (ecase (movitz:movitz-eval type env) (:unsigned-byte8 - `(with-inline-assembly (:returns :untagged-fixnum-eax) + `(with-inline-assembly (:returns :eax) (:compile-form (:result-mode :edx) ,port) - (:andl ,(ash #xffff movitz::+movitz-fixnum-shift+) :edx) - (:shrl #.movitz::+movitz-fixnum-shift+ :edx) + (:std) ; only EBX is now GC root + (:shrl ,movitz::+movitz-fixnum-shift+ :edx) (:xorl :eax :eax) - (:inb :dx :al))) + (:inb :dx :al) + (:shll ,movitz:+movitz-fixnum-shift+ :eax) + (:movl :edi :edx) + (:cld))) (:unsigned-byte16 - `(with-inline-assembly (:returns :untagged-fixnum-eax) + `(with-inline-assembly (:returns :eax) (:compile-form (:result-mode :edx) ,port) - (:andl ,(ash #xffff movitz::+movitz-fixnum-shift+) :edx) - (:shrl #.movitz::+movitz-fixnum-shift+ :edx) + (:std) + (:shrl ,movitz::+movitz-fixnum-shift+ :edx) (:xorl :eax :eax) - (:inw :dx :ax))) + (:inw :dx :ax) + (:shll ,movitz:+movitz-fixnum-shift+ :eax) + (:movl :edi :edx))) (:character `(with-inline-assembly (:returns :eax) (:compile-form (:result-mode :edx) ,port) - (:andl ,(ash #xffff movitz::+movitz-fixnum-shift+) :edx) + (:std) (:shrl #.movitz::+movitz-fixnum-shift+ :edx) (:xorl :eax :eax) (:inb :dx :al) (:shll 8 :eax) - (:movb ,(movitz::tag :character) :al)))))) + (:movb ,(movitz::tag :character) :al) + (:movl :edi :edx) + (:cld))))))

(defun io-port (port type) (ecase type @@ -60,68 +67,161 @@ (io-port port :character))))

(define-compiler-macro (setf io-port) (&whole form value port type) - (let ((value-code (if (not (movitz:movitz-constantp value)) - `((:compile-form (:result-mode :untagged-fixnum-eax) ,value)) - (let ((port-value (movitz::eval-form value))) - (check-type port-value (unsigned-byte 16)) - (movitz::make-immediate-move port-value :eax))))) + (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. (cond ((and (movitz:movitz-constantp type) (movitz:movitz-constantp port)) - (let ((the-port (movitz::eval-form port)) - (the-type (movitz::eval-form type))) + (let ((the-port (movitz:movitz-eval port)) + (the-type (movitz:movitz-eval type))) (etypecase the-port ((unsigned-byte 8) ; short form of outb can be used (ecase the-type (:unsigned-byte8 - `(with-inline-assembly (:returns :untagged-fixnum-eax) - ,@value-code - (:outb :al ,the-port))) + `(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))))) (:unsigned-byte16 - `(with-inline-assembly (:returns :untagged-fixnum-eax) - ,@value-code - (:outw :ax ,the-port))))) + `(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))))))) ((unsigned-byte 16) ; indirect (by DX) form of outb must be used (ecase the-type (:unsigned-byte8 - `(with-inline-assembly (:returns :untagged-fixnum-eax) - ,@value-code - ,@(movitz::make-immediate-move the-port :edx) - (:outb :al :dx))) + `(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))))) (:unsigned-byte16 - `(with-inline-assembly (:returns :untagged-fixnum-eax) - ,@value-code - ,@(movitz::make-immediate-move the-port :edx) - (:outw :ax :dx)))))))) + `(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)))))))))) ((movitz:movitz-constantp type) - (ecase (movitz::eval-form type) + (ecase (movitz:movitz-eval type) (:unsigned-byte8 - `(with-inline-assembly (:returns :untagged-fixnum-eax) - (:compile-form (:result-mode :push) ,port) - ,@value-code - (:popl :edx) - (:shrl #.movitz::+movitz-fixnum-shift+ :edx) - (:outb :al :dx))) + `(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))))) (:unsigned-byte16 - `(with-inline-assembly (:returns :untagged-fixnum-eax) - (:compile-form (:result-mode :push) ,port) - ,@value-code - (:popl :edx) - (:shrl #.movitz::+movitz-fixnum-shift+ :edx) - (:outw :ax :dx))) + `(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))))) (:character - `(with-inline-assembly (:returns :eax) - (:compile-form (:result-mode :push) ,port) - (:compile-form (:result-mode :eax) ,value) - (:cmpb #.(movitz::tag :character) :al) - (:jne '(:sub-program (not-a-character) (:int 60))) - (:popl :edx) - (:shrl 8 :eax) - (:shrl #.movitz::+movitz-fixnum-shift+ :edx) - (:outb :al :dx) - (:shll 8 :eax) - (:movb 2 :al))))) + `(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))))))) (t form))))

(defun (setf io-port) (value port type)