/* -*-C-*-
-$Id: bchdmp.c,v 9.70 1993/06/24 03:47:00 gjr Exp $
+$Id: bchdmp.c,v 9.71 1993/08/23 02:20:41 gjr Exp $
Copyright (c) 1987-1993 Massachusetts Institute of Technology
{
/* Should call tmpname */
- return;
+ return ((char *) fname);
}
# define FASDUMP_FILENAME "\\tmp\\fasdump.bin"
# include "nt.h"
# include "ntio.h"
-char *
-DEFUN (mktemp, (fname), unsigned char * fname)
-{
- /* Should call tmpname */
-
- return;
-}
+extern char * mktemp (char *);
# define FASDUMP_FILENAME "\\tmp\\fasdump.bin"
#define fasdump_remember_to_fix(location, contents) \
{ \
if ((fixup == fixup_buffer) && (!(reset_fixes ()))) \
- { \
return (PRIM_INTERRUPT); \
- } \
*--fixup = contents; \
*--fixup = ((SCHEME_OBJECT) location); \
}
#define fasdump_normal_setup() \
{ \
Old = (OBJECT_ADDRESS (Temp)); \
- if ((OBJECT_TYPE (*Old)) == TC_BROKEN_HEART) \
+ if (BROKEN_HEART_P (* Old)) \
{ \
- *Scan = (MAKE_OBJECT_FROM_OBJECTS (Temp, *Old)); \
+ (* Scan) = (MAKE_OBJECT_FROM_OBJECTS (Temp, (* Old))); \
continue; \
} \
New_Address = (MAKE_BROKEN_HEART (To_Address)); \
#define fasdump_flonum_setup() \
{ \
Old = (OBJECT_ADDRESS (Temp)); \
- if ((OBJECT_TYPE (*Old)) == TC_BROKEN_HEART) \
+ if (BROKEN_HEART_P (* Old)) \
{ \
- *Scan = (MAKE_OBJECT_FROM_OBJECTS (Temp, *Old)); \
+ (* 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); \
+ fasdump_remember_to_fix (Old, (* Old)); \
}
#else /* FLOATING_ALIGNMENT */
{ \
To = (dump_and_reset_free_buffer ((To - free_buffer_top), \
&success)); \
- if (!success) \
- { \
+ if (! success) \
return (PRIM_INTERRUPT); \
- } \
} \
}
#define fasdump_normal_end() \
{ \
- *(OBJECT_ADDRESS (Temp)) = New_Address; \
- *Scan = (MAKE_OBJECT_FROM_OBJECTS (Temp, New_Address)); \
+ (* (OBJECT_ADDRESS (Temp))) = New_Address; \
+ (* Scan) = (MAKE_OBJECT_FROM_OBJECTS (Temp, New_Address)); \
continue; \
}
\f
#define fasdump_typeless_setup() \
{ \
- Old = ((SCHEME_OBJECT *) Temp); \
- if (OBJECT_TYPE (*Old) == TC_BROKEN_HEART) \
+ Old = (SCHEME_ADDR_TO_ADDR (Temp)); \
+ if (BROKEN_HEART_P (* Old)) \
{ \
- *Scan = ((SCHEME_OBJECT) OBJECT_ADDRESS (*Old)); \
+ (* Scan) = (ADDR_TO_SCHEME_ADDR (OBJECT_ADDRESS (* Old))); \
continue; \
} \
New_Address = ((SCHEME_OBJECT) To_Address); \
- fasdump_remember_to_fix (Old, *Old); \
+ fasdump_remember_to_fix (Old, (* Old)); \
}
#define fasdump_typeless_end() \
{ \
- (* (OBJECT_ADDRESS (Temp))) = (MAKE_BROKEN_HEART (New_Address)); \
- *Scan = ((SCHEME_OBJECT) New_Address); \
+ (* (SCHEME_ADDR_TO_ADDR (Temp))) = (MAKE_BROKEN_HEART (New_Address)); \
+ (* Scan) = (ADDR_TO_SCHEME_ADDR (New_Address)); \
continue; \
}
fasdump_typeless_end (); \
}
-#define fasdump_compiled_entry() \
-do { \
+#define fasdump_compiled_entry() do \
+{ \
compiled_code_present_p = true; \
- Old = OBJECT_ADDRESS (Temp); \
+ Old = (OBJECT_ADDRESS (Temp)); \
Compiled_BH (false, continue); \
{ \
- SCHEME_OBJECT *Saved_Old = Old; \
+ SCHEME_OBJECT * Saved_Old = Old; \
\
- fasdump_remember_to_fix (Old, *Old); \
+ fasdump_remember_to_fix (Old, (* Old)); \
New_Address = (MAKE_BROKEN_HEART (To_Address)); \
copy_vector (&success); \
if (!success) \
- { \
return (PRIM_INTERRUPT); \
- } \
- *Saved_Old = New_Address; \
+ (* Saved_Old) = New_Address; \
Temp = RELOCATE_COMPILED (Temp, (OBJECT_ADDRESS (New_Address)), \
Saved_Old); \
continue; \
} \
-} while (false)
+} while (0)
-#define fasdump_linked_operator() \
+#define fasdump_linked_operator() do \
{ \
Scan = ((SCHEME_OBJECT *) (word_ptr)); \
BCH_EXTRACT_OPERATOR_LINKAGE_ADDRESS (Temp, Scan); \
fasdump_compiled_entry (); \
BCH_STORE_OPERATOR_LINKAGE_ADDRESS (Temp, Scan); \
-}
+} while (0)
-#define fasdump_manifest_closure() \
+#define fasdump_manifest_closure() do \
{ \
Scan = ((SCHEME_OBJECT *) (word_ptr)); \
BCH_EXTRACT_CLOSURE_ENTRY_ADDRESS (Temp, Scan); \
fasdump_compiled_entry (); \
BCH_STORE_CLOSURE_ENTRY_ADDRESS (Temp, Scan); \
-}
+} while (0)
\f
int
DEFUN (eta_read, (fid, buffer, size),
Boolean
DEFUN (fasdump_exit, (length), long length)
{
- fast SCHEME_OBJECT *fixes, *fix_address;
+ fast SCHEME_OBJECT * fixes, * fix_address;
Boolean result;
Free = saved_free;
#endif /* HAVE_TRUNCATE */
if (length == 0)
- {
(void) (unlink (dump_file_name));
- }
dump_file_name = ((char *) NULL);
fixes = fixup;
while (fixes != fixup_buffer_end)
{
- fix_address = ((SCHEME_OBJECT *) (*fixes++)); /* Where it goes. */
- *fix_address = *fixes++; /* Put it there. */
+ fix_address = ((SCHEME_OBJECT *) (* fixes++)); /* Where it goes. */
+ (* fix_address) = (* fixes++); /* Put it there. */
}
if (fixup_count >= 0)
(gc_file_start_position + (fixup_count << gc_buffer_byte_shift)),
gc_buffer_bytes, "read", "the fixup buffer",
&gc_file_current_position, io_error_retry_p))
- != gc_buffer_bytes)
+ != ((long) gc_buffer_bytes))
{
gc_death (TERM_EXIT,
"fasdump: Could not read back the fasdump fixup information",
fixup_count += 1;
start = (gc_file_start_position + (fixup_count << gc_buffer_byte_shift));
- if (((start + gc_buffer_bytes) > gc_file_end_position)
+ if (((start + ((long) gc_buffer_bytes)) > gc_file_end_position)
|| ((retrying_file_operation
(eta_write, real_gc_file, ((char *) fixup_buffer),
start, gc_buffer_bytes, "write", "the fixup buffer",
&gc_file_current_position, io_error_always_abort))
- != gc_buffer_bytes))
+ != ((long) gc_buffer_bytes)))
return (false);
fixup = fixup_buffer_end;
return (true);
long
DEFUN (dumploop, (Scan, To_ptr, To_Address_ptr),
- fast SCHEME_OBJECT *Scan AND
- SCHEME_OBJECT **To_ptr AND
- SCHEME_OBJECT **To_Address_ptr)
+ fast SCHEME_OBJECT * Scan AND
+ SCHEME_OBJECT ** To_ptr AND
+ SCHEME_OBJECT ** To_Address_ptr)
{
- fast SCHEME_OBJECT *To, *Old, Temp, *To_Address, New_Address;
+ fast SCHEME_OBJECT * To, * Old, Temp, * To_Address, New_Address;
Boolean success;
success = true;
- To = *To_ptr;
- To_Address = *To_Address_ptr;
+ To = (* To_ptr);
+ To_Address = (* To_Address_ptr);
for ( ; Scan != To; Scan++)
{
- Temp = *Scan;
+ Temp = (* Scan);
Switch_by_GC_Type (Temp)
{
case TC_BROKEN_HEART:
if ((OBJECT_DATUM (Temp)) == 0)
- {
break;
- }
if (Temp != (MAKE_POINTER_OBJECT (TC_BROKEN_HEART, Scan)))
{
sprintf (gc_death_message_buffer,
/*NOTREACHED*/
}
if (Scan != scan_buffer_top)
- {
goto end_dumploop;
- }
/* The -1 is here because of the Scan++ in the for header. */
Scan = ((dump_and_reload_scan_buffer (0, &success)) - 1);
if (!success)
- {
return (PRIM_INTERRUPT);
- }
continue;
\f
case TC_MANIFEST_NM_VECTOR:
and if so we need a new bufferfull. */
Scan += (OBJECT_DATUM (Temp));
if (Scan < scan_buffer_top)
- {
break;
- }
else
{
unsigned long overflow;
&success)) +
(overflow & gc_buffer_mask)) - 1);
if (!success)
- {
return (PRIM_INTERRUPT);
- }
break;
}
case TC_PRIMITIVE:
case TC_PCOMB0:
- *Scan = (dump_renumber_primitive (*Scan));
+ (* Scan) = (dump_renumber_primitive (* Scan));
break;
\f
case_compiled_entry_point:
fasdump_compiled_entry ();
- *Scan = Temp;
+ (* Scan) = Temp;
break;
case TC_LINKAGE_SECTION:
max_count -= count;
for ( ; --count >= 0; Scan += 1)
{
- Temp = *Scan;
+ Temp = (* Scan);
fasdump_typeless_pointer (copy_quadruple (), 4);
}
if (max_count != 0)
long overflow;
word_ptr = (FIRST_OPERATOR_LINKAGE_ENTRY (Scan));
- if (word_ptr > ((char *) scan_buffer_top))
+ if (! (word_ptr > ((char *) scan_buffer_top)))
+ BCH_START_OPERATOR_RELOCATION (Scan);
+ else
{
overflow = (word_ptr - ((char *) Scan));
extend_scan_buffer (word_ptr, To);
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)) -
word_ptr = next_ptr,
next_ptr = (NEXT_LINKAGE_OPERATOR_ENTRY (word_ptr)))
{
- if (next_ptr > ((char *) scan_buffer_top))
+ if (! (next_ptr > ((char *) scan_buffer_top)))
+ fasdump_linked_operator ();
+ else
{
extend_scan_buffer (next_ptr, To);
fasdump_linked_operator ();
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);
}
default:
- {
gc_death (TERM_EXIT,
"fasdump: Unknown compiler linkage kind.",
Scan, Free);
/*NOTREACHED*/
- }
}
break;
}
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)))
+ fasdump_manifest_closure ();
+ else
{
char * entry_end;
long de, dw;
word_ptr = (entry_end - dw);
end_ptr = (entry_end + de);
}
- else
- fasdump_manifest_closure ();
}
Scan = ((SCHEME_OBJECT *) (end_ptr));
BCH_END_CLOSURE_RELOCATION (Scan);
case TC_REFERENCE_TRAP:
if ((OBJECT_DATUM (Temp)) <= TRAP_MAX_IMMEDIATE)
- {
/* It is a non pointer. */
break;
- }
/* It is a pair, fall through. */
case TC_WEAK_CONS:
case TC_INTERNED_SYMBOL:
{
fasdump_normal_setup ();
- *To++ = *Old;
- *To++ = BROKEN_HEART_ZERO;
+ (* To++) = (* Old);
+ (* To++) = BROKEN_HEART_ZERO;
fasdump_transport_end (2);
fasdump_normal_end ();
}
case TC_UNINTERNED_SYMBOL:
{
fasdump_normal_setup ();
- *To++ = *Old;
- *To++ = UNBOUND_OBJECT;
+ (* To++) = (* Old);
+ (* To++) = UNBOUND_OBJECT;
fasdump_transport_end (2);
fasdump_normal_end ();
}
case TC_VARIABLE:
{
fasdump_normal_setup ();
- *To++ = *Old;
- *To++ = UNCOMPILED_VARIABLE;
- *To++ = SHARP_F;
+ (* To++) = (* Old);
+ (* To++) = UNCOMPILED_VARIABLE;
+ (* To++) = SHARP_F;
fasdump_transport_end (3);
fasdump_normal_end ();
}
Move_Vector:
copy_vector (&success);
if (!success)
- {
return (PRIM_INTERRUPT);
- }
fasdump_normal_end ();
case TC_ENVIRONMENT:
case TC_FUTURE:
fasdump_normal_setup ();
if (!(Future_Spliceable (Temp)))
- {
goto Move_Vector;
- }
- *Scan = (Future_Value (Temp));
+ (* Scan) = (Future_Value (Temp));
Scan -= 1;
continue;
case TC_STACK_ENVIRONMENT:
case_Fasload_Non_Pointer:
break;
-
}
}
end_dumploop:
- *To_ptr = To;
- *To_Address_ptr = To_Address;
+ (* To_ptr) = To;
+ (* To_Address_ptr) = To_Address;
return (PRIM_DONE);
}
\f
static SCHEME_OBJECT
DEFUN (dump_to_file, (root, fname),
- SCHEME_OBJECT root AND
- char *fname)
+ SCHEME_OBJECT root AND char * fname)
{
Boolean success;
long value, length, hlength, tlength, tsize;
- SCHEME_OBJECT *dumped_object, *free_buffer, *dummy;
- SCHEME_OBJECT *table_start, *table_end, *table_top;
+ SCHEME_OBJECT * dumped_object, * free_buffer, * dummy;
+ SCHEME_OBJECT * table_start, * table_end, * table_top;
SCHEME_OBJECT header[FASL_HEADER_LENGTH];
if (fixup_buffer == ((SCHEME_OBJECT *) NULL))
dummy = free_buffer;
FLOAT_ALIGN_FREE (Free, dummy);
- *free_buffer++ = root;
+ (* free_buffer++) = root;
dumped_object = Free;
Free += 1;
\f
{
fasdump_exit (0);
if (value == PRIM_INTERRUPT)
- {
return (SHARP_F);
- }
else
- {
signal_error_from_primitive (value);
- }
}
end_transport (&success);
- if (!success)
+ if (! success)
{
fasdump_exit (0);
return (SHARP_F);
root = (ARG_REF (1));
if (STRING_P (ARG_REF (2)))
- {
PRIMITIVE_RETURN (dump_to_file (root, (STRING_ARG (2))));
- }
else
{
extern char * EXFUN (mktemp, (char *));
(void) mktemp (temp_name);
fasdump_result = (dump_to_file (root, (temp_name)));
if (fasdump_result != SHARP_T)
- {
PRIMITIVE_RETURN (fasdump_result);
- }
temp_channel = (OS_open_input_file (temp_name));
copy_result = (OS_channel_copy ((OS_file_length (temp_channel)),
OS_channel_close (temp_channel);
OS_file_remove (temp_name);
if (copy_result < 0)
- {
signal_error_from_primitive (ERR_IO_ERROR);
- }
PRIMITIVE_RETURN (SHARP_T);
}
}
Free[COMB_1_FN] = (ARG_REF (1));
Free[COMB_1_ARG_1] = SHARP_F;
Free += 2;
- *Free++ = Combination;
- *Free++ = compiler_utilities;
- *Free = (MAKE_POINTER_OBJECT (TC_LIST, (Free - 2)));
- Free++; /* Some compilers are TOO clever about this and increment Free
+ (* Free++) = Combination;
+ (* Free++) = compiler_utilities;
+ (* Free) = (MAKE_POINTER_OBJECT (TC_LIST, (Free - 2)));
+ Free ++; /* Some compilers are TOO clever about this and increment Free
before calculating Free-2! */
table_start = Free;
table_end = (cons_whole_primitive_table (Free, Heap_Top, &table_length));
if (table_end >= Heap_Top)
- {
result = false;
- }
else
{
CONST char * filename = ((CONST char *) (STRING_LOC ((ARG_REF (2)), 0)));
dump_channel = (OS_open_dump_file (filename));
if (dump_channel == NO_CHANNEL)
- {
error_bad_range_arg (2);
- }
result = (Write_File ((Free - 1),
((long) (Free - Heap_Bottom)), Heap_Bottom,
((long) (Free_Constant - Constant_Space)),
(compiler_utilities != SHARP_F), true));
OS_channel_close_noerror (dump_channel);
if (!result)
- {
OS_file_remove (filename);
- }
}
Band_Dump_Exit_Hook ();
Free = saved_free;
/* -*-C-*-
-$Id: bchgcc.h,v 9.53 1993/08/22 22:19:10 gjr Exp $
+$Id: bchgcc.h,v 9.54 1993/08/23 02:21:13 gjr Exp $
Copyright (c) 1987-1993 Massachusetts Institute of Technology
#define relocate_normal_end() \
{ \
- *(OBJECT_ADDRESS (Temp)) = New_Address; \
- *Scan = (MAKE_OBJECT_FROM_OBJECTS (Temp, New_Address)); \
+ (* (OBJECT_ADDRESS (Temp))) = New_Address; \
+ (* Scan) = (MAKE_OBJECT_FROM_OBJECTS (Temp, New_Address)); \
continue; \
}
#define relocate_typeless_setup() \
{ \
- Old = ((SCHEME_OBJECT *) Temp); \
+ Old = (SCHEME_ADDR_TO_ADDR (Temp)); \
if (Old >= Low_Constant) \
continue; \
- if ((OBJECT_TYPE (*Old)) == TC_BROKEN_HEART) \
+ if (BROKEN_HEART_P (* Old)) \
{ \
- *Scan = ((SCHEME_OBJECT) (OBJECT_ADDRESS (*Old))); \
+ (* Scan) = (ADDR_TO_SCHEME_ADDR (OBJECT_ADDRESS (* Old))); \
continue; \
} \
New_Address = ((SCHEME_OBJECT) To_Address); \
}
-#define relocate_typeless_transport(copy_code, length) \
-{ \
- relocate_normal_transport (copy_code, length); \
-}
-
#define relocate_typeless_end() \
{ \
- (* ((SCHEME_OBJECT *) Temp)) = (MAKE_BROKEN_HEART (New_Address)); \
- *Scan = New_Address; \
+ (* (SCHEME_ADDR_TO_ADDR (Temp))) = (MAKE_BROKEN_HEART (New_Address)); \
+ (* Scan) = (ADDR_TO_SCHEME_ADDR (New_Address)); \
continue; \
}
#define relocate_typeless_pointer(copy_code, length) \
{ \
relocate_typeless_setup (); \
- relocate_typeless_transport (copy_code, length); \
+ relocate_normal_transport (copy_code, length); \
relocate_typeless_end (); \
}
\f
} \
} while (0)
-#define relocate_linked_operator(in_gc_p) \
+#define relocate_linked_operator(in_gc_p) do \
{ \
Scan = ((SCHEME_OBJECT *) (word_ptr)); \
BCH_EXTRACT_OPERATOR_LINKAGE_ADDRESS (Temp, Scan); \
relocate_compiled_entry (in_gc_p); \
BCH_STORE_OPERATOR_LINKAGE_ADDRESS (Temp, Scan); \
-}
+} while (0)
-#define relocate_manifest_closure(in_gc_p) \
+#define relocate_manifest_closure(in_gc_p) do \
{ \
Scan = ((SCHEME_OBJECT *) (word_ptr)); \
BCH_EXTRACT_CLOSURE_ENTRY_ADDRESS (Temp, Scan); \
relocate_compiled_entry (in_gc_p); \
BCH_STORE_CLOSURE_ENTRY_ADDRESS (Temp, Scan); \
-}
+} while (0)
#endif /* _BCHGCC_H_INCLUDED */
/* -*-C-*-
-$Id: bchgcl.c,v 9.45 1993/06/24 07:06:57 gjr Exp $
+$Id: bchgcl.c,v 9.46 1993/08/23 02:21:42 gjr Exp $
Copyright (c) 1987-1992 Massachusetts Institute of Technology
\f
SCHEME_OBJECT *
DEFUN (GCLoop, (Scan, To_ptr, To_Address_ptr),
- fast SCHEME_OBJECT *Scan AND
- SCHEME_OBJECT **To_ptr AND
- SCHEME_OBJECT **To_Address_ptr)
+ fast SCHEME_OBJECT * Scan AND
+ SCHEME_OBJECT ** To_ptr AND
+ SCHEME_OBJECT ** To_Address_ptr)
{
- fast SCHEME_OBJECT *To, *Old, Temp, *Low_Constant, *To_Address, New_Address;
+ fast SCHEME_OBJECT
+ * To, * Old, Temp, * Low_Constant,
+ * To_Address, New_Address;
- To = *To_ptr;
- To_Address = *To_Address_ptr;
+ To = (* To_ptr);
+ To_Address = (* To_Address_ptr);
Low_Constant = Constant_Space;
for ( ; Scan != To; Scan++)
{
- Temp = *Scan;
+ Temp = (* Scan);
Switch_by_GC_Type (Temp)
{
case TC_BROKEN_HEART:
and if so we need a new bufferfull. */
Scan += (OBJECT_DATUM (Temp));
if (Scan < scan_buffer_top)
- {
break;
- }
else
{
unsigned long overflow;
\f
case_compiled_entry_point:
relocate_compiled_entry (true);
- *Scan = Temp;
+ (* Scan) = Temp;
break;
case TC_LINKAGE_SECTION:
max_count -= count;
for ( ; --count >= 0; Scan += 1)
{
- Temp = *Scan;
+ Temp = (* Scan);
relocate_typeless_pointer (copy_quadruple (), 4);
}
if (max_count != 0)
long overflow;
word_ptr = (FIRST_OPERATOR_LINKAGE_ENTRY (Scan));
- if (word_ptr > ((char *) scan_buffer_top))
+ if (! (word_ptr > ((char *) scan_buffer_top)))
+ BCH_START_OPERATOR_RELOCATION (Scan);
+ else
{
overflow = (word_ptr - ((char *) Scan));
extend_scan_buffer (word_ptr, To);
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)) -
word_ptr = next_ptr,
next_ptr = (NEXT_LINKAGE_OPERATOR_ENTRY (word_ptr)))
{
- if (next_ptr > ((char *) scan_buffer_top))
+ if (! (next_ptr > ((char *) scan_buffer_top)))
+ relocate_linked_operator (true);
+ else
{
extend_scan_buffer (next_ptr, To);
relocate_linked_operator (true);
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);
}
default:
- {
gc_death (TERM_EXIT,
"GC: Unknown compiler linkage kind.",
Scan, Free);
/*NOTREACHED*/
- }
}
break;
}
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)))
+ relocate_manifest_closure (true);
+ else
{
char * entry_end;
long de, dw;
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);
case TC_REFERENCE_TRAP:
if ((OBJECT_DATUM (Temp)) <= TRAP_MAX_IMMEDIATE)
- {
/* It is a non pointer. */
break;
- }
/* It is a pair, fall through. */
case_Pair:
relocate_normal_pointer (copy_pair (), 2);
}
}
end_gcloop:
- *To_ptr = To;
- *To_Address_ptr = To_Address;
+ (* To_ptr) = To;
+ (* To_Address_ptr) = To_Address;
return (Scan);
}
/* -*-C-*-
-$Id: bchpur.c,v 9.60 1993/08/22 22:39:01 gjr Exp $
+$Id: bchpur.c,v 9.61 1993/08/23 02:22:09 gjr Exp $
Copyright (c) 1987-1992 Massachusetts Institute of Technology
Old = OBJECT_ADDRESS (Temp); \
if (Old >= Low_Constant) \
continue; \
- if (OBJECT_TYPE (*Old) == TC_BROKEN_HEART) \
- { \
+ if (BROKEN_HEART_P (* Old)) \
continue; \
- } \
New_Address = (MAKE_BROKEN_HEART (To_Address)); \
}
#define relocate_indirect_end() \
{ \
- *OBJECT_ADDRESS (Temp) = New_Address; \
+ (* (OBJECT_ADDRESS (Temp))) = New_Address; \
continue; \
}
\f
static SCHEME_OBJECT *
DEFUN (purifyloop, (Scan, To_ptr, To_Address_ptr, purify_mode),
- fast SCHEME_OBJECT *Scan AND
- SCHEME_OBJECT **To_ptr AND
- SCHEME_OBJECT **To_Address_ptr AND
+ fast SCHEME_OBJECT * Scan AND
+ SCHEME_OBJECT ** To_ptr AND
+ SCHEME_OBJECT ** To_Address_ptr AND
int purify_mode)
{
- fast SCHEME_OBJECT *To, *Old, Temp, *Low_Constant, *To_Address, New_Address;
+ fast SCHEME_OBJECT
+ * To, * Old, Temp, * Low_Constant,
+ * To_Address, New_Address;
- To = *To_ptr;
- To_Address = *To_Address_ptr;
+ To = (* To_ptr);
+ To_Address = (* To_Address_ptr);
Low_Constant = Constant_Space;
for ( ; Scan != To; Scan++)
{
- Temp = *Scan;
+ Temp = (* Scan);
Switch_by_GC_Type (Temp)
{
case TC_BROKEN_HEART:
if (purify_mode == PURE_COPY)
break;
relocate_compiled_entry (false);
- *Scan = Temp;
+ (* Scan) = Temp;
break;
case TC_LINKAGE_SECTION:
{
if (purify_mode == PURE_COPY)
- {
gc_death (TERM_COMPILER_DEATH,
"purifyloop: linkage section in pure area",
Scan, To);
/*NOTREACHED*/
- }
switch (READ_LINKAGE_KIND (Temp))
{
case REFERENCE_LINKAGE_KIND:
long overflow;
word_ptr = (FIRST_OPERATOR_LINKAGE_ENTRY (Scan));
- if (word_ptr > ((char *) scan_buffer_top))
+ if (! (word_ptr > ((char *) scan_buffer_top)))
+ BCH_START_OPERATOR_RELOCATION (Scan);
+ else
{
overflow = (word_ptr - ((char *) Scan));
extend_scan_buffer (word_ptr, To);
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)) -
word_ptr = next_ptr,
next_ptr = (NEXT_LINKAGE_OPERATOR_ENTRY (word_ptr)))
{
- if (next_ptr > ((char *) scan_buffer_top))
+ if (! (next_ptr > ((char *) scan_buffer_top)))
+ relocate_linked_operator (false);
+ else
{
extend_scan_buffer (next_ptr, To);
relocate_linked_operator (false);
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);
}
default:
- {
gc_death (TERM_EXIT,
"purify: Unknown compiler linkage kind.",
Scan, Free);
/*NOTREACHED*/
- }
}
break;
}
case TC_MANIFEST_CLOSURE:
{
if (purify_mode == PURE_COPY)
- {
gc_death (TERM_COMPILER_DEATH,
"purifyloop: manifest closure in pure area",
Scan, To);
/*NOTREACHED*/
- }
}
{
fast long count;
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)))
+ relocate_manifest_closure (false);
+ else
{
char * entry_end;
long de, dw;
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);
relocate_normal_setup();
if (!(Future_Spliceable (Temp)))
goto Move_Vector;
- *Scan = (Future_Value (Temp));
+ (* Scan) = (Future_Value (Temp));
Scan -= 1;
continue;
}
}
end_purifyloop:
- *To_ptr = To;
- *To_Address_ptr = To_Address;
+ (* To_ptr) = To;
+ (* To_Address_ptr) = To_Address;
return (Scan);
}
\f
*/
static SCHEME_OBJECT *
-DEFUN (purify_header_overflow, (free_buffer), SCHEME_OBJECT *free_buffer)
+DEFUN (purify_header_overflow, (free_buffer), SCHEME_OBJECT * free_buffer)
{
- SCHEME_OBJECT *scan_buffer;
+ SCHEME_OBJECT * scan_buffer;
long delta;
delta = (free_buffer - free_buffer_top);
fast SCHEME_OBJECT *ptr, *ptrend;
for (ptr = block_start, ptrend = old_free; ptr != ptrend; )
- *free_buffer_ptr++ = *ptr++;
+ * free_buffer_ptr++ = *ptr++;
}
new_free += 2;
- *free_buffer_ptr++ = SHARP_F; /* Pure block header. */
- *free_buffer_ptr++ = object;
+ * free_buffer_ptr++ = SHARP_F; /* Pure block header. */
+ * free_buffer_ptr++ = object;
if (free_buffer_ptr >= free_buffer_top)
free_buffer_ptr =
(dump_and_reset_free_buffer ((free_buffer_ptr - free_buffer_top), NULL));
- if (flag == SHARP_T)
+ if (flag != SHARP_T)
+ pure_length = 3;
+ else
{
scan_start = ((initialize_scan_buffer (block_start)) + delta);
result = (purifyloop (scan_start, &free_buffer_ptr,
&new_free, PURE_COPY));
if (result != free_buffer_ptr)
- {
gc_death (TERM_BROKEN_HEART,
"purify: pure copy ended too early",
result, free_buffer_ptr);
/*NOTREACHED*/
- }
pure_length = ((new_free - old_free) + 1);
}
- else
- pure_length = 3;
new_free += 2;
- *free_buffer_ptr++ = (MAKE_OBJECT (TC_MANIFEST_SPECIAL_NM_VECTOR, 1));
- *free_buffer_ptr++ = (MAKE_OBJECT (CONSTANT_PART, pure_length));
+ * free_buffer_ptr++ = (MAKE_OBJECT (TC_MANIFEST_SPECIAL_NM_VECTOR, 1));
+ * free_buffer_ptr++ = (MAKE_OBJECT (CONSTANT_PART, pure_length));
if (free_buffer_ptr >= free_buffer_top)
free_buffer_ptr = (purify_header_overflow (free_buffer_ptr));
\f
result = (GCLoop (scan_start, &free_buffer_ptr, &new_free));
if (result != free_buffer_ptr)
- {
gc_death (TERM_BROKEN_HEART, "purify: constant copy ended too early",
result, free_buffer_ptr);
/*NOTREACHED*/
- }
new_free += 2;
length = (new_free - old_free);
- *free_buffer_ptr++ = (MAKE_OBJECT (TC_MANIFEST_SPECIAL_NM_VECTOR, 1));
- *free_buffer_ptr++ = (MAKE_OBJECT (END_OF_BLOCK, (length - 1)));
+ * 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 (new_free)))
- {
gc_death (TERM_NO_SPACE, "purify: object too large", NULL, NULL);
/*NOTREACHED*/
- }
final_reload (block_start,
(new_free - block_start),
"the new constant space block");
- *old_free++ = (MAKE_OBJECT (TC_MANIFEST_SPECIAL_NM_VECTOR, pure_length));
- *old_free = (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)));
Free_Constant = new_free;
SET_CONSTANT_TOP ();
purify_result = (purify (object, (ARG_REF (2))));
words_free = (LONG_TO_UNSIGNED_FIXNUM (MemTop - Free));
result = (MAKE_POINTER_OBJECT (TC_LIST, Free));
- (*Free++) = purify_result;
- (*Free++) = words_free;
+ (* Free++) = purify_result;
+ (* Free++) = words_free;
}
run_post_gc_hooks ();
POP_PRIMITIVE_FRAME (3);
/* -*-C-*-
-$Id: i386.h,v 1.22 1993/08/21 01:51:42 gjr Exp $
+$Id: i386.h,v 1.23 1993/08/23 02:19:52 gjr Exp $
Copyright (c) 1992-1993 Massachusetts Institute of Technology
+ i386_pc_displacement_relocation); \
(* ((long *) displacement_address)) = new_displacement; \
(var) = ((SCHEME_OBJECT) \
- ((((long) (v_addr)) + 5) + new_displacement)); \
+ ((ADDR_TO_SCHEME_ADDR (((long) (v_addr)) + 5)) \
+ + new_displacement)); \
} while (0)
#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)); \
+ = (((long) (target)) \
+ - (ADDR_TO_SCHEME_ADDR (((long) (v_addr)) + 5))); \
} while (0)
\f
#define START_CLOSURE_RELOCATION(scan) do \
#define START_OPERATOR_RELOCATION(scan) do \
{ \
- SCHEME_OBJECT * _new, * _old, _loc; \
+ SCHEME_OBJECT * _scan, * _old, _loc; \
\
- _new = (((SCHEME_OBJECT *) (scan)) + 1); \
- _old = ((SCHEME_OBJECT *) (* _new)); \
- _loc = (ADDR_TO_SCHEME_ADDR (_new)); \
+ _scan = (((SCHEME_OBJECT *) (scan)) + 1); \
+ _old = ((SCHEME_OBJECT *) (* _scan)); \
+ _loc = (ADDR_TO_SCHEME_ADDR (_scan)); \
\
- (* _new) = _loc; \
+ (* _scan) = _loc; \
i386_pc_displacement_relocation = (((long) _old) - ((long) _loc)); \
} while (0)
\f
#define BCH_START_OPERATOR_RELOCATION(scan) do \
{ \
- SCHEME_OBJECT * _scan, * _new, * _old; \
+ SCHEME_OBJECT * _scan, * _old, _loc; \
\
_scan = (((SCHEME_OBJECT *) (scan)) + 1); \
- _new = ((SCHEME_OBJECT *) \
- (SCAN_POINTER_TO_NEWSPACE_ADDRESS (_scan))); \
_old = ((SCHEME_OBJECT *) (* _scan)); \
+ _loc = (ADDR_TO_SCHEME_ADDR \
+ (SCAN_POINTER_TO_NEWSPACE_ADDRESS (_scan))); \
\
- * _scan = ((SCHEME_OBJECT) _new); \
- i386_pc_displacement_relocation = (((long) _old) - ((long) _new)); \
+ * _scan = _loc; \
+ i386_pc_displacement_relocation = (((long) _old) - ((long) _loc)); \
} while (0)
#define BCH_END_OPERATOR_RELOCATION END_OPERATOR_RELOCATION
projects / mit-scheme.git / commitdiff