svm: Fixed signedness of some fixnum instructions.

Included code from liarc.h by moving it to fixnum.h.  Included
fixnum.h in fixnum.c and used it to replace near-identical code.

diff --git a/src/microcode/fixnum.c b/src/microcode/fixnum.c
index b5c7f977110eedcebeb98ff19c4186ebf7074890..d08c6cee4b79c6eb9f55589f42e16af232a84d4c 100644 (file)
--- a/src/microcode/fixnum.c
+++ b/src/microcode/fixnum.c
@@ -208,16 +208,9 @@ DEFINE_PRIMITIVE ("FIXNUM-QUOTIENT", Prim_fixnum_quotient, 2, 2, 0)
   {
     long numerator = (arg_fixnum (1));
     long denominator = (arg_fixnum (2));
-    FIXNUM_RESULT
-      ((denominator > 0)
-       ? ((numerator < 0)
-         ? (- ((- numerator) / denominator))
-         : (numerator / denominator))
-       : (denominator < 0)
-       ? ((numerator < 0)
-         ? ((- numerator) / (- denominator))
-         : (- (numerator / (- denominator))))
-       : (error_bad_range_arg (2), 0));
+    FIXNUM_RESULT (numerator == 0
+                  ? (error_bad_range_arg (2), 0)
+                  : FIXNUM_QUOTIENT (numerator, denominator));
   }
 }
 
@@ -227,16 +220,9 @@ DEFINE_PRIMITIVE ("FIXNUM-REMAINDER", Prim_fixnum_remainder, 2, 2, 0)
   {
     long numerator = (arg_fixnum (1));
     long denominator = (arg_fixnum (2));
-    FIXNUM_RESULT
-      ((denominator > 0)
-       ? ((numerator < 0)
-         ? (- ((- numerator) % denominator))
-         : (numerator % denominator))
-       : (denominator < 0)
-       ? ((numerator < 0)
-         ? (- ((- numerator) % (- denominator)))
-         : (numerator % (- denominator)))
-       : (error_bad_range_arg (2), 0));
+    FIXNUM_RESULT (numerator == 0
+                  ? (error_bad_range_arg (2), 0)
+                  : FIXNUM_REMAINDER (numerator, denominator));
   }
 }
 
@@ -296,11 +282,7 @@ DEFINE_PRIMITIVE ("FIXNUM-LSH", Prim_fixnum_lsh, 2, 2, 0)
     long y = (arg_fixnum (2));
     unsigned long z;
 
-    if (y < 0)
-      z = (((-y) > ((long) DATUM_LENGTH)) ? 0 : (x >> (-y)));
-    else
-      z = ((y > ((long) DATUM_LENGTH)) ? 0 : (x << y));
-    LOGICAL_RESULT (z);
+    LOGICAL_RESULT (FIXNUM_LSH (x, y));
   }
 }
 

