From 16312f67111b3954507865cf5cba2aceb379db9d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 8 Feb 2009 10:35:30 -0600 Subject: [PATCH 1/5] clean up stream-seek with some suggestions from slava --- basis/io/backend/unix/unix.factor | 4 ++-- basis/io/backend/windows/nt/nt.factor | 8 ++++---- basis/io/buffers/buffers.factor | 3 --- basis/io/ports/ports.factor | 13 +++++++++---- 4 files changed, 15 insertions(+), 13 deletions(-) diff --git a/basis/io/backend/unix/unix.factor b/basis/io/backend/unix/unix.factor index 3372f15cd9..f5e6426859 100644 --- a/basis/io/backend/unix/unix.factor +++ b/basis/io/backend/unix/unix.factor @@ -46,14 +46,14 @@ M: fd cancel-operation ( fd -- ) 2bi ] if ; -M: unix (stream-seek) ( n seek-type stream -- ) +M: unix seek-handle ( n seek-type handle -- ) swap { { io:seek-absolute [ SEEK_SET ] } { io:seek-relative [ SEEK_CUR ] } { io:seek-end [ SEEK_END ] } [ io:bad-seek-type ] } case - [ handle>> fd>> swap ] dip lseek io-error ; + [ fd>> swap ] dip lseek io-error ; SYMBOL: +retry+ ! just try the operation again without blocking SYMBOL: +input+ diff --git a/basis/io/backend/windows/nt/nt.factor b/basis/io/backend/windows/nt/nt.factor index 7b96e883dd..107f1902e3 100755 --- a/basis/io/backend/windows/nt/nt.factor +++ b/basis/io/backend/windows/nt/nt.factor @@ -87,11 +87,11 @@ ERROR: invalid-file-size n ; : handle>file-size ( handle -- n ) 0 [ GetFileSizeEx win32-error=0/f ] keep *ulonglong ; -M: winnt (stream-seek) ( n seek-type stream -- ) +M: winnt seek-handle ( n seek-type handle -- ) swap { - { seek-absolute [ handle>> (>>ptr) ] } - { seek-relative [ handle>> [ + ] change-ptr drop ] } - { seek-end [ handle>> [ handle>> handle>file-size + ] keep (>>ptr) ] } + { seek-absolute [ (>>ptr) ] } + { seek-relative [ [ + ] change-ptr drop ] } + { seek-end [ [ handle>> handle>file-size + ] keep (>>ptr) ] } [ bad-seek-type ] } case ; diff --git a/basis/io/buffers/buffers.factor b/basis/io/buffers/buffers.factor index a647f27dfc..4df081b17d 100644 --- a/basis/io/buffers/buffers.factor +++ b/basis/io/buffers/buffers.factor @@ -21,9 +21,6 @@ M: buffer dispose* ptr>> free ; : buffer-reset ( n buffer -- ) swap >>fill 0 >>pos drop ; -: buffer-reset-hard ( buffer -- ) - 0 >>fill 0 >>pos drop ; - : buffer-capacity ( buffer -- n ) [ size>> ] [ fill>> ] bi - ; inline diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor index 1f7fc5f115..1a58d4200b 100644 --- a/basis/io/ports/ports.factor +++ b/basis/io/ports/ports.factor @@ -120,12 +120,17 @@ M: output-port stream-write HOOK: (wait-to-write) io-backend ( port -- ) -HOOK: (stream-seek) os ( n seek-type stream -- ) +HOOK: seek-handle os ( n seek-type handle -- ) -M: port stream-seek ( n seek-type stream -- ) - dup check-disposed - [ buffer>> buffer-reset-hard 2drop ] [ (stream-seek) ] 3bi ; +M: input-port stream-seek ( n seek-type stream -- ) + [ check-disposed ] + [ buffer>> 0 swap buffer-reset ] + [ handle>> seek-handle ] tri ; +M: output-port stream-seek ( n seek-type stream -- ) + [ check-disposed ] + [ stream-flush ] + [ handle>> seek-handle ] tri ; GENERIC: shutdown ( handle -- ) From 69f4899e11cd69c01c572d9acd68e1ed20029cf9 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 8 Feb 2009 13:51:02 -0600 Subject: [PATCH 2/5] document stream seeking --- core/io/io-docs.factor | 53 +++++++++++++++++++++++++++++++++++++++++- 1 file changed, 52 insertions(+), 1 deletion(-) diff --git a/core/io/io-docs.factor b/core/io/io-docs.factor index d7534ddb50..5d8aa6a88f 100644 --- a/core/io/io-docs.factor +++ b/core/io/io-docs.factor @@ -68,6 +68,51 @@ HELP: stream-copy { $description "Copies the contents of one stream into another, closing both streams when done." } $io-error ; + +HELP: stream-seek +{ $values + { "n" integer } { "seek-type" "a seek singleton" } { "stream" "a stream" } +} +{ $description "Moves the pointer associated with a stream's handle to an offset " { $snippet "n" } " bytes from the seek type so that further reading or writing happens at the new location. For output streams, the buffer is flushed before seeking. Seeking past the end of an output stream will pad the difference with zeros once the stream is written to again." $nl + "Three methods of seeking are supported:" + { $list { $link seek-absolute } { $link seek-relative } { $link seek-end } } +} +{ $notes "Stream seeking is not supported on streams that do not have a known length, e.g. TCP/IP streams." } ; + +HELP: seek-absolute +{ $values + + { "value" "a seek singleton" } +} +{ $description "Seeks to an offset from the beginning of the stream." } ; + +HELP: seek-end +{ $values + + { "value" "a seek singleton" } +} +{ $description "Seeks to an offset from the end of the stream. If the offset puts the stream pointer past the end of the data on an output stream, writing to it will pad the difference with zeros." } ; + +HELP: seek-relative +{ $values + + { "value" "a seek singleton" } +} +{ $description "Seeks to an offset from the current position of the stream pointer." } ; + + +HELP: seek-input +{ $values + { "n" integer } { "seek-type" "a seek singleton" } +} +{ $description "Calls " { $link stream-seek } " on the stream stored in " { $link input-stream } "." } ; + +HELP: seek-output +{ $values + { "n" integer } { "seek-type" "a seek singleton" } +} +{ $description "Calls " { $link stream-seek } " on the stream stored in " { $link output-stream } "." } ; + HELP: input-stream { $var-description "Holds an input stream for various implicit stream operations. Rebound using " { $link with-input-stream } " and " { $link with-input-stream* } "." } ; @@ -196,6 +241,8 @@ $nl { $subsection stream-write } "This word is only required for string output streams:" { $subsection stream-nl } +"This word is for streams that allow seeking:" +{ $subsection stream-seek } "For a discussion of the distinction between binary and string streams, see " { $link "stream-elements" } "." { $see-also "io.timeouts" } ; @@ -249,6 +296,8 @@ $nl { $subsection read-partial } "If the default input stream is a string stream (" { $link "stream-elements" } "), lines of text can be read:" { $subsection readln } +"Seeking on the default input stream:" +{ $subsection seek-input } "A pair of combinators for rebinding the " { $link input-stream } " variable:" { $subsection with-input-stream } { $subsection with-input-stream* } @@ -256,7 +305,7 @@ $nl { $subsection output-stream } "Unless rebound in a child namespace, this variable will be set to a console stream for showing output to the user." $nl -"Words writing to the default input stream:" +"Words writing to the default output stream:" { $subsection flush } { $subsection write1 } { $subsection write } @@ -265,6 +314,8 @@ $nl { $subsection print } { $subsection nl } { $subsection bl } +"Seeking on the default output stream:" +{ $subsection seek-output } "A pair of combinators for rebinding the " { $link output-stream } " variable:" { $subsection with-output-stream } { $subsection with-output-stream* } From fef602b1857ab649d882461e76522388cefb24a9 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 8 Feb 2009 13:58:39 -0600 Subject: [PATCH 3/5] remove superfluous flush from io tests --- core/io/io-tests.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/core/io/io-tests.factor b/core/io/io-tests.factor index 8bfc52432d..d227ebeadf 100644 --- a/core/io/io-tests.factor +++ b/core/io/io-tests.factor @@ -16,7 +16,7 @@ IN: io.tests "seek-test1" unique-file binary [ [ - B{ 1 2 3 4 5 } write flush 0 seek-absolute seek-output + B{ 1 2 3 4 5 } write 0 seek-absolute seek-output B{ 3 } write ] with-file-writer ] [ @@ -29,7 +29,7 @@ IN: io.tests "seek-test2" unique-file binary [ [ - B{ 1 2 3 4 5 } write flush -1 seek-relative seek-output + B{ 1 2 3 4 5 } write -1 seek-relative seek-output B{ 3 } write ] with-file-writer ] [ @@ -42,7 +42,7 @@ IN: io.tests "seek-test3" unique-file binary [ [ - B{ 1 2 3 4 5 } write flush 1 seek-relative seek-output + B{ 1 2 3 4 5 } write 1 seek-relative seek-output B{ 3 } write ] with-file-writer ] [ From bba15986972c5b3918fc56cbea83b489c533f199 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 8 Feb 2009 13:59:32 -0600 Subject: [PATCH 4/5] move io tests into io.files --- core/io/files/files-tests.factor | 65 ++++++++++++++++++++++++++++++++ core/io/io-tests.factor | 63 ------------------------------- 2 files changed, 65 insertions(+), 63 deletions(-) diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index f9702fd133..423eb38144 100644 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -75,3 +75,68 @@ USE: debugger.threads [ t ] [ "quux-test.txt" temp-file exists? ] unit-test [ ] [ "quux-test.txt" temp-file delete-file ] unit-test + +! File seeking tests +[ B{ 3 2 3 4 5 } ] +[ + "seek-test1" unique-file binary + [ + [ + B{ 1 2 3 4 5 } write 0 seek-absolute seek-output + B{ 3 } write + ] with-file-writer + ] [ + file-contents + ] 2bi +] unit-test + +[ B{ 1 2 3 4 3 } ] +[ + "seek-test2" unique-file binary + [ + [ + B{ 1 2 3 4 5 } write -1 seek-relative seek-output + B{ 3 } write + ] with-file-writer + ] [ + file-contents + ] 2bi +] unit-test + +[ B{ 1 2 3 4 5 0 3 } ] +[ + "seek-test3" unique-file binary + [ + [ + B{ 1 2 3 4 5 } write 1 seek-relative seek-output + B{ 3 } write + ] with-file-writer + ] [ + file-contents + ] 2bi +] unit-test + +[ B{ 3 } ] +[ + B{ 1 2 3 4 5 } "seek-test4" unique-file binary [ + set-file-contents + ] [ + [ + -3 seek-end seek-input 1 read + ] with-file-reader + ] 2bi +] unit-test + +[ B{ 2 } ] +[ + B{ 1 2 3 4 5 } "seek-test5" unique-file binary [ + set-file-contents + ] [ + [ + 3 seek-absolute seek-input + -2 seek-relative seek-input + 1 read + ] with-file-reader + ] 2bi +] unit-test + diff --git a/core/io/io-tests.factor b/core/io/io-tests.factor index d227ebeadf..9e931279d7 100644 --- a/core/io/io-tests.factor +++ b/core/io/io-tests.factor @@ -10,66 +10,3 @@ IN: io.tests ! Make sure we use correct to_c_string form when writing [ ] [ "\0" write ] unit-test - -[ B{ 3 2 3 4 5 } ] -[ - "seek-test1" unique-file binary - [ - [ - B{ 1 2 3 4 5 } write 0 seek-absolute seek-output - B{ 3 } write - ] with-file-writer - ] [ - file-contents - ] 2bi -] unit-test - -[ B{ 1 2 3 4 3 } ] -[ - "seek-test2" unique-file binary - [ - [ - B{ 1 2 3 4 5 } write -1 seek-relative seek-output - B{ 3 } write - ] with-file-writer - ] [ - file-contents - ] 2bi -] unit-test - -[ B{ 1 2 3 4 5 0 3 } ] -[ - "seek-test3" unique-file binary - [ - [ - B{ 1 2 3 4 5 } write 1 seek-relative seek-output - B{ 3 } write - ] with-file-writer - ] [ - file-contents - ] 2bi -] unit-test - -[ B{ 3 } ] -[ - B{ 1 2 3 4 5 } "seek-test4" unique-file binary [ - set-file-contents - ] [ - [ - -3 seek-end seek-input 1 read - ] with-file-reader - ] 2bi -] unit-test - -[ B{ 2 } ] -[ - B{ 1 2 3 4 5 } "seek-test5" unique-file binary [ - set-file-contents - ] [ - [ - 3 seek-absolute seek-input - -2 seek-relative seek-input - 1 read - ] with-file-reader - ] 2bi -] unit-test From c069add10b86dc8038354e5b91c1b2d3a8da5c87 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 8 Feb 2009 17:34:17 -0600 Subject: [PATCH 5/5] fix using lists --- core/io/files/files-tests.factor | 10 ++++------ core/io/io-tests.factor | 4 +--- 2 files changed, 5 insertions(+), 9 deletions(-) diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index 423eb38144..d7fc3851e2 100644 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -1,8 +1,7 @@ -USING: tools.test io.files io.files.private io.files.temp -io.directories io.encodings.8-bit arrays make system -io.encodings.binary io threads kernel continuations -io.encodings.ascii sequences strings accessors -io.encodings.utf8 math destructors namespaces ; +USING: arrays debugger.threads destructors io io.directories +io.encodings.8-bit io.encodings.ascii io.encodings.binary +io.files io.files.private io.files.temp io.files.unique kernel +make math sequences system threads tools.test ; IN: io.files.tests \ exists? must-infer @@ -139,4 +138,3 @@ USE: debugger.threads ] with-file-reader ] 2bi ] unit-test - diff --git a/core/io/io-tests.factor b/core/io/io-tests.factor index 9e931279d7..cf6b935215 100644 --- a/core/io/io-tests.factor +++ b/core/io/io-tests.factor @@ -1,6 +1,4 @@ -USING: arrays io io.files kernel math parser strings system -tools.test words namespaces make io.encodings.8-bit -io.encodings.binary sequences io.files.unique ; +USING: io parser tools.test words ; IN: io.tests [ f ] [