Some changes for primitives accessed specially from compiled code

(arithmetic).

diff --git a/v7/src/microcode/boot.c b/v7/src/microcode/boot.c
index 55a6d1949a389a51dcf8c11bd9a9cb855ddd7cbd..285ce2db118c06e597ad30ac58562ad112929d1e 100644 (file)
--- a/v7/src/microcode/boot.c
+++ b/v7/src/microcode/boot.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/boot.c,v 9.40 1987/11/17 08:07:35 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/boot.c,v 9.41 1987/11/18 19:31:34 jinx Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -412,27 +412,34 @@ Start_Scheme(Start_Prim, File_Name)
        depending on the value of Start_Prim.
 */
 
-  FName = C_String_To_Scheme_String(File_Name);
-  Fasload_Call = Free;
   switch (Start_Prim)
   {
     case BOOT_FASLOAD: /* (SCODE-EVAL (BINARY-FASLOAD <file>) GLOBAL-ENV) */
-      *Free++ = make_primitive("BINARY-FASLOAD");
+      FName = C_String_To_Scheme_String(File_Name);
+      prim = make_primitive("BINARY-FASLOAD");
+      Fasload_Call = Free;
+      *Free++ = prim;
       *Free++ = FName;
+      prim = make_primitive("SCODE-EVAL");
       Init_Prog = Make_Pointer(TC_PCOMB2, Free);
-      *Free++ = make_primitive("SCODE-EVAL");
+      *Free++ = prim;
       *Free++ = Make_Pointer(TC_PCOMB1, Fasload_Call);
       *Free++ = Make_Non_Pointer(GLOBAL_ENV, GO_TO_GLOBAL);
       break;
 
     case BOOT_LOAD_BAND:       /* (LOAD-BAND <file>) */
-      *Free++ = make_primitive("LOAD-BAND");
+      FName = C_String_To_Scheme_String(File_Name);
+      prim = make_primitive("LOAD-BAND");
+      Fasload_Call = Free;
+      *Free++ = prim;
       *Free++ = FName;
       Init_Prog = Make_Pointer(TC_PCOMB1, Fasload_Call);
       break;
 
     case BOOT_GET_WORK:                /* ((GET-WORK)) */
-      *Free++ = make_primitive("GET-WORK");
+      prim = make_primitive("GET-WORK");
+      Fasload_Call = Free;
+      *Free++ = prim;
       *Free++ = NIL;
       Init_Prog = Make_Pointer(TC_COMBINATION, Free);
       *Free++ = Make_Non_Pointer(TC_MANIFEST_VECTOR, 1);

diff --git a/v7/src/microcode/primutl.c b/v7/src/microcode/primutl.c
index 2c2bdf86b3fa38929e0c6464ffb616e83b7c7e41..53cc2515937841305eef3999c488121ded2d8f23 100644 (file)
--- a/v7/src/microcode/primutl.c
+++ b/v7/src/microcode/primutl.c
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/primutl.c,v 9.42 1987/11/18 00:08:54 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/primutl.c,v 9.43 1987/11/18 19:30:52 jinx Exp $
  *
  * This file contains the support routines for mapping primitive names
  * to numbers within the microcode.  Primitives are written in C
@@ -163,7 +163,7 @@ primitive_code_to_arity(code, table, size)
     return ((long) table[code]);
   }
 }
-
+\f
 /* Externally visible utilities */
 
 extern Pointer make_primitive();
@@ -172,14 +172,24 @@ Pointer
 make_primitive(name)
      char *name;
 {
-  long i;
+  Pointer search_for_primitive();
 
-  i = primitive_name_to_code(name,
-                            &Primitive_Name_Table[0],
-                            MAX_PRIMITIVE);
-  return ((i == ((long) -1)) ?
-         NIL :
-         Make_Non_Pointer(TC_PRIMITIVE, i));
+  return (search_for_primitive(NIL, name, true, true,
+                              UNKNOWN_PRIMITIVE_ARITY));
+}
+
+extern Pointer find_primitive();
+
+Pointer
+find_primitive(name, intern_p, allow_p, arity)
+     Pointer name;
+     Boolean intern_p, allow_p;
+     int arity;
+{
+  Pointer search_for_primitive();
+
+  return (search_for_primitive(name, Scheme_String_To_C_String(name),
+                              intern_p, allow_p, arity));
 }
 \f
 extern long primitive_to_arity();
@@ -288,19 +298,23 @@ primitive_name(code)
   return (string_to_symbol(scheme_string));
 }
 \f
-extern Pointer find_primitive();
+/*
+  scheme_name can be NIL, meaning cons up from c_name as needed.
+  c_name must always be provided.
+ */
 
 Pointer
