~ 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_integer
Trap