~ chicken-core (chicken-5) 561e047f11f2975fbbf4a90edf62cd2a40fad10b
commit 561e047f11f2975fbbf4a90edf62cd2a40fad10b
Author: Peter Bex <peter.bex@xs4all.nl>
AuthorDate: Fri Mar 1 20:41:49 2013 +0100
Commit: Christian Kellermann <ckeen@pestilenz.org>
CommitDate: Sat Mar 2 15:00:37 2013 +0100
Remove ##sys#get-argument and simplify get-environment-variable
by using the FFI instead of hand-rolled C functions; deprecated these
underlying C functions This should make the code easier to understand,
more maintainable and reduce bloat. It is also a more structural
approach of preventing security problems like those fixed by
d9f2ad87b42f by using one vetted underlying system; the FFI conversion
procedures.
Signed-off-by: Christian Kellermann <ckeen@pestilenz.org>
Signed-off-by: Peter Bex <peter.bex@xs4all.nl>
diff --git a/NEWS b/NEWS
index a5f90541..03df87c5 100644
--- a/NEWS
+++ b/NEWS
@@ -10,6 +10,9 @@
- Runtime system
- Special events in poll() are now handled, avoiding hangs in threaded apps.
+- C API
+ - Deprecated C_get_argument[_2] and C_get_environment_variable[_2] functions.
+
4.8.1
- Security fixes
diff --git a/chicken.h b/chicken.h
index 566aad3e..2b9030a8 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1782,14 +1782,14 @@ C_fctexport void C_ccall C_quotient(C_word c, C_word closure, C_word k, C_word n
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;
+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;
+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;
diff --git a/library.scm b/library.scm
index 31e1e0c3..f11a4ee9 100644
--- a/library.scm
+++ b/library.scm
@@ -202,7 +202,7 @@ EOF
(define (current-milliseconds) (##core#inline_allocate ("C_a_i_current_milliseconds" 4) #f))
(define (current-gc-milliseconds) (##sys#fudge 31))
(define ##sys#decode-seconds (##core#primitive "C_decode_seconds"))
-(define get-environment-variable (##core#primitive "C_get_environment_variable"))
+(define get-environment-variable (foreign-lambda c-string "C_getenv" c-string))
(define (##sys#start-timer)
(##sys#gc #t)
@@ -4594,23 +4594,23 @@ EOF
;;; command-line handling
-(define ##sys#get-argument (##core#primitive "C_get_argument"))
(define argv ; includes program name
- (let ((cache #f))
+ (let ((cache #f)
+ (fetch-arg (foreign-lambda* c-string ((scheme-object i))
+ "C_return(C_main_argv[C_unfix(i)]);")))
(lambda ()
- (or cache
- (let ((v (let loop ((i 0))
- (let ((arg (##sys#get-argument i)))
- (if arg
- (cons arg (loop (fx+ i 1)))
- '())))))
- (set! cache v)
- v)))))
+ (unless cache
+ (set! cache (do ((i (fx- main_argc 1) (fx- i 1))
+ (v '() (cons (fetch-arg i) v)))
+ ((fx< i 0) v))))
+ cache)))
(define program-name
(make-parameter
- (or (##sys#get-argument 0) "<unknown>") ; may happen if embedded in C application
+ (if (null? (argv))
+ "<unknown>" ; may happen if embedded in C application
+ (car (argv)))
(lambda (x)
(##sys#check-string x 'program-name)
x) ) )
diff --git a/runtime.c b/runtime.c
index a5e45fca..61b4abae 100644
--- a/runtime.c
+++ b/runtime.c
@@ -500,10 +500,10 @@ static C_ccall void call_cc_values_wrapper(C_word c, C_word closure, C_word k, .
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;
+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;
+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;
@@ -790,7 +790,7 @@ 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);
+ C_pte(C_get_environment_variable); /* OBSOLETE */
C_pte(C_stop_timer);
C_pte(C_dload);
C_pte(C_set_dlopen_flags);
@@ -833,7 +833,7 @@ 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);
+ C_pte(C_get_argument); /* OBSOLETE */
/* IMPORTANT: did you remember the hardcoded pte table size? */
pt[ i ].id = NULL;
@@ -7822,6 +7822,7 @@ void get_argv_2(void *dummy)
}
+/* OBSOLETE */
void C_ccall C_get_argument(C_word c, C_word closure, C_word k, C_word index)
{
int i = C_unfix(index);
@@ -7841,6 +7842,7 @@ void C_ccall C_get_argument(C_word c, C_word closure, C_word k, C_word index)
}
+/* OBSOLETE */
void get_argument_2(void *dummy)
{
int i = C_unfix(C_restore);
@@ -7955,10 +7957,11 @@ void C_ccall C_return_to_host(C_word c, C_word closure, C_word k)
}
-#define C_do_getenv(v) C_getenv(v)
-#define C_free_envbuf() {}
+#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;
@@ -7989,6 +7992,7 @@ void C_ccall C_get_environment_variable(C_word c, C_word closure, C_word k, C_wo
}
+/* OBSOLETE */
void get_environment_variable_2(void *dummy)
{
int len = C_strlen(save_string);
Trap