Fix bchscheme to handle new representation of compiled procedures.

Add coerce-to-compiled-procedure primitive for inner loops.
Clean up some gc macros.

diff --git a/v7/src/microcode/comutl.c b/v7/src/microcode/comutl.c
index 6466a2416e377629b002d1a8fa7202492576f337..89a0d43308016ae61908e82ed3567c159d50f141 100644 (file)
--- a/v7/src/microcode/comutl.c
+++ b/v7/src/microcode/comutl.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/comutl.c,v 1.11 1988/03/12 16:04:26 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/comutl.c,v 1.12 1988/03/21 21:15:35 jinx Rel $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -37,9 +37,15 @@ MIT in each case. */
 #include "scheme.h"
 #include "primitive.h"
 
-extern Pointer *compiled_entry_to_block_address();
-extern long compiled_entry_to_block_offset();
-extern void compiled_entry_type();
+extern Pointer
+  *compiled_entry_to_block_address();
+
+extern long
+  compiled_entry_to_block_offset(),
+  coerce_to_compiled();
+
+extern void
+  compiled_entry_type();
 \f
 #define COMPILED_CODE_ADDRESS_P(object)                        \
    ((OBJECT_TYPE (object)) == TC_COMPILED_ENTRY)
@@ -100,3 +106,28 @@ DEFINE_PRIMITIVE("COMPILED-ENTRY-KIND", Prim_Compiled_Entry_Type, 1)
   temp[2] = MAKE_SIGNED_FIXNUM(((long) temp[2]));
   PRIMITIVE_RETURN (Make_Pointer(TC_HUNK3, temp));
 }
+\f
+DEFINE_PRIMITIVE("COERCE-TO-COMPILED-PROCEDURE", Prim_Coerce_To_Closure, 2)
+{
+  Pointer temp;
+  long value, result;
+  PRIMITIVE_HEADER(2);
+
+  CHECK_ARG (2, FIXNUM_P);
+
+  FIXNUM_VALUE(ARG_REF(2), value);
+  result = coerce_to_compiled(ARG_REF(1), value, &temp);
+  switch(result)
+  {
+    case PRIM_DONE:
+      PRIMITIVE_RETURN(temp);
+
+    case PRIM_INTERRUPT:
+      Primitive_GC(10);
+      /*NOTREACHED*/
+      
+    default:
+      Primitive_Error(ERR_ARG_2_BAD_RANGE);
+      /*NOTREACHED*/
+  }
+}

diff --git a/v7/src/microcode/fasdump.c b/v7/src/microcode/fasdump.c
index aa4f58fd48b8fe209335f135df1d5e99c729981d..6d3e6b2feeb339b7d303a0b1288c682a561738ee 100644 (file)
--- a/v7/src/microcode/fasdump.c
+++ b/v7/src/microcode/fasdump.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/fasdump.c,v 9.36 1988/03/12 16:05:10 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasdump.c,v 9.37 1988/03/21 21:15:48 jinx Exp $
 
    This file contains code for fasdump and dump-band.
 */
@@ -186,7 +186,7 @@ DumpLoop(Scan, Dump_Mode)
 
          while(--count >= 0)
          {
-           Scan = ((Pointer *) word_ptr);
+           Scan = OPERATOR_LINKAGE_ENTRY_ADDRESS(word_ptr);
            word_ptr = NEXT_LINKAGE_OPERATOR_ENTRY(word_ptr);
            Temp = *Scan;
            Dump_Compiled_Entry();
@@ -200,9 +200,8 @@ DumpLoop(Scan, Dump_Mode)
       {
        machine_word *start_ptr;
        fast machine_word *word_ptr;
-       Pointer *saved_scan;
 
-       saved_scan = ++Scan;
+       Scan += 1;
        word_ptr = FIRST_MANIFEST_CLOSURE_ENTRY(Scan);
        start_ptr = word_ptr;
 
@@ -213,7 +212,7 @@ DumpLoop(Scan, Dump_Mode)
          Temp = *Scan;
          Dump_Compiled_Entry();
        }
-       Scan = saved_scan + MANIFEST_CLOSURE_SIZE(word_ptr, start_ptr);
+       Scan = MANIFEST_CLOSURE_END(word_ptr, start_ptr);
        break;
       }
 

