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

\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\  0. Teil: Portumleitungen in echte Hardware über JTAG
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

\ Variablen

true variable TCLK-state

\ ------------------------------------------------------------------------------
: ClrSBWTDIO  SBWDATO JTAGOUT bic! ;
: SetSBWTDIO  SBWDATO JTAGOUT bis! ;
: ClrSBWTCK   SBWCLK  JTAGOUT bic! ;
: SetSBWTCK   SBWCLK  JTAGOUT bis! ;
\ -----------------------------------------------------------------------------

: TMSL   SBWDATO JTAGOUT bic!
         SBWCLK  JTAGOUT bic!
         SBWCLK  JTAGOUT bis! ;

: TMSH   SBWDATO JTAGOUT bis!
         SBWCLK  JTAGOUT bic!
         SBWCLK  JTAGOUT bis! ;

: TMSLDH SBWDATO JTAGOUT bic!
         SBWCLK  JTAGOUT bic!
         SBWDATO JTAGOUT bis!
         SBWCLK  JTAGOUT bis! ;

: TDIL   SBWDATO JTAGOUT bic!
         SBWCLK  JTAGOUT bic!
         SBWCLK  JTAGOUT bis! ;

: TDIH   SBWDATO JTAGOUT bis!
         SBWCLK  JTAGOUT bic!
         SBWCLK  JTAGOUT bis! ;

\ ------------------------------------------------------------------------------
: TDOsbw SBWDATO JTAGDIR bic!
         SBWCLK  JTAGOUT bic!
         SBWCLK  JTAGOUT bis!
         SBWDATO JTAGDIR bis! ;

: TDOrd  SBWDATO JTAGDIR bic!
         SBWCLK  JTAGOUT bic!
         SBWDATI JTAGIN  bit@
         SBWCLK  JTAGOUT bis!
         SBWDATO JTAGDIR bis! ;
\ ------------------------------------------------------------------------------

: TMSL_TDIL  TMSL TDIL TDOsbw ;
: TMSH_TDIL  TMSH TDIL TDOsbw ;
: TMSL_TDIH  TMSL TDIH TDOsbw ;
: TMSH_TDIH  TMSH TDIH TDOsbw ;

\ ------------------------------------------------------------------------------

: TMSL_TDIH_TDOrd  TMSL TDIH TDOrd ;
: TMSL_TDIL_TDOrd  TMSL TDIL TDOrd ;
: TMSH_TDIH_TDOrd  TMSH TDIH TDOrd ;
: TMSH_TDIL_TDOrd  TMSH TDIL TDOrd ;

\ -----------------------------------------------------------------------------
: ClrTCLK ( -- )

  TCLK-state @ if TMSLDH else TMSL then
  ClrSBWTDIO
  TDIL
  TDOsbw
  false TCLK-state !
;

\ -----------------------------------------------------------------------------
: SetTCLK ( -- )

  TCLK-state @ if TMSLDH else TMSL then
  SetSBWTDIO
  TDIH
  TDOsbw
  true TCLK-state !
;

\ -----------------------------------------------------------------------------
: Shift ( Hinaus Anzahl -- Hinein )

  0 do ( Bitmuster )
    \ MSB rausrotieren
    dup $8000 and if TMSL_TDIH_TDOrd else TMSL_TDIL_TDOrd then
    ( Bitmuster Frisch-Eingegangenes-Bit )
    1 and swap shl or
  loop

  \ Das letzte Bit noch behandeln:
  dup $8000 and if TMSH_TDIH_TDOrd else TMSH_TDIL_TDOrd then
  1 and swap shl or

  TMSH_TDIH
  TCLK-state @ if TMSL_TDIH else TMSL_TDIL then

  \ JTAG FSM = Run-Test/Idle

  $FFFF and
;

