version 1.29, 2000/02/28 21:27:07
|
version 1.35, 2002/09/14 08:34:03
|
Line 1
|
Line 1
|
\ A less simple implementation of the blocks wordset. |
\ A less simple implementation of the blocks wordset. |
|
|
\ Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. |
\ Copyright (C) 1995,1996,1997,1998,2000 Free Software Foundation, Inc. |
|
|
\ This file is part of Gforth. |
\ This file is part of Gforth. |
|
|
Line 16
|
Line 16
|
|
|
\ You should have received a copy of the GNU General Public License |
\ You should have received a copy of the GNU General Public License |
\ along with this program; if not, write to the Free Software |
\ along with this program; if not, write to the Free Software |
\ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. |
\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. |
|
|
|
|
\ A more efficient implementation would use mmap on OSs that |
\ A more efficient implementation would use mmap on OSs that |
Line 45 Variable last-block
|
Line 45 Variable last-block
|
$20 Value buffers |
$20 Value buffers |
|
|
User block-fid |
User block-fid |
User offset 0 offset ! \ store 1 here fore 0.4.0 compatibility |
User block-offset ( -- addr ) \ gforth |
|
\G User variable containing the number of the first block (default |
|
\G since 0.5.0: 0). Block files created with Gforth versions before |
|
\G 0.5.0 have the offset 1. If you use these files you can: @code{1 |
|
\G offset !}; or add 1 to every block number used; or prepend 1024 |
|
\G characters to the file. |
|
0 block-offset ! \ store 1 here fore 0.4.0 compatibility |
|
|
|
' block-offset alias offset \ !! eliminate this? |
|
|
: block-cold ( -- ) |
: block-cold ( -- ) |
block-fid off last-block off |
block-fid off last-block off |
Line 100 Defer flush-blocks ( -- ) \ gforth
|
Line 108 Defer flush-blocks ( -- ) \ gforth
|
if |
if |
r@ buffer-block @ block-position |
r@ buffer-block @ block-position |
r@ block-buffer chars/block r@ buffer-fid @ write-file throw |
r@ block-buffer chars/block r@ buffer-fid @ write-file throw |
|
buffer-fid @ flush-file throw |
r@ buffer-dirty off |
r@ buffer-dirty off |
endif |
endif |
rdrop ; |
rdrop ; |
Line 109 Defer flush-blocks ( -- ) \ gforth
|
Line 118 Defer flush-blocks ( -- ) \ gforth
|
|
|
: save-buffers ( -- ) \ block |
: save-buffers ( -- ) \ block |
\G Transfer the contents of each @code{update}d block buffer to |
\G Transfer the contents of each @code{update}d block buffer to |
\G mass storage, then mark all block buffers as unassigned. |
\G mass storage, then mark all block buffers as assigned-clean. |
block-buffers @ |
block-buffers @ |
buffers 0 ?DO dup save-buffer next-buffer LOOP drop ; |
buffers 0 ?DO dup save-buffer next-buffer LOOP drop ; |
|
|
Line 194 User scr ( -- a-addr ) \ block-ext s-c-r
|
Line 203 User scr ( -- a-addr ) \ block-ext s-c-r
|
i 2 .r space scr @ block i 64 * chars + 64 type cr |
i 2 .r space scr @ block i 64 * chars + 64 type cr |
loop ; |
loop ; |
|
|
|
[IFDEF] current-input |
|
:noname 2 <> -12 and throw >in ! blk ! ; |
|
\ restore-input |
|
:noname blk @ >in @ 2 ; \ save-input |
|
:noname 2 ; \ source-id "*a block*" |
|
:noname 1 blk +! 1 loadline +! true ; \ refill |
|
:noname blk @ block chars/block ; \ source |
|
|
|
Create block-input A, A, A, A, A, |
|
|
|
: load ( i*x n -- j*x ) \ block |
|
\G Save the current input source specification. Store @i{n} in |
|
\G @code{BLK}, set @code{>IN} to 0 and interpret. When the parse |
|
\G area is exhausted, restore the input source specification. |
|
block-input 0 new-tib dup loadline ! blk ! 2 loadfilename# ! |
|
['] interpret catch pop-file throw ; |
|
[ELSE] |
: (source) ( -- c-addr u ) |
: (source) ( -- c-addr u ) |
blk @ ?dup |
blk @ ?dup |
IF block chars/block |
IF block chars/block |
Line 208 User scr ( -- a-addr ) \ block-ext s-c-r
|
Line 234 User scr ( -- a-addr ) \ block-ext s-c-r
|
\G Save the current input source specification. Store @i{n} in |
\G Save the current input source specification. Store @i{n} in |
\G @code{BLK}, set @code{>IN} to 0 and interpret. When the parse |
\G @code{BLK}, set @code{>IN} to 0 and interpret. When the parse |
\G area is exhausted, restore the input source specification. |
\G area is exhausted, restore the input source specification. |
|
loadfilename# @ >r |
|
2 loadfilename# ! \ "*a block*" |
push-file |
push-file |
dup loadline ! blk ! >in off ['] interpret catch |
dup loadline ! blk ! >in off ['] interpret catch |
pop-file throw ; |
pop-file |
|
r> loadfilename# ! |
|
throw ; |
|
[THEN] |
|
|
: thru ( i*x n1 n2 -- j*x ) \ block-ext |
: thru ( i*x n1 n2 -- j*x ) \ block-ext |
\G @code{load} the blocks @i{n1} through @i{n2} in sequence. |
\G @code{load} the blocks @i{n1} through @i{n2} in sequence. |