~ chicken-core (chicken-5) 9f6a25779c62ce2a6c90d8fd1cdee4c04a4e3cfd
commit 9f6a25779c62ce2a6c90d8fd1cdee4c04a4e3cfd Author: Peter Bex <peter@more-magic.net> AuthorDate: Sat Aug 22 15:30:39 2015 +0200 Commit: Peter Bex <peter@more-magic.net> CommitDate: Sat Aug 22 15:30:39 2015 +0200 removed C_procXXX definitions, simplified cps-proc declarations, removed obsolete stuff Conflicts: chicken.h diff --git a/chicken.h b/chicken.h index a27080e1..6605ffab 100644 --- a/chicken.h +++ b/chicken.h @@ -817,78 +817,13 @@ typedef struct C_ptable_entry_struct void *ptr; } C_PTABLE_ENTRY; -#ifdef __x86_64__ -# define C_AMD64_ABI_WEIRDNESS , ... -#else -# define C_AMD64_ABI_WEIRDNESS -#endif - -/* C_WORD_p<P>_<B>: List of ((2 ** P) * B) 'C_word' parameters */ -#define C_WORD_p0_0 -#define C_WORD_p1_0 -#define C_WORD_p2_0 -#define C_WORD_p3_0 -#define C_WORD_p4_0 -#define C_WORD_p5_0 -#define C_WORD_p6_0 -#define C_WORD_p7_0 -#define C_WORD_p0_1 C_word, -#define C_WORD_p1_1 C_word, C_word, -#define C_WORD_p2_1 C_WORD_p1_1 C_WORD_p1_1 -#define C_WORD_p3_1 C_WORD_p2_1 C_WORD_p2_1 -#define C_WORD_p4_1 C_WORD_p3_1 C_WORD_p3_1 -#define C_WORD_p5_1 C_WORD_p4_1 C_WORD_p4_1 -#define C_WORD_p6_1 C_WORD_p5_1 C_WORD_p5_1 -#define C_WORD_p7_1 C_WORD_p6_1 C_WORD_p6_1 - -/* DECL_C_PROC_p0 (n0, p7,p6,p5,p4,p3,p2,p1,p0): - * declare function C_proc<n0>, which have <n0> 'C_word' parameters - * (not counting last 'C_word C_AMD64_ABI_WEIRDNESS' one). - * We must have: n0 = SUM (i = 7 to 0, p<i> * (1 << i)). - * DECL_C_PROC_p<N+1> (...): - * declare 2 as much functions as DECL_C_PROC_p<N>... - */ -#define DECL_C_PROC_p0( n0, p7,p6,p5,p4,p3,p2,p1,p0) \ - typedef void (C_ccall *C_proc##n0) (C_WORD_p7_##p7 C_WORD_p6_##p6 \ - C_WORD_p5_##p5 C_WORD_p4_##p4 \ - C_WORD_p3_##p3 C_WORD_p2_##p2 \ - C_WORD_p1_##p1 C_WORD_p0_##p0 \ - C_word C_AMD64_ABI_WEIRDNESS) C_noret; -#define DECL_C_PROC_p1( n0,n1, p7,p6,p5,p4,p3,p2,p1) \ - DECL_C_PROC_p0 (n0, p7,p6,p5,p4,p3,p2,p1,0) \ - DECL_C_PROC_p0 (n1, p7,p6,p5,p4,p3,p2,p1,1) -#define DECL_C_PROC_p2( n0,n1,n2,n3, p7,p6,p5,p4,p3,p2) \ - DECL_C_PROC_p1 (n0,n1, p7,p6,p5,p4,p3,p2,0) \ - DECL_C_PROC_p1 (n2,n3, p7,p6,p5,p4,p3,p2,1) -#define DECL_C_PROC_p3( n0,n1,n2,n3,n4,n5,n6,n7, p7,p6,p5,p4,p3) \ - DECL_C_PROC_p2 (n0,n1,n2,n3, p7,p6,p5,p4,p3,0) \ - DECL_C_PROC_p2 (n4,n5,n6,n7, p7,p6,p5,p4,p3,1) - -DECL_C_PROC_p1 (2,3, 0,0,0,0,0,0,1) -DECL_C_PROC_p2 (4,5,6,7, 0,0,0,0,0,1) -DECL_C_PROC_p3 (8,9,10,11,12,13,14,15, 0,0,0,0,1) -DECL_C_PROC_p3 (16,17,18,19,20,21,22,23, 0,0,0,1,0) -DECL_C_PROC_p3 (24,25,26,27,28,29,30,31, 0,0,0,1,1) -DECL_C_PROC_p3 (32,33,34,35,36,37,38,39, 0,0,1,0,0) -DECL_C_PROC_p3 (40,41,42,43,44,45,46,47, 0,0,1,0,1) -DECL_C_PROC_p3 (48,49,50,51,52,53,54,55, 0,0,1,1,0) -DECL_C_PROC_p3 (56,57,58,59,60,61,62,63, 0,0,1,1,1) -DECL_C_PROC_p1 (64,65, 0,1,0,0,0,0,0) -DECL_C_PROC_p0 (66, 0,1,0,0,0,0,1,0) -DECL_C_PROC_p0 (67, 0,1,0,0,0,0,1,1) -DECL_C_PROC_p2 (68,69,70,71, 0,1,0,0,0,1) -DECL_C_PROC_p3 (72,73,74,75,76,77,78,79, 0,1,0,0,1) -DECL_C_PROC_p3 (80,81,82,83,84,85,86,87, 0,1,0,1,0) -DECL_C_PROC_p3 (88,89,90,91,92,93,94,95, 0,1,0,1,1) -DECL_C_PROC_p3 (96,97,98,99,100,101,102,103, 0,1,1,0,0) -DECL_C_PROC_p3 (104,105,106,107,108,109,110,111, 0,1,1,0,1) -DECL_C_PROC_p3 (112,113,114,115,116,117,118,119, 0,1,1,1,0) -DECL_C_PROC_p3 (120,121,122,123,124,125,126,127, 0,1,1,1,1) -DECL_C_PROC_p0 (128, 1,0,0,0,0,0,0,0) +typedef void (C_ccall *C_proc)(C_word, C_word *); /* Macros: */ +#define C_cpsproc(name) C_ccall void name(C_word c, C_word *av) C_noret + #define CHICKEN_gc_root_ref(root) (((C_GC_ROOT *)(root))->value) #define CHICKEN_gc_root_set(root, x) C_mutate2(&((C_GC_ROOT *)(root))->value, (x)) @@ -1112,8 +1047,6 @@ DECL_C_PROC_p0 (128, 1,0,0,0,0,0,0,0) #define C_save(x) (*(--C_temporary_stack) = (C_word)(x)) #define C_adjust_stack(n) (C_temporary_stack -= (n)) #define C_rescue(x, i) (C_temporary_stack[ i ] = (x)) -#define C_save_rest(s, c, n) do { if((C_temporary_stack - (c - (n))) < C_temporary_stack_limit) C_temp_stack_overflow(); for(va_start(v, s); c-- > (n); C_save(va_arg(v, C_word))); }while(0) -#define C_rest_count(c) ((C_temporary_stack_bottom - C_temporary_stack) - (c)) #define C_restore (*(C_temporary_stack++)) #define C_heaptop ((C_word **)(&C_fromspace_top)) #define C_pick(n) (C_temporary_stack[ n ]) @@ -1858,8 +1791,7 @@ C_fctexport C_word C_fcall C_h_intern(C_word *slot, int len, C_char *str) C_regp C_fctexport C_word C_fcall C_h_intern_in(C_word *slot, int len, C_char *str, C_SYMBOL_TABLE *stable) C_regparm; C_fctexport C_word C_fcall C_intern2(C_word **ptr, C_char *str) C_regparm; C_fctexport C_word C_fcall C_intern3(C_word **ptr, C_char *str, C_word value) C_regparm; -C_fctexport C_word C_fcall C_restore_rest(C_word *ptr, int num) C_regparm; -C_fctexport C_word C_fcall C_restore_rest_vector(C_word *ptr, int num) C_regparm; +C_fctexport C_word C_fcall C_build_rest(C_word *ptr, C_word n, C_word *av) C_regparm; C_fctexport void C_bad_memory(void) C_noret; C_fctexport void C_bad_memory_2(void) C_noret; C_fctexport void C_bad_argc(int c, int n) C_noret; @@ -1887,8 +1819,9 @@ C_fctexport C_word C_structure(C_word **ptr, int n, ...); C_fctexport C_word C_fcall C_mutate_slot(C_word *slot, C_word val) C_regparm; C_fctexport C_word C_fcall C_scratch_alloc(C_uword size) C_regparm; C_fctexport C_word C_fcall C_migrate_buffer_object(C_word **ptr, C_word *start, C_word *end, C_word obj) C_regparm; -C_fctexport void C_fcall C_reclaim(void *trampoline, void *proc) C_regparm C_noret; -C_fctexport void C_save_and_reclaim(void *trampoline, void *proc, int n, ...) C_noret; +C_fctexport void C_fcall C_reclaim(void *trampoline, C_word c) C_regparm C_noret; +C_fctexport void C_save_and_reclaim(void *trampoline, int n, C_word *av) C_noret; +C_fctexport void C_save_and_reclaim_args(void *trampoline, int n, ...) C_noret; C_fctexport void C_fcall C_rereclaim2(C_uword size, int double_plus) C_regparm; C_fctexport void C_unbound_variable(C_word sym); C_fctexport C_word C_fcall C_retrieve2(C_word val, char *name) C_regparm; @@ -1936,74 +1869,73 @@ C_fctexport C_char *C_executable_dirname(); C_fctexport C_char *C_executable_pathname(); C_fctexport C_char *C_resolve_executable_pathname(C_char *fname); -C_fctimport void C_ccall C_toplevel(C_word c, C_word self, C_word k) C_noret; -C_fctimport void C_ccall C_invalid_procedure(int c, C_word self, ...) C_noret; -C_fctexport void C_ccall C_stop_timer(C_word c, C_word closure, C_word k) C_noret; -C_fctexport void C_ccall C_signum(C_word c, C_word self, C_word k, C_word x) C_noret; -C_fctexport void C_ccall C_apply(C_word c, C_word closure, C_word k, C_word fn, ...) C_noret; -C_fctexport void C_ccall C_do_apply(C_word n, C_word closure, C_word k) C_noret; -C_fctexport void C_ccall C_call_cc(C_word c, C_word closure, C_word k, C_word cont) C_noret; -C_fctexport void C_ccall C_continuation_graft(C_word c, C_word closure, C_word k, C_word kk, C_word proc) C_noret; -C_fctexport void C_ccall C_values(C_word c, C_word closure, C_word k, ...) C_noret; -C_fctexport void C_ccall C_apply_values(C_word c, C_word closure, C_word k, C_word lst) C_noret; -C_fctexport void C_ccall C_call_with_values(C_word c, C_word closure, C_word k, C_word thunk, C_word kont) C_noret; -C_fctexport void C_ccall C_u_call_with_values(C_word c, C_word closure, C_word k, C_word thunk, C_word kont) C_noret; -C_fctexport void C_ccall C_times(C_word c, C_word closure, C_word k, ...) C_noret; -C_fctexport void C_ccall C_plus(C_word c, C_word closure, C_word k, ...) C_noret; -C_fctexport void C_ccall C_minus(C_word c, C_word closure, C_word k, C_word n1, ...) C_noret; +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_signum); +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); /* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */ -C_fctexport void C_ccall C_divide(C_word c, C_word closure, C_word k, C_word n1, ...) C_noret; -C_fctexport void C_ccall C_quotient_and_remainder(C_word c, C_word self, C_word k, C_word x, C_word y) C_noret; -C_fctexport void C_ccall C_u_integer_quotient_and_remainder(C_word c, C_word self, C_word k, C_word x, C_word y) C_noret; -C_fctexport void C_ccall C_bitwise_and(C_word c, C_word closure, C_word k, ...) C_noret; -C_fctexport void C_ccall C_bitwise_ior(C_word c, C_word closure, C_word k, ...) C_noret; -C_fctexport void C_ccall C_bitwise_xor(C_word c, C_word closure, C_word k, ...) C_noret; - -C_fctexport void C_ccall C_nequalp(C_word c, C_word closure, C_word k, ...) C_noret; -C_fctexport void C_ccall C_greaterp(C_word c, C_word closure, C_word k, ...) C_noret; -C_fctexport void C_ccall C_lessp(C_word c, C_word closure, C_word k, ...) C_noret; -C_fctexport void C_ccall C_greater_or_equal_p(C_word c, C_word closure, C_word k, ...) C_noret; -C_fctexport void C_ccall C_less_or_equal_p(C_word c, C_word closure, C_word k, ...) C_noret; -C_fctexport void C_ccall C_gc(C_word c, C_word closure, C_word k, ...) C_noret; -C_fctexport void C_ccall C_open_file_port(C_word c, C_word closure, C_word k, C_word port, C_word channel, C_word mode) C_noret; -C_fctexport void C_ccall C_allocate_vector(C_word c, C_word closure, C_word k, C_word size, C_word type, C_word init, C_word align8) C_noret; -C_fctexport void C_ccall C_string_to_symbol(C_word c, C_word closure, C_word k, C_word string) C_noret; -C_fctexport void C_ccall C_build_symbol(C_word c, C_word closure, C_word k, C_word string) C_noret; +C_fctexport C_cpsproc(C_divide); +C_fctexport C_cpsproc(C_quotient_and_remainder); +C_fctexport C_cpsproc(C_u_integer_quotient_and_remainder); +C_fctexport C_cpsproc(C_bitwise_and); +C_fctexport C_cpsproc(C_bitwise_ior); +C_fctexport C_cpsproc(C_bitwise_xor); + +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_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); /* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */ -C_fctexport void C_ccall C_quotient(C_word c, C_word closure, C_word k, C_word n1, C_word n2) C_noret; -C_fctexport void C_ccall C_number_to_string(C_word c, C_word closure, C_word k, C_word num, ...) C_noret; -C_fctexport void C_ccall C_fixnum_to_string(C_word c, C_word closure, C_word k, C_word num, C_word radix) C_noret; -C_fctexport void C_ccall C_flonum_to_string(C_word c, C_word closure, C_word k, C_word num, C_word radix) C_noret; -C_fctexport void C_ccall C_integer_to_string(C_word c, C_word closure, C_word k, C_word num, C_word radix) C_noret; -C_fctexport void C_ccall C_make_structure(C_word c, C_word closure, C_word k, C_word type, ...) C_noret; -C_fctexport void C_ccall C_make_symbol(C_word c, C_word closure, C_word k, C_word name) C_noret; -C_fctexport void C_ccall C_make_pointer(C_word c, C_word closure, C_word k) C_noret; -C_fctexport void C_ccall C_make_tagged_pointer(C_word c, C_word closure, C_word k, C_word tag) C_noret; -C_fctexport void C_ccall C_ensure_heap_reserve(C_word c, C_word closure, C_word k, C_word n) C_noret; -C_fctexport void C_ccall C_return_to_host(C_word c, C_word closure, C_word k) C_noret; -C_fctexport void C_ccall C_get_symbol_table_info(C_word c, C_word closure, C_word k) C_noret; -C_fctexport void C_ccall C_get_memory_info(C_word c, C_word closure, C_word k) C_noret; -C_fctexport void C_ccall C_context_switch(C_word c, C_word closure, C_word k, C_word state) C_noret; -C_fctexport void C_ccall C_peek_signed_integer(C_word c, C_word closure, C_word k, C_word v, C_word index) C_noret; -C_fctexport void C_ccall C_peek_unsigned_integer(C_word c, C_word closure, C_word k, C_word v, C_word index) C_noret; -C_fctexport void C_ccall C_peek_int64(C_word c, C_word closure, C_word k, C_word v, C_word index) C_noret; -C_fctexport void C_ccall C_peek_uint64(C_word c, C_word closure, C_word k, C_word v, C_word index) C_noret; -C_fctexport void C_ccall C_decode_seconds(C_word c, C_word closure, C_word k, C_word secs, C_word mode) C_noret; -C_fctexport void C_ccall C_software_type(C_word c, C_word closure, C_word k) C_noret; -C_fctexport void C_ccall C_machine_type(C_word c, C_word closure, C_word k) C_noret; -C_fctexport void C_ccall C_machine_byte_order(C_word c, C_word closure, C_word k) C_noret; -C_fctexport void C_ccall C_software_version(C_word c, C_word closure, C_word k) C_noret; -C_fctexport void C_ccall C_build_platform(C_word c, C_word closure, C_word k) C_noret; -C_fctexport void C_ccall C_register_finalizer(C_word c, C_word closure, C_word k, C_word x, C_word proc) C_noret; -C_fctexport void C_ccall C_set_dlopen_flags(C_word c, C_word closure, C_word k, C_word now, C_word global) C_noret; -C_fctexport void C_ccall C_dload(C_word c, C_word closure, C_word k, C_word name, C_word entry) C_noret; -C_fctexport void C_ccall C_become(C_word c, C_word closure, C_word k, C_word table) C_noret; -C_fctexport void C_ccall C_locative_ref(C_word c, C_word closure, C_word k, C_word loc) C_noret; -C_fctexport void C_ccall C_call_with_cthulhu(C_word c, C_word self, C_word k, C_word proc) C_noret; -C_fctexport void C_ccall C_copy_closure(C_word c, C_word closure, C_word k, C_word proc) C_noret; -C_fctexport void C_ccall C_dump_heap_state(C_word x, C_word closure, C_word k) C_noret; -C_fctexport void C_ccall C_filter_heap_objects(C_word x, C_word closure, C_word k, C_word func, - C_word vector, C_word userarg) C_noret; +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_flonum_to_string); +C_fctexport C_cpsproc(C_integer_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_peek_int64); +C_fctexport C_cpsproc(C_peek_uint64); +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_fctexport time_t C_fcall C_seconds(C_long *ms) C_regparm; C_fctexport C_word C_fcall C_bignum_simplify(C_word big) C_regparm; C_fctexport C_word C_fcall C_allocate_scratch_bignum(C_word **ptr, C_word size, C_word negp, C_word initp) C_regparm; @@ -2210,8 +2142,8 @@ C_fctexport C_char *C_lookup_procedure_id(void *ptr); C_fctexport void *C_lookup_procedure_ptr(C_char *id); #ifdef C_SIXTY_FOUR -C_fctexport void C_ccall C_peek_signed_integer_32(C_word c, C_word closure, C_word k, C_word v, C_word index) C_noret; -C_fctexport void C_ccall C_peek_unsigned_integer_32(C_word c, C_word closure, C_word k, C_word v, C_word index) C_noret; +C_fctexport C_cpsproc(C_peek_signed_integer_32); +C_fctexport C_cpsproc(C_peek_unsigned_integer_32); #else # define C_peek_signed_integer_32 C_peek_signed_integer # define C_peek_unsigned_integer_32 C_peek_unsigned_integerTrap