add ftell primitive

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 )) }

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());

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"

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"

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)

vm/primitives.hpp

@@ -136,6 +136,7 @@ PRIMITIVE(fread);
 PRIMITIVE(fputc);
 PRIMITIVE(fwrite);
 PRIMITIVE(fflush);
+PRIMITIVE(ftell);
 PRIMITIVE(fseek);
 PRIMITIVE(fclose);
 PRIMITIVE(wrapper);

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();