From cfd1978aaae39839dec5ba9a6003ccb15992dc67 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Tue, 21 Oct 2008 21:51:54 -0500
Subject: [PATCH] checkin so i can work with this elsewhere

---
 extra/math/floating-point/authors.txt         |  1 +
 .../floating-point-tests.factor               |  4 +++
 .../math/floating-point/floating-point.factor | 32 +++++++++++++++++++
 3 files changed, 37 insertions(+)
 create mode 100644 extra/math/floating-point/authors.txt
 create mode 100644 extra/math/floating-point/floating-point-tests.factor
 create mode 100644 extra/math/floating-point/floating-point.factor

diff --git a/extra/math/floating-point/authors.txt b/extra/math/floating-point/authors.txt
new file mode 100644
index 0000000000..b4bd0e7b35
--- /dev/null
+++ b/extra/math/floating-point/authors.txt
@@ -0,0 +1 @@
+Doug Coleman
\ No newline at end of file
diff --git a/extra/math/floating-point/floating-point-tests.factor b/extra/math/floating-point/floating-point-tests.factor
new file mode 100644
index 0000000000..2a60d30d02
--- /dev/null
+++ b/extra/math/floating-point/floating-point-tests.factor
@@ -0,0 +1,4 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test math.floating-point ;
+IN: math.floating-point.tests
diff --git a/extra/math/floating-point/floating-point.factor b/extra/math/floating-point/floating-point.factor
new file mode 100644
index 0000000000..87767181cd
--- /dev/null
+++ b/extra/math/floating-point/floating-point.factor
@@ -0,0 +1,32 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math sequences ;
+IN: math.floating-point
+
+: float-sign ( float -- ? )
+    float>bits -31 shift { 1 -1 } nth ; 
+
+: double-sign ( float -- ? )
+    double>bits -63 shift { 1 -1 } nth ;
+
+: float-exponent-bits ( float -- n )
+    float>bits -23 shift 8 2^ 1- bitand ;
+
+: double-exponent-bits ( double -- n )
+    double>bits -52 shift 11 2^ 1- bitand ;
+
+: float-mantissa-bits ( float -- n )
+    float>bits 23 2^ 1- bitand ;
+
+: double-mantissa-bits ( double -- n )
+    double>bits 52 2^ 1- bitand ;
+
+: float-e ( -- float ) 127 ; inline
+: double-e ( -- float ) 1023 ; inline
+
+! : calculate-float ( S M E -- float )
+    ! float-e - 2^ * * ; ! bits>float ;
+
+! : calculate-double ( S M E -- frac )
+    ! double-e - 2^ swap 52 2^ /f 1+ * * ;
+