181 lines
5.4 KiB
Forth
181 lines
5.4 KiB
Forth
This is an implementation of the ilo computer. It's written in
|
|
RetroForth. I wrote this mostly to satisfy a personal desire to
|
|
run Konilo under RetroForth.
|
|
|
|
The ilo computer is quite similar to the nga computer that Retro
|
|
runs on. Both are dual stack minimal instruction set computers
|
|
with similar instruction sets. But ilo is, by design, a smaller,
|
|
simpler system.
|
|
|
|
ilo presents the following:
|
|
|
|
- 65,5536 cells of memory
|
|
- 32-bit cells are the only addressable memory unit
|
|
- data stack of 32 values
|
|
- address stack of 256 addresses
|
|
- keyboard input
|
|
- serial display
|
|
- block storage
|
|
- blocks are 1,024 cells in size
|
|
- 30 instructions
|
|
|
|
|
|
# Memory And Loading The ROM
|
|
|
|
A standard ilo system will provide exactly 65,536 cells of RAM.
|
|
I create a label pointing to this and allocate the space.
|
|
|
|
~~~
|
|
'IMAGE d:create #65536 allot
|
|
~~~
|
|
|
|
On startup, ilo loads a ROM (typically named "ilo.rom") into
|
|
memory. This will always be a full memory image, so the size
|
|
will be 65,536 cells. Loading this takes advantage of Retro's
|
|
`block:` vocabulary, reading in the ROM as a series of 64 1K
|
|
blocks. Doing this is significantly faster than reading the
|
|
ROM in byte by byte and assembling the bytes into cells.
|
|
|
|
~~~
|
|
:load-image (s-)
|
|
block:set-file
|
|
#64 [ I IMAGE I #1024 * + block:read ] indexed-times ;
|
|
|
|
'ilo.rom load-image
|
|
~~~
|
|
|
|
# Stacks & Registers
|
|
|
|
I create labels and allocate space for the two stacks. And also
|
|
create registers for the stack pointers and instruction pointer.
|
|
Using these, I then implement several words for moving values
|
|
to and from these. The `>s` and `s>` operate on the data stack
|
|
whereas `>r` and `r>` operate on the address stack.
|
|
|
|
It'd be faster to just use the RetroForth stacks directly, but
|
|
this is cleaner and less error prone. It also makes debugging
|
|
easier as the ilo stacks are now separate entities.
|
|
|
|
The last thing I define here is `[IP]`, which returns the value
|
|
in memory at the instruction pointer. This is strictly for
|
|
readability and could be inlined in the two places it's used.
|
|
|
|
~~~
|
|
'DataStack d:create #33 allot
|
|
'ReturnStack d:create #257 allot
|
|
|
|
'SP var
|
|
'RP var
|
|
'IP var
|
|
|
|
:>s (n-) &DataStack @SP + store &SP v:inc ;
|
|
:s> (-n) &SP v:dec &DataStack @SP + fetch ;
|
|
:>r (n-) &ReturnStack @RP + store &RP v:inc ;
|
|
:r> (-n) &RP v:dec &ReturnStack @RP + fetch ;
|
|
|
|
:[IP] IMAGE @IP + fetch ;
|
|
~~~
|
|
|
|
# A Utility Word
|
|
|
|
RetroForth doesn't have a word to directly compare two blocks
|
|
of memory. Until I rectify this, I define one here.
|
|
|
|
~~~
|
|
:compare (sdl-f)
|
|
#-1 swap
|
|
[ [ dup-pair &fetch bi@ eq? ] dip and [ &n:inc bi@ ] dip ]
|
|
times &drop-pair dip ;
|
|
~~~
|
|
|
|
# The ilo Instructions
|
|
|
|
Now I'm ready to implement the ilo instruction set. I chose to
|
|
follow my (very) similar approach from retro-extend(1) and the
|
|
Autopsy debugger. This creates one word per instruction and then
|
|
fills in a jump table of pointers.
|
|
|
|
If you are familiar with Retro, it should be pretty easy to
|
|
follow these. Mostly just move values onto the RetroForth stack,
|
|
do an operation, then put results back.
|
|
|
|
The longest one of these is the I/O instruction, which has 8
|
|
possible actions. I implemented this using a `case` structure.
|
|
|
|
~~~
|
|
:i:no ;
|
|
:i:li &IP v:inc [IP] >s ;
|
|
:i:du s> dup >s >s ;
|
|
:i:dr s> drop ;
|
|
:i:sw s> s> swap >s >s ;
|
|
:i:pu s> >r ;
|
|
:i:po r> >s ;
|
|
:i:ju s> n:dec !IP ;
|
|
:i:ca @IP >r i:ju ;
|
|
:i:cc s> s> [ >s i:ca ] &drop choose ;
|
|
:i:cj s> s> [ >s i:ju ] &drop choose ;
|
|
:i:re r> !IP ;
|
|
:i:eq s> s> eq? >s ;
|
|
:i:ne s> s> -eq? >s ;
|
|
:i:lt s> s> swap lt? >s ;
|
|
:i:gt s> s> swap gt? >s ;
|
|
:i:fe s> IMAGE + fetch >s ;
|
|
:i:st s> s> swap IMAGE + store ;
|
|
:i:ad s> s> + >s ;
|
|
:i:su s> s> swap - >s ;
|
|
:i:mu s> s> * >s ;
|
|
:i:di s> s> swap /mod swap >s >s ;
|
|
:i:an s> s> and >s ;
|
|
:i:or s> s> or >s ;
|
|
:i:xo s> s> xor >s ;
|
|
:i:sl s> s> swap n:abs n:negate shift >s ;
|
|
:i:sr s> s> swap n:abs shift >s ;
|
|
:i:cp s> s> s> [ IMAGE + ] bi@ 'abc 'cba reorder compare >s ;
|
|
:i:cy s> s> s> [ IMAGE + ] bi@ 'abc 'cba reorder copy ;
|
|
:i:io s>
|
|
#0 [ s> c:put ] case
|
|
#1 [ c:get >s ] case
|
|
#2 [ s> s> swap IMAGE + block:read ] case
|
|
#3 [ s> s> swap IMAGE + block:write ] case
|
|
#4 [ dump-stack ] case
|
|
#5 [ #-1 !IP ] case
|
|
#6 [ #65536 !IP ] case
|
|
#7 [ @SP >s @RP >s ] case
|
|
drop ;
|
|
|
|
'Instructions d:create
|
|
&i:no , &i:li , &i:du , &i:dr , &i:sw , &i:pu ,
|
|
&i:po , &i:ju , &i:ca , &i:cc , &i:cj , &i:re ,
|
|
&i:eq , &i:ne , &i:lt , &i:gt , &i:fe , &i:st ,
|
|
&i:ad , &i:su , &i:mu , &i:di , &i:an , &i:or ,
|
|
&i:xo , &i:sl , &i:sr , &i:cp , &i:cy , &i:io ,
|
|
~~~
|
|
|
|
# Instruction Processor
|
|
|
|
~~~
|
|
{{
|
|
:mask #255 and ;
|
|
:next #8 shift ;
|
|
---reveal---
|
|
:unpack (n-dcba)
|
|
dup mask swap next
|
|
dup mask swap next
|
|
dup mask swap next
|
|
'abcd 'dcba reorder ;
|
|
}}
|
|
|
|
:process-opcodes (n-)
|
|
unpack
|
|
&Instructions + fetch call
|
|
&Instructions + fetch call
|
|
&Instructions + fetch call
|
|
&Instructions + fetch call ;
|
|
|
|
:process (-)
|
|
[ [IP] process-opcodes &IP v:inc @IP #0 #65535 n:between? ] while ;
|
|
|
|
'ilo.blocks block:set-file
|
|
|
|
process
|
|
~~~
|