Host ———————————————————————

::host::

:noname     t, ; is t,call
:noname     $0f2c th, $000c th, $0c0d th, $0030 th, t,next ; is t,docon
:noname     $f92c th, $0000 th, ; is t,enter
:noname     s" exit" tfwdref ; is t,exit
:noname     $ea0c th, $0020 th, $fe03 th, $0000 th, ; is t,next
:noname     s" lit" tfwdref ; is t,lit
:noname     s" branch" tfwdref ; is t,branch
:noname     s" ?branch" tfwdref ; is t,?branch
:noname     talign
            there tlast @ t, tlast !
            $0000000080 t,
            there >target pack$ c@ 1+ tallot talign ; is thead
:noname     tlast @ tcell + dup t@ $40 or swap t! ; is timmediate
:noname     tcell + tcell + dup tc@ + taligned ; is tlink>
:noname     s" (does>)" tfind t, ; is t,dodoes
:noname     ; is t,docode

$00000000 to trom
$00000000 to tram
        4 to tcell

trom tdp !
tram tvp !

$80 torg

Target ——————————————————————-

::target::

$4000 buffer:  rsp
there constant r0
$4000 buffer:  psp
there constant s0

$40 constant init-latest
$44 constant init-dp

primitives.ft

../common/core.ft

input-output.ft

../common/strings.ft

../common/dictionary.ft

../common/output.ft

../common/input.ft

: .s sp@ begin dup s0 <> while dup @ u. cell+ repeat drop ;

../common/exception.ft

search-ext.ft

compiler.ft

../common/control-flow.ft

../common/interpret.ft

$ffffffff constant max-uint
$7fffffff constant max-int
$80000000 constant min-int
$7fffffff constant mid-uint
$80000000 constant mid-uint+1

: m*            u* s>d ;
: um*           u* s>d ;

: */            >r m* r> sm/rem swap drop ;
: */mod         >r m* r> sm/rem ;

: setup-pointers    init-latest @ forth-wordlist !
                    init-dp @ dp !
                    only forth definitions
                    ;

: cold          0 state ! 0 handler !
                0 include-stack# !
                0 (source-id) !   1 (sink-id) !
                setup-pointers
                hex
                argc @ 2 > if
                  2 arg included
                else
                  ." CoreForth p3216 ready" cr
                  abort
                then
                ;

::host::

variable hex-fd

#target #16 tcell * 0 fill

#09: ‘docol #10: IP #11: RSP #12: PSP #13: Flags #14: W

$60                     #09 tcell * t!
$ffffffff               #10 tcell * t!
t' r0 4 tcell * + t@    #11 tcell * t!
t' s0 4 tcell * + t@    #12 tcell * t!
t' cold                 #14 tcell * t!
t' cold                 #15 tcell * t!

tlast @ $40 t!
tdp @   $44 t!

t' docol $60 t!
t' docon $64 t!
t' dovar $68 t!
t' dodoes $6C t!

#target hex. space there hex. space there >target hex. space
tlast @ hex. space tdp @ hex. cr

: save-bin          s" p3216.bin" w/o create-file throw >r
                    #target there r@ write-file throw
                    r> close-file throw ;

::untethered:: save-bin

::tethered:: : start-tether
::tethered::   meta-wordlist hex. cr target-wordlist hex. cr forth-wordlist hex. cr
::tethered::   tether-port dup c@ 0= if drop exit then
::tethered::   count #115200
::tethered::   #target target# trom tcell
::tethered::   forth-wordlist target-wordlist meta-wordlist
::tethered::   tether-connect ;

::tethered:: start-tether