From 11d55131de4bd28ff26fe7d1e6ad49b42947b93c Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 3 Oct 2009 18:20:35 -0500
Subject: [PATCH 1/7] add ftell primitive

---
 core/bootstrap/primitives.factor |  1 +
 vm/io.cpp                        | 11 +++++++++++
 vm/os-unix.hpp                   |  1 +
 vm/os-windows.hpp                |  3 ++-
 vm/primitives.cpp                |  2 ++
 vm/primitives.hpp                |  1 +
 vm/vm.hpp                        |  1 +
 7 files changed, 19 insertions(+), 1 deletion(-)

diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor
index f7fb28c8f4..f42ab779f4 100644
--- 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 18a553af89..8e6eff730e 100755
--- 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 dc8acc445e..0afdbb200a 100644
--- 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 d1db3c26ac..319ad6c42a 100644
--- 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 f8552ab635..e2e663333f 100644
--- 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 983d2589b2..dd264869b2 100644
--- 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 8f2b96944f..4bd137289d 100644
--- 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();

From 098fd0248ac5dcd94d282339d83734c6034290e8 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 3 Oct 2009 18:27:09 -0500
Subject: [PATCH 2/7] support limited-streams correctly for seekable streams

---
 basis/io/backend/unix/unix.factor             |   3 +
 basis/io/ports/ports.factor                   |   5 +
 basis/io/streams/duplex/duplex.factor         |   1 -
 basis/io/streams/limited/limited-tests.factor | 119 +++++++++++++++++-
 basis/io/streams/limited/limited.factor       |  72 +++++++++--
 basis/io/streams/string/string.factor         |   7 +-
 core/io/encodings/encodings-tests.factor      |   2 +-
 core/io/encodings/encodings.factor            |   4 +
 core/io/io.factor                             |  23 +++-
 .../byte-array/byte-array-tests.factor        |   6 +-
 core/io/streams/byte-array/byte-array.factor  |  15 +--
 core/io/streams/c/c.factor                    |   2 +
 12 files changed, 227 insertions(+), 32 deletions(-)

diff --git a/basis/io/backend/unix/unix.factor b/basis/io/backend/unix/unix.factor
index 4b7ef4b40f..3245d80d4e 100644
--- a/basis/io/backend/unix/unix.factor
+++ b/basis/io/backend/unix/unix.factor
@@ -49,6 +49,9 @@ M: fd cancel-operation ( fd -- )
         2bi
     ] if ;
 
+M: unix tell-handle ( handle -- n )
+    fd>> SEEK_SET 0 lseek [ io-error ] [ ] bi ;
+
 M: unix seek-handle ( n seek-type handle -- )
     swap {
         { io:seek-absolute [ SEEK_SET ] }
diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor
index 49f6166e00..e225bed32f 100644
--- a/basis/io/ports/ports.factor
+++ b/basis/io/ports/ports.factor
@@ -124,8 +124,13 @@ M: output-port stream-write
 
 HOOK: (wait-to-write) io-backend ( port -- )
 
+HOOK: tell-handle os ( handle -- n )
 HOOK: seek-handle os ( n seek-type handle -- )
 
+M: buffered-port stream-tell ( stream -- n )
+    [ check-disposed ]
+    [ handle>> tell-handle ] bi ;
+
 M: input-port stream-seek ( n seek-type stream -- )
     [ check-disposed ]
     [ buffer>> 0 swap buffer-reset ]
diff --git a/basis/io/streams/duplex/duplex.factor b/basis/io/streams/duplex/duplex.factor
index 4903195abc..0e4d1fd195 100644
--- a/basis/io/streams/duplex/duplex.factor
+++ b/basis/io/streams/duplex/duplex.factor
@@ -44,4 +44,3 @@ M: duplex-stream underlying-handle
     >duplex-stream<
     [ underlying-handle ] bi@
     [ = [ invalid-duplex-stream ] when ] keep ;
-
diff --git a/basis/io/streams/limited/limited-tests.factor b/basis/io/streams/limited/limited-tests.factor
index f052be3b74..bc9125dd62 100644
--- a/basis/io/streams/limited/limited-tests.factor
+++ b/basis/io/streams/limited/limited-tests.factor
@@ -1,7 +1,8 @@
-USING: io io.streams.limited io.encodings io.encodings.string
-io.encodings.ascii io.encodings.binary io.streams.byte-array
-namespaces tools.test strings kernel io.streams.string accessors
-io.encodings.utf8 io.files destructors ;
+USING: accessors continuations destructors io io.encodings
+io.encodings.8-bit io.encodings.ascii io.encodings.binary
+io.encodings.string io.encodings.utf8 io.files io.pipes
+io.streams.byte-array io.streams.limited io.streams.string
+kernel namespaces strings tools.test ;
 IN: io.streams.limited.tests
 
 [ ] [
@@ -89,3 +90,113 @@ IN: io.streams.limited.tests
         unlimited-input contents
     ] with-input-stream
 ] unit-test
