some work on directory listing in cfactor

diff --git a/library/cross-compiler.factor b/library/cross-compiler.factor
index 8cb1e646e960d3e0f8d000a1ea2c4d85c301d063..a2d74f3d4debadbbf2fa0e389a0c4a6434d0541a 100644 (file)
--- a/library/cross-compiler.factor
+++ b/library/cross-compiler.factor
@@ -61,6 +61,7 @@ IN: io-internals
 DEFER: port?
 DEFER: open-file
 DEFER: stat
+DEFER: read-dir
 DEFER: client-socket
 DEFER: server-socket
 DEFER: close-port
@@ -220,6 +221,7 @@ IN: cross-compiler
         setenv
         open-file
         stat
+        read-dir
         garbage-collection
         save-image
         datastack

diff --git a/library/platform/native/files.factor b/library/platform/native/files.factor
index a4d2cc4390f84ee11ef853fb88b8a912ce2415f2..92d21c5cce508f505c35509afeccd481ce62e97e 100644 (file)
--- a/library/platform/native/files.factor
+++ b/library/platform/native/files.factor
@@ -32,13 +32,48 @@ USE: kernel
 USE: lists
 USE: logic
 USE: math
+USE: namespaces
 USE: stack
+USE: strings
 
-: exists? ( file -- ? )
-    stat >boolean ;
+: <file> ( path -- file )
+    #! Create an empty file object. Do not use this directly.
+    <namespace> [
+        "path" set
+        f "exists" set
+        f "directory" set
+        0 "permissions" set
+        0 "size" set
+        0 "mod-time" set
+    ] extend ;
+
+: path>file ( path -- file )
+    dup <file> [
+        stat [
+            "exists" on
+            [
+                "directory"
+                "permissions"
+                "size"
+                "mod-time"
+            ] [
+                set
+            ] 2each
+        ] when*
+    ] extend ;
+
+: ?path>file ( path/file -- file )
+    dup string? [ path>file ] when ;
 
-: dir-mode
-    OCT: 40000 ;
+: exists? ( file -- ? )
+    ?path>file "exists" swap get* ;
 
 : directory? ( file -- ? )
-    stat dup [ car dir-mode bitand 0 = not ] when ;
+    ?path>file "directory" swap get* ;
+
+: dirent>file ( parent name dir? -- file )
+    -rot "/" swap cat3 <file> [ "directory" set ] extend ;
+
+: directory ( file -- list )
+    #! Push a list of file objects in the directory.
+    dup read-dir [ dupd uncons dirent>file ] map nip ;

diff --git a/native/factor.h b/native/factor.h
index 14d95b57a4a4211b699feba02f1239acc4b124bc..424c6d5e9853485f1f03114eaaeb755c035ad2db 100644 (file)
--- a/native/factor.h
+++ b/native/factor.h
@@ -1,6 +1,7 @@
 #ifndef __FACTOR_H__
 #define __FACTOR_H__
 
+#include <dirent.h>
 #include <errno.h>
 #include <fcntl.h>
 #include <limits.h>

diff --git a/native/file.c b/native/file.c
index 3c96913bc3ebb325df47242cdc2628efec2e47e5..502cd3c91e32c22aa749c052841267db1df48a3f 100644 (file)
--- a/native/file.c
+++ b/native/file.c
@@ -33,14 +33,42 @@ void primitive_stat(void)
                dpush(F);
        else
        {
-               CELL mode = tag_integer(sb.st_mode);
+               CELL dirp = tag_boolean(S_ISDIR(sb.st_mode));
+               CELL mode = tag_fixnum(sb.st_mode & ~S_IFMT);
                CELL size = tag_object(s48_long_long_to_bignum(sb.st_size));
                CELL mtime = tag_integer(sb.st_mtime);
                dpush(tag_cons(cons(
-                       mode,
+                       dirp,
                        tag_cons(cons(
-                               size,
+                               mode,
                                tag_cons(cons(
-                                       mtime,F)))))));
+                                       size,
+                                       tag_cons(cons(
+                                               mtime,F)))))))));
        }
 }
+
+void primitive_read_dir(void)
+{
+       STRING* path = untag_string(dpop());
+       DIR* dir = opendir(to_c_string(path));
+       CELL result = F;
+       if(dir != NULL)
+       {
+               struct dirent* file;
+
+               while(file = readdir(dir))
+               {
+                       CELL name = tag_object(from_c_string(
+                               file->d_name));
+                       CELL dirp = tag_boolean(
+                               file->d_type == DT_DIR);
+                       CELL entry = tag_cons(cons(name,dirp));
+                       result = tag_cons(cons(entry,result));
+               }
+
+               closedir(dir);
+       }
+
+       dpush(result);
+}

diff --git a/native/file.h b/native/file.h
index 74326d9e6078ab4e8a361cbb14f4717e5723bcb3..5532601410322f29f35c1f6ef5d199a9b4e0efd7 100644 (file)
--- a/native/file.h
+++ b/native/file.h
@@ -2,3 +2,4 @@
 
 void primitive_open_file(void);
 void primitive_stat(void);
+void primitive_read_dir(void);

diff --git a/native/primitives.c b/native/primitives.c
index 7d144d86e1da486576b7bf377d1e32e6af59104b..e845e32604edeb78193e6989ac6cc8668a0a258c 100644 (file)
--- a/native/primitives.c
+++ b/native/primitives.c
@@ -109,6 +109,7 @@ XT primitives[] = {
        primitive_setenv,
        primitive_open_file,
        primitive_stat,
+       primitive_read_dir,
        primitive_gc,
        primitive_save_image,
        primitive_datastack,

diff --git a/native/primitives.h b/native/primitives.h
index b1ceb28c2261587d343e76080f827e8c2783d8d9..66097546ab52ef949d83c44b3089d40d896d53d7 100644 (file)
--- a/native/primitives.h
+++ b/native/primitives.h
@@ -1,4 +1,4 @@
 extern XT primitives[];
-#define PRIMITIVE_COUNT 146
+#define PRIMITIVE_COUNT 147
 
 CELL primitive_to_xt(CELL primitive);