conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

added setenv and unsetenv to (ikarus).

This commit is contained in:
Abdulaziz Ghuloum 2008-12-23 20:58:46 -05:00
parent 05180035f2
commit 4918b0e965
4 changed files with 36 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
scheme/ikarus.posix.ss
View File

@ -18,7 +18,7 @@
(export
posix-fork fork waitpid system file-exists? delete-file
nanosleep getenv env environ file-ctime file-mtime
nanosleep getenv setenv unsetenv env environ file-ctime file-mtime
current-directory file-regular? file-directory? file-readable?
file-writable? file-executable? file-size rename-file
file-symbolic-link? make-symbolic-link directory-list
@ -29,7 +29,7 @@
(rnrs bytevectors)
(except (ikarus)
nanosleep posix-fork fork waitpid system file-exists?
delete-file getenv env environ file-ctime file-mtime
delete-file getenv setenv unsetenv env environ file-ctime file-mtime
current-directory file-regular? file-directory?
file-readable? file-writable? file-executable? file-size
rename-file file-symbolic-link? make-symbolic-link
@ -322,6 +322,28 @@
($getenv-str key)
(die who "key is not a string" key)))
(define ($setenv key val overwrite)
(foreign-call "ikrt_setenv"
(string->utf8 key) (string->utf8 val) overwrite))
(define setenv
(case-lambda
[(key val overwrite)
(define who 'setenv)
(if (string? key)
(if (string? val)
(unless ($setenv key val overwrite)
(error who "cannot setenv"))
(die who "invalid value" val))
(die who "invalid key" key))]
[(key val) (setenv key val #t)]))
(define (unsetenv key)
(define who 'unsetenv)
(if (string? key)
(foreign-call "ikrt_unsetenv" (string->utf8 key))
(die who "invalid key" key)))
(define env
(let ()
(define env

2
scheme/last-revision
View File

@ -1 +1 @@
1722
1723

2
scheme/makefile.ss
View File

@ -1344,6 +1344,8 @@
[string-titlecase i r uc]
[string-upcase i r uc]
[getenv i]
[setenv i]
[unsetenv i]
[nanosleep i]
[char-ready? ]
[load i]

13
src/ikarus-runtime.c
View File

@ -944,10 +944,8 @@ ikrt_make_vector2(ikptr len, ikptr obj, ikpcb* pcb){
ikptr
ikrt_setenv(ikptr key, ikptr val, ikptr overwrite){
fprintf(stderr, "setenv busted!\n");
exit(-1);
int err = setenv((char*)(long)(key+off_bytevector_data),
(char*)(long)(val+off_bytevector_data),
int err = setenv((char*)(key+off_bytevector_data),
(char*)(val+off_bytevector_data),
overwrite!=false_object);
if(err){
return false_object;
@ -956,6 +954,13 @@ ikrt_setenv(ikptr key, ikptr val, ikptr overwrite){
}
}
ikptr
ikrt_unsetenv(ikptr key){
unsetenv((char*)(key+off_bytevector_data));
return void_object;
}
ikptr
ikrt_environ(ikpcb* pcb){