Re: [Chicken-hackers] [PATCH] drop ##sys#file-info

[Felix]

From: Alan Post <address@hidden>
Subject: Re: [Chicken-hackers] [PATCH] drop ##sys#file-info
Date: Mon, 3 Oct 2011 09:18:53 -0601

> On Sun, Oct 02, 2011 at 01:33:11PM +0200, Felix wrote:
>> This patch replaces ##sys#file-info with a cleaner file/directory
>> exists check. It checks for errors (except ENOENT) and can later be
>> extended to handle EOVERFLOW on those platforms that support some
>> workaround or large file support. "fifo?" was also changed to use
>> stat(3) and checks for errors instead of using ##sys#file-info.
>> 
>> The patch was done in collaboration with Christian, but I post it
>> here once more in case someone wants to comment.
>> 
>> 
>> cheers,
>> felix
> 
>> From 71eb0e713084f670d9f2cebc1f475ba25d779b3a Mon Sep 17 00:00:00 2001
>> From: felix <address@hidden>
>> Date: Fri, 30 Sep 2011 09:17:01 +0200
>> Subject: [PATCH 1/2] replaced ##sys#file-info with ##sys#file-exists?
>> 
>> ---
>>  c-platform.scm |    3 +-
>>  chicken.h      |    2 +-
>>  eval.scm       |   20 +++++---------
>>  library.scm    |   22 ++++++++++++---
>>  posixunix.scm  |   31 +++++++++++++++++++---
>>  posixwin.scm   |    9 +------
>>  runtime.c      |   77 
>> ++++++++++++++++----------------------------------------
>>  7 files changed, 77 insertions(+), 87 deletions(-)
>> 
>> diff --git a/posixunix.scm b/posixunix.scm
>> index a9e4565..5cde5b8 100644
>> --- a/posixunix.scm
>> +++ b/posixunix.scm
>> @@ -468,6 +468,26 @@ static int set_file_mtime(char *filename, C_word tm)
>>    return utime(filename, &tb);
>>  }
>>  
>> +static C_word C_i_fifo_p(C_word name) 
>> +{
>> +  struct stat buf;
>> +  int res;
>> +
>> +  res = stat(C_c_string(name), &buf);
>> +
>> +  if(res != 0) {
>> +#ifdef __CYGWIN__
>> +    return C_SCHEME_FALSE;
>> +#else
>> +    if((buf.st_mode & S_IFMT) == S_IFIFO) return C_SCHEME_TRUE;
>> +    else return C_SCHEME_FALSE;
>> +#endif
>> +  }
>> +
>> +  if(errno == ENOENT) return C_fix(0);
>> +  else return C_fix(res);
>> +}
>> +
>>  EOF
>>  ) )
>>  
> 
> I *think* by my reading of this routine there is a subtle problem
> here.
> 
> errno is only set when a syscall returns -1/signals an error.  If
> you call stat and it succeeds, errno wasn't touched by stat, and
> has whatever value it did before stat was called.
> 
> From the look of this routine, you're checking errno in the success
> case, where stat returned 0.  If that is the case, the errno value
> is not set by stat and has whatever value it already had.    
> 
> Do I read that correctly?

Yes, indeed. In fact, the implementation was completely broken.
Thanks for spotting the problem.

Attached a new patch.


cheers,
felix

commit 24de737e7fa806a226e5f23a7757aab8dd3b2801
Author: felix <address@hidden>
Date:   Tue Oct 4 08:00:04 2011 +0200

    Squashed commit of the following:
    
    commit 8220b82dfdb4e422c0ab03cfbf0866e03cd29e01
    Author: felix <address@hidden>
    Date:   Tue Oct 4 07:59:15 2011 +0200
    
        fixed completely broken implementation of fifo? - thanks to Alan Post
    
    commit 8ef1105d85e6e652c96e88a71b711b0ef75588b0
    Author: felix <address@hidden>
    Date:   Fri Sep 30 09:54:27 2011 +0200
    
        fixed type name and adjusted initial ptable
    
    commit 71eb0e713084f670d9f2cebc1f475ba25d779b3a
    Author: felix <address@hidden>
    Date:   Fri Sep 30 09:17:01 2011 +0200
    
        replaced ##sys#file-info with ##sys#file-exists?

diff --git a/c-platform.scm b/c-platform.scm
index efeb48e..7f27937 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -183,7 +183,8 @@
     ##sys#foreign-string-argument ##sys#foreign-pointer-argument ##sys#void
     ##sys#foreign-integer-argument ##sys#foreign-unsigned-integer-argument 
