/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchdmp.c,v 9.48 1989/12/06 05:49:28 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchdmp.c,v 9.49 1990/04/01 20:22:33 jinx Exp $
-Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989, 1990 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
#include "fasl.h"
#include "dump.c"
-#ifdef FLOATING_ALIGNMENT
-/* This must be fixed. */
-#include "error: bchdmp does not handle floating alignment."
-#endif
-
extern SCHEME_OBJECT
dump_renumber_primitive(),
*initialize_primitive_table(),
fasdump_remember_to_fix(Old, *Old); \
}
+#ifdef FLOATING_ALIGNMENT
+
+#define fasdump_flonum_setup() \
+{ \
+ Old = OBJECT_ADDRESS (Temp); \
+ if (OBJECT_TYPE (*Old) == TC_BROKEN_HEART) \
+ { \
+ *Scan = (MAKE_OBJECT_FROM_OBJECTS (Temp, *Old)); \
+ continue; \
+ } \
+ FLOAT_ALIGN_FREE(To_Address, To); \
+ New_Address = (MAKE_BROKEN_HEART (To_Address)); \
+ fasdump_remember_to_fix(Old, *Old); \
+}
+
+#else /* FLOATING_ALIGNMENT */
+
+#define fasdump_flonum_setup() fasdump_normal_setup()
+
+#endif /* FLOATING_ALIGNMENT */
+
#define fasdump_transport_end(length) \
{ \
To_Address += (length); \
fasdump_normal_pointer(copy_quadruple(), 4);
case TC_BIG_FLONUM:
+ fasdump_flonum_setup();
+ goto Move_Vector;
+
case TC_COMPILED_CODE_BLOCK:
case_Purify_Vector:
fasdump_normal_setup();
{
Boolean success;
long value, length, hlength, tlength, tsize;
- SCHEME_OBJECT *dumped_object, *free_buffer;
+ SCHEME_OBJECT *dumped_object, *free_buffer, *dummy;
SCHEME_OBJECT *table_start, *table_end, *table_top;
SCHEME_OBJECT header[FASL_HEADER_LENGTH];
PRIMITIVE_HEADER (3);
free_buffer = initialize_free_buffer();
Free = ((SCHEME_OBJECT *) NULL);
free_buffer += FASL_HEADER_LENGTH;
+
+ dummy = free_buffer;
+ FLOAT_ALIGN_FREE(Free, dummy);
+
*free_buffer++ = (ARG_REF (1));
dumped_object = Free;
Free += 1;
Band_Dump_Permitted ();
CHECK_ARG (1, INTERPRETER_APPLICABLE_P);
CHECK_ARG (2, STRING_P);
- if (! (Open_Dump_File ((ARG_REF (2)), WRITE_FLAG)))
- error_bad_range_arg (2);
Primitive_GC_If_Needed (5);
saved_free = Free;
Combination = MAKE_POINTER_OBJECT (TC_COMBINATION_1, Free);
}
else
{
-#if false
- /* Aligning here confuses some of the counts computed. */
- ALIGN_FLOAT (Free);
-#endif
+ if (! (Open_Dump_File ((ARG_REF (2)), WRITE_FLAG)))
+ error_bad_range_arg (2);
result = Write_File((Free - 1),
((long) (Free - Heap_Bottom)), Heap_Bottom,
((long) (Free_Constant - Constant_Space)),
table_start, table_length,
((long) (table_end - table_start)),
(compiler_utilities != SHARP_F), true);
+ /* The and is short-circuit, so it must be done in this order. */
+ result = ((Close_Dump_File ()) && result);
+ if (!result)
+ {
+ result = ((OS_file_remove (STRING_ARG (2))) && result);
+ }
}
- /* The and is short-circuit, so it must be done in this order. */
- result = (Close_Dump_File() && result);
- Band_Dump_Exit_Hook();
+ Band_Dump_Exit_Hook ();
Free = saved_free;
- if (result)
- {
- PRIMITIVE_RETURN (SHARP_T);
- }
- else
- {
- extern int unlink();
- unlink (STRING_LOC ((ARG_REF (2)), 0));
- PRIMITIVE_RETURN (SHARP_F);
- }
+ PRIMITIVE_RETURN (BOOLEAN_TO_OBJECT (result));
}
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchgcc.h,v 9.35 1989/10/28 15:37:55 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchgcc.h,v 9.36 1990/04/01 20:24:46 jinx Exp $
-Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989, 1990 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
relocate_normal_transport(copy_code, length); \
relocate_normal_end(); \
}
+
+#ifdef FLOATING_ALIGNMENT
+
+#define FLOAT_ALIGN_FREE(free,free_ptr) \
+do { \
+ while ((((long) ((free) + 1)) & FLOATING_ALIGNMENT) != 0) \
+ { \
+ free += 1; \
+ *free_ptr++ = (MAKE_OBJECT (TC_MANIFEST_NM_VECTOR, 0)); \
+ } \
+} while (0)
+
+#define relocate_flonum_setup() \
+{ \
+ relocate_normal_setup(); \
+ FLOAT_ALIGN_FREE(To_Address, To); \
+ New_Address = (MAKE_BROKEN_HEART (To_Address)); \
+}
+
+#else /* FLOATING_ALIGNMENT */
+
+#define FLOAT_ALIGN_FREE(free,free_ptr) \
+do { \
+} while (0)
+
+#define relocate_flonum_setup() relocate_normal_setup()
+
+#endif /* FLOATING_ALIGNMENT */
\f
/* Typeless objects (implicit types). */
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchgcl.c,v 9.39 1989/12/06 05:48:50 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchgcl.c,v 9.40 1990/04/01 20:26:39 jinx Rel $
-Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989, 1990 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
#include "scheme.h"
#include "bchgcc.h"
-
-#ifdef FLOATING_ALIGNMENT
-/* This must be fixed. */
-#include "error: bchgcl does not handle floating alignment."
-#endif
\f
SCHEME_OBJECT *
GCLoop(Scan, To_ptr, To_Address_ptr)
relocate_normal_pointer(copy_quadruple(), 4);
case TC_BIG_FLONUM:
+ relocate_flonum_setup();
+ goto Move_Vector;
+
case_Vector:
relocate_normal_setup();
Move_Vector:
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchmmg.c,v 9.51 1990/01/23 03:00:23 gjs Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchmmg.c,v 9.52 1990/04/01 20:30:17 jinx Exp $
-Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989, 1990 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
Problems with this implementation right now:
- Purify kills Scheme if there is not enough space in constant space
for the new object.
- - Floating alignment is not implemented.
- It only works on Unix (or systems which support Unix i/o calls).
- - Dumpworld cannot work because the file is not closed at dump time or
+ - Dumpworld does not work because the file is not closed at dump time or
reopened at restart time.
- Command line supplied gc files are not locked, so two processes can try
to share them and get very confused.
/* 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) +
- HEAP_BUFFER_SPACE);
+ ALLOCATE_HEAP_SPACE(Real_Stack_Size + Our_Heap_Size +
+ Our_Constant_Size + (2 * GC_BUFFER_SPACE) +
+ (HEAP_BUFFER_SPACE + 1));
/* Consistency check 2 */
if (Heap == NULL)
exit(1);
}
- /* Trim the system buffer space. */
-
- Highest_Allocated_Address -= (2 * GC_BUFFER_SPACE);
Heap += HEAP_BUFFER_SPACE;
INITIAL_ALIGN_FLOAT(Heap);
Constant_Space = Heap + Our_Heap_Size;
- gc_disk_buffer_1 = Constant_Space + Our_Constant_Size + Real_Stack_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_2 = (gc_disk_buffer_1 + GC_BUFFER_SPACE);
/* Consistency check 3 */
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchpur.c,v 9.48 1989/12/06 05:49:09 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchpur.c,v 9.49 1990/04/01 20:32:02 jinx Exp $
-Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989, 1990 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
#include "scheme.h"
#include "prims.h"
#include "bchgcc.h"
-
-#ifdef FLOATING_ALIGNMENT
-/* This must be fixed. */
-#include "error: bchpur does not handle floating alignment."
-#endif
\f
/* Purify modes */
case_Quadruple:
relocate_normal_pointer(copy_quadruple(), 4);
\f
+ case TC_BIG_FLONUM:
+ relocate_flonum_setup();
+ goto Move_Vector;
+
case TC_COMPILED_CODE_BLOCK:
case TC_ENVIRONMENT:
if (purify_mode == PURE_COPY)
break;
/* Fall through */
- case TC_BIG_FLONUM:
case_Purify_Vector:
relocate_normal_setup();
Move_Vector:
projects / mit-scheme.git / commitdiff