From 9235f0149f3f5bb02944615ac85ce8df8919e0a9 Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Thu, 12 Feb 1987 01:19:11 +0000 Subject: [PATCH] Entry for bchscheme (scheme with garbage collector to disk) added. --- v7/src/microcode/bchdmp.c | 94 ++++++ v7/src/microcode/bchgcc.h | 53 ++++ v7/src/microcode/bchgcl.c | 257 ++++++++++++++++ v7/src/microcode/bchmmg.c | 610 ++++++++++++++++++++++++++++++++++++++ v7/src/microcode/bchpur.c | 62 ++++ 5 files changed, 1076 insertions(+) create mode 100644 v7/src/microcode/bchdmp.c create mode 100644 v7/src/microcode/bchgcc.h create mode 100644 v7/src/microcode/bchgcl.c create mode 100644 v7/src/microcode/bchmmg.c create mode 100644 v7/src/microcode/bchpur.c diff --git a/v7/src/microcode/bchdmp.c b/v7/src/microcode/bchdmp.c new file mode 100644 index 000000000..37cc2221f --- /dev/null +++ b/v7/src/microcode/bchdmp.c @@ -0,0 +1,94 @@ +/* -*-C-*- + +Copyright (c) 1987 Massachusetts Institute of Technology + +This material was developed by the Scheme project at the Massachusetts +Institute of Technology, Department of Electrical Engineering and +Computer Science. Permission to copy this software, to redistribute +it, and to use it for any purpose is granted, subject to the following +restrictions and understandings. + +1. Any copy made of this software must include this copyright notice +in full. + +2. Users of this software agree to make their best efforts (a) to +return to the MIT Scheme project any improvements or extensions that +they make, so that these may be included in future releases; and (b) +to inform MIT of noteworthy uses of this software. + +3. All materials developed as a consequence of the use of this +software shall duly acknowledge such use, in accordance with the usual +standards of acknowledging credit in academic research. + +4. MIT has made no warrantee or representation that the operation of +this software will be error-free, and MIT is under no obligation to +provide any services, by way of maintenance, update, or otherwise. + +5. In conjunction with products arising from the use of this material, +there shall be no use of the name of the Massachusetts Institute of +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.26 1987/02/12 01:19:11 jinx Exp $ */ + +/* bchgcl, bchmmg, bchpur, and bchdmp can replace gcloop, memmag, + purify, and fasdump, respectively, to provide garbage collection + and related utilities to disk. +*/ + +#include "scheme.h" +#include "primitive.h" +#define In_Fasdump +#include "bchgcc.h" +#include "dump.c" + +/* (PRIMITIVE-FASDUMP object-to-dump file-name flag) + Not implemented yet. +*/ + +NIY(Prim_Prim_Fasdump, 3, "PRIMITIVE-FASDUMP") + +/* (DUMP-BAND PROCEDURE FILE-NAME) + [Primitive number 0xB7] + Saves all of the heap and pure space on FILE-NAME. When the + file is loaded back using BAND_LOAD, PROCEDURE is called with an + argument of NIL. +*/ +Built_In_Primitive(Prim_Band_Dump, 2, "DUMP-BAND") +{ Pointer Combination, Ext_Prims; + long Arg1Type; + Primitive_2_Args(); + + Band_Dump_Permitted(); + Arg1Type = Type_Code(Arg1); + if ((Arg1Type != TC_CONTROL_POINT) && + (Arg1Type != TC_PRIMITIVE) && + (Arg1Type != TC_PRIMITIVE_EXTERNAL) && + (Arg1Type != TC_EXTENDED_PROCEDURE)) Arg_1_Type(TC_PROCEDURE); + Arg_2_Type(TC_CHARACTER_STRING); + if (!Open_Dump_File(Arg2, WRITE_FLAG)) + Primitive_Error(ERR_ARG_2_BAD_RANGE); + /* Free cannot be saved around this code since Make_Prim_Exts will + intern the undefined externals and potentially allocate space. + */ + Ext_Prims = Make_Prim_Exts(); + Combination = Make_Pointer(TC_COMBINATION_1, Free); + Free[COMB_1_FN] = Arg1; + Free[COMB_1_ARG_1] = NIL; + Free += 2; + *Free++ = Combination; + *Free++ = return_to_interpreter; + *Free = Make_Pointer(TC_LIST, Free-2); + Free++; /* Some compilers are TOO clever about this and increment Free + before calculating Free-2! */ + *Free++ = Ext_Prims; + /* Aligning here confuses some of the counts computed. + Align_Float(Free); + */ + Write_File(((long) (Free-Heap_Bottom)), Heap_Bottom, Free-2, + ((long) (Free_Constant-Constant_Space)), + Constant_Space, Free-1); + fclose(File_Handle); + return TRUTH; +} diff --git a/v7/src/microcode/bchgcc.h b/v7/src/microcode/bchgcc.h new file mode 100644 index 000000000..f916712b4 --- /dev/null +++ b/v7/src/microcode/bchgcc.h @@ -0,0 +1,53 @@ +/* -*-C-*- + +Copyright (c) 1987 Massachusetts Institute of Technology + +This material was developed by the Scheme project at the Massachusetts +Institute of Technology, Department of Electrical Engineering and +Computer Science. Permission to copy this software, to redistribute +it, and to use it for any purpose is granted, subject to the following +restrictions and understandings. + +1. Any copy made of this software must include this copyright notice +in full. + +2. Users of this software agree to make their best efforts (a) to +return to the MIT Scheme project any improvements or extensions that +they make, so that these may be included in future releases; and (b) +to inform MIT of noteworthy uses of this software. + +3. All materials developed as a consequence of the use of this +software shall duly acknowledge such use, in accordance with the usual +standards of acknowledging credit in academic research. + +4. MIT has made no warrantee or representation that the operation of +this software will be error-free, and MIT is under no obligation to +provide any services, by way of maintenance, update, or otherwise. + +5. In conjunction with products arising from the use of this material, +there shall be no use of the name of the Massachusetts Institute of +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.26 1987/02/12 01:17:47 jinx Exp $ */ + +#include "gccode.h" + +/* All of these are in objects (Pointer), not bytes. */ + +#define GC_EXTRA_BUFFER_SIZE 512 +#define GC_DISK_BUFFER_SIZE 4096 +#define GC_BUFFER_SPACE (GC_DISK_BUFFER_SIZE + GC_EXTRA_BUFFER_SIZE) +#define GC_BUFFER_BYTES (GC_DISK_BUFFER_SIZE * sizeof(Pointer)) + +#define GC_FILE_MASK 0644 /* Everyone reads, owner writes */ +#define GC_DEFAULT_FILE_NAME "/tmp/GCXXXXXX" + +extern Pointer *scan_buffer_top; +extern Pointer *free_buffer_top; +extern Pointer *dump_and_reload_scan_buffer(); +extern Pointer *dump_and_reset_free_buffer(); +extern void dump_free_directly(); + +extern Pointer *GCLoop(); diff --git a/v7/src/microcode/bchgcl.c b/v7/src/microcode/bchgcl.c new file mode 100644 index 000000000..f77348a82 --- /dev/null +++ b/v7/src/microcode/bchgcl.c @@ -0,0 +1,257 @@ +/* -*-C-*- + +Copyright (c) 1987 Massachusetts Institute of Technology + +This material was developed by the Scheme project at the Massachusetts +Institute of Technology, Department of Electrical Engineering and +Computer Science. Permission to copy this software, to redistribute +it, and to use it for any purpose is granted, subject to the following +restrictions and understandings. + +1. Any copy made of this software must include this copyright notice +in full. + +2. Users of this software agree to make their best efforts (a) to +return to the MIT Scheme project any improvements or extensions that +they make, so that these may be included in future releases; and (b) +to inform MIT of noteworthy uses of this software. + +3. All materials developed as a consequence of the use of this +software shall duly acknowledge such use, in accordance with the usual +standards of acknowledging credit in academic research. + +4. MIT has made no warrantee or representation that the operation of +this software will be error-free, and MIT is under no obligation to +provide any services, by way of maintenance, update, or otherwise. + +5. In conjunction with products arising from the use of this material, +there shall be no use of the name of the Massachusetts Institute of +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.26 1987/02/12 01:14:59 jinx Exp $ */ + +/* bchgcl, bchmmg, bchpur, and bchdmp can replace gcloop, memmag, + purify, and fasdump, respectively, to provide garbage collection + and related utilities to disk. +*/ + +#include "scheme.h" +#include "bchgcc.h" + +/* Some utility macros */ + +#define copy_cell() \ +{ *To++ = *Old; \ +} + +#define copy_pair() \ +{ *To++ = *Old++; \ + *To++ = *Old; \ +} + +#define copy_weak_pair() \ +{ long Car_Type; \ + \ + Car_Type = Type_Code(*Old); \ + *To++ = Make_New_Pointer(TC_NULL, *Old); \ + Old += 1; \ + *To++ = *Old; \ + *Old = Make_New_Pointer(Car_Type, Weak_Chain); \ + Weak_Chain = Temp; \ +} + +#define copy_triple() \ +{ *To++ = *Old++; \ + *To++ = *Old++; \ + *To++ = *Old; \ +} + +#define copy_quadruple() \ +{ *To++ = *Old++; \ + *To++ = *Old++; \ + *To++ = *Old++; \ + *To++ = *Old; \ +} + +/* Transporting vectors is done in 3 parts: + - Finish filling the current free buffer, dump it, and get a new one. + - Dump the middle of the vector directly by bufferfulls. + - Copy the end of the vector to the new buffer. + The last piece of code is the only one executed when the vector does + not overflow the current buffer. +*/ + +#define copy_vector() \ +{ Pointer *Saved_Scan = Scan; \ + unsigned long real_length = 1 + Get_Integer(*Old); \ + \ + To_Address += real_length; \ + Scan = To + real_length; \ + if (Scan >= free_buffer_top) \ + { unsigned long overflow; \ + \ + overflow = Scan - free_buffer_top; \ + while (To != free_buffer_top) *To++ = *Old++; \ + To = dump_and_reset_free_buffer(0); \ + real_length = (overflow / GC_DISK_BUFFER_SIZE); \ + if (real_length > 0) dump_free_directly(Old, real_length); \ + Old += (real_length * GC_DISK_BUFFER_SIZE); \ + Scan = To + (overflow % GC_DISK_BUFFER_SIZE); \ + } \ + while (To != Scan) *To++ = *Old++; \ + Scan = Saved_Scan; \ +} + +#define relocate_normal_setup() \ +{ Old = Get_Pointer(Temp); \ + if (Old >= Low_Constant) continue; \ + if (Type_Code(*Old) == TC_BROKEN_HEART) \ + { *Scan = Make_New_Pointer(Type_Code(Temp), *Old); \ + continue; \ + } \ + New_Address = (BROKEN_HEART_0 + C_To_Scheme(To_Address)); \ +} + +#define relocate_normal_transport(copy_code, length) \ +{ copy_code; \ + To_Address += (length); \ + if (To >= free_buffer_top) \ + To = dump_and_reset_free_buffer(To - free_buffer_top); \ +} + +#define relocate_normal_end() \ +{ *Get_Pointer(Temp) = New_Address; \ + *Scan = Make_New_Pointer(Type_Code(Temp), New_Address); \ + continue; \ +} + +#define relocate_normal_pointer(copy_code, length) \ +{ relocate_normal_setup(); \ + relocate_normal_transport(copy_code, length); \ + relocate_normal_end(); \ +} + +Pointer +*GCLoop(Scan, To_ptr, To_Address_ptr) +fast Pointer *Scan; +Pointer **To_ptr, **To_Address_ptr; +{ fast Pointer *To, *Old, Temp, *Low_Constant, *To_Address, New_Address; + + To = *To_ptr; + To_Address = *To_Address_ptr; + Low_Constant = Constant_Space; + + for ( ; Scan != To; Scan++) + { Temp = *Scan; + Switch_by_GC_Type(Temp) + { case TC_BROKEN_HEART: + if (Scan != (Get_Pointer(Temp))) + { fprintf(stderr, "GC: Broken heart in scan.\n"); + Microcode_Termination(TERM_BROKEN_HEART); + } + 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; + continue; + + case TC_MANIFEST_NM_VECTOR: + case TC_MANIFEST_SPECIAL_NM_VECTOR: + /* Check whether this bumps over current buffer, + and if so we need a new bufferfull. */ + Scan += Get_Integer(Temp); + if (Scan < scan_buffer_top) + break; + else + { unsigned long overflow; + /* 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) + + (overflow % GC_DISK_BUFFER_SIZE)) - 1); + break; + } + + case_Non_Pointer: + break; + + case_compiled_entry_point: + Old = Get_Pointer(Temp); + if (Old >= Low_Constant) continue; + Old = Get_Compiled_Block(Old); + if (Type_Code(*Old) == TC_BROKEN_HEART) + { *Scan = Relocate_Compiled(Temp, Get_Pointer(*Old), Old); + continue; + } + else + { Pointer *Saved_Old = Old; + New_Address = (BROKEN_HEART_0 + C_To_Scheme(To_Address)); + copy_vector(); + *Saved_Old = New_Address; + *Scan = Relocate_Compiled(Temp, Get_Pointer(New_Address), Saved_Old); + continue; + } + + case_Cell: + relocate_normal_pointer(copy_cell(), 1); + + case_Pair: + relocate_normal_pointer(copy_pair(), 2); + + case_Triple: + relocate_normal_pointer(copy_triple(), 3); + +#ifdef QUADRUPLE + case_Quadruple: + relocate_normal_pointer(copy_quadruple(), 4); +#endif + + case TC_VARIABLE: + relocate_normal_setup(); + { Pointer Compiled_Type = Old[VARIABLE_COMPILED_TYPE]; + if ((Type_Code(Compiled_Type) == AUX_REF) && + (!Is_Constant(Get_Pointer(Compiled_Type))) && + (Type_Code(Vector_Ref(Compiled_Type, 0)) != TC_BROKEN_HEART)) + { Old[VARIABLE_COMPILED_TYPE] = UNCOMPILED_VARIABLE; + Old[VARIABLE_OFFSET] = NIL; + } + } + relocate_normal_transport(copy_triple(), 3); + relocate_normal_end(); + +#ifdef FLOATING_ALIGNMENT + case TC_BIG_FLONUM: + /* This must be fixed. */ +#include "error: bchgcl does not handle floating alignment." +#else + case TC_BIG_FLONUM: + /* Fall through */ +#endif + case_Vector: + relocate_normal_setup(); + Move_Vector: + copy_vector(); + relocate_normal_end(); + + case TC_FUTURE: + relocate_normal_setup(); + if (!(Future_Spliceable(Temp))) goto Move_Vector; + *Scan = Future_Value(Temp); + Scan -= 1; + continue; + + case TC_WEAK_CONS: + relocate_normal_pointer(copy_weak_pair(), 2); + + default: + fprintf(stderr, + "GCLoop: Bad type code = 0x%02x\n", + Type_Code(Temp)); + Invalid_Type_Code(); + } + } +end_gcloop: + *To_ptr = To; + *To_Address_ptr = To_Address; + return Scan; +} diff --git a/v7/src/microcode/bchmmg.c b/v7/src/microcode/bchmmg.c new file mode 100644 index 000000000..6c9df28db --- /dev/null +++ b/v7/src/microcode/bchmmg.c @@ -0,0 +1,610 @@ +/* -*-C-*- + +Copyright (c) 1987 Massachusetts Institute of Technology + +This material was developed by the Scheme project at the Massachusetts +Institute of Technology, Department of Electrical Engineering and +Computer Science. Permission to copy this software, to redistribute +it, and to use it for any purpose is granted, subject to the following +restrictions and understandings. + +1. Any copy made of this software must include this copyright notice +in full. + +2. Users of this software agree to make their best efforts (a) to +return to the MIT Scheme project any improvements or extensions that +they make, so that these may be included in future releases; and (b) +to inform MIT of noteworthy uses of this software. + +3. All materials developed as a consequence of the use of this +software shall duly acknowledge such use, in accordance with the usual +standards of acknowledging credit in academic research. + +4. MIT has made no warrantee or representation that the operation of +this software will be error-free, and MIT is under no obligation to +provide any services, by way of maintenance, update, or otherwise. + +5. In conjunction with products arising from the use of this material, +there shall be no use of the name of the Massachusetts Institute of +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.26 1987/02/12 01:17:03 jinx Exp $ */ + +/* Memory management top level. Garbage collection to disk. + + The algorithm is basically the same as for the 2 space collector, + except that new space is on the disk, and there are two windows to + it (the scan and free buffers). For information on the 2 space + collector, read the comments in the replaced files. + + The memory management code is spread over 3 files: + - bchmmg.c: initialization and top level. Replaces memmag.c + - bchgcl.c: main garbage collector loop. Replaces gcloop.c + - bchpur.c: constant/pure space hacking. Replaces purify.c + - bchdmp.c: object world image dumping. Replaces fasdump.c + + Problems with this implementation right now: + - It only works on Unix (or systems which support Unix i/o calls). + - Purify is not implemented. + - Fasdump is not implemented. + - Floating alignment is not implemented. + - Dumpworld will not work because the file is not closed at dump time. + - Command line supplied gc files are not locked, so two processes can try + to share them. + - Compiled code handling in bchgcl is not generic, may only work for 68k + family processors. +*/ + +#include "scheme.h" +#include "primitive.h" +#include "bchgcc.h" +#include + +/* Exports */ + +extern void Clear_Memory(), Setup_Memory(), Reset_Memory(); + +/* Memory Allocation, sequential processor, + garbage collection to disk version: + + ------------------------------------------ + | GC Buffer Space | + | | + ------------------------------------------ + | Control Stack || | + | \/ | + ------------------------------------------ + | Constant + Pure Space /\ | + | || | + ------------------------------------------ + | Heap Space | + | | + ------------------------------------------ + + Each area has a pointer to its starting address and a pointer to + the next free cell. The GC buffer space contains two equal size + buffers used during the garbage collection process. Usually one is + the scan buffer and the other is the free buffer, and they are + dumped and loaded from disk as necessary. Sometimes during the + garbage collection (especially at the beginning and at the end) + both buffers are identical, since transporting will occur into the + area being scanned. +*/ + +/* Local declarations */ + +static long scan_position, free_position; +static Pointer *gc_disk_buffer_1, *gc_disk_buffer_2; +Pointer *scan_buffer_top, *scan_buffer_bottom, *scan_buffer; +Pointer *free_buffer_top, *free_buffer_bottom, *free_buffer; + +/* Hacking the gc file */ + +extern char *mktemp(); + +static int gc_file; +static char *gc_file_name; +static char gc_default_file_name[FILE_NAME_LENGTH] = GC_DEFAULT_FILE_NAME; + +void +open_gc_file() +{ int position; + int flags; + + (void) mktemp(gc_default_file_name); + flags = (O_RDWR | O_CREAT | O_SYNCIO); + + position = Parse_Option("-gcfile", Saved_argc, Saved_argv, true); + if ((position != NOT_THERE) && + (position != (Saved_argc - 1))) + { gc_file_name = Saved_argv[position + 1]; + } + else + { gc_file_name = gc_default_file_name; + flags |= O_EXCL; + } + + while(true) + { gc_file = open(gc_file_name, flags, GC_FILE_MASK); + if (gc_file != -1) break; + if (gc_file_name != gc_default_file_name) + { fprintf(stderr, + "%s: GC file \"%s\" cannot be opened; ", + Saved_argv[0]), gc_file_name; + gc_file_name = gc_default_file_name; + fprintf(stderr, + "Using \"%s\" instead.\n", + gc_file_name); + flags |= O_EXCL; + continue; + } + fprintf(stderr, + "%s: GC file \"%s\" cannot be opened; ", + Saved_argv[0]), gc_file_name; + fprintf(stderr, "Aborting.\n"); + exit(1); + } + return; +} + +void +close_gc_file() +{ if (close(gc_file) == -1) + fprintf(stderr, + "%s: Problems closing GC file \"%s\".\n", + Saved_argv[0], gc_file_name); + if (gc_file_name == gc_default_file_name) + unlink(gc_file_name); + return; +} + +void +Clear_Memory(Our_Heap_Size, Our_Stack_Size, Our_Constant_Size) +int Our_Heap_Size, Our_Stack_Size, Our_Constant_Size; +{ Heap_Top = Heap_Bottom + Our_Heap_Size; + Set_Mem_Top(Heap_Top - GC_Reserve); + Free = Heap_Bottom; + Free_Constant = Constant_Space; + Set_Pure_Top(); + Initialize_Stack(); + return; +} + +void +Setup_Memory(Our_Heap_Size, Our_Stack_Size, Our_Constant_Size) +int Our_Heap_Size, Our_Stack_Size, Our_Constant_Size; +{ int Real_Stack_Size = Stack_Allocation_Size(Our_Stack_Size); + + /* Consistency check 1 */ + if (Our_Heap_Size == 0) + { printf("Configuration won't hold initial data.\n"); + exit(1); + } + + /* Allocate. + The two GC buffers are not included in the valid Scheme memory. + */ + Highest_Allocated_Address = + Allocate_Heap_Space(Real_Stack_Size + Our_Heap_Size + + Our_Constant_Size + (2 * GC_BUFFER_SPACE)); + Highest_Allocated_Address -= (2 * GC_BUFFER_SPACE); + + /* Consistency check 2 */ + if (Heap == NULL) + { fprintf(stderr, "Not enough memory for this configuration.\n"); + exit(1); + } + + /* Initialize the various global parameters. + Floating alignment will have to be added here. + */ + Constant_Space = Heap + Our_Heap_Size; + gc_disk_buffer_1 = Constant_Space + Our_Constant_Size + Real_Stack_Size; + gc_disk_buffer_2 = (gc_disk_buffer_1 + GC_BUFFER_SPACE); + + /* Consistency check 3 */ + if (((C_To_Scheme(Highest_Allocated_Address)) & TYPE_CODE_MASK) != 0) + { fprintf(stderr, + "Largest address does not fit in datum field of Pointer.\n"); + fprintf(stderr, + "Allocate less space or re-compile without Heap_In_Low_Memory.\n"); + exit(1); + } + + Heap_Bottom = Heap; + Clear_Memory(Our_Heap_Size, Our_Stack_Size, Our_Constant_Size); + + open_gc_file(); + return; +} + +void +Reset_Memory() +{ close_gc_file(); + return; +} + +void +dump_buffer(from, position, nbuffers, name) +Pointer *from; +long *position, nbuffers; +char *name; +{ 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 ((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*/ + } + + *position += bytes_written; + return; +} + +void +load_buffer(position, to, nbytes, name) +long position; +Pointer *to; +long nbytes; +char *name; +{ long bytes_read; + if (lseek(gc_file, position, 0) == -1) + { fprintf(stderr, "\nCould not position GC file to read %s.\n", name); + Microcode_Termination(TERM_EXIT); + /*NOTREACHED*/ + } + if ((bytes_read = read(gc_file, to, nbytes)) != nbytes) + { fprintf(stderr, "\nCould not read into %s.\n", name); + Microcode_Termination(TERM_EXIT); + /*NOTREACHED*/ + } + return; +} + +void +reload_scan_buffer() +{ if (scan_position == free_position) + { scan_buffer_bottom = free_buffer_bottom; + scan_buffer_top = free_buffer_top; + scan_buffer = scan_buffer_bottom; + return; + } + scan_buffer_bottom = ((free_buffer_bottom == gc_disk_buffer_1) ? + gc_disk_buffer_2 : + gc_disk_buffer_1); + load_buffer(scan_position, scan_buffer_bottom, + GC_BUFFER_BYTES, "the scan buffer"); + scan_buffer_top = scan_buffer_bottom + GC_DISK_BUFFER_SIZE; + *scan_buffer_top = Make_Pointer(TC_BROKEN_HEART, scan_buffer_top); + return; +} + +void +initialize_scan_buffer() +{ scan_position = 0; + reload_scan_buffer(); + scan_buffer = scan_buffer_bottom; + return; +} + +/* This hacks the scan buffer also so that Scan is always below + scan_buffer_top until the scan buffer is initialized. +*/ +void +initialize_free_buffer() +{ free_position = 0; + free_buffer_bottom = gc_disk_buffer_1; + free_buffer_top = free_buffer_bottom + GC_DISK_BUFFER_SIZE; + free_buffer = free_buffer_bottom; + scan_position = -1; + scan_buffer_bottom = gc_disk_buffer_2; + scan_buffer_top = scan_buffer_bottom + GC_DISK_BUFFER_SIZE; + return; +} + +Pointer +*dump_and_reload_scan_buffer(number_to_skip) +long number_to_skip; +{ dump_buffer(scan_buffer_bottom, &scan_position, 1, "scan"); + if (number_to_skip != 0) + scan_position += (number_to_skip * GC_BUFFER_BYTES); + reload_scan_buffer(); + return scan_buffer_bottom; +} + +Pointer +*dump_and_reset_free_buffer(overflow) +fast long overflow; +{ fast Pointer *into, *from; + + from = free_buffer_top; + 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. + */ + free_position += GC_BUFFER_BYTES; + free_buffer_bottom = ((scan_buffer_bottom == gc_disk_buffer_1) ? + gc_disk_buffer_2 : + gc_disk_buffer_1); + free_buffer_top = free_buffer_bottom + GC_DISK_BUFFER_SIZE; + } + else + dump_buffer(free_buffer_bottom, &free_position, 1, "free"); + + for (into = free_buffer_bottom; --overflow >= 0; ) + *into++ = *from++; + + /* This only needs to be done when they were the same buffer, + but it does not hurt. + */ + *scan_buffer_top = Make_Pointer(TC_BROKEN_HEART, scan_buffer_top); + + return into; +} + +void +dump_free_directly(from, nbuffers) +Pointer *from; +long nbuffers; +{ dump_buffer(from, &free_position, nbuffers, "free"); + return; +} + +static long current_buffer_position; + +void +initialize_new_space_buffer() +{ current_buffer_position = -1; + return; +} + +void +flush_new_space_buffer() +{ if (current_buffer_position == -1) + return; + dump_buffer(gc_disk_buffer_1, ¤t_buffer_position, + 1, "weak pair buffer"); + current_buffer_position = -1; + return; +} + +Pointer +*guarantee_in_memory(addr) +Pointer *addr; +{ long position, offset; + position = (addr - Heap_Bottom); + offset = (position % GC_DISK_BUFFER_SIZE); + position = (position / GC_DISK_BUFFER_SIZE); + position *= GC_BUFFER_BYTES; + if (position != current_buffer_position) + { flush_new_space_buffer(); + load_buffer(position, gc_disk_buffer_1, + GC_BUFFER_BYTES, "the weak pair buffer"); + current_buffer_position = position; + } + return &gc_disk_buffer_1[offset]; +} + +/* For a description of the algorithm, see memmag.c. + This has been modified only to account for the fact that new space + is on disk. Old space is in memory. +*/ + +void +Fix_Weak_Chain() +{ fast Pointer *Old_Weak_Cell, *Scan, Old_Car, Temp, *Old, *Low_Constant; + + initialize_new_space_buffer(); + Low_Constant = Constant_Space; + while (Weak_Chain != NIL) + { Old_Weak_Cell = Get_Pointer(Weak_Chain); + Scan = guarantee_in_memory(Get_Pointer(*Old_Weak_Cell++)); + Weak_Chain = *Old_Weak_Cell; + Old_Car = *Scan; + Temp = Make_New_Pointer(Type_Code(Weak_Chain), Old_Car); + Weak_Chain = Make_New_Pointer(TC_NULL, Weak_Chain); + + switch(GC_Type(Temp)) + { case GC_Non_Pointer: + *Scan = Temp; + continue; + + /* Normal pointer types, the broken heart is in the first word. + Note that most special types are treated normally here. + The BH code updates *Scan if the object has been relocated. + Otherwise it falls through and we replace it with a full NIL. + Eliminating this assignment would keep old data (pl. of datum). + */ + + case GC_Cell: + case GC_Pair: + case GC_Triple: + case GC_Quadruple: + case GC_Vector: + /* Old is still a pointer to old space */ + Old = Get_Pointer(Old_Car); + if (Old >= Low_Constant) + { *Scan = Temp; + continue; + } + if (Type_Code(*Old) == TC_BROKEN_HEART) + { *Scan = Make_New_Pointer(Type_Code(Temp), *Old); + continue; + } + *Scan = NIL; + continue; + + case GC_Compiled: + /* Old is still a pointer to old space */ + Old = Get_Pointer(Old_Car); + if (Old >= Low_Constant) + { *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; + } + *Scan = NIL; + continue; + + case GC_Special: + case GC_Undefined: + default: /* Non Marked Headers and Broken Hearts */ + fprintf(stderr, + "\nFix_Weak_Chain: Bad Object: Type = 0x%02x; Datum = %x\n", + Type_Code(Temp), Datum(Temp)); + Microcode_Termination(TERM_INVALID_TYPE_CODE); + /*NOTREACHED*/ + } + } + flush_new_space_buffer(); + return; +} + +void +GC() +{ Pointer *Root, *Result, *end_of_constant_area, + The_Precious_Objects, *Root2; + + initialize_free_buffer(); + Free = Heap_Bottom; + Set_Mem_Top(Heap_Top - GC_Reserve); + Weak_Chain = NIL; + + /* Save the microcode registers so that they can be relocated */ + Terminate_Old_Stacklet(); + Terminate_Constant_Space(end_of_constant_area); + + Root = Free; + The_Precious_Objects = Get_Fixed_Obj_Slot(Precious_Objects); + Set_Fixed_Obj_Slot(Precious_Objects, NIL); + Set_Fixed_Obj_Slot(Lost_Objects_Base, NIL); + + *free_buffer++ = Fixed_Objects; + *free_buffer++ = Make_Pointer(TC_HUNK3, History); + *free_buffer++ = Undefined_Externals; + *free_buffer++ = Get_Current_Stacklet(); + *free_buffer++ = ((Previous_Restore_History_Stacklet == NULL) ? + NIL : + Make_Pointer(TC_CONTROL_POINT, + Previous_Restore_History_Stacklet)); + *free_buffer++ = Current_State_Point; + *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); + + /* The 4 step GC */ + Result = GCLoop(Constant_Space, &free_buffer, &Free); + if (Result != end_of_constant_area) + { fprintf(stderr, "\nGC: Constant Scan ended too early.\n"); + Microcode_Termination(TERM_EXIT); + /*NOTREACHED*/ + } + initialize_scan_buffer(); + Result = GCLoop(scan_buffer, &free_buffer, &Free); + if (free_buffer != Result) + { fprintf(stderr, "\nGC-1: Heap Scan ended too early.\n"); + Microcode_Termination(TERM_EXIT); + /*NOTREACHED*/ + } + Root2 = Free; + *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); + Result = GCLoop(Result, &free_buffer, &Free); + if (free_buffer != Result) + { fprintf(stderr, "\nGC-2: Heap Scan ended too early.\n"); + Microcode_Termination(TERM_EXIT); + /*NOTREACHED*/ + } + dump_buffer(scan_buffer_bottom, &scan_position, 1, "scan"); + free_position = scan_position; + Fix_Weak_Chain(); + load_buffer(0, Heap_Bottom, + ((Free - Heap_Bottom) * sizeof(Pointer)), + "new space"); + + /* Make the microcode registers point to the copies in new-space. */ + + Fixed_Objects = *Root++; + Set_Fixed_Obj_Slot(Precious_Objects, *Root2); + Set_Fixed_Obj_Slot(Lost_Objects_Base, Make_Pointer(TC_ADDRESS, Root2)); + + History = Get_Pointer(*Root++); + Undefined_Externals = *Root++; + Set_Current_Stacklet(*Root); + Root += 1; /* Set_Current_Stacklet is sometimes a No-Op! */ + if (*Root == NIL) + { Previous_Restore_History_Stacklet = NULL; + Root += 1; + } + else Previous_Restore_History_Stacklet = Get_Pointer(*Root++); + Current_State_Point = *Root++; + Fluid_Bindings = *Root++; + Free_Stacklets = NULL; + return; +} + +/* (GARBAGE-COLLECT SLACK) + [Primitive number 0x3A] + Requests a garbage collection leaving the specified amount of slack + for the top of heap check on the next GC. The primitive ends by invoking + the GC daemon if there is one. +*/ + +Built_In_Primitive(Prim_Garbage_Collect, 1, "GARBAGE-COLLECT") +{ Pointer GC_Daemon_Proc; + Primitive_1_Arg(); + + Arg_1_Type(TC_FIXNUM); + if (Free > Heap_Top) + { fprintf(stderr, "\nGC has been delayed too long, and you are truly out of room!\n"); + fprintf(stderr, "Free=0x%x, MemTop=0x%x, Heap_Top=0x%x\n", Free, MemTop, Heap_Top); + Microcode_Termination(TERM_NO_SPACE); + /*NOTREACHED*/ + } + GC_Reserve = Get_Integer(Arg1); + GC(); + IntCode &= ~INT_GC; + if (GC_Check(GC_Space_Needed)) + { fprintf(stderr, + "\nGC just ended. The free pointer is at 0x%x, the top of this heap\n", + Free); + fprintf(stderr, + "is at 0x%x, and we are trying to cons 0x%x objects. Dead!\n", + MemTop, GC_Space_Needed); + Microcode_Termination(TERM_NO_SPACE); + /*NOTREACHED*/ + } + GC_Daemon_Proc = Get_Fixed_Obj_Slot(GC_Daemon); + if (GC_Daemon_Proc == NIL) + return FIXNUM_0 + (MemTop - Free); + Pop_Primitive_Frame(1); + Will_Push(CONTINUATION_SIZE + (STACK_ENV_EXTRA_SLOTS+1)); + Store_Return(RC_NORMAL_GC_DONE); + Store_Expression(FIXNUM_0 + (MemTop - Free)); + Save_Cont(); + Push(GC_Daemon_Proc); + Push(STACK_FRAME_HEADER); + Pushed(); + longjmp(*Back_To_Eval, PRIM_APPLY); + /* The following comment is by courtesy of LINT, your friendly sponsor. */ + /*NOTREACHED*/ +} diff --git a/v7/src/microcode/bchpur.c b/v7/src/microcode/bchpur.c new file mode 100644 index 000000000..d26cebb57 --- /dev/null +++ b/v7/src/microcode/bchpur.c @@ -0,0 +1,62 @@ +/* -*-C-*- + +Copyright (c) 1987 Massachusetts Institute of Technology + +This material was developed by the Scheme project at the Massachusetts +Institute of Technology, Department of Electrical Engineering and +Computer Science. Permission to copy this software, to redistribute +it, and to use it for any purpose is granted, subject to the following +restrictions and understandings. + +1. Any copy made of this software must include this copyright notice +in full. + +2. Users of this software agree to make their best efforts (a) to +return to the MIT Scheme project any improvements or extensions that +they make, so that these may be included in future releases; and (b) +to inform MIT of noteworthy uses of this software. + +3. All materials developed as a consequence of the use of this +software shall duly acknowledge such use, in accordance with the usual +standards of acknowledging credit in academic research. + +4. MIT has made no warrantee or representation that the operation of +this software will be error-free, and MIT is under no obligation to +provide any services, by way of maintenance, update, or otherwise. + +5. In conjunction with products arising from the use of this material, +there shall be no use of the name of the Massachusetts Institute of +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.26 1987/02/12 01:18:37 jinx Exp $ + * + * This file contains the code for primitives dealing with pure + * and constant space. Garbage collection to disk version. + * + * Currently this is not implemented. These are just stubs. + * + */ + +#include "scheme.h" +#include "primitive.h" +#include "bchgcc.h" + +/* Stub. Terminates Scheme if invoked. */ + +Pointer +Purify_Pass_2(info) +Pointer info; +{ fprintf(stderr, "\nPurify_Pass_2 invoked!\n"); + Microcode_Termination(TERM_EXIT); + /*NOTREACHED*/ +} + +/* Stub. Make it look as if it had succeeded. */ + +Built_In_Primitive(Prim_Primitive_Purify, 2, "PRIMITIVE-PURIFY") +{ + Primitive_2_Args(); + return TRUTH; +} -- 2.25.1