+
+[ 4 ] [
+    "abcdefgh" <string-reader> 4 stream-throws <limited-stream> [
+        4 seek-relative seek-input tell-input
+    ] with-input-stream
+] unit-test
+
+[
+    "abcdefgh" <string-reader> 4 stream-throws <limited-stream> [
+        4 seek-relative seek-input
+        4 read
+    ] with-input-stream
+] [
+    limit-exceeded?
+] must-fail-with
+
+[
+    "abcdefgh" <string-reader> 4 stream-throws <limited-stream> [
+        4 seek-relative seek-input
+        -2 seek-relative
+        2 read
+    ] with-input-stream
+] [
+    limit-exceeded?
+] must-fail-with
+
+[
+    "abcdefgh" <string-reader> [
+        4 seek-relative seek-input
+        2 stream-throws limit-input
+        -2 seek-relative seek-input
+        2 read
+    ] with-input-stream
+] [
+    limit-exceeded?
+] must-fail-with
+
+[ "ef" ] [
+    "abcdefgh" <string-reader> [
+        4 seek-relative seek-input
+        2 stream-throws limit-input
+        4 seek-absolute seek-input
+        2 read
+    ] with-input-stream
+] unit-test
+
+[ "ef" ] [
+    "abcdefgh" <string-reader> [
+        4 seek-absolute seek-input
+        2 stream-throws limit-input
+        2 seek-absolute seek-input
+        4 seek-absolute seek-input
+        2 read
+    ] with-input-stream
+] unit-test
+
+! stream-throws, pipes are duplex and not seekable
+[ "as" ] [
+    latin1 <pipe> [ 2 stream-throws <limited-stream> ] change-in
+    "asdf" over stream-write dup stream-flush
+    2 swap stream-read
+] unit-test
+
+[
+    latin1 <pipe> [ 2 stream-throws <limited-stream> ] change-in
+    "asdf" over stream-write dup stream-flush
+    3 swap stream-read
+] [
+    limit-exceeded?
+] must-fail-with
+
+! stream-eofs, pipes are duplex and not seekable
+[ "as" ] [
+    latin1 <pipe> [ 2 stream-eofs <limited-stream> ] change-in
+    "asdf" over stream-write dup stream-flush
+    2 swap stream-read
+] unit-test
+
+[ "as" ] [
+    latin1 <pipe> [ 2 stream-eofs <limited-stream> ] change-in
+    "asdf" over stream-write dup stream-flush
+    3 swap stream-read
+] unit-test
+
+! test seeking on limited unseekable streams
+[ "as" ] [
+    latin1 <pipe> [ 2 stream-eofs <limited-stream> ] change-in
+    "asdf" over stream-write dup stream-flush
+    2 swap stream-read
+] unit-test
+
+[ "as" ] [
+    latin1 <pipe> [ 2 stream-eofs <limited-stream> ] change-in
+    "asdf" over stream-write dup stream-flush
+    3 swap stream-read
+] unit-test
+
+[
+    latin1 <pipe> [ 2 stream-throws <limited-stream> ] change-in
+    2 seek-absolute rot in>> stream-seek
+] must-fail
+
+[
+    "as"
+] [
+    latin1 <pipe> [ 2 stream-throws <limited-stream> ] change-in
+    "asdf" over stream-write dup stream-flush
+    [ 2 seek-absolute rot in>> stream-seek ] [ drop ] recover
+    2 swap stream-read
+] unit-test
diff --git a/basis/io/streams/limited/limited.factor b/basis/io/streams/limited/limited.factor
index c71e99ab91..403643ed73 100755
--- a/basis/io/streams/limited/limited.factor
+++ b/basis/io/streams/limited/limited.factor
@@ -2,11 +2,14 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors byte-vectors combinators destructors fry io
-io.encodings io.files io.files.info kernel math namespaces
-sequences ;
+io.encodings io.files io.files.info kernel locals math
+namespaces sequences ;
 IN: io.streams.limited
 
