
compiletoflash

: ( [char] ) parse drop immediate ;  (  Forth-Style-Comment )
: { [char] } parse drop immediate ;  { Pascal-Style-Comment }
: \        0 parse drop immediate ;  \ Comment till end of line 

: 0-foldable $40 setflags immediate ;
: 1-foldable $41 setflags immediate ;
: 2-foldable $42 setflags immediate ;
: 3-foldable $43 setflags immediate ;

32 constant bl
: cr    10 emit ;
: space bl emit ;
: spaces 0 ?do space loop ;

$20 constant P1IN
$21 constant P1OUT
$22 constant P1DIR
$23 constant P1IFG
$24 constant P1IES
$25 constant P1IE
$26 constant P1SEL
$27 constant P1REN

\ Just in case if you don't have it already in your flash...


\ MSP430 Disassembler, Copyright (C) 2011  Matthias Koch
\ This is free software under GNU General Public License v3.
\ Knows MSP430 machine instructions, resolves call entry points and handles inline strings.
\ Usage: Specify your target address in disasm-$ and give disasm-step some calls.


\ Magic numbers inside:
\    Memory locations: $208 Variable for Link to latest definition
\                      $8000 Start of Flash-Dictionary
\                      $DD0C First definition in core
\                      $ED8C Runtime of ."
\                      $ED5C Runtime of s"
\    True magic:       $12B0 call opcode
\                      $4130 ret opcode

: name. ( Address -- ) \ Wenn die Adresse der Code-Anfang eines Dictionarywortes ist, wird es benannt.
  >r                   \ If the address is Code-Start of a dictionary word, it gets named.

  \ Catch dictionary entry point
  here $8000 u>= if $dd0c else $208 @ then

  begin        ( name-field-address R: wanted-code-address )
    1+         \ Skip Flags
    dup        ( name-field-address name-field-address )
    skipstring \ Skip string that contains name
               ( name-field-address link-field-address )

    dup 2+ r@ = if swap ."   --> " type else swap drop then

    @ dup $FFFF = \ Check if link points to another definition or into free space.
  until

  r> 2drop
;

0 variable disasm-$   \ Current position for disassembling

: disasm-fetch        \ ( -- Data ) Fetches opcodes and operands, increments disasm-$
    disasm-$ @ @      \             Holt Opcode oder Operand, incrementiert disasm-$
  2 disasm-$ +!   ;

: u.4 0 <# # # # # #> type ;
: u.ns 0 <# #s #> type ;
: u.h u.ns ." h";
: register. ." r" decimal u.ns hex ;
: disasm-const ." #" u.h ;
 
\ The following all enter with ( Opcode -- Opcode )

: disasm-jumps   \ Bei Sprüngen ist bereits alle Information im Opcode enthalten.
  dup $1C00 and  \ Jumps have all information readily in their opcodes.
  
  dup $0000 = if ." jnz " then
  dup $0400 = if ." jz "  then
  dup $0800 = if ." jnc " then
  dup $0C00 = if ." jc "  then
  dup $1000 = if ." jn "  then
  dup $1400 = if ." jge " then
  dup $1800 = if ." jl "  then
      $1C00 = if ." jmp " then

  \ Calculate Offset
  dup $03FF and   
    dup $0200 and if $FC00 or then
  shl disasm-$ @ +   u.4
;

: disasm-wordorbyte dup $0040 and if ." .b " else ." .w " then ;

0 variable source-reg
: get-source-reg source-reg @ ;

0 constant reg-pc
2 constant reg-sr
3 constant reg-cg

: disasm-source   \ Takes care of source operands 
                  \ Kümmert sich um den Quelloperanden des Befehls !

  dup $0030 and $0000 = if  \ Register
    get-source-reg reg-cg = 
    if 0 disasm-const else get-source-reg register. then
  then

  dup $0030 and $0010 = if \ Indexed
    get-source-reg reg-sr = if ." &" disasm-fetch u.h exit then
    get-source-reg reg-cg = if 1 disasm-const exit then
    get-source-reg disasm-fetch u.h ." (" register. ." )"      
  then  

  dup $0030 and $0020 = if \ Indirect
    get-source-reg reg-sr = if 4 disasm-const exit then
    get-source-reg reg-cg = if 2 disasm-const exit then
    get-source-reg ." @" register.
  then  

  dup $0030 and $0030 = if \ Indirect Autoincrement
    \ sr: 8 cg: -1 pc: Constant   All others: @rx+
    get-source-reg reg-sr = if  8           disasm-const exit then
    get-source-reg reg-cg = if -1           disasm-const exit then
    get-source-reg reg-pc = if disasm-fetch disasm-const exit then
    get-source-reg ." @" register. ." +"    
  then  
