~ chicken-core (chicken-5) 02ec62cebe699c4ea38693b1952b558c238f2025
commit 02ec62cebe699c4ea38693b1952b558c238f2025
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Sun Jul 12 22:09:10 2015 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Sun Jul 12 22:09:10 2015 +0200
runtime.c compiles
diff --git a/chicken.h b/chicken.h
index 267b7abb..a0e3b461 100644
--- a/chicken.h
+++ b/chicken.h
@@ -774,7 +774,7 @@ typedef struct C_ptable_entry_struct
void *ptr;
} C_PTABLE_ENTRY;
-typedef void (C_ccall *C_proc)(C_word, C_word *);
+typedef void (C_ccall *C_proc)(C_word, C_word *) C_noret;
/* Macros: */
@@ -1219,7 +1219,7 @@ typedef void (C_ccall *C_proc)(C_word, C_word *);
#define C_pointer_address(x) ((C_byte *)C_block_item((x), 0))
#define C_block_address(ptr, n, x) C_a_unsigned_int_to_num(ptr, n, x)
#define C_offset_pointer(x, y) (C_pointer_address(x) + (y))
-#define C_kontinue(k, r) ((C_proc2)(void *)C_block_item(k,0))(2, (k), (r))
+#define C_kontinue(k, r) { C_word avk[ 2 ]; avk[ 0 ] = (k); avk[ 1 ] = (r); ((C_proc)(void *)C_block_item((k),0))(2, avk); }
#define C_fetch_byte(x, p) (((unsigned C_byte *)C_data_pointer(x))[ p ])
#define C_poke_integer(x, i, n) (C_set_block_item(x, C_unfix(i), C_num_to_int(n)), C_SCHEME_UNDEFINED)
#define C_pointer_to_block(p, x) (C_set_block_item(p, 0, (C_word)C_data_pointer(x)), C_SCHEME_UNDEFINED)
@@ -1595,7 +1595,7 @@ C_varextern C_TLS void *C_restart_address;
C_varextern C_TLS int C_entry_point_status;
C_varextern C_TLS int C_gui_mode;
-C_varextern C_TLS void (C_fcall *C_restart_trampoline)(void *proc) C_regparm C_noret;
+C_varextern C_TLS void *C_restart_trampoline;
C_varextern C_TLS void (*C_pre_gc_hook)(int mode);
C_varextern C_TLS void (*C_post_gc_hook)(int mode, C_long ms);
C_varextern C_TLS void (*C_panic_hook)(C_char *msg);
@@ -1746,62 +1746,62 @@ C_fctexport C_word C_dbg_hook(C_word x);
C_fctexport void C_use_private_repository(C_char *path);
C_fctexport C_char *C_private_repository_path();
-C_fctimport C_cpsproc(C_toplevel);
-C_fctimport C_cpsproc(C_invalid_procedure);
-C_fctexport C_cpsproc(C_stop_timer);
-C_fctexport C_cpsproc(C_apply);
-C_fctexport C_cpsproc(C_call_cc);
-C_fctexport C_cpsproc(C_continuation_graft);
-C_fctexport C_cpsproc(C_values);
-C_fctexport C_cpsproc(C_apply_values);
-C_fctexport C_cpsproc(C_call_with_values);
-C_fctexport C_cpsproc(C_u_call_with_values);
-C_fctexport C_cpsproc(C_times);
-C_fctexport C_cpsproc(C_plus);
-C_fctexport C_cpsproc(C_minus);
-C_fctexport C_cpsproc(C_divide);
-C_fctexport C_cpsproc(C_nequalp);
-C_fctexport C_cpsproc(C_greaterp);
-C_fctexport C_cpsproc(C_lessp);
-C_fctexport C_cpsproc(C_greater_or_equal_p);
-C_fctexport C_cpsproc(C_less_or_equal_p);
-C_fctexport C_cpsproc(C_expt);
-C_fctexport C_cpsproc(C_gc);
-C_fctexport C_cpsproc(C_open_file_port);
-C_fctexport C_cpsproc(C_allocate_vector);
-C_fctexport C_cpsproc(C_string_to_symbol);
-C_fctexport C_cpsproc(C_build_symbol);
-C_fctexport C_cpsproc(C_flonum_fraction);
-C_fctexport C_cpsproc(C_flonum_rat);
-C_fctexport C_cpsproc(C_quotient);
-C_fctexport C_cpsproc(C_number_to_string);
-C_fctexport C_cpsproc(C_fixnum_to_string);
-C_fctexport C_cpsproc(C_make_structure);
-C_fctexport C_cpsproc(C_make_symbol);
-C_fctexport C_cpsproc(C_make_pointer);
-C_fctexport C_cpsproc(C_make_tagged_pointer);
-C_fctexport C_cpsproc(C_ensure_heap_reserve);
-C_fctexport C_cpsproc(C_return_to_host);
-C_fctexport C_cpsproc(C_get_symbol_table_info);
-C_fctexport C_cpsproc(C_get_memory_info);
-C_fctexport C_cpsproc(C_context_switch);
-C_fctexport C_cpsproc(C_peek_signed_integer);
-C_fctexport C_cpsproc(C_peek_unsigned_integer);
-C_fctexport C_cpsproc(C_decode_seconds);
-C_fctexport C_cpsproc(C_software_type);
-C_fctexport C_cpsproc(C_machine_type);
-C_fctexport C_cpsproc(C_machine_byte_order);
-C_fctexport C_cpsproc(C_software_version);
-C_fctexport C_cpsproc(C_build_platform);
-C_fctexport C_cpsproc(C_register_finalizer);
-C_fctexport C_cpsproc(C_set_dlopen_flags);
-C_fctexport C_cpsproc(C_dload);
-C_fctexport C_cpsproc(C_become);
-C_fctexport C_cpsproc(C_locative_ref);
-C_fctexport C_cpsproc(C_call_with_cthulhu);
-C_fctexport C_cpsproc(C_copy_closure);
-C_fctexport C_cpsproc(C_dump_heap_state);
-C_fctexport C_cpsproc(C_filter_heap_objects);
+C_fctimport C_cpsproc(C_toplevel) C_noret;
+C_fctimport C_cpsproc(C_invalid_procedure) C_noret;
+C_fctexport C_cpsproc(C_stop_timer) C_noret;
+C_fctexport C_cpsproc(C_apply) C_noret;
+C_fctexport C_cpsproc(C_call_cc) C_noret;
+C_fctexport C_cpsproc(C_continuation_graft) C_noret;
+C_fctexport C_cpsproc(C_values) C_noret;
+C_fctexport C_cpsproc(C_apply_values) C_noret;
+C_fctexport C_cpsproc(C_call_with_values) C_noret;
+C_fctexport C_cpsproc(C_u_call_with_values) C_noret;
+C_fctexport C_cpsproc(C_times) C_noret;
+C_fctexport C_cpsproc(C_plus) C_noret;
+C_fctexport C_cpsproc(C_minus) C_noret;
+C_fctexport C_cpsproc(C_divide) C_noret;
+C_fctexport C_cpsproc(C_nequalp) C_noret;
+C_fctexport C_cpsproc(C_greaterp) C_noret;
+C_fctexport C_cpsproc(C_lessp) C_noret;
+C_fctexport C_cpsproc(C_greater_or_equal_p) C_noret;
+C_fctexport C_cpsproc(C_less_or_equal_p) C_noret;
+C_fctexport C_cpsproc(C_expt) C_noret;
+C_fctexport C_cpsproc(C_gc) C_noret;
+C_fctexport C_cpsproc(C_open_file_port) C_noret;
+C_fctexport C_cpsproc(C_allocate_vector) C_noret;
+C_fctexport C_cpsproc(C_string_to_symbol) C_noret;
+C_fctexport C_cpsproc(C_build_symbol) C_noret;
+C_fctexport C_cpsproc(C_flonum_fraction) C_noret;
+C_fctexport C_cpsproc(C_flonum_rat) C_noret;
+C_fctexport C_cpsproc(C_quotient) C_noret;
+C_fctexport C_cpsproc(C_number_to_string) C_noret;
+C_fctexport C_cpsproc(C_fixnum_to_string) C_noret;
+C_fctexport C_cpsproc(C_make_structure) C_noret;
+C_fctexport C_cpsproc(C_make_symbol) C_noret;
+C_fctexport C_cpsproc(C_make_pointer) C_noret;
+C_fctexport C_cpsproc(C_make_tagged_pointer) C_noret;
+C_fctexport C_cpsproc(C_ensure_heap_reserve) C_noret;
+C_fctexport C_cpsproc(C_return_to_host) C_noret;
+C_fctexport C_cpsproc(C_get_symbol_table_info) C_noret;
+C_fctexport C_cpsproc(C_get_memory_info) C_noret;
+C_fctexport C_cpsproc(C_context_switch) C_noret;
+C_fctexport C_cpsproc(C_peek_signed_integer) C_noret;
+C_fctexport C_cpsproc(C_peek_unsigned_integer) C_noret;
+C_fctexport C_cpsproc(C_decode_seconds) C_noret;
+C_fctexport C_cpsproc(C_software_type) C_noret;
+C_fctexport C_cpsproc(C_machine_type) C_noret;
+C_fctexport C_cpsproc(C_machine_byte_order) C_noret;
+C_fctexport C_cpsproc(C_software_version) C_noret;
+C_fctexport C_cpsproc(C_build_platform) C_noret;
+C_fctexport C_cpsproc(C_register_finalizer) C_noret;
+C_fctexport C_cpsproc(C_set_dlopen_flags) C_noret;
+C_fctexport C_cpsproc(C_dload) C_noret;
+C_fctexport C_cpsproc(C_become) C_noret;
+C_fctexport C_cpsproc(C_locative_ref) C_noret;
+C_fctexport C_cpsproc(C_call_with_cthulhu) C_noret;
+C_fctexport C_cpsproc(C_copy_closure) C_noret;
+C_fctexport C_cpsproc(C_dump_heap_state) C_noret;
+C_fctexport C_cpsproc(C_filter_heap_objects) C_noret;
C_fctexport time_t C_fcall C_seconds(C_long *ms) C_regparm;
C_fctexport C_word C_a_i_list(C_word **a, int c, ...);
diff --git a/runtime.c b/runtime.c
index 62fa6fa3..b9f9fb43 100644
--- a/runtime.c
+++ b/runtime.c
@@ -263,8 +263,6 @@ static C_TLS int timezone;
/* Type definitions: */
-typedef void (*TOPLEVEL)(C_word c, C_word self, C_word k) C_noret;
-
typedef struct lf_list_struct
{
C_word *lf;
@@ -475,10 +473,9 @@ static void barf(int code, char *loc, ...) C_noret;
static void panic(C_char *msg) C_noret;
static void usual_panic(C_char *msg) C_noret;
static void horror(C_char *msg) C_noret;
-static void C_fcall initial_trampoline(void *proc) C_regparm C_noret;
static void C_fcall really_mark(C_word *x) C_regparm;
static WEAK_TABLE_ENTRY *C_fcall lookup_weak_table_entry(C_word item, C_word container) C_regparm;
-static C_cpsproc(values_continuation);
+static C_cpsproc(values_continuation) C_noret;
static C_word add_symbol(C_word **ptr, C_word key, C_word string, C_SYMBOL_TABLE *stable);
static C_regparm int C_fcall C_in_new_heapp(C_word x);
static C_word C_fcall hash_string(int len, C_char *str, C_word m, C_word r, int ci) C_regparm;
@@ -486,27 +483,29 @@ static C_word C_fcall lookup(C_word key, int len, C_char *str, C_SYMBOL_TABLE *s
static double compute_symbol_table_load(double *avg_bucket_len, int *total);
static C_word C_fcall convert_string_to_number(C_char *str, int radix, C_word *fix, double *flo) C_regparm;
static C_word C_fcall maybe_inexact_to_exact(C_word n) C_regparm;
+static void C_fcall mark_system_globals(void) C_regparm;
static void C_fcall remark_system_globals(void) C_regparm;
static void C_fcall really_remark(C_word *x) C_regparm;
static C_word C_fcall intern0(C_char *name) C_regparm;
static void C_fcall update_locative_table(int mode) C_regparm;
static LF_LIST *find_module_handle(C_char *name);
-static C_cpsproc(call_cc_wrapper);
-static C_cpsproc(call_cc_values_wrapper);
-static C_cpsproc(gc_2);
-static C_cpsproc(allocate_vector_2);
-static C_cpsproc(make_structure_2);
-static C_cpsproc(generic_trampoline);
+static C_cpsproc(call_cc_wrapper) C_noret;
+static C_cpsproc(call_cc_values_wrapper) C_noret;
+static C_cpsproc(gc_2) C_noret;
+static C_cpsproc(allocate_vector_2) C_noret;
+static C_cpsproc(make_structure_2) C_noret;
+static C_cpsproc(generic_trampoline) C_noret;
static void handle_interrupt(void *trampoline) C_noret;
-static C_cpsproc(callback_return_continuation);
-static C_cpsproc(become_2);
-static C_cpsproc(copy_closure_2);
-static C_cpsproc(dump_heap_state_2);
-static C_cpsproc(sigsegv_trampoline);
-static C_cpsproc(sigill_trampoline);
-static C_cpsproc(sigfpe_trampoline);
-static C_cpsproc(sigbus_trampoline);
+static C_cpsproc(callback_return_continuation) C_noret;
+static C_cpsproc(termination_continuation) C_noret;
+static C_cpsproc(become_2) C_noret;
+static C_cpsproc(copy_closure_2) C_noret;
+static C_cpsproc(dump_heap_state_2) C_noret;
+static C_cpsproc(sigsegv_trampoline) C_noret;
+static C_cpsproc(sigill_trampoline) C_noret;
+static C_cpsproc(sigfpe_trampoline) C_noret;
+static C_cpsproc(sigbus_trampoline) C_noret;
static C_PTABLE_ENTRY *create_initial_ptable();
@@ -1422,19 +1421,6 @@ C_word CHICKEN_continue(C_word k)
}
-/* Trampoline called at system startup: */
-
-C_regparm void C_fcall initial_trampoline(void *proc)
-{
- TOPLEVEL top = (TOPLEVEL)proc;
- C_word closure = (C_word)C_alloc(2);
-
- ((C_SCHEME_BLOCK *)closure)->header = C_CLOSURE_TYPE | 1;
- C_set_block_item(closure, 0, (C_word)termination_continuation);
- (top)(2, C_SCHEME_UNDEFINED, closure);
-}
-
-
/* The final continuation: */
void C_ccall termination_continuation(C_word c, C_word *av)
@@ -1501,6 +1487,7 @@ void barf(int code, char *loc, ...)
C_word err = error_hook_symbol;
int c, i;
va_list v;
+ C_word *av;
C_dbg_hook(C_SCHEME_UNDEFINED);
@@ -1748,26 +1735,27 @@ void barf(int code, char *loc, ...)
default: panic(C_text("illegal internal error code"));
}
+
+ av = C_alloc(c + 4);
if(!C_immediatep(err)) {
- C_save(C_fix(code));
+ av[ 0 ] = err;
+ /* No continuation is passed: '##sys#error-hook' may not return: */
+ av[ 1 ] = C_SCHEME_UNDEFINED;
+ av[ 2 ] = C_fix(code);
if(loc != NULL)
- C_save(intern0(loc));
+ av[ 3 ] = intern0(loc);
else {
- C_save(error_location);
+ av[ 3 ] = error_location;
error_location = C_SCHEME_FALSE;
}
-
- va_start(v, loc);
- i = c;
- while(i--)
- C_save(va_arg(v, C_word));
+ for(i = 0; i < c; ++i)
+ av[ i + 4 ] = va_arg(v, C_word);
va_end(v);
- /* No continuation is passed: '##sys#error-hook' may not return: */
- C_do_apply(c + 2, err, C_SCHEME_UNDEFINED);
+ C_apply(c + 4, av);
}
else panic(msg);
}
@@ -1882,13 +1870,14 @@ C_word C_fcall C_restore_callback_continuation2(int level)
C_word C_fcall C_callback(C_word closure, int argc)
{
#ifdef HAVE_SIGSETJMP
- sigjmp_buf prev;
-#else
+ sigjmp_buf prev;
+#else
jmp_buf prev;
#endif
C_word
*a = C_alloc(3),
- k = C_closure(&a, 2, (C_word)callback_return_continuation, C_SCHEME_FALSE);
+ k = C_closure(&a, 2, (C_word)callback_return_continuation, C_SCHEME_FALSE),
+ *av;
int old = chicken_is_running;
if(old && C_block_item(callback_continuation_stack_symbol, 0) == C_SCHEME_END_OF_LIST)
@@ -1897,16 +1886,21 @@ C_word C_fcall C_callback(C_word closure, int argc)
C_memcpy(&prev, &C_restart, sizeof(C_restart));
callback_returned_flag = 0;
chicken_is_running = 1;
-
+ av = C_alloc(argc + 2);
+ av[ 0 ] = closure;
+ av[ 1 ] = k;
+ C_memcpy(av + 2, C_temporary_stack, (argc - 2) * sizeof(C_word));
+
#ifdef HAVE_SIGSETJMP
- if(!C_sigsetjmp(C_restart, 0)) C_do_apply(argc, closure, k);
+ if(!C_sigsetjmp(C_restart, 0)) C_apply(argc, av);
#else
- if(!C_setjmp(C_restart)) C_do_apply(argc, closure, k);
+ if(!C_setjmp(C_restart)) C_do_apply(argc, av);
#endif
serious_signal_occurred = 0;
- if(!callback_returned_flag) (C_restart_trampoline)(C_restart_c);
+ if(!callback_returned_flag)
+ ((C_proc)C_restart_trampoline)(C_restart_c, C_temporary_stack);
else {
C_memcpy(&C_restart, &prev, sizeof(C_restart));
callback_returned_flag = 0;
@@ -3650,7 +3644,7 @@ void handle_interrupt(void *trampoline)
reason = C_fix(pending_interrupts[ --pending_interrupts_count ]);
proc = C_block_item(interrupt_hook_symbol, 0);
- if(C_immediatep(x))
+ if(C_immediatep(proc))
panic(C_text("`##sys#interrupt-hook' is not defined"));
c = C_cpu_milliseconds() - interrupt_time;
@@ -4017,8 +4011,9 @@ C_regparm C_word C_fcall C_start_timer(void)
void C_ccall C_stop_timer(C_word c, C_word *av)
{
- C_word closure = av[ 0 ];
- C_word k = av[ 1 ];
+ C_word
+ closure = av[ 0 ],
+ k = av[ 1 ];
double t0 = C_cpu_milliseconds() - timer_start_ms;
C_word
ab[ WORDS_PER_FLONUM * 2 + 7 ], /* 2 flonums, 1 vector of 6 elements */
@@ -4026,7 +4021,7 @@ void C_ccall C_stop_timer(C_word c, C_word *av)
elapsed = C_flonum(&a, t0 / 1000.0),
gc_time = C_flonum(&a, gc_ms / 1000.0),
info;
-
+
info = C_vector(&a, 6, elapsed, gc_time, C_fix(mutation_count),
C_fix(tracked_mutation_count), C_fix(gc_count_1_total),
C_fix(gc_count_2));
@@ -5964,7 +5959,7 @@ void C_ccall C_apply(C_word c, C_word *av)
C_temporary_stack -= n;
- if(C_temporary_stack < C_temprary_stack_limit)
+ if(C_temporary_stack < C_temporary_stack_limit)
barf(C_TOO_MANY_PARAMETERS_ERROR, "apply");
C_memcpy(C_temporary_stack, av + 3, n * sizeof(C_word));
@@ -5982,20 +5977,20 @@ void C_ccall C_call_cc(C_word c, C_word *av)
C_word *a = C_alloc(3);
C_word wrapper;
void *pr = (void *)C_block_item(cont,0);
- C_word av[ 3 ];
-
+ C_word av2[ 3 ];
+
if(C_immediatep(cont) || C_header_bits(cont) != C_CLOSURE_TYPE)
barf(C_BAD_ARGUMENT_TYPE_ERROR, "call-with-current-continuation", cont);
-
+
/* Check for values-continuation: */
if(C_block_item(k, 0) == (C_word)values_continuation)
wrapper = C_closure(&a, 2, (C_word)call_cc_values_wrapper, k);
else wrapper = C_closure(&a, 2, (C_word)call_cc_wrapper, k);
-
- av[ 0 ] = cont;
- av[ 1 ] = k;
- av[ 2 ] = wrapper;
- ((C_proc)pr)(3, av);
+
+ av2[ 0 ] = cont;
+ av2[ 1 ] = k;
+ av2[ 2 ] = wrapper;
+ ((C_proc)pr)(3, av2);
}
@@ -6021,12 +6016,12 @@ void C_ccall call_cc_values_wrapper(C_word c, C_word *av)
x1,
n = c;
- av[ 0 ] = cont;
+ av[ 0 ] = cont; /* reuse av */
if(c > 2) --n;
else av[ 1 ] = C_SCHEME_UNBOUND;
- C_apply(n - 2, av2);
+ C_apply(n - 2, av);
}
@@ -6071,7 +6066,6 @@ void C_ccall C_values(C_word c, C_word *av)
}
else n = av[ 2 ];
- va_end(v);
C_kontinue(k, n);
}
@@ -6366,8 +6360,12 @@ void C_ccall C_minus(C_word c, C_word *av)
else barf(C_BAD_ARGUMENT_TYPE_ERROR, "-", n1);
if(c == 3) {
- if(!ff) C_kontinue(k, C_fix(-C_unfix(n1)));
- else C_kontinue_flonum(k, -fresult);
+ if(!ff) {
+ C_kontinue(k, C_fix(-C_unfix(n1)));
+ }
+ else {
+ C_kontinue_flonum(k, -fresult);
+ }
}
c -= 3;
@@ -7052,7 +7050,7 @@ void C_ccall C_gc(C_word c, C_word *av)
if(size && !C_heap_size_is_fixed) {
C_rereclaim2(size, 0);
- gc_2(NULL);
+ gc_2(0, NULL);
}
else if(f) C_fromspace_top = C_fromspace_limit;
@@ -7121,7 +7119,7 @@ void C_ccall C_allocate_vector(C_word c, C_word *av)
k = av[ 1 ],
size, bvecf, init, align8,
bytes,
- n = C_unfix(size);
+ n;
if(c != 6) C_bad_argc(c, 6);
@@ -7129,6 +7127,7 @@ void C_ccall C_allocate_vector(C_word c, C_word *av)
bvecf = av[ 3 ];
init = av[ 4 ];
align8 = av[ 5 ];
+ n = C_unfix(size);
if(n > C_HEADER_SIZE_MASK)
barf(C_OUT_OF_RANGE_ERROR, NULL, size, C_fix(C_HEADER_SIZE_MASK));
@@ -7155,7 +7154,7 @@ void C_ccall C_allocate_vector(C_word c, C_word *av)
}
C_save(C_SCHEME_FALSE);
- allocate_vector_2(NULL);
+ allocate_vector_2(0, NULL);
}
@@ -7261,6 +7260,7 @@ void C_ccall C_flonum_rat(C_word c, C_word *av)
double ga, gb;
C_word ab[WORDS_PER_FLONUM * 2], *ap = ab;
int i = 0;
+ C_word av2[ 4 ];
if (isnormal(fn)) {
/* Calculate bit-length of the fractional part (ie, after decimal point) */
@@ -7279,7 +7279,11 @@ void C_ccall C_flonum_rat(C_word c, C_word *av)
denom = 1.0/0.0; /* +inf */
}
- C_values(4, C_SCHEME_UNDEFINED, k, C_flonum(&ap, numer), C_flonum(&ap, denom));
+ av2[ 0 ] = C_SCHEME_UNDEFINED;
+ av2[ 1 ] = k;
+ av2[ 2 ] = C_flonum(&ap, numer);
+ av2[ 3 ] = C_flonum(&ap, denom);
+ C_values(4, av2);
}
@@ -7741,10 +7745,13 @@ void C_ccall C_number_to_string(C_word c, C_word *av)
/* special case for fixnum arg and decimal radix */
-void C_ccall
-C_fixnum_to_string(C_word c, C_word self, C_word k, C_word num)
+void C_ccall C_fixnum_to_string(C_word c, C_word *av)
{
- C_word *a, s;
+ C_word
+ /* closure = av[ 0 ] */
+ k = av[ 1 ],
+ num = av[ 2 ],
+ *a, s;
int n;
/*XXX is this necessary? */
@@ -7778,7 +7785,7 @@ void C_ccall C_make_structure(C_word c, C_word *av)
if(!C_demand(c - 1))
C_reclaim((void *)make_structure_2, c);
- make_structure_2(NULL);
+ make_structure_2(0, NULL);
}
@@ -7787,7 +7794,7 @@ void C_ccall make_structure_2(C_word c, C_word *av)
C_word
k = C_restore,
type = C_restore,
- size = C_rest_count(0),
+ size = c - 2,
*a = C_alloc(size + 2),
*s = a,
s0 = (C_word)s;
@@ -7862,7 +7869,7 @@ void C_ccall C_ensure_heap_reserve(C_word c, C_word *av)
if(!C_demand(C_bytestowords(C_unfix(n))))
C_reclaim((void *)generic_trampoline, c);
- generic_trampoline(NULL);
+ generic_trampoline(0, NULL);
}
@@ -8201,7 +8208,7 @@ void C_ccall C_dload(C_word c, C_word *av)
#if !defined(NO_DLOAD2) && (defined(HAVE_DLFCN_H) || defined(HAVE_DL_H) || (defined(HAVE_LOADLIBRARY) && defined(HAVE_GETPROCADDRESS)))
/* Force minor GC: otherwise the lf may contain pointers to stack-data
(stack allocated interned symbols, for example) */
- C_save_and_reclaim((void *)dload_2, NULL, 3, k, name, entry);
+ C_save_and_reclaim_args((void *)dload_2, 3, k, name, entry);
#endif
C_kontinue(k, C_SCHEME_FALSE);
@@ -8218,9 +8225,11 @@ void C_ccall C_dload(C_word c, C_word *av)
void dload_2(void *dummy)
{
void *handle, *p;
- C_word entry = C_restore,
- name = C_restore,
- k = C_restore;
+ C_word
+ entry = C_restore,
+ name = C_restore,
+ k = C_restore,
+ av[ 2 ];
C_char *mname = (C_char *)C_data_pointer(name);
/*
@@ -8245,7 +8254,9 @@ void dload_2(void *dummy)
current_module_name, (C_uword)current_module_handle);
}
- ((C_proc2)p)(2, C_SCHEME_UNDEFINED, k);
+ av[ 0 ] = C_SCHEME_UNDEFINED;
+ av[ 1 ] = k;
+ ((C_proc)p)(2, av); /* doesn't return */
} else {
C_dlerror = (char *) C_strerror(errno);
shl_unload(shl_handle);
@@ -8269,7 +8280,8 @@ void dload_2(void *dummy)
C_word
entry = C_restore,
name = C_restore,
- k = C_restore;
+ k = C_restore,
+ av[ 2 ];
C_char *topname = (C_char *)C_data_pointer(entry);
C_char *mname = (C_char *)C_data_pointer(name);
C_char *tmp;
@@ -8298,7 +8310,9 @@ void dload_2(void *dummy)
current_module_name, (C_uword)current_module_handle);
}
- ((C_proc2)p)(2, C_SCHEME_UNDEFINED, k); /* doesn't return */
+ av[ 0 ] = C_SCHEME_UNDEFINED;
+ av[ 1 ] = k;
+ ((C_proc)p)(2, *av); /* doesn't return */
}
C_dlclose(handle);
@@ -8320,7 +8334,8 @@ void dload_2(void *dummy)
C_word
entry = C_restore,
name = C_restore,
- k = C_restore;
+ k = C_restore,
+ av[ 2 ];
C_char *topname = (C_char *)C_data_pointer(entry);
C_char *mname = (C_char *)C_data_pointer(name);
@@ -8343,7 +8358,9 @@ void dload_2(void *dummy)
current_module_name, (C_uword)current_module_handle);
}
- ((C_proc2)p)(2, C_SCHEME_UNDEFINED, k);
+ av[ 0 ] = C_SCHEME_UNDEFINED;
+ av[ 1 ] = k;
+ ((C_proc)p)(2, av); /* doesn't return */
}
else FreeLibrary(handle);
}
@@ -8386,7 +8403,7 @@ void C_ccall C_become(C_word c, C_word *av)
*p = 0;
C_fromspace_top = C_fromspace_limit;
- C_save_and_reclaim((void *)become_2, NULL, 1, k);
+ C_save_and_reclaim_args((void *)become_2, 1, k);
}
@@ -8477,12 +8494,15 @@ void C_ccall C_locative_ref(C_word c, C_word *av)
C_word
/* closure = av[ 0 ] */
k = av[ 1 ],
- loc = av[ 2 ],
+ loc,
+ *av2,
*ptr, val;
C_alloc_flonum;
if(c != 3) C_bad_argc(c, 3);
+ loc = av[ 2 ];
+
if(C_immediatep(loc) || C_block_header(loc) != C_LOCATIVE_TAG)
barf(C_BAD_ARGUMENT_TYPE_ERROR, "locative-set!", loc);
@@ -8497,8 +8517,20 @@ void C_ccall C_locative_ref(C_word c, C_word *av)
case C_S8_LOCATIVE: C_kontinue(k, C_fix(*((char *)ptr)));
case C_U16_LOCATIVE: C_kontinue(k, C_fix(*((unsigned short *)ptr)));
case C_S16_LOCATIVE: C_kontinue(k, C_fix(*((short *)ptr)));
- case C_U32_LOCATIVE: C_peek_unsigned_integer(0, 0, k, (C_word)(ptr - 1), 0);
- case C_S32_LOCATIVE: C_peek_signed_integer(0, 0, k, (C_word)(ptr - 1), 0);
+ case C_U32_LOCATIVE:
+ av2 = C_alloc(4);
+ av2[ 0 ] = C_SCHEME_UNDEFINED;
+ av2[ 1 ] = k;
+ av2[ 2 ] = (C_word)(ptr - 1);
+ av2[ 3 ] = C_fix(0);
+ C_peek_unsigned_integer(3, av);
+ case C_S32_LOCATIVE:
+ av2 = C_alloc(4);
+ av2[ 0 ] = C_SCHEME_UNDEFINED;
+ av2[ 1 ] = k;
+ av2[ 2 ] = (C_word)(ptr - 1);
+ av2[ 3 ] = C_fix(0);
+ C_peek_signed_integer(3, av);
case C_F32_LOCATIVE: C_kontinue_flonum(k, *((float *)ptr));
case C_F64_LOCATIVE: C_kontinue_flonum(k, *((double *)ptr));
default: panic(C_text("bad locative type"));
@@ -8683,16 +8715,17 @@ void C_ccall C_copy_closure(C_word c, C_word *av)
proc = av[ 2 ];
int n = C_header_size(proc);
- if(!C_demand(n + 1)) C_save_and_reclaim((void *)copy_closure_2, NULL, 2, proc, k);
+ if(!C_demand(n + 1))
+ C_save_and_reclaim_args((void *)copy_closure_2, 2, proc, k);
else {
C_save(proc);
C_save(k);
- copy_closure_2(NULL);
+ copy_closure_2(0, NULL);
}
}
-static void C_ccall copy_closure_2(C_word c, C_word *av)
+static void C_ccall copy_closure_2(C_word c, C_word *av)
{
C_word
k = C_restore,
@@ -8717,10 +8750,14 @@ void C_ccall C_call_with_cthulhu(C_word c, C_word *av)
/* closure = av[ 0 ] */
k = av[ 1 ],
proc = av[ 2 ],
- *a = C_alloc(3);
+ *a = C_alloc(3),
+ av2[ 4 ];
- k = C_closure(&a, 1, (C_word)termination_continuation);
- C_apply(4, C_SCHEME_UNDEFINED, k, proc, C_SCHEME_END_OF_LIST);
+ av2[ 0 ] = C_SCHEME_UNDEFINED;
+ av2[ 1 ] = C_closure(&a, 1, (C_word)termination_continuation); /* k */
+ av2[ 2 ] = proc;
+ av2[ 3 ] = C_SCHEME_END_OF_LIST;
+ C_apply(4, av2);
}
Trap