io.fs (2830B) - raw
1 \ Input/Output. See doc/io 2 3 struct+[ IO 4 : :write ( a n hdl -- ) >r begin ( a n ) ?dup while 5 2dup r@ :writebuf ?dup not if _ioerr then 6 ( a n written-n ) tuck - ( a written-n new-n ) rot> + swap repeat ( a ) 7 drop rdrop ; 8 : :read ( a n hdl -- ) >r begin ( a n ) ?dup while 9 2dup r@ :readbuf ?dup not if _ioerr then ( a n dst src read-n ) 10 >r swap r@ move r> ( a n read-n ) 11 tuck - ( a read-n new-n ) rot> + swap repeat ( a ) 12 drop rdrop ; 13 : :readall ( a hdl -- ) >r begin ( a ) 14 dup -1 r@ :readbuf ?dup while ( a dst src read-n ) 15 >r swap r@ move r> ( a read-n ) + repeat ( a a ) 16 2drop rdrop ; 17 : :putback ( c hdl ) to putback ; 18 create _buf 1 allot 19 : :putc ( c hdl -- ) swap _buf c! _buf 1 rot :writebuf not if _ioerr then ; 20 : :puts ( str hdl -- ) swap c@+ rot :write ; 21 : :putz ( zstr hdl -- ) 22 over 0 swap $100 cidx not if _ioerr then ( zstr hdl len ) swap :write ; 23 24 create _buf( $100 allot 25 here value _)buf 26 : :readline 27 dup :getc dup 0< if ( EOF ) 2drop 0 exit then ( hdl c ) 28 swap >r _buf( 1+ >r begin ( c ) \ V1=hdl V2=buf 29 V2 _)buf = if _ioerr then ( c ) 30 dup 0>= over LF <> and while 8b to!+ V2 V1 :getc repeat ( c ) drop 31 r> _buf( - 1- ( len ) _buf( c! _buf( ( str ) rdrop ; 32 : :spit ( dst hdl -- ) 33 >r >r begin \ V1=hdl V2=dst 34 -1 V1 :readbuf ?dup while ( a n ) V2 :write repeat 2rdrop ; 35 ]struct 36 37 : _consoleemit console :putc ; 38 ' _consoleemit ' emit realias 39 40 extends IO struct[ SumIO 41 sfield fn 42 sfield res 43 44 alias _ioerr readbuf 45 : writebuf ( a n hdl -- written-n ) 46 dup >r fn >r swap >r dup >r V1 res for ( n r ) \ V1=hdl V2=fn V3=a 47 8b to@+ V3 V2 execute next ( n r ) 48 V1 to res 2rdrop 2rdrop ( written-n ) ; 49 \ fn sig: ( sum c -- sum ) 50 : :new ( 'fn -- hdl ) 51 IO :new ,[ :[methods] ], -move, swap ( 'fn ) , 0 , ; 52 ]struct 53 54 extends IO struct[ MemIO 55 sfield buf( 56 sfield )buf 57 sfield ptr 58 59 : _bounds ( n hdl -- n ) dup )buf swap ptr - min ; 60 : readbuf ( n hdl -- a? read-n ) >r \ V1=self 61 V1 _bounds dup if r@ ptr swap dup to+ r> ptr else rdrop then ; 62 : writebuf ( a n hdl -- written-n ) >r \ V1=self 63 V1 _bounds dup if ( a n ) 64 dup >r V1 ptr ( src n dst ) swap move \ V2=n 65 r> dup r> ( n n hdl ) to+ ptr ( written-n ) 66 else nip rdrop then ; 67 : :range ( hdl -- a u ) dup buf( swap )buf over - ; 68 : :eof? dup )buf swap ptr = ; 69 : :rewind ( hdl -- ) dup buf( swap to ptr ; 70 : :new ( a u -- hdl ) 71 IO :new >r ,[ :[methods] ], -move, 72 over , over + , , r> ; 73 ]struct 74 75 extends IO struct[ ByteWriter 76 smethod :writebyte ( c self -- ) 77 78 alias _ioerr readbuf 79 : writebuf ( a n self -- written-n ) >r r! \ V1=self V2=n 80 for ( a ) c@+ V1 :writebyte next drop r> rdrop ; 81 82 : :new ( writebyte -- writer ) 83 IO :new ,[ :[methods] ], -move, swap ( writebyte ) , ; 84 ]struct