Index: /branches/working-0711/ccl/level-0/X86/X8664/x8664-bignum.lisp
===================================================================
--- /branches/working-0711/ccl/level-0/X86/X8664/x8664-bignum.lisp	(revision 12972)
+++ /branches/working-0711/ccl/level-0/X86/X8664/x8664-bignum.lisp	(revision 12973)
@@ -71,4 +71,32 @@
     (single-value-return 4)))
 
+(defx86lapfunction %multiply-and-add-loop64
+    ((xs 16) (ys 8) #|(ra 0)|# (r arg_x) (i arg_y) (ylen arg_z))
+  (let ((y temp2)
+	(j temp0)
+	(c imm2))
+    (movq (@ xs (% rsp)) (% temp0))
+    (movq (@ x8664::misc-data-offset (% temp0) (% i)) (% mm0)) ;x[i]
+    (movq (@ ys (% rsp)) (% y))
+    (xorl (%l j) (%l j))
+    (xorl (%l c) (%l c))
+    @loop
+    ;; It's a pity to have to reload this every time, but there's no
+    ;; imm3.  (Give him 16 registers, and he still complains...)
+    (movd (% mm0) (% rax))
+    (mulq (@ x8664::misc-data-offset (% y) (% j))) ;128-bit x * y[j] in rdx:rax
+    (addq (@ x8664::misc-data-offset (% r) (% i)) (% rax)) ;add in r[i]
+    (adcq ($ 0) (% rdx))
+    ;; add in carry digit
+    (addq (% c) (% rax))
+    (movl ($ 0) (%l c))
+    (adcq (% rdx) (% c))				   ;new carry digit
+    (movq (% rax) (@ x8664::misc-data-offset (% r) (% i))) ;update r[i]
+    (addq ($ '1) (% i))
+    (addq ($ '1) (% j))
+    (subq ($ '1) (% ylen))
+    (ja @loop)
+    (movq (% c) (@ x8664::misc-data-offset (% r) (% i)))
+    (single-value-return 4)))
 
 ;;; Multiply the (32-bit) digits X and Y, producing a 64-bit result.
Index: /branches/working-0711/ccl/level-0/l0-bignum64.lisp
===================================================================
--- /branches/working-0711/ccl/level-0/l0-bignum64.lisp	(revision 12972)
+++ /branches/working-0711/ccl/level-0/l0-bignum64.lisp	(revision 12973)
@@ -804,15 +804,33 @@
 		    (len-b (%bignum-length b))
 		    (len-res (+ len-a len-b))
-		    (res (%allocate-bignum len-res)) )
+		    (res (%allocate-bignum len-res)))
 	       (declare (bignum-index len-a len-b len-res))
 	       (dotimes (i len-a)
 		 (declare (type bignum-index i))
 		 (%multiply-and-add-loop a b res i len-b))
+	       res))
+	   (multiply-unsigned-bignums64 (a b)
+	     (let* ((len-a (ceiling (%bignum-length a) 2))
+		    (len-b (ceiling (%bignum-length b) 2))
+		    (len-res (+ len-a len-b))
+		    (res (%allocate-bignum (+ len-res len-res))))
+	       (declare (bignum-index len-a len-b len-res))
+	       (dotimes (i len-a)
+		 (declare (type bignum-index i))
+		 (%multiply-and-add-loop64 a b res i len-b))
 	       res)))
-      (let* ((res (with-negated-bignum-buffers a b multiply-unsigned-bignums)))
+      (let* ((res (with-negated-bignum-buffers a b
+					       multiply-unsigned-bignums64)))
 	(if signs-differ (negate-bignum-in-place res))
 	(%normalize-bignum-macro res)))))
 
-
+(defun multiply-bignum-and-fixnum (bignum fixnum)
+  (declare (type bignum-type bignum) (fixnum fixnum))
+  (if (eql fixnum 1)
+    bignum
+    (with-small-bignum-buffers ((big-fix fixnum))
+      (multiply-bignums bignum big-fix))))
+
+#+slower
 (defun multiply-bignum-and-fixnum (bignum fixnum)
   (declare (type bignum-type bignum) (fixnum fixnum))