interact.mu4

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

loading PIC18 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    ( - dp)
chat-cmd t.run           ( pc dp)
chat-cmd t.read-space    ( buf a u space)
chat-cmd t.write-data    ( buf a u)
chat-cmd t.write-eeprom  ( buf a u)
chat-cmd t.app-start
chat-cmd t.app-stop
chat-cmd t.flash-begin
chat-cmd t.flash-end
chat-cmd t.erase         ( a)
chat-cmd t.program       ( buf a u)
drop

( Choose a memory space based on current host region.)
: choose-space
   h preserve
   'aspace  flash 'aspace = if 0 ^ then  ( flash)
                               1 ;       ( ram/data)

: t.read       ( buf a u)  choose-space t.read-space ;
: t.read-data  ( buf a u)             1 t.read-space ;

: >image   ['] read-host-image  ( read from memory image)      du-target ;
: >chat    ['] 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)

: copy-chunk  ( 'target len - 'target+len)
   | cr ." copy-chunk "  2dup swap u. u.
   2dup + push  over image+ -rot t.write-data  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
   ram-copied @  dup 0= if  drop  \m origin  then
   \m here  over -  copy-region
   \m here  ram-copied ! ;

defer verify-quietly  ( - diff)

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

: chat-via   pop  chat-vector !  hi ;


: 2sp  space space ;
: 4#   # # # # ;
: .h16    hex  <#  4#  #> type ;
: .w   .h16  2sp ;
: .r   ( addr)  @  .w ;


| Since the PIC18 has a *hardware* return stack, we are only going to
| define the boundaries of the data stack.
|
| Put the D stack at the end of ram, for now - leaving one cell of space
| for the use of chat.

@ram #ram +  \m cell-  constant dp0

| We'd like numbers that the target would consider negative to be negative
| on the host stack as well. So let's sign extend stack values when they
| come back from the target.
|
| XXX At the moment, the common stack code doesn't use this, but it should!

: t>h  ( n - n')  ( "target to host")  dup "8000 and if  "1_0000 -  then ;

: stack-write  t.write-data ;
: stack-read   t.read-data ;

ld target/common/stacks.mu4

: run      ( pc)           copy-ram  dp@  t.run ;  ( don't wait for target)
: runwait  ( pc)  run  t.get-status  dp! ;               ( wait for target)


| Set |@ and |c@ to _some_ form of target fetch. Prefer to get bytes from
| target if we're connected. This word is useful so we can set an initial
| state for target's  du  and  dis  so that inspect won't crash when it
| runs |@ to get a default ea.

: >target  chatting @ if  >chat ^  then  >image ;


| Define our own key bindings for memory dumping and disassembly. We'll
| default to host bindings if there isn't one in our array. This way we
| only have to define the "delta" between host and target behaviours.

128 array pic-seekeys

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

( Support for dumping memory)
: 1dump  ( a)
   hex-bytes  ( set field width)
   >image   dup .addr  dup .hex-bytes
   chatting @ if
      -valid
      >chat   dup _addr  dup .hex-bytes
      -valid
   then
   drop ( a) ;

( So we can easily look at the signature embedded into the image.)
: 1dump-chars  ( a)
   hex-bytes
   >target
   dup _addr  dup .chars
   dup .addr  dup .hex-bytes
   drop ;

pic-seekeys  -1  du-mode dumping        >target  skip+  skip-  1dump        ( a - a')
pic-seekeys  -1  du-mode dumping-chars  >target  skip+  skip-  1dump-chars  ( a - a')
pic-seekeys  -1  du-mode disasming      >target  dis+   dis-   1dis         ( a - a')

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

key: d  ( a - a 0)   dumping        0 ;
key: C  ( a - a 0)   dumping-chars  0 ;  ( small c is "call")
key: i  ( a - a 0)   disasming      0 ;

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


( Interactive)

meta
: du   ( a - a')   dumping    inspect ;
: dis  ( a - a')   disasming  inspect ;

forth