From 66151c4173c0d12afcb7d5065990b545cf4fa6cf Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Sat, 7 Sep 1991 01:06:53 +0000 Subject: [PATCH] - Align GC buffers and Scheme spaces so that raw (character) devices can be used for the gc heap. - Limited recovery and better error reporting on system call errors. --- v7/src/microcode/bchgcc.h | 86 +++++--- v7/src/microcode/bchmmg.c | 402 ++++++++++++++++++++++++++++---------- v7/src/microcode/bchpur.c | 53 +++-- 3 files changed, 395 insertions(+), 146 deletions(-) diff --git a/v7/src/microcode/bchgcc.h b/v7/src/microcode/bchgcc.h index 01407b497..2c7ad50c6 100644 --- a/v7/src/microcode/bchgcc.h +++ b/v7/src/microcode/bchgcc.h @@ -1,6 +1,6 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchgcc.h,v 9.37 1990/06/20 17:38:12 cph Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchgcc.h,v 9.38 1991/09/07 01:06:20 jinx Exp $ Copyright (c) 1987, 1988, 1989, 1990 Massachusetts Institute of Technology @@ -40,35 +40,69 @@ MIT in each case. */ #include #endif +/* This should be fixed. + We need to change the definition of INITIAL_ALIGN_HEAP, and some + uses. + */ + /* All of these are in objects (SCHEME_OBJECT), not bytes. */ -#define GC_EXTRA_BUFFER_SIZE 512 -#define GC_DISK_BUFFER_SIZE 1024 +#define GC_DISK_BUFFER_SIZE 16384 /* Used to be 1024 */ +#define GC_EXTRA_BUFFER_SIZE GC_DISK_BUFFER_SIZE /* Complete next bufferfull */ #define GC_BUFFER_SPACE (GC_DISK_BUFFER_SIZE + GC_EXTRA_BUFFER_SIZE) #define GC_BUFFER_BYTES (GC_DISK_BUFFER_SIZE * sizeof(SCHEME_OBJECT)) #define GC_BUFFER_OVERLAP_BYTES (GC_EXTRA_BUFFER_SIZE * sizeof(SCHEME_OBJECT)) #define GC_BUFFER_REMAINDER_BYTES (GC_BUFFER_BYTES - GC_BUFFER_OVERLAP_BYTES) +#define GC_FUDGE_SIZE GC_EXTRA_BUFFER_SIZE -#define GC_FILE_FLAGS (O_RDWR | O_CREAT) /* O_SYNCIO removed */ -#define GC_FILE_MASK 0644 /* Everyone reads, owner writes */ -#define GC_DEFAULT_FILE_NAME "/tmp/GCXXXXXX" +#define GC_BUFFER_BLOCK(size) \ + (GC_DISK_BUFFER_SIZE \ + * (((size) + (GC_DISK_BUFFER_SIZE - 1)) / GC_DISK_BUFFER_SIZE)) + +/* These assume that GC_BUFFER_BYTES is a power of 2! */ -extern SCHEME_OBJECT *scan_buffer_top, *scan_buffer_bottom; -extern SCHEME_OBJECT *free_buffer_top, *free_buffer_bottom; -extern SCHEME_OBJECT *dump_and_reload_scan_buffer(); -extern SCHEME_OBJECT *dump_and_reset_free_buffer(); -extern void dump_free_directly(), load_buffer(); +#define ALIGN_DOWN_TO_GC_BUFFER(addr) \ + (((unsigned long) (addr)) & (~(GC_BUFFER_BYTES - 1))) -extern void extend_scan_buffer(); -extern char *end_scan_buffer_extension(); +#define ALIGN_UP_TO_GC_BUFFER(addr) \ + (ALIGN_DOWN_TO_GC_BUFFER (((unsigned long) (addr)) + (GC_BUFFER_BYTES - 1))) -extern SCHEME_OBJECT *GCLoop(); -extern SCHEME_OBJECT *initialize_free_buffer(), *initialize_scan_buffer(); -extern void end_transport(), GC(); -extern int gc_file; +#define ALIGNED_TO_GC_BUFFER_P(addr) \ + (((unsigned long) (addr)) == (ALIGN_DOWN_TO_GC_BUFFER (addr))) -extern void gc_death(); -extern char gc_death_message_buffer[]; +#define GC_FILE_FLAGS (O_RDWR | O_CREAT) /* O_SYNCIO removed */ +#define GC_FILE_MASK 0644 /* Everyone reads, owner writes */ +#define GC_DEFAULT_FILE_NAME "/tmp/GCXXXXXX" + +extern char + gc_death_message_buffer[]; + +extern int + gc_file; + +extern SCHEME_OBJECT + *scan_buffer_top, + *scan_buffer_bottom, + *free_buffer_top, + *free_buffer_bottom; + +extern SCHEME_OBJECT + * EXFUN (GCLoop, (SCHEME_OBJECT *, SCHEME_OBJECT **, SCHEME_OBJECT **)), + * EXFUN (dump_and_reload_scan_buffer, (long, Boolean *)), + * EXFUN (dump_and_reset_free_buffer, (long, Boolean *)), + * EXFUN (initialize_free_buffer, (void)), + * EXFUN (initialize_scan_buffer, (void)); + +extern void + EXFUN (GC, (SCHEME_OBJECT)), + EXFUN (end_transport, (Boolean *)), + EXFUN (dump_free_directly, (SCHEME_OBJECT *, long, Boolean *)), + EXFUN (load_buffer, (long, SCHEME_OBJECT *, long, char *)), + EXFUN (extend_scan_buffer, (char *, SCHEME_OBJECT *)), + EXFUN (gc_death, (long, char *, SCHEME_OBJECT *, SCHEME_OBJECT *)); + +extern char + * EXFUN (end_scan_buffer_extension, (char *)); /* Some utility macros */ @@ -121,30 +155,26 @@ extern char gc_death_message_buffer[]; #define copy_vector(success) \ { \ SCHEME_OBJECT *Saved_Scan = Scan; \ - unsigned long real_length = 1 + OBJECT_DATUM (*Old); \ + unsigned long real_length = (1 + (OBJECT_DATUM (*Old))); \ \ To_Address += real_length; \ - Scan = To + real_length; \ + Scan = (To + real_length); \ if (Scan >= free_buffer_top) \ { \ unsigned long overflow; \ \ - overflow = Scan - free_buffer_top; \ + overflow = (Scan - free_buffer_top); \ while (To != free_buffer_top) \ *To++ = *Old++; \ - To = dump_and_reset_free_buffer(0, success); \ + 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, success); \ - } \ + dump_free_directly (Old, real_length, success); \ Old += (real_length * GC_DISK_BUFFER_SIZE); \ Scan = To + (overflow % GC_DISK_BUFFER_SIZE); \ } \ while (To != Scan) \ - { \ *To++ = *Old++; \ - } \ Scan = Saved_Scan; \ } diff --git a/v7/src/microcode/bchmmg.c b/v7/src/microcode/bchmmg.c index bec944977..e74c50557 100644 --- a/v7/src/microcode/bchmmg.c +++ b/v7/src/microcode/bchmmg.c @@ -1,6 +1,6 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchmmg.c,v 9.61 1991/03/24 01:10:22 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchmmg.c,v 9.62 1991/09/07 01:06:38 jinx Exp $ Copyright (c) 1987-1991 Massachusetts Institute of Technology @@ -62,11 +62,29 @@ MIT in each case. */ #include "prims.h" #include "bchgcc.h" #include "option.h" +#include +#include +#include /* Exports */ extern void EXFUN (Clear_Memory, (int, int, int)); extern void EXFUN (Setup_Memory, (int, int, int)); extern void EXFUN (Reset_Memory, (void)); + +char * +DEFUN (error_name, (code), + int code) +{ + extern int sys_nerr; + extern char *sys_errlist[]; + static char buf[512]; + + if ((code >= 0) && (code <= sys_nerr)) + sprintf (&buf[0], "%d, %s", code, sys_errlist[code]); + else + sprintf (&buf[0], "%d, unknown error", code); + return (&buf[0]); +} /* Memory Allocation, sequential processor, garbage collection to disk version: @@ -113,6 +131,7 @@ int gc_file; static long current_disk_position; static CONST char * gc_file_name; static char gc_default_file_name[FILE_NAME_LENGTH] = GC_DEFAULT_FILE_NAME; +static Boolean can_dump_directly_p; void DEFUN (open_gc_file, (size), int size) @@ -123,34 +142,69 @@ DEFUN (open_gc_file, (size), int size) (void) (mktemp (gc_default_file_name)); flags = GC_FILE_FLAGS; gc_file_name = option_gc_file; - if (gc_file_name == 0) + if (gc_file_name != ((char *) NULL)) + { + struct stat file_info; + if ((stat (gc_file_name, &file_info)) != -1) { + /* If it is S_IFCHR, it should determine the IO block + size and make sure that it will work. + I don't know how to do that. + ustat(2) will do that for a mounted file system, + but obviously, if a raw device file is used, + there better not be a file system on the file. + */ + + if ((file_info.st_mode & S_IFMT) == S_IFCHR) + can_dump_directly_p = false; + else if (((file_info.st_mode & S_IFMT) != S_IFREG) + && ((file_info.st_mode & S_IFMT) != S_IFBLK)) + { + fprintf (stderr, + "\ +%s: GC file \"%s\" cannot be used as a GC file (type = 0x%08x).\n", + scheme_program_name, gc_file_name, + ((int) (file_info.st_mode & S_IFMT))); + gc_file_name = ((char *) NULL); + fprintf (stderr, + "\tUsing \"%s\" instead.\n", + gc_default_file_name); + } + else + can_dump_directly_p = true; + } + } + + while (true) + { + if (gc_file_name == ((char *) NULL)) + { + can_dump_directly_p = true; gc_file_name = gc_default_file_name; flags |= O_EXCL; } - while (1) - { gc_file = (open (gc_file_name, flags, GC_FILE_MASK)); if (gc_file != -1) { break; } - if (gc_file_name != gc_default_file_name) + else if (gc_file_name != gc_default_file_name) { fprintf (stderr, - "%s: GC file \"%s\" cannot be opened; ", - scheme_program_name, gc_file_name); - gc_file_name = gc_default_file_name; + "%s: GC file \"%s\" cannot be opened (errno = %s).\n", + scheme_program_name, gc_file_name, (error_name (errno))); fprintf (stderr, - "Using \"%s\" instead.\n", - gc_file_name); - flags |= O_EXCL; - continue; + "\tUsing \"%s\" instead.\n", + gc_default_file_name); + gc_file_name = ((char *) NULL); + } + else + { + fprintf (stderr, + "%s: GC file \"%s\" cannot be opened (errno = %s); Aborting.\n", + scheme_program_name, gc_file_name, (error_name (errno))); + exit (1); } - fprintf (stderr, - "%s: GC file \"%s\" cannot be opened; Aborting.\n", - scheme_program_name, gc_file_name); - exit (1); } #ifdef _HPUX if (gc_file_name == gc_default_file_name) @@ -212,9 +266,7 @@ DEFUN (Setup_Memory, (Our_Heap_Size, Our_Stack_Size, Our_Constant_Size), int Our_Constant_Size) { SCHEME_OBJECT test_value; - int Real_Stack_Size; - - Real_Stack_Size = (Stack_Allocation_Size (Our_Stack_Size)); + int Real_Stack_Size, fudge_space; /* Consistency check 1 */ if (Our_Heap_Size == 0) @@ -223,33 +275,36 @@ DEFUN (Setup_Memory, (Our_Heap_Size, Our_Stack_Size, Our_Constant_Size), exit (1); } + Real_Stack_Size = (Stack_Allocation_Size (Our_Stack_Size)); + + /* Allocate in blocks of GC_DISK_BUFFER_SIZE. */ + + fudge_space = (GC_BUFFER_BLOCK (HEAP_BUFFER_SPACE + 1 + GC_FUDGE_SIZE)); + Our_Heap_Size = (GC_BUFFER_BLOCK (Our_Heap_Size)); + Our_Constant_Size = (GC_BUFFER_BLOCK (Our_Constant_Size)); + Real_Stack_Size = (GC_BUFFER_BLOCK (Real_Stack_Size)); + /* Allocate. The two GC buffers are not included in the valid Scheme memory. */ - ALLOCATE_HEAP_SPACE (Real_Stack_Size + Our_Heap_Size + - Our_Constant_Size + (2 * GC_BUFFER_SPACE) + - (HEAP_BUFFER_SPACE + 1)); + + ALLOCATE_HEAP_SPACE (Real_Stack_Size + Our_Heap_Size + + Our_Constant_Size + (2 * GC_BUFFER_SPACE) + + fudge_space); /* Consistency check 2 */ if (Heap == NULL) { - fprintf(stderr, "Not enough memory for this configuration.\n"); - exit(1); + fprintf (stderr, "Not enough memory for this configuration.\n"); + exit (1); } - + Heap += HEAP_BUFFER_SPACE; - INITIAL_ALIGN_FLOAT (Heap); - + Heap = ((SCHEME_OBJECT *) (ALIGN_UP_TO_GC_BUFFER (Heap))); Constant_Space = (Heap + Our_Heap_Size); - ALIGN_FLOAT (Constant_Space); - - /* Trim the system buffer space. */ - - Highest_Allocated_Address = (Constant_Space + - (Our_Constant_Size + Real_Stack_Size)); - - gc_disk_buffer_1 = Highest_Allocated_Address + 1; + gc_disk_buffer_1 = (Constant_Space + Our_Constant_Size + Real_Stack_Size); gc_disk_buffer_2 = (gc_disk_buffer_1 + GC_BUFFER_SPACE); + Highest_Allocated_Address = (gc_disk_buffer_1 - 1); /* Consistency check 3 */ test_value = @@ -264,6 +319,16 @@ DEFUN (Setup_Memory, (Our_Heap_Size, Our_Stack_Size, Our_Constant_Size), "Allocate less space or re-configure without HEAP_IN_LOW_MEMORY.\n"); exit (1); } + /* This does not use INITIAL_ALIGN_HEAP because it would + make Heap point to the previous GC_BUFFER frame. + INITIAL_ALIGN_HEAP should have its phase changed so that it would + be a NOP below, and constant space should use it too. + */ + + ALIGN_FLOAT (Heap); + ALIGN_FLOAT (Constant_Space); + Our_Heap_Size = (Constant_Space - Heap); + Our_Constant_Size = ((Highest_Allocated_Address - Constant_Space) - Real_Stack_Size); Heap_Bottom = Heap; Clear_Memory (Our_Heap_Size, Our_Stack_Size, Our_Constant_Size); @@ -279,6 +344,81 @@ DEFUN_VOID (Reset_Memory) return; } +long +DEFUN (gc_file_operation, (operation, ptr, arg, success, name, errmsg), + long EXFUN ((*operation), (int, long, long)) AND + long ptr AND + long arg AND + Boolean *success AND + CONST char * name AND + CONST char *errmsg) +{ + extern char EXFUN (userio_choose_option, + (const char *, const char *, const char **)); + static CONST char * retry_choices [] = + { + "K = kill scheme", + "Q = quit scheme", + "R = retry the operation", + "S = sleep for 1 minute and retry the operation", + "X = exit scheme", + 0 + }; + long result; + + while ((result = ((*operation) (gc_file, ptr, arg))) + == -1) + { + if (success != ((Boolean *) NULL)) + { + *success = false; + return (result); + } + fprintf (stderr, errmsg, name, (error_name (errno))); + switch (userio_choose_option + ("Choose one of the following actions:", + "Action -> ", + retry_choices)) + { + case '\0': + /* IO problems, assume everything scrod. */ + fprintf (stderr, "Problems reading keyboard input -- exitting.\n"); + /* fall through */ + + case 'K': + case 'Q': + case 'X': + Microcode_Termination (TERM_EXIT); + /*NOTREACHED*/ + + case 'S': + sleep (60); + /* fall through */ + + case 'R': + default: + break; + } + } + return (result); +} + +#define DEFINE_LONG_VERSION(long_name, name, rettype, type1, type2) \ +long \ +DEFUN (long_name, (fd, param1, param2), \ + int fd AND \ + long param1 AND \ + long param2) \ +{ \ + extern rettype EXFUN (name, (int, type1, type2)); \ + \ + return ((long) (name (fd, ((type1) param1), ((type2) param2)))); \ +} + +DEFINE_LONG_VERSION(long_lseek, lseek, long, long, int) +DEFINE_LONG_VERSION(long_read, read, int, char *, int) +DEFINE_LONG_VERSION(long_write, write, int, char *, int) + void DEFUN (dump_buffer, (from, position, nbuffers, name, success), SCHEME_OBJECT *from AND @@ -287,37 +427,37 @@ DEFUN (dump_buffer, (from, position, nbuffers, name, success), char *name AND Boolean *success) { - long bytes_written; - - if ((current_disk_position != *position) && - ((lseek (gc_file, *position, 0)) == -1)) - { - if (success == NULL) - { - fprintf (stderr, - "\nCould not position GC file to write the %s buffer.\n", - name); - Microcode_Termination (TERM_EXIT); - /*NOTREACHED*/ - } - *success = false; + long total_bytes_to_write, bytes_to_write, bytes_written; + char *membuf; + + if ((current_disk_position != *position) + && ((gc_file_operation (long_lseek, *position, 0, + success, name, "\ +\nCould not position GC file to write the %s buffer (errno = %s).\n")) + == -1)) return; - } - if ((bytes_written = - (write (gc_file, from, (nbuffers * GC_BUFFER_BYTES)))) - == -1) + + total_bytes_to_write = (nbuffers * GC_BUFFER_BYTES); + bytes_to_write = total_bytes_to_write; + membuf = ((char *) from); + + while ((bytes_to_write > 0) + && ((bytes_written + = (gc_file_operation (long_write, ((long) membuf), bytes_to_write, + success, name, "\ +\nCould not write out the %s buffer (errno = %s).\n"))) + != bytes_to_write)) { - if (success == NULL) - { - fprintf (stderr, "\nCould not write out the %s buffer.\n", name); - Microcode_Termination (TERM_EXIT); - /*NOTREACHED*/ - } - *success = false; - return; + if (bytes_written == -1) + return; + + /* Short write, continue. */ + + membuf += bytes_written; + bytes_to_write -= bytes_written; } - *position += bytes_written; + *position += total_bytes_to_write; current_disk_position = *position; return; } @@ -329,25 +469,42 @@ DEFUN (load_buffer, (position, to, nbytes, name), long nbytes AND char *name) { - long bytes_read; + long bytes_to_read, bytes_read; + char *membuf; if (current_disk_position != position) { - if ((lseek (gc_file, position, 0)) == -1) - { - fprintf (stderr, "\nCould not position GC file to read %s.\n", name); - Microcode_Termination (TERM_EXIT); - /*NOTREACHED*/ - } + (void) (gc_file_operation (long_lseek, position, 0, + ((Boolean *) NULL), name, "\ +Could not position GC file to read %s (errno = %s).\n")); current_disk_position = position; } - if ((bytes_read = (read (gc_file, to, nbytes))) != nbytes) + + bytes_to_read = nbytes; + membuf = ((char *) to); + + while ((bytes_to_read > 0) + && ((bytes_read + = (gc_file_operation (long_read, ((long) membuf), bytes_to_read, + ((Boolean *) NULL), name, "\ +\nCould not read into %s (errno = %s).\n"))) + != bytes_to_read)) { - fprintf (stderr, "\nCould not read into %s.\n", name); - Microcode_Termination (TERM_EXIT); - /*NOTREACHED*/ + if (bytes_read <= 0) + { + fprintf (stderr, + "\nInconsistency: data to be read into %s has disappeared!\n", + name); + Microcode_Termination (TERM_EXIT); + } + + /* Short read, continue. */ + + membuf += bytes_read; + bytes_to_read -= bytes_read; } - current_disk_position += bytes_read; + + current_disk_position += nbytes; return; } @@ -424,7 +581,8 @@ DEFUN (extend_scan_buffer, (to_where, current_free), new_scan_position = (scan_position + GC_BUFFER_BYTES); /* Is there overlap?, ie. is the next bufferfull the one cached - in the free pointer window? */ + in the free pointer window? + */ if (new_scan_position == free_position) { @@ -479,10 +637,13 @@ DEFUN (end_scan_buffer_extension, (to_relocate), char *to_relocate) { *dest++ = *source++; } - load_buffer ((scan_position + GC_BUFFER_OVERLAP_BYTES), - dest, - GC_BUFFER_REMAINDER_BYTES, - "the scan buffer"); + if (GC_BUFFER_REMAINDER_BYTES != 0) + { + load_buffer ((scan_position + GC_BUFFER_OVERLAP_BYTES), + dest, + GC_BUFFER_REMAINDER_BYTES, + "the scan buffer"); + } *scan_buffer_top = (MAKE_POINTER_OBJECT (TC_BROKEN_HEART, scan_buffer_top)); } @@ -491,34 +652,43 @@ DEFUN (end_scan_buffer_extension, (to_relocate), char *to_relocate) fast char *source, *dest, *limit; source = ((char *) scan_buffer_top); - dest = ((scan_position == free_position) ? - ((char *) free_buffer_bottom) : - ((char *) scan_buffer_bottom)); - limit = &source[extension_overlap_length]; - result = &dest[to_relocate - source]; + limit = (source + extension_overlap_length); - while (source < limit) - { - *dest++ = *source++; - } if (scan_position == free_position) { /* There was overlap, and there still is. */ + dest = ((char *) free_buffer_bottom); scan_buffer_bottom = free_buffer_bottom; scan_buffer_top = free_buffer_top; + } else { /* There was overlap, but there no longer is. */ - load_buffer ((scan_position + extension_overlap_length), + dest = ((char *) scan_buffer_bottom); + + /* The following reads the old overlapped data, but will be aligned. + The garbage read will be overwritten with the goodies below. + */ + + load_buffer (scan_position, ((SCHEME_OBJECT *) dest), - (GC_BUFFER_BYTES - extension_overlap_length), + GC_BUFFER_BYTES, "the scan buffer"); + } + + result = (dest + (to_relocate - source)); + + while (source < limit) + { + *dest++ = *source++; + } + + if (scan_position != free_position) *scan_buffer_top = (MAKE_POINTER_OBJECT (TC_BROKEN_HEART, scan_buffer_top)); - } } extension_overlap_p = false; return (result); @@ -577,11 +747,33 @@ DEFUN (dump_and_reset_free_buffer, (overflow, success), void DEFUN (dump_free_directly, (from, nbuffers, success), - SCHEME_OBJECT *from AND - long nbuffers AND + fast SCHEME_OBJECT *from AND + fast long nbuffers AND Boolean *success) { - dump_buffer (from, &free_position, nbuffers, "free", success); + if (can_dump_directly_p || (ALIGNED_TO_GC_BUFFER_P (from))) + { + dump_buffer (from, &free_position, nbuffers, "free", success); + } + else + { + /* We are writing to a raw (character) device special file, + and writes must be aligned. + We don't know the real alignment size, we'll use the GC buffer size. + This assumes that the free buffer has no valid data, so it can be + used as scratch. + */ + + while ((--nbuffers) >= 0) + { + fast SCHEME_OBJECT *to, *bufend; + + for (to = free_buffer_bottom, bufend = free_buffer_top; to != bufend; ) + *to++ = *from++; + + dump_buffer (free_buffer_bottom, &free_position, 1, "free", success); + } + } return; } @@ -755,10 +947,21 @@ DEFUN (GC, (initial_weak_chain), SCHEME_OBJECT initial_weak_chain) { SCHEME_OBJECT *Root, *Result, *end_of_constant_area, - The_Precious_Objects, *Root2, *free_buffer; + The_Precious_Objects, *Root2, *free_buffer, *block_start; free_buffer = (initialize_free_buffer ()); Free = Heap_Bottom; + block_start = ((SCHEME_OBJECT *) (ALIGN_DOWN_TO_GC_BUFFER (Free))); + if (block_start != Free) + { + /* This assumes that the space between block_start and + Heap_Bottom is not used at all. Otherwise it won't be + correctly preserved. + */ + + free_buffer += (Free - block_start); + } + SET_MEMTOP (Heap_Top - GC_Reserve); Weak_Chain = initial_weak_chain; @@ -799,7 +1002,9 @@ DEFUN (GC, (initial_weak_chain), SCHEME_OBJECT initial_weak_chain) /*NOTREACHED*/ } - Result = GCLoop(initialize_scan_buffer(), &free_buffer, &Free); + Result = (GCLoop (((initialize_scan_buffer ()) + + (Heap_Bottom - block_start)), + &free_buffer, &Free)); if (free_buffer != Result) { fprintf (stderr, "\nGC-1: Heap Scan ended too early.\n"); @@ -828,8 +1033,9 @@ DEFUN (GC, (initial_weak_chain), SCHEME_OBJECT initial_weak_chain) /* Load new space into memory. */ - load_buffer (0, Heap_Bottom, - ((Free - Heap_Bottom) * sizeof(SCHEME_OBJECT)), + load_buffer (0, block_start, + ((GC_BUFFER_BLOCK (Free - block_start)) + * sizeof(SCHEME_OBJECT)), "new space"); /* Make the microcode registers point to the copies in new-space. */ diff --git a/v7/src/microcode/bchpur.c b/v7/src/microcode/bchpur.c index 850901a4f..7ceab39f0 100644 --- a/v7/src/microcode/bchpur.c +++ b/v7/src/microcode/bchpur.c @@ -1,6 +1,6 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchpur.c,v 9.53 1991/05/05 00:45:30 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchpur.c,v 9.54 1991/09/07 01:06:53 jinx Exp $ Copyright (c) 1987-91 Massachusetts Institute of Technology @@ -398,12 +398,21 @@ DEFUN (purify, (object, flag), SCHEME_OBJECT object AND SCHEME_OBJECT flag) { - long length, pure_length; - SCHEME_OBJECT value, *Result, *free_buffer, *block_start; + long length, pure_length, delta; + SCHEME_OBJECT value, *result, *free_buffer, *old_free, *block_start; Weak_Chain = EMPTY_LIST; free_buffer = (initialize_free_buffer ()); - block_start = Free_Constant; + old_free = Free_Constant; + block_start = ((SCHEME_OBJECT *) (ALIGN_DOWN_TO_GC_BUFFER (old_free))); + delta = (old_free - block_start); + if (delta != 0) + { + fast SCHEME_OBJECT *ptr, *ptrend; + + for (ptr = block_start, ptrend = old_free; ptr != ptrend; ) + *free_buffer++ = *ptr++; + } Free_Constant += 2; *free_buffer++ = SHARP_F; /* Pure block header. */ @@ -416,17 +425,17 @@ DEFUN (purify, (object, flag), if (flag == SHARP_T) { - Result = (purifyloop ((initialize_scan_buffer()), + result = (purifyloop (((initialize_scan_buffer()) + delta), &free_buffer, &Free_Constant, PURE_COPY)); - if (Result != free_buffer) + if (result != free_buffer) { gc_death (TERM_BROKEN_HEART, "purify: pure copy ended too early", - Result, free_buffer); + result, free_buffer); /*NOTREACHED*/ } - pure_length = ((Free_Constant - block_start) + 1); + pure_length = ((Free_Constant - old_free) + 1); } else { @@ -443,29 +452,31 @@ DEFUN (purify, (object, flag), if (flag == SHARP_T) { - Result = (purifyloop ((initialize_scan_buffer ()), + result = (purifyloop (((initialize_scan_buffer ()) + delta), &free_buffer, &Free_Constant, CONSTANT_COPY)); } else - Result = - (GCLoop ((initialize_scan_buffer()), &free_buffer, &Free_Constant)); - if (Result != free_buffer) + result = + (GCLoop (((initialize_scan_buffer()) + delta), + &free_buffer, + &Free_Constant)); + + if (result != free_buffer) { gc_death (TERM_BROKEN_HEART, "purify: constant copy ended too early", - Result, free_buffer); + result, free_buffer); /*NOTREACHED*/ } Free_Constant += 2; - length = (Free_Constant - block_start); + length = (Free_Constant - old_free); *free_buffer++ = (MAKE_OBJECT (TC_MANIFEST_SPECIAL_NM_VECTOR, 1)); *free_buffer++ = (MAKE_OBJECT (END_OF_BLOCK, (length - 1))); if (free_buffer >= free_buffer_top) { - free_buffer = purify_header_overflow (free_buffer); + free_buffer = (purify_header_overflow (free_buffer)); } - end_transport (NULL); if (!(TEST_CONSTANT_TOP (Free_Constant))) @@ -474,11 +485,13 @@ DEFUN (purify, (object, flag), /*NOTREACHED*/ } - load_buffer (0, block_start, - (length * sizeof(SCHEME_OBJECT)), + load_buffer (0, + block_start, + ((GC_BUFFER_BLOCK (Free_Constant - block_start)) + * (sizeof (SCHEME_OBJECT))), "into constant space"); - *block_start++ = (MAKE_OBJECT (TC_MANIFEST_SPECIAL_NM_VECTOR, pure_length)); - *block_start = (MAKE_OBJECT (PURE_PART, (length - 1))); + *old_free++ = (MAKE_OBJECT (TC_MANIFEST_SPECIAL_NM_VECTOR, pure_length)); + *old_free = (MAKE_OBJECT (PURE_PART, (length - 1))); SET_CONSTANT_TOP (); GC (Weak_Chain); return (SHARP_T); -- 2.25.1