From: Jason Wilson <edu/mit/csail/zurich/jawilson>
Date: Tue, 26 Oct 1993 03:05:43 +0000 (+0000)
Subject: These changes were to bring the C backend back to life.
X-Git-Tag: 20090517-FFI~7699
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=8e3e3a02c9b7c41a4852b085d23017907e67f681;p=mit-scheme.git

These changes were to bring the C backend back to life.
---

diff --git a/v7/src/microcode/boot.c b/v7/src/microcode/boot.c
index 93349f182..001f1bf06 100644
--- a/v7/src/microcode/boot.c
+++ b/v7/src/microcode/boot.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: boot.c,v 9.85 1993/10/14 19:20:09 gjr Exp $
+$Id: boot.c,v 9.86 1993/10/26 03:04:06 jawilson Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -50,7 +50,7 @@ extern void EXFUN (init_exit_scheme, (void));
 extern void EXFUN (Clear_Memory, (int, int, int));
 extern void EXFUN (Setup_Memory, (int, int, int));
 extern void EXFUN (compiler_initialize, (long fasl_p));
-extern SCHEME_OBJECT EXFUN (make_primitive, (char *));
+extern SCHEME_OBJECT EXFUN (make_primitive, (char *, int));
 
 static void EXFUN (Start_Scheme, (int, CONST char *));
 static void EXFUN (Enter_Interpreter, (void));
