mirror of
https://github.com/hsoft/collapseos.git
synced 2024-12-25 04:38:05 +11:00
Add word ROT>
There are many situations where it can be useful. Worth it.
This commit is contained in:
parent
75ef1f440c
commit
e31527f5ac
4
blk/162
4
blk/162
@ -8,6 +8,6 @@
|
||||
0x4c _cmd DROP asprdy ;
|
||||
: aspf@ ( page a -- n, read word from flash )
|
||||
SWAP aspfpgsz @ * OR ( addr ) 256 /MOD ( lsb msb )
|
||||
2DUP 0 ROT ROT ( lsb msb 0 lsb msb )
|
||||
2DUP 0 ROT> ( lsb msb 0 lsb msb )
|
||||
0x20 _cmd ( lsb msb low )
|
||||
ROT ROT 0 ROT ROT ( low 0 lsb msb ) 0x28 _cmd 8 LSHIFT OR ;
|
||||
ROT> 0 ROT> ( low 0 lsb msb ) 0x28 _cmd 8 LSHIFT OR ;
|
||||
|
10
blk/308
10
blk/308
@ -2,15 +2,15 @@ CODE ROT ( a b c -- b c a )
|
||||
HL POP, ( C ) DE POP, ( B ) IY POP, ( A ) chkPS,
|
||||
DE PUSH, ( B ) HL PUSH, ( C ) IY PUSH, ( A )
|
||||
;CODE
|
||||
CODE ROT> ( a b c -- c a b )
|
||||
HL POP, ( C ) DE POP, ( B ) IY POP, ( A ) chkPS,
|
||||
HL PUSH, ( C ) IY PUSH, ( A ) DE PUSH, ( B )
|
||||
;CODE
|
||||
CODE DUP ( a -- a a )
|
||||
HL POP, chkPS,
|
||||
HL PUSH, HL PUSH,
|
||||
;CODE
|
||||
CODE ?DUP
|
||||
HL POP, chkPS,
|
||||
HL PUSH,
|
||||
HL POP, chkPS, HL PUSH,
|
||||
HLZ, IFNZ, HL PUSH, THEN,
|
||||
;CODE
|
||||
CODE DROP ( a -- )
|
||||
HL POP, chkPS,
|
||||
;CODE
|
||||
|
4
blk/309
4
blk/309
@ -1,9 +1,11 @@
|
||||
CODE DROP ( a -- )
|
||||
HL POP, chkPS,
|
||||
;CODE
|
||||
CODE SWAP ( a b -- b a )
|
||||
HL POP, ( B ) DE POP, ( A )
|
||||
chkPS,
|
||||
HL PUSH, ( B ) DE PUSH, ( A )
|
||||
;CODE
|
||||
|
||||
CODE OVER ( a b -- a b a )
|
||||
HL POP, ( B ) DE POP, ( A )
|
||||
chkPS,
|
||||
|
4
blk/354
4
blk/354
@ -1,8 +1,8 @@
|
||||
: ABORT (resSP) QUIT ;
|
||||
: = CMP NOT ; : < CMP -1 = ; : > CMP 1 = ;
|
||||
: 0< 32767 > ; : >= < NOT ; : <= > NOT ; : 0>= 0< NOT ;
|
||||
: >< ( n l h -- f ) 2 PICK > ( n l f ) ROT ROT > AND ;
|
||||
: =><= 2 PICK >= ( n l f ) ROT ROT >= AND ;
|
||||
: >< ( n l h -- f ) 2 PICK > ( n l f ) ROT> > AND ;
|
||||
: =><= 2 PICK >= ( n l f ) 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 ;
|
||||
|
2
blk/358
2
blk/358
@ -4,7 +4,7 @@
|
||||
SWAP '-' = IF 1+ THEN ( a len startat )
|
||||
( if we can do the whole string, success. if _pdacc returns
|
||||
false before, failure. )
|
||||
0 ROT ROT ( len ) ( startat ) DO ( a r )
|
||||
0 ROT> ( len ) ( startat ) DO ( a r )
|
||||
OVER I + C@ ( a r c ) _pdacc ( a r f )
|
||||
NOT IF DROP 1- 0 UNLOOP EXIT THEN LOOP ( a r )
|
||||
( if we had '-', we need to invert result. )
|
||||
|
8
blk/454
8
blk/454
@ -1,12 +1,12 @@
|
||||
CODE ROT ( a b c -- b c a ) 3 chkPS,
|
||||
CX POPx, BX POPx, AX POPx,
|
||||
BX PUSHx, CX PUSHx, AX PUSHx,
|
||||
;CODE
|
||||
BX PUSHx, CX PUSHx, AX PUSHx, ;CODE
|
||||
CODE ROT> ( a b c -- c a b ) 3 chkPS,
|
||||
CX POPx, BX POPx, AX POPx,
|
||||
CX PUSHx, AX PUSHx, BX PUSHx, ;CODE
|
||||
CODE DUP 1 chkPS, AX POPx, AX PUSHx, AX PUSHx, ;CODE
|
||||
CODE ?DUP 1 chkPS, AX POPx, AX AX ORxx, AX PUSHx,
|
||||
IFNZ, AX PUSHx, THEN, ;CODE
|
||||
CODE DROP 1 chkPS, AX POPx, ;CODE
|
||||
CODE SWAP AX POPx, BX POPx, AX PUSHx, BX PUSHx, ;CODE
|
||||
CODE OVER ( a b -- a b a ) 2 chkPS,
|
||||
DI SP MOVxx, AX [DI] 2 MOVx[]+, AX PUSHx, ;CODE
|
||||
CODE PICK
|
||||
|
4
blk/455
4
blk/455
@ -3,6 +3,8 @@ CODE (roll) ( "2 3 4 5 4 --> 2 4 5 5". See B311 )
|
||||
SI SP MOVxx, SI CX ADDxx,
|
||||
DI SI MOVxx, DI 2 ADDxi, STD, REPZ, MOVSB,
|
||||
;CODE
|
||||
CODE SWAP AX POPx, BX POPx, AX PUSHx, BX PUSHx, ;CODE
|
||||
CODE DROP 1 chkPS, AX POPx, ;CODE
|
||||
CODE 2DROP 2 chkPS, SP 4 ADDxi, ;CODE
|
||||
CODE 2DUP 2 chkPS,
|
||||
AX POPx, BX POPx,
|
||||
@ -12,5 +14,3 @@ CODE S0 AX PS_ADDR MOVxI, AX PUSHx, ;CODE
|
||||
CODE 'S SP PUSHx, ;CODE
|
||||
CODE AND 2 chkPS,
|
||||
AX POPx, BX POPx, AX BX ANDxx, AX PUSHx, ;CODE
|
||||
CODE OR 2 chkPS,
|
||||
AX POPx, BX POPx, AX BX ORxx, AX PUSHx, ;CODE
|
||||
|
8
blk/456
8
blk/456
@ -1,9 +1,10 @@
|
||||
CODE OR 2 chkPS,
|
||||
AX POPx, BX POPx, AX BX ORxx, AX PUSHx, ;CODE
|
||||
CODE XOR 2 chkPS,
|
||||
AX POPx, BX POPx, AX BX XORxx, AX PUSHx, ;CODE
|
||||
CODE NOT 1 chkPS,
|
||||
AX POPx, AX AX ORxx,
|
||||
IFNZ, AX -1 MOVxI, THEN, AX INCx, AX PUSHx,
|
||||
;CODE
|
||||
IFNZ, AX -1 MOVxI, THEN, AX INCx, AX PUSHx, ;CODE
|
||||
CODE + 2 chkPS,
|
||||
AX POPx, BX POPx, AX BX ADDxx, AX PUSHx, ;CODE
|
||||
CODE - 2 chkPS,
|
||||
@ -11,5 +12,4 @@ CODE - 2 chkPS,
|
||||
CODE * 2 chkPS,
|
||||
AX POPx, BX POPx,
|
||||
DX PUSHx, ( protect from MUL ) BX MULx, DX POPx,
|
||||
AX PUSHx,
|
||||
;CODE
|
||||
AX PUSHx, ;CODE
|
||||
|
BIN
cvm/forth.bin
BIN
cvm/forth.bin
Binary file not shown.
5
cvm/vm.c
5
cvm/vm.c
@ -184,6 +184,10 @@ static void ROT() { // a b c -- b c a
|
||||
word c = pop(); word b = pop(); word a = pop();
|
||||
push(b); push(c); push(a);
|
||||
}
|
||||
static void ROTR() { // a b c -- c a b
|
||||
word c = pop(); word b = pop(); word a = pop();
|
||||
push(c); push(a); push(b);
|
||||
}
|
||||
static void DUP() { // a -- a a
|
||||
word a = pop(); push(a); push(a);
|
||||
}
|
||||
@ -387,6 +391,7 @@ VM* VM_init(char *blkfs_path) {
|
||||
native(RSHIFT);
|
||||
native(LSHIFT);
|
||||
native(TICKS);
|
||||
native(ROTR);
|
||||
vm.IP = gw(0x04) + 1; // BOOT
|
||||
sw(SYSVARS+0x02, gw(0x08)); // CURRENT
|
||||
sw(SYSVARS+0x04, gw(0x08)); // HERE
|
||||
|
@ -69,6 +69,7 @@ H@ 4 + XCURRENT ! ( make next CODE have 0 prev field )
|
||||
0x35 CODE RSHIFT
|
||||
0x36 CODE LSHIFT
|
||||
0x37 CODE TICKS
|
||||
0x38 CODE ROT>
|
||||
353 LOAD ( xcomp core )
|
||||
: (emit) 0 PC! ;
|
||||
: (key) 0 PC@ ;
|
||||
|
@ -123,6 +123,7 @@ DUP a -- a a
|
||||
NIP a b -- b
|
||||
OVER a b -- a b a
|
||||
ROT a b c -- b c a
|
||||
ROT> a b c -- c a b
|
||||
SWAP a b -- b a
|
||||
TUCK a b -- b a b
|
||||
2DROP a a --
|
||||
|
4
tests/all/test_ps.fs
Normal file
4
tests/all/test_ps.fs
Normal file
@ -0,0 +1,4 @@
|
||||
42 43 44 ROT
|
||||
42 #eq 44 #eq 43 #eq
|
||||
42 43 44 ROT>
|
||||
43 #eq 42 #eq 44 #eq
|
Loading…
Reference in New Issue
Block a user