Added the following file system primitives

- file-readable? path -> boolean
 - file-writable? path -> boolean
 - file-executable? path -> boolean
 - file-size path -> integer
 - rename-file source dest -> void
(thanks to Andreas Rottmann)

scheme/ikarus.compiler.tag-annotation-analysis.ss

@@ -85,6 +85,9 @@
       [file-exists?          boolean]
       [file-regular?         boolean]
       [file-directory?       boolean]
+      [file-readable?        boolean]
+      [file-writable?        boolean]
+      [file-executable?      boolean]
       [file-symbolic-link?   boolean]
       [record?               boolean]
       [record-field-mutable? boolean]

scheme/ikarus.posix.ss

@@ -15,24 +15,27 @@
 
 
 (library (ikarus.posix)
-  (export posix-fork fork waitpid system file-exists? delete-file
-          nanosleep getenv env environ file-ctime file-mtime
-          current-directory
-          file-regular? file-directory? file-symbolic-link? make-symbolic-link
-          directory-list make-directory delete-directory change-mode
-          kill strerror 
-          wstatus-pid wstatus-exit-status wstatus-received-signal)
+
+  (export
+    posix-fork fork waitpid system file-exists? delete-file
+    nanosleep getenv 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
+    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 env environ file-ctime file-mtime 
-       current-directory
-       file-regular? file-directory? file-symbolic-link? make-symbolic-link
-       directory-list make-directory delete-directory change-mode
-       kill strerror
-       wstatus-pid wstatus-exit-status wstatus-received-signal))
+      nanosleep posix-fork fork waitpid system file-exists?
+      delete-file getenv 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 make-directory delete-directory change-mode
+      kill strerror wstatus-pid wstatus-exit-status
+      wstatus-received-signal))
 
   (define posix-fork
     (lambda ()
@@ -151,6 +154,15 @@
           [(-45) #f]  ;; from ikarus-errno.c: ENOENT -- path does not exist
           [else (raise/strerror who r path)]))))
 
