mirror of
https://github.com/nineties/planckforth
synced 2024-12-26 21:58:42 +01:00
Merge pull request #32 from nineties/fix-write-file
fix bugs of write-file
This commit is contained in:
commit
7dcd492050
1 changed files with 12 additions and 9 deletions
21
bootstrap.fs
21
bootstrap.fs
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue