Applied patch for "make-hard-link". Thanks to Andreas Rottmann.

scheme/ikarus.posix.ss

@@ -21,7 +21,7 @@
     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 directory-list
+    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)
 
@@ -32,7 +32,7 @@
       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
+      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))
@@ -278,16 +278,23 @@
         (unless (eq? r #t)
           (raise/strerror who r path)))))
   
-  (define make-symbolic-link
+  (define ($make-link to path who proc)
-    (lambda (to path)
+    (unless (and (string? to) (string? path))
-      (define who 'make-symbolic-link)
+      (die who "not a string" (if (string? to) path to)))
-      (unless (and (string? to) (string? path))
+    (let ([r (proc (string->utf8 to) (string->utf8 path))])
-        (die who "not a string" (if (string? to) path to)))
+      (unless (eq? r #t)
-      (let ([r (foreign-call "ikrt_symlink" 
+        (raise/strerror who r path))))
-                 (string->utf8 to) (string->utf8 path))])
+  
-        (unless (eq? r #t)
+  (define (make-symbolic-link to path)
-          (raise/strerror who r path)))))
+    ($make-link to path 'make-symbolic-link
-
+                (lambda (u-to u-path)
+                  (foreign-call "ikrt_symlink" u-to u-path))))
+  
+  (define (make-hard-link to path)
+    ($make-link to path 'make-hard-link
+                (lambda (u-to u-path)
+                  (foreign-call "ikrt_link" u-to u-path))))
+  
   (define ($file-time x who proc)
     (unless (string? x) 
       (die who "not a string" x))

scheme/last-revision

@@ -1 +1 @@
-1739
+1740

scheme/makefile.ss

@@ -1273,6 +1273,7 @@
     [delete-directory                            i]
     [change-mode                                 i]
     [make-symbolic-link                          i]
+    [make-hard-link                              i]
     [file-ctime                                  i]
     [file-mtime                                  i]
     [file-size                                   i]

src/ikarus-runtime.c

@@ -679,6 +679,14 @@ ikrt_symlink(ikptr to, ikptr path /*, ikpcb* pcb */){
   return ik_errno_to_code();
 }
 
+ikptr
+ikrt_link(ikptr to, ikptr path /*, ikpcb* pcb */){
+  int r = link((char*)(to+off_bytevector_data), (char*)(path+off_bytevector_data));
+  if(r == 0){
+    return true_object;
+  }
+  return ik_errno_to_code();
+}
 
 ikptr 
 ik_system(ikptr str){