+
+  (define access
+    (lambda (path how who)
+      (unless (string? path)
+        (die who "not a string" path))
+      (let ([r (foreign-call "ikrt_access" (string->utf8 path) how)])
+        (unless (boolean? r) (raise/strerror who r path))
+        r)))
+
   (define file-exists?
     (case-lambda 
       [(path) (file-exists? path #t)]
@@ -173,6 +185,29 @@
     (lambda (path)
       (eq? 'symlink (stat path #f 'file-symbolic-link?))))
 
+
+  (define file-readable?
+    (lambda (path)
+      (access path 1 'file-readable?)))
+  
+  (define file-writable?
+    (lambda (path)
+      (access path 2 'file-writable?)))
+
+  (define file-executable?
+    (lambda (path)
+      (access path 4 'file-executable?)))
+
+  (define file-size
+    (lambda (path)
+      (define who 'file-size)
+      (unless (string? path)
+        (die who "filename is not a string" path))
+      (let* ([v (foreign-call "ikrt_file_size" (string->utf8 path))])
+        (if (>= v 0)
+            v
+            (raise/strerror who v path)))))
+
   (define delete-file
     (lambda (x)
       (define who 'delete-file)
@@ -183,6 +218,20 @@
         (unless (eq? v #t)
           (raise/strerror who v x)))))
   
+
+  (define rename-file
+    (lambda (src dst)
+      (define who 'rename-file)
+      (unless (string? src)
+        (die who "source file name is not a string" src))
+      (unless (string? dst)
+        (die who "destination file name is not a string" dst))
+      (let ([v (foreign-call "ikrt_rename_file"
+                             (string->utf8 src)
+                             (string->utf8 dst))])
+        (unless (eq? v #t)
+          (raise/strerror who v src)))))
+
   (define directory-list
     (lambda (path)
       (define who 'directory-list)

scheme/last-revision

@@ -1 +1 @@
-1664
+1665

scheme/makefile.ss

@@ -1246,9 +1246,13 @@
     [vector-sort!                                i r sr]
     [file-exists?                                i r fi]
     [delete-file                                 i r fi]
+    [rename-file                                 i]
     [file-regular?                               i]
     [file-directory?                             i]
     [file-symbolic-link?                         i]
+    [file-readable?                              i]
+    [file-writable?                              i]
+    [file-executable?                            i]
     [current-directory                           i]
     [directory-list                              i]
     [make-directory                              i]
@@ -1257,6 +1261,7 @@
     [make-symbolic-link                          i]
     [file-ctime                                  i]
     [file-mtime                                  i]
+    [file-size                                   i]
     [fork                                        i]
     [define-record-type                          i r rs]
     [fields                                      i r rs]

src/ikarus-data.h

@@ -220,6 +220,10 @@ ikptr ik_underflow_handler(ikpcb*);
 ikptr ik_unsafe_alloc(ikpcb* pcb, int size);
 ikptr ik_safe_alloc(ikpcb* pcb, int size);
 
+ikptr u_to_number(unsigned long, ikpcb*);
+ikptr ull_to_number(unsigned long long, ikpcb*);
+ikptr normalize_bignum(long int limbs, int sign, ikptr r);
+
 #define IK_HEAP_EXT_SIZE  (32 * 4096)
 #define IK_HEAPSIZE       (1024 * ((wordsize==4)?1:2) * 4096) /* 4/8 MB */
 

src/ikarus-pointers.c

@@ -3,6 +3,7 @@
 #include <dlfcn.h>
 #include <string.h>
 #include <stdlib.h>
+#include <gmp.h>
 
 ikptr
 ikrt_isapointer(ikptr x, ikpcb* pcb){
@@ -262,6 +263,18 @@ u_to_number(unsigned long n, ikpcb* pcb) {
   return bn+vector_tag;
 }
 
+
+ikptr
+ull_to_number(unsigned long long n, ikpcb* pcb) {
+  unsigned long long mxn = ((unsigned long)-1)>>(fx_shift+1);
+  if (n <= mxn) {
+    return fix(n);
+  }
+  ikptr bn = ik_safe_alloc(pcb, align(disp_bignum_data+sizeof(long long)));
+  bcopy((char*)(&n), (char*)(bn+disp_bignum_data), sizeof(long long));
+  return normalize_bignum(sizeof(long long)/sizeof(mp_limb_t), 0, bn);
+}
+
 ikptr
 d_to_number(double n, ikpcb* pcb) {
   ikptr x = ik_safe_alloc(pcb, flonum_size) + vector_tag;

src/ikarus-runtime.c

@@ -1037,3 +1037,62 @@ ikrt_debug(ikptr x){
   fprintf(stderr, "DEBUG 0x%016lx\n", (long int)x);
   return 0;
 }
+
+ikptr
+ikrt_access(ikptr filename, ikptr how /*, ikpcb* pcb */){
+  char* fn = (char*)(filename + off_bytevector_data);
+  int r;
+  int ik_how;
+  int c_how;
+
+  ik_how = unfix(how);
+  if (ik_how == 0) {
+    c_how = F_OK;
+  } else {
+    c_how = 0;
+    if (ik_how & 1) c_how |= R_OK;
+    if (ik_how & 2) c_how |= W_OK;
+    if (ik_how & 4) c_how |= X_OK;
+  }
+  
+  r = access(fn, c_how);
+  if (r == 0) {
+    return true_object;
+  } else if ((errno == EACCES) ||
+             (errno == EROFS) ||
+             (errno == ETXTBSY)) {
+    return false_object;
+  } else {
+    return ik_errno_to_code();
+  }
+}
+
+ikptr
+ikrt_file_size(ikptr filename, ikpcb* pcb){
+  char* fn = (char*)(filename + off_bytevector_data);
+  struct stat s;
+  int r = stat(fn, &s);
+  if (r == 0) {
+    if (sizeof(off_t) == sizeof(long)) {
+      return u_to_number(s.st_size, pcb);
+    } else if (sizeof(off_t) == sizeof(long long)) {
+      return ull_to_number(s.st_size, pcb);
+    } else {
+      fprintf(stderr, "internal error in ikarus: invalid off_t size\n");
+      exit(-1);
+    }
+  } else {
+    return ik_errno_to_code();
+  }
+}
+
+ikptr
+ikrt_rename_file(ikptr src, ikptr dst /* ikpcb* pcb */){
+  int err = rename((char*)(src + off_bytevector_data),
+                   (char*)(dst + off_bytevector_data));
+  if (err == 0) {
+    return true_object;
+  } else {
+    return ik_errno_to_code();
+  }
+}