-TUPLE: limited-stream stream count limit mode stack ;
+TUPLE: limited-stream
+    stream mode
+    count limit
+    current start stop ;
 
 SINGLETONS: stream-throws stream-eofs ;
 
@@ -51,13 +54,27 @@ M: object unlimited ( stream -- stream' )
 : with-limited-stream ( stream limit mode quot -- )
     [ limit ] dip call ; inline
 
-ERROR: limit-exceeded ;
+ERROR: limit-exceeded n stream ;
 
 ERROR: bad-stream-mode mode ;
 
 <PRIVATE
 
-: adjust-limit ( n stream -- n' stream )
+: adjust-current-limit ( n stream -- n' stream )
+    2dup [ + ] change-current
+    [ current>> ] [ stop>> ] bi >
+    [
+        dup mode>> {
+            { stream-throws [ limit-exceeded ] }
+            { stream-eofs [ 
+                dup [ current>> ] [ stop>> ] bi -
+                '[ _ - ] dip
+            ] }
+            [ bad-stream-mode ]
+        } case
+    ] when ; inline
+
+: adjust-count-limit ( n stream -- n' stream )
     2dup [ + ] change-count
     [ count>> ] [ limit>> ] bi >
     [
@@ -66,13 +83,29 @@ ERROR: bad-stream-mode mode ;
             { stream-eofs [ 
                 dup [ count>> ] [ limit>> ] bi -
                 '[ _ - ] dip
+                dup limit>> >>count
             ] }
             [ bad-stream-mode ]
         } case
     ] when ; inline
 
+: check-count-bounds ( n stream -- n stream )
+    dup [ count>> ] [ limit>> ] bi >
+    [ limit-exceeded ] when ;
+
+: check-current-bounds ( n stream -- n stream )
+    dup [ current>> ] [ start>> ] bi <
+    [ limit-exceeded ] when ;
+
+: adjust-limited-read ( n stream -- n stream )
+    dup start>> [
+        check-current-bounds adjust-current-limit
+    ] [
+        check-count-bounds adjust-count-limit
+    ] if ;
+
 : maybe-read ( n limited-stream quot: ( n stream -- seq/f ) -- seq/f )
-    [ adjust-limit ] dip
+    [ adjust-limited-read ] dip
     pick 0 <= [ 3drop f ] [ [ stream>> ] dip call ] if ; inline
 
 PRIVATE>
@@ -93,16 +126,35 @@ M: limited-stream stream-read-partial
     3dup [ [ stream-read1 dup ] dip memq? ] dip
     swap [ drop ] [ push (read-until) ] if ;
 
+:: limited-stream-seek ( n seek-type stream -- )
+    seek-type {
+        { seek-absolute [ n stream (>>current) ] }
+        { seek-relative [ stream [ n + ] change-current drop ] }
+        { seek-end [ stream stop>> n - stream (>>current) ] }
+        [ bad-seek-type ]
+    } case ;
+
+: >limited-seek ( stream -- stream' )
+    dup start>> [
+        dup stream-tell >>current
+        dup [ current>> ] [ count>> ] bi - >>start
+        dup [ start>> ] [ limit>> ] bi + >>stop
+    ] unless ;
+
 PRIVATE>
 
 M: limited-stream stream-read-until
     swap BV{ } clone (read-until) [ 2nip B{ } like ] dip ;
 
-M: limited-stream stream-seek
-    stream>> stream-seek ;
+M: limited-stream stream-tell
+    stream>> stream-tell ;
 
-M: limited-stream dispose
-    stream>> dispose ;
+M: limited-stream stream-seek
+    >limited-seek
+    [ stream>> stream-seek ]
+    [ limited-stream-seek ] 3bi ;
+
+M: limited-stream dispose stream>> dispose ;
 
 M: limited-stream stream-element-type
     stream>> stream-element-type ;
diff --git a/basis/io/streams/string/string.factor b/basis/io/streams/string/string.factor
index 85cb3022f5..be9016d1f2 100644
--- a/basis/io/streams/string/string.factor
+++ b/basis/io/streams/string/string.factor
@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors io kernel math namespaces sequences sbufs
 strings generic splitting continuations destructors sequences.private
-io.streams.plain io.encodings math.order growable io.streams.sequence ;
+io.streams.plain io.encodings math.order growable io.streams.sequence
+io.private ;
 IN: io.streams.string
 
 ! Readers
@@ -13,6 +14,8 @@ M: string-reader stream-read-partial stream-read ;
 M: string-reader stream-read sequence-read ;
 M: string-reader stream-read1 sequence-read1 ;
 M: string-reader stream-read-until sequence-read-until ;
+M: string-reader stream-tell i>> ;
+M: string-reader stream-seek (stream-seek) ;
 M: string-reader dispose drop ;
 
 <PRIVATE
@@ -35,4 +38,4 @@ M: sbuf stream-element-type drop +character+ ;
 : with-string-writer ( quot -- str )
     <string-writer> [
         swap with-output-stream*
-    ] keep >string ; inline
\ No newline at end of file
+    ] keep >string ; inline
diff --git a/core/io/encodings/encodings-tests.factor b/core/io/encodings/encodings-tests.factor
index fa8832deab..9b88db5136 100644
--- a/core/io/encodings/encodings-tests.factor
+++ b/core/io/encodings/encodings-tests.factor
@@ -1,6 +1,6 @@
 USING: io.files io.streams.string io io.streams.byte-array
 tools.test kernel io.encodings.ascii io.encodings.utf8
-namespaces accessors io.encodings ;
+namespaces accessors io.encodings io.streams.limited ;
 IN: io.streams.encodings.tests
 
 [ { } ]
diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor
index 174816dd34..03e8723d20 100644
--- a/core/io/encodings/encodings.factor
+++ b/core/io/encodings/encodings.factor
@@ -50,6 +50,10 @@ M: object <decoder> f decoder boa ;
 M: decoder stream-element-type
     drop +character+ ;
 
+M: decoder stream-tell stream>> stream-tell ;
+
+M: decoder stream-seek stream>> stream-seek ;
+
 M: decoder stream-read1
     dup >decoder< decode-char fix-read1 ;
 
diff --git a/core/io/io.factor b/core/io/io.factor
index 669f104a5f..e240467c07 100644
--- a/core/io/io.factor
+++ b/core/io/io.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2003, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: hashtables generic kernel math namespaces make sequences
-continuations destructors assocs combinators ;
+USING: accessors combinators continuations destructors kernel
+math namespaces sequences ;
 IN: io
 
 SYMBOLS: +byte+ +character+ ;
@@ -23,9 +23,24 @@ ERROR: bad-seek-type type ;
 
 SINGLETONS: seek-absolute seek-relative seek-end ;
 
+GENERIC: stream-tell ( stream -- n )
 GENERIC: stream-seek ( n seek-type stream -- )
 
-: stream-print ( str stream -- ) [ stream-write ] keep stream-nl ;
+<PRIVATE
+
+SLOT: i
+
+: (stream-seek) ( n seek-type stream -- )
+    swap {
+        { seek-absolute [ (>>i) ] }
+        { seek-relative [ [ + ] change-i drop ] }
+        { seek-end [ [ underlying>> length + ] [ (>>i) ] bi ] }
+        [ bad-seek-type ]
+    } case ;
+
+PRIVATE>
+
+: stream-print ( str stream -- ) [ stream-write ] [ stream-nl ] bi ;
 
 ! Default streams
 SYMBOL: input-stream
@@ -37,6 +52,8 @@ SYMBOL: error-stream
 : read ( n -- seq ) input-stream get stream-read ;
 : read-until ( seps -- seq sep/f ) input-stream get stream-read-until ;
 : read-partial ( n -- seq ) input-stream get stream-read-partial ;
+: tell-input ( -- n ) input-stream get stream-tell ;
+: tell-output ( -- n ) output-stream get stream-tell ;
 : seek-input ( n seek-type -- ) input-stream get stream-seek ;
 : seek-output ( n seek-type -- ) output-stream get stream-seek ;
 
diff --git a/core/io/streams/byte-array/byte-array-tests.factor b/core/io/streams/byte-array/byte-array-tests.factor
index 3a08dd10d9..96b122549d 100644
--- a/core/io/streams/byte-array/byte-array-tests.factor
+++ b/core/io/streams/byte-array/byte-array-tests.factor
@@ -29,7 +29,11 @@ io.encodings.utf8 io kernel arrays strings namespaces math ;
     ] with-byte-reader
 ] unit-test
 
+[ 0 ] [
+    B{ 1 2 3 4 5 6 7 8 9 10 11 12 } binary [ tell-input ] with-byte-reader
+] unit-test
+
 ! Overly aggressive compiler optimizations
 [ B{ 123 } ] [
     binary [ 123 >bignum write1 ] with-byte-writer
-] unit-test
\ No newline at end of file
+] unit-test
diff --git a/core/io/streams/byte-array/byte-array.factor b/core/io/streams/byte-array/byte-array.factor
index 4cb50dfbc1..6f9b05cf18 100644
--- a/core/io/streams/byte-array/byte-array.factor
+++ b/core/io/streams/byte-array/byte-array.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2008, 2009 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
-USING: byte-arrays byte-vectors kernel io.encodings sequences io
-namespaces io.encodings.private accessors sequences.private
-io.streams.sequence destructors math combinators ;
+USING: accessors byte-arrays byte-vectors destructors io
+io.encodings io.private io.streams.sequence kernel namespaces
+sequences sequences.private ;
 IN: io.streams.byte-array
 
 M: byte-vector stream-element-type drop +byte+ ;
