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

ForthMacroDescription
-MINUSremove TOS and subtract TOS from 2OS. implemented as NEGATE +
+PLUSremove TOS and add TOS to 2OS
*TIMESremove TOS and multiply 2OS by TOS
U/UDIVremove TOS and divide 2OS by TOS
UMODUMODremove TOS and 2OS. divide 2OS by TOS, place remainder on stack
1+ONEPLUSadd 1 to TOS
ABSABSreplace TOS with the absolute value of TOS
NEGATENEGATEreplace TOS with -TOS
=EQUALSremove TOS. if TOS = 2OS replace 2OS with true. else false
0=ZEQUALSif TOS = 0 replace TOS with true. else replace with false
U<ULESSremove TOS. if 2OS < TOS replace 2O with true. else false

Flow Control

ForthMacroDescription
BEGINBEGINplace current IP on the return stack
UNTILUNTILremove TOS. if TOS = 0 then jump to TORS, else remove TORS
EXECUTEEXECUTEremove TOS, place IP on the return stack and jump to TOS
EXITEXITremove and jump to TORS
DODOremove TOS and 2OS. place IP, TOS and 2OS on the return stack
IIplace the inner loop index on the stack
JJplace the outer loop index on the stack
LOOPLOOPadd 1 to 2ORS. if <> TORS go to 3ORS, else drop TORS, 2ORS and 3ORS

Output

ForthMacroDescription
U.UDOTremove TOS and display as an unsigned base 10 number
SPACESPACEdisplay a space
CRCRdisplay a newline character
EMITEMITremove and display TOS

Stack Manipulation

ForthMacroDescription
DROPDROPremove TOS
DUPDUPplace a copy of TOS on the stack
OVEROVERplace a copy of 2OS on the stack. implemented as 1 PICK
PICKPICKreplace TOS with a copy of the TOSth stack item
SWAPSWAPexchange TOS and 2OS. implemented as 1 ROLL
ROTROTrotate TOS, 2OS and 3OS, moving 3OS to TOS. implemented as 2 ROLL
ROLLROLLremove TOS and rotate TOS stack items, moving the deepest to TOS
DEPTHDEPTHplace the size of the stack on the stack
?DUPQDUPif TOS <> 0, place a copy of TOS on the stack

Miscellaneous

ForthMacroDescription
LITLITplace a copy of the next value in the program on the stack
LITPLITPadjust the next value to be relative to IP then place on stack
R@RFETCHplace a copy of TORS on the stack
R>RFROMremove TORS and place on the stack
>RTORremove 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:

01

Next, lit 20 lit 0 places 20, 0 on the stack:

01200

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:

01

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:

10

Then over places a copy of the second element onto the stack:

101

plus add the top element to the second element, then removes the top element:

11

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