diff --git a/library/cross-compiler.factor b/library/cross-compiler.factor index 8cb1e646e9..a2d74f3d4d 100644 --- 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 a4d2cc4390..92d21c5cce 100644 --- 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 + +: ( path -- file ) + #! Create an empty file object. Do not use this directly. + [ + "path" set + f "exists" set + f "directory" set + 0 "permissions" set + 0 "size" set + 0 "mod-time" set + ] extend ; + +: path>file ( path -- file ) + dup [ + stat [ + "exists" on + [ + "directory" + "permissions" + "size" + "mod-time" + ] [ + set + ] 2each + ] when* + ] extend ; + +: ?path>file ( path/file -- file ) + dup string? [ path>file ] when ; : exists? ( file -- ? ) - stat >boolean ; - -: dir-mode - OCT: 40000 ; + ?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 [ "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 14d95b57a4..424c6d5e98 100644 --- a/native/factor.h +++ b/native/factor.h @@ -1,6 +1,7 @@ #ifndef __FACTOR_H__ #define __FACTOR_H__ +#include #include #include #include diff --git a/native/file.c b/native/file.c index 3c96913bc3..502cd3c91e 100644 --- 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 74326d9e60..5532601410 100644 --- 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 7d144d86e1..e845e32604 100644 --- 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 b1ceb28c22..66097546ab 100644 --- 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);