\ -----------------------------------------------------------------------------
: DR_Shift ( Hinaus -- Hinein )

    \ JTAG FSM state = Run-Test/Idle
  TCLK-state @ if TMSH_TDIH else TMSH_TDIL then
    \ JTAG FSM state = Select DR-Scan
  TMSL_TDIH
    \ JTAG FSM state = Capture-DR
  TMSL_TDIH
    \ JTAG FSM state = Shift-DR, Shiftin TDI (16 bit)
  15 Shift
;

\ -----------------------------------------------------------------------------
: IR_Shift ( Hinaus -- Hinein )

    \ JTAG FSM state = Run-Test/Idle
  TCLK-state @ if TMSH_TDIH else TMSH_TDIL then
    \ JTAG FSM state = Select DR-Scan
  TMSH_TDIH
    \ JTAG FSM state = Select IR-Scan
  TMSL_TDIH
    \ JTAG FSM state = Capture-IR
  TMSL_TDIH
    \ JTAG FSM state = Shift-IR, Shiftin TDI (8 bit)
  8 lshift 7 Shift
;

\ ------------------------------------------------------------------------------
: SBW_Enter_Sequenz ( -- ) \ Der "Einstieg" in den SBW-Modus

  \ Aus der Pascal-Routine
  ClrSBWTCK
  SetSBWTDIO
  1 ms \ ~ 1 ms, unkritisch
  ClrSBWTDIO
  ClrSBWTCK

  \ SpyBiWire entry sequence
  SetSBWTDIO  \ Reset = 1
  SetSBWTCK   \ TEST pin = 1
  \ initial 1 SBWCLKs to enter sbw-mode
  ClrSBWTCK
  SetSBWTCK
  \ SpyBiWire mode is active now
;


\ -----------------------------------------------------------------------------
: ResetTAP ( -- )

  \ 6 mal.
  TMSH_TDIH
  TMSH_TDIH
  TMSH_TDIH
  TMSH_TDIH
  TMSH_TDIH
  TMSH_TDIH

  \ JTAG FSM is now in Test-Logic-Reset
  TMSL_TDIH \ now in Run/Test Idle

  \ Fuse check
  TMSH_TDIH
  TMSL_TDIH
  TMSH_TDIH
  TMSL_TDIH
  TMSH_TDIH

  \ In every TDI slot a TCK for the JTAG machine is generated.
  \ Thus we need to get TAP in Run/Test Idle state back again.
  TMSH_TDIH
  TMSL_TDIH
;

\ ------------------------------------------------------------------------------
: Clock_PSA_Sequenz ( -- )
  TMSH_TDIL
  TMSL_TDIL
  TMSL_TDIL
  TMSH_TDIL
  TMSH_TDIL
  TMSL_TDIL
;

\ ------------------------------------------------------------------------------
: TCLK-Strobes \ ( Anzahl -- ) Gibt Takt. Und zwar viel.
              \ enters with TCLK-state and exits with TCLK = 1

  \ This function generates Amount strobes with the Flash Timing Generator
  \ Frequency fFTG = 257..476kHz (t = 3.9..2.1us).

  \ So wie es ist, wird momentan 450 kHz generiert. Prima ! Achtung, das war in der Variante ohne Registerallokator.

  TCLK-state @ if TMSLDH else TMSL then

  0 ?do
    ClrSBWTDIO
    SetSBWTDIO
  loop

  TDIH TDOsbw \ ExitTCLK
  true TCLK-state !
;

\ ------------------------------------------------------------------------------
\ Jetzt kommen die Stellen aus Jtag-Funktionen in Pascal.
\ ------------------------------------------------------------------------------

\ Instructions for the JTAG control signal register
$C8 constant IR_CNTRL_SIG_16BIT     \ 0x13 original values
$28 constant IR_CNTRL_SIG_CAPTURE   \ 0x14
$A8 constant IR_CNTRL_SIG_RELEASE   \ 0x15

\ Instructions for the JTAG data register
$82 constant IR_DATA_16BIT          \ 0x41
$42 constant IR_DATA_CAPTURE        \ 0x42
$C2 constant IR_DATA_QUICK          \ 0x43

