mikpa@massormetrix.ida.liu.se (Mikael Patel) (08/16/89)
After some discussions and help of Mitch Bradley (wmb@Sun.COM) and Peter
da Silva (peter@ficc.uu.net) the Minimal Forth Machine is down to nine
instructions. Three stack instructions may be added when considering
hardware structures as they are implict in the basic set.
With this tiny set of instructions a Forth environment can be built;
may it be virtual on an other processor or directly in hardware.
Some interesting observation are:
1. The machine does not have a branch instruction.
2. The machine has only three basic functions.
3. All instructions can be realized so that they only take one
clock cycle. Even memory access!
4. The time complexity of the arithmetric operations are:
+ ( x y -- z) O(y)
- ( x y -- z) O(y)
* ( x y -- z) O(x*y)
/ ( x y -- z) O(x/y)
So the time to perform arithmetric operations is proportional to
the operation and the operands. Very human :-).
Below follows a description of the Machine in a toy hardware language
and Forth definitions for:
1. Stack manipulation
2. Logical operations
3. Arithmetric operations
4. Control structures
5. Some system dependent words
The description of the physical machine is 16-bit and the code has been
tested on a 32-bit Forth-83 environment.
Mikael R.K. Patel
Researcher and Lecturer
Computer Aided Design Laboratory
Department of Computer and Information Science
Linkoeping University, S-581 83 LINKOEPING, SWEDEN
-----8<-----8<-----8<-----8<-----8<-----8<-----8<-----8<-----8<-----
( The required set of primitives, Mikael Patel, 1989)
>r ( x -- )
r> ( -- x)
1+ ( x -- y)
0= ( x -- flag)
nand ( x y -- z)
@ ( addr -- x)
dup! ( x addr -- x)
execute ( addr -- )
exit ( -- )
( May be included because of hardware considerations)
drop ( x -- )
dup ( x -- x x)
swap ( x y -- y x)
( The structure of the minimal machine, Mikael Patel, 1989)
16 constant bits/word ( Bits per word)
bits/word bus b0 ( Bus 0)
bits/word bus b1 ( Bus 1 )
bits/word register ir ( Instruction register)
bits/word register tos ( Top of stack)
bits/word register ip ( Instruction pointer)
16 bits/word stack st ( Parameter stack)
16 bits/word stack rt ( Return stack)
wr bits/word port ma ( Port for address to memory)
rd/wr bits/word port md ( Port for data to and from memory)
( A simple register transfer language)
fetch ( -- )
ip -> b0, ( Fetch next instruction)
b0 -> ma,
md -> b1,
b1 -> ir ( Put into decode register)
* ( Execute instruction)
ip + 1 -> ip ( And incremenent instruction pointer)
drop ( x -- )
st -> b1, ( Pop parameter stack into tos)
b1 -> tos
dup ( x -- x x)
tos -> b0, ( Push tos onto parameter stack)
b0 -> st
swap ( x y -- y x)
tos -> b0, ( Exchange contents of tos and)
b0 -> st, ( parameter stack)
st -> b1,
b1 -> tos
>r ( x -- )
tos -> b0, ( Pop tos to return stack)
b0 -> rt,
st -> b1,
b1 -> tos
r> ( -- x)
tos -> b0, ( Pop return stack to tos)
b0 -> st,
rt -> b1,
b1 -> tos
unary ( x -- y)
f(tos) -> tos ( Perform operation on tos)
1+ ( x -- y)
0= ( x -- flag)
binary ( x y -- z)
st -> b1, ( Perform operation on tos and)
b1 -> f(st, tos) -> tos ( top of parameter stack)
nand ( x y -- z)
@ ( addr -- x)
c@ ( addr -- x)
tos -> b0, ( Access memory port and read)
b0 -> ma,
md -> b1,
b1 -> tos
dup! ( x addr -- x)
dupc! ( x addr -- x)
tos -> b0, ( Access memory port and write)
b0 -> ma,
st -> b1, ( Pop one parameter)
b1 -> tos, md
call ( -- )
ip -> b0, ( Push old instruction pointer)
b0 -> rt, ( And branch to new one)
ir -> b1,
b1 -> ip
exit ( -- )
rt -> b1, ( Pop old instruction pointer)
b1 -> ip
( Stack operations with a small set of primitives, Mikael Patel, 1989)
: rot ( x y z -- y z x)
>r swap r> swap ;
: over ( x y -- x y x)
>r dup r> swap ;
: ?dup ( x -- [0] or [x x])
dup if dup then ;
: r@ ( -- n)
r> dup >r ;
( Logical words using a small set of primitive, Mikael Patel, 1989)
: not ( x -- y)
dup nand ;
: and ( x y -- z)
nand not ;
: or ( x y -- z)
not swap not nand ;
: xor ( x y -- z)
over over not nand >r
swap not nand
r> nand ;
( Comparision operations with a small set of primitives, Mikael Patel, 1989)
: 0< ( n -- flag)
min-int and 0= not ; ( Check the sign bit)
: 0> ( n -- flag)
dup 0< swap 0= or not ; ( Check not negative and not zero)
: = ( x y -- flag)
- 0= ; ( Subtract and check against zero)
: < ( x y -- flag)
- 0< ; ( Subtract and check against zero)
: > ( x y -- flag)
- 0> ; ( Subtract and check against zero)
: d< ( dx dy -- flag)
dnegate d+ swap drop 0< ; ( Subtract and check against zero)
: boolean ( n -- flag)
0= not ; ( Check not zero)
( Arithmetric operations with a small set of primitives, Mikael Patel, 1989)
: negate ( x -- y)
not 1+ ;
: 1- ( x -- y)
not 1+ not ;
: 2+ ( x -- y)
1+ 1+ ;
: 2- ( x -- y)
not 1+ 1+ not ;
: abs ( x -- y)
dup 0< ( Check if less than zero)
if negate then ; ( Then negate)
: + ( x y -- z)
begin
dup ( Check if there is still more to do)
while
dup 0< ( Check direction)
if 1+ swap 1- swap ( Decrement and increment)
else
1- swap 1+ swap ( Increment and decrement)
then
repeat
drop ; ( Drop counter)
: - ( x y -- z)
negate + ; ( Negate and add)
: d+ ( lx hx ly hy -- lz hz)
>r rot swap ( Save high part of hy)
begin
dup ( Check if there is still more to do)
while
1- swap 1+ swap ( Decrement and increment)
over 0= ( Check for carry)
if rot 1+ rot rot then ( Increment high word)
repeat
drop ( Drop counter)
swap r> + swap ; ( Add high words)
: dnegate ( dx -- dy)
not swap not swap ( Complement double number)
1 0 d+ ; ( And add one)
: min ( x y -- z)
over over > ( Compare the two numbers)
if swap then ( If greater then swap)
drop ; ( And drop)
: max ( x y -- z)
over over < ( Compare the two numbers)
if swap then ( If less then swap)
drop ; ( And drop)
: * ( x y -- z)
dup ( Check not zero)
if over 0< over 0< xor >r ( Calculate sign of result)
0 rot abs rot abs ( Make absolute values)
begin
dup ( Check if there is still more to do)
while
swap rot over + ( Add to accumulator)
swap rot 1- ( and decrement counter)
repeat
drop drop ( Drop temporary parameters)
r> if negate then ( Check sign and return)
else
swap drop ( Return zero)
then ;
: 2* ( x -- y)
2 * ; ( Two times)
: /mod ( x y -- r q)
dup
if over 0< >r ( Save sign of divident)
over 0< over 0< xor >r ( Save sign of result)
0 rot abs rot abs ( Create accumlator and inital values)
begin
swap over - dup 0< not ( Calculate next reminder)
while
swap rot 1+ ( Increment quotient)
rot rot ( And put back into order)
repeat
+ swap ( Restore reminder)
r> if negate then ( Check sign and negate if needed)
r> if swap negate swap then ( Check sign of reminder)
then ;
: / ( x y -- q)
/mod swap drop ; ( Do it and drop reminder)
: mod ( x y -- r)
/mod drop ; ( Do it and drop quotient)
: 2/ ( x -- y)
2 / ; ( Divide by two)
: sqr ( x -- x**2)
dup * ; ( Multply with its self)
: fac ( n -- n!)
dup 0> ( Check if end of iteration)
if dup 1- recurse * ( Decrement and go again)
else
drop 1 ( Drop parameter and return 1)
then ;
: sqrt ( x -- x**1/2)
1 11 0 do ( Newton's method-type algorithm)
over over / + 2/ ( Guess one and divide successive)
loop ( values)
swap drop ; ( Drop temporary value and return)
( Control structures with a small set of primitives, Mikael Patel, 1989)
: >mark ( -- addr)
here 0 , ; ( Save position and make place)
: >resolve ( addr -- )
here swap ! ; ( Store branch address)
: if ( flag -- )
compile (?branch) >mark ; immediate ( Compile conditional branch forward)
: else ( -- )
compile (branch) >mark ( Compile branch forward)
swap >resolve ; immediate ( Access old branch offset and resolve)
: then ( -- )
>resolve ; immediate ( Resolve forward branch)
: <mark ( -- addr)
here ; ( Save pointer for backwards branch)
: <resolve ( addr -- )
, ; ( Store branch address)
: begin ( -- )
<mark ; immediate ( Mark beginning of block)
: again ( -- )
compile (branch) ( Compile a backward branch)
<resolve ; immediate ( And resolve branch address)
: until ( flag -- )
compile (?branch) ( Compile a conditional branch)
<resolve ; immediate ( And resolve branch address)
: while ( flag -- )
compile (?branch) ( Compile a conditional brach forward)
>mark ; immediate ( And make address)
: repeat ( -- )
swap ( Access block start)
compile (branch) ( Compile a backward branch)
<resolve ( And resolve branch address)
>resolve ; immediate ( And resolve forward branch address)
Now for the fun part. The minimal machine DOES NOT require a
branch instruction. It may be defined using logical operators.
( System dependent definitions, Mikael Patel, 1989)
0 constant 0 ( A bit crazy but...)
1 constant 1 ( ...you an't seen nothing yet)
-1 constant true ( The truth)
0 constant false ( And whats not)
0 constant nil ( Nil pointer)
04 constant bytes/word ( Memory words size in bytes)
32 constant bits/word ( Bits per word)
-2147483648 constant min-int ( Just for simplicity!!)
2147483647 constant max-int
: word+ ( n -- m)
1+ 1+ 1+ 1+ ; ( Increment to next word)
: thread ( addr -- )
, ; ( Thread the given address)
: unthread ( addr1 -- addr2)
@ ; ( Access threaded pointer)
: (literal) ( -- n)
>r dup word+ >r @ ; ( Access literal number)
: (branch) ( -- )
r> @ >r ; ( Fetch branch address and go to it)
: (?branch) ( flag -- )
0= dup r@ @ and ( Fetch branch address and mask)
swap not r> word+ and or >r ; ( Create skip address and select)