neuttower/job.jor

87 lines
2.1 KiB
Plaintext
Raw Normal View History

2020-02-02 23:33:07 +00:00
defer any-job-started
defer all-jobs-complete
var JOBSTATE
array JOBTASKS 4 cells allot
array JOBS 8 cells allot
array JOBDATA 8 cells allot
: by-jobid ( jobid p -- p ) swap 1 - cells + ;
: jobdata ( jobid -- jobid data ) dup JOBDATA by-jobid @ ;
: jobdata! ( data jobid -- ) JOBDATA by-jobid ! ;
: ijobtask-running ( -- i )
0 0 4 for JOBTASKS i cells + @ running = if drop i then next ;
: jobtask-busy-flag ( ijobtask -- v f )
1 swap << JOBSTATE swap ;
: job-scheduled-flag ( jobid -- v f )
0x08 swap << JOBSTATE swap ;
: next-matching-jobid ( matcher -- jobid )
0 1 9 for dup not if
over i swap execute if drop i then
then next swap drop ;
: job-unscheduled+xp ( jobid -- b xp )
dup job-scheduled-flag f@ not
swap JOBS by-jobid @ ;
: next-unused-jobid ( -- jobid )
:| job-unscheduled+xp not and |; next-matching-jobid ;
: next-waiting-jobid ( -- jobid )
:| job-unscheduled+xp and |; next-matching-jobid ;
: on-job-complete ( jobid -- )
0 swap job-scheduled-flag f!
next-waiting-jobid dup if
dup running send
1 swap job-scheduled-flag f!
else
( 0 ) ijobtask-running jobtask-busy-flag f!
JOBSTATE @ not if all-jobs-complete then
then ;
: listen-for-jobs activate blah
begin receive ( jobid )
any-job-started
dup JOBS by-jobid 0 swap @!
execute
on-job-complete
again ;
: start-jobtask ( i -- )
task dup listen-for-jobs swap cells JOBTASKS + ! ;
: next-free-job-task ( -- task )
0 0 4 for dup not if
JOBSTATE 1 i << f@ not if
drop JOBTASKS i cells + @
then
then next ;
: enqueue-job ( xp -- jobid )
next-unused-jobid dup if
dup >rot 1 - cells JOBS + !
else swap drop then ;
: try-run-job ( jobid -- )
0 4 for i jobtask-busy-flag f@ not if
1 i jobtask-busy-flag f!
1 over job-scheduled-flag f!
JOBTASKS i cells + @ send breakfor
then next ;
: sched ( xp -- ) enqueue-job try-run-job ;
: sched-with ( data xp -- ) enqueue-job dup >rot jobdata! try-run-job ;
:noname
0 start-jobtask
1 start-jobtask
2 start-jobtask
3 start-jobtask
; ' onload redefine