| \ 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. |
| |
|
| |
|
| \ 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 |
| 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 |
| \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. |