diff --git a/v7/src/microcode/fasload.c b/v7/src/microcode/fasload.c
index 541b733e66ca1a1a0f62b401ccc91bed9150fdca..474389a5b48931eea6fc27fc5bb79f63b47bdc2c 100644 (file)
--- a/v7/src/microcode/fasload.c
+++ b/v7/src/microcode/fasload.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/fasload.c,v 9.35 1988/03/12 16:05:26 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasload.c,v 9.36 1988/03/21 21:16:04 jinx Rel $
 
    The "fast loader" which reads in and relocates binary files and then
    interns symbols.  It is called with one argument: the (character
@@ -333,7 +333,7 @@ Relocate_Block(Scan, Stop_At)
 
          while(--count >= 0)
          {
-           Scan = ((Pointer *) word_ptr);
+           Scan = OPERATOR_LINKAGE_ENTRY_ADDRESS(word_ptr);
            word_ptr = NEXT_LINKAGE_OPERATOR_ENTRY(word_ptr);
            address = ((long) *Scan);
            *Scan = ((Pointer) Relocate(address));
@@ -347,9 +347,8 @@ Relocate_Block(Scan, Stop_At)
       {
        machine_word *start_ptr;
        fast machine_word *word_ptr;
-       Pointer *saved_scan;
 
-       saved_scan = ++Scan;
+       Scan += 1;
        word_ptr = FIRST_MANIFEST_CLOSURE_ENTRY(Scan);
        start_ptr = word_ptr;
 
@@ -360,7 +359,7 @@ Relocate_Block(Scan, Stop_At)
          address = ((long) *Scan);
          *Scan = ((Pointer) Relocate(address));
        }
-       Scan = saved_scan + (1 + MANIFEST_CLOSURE_SIZE(word_ptr, start_ptr));
+       Scan = &((MANIFEST_CLOSURE_END(word_ptr, start_ptr))[1]);
        break;
       }
 \f

diff --git a/v7/src/microcode/gccode.h b/v7/src/microcode/gccode.h
index 744c58ea6ae4d88a5f0a5477b4ce94230b3ca7ba..6da351a09d30105b08590ac8ab8317bfd93d6597 100644 (file)
--- a/v7/src/microcode/gccode.h
+++ b/v7/src/microcode/gccode.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/gccode.h,v 9.35 1988/03/12 16:05:46 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/gccode.h,v 9.36 1988/03/21 21:16:23 jinx Exp $
  *
  * This file contains the macros for use in code which does GC-like
  * loops over memory.  It is only included in a few files, unlike
@@ -425,11 +425,10 @@ typedef unsigned long machine_word;
           "relocate_compiled: No compiler support!",                   \
           Scan, To)
 
-#define GC_NO_COMPILER_EXPR()                                          \
-  (GC_NO_COMPILER_STMT(), NIL)
+#define GC_NO_COMPILER_EXPR()                  (GC_NO_COMPILER_STMT(), NIL)
 
-#define Relocate_Compiled(object, new_block, old_block)                        \
-  GC_NO_COMPILER_EXPR()
+
+#define Relocate_Compiled(obj, nb, ob)         GC_NO_COMPILER_EXPR()
 
 #define Transport_Compiled()                   GC_NO_COMPILER_STMT()
 
@@ -437,26 +436,36 @@ typedef unsigned long machine_word;
 
 #define Get_Compiled_Block(var, address)       GC_NO_COMPILER_STMT()
 
-#define READ_MANIFEST_CLOSURE_SIZE(scan)       GC_NO_COMPILER_EXPR()
 
 #define FIRST_MANIFEST_CLOSURE_ENTRY(scan)     GC_NO_COMPILER_EXPR()
 
+#define VALID_MANIFEST_CLOSURE_ENTRY(word_ptr) GC_NO_COMPILER_EXPR()
+
 #define NEXT_MANIFEST_CLOSURE_ENTRY(word_ptr)  GC_NO_COMPILER_EXPR()
 
-#define END_MANIFEST_CLOSURE_AREA(scan, count) GC_NO_COMPILER_EXPR()
+#define MANIFEST_CLOSURE_ENTRY_ADDRESS(ptr)    GC_NO_COMPILER_EXPR()
+
+#define MANIFEST_CLOSURE_END(end, start)       GC_NO_COMPILER_EXPR()
+
+#define MANIFEST_CLOSURE_VALID_FITS_P(end, st) GC_NO_COMPILER_EXPR()
+
 
 #define READ_LINKAGE_KIND(header)              GC_NO_COMPILER_EXPR()
 
+#define OPERATOR_LINKAGE_KIND                  0
+
+
 #define READ_CACHE_LINKAGE_COUNT(header)       GC_NO_COMPILER_EXPR()
 
 #define READ_OPERATOR_LINKAGE_COUNT(header)    GC_NO_COMPILER_EXPR()
   
 #define END_OPERATOR_LINKAGE_AREA(scan, count) GC_NO_COMPILER_EXPR()
 
+
 #define FIRST_OPERATOR_LINKAGE_ENTRY(scan)     GC_NO_COMPILER_EXPR()
 
-#define NEXT_LINKAGE_OPERATOR_ENTRY(word_ptr)  GC_NO_COMPILER_EXPR()
+#define NEXT_LINKAGE_OPERATOR_ENTRY(ptr)       GC_NO_COMPILER_EXPR()
 
-#define OPERATOR_LINKAGE_KIND                  0
+#define OPERATOR_LINKAGE_ENTRY_ADDRESS(ptr)    GC_NO_COMPILER_EXPR()
 
 #endif

