From: Helmut Eller <eller.helmut@gmail.com>
Date: Sun, 18 Dec 2016 09:45:06 +0000 (+0100)
Subject: Fix +loop on 64-bit machines
X-Git-Url: http://git.subgeniuskitty.com/pforth/.git/commitdiff_plain/d98c27bbb69e33587dde4a89dc5ee87eaa8c32d0

Fix +loop on 64-bit machines

* csrc/pf_inner.c: Use idea from Gforth with signed arithmetic and
clever bit manipulation to avoid word size specific code.

* fth/t_corex.fth: +loop tests adopted from Gerry Jackson's Forth2012
test suite.
---

diff --git a/csrc/pf_inner.c b/csrc/pf_inner.c
index 8ecdec7..7cdaeb1 100644
--- a/csrc/pf_inner.c
+++ b/csrc/pf_inner.c
@@ -1391,15 +1391,18 @@ DBUG(("XX ah,m,l = 0x%8x,%8x,%8x - qh,l = 0x%8x,%8x\n", ah,am,al, qh,ql ));
 
         case ID_PLUSLOOP_P: /* ( delta -- ) ( R: index limit -- | index limit ) */
             {
-                ucell_t OldIndex, NewIndex, Limit;
-
-                Limit = M_R_POP;
-                OldIndex = M_R_POP;
-                NewIndex = OldIndex + TOS; /* add TOS to index, not 1 */
-/* Do indices cross boundary between LIMIT-1 and LIMIT ? */
-                if( ( (OldIndex - Limit) & ((Limit-1) - NewIndex) & 0x80000000 ) ||
-                    ( (NewIndex - Limit) & ((Limit-1) - OldIndex) & 0x80000000 ) )
-                {
+		cell_t Limit = M_R_POP;
+		cell_t OldIndex = M_R_POP;
+		cell_t Delta = TOS; /* add TOS to index, not 1 */
+		cell_t NewIndex = OldIndex + Delta;
+		cell_t OldDiff = OldIndex - Limit;
+
+		/* This exploits this idea (lifted from Gforth):
+		   (x^y)<0 is equivalent to (x<0) != (y<0) */
+                if( ((OldDiff ^ (OldDiff + Delta)) /* is the limit crossed? */
+		     & (OldDiff ^ Delta))          /* is it a wrap-around? */
+		    < 0 )
+		{
                     InsPtr++;   /* skip branch offset, exit loop */
                 }
                 else
diff --git a/fth/t_corex.fth b/fth/t_corex.fth
index 33103f4..3b07d89 100644
--- a/fth/t_corex.fth
+++ b/fth/t_corex.fth
@@ -222,5 +222,65 @@ T{ 10  -5 10 WITHIN }T{ 0 }T
 T{ T.[COMPILE] }T{ TRUE }T
 
 \  ----------------------------------------------------- \
+
+\ .( TESTING DO +LOOP with large and small increments )
+
+\ Contributed by Andrew Haley
+0 invert CONSTANT MAX-UINT
+0 INVERT 1 RSHIFT CONSTANT MAX-INT
+0 INVERT 1 RSHIFT INVERT    CONSTANT MIN-INT
+MAX-UINT 8 RSHIFT 1+ CONSTANT USTEP
+USTEP NEGATE CONSTANT -USTEP
+MAX-INT 7 RSHIFT 1+ CONSTANT STEP
+STEP NEGATE CONSTANT -STEP
+
+VARIABLE BUMP
+
+T{ : GD8 BUMP ! DO 1+ BUMP @ +LOOP ; }T{ }T
+
+T{ 0 MAX-UINT 0 USTEP GD8 }T{ 256 }T
+T{ 0 0 MAX-UINT -USTEP GD8 }T{ 256 }T
+
+T{ 0 MAX-INT MIN-INT STEP GD8 }T{ 256 }T
+T{ 0 MIN-INT MAX-INT -STEP GD8 }T{ 256 }T
+
+\ Two's complement arithmetic, wraps around modulo wordsize
+\ Only tested if the Forth system does wrap around, use of conditional
+\ compilation deliberately avoided
+
+MAX-INT 1+ MIN-INT = CONSTANT +WRAP?
+MIN-INT 1- MAX-INT = CONSTANT -WRAP?
+MAX-UINT 1+ 0=       CONSTANT +UWRAP?
+0 1- MAX-UINT =      CONSTANT -UWRAP?
+
+: GD9  ( n limit start step f result -- )
+   >R IF GD8 ELSE 2DROP 2DROP R@ THEN }T{ R> }T
+;
+
+T{ 0 0 0  USTEP +UWRAP? 256 GD9
+T{ 0 0 0 -USTEP -UWRAP?   1 GD9
+T{ 0 MIN-INT MAX-INT  STEP +WRAP? 1 GD9
+T{ 0 MAX-INT MIN-INT -STEP -WRAP? 1 GD9
+
+\ --------------------------------------------------------------------------
+\ .( TESTING DO +LOOP with maximum and minimum increments )
+
+: (-MI) MAX-INT DUP NEGATE + 0= IF MAX-INT NEGATE ELSE -32767 THEN ;
+(-MI) CONSTANT -MAX-INT
+
+T{ 0 1 0 MAX-INT GD8  }T{ 1 }T
+T{ 0 -MAX-INT NEGATE -MAX-INT OVER GD8  }T{ 2 }T
+
+T{ 0 MAX-INT  0 MAX-INT GD8  }T{ 1 }T
+T{ 0 MAX-INT  1 MAX-INT GD8  }T{ 1 }T
+T{ 0 MAX-INT -1 MAX-INT GD8  }T{ 2 }T
+T{ 0 MAX-INT DUP 1- MAX-INT GD8  }T{ 1 }T
+
+T{ 0 MIN-INT 1+   0 MIN-INT GD8  }T{ 1 }T
+T{ 0 MIN-INT 1+  -1 MIN-INT GD8  }T{ 1 }T
+T{ 0 MIN-INT 1+   1 MIN-INT GD8  }T{ 2 }T
+T{ 0 MIN-INT 1+ DUP MIN-INT GD8  }T{ 1 }T
+
+
 }TEST