[movitz-cvs] CVS update: movitz/losp/muerte/inspect.lisp

[Frode Vatvedt Fjeld]

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

Modified Files:
	inspect.lisp 
Log Message:
Moved some operators to bignums.lisp.

Date: Sat Jul 17 12:32:16 2004
Author: ffjeld

Index: movitz/losp/muerte/inspect.lisp
diff -u movitz/losp/muerte/inspect.lisp:1.24 movitz/losp/muerte/inspect.lisp:1.25
--- movitz/losp/muerte/inspect.lisp:1.24	Fri Jul 16 18:52:29 2004
+++ movitz/losp/muerte/inspect.lisp	Sat Jul 17 12:32:16 2004
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Fri Oct 24 09:50:41 2003
 ;;;;                
-;;;; $Id: inspect.lisp,v 1.24 2004/07/17 01:52:29 ffjeld Exp $
+;;;; $Id: inspect.lisp,v 1.25 2004/07/17 19:32:16 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -258,74 +258,3 @@
 	      #.(movitz::movitz-type-word-size :movitz-struct)
 	      (* 2 (truncate (+ (structure-object-length object) 1) 2))))))))
 
-(defun %bignum-bigits (x)
-  (%bignum-bigits x))
-
-(defun %bignum-canonicalize (x)
-  "Assuming x is a bignum, return the canonical integer value. That is,
-either return a fixnum, or destructively modify the bignum's length so
-that the msb isn't zero. DO NOT APPLY TO NON-BIGNUM VALUES!"
-  (check-type x bignum)
-  (macrolet
-      ((do-it ()
-	 `(with-inline-assembly (:returns :eax)
-	    (:load-lexical (:lexical-binding x) :eax)
-	    (:movl (:eax ,movitz:+other-type-offset+) :ecx)
-	    (:shrl 16 :ecx)
-	    (:jz '(:sub-program (should-never-happen)
-		   (:int 107)))
-	   shrink-loop
-	    (:cmpl 4 :ecx)
-	    (:je 'shrink-no-more)
-	    (:cmpl 0 (:eax :ecx ,(+ -4 (bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))))
-	    (:jnz 'shrink-done)
-	    (:subl 4 :ecx)
-	    (:jmp 'shrink-loop)
-	   shrink-no-more
-	    (:cmpl ,(1+ movitz:+movitz-most-positive-fixnum+)
-		   (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)))
-	    (:jc '(:sub-program (fixnum-result)
-		   (:movl (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))
-		    :ecx)
-		   (:leal ((:ecx ,movitz:+movitz-fixnum-factor+)) :eax)
-		   (:jmp 'done)))
-	   shrink-done
-	    (:testb 3 :cl)
-	    (:jnz '(:sub-program () (:int 107)))
-	    (:testw :cx :cx)
-	    (:jz '(:sub-program () (:int 107)))
-	    (:movw :cx (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::length)))
-	   done
-	    )))
-    (do-it)))
-
-(defun copy-bignum (old)
-  (check-type old bignum)
-  (let* ((length (%bignum-bigits old))
-	 (new (malloc-non-pointer-words (1+ length))))
-    (with-inline-assembly (:returns :eax)
-      (:compile-two-forms (:eax :ebx) new old)
-      (:compile-form (:result-mode :edx) length)
-     copy-bignum-loop
-      (:movl (:ebx :edx #.movitz:+other-type-offset+) :ecx)
-      (:movl :ecx (:eax :edx #.movitz:+other-type-offset+))
-      (:subl 4 :edx)
-      (:jnc 'copy-bignum-loop))))
-
-(defun %make-bignum (bigits)
-  (assert (plusp bigits))
-  (macrolet
-      ((do-it ()
-	 `(with-inline-assembly (:returns :eax)
-	    (:compile-two-forms (:eax :ecx) (malloc-non-pointer-words (1+ bigits)) bigits)
-	    (:shll 16 :ecx)
-	    (:orl ,(movitz:tag :bignum 0) :ecx)
-	    (:movl :ecx (:eax ,movitz:+other-type-offset+)))))
-    (do-it)))
-
-(defun print-bignum (x)
-  (check-type x bignum)
-  (dotimes (i (1+ (%bignum-bigits x)))
-    (format t "~8,'0X " (memref x -6 i :unsigned-byte32)))
-  (terpri)
-  (values))