- Added file-real-path which is identical to realpath(3).

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
+    nanosleep getenv setenv unsetenv env environ file-ctime
-    current-directory file-regular? file-directory? file-readable?
+    file-mtime file-real-path current-directory file-regular?
-    file-writable? file-executable? file-size rename-file
+    file-directory? file-readable?  file-writable?  file-executable?
-    file-symbolic-link? make-symbolic-link make-hard-link directory-list
+    file-size rename-file file-symbolic-link?  make-symbolic-link
-    make-directory delete-directory change-mode kill strerror
+    make-hard-link directory-list make-directory delete-directory
-    wstatus-pid wstatus-exit-status wstatus-received-signal)
+    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
+      delete-file getenv setenv unsetenv env environ file-ctime
-      current-directory file-regular? file-directory?
+      file-mtime file-real-path current-directory file-regular?
-      file-readable? file-writable? file-executable? file-size
+      file-directory?  file-readable? file-writable?
-      rename-file file-symbolic-link? make-symbolic-link make-hard-link
+      file-executable? file-size rename-file file-symbolic-link?
-      directory-list make-directory delete-directory change-mode
+      make-symbolic-link make-hard-link directory-list
-      kill strerror wstatus-pid wstatus-exit-status
+      make-directory delete-directory change-mode kill strerror
-      wstatus-received-signal))
+      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)

scheme/last-revision

@@ -1 +1 @@
-1789
+1790

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]

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";