From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 28 Sep 1989 21:19:51 +0000 (+0000)
Subject: Add primitives `fixnum-quotient' and `fixnum-remainder'.
X-Git-Tag: 20090517-FFI~11765
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=fd6f2014e06e2d02c787c9094c85d13f18671372;p=mit-scheme.git

Add primitives `fixnum-quotient' and `fixnum-remainder'.
---

diff --git a/v7/src/microcode/fixnum.c b/v7/src/microcode/fixnum.c
index 72537536f..15e5be261 100644
--- a/v7/src/microcode/fixnum.c
+++ b/v7/src/microcode/fixnum.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fixnum.c,v 9.28 1989/09/20 23:08:26 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fixnum.c,v 9.29 1989/09/28 21:18:59 cph Exp $
 
 Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
@@ -122,6 +122,12 @@ DEFINE_PRIMITIVE ("MINUS-FIXNUM", Prim_minus_fixnum, 2, 2, 0)
   FIXNUM_RESULT ((arg_fixnum (1)) - (arg_fixnum (2)));
 }
 
+DEFINE_PRIMITIVE ("FIXNUM-NEGATE", Prim_fixnum_negate, 1, 1, 0)
+{
+  PRIMITIVE_HEADER (1);
+  FIXNUM_RESULT (- (arg_fixnum (1)));
+}
+
 /* Fixnum multiplication routine with overflow detection. */
 #include "mul.c"
 
@@ -180,6 +186,48 @@ DEFINE_PRIMITIVE ("DIVIDE-FIXNUM", Prim_divide_fixnum, 2, 2, 0)
   PRIMITIVE_RETURN
     (cons ((LONG_TO_FIXNUM (quotient)), (LONG_TO_FIXNUM (remainder))));
 }
+
+DEFINE_PRIMITIVE ("FIXNUM-QUOTIENT", Prim_fixnum_quotient, 2, 2, 0)
+{
+  PRIMITIVE_HEADER (2);
+  {
+    fast long numerator = (arg_fixnum (1));
+    fast long denominator = (arg_fixnum (2));
+    fast long quotient =
+      ((denominator > 0)
+       ? ((numerator < 0)
+	  ? (- ((- numerator) / denominator))
+	  : (numerator / denominator))
+       : (denominator < 0)
+       ? ((numerator < 0)
+	  ? ((- numerator) / (- denominator))
+	  : (- (numerator / (- denominator))))
+       : (error_bad_range_arg (2), 0));
+    if (! (LONG_TO_FIXNUM_P (quotient)))
+      error_bad_range_arg (1);
+    PRIMITIVE_RETURN (LONG_TO_FIXNUM (quotient));
+  }
+}
+
+DEFINE_PRIMITIVE ("FIXNUM-REMAINDER", Prim_fixnum_remainder, 2, 2, 0)
+{
+  PRIMITIVE_HEADER (2);
+  {
+    fast long numerator = (arg_fixnum (1));
+    fast long denominator = (arg_fixnum (2));
+    PRIMITIVE_RETURN
+      (LONG_TO_FIXNUM
+       ((denominator > 0)
+	? ((numerator < 0)
+	   ? (- ((- numerator) % denominator))
+	   : (numerator % denominator))
+	: (denominator < 0)
+	? ((numerator < 0)
+	   ? (- ((- numerator) % (- denominator)))
+	   : (numerator % (- denominator)))
+	: (error_bad_range_arg (2), 0)));
+  }
+}
 
 DEFINE_PRIMITIVE ("GCD-FIXNUM", Prim_gcd_fixnum, 2, 2, 0)
 {
@@ -189,6 +237,8 @@ DEFINE_PRIMITIVE ("GCD-FIXNUM", Prim_gcd_fixnum, 2, 2, 0)
   PRIMITIVE_HEADER (2);
   x = (arg_fixnum (1));
   y = (arg_fixnum (2));
+  if (x < 0) x = (-x);
+  if (y < 0) y = (-y);
   while (y != 0)
     {
       z = x;
diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h
index a6a0d27a2..b63eb8618 100644
--- a/v7/src/microcode/version.h
+++ b/v7/src/microcode/version.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 11.3 1989/09/25 16:51:23 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 11.4 1989/09/28 21:19:51 cph Exp $
 
 Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
@@ -46,7 +46,7 @@ MIT in each case. */
 #define VERSION		11
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION	3
+#define SUBVERSION	4
 #endif
 
 #ifndef UCODE_TABLES_FILENAME
diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h
index f88b690f6..8cde4c23e 100644
--- a/v8/src/microcode/version.h
+++ b/v8/src/microcode/version.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 11.3 1989/09/25 16:51:23 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 11.4 1989/09/28 21:19:51 cph Exp $
 
 Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
@@ -46,7 +46,7 @@ MIT in each case. */
 #define VERSION		11
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION	3
+#define SUBVERSION	4
 #endif
 
 #ifndef UCODE_TABLES_FILENAME