Merge pull request #32 from nineties/fix-write-file

fix bugs of write-file
This commit is contained in:
Koichi NAKAMURA 2021-12-19 21:47:37 +09:00 committed by GitHub
commit 7dcd492050
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23

View file

@ -1729,7 +1729,7 @@ end-struct file%
\ wbuf wbeg wend \ wbuf wbeg wend
: write-buffer-content ( file -- c-addr u ) : write-buffer-content ( file -- c-addr u )
dup file>wbeg @ swap file>wbuf tuck - dup file>wbeg @ swap file>wbuf @ tuck -
; ;
: empty-write-buffer ( file -- ) : empty-write-buffer ( file -- )
@ -1783,7 +1783,8 @@ end-struct file%
dup 0< if 2drop FLUSH-FILE-ERROR exit then dup 0< if 2drop FLUSH-FILE-ERROR exit then
( file buf u n ) ( file buf u n )
2dup < if not-reachable then 2dup < if not-reachable then
succ-write-buffer tuck - >r + r>
( file buf+n u-n )
again again
; ;
@ -1792,16 +1793,18 @@ end-struct file%
dup writable? unless WRITE-FILE-ERROR exit then dup writable? unless WRITE-FILE-ERROR exit then
over 0<= if 3drop WRITE-FILE-ERROR exit then over 0<= if 3drop WRITE-FILE-ERROR exit then
dup write-buffer-content BUFSIZE swap - ( space ) dup write-buffer-content BUFSIZE swap - ( buf space )
2 pick ( space u ) 3 pick
<= if ( c-addr u file buf space u )
( c-addr u file ) >= if
\ enough space, copy data \ enogu space, copy u-bytes from c-addr to buf
2 pick over file>wbeg @ 3 pick memcpy ( c-addr u file buf )
3 pick swap 3 pick memcpy
\ increment wbeg \ increment wbeg
swap succ-write-buffer drop success exit swap succ-write-buffer drop success exit
then then
( c-addr u file ) ( c-addr u file buf )
not-implemented
dup flush-file throw dup flush-file throw
over BUFSIZE <= if over BUFSIZE <= if