machine.
For the C back end, this should be innocuous, since there are no
alignment constraints on code.
For the native back ends, the native code is only meaningful on the
same machine, so the alignment constraints should be the same.
/* -*-C-*-
-$Id: bintopsb.c,v 9.64 1994/01/06 19:51:22 gjr Exp $
+$Id: bintopsb.c,v 9.65 1994/01/12 00:30:20 gjr Exp $
-Copyright (c) 1987-1993 Massachusetts Institute of Technology
+Copyright (c) 1987-1994 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
NBitstrs, NBBits,
NStrings, NChars,
NPChars, NCChars;
+
+#define NO_ALIGNMENT(index) do { } while (0)
+
+#ifdef FLOATING_ALIGNMENT
+#define INDEX_ALIGN_FLOAT(index) do \
+{ \
+ while (((((unsigned long) (& Mem_Base[(index) + 1])) \
+ - ((unsigned long) (& Mem_Base[0]))) \
+ & FLOATING_ALIGNMENT) \
+ != 0) \
+ Mem_Base[(index)++] = SHARP_F; \
+} while (0)
+#endif /* FLOATING_ALIGNMENT */
+
+#ifndef INDEX_ALIGN_FLOAT
+#define INDEX_ALIGN_FLOAT NO_ALIGNMENT
+#endif /* INDEX_ALIGN_FLOAT */
\f
#define OUT(s) \
{ \
(Mem_Base [(Fre)++]) = (*Old_Address++); \
} while (0)
-#define DO_VECTOR(Code, Rel, Fre, Scn, Obj, FObj) do \
-{ \
- Old_Address += (Rel); \
- Old_Contents = (*Old_Address); \
- if (BROKEN_HEART_P (Old_Contents)) \
- (Mem_Base [(Scn)]) = \
- (MAKE_OBJECT_FROM_OBJECTS (This, Old_Contents)); \
- else \
- { \
- (Mem_Base [(Scn)]) = (OBJECT_NEW_DATUM (This, (Fre))); \
- COPY_VECTOR (Fre); \
- } \
-} while (0)
-
/* This is a hack to get the cross compiler to work
accross different endianness.
*/
-#define DO_INVERTED_BLOCK(Code, Rel, Fre, Scn, Obj, FObj) do \
+#define COPY_INVERTED_VECTOR(Fre) do \
+{ \
+ fast long len1, len2; \
+ SCHEME_OBJECT * Saved; \
+ \
+ len1 = (OBJECT_DATUM (Old_Contents)); \
+ (*Old_Address++) = (MAKE_BROKEN_HEART (Fre)); \
+ (Mem_Base [(Fre)++]) = Old_Contents; \
+ if ((OBJECT_TYPE (* Old_Address)) != TC_MANIFEST_NM_VECTOR) \
+ { \
+ fprintf (stderr, "%s: Bad compiled code block found.\n", \
+ program_name); \
+ quit (1); \
+ } \
+ len2 = (OBJECT_DATUM (*Old_Address)); \
+ (Mem_Base [(Fre)++]) = (*Old_Address++); \
+ Old_Address += len2; \
+ Saved = Old_Address; \
+ len1 -= (len2 + 1); \
+ while ((len2--) > 0) \
+ (Mem_Base [(Fre)++]) = (*--Old_Address); \
+ Old_Address = Saved; \
+ while ((len1--) > 0) \
+ (Mem_Base [(Fre)++]) = (*Old_Address++); \
+} while (0)
+
+#define DO_VECTOR_2(aligner, copier, Code, Rel, Fre, Scn, Obj, FObj) do \
{ \
Old_Address += (Rel); \
Old_Contents = (*Old_Address); \
(MAKE_OBJECT_FROM_OBJECTS (This, Old_Contents)); \
else \
{ \
- fast long len1, len2; \
- SCHEME_OBJECT * Saved; \
+ aligner (Fre); \
(Mem_Base [(Scn)]) = (OBJECT_NEW_DATUM (This, (Fre))); \
- len1 = (OBJECT_DATUM (Old_Contents)); \
- (*Old_Address++) = (MAKE_BROKEN_HEART (Fre)); \
- (Mem_Base [(Fre)++]) = Old_Contents; \
- if ((OBJECT_TYPE (*Old_Address)) != TC_MANIFEST_NM_VECTOR) \
- { \
- fprintf (stderr, "%s: Bad compiled code block found.\n", \
- program_name); \
- quit (1); \
- } \
- len2 = (OBJECT_DATUM (*Old_Address)); \
- (Mem_Base [(Fre)++]) = (*Old_Address++); \
- Old_Address += len2; \
- Saved = Old_Address; \
- len1 -= (len2 + 1); \
- while ((len2--) > 0) \
- (Mem_Base [(Fre)++]) = (*--Old_Address); \
- Old_Address = Saved; \
- while ((len1--) > 0) \
- (Mem_Base [(Fre)++]) = (*Old_Address++); \
+ copier (Fre); \
} \
} while (0)
+
+#define DO_VECTOR(Code, Rel, Fre, Scn, Obj, FObj) \
+ DO_VECTOR_2 (NO_ALIGNMENT, COPY_VECTOR, \
+ Code, Rel, Fre, Scn, Obj, FObj)
+
+#define DO_INVERTED_BLOCK(Code, Rel, Fre, Scn, Obj, FObj) \
+ DO_VECTOR_2 (NO_ALIGNMENT, COPY_INVERTED_VECTOR, \
+ Code, Rel, Fre, Scn, Obj, FObj)
\f
#ifdef HAS_COMPILER_SUPPORT
(MAKE_OBJECT_FROM_OBJECTS (This, Old_Contents)); \
else \
{ \
+ INDEX_ALIGN_FLOAT (Fre); \
(*compiled_entry_pointer++) = \
(MAKE_OBJECT_FROM_OBJECTS (This, (Fre))); \
copy (Fre); \
} \
} while (0)
+#define DO_COMPILED_BLOCK(Code, Rel, Fre, Scn, Obj, FObj) \
+ DO_VECTOR_2 (INDEX_ALIGN_FLOAT, COPY_VECTOR, \
+ Code, Rel, Fre, Scn, Obj, FObj)
+
+#define DO_INVERTED_COMPILED_BLOCK(Code, Rel, Fre, Scn, Obj, FObj) \
+ DO_VECTOR_2 (INDEX_ALIGN_FLOAT, COPY_INVERTED_VECTOR, \
+ Code, Rel, Fre, Scn, Obj, FObj)
+
+#define DO_C_COMPILED_BLOCK(Code, Rel, Fre, Scn, Obj, FObj) \
+ DO_VECTOR_2 (INDEX_ALIGN_FLOAT, COPY_C_COMPILED_BLOCK, \
+ Code, Rel, Fre, Scn, Obj, FObj)
+
#define DO_COMPILED_ENTRY(Code, Rel, Fre, Scn, Obj, FObj) \
- DO_ENTRY_INTERNAL(CHAR_OFFSET, COPY_VECTOR, \
- Code, Rel, Fre, Scn, Obj, FObj)
+ DO_ENTRY_INTERNAL (CHAR_OFFSET, COPY_VECTOR, \
+ Code, Rel, Fre, Scn, Obj, FObj)
#define DO_C_COMPILED_ENTRY(Code, Rel, Fre, Scn, Obj, FObj) \
- DO_ENTRY_INTERNAL(OBJ_OFFSET, COPY_C_COMPILED_BLOCK, \
- Code, Rel, Fre, Scn, Obj, FObj)
-
-#define DO_C_COMPILED_BLOCK(Code, Rel, Fre, Scn, Obj, FObj) do \
-{ \
- Old_Address += (Rel); \
- Old_Contents = (* Old_Address); \
- if (BROKEN_HEART_P (Old_Contents)) \
- (Mem_Base [(Scn)]) = \
- (MAKE_OBJECT_FROM_OBJECTS (This, Old_Contents)); \
- else \
- { \
- (Mem_Base [(Scn)]) = (OBJECT_NEW_DATUM (This, (Fre))); \
- COPY_C_COMPILED_BLOCK (Fre); \
- } \
-} while (0)
+ DO_ENTRY_INTERNAL (OBJ_OFFSET, COPY_C_COMPILED_BLOCK, \
+ Code, Rel, Fre, Scn, Obj, FObj)
\f
/* This depends on the fact that a compiled code block has an NMV
header in the first or second words.
{ \
Fre = copy_c_compiled_block (Fre, Old_Contents, Old_Address); \
} while (0)
-
+\f
#else /* no HAS_COMPILER_SUPPORT */
-#define DO_COMPILED_ENTRY(Code, Rel, Fre, Scn, Obj, FObj) do \
+#define COMPILER_BAD_STMT(name) do \
{ \
- fprintf \
- (stderr, \
- "%s: Invoking DO_COMPILED_ENTRY with no compiler support!\n", \
- program_name); \
+ fprintf (stderr, \
+ "%s: Invoking %s with no compiler support!\n", \
+ program_name, name); \
quit (1); \
} while (0)
-#define DO_C_COMPILED_ENTRY DO_COMPILED_ENTRY
+#define DO_COMPILED_ENTRY(Code, Rel, Fre, Scn, Obj, FObj) \
+ COMPILER_BAD_STMT ("DO_COMPILED_ENTRY")
+
+#define DO_COMPILED_BLOCK(Code, Rel, Fre, Scn, Obj, FObj) \
+ COMPILER_BAD_STMT ("DO_COMPILED_BLOCK")
-#define DO_C_COMPILED_BLOCK(Code, Rel, Fre, Scn, Obj, FObj) do \
-{ \
- fprintf \
- (stderr, \
- "%s: Invoking DO_C_COMPILED_BLOCK with no compiler support!\n", \
- program_name); \
- quit (1); \
-} while (0)
+#define DO_INVERTED_COMPILED_BLOCK(Code, Rel, Fre, Scn, Obj, FObj) \
+ COMPILER_BAD_STMT ("DO_INVERTED_COMPILED_BLOCK")
+
+#define DO_C_COMPILED_ENTRY(Code, Rel, Fre, Scn, Obj, FObj) \
+ COMPILER_BAD_STMT ("DO_C_COMPILED_ENTRY")
+
+#define DO_C_COMPILED_BLOCK(Code, Rel, Fre, Scn, Obj, FObj)
+ COMPILER_BAD_STMT ("DO_C_COMPILED_BLOCK")
#endif /* HAS_COMPILER_SUPPORT */
\f
else if (c_compiled_p)
DO_POINTER (*Area, DO_C_COMPILED_BLOCK);
else if (endian_invert_p)
- DO_POINTER (*Area, DO_INVERTED_BLOCK);
+ DO_POINTER (*Area, DO_INVERTED_COMPILED_BLOCK);
else
- DO_POINTER (*Area, DO_VECTOR);
+ DO_POINTER (*Area, DO_COMPILED_BLOCK);
break;
case_compiled_entry_point:
/* This is way larger than needed, but... what the hell? */
- Size = ((2 * (TRAP_MAX_IMMEDIATE + 1))
- + (2 * ((FLOATING_ALIGNMENT + 1) / (sizeof (SCHEME_OBJECT))))
+ Size = (
+ /* All pointers must have datum > TRAP_MAX_IMMEDIATE */
+ (2 * (TRAP_MAX_IMMEDIATE + 1))
+ /* Floating alignment of Heap and Constant Space
+ in incoming image, and of output arenas.
+ */
+ + (5 * ((FLOATING_ALIGNMENT + 1) / (sizeof (SCHEME_OBJECT))))
+ /* Space taken by incoming image. */
+ (Heap_Count + Const_Count)
+ /* We don't know the partition of the outgoing image,
+ so, make each of the areas large enough:
+ Heap pointers and external heap objects,
+ Constant pointers and external constant objects,
+ Pure pointers and exteranl pure objects
+ */
+ (2 * (Heap_Count + (2 * Const_Count)))
+ /* Space for the roots */
+ (NROOTS + 1)
+ /* Space for the primitive table, or space to upgrade */
+ (upgrade_primitives_p
? (3 * PRIMITIVE_UPGRADE_SPACE)
- : Primitive_Table_Size) +
- (allow_compiled_p
- ? (2 + ((c_compiled_p ? 4 : 2) * (Heap_Count + Const_Count)))
- : 0)
+ : Primitive_Table_Size)
+ /* Everything might be compiled code blocks, requiring
+ extra tables to map entries to objects, and block alignment
+ */
+ + (allow_compiled_p
+ ? (2 + ((c_compiled_p ? 5 : 3) * (Heap_Count + Const_Count)))
+ : 0)
+ /* C code IDs */
+ C_Code_Table_Size);
ALLOCATE_HEAP_SPACE (Size,
NBits = NBBits = NChars = 0;
Heap_Start = (NROOTS + (TRAP_MAX_IMMEDIATE + 1));
- Heap_Objects_Start = (Heap_Start + Heap_Count);
+ INDEX_ALIGN_FLOAT (Heap_Start);
+ Heap_Objects_Start = (Heap_Start
+ + (allow_compiled_p
+ ? (2 * Heap_Count)
+ : Heap_Count));
if (! band_p)
dumped_utilities = SHARP_F;
Mem_Base[(Heap_Start - NROOTS) + 0] = dumped_utilities;
Objects = 0;
Constant_Start = (Heap_Objects_Start + Heap_Count);
- Constant_Objects_Start = (Constant_Start + Const_Count);
+ INDEX_ALIGN_FLOAT (Constant_Start);
+ Constant_Objects_Start = (Constant_Start
+ + (allow_compiled_p
+ ? (2 * Const_Count)
+ : Const_Count));
Scan_Constant = Constant_Start;
Free_Constant = Constant_Start;
Free_Cobjects = &Mem_Base[Constant_Objects_Start];
Constant_Objects = 0;
Pure_Start = (Constant_Objects_Start + Const_Count);
- Pure_Objects_Start = (Pure_Start + Const_Count);
+ INDEX_ALIGN_FLOAT (Pure_Start);
+ Pure_Objects_Start = (Pure_Start
+ + (allow_compiled_p
+ ? (2 * Const_Count)
+ : Const_Count));
Scan_Pure = Pure_Start;
Free_Pure = Pure_Start;
Free_Pobjects = &Mem_Base[Pure_Objects_Start];
Pure_Objects = 0;
-
+\f
if (Const_Count == 0)
DO_AREA (HEAP_CODE, Scan, Free, Objects, Free_Objects);
else
WHEN (((Free_Cobjects - &Mem_Base[Pure_Objects_Start])
> Const_Count),
"Free_Cobjects overran Pure Object Space");
-\f
+
/* Output the data */
if (found_ext_prims)
fprintf (stderr, " You may want to fix this by hand.\n");
}
- /* Header */
+ if (! compiled_p)
+ {
+ dumped_processor_type = 0;
+ dumped_interface_version = 0;
+ }
+\f
+ /* Header:
+ Portable Version
+ Machine
+ Version
+ Sub Version
+ Flags
+ Heap Count
+ Heap Base
+ Heap Objects
+ Constant Count
+ Constant Base
+ Constant Objects
+ Pure Count
+ Pure Base
+ Pure Objects
+ & Dumped Object
+ Maximum Stack Offset
+ Number of flonums
+ Number of integers
+ Number of bits in integers
+ Number of bit strings
+ Number of bits in bit strings
+ Number of character strings
+ Number of characters in strings
+ Number of primitives
+ Number of characters in primitives
+ CPU type
+ Compiled code interface version
+ Compiler utilities vector
+ Number of C code blocks
+ Number of characters in C code blocks
+ Number of reserved C entries
+ */
WRITE_HEADER ("Portable Version", "%ld", PORTABLE_VERSION);
WRITE_HEADER ("Machine", "%ld", FASL_INTERNAL_FORMAT);
WRITE_HEADER ("Pure Objects", "%ld", Pure_Objects);
WRITE_HEADER ("& Dumped Object", "%ld",
- (OBJECT_DATUM (Mem_Base[(TRAP_MAX_IMMEDIATE + 1) + 1])));
+ (OBJECT_DATUM (Mem_Base[(Heap_Start - NROOTS) + 1])));
WRITE_HEADER ("Maximum Stack Offset", "%ld", Max_Stack_Offset);
WRITE_HEADER ("Number of flonums", "%ld", NFlonums);
WRITE_HEADER ("Number of primitives", "%ld", Primitive_Table_Length);
WRITE_HEADER ("Number of characters in primitives", "%ld", NPChars);
- if (! compiled_p)
- {
- dumped_processor_type = 0;
- dumped_interface_version = 0;
- }
-
WRITE_HEADER ("CPU type", "%ld", dumped_processor_type);
WRITE_HEADER ("Compiled code interface version", "%ld",
dumped_interface_version);
if (allow_bands_p)
WRITE_HEADER ("Compiler utilities vector", "%ld",
- (OBJECT_DATUM (Mem_Base[(TRAP_MAX_IMMEDIATE + 1) + 0])));
+ (OBJECT_DATUM (Mem_Base[(Heap_Start - NROOTS) + 0])));
else
WRITE_HEADER ("Compiler utilities vector", "%ld", 0);
WRITE_HEADER ("Number of characters in C code blocks", "%ld", NCChars);
WRITE_HEADER ("Number of reserved C entries", "%ld",
(OBJECT_DATUM (c_code_table[0])));
-
+\f
/* Binary Objects */
print_binary_objects (&Mem_Base[Pure_Objects_Start], Pure_Objects);
print_binary_objects (&Mem_Base[Constant_Objects_Start], Constant_Objects);
print_binary_objects (&Mem_Base[Heap_Objects_Start], Objects);
-\f
+
/* Normal Objects: pointers, simple non-pointers (e.g. SHARP_F) */
print_objects (&Mem_Base[Pure_Start], &Mem_Base[Free_Pure]);
/* -*-C-*-
-$Id: psbtobin.c,v 9.55 1993/11/16 04:49:56 gjr Exp $
+$Id: psbtobin.c,v 9.56 1994/01/12 00:30:57 gjr Exp $
-Copyright (c) 1987-1993 Massachusetts Institute of Technology
+Copyright (c) 1987-1994 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
static SCHEME_OBJECT
* Heap, * Constant_Space, * Constant_Top, * Stack_Top,
- * Heap_Base, * Heap_Table, * Heap_Object_Limit, * Free,
- * Const_Base, * Const_Table, * Const_Object_Limit, * Free_Const,
- * Pure_Base, * Pure_Table, * Pure_Object_Limit, * Free_Pure;
+ * Heap_Base, * Heap_Table, * Heap_Object_Limit,
+ * Heap_Pointers, * Free,
+ * Const_Base, * Const_Table, * Const_Object_Limit,
+ * Const_Pointers, * Free_Const,
+ * Pure_Base, * Pure_Table, * Pure_Object_Limit,
+ * Pure_Pointers, * Free_Pure;
static long
DEFUN (Write_Data, (Count, From_Where),
long _addr = (Addr); \
\
if ((_addr >= Dumped_Heap_Base) && (_addr < Dumped_Heap_Limit)) \
- (Where) = &Heap_Object_Limit[_addr - Dumped_Heap_Base]; \
+ (Where) = &Heap_Pointers[_addr - Dumped_Heap_Base]; \
else if ((_addr >= Dumped_Const_Base) \
&& (_addr < Dumped_Const_Limit)) \
- (Where) = &Const_Object_Limit[_addr - Dumped_Const_Base]; \
+ (Where) = &Const_Pointers[_addr - Dumped_Const_Base]; \
else if ((_addr >= Dumped_Pure_Base) \
&& (_addr < Dumped_Pure_Limit)) \
- (Where) = &Pure_Object_Limit[_addr - Dumped_Pure_Base]; \
+ (Where) = &Pure_Pointers[_addr - Dumped_Pure_Base]; \
else \
(void) relocation_error (_addr); \
} while (0)
#define Relocate(Addr) \
((((Addr) >= Dumped_Heap_Base) && ((Addr) < Dumped_Heap_Limit)) \
- ? &Heap_Object_Limit[(Addr) - Dumped_Heap_Base] \
+ ? &Heap_Pointers[(Addr) - Dumped_Heap_Base] \
: ((((Addr) >= Dumped_Const_Base) && ((Addr) < Dumped_Const_Limit)) \
- ? &Const_Object_Limit[(Addr) - Dumped_Const_Base] \
+ ? &Const_Pointers[(Addr) - Dumped_Const_Base] \
: ((((Addr) >= Dumped_Pure_Base) && ((Addr) < Dumped_Pure_Limit)) \
- ? &Pure_Object_Limit[(Addr) - Dumped_Pure_Base] \
+ ? &Pure_Pointers[(Addr) - Dumped_Pure_Base] \
: ((relocation_error (Addr)), ((SCHEME_OBJECT *) NULL)))))
#else
quit (1);
}
\f
+/* Header:
+
+ Portable Version
+ Machine
+ Version
+ Sub Version
+ Flags
+ Heap Count
+ Heap Base
+ Heap Objects
+ Constant Count
+ Constant Base
+ Constant Objects
+ Pure Count
+ Pure Base
+ Pure Objects
+ & Dumped Object
+ Maximum Stack Offset
+ Number of flonums
+ Number of integers
+ Number of bits in integers
+ Number of bit strings
+ Number of bits in bit strings
+ Number of character strings
+ Number of characters in strings
+ Number of primitives
+ Number of characters in primitives
+ CPU type
+ Compiled code interface version
+ Compiler utilities vector
+ Number of C code blocks
+ Number of characters in C code blocks
+ Number of reserved C entries
+
+ */
+\f
static SCHEME_OBJECT * Lowest_Allocated_Address, * Highest_Allocated_Address;
static long
if (Max_Stack_Offset > initial_delta)
initial_delta = Max_Stack_Offset;
- Size = (6 /* SNMV */
- + (2 * ((FLOATING_ALIGNMENT + 1) / (sizeof (SCHEME_OBJECT))))
+ Size = (
+ /* SNMV headers for constant and pure space */
+ 6
+ /* Float alignment of the different arenas */
+ + (5 * ((FLOATING_ALIGNMENT + 1) / (sizeof (SCHEME_OBJECT))))
+ /* All pointers must have datum greater than this */
+ initial_delta
+ /* Incoming heap */
+ (Heap_Count + Heap_Objects)
+ /* Incoming constant space */
+ (Const_Count + Const_Objects)
+ /* Incoming pure space */
+ (Pure_Count + Pure_Objects)
+ /* Maximum space taken up by flonums */
+ (flonum_to_pointer (NFlonums))
+ /* Maximum space taken up by integers */
+ ((NIntegers * (2 + (BYTES_TO_WORDS (sizeof (bignum_digit_type)))))
+ (BYTES_TO_WORDS (BIGNUM_BITS_TO_DIGITS (NBits))))
+ /* Maximum space taken up by strings */
+ ((NStrings * (1 + STRING_CHARS))
+ (char_to_pointer (NChars)))
+ /* Maximum space taken up by bit strings */
+ ((NBitstrs * (1 + BIT_STRING_FIRST_WORD))
+ (BIT_STRING_LENGTH_TO_GC_LENGTH (NBBits)))
+ /* space taken by the primitive table */
+ ((Primitive_Table_Length * (2 + STRING_CHARS))
+ (char_to_pointer (NPChars)))
+ /* Space taken up by the C code block IDs */
+ (1 + (2 * C_Code_Table_Length) + (char_to_pointer (NCChars))));
ALLOCATE_HEAP_SPACE (Size,
Pure_Base = &Constant_Space[2];
Pure_Object_Limit
= (Read_External (Pure_Objects, Pure_Table, Pure_Base));
+ Pure_Pointers = Pure_Object_Limit;
+ ALIGN_FLOAT (Pure_Pointers);
XDEBUGGING (print_external_objects ("Pure", Pure_Table, Pure_Objects));
DEBUGGING (fprintf (stderr, "Pure_Base: 0x%x\n", Pure_Base));
- DEBUGGING (fprintf (stderr, "Pure_Object_Limit: 0x%x\n",
- Pure_Object_Limit));
+ DEBUGGING (fprintf (stderr, "Pure_Pointers: 0x%x\n", Pure_Pointers));
- Const_Base = &Pure_Object_Limit[Pure_Count + 2];
+ Const_Base = &Pure_Pointers[Pure_Count + 2];
Const_Object_Limit
= (Read_External (Const_Objects, Const_Table, Const_Base));
+ Const_Pointers = Const_Object_Limit;
+ ALIGN_FLOAT (Const_Pointers);
XDEBUGGING (print_external_objects ("Constant", Const_Table,
Const_Objects));
DEBUGGING (fprintf (stderr, "Const_Base: 0x%x\n", Const_Base));
- DEBUGGING (fprintf (stderr, "Const_Object_Limit: 0x%x\n",
- Const_Object_Limit));
+ DEBUGGING (fprintf (stderr, "Const_Pointers: 0x%x\n", Const_Pointers));
- Constant_Top = &Const_Object_Limit[Const_Count + 2];
+ Constant_Top = &Const_Pointers[Const_Count + 2];
Heap_Base = Constant_Top;
ALIGN_FLOAT (Heap_Base);
Heap_Object_Limit
= (Read_External (Heap_Objects, Heap_Table, Heap_Base));
+ Heap_Pointers = Heap_Object_Limit;
+ ALIGN_FLOAT (Heap_Pointers);
XDEBUGGING (print_external_objects ("Heap", Heap_Table, Heap_Objects));
DEBUGGING (fprintf (stderr, "Heap_Base: 0x%x\n", Heap_Base));
- DEBUGGING (fprintf (stderr, "Heap_Object_Limit: 0x%x\n",
- Heap_Object_Limit));
+ DEBUGGING (fprintf (stderr, "Heap_Pointers: 0x%x\n", Heap_Pointers));
- primitive_table = &Heap_Object_Limit[Heap_Count];
+ primitive_table = &Heap_Pointers[Heap_Count];
WHEN ((primitive_table > &Heap[Size]), "primitive_table overran memory.");
/* Read the normal objects */
- Free_Pure = (Read_Pointers_and_Relocate (Pure_Count, Pure_Object_Limit));
+ Free_Pure = (Read_Pointers_and_Relocate (Pure_Count, Pure_Pointers));
WHEN ((Free_Pure > (Const_Base - 2)),
"Free_Pure overran Const_Base");
WHEN ((Free_Pure < (Const_Base - 2)),
"Free_Pure did not reach Const_Base");
- Free_Const = (Read_Pointers_and_Relocate (Const_Count,
- Const_Object_Limit));
+ Free_Const = (Read_Pointers_and_Relocate (Const_Count, Const_Pointers));
WHEN ((Free_Const > (Constant_Top - 2)),
"Free_Const overran Constant_Top");
WHEN ((Free_Const < (Constant_Top - 2)),
"Free_Const did not reach Constant_Top");
- Free = (Read_Pointers_and_Relocate (Heap_Count, Heap_Object_Limit));
+ Free = (Read_Pointers_and_Relocate (Heap_Count, Heap_Pointers));
WHEN ((Free > primitive_table), "Free overran primitive_table");
WHEN ((Free < primitive_table), "Free did not reach primitive_table");
/* -*-C-*-
-$Id: bintopsb.c,v 9.64 1994/01/06 19:51:22 gjr Exp $
+$Id: bintopsb.c,v 9.65 1994/01/12 00:30:20 gjr Exp $
-Copyright (c) 1987-1993 Massachusetts Institute of Technology
+Copyright (c) 1987-1994 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
NBitstrs, NBBits,
NStrings, NChars,
NPChars, NCChars;
+
+#define NO_ALIGNMENT(index) do { } while (0)
+
+#ifdef FLOATING_ALIGNMENT
+#define INDEX_ALIGN_FLOAT(index) do \
+{ \
+ while (((((unsigned long) (& Mem_Base[(index) + 1])) \
+ - ((unsigned long) (& Mem_Base[0]))) \
+ & FLOATING_ALIGNMENT) \
+ != 0) \
+ Mem_Base[(index)++] = SHARP_F; \
+} while (0)
+#endif /* FLOATING_ALIGNMENT */
+
+#ifndef INDEX_ALIGN_FLOAT
+#define INDEX_ALIGN_FLOAT NO_ALIGNMENT
+#endif /* INDEX_ALIGN_FLOAT */
\f
#define OUT(s) \
{ \
(Mem_Base [(Fre)++]) = (*Old_Address++); \
} while (0)
-#define DO_VECTOR(Code, Rel, Fre, Scn, Obj, FObj) do \
-{ \
- Old_Address += (Rel); \
- Old_Contents = (*Old_Address); \
- if (BROKEN_HEART_P (Old_Contents)) \
- (Mem_Base [(Scn)]) = \
- (MAKE_OBJECT_FROM_OBJECTS (This, Old_Contents)); \
- else \
- { \
- (Mem_Base [(Scn)]) = (OBJECT_NEW_DATUM (This, (Fre))); \
- COPY_VECTOR (Fre); \
- } \
-} while (0)
-
/* This is a hack to get the cross compiler to work
accross different endianness.
*/
-#define DO_INVERTED_BLOCK(Code, Rel, Fre, Scn, Obj, FObj) do \
+#define COPY_INVERTED_VECTOR(Fre) do \
+{ \
+ fast long len1, len2; \
+ SCHEME_OBJECT * Saved; \
+ \
+ len1 = (OBJECT_DATUM (Old_Contents)); \
+ (*Old_Address++) = (MAKE_BROKEN_HEART (Fre)); \
+ (Mem_Base [(Fre)++]) = Old_Contents; \
+ if ((OBJECT_TYPE (* Old_Address)) != TC_MANIFEST_NM_VECTOR) \
+ { \
+ fprintf (stderr, "%s: Bad compiled code block found.\n", \
+ program_name); \
+ quit (1); \
+ } \
+ len2 = (OBJECT_DATUM (*Old_Address)); \
+ (Mem_Base [(Fre)++]) = (*Old_Address++); \
+ Old_Address += len2; \
+ Saved = Old_Address; \
+ len1 -= (len2 + 1); \
+ while ((len2--) > 0) \
+ (Mem_Base [(Fre)++]) = (*--Old_Address); \
+ Old_Address = Saved; \
+ while ((len1--) > 0) \
+ (Mem_Base [(Fre)++]) = (*Old_Address++); \
+} while (0)
+
+#define DO_VECTOR_2(aligner, copier, Code, Rel, Fre, Scn, Obj, FObj) do \
{ \
Old_Address += (Rel); \
Old_Contents = (*Old_Address); \
(MAKE_OBJECT_FROM_OBJECTS (This, Old_Contents)); \
else \
{ \
- fast long len1, len2; \
- SCHEME_OBJECT * Saved; \
+ aligner (Fre); \
(Mem_Base [(Scn)]) = (OBJECT_NEW_DATUM (This, (Fre))); \
- len1 = (OBJECT_DATUM (Old_Contents)); \
- (*Old_Address++) = (MAKE_BROKEN_HEART (Fre)); \
- (Mem_Base [(Fre)++]) = Old_Contents; \
- if ((OBJECT_TYPE (*Old_Address)) != TC_MANIFEST_NM_VECTOR) \
- { \
- fprintf (stderr, "%s: Bad compiled code block found.\n", \
- program_name); \
- quit (1); \
- } \
- len2 = (OBJECT_DATUM (*Old_Address)); \
- (Mem_Base [(Fre)++]) = (*Old_Address++); \
- Old_Address += len2; \
- Saved = Old_Address; \
- len1 -= (len2 + 1); \
- while ((len2--) > 0) \
- (Mem_Base [(Fre)++]) = (*--Old_Address); \
- Old_Address = Saved; \
- while ((len1--) > 0) \
- (Mem_Base [(Fre)++]) = (*Old_Address++); \
+ copier (Fre); \
} \
} while (0)
+
+#define DO_VECTOR(Code, Rel, Fre, Scn, Obj, FObj) \
+ DO_VECTOR_2 (NO_ALIGNMENT, COPY_VECTOR, \
+ Code, Rel, Fre, Scn, Obj, FObj)
+
+#define DO_INVERTED_BLOCK(Code, Rel, Fre, Scn, Obj, FObj) \
+ DO_VECTOR_2 (NO_ALIGNMENT, COPY_INVERTED_VECTOR, \
+ Code, Rel, Fre, Scn, Obj, FObj)
\f
#ifdef HAS_COMPILER_SUPPORT
(MAKE_OBJECT_FROM_OBJECTS (This, Old_Contents)); \
else \
{ \
+ INDEX_ALIGN_FLOAT (Fre); \
(*compiled_entry_pointer++) = \
(MAKE_OBJECT_FROM_OBJECTS (This, (Fre))); \
copy (Fre); \
} \
} while (0)
+#define DO_COMPILED_BLOCK(Code, Rel, Fre, Scn, Obj, FObj) \
+ DO_VECTOR_2 (INDEX_ALIGN_FLOAT, COPY_VECTOR, \
+ Code, Rel, Fre, Scn, Obj, FObj)
+
+#define DO_INVERTED_COMPILED_BLOCK(Code, Rel, Fre, Scn, Obj, FObj) \
+ DO_VECTOR_2 (INDEX_ALIGN_FLOAT, COPY_INVERTED_VECTOR, \
+ Code, Rel, Fre, Scn, Obj, FObj)
+
+#define DO_C_COMPILED_BLOCK(Code, Rel, Fre, Scn, Obj, FObj) \
+ DO_VECTOR_2 (INDEX_ALIGN_FLOAT, COPY_C_COMPILED_BLOCK, \
+ Code, Rel, Fre, Scn, Obj, FObj)
+
#define DO_COMPILED_ENTRY(Code, Rel, Fre, Scn, Obj, FObj) \
- DO_ENTRY_INTERNAL(CHAR_OFFSET, COPY_VECTOR, \
- Code, Rel, Fre, Scn, Obj, FObj)
+ DO_ENTRY_INTERNAL (CHAR_OFFSET, COPY_VECTOR, \
+ Code, Rel, Fre, Scn, Obj, FObj)
#define DO_C_COMPILED_ENTRY(Code, Rel, Fre, Scn, Obj, FObj) \
- DO_ENTRY_INTERNAL(OBJ_OFFSET, COPY_C_COMPILED_BLOCK, \
- Code, Rel, Fre, Scn, Obj, FObj)
-
-#define DO_C_COMPILED_BLOCK(Code, Rel, Fre, Scn, Obj, FObj) do \
-{ \
- Old_Address += (Rel); \
- Old_Contents = (* Old_Address); \
- if (BROKEN_HEART_P (Old_Contents)) \
- (Mem_Base [(Scn)]) = \
- (MAKE_OBJECT_FROM_OBJECTS (This, Old_Contents)); \
- else \
- { \
- (Mem_Base [(Scn)]) = (OBJECT_NEW_DATUM (This, (Fre))); \
- COPY_C_COMPILED_BLOCK (Fre); \
- } \
-} while (0)
+ DO_ENTRY_INTERNAL (OBJ_OFFSET, COPY_C_COMPILED_BLOCK, \
+ Code, Rel, Fre, Scn, Obj, FObj)
\f
/* This depends on the fact that a compiled code block has an NMV
header in the first or second words.
{ \
Fre = copy_c_compiled_block (Fre, Old_Contents, Old_Address); \
} while (0)
-
+\f
#else /* no HAS_COMPILER_SUPPORT */
-#define DO_COMPILED_ENTRY(Code, Rel, Fre, Scn, Obj, FObj) do \
+#define COMPILER_BAD_STMT(name) do \
{ \
- fprintf \
- (stderr, \
- "%s: Invoking DO_COMPILED_ENTRY with no compiler support!\n", \
- program_name); \
+ fprintf (stderr, \
+ "%s: Invoking %s with no compiler support!\n", \
+ program_name, name); \
quit (1); \
} while (0)
-#define DO_C_COMPILED_ENTRY DO_COMPILED_ENTRY
+#define DO_COMPILED_ENTRY(Code, Rel, Fre, Scn, Obj, FObj) \
+ COMPILER_BAD_STMT ("DO_COMPILED_ENTRY")
+
+#define DO_COMPILED_BLOCK(Code, Rel, Fre, Scn, Obj, FObj) \
+ COMPILER_BAD_STMT ("DO_COMPILED_BLOCK")
-#define DO_C_COMPILED_BLOCK(Code, Rel, Fre, Scn, Obj, FObj) do \
-{ \
- fprintf \
- (stderr, \
- "%s: Invoking DO_C_COMPILED_BLOCK with no compiler support!\n", \
- program_name); \
- quit (1); \
-} while (0)
+#define DO_INVERTED_COMPILED_BLOCK(Code, Rel, Fre, Scn, Obj, FObj) \
+ COMPILER_BAD_STMT ("DO_INVERTED_COMPILED_BLOCK")
+
+#define DO_C_COMPILED_ENTRY(Code, Rel, Fre, Scn, Obj, FObj) \
+ COMPILER_BAD_STMT ("DO_C_COMPILED_ENTRY")
+
+#define DO_C_COMPILED_BLOCK(Code, Rel, Fre, Scn, Obj, FObj)
+ COMPILER_BAD_STMT ("DO_C_COMPILED_BLOCK")
#endif /* HAS_COMPILER_SUPPORT */
\f
else if (c_compiled_p)
DO_POINTER (*Area, DO_C_COMPILED_BLOCK);
else if (endian_invert_p)
- DO_POINTER (*Area, DO_INVERTED_BLOCK);
+ DO_POINTER (*Area, DO_INVERTED_COMPILED_BLOCK);
else
- DO_POINTER (*Area, DO_VECTOR);
+ DO_POINTER (*Area, DO_COMPILED_BLOCK);
break;
case_compiled_entry_point:
/* This is way larger than needed, but... what the hell? */
- Size = ((2 * (TRAP_MAX_IMMEDIATE + 1))
- + (2 * ((FLOATING_ALIGNMENT + 1) / (sizeof (SCHEME_OBJECT))))
+ Size = (
+ /* All pointers must have datum > TRAP_MAX_IMMEDIATE */
+ (2 * (TRAP_MAX_IMMEDIATE + 1))
+ /* Floating alignment of Heap and Constant Space
+ in incoming image, and of output arenas.
+ */
+ + (5 * ((FLOATING_ALIGNMENT + 1) / (sizeof (SCHEME_OBJECT))))
+ /* Space taken by incoming image. */
+ (Heap_Count + Const_Count)
+ /* We don't know the partition of the outgoing image,
+ so, make each of the areas large enough:
+ Heap pointers and external heap objects,
+ Constant pointers and external constant objects,
+ Pure pointers and exteranl pure objects
+ */
+ (2 * (Heap_Count + (2 * Const_Count)))
+ /* Space for the roots */
+ (NROOTS + 1)
+ /* Space for the primitive table, or space to upgrade */
+ (upgrade_primitives_p
? (3 * PRIMITIVE_UPGRADE_SPACE)
- : Primitive_Table_Size) +
- (allow_compiled_p
- ? (2 + ((c_compiled_p ? 4 : 2) * (Heap_Count + Const_Count)))
- : 0)
+ : Primitive_Table_Size)
+ /* Everything might be compiled code blocks, requiring
+ extra tables to map entries to objects, and block alignment
+ */
+ + (allow_compiled_p
+ ? (2 + ((c_compiled_p ? 5 : 3) * (Heap_Count + Const_Count)))
+ : 0)
+ /* C code IDs */
+ C_Code_Table_Size);
ALLOCATE_HEAP_SPACE (Size,
NBits = NBBits = NChars = 0;
Heap_Start = (NROOTS + (TRAP_MAX_IMMEDIATE + 1));
- Heap_Objects_Start = (Heap_Start + Heap_Count);
+ INDEX_ALIGN_FLOAT (Heap_Start);
+ Heap_Objects_Start = (Heap_Start
+ + (allow_compiled_p
+ ? (2 * Heap_Count)
+ : Heap_Count));
if (! band_p)
dumped_utilities = SHARP_F;
Mem_Base[(Heap_Start - NROOTS) + 0] = dumped_utilities;
Objects = 0;
Constant_Start = (Heap_Objects_Start + Heap_Count);
- Constant_Objects_Start = (Constant_Start + Const_Count);
+ INDEX_ALIGN_FLOAT (Constant_Start);
+ Constant_Objects_Start = (Constant_Start
+ + (allow_compiled_p
+ ? (2 * Const_Count)
+ : Const_Count));
Scan_Constant = Constant_Start;
Free_Constant = Constant_Start;
Free_Cobjects = &Mem_Base[Constant_Objects_Start];
Constant_Objects = 0;
Pure_Start = (Constant_Objects_Start + Const_Count);
- Pure_Objects_Start = (Pure_Start + Const_Count);
+ INDEX_ALIGN_FLOAT (Pure_Start);
+ Pure_Objects_Start = (Pure_Start
+ + (allow_compiled_p
+ ? (2 * Const_Count)
+ : Const_Count));
Scan_Pure = Pure_Start;
Free_Pure = Pure_Start;
Free_Pobjects = &Mem_Base[Pure_Objects_Start];
Pure_Objects = 0;
-
+\f
if (Const_Count == 0)
DO_AREA (HEAP_CODE, Scan, Free, Objects, Free_Objects);
else
WHEN (((Free_Cobjects - &Mem_Base[Pure_Objects_Start])
> Const_Count),
"Free_Cobjects overran Pure Object Space");
-\f
+
/* Output the data */
if (found_ext_prims)
fprintf (stderr, " You may want to fix this by hand.\n");
}
- /* Header */
+ if (! compiled_p)
+ {
+ dumped_processor_type = 0;
+ dumped_interface_version = 0;
+ }
+\f
+ /* Header:
+ Portable Version
+ Machine
+ Version
+ Sub Version
+ Flags
+ Heap Count
+ Heap Base
+ Heap Objects
+ Constant Count
+ Constant Base
+ Constant Objects
+ Pure Count
+ Pure Base
+ Pure Objects
+ & Dumped Object
+ Maximum Stack Offset
+ Number of flonums
+ Number of integers
+ Number of bits in integers
+ Number of bit strings
+ Number of bits in bit strings
+ Number of character strings
+ Number of characters in strings
+ Number of primitives
+ Number of characters in primitives
+ CPU type
+ Compiled code interface version
+ Compiler utilities vector
+ Number of C code blocks
+ Number of characters in C code blocks
+ Number of reserved C entries
+ */
WRITE_HEADER ("Portable Version", "%ld", PORTABLE_VERSION);
WRITE_HEADER ("Machine", "%ld", FASL_INTERNAL_FORMAT);
WRITE_HEADER ("Pure Objects", "%ld", Pure_Objects);
WRITE_HEADER ("& Dumped Object", "%ld",
- (OBJECT_DATUM (Mem_Base[(TRAP_MAX_IMMEDIATE + 1) + 1])));
+ (OBJECT_DATUM (Mem_Base[(Heap_Start - NROOTS) + 1])));
WRITE_HEADER ("Maximum Stack Offset", "%ld", Max_Stack_Offset);
WRITE_HEADER ("Number of flonums", "%ld", NFlonums);
WRITE_HEADER ("Number of primitives", "%ld", Primitive_Table_Length);
WRITE_HEADER ("Number of characters in primitives", "%ld", NPChars);
- if (! compiled_p)
- {
- dumped_processor_type = 0;
- dumped_interface_version = 0;
- }
-
WRITE_HEADER ("CPU type", "%ld", dumped_processor_type);
WRITE_HEADER ("Compiled code interface version", "%ld",
dumped_interface_version);
if (allow_bands_p)
WRITE_HEADER ("Compiler utilities vector", "%ld",
- (OBJECT_DATUM (Mem_Base[(TRAP_MAX_IMMEDIATE + 1) + 0])));
+ (OBJECT_DATUM (Mem_Base[(Heap_Start - NROOTS) + 0])));
else
WRITE_HEADER ("Compiler utilities vector", "%ld", 0);
WRITE_HEADER ("Number of characters in C code blocks", "%ld", NCChars);
WRITE_HEADER ("Number of reserved C entries", "%ld",
(OBJECT_DATUM (c_code_table[0])));
-
+\f
/* Binary Objects */
print_binary_objects (&Mem_Base[Pure_Objects_Start], Pure_Objects);
print_binary_objects (&Mem_Base[Constant_Objects_Start], Constant_Objects);
print_binary_objects (&Mem_Base[Heap_Objects_Start], Objects);
-\f
+
/* Normal Objects: pointers, simple non-pointers (e.g. SHARP_F) */
print_objects (&Mem_Base[Pure_Start], &Mem_Base[Free_Pure]);
/* -*-C-*-
-$Id: psbtobin.c,v 9.55 1993/11/16 04:49:56 gjr Exp $
+$Id: psbtobin.c,v 9.56 1994/01/12 00:30:57 gjr Exp $
-Copyright (c) 1987-1993 Massachusetts Institute of Technology
+Copyright (c) 1987-1994 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
static SCHEME_OBJECT
* Heap, * Constant_Space, * Constant_Top, * Stack_Top,
- * Heap_Base, * Heap_Table, * Heap_Object_Limit, * Free,
- * Const_Base, * Const_Table, * Const_Object_Limit, * Free_Const,
- * Pure_Base, * Pure_Table, * Pure_Object_Limit, * Free_Pure;
+ * Heap_Base, * Heap_Table, * Heap_Object_Limit,
+ * Heap_Pointers, * Free,
+ * Const_Base, * Const_Table, * Const_Object_Limit,
+ * Const_Pointers, * Free_Const,
+ * Pure_Base, * Pure_Table, * Pure_Object_Limit,
+ * Pure_Pointers, * Free_Pure;
static long
DEFUN (Write_Data, (Count, From_Where),
long _addr = (Addr); \
\
if ((_addr >= Dumped_Heap_Base) && (_addr < Dumped_Heap_Limit)) \
- (Where) = &Heap_Object_Limit[_addr - Dumped_Heap_Base]; \
+ (Where) = &Heap_Pointers[_addr - Dumped_Heap_Base]; \
else if ((_addr >= Dumped_Const_Base) \
&& (_addr < Dumped_Const_Limit)) \
- (Where) = &Const_Object_Limit[_addr - Dumped_Const_Base]; \
+ (Where) = &Const_Pointers[_addr - Dumped_Const_Base]; \
else if ((_addr >= Dumped_Pure_Base) \
&& (_addr < Dumped_Pure_Limit)) \
- (Where) = &Pure_Object_Limit[_addr - Dumped_Pure_Base]; \
+ (Where) = &Pure_Pointers[_addr - Dumped_Pure_Base]; \
else \
(void) relocation_error (_addr); \
} while (0)
#define Relocate(Addr) \
((((Addr) >= Dumped_Heap_Base) && ((Addr) < Dumped_Heap_Limit)) \
- ? &Heap_Object_Limit[(Addr) - Dumped_Heap_Base] \
+ ? &Heap_Pointers[(Addr) - Dumped_Heap_Base] \
: ((((Addr) >= Dumped_Const_Base) && ((Addr) < Dumped_Const_Limit)) \
- ? &Const_Object_Limit[(Addr) - Dumped_Const_Base] \
+ ? &Const_Pointers[(Addr) - Dumped_Const_Base] \
: ((((Addr) >= Dumped_Pure_Base) && ((Addr) < Dumped_Pure_Limit)) \
- ? &Pure_Object_Limit[(Addr) - Dumped_Pure_Base] \
+ ? &Pure_Pointers[(Addr) - Dumped_Pure_Base] \
: ((relocation_error (Addr)), ((SCHEME_OBJECT *) NULL)))))
#else
quit (1);
}
\f
+/* Header:
+
+ Portable Version
+ Machine
+ Version
+ Sub Version
+ Flags
+ Heap Count
+ Heap Base
+ Heap Objects
+ Constant Count
+ Constant Base
+ Constant Objects
+ Pure Count
+ Pure Base
+ Pure Objects
+ & Dumped Object
+ Maximum Stack Offset
+ Number of flonums
+ Number of integers
+ Number of bits in integers
+ Number of bit strings
+ Number of bits in bit strings
+ Number of character strings
+ Number of characters in strings
+ Number of primitives
+ Number of characters in primitives
+ CPU type
+ Compiled code interface version
+ Compiler utilities vector
+ Number of C code blocks
+ Number of characters in C code blocks
+ Number of reserved C entries
+
+ */
+\f
static SCHEME_OBJECT * Lowest_Allocated_Address, * Highest_Allocated_Address;
static long
if (Max_Stack_Offset > initial_delta)
initial_delta = Max_Stack_Offset;
- Size = (6 /* SNMV */
- + (2 * ((FLOATING_ALIGNMENT + 1) / (sizeof (SCHEME_OBJECT))))
+ Size = (
+ /* SNMV headers for constant and pure space */
+ 6
+ /* Float alignment of the different arenas */
+ + (5 * ((FLOATING_ALIGNMENT + 1) / (sizeof (SCHEME_OBJECT))))
+ /* All pointers must have datum greater than this */
+ initial_delta
+ /* Incoming heap */
+ (Heap_Count + Heap_Objects)
+ /* Incoming constant space */
+ (Const_Count + Const_Objects)
+ /* Incoming pure space */
+ (Pure_Count + Pure_Objects)
+ /* Maximum space taken up by flonums */
+ (flonum_to_pointer (NFlonums))
+ /* Maximum space taken up by integers */
+ ((NIntegers * (2 + (BYTES_TO_WORDS (sizeof (bignum_digit_type)))))
+ (BYTES_TO_WORDS (BIGNUM_BITS_TO_DIGITS (NBits))))
+ /* Maximum space taken up by strings */
+ ((NStrings * (1 + STRING_CHARS))
+ (char_to_pointer (NChars)))
+ /* Maximum space taken up by bit strings */
+ ((NBitstrs * (1 + BIT_STRING_FIRST_WORD))
+ (BIT_STRING_LENGTH_TO_GC_LENGTH (NBBits)))
+ /* space taken by the primitive table */
+ ((Primitive_Table_Length * (2 + STRING_CHARS))
+ (char_to_pointer (NPChars)))
+ /* Space taken up by the C code block IDs */
+ (1 + (2 * C_Code_Table_Length) + (char_to_pointer (NCChars))));
ALLOCATE_HEAP_SPACE (Size,
Pure_Base = &Constant_Space[2];
Pure_Object_Limit
= (Read_External (Pure_Objects, Pure_Table, Pure_Base));
+ Pure_Pointers = Pure_Object_Limit;
+ ALIGN_FLOAT (Pure_Pointers);
XDEBUGGING (print_external_objects ("Pure", Pure_Table, Pure_Objects));
DEBUGGING (fprintf (stderr, "Pure_Base: 0x%x\n", Pure_Base));
- DEBUGGING (fprintf (stderr, "Pure_Object_Limit: 0x%x\n",
- Pure_Object_Limit));
+ DEBUGGING (fprintf (stderr, "Pure_Pointers: 0x%x\n", Pure_Pointers));
- Const_Base = &Pure_Object_Limit[Pure_Count + 2];
+ Const_Base = &Pure_Pointers[Pure_Count + 2];
Const_Object_Limit
= (Read_External (Const_Objects, Const_Table, Const_Base));
+ Const_Pointers = Const_Object_Limit;
+ ALIGN_FLOAT (Const_Pointers);
XDEBUGGING (print_external_objects ("Constant", Const_Table,
Const_Objects));
DEBUGGING (fprintf (stderr, "Const_Base: 0x%x\n", Const_Base));
- DEBUGGING (fprintf (stderr, "Const_Object_Limit: 0x%x\n",
- Const_Object_Limit));
+ DEBUGGING (fprintf (stderr, "Const_Pointers: 0x%x\n", Const_Pointers));
- Constant_Top = &Const_Object_Limit[Const_Count + 2];
+ Constant_Top = &Const_Pointers[Const_Count + 2];
Heap_Base = Constant_Top;
ALIGN_FLOAT (Heap_Base);
Heap_Object_Limit
= (Read_External (Heap_Objects, Heap_Table, Heap_Base));
+ Heap_Pointers = Heap_Object_Limit;
+ ALIGN_FLOAT (Heap_Pointers);
XDEBUGGING (print_external_objects ("Heap", Heap_Table, Heap_Objects));
DEBUGGING (fprintf (stderr, "Heap_Base: 0x%x\n", Heap_Base));
- DEBUGGING (fprintf (stderr, "Heap_Object_Limit: 0x%x\n",
- Heap_Object_Limit));
+ DEBUGGING (fprintf (stderr, "Heap_Pointers: 0x%x\n", Heap_Pointers));
- primitive_table = &Heap_Object_Limit[Heap_Count];
+ primitive_table = &Heap_Pointers[Heap_Count];
WHEN ((primitive_table > &Heap[Size]), "primitive_table overran memory.");
/* Read the normal objects */
- Free_Pure = (Read_Pointers_and_Relocate (Pure_Count, Pure_Object_Limit));
+ Free_Pure = (Read_Pointers_and_Relocate (Pure_Count, Pure_Pointers));
WHEN ((Free_Pure > (Const_Base - 2)),
"Free_Pure overran Const_Base");
WHEN ((Free_Pure < (Const_Base - 2)),
"Free_Pure did not reach Const_Base");
- Free_Const = (Read_Pointers_and_Relocate (Const_Count,
- Const_Object_Limit));
+ Free_Const = (Read_Pointers_and_Relocate (Const_Count, Const_Pointers));
WHEN ((Free_Const > (Constant_Top - 2)),
"Free_Const overran Constant_Top");
WHEN ((Free_Const < (Constant_Top - 2)),
"Free_Const did not reach Constant_Top");
- Free = (Read_Pointers_and_Relocate (Heap_Count, Heap_Object_Limit));
+ Free = (Read_Pointers_and_Relocate (Heap_Count, Heap_Pointers));
WHEN ((Free > primitive_table), "Free overran primitive_table");
WHEN ((Free < primitive_table), "Free did not reach primitive_table");
projects / mit-scheme.git / commitdiff