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@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)