87 lines
2.1 KiB
Plaintext
Executable file
87 lines
2.1 KiB
Plaintext
Executable file
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
|