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

[Frode Vatvedt Fjeld]

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

Modified Files:
	bignums.lisp 
Log Message:
Add an optional (8-bit) fill parameter to %make-bignum.

Date: Sat Aug 20 22:25:41 2005
Author: ffjeld

Index: movitz/losp/muerte/bignums.lisp
diff -u movitz/losp/muerte/bignums.lisp:1.15 movitz/losp/muerte/bignums.lisp:1.16
--- movitz/losp/muerte/bignums.lisp:1.15	Mon Feb 14 08:13:42 2005
+++ movitz/losp/muerte/bignums.lisp	Sat Aug 20 22:25:41 2005
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Sat Jul 17 19:42:57 2004
 ;;;;                
-;;;; $Id: bignums.lisp,v 1.15 2005/02/14 07:13:42 ffjeld Exp $
+;;;; $Id: bignums.lisp,v 1.16 2005/08/20 20:25:41 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -66,18 +66,29 @@
   (check-type old bignum)
   (%shallow-copy-object old (1+ (%bignum-bigits old))))
 
-(defun %make-bignum (bigits)
-  (assert (plusp bigits))
-  (macrolet
-      ((do-it ()
-	 `(let ((words (1+ bigits)))
-	    (with-non-pointer-allocation-assembly (words :fixed-size-p t
-							 :object-register :eax)
-	      (:load-lexical (:lexical-binding bigits) :ecx)
-	      (:shll 16 :ecx)
-	      (:orl ,(movitz:tag :bignum 0) :ecx)
-	      (:movl :ecx (:eax (:offset movitz-bignum type)))))))
-    (do-it)))
+(defun %make-bignum (bigits &optional fill)
+  (numargs-case
+   (1 (bigits)
+      (check-type bigits (unsigned-byte 14))
+      (macrolet
+	  ((do-it ()
+	     `(let ((words (1+ bigits)))
+		(with-non-pointer-allocation-assembly (words :fixed-size-p t
+							     :object-register :eax)
+		  (:load-lexical (:lexical-binding bigits) :ecx)
+		  (:shll 16 :ecx)
+		  (:orl ,(movitz:tag :bignum 0) :ecx)
+		  (:movl :ecx (:eax (:offset movitz-bignum type)))))))
+	(do-it)))
+   (t (bigits &optional fill)
+      (let ((bignum (%make-bignum bigits)))
+	(when fill
+	  (check-type fill (unsigned-byte 8))
+	  (dotimes (i (* 4 bigits))
+	    (setf (memref bignum (movitz-type-slot-offset 'movitz-bignum 'bigit0)
+			  :index i :type :unsigned-byte8)
+	      fill)))
+	bignum))))
 
 (defun print-bignum (x)
   (check-type x bignum)