From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 12 Jan 1990 15:20:27 +0000 (+0000)
Subject: Make generic arithmetic primitives perform fixnum arithmetic as a
X-Git-Tag: 20090517-FFI~11598
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=f79a2fa9a523b84987b2fe6d6e4b45753ae3a1fd;p=mit-scheme.git

Make generic arithmetic primitives perform fixnum arithmetic as a
special case.  This makes a factor of 10 difference for (fib 20) on an
interpreted system.
---

diff --git a/v7/src/microcode/generic.c b/v7/src/microcode/generic.c
index ebd7c9a16..ac32534ea 100644
--- a/v7/src/microcode/generic.c
+++ b/v7/src/microcode/generic.c
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/generic.c,v 9.32 1989/10/26 07:49:47 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/generic.c,v 9.33 1990/01/12 15:20:15 cph Exp $
 
-Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989, 1990 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -35,51 +35,96 @@ MIT in each case. */
 #include "scheme.h"
 #include "prims.h"
 
-#define INDIRECT_1(slot)						\
+#define INDIRECT(slot, arity)						\
 {									\
-  PRIMITIVE_HEADER (1);							\
   PRIMITIVE_CANONICALIZE_CONTEXT ();					\
  Will_Push (STACK_ENV_EXTRA_SLOTS + 1);					\
   Push (Get_Fixed_Obj_Slot (slot));					\
-  Push (STACK_FRAME_HEADER + 1);					\
+  Push (STACK_FRAME_HEADER + arity);					\
  Pushed ();								\
   PRIMITIVE_ABORT (PRIM_APPLY);						\
   /*NOTREACHED*/							\
 }
 
+#define INDIRECT_TEST_1(test, slot)					\
+{									\
+  PRIMITIVE_HEADER (1);							\
+  {									\
+    fast SCHEME_OBJECT x = (ARG_REF (1));				\
+    if (FIXNUM_P (x))							\
+      return (test (x));						\
+  }									\
+  INDIRECT (slot, 1);							\
+}
+
 DEFINE_PRIMITIVE ("ZERO?", Prim_zero, 1, 1, 0)
-     INDIRECT_1 (GENERIC_TRAMPOLINE_ZERO_P)
+     INDIRECT_TEST_1 (FIXNUM_ZERO_P, GENERIC_TRAMPOLINE_ZERO_P)
 DEFINE_PRIMITIVE ("POSITIVE?", Prim_positive, 1, 1, 0)
-     INDIRECT_1 (GENERIC_TRAMPOLINE_POSITIVE_P)
+     INDIRECT_TEST_1 (FIXNUM_POSITIVE_P, GENERIC_TRAMPOLINE_POSITIVE_P)
 DEFINE_PRIMITIVE ("NEGATIVE?", Prim_negative, 1, 1, 0)
-     INDIRECT_1 (GENERIC_TRAMPOLINE_NEGATIVE_P)
+     INDIRECT_TEST_1 (FIXNUM_NEGATIVE_P, GENERIC_TRAMPOLINE_NEGATIVE_P)
+
+#define INDIRECT_INCREMENT(op, slot)					\
+{									\
+  PRIMITIVE_HEADER (1);							\
+  {									\
+    fast SCHEME_OBJECT x = (ARG_REF (1));				\
+    if (FIXNUM_P (x))							\
+      return (long_to_integer ((FIXNUM_TO_LONG (x)) op 1));		\
+  }									\
+  INDIRECT (slot, 1);							\
+}
+
 DEFINE_PRIMITIVE ("1+", Prim_add_one, 1, 1, 0)
-     INDIRECT_1 (GENERIC_TRAMPOLINE_SUCCESSOR)
+     INDIRECT_INCREMENT (+, GENERIC_TRAMPOLINE_SUCCESSOR)
 DEFINE_PRIMITIVE ("-1+", Prim_subtract_one, 1, 1, 0)
