Miroirs/planckforth
1
0
Fork 0
mirror of https://github.com/nineties/planckforth synced 2024-12-25 21:58:22 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

fix bugs of write-file

Browse source
This commit is contained in:
Koichi Nakamura 2021-12-19 21:46:11 +09:00
parent 03b2ab4cac
commit e4d6b1c38d
1 changed files with 12 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
bootstrap.fs
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