@@ -237,47 +237,47 @@ DEFUN_VOID (make_fixed_objects_vector)
   FAST_VECTOR_SET
     (fixed_objects_vector,
      GENERIC_TRAMPOLINE_ZERO_P,
-     (make_primitive ("INTEGER-ZERO?")));
+     (make_primitive ("INTEGER-ZERO?", 1)));
   FAST_VECTOR_SET
     (fixed_objects_vector,
      GENERIC_TRAMPOLINE_POSITIVE_P,
-     (make_primitive ("INTEGER-POSITIVE?")));
+     (make_primitive ("INTEGER-POSITIVE?", 1)));
   FAST_VECTOR_SET
     (fixed_objects_vector,
      GENERIC_TRAMPOLINE_NEGATIVE_P,
-     (make_primitive ("INTEGER-NEGATIVE?")));
+     (make_primitive ("INTEGER-NEGATIVE?", 1)));
   FAST_VECTOR_SET
     (fixed_objects_vector,
      GENERIC_TRAMPOLINE_SUCCESSOR,
-     (make_primitive ("INTEGER-ADD-1")));
+     (make_primitive ("INTEGER-ADD-1", 1)));
   FAST_VECTOR_SET
     (fixed_objects_vector,
      GENERIC_TRAMPOLINE_PREDECESSOR,
-     (make_primitive ("INTEGER-SUBTRACT-1")));
+     (make_primitive ("INTEGER-SUBTRACT-1", 1)));
   FAST_VECTOR_SET
     (fixed_objects_vector,
      GENERIC_TRAMPOLINE_EQUAL_P,
-     (make_primitive ("INTEGER-EQUAL?")));
+     (make_primitive ("INTEGER-EQUAL?", 2)));
   FAST_VECTOR_SET
     (fixed_objects_vector,
      GENERIC_TRAMPOLINE_LESS_P,
-     (make_primitive ("INTEGER-LESS?")));
+     (make_primitive ("INTEGER-LESS?", 2)));
   FAST_VECTOR_SET
     (fixed_objects_vector,
      GENERIC_TRAMPOLINE_GREATER_P,
-     (make_primitive ("INTEGER-GREATER?")));
+     (make_primitive ("INTEGER-GREATER?", 2)));
   FAST_VECTOR_SET
     (fixed_objects_vector,
      GENERIC_TRAMPOLINE_ADD,
-     (make_primitive ("INTEGER-ADD")));
+     (make_primitive ("INTEGER-ADD", 2)));
   FAST_VECTOR_SET
     (fixed_objects_vector,
      GENERIC_TRAMPOLINE_SUBTRACT,
-     (make_primitive ("INTEGER-SUBTRACT")));
+     (make_primitive ("INTEGER-SUBTRACT", 2)));
   FAST_VECTOR_SET
     (fixed_objects_vector,
      GENERIC_TRAMPOLINE_MULTIPLY,
-     (make_primitive ("INTEGER-MULTIPLY")));
+     (make_primitive ("INTEGER-MULTIPLY", 2)));
   FAST_VECTOR_SET
     (fixed_objects_vector,
      GENERIC_TRAMPOLINE_DIVIDE,
@@ -362,11 +362,11 @@ DEFUN (Start_Scheme, (Start_Prim, File_Name),
   {
     case BOOT_FASLOAD:	/* (SCODE-EVAL (BINARY-FASLOAD <file>) GLOBAL-ENV) */
       FName = (char_pointer_to_string ((unsigned char *) File_Name));
-      prim = (make_primitive ("BINARY-FASLOAD"));
+      prim = (make_primitive ("BINARY-FASLOAD", 1));
       inner_arg = Free;
       *Free++ = prim;
       *Free++ = FName;
-      prim = (make_primitive ("SCODE-EVAL"));
+      prim = (make_primitive ("SCODE-EVAL", 2));
       expr = MAKE_POINTER_OBJECT (TC_PCOMB2, Free);
       *Free++ = prim;
       *Free++ = MAKE_POINTER_OBJECT (TC_PCOMB1, inner_arg);
@@ -375,7 +375,7 @@ DEFUN (Start_Scheme, (Start_Prim, File_Name),
 
     case BOOT_LOAD_BAND:	/* (LOAD-BAND <file>) */
       FName = (char_pointer_to_string ((unsigned char *) File_Name));
-      prim = make_primitive ("LOAD-BAND");
+      prim = (make_primitive ("LOAD-BAND", 1));
       inner_arg = Free;
       *Free++ = prim;
       *Free++ = FName;
@@ -383,7 +383,7 @@ DEFUN (Start_Scheme, (Start_Prim, File_Name),
       break;
 
     case BOOT_GET_WORK:		/* ((GET-WORK)) */
-      prim = make_primitive ("GET-WORK");
+      prim = (make_primitive ("GET-WORK", 0));
       inner_arg = Free;
       *Free++ = prim;
       *Free++ = SHARP_F;
@@ -395,11 +395,11 @@ DEFUN (Start_Scheme, (Start_Prim, File_Name),
     case BOOT_EXECUTE:
       /* (SCODE-EVAL (INITIALIZE-C-COMPILED-BLOCK <file>) GLOBAL-ENV) */
       FName = (char_pointer_to_string ((unsigned char *) File_Name));
-      prim = (make_primitive ("INITIALIZE-C-COMPILED-BLOCK"));
+      prim = (make_primitive ("INITIALIZE-C-COMPILED-BLOCK", 1));
       inner_arg = Free;
       *Free++ = prim;
       *Free++ = FName;
-      prim = (make_primitive ("SCODE-EVAL"));
+      prim = (make_primitive ("SCODE-EVAL", 2));
       expr = (MAKE_POINTER_OBJECT (TC_PCOMB2, Free));
       *Free++ = prim;
       *Free++ = (MAKE_POINTER_OBJECT (TC_PCOMB1, inner_arg));
diff --git a/v7/src/microcode/cmpauxmd/c.c b/v7/src/microcode/cmpauxmd/c.c
index 205c50578..6e508d84c 100644
--- a/v7/src/microcode/cmpauxmd/c.c
+++ b/v7/src/microcode/cmpauxmd/c.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: c.c,v 1.3 1993/06/15 19:02:11 gjr Exp $
+$Id: c.c,v 1.4 1993/10/26 03:05:43 jawilson Exp $
 
 Copyright (c) 1992-1993 Massachusetts Institute of Technology
 
@@ -48,8 +48,7 @@ extern SCHEME_OBJECT EXFUN (double_to_flonum, (double));
 extern SCHEME_OBJECT EXFUN (long_to_integer, (long));
 extern SCHEME_OBJECT EXFUN (digit_string_to_integer, (Boolean, long, char *));
 extern SCHEME_OBJECT EXFUN (digit_string_to_bit_string, (long, long, char *));
-extern SCHEME_OBJECT EXFUN (search_for_primitive,
-			    (SCHEME_OBJECT, char *, Boolean, Boolean, int));
+extern SCHEME_OBJECT EXFUN (make_primitive, (char *, int));
 
 SCHEME_OBJECT EXFUN ((* (constructor_kludge [10])), ()) =
 {
@@ -62,7 +61,7 @@ SCHEME_OBJECT EXFUN ((* (constructor_kludge [10])), ()) =
   ((SCHEME_OBJECT EXFUN ((*), ())) long_to_integer),
   ((SCHEME_OBJECT EXFUN ((*), ())) digit_string_to_integer),
   ((SCHEME_OBJECT EXFUN ((*), ())) digit_string_to_bit_string),
-  ((SCHEME_OBJECT EXFUN ((*), ())) search_for_primitive)
+  ((SCHEME_OBJECT EXFUN ((*), ())) make_primitive)
 };
 
 #endif /* BUG_GCC_LONG_CALLS */
diff --git a/v7/src/microcode/dosconio.c b/v7/src/microcode/dosconio.c
index d75f08b37..0631a48a4 100644
--- a/v7/src/microcode/dosconio.c
+++ b/v7/src/microcode/dosconio.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: dosconio.c,v 1.11 1993/07/18 22:25:57 gjr Exp $
+$Id: dosconio.c,v 1.12 1993/10/26 03:04:07 jawilson Exp $
 
 Copyright (c) 1992-1993 Massachusetts Institute of Technology
 
@@ -271,7 +271,7 @@ DEFUN (DOS_initialize_fov, (fov), SCHEME_OBJECT fov)
 {
   int ctr, in;
   SCHEME_OBJECT iv, imv, prim, mask;
-  extern SCHEME_OBJECT EXFUN (make_primitive, (char *));
+  extern SCHEME_OBJECT EXFUN (make_primitive, (char *, int));
   static int interrupt_numbers[] = {
     Global_GC_Level,
     Global_1_Level
@@ -283,7 +283,7 @@ DEFUN (DOS_initialize_fov, (fov), SCHEME_OBJECT fov)
 
   iv = (FAST_VECTOR_REF (fov, System_Interrupt_Vector));
   imv = (FAST_VECTOR_REF (fov, FIXOBJ_INTERRUPT_MASK_VECTOR));
-  prim = (make_primitive ("MICROCODE-POLL-INTERRUPT-HANDLER"));
+  prim = (make_primitive ("MICROCODE-POLL-INTERRUPT-HANDLER", 2));
 
   for (ctr = 0; ctr < ((sizeof (interrupt_numbers)) / (sizeof (int))); ctr++)
   {
@@ -374,8 +374,8 @@ DEFUN (console_read, (buffer, nbytes, buffered_p, blocking_p, intrpt_p),
   return (0);
 }
 
-DEFINE_PRIMITIVE ("MICROCODE-POLL-INTERRUPT-HANDLER", Prim_dos_high_priority_timer, 2, 2,
-		  "DOS Polling interrupt handler---timer and keyboard.")
+DEFINE_PRIMITIVE ("MICROCODE-POLL-INTERRUPT-HANDLER", Prim_dos_high_priority_timer,
+		  2, 2, "DOS Polling interrupt handler---timer and keyboard.")
 {
   extern void EXFUN (dos_process_timer_interrupt, (void));
   PRIMITIVE_HEADER (2);
diff --git a/v7/src/microcode/intercom.c b/v7/src/microcode/intercom.c
index fe6e7f475..8481c7c96 100644
--- a/v7/src/microcode/intercom.c
+++ b/v7/src/microcode/intercom.c
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Id: intercom.c,v 9.29 1993/06/24 07:08:51 gjr Exp $
+$Id: intercom.c,v 9.30 1993/10/26 03:04:08 jawilson Exp $
 
-Copyright (c) 1987, 1988, 1989, 1990 Massachusetts Institute of Technology
+Copyright (c) 1987-1993 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -287,14 +287,14 @@ DEFINE_PRIMITIVE ("MASTER-GC-BEFORE-SYNC", Prim_master_before, 0, 0, 0)
 DEFINE_PRIMITIVE ("MASTER-GC-LOOP", Prim_master_gc, 1, 1, 0)
 {
   static SCHEME_OBJECT gc_prim = SHARP_F;
-  extern SCHEME_OBJECT make_primitive ();
+  extern SCHEME_OBJECT EXFUN (make_primitive, (char *, int));
   PRIMITIVE_HEADER (1);
   PRIMITIVE_CANONICALIZE_CONTEXT();
   /* This primitive caches the Scheme object for the garbage collector
      primitive so that it does not have to perform a potentially
      expensive search each time. */
   if (gc_prim == SHARP_F)
-    gc_prim = (make_primitive ("GARBAGE-COLLECT"));
+    gc_prim = (make_primitive ("GARBAGE-COLLECT", 1));
   {
     SCHEME_OBJECT argument = (ARG_REF (1));
     POP_PRIMITIVE_FRAME (1);
diff --git a/v7/src/microcode/liarc.h b/v7/src/microcode/liarc.h
index 70cbc2ba4..6aa924a6d 100644
--- a/v7/src/microcode/liarc.h
+++ b/v7/src/microcode/liarc.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: liarc.h,v 1.2 1993/06/24 05:46:01 gjr Exp $
+$Id: liarc.h,v 1.3 1993/10/26 03:04:10 jawilson Exp $
 
 Copyright (c) 1992-1993 Massachusetts Institute of Technology
 
@@ -89,8 +89,7 @@ extern void EXFUN (error_band_already_built, (void));
 #define C_SYM_INTERN(len,str)						\
   (MEMORY_TO_SYMBOL ((len), ((unsigned char *) str)))
 
-#define MAKE_PRIMITIVE_PROCEDURE(name,arity)				\
-  (SEARCH_FOR_PRIMITIVE (SHARP_F, name, true, true, arity))
+#define MAKE_PRIMITIVE_PROCEDURE(name,arity) (MAKE_PRIMITIVE (name, arity))
 
 #define MAKE_LINKER_HEADER(kind,count)					\
   (OBJECT_NEW_TYPE (TC_FIXNUM,						\
@@ -348,6 +347,36 @@ REGISTER SCHEME_OBJECT * stack_pointer = Stack_Pointer
     ? (- ((source1) / (- (source2))))					\
     : ((- (source1)) / (- (source2)))))
 
+extern double EXFUN (acos, (double));
+extern double EXFUN (asin, (double));
+extern double EXFUN (atan, (double));
+extern double EXFUN (ceil, (double));
+extern double EXFUN (cos, (double));
+extern double EXFUN (exp, (double));
+extern double EXFUN (floor, (double));
+extern double EXFUN (log, (double));
+extern double EXFUN (sin, (double));
+extern double EXFUN (sqrt, (double));
+extern double EXFUN (tan, (double));
+extern double EXFUN (double_truncate, (double));
+
+#define DOUBLE_ACOS acos
+#define DOUBLE_ASIN asin
+#define DOUBLE_ATAN atan
+#define DOUBLE_CEILING ceil
+#define DOUBLE_COS cos
+#define DOUBLE_EXP exp
+#define DOUBLE_FLOOR floor
+#define DOUBLE_LOG log
+#define DOUBLE_ROUND(dx) (double_truncate ((dx < 0) ? (dx - 0.5) : (dx + 0.5)))
+#define DOUBLE_SIN sin
+#define DOUBLE_SQRT sqrt
+#define DOUBLE_TAN tan
+#define DOUBLE_TRUNCATE double_truncate
+
+extern double EXFUN (atan2, (double, double));
+#define DOUBLE_ATAN2 atan2
+
 #define CLOSURE_HEADER(offset) do					\
 {									\
   SCHEME_OBJECT * entry = ((SCHEME_OBJECT *) my_pc[1]);			\
@@ -421,8 +450,7 @@ extern SCHEME_OBJECT EXFUN (double_to_flonum, (double));
 extern SCHEME_OBJECT EXFUN (long_to_integer, (long));
 extern SCHEME_OBJECT EXFUN (digit_string_to_integer, (Boolean, long, char *));
 extern SCHEME_OBJECT EXFUN (digit_string_to_bit_string, (long, long, char *));
-extern SCHEME_OBJECT EXFUN (search_for_primitive,
-			    (SCHEME_OBJECT, char *, Boolean, Boolean, int));
+extern SCHEME_OBJECT EXFUN (make_primitive, (char *, int));
 
 #define MEMORY_TO_STRING memory_to_string
 #define MEMORY_TO_SYMBOL memory_to_symbol
@@ -433,9 +461,9 @@ extern SCHEME_OBJECT EXFUN (search_for_primitive,
 #define LONG_TO_INTEGER long_to_integer
 #define DIGIT_STRING_TO_INTEGER digit_string_to_integer
 #define DIGIT_STRING_TO_BIT_STRING digit_string_to_bit_string
-#define SEARCH_FOR_PRIMITIVE search_for_primitive
+#define MAKE_PRIMITIVE make_primitive
 
-#else /* GCC on Specturm has a strange bug so do thing differently .... */
+#else /* GCC on Spectrum has a strange bug so do thing differently .... */
 
 extern SCHEME_OBJECT EXFUN ((* (constructor_kludge [10])), ());
 
@@ -466,10 +494,8 @@ extern SCHEME_OBJECT EXFUN ((* (constructor_kludge [10])), ());
 #define DIGIT_STRING_TO_BIT_STRING					\
      ((SCHEME_OBJECT EXFUN ((*), (long, long, char *))) (constructor_kludge[8]))
 
-#define SEARCH_FOR_PRIMITIVE						\
-     ((SCHEME_OBJECT EXFUN ((*), (SCHEME_OBJECT, char *,		\
-				  Boolean, Boolean, int)))		\
-      (constructor_kludge[9]))
+#define MAKE_PRIMITIVE							\
+     ((SCHEME_OBJECT EXFUN ((*), (char *, int))) (constructor_kludge[9]))
 
 #endif /* BUG_GCC_LONG_CALLS */
 
diff --git a/v7/src/microcode/ntsig.c b/v7/src/microcode/ntsig.c
index 2a32645a9..df16e4a43 100644
--- a/v7/src/microcode/ntsig.c
+++ b/v7/src/microcode/ntsig.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: ntsig.c,v 1.14 1993/09/13 18:38:57 gjr Exp $
+$Id: ntsig.c,v 1.15 1993/10/26 03:04:10 jawilson Exp $
 
 Copyright (c) 1992-1993 Massachusetts Institute of Technology
 
@@ -480,7 +480,7 @@ DEFUN (NT_initialize_fov, (fov), SCHEME_OBJECT fov)
 {
   int ctr, in;
   SCHEME_OBJECT iv, imv, prim;
-  extern SCHEME_OBJECT EXFUN (make_primitive, (char *));
+  extern SCHEME_OBJECT EXFUN (make_primitive, (char *, int));
   static int interrupt_numbers[2] =
   {
     Global_GC_Level,
@@ -494,7 +494,7 @@ DEFUN (NT_initialize_fov, (fov), SCHEME_OBJECT fov)
 
   iv = (FAST_VECTOR_REF (fov, System_Interrupt_Vector));
   imv = (FAST_VECTOR_REF (fov, FIXOBJ_INTERRUPT_MASK_VECTOR));
-  prim = (make_primitive ("MICROCODE-POLL-INTERRUPT-HANDLER"));
+  prim = (make_primitive ("MICROCODE-POLL-INTERRUPT-HANDLER", 2));
 
   for (ctr = 0; ctr < ((sizeof (interrupt_numbers)) / (sizeof (int))); ctr++)
   {
diff --git a/v7/src/microcode/primutl.c b/v7/src/microcode/primutl.c
index 68ed30c41..26bd2de2b 100644
--- a/v7/src/microcode/primutl.c
+++ b/v7/src/microcode/primutl.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: primutl.c,v 9.66 1993/08/28 20:01:08 gjr Exp $
+$Id: primutl.c,v 9.67 1993/10/26 03:04:12 jawilson Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -87,7 +87,7 @@ extern void
   EXFUN (install_primitive_table, (SCHEME_OBJECT *, long));
 
 extern SCHEME_OBJECT
-  EXFUN (make_primitive, (char *)),
+  EXFUN (make_primitive, (char *, int)),
   EXFUN (find_primitive, (SCHEME_OBJECT, Boolean, Boolean, int)),
   EXFUN (declare_primitive, (char *, primitive_procedure_t, int, int, char *)),
   EXFUN (install_primitive, (char *, primitive_procedure_t, int, int, char *)),
@@ -100,7 +100,6 @@ extern SCHEME_OBJECT
 
 extern int
   EXFUN (strcmp_ci, (char *, char *));
-
 
 /* Common utilities. */
 
@@ -436,7 +435,8 @@ DEFUN_VOID (initialize_primitives)
 
     if (orig == ((node) NULL))
     {
-      SCHEME_OBJECT old = (make_primitive (primitive_aliases[counter].name));
+      SCHEME_OBJECT old = (make_primitive (primitive_aliases[counter].name,
+					   UNKNOWN_PRIMITIVE_ARITY));
       
       if (old == SHARP_F)
       {
@@ -567,14 +567,14 @@ DEFUN (install_primitive, (name, code, nargs_lo, nargs_hi, docstr),
  */
 
 SCHEME_OBJECT
-DEFUN (make_primitive, (name), char * name)
+DEFUN (make_primitive, (name, arity), char * name AND int arity)
 {
   SCHEME_OBJECT result;
 
   result = (declare_primitive (name,
 			       Prim_unimplemented,
-			       UNKNOWN_PRIMITIVE_ARITY,
-			       UNKNOWN_PRIMITIVE_ARITY,
+			       arity,
+			       arity,
 			       ((char *) NULL)));
   return ((result == SHARP_F)
 	  ? SHARP_F
diff --git a/v8/src/microcode/liarc.h b/v8/src/microcode/liarc.h
index 70cbc2ba4..6aa924a6d 100644
--- a/v8/src/microcode/liarc.h
+++ b/v8/src/microcode/liarc.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: liarc.h,v 1.2 1993/06/24 05:46:01 gjr Exp $
+$Id: liarc.h,v 1.3 1993/10/26 03:04:10 jawilson Exp $
 
 Copyright (c) 1992-1993 Massachusetts Institute of Technology
 
@@ -89,8 +89,7 @@ extern void EXFUN (error_band_already_built, (void));
 #define C_SYM_INTERN(len,str)						\
   (MEMORY_TO_SYMBOL ((len), ((unsigned char *) str)))
 
-#define MAKE_PRIMITIVE_PROCEDURE(name,arity)				\
-  (SEARCH_FOR_PRIMITIVE (SHARP_F, name, true, true, arity))
+#define MAKE_PRIMITIVE_PROCEDURE(name,arity) (MAKE_PRIMITIVE (name, arity))
 
 #define MAKE_LINKER_HEADER(kind,count)					\
   (OBJECT_NEW_TYPE (TC_FIXNUM,						\
@@ -348,6 +347,36 @@ REGISTER SCHEME_OBJECT * stack_pointer = Stack_Pointer
     ? (- ((source1) / (- (source2))))					\
     : ((- (source1)) / (- (source2)))))
 
+extern double EXFUN (acos, (double));
+extern double EXFUN (asin, (double));
+extern double EXFUN (atan, (double));
+extern double EXFUN (ceil, (double));
+extern double EXFUN (cos, (double));
+extern double EXFUN (exp, (double));
+extern double EXFUN (floor, (double));
+extern double EXFUN (log, (double));
+extern double EXFUN (sin, (double));
+extern double EXFUN (sqrt, (double));
+extern double EXFUN (tan, (double));
+extern double EXFUN (double_truncate, (double));
+
+#define DOUBLE_ACOS acos
+#define DOUBLE_ASIN asin
+#define DOUBLE_ATAN atan
+#define DOUBLE_CEILING ceil
+#define DOUBLE_COS cos
+#define DOUBLE_EXP exp
+#define DOUBLE_FLOOR floor
+#define DOUBLE_LOG log
+#define DOUBLE_ROUND(dx) (double_truncate ((dx < 0) ? (dx - 0.5) : (dx + 0.5)))
+#define DOUBLE_SIN sin
+#define DOUBLE_SQRT sqrt
+#define DOUBLE_TAN tan
+#define DOUBLE_TRUNCATE double_truncate
+
+extern double EXFUN (atan2, (double, double));
+#define DOUBLE_ATAN2 atan2
+
 #define CLOSURE_HEADER(offset) do					\
 {									\
   SCHEME_OBJECT * entry = ((SCHEME_OBJECT *) my_pc[1]);			\
@@ -421,8 +450,7 @@ extern SCHEME_OBJECT EXFUN (double_to_flonum, (double));
 extern SCHEME_OBJECT EXFUN (long_to_integer, (long));
 extern SCHEME_OBJECT EXFUN (digit_string_to_integer, (Boolean, long, char *));
 extern SCHEME_OBJECT EXFUN (digit_string_to_bit_string, (long, long, char *));
-extern SCHEME_OBJECT EXFUN (search_for_primitive,
-			    (SCHEME_OBJECT, char *, Boolean, Boolean, int));
+extern SCHEME_OBJECT EXFUN (make_primitive, (char *, int));
 
 #define MEMORY_TO_STRING memory_to_string
 #define MEMORY_TO_SYMBOL memory_to_symbol
@@ -433,9 +461,9 @@ extern SCHEME_OBJECT EXFUN (search_for_primitive,
 #define LONG_TO_INTEGER long_to_integer
 #define DIGIT_STRING_TO_INTEGER digit_string_to_integer
 #define DIGIT_STRING_TO_BIT_STRING digit_string_to_bit_string
-#define SEARCH_FOR_PRIMITIVE search_for_primitive
+#define MAKE_PRIMITIVE make_primitive
 
-#else /* GCC on Specturm has a strange bug so do thing differently .... */
+#else /* GCC on Spectrum has a strange bug so do thing differently .... */
 
 extern SCHEME_OBJECT EXFUN ((* (constructor_kludge [10])), ());
 
@@ -466,10 +494,8 @@ extern SCHEME_OBJECT EXFUN ((* (constructor_kludge [10])), ());
 #define DIGIT_STRING_TO_BIT_STRING					\
      ((SCHEME_OBJECT EXFUN ((*), (long, long, char *))) (constructor_kludge[8]))
 
-#define SEARCH_FOR_PRIMITIVE						\
-     ((SCHEME_OBJECT EXFUN ((*), (SCHEME_OBJECT, char *,		\
-				  Boolean, Boolean, int)))		\
-      (constructor_kludge[9]))
+#define MAKE_PRIMITIVE							\
+     ((SCHEME_OBJECT EXFUN ((*), (char *, int))) (constructor_kludge[9]))
 
 #endif /* BUG_GCC_LONG_CALLS */