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

Fixed bugs of flush-file

Browse source
This commit is contained in:
Koichi Nakamura 2021-01-09 20:52:47 +09:00
parent 7ee972882b
commit ad5197f603
1 changed files with 9 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
bootstrap.fs
View file

@ -1511,7 +1511,7 @@ end-struct file%
: empty-write-buffer ( file -- ) : empty-write-buffer ( file -- )
dup file>wbuf @ over file>wbeg ! dup file>wbuf @ over file>wbeg !
dup file>wbuf @ BUFSIZE + over file>wend ! dup file>wbuf @ over file>wend !
drop drop
; ;
@ -1551,17 +1551,16 @@ end-struct file%
\ Flush output buffer of file, return error-code. \ Flush output buffer of file, return error-code.
: flush-file ( file -- e ) : flush-file ( file -- e )
dup writable? unless FLUSH-FILE-ERROR exit then dup writable? unless FLUSH-FILE-ERROR exit then
begin
( file )
dup write-buffer-content ( file buf u ) dup write-buffer-content ( file buf u )
dup 0= if 3drop success exit then begin
2 pick file>fd @ 3 pick file>write @ execute ( file buf u )
( file n ) dup 0= if 2drop empty-write-buffer success exit then
2dup 4 pick file>fd @ 5 pick file>write @ execute
( file buf u n )
dup 0< if 2drop FLUSH-FILE-ERROR exit then dup 0< if 2drop FLUSH-FILE-ERROR exit then
over write-buffer-content ( file buf u n )
( file n u ) 2dup < if not-reachable then
over > if not-reachable then succ-write-buffer
over swap succ-write-buffer
again again
; ;