]> gitweb.factorcode.org Git - factor.git/commitdiff
bootstrap, io.streams.c: use new fread primitive
authorJoe Groff <arcata@gmail.com>
Tue, 11 Oct 2011 06:04:55 +0000 (23:04 -0700)
committerJoe Groff <arcata@gmail.com>
Tue, 18 Oct 2011 04:22:58 +0000 (21:22 -0700)
Change the fread primitive to fread-unsafe, matching the new primitive in the VM, and update the implementation of c-reader to implement stream-read-unsafe and stream-read in terms of fread-unsafe

basis/stack-checker/known-words/known-words.factor
core/bootstrap/primitives.factor
core/io/streams/c/c-docs.factor
core/io/streams/c/c.factor

index d51ac0b6d672861867d22d1164616669539b60b6..11657af4587a6a0d098c8e35678616f922e07442 100644 (file)
@@ -409,7 +409,7 @@ M: object infer-call* \ call bad-macro-input ;
 \ float>fixnum { float } { fixnum } define-primitive \ bignum>fixnum make-foldable
 \ fpu-state { } { } define-primitive
 \ fputc { object alien } { } define-primitive
-\ fread { integer alien } { object } define-primitive
+\ fread-unsafe { integer c-ptr alien } { integer } define-primitive
 \ fseek { integer integer alien } { } define-primitive
 \ ftell { alien } { integer } define-primitive
 \ fwrite { c-ptr integer alien } { } define-primitive
index de8d7b7d5a9a4096ff6ae3c88233b12b244b4b16..2d823f981020e483af5d819024499e91929b030c 100755 (executable)
@@ -442,7 +442,7 @@ tuple
     { "fflush" "io.streams.c" "primitive_fflush" (( alien -- )) }
     { "fgetc" "io.streams.c" "primitive_fgetc" (( alien -- ch/f )) }
     { "fputc" "io.streams.c" "primitive_fputc" (( ch alien -- )) }
-    { "fread" "io.streams.c" "primitive_fread" (( n alien -- str/f )) }
+    { "fread-unsafe" "io.streams.c" "primitive_fread" (( n buf alien -- count )) }
     { "fseek" "io.streams.c" "primitive_fseek" (( alien offset whence -- )) }
     { "ftell" "io.streams.c" "primitive_ftell" (( alien -- n )) }
     { "fwrite" "io.streams.c" "primitive_fwrite" (( data length alien -- )) }
index 246f65de9877bfac9e211096b17a082e6bbfcb38..f3801ba941449e9267f1ca183a649ca7ee3b7e47 100644 (file)
@@ -15,7 +15,7 @@ ARTICLE: "io.streams.c" "ANSI C streams"
     fflush
     fclose
     fgetc
-    fread
+    fread-unsafe
 }
 "The three standard file handles:"
 { $subsections
@@ -58,12 +58,18 @@ HELP: fclose ( alien -- )
 
 HELP: fgetc ( alien -- ch/f )
 { $values { "alien" "a C FILE* handle" } { "ch/f" "a character or " { $link f } } }
-{ $description "Reads a single character from a C FILE* handle, and outputs " { $link f } " on end of file." } 
+{ $description "Reads a single byte from a C FILE* handle, and outputs " { $link f } " on end of file." } 
 { $errors "Throws an error if the input operation failed." } ;
 
-HELP: fread ( n alien -- str/f )
-{ $values { "n" "a positive integer" } { "alien" "a C FILE* handle" } { "str/f" { $maybe string } } }
-{ $description "Reads a sequence of characters from a C FILE* handle, and outputs " { $link f } " on end of file." }
+HELP: fputc ( alien -- ch/f )
+{ $values { "alien" "a C FILE* handle" } { "ch/f" "a character or " { $link f } } }
+{ $description "Reads a single byte from a C FILE* handle, and outputs " { $link f } " on end of file." } 
+{ $errors "Throws an error if the input operation failed." } ;
+
+HELP: fread-unsafe ( n buf alien -- str/f )
+{ $values { "n" "a positive integer" } { "buf" c-ptr } { "alien" "a C FILE* handle" } { "count" integer } }
+{ $description "Reads " { $snippet "n" } " bytes from a C FILE* handle into the memory referenced by " { $snippet "buf" } ", and outputs the number of characters read. Zero is output on end of file." }
+{ $warning "This word does not check whether " { $snippet "buf" } " is large enough to accommodate the requested number of bytes. Memory corruption will occur if this is not the case." }
 { $errors "Throws an error if the input operation failed." } ;
 
 HELP: stdin-handle
index 9ebf7f701836ea99c4140f31306ad4db8c4d7ed1..81e79d9ef2a5e0ed043e131381bfae83051f3873 100644 (file)
@@ -20,7 +20,7 @@ M: c-stream stream-seek
         {
             { seek-absolute [ 0 ] }
             { seek-relative [ 1 ] }
-            { seek-end [ 2 ] }
+            { seek-end      [ 2 ] }
             [ bad-seek-type ]
         } case
     ] [ handle>> ] bi* fseek ;
@@ -45,8 +45,13 @@ TUPLE: c-reader < c-stream ;
 
 M: c-reader stream-element-type drop +byte+ ;
 
-M: c-reader stream-read dup check-disposed handle>> fread ;
+M: c-reader stream-read-unsafe dup check-disposed handle>> fread-unsafe ;
+M: c-reader stream-read
+    [ dup <byte-array> ] dip
+    [ stream-read-unsafe ] curry keep
+    over 0 = [ 2drop f ] [ resize-byte-array ] if ;
 
+M: c-reader stream-read-partial-unsafe stream-read-unsafe ;
 M: c-reader stream-read-partial stream-read ;
 
 M: c-reader stream-read1 dup check-disposed handle>> fgetc ;