@@ -24,13 +24,8 @@ M: byte-reader stream-read1 sequence-read1 ;
 M: byte-reader stream-read-until sequence-read-until ;
 M: byte-reader dispose drop ;
 
-M: byte-reader stream-seek ( n seek-type stream -- )
-    swap {
-        { seek-absolute [ (>>i) ] }
-        { seek-relative [ [ + ] change-i drop ] }
-        { seek-end [ [ underlying>> length + ] keep (>>i) ] }
-        [ bad-seek-type ]
-    } case ;
+M: byte-reader stream-tell i>> ;
+M: byte-reader stream-seek (stream-seek) ;
 
 : <byte-reader> ( byte-array encoding -- stream )
     [ B{ } like 0 byte-reader boa ] dip <decoder> ;
diff --git a/core/io/streams/c/c.factor b/core/io/streams/c/c.factor
index aebc709a9e..6ff1a4b35c 100755
--- a/core/io/streams/c/c.factor
+++ b/core/io/streams/c/c.factor
@@ -13,6 +13,8 @@ TUPLE: c-stream < disposable handle ;
 
 M: c-stream dispose* handle>> fclose ;
 
+M: c-stream stream-tell handle>> ftell ;
+
 M: c-stream stream-seek
     handle>> swap {
         { seek-absolute [ 0 ] }

From 1d41f4c66cf82ea46c09c5453bcaf414a18914ef Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 3 Oct 2009 19:07:16 -0500
Subject: [PATCH 3/7] add unit test for c stream-tell

---
 core/io/streams/c/c-tests.factor | 11 ++++++++++-
 1 file changed, 10 insertions(+), 1 deletion(-)

diff --git a/core/io/streams/c/c-tests.factor b/core/io/streams/c/c-tests.factor
index 6a82d6d545..657c6ccd75 100644
--- a/core/io/streams/c/c-tests.factor
+++ b/core/io/streams/c/c-tests.factor
@@ -1,5 +1,5 @@
 USING: tools.test io.files io.files.temp io io.streams.c
-io.encodings.ascii strings ;
+io.encodings.ascii strings destructors kernel ;
 IN: io.streams.c.tests
 
 [ "hello world" ] [
@@ -8,3 +8,12 @@ IN: io.streams.c.tests
     "test.txt" temp-file "rb" fopen <c-reader> stream-contents
     >string
 ] unit-test
+
+[ 0 ]
+[ "test.txt" temp-file "rb" fopen <c-reader> [ stream-tell ] [ dispose ] bi ] unit-test
+
+[ 3 ] [
+    "test.txt" temp-file "rb" fopen <c-reader>
+    3 over stream-read drop
+    [ stream-tell ] [ dispose ] bi
+] unit-test

From aa37a57b9a991b42f4bfc922b382a09a649f9405 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 3 Oct 2009 19:15:56 -0500
Subject: [PATCH 4/7] take the buffer position into account on buffered-port
 stream-tell

---
 basis/io/ports/ports.factor | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor
index e225bed32f..7ecb420478 100644
--- a/basis/io/ports/ports.factor
+++ b/basis/io/ports/ports.factor
@@ -129,7 +129,8 @@ HOOK: seek-handle os ( n seek-type handle -- )
 
 M: buffered-port stream-tell ( stream -- n )
     [ check-disposed ]
-    [ handle>> tell-handle ] bi ;
+    [ handle>> tell-handle ]
+    [ buffer>> pos>> ] tri + ;
 
 M: input-port stream-seek ( n seek-type stream -- )
     [ check-disposed ]

From ed1636a0c00625369e183128f3d51beb230945e5 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 3 Oct 2009 19:26:59 -0500
Subject: [PATCH 5/7] fix stream-tell

---
 basis/io/backend/unix/unix.factor | 2 +-
 basis/io/ports/ports.factor       | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/basis/io/backend/unix/unix.factor b/basis/io/backend/unix/unix.factor
index 3245d80d4e..ebb8f1ec05 100644
--- a/basis/io/backend/unix/unix.factor
+++ b/basis/io/backend/unix/unix.factor
@@ -50,7 +50,7 @@ M: fd cancel-operation ( fd -- )
     ] if ;
 
 M: unix tell-handle ( handle -- n )