##sys#double->number
     ##sys#peek-fixnum ##sys#setislot ##sys#poke-integer ##sys#permanent? 
##sys#values ##sys#poke-double
-    ##sys#intern-symbol ##sys#make-symbol ##sys#null-pointer? ##sys#peek-byte) 
)
+    ##sys#intern-symbol ##sys#make-symbol ##sys#null-pointer? ##sys#peek-byte
+    ##sys#file-exists?) )
 
 (define non-foldable-bindings
   '(vector
diff --git a/chicken.h b/chicken.h
index 8c6eff3..d888730 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1673,7 +1673,6 @@ C_fctexport void C_ccall C_make_pointer(C_word c, C_word 
closure, C_word k) C_no
 C_fctexport void C_ccall C_make_tagged_pointer(C_word c, C_word closure, 
C_word k, C_word tag) C_noret;
 C_fctexport void C_ccall C_ensure_heap_reserve(C_word c, C_word closure, 
C_word k, C_word n) C_noret;
 C_fctexport void C_ccall C_return_to_host(C_word c, C_word closure, C_word k) 
C_noret;
-C_fctexport void C_ccall C_file_info(C_word c, C_word closure, C_word k, 
C_word port) C_noret;
 C_fctexport void C_ccall C_get_environment_variable(C_word c, C_word closure, 
C_word k, C_word name) C_noret;
 C_fctexport void C_ccall C_get_symbol_table_info(C_word c, C_word closure, 
C_word k) C_noret;
 C_fctexport void C_ccall C_get_memory_info(C_word c, C_word closure, C_word k) 
C_noret;
@@ -1816,6 +1815,7 @@ C_fctexport double C_fcall C_cpu_milliseconds(void) 
C_regparm;
 C_fctexport C_word C_fcall C_a_i_cpu_time(C_word **a, int c, C_word buf) 
C_regparm;
 C_fctexport C_word C_fcall C_a_i_string_to_number(C_word **a, int c, C_word 
str, C_word radix) C_regparm;
 C_fctexport C_word C_fcall C_a_i_exact_to_inexact(C_word **a, int c, C_word n) 
C_regparm;
+C_fctexport C_word C_fcall C_i_file_exists_p(C_word name, C_word file, C_word 
dir) C_regparm;
 
 C_fctexport C_word C_fcall C_i_foreign_char_argumentp(C_word x) C_regparm;
 C_fctexport C_word C_fcall C_i_foreign_fixnum_argumentp(C_word x) C_regparm;
diff --git a/eval.scm b/eval.scm
index 445df6e..d0b27ee 100644
--- a/eval.scm
+++ b/eval.scm
@@ -919,25 +919,20 @@
     (lambda (input evaluator pf #!optional timer printer)
       (when (string? input) 
        (set! input (##sys#expand-home-path input)) )
-      (let* ([isdir #f]
-            [fname 
+      (let* ((fname 
              (cond [(port? input) #f]
                    [(not (string? input)) (badfile input)]
-                   [(and-let* ([info (##sys#file-info input)]
-                               [id (##sys#slot info 4)] )
-                      (set! isdir (eq? 1 id)) 
-                      (not isdir) )
-                    input]
-                   [else
+                   ((##sys#file-exists? input #t #f 'load) input)
+                   (else
                     (let ([fname2 (##sys#string-append input 
##sys#load-dynamic-extension)])
                       (if (and (not ##sys#dload-disabled)
                                (##sys#fudge 24) ; dload?
-                               (##sys#file-info fname2))
+                               (##sys#file-exists? fname2 #t #f 'load))
                           fname2
                           (let ([fname3 (##sys#string-append input 
source-file-extension)])
-                            (if (##sys#file-info fname3)
+                            (if (##sys#file-exists? fname3 #t #f 'load)
                                 fname3
-                                (and (not isdir) input) ) ) ) ) ] ) ]
+                                input) ) ) ) )))
             [evproc (or evaluator eval)] )
        (cond [(and (string? input) (not fname))
               (##sys#signal-hook #:file-error 'load "cannot open file" input) ]
@@ -1414,8 +1409,7 @@
 (define ##sys#resolve-include-filename
   (let ((string-append string-append) )
     (define (exists? fname)
-      (let ([info (##sys#file-info fname)])
-       (and info (not (eq? 1 (##sys#slot info 4)))) ) )
+      (##sys#file-exists? fname #t #f #f))
     (lambda (fname prefer-source #!optional repo)
       (define (test2 fname lst)
        (if (null? lst)
diff --git a/library.scm b/library.scm
index 477b7a4..ce560c3 100644
--- a/library.scm
+++ b/library.scm
@@ -190,7 +190,6 @@ EOF
 (define (##sys#fudge index) (##core#inline "C_fudge" index))
 (define ##sys#call-host (##core#primitive "C_return_to_host"))
 (define return-to-host ##sys#call-host)
-(define ##sys#file-info (##core#primitive "C_file_info"))
 (define ##sys#symbol-table-info (##core#primitive "C_get_symbol_table_info"))
 (define ##sys#memory-info (##core#primitive "C_get_memory_info"))
 (define (current-milliseconds) (##core#inline_allocate 
("C_a_i_current_milliseconds" 4) #f))
@@ -1974,12 +1973,24 @@ EOF
            (set! ##sys#standard-output old)
            (apply ##sys#values results) ) ) ) ) ) )
 
+(define (##sys#file-exists? name file? dir? loc)
+  (case (##core#inline "C_i_file_exists_p" (##sys#make-c-string name loc) 
file? dir?)
+    ((#f) #f)
+    ((#t) #t)
+    (else 
+     (##sys#signal-hook 
+      #:file-error loc "system error while trying to access file" 
+      name))))
+
 (define (file-exists? name)
   (##sys#check-string name 'file-exists?)
   (##sys#pathname-resolution
     name
     (lambda (name)
-      (and (##sys#file-info (##sys#platform-fixup-pathname name)) name) )
+      (and (##sys#file-exists? 
+           (##sys#platform-fixup-pathname name) 
+           #f #f 'file-exists?) 
+          name) )
     #:exists?) )
 
 (define (directory-exists? name)
@@ -1987,9 +1998,10 @@ EOF
   (##sys#pathname-resolution
    name
    (lambda (name)
-     (and-let* ((info (##sys#file-info (##sys#platform-fixup-pathname name)))
-               ((eq? 1 (vector-ref info 4))))
-       name))
+     (and (##sys#file-exists?
+          (##sys#platform-fixup-pathname name)
+          #f #t 'directory-exists?)
+         name) )
    #:exists?) )
 
 (define (##sys#flush-output port)
diff --git a/posixunix.scm b/posixunix.scm
index a9e4565..c89d77b 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -468,6 +468,26 @@ static int set_file_mtime(char *filename, C_word tm)
   return utime(filename, &tb);
 }
 
+static C_word C_i_fifo_p(C_word name) 
+{
+  struct stat buf;
+  int res;
+
+  res = stat(C_c_string(name), &buf);
+
+  if(res != 0) {
+#ifdef __CYGWIN__
+    return C_SCHEME_FALSE;
+#else
+    if(errno == ENOENT) return C_fix(0);
+    else return C_fix(res);
+#endif
+  }
+
+  if((buf.st_mode & S_IFMT) == S_IFIFO) return C_SCHEME_TRUE;
+  else return C_SCHEME_FALSE;
+}
+
 EOF
 ) )
 
@@ -1539,10 +1559,16 @@ EOF
 (define fifo?
   (lambda (filename)
     (##sys#check-string filename 'fifo?)
-    (let ([v (##sys#file-info (##sys#expand-home-path filename))])
-      (if v
-          (fx= 3 (##sys#slot v 4))
-          (posix-error #:file-error 'fifo? "file does not exist" filename) ) ) 
) )
+    (case (##core#inline 
+          "C_i_fifo_p"
+          (##sys#make-c-string (##sys#expand-home-path filename) 'fifo?))
+      ((#t) #t)
+      ((#f) #f)
+      ((0) (##sys#signal-hook #:file-error 'fifo? "file does not exist" 
filename) )
+      (else
+       (posix-error 
+       #:file-error 'fifo?
+       "system error while trying to access file" filename) ) ) ) )
 
 
 ;;; Environment access:
diff --git a/posixwin.scm b/posixwin.scm
index 0430876..d253b7c 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -1083,15 +1083,8 @@ EOF
     (##sys#signal-hook #:file-error 'create-directory
                       "cannot create directory" name)))
 
-(define-inline (create-directory-check name)
-  (if (file-exists? name)
-      (let ((i   (##sys#file-info name)))
-       (and i
-            (fx= 1 (##sys#slot i 4))))
-      #f))
-
 (define-inline (create-directory-helper-silent name)
-  (unless (create-directory-check name)
+  (unless (##sys#file-exists? name #f #t #f)
     (create-directory-helper name)))
 
 (define-inline (create-directory-helper-parents name)
diff --git a/runtime.c b/runtime.c
index c0c91bc..ee3bac3 100644
--- a/runtime.c
+++ b/runtime.c
@@ -720,7 +720,7 @@ int CHICKEN_initialize(int heap, int stack, int symbols, 
void *toplevel)
 static C_PTABLE_ENTRY *create_initial_ptable()
 {
   /* hardcoded table size - this must match the number of C_pte calls! */
-  C_PTABLE_ENTRY *pt = (C_PTABLE_ENTRY *)C_malloc(sizeof(C_PTABLE_ENTRY) * 61);
+  C_PTABLE_ENTRY *pt = (C_PTABLE_ENTRY *)C_malloc(sizeof(C_PTABLE_ENTRY) * 60);
   int i = 0;
 
   if(pt == NULL)
@@ -736,7 +736,6 @@ static C_PTABLE_ENTRY *create_initial_ptable()
   C_pte(C_make_structure);
   C_pte(C_ensure_heap_reserve);
   C_pte(C_return_to_host);
-  C_pte(C_file_info);
   C_pte(C_get_symbol_table_info);
   C_pte(C_get_memory_info);
   C_pte(C_decode_seconds);
@@ -7766,61 +7765,6 @@ void C_ccall C_return_to_host(C_word c, C_word closure, 
C_word k)
 }
 
 
-void C_ccall C_file_info(C_word c, C_word closure, C_word k, C_word name)
-{
-  C_save(k);
-  C_save(name);
-  
-  if(!C_demand(FILE_INFO_SIZE + 1 + C_SIZEOF_FLONUM * 3)) C_reclaim((void 
*)file_info_2, NULL);
-
-  file_info_2(NULL);
-}
-
-
-void file_info_2(void *dummy)
-{
-  C_word name = C_restore,
-      k = C_restore,
-      *a = C_alloc(FILE_INFO_SIZE + 1 + C_SIZEOF_FLONUM * 3),
-      v = C_SCHEME_FALSE,
-      t, f1, f2, f3;
-  int len = C_header_size(name);
-  char *buffer2;
-  struct stat buf;
-
-  buffer2 = buffer;
-  if(len >= sizeof(buffer)) {
-    if((buffer2 = (char *)C_malloc(len + 1)) == NULL)
-      barf(C_OUT_OF_MEMORY_ERROR, "stat");
-  }
-  C_strncpy(buffer2, C_c_string(name), len);
-  buffer2[ len ] = '\0';
-
-  if(stat(buffer2, &buf) != 0) v = C_SCHEME_FALSE;
-  else {
-    switch(buf.st_mode & S_IFMT) {
-    case S_IFDIR: t = 1; break;
-    case S_IFIFO: t = 3; break;
-#if !defined(__MINGW32__)
-    case S_IFSOCK: t = 4; break;
-#endif
-    default: t = 0;
-    }
-
-    f1 = C_flonum(&a, buf.st_atime);
-    f2 = C_flonum(&a, buf.st_ctime);
-    f3 = C_flonum(&a, buf.st_mtime);
-    v = C_vector(&a, FILE_INFO_SIZE, f1, f2, f3,
-                C_fix(buf.st_size), C_fix(t), C_fix(buf.st_mode), 
C_fix(buf.st_uid) ); 
-  }
-
-  if (buffer2 != buffer)
-    free(buffer2);
-
-  C_kontinue(k, v);
-}
-
-
 #define C_do_getenv(v) C_getenv(v)
 #define C_free_envbuf() {}
 
@@ -9229,3 +9173,25 @@ C_filter_heap_objects(C_word c, C_word closure, C_word 
k, C_word func, C_word ve
   C_fromspace_top = C_fromspace_limit; /* force major GC */
   C_reclaim((void *)filter_heap_objects_2, NULL);
 }
+
+
+C_regparm C_word C_fcall
+C_i_file_exists_p(C_word name, C_word file, C_word dir)
+{
+  struct stat buf;
+  int res;
+
+  res = stat(C_c_string(name), &buf);
+
+  if(res != 0) {
+    if(errno == ENOENT) return C_SCHEME_FALSE;
+    else return C_fix(res);
+  }
+
+  switch(buf.st_mode & S_IFMT) {
+  case S_IFDIR: return C_truep(file) ? C_SCHEME_FALSE : C_SCHEME_TRUE;
+  default: return C_truep(dir) ? C_SCHEME_FALSE : C_SCHEME_TRUE;
+  }
+}
+
+