mirror of
https://github.com/hsoft/collapseos.git
synced 2024-12-25 05:08:05 +11:00
Add word TUCK
This commit is contained in:
parent
41d439376d
commit
bb190f9665
4
blk/046
4
blk/046
@ -7,10 +7,10 @@ NIP a b -- b
|
||||
OVER a b -- a b a
|
||||
ROT a b c -- b c a
|
||||
SWAP a b -- b a
|
||||
TUCK a b -- b a b
|
||||
2DROP a a --
|
||||
2DUP a b -- a b a b
|
||||
2OVER a b c d -- a b c d a b
|
||||
2SWAP a b c d -- c d a b
|
||||
'S Returns current stack pointer, not counting the
|
||||
push it's making right now.
|
||||
(cont.)
|
||||
push it's making right now. (cont.)
|
||||
|
2
blk/107
2
blk/107
@ -3,7 +3,7 @@
|
||||
BEGIN
|
||||
C@+ ROT ( a2+1 c2 a1 ) C@+ ROT ( a2+1 a1+1 c1 c2 )
|
||||
= NOT IF DROP FBUF THEN
|
||||
SWAP OVER C@ 0xd = ( a1 a2 f1 )
|
||||
TUCK C@ 0xd = ( a1 a2 f1 )
|
||||
OVER BLK) = OR ( a1 a2 f1|f2 )
|
||||
UNTIL
|
||||
DUP BLK) < IF BLK( - FBUF + -^ EDPOS ! THEN
|
||||
|
2
blk/108
2
blk/108
@ -4,7 +4,7 @@
|
||||
EDPOS @ 64 MOD 63 -^ ;
|
||||
: _I
|
||||
IBUF _type _rbufsz IBUF _blen 2DUP > IF
|
||||
SWAP OVER - ( ilen chars-to-move )
|
||||
TUCK - ( ilen chars-to-move )
|
||||
SWAP EDPOS @ _cpos 2DUP + ( ctm ilen a a+ilen )
|
||||
3 PICK MOVE- ( ctm ilen )
|
||||
NIP ( ilen )
|
||||
|
2
blk/125
2
blk/125
@ -9,7 +9,7 @@
|
||||
< IF ( under limit, do nothing )
|
||||
NIP ( a )
|
||||
ELSE ( o a )
|
||||
SWAP OVER @ ( a o n )
|
||||
TUCK @ ( a o n )
|
||||
-^ ( a n-o )
|
||||
OVER ! ( a )
|
||||
THEN
|
||||
|
2
blk/144
2
blk/144
@ -3,7 +3,7 @@
|
||||
: AMOVE
|
||||
( u ) 0 DO
|
||||
SWAP DUP I + A@ ( dst src x )
|
||||
ROT SWAP OVER I + ( src dst x dst )
|
||||
ROT TUCK I + ( src dst x dst )
|
||||
A! ( src dst )
|
||||
LOOP
|
||||
2DROP
|
||||
|
5
blk/354
5
blk/354
@ -6,7 +6,8 @@
|
||||
: =><= 2 PICK >= ( n l f ) ROT ROT >= AND ;
|
||||
: MIN ( n n - n ) 2DUP > IF SWAP THEN DROP ;
|
||||
: MAX ( n n - n ) 2DUP < IF SWAP THEN DROP ;
|
||||
: NIP SWAP DROP ; : TUCK SWAP OVER ;
|
||||
: C@+ ( a -- a+1 c ) DUP C@ SWAP 1+ SWAP ;
|
||||
: C!+ ( c a -- a+1 ) SWAP OVER C! 1+ ;
|
||||
: C!+ ( c a -- a+1 ) TUCK C! 1+ ;
|
||||
: C@- ( a -- a-1 c ) DUP C@ SWAP 1- SWAP ;
|
||||
: C!- ( c a -- a-1 ) SWAP OVER C! 1- ;
|
||||
: C!- ( c a -- a-1 ) TUCK C! 1- ;
|
||||
|
1
blk/364
1
blk/364
@ -12,4 +12,3 @@
|
||||
IF OVER C@ OR
|
||||
ELSE 0xff XOR OVER C@ AND THEN ( addr flg )
|
||||
SWAP C! ;
|
||||
: NIP SWAP DROP ;
|
||||
|
2
blk/369
2
blk/369
@ -5,7 +5,7 @@
|
||||
CURRENT @ 1-
|
||||
DUP C@ 128 OR SWAP C! ;
|
||||
: IMMED? 1- C@ 0x80 AND ;
|
||||
: +! SWAP OVER @ + SWAP ! ;
|
||||
: +! TUCK @ + SWAP ! ;
|
||||
: -^ SWAP - ;
|
||||
: / /MOD NIP ;
|
||||
: MOD /MOD DROP ;
|
||||
|
2
blk/371
2
blk/371
@ -4,7 +4,7 @@
|
||||
ROT C!+ ( a1+1 a2+1 )
|
||||
LOOP 2DROP ;
|
||||
: MOVE- ( a1 a2 u -- )
|
||||
SWAP OVER + 1- ( a1 u a2+u-1 )
|
||||
TUCK + 1- ( a1 u a2+u-1 )
|
||||
ROT 2 PICK + 1- ( u a2+u-1 a1+u-1 )
|
||||
ROT ( u ) 0 DO ( a2 a1 )
|
||||
C@- ( a2 a1-1 x )
|
||||
|
BIN
emul/forth.bin
BIN
emul/forth.bin
Binary file not shown.
Loading…
Reference in New Issue
Block a user