\ Instructions for the JTAG PSA mode
$22 constant IR_DATA_PSA            \ 0x44
$62 constant IR_SHIFT_OUT_PSA       \ 0x46

\ Instructions for the JTAG address register
$C1 constant IR_ADDR_16BIT          \ 0x83
$21 constant IR_ADDR_CAPTURE        \ 0x84
$A1 constant IR_DATA_TO_ADDR        \ 0x85

\ Bypass instruction
\ $FF constant IR_BYPASS            \ 0xFF

\ JTAG identification value for all existing Flash-based MSP430 devices
$89 constant JTAG_ID

\ ------------------------------------------------------------------------------
: ir-cntrl-sig ( Mode -- )
  IR_CNTRL_SIG_16BIT IR_Shift drop
                     DR_Shift drop
;

: ir-set-address ( Address -- )
    IR_ADDR_16BIT IR_Shift drop
                  DR_Shift drop
;

\ ------------------------------------------------------------------------------
: SetInstrFetch
  \ Probehalber einmal eingefügt. Klappt jetzt alles ?
  $2401 ir-cntrl-sig \ Set device into JTAG mode + read

  IR_CNTRL_SIG_CAPTURE IR_Shift drop
  \ Wait until CPU is in instr. fetch state, timeout after limited attempts

  50 0 do
    $0000 DR_Shift $0080 and 0 <> if unloop exit then
      ClrTCLK
      SetTCLK
  loop
  ." SetInstrFetch failed " quit
;

\ ------------------------------------------------------------------------------
: HaltCPU
    SetInstrFetch                \ Set CPU into instruction fetch mode

    IR_DATA_16BIT IR_Shift drop
    $3FFF DR_Shift drop           \ Send JMP $ instruction
    ClrTCLK
      $2409 ir-cntrl-sig          \ Set JTAG_HALT bit
    SetTCLK
;

\ ------------------------------------------------------------------------------
: ReleaseCPU
    ClrTCLK
      $2401 ir-cntrl-sig  \ Clear the HALT_JTAG bit
      IR_ADDR_CAPTURE IR_Shift drop
    SetTCLK
;

\ ------------------------------------------------------------------------------

: readmembasis
    ClrTCLK
    ir-cntrl-sig   \ Set word/byte read mode
    ir-set-address \ Set address
    IR_DATA_TO_ADDR IR_Shift drop
    SetTCLK

    ClrTCLK
    $0000 DR_Shift   \ Shift out 16 bits
;

: ReadMemWord ( Adresse - Inhalt ) \ Gut !
  $2409 readmembasis \ Set word read
;

: ReadMemByte ( Adresse - Inhalt ) \ Gut !
  $2419 readmembasis \ Set byte read
  $FF and
;

\ ------------------------------------------------------------------------------

: writemembasis
    ClrTCLK
    ir-cntrl-sig           \ Set word/byte write mode
    ir-set-address         \ Set addr
    IR_DATA_TO_ADDR IR_Shift drop
    DR_Shift drop          \ Shift in 16 bits
    SetTCLK
;

: WriteMemWord ( Inhalt Adresse -- ) \ Gut !
  $2408 writemembasis    \ Set word write
;

: WriteMemByte ( Inhalt Adresse -- ) \ Gut !
  $2418 writemembasis    \ Set byte write
;

\ ------------------------------------------------------------------------------
: ExecutePUC
  \ Perform Reset

  $2C01 ir-cntrl-sig  \ Apply Reset
  $2401 ir-cntrl-sig  \ Remove Reset

  ClrTCLK SetTCLK
  ClrTCLK SetTCLK
  ClrTCLK
    IR_ADDR_CAPTURE IR_Shift  \ read JTAG ID, checked at function end
  SetTCLK

  haltcpu
  $5A80 $0120 WriteMemWord \ WriteMem(F_WORD, $0120, $5A80);   \ Disable Watchdog on target device

  JTAG_ID <> if ." ExecutePUC failed " quit then
