Commit c1ff33ac authored by bernd's avatar bernd

Strip out file operations into separate sources

parent 91de256a
......@@ -52,7 +52,10 @@ reply-table $@ inherit-table fs-table
:noname fs-id @ ulit, file-id ; fs-class to start-req
$20 net2o: open-file ( $:string mode -- ) \ open file with mode
64>n $> rot fs-open ;
64>r $> 64r> fs-open ;
+net2o: file-type ( n -- ) \ choose file type
;
+net2o: close-file ( -- ) \ close file
fs-close ;
+net2o: set-size ( size -- ) \ set size attribute of current file
......
\ file states
\ Copyright (C) 2010-2014 Bernd Paysan
\ This program is free software: you can redistribute it and/or modify
\ it under the terms of the GNU Affero General Public License as published by
\ the Free Software Foundation, either version 3 of the License, or
\ (at your option) any later version.
\ This program is distributed in the hope that it will be useful,
\ but WITHOUT ANY WARRANTY; without even the implied warranty of
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
\ GNU Affero General Public License for more details.
\ You should have received a copy of the GNU Affero General Public License
\ along with this program. If not, see <http://www.gnu.org/licenses/>.
Variable net2o-path
pad 200 get-dir net2o-path $!
cmd-class class
64field: fs-size
64field: fs-seek
64field: fs-seekto
64field: fs-limit
64field: fs-time
field: fs-fid
field: fs-path
field: fs-id
field: term-w
field: term-h
method fs-read
method fs-write
method fs-open
method fs-close
end-class fs-class
fs-class class
end-class socket-class
fs-class class
end-class terminal-class
Variable fs-table
: >seek ( size 64to 64seek -- size' )
64dup 64>d fs-fid @ reposition-file throw 64- 64>n umin ;
: fs-timestamp! ( mtime fileno -- ) >r
[IFDEF] android rdrop 64drop
[ELSE] \ ." Set time: " r@ . 64dup 64>d d. cr
64>d 2dup statbuf ntime!
statbuf 2 cells + ntime!
r> statbuf futimens ?ior [THEN] ;
:noname ( addr u -- n )
fs-limit 64@ fs-seekto 64@ >seek
fs-fid @ read-file throw
dup n>64 fs-seekto 64+!
; fs-class to fs-read
:noname ( addr u -- n )
fs-limit 64@ fs-size 64@ 64umin
fs-seek 64@ >seek
tuck fs-fid @ write-file throw
dup n>64 fs-seek 64+!
; fs-class to fs-write
:noname ( -- )
fs-fid @ 0= ?EXIT
fs-time 64@ 64dup 64-0= IF 64drop
ELSE
fs-fid @ flush-file throw
fs-fid @ fileno fs-timestamp!
THEN
fs-fid @ close-file throw fs-fid off
; fs-class to fs-close
:noname ( addr u mode -- ) fs-close 64>n
msg( dup 2over ." open file: " type ." with mode " . cr )
>r 2dup absolut-path? !!abs-path!!
net2o-path open-path-file throw fs-path $! fs-fid !
r@ r/o <> IF 0 fs-fid !@ close-file throw
fs-path $@ r@ open-file throw fs-fid ! THEN rdrop
fs-fid @ file-size throw d>64 64dup fs-size 64! fs-limit 64!
64#0 fs-seek 64! 64#0 fs-seekto 64! 64#0 fs-time 64!
; fs-class to fs-open
: id>addr ( id -- addr remainder )
>r file-state $@ r> cells /string >r dup IF @ THEN r> ;
: id>addr? ( id -- addr )
id>addr cell < !!fileid!! ;
: new>file ( id -- )
[: fs-class new { w^ fsp } fsp cell file-state $+!
fsp @ >o fs-id !
fs-table @ token-table ! 64#-1 fs-limit 64! o> ;]
filestate-lock c-section ;
: lastfile@ ( -- fs-state ) file-state $@ + cell- @ ;
: state-addr ( id -- addr )
dup >r id>addr dup 0< !!gap!!
0= IF drop r@ new>file lastfile@ THEN rdrop ;
: dest-top! ( addr -- )
\ dest-tail @ dest-size @ + umin
dup dup dest-top @ U+DO
data-ackbits @ I I' fix-size dup { len }
chunk-p2 rshift swap chunk-p2 rshift swap bit-erase
len +LOOP dest-top ! ;
: dest-back! ( addr -- )
dup dup dest-back @ U+DO
data-ackbits @ I I' fix-size dup { len }
chunk-p2 rshift swap chunk-p2 rshift swap bit-fill
len +LOOP dest-back ! ;
: size! ( 64 -- )
64dup fs-size 64! fs-limit 64umin!
64#0 fs-seekto 64! 64#0 fs-seek 64! ;
: seekto! ( 64 -- )
fs-size 64@ 64umin fs-seekto 64umax! ;
: limit-min! ( 64 id -- )
fs-size 64@ 64umin fs-limit 64! ;
: init-limit! ( 64 id -- ) state-addr .fs-limit 64! ;
: file+ ( addr -- ) >r 1 r@ +!
r@ @ id>addr nip 0<= IF r@ off THEN rdrop ;
: fstates ( -- n ) file-state $@len cell/ ;
: fstate-off ( -- ) file-state @ 0= ?EXIT
file-state $@ bounds ?DO I @ .dispose cell +LOOP
file-state $off ;
: n2o:save-block ( id -- delta )
rdata-back@ file( over data-rmap @ .dest-raddr @ -
{ os } ." file write: " 2 pick . os hex.
\ os addr>ts data-rmap @ .dest-cookies @ + over addr>ts xtype space
\ data-rmap @ .data-ackbits @ os addr>bits 2 pick addr>bits bittype space
)
rot id>addr? .fs-write dup /back file( dup hex. residualwrite @ hex. cr ) ;
Sema file-sema
\ careful: must follow exactpy the same loic as slurp (see below)
: n2o:spit ( -- ) fstates 0= ?EXIT
[: +calc fstates 0 { states fails }
BEGIN rdata-back? WHILE
write-file# @ n2o:save-block
IF 0 ELSE fails 1+ residualwrite off THEN to fails
residualwrite @ 0= IF
write-file# file+ blocksize @ residualwrite ! THEN
fails states u>= UNTIL THEN msg( ." Write end" cr ) +file ;]
file-sema c-section ;
: save-to ( addr u n -- ) state-addr >o
r/w create-file throw fs-fid ! o> ;
\ file status stuff
: n2o:get-stat ( -- mtime mod )
fs-fid @ fileno statbuf fstat ?ior
statbuf st_mtime ntime@ d>64
statbuf st_mode l@ $FFF and ;
: n2o:track-mod ( mod fileno -- )
[IFDEF] android 2drop
[ELSE] swap fchmod ?ior [THEN] ;
: n2o:set-stat ( mtime mod -- )
fs-fid @ fileno n2o:track-mod fs-time 64! ;
\ open/close a file - this needs *way more checking*! !!FIXME!!
User file-reg#
: n2o:close-file ( id -- )
id>addr? .fs-close ;
: blocksize! ( n -- )
dup blocksize !
file( ." file read: ======= " cr ." file write: ======= " cr )
dup residualread ! residualwrite ! ;
: n2o:close-all ( -- )
[: fstates 0 ?DO
I n2o:close-file
LOOP file-reg# off fstate-off
blocksize @ blocksize!
read-file# off write-file# off ;] file-sema c-section ;
: n2o:open-file ( addr u mode id -- )
state-addr .fs-open ;
\ read in from files
: n2o:slurp-block ( id -- delta )
data-head@ file( over data-map @ .dest-raddr @ -
>r ." file read: " rot dup . -rot r> hex. )
rot id>addr? .fs-read dup /head file( dup hex. residualread @ hex. cr ) ;
\ careful: must follow exactpy the same loic as n2o:spit (see above)
: n2o:slurp ( -- head end-flag )
data-head? 0= fstates 0= or IF head@ 0 EXIT THEN
[: +calc fstates 0 { states fails }
0 BEGIN data-head? WHILE
read-file# @ n2o:slurp-block
IF 0 ELSE fails 1+ residualread off THEN to fails
residualread @ 0= IF
read-file# file+ blocksize @ residualread ! THEN
fails states u>= UNTIL THEN msg( ." Read end" cr ) +file
head@ fails states u>= ;]
file-sema c-section file( dup IF ." data end" cr THEN ) ;
: n2o:track-seeks ( idbits xt -- ) { xt } ( i seeklen -- )
8 cells 0 DO
dup 1 and IF
I dup id>addr? >o fs-seek 64@ fs-seekto 64@ 64<> IF
fs-seekto 64@ 64dup fs-seek 64! o>
xt execute ELSE drop o> THEN
THEN 2/
LOOP drop ;
: n2o:track-all-seeks ( xt -- ) { xt } ( i seeklen -- )
fstates 0 ?DO
I dup id>addr? >o fs-seek 64@ fs-seekto 64@ 64<> IF
fs-seekto 64@ 64dup fs-seek 64! o>
xt execute ELSE drop o> THEN
LOOP ;
0 [IF]
Local Variables:
forth-local-words:
(
(("event:") definition-starter (font-lock-keyword-face . 1)
"[ \t\n]" t name (font-lock-function-name-face . 3))
(("debug:" "field:" "2field:" "sffield:" "dffield:" "64field:") non-immediate (font-lock-type-face . 2)
"[ \t\n]" t name (font-lock-variable-name-face . 3))
("[a-z\-0-9]+(" immediate (font-lock-comment-face . 1)
")" nil comment (font-lock-comment-face . 1))
)
forth-local-indent-words:
(
(("event:") (0 . 2) (0 . 2) non-immediate)
)
End:
[THEN]
......@@ -1555,210 +1555,7 @@ $20 Value mask-bits#
\ file handling
\ file states
Variable net2o-path
pad 200 get-dir net2o-path $!
cmd-class class
64field: fs-size
64field: fs-seek
64field: fs-seekto
64field: fs-limit
64field: fs-time
field: fs-fid
field: fs-path
field: fs-id
field: term-w
field: term-h
method fs-read
method fs-write
method fs-open
method fs-close
end-class fs-class
Variable fs-table
: >seek ( size 64to 64seek -- size' )
64dup 64>d fs-fid @ reposition-file throw 64- 64>n umin ;
: fs-timestamp! ( mtime fileno -- ) >r
[IFDEF] android rdrop 64drop
[ELSE] \ ." Set time: " r@ . 64dup 64>d d. cr
64>d 2dup statbuf ntime!
statbuf 2 cells + ntime!
r> statbuf futimens ?ior [THEN] ;
:noname ( addr u -- n )
fs-limit 64@ fs-seekto 64@ >seek
fs-fid @ read-file throw
dup n>64 fs-seekto 64+!
; fs-class to fs-read
:noname ( addr u -- n )
fs-limit 64@ fs-size 64@ 64umin
fs-seek 64@ >seek
tuck fs-fid @ write-file throw
dup n>64 fs-seek 64+!
; fs-class to fs-write
:noname ( -- )
fs-fid @ 0= ?EXIT
fs-time 64@ 64dup 64-0= IF 64drop
ELSE
fs-fid @ flush-file throw
fs-fid @ fileno fs-timestamp!
THEN
fs-fid @ close-file throw fs-fid off
; fs-class to fs-close
:noname ( addr u mode -- ) fs-close
msg( dup 2over ." open file: " type ." with mode " . cr )
>r 2dup absolut-path? !!abs-path!!
net2o-path open-path-file throw fs-path $! fs-fid !
r@ r/o <> IF 0 fs-fid !@ close-file throw
fs-path $@ r@ open-file throw fs-fid ! THEN rdrop
fs-fid @ file-size throw d>64 64dup fs-size 64! fs-limit 64!
64#0 fs-seek 64! 64#0 fs-seekto 64! 64#0 fs-time 64!
; fs-class to fs-open
: id>addr ( id -- addr remainder )
>r file-state $@ r> cells /string >r dup IF @ THEN r> ;
: id>addr? ( id -- addr )
id>addr cell < !!fileid!! ;
: new>file ( id -- )
[: fs-class new { w^ fsp } fsp cell file-state $+!
fsp @ >o fs-id !
fs-table @ token-table ! 64#-1 fs-limit 64! o> ;]
filestate-lock c-section ;
: lastfile@ ( -- fs-state ) file-state $@ + cell- @ ;
: state-addr ( id -- addr )
dup >r id>addr dup 0< !!gap!!
0= IF drop r@ new>file lastfile@ THEN rdrop ;
: dest-top! ( addr -- )
\ dest-tail @ dest-size @ + umin
dup dup dest-top @ U+DO
data-ackbits @ I I' fix-size dup { len }
chunk-p2 rshift swap chunk-p2 rshift swap bit-erase
len +LOOP dest-top ! ;
: dest-back! ( addr -- )
dup dup dest-back @ U+DO
data-ackbits @ I I' fix-size dup { len }
chunk-p2 rshift swap chunk-p2 rshift swap bit-fill
len +LOOP dest-back ! ;
: size! ( 64 -- )
64dup fs-size 64! fs-limit 64umin!
64#0 fs-seekto 64! 64#0 fs-seek 64! ;
: seekto! ( 64 -- )
fs-size 64@ 64umin fs-seekto 64umax! ;
: limit-min! ( 64 id -- )
fs-size 64@ 64umin fs-limit 64! ;
: init-limit! ( 64 id -- ) state-addr .fs-limit 64! ;
: file+ ( addr -- ) >r 1 r@ +!
r@ @ id>addr nip 0<= IF r@ off THEN rdrop ;
: fstates ( -- n ) file-state $@len cell/ ;
: fstate-off ( -- ) file-state @ 0= ?EXIT
file-state $@ bounds ?DO I @ .dispose cell +LOOP
file-state $off ;
: n2o:save-block ( id -- delta )
rdata-back@ file( over data-rmap @ .dest-raddr @ -
{ os } ." file write: " 2 pick . os hex.
\ os addr>ts data-rmap @ .dest-cookies @ + over addr>ts xtype space
\ data-rmap @ .data-ackbits @ os addr>bits 2 pick addr>bits bittype space
)
rot id>addr? .fs-write dup /back file( dup hex. residualwrite @ hex. cr ) ;
Sema file-sema
\ careful: must follow exactpy the same loic as slurp (see below)
: n2o:spit ( -- ) fstates 0= ?EXIT
[: +calc fstates 0 { states fails }
BEGIN rdata-back? WHILE
write-file# @ n2o:save-block
IF 0 ELSE fails 1+ residualwrite off THEN to fails
residualwrite @ 0= IF
write-file# file+ blocksize @ residualwrite ! THEN
fails states u>= UNTIL THEN msg( ." Write end" cr ) +file ;]
file-sema c-section ;
: save-to ( addr u n -- ) state-addr >o
r/w create-file throw fs-fid ! o> ;
\ file status stuff
: n2o:get-stat ( -- mtime mod )
fs-fid @ fileno statbuf fstat ?ior
statbuf st_mtime ntime@ d>64
statbuf st_mode l@ $FFF and ;
: n2o:track-mod ( mod fileno -- )
[IFDEF] android 2drop
[ELSE] swap fchmod ?ior [THEN] ;
: n2o:set-stat ( mtime mod -- )
fs-fid @ fileno n2o:track-mod fs-time 64! ;
\ open/close a file - this needs *way more checking*! !!FIXME!!
User file-reg#
: n2o:close-file ( id -- )
id>addr? .fs-close ;
: blocksize! ( n -- )
dup blocksize !
file( ." file read: ======= " cr ." file write: ======= " cr )
dup residualread ! residualwrite ! ;
: n2o:close-all ( -- )
[: fstates 0 ?DO
I n2o:close-file
LOOP file-reg# off fstate-off
blocksize @ blocksize!
read-file# off write-file# off ;] file-sema c-section ;
: n2o:open-file ( addr u mode id -- )
state-addr .fs-open ;
\ read in from files
: n2o:slurp-block ( id -- delta )
data-head@ file( over data-map @ .dest-raddr @ -
>r ." file read: " rot dup . -rot r> hex. )
rot id>addr? .fs-read dup /head file( dup hex. residualread @ hex. cr ) ;
\ careful: must follow exactpy the same loic as n2o:spit (see above)
: n2o:slurp ( -- head end-flag )
data-head? 0= fstates 0= or IF head@ 0 EXIT THEN
[: +calc fstates 0 { states fails }
0 BEGIN data-head? WHILE
read-file# @ n2o:slurp-block
IF 0 ELSE fails 1+ residualread off THEN to fails
residualread @ 0= IF
read-file# file+ blocksize @ residualread ! THEN
fails states u>= UNTIL THEN msg( ." Read end" cr ) +file
head@ fails states u>= ;]
file-sema c-section file( dup IF ." data end" cr THEN ) ;
: n2o:track-seeks ( idbits xt -- ) { xt } ( i seeklen -- )
8 cells 0 DO
dup 1 and IF
I dup id>addr? >o fs-seek 64@ fs-seekto 64@ 64<> IF
fs-seekto 64@ 64dup fs-seek 64! o>
xt execute ELSE drop o> THEN
THEN 2/
LOOP drop ;
: n2o:track-all-seeks ( xt -- ) { xt } ( i seeklen -- )
fstates 0 ?DO
I dup id>addr? >o fs-seek 64@ fs-seekto 64@ 64<> IF
fs-seekto 64@ 64dup fs-seek 64! o>
xt execute ELSE drop o> THEN
LOOP ;
require net2o-file.fs
\ helpers for addresses
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment