Artifact 530c1e56818e6be5d4d5df6c37f3505fe5952136
File langs/assembler.rx part of check-in [d844f9fff0] - add assembler, brainf*** compiler by charleschilders on 2011-05-31 03:24:50. [annotate]
( Ngaro Assembler ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( Copyright [c] 2008 - 2011, Charles Childers )
( Copyright [c] 2009 - 2010, Luke Parrish )
( Copyright [c] 2010, Marc Simpson )
( Copyright [c] 2010, Jay Skeer )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
8000 constant MAX-APP-SIZE
( Assembler ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
3 elements target origin fid
: pad ( - ) @origin 32 + !target ;
: m, ( n- ) @target !+ !target ;
: vm: ( n"- ) ` : .data ` m, ` ; ;
0 vm: nop, 1 vm: lit, 2 vm: dup,
3 vm: drop, 4 vm: swap, 5 vm: push,
6 vm: pop, 7 vm: loop, 8 vm: jump,
9 vm: ret, 10 vm: >jump, 11 vm: <jump,
12 vm: !jump, 13 vm: =jump, 14 vm: @,
15 vm: !, 16 vm: +, 17 vm: -,
18 vm: *, 19 vm: /mod, 20 vm: and,
21 vm: or, 22 vm: xor, 23 vm: <<,
24 vm: >>, 25 vm: 0; 26 vm: 1+,
27 vm: 1-, 28 vm: in, 29 vm: out,
30 vm: wait,
: t-here ( -n ) @target @origin - ;
{{
: writeByte ( n- )
@fid ^files'write drop ;
: applyMask ( n- )
%00000000000000000000000011111111 and ;
: writeCell ( n- )
dup applyMask writeByte
8 >> dup applyMask writeByte
8 >> dup applyMask writeByte
8 >> applyMask writeByte ;
---reveal---
: saveImage ( - )
"appImage" ^files':W ^files'open !fid
@origin t-here [ @+ writeCell ] times drop
@fid ^files'close drop bye ;
}}
: endApp ( - )
t-here "\nApp ends @ %d\n" puts
MAX-APP-SIZE t-here - "%d cells free" puts
depth 1 >= [ "\nError in stack depth!: " puts .s ] ifTrue ;
: :main ( - ) t-here [ "\nMAIN @ %d" puts ] [ @origin 1+ ! ] bi ;
: # ( n- ) lit, m, ;
: __# ( $- ) lit, toNumber m, ; parsing
: $, ( $- ) withLength [ @+ m, ] times 0 m, drop ;
: __: ( $- ) header t-here @last !d->xt ; parsing
: call ( "- ) ' m, ;
: jump ( "- ) 8 m, ' m, ;
{{
: cond ( -a ) @target 0 m, ;
---reveal---
: =if ( -a ) !jump, cond ;
: <if ( -a ) >jump, cond ;
: >if ( -a ) <jump, cond ;
: !if ( -a ) =jump, cond ;
: then ( a- ) t-here swap ! ;
}}
: jump: ( "- ) jump, ' m, ;
: repeat ( -a ) t-here ;
: again ( a- ) jump, m, ;
( Setup target memory for new image ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
here [ !target ] [ !origin ] bi MAX-APP-SIZE allot
jump, 0 m, pad
reset
doc{
===============
Ngaro Assembler
===============
--------
Overview
--------
This is an assembler for the Ngaro instruction set. It is intended to be the
first in a series of small tools to help target other languages to the Ngaro
virtual machine.
---------
Functions
---------
+----------+-----------+------------------------------------------------+
| Name | Stack | Usage |
+==========+===========+================================================+
}doc