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

Fixed environ. The procedure environ takes no arguments and returns 

an association list where both keys and values and strings found in
the posix environment.
This commit is contained in:
Abdulaziz Ghuloum 2009-04-06 09:59:07 +03:00
parent 7b60ec46a9
commit b97cbf1688
4 changed files with 25 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
scheme/ikarus.posix.ss
View File

@ -371,22 +371,22 @@
busted)) busted))
(define environ (lambda args (die 'environ "busted!"))) (define environ
(define environ^
(lambda () (lambda ()
(map (map
(lambda (s) (lambda (bv)
(define (loc= s i n) (let ([s (utf8->string bv)])
(cond (define (loc= s i n)
[(fx= i n) i] (cond
[(char=? (string-ref s i) #\=) i] [(fx= i n) i]
[else (loc= s (fx+ i 1) n)])) [(char=? (string-ref s i) #\=) i]
(let ([n (string-length s)]) [else (loc= s (fx+ i 1) n)]))
(let ([i (loc= s 0 n)]) (let ([n (string-length s)])
(cons (substring s 0 i) (let ([i (loc= s 0 n)])
(if (fx< (fxadd1 i) n) (cons (substring s 0 i)
(substring s (fxadd1 i) n) (if (fx< (fxadd1 i) n)
""))))) (substring s (fxadd1 i) n)
""))))))
(foreign-call "ikrt_environ")))) (foreign-call "ikrt_environ"))))
(define (nanosleep secs nsecs) (define (nanosleep secs nsecs)

2
scheme/last-revision
View File

@ -1 +1 @@
1746 1748

1
scheme/makefile.ss
View File

@ -1357,6 +1357,7 @@
[getenv i] [getenv i]
[setenv i] [setenv i]
[unsetenv i] [unsetenv i]
[environ i]
[nanosleep i] [nanosleep i]
[char-ready? ] [char-ready? ]
[load i] [load i]

15
src/ikarus-runtime.c
View File

@ -972,21 +972,24 @@ ikrt_unsetenv(ikptr key){
ikptr ikptr
ikrt_environ(ikpcb* pcb){ ikrt_environ(ikpcb* pcb){
fprintf(stderr, "environ busted!\n");
exit(-1);
char** es = environ; char** es = environ;
int i; char* e; int i; char* e;
ikptr ac = null_object; ikptr ac = null_object;
pcb->root0 = &ac;
for(i=0; (e=es[i]); i++){ for(i=0; (e=es[i]); i++){
long int n = strlen(e); long int n = strlen(e);
ikptr s = ik_unsafe_alloc(pcb, align(n+disp_string_data+1)) + string_tag; ikptr s = ik_safe_alloc(pcb, align(n+disp_bytevector_data+1))
ref(s, -string_tag) = fix(n); + bytevector_tag;
memcpy((char*)(long)(s+off_string_data), e, n+1); ref(s, -bytevector_tag) = fix(n);
ikptr p = ik_unsafe_alloc(pcb, pair_size) + pair_tag; memcpy((char*)(long)(s+off_bytevector_data), e, n+1);
pcb->root1 = &s;
ikptr p = ik_safe_alloc(pcb, pair_size) + pair_tag;
pcb->root1 = 0;
ref(p, off_cdr) = ac; ref(p, off_cdr) = ac;
ref(p, off_car) = s; ref(p, off_car) = s;
ac = p; ac = p;
} }
pcb->root0 = 0;
return ac; return ac;
} }