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.31 1987/06/05 04:12:14 jinx Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchdmp.c,v 9.32 1987/06/15 19:25:22 jinx Exp $ */
/* bchgcl, bchmmg, bchpur, and bchdmp can replace gcloop, memmag,
purify, and fasdump, respectively, to provide garbage collection
{ \
To_Address += (length); \
if (To >= free_buffer_top) \
- To = dump_and_reset_free_buffer(To - free_buffer_top); \
+ { \
+ To = dump_and_reset_free_buffer((To - free_buffer_top), &success); \
+ if (!success) \
+ return false; \
+ } \
}
#define fasdump_normal_transport(copy_code, length) \
Pointer **To_ptr, **To_Address_ptr;
{
fast Pointer *To, *Old, Temp, *To_Address, New_Address;
+ Boolean success;
+ success = true;
To = *To_ptr;
To_Address = *To_Address_ptr;
if (Scan != scan_buffer_top)
goto end_dumploop;
/* The -1 is here because of the Scan++ in the for header. */
- Scan = dump_and_reload_scan_buffer(0) - 1;
+ Scan = dump_and_reload_scan_buffer(0, &success) - 1;
+ if (!success)
+ return false;
continue;
case TC_MANIFEST_NM_VECTOR:
/* The + & -1 are here because of the Scan++ in the for header. */
overflow = (Scan - scan_buffer_top) + 1;
- Scan = ((dump_and_reload_scan_buffer(overflow / GC_DISK_BUFFER_SIZE) +
+ Scan = ((dump_and_reload_scan_buffer((overflow / GC_DISK_BUFFER_SIZE), &success) +
(overflow % GC_DISK_BUFFER_SIZE)) - 1);
+ if (!success)
+ return false;
break;
}
fasdump_remember_to_fix(Old, *Old);
New_Address = Make_Broken_Heart(C_To_Scheme(To_Address));
- copy_vector();
+ copy_vector(&success);
+ if (!success)
+ return false;
*Saved_Old = New_Address;
*Scan = Relocate_Compiled(Temp, Get_Pointer(New_Address), Saved_Old);
continue;
case_Vector:
fasdump_normal_setup();
Move_Vector:
- copy_vector();
+ copy_vector(&success);
+ if (!success)
+ return false;
fasdump_normal_end();
case TC_FUTURE:
Built_In_Primitive(Prim_Prim_Fasdump, 3, "PRIMITIVE-FASDUMP", 0x56)
{
+ Boolean success;
long length, hlength;
Pointer Prim_Exts, *dumped_object, *exts, *free_buffer;
Pointer header[FASL_HEADER_LENGTH];
Primitive_3_Args();
+ success = true;
if (Type_Code(Arg2) != TC_CHARACTER_STRING)
Primitive_Error(ERR_ARG_2_WRONG_TYPE);
dump_file_name = Scheme_String_To_C_String(Arg2);
fasdump_exit(0);
PRIMITIVE_RETURN(NIL);
}
- end_transport();
+ end_transport(&success);
+ if (!success)
+ {
+ fasdump_exit(0);
+ PRIMITIVE_RETURN(NIL);
+ }
length = (Free - dumped_object);
prepare_dump_header(header, length, dumped_object, dumped_object,
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.27 1987/06/02 00:16:16 jinx Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchgcc.h,v 9.28 1987/06/15 19:25:36 jinx Exp $ */
#include "gccode.h"
#include <fcntl.h>
not overflow the current buffer.
*/
-#define copy_vector() \
+#define copy_vector(success) \
{ \
Pointer *Saved_Scan = Scan; \
unsigned long real_length = 1 + Get_Integer(*Old); \
overflow = Scan - free_buffer_top; \
while (To != free_buffer_top) \
*To++ = *Old++; \
- To = dump_and_reset_free_buffer(0); \
+ To = dump_and_reset_free_buffer(0, success); \
real_length = (overflow / GC_DISK_BUFFER_SIZE); \
if (real_length > 0) \
- dump_free_directly(Old, real_length); \
+ { \
+ dump_free_directly(Old, real_length, success); \
+ } \
Old += (real_length * GC_DISK_BUFFER_SIZE); \
Scan = To + (overflow % GC_DISK_BUFFER_SIZE); \
} \
copy_code; \
To_Address += (length); \
if (To >= free_buffer_top) \
- To = dump_and_reset_free_buffer(To - free_buffer_top); \
+ To = dump_and_reset_free_buffer((To - free_buffer_top), NULL); \
}
#define relocate_normal_end() \
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.29 1987/06/02 00:16:25 jinx Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchgcl.c,v 9.30 1987/06/15 19:25:47 jinx Rel $ */
/* bchgcl, bchmmg, bchpur, and bchdmp can replace gcloop, memmag,
purify, and fasdump, respectively, to provide garbage collection
if (Scan != scan_buffer_top)
goto end_gcloop;
/* The -1 is here because of the Scan++ in the for header. */
- Scan = dump_and_reload_scan_buffer(0) - 1;
+ Scan = dump_and_reload_scan_buffer(0, NULL) - 1;
continue;
case TC_MANIFEST_NM_VECTOR:
/* The + & -1 are here because of the Scan++ in the for header. */
overflow = (Scan - scan_buffer_top) + 1;
- Scan = ((dump_and_reload_scan_buffer(overflow / GC_DISK_BUFFER_SIZE) +
+ Scan = ((dump_and_reload_scan_buffer((overflow / GC_DISK_BUFFER_SIZE), NULL) +
(overflow % GC_DISK_BUFFER_SIZE)) - 1);
break;
}
Pointer *Saved_Old = Old;
New_Address = Make_Broken_Heart(C_To_Scheme(To_Address));
- copy_vector();
+ copy_vector(NULL);
*Saved_Old = New_Address;
*Scan = Relocate_Compiled(Temp, Get_Pointer(New_Address), Saved_Old);
continue;
case_Vector:
relocate_normal_setup();
Move_Vector:
- copy_vector();
+ copy_vector(NULL);
relocate_normal_end();
case TC_FUTURE:
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.30 1987/06/02 00:16:36 jinx Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchmmg.c,v 9.31 1987/06/15 19:25:57 jinx Exp $ */
/* Memory management top level. Garbage collection to disk.
}
\f
void
-dump_buffer(from, position, nbuffers, name)
+dump_buffer(from, position, nbuffers, name, success)
Pointer *from;
long *position, nbuffers;
char *name;
+ Boolean *success;
{
long bytes_written;
if (lseek(gc_file, *position, 0) == -1)
{
- fprintf(stderr,
- "\nCould not position GC file to write the %s buffer.\n",
- name);
- Microcode_Termination(TERM_EXIT);
- /*NOTREACHED*/
+ if (success == NULL)
+ {
+ fprintf(stderr,
+ "\nCould not position GC file to write the %s buffer.\n",
+ name);
+ Microcode_Termination(TERM_EXIT);
+ /*NOTREACHED*/
+ }
+ *success = false;
+ return;
}
if ((bytes_written = write(gc_file, from, (nbuffers * GC_BUFFER_BYTES))) ==
-1)
{
- fprintf(stderr, "\nCould not write out the %s buffer.\n", name);
- Microcode_Termination(TERM_EXIT);
- /*NOTREACHED*/
+ if (success == NULL)
+ {
+ fprintf(stderr, "\nCould not write out the %s buffer.\n", name);
+ Microcode_Termination(TERM_EXIT);
+ /*NOTREACHED*/
+ }
+ *success = false;
+ return;
}
*position += bytes_written;
return;
}
-
+\f
void
load_buffer(position, to, nbytes, name)
long position;
}
void
-end_transport()
+end_transport(success)
+ Boolean *success;
{
- dump_buffer(scan_buffer_bottom, &scan_position, 1, "scan");
+ dump_buffer(scan_buffer_bottom, &scan_position, 1, "scan", success);
free_position = scan_position;
return;
}
\f
Pointer *
-dump_and_reload_scan_buffer(number_to_skip)
+dump_and_reload_scan_buffer(number_to_skip, success)
long number_to_skip;
+ Boolean *success;
{
- dump_buffer(scan_buffer_bottom, &scan_position, 1, "scan");
+ dump_buffer(scan_buffer_bottom, &scan_position, 1, "scan", success);
if (number_to_skip != 0)
scan_position += (number_to_skip * GC_BUFFER_BYTES);
reload_scan_buffer();
}
Pointer *
-dump_and_reset_free_buffer(overflow)
+dump_and_reset_free_buffer(overflow, success)
fast long overflow;
+ Boolean *success;
{
fast Pointer *into, *from;
if (free_buffer_bottom == scan_buffer_bottom)
{
/* No need to dump now, it will be dumped when scan is dumped.
- Does this work?
- We may need to dump the buffer anyway so we can dump the next one.
- It may not be possible to lseek past the end of file.
+ Note that the next buffer may be dumped before this one,
+ but there is no problem lseeking past the end of file.
*/
free_position += GC_BUFFER_BYTES;
free_buffer_bottom = ((scan_buffer_bottom == gc_disk_buffer_1) ?
free_buffer_top = free_buffer_bottom + GC_DISK_BUFFER_SIZE;
}
else
- dump_buffer(free_buffer_bottom, &free_position, 1, "free");
+ dump_buffer(free_buffer_bottom, &free_position, 1, "free", success);
for (into = free_buffer_bottom; --overflow >= 0; )
*into++ = *from++;
}
void
-dump_free_directly(from, nbuffers)
+dump_free_directly(from, nbuffers, success)
Pointer *from;
long nbuffers;
+ Boolean *success;
{
- dump_buffer(from, &free_position, nbuffers, "free");
+ dump_buffer(from, &free_position, nbuffers, "free", success);
return;
}
\f
if (current_buffer_position == -1)
return;
dump_buffer(gc_disk_buffer_1, ¤t_buffer_position,
- 1, "weak pair buffer");
+ 1, "weak pair buffer", NULL);
current_buffer_position = -1;
return;
}
*free_buffer++ = Fluid_Bindings;
Free += (free_buffer - free_buffer_bottom);
if (free_buffer >= free_buffer_top)
- free_buffer = dump_and_reset_free_buffer(free_buffer - free_buffer_top);
+ free_buffer = dump_and_reset_free_buffer((free_buffer - free_buffer_top),
+ NULL);
/* The 4 step GC */
*free_buffer++ = The_Precious_Objects;
Free += (free_buffer - Result);
if (free_buffer >= free_buffer_top)
- free_buffer = dump_and_reset_free_buffer(free_buffer - free_buffer_top);
+ free_buffer = dump_and_reset_free_buffer((free_buffer - free_buffer_top), NULL);
Result = GCLoop(Result, &free_buffer, &Free);
if (free_buffer != Result)
/*NOTREACHED*/
}
- end_transport();
+ end_transport(NULL);
Fix_Weak_Chain();
load_buffer(0, Heap_Bottom,
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/bchpur.c,v 9.31 1987/06/05 19:55:06 cph Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchpur.c,v 9.32 1987/06/15 19:26:16 jinx Exp $
*
* This file contains the code for primitives dealing with pure
* and constant space. Garbage collection to disk version.
if (Scan != scan_buffer_top)
goto end_purifyloop;
/* The -1 is here because of the Scan++ in the for header. */
- Scan = dump_and_reload_scan_buffer(0) - 1;
+ Scan = dump_and_reload_scan_buffer(0, NULL) - 1;
continue;
case TC_MANIFEST_NM_VECTOR:
/* The + & -1 are here because of the Scan++ in the for header. */
overflow = (Scan - scan_buffer_top) + 1;
- Scan = ((dump_and_reload_scan_buffer(overflow / GC_DISK_BUFFER_SIZE) +
+ Scan = ((dump_and_reload_scan_buffer((overflow / GC_DISK_BUFFER_SIZE), NULL) +
(overflow % GC_DISK_BUFFER_SIZE)) - 1);
break;
}
Pointer *Saved_Old = Old;
New_Address = Make_Broken_Heart(C_To_Scheme(To_Address));
- copy_vector();
+ copy_vector(NULL);
*Saved_Old = New_Address;
*Scan = Relocate_Compiled(Temp, Get_Pointer(New_Address), Saved_Old);
continue;
{
Temp = Vector_Ref(Temp, SYMBOL_NAME);
relocate_indirect_setup();
- copy_vector();
+ copy_vector(NULL);
relocate_indirect_end();
}
/* Fall through. */
case_Purify_Vector:
relocate_normal_setup();
Move_Vector:
- copy_vector();
+ copy_vector(NULL);
relocate_normal_end();
case TC_FUTURE:
fprintf(stderr, "\nPurify: Object too large.\n");
Microcode_Termination(TERM_NO_SPACE);
}
- end_transport();
+ end_transport(NULL);
load_buffer(0, block_start,
(length * sizeof(Pointer)),
"into constant space");
projects / mit-scheme.git / commitdiff