: stdout ' putc task-emit ! ;
s" forp.log" open const LOGFILE
: log-emit LOGFILE fputc ;

2 const cell
: cells cell * ;

key ) const ')'

10 const '\n'
key  const sp

: cr '\n' emit ;
: bl sp emit ;

: if ' BZ_ , here 0 , ; immediate
: else ' GOTO_ , 0 , here swap ! here cell - ; immediate
: then here swap ! ; immediate

: begin here ; immediate
: while ' BZ_ , here 0 , ; immediate
: repeat ' GOTO_ , swap , here swap ! ; immediate
: again ' GOTO_ , , ; immediate
: until ' BZ_ , , ; immediate

: ( begin key ')' = until ; immediate

: 2dup over over ;

: decompile
  word lookup if 1 begin ( cp i )
    2dup cells + @ ( cp i @cp+i )
    dup ' ret != ( cp i @cp+i bool )
  while
    dup ` dup if type drop else drop . then bl ( cp i )
    1 + ( cp i+1 )
  repeat drop drop then drop ;

: lit ' LIT_ , , ;

( tasks )
: mailbox 2 cells + ;
: task-ip task-user-size cells + ;
: task-sp task-user-size 1 + cells + ;
: task-rsp task-user-size 2 + cells + ;
: task-stack task-user-size 3 + cells + ;
: task-rstack task-stack stacksize cells + ;

: doactivate ( task ip -- )
  over task-ip !
  dup task-stack over task-sp !
  dup task-rstack over task-rsp !
  drop
;

: activate
  here 4 cells + lit
  ' doactivate ,
  ' ret ,
; immediate

: send ( val task -- )
  mailbox
  begin dup @ while suspend repeat ( wait for empty mailbox )
  ! ;

: receive ( -- val )
  running mailbox
  begin dup @ not while suspend repeat ( wait for mail )
  dup @ 0 rot ! ;