-find_primitive(Name, intern_p, allow_p, arity)
-     Pointer Name;
+search_for_primitive(scheme_name, c_name, intern_p, allow_p, arity)
+     Pointer scheme_name;
+     char *c_name;
      Boolean intern_p, allow_p;
      int arity;
 {
-  extern Boolean string_equal();
+  extern int strcmp();
   long i, Max, old_arity;
   Pointer *Next;
 
-  i = primitive_name_to_code(Scheme_String_To_C_String(Name),
+  i = primitive_name_to_code(c_name,
                             &Primitive_Name_Table[0],
                             MAX_PRIMITIVE);
   if (i != -1)
@@ -315,14 +329,13 @@ find_primitive(Name, intern_p, allow_p, arity)
       return (MAKE_SIGNED_FIXNUM(old_arity));
     }
   }
-\f
   /* Search the undefined primitives table if allowed. */
 
   if (!allow_p)
   {
     return (NIL);
   }
-
+\f
   /* The vector should be sorted for faster comparison. */
 
   Max = NUMBER_OF_UNDEFINED_PRIMITIVES();
@@ -334,7 +347,8 @@ find_primitive(Name, intern_p, allow_p, arity)
     {
       Pointer temp;
 
-      if (string_equal(Name, *Next++))
+      temp = *Next++;
+      if (strcmp(c_name, Scheme_String_To_C_String(temp)) == 0)
       {
        if (arity != UNKNOWN_PRIMITIVE_ARITY)
        {
@@ -358,7 +372,7 @@ find_primitive(Name, intern_p, allow_p, arity)
       }
     }
   }
-\f
+
   /*
     Intern the primitive name by adding it to the vector of
     undefined primitives, if interning is allowed.
@@ -369,6 +383,11 @@ find_primitive(Name, intern_p, allow_p, arity)
     return (NIL);
   }
 
+  if (scheme_name == NIL)
+  {
+    scheme_name = C_String_To_Scheme_String(c_name);
+  }
+\f
   if ((Max % CHUNK_SIZE) == 0)
   {
     Primitive_GC_If_Needed(2 * (Max + CHUNK_SIZE + 2));
@@ -383,7 +402,7 @@ find_primitive(Name, intern_p, allow_p, arity)
     {
       *Free++ = Fetch(*Next++);
     }
-    *Free++ = Name;
+    *Free++ = scheme_name;
     for (i = 1; i < CHUNK_SIZE; i++)
     {
       *Free++ = NIL;
@@ -411,7 +430,7 @@ find_primitive(Name, intern_p, allow_p, arity)
   else
   {
     Max += 1;
-    User_Vector_Set(Undefined_Primitives, Max, Name);
+    User_Vector_Set(Undefined_Primitives, Max, scheme_name);
     if (arity != UNKNOWN_PRIMITIVE_ARITY)
     {
       User_Vector_Set(Undefined_Primitives_Arity,
@@ -566,8 +585,9 @@ install_primitive_table(table, length, flush_p)
     Sign_Extend(*table, arity);
     table += 1;
     result =
-      find_primitive(Make_Pointer(TC_CHARACTER_STRING, table),
-                    true, true, arity);
+      search_for_primitive(Make_Pointer(TC_CHARACTER_STRING, table),
+                          ((char *) (&table[STRING_CHARS])),
+                          true, true, arity);
     if (OBJECT_TYPE(result) != TC_PRIMITIVE)
     {
       Primitive_Error(ERR_WRONG_ARITY_PRIMITIVES);

diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h
index 79bdfbee985795c5713669213176bc9d23511645..ef9a38ec4c0a52657ff6c192ca367959d64cea5d 100644 (file)
--- a/v7/src/microcode/version.h
+++ b/v7/src/microcode/version.h
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 10.3 1987/11/17 08:21:22 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 10.4 1987/11/18 19:30:26 jinx Exp $
 
 This file contains version information for the microcode. */
 \f
@@ -46,7 +46,7 @@ This file contains version information for the microcode. */
 #define VERSION                10
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION     5
+#define SUBVERSION     6
 #endif
 
 #ifndef UCODE_TABLES_FILENAME

diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h
index 230eeb17cb3889ce623e08af82704ed7a78f5e0f..041b1f2efbbd01e519b96d0ad765bd4ad6084dd3 100644 (file)
--- a/v8/src/microcode/version.h
+++ b/v8/src/microcode/version.h
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 10.3 1987/11/17 08:21:22 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 10.4 1987/11/18 19:30:26 jinx Exp $
 
 This file contains version information for the microcode. */
 \f
@@ -46,7 +46,7 @@ This file contains version information for the microcode. */
 #define VERSION                10
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION     5
+#define SUBVERSION     6
 #endif
 
 #ifndef UCODE_TABLES_FILENAME