;

\ ------------------------------------------------------------------------------
: GetDevice ( -- ) \ Gut !

  SBW_Enter_Sequenz
  ResetTAP

  $2401 ir-cntrl-sig \ Set device into JTAG mode + read

  IR_CNTRL_SIG_CAPTURE IR_Shift JTAG_ID <> if ." JTAG-ID invalid " cr quit then

  \ Wait until CPU is synchronized, timeout after a limited # of attempts
  50 0 do \ Maximal 50 Versuche
    0 DR_Shift $0200 and 0 <> if
                                  ." Chip detected: "
                                  $0FF0 ReadMemWord dup $FF and 8 lshift swap 8 rshift $FF and or hex . decimal
                                  leave
                                then
  loop

  ExecutePUC
;

\ ------------------------------------------------------------------------------
\ Registerzugriffe hinein und hinaus, um in den Prozessor zu schauen.

: registerzugriff-init
  SetInstrFetch
  $3401 ir-cntrl-sig \ CPU controls RW & BYTE
  \ Diese Beiden, setinstrfetch und $3401 ir-cntrl-sig, haben probehalber die Plätze getauscht !

  IR_DATA_16BIT ir_shift drop

  \ "sub #8,PC" instruction
  \ PC-8 -> PC
  \ PC is advanced 4 bytes by this instruction
  \ needs 3 clock cycles

  $8030 DR_Shift drop
  SetTCLK ClrTCLK
  $0008 DR_Shift drop
  SetTCLK ClrTCLK
  SetTCLK ClrTCLK
;

: register@ ( Register -- Wert )
  \ reads a register from the target CPU

  registerzugriff-init

  \ "mov Rn,&0x01fe" instruction
  \ Rn -> &0x01fe
  \ PC is advanced 4 bytes by this instruction
  \ needs 4 clock cycles
  \ it's a ROM address, write has no effect, but
  \ the registers value is placed on the databus

  ( Register )
  8 lshift $0F00 and $4082 or DR_Shift drop \ DR_Shift(p, 0x4082 | (((unsigned int)reg << 8) & 0x0f00) )
  SetTCLK ClrTCLK

  $01fe DR_Shift drop
  SetTCLK ClrTCLK
  SetTCLK ClrTCLK
  SetTCLK ClrTCLK

  \ read databus which contains the registers value
  IR_DATA_CAPTURE ir_shift drop
  0 DR_Shift ( Wert )

  $2401 ir-cntrl-sig \ JTAG controls RW & BYTE
;


: register! ( Wert Register -- )
  \ writes a value into a register of the target CPU

  registerzugriff-init

  \ "mov #value,Rn" instruction
  \ value -> Rn
  \ PC is advanced 4 bytes by this instruction
  \ needs 2 clock cycles
  ( Wert Register )

  $000F and
      \ *** dup
  $4030 or DR_Shift drop   \ jtag_DR_Shift(p, 0x4030 | (reg & 0x000f) );

  SetTCLK ClrTCLK

      \ *** ( Wert Register )
      \ *** 0= if 4 - then \ Value for PC has to be 4 less Wirklich ?

  ( Wert )
  DR_Shift drop
  SetTCLK ClrTCLK
  $2401 ir-cntrl-sig \ JTAG controls RW & BYTE
;

\ ------------------------------------------------------------------------------
\ : SetPC-alt ( Adresse -- ) \ Noch vorhanden, kann aber bald entfernt werden.
\
\     SetInstrFetch              \ Set CPU into instruction fetch mode, TCLK=1
\
\     \ Load PC with address
\     $3401 ir-cntrl-sig           \ CPU has control of RW & BYTE.
\     IR_DATA_16BIT IR_Shift drop
\     $4030 DR_Shift drop          \ "mov #addr,PC" instruction
\     ClrTCLK
\     SetTCLK                   \ F2xxx
\     DR_Shift drop             \ "mov #addr,PC" instruction
\     ClrTCLK
\     IR_ADDR_CAPTURE IR_Shift drop
\     SetTCLK
\     ClrTCLK                    \ Now the PC should be on Addr
\
\     $2401 ir-cntrl-sig         \ JTAG has control of RW & BYTE.
\ ;

