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

Modified Files: inspect.lisp Log Message: Added %bignum-canonicalize.

Date: Thu Jul 8 14:48:58 2004 Author: ffjeld

Index: movitz/losp/muerte/inspect.lisp diff -u movitz/losp/muerte/inspect.lisp:1.15 movitz/losp/muerte/inspect.lisp:1.16 --- movitz/losp/muerte/inspect.lisp:1.15 Thu Jul 8 11:53:47 2004 +++ movitz/losp/muerte/inspect.lisp Thu Jul 8 14:48:58 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld frodef@acm.org ;;;; Created at: Fri Oct 24 09:50:41 2003 ;;;; -;;;; $Id: inspect.lisp,v 1.15 2004/07/08 18:53:47 ffjeld Exp $ +;;;; $Id: inspect.lisp,v 1.16 2004/07/08 21:48:58 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -245,7 +245,7 @@ (+ -1 object-location #.(movitz::movitz-type-word-size :movitz-funobj) (funobj-num-constants object)))) - ((or string code-vector (simple-array (unsigned-byte 8))) + ((or string code-vector (simple-array (unsigned-byte 8) 1)) (<= object-location location (+ -1 object-location @@ -272,6 +272,37 @@

(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!" + (macrolet + ((do-it () + `(with-inline-assembly (:returns :eax) + (:load-lexical (:lexical-binding x) :eax) + (:movl (:eax ,movitz:+other-type-offset+) :ecx) + (:shrl 16 :ecx) + shrink-loop + (:cmpl 1 :ecx) + (:je 'shrink-no-more) + (:cmpl 0 (:eax (:ecx 4) ,(+ -4 (bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)))) + (:jnz 'shrink-done) + (:subl 1 :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 + (:movw :cx (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::length))) + done + ))) + (do-it)))

(defun copy-bignum (old) (check-type old bignum)