~ chicken-core (chicken-5) c407a369197af4785b6e546bf5168621ae8f95f7
commit c407a369197af4785b6e546bf5168621ae8f95f7
Author: Peter Bex <peter.bex@xs4all.nl>
AuthorDate: Sat Jun 7 22:21:10 2014 +0200
Commit: Christian Kellermann <ckeen@pestilenz.org>
CommitDate: Mon Jun 9 15:27:03 2014 +0200
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
Signed-off-by: Christian Kellermann <ckeen@pestilenz.org>
diff --git a/NEWS b/NEWS
index f96f68bf..acec2fc8 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 efbc52ea..6887b6be 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 2df88c8e..732ea2a6 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 03138cd6..4a3c77ad 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 3565a5f5..d3b9549c 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 ed1b92dd..fea8a028 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 59ddc36e..87f76495 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 ef2f1994..f8917cf4 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 11b71bb4..d47afb13 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)) ) ) ) ) )
Trap