--- gforth/blocks.fs 1996/05/07 16:15:21 1.8 +++ gforth/blocks.fs 1997/03/27 13:31:01 1.13 @@ -55,9 +55,10 @@ User block-fid block-cold -Defer flush-file +Defer flush-blocks -: use-file ( addr u -- ) +: open-blocks ( addr u -- ) \ gforth + \g use the file, whose name is given by @var{addr u}, as blocks file 2dup ['] open-path-file catch 0<> if 2drop r/w bin create-file throw @@ -65,18 +66,19 @@ Defer flush-file rot close-file throw 2dup file-status throw bin open-file throw >r 2drop r> then - block-fid @ IF flush-file block-fid @ close-file throw THEN + block-fid @ IF flush-blocks block-fid @ close-file throw THEN block-fid ! ; -: use ( "file" -- ) - name use-file ; +: use ( "file" -- ) \ gforth + \g use @var{file} as blocks file + name open-blocks ; \ the file is opened as binary file, since it either will contain text \ without newlines or binary data : get-block-fid ( -- fid ) block-fid @ 0= if - s" blocks.fb" use-file + s" blocks.fb" open-blocks then block-fid @ ; @@ -109,7 +111,7 @@ Defer flush-file save-buffers empty-buffers ; -' flush IS flush-file +' flush IS flush-blocks : get-buffer ( n -- a-addr ) buffers mod buffer-struct drop * block-buffers @ + ; @@ -118,7 +120,7 @@ Defer flush-file dup 0= -35 and throw dup get-buffer >r dup r@ buffer-block @ <> - r@ buffer-fid @ block-fid @ <> and + r@ buffer-fid @ block-fid @ <> or if r@ save-buffer dup block-position @@ -176,13 +178,14 @@ User scr 0 scr ! : --> ( -- ) refill drop ; immediate : block-included ( addr u -- ) - block-fid @ >r block-fid off use-file + block-fid @ >r block-fid off open-blocks 1 load block-fid @ close-file throw flush r> block-fid ! ; -: include ( "name" -- ) - name 2dup dup 3 - /string s" .fb" compare - 0= IF block-included ELSE included THEN ; +\ thrown out because it may provide unpleasant surprises - anton +\ : include ( "name" -- ) +\ name 2dup dup 3 - /string s" .fb" compare +\ 0= IF block-included ELSE included THEN ; get-current environment-wordlist set-current true constant block