From 435562dd09f0470b397ccdbb52cd0f8bb32d1aeb Mon Sep 17 00:00:00 2001
From: rtoy <rtoy>
Date: Sat, 1 Jul 2006 18:12:41 +0000
Subject: [PATCH] Random double-double floats.

---
 code/rand-mt19937.lisp | 20 +++++++++++++++++++-
 1 file changed, 19 insertions(+), 1 deletion(-)

diff --git a/code/rand-mt19937.lisp b/code/rand-mt19937.lisp
index 2321f5bcb..d6f61bc25 100644
--- a/code/rand-mt19937.lisp
+++ b/code/rand-mt19937.lisp
@@ -6,7 +6,7 @@
 ;;; placed in the Public domain, and is provided 'as is'.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/rand-mt19937.lisp,v 1.13 2003/11/12 22:49:53 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/rand-mt19937.lisp,v 1.14 2006/07/01 18:12:41 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -388,6 +388,21 @@
 	 (lisp::long-float-exp-bits 1l0)	; X needs more work
 	 (random-chunk state) (random-chunk state) (random-chunk state))
 	1l0)))
+#+double-double
+(defun %random-double-double-float (arg state)
+  (declare (type (double-double-float (0w0)) arg)
+	   (type random-state state))
+  ;; Generate a 31-bit integer, scale it and sum them up
+  (let* ((r 0w0)
+	 (scale (scale-float 1d0 -31))
+	 (mult scale))
+    (declare (double-float mult)
+	     (type double-double-float r)
+	     (optimize (speed 3)))
+    (dotimes (k 4)
+      (setf r (+ r (* mult (ldb (byte 31 0) (random-chunk state)))))
+      (setf mult (* mult scale)))
+    (* arg r)))
 
 
 ;;;; Random integers:
@@ -437,6 +452,9 @@
     #+long-float
     ((and (typep arg 'long-float) (> arg 0.0L0))
      (%random-long-float arg state))
+    #+double-double
+    ((and (typep arg 'double-double-float) (> arg 0.0w0))
+     (%random-double-double-float arg state))
     ((and (integerp arg) (> arg 0))
      (%random-integer arg state))
     (t
-- 
GitLab