mirror of
https://github.com/forth-ev/VolksForth.git
synced 2024-11-26 02:49:17 +00:00
35 lines
2.1 KiB
Forth
35 lines
2.1 KiB
Forth
|
\ *** Block No. 0 Hexblock 0
|
||
|
|
\ Copy und Convey 19Nov87
|
||
|
|
|
||
|
|
Dieses File enthaelt Definitionen, die urspruenglich im Kern
|
||
|
|
enthalten waren. Sie sind jetzt ausgelagert worden, um den Kern
|
||
|
|
klein zu halten.
|
||
|
|
|
||
|
|
copy kopiert einen Screen
|
||
|
|
|
||
|
|
convey kopiert einen Bereich von Screens
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
\ *** Block No. 1 Hexblock 1
|
||
|
|
\ moving blocks 20Oct86 19Nov87
|
||
|
|
| : full? ( -- flag ) prev BEGIN @ dup @ 0= UNTIL 6 + @ 0< ;
|
||
|
|
| : fromblock ( blk -- adr ) fromfile @ (block ;
|
||
|
|
| : (copy ( from to -- )
|
||
|
|
dup isfile@ core? IF prev @ emptybuf THEN
|
||
|
|
full? IF save-buffers THEN
|
||
|
|
offset @ + isfile@ rot fromblock 6 - 2! update ;
|
||
|
|
| : blkmove ( from to quan --) save-buffers >r
|
||
|
|
over r@ + over u> >r 2dup u< r> and
|
||
|
|
IF r@ r@ d+ r> 0 ?DO -1 -2 d+ 2dup (copy LOOP
|
||
|
|
ELSE r> 0 ?DO 2dup (copy 1 1 d+ LOOP THEN
|
||
|
|
save-buffers 2drop ;
|
||
|
|
|
||
|
|
: copy ( from to --) 1 blkmove ;
|
||
|
|
: convey ( [blk1 blk2] [to.blk --)
|
||
|
|
swap 1+ 2 pick - dup 0> not Abort" Nein !" blkmove ;
|