mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-27 12:58:09 +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
|
OVER a b -- a b a
|
||||||
ROT a b c -- b c a
|
ROT a b c -- b c a
|
||||||
SWAP a b -- b a
|
SWAP a b -- b a
|
||||||
|
TUCK a b -- b a b
|
||||||
2DROP a a --
|
2DROP a a --
|
||||||
2DUP a b -- a b a b
|
2DUP a b -- a b a b
|
||||||
2OVER a b c d -- a b c d a b
|
2OVER a b c d -- a b c d a b
|
||||||
2SWAP a b c d -- c d a b
|
2SWAP a b c d -- c d a b
|
||||||
'S Returns current stack pointer, not counting the
|
'S Returns current stack pointer, not counting the
|
||||||
push it's making right now.
|
push it's making right now. (cont.)
|
||||||
(cont.)
|
|
||||||
|
2
blk/107
2
blk/107
@ -3,7 +3,7 @@
|
|||||||
BEGIN
|
BEGIN
|
||||||
C@+ ROT ( a2+1 c2 a1 ) C@+ ROT ( a2+1 a1+1 c1 c2 )
|
C@+ ROT ( a2+1 c2 a1 ) C@+ ROT ( a2+1 a1+1 c1 c2 )
|
||||||
= NOT IF DROP FBUF THEN
|
= 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 )
|
OVER BLK) = OR ( a1 a2 f1|f2 )
|
||||||
UNTIL
|
UNTIL
|
||||||
DUP BLK) < IF BLK( - FBUF + -^ EDPOS ! THEN
|
DUP BLK) < IF BLK( - FBUF + -^ EDPOS ! THEN
|
||||||
|
2
blk/108
2
blk/108
@ -4,7 +4,7 @@
|
|||||||
EDPOS @ 64 MOD 63 -^ ;
|
EDPOS @ 64 MOD 63 -^ ;
|
||||||
: _I
|
: _I
|
||||||
IBUF _type _rbufsz IBUF _blen 2DUP > IF
|
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 )
|
SWAP EDPOS @ _cpos 2DUP + ( ctm ilen a a+ilen )
|
||||||
3 PICK MOVE- ( ctm ilen )
|
3 PICK MOVE- ( ctm ilen )
|
||||||
NIP ( ilen )
|
NIP ( ilen )
|
||||||
|
2
blk/125
2
blk/125
@ -9,7 +9,7 @@
|
|||||||
< IF ( under limit, do nothing )
|
< IF ( under limit, do nothing )
|
||||||
NIP ( a )
|
NIP ( a )
|
||||||
ELSE ( o a )
|
ELSE ( o a )
|
||||||
SWAP OVER @ ( a o n )
|
TUCK @ ( a o n )
|
||||||
-^ ( a n-o )
|
-^ ( a n-o )
|
||||||
OVER ! ( a )
|
OVER ! ( a )
|
||||||
THEN
|
THEN
|
||||||
|
2
blk/144
2
blk/144
@ -3,7 +3,7 @@
|
|||||||
: AMOVE
|
: AMOVE
|
||||||
( u ) 0 DO
|
( u ) 0 DO
|
||||||
SWAP DUP I + A@ ( dst src x )
|
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 )
|
A! ( src dst )
|
||||||
LOOP
|
LOOP
|
||||||
2DROP
|
2DROP
|
||||||
|
5
blk/354
5
blk/354
@ -6,7 +6,8 @@
|
|||||||
: =><= 2 PICK >= ( n l f ) ROT ROT >= AND ;
|
: =><= 2 PICK >= ( n l f ) ROT ROT >= AND ;
|
||||||
: MIN ( n n - n ) 2DUP > IF SWAP THEN DROP ;
|
: MIN ( n n - n ) 2DUP > IF SWAP THEN DROP ;
|
||||||
: MAX ( 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@+ ( 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@- ( 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
|
IF OVER C@ OR
|
||||||
ELSE 0xff XOR OVER C@ AND THEN ( addr flg )
|
ELSE 0xff XOR OVER C@ AND THEN ( addr flg )
|
||||||
SWAP C! ;
|
SWAP C! ;
|
||||||
: NIP SWAP DROP ;
|
|
||||||
|
2
blk/369
2
blk/369
@ -5,7 +5,7 @@
|
|||||||
CURRENT @ 1-
|
CURRENT @ 1-
|
||||||
DUP C@ 128 OR SWAP C! ;
|
DUP C@ 128 OR SWAP C! ;
|
||||||
: IMMED? 1- C@ 0x80 AND ;
|
: IMMED? 1- C@ 0x80 AND ;
|
||||||
: +! SWAP OVER @ + SWAP ! ;
|
: +! TUCK @ + SWAP ! ;
|
||||||
: -^ SWAP - ;
|
: -^ SWAP - ;
|
||||||
: / /MOD NIP ;
|
: / /MOD NIP ;
|
||||||
: MOD /MOD DROP ;
|
: MOD /MOD DROP ;
|
||||||
|
2
blk/371
2
blk/371
@ -4,7 +4,7 @@
|
|||||||
ROT C!+ ( a1+1 a2+1 )
|
ROT C!+ ( a1+1 a2+1 )
|
||||||
LOOP 2DROP ;
|
LOOP 2DROP ;
|
||||||
: MOVE- ( a1 a2 u -- )
|
: 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 2 PICK + 1- ( u a2+u-1 a1+u-1 )
|
||||||
ROT ( u ) 0 DO ( a2 a1 )
|
ROT ( u ) 0 DO ( a2 a1 )
|
||||||
C@- ( a2 a1-1 x )
|
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