diff --git a/scheme/ikarus.posix.ss b/scheme/ikarus.posix.ss index 15d93d4..7bffbf8 100644 --- a/scheme/ikarus.posix.ss +++ b/scheme/ikarus.posix.ss @@ -16,26 +16,27 @@ (library (ikarus.posix) - (export + (export posix-fork fork waitpid system file-exists? delete-file - 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 make-hard-link directory-list - make-directory delete-directory change-mode kill strerror - wstatus-pid wstatus-exit-status wstatus-received-signal) + nanosleep getenv setenv unsetenv env environ file-ctime + file-mtime file-real-path current-directory file-regular? + file-directory? file-readable? file-writable? file-executable? + file-size rename-file file-symbolic-link? make-symbolic-link + make-hard-link directory-list make-directory delete-directory + change-mode kill strerror wstatus-pid wstatus-exit-status + wstatus-received-signal) (import (rnrs bytevectors) (except (ikarus) nanosleep posix-fork fork waitpid system file-exists? - 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 make-hard-link - directory-list make-directory delete-directory change-mode - kill strerror wstatus-pid wstatus-exit-status - wstatus-received-signal)) + delete-file getenv setenv unsetenv env environ file-ctime + file-mtime file-real-path current-directory file-regular? + file-directory? file-readable? file-writable? + file-executable? file-size rename-file file-symbolic-link? + make-symbolic-link make-hard-link directory-list + make-directory delete-directory change-mode kill strerror + wstatus-pid wstatus-exit-status wstatus-received-signal)) (define posix-fork (lambda () @@ -185,7 +186,6 @@ (lambda (path) (eq? 'symlink (stat path #f 'file-symbolic-link?)))) - (define file-readable? (lambda (path) (access path 1 'file-readable?))) @@ -316,7 +316,14 @@ ($file-time x 'file-mtime (lambda (u) (foreign-call "ikrt_file_mtime2" u)))) - + (define (file-real-path x) + (define who 'file-real-path) + (unless (string? x) + (die who "not a string" x)) + (let ([v (foreign-call "ikrt_realpath" (string->utf8 x))]) + (cond + [(bytevector? v) (utf8->string v)] + [else (raise/strerror who v x)]))) (define (getenv key) (define who 'getenv) diff --git a/scheme/last-revision b/scheme/last-revision index 0fbe6bb..c670086 100644 --- a/scheme/last-revision +++ b/scheme/last-revision @@ -1 +1 @@ -1789 +1790 diff --git a/scheme/makefile.ss b/scheme/makefile.ss index 7cf1764..ec16c2d 100755 --- a/scheme/makefile.ss +++ b/scheme/makefile.ss @@ -1289,6 +1289,7 @@ [file-ctime i] [file-mtime i] [file-size i] + [file-real-path i] [fork i] [define-record-type i r rs] [fields i r rs] diff --git a/src/ikarus-runtime.c b/src/ikarus-runtime.c index 7ad8202..6622c9f 100644 --- a/src/ikarus-runtime.c +++ b/src/ikarus-runtime.c @@ -688,6 +688,20 @@ ikrt_link(ikptr to, ikptr path /*, ikpcb* pcb */){ return ik_errno_to_code(); } +ikptr +ikrt_realpath(ikptr bv, ikpcb* pcb){ + char buff[PATH_MAX]; + char* p = realpath((char*)(bv+off_bytevector_data), buff); + if(p == NULL){ + return ik_errno_to_code(); + } + int n = strlen(p); + ikptr r = ik_safe_alloc(pcb, align(disp_bytevector_data+n+1)); + ref(r, 0) = fix(n); + memcpy((char*)(r+disp_bytevector_data), p, n+1); + return r+bytevector_tag; +} + ikptr ik_system(ikptr str){ if(tagof(str) == bytevector_tag){ @@ -708,7 +722,7 @@ mtname(unsigned int n){ if(n == mainheap_type) { return "HEAP_T"; } if(n == mainstack_type) { return "STAK_T"; } if(n == pointers_type) { return "PTER_T"; } - if(n == dat_type) { return "DATA_T"; } + if(n == dat_type) { return "DATA_T"; } if(n == code_type) { return "CODE_T"; } if(n == hole_type) { return " "; } return "WHAT_T";