refill.ft

target definitions

target -1 CONSTANT SRC-EVALUATE
target  0 CONSTANT SRC-KEYBOARD

\ REFILL is vectored based on the SOURCE-ID. Replace these vectors with
\ platform-specific ones as needed.
\ There's room for -2 through +5.
host definitions

1 tcellbits  1- lshift                 CONSTANT top-bit
1 tcellbits  lshift 1- invert   -1 and CONSTANT signed-mask

\ Properly sign-extends a target signed number into a host signed number,
\ should the host's integers be wider than the target's.
: signed ( tn -- n ) dup top-bit and IF signed-mask or THEN ;

: hex.s ( -- ) base @ >R   hex .s   R> base ! ;

target definitions
CREATE refillers 8 cells allot
: refiller ( src-id -- 'refiller-xt ) 2 + cells refillers + ;
  host acts: signed 2 + tcells [T'] refillers t>body + ;
target

: REFILL ( -- ? ) source-id refiller @ execute ;

\ Refill for keyboard: ACCEPT a complete line.
:noname ( -- ? )
  tib 128 accept ( u )
  0 >IN !   tib swap 'SOURCE 2! \ Set it up as the new input
  state @ 0= IF bl emit THEN    \ If interpreting, append a space separator.
  -1 ; src-keyboard refiller ! \ And return true

\ Refill for EVALUATE: just return 0.
:noname 0 ; src-evaluate refiller !

\ HACK: Do not call +SRC or -SRC directly; they are tightly coupled and must
\ be called with care. Use evaluate or (evalmany).
target : +SRC ( i*x src-id -- j*x )
  R> ( src-id ret )
  'source 2@ >R >R   >IN @ >R   source-id >R
  10000 >IN !   swap 'source-id !
  ( ret ) >R ;

target : -SRC ( -- )
  R> ( ret ) R> 'source-id !   R> >IN !   R> R> 'source 2!   >R ;

target : EVALUATE   ( ... c-addr u -- ... )
  src-evaluate +SRC   'source 2!   0 >IN !   interpret -SRC ;

host presume (quit)

\ Begins with REFILL, so doesn't expect an existing string.
target : (EVALMANY) ( ... src-id -- ... ) +SRC (quit) -SRC ;