interact.mu4

| This file is part of muforth: https://muforth.dev/
|
| Copyright 2002-2024 David Frech. (Read the LICENSE for details.)

loading ARM v6-M interaction

variable chatting

variable chat-vector
: chat-cmd   ( index - index+1)  dup  cells constant  1+
             does> @  chat-vector @ =if  +  @execute  ^  then  2drop
                error" Not connected to a chat-capable target" ;

: chat-fail   error" Chat command not implemented" ;

0
chat-cmd t.hello    ( - chunk-size)
chat-cmd t.get-status   ( - #retries sp pc)
chat-cmd t.run      ( pc sp)
chat-cmd t.read     ( buf a u)
chat-cmd t.write    ( buf a u)
chat-cmd t.flash-begin
chat-cmd t.flash-end
chat-cmd t.erase    ( a)
chat-cmd t.program  ( buf a u)
drop

: >image
   ['] image-@  is |@   ( fetch from host memory image)
   ['] read-host-image  ( read from host memory image)  du-target ;

-:  ( target - word)  pad swap 4  t.read  pad lew@ ;
: >chat
   [ #]         is |@   ( fetch from connected target)
   ['] t.read           ( read from connected target)  du-target ;

| Chunk size is reported by the debug interface. Always use this when
| copying RAM contents or programming the flash!

variable /chunk  ( chunk size, as reported by debug interface)
   256 /chunk !  ( sane default)

: copy-chunk  ( 'target len - 'target+len)
   | cr ." copy-chunk "  2dup swap u. u.
   2dup + push  over image+ -rot t.write  pop ;

: copy-region  ( a u)
   | cr ." copy-region "  2dup swap u. u.
   /chunk @  /mod ( r q)  swap push  for   /chunk @  copy-chunk  next
                                    pop  =if  ( rem) copy-chunk  drop ^  then  2drop ;

variable ram-copied  ( pointer to first un-copied byte)

: copy-ram
   h preserve  ram  \m align ( make sure ram region is aligned before copying)
   ram-copied @  dup 0= if  drop  region drop  then
   \m here  over -  copy-region
   \m here  ram-copied ! ;

| Define local copies of target registers. Before executing code on the
| target, we "push" these values to the target, and after executing code,
| we "pull" the new values. We used the local, cached values when printing
| the registers with .regs .

( Name these so they don't conflict with assembler names.)
variable tsp    ( target SP)
variable trp    ( target RP)
variable tip    ( target IP)
variable tix    ( target loop index counter)

( Count of retries before get-status got a response from the target.)
variable #retries

: get-regs  ( ignoring PC right now)  t.get-status  drop  tsp !  #retries ! ;

: 2sp   space space ;
: .h32     radix preserve  hex  <#  4#               4#  #> type ;
: .h16_16  radix preserve  hex  <#  4#  char _ hold  4#  #> type ;

: .h32__     .h32    2sp ;
: .h16_16__  .h16_16 2sp ;

: .tr   ( variable)  ( "target register")  @ .h32__ ;
defer .regs   now nope is .regs  ( print nothing by default)

defer verify-quietly  ( - diff)

: hi
   chatting on  >chat  t.hello  /chunk !  get-regs  .regs
   ram-copied off  copy-ram
.ifndef noverify  verify-quietly drop  .then
   now __chatting is __meta  __meta ;

: chat-via   pop  chat-vector !  hi ;


: run      ( pc)  copy-ram  tsp @  t.run ;  ( don't wait for target)
: runwait  ( pc)  run  get-regs ;           ( wait for target)

( For running random bits of code.)
: call     ( pc)  runwait  .regs ;


| Because the target "caches" the top of the stack in a register, and
| because the trampoline code loads this register before execution, and
| pushes it afterward, we can deal only with the "memory image" of the target
| stack, rather than also worrying about what to put into the "top" register.
|
| What's a bit mystifying at first is that, to achieve a target stack depth
| of N, the host has to push N+1 items. The top one goes into top; and the
| bottom-most one is the "sentinel" value that gets loaded into top when the
| stack becomes empty.
|
| When pushing from the host, or when "pulling" from the target, we don't
| move more than 8 "user" items - but we pad this value a bit, since we are
| also using the stack to pass some execution context between host and
| target.

| Traditional Forth stack layout:
|
| User area    higher memory
| R stack
| D stack      lower memory
|
| Bottom of user area is also RP0. User area contains SP0 and SP. RP is
| pushed onto D stack in pause/yield.
|
| Let's do a similar thing - with R stack at higher memory - to ease the
| transition to a tasking version.

meta
@ram #ram +            constant rp0   ( R stack is at the end of RAM)
\m rp0  #64 \m cells - constant sp0   ( D stack is *below* R stack)

: depth   \m sp0  tsp @ -  \m cell/  1- ;
forth

| stack> *first* builds a local image of the target stack - in the RAM
| image - and *then* copies it, in one chunk, to the target.

: stack>  ( "push" stack to target)
   depth 0 max 12 min
   \m sp0  over 1+  \m cells -  dup tsp ! ( top of D stack)  swap
   for  tuck image-!  \m cell+  next  ( copy each cell as a word to D stack)
   "decafbad swap image-! ( sentinel)
   tsp @ image+  tsp @  \m sp0  over -  t.write  ( copy stack image to target) ;

| stack< *first* copies the target stack, in one chunk, to the host's RAM
| image, and *then* pulls the values out and pushes them onto the host's stack.

: stack<  ( "pop" stack from target)
   \m depth 0 max 12 min  =if
      push
      tsp @ image+  tsp @  r@ \m cells  t.read  ( read target stack)
      pop
      tsp @  over  ( n sp n)
      for  dup image-@  pop 2push  \m cell+  next ( starting with top, push to R)
      drop ( sp)
      for  2pop push  next  ( pop from R to reverse order)
      0
   then  drop ;

| Target always starts by executing the code at continue-forth, with SP
| pointing to the data stack, which contains both the data to be consumed,
| and the "Forth VM" context.
|
| When first executing a word, the host sets things up like this:
|    IP = trampoline
|    RP = bottom of R stack ie, empty R stack
|
| When instead continuing execution - perhaps inside a loop that contains a
| call to bug - the host sets things up like this:
|    IP = saved IP
|    RP = saved RP

: ?chat
   chatting @ 0= if  error" not connected to target"  then ;

( These are implement'ed by the kernel code.)
meta
variable continue-forth
variable trampoline
forth

( NOTE: For initial execution of a Forth word, xn is cfa!)
: continue  ( x0 .. xn ip rp ix - y0 .. yn ip rp ix)
   ?chat
   stack>  p@ continue-forth runwait  stack<
   tix !  trp !  tip !  .regs ;

meta
: cont    ( )     ( continue forth execution)
   tip @  trp @  tix @  ( ip rp ix)  continue ;
forth

( Set rp to rp0, ix to 0, and ip to trampoline.)
-: ( cfa)  ( execute target forth word)
   p@ trampoline  \m rp0  0  ( ip rp ix)  continue ;  is remote


128 array cortex-seekeys

( Default key action is to run host key code)
host-seekeys cortex-seekeys  128 cells cmove

: >target
   chatting @ if   >chat  ^  then  >image ;  ( set up memory access)

( Support for dumping memory)
: 1dump  ( a)
   hex-bytes
   | dup  p !  cell*  ea !  ( default ea: fetch cell)
   dup  p !  cell*  -4 and  ea !  ( default ea: fetch cell and round down)
   dup _addr  dup .chars
   dup .addr  dup .hex-bytes
   dup _addr  dup .hex-cells
   drop ;

| Cross-ref image and target. Print line of image memory, then line of
| target memory.

: 1xref  ( a)
   hex-bytes
   >image    dup .addr  dup .hex-cells
   chatting @ if
      -valid
      >chat  dup _addr  dup .hex-cells
      -valid
   then
   drop ;


( Support for interactive decompiling.)
: dec+  ( a - a' 0)   4 advance  0 ;
: dec-  ( a - a' 0)  -4 advance  0 ;

defer 1smart-dec
defer 1smart-dis

cortex-seekeys  -4  du-mode dumping       >target  skip+  skip-  1dump
cortex-seekeys  -4  du-mode decompiling   >target  dec+   dec-   1smart-dec
cortex-seekeys  -4  du-mode xrefing       >target  skip+  skip-  1xref
cortex-seekeys  -2  du-mode disasming     >target  dis+   dis-   1smart-dis


meta
variable target-do-colon
variable target-do-const
variable target-do-var
forth

: .target-code  ( a)
   p !  cell*  ( code field)  -2 and  ( remove thumb bit)
   0 disasming drop
   dup                  p @ = if  drop  ." code "      ^  then
   0 decompiling drop ( start decompiling a colon definition)
   dup \m target-do-colon @ = if  drop  ." : "         ^  then
   dup \m target-do-const @ = if  drop  ." constant "  ^  then
   dup \m target-do-var   @ = if  drop  ." variable "  ^  then
   .hcell_  ." (unknown code field) " ( print value and mark as "unknown") ;

: 1dec  ( a)
   dup .addr .nesting space
   p !  cell*  dup .hcell_
   dup -4 and ea !  ( default ea: fetch cell and round down)
   dup .target-runtime. find-constant-chained if
     .target space  drop ^  then
   equate?  if  .equate space  then ;

: ?switch  ( a - a | <nothing> )
   dup  p !  cell*  ea !  ( default ea: fetch cell)
   dup .target-runtime. find-constant-chained if  push ( 'link)
      dup .addr .nesting space
      .target-code  pop .target space  shunt  ^  then ;

| Generic decompiler. Switches modes any time a target word points to
| current address.
-: ( a)  ?switch  1dis ;  is 1smart-dis
-: ( a)  ?switch  1dec ;  is 1smart-dec

cortex-seekeys 'seekeys !    ( switch over to our bindings)

key: d  ( a - a 0)   dumping      0 ;
key: e  ( a - a 0)   decompiling  0 ;  ( XXX 'f'? ':'? )
key: x  ( a - a 0)   xrefing      0 ;
key: i  ( a - a 0)   disasming    0 ;

| Fetch a vector and start disassembling the code it points to. Treat it
| like a "call" - key c - and push the i-stack.

key: v  ( 'vector - vector 0)  dup  p !  cell*  i-push  disasming  0 ;

host-seekeys 'seekeys !  ( back to host bindings)


( Interactive)

( Host du available as \f du)
meta
: du   ( a - a')   dumping      inspect ;
: dis  ( a - a')   disasming    inspect ;
: dec  ( a - a')   decompiling  inspect ;
forth


( Batch mode)
( Redirect to stdout to make it easier to write output to a file.)
defer dump-line
: batch-dump  ( start limit cfa)  is dump-line
   >target  ( XXX should this be >image ?)
   out-channel preserve  >stdout
   radix preserve
   istack-depth preserve  istack-depth off
   begin  swap  dump-line drop  swap  2dup u< 0=  until  2drop ;

( XXX create/does> instead?)
-: ( a - a' 0)  dup 1dump  16 advance  0 ;
: dumps  ( start limit)   [ #]  batch-dump ;

-: ( a - a' 0)  dup 1dis   dis+ ;
: disses  ( start limit)  [ #]  batch-dump ;