61 lines
2.2 KiB
Forth
61 lines
2.2 KiB
Forth
( Base words implemented in assembler JCB 13:10 08/24/10)
|
|
|
|
meta
|
|
: noop T alu ;
|
|
: + T+N d-1 alu ;
|
|
: xor T^N d-1 alu ;
|
|
: and T&N d-1 alu ;
|
|
: or T|N d-1 alu ;
|
|
: invert ~T alu ;
|
|
: = N==T d-1 alu ;
|
|
: < N<T d-1 alu ;
|
|
: u< Nu<T d-1 alu ;
|
|
: swap N T->N alu ;
|
|
: dup T T->N d+1 alu ;
|
|
: drop N d-1 alu ;
|
|
: over N T->N d+1 alu ;
|
|
: nip T d-1 alu ;
|
|
: >r N T->R r+1 d-1 alu ;
|
|
: r> rT T->N r-1 d+1 alu ;
|
|
: r@ rT T->N d+1 alu ;
|
|
: @ [T] alu ;
|
|
: ! T N->[T] d-1 alu
|
|
N d-1 alu ;
|
|
: dsp dsp T->N d+1 alu ;
|
|
: lshift N<<T d-1 alu ;
|
|
: rshift N>>T d-1 alu ;
|
|
: 1- T-1 alu ;
|
|
: 2r> rT T->N r-1 d+1 alu
|
|
rT T->N r-1 d+1 alu
|
|
N T->N alu ;
|
|
: 2>r N T->N alu
|
|
N T->R r+1 d-1 alu
|
|
N T->R r+1 d-1 alu ;
|
|
: 2r@ rT T->N r-1 d+1 alu
|
|
rT T->N r-1 d+1 alu
|
|
N T->N d+1 alu
|
|
N T->N d+1 alu
|
|
N T->R r+1 d-1 alu
|
|
N T->R r+1 d-1 alu
|
|
N T->N alu ;
|
|
: unloop
|
|
T r-1 alu
|
|
T r-1 alu ;
|
|
: exit return ;
|
|
|
|
\ Elided words
|
|
: dup@ [T] T->N d+1 alu ;
|
|
: dup>r T T->R r+1 alu ;
|
|
: 2dupxor T^N T->N d+1 alu ;
|
|
: 2dup= N==T T->N d+1 alu ;
|
|
: !nip T N->[T] d-1 alu ;
|
|
: 2dup! T N->[T] alu ;
|
|
|
|
\ Words used to implement pick
|
|
: up1 T d+1 alu ;
|
|
: down1 T d-1 alu ;
|
|
: copy N alu ;
|
|
|
|
: module[ there [char] " parse preserve ;
|
|
: ]module s" Compiled " type count type space there swap - . cr ;
|