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

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

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