Make generic arithmetic primitives perform fixnum arithmetic as a
authorChris Hanson <org/chris-hanson/cph>
Fri, 12 Jan 1990 15:20:27 +0000 (15:20 +0000)
committerChris Hanson <org/chris-hanson/cph>
Fri, 12 Jan 1990 15:20:27 +0000 (15:20 +0000)
special case.  This makes a factor of 10 difference for (fib 20) on an
interpreted system.

v7/src/microcode/generic.c
v7/src/microcode/version.h
v8/src/microcode/version.h

index ebd7c9a16422a0f26c3dda1c77fb4aaef1c1de42..ac32534ead85546ff12911403075ec93fd4a4904 100644 (file)
@@ -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"
 \f
-#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)
+\f
+#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)
index 4be557aa82f4cbaa943363b6c0f648932dbc1226..15cf473d2843a206f2a6f87117f6a9882c8c9412 100644 (file)
@@ -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
index de90dd5a0519f077da8355064e62f5b2651c791a..c2c42fd7e5f9e7ac79aac1a356cf46066e8160df 100644 (file)
@@ -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