pete286/defs.jor

55 lines
1.2 KiB
Plaintext
Raw Normal View History

: stdout ' putc task-emit ! ;
s" jorth.log" open const LOGFILE
: log-emit LOGFILE fputc ;
' cells @ const docolon ( get the colon execution token )
: :noname here docolon , ] ;
: 2dup over over ;
2019-02-11 00:17:58 +00:00
: noop ;
2019-02-11 00:17:58 +00:00
: defer word new-word docolon , ' noop , ' ret , ;
: redefine ( cp cpdeferred ) cell + ! ;
: 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 ;
( 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 ! ;