From 6f7e7963bc91818e7ae972f40a5ff027378d9d53 Mon Sep 17 00:00:00 2001
From: Bjoren Davis <bjorend@users.gitlab.com>
Date: Mon, 18 Jan 2021 20:22:34 +0100
Subject: [PATCH] small (1 and 2 word) floating point literals not parsed
 correctly

Fix gitlab issue #5.

The parse_float() function has several bugs:

    1. For 1- and 2-word floats it will always write all 4 bytes if the value is
       exactly 0.
    2. It incorrectly rounds and normalizes 1- and 2-word floats.

To see the issue easily try the following inputs:

     .flt2  1.0
     .flt4  1.0

These will assemble as '040100 000000' and '040200 000000 000000 000000'.
They should both begin '040200'.

In fact the test file test/test-prec.mac is incorrect in its only floating point value:
	.word	^f 1.5		; 040140
should actually assemble as 040300, not 040140 (040140 is actually ^F0.875).
I confirmed this on RT-11 running MACRO V05.06.

I fixed the problem with the following deltas:

[the patch]

The most crucial change is the very last one. 0x200000000000 is actually (1 << 45)
and because ufrac is normalized it means that it will always downshift ufrac by 1.
---
 parse.c                | 43 +++++++++++++++++++++++++++++++++---------
 tests/test-prec.lst.ok |  2 +-
 tests/test-prec.mac    |  2 +-
 3 files changed, 36 insertions(+), 11 deletions(-)

diff --git a/parse.c b/parse.c
index 843cb40..91e73bc 100644
--- a/parse.c
+++ b/parse.c
@@ -353,31 +353,56 @@ int parse_float(
         *endp = cp;
 
     if (d == 0.0) {
-        flt[0] = flt[1] = flt[2] = flt[3] = 0;  /* All-bits-zero equals zero */
+        for (i = 0; i < size; i++) {
+            flt[i] = 0; /* All-bits-zero equals zero */
+        }
         return 1;                      /* Good job. */
     }
 
     frac = frexp(d, &sexp);            /* Separate into exponent and mantissa */
-    if (sexp < -128 || sexp > 127)
+    if (sexp < -127 || sexp > 127)
         return 0;                      /* Exponent out of range. */
 
     uexp = sexp + 128;                  /* Make excess-128 mode */
     uexp &= 0xff;                       /* express in 8 bits */
 
+    /*
+     * frexp guarantees its fractional return value is
+     *   abs(frac) >= 0.5    and  abs(frac) < 1.0
+     * Another way to think of this is that:
+     *   abs(frac) >= 2**-1  and  abs(frac) < 2**0
+     */
+
     if (frac < 0) {
-        sign = 0100000;                /* Negative sign */
+        sign = (1 << 15);              /* Negative sign */
         frac = -frac;                  /* fix the mantissa */
     }
 
-    /* The following big literal is 2 to the 49th power: */
+    /*
+     * For the PDP-11 floating point representation the
+     *  fractional part is 7 bits (for 16-bit floating point
+     *  literals), 23 bits (for 32-bit floating point values),
+     *  or 55 bits (for 64-bit floating point values).
+     * However the bit immediately above the MSB is always 1
+     *  because the value is normalized.  So it's actually
+     *  8 bits, 24 bits, or 56 bits.
+     * We multiply the fractional part of our value by
+     *  2**56 to fully expose all of those bits (including
+     *  the MSB which is 1).
+     */
+
+
+    /* The following big literal is 2 to the 56th power: */
     ufrac = (ulong64) (frac * 72057594037927936.0);     /* Align fraction bits */
 
-    /* Round from FLT4 to FLT2 */
-    if (size < 4) {
-        ufrac += 0x80000000;           /* Round to nearest 32-bit
-                                          representation */
+    /* ufrac is now >= 2**55 and < 2**56 */
 
-        if (ufrac > 0x200000000000) {  /* Overflow? */
+    /* Round from FLT4 to FLT2 or single-word float */
+    if (size < 4) {
+        /* Round to nearest 8- or 24- bit approximation */
+        ufrac += (1UL << (56 - (8 + 16*(size-1)) - 1));
+
+        if ((ufrac >> 56) > 0) {  /* Overflow? */
             ufrac >>= 1;               /* Normalize */
             uexp--;
         }
diff --git a/tests/test-prec.lst.ok b/tests/test-prec.lst.ok
index 9e5add9..b0ae881 100644
--- a/tests/test-prec.lst.ok
+++ b/tests/test-prec.lst.ok
@@ -45,7 +45,7 @@
       45 000100 070204                  	.word	^r<R D>		; bracketed strings are an extension
       46 000102 070250                  	.word	^r<RA >		; bracketed strings are an extension
       47 000104 157614                  	.word	^R50.		; 157614 there is no whitespace in between.
-      48 000106 040140                  	.word	^f 1.5		; 040140
+      48 000106 040300                  	.word	^f 1.5		; 040300
       49                                
       50                                ;;;;;
       51                                ;
diff --git a/tests/test-prec.mac b/tests/test-prec.mac
index ee830a5..52083e5 100644
--- a/tests/test-prec.mac
+++ b/tests/test-prec.mac
@@ -45,7 +45,7 @@
 	.word	^r<R D>		; bracketed strings are an extension
 	.word	^r<RA >		; bracketed strings are an extension
 	.word	^R50.		; 157614 there is no whitespace in between.
-	.word	^f 1.5		; 040140
+	.word	^f 1.5		; 040300
 
 ;;;;;
 ;