From 7b11f8b7c022589d46754e091368b16c02980596 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=B6rg=20F=2E=20Wittenberger?= Date: Tue, 23 Feb 2016 19:58:07 +0100 Subject: [PATCH] increase reuse of argvector --- c-backend.scm | 9 +-- chicken.h | 26 ++++++- runtime.c | 218 +++++++++++++++++++++++++++++++--------------------------- 3 files changed, 142 insertions(+), 111 deletions(-) diff --git a/c-backend.scm b/c-backend.scm index 3f9846f..c96ae2c 100644 --- a/c-backend.scm +++ b/c-backend.scm @@ -483,13 +483,8 @@ ;; CPS context, so callee never returns to current function. ;; And even so, av[] is already copied into temporaries. (cond (caller-has-av? - (gen #t "C_word *av2;") - (gen #t "if(c >= " avl ") {") - (gen #t " av2=av; /* Re-use our own argvector */") - (gen #t "} else {") - (gen #t " av2=C_alloc(" avl ");") - (gen #t "}")) - (else (gen #t "C_word av2[" avl "];"))) + (gen #t "C_word *av2 = C_allocate_argvector(c, av, " avl ");")) + (else (gen #t "C_word *av2 = C_allocate_fresh_argvector(" avl ");"))) (when selfarg (gen #t "av2[0]=" selfarg ";")) (do ((j (if selfarg 1 0) (add1 j)) (args args (cdr args))) diff --git a/chicken.h b/chicken.h index 3694cd6..845aac4 100644 --- a/chicken.h +++ b/chicken.h @@ -1,3 +1,4 @@ +#define USE_OLD_AV 1 // set to 1 for backward compatible version to boot modified chicken /* chicken.h - General headerfile for compiler generated executables ; ; Copyright (c) 2008-2016, The CHICKEN Team @@ -1010,6 +1011,21 @@ typedef void (C_ccall *C_proc)(C_word, C_word *) C_noret; #define C_heaptop ((C_word **)(&C_fromspace_top)) #define C_drop(n) (C_temporary_stack += (n)) #define C_alloc(n) ((C_word *)C_alloca((n) * sizeof(C_word))) + +#if USE_OLD_AV +#define C_allocate_fresh_argvector(n) C_alloc(n) +#define C_allocate_argvector(c, av, avl) ( (c >= avl) ? av : C_force_allocate_fresh_argvector(avl)) +#else +#define C_argvector_reuse_dflt(n) ((C_default_argvector_value != NULL) && (C_default_argvector_value[0] >= (n))) +#define C_argvector_flush() (C_default_argvector_value = NULL) +#define C_force_allocate_fresh_argvector(n) ((C_default_argvector_value = C_alloc((n)+1)), *C_default_argvector_value=(n), C_default_argvector_value+1) +#define C_allocate_fresh_argvector(avl) (C_argvector_reuse_dflt(avl) ? C_default_argvector_value+1 : C_force_allocate_fresh_argvector(avl)) +#define C_argvector_size(av) (av[-1]) +//#define C_allocate_argvector(c, av, avl) (C_argvector_size(av) >= (avl) ? av : C_force_allocate_fresh_argvector(avl)) +// should try this too: +#define C_allocate_argvector(c, av, avl) ((((c) >= (avl)) || (C_argvector_size(av) >= (avl))) ? av : C_force_allocate_fresh_argvector(avl)) +#endif + #if defined (__llvm__) && defined (__GNUC__) # if defined (__i386__) # define C_stack_pointer ({C_word *sp; __asm__ __volatile__("movl %%esp,%0":"=r"(sp):);sp;}) @@ -1225,7 +1241,13 @@ typedef void (C_ccall *C_proc)(C_word, C_word *) C_noret; #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_do_apply(c, av) ((C_proc)(void *)C_block_item((av)[0], 0))((c), (av)) -#define C_kontinue(k, r) do { C_word avk[ 2 ]; avk[ 0 ] = (k); avk[ 1 ] = (r); ((C_proc)(void *)C_block_item((k),0))(2, avk); } while(0) +// #define C_kontinue(k, r) do { C_word avk[ 2 ]; avk[ 0 ] = (k); avk[ 1 ] = (r); ((C_proc)(void *)C_block_item((k),0))(2, avk); } while(0) +#define C_kontinue(k, r) do { C_word *avk = C_allocate_fresh_argvector(2); avk[ 0 ] = (k); avk[ 1 ] = (r); ((C_proc)(void *)C_block_item((k),0))(2, avk); } while(0) +#if USE_OLD_AV +#define C_kontinue_av(av, k, r) C_kontinue(k, r) +#else +#define C_kontinue_av(av, k, r) do { av[ 0 ] = (k); av[ 1 ] = (r); ((C_proc)(void *)C_block_item((k),0))(2, av); } while(0) +#endif #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) @@ -1537,6 +1559,7 @@ typedef void (C_ccall *C_proc)(C_word, C_word *) C_noret; #define C_alloc_flonum C_word *___tmpflonum = C_alloc(WORDS_PER_FLONUM) #define C_kontinue_flonum(k, n) C_kontinue((k), C_flonum(&___tmpflonum, (n))) +#define C_kontinue_av_flonum(av, k, n) C_kontinue_av(av, (k), C_flonum(&___tmpflonum, (n))) #define C_a_i_flonum_truncate(ptr, n, x) C_flonum(ptr, C_trunc(C_flonum_magnitude(x))) #define C_a_i_flonum_ceiling(ptr, n, x) C_flonum(ptr, C_ceil(C_flonum_magnitude(x))) @@ -1601,6 +1624,7 @@ C_fctexport void C_register_debug_info(C_DEBUG_INFO *); /* Variables: */ +C_varextern C_TLS C_word *C_default_argvector_value; C_varextern C_TLS time_t C_startup_time_seconds; C_varextern C_TLS C_word *C_temporary_stack, diff --git a/runtime.c b/runtime.c index b1e99e2..caaf77b 100644 --- a/runtime.c +++ b/runtime.c @@ -325,6 +325,8 @@ typedef struct profile_bucket_struct /* Variables: */ +C_TLS C_word *C_default_argvector_value = NULL; + C_TLS C_word *C_temporary_stack, *C_temporary_stack_bottom, @@ -1493,7 +1495,7 @@ C_word CHICKEN_run(void *toplevel) if(!return_to_host) { int argcount = C_temporary_stack_bottom - C_temporary_stack; - C_word *p = C_alloc(argcount); + C_word *p = C_force_allocate_fresh_argvector(argcount); // FIXME: do we HAVE TO _force_ it? C_memcpy(p, C_temporary_stack, argcount * sizeof(C_word)); C_temporary_stack = C_temporary_stack_bottom; ((C_proc)C_restart_trampoline)(C_restart_c, p); @@ -1834,7 +1836,7 @@ void barf(int code, char *loc, ...) default: panic(C_text("illegal internal error code")); } - av = C_alloc(c + 4); + av = C_allocate_fresh_argvector(c + 4); if(!C_immediatep(err)) { va_start(v, loc); @@ -1984,7 +1986,7 @@ 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 = C_allocate_fresh_argvector(argc + 2); av[ 0 ] = closure; av[ 1 ] = k; /*XXX is the order of arguments an issue? */ @@ -2855,6 +2857,8 @@ C_regparm void C_fcall C_reclaim(void *trampoline, C_word c) if(pending_interrupts_count > 0 && C_interrupts_enabled) handle_interrupt(trampoline); + C_argvector_flush(); + cell.enabled = 0; cell.event = C_DEBUG_GC; cell.loc = ""; @@ -3766,7 +3770,7 @@ void handle_interrupt(void *trampoline) { C_word *p, h, reason, state, proc, n; double c; - C_word av[ 4 ]; + C_word *av = C_allocate_fresh_argvector(4); /* Build vector with context information: */ n = C_temporary_stack_bottom - C_temporary_stack; @@ -4268,7 +4272,7 @@ void C_ccall C_stop_timer(C_word c, C_word *av) 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)); - C_kontinue(k, info); + C_kontinue_av(av, k, info); } @@ -6215,6 +6219,7 @@ C_regparm C_word C_i_char_less_or_equal_p(C_word x, C_word y) /* Primitives: */ + void C_ccall C_apply(C_word c, C_word *av) { C_word @@ -6237,15 +6242,15 @@ void C_ccall C_apply(C_word c, C_word *av) len = C_unfix(C_u_i_length(lst)); av2_size = 2 + non_list_args + len; - if(!C_demand(av2_size)) + if((C_argvector_size(av) < av2_size) && !C_demand(av2_size)) C_save_and_reclaim((void *)C_apply, c, av); - av2 = ptr = C_alloc(av2_size); + av2 = ptr = C_allocate_argvector(c, av, av2_size); *(ptr++) = fn; *(ptr++) = k; if(non_list_args > 0) { - C_memcpy(ptr, av + 3, non_list_args * sizeof(C_word)); + C_memmove(ptr, av + 3, non_list_args * sizeof(C_word)); ptr += non_list_args; } @@ -6269,7 +6274,7 @@ void C_ccall C_call_cc(C_word c, C_word *av) *a = C_alloc(3), wrapper; void *pr = (void *)C_block_item(cont,0); - C_word av2[ 3 ]; + C_word *av2 = C_allocate_argvector(c, av, 3); if(C_immediatep(cont) || C_header_bits(cont) != C_CLOSURE_TYPE) barf(C_BAD_ARGUMENT_TYPE_ERROR, "call-with-current-continuation", cont); @@ -6297,7 +6302,7 @@ void C_ccall call_cc_wrapper(C_word c, C_word *av) if(c != 3) C_bad_argc(c, 3); result = av[ 2 ]; - C_kontinue(k, result); + C_kontinue_av(av, k, result); } @@ -6357,7 +6362,7 @@ void C_ccall C_values(C_word c, C_word *av) } else n = av[ 2 ]; - C_kontinue(k, n); + C_kontinue_av(av, k, n); } @@ -6382,10 +6387,10 @@ void C_ccall C_apply_values(C_word c, C_word *av) len = C_unfix(C_u_i_length(lst)); n = len + 1; - if(!C_demand(n)) + if((C_argvector_size(av) < n) && !C_demand(n)) C_save_and_reclaim((void *)C_apply_values, c, av); - av2 = C_alloc(n); + av2 = C_allocate_argvector(c, av, n); av2[ 0 ] = k; ptr = av2 + 1; while(len--) { @@ -6416,7 +6421,7 @@ void C_ccall C_apply_values(C_word c, C_word *av) } else barf(C_BAD_ARGUMENT_TYPE_ERROR, "apply", lst); - C_kontinue(k, n); + C_kontinue_av(av, k, n); } @@ -6471,11 +6476,11 @@ void C_ccall values_continuation(C_word c, C_word *av) closure = av[ 0 ], kont = C_block_item(closure, 1), k = C_block_item(closure, 2), - *av2 = C_alloc(c + 1); + *av2 = C_allocate_argvector(c, av, c + 1); + C_memmove(av2 + 2, av + 1, (c - 1) * sizeof(C_word)); av2[ 0 ] = kont; av2[ 1 ] = k; - C_memcpy(av2 + 2, av + 1, (c - 1) * sizeof(C_word)); C_do_apply(c + 1, av2); } @@ -6486,7 +6491,8 @@ void C_ccall C_times(C_word c, C_word *av) /* closure = av[ 0 ] */ k = av[ 1 ], x, y, - iresult = C_fix(1); + *av0=av, + iresult = C_fix(1); double fresult; C_alloc_flonum; @@ -6512,7 +6518,7 @@ void C_ccall C_times(C_word c, C_word *av) else barf(C_BAD_ARGUMENT_TYPE_ERROR, "*", x); } - C_kontinue(k, iresult); + C_kontinue_av(av0, k, iresult); flonum_result: while(c--) { @@ -6525,7 +6531,7 @@ void C_ccall C_times(C_word c, C_word *av) else barf(C_BAD_ARGUMENT_TYPE_ERROR, "*", x); } - C_kontinue_flonum(k, fresult); + C_kontinue_av_flonum(av0, k, fresult); } @@ -6564,6 +6570,7 @@ void C_ccall C_plus(C_word c, C_word *av) /* closure = av[ 0 ] */ k = av[ 1 ], x, y, + *av0=av, iresult = C_fix(0); double fresult; C_alloc_flonum; @@ -6590,7 +6597,7 @@ void C_ccall C_plus(C_word c, C_word *av) else barf(C_BAD_ARGUMENT_TYPE_ERROR, "+", x); } - C_kontinue(k, iresult); + C_kontinue_av(av0, k, iresult); flonum_result: while(c--) { @@ -6603,7 +6610,7 @@ void C_ccall C_plus(C_word c, C_word *av) else barf(C_BAD_ARGUMENT_TYPE_ERROR, "+", x); } - C_kontinue_flonum(k, fresult); + C_kontinue_av_flonum(av0, k, fresult); } @@ -6642,6 +6649,7 @@ void C_ccall C_minus(C_word c, C_word *av) /* closure = av[ 0 ] */ k = av[ 1 ], x, y, n1, + *av0=av, iresult; double fresult; int ff = 0; @@ -6660,10 +6668,10 @@ void C_ccall C_minus(C_word c, C_word *av) if(c == 3) { if(!ff) { - C_kontinue(k, C_fix(-C_unfix(n1))); + C_kontinue_av(av0, k, C_fix(-C_unfix(n1))); } else { - C_kontinue_flonum(k, -fresult); + C_kontinue_av_flonum(av0, k, -fresult); } } @@ -6691,7 +6699,7 @@ void C_ccall C_minus(C_word c, C_word *av) else barf(C_BAD_ARGUMENT_TYPE_ERROR, "-", x); } - C_kontinue(k, iresult); + C_kontinue_av(av0, k, iresult); flonum_result: while(c--) { @@ -6704,7 +6712,7 @@ void C_ccall C_minus(C_word c, C_word *av) else barf(C_BAD_ARGUMENT_TYPE_ERROR, "-", x); } - C_kontinue_flonum(k, fresult); + C_kontinue_av_flonum(av0, k, fresult); } @@ -6744,6 +6752,7 @@ void C_ccall C_divide(C_word c, C_word *av) /* closure = av[ 0 ] */ k = av[ 1 ], n1, n2, + *av0=av, iresult, n3; int fflag; double fresult, f2; @@ -6771,7 +6780,7 @@ void C_ccall C_divide(C_word c, C_word *av) } else { if(iresult == 0) barf(C_DIVISION_BY_ZERO_ERROR, "/"); - else if(iresult == 1) C_kontinue(k, C_fix(1)); + else if(iresult == 1) C_kontinue_av(av0, k, C_fix(1)); fresult = 1.0 / (double)iresult; fflag = 1; @@ -6825,11 +6834,11 @@ void C_ccall C_divide(C_word c, C_word *av) cont: if(fflag) { - C_kontinue_flonum(k, fresult); + C_kontinue_av_flonum(av0, k, fresult); } else n1 = C_fix(iresult); - C_kontinue(k, n1); + C_kontinue_av(av0, k, n1); } @@ -6884,6 +6893,7 @@ void C_ccall C_nequalp(C_word c, C_word *av) C_word /* closure = av[ 0 ] */ k = av[ 1 ], + *av0=av, x, i2, f, fflag, ilast; double flast, f2; @@ -6935,7 +6945,7 @@ void C_ccall C_nequalp(C_word c, C_word *av) } cont: - C_kontinue(k, C_mk_bool(f)); + C_kontinue_av(av0, k, C_mk_bool(f)); } @@ -6966,6 +6976,7 @@ void C_ccall C_greaterp(C_word c, C_word *av) C_word /* closure = av[ 0 ] */ k = av[ 1 ], + *av0=av, x, i2, f, fflag, ilast; double flast, f2; @@ -7017,7 +7028,7 @@ void C_ccall C_greaterp(C_word c, C_word *av) } cont: - C_kontinue(k, C_mk_bool(f)); + C_kontinue_av(av0, k, C_mk_bool(f)); } @@ -7048,6 +7059,7 @@ void C_ccall C_lessp(C_word c, C_word *av) C_word /* closure = av[ 0 ] */ k = av[ 1 ], + *av0=av, x, i2, f, fflag, ilast; double flast, f2; @@ -7099,7 +7111,7 @@ void C_ccall C_lessp(C_word c, C_word *av) } cont: - C_kontinue(k, C_mk_bool(f)); + C_kontinue_av(av0, k, C_mk_bool(f)); } @@ -7130,6 +7142,7 @@ void C_ccall C_greater_or_equal_p(C_word c, C_word *av) C_word /* closure = av[ 0 ] */ k = av[ 1 ], + *av0=av, x, i2, f, fflag, ilast; double flast, f2; @@ -7181,7 +7194,7 @@ void C_ccall C_greater_or_equal_p(C_word c, C_word *av) } cont: - C_kontinue(k, C_mk_bool(f)); + C_kontinue_av(av0, k, C_mk_bool(f)); } @@ -7212,6 +7225,7 @@ void C_ccall C_less_or_equal_p(C_word c, C_word *av) C_word /* closure = av[ 0 ] */ k = av[ 1 ], + *av0=av, x, i2, f, fflag, ilast; double flast, f2; @@ -7263,7 +7277,7 @@ void C_ccall C_less_or_equal_p(C_word c, C_word *av) } cont: - C_kontinue(k, C_mk_bool(f)); + C_kontinue_av(av0, k, C_mk_bool(f)); } @@ -7317,9 +7331,9 @@ void C_ccall C_expt(C_word c, C_word *av) r = (C_word)m1; if(r == m1 && (n1 & C_FIXNUM_BIT) && (n2 & C_FIXNUM_BIT) && modf(m1, &m2) == 0.0 && C_fitsinfixnump(r)) - C_kontinue(k, C_fix(r)); + C_kontinue_av(av, k, C_fix(r)); - C_kontinue_flonum(k, m1); + C_kontinue_av_flonum(av, k, m1); } @@ -7363,7 +7377,7 @@ void C_ccall gc_2(C_word c, C_word *av) { C_word k = av[ 0 ]; - C_kontinue(k, C_fix((C_uword)C_fromspace_limit - (C_uword)C_fromspace_top)); + C_kontinue(k, C_fix((C_uword)C_fromspace_limit - (C_uword)C_fromspace_top)); // no av-reuse } @@ -7409,7 +7423,7 @@ void C_ccall C_open_file_port(C_word c, C_word *av) } C_set_block_item(port, 0, (C_word)fp); - C_kontinue(k, C_mk_bool(fp != NULL)); + C_kontinue_av(av, k, C_mk_bool(fp != NULL)); } @@ -7508,7 +7522,7 @@ void C_ccall allocate_vector_2(C_word c, C_word *av) C_memset(v0, C_character_code(init), size); } - C_kontinue(k, v); + C_kontinue(k, v); // Note: this argvector may not be reusable (see allocate_vector) } @@ -7536,7 +7550,7 @@ void C_ccall C_string_to_symbol(C_word c, C_word *av) if(!C_truep(s = lookup(key, len, name, symbol_table))) s = add_symbol(&a, key, string, symbol_table); - C_kontinue(k, s); + C_kontinue_av(av, k, s); } @@ -7549,7 +7563,7 @@ void C_ccall C_flonum_fraction(C_word c, C_word *av) double i, fn = C_flonum_magnitude(n); C_alloc_flonum; - C_kontinue_flonum(k, modf(fn, &i)); + C_kontinue_av_flonum(av, k, modf(fn, &i)); } @@ -7563,7 +7577,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 ]; + C_word *av2 = C_allocate_argvector(c, av, 4); if (isnormal(fn)) { /* Calculate bit-length of the fractional part (ie, after decimal point) */ @@ -7650,7 +7664,7 @@ void C_ccall C_quotient(C_word c, C_word *av) barf(C_DIVISION_BY_ZERO_ERROR, "quotient"); result = C_fix(C_unfix(n1) / n2); - C_kontinue(k, result); + C_kontinue_av(av, k, result); } else if(!C_immediatep(n2) && C_block_header(n2) == C_FLONUM_TAG) { f1 = (double)C_unfix(n1); @@ -7680,7 +7694,7 @@ void C_ccall C_quotient(C_word c, C_word *av) barf(C_DIVISION_BY_ZERO_ERROR, "quotient"); modf(f1 / f2, &r); - C_kontinue_flonum(k, r); + C_kontinue_av_flonum(av, k, r); } @@ -8043,7 +8057,7 @@ void C_ccall C_number_to_string(C_word c, C_word *av) radix = C_strlen(p); a = C_alloc((C_bytestowords(radix) + 1)); radix = C_string(&a, radix, p); - C_kontinue(k, radix); + C_kontinue_av(av, k, radix); } @@ -8066,7 +8080,7 @@ void C_ccall C_fixnum_to_string(C_word c, C_word *av) n = C_strlen(buffer); a = C_alloc(C_bytestowords(n) + 1); s = C_string2(&a, buffer); - C_kontinue(k, s); + C_kontinue_av(av, k, s); } @@ -8076,6 +8090,7 @@ void C_ccall C_make_structure(C_word c, C_word *av) /* closure = av[ 0 ] */ k = av[ 1 ], type = av[ 2 ], + *av0 = av, size = c - 3, *s, s0; @@ -8091,7 +8106,7 @@ void C_ccall C_make_structure(C_word c, C_word *av) while(size--) *(s++) = *(av++); - C_kontinue(k, s0); + C_kontinue_av(av0, k, s0); } @@ -8109,7 +8124,7 @@ void C_ccall C_make_symbol(C_word c, C_word *av) *(a++) = C_SCHEME_UNBOUND; *(a++) = name; *a = C_SCHEME_END_OF_LIST; - C_kontinue(k, s0); + C_kontinue_av(av, k, s0); } @@ -8123,7 +8138,7 @@ void C_ccall C_make_pointer(C_word c, C_word *av) p; p = C_mpointer(&a, NULL); - C_kontinue(k, p); + C_kontinue_av(av, k, p); } @@ -8138,7 +8153,7 @@ void C_ccall C_make_tagged_pointer(C_word c, C_word *av) p; p = C_taggedmpointer(&a, tag, NULL); - C_kontinue(k, p); + C_kontinue_av(av, k, p); } @@ -8165,7 +8180,7 @@ void C_ccall generic_trampoline(C_word c, C_word *av) { C_word k = av[ 0 ]; - C_kontinue(k, C_SCHEME_UNDEFINED); + C_kontinue(k, C_SCHEME_UNDEFINED); // no av-reuse! see C_ensure_heap_reserve } @@ -8200,7 +8215,7 @@ void C_ccall C_get_symbol_table_info(C_word c, C_word *av) d1 = compute_symbol_table_load(&d2, &total); x = C_flonum(&a, d1); /* load */ y = C_flonum(&a, d2); /* avg bucket length */ - C_kontinue(k, C_vector(&a, 4, x, y, C_fix(total), C_fix(n))); + C_kontinue_av(av, k, C_vector(&a, 4, x, y, C_fix(total), C_fix(n))); } @@ -8212,7 +8227,7 @@ void C_ccall C_get_memory_info(C_word c, C_word *av) ab[ 3 ], *a = ab; - C_kontinue(k, C_vector(&a, 2, C_fix(heap_size), C_fix(stack_size))); + C_kontinue_av(av, k, C_vector(&a, 2, C_fix(heap_size), C_fix(stack_size))); } @@ -8230,7 +8245,7 @@ void C_ccall C_context_switch(C_word c, C_word *av) * vector should not be re-invoked(?), but it can be kept alive * during GC, so the mutated argvector/state slots may turn stale. */ - av2 = C_alloc(n); + av2 = C_force_allocate_fresh_argvector(n); C_memcpy(av2, (C_word *)state + 2, n * sizeof(C_word)); tp(n, av2); } @@ -8247,10 +8262,10 @@ void C_ccall C_peek_signed_integer(C_word c, C_word *av) C_alloc_flonum; if((x & C_INT_SIGN_BIT) != (((C_uword)x << 1) & C_INT_SIGN_BIT)) { - C_kontinue_flonum(k, (double)x); + C_kontinue_av_flonum(av, k, (double)x); } - C_kontinue(k, C_fix(x)); + C_kontinue_av(av, k, C_fix(x)); } @@ -8265,10 +8280,10 @@ void C_ccall C_peek_unsigned_integer(C_word c, C_word *av) C_alloc_flonum; if((x & C_INT_SIGN_BIT) || (((C_uword)x << 1) & C_INT_SIGN_BIT)) { - C_kontinue_flonum(k, (double)(C_uword)x); + C_kontinue_av_flonum(av, k, (double)(C_uword)x); } - C_kontinue(k, C_fix(x)); + C_kontinue_av(av, k, C_fix(x)); } @@ -8292,7 +8307,7 @@ void C_ccall C_decode_seconds(C_word c, C_word *av) else tmt = C_gmtime(&tsecs); if(tmt == NULL) - C_kontinue(k, C_SCHEME_FALSE); + C_kontinue_av(av, k, C_SCHEME_FALSE); info = C_vector(&a, 10, C_fix(tmt->tm_sec), C_fix(tmt->tm_min), C_fix(tmt->tm_hour), C_fix(tmt->tm_mday), C_fix(tmt->tm_mon), C_fix(tmt->tm_year), @@ -8307,7 +8322,7 @@ void C_ccall C_decode_seconds(C_word c, C_word *av) C_fix(mode == C_SCHEME_FALSE ? timezone : 0) /* does not account for DST */ #endif ); - C_kontinue(k, info); + C_kontinue_av(av, k, info); } @@ -8333,7 +8348,7 @@ void C_ccall C_machine_byte_order(C_word c, C_word *av) a = C_alloc(2 + C_bytestowords(strlen(str))); s = C_string2(&a, str); - C_kontinue(k, s); + C_kontinue_av(av, k, s); } @@ -8349,7 +8364,7 @@ void C_ccall C_machine_type(C_word c, C_word *av) a = C_alloc(2 + C_bytestowords(strlen(C_MACHINE_TYPE))); s = C_string2(&a, C_MACHINE_TYPE); - C_kontinue(k, s); + C_kontinue_av(av, k, s); } @@ -8365,7 +8380,7 @@ void C_ccall C_software_type(C_word c, C_word *av) a = C_alloc(2 + C_bytestowords(strlen(C_SOFTWARE_TYPE))); s = C_string2(&a, C_SOFTWARE_TYPE); - C_kontinue(k, s); + C_kontinue_av(av, k, s); } @@ -8381,7 +8396,7 @@ void C_ccall C_build_platform(C_word c, C_word *av) a = C_alloc(2 + C_bytestowords(strlen(C_BUILD_PLATFORM))); s = C_string2(&a, C_BUILD_PLATFORM); - C_kontinue(k, s); + C_kontinue_av(av, k, s); } @@ -8397,7 +8412,7 @@ void C_ccall C_software_version(C_word c, C_word *av) a = C_alloc(2 + C_bytestowords(strlen(C_SOFTWARE_VERSION))); s = C_string2(&a, C_SOFTWARE_VERSION); - C_kontinue(k, s); + C_kontinue_av(av, k, s); } @@ -8412,10 +8427,10 @@ void C_ccall C_register_finalizer(C_word c, C_word *av) proc = av[ 3 ]; if(C_immediatep(x) || (!C_in_stackp(x) && !C_in_heapp(x))) /* not GCable? */ - C_kontinue(k, x); + C_kontinue_av(av, k, x); C_do_register_finalizer(x, proc); - C_kontinue(k, x); + C_kontinue_av(av, k, x); } @@ -8487,7 +8502,7 @@ void C_ccall C_set_dlopen_flags(C_word c, C_word *av) #if !defined(NO_DLOAD2) && defined(HAVE_DLFCN_H) dlopen_flags = (C_truep(now) ? RTLD_NOW : RTLD_LAZY) | (C_truep(global) ? RTLD_GLOBAL : RTLD_LOCAL); #endif - C_kontinue(k, C_SCHEME_UNDEFINED); + C_kontinue_av(av, k, C_SCHEME_UNDEFINED); } @@ -8505,7 +8520,7 @@ void C_ccall C_dload(C_word c, C_word *av) C_save_and_reclaim_args((void *)dload_2, 3, k, name, entry); #endif - C_kontinue(k, C_SCHEME_FALSE); + C_kontinue_av(av, k, C_SCHEME_FALSE); } @@ -8516,14 +8531,13 @@ void C_ccall C_dload(C_word c, C_word *av) #if !defined(NO_DLOAD2) && defined(HAVE_DL_H) && !defined(DLOAD_2_DEFINED) # ifdef __hpux__ # define DLOAD_2_DEFINED -void C_ccall dload_2(C_word c, C_word *av0) +void C_ccall dload_2(C_word c, C_word *av) { void *handle, *p; C_word - entry = av0[ 0 ], - name = av0[ 1 ], - k = av0[ 2 ],, - av[ 2 ]; + entry = av[ 0 ], + name = av[ 1 ], + k = av[ 2 ]: C_char *mname = (C_char *)C_data_pointer(name); /* @@ -8559,7 +8573,7 @@ void C_ccall dload_2(C_word c, C_word *av0) C_dlerror = (char *) C_strerror(errno); } - C_kontinue(k, C_SCHEME_FALSE); + C_kontinue_av(av, k, C_SCHEME_FALSE); } # endif #endif @@ -8568,14 +8582,13 @@ void C_ccall dload_2(C_word c, C_word *av0) #if !defined(NO_DLOAD2) && defined(HAVE_DLFCN_H) && !defined(DLOAD_2_DEFINED) # ifndef __hpux__ # define DLOAD_2_DEFINED -void C_ccall dload_2(C_word c, C_word *av0) +void C_ccall dload_2(C_word c, C_word *av) { void *handle, *p, *p2; C_word - entry = av0[ 0 ], - name = av0[ 1 ], - k = av0[ 2 ], - av[ 2 ]; + entry = av[ 0 ], + name = av[ 1 ], + k = av[ 2 ]; C_char *topname = (C_char *)C_data_pointer(entry); C_char *mname = (C_char *)C_data_pointer(name); C_char *tmp; @@ -8613,7 +8626,7 @@ void C_ccall dload_2(C_word c, C_word *av0) } C_dlerror = (char *)dlerror(); - C_kontinue(k, C_SCHEME_FALSE); + C_kontinue_av(av, k, C_SCHEME_FALSE); } # endif #endif @@ -8621,15 +8634,14 @@ void C_ccall dload_2(C_word c, C_word *av0) #if !defined(NO_DLOAD2) && (defined(HAVE_LOADLIBRARY) && defined(HAVE_GETPROCADDRESS)) && !defined(DLOAD_2_DEFINED) # define DLOAD_2_DEFINED -void C_ccall dload_2(C_word c, C_word *av0) +void C_ccall dload_2(C_word c, C_word *av) { HINSTANCE handle; FARPROC p = NULL, p2; C_word - entry = av0[ 0 ], - name = av0[ 1 ], - k = av0[ 2 ], - av[ 2 ]; + entry = av[ 0 ], + name = av[ 1 ], + k = av[ 2 ]; C_char *topname = (C_char *)C_data_pointer(entry); C_char *mname = (C_char *)C_data_pointer(name); @@ -8639,7 +8651,7 @@ void C_ccall dload_2(C_word c, C_word *av0) int l = C_header_size(name); if (C_strncasecmp(".dll", n+l-5, 4) && C_strncasecmp(".so", n+l-4, 3)) - C_kontinue(k, C_SCHEME_FALSE); + C_kontinue_av(av, k, C_SCHEME_FALSE); } if((handle = LoadLibrary(mname)) != NULL) { @@ -8660,7 +8672,7 @@ void C_ccall dload_2(C_word c, C_word *av0) } C_dlerror = (char *) C_strerror(errno); - C_kontinue(k, C_SCHEME_FALSE); + C_kontinue_av(av, k, C_SCHEME_FALSE); } #endif @@ -8706,7 +8718,7 @@ void C_ccall become_2(C_word c, C_word *av) C_word k = av[ 0 ]; *forwarding_table = 0; - C_kontinue(k, C_SCHEME_UNDEFINED); + C_kontinue_av(av, k, C_SCHEME_UNDEFINED); } @@ -8804,16 +8816,16 @@ void C_ccall C_locative_ref(C_word c, C_word *av) if(ptr == NULL) barf(C_LOST_LOCATIVE_ERROR, "locative-ref", loc); switch(C_unfix(C_block_item(loc, 2))) { - case C_SLOT_LOCATIVE: C_kontinue(k, *ptr); - case C_CHAR_LOCATIVE: C_kontinue(k, C_make_character(*((char *)ptr))); - case C_U8_LOCATIVE: C_kontinue(k, C_fix(*((unsigned char *)ptr))); - 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_kontinue(k, C_unsigned_int_to_num(&a, *((C_u32 *)ptr))); - case C_S32_LOCATIVE: C_kontinue(k, C_int_to_num(&a, *((C_s32 *)ptr))); - case C_F32_LOCATIVE: C_kontinue(k, C_flonum(&a, *((float *)ptr))); - case C_F64_LOCATIVE: C_kontinue(k, C_flonum(&a, *((double *)ptr))); + case C_SLOT_LOCATIVE: C_kontinue_av(av, k, *ptr); + case C_CHAR_LOCATIVE: C_kontinue_av(av, k, C_make_character(*((char *)ptr))); + case C_U8_LOCATIVE: C_kontinue_av(av, k, C_fix(*((unsigned char *)ptr))); + case C_S8_LOCATIVE: C_kontinue_av(av, k, C_fix(*((char *)ptr))); + case C_U16_LOCATIVE: C_kontinue_av(av, k, C_fix(*((unsigned short *)ptr))); + case C_S16_LOCATIVE: C_kontinue_av(av, k, C_fix(*((short *)ptr))); + case C_U32_LOCATIVE: C_kontinue_av(av, k, C_unsigned_int_to_num(&a, *((C_u32 *)ptr))); + case C_S32_LOCATIVE: C_kontinue_av(av, k, C_int_to_num(&a, *((C_s32 *)ptr))); + case C_F32_LOCATIVE: C_kontinue_av(av, k, C_flonum(&a, *((float *)ptr))); + case C_F64_LOCATIVE: C_kontinue_av(av, k, C_flonum(&a, *((double *)ptr))); default: panic(C_text("bad locative type")); } } @@ -9022,7 +9034,7 @@ static void C_ccall copy_closure_2(C_word c, C_word *av) *(p++) = C_CLOSURE_TYPE | cells; /* this is only allowed because the storage is freshly allocated: */ C_memcpy_slots(p, C_data_pointer(proc), cells); - C_kontinue(k, (C_word)ptr); + C_kontinue(k, (C_word)ptr); // no argv-reuse! } @@ -9035,7 +9047,7 @@ void C_ccall C_call_with_cthulhu(C_word c, C_word *av) k = av[ 1 ], proc = av[ 2 ], *a = C_alloc(3), - av2[ 4 ]; + *av2 = C_allocate_argvector(c, av, 4); av2[ 0 ] = C_SCHEME_UNDEFINED; av2[ 1 ] = C_closure(&a, 1, (C_word)termination_continuation); /* k */ @@ -9643,7 +9655,7 @@ static void C_ccall dump_heap_state_2(C_word c, C_word *av) C_fprintf(C_stderr, C_text("\ntotal number of blocks: %d, immediates: %d\n"), blk, imm); C_free(hdump_table); - C_kontinue(k, C_SCHEME_UNDEFINED); + C_kontinue_av(av, k, C_SCHEME_UNDEFINED); } @@ -9683,14 +9695,14 @@ static void C_ccall filter_heap_objects_2(C_word c, C_word *av) ++vcount; } else { - C_kontinue(k, C_fix(-1)); + C_kontinue_av(av, k, C_fix(-1)); // no arg-reuse } } scan = (C_byte *)sbp + C_align(bytes) + sizeof(C_word); } - C_kontinue(k, C_fix(vcount)); + C_kontinue_av(av, k, C_fix(vcount)); // no arg-reuse } -- 2.6.2