The microcode now understands 32 bit block offsets in compiled code.
authorGuillermo J. Rozas <edu/mit/csail/zurich/gjr>
Wed, 22 Jul 1987 21:54:58 +0000 (21:54 +0000)
committerGuillermo J. Rozas <edu/mit/csail/zurich/gjr>
Wed, 22 Jul 1987 21:54:58 +0000 (21:54 +0000)
v7/src/microcode/bchmmg.c
v7/src/microcode/comutl.c
v7/src/microcode/gccode.h
v7/src/microcode/purutl.c
v7/src/microcode/version.h
v8/src/microcode/version.h

index 3f724ef492a8badec4d06f4a5f221d2cb3237306..54ef6c0303515983c24bf0e598e204435526c7e6 100644 (file)
@@ -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/bchmmg.c,v 9.32 1987/06/23 22:00:37 cph Rel $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchmmg.c,v 9.33 1987/07/22 21:54:00 jinx Exp $ */
 
 /* Memory management top level.  Garbage collection to disk.
 
@@ -529,13 +529,7 @@ Fix_Weak_Chain()
          *Scan = Temp;
          continue;
        }
-       /* Ditto */
-       Old = Get_Compiled_Block(Old);
-       if (Type_Code(*Old) == TC_BROKEN_HEART)
-       {
-         *Scan = Relocate_Compiled(Temp, Get_Pointer(*Old), Old);
-         continue;
-       }
+       Compiled_BH(false, continue);
        *Scan = NIL;
        continue;
 
index 3081caf679f8417e9786774d6baa1ddcec26e402..70a24d5583141f3c54bdaa2d0ce6cb31d4a665b4 100644 (file)
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/comutl.c,v 1.6 1987/07/15 22:09:17 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/comutl.c,v 1.7 1987/07/22 21:54:26 jinx Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -37,11 +37,55 @@ MIT in each case. */
 #include "scheme.h"
 #include "primitive.h"
 #include "gccode.h"
+
+extern Pointer *compiled_entry_to_block_address();
+extern long compiled_entry_to_block_offset();
 \f
 #define COMPILED_CODE_ADDRESS_P(object)                                        \
   (((OBJECT_TYPE (object)) == TC_COMPILED_EXPRESSION) ||               \
    ((OBJECT_TYPE (object)) == TC_RETURN_ADDRESS))
 
+Pointer *
+compiled_entry_to_block_address(ce)
+     Pointer ce;
+{
+#ifdef Get_Compiled_Block
+
+  Pointer *block;
+
+  block = Get_Pointer(ce);
+  Get_Compiled_Block(block, block);
+  return block;
+
+#else
+
+  error_external_return();
+  /*NOTREACHED*/
+
+#endif
+}
+
+long
+compiled_entry_to_block_offset(ce)
+     Pointer ce;
+{
+#ifdef Get_Compiled_Offset
+
+  Pointer *address;
+  long offset;
+
+  address = Get_Pointer(ce);
+  Get_Compiled_Offset(offset, address);
+  return offset;
+
+#else
+
+  error_external_return();
+  /*NOTREACHED*/
+
+#endif
+}
+\f
 Built_In_Primitive (Prim_comp_code_address_block, 1,
                    "COMPILED-CODE-ADDRESS->BLOCK", 0xB5)
 {
@@ -49,28 +93,17 @@ Built_In_Primitive (Prim_comp_code_address_block, 1,
   Primitive_1_Arg ();
 
   CHECK_ARG (1, COMPILED_CODE_ADDRESS_P);
-  address = (Get_Pointer (Arg1));
-
-#ifdef CMPGCFILE
-  return (Make_Pointer (TC_COMPILED_CODE_BLOCK,
-                       (Get_Compiled_Block (address))));
-#else /* not CMPGCFILE */
-  error_external_return ();
-#endif /* CMPGCFILE */
+  address = compiled_entry_to_block_address(Arg1);
+  return (Make_Pointer (TC_COMPILED_CODE_BLOCK, address));
 }
 
 Built_In_Primitive (Prim_comp_code_address_offset, 1,
                    "COMPILED-CODE-ADDRESS->OFFSET", 0xAC)
 {
-  Pointer *address;
+  long offset;
   Primitive_1_Arg ();
 
   CHECK_ARG (1, COMPILED_CODE_ADDRESS_P);
-  address = (Get_Pointer (Arg1));
-
-#ifdef CMPGCFILE
-  return (Make_Signed_Fixnum (Get_Compiled_Offset (address)));
-#else /* not CMPGCFILE */
-  error_external_return ();
-#endif /* CMPGCFILE */
+  offset = compiled_entry_to_block_offset(Arg1);
+  return (Make_Signed_Fixnum (offset));
 }
index 3502434e72e0d7334c5d018a65a4cc2f70db73b8..2eac14d8d324cafe521d3c5be22208066040cc91 100644 (file)
@@ -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.25 1987/07/21 22:51:22 cph Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/gccode.h,v 9.26 1987/07/22 21:54:35 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
@@ -344,18 +344,6 @@ Pointer_End()
 
 /* Is there anything else that can be done here? */
 
-#define Get_Compiled_Offset(address)                                   \
-  (fprintf(stderr,                                                     \
-          "\nRelocating compiled code without compiler support!\n"),   \
-   Microcode_Termination(TERM_COMPILER_DEATH),                         \
-   0)
-
-#define Get_Compiled_Block(address)                                    \
-  (fprintf(stderr,                                                     \
-          "\nRelocating compiled code without compiler support!\n"),   \
-   Microcode_Termination(TERM_COMPILER_DEATH),                         \
-   ((Pointer *) NULL))
-
 #define Relocate_Compiled(object, new_block, old_block)                        \
   (fprintf(stderr,                                                     \
           "\nRelocating compiled code without compiler support!\n"),   \
index b79a72bf4ad5fdeaab6b993878f235a5b977ae7e..d8abfa8ad9d4e18c63fce3fd0f23bea0e9fd2c9a 100644 (file)
@@ -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/purutl.c,v 9.29 1987/06/05 17:29:30 cph Rel $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/purutl.c,v 9.30 1987/07/22 21:54:46 jinx Exp $ */
 
 /* Pure/Constant space utilities. */
 
@@ -221,11 +221,12 @@ Built_In_Primitive(Prim_Pure_P, 1, "PURE?", 0xBB)
     return TRUTH;
   Touch_In_Primitive(Arg1, Arg1);
   {
+    extern Pointer *compiled_entry_to_block_address();
     Pointer *Obj_Address;
 
     Obj_Address =
       ((GC_Type_Compiled(Arg1))
-       ? (Get_Compiled_Block(Get_Pointer(Arg1)))
+       ? (compiled_entry_to_block_address(Arg1))
        : (Get_Pointer(Arg1)));
     if (Is_Pure(Obj_Address))
       return TRUTH;
index 22f20e07bc76e9ceb06a8200e4dd0860a5958d59..681b6d720792064d1dc4eaf3960c75d6dac8a1a3 100644 (file)
@@ -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 9.84 1987/07/19 22:00:32 cph Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 9.85 1987/07/22 21:54:58 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                9
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION     84
+#define SUBVERSION     85
 #endif
 
 #ifndef UCODE_TABLES_FILENAME
index 9280c4315452d69b76693ce03e5cf01595ae9b97..0167174b6949554ef9a19f9ec58f23a0748e92d7 100644 (file)
@@ -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 9.84 1987/07/19 22:00:32 cph Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 9.85 1987/07/22 21:54:58 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                9
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION     84
+#define SUBVERSION     85
 #endif
 
 #ifndef UCODE_TABLES_FILENAME