[movitz-cvs] CVS update: movitz/losp/muerte/io-port.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Wed Apr 14 14:39:18 UTC 2004
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 at 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)
- , at 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)
- , at 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)
- , at 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)
- , at 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)
- , at 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)
- , at 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)
More information about the Movitz-cvs
mailing list