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/bchdmp.c,v 9.40 1988/02/12 16:49:43 jinx Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchdmp.c,v 9.41 1988/02/20 06:15:49 jinx Exp $ */
/* bchgcl, bchmmg, bchpur, and bchdmp can replace gcloop, memmag,
purify, and fasdump, respectively, to provide garbage collection
(read(real_gc_file, fixup_buffer, GC_BUFFER_BYTES) !=
GC_BUFFER_BYTES))
{
- fprintf(stderr,
- "\nCould not read back the fasdump fixup information.\n");
- Microcode_Termination(TERM_EXIT);
+ gc_death(TERM_EXIT,
+ "fasdump: Could not read back the fasdump fixup information",
+ NULL, NULL);
+ /*NOTREACHED*/
}
fixup_count -= 1;
fixes = fixup_buffer;
}
if (Scan != (Get_Pointer(Temp)))
{
- fprintf(stderr, "\ndumploop: Broken heart in scan.\n");
- Microcode_Termination(TERM_BROKEN_HEART);
+ sprintf(gc_death_message_buffer,
+ "purifyloop: broken heart (0x%lx) in scan",
+ Temp);
+ gc_death(TERM_BROKEN_HEART, gc_death_message_buffer, Scan, To);
+ /*NOTREACHED*/
}
if (Scan != scan_buffer_top)
{
continue;
default:
- fprintf(stderr,
- "\ndumploop: Bad type code = 0x%02x\n",
+ sprintf(gc_death_message_buffer,
+ "dumploop: bad type code (0x%02x)",
OBJECT_TYPE(Temp));
- fprintf(stderr,
- "Scan = 0x%lx; Free = 0x%lx; Heap_Bottom = 0x%lx\n",
- To, Scan, Heap_Bottom);
- Invalid_Type_Code();
+ gc_death(TERM_INVALID_TYPE_CODE, gc_death_message_buffer,
+ Scan, To);
+ /*NOTREACHED*/
}
}
end_dumploop:
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/bchgcc.h,v 9.30 1987/08/10 21:11:21 jinx Rel $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchgcc.h,v 9.31 1988/02/20 06:16:05 jinx Exp $ */
#include "gccode.h"
#ifdef bsd
extern Pointer *initialize_free_buffer(), *initialize_scan_buffer();
extern void end_transport(), GC();
extern int gc_file;
+
+extern void gc_death();
+extern char gc_death_message_buffer[];
\f
/* Some utility macros */
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/bchgcl.c,v 9.31 1988/02/12 16:49:57 jinx Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchgcl.c,v 9.32 1988/02/20 06:16:15 jinx Exp $ */
/* bchgcl, bchmmg, bchpur, and bchdmp can replace gcloop, memmag,
purify, and fasdump, respectively, to provide garbage collection
case TC_BROKEN_HEART:
if (Scan != (Get_Pointer(Temp)))
{
- fprintf(stderr, "\nGC: Broken heart in scan.\n");
- Microcode_Termination(TERM_BROKEN_HEART);
+ sprintf(gc_death_message_buffer,
+ "gcloop: broken heart (0x%lx) in scan",
+ Temp);
+ gc_death(TERM_BROKEN_HEART, gc_death_message_buffer, Scan, To);
+ /*NOTREACHED*/
}
if (Scan != scan_buffer_top)
goto end_gcloop;
relocate_normal_pointer(copy_weak_pair(), 2);
default:
- fprintf(stderr,
- "\nGCLoop: Bad type code = 0x%02x\n",
+ sprintf(gc_death_message_buffer,
+ "gcloop: bad type code (0x%02x)",
OBJECT_TYPE(Temp));
- fprintf(stderr,
- "Scan = 0x%lx; Free = 0x%lx; Heap_Bottom = 0x%lx\n",
- To, Scan, Heap_Bottom);
- Invalid_Type_Code();
+ gc_death(TERM_INVALID_TYPE_CODE, gc_death_message_buffer,
+ Scan, To);
+ /*NOTREACHED*/
}
}
end_gcloop:
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchpur.c,v 9.37 1988/02/12 16:50:08 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchpur.c,v 9.38 1988/02/20 06:16:26 jinx Exp $
Copyright (c) 1987 Massachusetts Institute of Technology
Pointer
Purify_Pass_2(info)
-Pointer info;
+ Pointer info;
{
- fprintf(stderr, "\nPurify_Pass_2 invoked!\n");
- Microcode_Termination(TERM_EXIT);
+ gc_death(TERM_EXIT, "Purify_Pass_2 invoked", NULL, NULL);
/*NOTREACHED*/
}
case TC_BROKEN_HEART:
if (Scan != (Get_Pointer(Temp)))
{
- fprintf(stderr, "\npurifyloop: Broken heart in scan.\n");
- Microcode_Termination(TERM_BROKEN_HEART);
+ sprintf(gc_death_message_buffer,
+ "purifyloop: broken heart (0x%lx) in scan",
+ Temp);
+ gc_death(TERM_BROKEN_HEART, gc_death_message_buffer, Scan, To);
+ /*NOTREACHED*/
}
if (Scan != scan_buffer_top)
goto end_purifyloop;
continue;
default:
- fprintf(stderr,
- "\npurifyloop: Bad type code = 0x%02x\n",
+ sprintf(gc_death_message_buffer,
+ "gcloop: bad type code (0x%02x)",
OBJECT_TYPE(Temp));
- fprintf(stderr,
- "Scan = 0x%lx; Free = 0x%lx; Heap_Bottom = 0x%lx\n",
- To, Scan, Heap_Bottom);
- Invalid_Type_Code();
+ gc_death(TERM_INVALID_TYPE_CODE, gc_death_message_buffer,
+ Scan, To);
+ /*NOTREACHED*/
}
}
end_purifyloop:
scan_buffer = dump_and_reload_scan_buffer(0, NULL);
if ((scan_buffer + delta) != free_buffer)
{
- fprintf(stderr,
- "\nPurify: Scan and Free do not meet at the end.\n");
- Microcode_Termination(TERM_EXIT);
+ gc_death(TERM_EXIT, "purify: scan and free do not meet at the end",
+ (scan_buffer + delta), free_buffer);
+ /*NOTREACHED*/
}
return (free_buffer);
}
PURE_COPY);
if (Result != free_buffer)
{
- fprintf(stderr, "\nPurify: Pure copy ended too early.\n");
- Microcode_Termination(TERM_BROKEN_HEART);
+ gc_death(TERM_BROKEN_HEART, "purify: pure copy ended too early",
+ Result, free_buffer);
+ /*NOTREACHED*/
}
pure_length = (Free_Constant - block_start) + 1;
}
}
if (Result != free_buffer)
{
- fprintf(stderr, "\nPurify: Constant Copy ended too early.\n");
- Microcode_Termination(TERM_BROKEN_HEART);
+ gc_death(TERM_BROKEN_HEART, "purify: constant copy ended too early",
+ Result, free_buffer);
+ /*NOTREACHED*/
}
Free_Constant += 2;
if (!Test_Pure_Space_Top(Free_Constant))
{
- fprintf(stderr, "\nPurify: Object too large.\n");
- Microcode_Termination(TERM_NO_SPACE);
+ gc_death(TERM_NO_SPACE, "purify: object too large", NULL, NULL);
+ /*NOTREACHED*/
}
load_buffer(0, block_start,
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/boot.c,v 9.44 1988/02/06 20:38:24 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/boot.c,v 9.45 1988/02/20 06:16:41 jinx Exp $
Copyright (c) 1987 Massachusetts Institute of Technology
/*NOTREACHED*/
}
\f
+extern Pointer
+ *deadly_free,
+ *deadly_scan;
+
+extern void
+ gc_death();
+
+extern char
+ gc_death_message_buffer[];
+
+Pointer
+ *deadly_free,
+ *deadly_scan;
+
+char
+ gc_death_message_buffer[100];
+
+void
+gc_death(code, message, scan, free)
+ long code;
+ char *message;
+ Pointer *scan, *free;
+{
+ fprintf(stderr, "\n%s.\n", message);
+ fprintf(stderr, "scan = 0x%lx; free = 0x%lx\n", scan, free);
+ deadly_scan = scan;
+ deadly_free = free;
+ Microcode_Termination(code);
+ /*NOTREACHED*/
+}
+\f
/* Utility primitives. */
#define IDENTITY_LENGTH 20 /* Plenty of room */
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.34 1988/02/12 16:50:37 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasdump.c,v 9.35 1988/02/20 06:17:33 jinx Exp $
This file contains code for fasdump and dump-band.
*/
case TC_BROKEN_HEART:
if (OBJECT_DATUM(Temp) != 0)
{
- fprintf(stderr, "\nDump: Broken heart in scan.\n");
- Microcode_Termination(TERM_BROKEN_HEART);
+ sprintf(gc_death_message_buffer,
+ "dumploop: broken heart (0x%lx) in scan",
+ Temp);
+ gc_death(TERM_BROKEN_HEART, gc_death_message_buffer, Scan, To);
+ /*NOTREACHED*/
}
break;
Setup_Pointer_for_Dump(Transport_Future());
default:
- fprintf(stderr,
- "\nDumpLoop: Bad type code = 0x%02x\n",
+ sprintf(gc_death_message_buffer,
+ "dumploop: bad type code (0x%02x)",
OBJECT_TYPE(Temp));
- fprintf(stderr,
- "Scan = 0x%lx; Free = 0x%lx; Heap_Bottom = 0x%lx\n",
- To, Scan, Heap_Bottom);
- Invalid_Type_Code();
+ gc_death(TERM_INVALID_TYPE_CODE, gc_death_message_buffer,
+ Scan, To);
+ /*NOTREACHED*/
}
}
NewFree = To;
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.33 1988/02/12 16:50:51 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/gccode.h,v 9.34 1988/02/20 06:17:48 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
- * GC.H which contains general purpose macros and constants.
+ * gc.h which contains general purpose macros and constants.
*
*/
\f
+extern void gc_death();
+extern char gc_death_message_buffer[];
+
/* A SWITCH on GC types, duplicates information in GC_Type_Map[], but exists
for efficiency reasons. Macros must be used by convention: first
Switch_by_GC_Type, then each of the case_ macros (in any order). The
/* Check whether it has been relocated. */
-#define Normal_BH(In_GC, then_what) \
-if (Type_Code(*Old) == TC_BROKEN_HEART) \
-{ *Scan = Make_New_Pointer(Type_Code(Temp), *Old); \
- then_what; \
+#define Normal_BH(In_GC, then_what) \
+if (OBJECT_TYPE(*Old) == TC_BROKEN_HEART) \
+{ \
+ *Scan = Make_New_Pointer(OBJECT_TYPE(Temp), *Old); \
+ then_what; \
}
-#define Setup_Internal(In_GC, Extra_Code, BH_Code) \
-if And2(In_GC, Consistency_Check) \
- if ((Old >= Highest_Allocated_Address) || (Old < Heap)) \
- { fprintf(stderr, "Out of range pointer: %x.\n", Temp); \
- Microcode_Termination(TERM_EXIT); \
- } \
-if (Old >= Low_Constant) \
- continue; \
-BH_Code; \
-New_Address = (Make_Broken_Heart(C_To_Scheme(To))); \
-Extra_Code; \
+#define Setup_Internal(In_GC, Extra_Code, BH_Code) \
+if And2(In_GC, Consistency_Check) \
+{ \
+ if ((Old >= Highest_Allocated_Address) || (Old < Heap)) \
+ { \
+ sprintf(gc_death_message_buffer, \
+ "setup_internal: out of range pointer (0x%lx)", \
+ Temp); \
+ gc_death(TERM_EXIT, gc_death_message_buffer, Scan, To); \
+ /*NOTREACHED*/ \
+ } \
+} \
+if (Old >= Low_Constant) \
+{ \
+ continue; \
+} \
+BH_Code; \
+New_Address = (Make_Broken_Heart(C_To_Scheme(To))); \
+Extra_Code; \
continue
#define Setup_Pointer(In_GC, Extra_Code) \
"middle" of vectors.
*/
-#define Real_Transport_Vector() \
-{ Pointer *Saved_Scan = Scan; \
- Scan = To + 1 + Get_Integer(*Old); \
- if ((Consistency_Check) && \
- (Scan >= Low_Constant) && \
- (To < Low_Constant)) \
- { fprintf(stderr, "\nVector Length %d\n", \
- Get_Integer(*Old)); \
- Microcode_Termination(TERM_EXIT); \
- } \
- while (To != Scan) *To++ = *Old++; \
- Scan = Saved_Scan; \
+#define Real_Transport_Vector() \
+{ \
+ Pointer *Saved_Scan; \
+ \
+ Saved_Scan = Scan; \
+ Scan = To + 1 + OBJECT_DATUM(*Old); \
+ if ((Consistency_Check) && \
+ (Scan >= Low_Constant) && \
+ (To < Low_Constant)) \
+ { \
+ sprintf(gc_death_message_buffer, \
+ "real_transport_vector: vector length too large (%d)", \
+ OBJECT_DATUM(*Old)); \
+ gc_death(TERM_EXIT, gc_death_message_buffer, Saved_Scan, To); \
+ } \
+ while (To != Scan) \
+ { \
+ *To++ = *Old++; \
+ } \
+ Scan = Saved_Scan; \
}
#else In_Fasdump
/* Is there anything else that can be done here? */
#define Relocate_Compiled(object, new_block, old_block) \
- (fprintf(stderr, \
- "\nRelocating compiled code without compiler support!\n"), \
- Microcode_Termination(TERM_COMPILER_DEATH), \
+ (gc_death(TERM_COMPILER_DEATH, \
+ "relocate_compiled: No compiler support!", \
+ Scan, To), \
NIL)
#define Compiled_BH(flag, then_what) \
{ \
- fprintf(stderr, \
- "\nRelocating compiled code without compiler support!\n"); \
- Microcode_Termination(TERM_COMPILER_DEATH); \
+ gc_death(TERM_COMPILER_DEATH, \
+ "relocate_compiled: No compiler support!", \
+ Scan, To); \
+ /*NOTREACHED*/ \
}
#define Transport_Compiled()
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.25 1988/02/12 16:51:04 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/gcloop.c,v 9.26 1988/02/20 06:18:04 jinx Exp $
*
* This file contains the code for the most primitive part
* of garbage collection.
Switch_by_GC_Type(Temp)
{ case TC_BROKEN_HEART:
if (Scan == (Get_Pointer(Temp)))
- { *To_Pointer = To;
- return Scan;
+ {
+ *To_Pointer = To;
+ return (Scan);
}
- fprintf(stderr, "GC: Broken heart in scan.\n");
- Microcode_Termination(TERM_BROKEN_HEART);
+ sprintf(gc_death_message_buffer,
+ "gcloop: broken heart (0x%lx) in scan",
+ Temp);
+ gc_death(TERM_BROKEN_HEART, gc_death_message_buffer, Scan, To);
+ /*NOTREACHED*/
case TC_MANIFEST_NM_VECTOR:
case TC_MANIFEST_SPECIAL_NM_VECTOR:
- Scan += Get_Integer(Temp);
+ Scan += OBJECT_DATUM(Temp);
break;
case_Non_Pointer:
Setup_Pointer_for_GC(Transport_Cell());
case TC_REFERENCE_TRAP:
- if (Datum(Temp) <= TRAP_MAX_IMMEDIATE)
+ if (OBJECT_DATUM(Temp) <= TRAP_MAX_IMMEDIATE)
{
/* It is a non pointer. */
break;
Setup_Pointer_for_GC(Transport_Weak_Cons());
default:
- fprintf(stderr,
- "\nGCLoop: Bad type code = 0x%02x\n",
+ sprintf(gc_death_message_buffer,
+ "gcloop: bad type code (0x%02x)",
OBJECT_TYPE(Temp));
- fprintf(stderr,
- "Scan = 0x%lx; Free = 0x%lx; Heap_Bottom = 0x%lx\n",
- To, Scan, Heap_Bottom);
- Invalid_Type_Code();
-
+ gc_death(TERM_INVALID_TYPE_CODE, gc_death_message_buffer,
+ Scan, To);
+ /*NOTREACHED*/
} /* Switch_by_GC_Type */
} /* For loop */
*To_Pointer = To;
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/interp.c,v 9.38 1988/02/12 16:51:27 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/interp.c,v 9.39 1988/02/20 06:18:15 jinx Exp $
*
* This file contains the heart of the Scheme Scode
* interpreter
else \
{ \
Save_Cont(); \
- Will_Push(CONTINUATION_SIZE + + (STACK_ENV_EXTRA_SLOTS + 2)); \
+ Will_Push(CONTINUATION_SIZE + (STACK_ENV_EXTRA_SLOTS + 2)); \
Store_Return(RC_RESTORE_VALUE); \
Store_Expression(Orig_Val); \
Save_Cont(); \
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.30 1988/02/12 16:52:00 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/purify.c,v 9.31 1988/02/20 06:18:49 jinx Exp $
*
* This file contains the code that copies objects into pure
* and constant space.
*To_Pointer = To;
return Scan;
}
- fprintf(stderr, "Purify: Broken heart in scan.\n");
- Microcode_Termination(TERM_BROKEN_HEART);
+ sprintf(gc_death_message_buffer,
+ "purifyloop: broken heart (0x%lx) in scan",
+ Temp);
+ gc_death(TERM_BROKEN_HEART, gc_death_message_buffer, Scan, To);
+ /*NOTREACHED*/
case TC_MANIFEST_NM_VECTOR:
case TC_MANIFEST_SPECIAL_NM_VECTOR:
#endif
default:
- fprintf(stderr,
- "\nPurifyLoop: Bad type code = 0x%02x\n",
+ sprintf(gc_death_message_buffer,
+ "purifyloop: bad type code (0x%02x)",
OBJECT_TYPE(Temp));
- fprintf(stderr,
- "Scan = 0x%lx; Free = 0x%lx; Heap_Bottom = 0x%lx\n",
- To, Scan, Heap_Bottom);
- Invalid_Type_Code();
+ gc_death(TERM_INVALID_TYPE_CODE, gc_death_message_buffer,
+ Scan, To);
+ /*NOTREACHED*/
} /* Switch_by_GC_Type */
} /* For loop */
*To_Pointer = To;
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.21 1988/02/12 16:53:59 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 10.22 1988/02/20 06:19:45 jinx Exp $
This file contains version information for the microcode. */
\f
#define VERSION 10
#endif
#ifndef SUBVERSION
-#define SUBVERSION 21
+#define SUBVERSION 22
#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/interp.c,v 9.38 1988/02/12 16:51:27 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/interp.c,v 9.39 1988/02/20 06:18:15 jinx Exp $
*
* This file contains the heart of the Scheme Scode
* interpreter
else \
{ \
Save_Cont(); \
- Will_Push(CONTINUATION_SIZE + + (STACK_ENV_EXTRA_SLOTS + 2)); \
+ Will_Push(CONTINUATION_SIZE + (STACK_ENV_EXTRA_SLOTS + 2)); \
Store_Return(RC_RESTORE_VALUE); \
Store_Expression(Orig_Val); \
Save_Cont(); \
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.21 1988/02/12 16:53:59 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 10.22 1988/02/20 06:19:45 jinx Exp $
This file contains version information for the microcode. */
\f
#define VERSION 10
#endif
#ifndef SUBVERSION
-#define SUBVERSION 21
+#define SUBVERSION 22
#endif
#ifndef UCODE_TABLES_FILENAME
projects / mit-scheme.git / commitdiff