\
\    Mecrisp-Across - A Forth cross compiler for small MSP430 microcontrollers
\    Copyright (C) 2016  Matthias Koch
\
\    This program is free software: you can redistribute it and/or modify
\    it under the terms of the GNU General Public License as published by
\    the Free Software Foundation, either version 3 of the License, or
\    (at your option) any later version.
\
\    This program is distributed in the hope that it will be useful,
\    but WITHOUT ANY WARRANTY; without even the implied warranty of
\    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
\    GNU General Public License for more details.
\
\    You should have received a copy of the GNU General Public License
\    along with this program.  If not, see <http://www.gnu.org/licenses/>.
\


\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\  5. Teil: Disassembler zum Anschauen, ob auch alles stimmt.
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

\ -------------------------------------------------------------
\  Disassembler
\ -------------------------------------------------------------

\ 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.

0 variable disasm-$   \ Current position for disassembling

: disasm-fetch        \ ( -- Data ) Fetches opcodes and operands, increments disasm-$
    disasm-$ @ image@  \             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 ;

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

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

: disasm-source   \ Takes care of source operands
                  \ Kümmert sich um den Quelloperanden des Befehls !
                  ( Opcode Source-Reg -- Opcode )

  over ( Opcode Source-Reg Opcode )  
  dup $0040 and if ." .b " else ." .w " then

  $0030 and
  case
    $0000 of \ Register
            case
              3 of 0 disasm-const endof   \ CG
              dup register.
            endcase
          endof

    $0010 of \ Indexed
            case
              2 of ." &" disasm-fetch u.h endof \ SR
              3 of 1 disasm-const endof         \ CG

              dup disasm-fetch u.h ." (" register. ." )"
            endcase
          endof

    $0020 of \ Indirect
            case
              2 of 4 disasm-const endof \ SR
              3 of 2 disasm-const endof \ CG

              dup ." @" register.
            endcase
          endof

    $0030 of \ Indirect Autoincrement
             \ sr: 8 cg: -1 pc: Constant   All others: @rx+
            case
              2 of  8           disasm-const endof \ SR
              3 of $FFFF        disasm-const endof \ CG
              0 of disasm-fetch disasm-const endof \ PC

              dup ." @" register. ." +"
            endcase
          endof
  endcase
;

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

    dup $000F and 2 =
    if \ SR - Absolute addressing
      drop disasm-fetch ." &" u.h
    else \ Normal Indexed
      disasm-fetch u.h ." (" $000F and register. ." )"
    then

  else  \ Register Destination
    $000F and register.
  then
;

: disasm-single ( Opcode -- )
    dup $0F80 and
    case
      $0000 of ." rrc"  endof
      $0080 of ." swpb" endof
      $0100 of ." rra"  endof
      $0180 of ." sxt"  endof
      $0200 of ." push" endof
      $0280 of ." call" endof
      $0300 of ." reti" endof

      ." Unknown Opcode "
    endcase

  dup $000F and \ Mask Source Register
  ( Opcode Source-Reg )
  disasm-source
  ( Opcode )

  drop
;

: disasm-double ( Opcode -- )
  dup $0F00 and 8 rshift \ Mask Source Register
  ( Opcode Source-Reg )
  disasm-source
  ( Opcode )
  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  ( Opcode Instruction-Mask )
  case
     $1000 of          disasm-single endof
     $2000 of          disasm-jumps  endof
     $3000 of          disasm-jumps  endof
     $4000 of ." mov"  disasm-double endof
     $5000 of ." add"  disasm-double endof
     $6000 of ." addc" disasm-double endof
     $7000 of ." subc" disasm-double endof
     $8000 of ." sub"  disasm-double endof
     $9000 of ." cmp"  disasm-double endof
     $A000 of ." dadd" disasm-double endof
     $B000 of ." bit"  disasm-double endof
     $C000 of ." bic"  disasm-double endof
     $D000 of ." bis"  disasm-double endof
     $E000 of ." xor"  disasm-double endof
     $F000 of ." and"  disasm-double endof

     ." Unknown Opcode " drop
  endcase
;

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

: disasm-step ( -- )
    disasm-$ @                 \ 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
;

: seec ( -- ) \ Continues to see
  base @ hex cr

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

  base !
;

: disimage ( -- )
  base @ hex cr

  flashstart disasm-$ !
  begin    
    disasm-$ @ image@ $4130 =     \ ret
    disasm-$ @ image@ $1300 = or  \ reti
      disasm-step
    if cr then
    
    disasm-$ @ org @ u>=    
  until

  base !
  
  speicherbedarf
;

\ -----------------------------------------------------------------------------
\   Intel HEX output
\ -----------------------------------------------------------------------------

: u.4 ( u -- ) 0 <# # # # # #> type ;
: u.2 ( u -- ) 0 <# # # #> type ;

: hexdump ( -- ) \ Dumps complete Flash
  ( cr ) hex

  flashend flashstart
  do
    \ Check if it would be $FFFF only:
    0                    \ Not worthy to print
    i #16 + i do          \ Scan data
      i imagec@ $FF <> or  \ Set flag if there is a non-$FF byte
    loop

    if
      ." :10" i u.4 ." 00" \ Write record-intro with 4 digits.
      $10                   \ Begin checksum
      i          $FF and +   \ Sum the address bytes 
      i 8 rshift $FF and +    \ separately into the checksum

      i #16 + i do
        i imagec@ u.2 \ Print data with 2 digits
        i imagec@ +    \ Sum it up for Checksum
      loop

      negate u.2  \ Write Checksum
      cr
    then

  #16 +loop
  ." :00000001FF" cr
  decimal
;


\ -----------------------------------------------------------------------------
\   Flash crosscompiled image to target
\ -----------------------------------------------------------------------------

\ Nur zum Testen ohne echte JTAG-Verbindung:
\ : writeflash ( x addr -- ) hex. hex. cr ;
\ : jtag-t@ ( addr -- x ) $FFFF or ;

: flashtarget ( -- )
  jtag? @ not if ." JTAG-Connection required." cr quit then

  erasetarget

  \ Write target
  
  flashend flashstart do
    i image@ $FFFF <> if i image@ i writeflash then  
  2 +loop   
  
  \ Verify target memory
  
  flashend flashstart do
     i jtag-t@   i image@  2dup <> if ." Memory verify error at " i hex. ." : Image: " hex. ." Target: " hex. cr else 2drop then     
  2 +loop
  
  \ Fine.
;

