Not logged in

Artifact 4351abf99759aeb822ebf158eba6032c6b98ed70

File langs/assembler.rx part of check-in [537872ae2e] - continue replacing elements with variables| by crc on 2011-12-07 12:34:14. [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 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
variables| 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

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                                          |
+==========+===========+================================================+
| nop,     | ``-``     | Ngaro instruction                              |
+----------+-----------+------------------------------------------------+
| lit,     | ``-``     | Ngaro instruction                              |
+----------+-----------+------------------------------------------------+
| dup,     | ``-``     | Ngaro instruction                              |
+----------+-----------+------------------------------------------------+
| drop,    | ``-``     | Ngaro instruction                              |
+----------+-----------+------------------------------------------------+
| swap,    | ``-``     | Ngaro instruction                              |
+----------+-----------+------------------------------------------------+
| push,    | ``-``     | Ngaro instruction                              |
+----------+-----------+------------------------------------------------+
| pop,     | ``-``     | Ngaro instruction                              |
+----------+-----------+------------------------------------------------+
| loop,    | ``-``     | Ngaro instruction                              |
+----------+-----------+------------------------------------------------+
| jump,    | ``-``     | Ngaro instruction                              |
+----------+-----------+------------------------------------------------+
| ret,     | ``-``     | Ngaro instruction                              |
+----------+-----------+------------------------------------------------+
| >jump,   | ``-``     | Ngaro instruction                              |
+----------+-----------+------------------------------------------------+
| <jump,   | ``-``     | Ngaro instruction                              |
+----------+-----------+------------------------------------------------+
| !jump,   | ``-``     | Ngaro instruction                              |
+----------+-----------+------------------------------------------------+
| =jump,   | ``-``     | Ngaro instruction                              |
+----------+-----------+------------------------------------------------+
| @,       | ``-``     | Ngaro instruction                              |
+----------+-----------+------------------------------------------------+
| !,       | ``-``     | Ngaro instruction                              |
+----------+-----------+------------------------------------------------+
| +,       | ``-``     | Ngaro instruction                              |
+----------+-----------+------------------------------------------------+
| -,       | ``-``     | Ngaro instruction                              |
+----------+-----------+------------------------------------------------+
| *,       | ``-``     | Ngaro instruction                              |
+----------+-----------+------------------------------------------------+
| /mod,    | ``-``     | Ngaro instruction                              |
+----------+-----------+------------------------------------------------+
| and,     | ``-``     | Ngaro instruction                              |
+----------+-----------+------------------------------------------------+
| or,      | ``-``     | Ngaro instruction                              |
+----------+-----------+------------------------------------------------+
| xor,     | ``-``     | Ngaro instruction                              |
+----------+-----------+------------------------------------------------+
| <<,      | ``-``     | Ngaro instruction                              |
+----------+-----------+------------------------------------------------+
| >>,      | ``-``     | Ngaro instruction                              |
+----------+-----------+------------------------------------------------+
| 0;       | ``-``     | Ngaro instruction                              |
+----------+-----------+------------------------------------------------+
| 1+,      | ``-``     | Ngaro instruction                              |
+----------+-----------+------------------------------------------------+
| 1-,      | ``-``     | Ngaro instruction                              |
+----------+-----------+------------------------------------------------+
| in,      | ``-``     | Ngaro instruction                              |
+----------+-----------+------------------------------------------------+
| out,     | ``-``     | Ngaro instruction                              |
+----------+-----------+------------------------------------------------+
| wait,    | ``-``     | Ngaro instruction                              |
+----------+-----------+------------------------------------------------+
| :main    | ``-``     | Main entry point                               |
+----------+-----------+------------------------------------------------+
| #        | n-        | Compile a number as a literal                  |
+----------+-----------+------------------------------------------------+
| __#      | $-        | Prefix; compile a number as a literal          |
+----------+-----------+------------------------------------------------+
| $,       | $-        | Compile a string to the target buffer          |
+----------+-----------+------------------------------------------------+
| __:      | $-        | Prefix; create a label                         |
+----------+-----------+------------------------------------------------+
| call     | "-        | Compile a call to a label                      |
+----------+-----------+------------------------------------------------+
| jump     | "-        | Compile a jump to a label                      |
+----------+-----------+------------------------------------------------+
| saveImage| ``-``     | Save the target buffer to *appImage*           |
+----------+-----------+------------------------------------------------+
| t-here   | -n        | Current address in target buffer               |
+----------+-----------+------------------------------------------------+
| endApp   | ``-``     | End assembly and exit                          |
+----------+-----------+------------------------------------------------+

}doc