121 lines
2.7 KiB
Plaintext
Executable file
121 lines
2.7 KiB
Plaintext
Executable file
{ 0x100 var, userhere
|
|
: userallot userhere @ + userhere ! ;
|
|
: userarray userhere @ CONST userallot ;
|
|
: uservar cell userarray ; }
|
|
|
|
uservar tasksp
|
|
uservar taskbp
|
|
uservar tasksi
|
|
uservar taskcoff
|
|
uservar taskcs
|
|
uservar next-task
|
|
|
|
:asm @u ( p -- v )
|
|
POP BX
|
|
PUSH @[ SS: BX]
|
|
NEXT
|
|
|
|
:asm !u ( v p -- )
|
|
POP BX
|
|
POP AX
|
|
MOV @[ SS: BX] AX
|
|
NEXT
|
|
|
|
:asm get-cseg PUSH CS NEXT
|
|
{ :asm get-host-cseg PUSH CS NEXT }
|
|
|
|
:asm suspend
|
|
MOV @[ SS: taskcs @] CS
|
|
MOV @[ SS: tasksp @] SP
|
|
MOV @[ SS: taskbp @] BP
|
|
MOV @[ SS: tasksi @] SI
|
|
MOV AX @[ SS: next-task @]
|
|
L: resume-task-ax
|
|
MOV SS AX
|
|
MOV SP @[ SS: tasksp @]
|
|
MOV BP @[ SS: taskbp @]
|
|
MOV SI @[ SS: tasksi @]
|
|
MOV DS @[ SS: taskcs @]
|
|
LODSW
|
|
MOV BX AX
|
|
MOV AX @[ BX]
|
|
MOV @[ SS: taskcoff @] AX
|
|
JMP FAR @[ SS: taskcoff @]
|
|
|
|
:asm resume-task ( taskseg -- )
|
|
POP AX
|
|
JMP resume-task-ax
|
|
|
|
:asm taskseg
|
|
PUSH SS
|
|
NEXT
|
|
|
|
0 var, first-task
|
|
0 var, last-task
|
|
0x200 4 >> const tasksegsize
|
|
|
|
( taskseg -- taskseg )
|
|
deferred task-init noop
|
|
|
|
: init-first-task
|
|
taskseg dup next-task !u task-init dup first-task ! last-task ! ;
|
|
|
|
init-first-task
|
|
' init :chain init-first-task ;
|
|
|
|
:asm unlink-task ( prevtaskseg taskseg -- )
|
|
MOV CX SS
|
|
POP AX
|
|
POP BX
|
|
MOV SS AX
|
|
MOV DX @[ SS: next-task @]
|
|
XOR AX AX
|
|
MOV @[ SS: next-task @] AX
|
|
MOV SS BX
|
|
MOV @[ SS: next-task @] DX
|
|
MOV SS CX
|
|
NEXT
|
|
|
|
: prev-taskseg ( -- taskseg )
|
|
first-task @ begin next-task over @far taskseg != while
|
|
tasksegsize + repeat ;
|
|
: next-unused-taskseg
|
|
first-task @ begin next-task over @far over last-task @ <= and while
|
|
tasksegsize + repeat ;
|
|
|
|
: task-complete next-task @u prev-taskseg taskseg unlink-task resume-task [
|
|
: task-arise execute task-complete [
|
|
{ : task-arise-host execute task-complete [ }
|
|
|
|
:asm link-new-task ( taskseg -- )
|
|
MOV CX SS
|
|
POP AX ( taskseg )
|
|
( save the current next task in BX so we can point the new task at it )
|
|
MOV BX @[ SS: next-task @]
|
|
( link our task segment to the new task )
|
|
MOV @[ SS: next-task @] AX
|
|
MOV SS AX
|
|
MOV AX 0x100 #
|
|
MOV @[ SS: tasksp @] AX
|
|
XOR AX AX
|
|
MOV @[ SS: taskbp @] AX
|
|
MOV @[ SS: next-task @] BX
|
|
MOV SS CX ( restore the current task )
|
|
NEXT
|
|
|
|
: push-into-task ( v taskseg -- )
|
|
>r tasksp r@ @far 2 - dup tasksp r@ !far <r !far ;
|
|
: spawn-task-raw ( cp cseg arise -- taskseg )
|
|
next-unused-taskseg >r r@ link-new-task
|
|
r@ last-task @ > if r@ last-task ! then
|
|
cell + tasksi r@ !far
|
|
taskcs r@ !far
|
|
r@ push-into-task
|
|
<r task-init ;
|
|
|
|
: spawn-task ( cp -- taskseg )
|
|
get-cseg ' task-arise spawn-task-raw ;
|
|
{ : spawn-task ( cp -- taskseg )
|
|
get-host-cseg ' task-arise-host spawn-task-raw ; }
|
|
|