CoreForth-0

p3216/tether.ft.md


variable tether-fd
variable tether-buf
variable (meta-wordlist)
variable (target-wordlist)
variable (host-wordlist)
variable trom
variable tcell
variable #target
variable #target-shadow
variable target#

: >tether-byte  $FF and tether-buf tuck c! 1 tether-fd @
                write-file abort" failed to write" ;
: tether-byte>  tether-buf dup 1 tether-fd @
                read-file abort" failed to read"
                0= abort" read zero bytes"
                c@ ;

: >tether-word  tether-buf tuck ! 4 tether-fd @
                write-file abort" failed to write" ;

: tether-word>  tether-buf dup 4 tether-fd @
                read-file abort" failed to read"
                0= abort" read zero bytes"
                @ ;

: tether-store  tether-word> tether-word> swap ! ;
: tether-fetch  tether-word> @ >tether-word ;
: tether-number tether-word> ;
: tether-exec   tether-word> execute ;

: tether-cmd    dup [char] ! = if drop tether-store false exit then
                dup [char] @ = if drop tether-fetch false exit then
                dup [char] # = if drop tether-number false exit then
                [char] X = if tether-exec false exit then
                true
                ;

: tether-listen (pty) dup tether-fd ! (sink-id) !
                begin tether-byte> tether-cmd 4 >tether-byte until
                tether-fd @ close-file throw ;

: open          2 open-file abort" failed to open port"
                dup tether-fd !
                cf-make-raw abort" failed to set raw mode"
                ;

: await-done    begin tether-byte> dup 4 <> while emit repeat drop ;

: send-delta    target# @ 0 do
                  #target-shadow @ i + @ #target @ i + @ 2dup <> if
                    i hex. space 2dup swap hex. space hex. cr
                    [char] ! >tether-byte
                    trom @ i + >tether-word
                    >tether-word
                    await-done
                    drop
                  else 2drop
                  then
                tcell @ +loop
                ;

: reset-delta   #target @ #target-shadow @ target# @ cmove ;

: is-meta?      (meta-wordlist) @ search-wordlist ;
: is-target?    (target-wordlist) @ search-wordlist ;
: is-host?      (host-wordlist) @ search-wordlist ;

: target-execute
                [char] X >tether-byte
                >tether-word
                await-done
                ;
: target-number ?number 0= if drop [char] ? emit cr exit then
                [char] # >tether-byte
                >tether-word
                await-done
                ;

: do-meta       magenta +fg-color execute -fg-color ;
: do-target     >body @ target-execute ;
: do-host       blue +fg-color execute -fg-color ;

: handle-word   dup count is-meta? if do-meta drop exit then
                dup count is-target? if do-target drop exit then
                dup count is-host? if do-host drop exit then
                target-number
                ;

: shadow.       #target-shadow @ 40 dumpw ;
: target.       #target @ 40 dumpw ;
: untether      bye ;

: set-wordlists ( host-wordlist target-wordlist meta-wordlist -- )
                rot dup (host-wordlist) !
                rot dup (target-wordlist) !
                rot dup (meta-wordlist) !
                3 set-order
                order
                ;

: set-shadow    ( #target target# org cell# -- )
                tcell !
                trom !
                here #target-shadow ! dup target# ! allot
                #target !
                $12000 target# !
                ;

: tether-connect   ( #port port# speed #target target# org cell# host-wordlist target-wordlist meta-wordlist -- )
                0 (source-id) !   1 (sink-id) !
                set-wordlists
                set-shadow
                >r 2dup open r> tether-fd @ set-speed abort" failed to set line speed"
                cr ." Tethered to " type cr
                begin
                  reset-delta
                  refill space while
                  begin bl word dup c@ while handle-word repeat drop
                  send-delta
                  ." ok " .s cr
                repeat
                tether-fd @ close-file drop
                quit
                ;