--- gforth/blocks.fs 1996/10/02 09:48:56 1.11 +++ gforth/blocks.fs 1997/07/06 16:03:24 1.16 @@ -47,26 +47,26 @@ $20 Value buffers User block-fid : block-cold - defers 'cold block-fid off last-block off + block-fid off last-block off buffers buffer-struct drop * allocate throw dup block-buffers ! buffers buffer-struct drop * erase ; -' block-cold IS 'cold +' block-cold INIT8 chained block-cold -Defer flush-file +Defer flush-blocks : 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<> + 2dup ['] open-fpath-file catch 0<> if 2drop r/w bin create-file throw else 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" -- ) \ gforth @@ -111,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 @ + ; @@ -168,12 +168,12 @@ User scr 0 scr ! pop-file ( throw ) ; : thru ( i*x n1 n2 -- j*x ) - 1+ swap 0 ?DO I load LOOP ; + 1+ swap ?DO I load LOOP ; : +load ( i*x n -- j*x ) blk @ + load ; : +thru ( i*x n1 n2 -- j*x ) - 1+ swap 0 ?DO I +load LOOP ; + 1+ swap ?DO I +load LOOP ; : --> ( -- ) refill drop ; immediate @@ -182,13 +182,14 @@ User scr 0 scr ! 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 true constant block-ext set-current -: bye ['] flush catch drop bye ; \ No newline at end of file +: bye ['] flush catch drop bye ;