>From 2bec6159ae1a5be4609e7b38a2076f723cd8ea0e Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Sat, 7 Jun 2014 22:21:10 +0200 Subject: [PATCH] Remove obsolete procedures and C functions, undeprecate C_mutate() and deprecate C_mutate2(). An obscure deprecated internal detail of how temporaries introduced by specialization were handled is now converted from a comment to a hard error. If this causes no trouble we can eventually really remove it. In particular, these Scheme procedures were removed: ##sys#zap-strings, ##sys#round, ##sys#foreign-number-vector-argument These public C functions and macros were removed: C_zap_strings, C_stack_check, C_retrieve, C_retrieve_proc, C_retrieve_symbol_proc, C_i_foreign_number_vector_argumentp, C_display_flonum, C_enumerate_symbols, C_get_argv, C_get_argument, C_get_environment_variable These internal C functions and macros were removed: resolve_procedure, C_get_argv_2, get_argument_2, C_do_getenv, C_free_envbuf, get_environment_variable_2 --- NEWS | 13 +++ c-platform.scm | 2 - chicken-install.scm | 2 - chicken.h | 22 ++--- csi.scm | 1 - eval.scm | 2 +- library.scm | 6 -- runtime.c | 253 +++------------------------------------------------ support.scm | 2 +- 9 files changed, 35 insertions(+), 268 deletions(-) diff --git a/NEWS b/NEWS index f96f68b..acec2fc 100644 --- a/NEWS +++ b/NEWS @@ -11,6 +11,19 @@ - set-file-position! now allows negative positions for seek/cur (thanks to Seth Alves). +- Runtime system: + - Removed several deprecated, undocumented parts of the C interface: + C_zap_strings, C_stack_check, C_retrieve, C_retrieve_proc, + C_retrieve_symbol_proc, C_i_foreign_number_vector_argumentp, + C_display_flonum, C_enumerate_symbols + - Removed several deprecated and undocumented internal procedures: + ##sys#zap-strings, ##sys#round, ##sys#foreign-number-vector-argument + +- C API + - Removed deprecated C_get_argument[_2] and + C_get_environment_variable[_2] functions. + - C_mutate2 has been deprecated in favor of C_mutate + 4.9.0 - Security fixes diff --git a/c-platform.scm b/c-platform.scm index efbc52e..6887b6b 100644 --- a/c-platform.scm +++ b/c-platform.scm @@ -788,8 +788,6 @@ (rewrite 'lcm 18 1) (rewrite 'list 18 '()) -(rewrite 'argv 13 "C_get_argv" #t) - (rewrite '* 16 2 "C_a_i_times" #t 4) ; words-per-flonum (rewrite '+ 16 2 "C_a_i_plus" #t 4) ; words-per-flonum (rewrite '- 16 2 "C_a_i_minus" #t 4) ; words-per-flonum diff --git a/chicken-install.scm b/chicken-install.scm index 2df88c8..732ea2a 100644 --- a/chicken-install.scm +++ b/chicken-install.scm @@ -26,8 +26,6 @@ (require-library setup-download setup-api) (require-library srfi-1 posix data-structures utils irregex ports extras srfi-13 files) -(require-library chicken-syntax) ; OBSOLETE (but left to allow older chicken's to bootstrap) -(require-library chicken-ffi-syntax) ; same reason, also for filling modules.db (module main () diff --git a/chicken.h b/chicken.h index 03138cd..4a3c77a 100644 --- a/chicken.h +++ b/chicken.h @@ -1136,9 +1136,6 @@ extern double trunc(double); #define C_stack_overflow_check C_stack_check1(C_stack_overflow()) -/*XXX OBSOLETE */ -#define C_stack_check C_stack_overflow_check - #if C_STACK_GROWS_DOWNWARD # define C_demand(n) (C_stress && ((C_word)(C_stack_pointer - C_stack_limit) > (n))) # define C_stack_probe(p) (C_stress && ((C_word *)(p) >= C_stack_limit)) @@ -1717,7 +1714,6 @@ C_fctexport void C_fcall C_toplevel_entry(C_char *name) C_regparm; C_fctexport C_word C_fcall C_enable_interrupts(void) C_regparm; C_fctexport C_word C_fcall C_disable_interrupts(void) C_regparm; C_fctexport void C_fcall C_paranoid_check_for_interrupt(void) C_regparm; -C_fctexport void C_zap_strings(C_word str); /* OBSOLETE */ C_fctexport void C_set_or_change_heap_size(C_word heap, int reintern); C_fctexport void C_do_resize_stack(C_word stack); C_fctexport C_word C_resize_pending_finalizers(C_word size); @@ -1770,15 +1766,11 @@ C_fctexport C_word C_fcall C_swigmpointer(C_word **ptr, void *mp, void *sdata) C C_fctexport C_word C_vector(C_word **ptr, int n, ...); 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_mutate(C_word *slot, C_word val) 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_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_retrieve(C_word sym) C_regparm; C_fctexport C_word C_fcall C_retrieve2(C_word val, char *name) C_regparm; -C_fctexport void *C_fcall C_retrieve_proc(C_word closure) C_regparm; -C_fctexport void *C_fcall C_retrieve_symbol_proc(C_word sym) C_regparm; C_fctexport void *C_fcall C_retrieve2_symbol_proc(C_word val, char *name) C_regparm; C_fctexport int C_in_stackp(C_word x) C_regparm; C_fctexport int C_fcall C_in_heapp(C_word x) C_regparm; @@ -1793,7 +1785,6 @@ C_fctexport C_word C_fcall C_equalp(C_word x, C_word y) C_regparm; C_fctexport C_word C_fcall C_set_gc_report(C_word flag) C_regparm; C_fctexport C_word C_fcall C_start_timer(void) C_regparm; C_fctexport C_word C_exit_runtime(C_word code); -C_fctexport C_word C_fcall C_display_flonum(C_word port, C_word n) C_regparm; /* OBSOLETE */ C_fctexport C_word C_fcall C_set_print_precision(C_word n) C_regparm; C_fctexport C_word C_fcall C_get_print_precision(void) C_regparm; C_fctexport C_word C_fcall C_read_char(C_word port) C_regparm; @@ -1814,7 +1805,6 @@ C_fctexport void C_set_symbol_table(C_SYMBOL_TABLE *st) C_regparm; C_fctexport C_SYMBOL_TABLE *C_find_symbol_table(char *name) C_regparm; C_fctexport C_word C_find_symbol(C_word str, C_SYMBOL_TABLE *stable) C_regparm; C_fctexport C_word C_fcall C_lookup_symbol(C_word sym) C_regparm; -C_fctexport C_word C_enumerate_symbols(C_SYMBOL_TABLE *stable, C_word pos) C_regparm; C_fctexport void C_do_register_finalizer(C_word x, C_word proc); C_fctexport int C_do_unregister_finalizer(C_word x); C_fctexport C_word C_dbg_hook(C_word x); @@ -1852,15 +1842,12 @@ C_fctexport void C_ccall C_flonum_rat(C_word c, C_word closure, C_word k, C_word 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_noret; -C_fctexport void C_ccall C_get_argv(C_word c, C_word closure, C_word k) C_noret; /* OBSOLETE */ -C_fctexport void C_ccall C_get_argument(C_word c, C_word closure, C_word k, C_word index) C_noret; /* OBSOLETE */ 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_environment_variable(C_word c, C_word closure, C_word k, C_word name) C_noret; /* OBSOLETE */ 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; @@ -2003,7 +1990,6 @@ C_fctexport C_word C_fcall C_i_foreign_char_argumentp(C_word x) C_regparm; C_fctexport C_word C_fcall C_i_foreign_fixnum_argumentp(C_word x) C_regparm; C_fctexport C_word C_fcall C_i_foreign_flonum_argumentp(C_word x) C_regparm; C_fctexport C_word C_fcall C_i_foreign_block_argumentp(C_word x) C_regparm; -C_fctexport C_word C_fcall C_i_foreign_number_vector_argumentp(C_word t, C_word x) C_regparm; /* OBSOLETE */ C_fctexport C_word C_fcall C_i_foreign_struct_wrapper_argumentp(C_word t, C_word x) C_regparm; C_fctexport C_word C_fcall C_i_foreign_string_argumentp(C_word x) C_regparm; C_fctexport C_word C_fcall C_i_foreign_symbol_argumentp(C_word x) C_regparm; @@ -2060,12 +2046,18 @@ C_inline C_word *C_a_i(C_word **a, int n) #endif C_inline C_word -C_mutate2(C_word *slot, C_word val) +C_mutate(C_word *slot, C_word val) { if(!C_immediatep(val)) return C_mutate_slot(slot, val); else return *slot = val; } +C_inline C_word +C_mutate2(C_word *slot, C_word val) /* OBSOLETE */ +{ + if(!C_immediatep(val)) return C_mutate_slot(slot, val); + else return *slot = val; +} C_inline C_word C_permanentp(C_word x) { diff --git a/csi.scm b/csi.scm index 3565a5f..d3b9549 100644 --- a/csi.scm +++ b/csi.scm @@ -26,7 +26,6 @@ (declare - (uses chicken-syntax) ; OBSOLETE (but left to allow older chicken's to bootstrap) (uses ports extras) (usual-integrations) (disable-interrupts) diff --git a/eval.scm b/eval.scm index ed1b92d..fea8a02 100644 --- a/eval.scm +++ b/eval.scm @@ -265,7 +265,7 @@ ((##sys#symbol-has-toplevel-binding? var) (lambda v (##sys#slot var 0))) (else - (lambda v (##core#inline "C_retrieve" var)))))) + (lambda v (##core#inline "C_fast_retrieve" var)))))) (else (case i ((0) (lambda (v) diff --git a/library.scm b/library.scm index 59ddc36..87f7649 100644 --- a/library.scm +++ b/library.scm @@ -996,8 +996,6 @@ EOF x (##core#inline_allocate ("C_a_i_flonum_round_proper" 4) x))) -(define ##sys#round round) ; this is obsolete and is used by the "numbers" egg (gmp version) - (define remainder (lambda (x y) (- x (* (quotient x y) y))) ) @@ -4433,9 +4431,6 @@ EOF from to offset1 offset2 bytes) ) -;; OBSOLETE -(define ##sys#zap-strings (foreign-lambda void "C_zap_strings" scheme-object)) - (define (##sys#block-pointer x) (let ([ptr (##sys#make-pointer)]) (##core#inline "C_pointer_to_block" ptr x) @@ -4452,7 +4447,6 @@ EOF (define (##sys#foreign-struct-wrapper-argument t x) (##core#inline "C_i_foreign_struct_wrapper_argumentp" t x)) -(define ##sys#foreign-number-vector-argument ##sys#foreign-struct-wrapper-argument) ;OBSOLETE (define (##sys#foreign-string-argument x) (##core#inline "C_i_foreign_string_argumentp" x)) (define (##sys#foreign-symbol-argument x) (##core#inline "C_i_foreign_symbol_argumentp" x)) (define (##sys#foreign-pointer-argument x) (##core#inline "C_i_foreign_pointer_argumentp" x)) diff --git a/runtime.c b/runtime.c index ef2f199..f8917cf 100644 --- a/runtime.c +++ b/runtime.c @@ -512,11 +512,8 @@ static C_ccall void call_cc_wrapper(C_word c, C_word closure, C_word k, C_word r static C_ccall void call_cc_values_wrapper(C_word c, C_word closure, C_word k, ...) C_noret; static void gc_2(void *dummy) C_noret; static void allocate_vector_2(void *dummy) C_noret; -static void get_argv_2(void *dummy) C_noret; /* OBSOLETE */ -static void get_argument_2(void *dummy) C_noret; /* OBSOLETE */ static void make_structure_2(void *dummy) C_noret; static void generic_trampoline(void *dummy) C_noret; -static void get_environment_variable_2(void *dummy) C_noret; /* OBSOLETE */ static void handle_interrupt(void *trampoline, void *proc) C_noret; static void callback_trampoline(void *dummy) C_noret; static C_ccall void callback_return_continuation(C_word c, C_word self, C_word r) C_noret; @@ -785,8 +782,9 @@ int CHICKEN_initialize(int heap, int stack, int symbols, void *toplevel) static C_PTABLE_ENTRY *create_initial_ptable() { - /* IMPORTANT: hardcoded table size - this must match the number of C_pte calls! */ - C_PTABLE_ENTRY *pt = (C_PTABLE_ENTRY *)C_malloc(sizeof(C_PTABLE_ENTRY) * 58); + /* IMPORTANT: hardcoded table size - + this must match the number of C_pte calls + 1 (NULL terminator)! */ + C_PTABLE_ENTRY *pt = (C_PTABLE_ENTRY *)C_malloc(sizeof(C_PTABLE_ENTRY) * 56); int i = 0; if(pt == NULL) @@ -805,7 +803,6 @@ static C_PTABLE_ENTRY *create_initial_ptable() C_pte(C_get_symbol_table_info); C_pte(C_get_memory_info); C_pte(C_decode_seconds); - C_pte(C_get_environment_variable); /* OBSOLETE */ C_pte(C_stop_timer); C_pte(C_dload); C_pte(C_set_dlopen_flags); @@ -849,7 +846,6 @@ static C_PTABLE_ENTRY *create_initial_ptable() C_pte(C_copy_closure); C_pte(C_dump_heap_state); C_pte(C_filter_heap_objects); - C_pte(C_get_argument); /* OBSOLETE */ /* IMPORTANT: did you remember the hardcoded pte table size? */ pt[ i ].id = NULL; @@ -1000,33 +996,6 @@ C_regparm C_word C_find_symbol(C_word str, C_SYMBOL_TABLE *stable) else return C_SCHEME_FALSE; } -/* OBSOLETE */ -C_regparm C_word C_enumerate_symbols(C_SYMBOL_TABLE *stable, C_word pos) -{ - int i; - C_word - sym, - bucket = C_u_i_car(pos); - - if(!C_truep(bucket)) return C_SCHEME_FALSE; /* end already reached */ - else i = C_unfix(bucket); - - bucket = C_u_i_cdr(pos); - - while(bucket == C_SCHEME_END_OF_LIST) { - if(++i >= stable->size) { - C_set_block_item(pos, 0, C_SCHEME_FALSE); /* no more buckets */ - return C_SCHEME_FALSE; - } - else bucket = stable->table[ i ]; - } - - sym = C_block_item(bucket, 0); - C_set_block_item(pos, 0, C_fix(i)); - C_mutate2(&C_u_i_cdr(pos), C_block_item(bucket, 1)); - return sym; -} - /* Setup symbol-table with internally used symbols; */ @@ -2006,25 +1975,6 @@ void C_ccall callback_return_continuation(C_word c, C_word self, C_word r) } -/* Zap symbol names: (OBSOLETE) */ - -void C_zap_strings(C_word str) -{ - int i; - - for(i = 0; i < symbol_table->size; ++i) { - C_word bucket, sym; - - for(bucket = symbol_table->table[ i ]; - bucket != C_SCHEME_END_OF_LIST; - bucket = C_block_item(bucket,1)) { - sym = C_block_item(bucket,0); - C_set_block_item(sym, 1, str); - } - } -} - - /* Register/unregister literal frame: */ void C_initialize_lf(C_word *lf, int count) @@ -2751,13 +2701,6 @@ C_mutate_slot(C_word *slot, C_word val) } -C_regparm C_word C_fcall -C_mutate(C_word *slot, C_word val) /* OBSOLETE */ -{ - return C_mutate2(slot, val); -} - - /* Initiate garbage collection: */ @@ -3724,13 +3667,8 @@ C_unbound_variable(C_word sym) barf(C_UNBOUND_VARIABLE_ERROR, NULL, sym); } - -C_regparm C_word C_fcall C_retrieve(C_word sym) /* OBSOLETE */ -{ - return C_fast_retrieve(sym); -} - - +/* XXX: This needs to be given a better name. + C_retrieve used to exist but it just called C_fast_retrieve */ C_regparm C_word C_fcall C_retrieve2(C_word val, char *name) { C_word *p; @@ -3755,33 +3693,6 @@ C_invalid_procedure(int c, C_word self, ...) } -static C_word resolve_procedure(C_word closure, C_char *where) /* OBSOLETE */ -{ - if(C_immediatep(closure) || C_header_bits(closure) != C_CLOSURE_TYPE) { - barf(C_NOT_A_CLOSURE_ERROR, where, closure); - } - - return closure; -} - - -C_regparm void *C_fcall C_retrieve_proc(C_word closure) /* OBSOLETE */ -{ - return C_fast_retrieve_proc(closure); -} - - -C_regparm void *C_fcall C_retrieve_symbol_proc(C_word sym) /* OBSOLETE */ -{ - C_word val = C_block_item(sym, 0); - - if(val == C_SCHEME_UNBOUND) - barf(C_UNBOUND_VARIABLE_ERROR, NULL, sym); - - return C_fast_retrieve_proc(val); -} - - C_regparm void *C_fcall C_retrieve2_symbol_proc(C_word val, char *name) { C_word *p; @@ -4136,15 +4047,6 @@ C_regparm C_word C_fcall C_get_print_precision(void) } -C_regparm C_word C_fcall C_display_flonum(C_word port, C_word n) -{ - C_FILEPTR fp = C_port_file(port); - - C_fprintf(fp, C_text("%.*g"), flonum_print_precision, C_flonum_magnitude(n)); - return C_SCHEME_UNDEFINED; -} - - C_regparm C_word C_fcall C_read_char(C_word port) { C_FILEPTR fp = C_port_file(port); @@ -5863,16 +5765,6 @@ C_regparm C_word C_fcall C_i_foreign_block_argumentp(C_word x) } -/* OBSOLETE */ -C_regparm C_word C_fcall C_i_foreign_number_vector_argumentp(C_word t, C_word x) -{ - if(C_immediatep(x) || C_header_bits(x) != C_STRUCTURE_TYPE || C_block_item(x, 0) != t) - barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_VECTOR_ERROR, NULL, x, t); - - return x; -} - - C_regparm C_word C_fcall C_i_foreign_struct_wrapper_argumentp(C_word t, C_word x) { if(C_immediatep(x) || C_header_bits(x) != C_STRUCTURE_TYPE || C_block_item(x, 0) != t) @@ -6045,7 +5937,7 @@ void C_ccall C_apply(C_word c, C_word closure, C_word k, C_word fn, ...) { va_list v; int i, n = c - 3; - C_word x, skip, fn2; + C_word x, skip; #ifdef C_HACKED_APPLY C_word *buf = C_temporary_stack_limit; void *proc; @@ -6053,7 +5945,9 @@ void C_ccall C_apply(C_word c, C_word closure, C_word k, C_word fn, ...) if(c < 4) C_bad_min_argc(c, 4); - fn2 = resolve_procedure(fn, "apply"); + if(C_immediatep(fn) || C_header_bits(fn) != C_CLOSURE_TYPE) { + barf(C_NOT_A_CLOSURE_ERROR, "apply", fn); + } va_start(v, fn); @@ -6098,13 +5992,13 @@ void C_ccall C_apply(C_word c, C_word closure, C_word k, C_word fn, ...) buf = (void *)C_align16((C_uword)buf); # endif buf[ 0 ] = n + 2; - buf[ 1 ] = fn2; + buf[ 1 ] = fn; buf[ 2 ] = k; C_memcpy(&buf[ 3 ], C_temporary_stack_limit, n * sizeof(C_word)); - proc = (void *)C_block_item(fn2, 0); + proc = (void *)C_block_item(fn, 0); C_do_apply_hack(proc, buf, n + 3); #else - C_do_apply(n, fn2, k); + C_do_apply(n, fn, k); #endif } @@ -6242,7 +6136,7 @@ void C_ccall call_cc_values_wrapper(C_word c, C_word closure, C_word k, ...) /* I */ void C_ccall C_continuation_graft(C_word c, C_word self, C_word k, C_word kk, C_word proc) { - ((C_proc2)C_retrieve_proc(proc))(2, proc, C_block_item(kk, 1)); + ((C_proc2)C_fast_retrieve_proc(proc))(2, proc, C_block_item(kk, 1)); } @@ -7881,79 +7775,6 @@ C_fixnum_to_string(C_word c, C_word self, C_word k, C_word num) } -/* OBSOLETE */ -void C_ccall C_get_argv(C_word c, C_word closure, C_word k) -{ - int i, cells; - - if(c != 2) C_bad_argc(c, 2); - - i = C_main_argc; - cells = 0; - - while(i--) - cells += 7 + C_align(C_strlen(C_main_argv[ i ])); - - C_save(k); - C_save(C_fix(cells)); - - if(!C_demand(cells)) C_reclaim((void *)get_argv_2, NULL); - - get_argv_2(NULL); -} - - -/* OBSOLETE */ -void get_argv_2(void *dummy) -{ - int cells = C_unfix(C_restore), - i = C_main_argc; - C_word k = C_restore, - *a = C_alloc(cells), - list, str; - - for(list = C_SCHEME_END_OF_LIST; i--; list = C_a_pair(&a, str, list)) - str = C_string2(&a, C_main_argv[ i ]); - - C_kontinue(k, list); -} - - -/* OBSOLETE */ -void C_ccall C_get_argument(C_word c, C_word closure, C_word k, C_word index) -{ - int i = C_unfix(index); - int cells; - - if(i >= C_main_argc) - C_kontinue(k, C_SCHEME_FALSE); - - cells = C_SIZEOF_STRING(C_strlen(C_main_argv[ i ])); - C_save(k); - C_save(C_fix(cells)); - C_save(index); - - if(!C_demand(cells)) C_reclaim((void *)get_argument_2, NULL); - - get_argument_2(NULL); -} - - -/* OBSOLETE */ -void get_argument_2(void *dummy) -{ - int i = C_unfix(C_restore); - int cells = C_unfix(C_restore); - C_word - k = C_restore, - *a = C_alloc(cells), - str; - - str = C_string2(&a, C_main_argv[ i ]); - C_kontinue(k, str); -} - - void C_ccall C_make_structure(C_word c, C_word closure, C_word k, C_word type, ...) { va_list v; @@ -8054,54 +7875,6 @@ void C_ccall C_return_to_host(C_word c, C_word closure, C_word k) } -#define C_do_getenv(v) C_getenv(v) /* OBSOLETE */ -#define C_free_envbuf() {} /* OBSOLETE */ - - -/* OBSOLETE */ -void C_ccall C_get_environment_variable(C_word c, C_word closure, C_word k, C_word name) -{ - int len; - - if(c != 3) C_bad_argc(c, 3); - - if(C_immediatep(name) || C_header_bits(name) != C_STRING_TYPE) - barf(C_BAD_ARGUMENT_TYPE_ERROR, "get-environment-variable", name); - - if((len = C_header_size(name)) >= STRING_BUFFER_SIZE) - C_kontinue(k, C_SCHEME_FALSE); - - strncpy(buffer, C_c_string(name), len); - buffer[ len ] = '\0'; - if (len != strlen(buffer)) - barf(C_ASCIIZ_REPRESENTATION_ERROR, "get-environment-variable", name); - - if((save_string = C_do_getenv(buffer)) == NULL) - C_kontinue(k, C_SCHEME_FALSE); - - C_save(k); - - len = C_strlen(save_string); - if(!C_demand(1 + C_bytestowords(len + 1))) - C_reclaim((void *)get_environment_variable_2, NULL); - - get_environment_variable_2(NULL); -} - - -/* OBSOLETE */ -void get_environment_variable_2(void *dummy) -{ - int len = C_strlen(save_string); - C_word k = C_restore, - *a = C_alloc(1 + C_bytestowords(len + 1)), - str = C_string(&a, len, save_string); - - C_free_envbuf(); - C_kontinue(k, str); -} - - void C_ccall C_get_symbol_table_info(C_word c, C_word closure, C_word k) { double d1, d2; diff --git a/support.scm b/support.scm index 11b71bb..d47afb1 100644 --- a/support.scm +++ b/support.scm @@ -545,7 +545,7 @@ 'let (map (lambda (v) ;; for temporaries introduced by specialization - (if (eq? '#:tmp v) (gensym) v)) ; OBSOLETE + (if (eq? '#:tmp v) (error "SHOULD NOT HAPPEN") v)) ; OBSOLETE (unzip1 bs)) (append (map (lambda (b) (walk (cadr b))) (cadr x)) (list (walk body)) ) ) ) ) ) -- 1.7.10.4