add ftell primitive

diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor
index f7fb28c8f4cc991ebaa269601f8cfa4ae5e8daca..f42ab779f48972a47aad3f56dc23624a19d2791f 100644 (file)
--- a/core/bootstrap/primitives.factor
+++ b/core/bootstrap/primitives.factor
@@ -486,6 +486,7 @@ tuple
     { "fputc" "io.streams.c" (( ch alien -- )) }
     { "fwrite" "io.streams.c" (( string alien -- )) }
     { "fflush" "io.streams.c" (( alien -- )) }
+    { "ftell" "io.streams.c" (( alien -- n )) }
     { "fseek" "io.streams.c" (( alien offset whence -- )) }
     { "fclose" "io.streams.c" (( alien -- )) }
     { "<wrapper>" "kernel" (( obj -- wrapper )) }

diff --git a/vm/io.cpp b/vm/io.cpp
index 18a553af89d5e4f88519b02ecd1db335af5150b4..8e6eff730e2657ca3cde9a4d2123df679085c3a1 100755 (executable)
--- a/vm/io.cpp
+++ b/vm/io.cpp
@@ -164,6 +164,17 @@ void factor_vm::primitive_fwrite()
        }
 }
 
+void factor_vm::primitive_ftell()
+{
+       FILE *file = (FILE *)unbox_alien();
+       off_t offset;
+
+       if((offset = FTELL(file)) == -1)
+               io_error();
+
+       box_signed_8(offset);
+}
+
 void factor_vm::primitive_fseek()
 {
        int whence = to_fixnum(dpop());

diff --git a/vm/os-unix.hpp b/vm/os-unix.hpp
index dc8acc445eae01af5b18be058968d2a403a87196..0afdbb200a4dcffd234ff66ade2eb7a1e5073dae 100644 (file)
--- a/vm/os-unix.hpp
+++ b/vm/os-unix.hpp
@@ -23,6 +23,7 @@ typedef char symbol_char;
 #define STRNCMP strncmp
 #define STRDUP strdup
 
+#define FTELL ftello
 #define FSEEK fseeko
 
 #define FIXNUM_FORMAT "%ld"

diff --git a/vm/os-windows.hpp b/vm/os-windows.hpp
index d1db3c26ac8a3b0014b92e537d72ba88c31d3038..319ad6c42a84b0c3f10273be28da3aabe8c0d461 100644 (file)
--- a/vm/os-windows.hpp
+++ b/vm/os-windows.hpp
@@ -19,7 +19,8 @@ typedef wchar_t vm_char;
 #define STRNCMP wcsncmp
 #define STRDUP _wcsdup
 #define MIN(a,b) ((a)>(b)?(b):(a))
-#define FSEEK fseek
+#define FTELL _ftelli64
+#define FSEEK _fseeki64
 
 #ifdef WIN64
        #define CELL_FORMAT "%Iu"

diff --git a/vm/primitives.cpp b/vm/primitives.cpp
index f8552ab63591a50b8d5752af8e9ea3ab410e2fc8..e2e663333f41000c704c9658e251a0c02d9427ce 100644 (file)
--- a/vm/primitives.cpp
+++ b/vm/primitives.cpp
@@ -128,6 +128,7 @@ const primitive_type primitives[] = {
        primitive_fputc,
        primitive_fwrite,
        primitive_fflush,
+       primitive_ftell,
        primitive_fseek,
        primitive_fclose,
        primitive_wrapper,
@@ -254,6 +255,7 @@ PRIMITIVE_FORWARD(fread)
 PRIMITIVE_FORWARD(fputc)
 PRIMITIVE_FORWARD(fwrite)
 PRIMITIVE_FORWARD(fflush)
+PRIMITIVE_FORWARD(ftell)
 PRIMITIVE_FORWARD(fseek)
 PRIMITIVE_FORWARD(fclose)
 PRIMITIVE_FORWARD(wrapper)

diff --git a/vm/primitives.hpp b/vm/primitives.hpp
index 983d2589b2122d904a72ae85a384aa76e3c28f9a..dd264869b29019b3790a540655a48244bb25bd90 100644 (file)
--- a/vm/primitives.hpp
+++ b/vm/primitives.hpp
@@ -136,6 +136,7 @@ PRIMITIVE(fread);
 PRIMITIVE(fputc);
 PRIMITIVE(fwrite);
 PRIMITIVE(fflush);
+PRIMITIVE(ftell);
 PRIMITIVE(fseek);
 PRIMITIVE(fclose);
 PRIMITIVE(wrapper);

diff --git a/vm/vm.hpp b/vm/vm.hpp
index 8f2b96944fe222196e2a957db8f9f39799bba060..4bd137289d3442dca58a9bead199e491059b4dd4 100644 (file)
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -510,6 +510,7 @@ struct factor_vm
        void primitive_fread();
        void primitive_fputc();
        void primitive_fwrite();
+       void primitive_ftell();
        void primitive_fseek();
        void primitive_fflush();
        void primitive_fclose();