version 1.12, 1997/03/20 14:39:49
|
version 1.16, 1997/07/06 16:03:24
|
Line 47 $20 Value buffers
|
Line 47 $20 Value buffers
|
User block-fid |
User block-fid |
|
|
: block-cold |
: 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 * allocate throw dup block-buffers ! |
buffers buffer-struct drop * erase ; |
buffers buffer-struct drop * erase ; |
|
|
' block-cold IS 'cold |
' block-cold INIT8 chained |
|
|
block-cold |
block-cold |
|
|
Line 59 Defer flush-blocks
|
Line 59 Defer flush-blocks
|
|
|
: open-blocks ( addr u -- ) \ gforth |
: open-blocks ( addr u -- ) \ gforth |
\g use the file, whose name is given by @var{addr u}, as blocks file |
\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 |
if |
2drop r/w bin create-file throw |
2drop r/w bin create-file throw |
else |
else |
Line 168 User scr 0 scr !
|
Line 168 User scr 0 scr !
|
pop-file ( throw ) ; |
pop-file ( throw ) ; |
|
|
: thru ( i*x n1 n2 -- j*x ) |
: 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 ; |
: +load ( i*x n -- j*x ) blk @ + load ; |
|
|
: +thru ( i*x n1 n2 -- j*x ) |
: +thru ( i*x n1 n2 -- j*x ) |
1+ swap 0 ?DO I +load LOOP ; |
1+ swap ?DO I +load LOOP ; |
|
|
: --> ( -- ) refill drop ; immediate |
: --> ( -- ) refill drop ; immediate |
|
|
Line 182 User scr 0 scr !
|
Line 182 User scr 0 scr !
|
1 load block-fid @ close-file throw flush |
1 load block-fid @ close-file throw flush |
r> block-fid ! ; |
r> block-fid ! ; |
|
|
: include ( "name" -- ) |
\ thrown out because it may provide unpleasant surprises - anton |
name 2dup dup 3 - /string s" .fb" compare |
\ : include ( "name" -- ) |
0= IF block-included ELSE included THEN ; |
\ name 2dup dup 3 - /string s" .fb" compare |
|
\ 0= IF block-included ELSE included THEN ; |
|
|
get-current environment-wordlist set-current |
get-current environment-wordlist set-current |
true constant block |
true constant block |
true constant block-ext |
true constant block-ext |
set-current |
set-current |
|
|
: bye ['] flush catch drop bye ; |
|
|
|
|
: bye ['] flush catch drop bye ; |