Add fseek primitive so that c-streams can seek. This lets the UI work without native IO

basis/stack-checker/known-words/known-words.factor

@@ -605,6 +605,8 @@ M: object infer-call*
 
 \ fflush { alien } { } define-primitive
 
+\ fseek { alien integer integer } { } define-primitive
+
 \ fclose { alien } { } define-primitive
 
 \ <wrapper> { object } { wrapper } define-primitive

core/bootstrap/primitives.factor

@@ -510,6 +510,7 @@ tuple
     { "fputc" "io.streams.c" (( ch alien -- )) }
     { "fwrite" "io.streams.c" (( string alien -- )) }
     { "fflush" "io.streams.c" (( alien -- )) }
+    { "fseek" "io.streams.c" (( alien offset whence -- )) }
     { "fclose" "io.streams.c" (( alien -- )) }
     { "<wrapper>" "kernel" (( obj -- wrapper )) }
     { "(clone)" "kernel" (( obj -- newobj )) }

core/io/streams/c/c.factor

@@ -1,11 +1,24 @@
-! Copyright (C) 2004, 2008 Slava Pestov.
+! Copyright (C) 2004, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel kernel.private namespaces make io io.encodings
 sequences math generic threads.private classes io.backend
-io.files continuations destructors byte-arrays accessors ;
+io.files continuations destructors byte-arrays accessors
+combinators ;
 IN: io.streams.c
 
-TUPLE: c-writer handle disposed ;
+TUPLE: c-stream handle disposed ;
+
+M: c-stream dispose* handle>> fclose ;
+
+M: c-stream stream-seek
+    handle>> swap {
+        { seek-absolute [ 0 ] }
+        { seek-relative [ 1 ] }
+        { seek-end [ 2 ] }
+        [ bad-seek-type ]
+    } case fseek ;
+
+TUPLE: c-writer < c-stream ;
 
 : <c-writer> ( handle -- stream ) f c-writer boa ;
 
@@ -17,9 +30,7 @@ M: c-writer stream-write dup check-disposed handle>> fwrite ;
 
 M: c-writer stream-flush dup check-disposed handle>> fflush ;
 
-M: c-writer dispose* handle>> fclose ;
-
-TUPLE: c-reader handle disposed ;
+TUPLE: c-reader < c-stream ;
 
 : <c-reader> ( handle -- stream ) f c-reader boa ;
 
@@ -43,9 +54,6 @@ M: c-reader stream-read-until
     [ swap read-until-loop ] B{ } make swap
     over empty? over not and [ 2drop f f ] when ;
 
-M: c-reader dispose*
-    handle>> fclose ;
-
 M: c-io-backend init-io ;
 
 : stdin-handle ( -- alien ) 11 getenv ;

vm/io.c

@@ -163,6 +163,31 @@ void primitive_fwrite(void)
 	}
 }
 
+void primitive_fseek(void)
+{
+	int whence = to_fixnum(dpop());
+	FILE *file = unbox_alien();
+	off_t offset = to_signed_8(dpop());
+
+	switch(whence)
+	{
+	case 0: whence = SEEK_SET; break;
+	case 1: whence = SEEK_CUR; break;
+	case 2: whence = SEEK_END; break;
+	default:
+		critical_error("Bad value for whence",whence);
+		break;
+	}
+
+	if(fseeko(file,offset,whence) == -1)
+	{
+		io_error();
+
+		/* Still here? EINTR */
+		critical_error("Don't know what to do; EINTR from fseek()?",0);
+	}
+}
+
 void primitive_fflush(void)
 {
 	FILE *file = unbox_alien();

vm/io.h

@@ -9,6 +9,7 @@ void primitive_fread(void);
 void primitive_fputc(void);
 void primitive_fwrite(void);
 void primitive_fflush(void);
+void primitive_fseek(void);
 void primitive_fclose(void);
 
 /* Platform specific primitives */

vm/primitives.c

@@ -121,6 +121,7 @@ void *primitives[] = {
 	primitive_fputc,
 	primitive_fwrite,
 	primitive_fflush,
+	primitive_fseek,
 	primitive_fclose,
 	primitive_wrapper,
 	primitive_clone,