: SetPC ( Adresse -- ) 0 register! ; \ Viel kürzer

\ ------------------------------------------------------------------------------
: ReleaseDeviceReset ( -- )
  $2C01 ir-cntrl-sig         \ Perform a reset
  $2401 ir-cntrl-sig
  IR_CNTRL_SIG_RELEASE IR_Shift drop
;

\ ------------------------------------------------------------------------------
: ReleaseDevice ( Addresse -- )
  SetPC \ Set target CPU's PC
  IR_CNTRL_SIG_RELEASE IR_Shift drop
;


\ ------------------------------------------------------------------------------
\ Flashzugriffe zum Brennen des Targets

: writeflash ( Data Address -- )
  haltcpu

  $A540 $0128 writememword \ Enable FLASH write in FCTL1
  $A540 $012A writememword \ Select MCLK as source, DIV=1 in FCTL2
  $A500 $012C writememword \ Clear FCTL3
                 \ $A500    \ ok for all devices; if Info-Seg. A on F2xxx should not be programmed
                 \ $A540    \ only if Info-Seg. A on F2xxx should be programmed

              writememword \ Write Data

  ClrTCLK
  IR_CNTRL_SIG_16BIT ir_shift drop
               $2409 dr_shift drop \ Set RW to read

  35 TCLK-Strobes \ Provide TCLKs, min. 33 for F149 and F449.  F2xxx: 29 are ok

  $A500 $0128 writememword \ Disable Flash write in FCTL1
  releasecpu
;

: erasetarget ( -- ) \ Gut, geprüft !

  $A504 $0128 writememword \ Enable main erase mode in FCTL1
  $A540 $012A writememword \ MCLK is source, DIV=1 in FCTL2
  $A500 $012C writememword \ Clear FCTL3; F2xxx: Unlock Info-Seg. A by toggling LOCKA-Bit if required in FCTL3
                           \ A500 ok for all devices; if Info-Seg. A on F2xxx should not be programmed
                           \ A540 only if Info-Seg. A on F2xxx should be programmed

  $55AA $FE00 writememword \ Dummy write to start erase

  10600 TCLK-Strobes \ For fast Flash as in F2xxx devices

  $A500 $0128 writememword \ Lock Flash again by clearing erase bit in FCTL1
;

\ ------------------------------------------------------------------------------

: jtag-t!  haltcpu writememword releasecpu ;
: jtag-tc! haltcpu writemembyte releasecpu ;
: jtag-t@  haltcpu readmemword  releasecpu ;
: jtag-tc@ haltcpu readmembyte  releasecpu ;

\ ------------------------------------------------------------------------------
\ Praktische Helferlein für den Menschen

: connect init-cycles inittarget getdevice haltcpu  ;
: disconnect releasecpu releasetarget   ;

: run ReleasedeviceReset ;

: cont IR_CNTRL_SIG_RELEASE IR_Shift drop ; \ Weitermachen, wo aufgehört wurde.
  \ Alternativ vielleicht 0 ir-cntrl-sig \ Release from JTAG, but without generating a Reset.

: stop
  $2401 ir-cntrl-sig  \ Set device into JTAG mode + read
  haltcpu
  cr
  16 0 do
    ." R" i . ." : " i register@ hex hex. decimal cr
  loop
  \ cr 0 register@ 10 seesome cr \ Disassembliere ein Stückchen weit
;

\ ------------------------------------------------------------------------------

false variable jtag?

: +jtag  ( -- )     connect   true jtag? ! ;
: -jtag  ( -- )  disconnect  false jtag? ! ;

