82 lines
1.6 KiB
Plaintext
Executable file
82 lines
1.6 KiB
Plaintext
Executable file
: stdout ' putc task-emit ! ;
|
|
s" forp.log" open const LOGFILE
|
|
: log-emit LOGFILE fputc ;
|
|
|
|
stdout
|
|
' log-emit task-echo !
|
|
|
|
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 ! ;
|
|
|
|
|
|
: start-repl activate
|
|
stdout
|
|
' log-emit task-echo !
|
|
begin receive loadstring again ;
|
|
task const REPL
|
|
|
|
REPL start-repl |