;

: disasm-destination \ Takes care of destination operands in two-operand-instructions
  ." , "             \ Kümmert sich um den Zieloperanden bei zwei-Operanden-Befehlen.
  dup $0080 and
  if  \ Indexed Destination

    dup $000F and reg-sr =
    if \ SR - Absolute addressing
      disasm-fetch ." &" u.h
    else \ Normal Indexed
      disasm-fetch u.h ." (" dup $000F and register. ." )"
    then
 
  else  \ Register Destination
    dup $000F and register.
  then
;

: disasm-string ( -- ) \ Takes care of an inline string
  disasm-$ @ dup type skipstring disasm-$ !
;

: disasm-single
    dup $0F80 and

    dup $0000 = if ." rrc"  then
    dup $0080 = if ." swpb" then
    dup $0100 = if ." rra"  then
    dup $0180 = if ." sxt"  then
    dup $0200 = if ." push" then
    dup $0280 = if ." call" then
        $0300 = if ." reti" then

  disasm-wordorbyte
  dup $000F and source-reg !
  disasm-source 

  \ Bei Call-Befehlen versuchen, den Einsprung zu benennen und Strings zu erkennen.
  \ Try to give calls a name and detect inline strings.
  dup $12B0 = if 
    disasm-$ @ 2- @  \ Fetch call target address
    dup name. \ Try to give it a name
    dup $ED8C = if ."    .' " disasm-string ." '" then \ It is ." ?
        $ED5C = if ."    s' " disasm-string ." '" then \ It is .s ?
  then
;

: disasm-double 
    disasm-wordorbyte   
    dup $0F00 and 8 rshift source-reg !
    disasm-source 
    disasm-destination 
;

: disasm ( -- )    \ Disassembles one machine instruction and advances disasm-$
  disasm-fetch     \ Fetch Opcode and test instruction type. 
                   \ Opcode holen und auf Befehlstyp hin prüfen.
  
  dup $F000 and >r  ( Opcode R: Instruction mask )

  r@ $0000 = if ." Unknown Opcode " then
  r@ $1000 = if disasm-single then
  r@ $2000 = if disasm-jumps then
  r@ $3000 = if disasm-jumps then
  r@ $4000 = if ." mov"  disasm-double then
  r@ $5000 = if ." add"  disasm-double then
  r@ $6000 = if ." addc" disasm-double then
  r@ $7000 = if ." subc" disasm-double then
  r@ $8000 = if ." sub"  disasm-double then
  r@ $9000 = if ." cmp"  disasm-double then
  r@ $A000 = if ." dadd" disasm-double then
  r@ $B000 = if ." bit"  disasm-double then
  r@ $C000 = if ." bic"  disasm-double then
  r@ $D000 = if ." bis"  disasm-double then
  r@ $E000 = if ." xor"  disasm-double then
  r> $F000 = if ." and"  disasm-double then

  ( Opcode R: ) drop
;

: memstamp \ ( Addr -- ) Shows a memory location nicely
    dup u.4 ." : " @ u.4 ."   " ;

: disasm-step ( -- )
    disasm-$ @ ( AlterStand )  \ Note current position                                
    dup memstamp disasm cr     \ Disassemble one instruction
        
    begin \ Write out all disassembled memory locations
      2+ dup disasm-$ @ <> 
    while
      dup memstamp cr
    repeat
    drop
;

: see \ Takes name of definition and shows its contents from beginning to first ret
  base @ hex cr
  
  ' disasm-$ !

  begin
    disasm-$ @ @ $4130 =  \ Flag: Loop terminates with ret
    disasm-step
  until

  base !
;
