From 17a2fd509422b30783f6d3f8ce04ff03fef48adb Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Mon, 15 Jun 1987 19:26:16 +0000 Subject: [PATCH] Make fasdump in bchscheme back out when the object being dumped is too large. --- v7/src/microcode/bchdmp.c | 35 ++++++++++++++++---- v7/src/microcode/bchgcc.h | 12 ++++--- v7/src/microcode/bchgcl.c | 10 +++--- v7/src/microcode/bchmmg.c | 67 ++++++++++++++++++++++++--------------- v7/src/microcode/bchpur.c | 14 ++++---- 5 files changed, 88 insertions(+), 50 deletions(-) diff --git a/v7/src/microcode/bchdmp.c b/v7/src/microcode/bchdmp.c index 54d8564a7..e756caf34 100644 --- a/v7/src/microcode/bchdmp.c +++ b/v7/src/microcode/bchdmp.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/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 @@ -72,7 +72,11 @@ static fixup_count = 0; { \ 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) \ @@ -168,7 +172,9 @@ dumploop(Scan, To_ptr, To_Address_ptr) 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; @@ -188,7 +194,9 @@ dumploop(Scan, To_ptr, 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: @@ -204,8 +212,10 @@ dumploop(Scan, To_ptr, To_Address_ptr) /* 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; } @@ -220,7 +230,9 @@ dumploop(Scan, To_ptr, To_Address_ptr) 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; @@ -285,7 +297,9 @@ dumploop(Scan, To_ptr, To_Address_ptr) case_Vector: fasdump_normal_setup(); Move_Vector: - copy_vector(); + copy_vector(&success); + if (!success) + return false; fasdump_normal_end(); case TC_FUTURE: @@ -323,11 +337,13 @@ end_dumploop: 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); @@ -363,7 +379,12 @@ Built_In_Primitive(Prim_Prim_Fasdump, 3, "PRIMITIVE-FASDUMP", 0x56) 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, diff --git a/v7/src/microcode/bchgcc.h b/v7/src/microcode/bchgcc.h index 7d42087a3..1d7d1b2aa 100644 --- a/v7/src/microcode/bchgcc.h +++ b/v7/src/microcode/bchgcc.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/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 @@ -105,7 +105,7 @@ extern int gc_file; not overflow the current buffer. */ -#define copy_vector() \ +#define copy_vector(success) \ { \ Pointer *Saved_Scan = Scan; \ unsigned long real_length = 1 + Get_Integer(*Old); \ @@ -119,10 +119,12 @@ extern int gc_file; 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); \ } \ @@ -151,7 +153,7 @@ extern int gc_file; 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() \ diff --git a/v7/src/microcode/bchgcl.c b/v7/src/microcode/bchgcl.c index 444855a78..7e8875173 100644 --- a/v7/src/microcode/bchgcl.c +++ b/v7/src/microcode/bchgcl.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/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 @@ -65,7 +65,7 @@ GCLoop(Scan, To_ptr, To_Address_ptr) 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: @@ -81,7 +81,7 @@ GCLoop(Scan, To_ptr, To_Address_ptr) /* 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; } @@ -98,7 +98,7 @@ GCLoop(Scan, To_ptr, To_Address_ptr) 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; @@ -135,7 +135,7 @@ GCLoop(Scan, To_ptr, To_Address_ptr) case_Vector: relocate_normal_setup(); Move_Vector: - copy_vector(); + copy_vector(NULL); relocate_normal_end(); case TC_FUTURE: diff --git a/v7/src/microcode/bchmmg.c b/v7/src/microcode/bchmmg.c index 9cc362651..741a66788 100644 --- a/v7/src/microcode/bchmmg.c +++ b/v7/src/microcode/bchmmg.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/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. @@ -244,33 +244,44 @@ Reset_Memory() } 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; } - + void load_buffer(position, to, nbytes, name) long position; @@ -338,18 +349,20 @@ initialize_free_buffer() } 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; } 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(); @@ -357,8 +370,9 @@ dump_and_reload_scan_buffer(number_to_skip) } Pointer * -dump_and_reset_free_buffer(overflow) +dump_and_reset_free_buffer(overflow, success) fast long overflow; + Boolean *success; { fast Pointer *into, *from; @@ -366,9 +380,8 @@ dump_and_reset_free_buffer(overflow) 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) ? @@ -377,7 +390,7 @@ dump_and_reset_free_buffer(overflow) 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++; @@ -391,11 +404,12 @@ dump_and_reset_free_buffer(overflow) } 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; } @@ -414,7 +428,7 @@ flush_new_space_buffer() 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; } @@ -570,7 +584,8 @@ GC() *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 */ @@ -594,7 +609,7 @@ 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) @@ -604,7 +619,7 @@ GC() /*NOTREACHED*/ } - end_transport(); + end_transport(NULL); Fix_Weak_Chain(); load_buffer(0, Heap_Bottom, diff --git a/v7/src/microcode/bchpur.c b/v7/src/microcode/bchpur.c index 4b217e4b3..26d8372f7 100644 --- a/v7/src/microcode/bchpur.c +++ b/v7/src/microcode/bchpur.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/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. @@ -105,7 +105,7 @@ purifyloop(Scan, To_ptr, To_Address_ptr, purify_mode) 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: @@ -121,7 +121,7 @@ purifyloop(Scan, To_ptr, To_Address_ptr, purify_mode) /* 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; } @@ -140,7 +140,7 @@ purifyloop(Scan, To_ptr, To_Address_ptr, purify_mode) 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; @@ -163,7 +163,7 @@ purifyloop(Scan, To_ptr, To_Address_ptr, purify_mode) { Temp = Vector_Ref(Temp, SYMBOL_NAME); relocate_indirect_setup(); - copy_vector(); + copy_vector(NULL); relocate_indirect_end(); } /* Fall through. */ @@ -197,7 +197,7 @@ purifyloop(Scan, To_ptr, To_Address_ptr, purify_mode) case_Purify_Vector: relocate_normal_setup(); Move_Vector: - copy_vector(); + copy_vector(NULL); relocate_normal_end(); case TC_FUTURE: @@ -276,7 +276,7 @@ purify(object, flag) 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"); -- 2.25.1