-    fd>> SEEK_SET 0 lseek [ io-error ] [ ] bi ;
+    fd>> 0 SEEK_CUR lseek [ io-error ] [ ] bi ;
 
 M: unix seek-handle ( n seek-type handle -- )
     swap {
diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor
index 7ecb420478..8cdd1d97bd 100644
--- a/basis/io/ports/ports.factor
+++ b/basis/io/ports/ports.factor
@@ -130,7 +130,7 @@ HOOK: seek-handle os ( n seek-type handle -- )
 M: buffered-port stream-tell ( stream -- n )
     [ check-disposed ]
     [ handle>> tell-handle ]
-    [ buffer>> pos>> ] tri + ;
+    [ [ buffer>> size>> - 0 max ] [ buffer>> pos>> ] bi + ] tri ;
 
 M: input-port stream-seek ( n seek-type stream -- )
     [ check-disposed ]

From 770405359e748b8064f9a8ace44cf7b4dfed8b7f Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 3 Oct 2009 19:33:54 -0500
Subject: [PATCH 6/7] better tests for stream-tell

---
 basis/io/streams/limited/limited-tests.factor | 16 +++++++++++++++-
 1 file changed, 15 insertions(+), 1 deletion(-)

diff --git a/basis/io/streams/limited/limited-tests.factor b/basis/io/streams/limited/limited-tests.factor
index bc9125dd62..022d20eb5e 100644
--- a/basis/io/streams/limited/limited-tests.factor
+++ b/basis/io/streams/limited/limited-tests.factor
@@ -2,7 +2,7 @@ USING: accessors continuations destructors io io.encodings
 io.encodings.8-bit io.encodings.ascii io.encodings.binary
 io.encodings.string io.encodings.utf8 io.files io.pipes
 io.streams.byte-array io.streams.limited io.streams.string
-kernel namespaces strings tools.test ;
+kernel namespaces strings tools.test system ;
 IN: io.streams.limited.tests
 
 [ ] [
@@ -200,3 +200,17 @@ IN: io.streams.limited.tests
     [ 2 seek-absolute rot in>> stream-seek ] [ drop ] recover
     2 swap stream-read
 ] unit-test
+
+[ 7 ] [
+    image binary stream-throws <limited-file-reader> [
+        7 read drop
+        tell-input
+    ] with-input-stream
+] unit-test
+
+[ 70000 ] [
+    image binary stream-throws <limited-file-reader> [
+        70000 read drop
+        tell-input
+    ] with-input-stream
+] unit-test

From 84fd08d86b53c4421d53c01b7305bd1ac5123008 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 3 Oct 2009 19:39:06 -0500
Subject: [PATCH 7/7] update docs for stream-tell

---
 basis/io/streams/limited/limited-docs.factor | 17 ++++++++++++++++-
 core/io/io-docs.factor                       | 15 +++++++++++++--
 2 files changed, 29 insertions(+), 3 deletions(-)

diff --git a/basis/io/streams/limited/limited-docs.factor b/basis/io/streams/limited/limited-docs.factor
index a7199eaad1..833e53820e 100755
--- a/basis/io/streams/limited/limited-docs.factor
+++ b/basis/io/streams/limited/limited-docs.factor
@@ -24,7 +24,22 @@ HELP: limit
         "    \"123456\" <string-reader> 3 stream-throws limit"
         "    100 swap stream-read ."
         "] [ ] recover ."
-        "T{ limit-exceeded }"
+"""T{ limit-exceeded
+    { n 1 }
+    { stream
+        T{ limited-stream
+            { stream
+                T{ string-reader
+                    { underlying "123456" }
+                    { i 3 }
+                }
+            }
+            { mode stream-throws }
+            { count 4 }
+            { limit 3 }
+        }
+    }
+}"""
     }
     "Returning " { $link f } " on exhaustion:"
     { $example
diff --git a/core/io/io-docs.factor b/core/io/io-docs.factor
index 13048fdb61..e0b74d5ab3 100644
--- a/core/io/io-docs.factor
+++ b/core/io/io-docs.factor
@@ -86,6 +86,14 @@ HELP: stream-copy
 { $description "Copies the contents of one stream into another, closing both streams when done." } 
 $io-error ;
 
+HELP: stream-tell
+{ $values
+     { "stream" "a stream" } { "n" integer }
+}
+{ $description "Returns the index of the stream pointer if the stream is seekable." }
+{ $notes "Stream seeking is not supported on streams that do not have a known length, e.g. TCP/IP streams." } ;
+
+
 HELP: stream-seek
 { $values
      { "n" integer } { "seek-type" "a seek singleton" } { "stream" "a stream" }
@@ -274,8 +282,11 @@ $nl
 }
 "This word is only required for string output streams:"
 { $subsections stream-nl }
-"This word is for streams that allow seeking:"
-{ $subsections stream-seek }
+"These words are for seekable streams:"
+{ $subsections
+    stream-tell
+    stream-seek
+}
 { $see-also "io.timeouts" } ;
 
 ARTICLE: "stdio-motivation" "Motivation for default streams"