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

24 May 2004

Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv1344
Modified Files:
    primitive-functions.lisp 
Log Message:
Renamed normalize-u32-ecx to box-u32-ecx, and added primitive-function
box-u32 that does the inverse. Improved aref and (setf aref) of
u32-vectors accordingly.
Date: Mon May 24 15:34:34 2004
Author: ffjeld
Index: movitz/losp/muerte/primitive-functions.lisp
diff -u movitz/losp/muerte/primitive-functions.lisp:1.18 movitz/losp/muerte/primitive-functions.lisp:1.19

--- movitz/losp/muerte/primitive-functions.lisp:1.18	Mon May 24 10:58:56 2004
+++ movitz/losp/muerte/primitive-functions.lisp	Mon May 24 15:34:34 2004
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld frodef@acm.org
 ;;;; Created at:    Tue Oct  2 21:02:18 2001
 ;;;;                
-;;;; $Id: primitive-functions.lisp,v 1.18 2004/05/24 14:58:56 ffjeld Exp $
+;;;; $Id: primitive-functions.lisp,v 1.19 2004/05/24 19:34:34 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
@@ -505,8 +505,8 @@
     (:ret)))
-(define-primitive-function normalize-u32-ecx ()
-  "Make u32 in ECX into a fixnum or bignum."
+(define-primitive-function box-u32-ecx ()
+  "Make u32 in ECX into a fixnum or bignum in EAX."
   (with-inline-assembly (:returns :multiple-values)
     (:cmpl #.movitz:+movitz-most-positive-fixnum+ :ecx)
     (:ja 'not-fixnum)
@@ -514,6 +514,32 @@
     (:ret)
    not-fixnum
     (:int 107)))			; not implemented by default!
+
+(define-primitive-function unbox-u32 ()
+  "Coerce EAX into a u32 in ECX, or signal type error.
+Preserve EAX, EBX, and EDX."
+  (macrolet
+      ((do-it ()
+	 `(with-inline-assembly (:returns :multiple-values)
+	    (:testl ,(logior #x80000000 movitz:+movitz-fixnum-zmask+)
+		    :eax)
+	    (:jnz 'not-fixnum)
+	    (:movl :eax :ecx)
+	    (:shrl ,movitz:+movitz-fixnum-shift+ :ecx)
+	    (:ret)
+	   not-fixnum
+	    (:leal (:eax ,(- (movitz:tag :other))) :ecx)
+	    (:testb 7 :cl)
+	    (:jnz 'fail)
+	    (:cmpl ,(dpb 1 (byte 16 16) (movitz:tag :bignum 0))
+		   (:eax ,movitz:+other-type-offset+))
+	    (:jne 'fail)
+	    (:movl (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))
+		   :ecx)
+	    (:ret)
+	   fail
+	    (:int 107))))
+    (do-it)))
;;;;

    