diff --git a/src/microcode/fixnum.h b/src/microcode/fixnum.h
new file mode 100644 (file)
index 0000000..8e8d3dc
--- /dev/null
+++ b/src/microcode/fixnum.h
@@ -0,0 +1,70 @@
+/* -*-C-*-
+
+Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
+    1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+    2006, 2007, 2008, 2009, 2010, 2011 Massachusetts Institute of
+    Technology
+
+This file is part of MIT/GNU Scheme.
+
+MIT/GNU Scheme is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at
+your option) any later version.
+
+MIT/GNU Scheme is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with MIT/GNU Scheme; if not, write to the Free Software
+Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
+USA.
+
+*/
+
+#ifndef SCM_FIXNUM_H_INCLUDED
+#define SCM_FIXNUM_H_INCLUDED 1
+
+#define MAX_BIT_SHIFT DATUM_LENGTH
+
+#define RIGHT_SHIFT_UNSIGNED(source, number)                           \
+  (((number) > MAX_BIT_SHIFT)                                          \
+   ? 0                                                                 \
+   : ((((unsigned long) (source)) & DATUM_MASK) >> (number)))
+
+#define RIGHT_SHIFT(source, number)                                    \
+  (((number) > MAX_BIT_SHIFT)                                          \
+   ? 0                                                                 \
+   : ((source) >> (number)))
+
+#define LEFT_SHIFT(source, number)                                     \
+  (((number) > MAX_BIT_SHIFT)                                          \
+   ? 0                                                                 \
+   : ((source) << (number)))
+
+#define FIXNUM_LSH(source, number)                                     \
+  (((number) >= 0)                                                     \
+   ? (LEFT_SHIFT (source, number))                                     \
+   : (RIGHT_SHIFT_UNSIGNED (source, (- (number)))))
+
+#define FIXNUM_REMAINDER(source1, source2)                             \
+  (((source2) > 0)                                                     \
+   ? (((source1) >= 0)                                                 \
+      ? ((source1) % (source2))                                                \
+      : (- ((- (source1)) % (source2))))                               \
+   : (((source1) >= 0)                                                 \
+      ? ((source1) % (- (source2)))                                    \
+      : (- ((- (source1)) % (- (source2))))))
+
+#define FIXNUM_QUOTIENT(source1, source2)                              \
+  (((source2) > 0)                                                     \
+   ? (((source1) >= 0)                                                 \
+      ? ((source1) / (source2))                                                \
+      : (- ((- (source1)) / (source2))))                               \
+   : (((source1) >= 0)                                                 \
+      ? (- ((source1) / (- (source2))))                                        \
+      : ((- (source1)) / (- (source2)))))
+
+#endif /* !SCM_FIXNUM_H_INCLUDED */

diff --git a/src/microcode/liarc.h b/src/microcode/liarc.h
index 2b577d1d1e72dd280ed178f5cb7c24552a533b14..8828d45cc0ff5861859ac6a08ed77920f1f85f5e 100644 (file)
--- a/src/microcode/liarc.h
+++ b/src/microcode/liarc.h
@@ -37,6 +37,7 @@ USA.
 #include "const.h"
 #include "object.h"
 #include "sdata.h"
+#include "fixnum.h"
 #include "errors.h"
 #include "stack.h"
 #include "interp.h"
@@ -249,46 +250,6 @@ typedef unsigned long entry_count_t;
   CACHE_VARIABLES ();                                                  \
   JUMP (IICdest);                                                      \
 } while (false)
