Added current-directory parameter that gets/sets cwd.
This commit is contained in:
parent
7e5d053fb2
commit
5f92e4b96d
|
@ -16,13 +16,13 @@
|
||||||
|
|
||||||
(library (ikarus posix)
|
(library (ikarus posix)
|
||||||
(export posix-fork fork waitpid system file-exists? delete-file
|
(export posix-fork fork waitpid system file-exists? delete-file
|
||||||
nanosleep getenv env environ file-ctime)
|
nanosleep getenv env environ file-ctime current-directory)
|
||||||
(import
|
(import
|
||||||
(rnrs bytevectors)
|
(rnrs bytevectors)
|
||||||
(except (ikarus)
|
(except (ikarus)
|
||||||
nanosleep
|
nanosleep
|
||||||
posix-fork fork waitpid system file-exists? delete-file
|
posix-fork fork waitpid system file-exists? delete-file
|
||||||
getenv env environ file-ctime))
|
getenv env environ file-ctime current-directory))
|
||||||
|
|
||||||
(define posix-fork
|
(define posix-fork
|
||||||
(lambda ()
|
(lambda ()
|
||||||
|
@ -184,4 +184,22 @@
|
||||||
(unless (eq? rv 0)
|
(unless (eq? rv 0)
|
||||||
(error 'nanosleep "failed"))))
|
(error 'nanosleep "failed"))))
|
||||||
|
|
||||||
|
|
||||||
|
(define current-directory
|
||||||
|
(case-lambda
|
||||||
|
[()
|
||||||
|
(let ([v (foreign-call "ikrt_getcwd")])
|
||||||
|
(if (bytevector? v)
|
||||||
|
(utf8->string v)
|
||||||
|
(die 'current-directory
|
||||||
|
"failed to get current directory")))]
|
||||||
|
[(x)
|
||||||
|
(if (string? x)
|
||||||
|
(let ([rv (foreign-call "ikrt_chdir" (string->utf8 x))])
|
||||||
|
(unless (eq? rv 0)
|
||||||
|
(die 'current-directory
|
||||||
|
"failed to set current directory")))
|
||||||
|
(die 'current-directory "not a string" x))]))
|
||||||
|
|
||||||
|
|
||||||
)
|
)
|
||||||
|
|
|
@ -1 +1 @@
|
||||||
1462
|
1464
|
||||||
|
|
|
@ -1202,6 +1202,7 @@
|
||||||
[vector-sort! i r sr]
|
[vector-sort! i r sr]
|
||||||
[file-exists? i r fi]
|
[file-exists? i r fi]
|
||||||
[delete-file i r fi]
|
[delete-file i r fi]
|
||||||
|
[current-directory i]
|
||||||
[file-ctime i]
|
[file-ctime i]
|
||||||
[define-record-type i r rs]
|
[define-record-type i r rs]
|
||||||
[fields i r rs]
|
[fields i r rs]
|
||||||
|
|
|
@ -32,6 +32,7 @@
|
||||||
#include <sys/time.h>
|
#include <sys/time.h>
|
||||||
#include <sys/resource.h>
|
#include <sys/resource.h>
|
||||||
#include <sys/wait.h>
|
#include <sys/wait.h>
|
||||||
|
#include <sys/param.h>
|
||||||
#ifdef __CYGWIN__
|
#ifdef __CYGWIN__
|
||||||
#include "ikarus-winmmap.h"
|
#include "ikarus-winmmap.h"
|
||||||
#endif
|
#endif
|
||||||
|
@ -991,6 +992,27 @@ ikrt_nanosleep(ikptr secs, ikptr nsecs, ikpcb* pcb){
|
||||||
return fix(nanosleep(&t, NULL));
|
return fix(nanosleep(&t, NULL));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
ikptr
|
||||||
|
ikrt_chdir(ikptr pathbv, ikpcb* pcb){
|
||||||
|
int err = chdir(off_bytevector_data+(char*)pathbv);
|
||||||
|
return fix(err); /* FIXME: provide more meaninful result */
|
||||||
|
}
|
||||||
|
|
||||||
|
ikptr
|
||||||
|
ikrt_getcwd(ikpcb* pcb){
|
||||||
|
char buff[MAXPATHLEN+1];
|
||||||
|
char* path = getcwd(buff, MAXPATHLEN);
|
||||||
|
if(! path){
|
||||||
|
return fix(-1); /* FIXME: provide more meaninful result */
|
||||||
|
}
|
||||||
|
int len = strlen(path);
|
||||||
|
ikptr bv = ik_safe_alloc(pcb, align(disp_bytevector_data+len+1));
|
||||||
|
ref(bv,0) = fix(len);
|
||||||
|
strncpy(disp_bytevector_data+(char*)(bv), path, len);
|
||||||
|
return bv+bytevector_tag;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
ikptr
|
ikptr
|
||||||
ikrt_debug(ikptr x){
|
ikrt_debug(ikptr x){
|
||||||
|
|
Loading…
Reference in New Issue