[movitz-cvs] CVS update: movitz/losp/muerte/io-port.lisp - movitz-cvs@common-lisp.net - mailman3.common-lisp.net

15 Aug 2005

Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv7446
Modified Files:
    io-port.lisp 
Log Message:
Smarted up io-port compiler-macros a bit.
Date: Mon Aug 15 02:06:19 2005
Author: ffjeld
Index: movitz/losp/muerte/io-port.lisp
diff -u movitz/losp/muerte/io-port.lisp:1.16 movitz/losp/muerte/io-port.lisp:1.17

--- movitz/losp/muerte/io-port.lisp:1.16	Sat Aug 13 00:55:43 2005
+++ movitz/losp/muerte/io-port.lisp	Mon Aug 15 02:06:19 2005
@@ -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.16 2005/08/12 22:55:43 ffjeld Exp $
+;;;; $Id: io-port.lisp,v 1.17 2005/08/15 00:06:19 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
@@ -27,27 +27,50 @@
       form
     (ecase (movitz:movitz-eval type env)
       (:unsigned-byte8
-       `(with-inline-assembly (:returns :eax)
-	  (:compile-form (:result-mode :edx) ,port)
-	  (:std)			; only EBX is now GC root
-	  (:shrl ,movitz::+movitz-fixnum-shift+ :edx)
-	  (:xorl :eax :eax)
-	  (:inb :dx :al)
-	  (:shll ,movitz:+movitz-fixnum-shift+ :eax)
-	  (:movl :edi :edx)
-	  (:cld)))
+       `(with-inline-assembly-case (:type (unsigned-byte 8))
+	  (do-case (:untagged-fixnum-ecx :untagged-fixnum-ecx)
+	    (:compile-form (:result-mode :edx) ,port)
+	    (:std)			; only EBX is now GC root
+	    (:shrl ,movitz::+movitz-fixnum-shift+ :edx)
+	    (:xorl :eax :eax)
+	    (:inb :dx :al)
+	    (:movl :eax :ecx)
+	    (:movl :edi :eax)
+	    (:movl :edi :edx)
+	    (:cld))
+	  (do-case (t :eax)
+	    (:compile-form (:result-mode :edx) ,port)
+	    (:std)			; only EBX is now GC root
+	    (:shrl ,movitz::+movitz-fixnum-shift+ :edx)
+	    (:xorl :eax :eax)
+	    (:inb :dx :al)
+	    (:shll ,movitz:+movitz-fixnum-shift+ :eax)
+	    (:movl :edi :edx)
+	    (:cld))))
       (:unsigned-byte16
-       `(with-inline-assembly (:returns :eax)
-	  (:compile-form (:result-mode :edx) ,port)
-	  (:std)
-	  (:shrl ,movitz::+movitz-fixnum-shift+ :edx)
-	  (:xorl :eax :eax)
-	  (:inw :dx :ax)
-	  (:shll ,movitz:+movitz-fixnum-shift+ :eax)
-	  (:movl :edi :edx)
-	  (:cld)))
+       `(with-inline-assembly-case (:type (unsigned-byte 16))
+	  (do-case (:untagged-fixnum-ecx :untagged-fixnum-ecx)
+	    (:compile-form (:result-mode :edx) ,port)
+	    (:std)
+	    (:shrl ,movitz::+movitz-fixnum-shift+ :edx)
+	    (:xorl :eax :eax)
+	    (:inw :dx :ax)
+	    (:movl :eax :ecx)
+	    (:movl :edi :eax)
+	    (:movl :edi :edx)
+	    (:cld))
+	  (do-case (t :eax)
+	    (:compile-form (:result-mode :edx) ,port)
+	    (:std)
+	    (:shrl ,movitz::+movitz-fixnum-shift+ :edx)
+	    (:xorl :eax :eax)
+	    (:inw :dx :ax)
+	    (:shll ,movitz:+movitz-fixnum-shift+ :eax)
+	    (:movl :edi :edx)
+	    (:cld))))
       (:unsigned-byte32
-       `(with-inline-assembly (:returns :untagged-fixnum-ecx)
+       `(with-inline-assembly (:returns :untagged-fixnum-ecx
+					:type (unsigned-byte 32))
      (:compile-form (:result-mode :edx) ,port)
      (:std)
      (:shrl ,movitz::+movitz-fixnum-shift+ :edx)
@@ -139,6 +162,61 @@
    	       `((:movl :edi :edx)))
    	   (:movl :edi :eax)
    	   (:cld)))))))))
+     ((and (movitz:movitz-constantp type env)
+	   (movitz:movitz-constantp value env))
+      (let ((value (movitz:movitz-eval value env)))
+	(ecase (movitz:movitz-eval type env)
+	  (:unsigned-byte8
+	   (check-type value (unsigned-byte 8))
+	   `(let ((,port-var ,port))
+	      (with-inline-assembly (:returns :nothing)
+		(:load-lexical (:lexical-binding ,port-var) :untagged-fixnum-ecx)
+		(:std)
+		(:movl :ecx :edx)
+		(:movb ,value :al)
+		(:outb :al :dx)
+		(:movl :edi :edx)
+		(:movl :edi :eax)
+		(:cld))
+	      ,value))
+	  (:unsigned-byte16
+	   (check-type value (unsigned-byte 16))
+	   `(let ((,port-var ,port))
+	      (with-inline-assembly (:returns :nothing)
+		(:load-lexical (:lexical-binding ,port-var) :untagged-fixnum-ecx)
+		(:std)
+		(:movl :ecx :edx)
+		(:movl ,value :eax)
+		(:outw :ax :dx)
+		(:movl :edi :edx)
+		(:movl :edi :eax)
+		(:cld))
+	      ,value))
+	  (:unsigned-byte32
+	   `(let ((,port-var ,port))
+	      (with-inline-assembly (:returns :nothing)
+		(:load-lexical (:lexical-binding ,port-var) :untagged-fixnum-ecx)
+		(:std)
+		(:movl :ecx :edx)
+		(:movl ,value :eax)
+		(:outl :eax :dx)
+		(:movl :edi :edx)
+		(:movl :edi :eax)
+		(:cld))
+	      ,value))
+	  (:character
+	   `(let ((,port-var ,port))
+	      (check-type value character)
+	      (with-inline-assembly (:returns :nothing)
+		(:load-lexical (:lexical-binding ,port-var) :untagged-fixnum-ecx)
+		(:std)
+		(:movl :ecx :edx)
+		(:movb ,(char-code value) :al)
+		(:outb :al :dx)
+		(:movl :edi :edx)
+		(:movl :edi :eax)
+		(:cld))
+	      ,value)))))
      ((movitz:movitz-constantp type env)
       (ecase (movitz:movitz-eval type env)
    (:unsigned-byte8
@@ -160,10 +238,10 @@
    	(,port-var ,port))
        (with-inline-assembly (:returns :nothing)
          (:load-lexical (:lexical-binding ,port-var) :edx)
-	      (:load-lexical (:lexical-binding ,value-var) :eax)
+	      (:load-lexical (:lexical-binding ,value-var) :untagged-fixnum-ecx)
          (:std)
          (:shrl ,movitz::+movitz-fixnum-shift+ :edx)
-	      (:shrl ,movitz::+movitz-fixnum-shift+ :eax)
+	      (:movl :ecx :eax)
          (:outw :ax :dx)
          (:movl :edi :edx)
          (:movl :edi :eax)

    