-     INDIRECT_1 (GENERIC_TRAMPOLINE_PREDECESSOR)
-
-#define INDIRECT_2(slot)						\
+     INDIRECT_INCREMENT (-, GENERIC_TRAMPOLINE_PREDECESSOR)
+
+#define INDIRECT_TEST_2(test, slot)					\
 {									\
   PRIMITIVE_HEADER (2);							\
-  PRIMITIVE_CANONICALIZE_CONTEXT ();					\
- Will_Push (STACK_ENV_EXTRA_SLOTS + 1);					\
-  Push (Get_Fixed_Obj_Slot (slot));					\
-  Push (STACK_FRAME_HEADER + 2);					\
- Pushed ();								\
-  PRIMITIVE_ABORT (PRIM_APPLY);						\
-  /*NOTREACHED*/							\
+  {									\
+    fast SCHEME_OBJECT x = (ARG_REF (1));				\
+    fast SCHEME_OBJECT y = (ARG_REF (2));				\
+    if ((FIXNUM_P (x)) && (FIXNUM_P (y)))				\
+      return (test (x, y));						\
+  }									\
+  INDIRECT (slot, 2);							\
 }
 
+#define FIXNUM_GREATER_P(x, y) FIXNUM_LESS_P (y, x)
+
 DEFINE_PRIMITIVE ("&=", Prim_equal_number, 2, 2, 0)
-     INDIRECT_2 (GENERIC_TRAMPOLINE_EQUAL_P)
+     INDIRECT_TEST_2 (FIXNUM_EQUAL_P, GENERIC_TRAMPOLINE_EQUAL_P)
 DEFINE_PRIMITIVE ("&<", Prim_less, 2, 2, 0)
-     INDIRECT_2 (GENERIC_TRAMPOLINE_LESS_P)
+     INDIRECT_TEST_2 (FIXNUM_LESS_P, GENERIC_TRAMPOLINE_LESS_P)
 DEFINE_PRIMITIVE ("&>", Prim_greater, 2, 2, 0)
-     INDIRECT_2 (GENERIC_TRAMPOLINE_GREATER_P)
+     INDIRECT_TEST_2 (FIXNUM_GREATER_P, GENERIC_TRAMPOLINE_GREATER_P)
+
+#define INDIRECT_SUM(op, slot)						\
+{									\
+  PRIMITIVE_HEADER (2);							\
+  {									\
+    fast SCHEME_OBJECT x = (ARG_REF (1));				\
+    fast SCHEME_OBJECT y = (ARG_REF (2));				\
+    if ((FIXNUM_P (x)) && (FIXNUM_P (y)))				\
+      return (long_to_integer ((FIXNUM_TO_LONG (x)) op			\
+			       (FIXNUM_TO_LONG (y))));			\
+  }									\
+  INDIRECT (slot, 2);							\
+}
+
 DEFINE_PRIMITIVE ("&+", Prim_add, 2, 2, 0)
-     INDIRECT_2 (GENERIC_TRAMPOLINE_ADD)
+     INDIRECT_SUM (+, GENERIC_TRAMPOLINE_ADD)
 DEFINE_PRIMITIVE ("&-", Prim_subtract, 2, 2, 0)
-     INDIRECT_2 (GENERIC_TRAMPOLINE_SUBTRACT)
+     INDIRECT_SUM (-, GENERIC_TRAMPOLINE_SUBTRACT)
+
+#define INDIRECT_2(slot)						\
+{									\
+  PRIMITIVE_HEADER (2);							\
+  INDIRECT (slot, 2);							\
+}
+
 DEFINE_PRIMITIVE ("&*", Prim_multiply, 2, 2, 0)
      INDIRECT_2 (GENERIC_TRAMPOLINE_MULTIPLY)
 DEFINE_PRIMITIVE ("&/", Prim_divide, 2, 2, 0)
diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h
index 4be557aa8..15cf473d2 100644
--- a/v7/src/microcode/version.h
+++ b/v7/src/microcode/version.h
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 11.16 1989/12/10 00:50:36 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 11.17 1990/01/12 15:20:27 cph Exp $
 
-Copyright (c) 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -46,7 +46,7 @@ MIT in each case. */
 #define VERSION		11
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION	16
+#define SUBVERSION	17
 #endif
 
 #ifndef UCODE_TABLES_FILENAME
diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h
index de90dd5a0..c2c42fd7e 100644
--- a/v8/src/microcode/version.h
+++ b/v8/src/microcode/version.h
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 11.16 1989/12/10 00:50:36 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 11.17 1990/01/12 15:20:27 cph Exp $
 
-Copyright (c) 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -46,7 +46,7 @@ MIT in each case. */
 #define VERSION		11
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION	16
+#define SUBVERSION	17
 #endif
 
 #ifndef UCODE_TABLES_FILENAME