/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchdmp.c,v 9.63 1992/03/26 11:01:14 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchdmp.c,v 9.64 1992/05/04 18:32:03 jinx Exp $
-Copyright (c) 1987-92 Massachusetts Institute of Technology
+Copyright (c) 1987-1992 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
return size;
}
-void
+char *
DEFUN (mktemp, (fname), unsigned char * fname)
-{ /* Should call tmpname */
+{
+ /* Should call tmpname */
+
return;
}
#define fasdump_linked_operator() \
{ \
Scan = ((SCHEME_OBJECT *) (word_ptr)); \
- EXTRACT_OPERATOR_LINKAGE_ADDRESS (Temp, Scan); \
+ BCH_EXTRACT_OPERATOR_LINKAGE_ADDRESS (Temp, Scan); \
fasdump_compiled_entry (); \
- STORE_OPERATOR_LINKAGE_ADDRESS (Temp, Scan); \
+ BCH_STORE_OPERATOR_LINKAGE_ADDRESS (Temp, Scan); \
}
#define fasdump_manifest_closure() \
{ \
Scan = ((SCHEME_OBJECT *) (word_ptr)); \
- EXTRACT_CLOSURE_ENTRY_ADDRESS (Temp, Scan); \
+ BCH_EXTRACT_CLOSURE_ENTRY_ADDRESS (Temp, Scan); \
fasdump_compiled_entry (); \
- STORE_CLOSURE_ENTRY_ADDRESS (Temp, Scan); \
+ BCH_STORE_CLOSURE_ENTRY_ADDRESS (Temp, Scan); \
}
\f
#if (defined(_HPUX) && (_HPUX_VERSION >= 80)) || defined(_SYSV4)
fast char *word_ptr, *next_ptr;
long overflow;
- count = (READ_OPERATOR_LINKAGE_COUNT (Temp));
word_ptr = (FIRST_OPERATOR_LINKAGE_ENTRY (Scan));
+ if (word_ptr > ((char *) scan_buffer_top))
+ {
+ overflow = (word_ptr - ((char *) Scan));
+ extend_scan_buffer (word_ptr, To);
+ BCH_START_OPERATOR_RELOCATION (Scan);
+ word_ptr = (end_scan_buffer_extension (word_ptr));
+ Scan = ((SCHEME_OBJECT *) (word_ptr - overflow));
+ }
+ else
+ BCH_START_OPERATOR_RELOCATION (Scan);
+
+ count = (READ_OPERATOR_LINKAGE_COUNT (Temp));
overflow = ((END_OPERATOR_LINKAGE_AREA (Scan, count)) -
scan_buffer_top);
{
if (next_ptr > ((char *) scan_buffer_top))
{
- extend_scan_buffer (((char *) next_ptr), To);
+ extend_scan_buffer (next_ptr, To);
fasdump_linked_operator ();
- next_ptr = ((char *)
- (end_scan_buffer_extension ((char *) next_ptr)));
+ next_ptr = (end_scan_buffer_extension (next_ptr));
overflow -= gc_buffer_size;
}
else
- {
fasdump_linked_operator ();
- }
}
Scan = (scan_buffer_top + overflow);
+ BCH_END_OPERATOR_RELOCATION (Scan);
break;
}
case TC_MANIFEST_CLOSURE:
{
fast long count;
- fast char *word_ptr;
- char *end_ptr;
+ fast char * word_ptr;
+ char * end_ptr;
Scan += 1;
+
/* Is there enough space to read the count? */
- if ((((char *) Scan) + (2 * (sizeof (format_word)))) >
- ((char *) scan_buffer_top))
+
+ end_ptr = (((char *) Scan) + (2 * (sizeof (format_word))));
+ if (end_ptr > ((char *) scan_buffer_top))
{
long dw;
- char *header_end;
- header_end = (((char *) Scan) + (2 * (sizeof (format_word))));
- extend_scan_buffer (((char *) header_end), To);
+ extend_scan_buffer (end_ptr, To);
+ BCH_START_CLOSURE_RELOCATION (Scan - 1);
count = (MANIFEST_CLOSURE_COUNT (Scan));
word_ptr = (FIRST_MANIFEST_CLOSURE_ENTRY (Scan));
- dw = (word_ptr - header_end);
- header_end = ((char *)
- (end_scan_buffer_extension ((char *) header_end)));
- word_ptr = (header_end + dw);
- Scan = ((SCHEME_OBJECT *)
- (header_end - (2 * (sizeof (format_word)))));
+ dw = (word_ptr - end_ptr);
+ end_ptr = (end_scan_buffer_extension (end_ptr));
+ word_ptr = (end_ptr + dw);
+ Scan = ((SCHEME_OBJECT *) (end_ptr - (2 * (sizeof (format_word)))));
}
else
{
+ BCH_START_CLOSURE_RELOCATION (Scan - 1);
count = (MANIFEST_CLOSURE_COUNT (Scan));
word_ptr = (FIRST_MANIFEST_CLOSURE_ENTRY (Scan));
}
{
if ((CLOSURE_ENTRY_END (word_ptr)) > ((char *) scan_buffer_top))
{
- char *entry_end;
+ char * entry_end;
long de, dw;
entry_end = (CLOSURE_ENTRY_END (word_ptr));
de = (end_ptr - entry_end);
dw = (entry_end - word_ptr);
- extend_scan_buffer (((char *) entry_end), To);
+ extend_scan_buffer (entry_end, To);
fasdump_manifest_closure ();
- entry_end = ((char *)
- (end_scan_buffer_extension ((char *) entry_end)));
+ entry_end = (end_scan_buffer_extension (entry_end));
word_ptr = (entry_end - dw);
end_ptr = (entry_end + de);
}
else
- {
fasdump_manifest_closure ();
- }
}
Scan = ((SCHEME_OBJECT *) (end_ptr));
+ BCH_END_CLOSURE_RELOCATION (Scan);
break;
}
\f
dumped_object = Free;
Free += 1;
\f
- value = dumploop (((initialize_scan_buffer ()) + FASL_HEADER_LENGTH),
+ value = dumploop (((initialize_scan_buffer ((SCHEME_OBJECT *) NULL))
+ + FASL_HEADER_LENGTH),
&free_buffer, &Free);
if (value != PRIM_DONE)
{
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchgcc.h,v 9.44 1992/02/29 19:36:55 mhwu Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchgcc.h,v 9.45 1992/05/04 18:31:22 jinx Exp $
Copyright (c) 1987-1992 Massachusetts Institute of Technology
#ifndef DOS386
#include <sys/param.h>
#endif
+\f
+#ifndef BCH_START_CLOSURE_RELOCATION
+# define BCH_START_CLOSURE_RELOCATION(scan) do { } while (0)
+#endif
+
+#ifndef BCH_END_CLOSURE_RELOCATION
+# define BCH_END_CLOSURE_RELOCATION(scan) do { } while (0)
+#endif
+
+#ifndef BCH_EXTRACT_CLOSURE_ENTRY_ADDRESS
+# define BCH_EXTRACT_CLOSURE_ENTRY_ADDRESS EXTRACT_CLOSURE_ENTRY_ADDRESS
+#endif
+
+#ifndef BCH_STORE_CLOSURE_ENTRY_ADDRESS
+# define BCH_STORE_CLOSURE_ENTRY_ADDRESS STORE_CLOSURE_ENTRY_ADDRESS
+#endif
+
+
+#ifndef BCH_START_OPERATOR_RELOCATION
+# define BCH_START_OPERATOR_RELOCATION(scan) do { } while (0)
+#endif
+
+#ifndef BCH_END_OPERATOR_RELOCATION
+# define BCH_END_OPERATOR_RELOCATION(scan) do { } while (0)
+#endif
+
+#ifndef BCH_EXTRACT_OPERATOR_LINKAGE_ADDRESS
+# define BCH_EXTRACT_OPERATOR_LINKAGE_ADDRESS EXTRACT_OPERATOR_LINKAGE_ADDRESS
+#endif
+
+#ifndef BCH_STORE_OPERATOR_LINKAGE_ADDRESS
+# define BCH_STORE_OPERATOR_LINKAGE_ADDRESS STORE_OPERATOR_LINKAGE_ADDRESS
+#endif
+
extern char * EXFUN (error_name, (int));
* free_buffer_top,
* free_buffer_bottom,
* weak_pair_stack_ptr,
- * weak_pair_stack_limit;
+ * weak_pair_stack_limit,
+ * virtual_scan_pointer;
extern SCHEME_OBJECT
* EXFUN (GCLoop, (SCHEME_OBJECT *, SCHEME_OBJECT **, SCHEME_OBJECT **)),
* EXFUN (dump_and_reset_free_buffer, (long, Boolean *)),
* EXFUN (dump_free_directly, (SCHEME_OBJECT *, long, Boolean *)),
* EXFUN (initialize_free_buffer, (void)),
- * EXFUN (initialize_scan_buffer, (void));
+ * EXFUN (initialize_scan_buffer, (SCHEME_OBJECT *)),
+ EXFUN (read_newspace_address, (SCHEME_OBJECT *));
extern void
EXFUN (GC, (int)),
\f
/* Some utility macros */
-#define copy_cell() \
-{ \
- *To++ = *Old; \
-}
+/* These work even when scan/addr point to constant space
+ because initialize_free_buffer (in bchmmg.c) cleverly initializes
+ scan_buffer_bottom, scan_buffer_top, and virtual_scan_pointer
+ so that the operations below do the right thing.
-#define copy_pair() \
+ These depend on (scan) and (addr) always pointing past the current
+ Scan pointer!
+ */
+
+#define SCAN_POINTER_TO_NEWSPACE_ADDRESS(scan) \
+ (((char *) virtual_scan_pointer) \
+ + (((char *) (scan)) - ((char *) scan_buffer_bottom)))
+
+#define READ_NEWSPACE_ADDRESS(loc, addr) do \
{ \
- *To++ = *Old++; \
- *To++ = *Old; \
-}
+ SCHEME_OBJECT * _addr, * _scaddr; \
+ \
+ _addr = (addr); \
+ _scaddr = (scan_buffer_bottom + ((_addr) - virtual_scan_pointer)); \
+ \
+ if ((_scaddr >= scan_buffer_bottom) && (_scaddr < scan_buffer_top)) \
+ (loc) = (* _scaddr); \
+ else if ((_addr >= Constant_Space) && (_addr < Free_Constant)) \
+ (loc) = (* _addr); \
+ else \
+ (loc) = (read_newspace_address (_addr)); \
+} while (0)
#define copy_weak_pair() \
{ \
weak_car = (*Old++); \
car_type = (OBJECT_TYPE (weak_car)); \
if ((car_type == TC_NULL) \
- || ((OBJECT_ADDRESS (weak_car)) >= Constant_Space)) \
+ || ((OBJECT_ADDRESS (weak_car)) >= Low_Constant)) \
{ \
*To++ = weak_car; \
*To++ = (*Old); \
Weak_Chain = Temp; \
} \
}
+\f
+#define copy_cell() \
+{ \
+ *To++ = *Old; \
+}
+
+#define copy_pair() \
+{ \
+ *To++ = *Old++; \
+ *To++ = *Old; \
+}
#define copy_triple() \
{ \
*To++ = *Old++; \
*To++ = *Old; \
}
-\f
+
/* 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.
#define copy_vector(success) \
{ \
- SCHEME_OBJECT *Saved_Scan = Scan; \
+ SCHEME_OBJECT * Saved_Scan = Scan; \
unsigned long real_length = (1 + (OBJECT_DATUM (*Old))); \
\
To_Address += real_length; \
copy_code; \
To_Address += (length); \
if (To >= free_buffer_top) \
- { \
To = (dump_and_reset_free_buffer ((To - free_buffer_top), NULL)); \
- } \
}
#define relocate_normal_end() \
relocate_typeless_end (); \
}
\f
-#define relocate_compiled_entry(in_gc_p) \
-do { \
+/* The following macro uses do-while to trap the use of continue.
+ On certain machines, the operator/closure need to be updated
+ since the only addressing mode is pc-relative and the object
+ containing the reference may not be at the same address as it was
+ last time.
+ In addition, we may be in the middle of a scan-buffer extension,
+ which we need to finish.
+ */
+
+#define relocate_compiled_entry(in_gc_p) do \
+{ \
Old = (OBJECT_ADDRESS (Temp)); \
if (Old >= Low_Constant) \
continue; \
\
New_Address = (MAKE_BROKEN_HEART (To_Address)); \
copy_vector (NULL); \
- *Saved_Old = New_Address; \
+ * Saved_Old = New_Address; \
Temp = (RELOCATE_COMPILED (Temp, \
(OBJECT_ADDRESS (New_Address)), \
Saved_Old)); \
#define relocate_linked_operator(in_gc_p) \
{ \
Scan = ((SCHEME_OBJECT *) (word_ptr)); \
- EXTRACT_OPERATOR_LINKAGE_ADDRESS (Temp, Scan); \
+ BCH_EXTRACT_OPERATOR_LINKAGE_ADDRESS (Temp, Scan); \
relocate_compiled_entry (in_gc_p); \
- STORE_OPERATOR_LINKAGE_ADDRESS (Temp, Scan); \
+ BCH_STORE_OPERATOR_LINKAGE_ADDRESS (Temp, Scan); \
}
#define relocate_manifest_closure(in_gc_p) \
{ \
Scan = ((SCHEME_OBJECT *) (word_ptr)); \
- EXTRACT_CLOSURE_ENTRY_ADDRESS (Temp, Scan); \
+ BCH_EXTRACT_CLOSURE_ENTRY_ADDRESS (Temp, Scan); \
relocate_compiled_entry (in_gc_p); \
- STORE_CLOSURE_ENTRY_ADDRESS (Temp, Scan); \
+ BCH_STORE_CLOSURE_ENTRY_ADDRESS (Temp, Scan); \
}
#endif /* _BCHGCC_H_INCLUDED */
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchgcl.c,v 9.43 1991/10/29 22:35:51 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchgcl.c,v 9.44 1992/05/04 18:31:41 jinx Exp $
-Copyright (c) 1987-1991 Massachusetts Institute of Technology
+Copyright (c) 1987-1992 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
/* Operator linkage */
fast long count;
- fast char *word_ptr, *next_ptr;
+ fast char * word_ptr, * next_ptr;
long overflow;
- count = (READ_OPERATOR_LINKAGE_COUNT (Temp));
word_ptr = (FIRST_OPERATOR_LINKAGE_ENTRY (Scan));
+ if (word_ptr > ((char *) scan_buffer_top))
+ {
+ overflow = (word_ptr - ((char *) Scan));
+ extend_scan_buffer (word_ptr, To);
+ BCH_START_OPERATOR_RELOCATION (Scan);
+ word_ptr = (end_scan_buffer_extension (word_ptr));
+ Scan = ((SCHEME_OBJECT *) (word_ptr - overflow));
+ }
+ else
+ BCH_START_OPERATOR_RELOCATION (Scan);
+
+ count = (READ_OPERATOR_LINKAGE_COUNT (Temp));
overflow = ((END_OPERATOR_LINKAGE_AREA (Scan, count)) -
scan_buffer_top);
{
if (next_ptr > ((char *) scan_buffer_top))
{
- extend_scan_buffer ((char *) next_ptr, To);
+ extend_scan_buffer (next_ptr, To);
relocate_linked_operator (true);
- next_ptr = ((char *)
- (end_scan_buffer_extension ((char *) next_ptr)));
+ next_ptr = (end_scan_buffer_extension (next_ptr));
overflow -= gc_buffer_size;
}
else
- {
relocate_linked_operator (true);
- }
}
Scan = (scan_buffer_top + overflow);
+ BCH_END_OPERATOR_RELOCATION (Scan);
break;
}
case TC_MANIFEST_CLOSURE:
{
fast long count;
- fast char *word_ptr;
- char *end_ptr;
+ fast char * word_ptr;
+ char * end_ptr;
Scan += 1;
+
/* Is there enough space to read the count? */
- if ((((char *) Scan) + (2 * (sizeof (format_word)))) >
- ((char *) scan_buffer_top))
+
+ end_ptr = (((char *) Scan) + (2 * (sizeof (format_word))));
+ if (end_ptr > ((char *) scan_buffer_top))
{
long dw;
- char *header_end;
- header_end = (((char *) Scan) + (2 * (sizeof (format_word))));
- extend_scan_buffer (((char *) header_end), To);
+ extend_scan_buffer (end_ptr, To);
+ BCH_START_CLOSURE_RELOCATION (Scan - 1);
count = (MANIFEST_CLOSURE_COUNT (Scan));
word_ptr = (FIRST_MANIFEST_CLOSURE_ENTRY (Scan));
- dw = (word_ptr - header_end);
- header_end = ((char *)
- (end_scan_buffer_extension ((char *) header_end)));
- word_ptr = (header_end + dw);
- Scan = ((SCHEME_OBJECT *)
- (header_end - (2 * (sizeof (format_word)))));
+ dw = (word_ptr - end_ptr);
+ end_ptr = (end_scan_buffer_extension (end_ptr));
+ word_ptr = (end_ptr + dw);
+ Scan = ((SCHEME_OBJECT *) (end_ptr - (2 * (sizeof (format_word)))));
}
else
{
+ BCH_START_CLOSURE_RELOCATION (Scan - 1);
count = (MANIFEST_CLOSURE_COUNT (Scan));
word_ptr = (FIRST_MANIFEST_CLOSURE_ENTRY (Scan));
}
{
if ((CLOSURE_ENTRY_END (word_ptr)) > ((char *) scan_buffer_top))
{
- char *entry_end;
+ char * entry_end;
long de, dw;
entry_end = (CLOSURE_ENTRY_END (word_ptr));
de = (end_ptr - entry_end);
dw = (entry_end - word_ptr);
- extend_scan_buffer (((char *) entry_end), To);
- relocate_manifest_closure(true);
- entry_end = ((char *)
- (end_scan_buffer_extension ((char *) entry_end)));
+ extend_scan_buffer (entry_end, To);
+ relocate_manifest_closure (true);
+ entry_end = (end_scan_buffer_extension (entry_end));
word_ptr = (entry_end - dw);
end_ptr = (entry_end + de);
}
else
- {
relocate_manifest_closure (true);
- }
}
Scan = ((SCHEME_OBJECT *) (end_ptr));
+ BCH_END_CLOSURE_RELOCATION (Scan);
break;
}
\f
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchmmg.c,v 9.73 1992/03/26 04:17:53 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchmmg.c,v 9.74 1992/05/04 18:31:32 jinx Exp $
-Copyright (c) 1987-92 Massachusetts Institute of Technology
+Copyright (c) 1987-1992 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
SCHEME_OBJECT
* scan_buffer_top, * scan_buffer_bottom,
- * free_buffer_top, * free_buffer_bottom;
+ * free_buffer_top, * free_buffer_bottom,
+ * virtual_scan_pointer;
+
+static SCHEME_OBJECT
+ * virtual_scan_base;
static char
* gc_file_name = ((char *) NULL),
static Boolean
can_dump_directly_p,
- extension_overlap_p;
+ extension_overlap_p,
+ scan_buffer_extended_p;
static long
scan_position,
(void) (mktemp (gc_file_name));
flags = GC_FILE_FLAGS;
- gc_file_start_position = option_gc_start_position;
+ gc_file_start_position = (ALIGN_UP_TO_IO_PAGE (option_gc_start_position));
gc_file_end_position = option_gc_end_position;
if (gc_file_end_position == -1)
gc_file_end_position = (gc_file_start_position + size);
+ gc_file_end_position = (ALIGN_DOWN_TO_IO_PAGE (gc_file_end_position));
+ if (gc_file_end_position < gc_file_start_position)
+ {
+ fprintf (stderr, "%s (open_gc_file): file bounds are inconsistent.\n",
+ scheme_program_name);
+ fprintf (stderr, "\trequested start = 0x%lx;\taligned start = 0x%lx.\n",
+ option_gc_start_position, gc_file_start_position);
+ fprintf (stderr, "\trequested end = 0x%lx;\taligned end = 0x%lx.\n",
+ option_gc_end_position, gc_file_end_position);
+ termination_open_gc_file (((char *) NULL), ((char *) NULL));
+ }
\f
if ((stat (gc_file_name, &file_info)) == -1)
{
}
new_buffer_overlap_bytes = IO_PAGE_SIZE;
- new_extra_buffer_size = (new_buffer_overlap_bytes / (sizeof (SCHEME_OBJECT)));
- if ((new_extra_buffer_size * (sizeof (SCHEME_OBJECT))) != new_buffer_overlap_bytes)
+ new_extra_buffer_size
+ = (new_buffer_overlap_bytes / (sizeof (SCHEME_OBJECT)));
+ if ((new_extra_buffer_size * (sizeof (SCHEME_OBJECT)))
+ != new_buffer_overlap_bytes)
{
fprintf (stderr, " %s (Setup_Memory): improper IO_PAGE_SIZE.\n",
scheme_program_name);
diff = ((free_position - pre_read_position) >> gc_buffer_byte_shift);
if (diff >= read_overlap)
DUMP_BUFFER (free_buffer, free_position, gc_buffer_bytes,
- success, "the free buffer");
+ success, "the free buffer");
else
{
ENQUEUE_READY_BUFFER (free_buffer, free_position, gc_buffer_bytes);
static void
DEFUN (reload_scan_buffer, (skip), int skip)
{
+
scan_position += (skip << gc_buffer_byte_shift);
+ virtual_scan_pointer += (skip << gc_buffer_shift);
if ((read_overlap > 0) && (scan_position > pre_read_position))
abort_pre_reads ();
in the free pointer window?
*/
+ scan_buffer_extended_p = true;
dest = ((char *) scan_buffer_top);
extension_overlap_length = (to_where - dest);
extension_overlap_p = (new_scan_position == free_position);
DUMP_BUFFER (scan_buffer, scan_position, gc_buffer_bytes,
((Boolean *) NULL), "the scan buffer");
scan_position += gc_buffer_bytes;
+ virtual_scan_pointer += gc_buffer_size;
scan_buffer = (OTHER_BUFFER (free_buffer));
scan_buffer_bottom = (GC_BUFFER_BOTTOM (scan_buffer));
DUMP_BUFFER (scan_buffer, scan_position, gc_buffer_bytes,
((Boolean *) NULL), "the scan buffer");
scan_position += gc_buffer_bytes;
+ virtual_scan_pointer += gc_buffer_size;
scan_buffer = next_scan_buffer;
next_scan_buffer = NULL;
(MAKE_POINTER_OBJECT (TC_BROKEN_HEART, scan_buffer_top));
schedule_pre_reads ();
}
+ scan_buffer_extended_p = false;
return (result);
}
free_buffer = (INITIAL_FREE_BUFFER ());
free_buffer_bottom = (GC_BUFFER_BOTTOM (free_buffer));
free_buffer_top = (GC_BUFFER_TOP (free_buffer));
+ virtual_scan_pointer = NULL;
scan_position = -1L;
scan_buffer = NULL;
scan_buffer_bottom = NULL;
/* Force first write to do an lseek. */
gc_file_current_position = -1;
next_scan_buffer = NULL;
+ scan_buffer_extended_p = false;
extension_overlap_p = false;
extension_overlap_length = 0;
return (free_buffer_bottom);
}
\f
SCHEME_OBJECT *
-DEFUN_VOID (initialize_scan_buffer)
+DEFUN (initialize_scan_buffer, (block_start), SCHEME_OBJECT * block_start)
{
+ virtual_scan_base = block_start;
+ virtual_scan_pointer = virtual_scan_base;
scan_position = gc_file_start_position;
scan_buffer = (INITIAL_SCAN_BUFFER ());
scan_buffer_bottom = (GC_BUFFER_BOTTOM (scan_buffer));
DUMP_BUFFER (scan_buffer, scan_position, gc_buffer_bytes,
success, "the final scan buffer");
scan_position += gc_buffer_bytes;
+ virtual_scan_pointer += gc_buffer_size;
free_position = scan_position;
END_TRANSPORT_HOOK ();
STATISTICS_PRINT (2, "after transport");
position = (obj_addr - aligned_heap);
position = (position >> gc_buffer_shift);
position = (position << gc_buffer_byte_shift);
+ position += gc_file_start_position;
+
if ((position != last_position)
&& (position != weak_pair_buffer_position))
{
return;
}
\f
+/* The following code depends on being called in between copying objects,
+ so that the "free" pointer points to the middle of the free buffer,
+ and thus the overlap area at the end of the free buffer is available
+ as temporary storage. In addition, because we have not yet moved free,
+ next_scan_buffer has not been set even if we are in the middle of a
+ scan buffer extension.
+ */
+
+SCHEME_OBJECT
+DEFUN (read_newspace_address, (addr), SCHEME_OBJECT * addr)
+{
+ unsigned long position, offset;
+ SCHEME_OBJECT result;
+
+ if ((addr >= Constant_Space) && (addr < Free_Constant))
+ return (* addr);
+
+ position = (addr - virtual_scan_base);
+ offset = (position & gc_buffer_mask);
+ position = (position >> gc_buffer_shift);
+ position = (position << gc_buffer_byte_shift);
+ position += gc_file_start_position;
+
+ if (position > free_position)
+ {
+ fprintf (stderr,
+ "\n%s (read_newspace_address): Reading outside of GC window!\n",
+ scheme_program_name);
+ fprintf (stderr, "\t addr = 0x%lx;\t position = 0x%lx.\n",
+ addr, position);
+ fprintf (stderr, "\tscan_position = 0x%lx;\tfree_position = 0x%lx.\n",
+ scan_position, free_position);
+ fflush (stderr);
+ Microcode_Termination (TERM_EXIT);
+ /*NOTREACHED*/
+ }
+ if (position == scan_position)
+ result = (* (scan_buffer_bottom + offset));
+ else if (position == free_position)
+ result = (* (free_buffer_bottom + offset));
+ else if ((position == (scan_position + 1))
+ && scan_buffer_extended_p
+ && ((read_overlap != 0) || (offset < gc_extra_buffer_size)))
+ {
+ /* Note: we need not worry about the state of extension_overlap_p,
+ because if there is overlap between the scan extension and the free
+ buffer, then (position == free_position) would be true,
+ and that case has already been taken care of.
+ */
+
+ result = ((read_overlap == 0)
+ ? (* (scan_buffer_top + offset))
+ : (* ((GC_BUFFER_BOTTOM (next_scan_buffer)) + offset)));
+ }
+ else if ((read_overlap <= 0) || (position > pre_read_position))
+ {
+ unsigned long position2;
+
+ position = (((char *) addr) - ((char *) virtual_scan_base));
+ position2 = (ALIGN_DOWN_TO_IO_PAGE (position));
+ offset = (position - position2);
+ position2 += gc_file_start_position;
+
+ load_data (position2,
+ ((char *) free_buffer_top),
+ IO_PAGE_SIZE,
+ "a buffer for read_newspace_address",
+ ((Boolean *) NULL));
+ result = (* ((SCHEME_OBJECT *) (((char *) free_buffer_top) + offset)));
+ }
+ else
+ {
+ /* The buffer is pre-read or in the process of being pre-read.
+ Force completion of the read, fetch the location,
+ and re-queue the buffer as ready.
+ */
+
+ LOAD_BUFFER (next_scan_buffer, position, gc_buffer_bytes,
+ "a buffer for read_newspace_address");
+ result = ((GC_BUFFER_BOTTOM (next_scan_buffer)) [offset]);
+ ENQUEUE_READY_BUFFER (next_scan_buffer, position, gc_buffer_bytes);
+ next_scan_buffer = ((struct buffer_info *) NULL);
+ }
+ return (result);
+}
+\f
static void
DEFUN (initialize_new_space_buffer, (chain), SCHEME_OBJECT chain)
{
offset = (position & gc_buffer_mask);
position = (position >> gc_buffer_shift);
position = (position << gc_buffer_byte_shift);
+ position += gc_file_start_position;
+
if (position != weak_pair_buffer_position)
{
flush_new_space_buffer ();
/*NOTREACHED*/
}
- result = (GCLoop (((initialize_scan_buffer ())
+ result = (GCLoop (((initialize_scan_buffer (block_start))
+ (Heap_Bottom - block_start)),
&free_buffer, &Free));
if (free_buffer != result)
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchpur.c,v 9.56 1991/10/29 22:35:22 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchpur.c,v 9.57 1992/05/04 18:31:55 jinx Exp $
-Copyright (c) 1987-91 Massachusetts Institute of Technology
+Copyright (c) 1987-1992 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
fast char *word_ptr, *next_ptr;
long overflow;
- count = (READ_OPERATOR_LINKAGE_COUNT (Temp));
word_ptr = (FIRST_OPERATOR_LINKAGE_ENTRY (Scan));
+ if (word_ptr > ((char *) scan_buffer_top))
+ {
+ overflow = (word_ptr - ((char *) Scan));
+ extend_scan_buffer (word_ptr, To);
+ BCH_START_OPERATOR_RELOCATION (Scan);
+ word_ptr = (end_scan_buffer_extension (word_ptr));
+ Scan = ((SCHEME_OBJECT *) (word_ptr - overflow));
+ }
+ else
+ BCH_START_OPERATOR_RELOCATION (Scan);
+
+ count = (READ_OPERATOR_LINKAGE_COUNT (Temp));
overflow = ((END_OPERATOR_LINKAGE_AREA (Scan, count)) -
scan_buffer_top);
{
if (next_ptr > ((char *) scan_buffer_top))
{
- extend_scan_buffer (((char *) next_ptr), To);
+ extend_scan_buffer (next_ptr, To);
relocate_linked_operator (false);
- next_ptr = ((char *)
- (end_scan_buffer_extension ((char *) next_ptr)));
+ next_ptr = (end_scan_buffer_extension (next_ptr));
overflow -= gc_buffer_size;
}
else
- {
relocate_linked_operator (false);
- }
}
Scan = (scan_buffer_top + overflow);
+ BCH_END_OPERATOR_RELOCATION (Scan);
break;
}
}
{
fast long count;
- fast char *word_ptr;
- char *end_ptr;
+ fast char * word_ptr;
+ char * end_ptr;
Scan += 1;
+
/* Is there enough space to read the count? */
- if ((((char *) Scan) + (2 * (sizeof (format_word)))) >
- ((char *) scan_buffer_top))
+
+ end_ptr = (((char *) Scan) + (2 * (sizeof (format_word))));
+ if (end_ptr > ((char *) scan_buffer_top))
{
long dw;
- char *header_end;
- header_end = (((char *) Scan) + (2 * (sizeof (format_word))));
- extend_scan_buffer (((char *) header_end), To);
+ extend_scan_buffer (end_ptr, To);
+ BCH_START_CLOSURE_RELOCATION (Scan - 1);
count = (MANIFEST_CLOSURE_COUNT (Scan));
word_ptr = (FIRST_MANIFEST_CLOSURE_ENTRY (Scan));
- dw = (word_ptr - header_end);
- header_end = ((char *)
- (end_scan_buffer_extension ((char *) header_end)));
- word_ptr = (header_end + dw);
- Scan = ((SCHEME_OBJECT *)
- (header_end - (2 * (sizeof (format_word)))));
+ dw = (word_ptr - end_ptr);
+ end_ptr = (end_scan_buffer_extension (end_ptr));
+ word_ptr = (end_ptr + dw);
+ Scan = ((SCHEME_OBJECT *) (end_ptr - (2 * (sizeof (format_word)))));
}
else
{
+ BCH_START_CLOSURE_RELOCATION (Scan - 1);
count = (MANIFEST_CLOSURE_COUNT (Scan));
word_ptr = (FIRST_MANIFEST_CLOSURE_ENTRY (Scan));
}
for ( ; ((--count) >= 0);
(word_ptr = (NEXT_MANIFEST_CLOSURE_ENTRY (word_ptr))))
{
- if ((CLOSURE_ENTRY_END(word_ptr)) > ((char *) scan_buffer_top))
+ if ((CLOSURE_ENTRY_END (word_ptr)) > ((char *) scan_buffer_top))
{
- char *entry_end;
+ char * entry_end;
long de, dw;
entry_end = (CLOSURE_ENTRY_END (word_ptr));
de = (end_ptr - entry_end);
dw = (entry_end - word_ptr);
- extend_scan_buffer (((char *) entry_end), To);
+ extend_scan_buffer (entry_end, To);
relocate_manifest_closure (false);
- entry_end = ((char *)
- (end_scan_buffer_extension ((char *) entry_end)));
+ entry_end = (end_scan_buffer_extension (entry_end));
word_ptr = (entry_end - dw);
end_ptr = (entry_end + de);
}
else
- {
relocate_manifest_closure (false);
- }
}
Scan = ((SCHEME_OBJECT *) (end_ptr));
+ BCH_END_CLOSURE_RELOCATION (Scan);
break;
}
\f
if (flag == SHARP_T)
{
- scan_start = ((initialize_scan_buffer ()) + delta);
+ scan_start = ((initialize_scan_buffer (block_start)) + delta);
result = (purifyloop (scan_start, &free_buffer_ptr,
&Free_Constant, PURE_COPY));
if (result != free_buffer_ptr)
if (free_buffer_ptr >= free_buffer_top)
free_buffer_ptr = (purify_header_overflow (free_buffer_ptr));
\f
- scan_start = ((initialize_scan_buffer ()) + delta);
+ scan_start = ((initialize_scan_buffer (block_start)) + delta);
if (flag == SHARP_T)
result = (purifyloop (scan_start, &free_buffer_ptr,
&Free_Constant, CONSTANT_COPY));
*free_buffer_ptr++ = (MAKE_OBJECT (TC_MANIFEST_SPECIAL_NM_VECTOR, 1));
*free_buffer_ptr++ = (MAKE_OBJECT (END_OF_BLOCK, (length - 1)));
if (free_buffer_ptr >= free_buffer_top)
- {
free_buffer_ptr = (purify_header_overflow (free_buffer_ptr));
- }
end_transport (NULL);
if (!(TEST_CONSTANT_TOP (Free_Constant)))
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/cmpintmd/i386.h,v 1.16 1992/04/14 18:40:13 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/cmpintmd/i386.h,v 1.17 1992/05/04 18:31:13 jinx Exp $
Copyright (c) 1992 Massachusetts Institute of Technology
#define PC_ZERO_BITS 0
+/* See the encodings above. */
+
+#define ENTRY_SKIPPED_CHECK_OFFSET 4
+#define ENTRY_PREFIX_LENGTH 3
+
+#define CLOSURE_SKIPPED_CHECK_OFFSET 11
+
+# define COMPILED_CLOSURE_ENTRY_SIZE \
+ ((2 * (sizeof (format_word))) + 6)
+
+# define ADJUST_CLOSURE_AT_CALL(entry_point, location) \
+do { \
+ long magic_constant; \
+ \
+ magic_constant = (* ((long *) (((char *) (entry_point)) + 3))); \
+ (location) = ((SCHEME_OBJECT) \
+ ((((long) (OBJECT_ADDRESS (location))) + 5) + \
+ magic_constant)); \
+} while (0)
+\f
/* For the relocation of PC-relative JMP and CALL instructions.
This is used during GC/relocation, when the displacement
is incorrect, since it was computed with respect to the
extern long i386_pc_displacement_relocation;
-#define EXTRACT_ADDRESS_FROM_DISPLACEMENT(loc, instr_addr) do \
+#define EXTRACT_ADDRESS_FROM_DISPLACEMENT(var, instr_addr) do \
{ \
long displacement_address, new_displacement; \
\
new_displacement = ((* ((long *) displacement_address)) \
+ i386_pc_displacement_relocation); \
(* ((long *) displacement_address)) = new_displacement; \
- (loc) = ((SCHEME_OBJECT) \
+ (var) = ((SCHEME_OBJECT) \
((displacement_address + 4) + new_displacement)); \
} while (0)
(((long) (target)) - (displacement_address + 4)); \
} while (0)
-/* See the encodings above. */
-
-#define ENTRY_SKIPPED_CHECK_OFFSET 4
-#define ENTRY_PREFIX_LENGTH 3
-
-#define CLOSURE_SKIPPED_CHECK_OFFSET 11
-
-# define ADJUST_CLOSURE_AT_CALL(entry_point, location) \
-do { \
- long magic_constant; \
+#define BCH_EXTRACT_ADDRESS_FROM_DISPLACEMENT(var, v_addr, p_addr) do \
+{ \
+ long displacement_address, new_displacement; \
\
- magic_constant = (* ((long *) (((char *) (entry_point)) + 3))); \
- (location) = ((SCHEME_OBJECT) \
- ((((long) (OBJECT_ADDRESS (location))) + 5) + \
- magic_constant)); \
+ displacement_address = (((long) (p_addr)) + 1); \
+ new_displacement = ((* ((long *) displacement_address)) \
+ + i386_pc_displacement_relocation); \
+ (* ((long *) displacement_address)) = new_displacement; \
+ (var) = ((SCHEME_OBJECT) \
+ ((((long) (v_addr)) + 5) + new_displacement)); \
} while (0)
-# define COMPILED_CLOSURE_ENTRY_SIZE \
- ((2 * (sizeof (format_word))) + 6)
-
+#define BCH_STORE_DISPLACEMENT_FROM_ADDRESS(target, v_addr, p_addr) do \
+{ \
+ long displacement_address = (((long) (p_addr)) + 1); \
+ (* ((long *) displacement_address)) \
+ = (((long) (target)) - (((long) (v_addr)) + 5)); \
+} while (0)
+\f
#define START_CLOSURE_RELOCATION(scan) do \
{ \
- SCHEME_OBJECT \
- * _block = ((SCHEME_OBJECT *) (scan)), \
- * _old = (OBJECT_ADDRESS (_block[(OBJECT_DATUM (*_block))])); \
- char * _new = \
- ((char *) (FIRST_MANIFEST_CLOSURE_ENTRY (_block + 1))); \
+ SCHEME_OBJECT * _block, * _old; \
+ char * _new; \
+ \
+ _block = ((SCHEME_OBJECT *) (scan)); \
+ _old = (OBJECT_ADDRESS (_block[(OBJECT_DATUM (*_block))])); \
+ _new = ((char *) (FIRST_MANIFEST_CLOSURE_ENTRY (_block + 1))); \
\
i386_pc_displacement_relocation = (((long) _old) - ((long) _new)); \
} while (0)
#define END_CLOSURE_RELOCATION(scan) i386_pc_displacement_relocation = 0
-
#define EXTRACT_CLOSURE_ENTRY_ADDRESS EXTRACT_ADDRESS_FROM_DISPLACEMENT
#define STORE_CLOSURE_ENTRY_ADDRESS STORE_DISPLACEMENT_FROM_ADDRESS
+
+#define BCH_START_CLOSURE_RELOCATION(scan) do \
+{ \
+ SCHEME_OBJECT * _scan, * _block, _old_obj, * _old; \
+ char * _new; \
+ \
+ _scan = ((SCHEME_OBJECT *) (scan)); \
+ _block = ((SCHEME_OBJECT *) \
+ (SCAN_POINTER_TO_NEWSPACE_ADDRESS (_scan))); \
+ READ_NEWSPACE_ADDRESS (_old_obj, \
+ (_block + (OBJECT_DATUM (* _scan)))); \
+ _old = (OBJECT_ADDRESS (_old_obj)); \
+ _new = ((char *) (FIRST_MANIFEST_CLOSURE_ENTRY (_scan + 1))); \
+ \
+ i386_pc_displacement_relocation \
+ = (((long) _old) \
+ - ((long) (SCAN_POINTER_TO_NEWSPACE_ADDRESS (_new)))); \
+} while (0)
+
+#define BCH_END_CLOSURE_RELOCATION END_CLOSURE_RELOCATION
+
+#define BCH_EXTRACT_CLOSURE_ENTRY_ADDRESS(var, p_addr) do \
+{ \
+ SCHEME_OBJECT * _p_addr, * _v_addr; \
+ \
+ _p_addr = ((SCHEME_OBJECT *) (p_addr)); \
+ _v_addr = ((SCHEME_OBJECT *) \
+ (SCAN_POINTER_TO_NEWSPACE_ADDRESS (_p_addr))); \
+ \
+ BCH_EXTRACT_ADDRESS_FROM_DISPLACEMENT (var, _v_addr, _p_addr); \
+} while (0)
+
+#define BCH_STORE_CLOSURE_ENTRY_ADDRESS(target, p_addr) do \
+{ \
+ SCHEME_OBJECT * _p_addr, * _v_addr; \
+ \
+ _p_addr = ((SCHEME_OBJECT *) (p_addr)); \
+ _v_addr = ((SCHEME_OBJECT *) \
+ (SCAN_POINTER_TO_NEWSPACE_ADDRESS (_p_addr))); \
+ \
+ BCH_STORE_DISPLACEMENT_FROM_ADDRESS (target, _v_addr, _p_addr); \
+} while (0)
\f
#define EXECUTE_CACHE_ENTRY_SIZE 2
+#define FIRST_OPERATOR_LINKAGE_OFFSET 2
+
#define EXTRACT_EXECUTE_CACHE_ARITY(target, address) do \
{ \
(target) = ((long) (* ((unsigned short *) (address)))); \
#define START_OPERATOR_RELOCATION(scan) do \
{ \
- SCHEME_OBJECT \
- * _new = (((SCHEME_OBJECT *) (scan)) + 1), \
- * _old = ((SCHEME_OBJECT *) (* _new)); \
+ SCHEME_OBJECT * _new, * _old; \
+ \
+ _new = (((SCHEME_OBJECT *) (scan)) + 1); \
+ _old = ((SCHEME_OBJECT *) (* _new)); \
\
(* _new) = ((SCHEME_OBJECT) _new); \
i386_pc_displacement_relocation = (((long) _old) - ((long) _new)); \
} while (0)
#define END_OPERATOR_RELOCATION(scan) i386_pc_displacement_relocation = 0
+\f
+#define BCH_START_OPERATOR_RELOCATION(scan) do \
+{ \
+ SCHEME_OBJECT * _scan, * _new, * _old; \
+ \
+ _scan = (((SCHEME_OBJECT *) (scan)) + 1); \
+ _new = ((SCHEME_OBJECT *) \
+ (SCAN_POINTER_TO_NEWSPACE_ADDRESS (_scan))); \
+ _old = ((SCHEME_OBJECT *) (* _scan)); \
+ \
+ * _scan = ((SCHEME_OBJECT) _new); \
+ i386_pc_displacement_relocation = (((long) _old) - ((long) _new)); \
+} while (0)
-#define FIRST_OPERATOR_LINKAGE_OFFSET 2
+#define BCH_END_OPERATOR_RELOCATION END_OPERATOR_RELOCATION
+#define BCH_EXTRACT_OPERATOR_LINKAGE_ADDRESS(var, p_addr) do \
+{ \
+ SCHEME_OBJECT * _p_addr, * _v_addr; \
+ \
+ _p_addr = ((SCHEME_OBJECT *) (((long) (p_addr)) + 3)); \
+ _v_addr = ((SCHEME_OBJECT *) \
+ (SCAN_POINTER_TO_NEWSPACE_ADDRESS (_p_addr))); \
+ \
+ BCH_EXTRACT_ADDRESS_FROM_DISPLACEMENT (var, _v_addr, _p_addr); \
+} while (0)
+
+#define BCH_STORE_OPERATOR_LINKAGE_ADDRESS(e_addr, p_addr) do \
+{ \
+ SCHEME_OBJECT * _p_addr, * _v_addr; \
+ \
+ _p_addr = ((SCHEME_OBJECT *) (((long) (p_addr)) + 3)); \
+ _v_addr = ((SCHEME_OBJECT *) \
+ (SCAN_POINTER_TO_NEWSPACE_ADDRESS (_p_addr))); \
+ \
+ BCH_STORE_DISPLACEMENT_FROM_ADDRESS (e_addr, _v_addr, _p_addr); \
+} while (0)
+\f
#define TRAMPOLINE_ENTRY_SIZE 3
#define TRAMPOLINE_BLOCK_TO_ENTRY 3 /* MNV to MOV instr. */
projects / mit-scheme.git / commitdiff