diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index a38bb42c7e..c55e69a8a2 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/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 \ { object } { wrapper } define-primitive diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index e3803f2150..4466bd9bfe 100644 --- a/core/bootstrap/primitives.factor +++ b/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 -- )) } { "" "kernel" (( obj -- wrapper )) } { "(clone)" "kernel" (( obj -- newobj )) } diff --git a/core/io/streams/c/c.factor b/core/io/streams/c/c.factor index eb23a627b9..bec3bdc6bf 100755 --- a/core/io/streams/c/c.factor +++ b/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 ; : ( 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 ; : ( 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 ; diff --git a/vm/io.c b/vm/io.c index bad4854775..950b1ed080 100755 --- a/vm/io.c +++ b/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(); diff --git a/vm/io.h b/vm/io.h index dc7d69edee..63a9c35490 100755 --- a/vm/io.h +++ b/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 */ diff --git a/vm/primitives.c b/vm/primitives.c index 00103ac047..80b672d9d2 100755 --- a/vm/primitives.c +++ b/vm/primitives.c @@ -121,6 +121,7 @@ void *primitives[] = { primitive_fputc, primitive_fwrite, primitive_fflush, + primitive_fseek, primitive_fclose, primitive_wrapper, primitive_clone,