Execute Brain****/Retro
Executing Brain**** in Retro is currently a two part task. First, there is a compiler, and secondly you need to run the compiled code.
<lang Retro>( 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, ;
( Setup target memory for new image ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ) here [ !target ] [ !origin ] bi MAX-APP-SIZE allot jump, 0 m, pad reset
( Support functions: basic input, output, and data pointer support )
- wait
#0 #0 out, wait, ret,
- bye
#-9 #5 out, ret,
- dp 32768 m,
- bf_>
dp # @, 1+, dp # !, ret,
- bf_<
dp # @, 1-, dp # !, ret,
- bf_+
dp # @, @, 1+, dp # @, !, ret,
- bf_-
dp # @, @, 1-, dp # @, !, ret,
- bf_.
dp # @, @, #1 #2 out, call wait #0 #3 out, ret,
- bf_,
#1 #1 out, call wait #1 in, dp # @, !, ret,
( Actual BrainF*** compiler ) variable ip
- run
t-here putn space @ip @ putc cr @ip @ ip ++ [ '> = ] [ drop bf_> m, ] when [ '< = ] [ drop bf_< m, ] when [ '+ = ] [ drop bf_+ m, ] when [ '- = ] [ drop bf_- m, ] when [ '. = ] [ drop bf_. m, ] when [ ', = ] [ drop bf_, m, ] when [ '[ = ] [ drop t-here dp # @, @, lit, 0 m, =jump, @target 0 m, ] when [ '] = ] [ drop swap jump, m, t-here swap ! ] when drop ;
- do
[ run @ip @ ] while ;
- bf: ( "- )
'~ accept tib keepString !ip cr do ;
( Start Compilation of BrainF*** code after this )
- main</lang>
Apart from support code, the actual compiler is implemented in the run function.
This accepts sources like:
<lang Retro>bf: >+++++++++[<++++++++>-]<.>+++++++[<++++>-]<+.+++++++..+++.[-]>++++++++[<++++>-]~ bf: <.>+++++++++++[<+++++>-]<.>++++++++[<+++>-]<.+++.------.--------.[-]>++++++++[~ bf: <++++>-]<+.[-]++++++++++.~
endApp saveImage</lang>
And upon completion a new appImage file is created. This can be run from the command line, using the --image command line argument:
<lang Retro>./retro --image appImage</lang>