-\f
-#define MAX_BIT_SHIFT DATUM_LENGTH
-
-#define RIGHT_SHIFT_UNSIGNED(source, number)                           \
-  (((number) > MAX_BIT_SHIFT)                                          \
-   ? 0                                                                 \
-   : ((((unsigned long) (source)) & DATUM_MASK) >> (number)))
-
-#define RIGHT_SHIFT(source, number)                                    \
-  (((number) > MAX_BIT_SHIFT)                                          \
-   ? 0                                                                 \
-   : ((source) >> (number)))
-
-#define LEFT_SHIFT(source, number)                                     \
-  (((number) > MAX_BIT_SHIFT)                                          \
-   ? 0                                                                 \
-   : ((source) << (number)))
-
-#define FIXNUM_LSH(source, number)                                     \
-  (((number) >= 0)                                                     \
-   ? (LEFT_SHIFT (source, number))                                     \
-   : (RIGHT_SHIFT_UNSIGNED (source, (- (number)))))
-
-#define FIXNUM_REMAINDER(source1, source2)                             \
-  (((source2) > 0)                                                     \
-   ? (((source1) >= 0)                                                 \
-      ? ((source1) % (source2))                                                \
-      : (- ((- (source1)) % (source2))))                               \
-   : (((source1) >= 0)                                                 \
-      ? ((source1) % (- (source2)))                                    \
-      : (- ((- (source1)) % (- (source2))))))
-
-#define FIXNUM_QUOTIENT(source1, source2)                              \
-  (((source2) > 0)                                                     \
-   ? (((source1) >= 0)                                                 \
-      ? ((source1) / (source2))                                                \
-      : (- ((- (source1)) / (source2))))                               \
-   : (((source1) >= 0)                                                 \
-      ? (- ((source1) / (- (source2))))                                        \
-      : ((- (source1)) / (- (source2)))))
 
 #define INTERRUPT_CHECK(code, entry_point) do                          \
 {                                                                      \

diff --git a/src/microcode/svm1-interp.c b/src/microcode/svm1-interp.c
index e46748d31b342dbdea552068b6ddbf2e5356c161..a054340e672515dbf4b875b2e16d5729ee90d96e 100644 (file)
--- a/src/microcode/svm1-interp.c
+++ b/src/microcode/svm1-interp.c
@@ -27,6 +27,7 @@ USA.
 /* Scheme Virtual Machine version 1 */
 
 #include "scheme.h"
+#include "fixnum.h"
 #include "svm1-defns.h"
 #include "cmpintmd/svm1.h"
 
@@ -245,6 +246,9 @@ signal_illegal_instruction (void)
 #define SIGNED_BINARY(op, a1, a2)                                      \
   (FROM_SIGNED ((TO_SIGNED (a1)) op (TO_SIGNED (a2))))
 
+#define SIGNED_BINFUNC(func, a1, a2)                                   \
+  (FROM_SIGNED (func (TO_SIGNED (a1), TO_SIGNED (a2))))
+
 #if 0
 /* The above definition isn't guaranteed to work in ANSI C, but in
    practice it usually does.  Here's an alternative that should always
@@ -1121,11 +1125,16 @@ DEFINE_INST (flonum_align)
 #define FDECR(x) ((x) - 1.0)
 #define WABS(x) (SIGNED_UNARY (labs, (x)))
 
-#define OP_ADD(x, y) ((x) + (y))
-#define OP_SUBTRACT(x, y) ((x) - (y))
-#define OP_MULTIPLY(x, y) ((x) * (y))
-#define OP_DIVIDE(x, y) ((x) / (y))
-#define OP_REMAINDER(x, y) ((x) % (y))
+#define FOP_ADD(x, y) ((x) + (y))
+#define FOP_SUBTRACT(x, y) ((x) - (y))
+#define FOP_MULTIPLY(x, y) ((x) * (y))
+#define FOP_DIVIDE(x, y) ((x) / (y))
+
+#define OP_ADD(x, y) (SIGNED_BINARY (+, (x), (y)))
+#define OP_SUBTRACT(x, y) (SIGNED_BINARY (-, (x), (y)))
+#define OP_MULTIPLY(x, y) (SIGNED_BINARY (*, (x), (y)))
+#define OP_DIVIDE(x, y) (SIGNED_BINFUNC (FIXNUM_QUOTIENT, (x), (y)))
+#define OP_REMAINDER(x, y) (SIGNED_BINFUNC (FIXNUM_REMAINDER, (x), (y)))
 #define OP_AND(x, y) ((x) & (y))
 #define OP_ANDC(x, y) ((x) &~ (y))
 #define OP_OR(x, y) ((x) | (y))
@@ -1212,10 +1221,7 @@ DEFINE_INST (lsh)
 {
   DECODE_SVM1_INST_LSH (target, source1, source2);
   long n = (TO_SIGNED (WREG_REF (source2)));
-  WREG_SET (target,
-           ((n < 0)
-            ? ((WREG_REF (source1)) >> (- n))
-            : ((WREG_REF (source1)) << n)));
+  WREG_SET (target, FIXNUM_LSH((WREG_REF (source1)), n));
   NEXT_PC;
 }
 
@@ -1245,10 +1251,10 @@ DEFINE_INST (nl)                                                        \
   NEXT_PC;                                                             \
 }
 
-DEFINE_BINARY_FR (add_fr, ADD_FR, OP_ADD)
-DEFINE_BINARY_FR (subtract_fr, SUBTRACT_FR, OP_SUBTRACT)
-DEFINE_BINARY_FR (multiply_fr, MULTIPLY_FR, OP_MULTIPLY)
-DEFINE_BINARY_FR (divide, DIVIDE, OP_DIVIDE)
+DEFINE_BINARY_FR (add_fr, ADD_FR, FOP_ADD)
+DEFINE_BINARY_FR (subtract_fr, SUBTRACT_FR, FOP_SUBTRACT)
+DEFINE_BINARY_FR (multiply_fr, MULTIPLY_FR, FOP_MULTIPLY)
+DEFINE_BINARY_FR (divide, DIVIDE, FOP_DIVIDE)
 DEFINE_BINARY_FR (atan2, ATAN2, atan2)
 \f
 /* Address decoders */