diff --git a/v7/src/microcode/gcloop.c b/v7/src/microcode/gcloop.c
index 5e42a9227c155f93af58d328a61fdc12838c0a5e..882b76a7ecaf594bc800f268331d19aa4b689870 100644 (file)
--- a/v7/src/microcode/gcloop.c
+++ b/v7/src/microcode/gcloop.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/gcloop.c,v 9.27 1988/03/12 16:06:06 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/gcloop.c,v 9.28 1988/03/21 21:16:41 jinx Rel $
  *
  * This file contains the code for the most primitive part
  * of garbage collection.
@@ -149,7 +149,7 @@ GCLoop(Scan, To_Pointer)
 
          while(--count >= 0)
          {
-           Scan = ((Pointer *) word_ptr);
+           Scan = OPERATOR_LINKAGE_ENTRY_ADDRESS(word_ptr);
            word_ptr = NEXT_LINKAGE_OPERATOR_ENTRY(word_ptr);
            Temp = *Scan;
            GC_Pointer(Setup_Internal(true,
@@ -165,9 +165,8 @@ GCLoop(Scan, To_Pointer)
       {
        machine_word *start_ptr;
        fast machine_word *word_ptr;
-       Pointer *saved_scan;
 
-       saved_scan = ++Scan;
+       Scan += 1;
        word_ptr = FIRST_MANIFEST_CLOSURE_ENTRY(Scan);
        start_ptr = word_ptr;
 
@@ -180,7 +179,7 @@ GCLoop(Scan, To_Pointer)
                                    Transport_Compiled(),
                                    Compiled_BH(true, continue)));
        }
-       Scan = saved_scan + MANIFEST_CLOSURE_SIZE(word_ptr, start_ptr);
+       Scan = MANIFEST_CLOSURE_END(word_ptr, start_ptr);
        break;
       }
 

diff --git a/v7/src/microcode/purify.c b/v7/src/microcode/purify.c
index 90c5c6f5acb93236f0acff86bd5042e8b9f29be5..af030b76708e3912a246b811e6abeca81bdfff8a 100644 (file)
--- a/v7/src/microcode/purify.c
+++ b/v7/src/microcode/purify.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/purify.c,v 9.32 1988/03/12 16:07:11 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/purify.c,v 9.33 1988/03/21 21:17:00 jinx Rel $
  *
  * This file contains the code that copies objects into pure
  * and constant space.
@@ -160,7 +160,7 @@ PurifyLoop(Scan, To_Pointer, GC_Mode)
 
          while(--count >= 0)
          {
-           Scan = ((Pointer *) word_ptr);
+           Scan = OPERATOR_LINKAGE_ENTRY_ADDRESS(word_ptr);
            word_ptr = NEXT_LINKAGE_OPERATOR_ENTRY(word_ptr);
            Temp = *Scan;
            Purify_Pointer(Setup_Internal(false,
@@ -176,7 +176,6 @@ PurifyLoop(Scan, To_Pointer, GC_Mode)
       {
        machine_word *start_ptr;
        fast machine_word *word_ptr;
-       Pointer *saved_scan;
 
        if (GC_Mode == PURE_COPY)
        {
@@ -186,7 +185,7 @@ PurifyLoop(Scan, To_Pointer, GC_Mode)
          /*NOTREACHED*/
        }
 
-       saved_scan = ++Scan;
+       Scan += 1;
        word_ptr = FIRST_MANIFEST_CLOSURE_ENTRY(Scan);
        start_ptr = word_ptr;
 
@@ -199,7 +198,7 @@ PurifyLoop(Scan, To_Pointer, GC_Mode)
                                        Transport_Compiled(),
                                        Compiled_BH(false, continue)));
        }
-       Scan = saved_scan + MANIFEST_CLOSURE_SIZE(word_ptr, start_ptr);
+       Scan = MANIFEST_CLOSURE_END(word_ptr, start_ptr);
        break;
       }
 

diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h
index 61e0947e032faafd5d4bc1f9f48f141ca00bee21..07fcdc50c45795efa94966e43883b2c6e4adec82 100644 (file)
--- 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 10.28 1988/03/12 16:08:44 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 10.29 1988/03/21 21:17:16 jinx Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -46,7 +46,7 @@ MIT in each case. */
 #define VERSION                10
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION     28
+#define SUBVERSION     29
 #endif
 
 #ifndef UCODE_TABLES_FILENAME

diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h
index c285b30279b063ac13aabe98e14d45396fb023e6..bb3156cd4b5886aaf735718eeca924f499d88356 100644 (file)
--- 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 10.28 1988/03/12 16:08:44 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 10.29 1988/03/21 21:17:16 jinx Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -46,7 +46,7 @@ MIT in each case. */
 #define VERSION                10
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION     28
+#define SUBVERSION     29
 #endif
 
 #ifndef UCODE_TABLES_FILENAME