Overview
Forth is a structured, stack-based programming language developed by Charles Moore. Forth provides two stacks, the data stack and the return stack. Instructions in Forth manipulate the values on the stacks.
Redcode Forth is a threaded implementation of Forth for the MARS virtual machine. The subset provides 36 Forth words in 85 Redcode instructions. Programs are stored as a list of subroutine calls.
Instruction set
The following instructions are implemented in Redcode Forth:
Mathematics
| Forth | Macro | Description |
|---|---|---|
| - | MINUS | remove TOS and subtract TOS from 2OS. implemented as NEGATE + |
| + | PLUS | remove TOS and add TOS to 2OS |
| * | TIMES | remove TOS and multiply 2OS by TOS |
| U/ | UDIV | remove TOS and divide 2OS by TOS |
| UMOD | UMOD | remove TOS and 2OS. divide 2OS by TOS, place remainder on stack |
| 1+ | ONEPLUS | add 1 to TOS |
| ABS | ABS | replace TOS with the absolute value of TOS |
| NEGATE | NEGATE | replace TOS with -TOS |
| = | EQUALS | remove TOS. if TOS = 2OS replace 2OS with true. else false |
| 0= | ZEQUALS | if TOS = 0 replace TOS with true. else replace with false |
| U< | ULESS | remove TOS. if 2OS < TOS replace 2O with true. else false |
Flow Control
| Forth | Macro | Description |
|---|---|---|
| BEGIN | BEGIN | place current IP on the return stack |
| UNTIL | UNTIL | remove TOS. if TOS = 0 then jump to TORS, else remove TORS |
| EXECUTE | EXECUTE | remove TOS, place IP on the return stack and jump to TOS |
| EXIT | EXIT | remove and jump to TORS |
| DO | DO | remove TOS and 2OS. place IP, TOS and 2OS on the return stack |
| I | I | place the inner loop index on the stack |
| J | J | place the outer loop index on the stack |
| LOOP | LOOP | add 1 to 2ORS. if <> TORS go to 3ORS, else drop TORS, 2ORS and 3ORS |
Output
| Forth | Macro | Description |
|---|---|---|
| U. | UDOT | remove TOS and display as an unsigned base 10 number |
| SPACE | SPACE | display a space |
| CR | CR | display a newline character |
| EMIT | EMIT | remove and display TOS |
Stack Manipulation
| Forth | Macro | Description |
|---|---|---|
| DROP | DROP | remove TOS |
| DUP | DUP | place a copy of TOS on the stack |
| OVER | OVER | place a copy of 2OS on the stack. implemented as 1 PICK |
| PICK | PICK | replace TOS with a copy of the TOSth stack item |
| SWAP | SWAP | exchange TOS and 2OS. implemented as 1 ROLL |
| ROT | ROT | rotate TOS, 2OS and 3OS, moving 3OS to TOS. implemented as 2 ROLL |
| ROLL | ROLL | remove TOS and rotate TOS stack items, moving the deepest to TOS |
| DEPTH | DEPTH | place the size of the stack on the stack |
| ?DUP | QDUP | if TOS <> 0, place a copy of TOS on the stack |
Miscellaneous
| Forth | Macro | Description |
|---|---|---|
| LIT | LIT | place a copy of the next value in the program on the stack |
| LITP | LITP | adjust the next value to be relative to IP then place on stack |
| R@ | RFETCH | place a copy of TORS on the stack |
| R> | RFROM | remove TORS and place on the stack |
| >R | TOR | remove TOS and place on the return stack |
Example Programs
Fibonacci Sequence
The Fibonacci Sequence is a series of numbers studied by Leonardo of Pisa, also known as Fibonacci. Each number in the sequence is the sum of the previous two. The following Redcode Forth program displays the first 20 numbers:
main
lit 0 lit 1
lit 20 lit 0
do
dup udot cr
swap over
plus
loop
end
The first line of the program contains the label main to
show Redcode Forth where the program begins. The second line contains two
instructions. lit 0 places 0 on the stack, then
lit 1 places 1 on the stack. These are the first two numbers
in the Fibonacci Sequence:
| 0 | 1 |
Next, lit 20 lit 0 places 20, 0 on the stack:
| 0 | 1 | 20 | 0 |
do removes the top two elements from the stack to use as the
parameters for a do ... loop. The loop index is set to 0 and the loop limit
is set to 20:
| 0 | 1 |
dup places a copy of the top stack element on the stack.
udot removes the top element and displays it, then
cr displays a newline.
Next, swap exchanges the top two stack elements:
| 1 | 0 |
Then over places a copy of the second element onto the
stack:
| 1 | 0 | 1 |
plus add the top element to the second element, then removes
the top element:
| 1 | 1 |
Finally, loop adds 1 to the loop index. If the loop index
is less than the loop limit, the program jumps back to the matching
do. The initial loop index is 0 and the limit is 20, so the
do ... loop will be repeated 20 times.
Implemention in Redcode
; Redcode FORTH
; TOS = top of stack
; 2OS = 2nd on stack
; TORS = top of return stack
; 2ORS = 2nd on return stack
org next
return stack equ (_top-2)
_top
; ----------------------------------------------------------------
; LIT - place a copy of the next value in the program on the stack
; LITP - adjust the next value to be relative to IP then place on stack
xlit mov.b }ip, <stack
jmp next
; ----------------------------------------------------------------
; ?DUP QDUP - if TOS <> 0, place a copy of TOS on the stack
; DUP - place a copy of TOS on the stack
; OVER - place a copy of 2OS on the stack. implemented as 1 PICK
; PICK - replace TOS with a copy of the TOSth stack item
xqdup seq #0, @stack
xdup mov.b @stack, <stack
jmp next
xover mov #1, <stack
xpick mov.b stack, stack+1
add.b @stack, stack+1
mov.b @stack+1, @stack
jmp next
; ----------------------------------------------------------------
; SWAP - exchange TOS and 2OS. implemented as 1 ROLL
; ROT - rotate TOS, 2OS and 3OS, moving 3OS to TOS. implemented as 2 ROLL
; ROLL - remove TOS and rotate TOS stack items, moving the deepest to TOS
xswap mov #1, <stack
jmp xroll
xrot mov #2, <stack
xroll mov.b stack, stack+1
add.b @stack, stack+1
mov.b >stack+1, >stack
_rcopy sub #2, stack+1
mov.b >stack+1, @stack+1
slt stack+1, stack
jmp _rcopy
jmp next
; ----------------------------------------------------------------
; R@ RFETCH - place a copy of TORS on the stack
; R> RFROM - remove TORS and place on the stack
; >R TOR - remove TOS and place on the return stack
; BEGIN - place current IP on the return stack
; UNTIL - remove TOS. if TOS = 0 then jump to TORS, else remove TORS
; EXECUTE - remove TOS, place IP on the return stack and jump to TOS
; EXIT - remove and jump to TORS
; DROP - remove TOS
xbegin mov.ab ip, <stack
xtor mov.ba @stack, {return
xdrop jmp next, >stack
xuntil jmn _exit, >stack
mov.a *return, {return
xexit mov.a *return, ip
_exit jmp next, }return
xexecut mov.a ip, {return
mov.ba >stack, ip
jmp next
xrfetch mov.a *return, {return
xrfrom mov.ab }return, <stack
jmp next
; ----------------------------------------------------------------
; DO - remove TOS and 2OS. place IP, TOS and 2OS on the return stack
; I - place the inner loop index on the stack
; J - place the outer loop index on the stack
; LOOP - add 1 to 2ORS. if <> TORS go to 3ORS, else drop TORS, 2ORS and 3ORS
xdo mov.a ip, {return
mov.ba >stack, {return
sub #1, @stack
jmp xtor
xi mov.a return, return+1
_getind mov.ab *return+1, <stack
jmp next
xj mov.a return, return+1
add.a #3, return+1
jmp _getind
xloop sne.a }return, }return
jmp next, }return
mov.a *return, ip
add.a #1, {return
jmp next, {return
; ----------------------------------------------------------------
; U. UDOT - remove TOS and display as an unsigned base 10 number
; SPACE - display a space
; CR - display a newline character
; EMIT - remove and display TOS
xudot mov.b @stack, <stack
div #10, >stack
mod #10, @stack
add #48, @stack
add #1, _ucount
jmn xudot, <stack
add #1, stack
_uloop sts >stack, 0
_ucount djn _uloop, #0
xspace sts.a #32, 0
jmp next
xcr mov #10, <stack
xemit sts >stack, 0
jmp next
; ----------------------------------------------------------------
; ABS - replace TOS with the absolute value of TOS
; NEGATE - replace TOS with -TOS
; DEPTH - place the size of the stack on the stack
xdepth mov.b stack, <stack
xabs slt @stack, #1+CORESIZE/2
xnegate mul #-1, @stack
jmp next
; ----------------------------------------------------------------
; - MINUS - remove TOS and subtract TOS from 2OS. implemented as NEGATE +
; + PLUS - remove TOS and add TOS to 2OS
; * TIMES - remove TOS and multiply 2OS by TOS
; U/ UDIV - remove TOS and divide 2OS by TOS
; UMOD - remove TOS and 2OS. divide 2OS by TOS, place remainder on stack
; 1+ ONEPLUS - add 1 to TOS
; = EQUALS - remove TOS. if TOS = 2OS replace 2OS with true. else false
; 0= ZEQUALS - if TOS = 0 replace TOS with true. else replace with false
; U< ULESS - remove TOS. if 2OS < TOS replace 2O with true. else false
xudiv div.b >stack, @stack
jmp next
xumod mod.b >stack, @stack
jmp next
xtimes mul.b >stack, @stack
jmp next
xuless mov.b stack, stack+1
slt @stack+1, >stack
jmp _set0
mov #1, @stack
jmp next
xequals sub.b >stack, @stack
xzequal seq #0, @stack
_set0 mov #-1, @stack
x1plus mov #-1, <stack
xminus mul #-1, @stack
xplus add.b >stack, @stack
; jmp next
; ----------------------------------------------------------------
next ip jmp @main, }ip
; ----------------------------------------------------------------
_x equ
equ dat 1+
lit equ _x xlit _x -1+
litp equ _x xlit _x -1-ip+
over equ _x xover
pick equ _x xpick
rot equ _x xrot
roll equ _x xroll
udot equ _x xudot
space equ _x xspace
times equ _x xtimes
equals equ _x xequals
zequals equ _x xzequal
oneplus equ _x x1plus
minus equ _x xminus
plus equ _x xplus
swap equ _x xswap
qdup equ _x xqdup
dup equ _x xdup
depth equ _x xdepth
abs equ _x xabs
negate equ _x xnegate
rfetch equ _x xrfetch
rfrom equ _x xrfrom
begin equ _x xbegin
tor equ _x xtor
drop equ _x xdrop
until equ _x xuntil
exit equ _x xexit
execute equ _x xexecut
cr equ _x xcr
emit equ _x xemit
do equ _x xdo
loop equ _x xloop
i equ _x xi
j equ _x xj
udiv equ _x xudiv
umod equ _x xumod
uless equ _x xuless
; ----------------------------------------------------------------
main