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.
*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;
/* -*-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
#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)
{
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));
}
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
/* 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"), \
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. */
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;
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
#define VERSION 9
#endif
#ifndef SUBVERSION
-#define SUBVERSION 84
+#define SUBVERSION 85
#endif
#ifndef UCODE_TABLES_FILENAME
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
#define VERSION 9
#endif
#ifndef SUBVERSION
-#define SUBVERSION 84
+#define SUBVERSION 85
#endif
#ifndef UCODE_TABLES_FILENAME