From 513c3b23e97cf7e1af4da202053bedf96e70cc44 Mon Sep 17 00:00:00 2001
From: Raymond Toy <toy.raymond@gmail.com>
Date: Sat, 1 Mar 2014 08:30:18 -0800
Subject: [PATCH] Fix ticket 94.

 * Add least-positive-normalized-double-double-float,
   least-negative-normalized-double-double-float,
   least-positive-double-double-float,
   least-negative-double-double-float,
   most-positive-double-double-float,
   most-negative-double-double-float to the extensions package.
---
 src/code/exports.lisp |  8 ++++++++
 src/code/float.lisp   | 34 ++++++++++++++++++++++++++++++++++
 2 files changed, 42 insertions(+)

diff --git a/src/code/exports.lisp b/src/code/exports.lisp
index 9322c5d12..a5f5ca653 100644
--- a/src/code/exports.lisp
+++ b/src/code/exports.lisp
@@ -1418,6 +1418,14 @@
 	   "FLOAT-DENORMALIZED-P" "FLOAT-INFINITY-P"
 	   "FLOAT-NAN-P" "FLOAT-TRAPPING-NAN-P" 
 	   "WITH-FLOAT-TRAPS-MASKED")
+  ;; More float extensions
+  #+double-double
+  (:export "LEAST-POSITIVE-NORMALIZED-DOUBLE-DOUBLE-FLOAT"
+	   "LEAST-NEGATIVE-NORMALIZED-DOUBLE-DOUBLE-FLOAT"
+	   "LEAST-POSITIVE-DOUBLE-DOUBLE-FLOAT"
+	   "LEAST-NEGATIVE-DOUBLE-DOUBLE-FLOAT"
+	   "MOST-POSITIVE-DOUBLE-DOUBLE-FLOAT"
+	   "MOST-NEGATIVE-DOUBLE-DOUBLE-FLOAT")
 
   ;; Spice lisp extensions
   (:export "LETF*" "LETF" "DOVECTOR" "DELETEF" "INDENTING-FURTHER" "FILE-COMMENT"
diff --git a/src/code/float.lisp b/src/code/float.lisp
index ce7e57207..01b70020f 100644
--- a/src/code/float.lisp
+++ b/src/code/float.lisp
@@ -59,6 +59,14 @@
 	  set-floating-point-modes float-denormalized-p float-nan-p
 	  float-trapping-nan-p float-infinity-p))
 
+#+double-double
+(export '(least-positive-normalized-double-double-float
+	  least-negative-normalized-double-double-float
+	  least-positive-double-double-float
+	  least-negative-double-double-float
+	  most-positive-double-double-float
+	  most-negative-double-double-float))
+
 (in-package "KERNEL")
 
 
@@ -127,6 +135,32 @@
 #+(and long-float x86)
 (defconstant least-negative-long-float (long-from-bits 1 0 1))
 
+#+double-double
+(progn
+(defconstant least-positive-normalized-double-double-float
+  ;; What is the right value?
+  (kernel:make-double-double-float least-positive-normalized-double-float
+				   0d0))
+(defconstant least-negative-normalized-double-double-float
+  ;; What is the right value?
+  (kernel:make-double-double-float least-negative-normalized-double-float
+				   0d0))
+(defconstant least-positive-double-double-float
+  (kernel:make-double-double-float least-positive-double-float
+				   0d0))
+(defconstant least-negative-double-double-float
+  (kernel:make-double-double-float least-negative-double-float
+				   0d0))
+(defconstant most-positive-double-double-float
+  ;; What is the right value?
+  (kernel:make-double-double-float most-positive-double-float
+				   0d0))
+(defconstant most-negative-double-double-float
+  ;; What is the right value?
+  (kernel:make-double-double-float most-negative-double-float
+				   0d0))
+); double-double
+
 (defconstant least-positive-normalized-single-float
   (single-from-bits 0 vm:single-float-normal-exponent-min 0))
 (defconstant least-positive-normalized-short-float
-- 
GitLab