' By Mark junker
'
defint a-z

' Die wichtigsten Task-Infos
type tTaskInfo
 Priority      as word  ' Prioritaet (je hoeher, desto schneller ist d. Task)
 PriorityCount as word  ' Zaehler, damit Tasks mit niedriger Prioritaet auch
                        ' mal drankommen
 StackPointer  as word  ' SP des Tasks
 BasePointer   as word  ' BP des Tasks
end type

%MaxTasks = 100         : ' Maximale Anzahl Tasks
%MaxStackSize = 4096    : ' Maximale Groesse des Stacks
%StackSizeCorrect = &H0 : ' Korrektur der Stack-Groesse 'nach oben'

$stack %MaxStackSize     ' Stack-Groesse setzen

declare sub SetUEvent (): ' 'SetUEvent' verfuegbar machen

on uevent gosub TaskHandler   : ' Basic-Part des INT-Handlers aktivieren
uevent on
on error goto TaskerStop      : ' Bei Fehlern Programm SOFORT beenden
exit far at TaskerStop        : ' Bei kritischen Fehlern bei TASK.CREATE
                              : '   wird EXIT FAR ausgefuehrt (SOFORT ENDE)

dim IRQ8HandlerPtr as dword ptr     : ' alter IRQ8-Handler
dim StackBase as shared word        : ' Stack-Anfangs-Adresse
dim TaskSwitchState as shared dword : ' Zaehler f. TASK-Switches
dim TaskNumber as shared word       : ' Task-Nummer
dim TaskCount as shared word        : ' Anzahl Tasks
dim TaskInfo (%MaxTasks) as shared tTaskInfo  : ' Array mit TASK-Infos
dim TaskStack (%MaxTasks) as shared string    : ' Array mit TASK-Stacks

! mov StackBase??,sp                ; Aktuellen Stack-Pointer auslesen
! add StackBase??,%StackSizeCorrect ; ggf. korrigieren
! mov ax,StackBase??
! sub ax,%MaxStackSize
! mov StackBaseLow,ax               ; Untere STACK-Grenze errechnen
! mov StackBaseLow[2],ss

TaskInfo(0).Priority=1              : ' Task-Infos fuer d. 1. Task
TaskCount=0                         : ' Anzahl Tasks (ohne den Haupt-Task)

$event off
! cli
out &H70,11
OldStatRegB=inp(&H71)           : ' Alten C-MOS-Wert (f. INTs) merken
out &H70,11
out &H71,OldStatRegB and 7      : ' Alle RTC-Ints abschalten
OldPIC2Value=inp(&Ha1)
out &Ha1,OldPIC2Value or 1      : ' IRQ 8 ausschalten
IRQ8HandlerPtr=codeptr32(OldIRQ8Handler)   : ' Adresse f. alten Handler
                                           : '  in PTR-Variable sichern
call SysIntGet(&H70,@IRQ8HandlerPtr)       : ' Addresse d. alten Handlers
                                           : '  speichern
call SysIntSet(&H70,codeptr32(IRQ8Handler)): ' Neuen Handler installieren

out &H70,10
OldStageDiv?=inp(&H71) and &HF0
out &H70,10
out &H71,OldStageDiv? or &B1010 : ' Interrupt-Speed=15,258*2^Wert Mikrosek.
                                : '  Je langsamer, desto sicherer ...
                                : '  ... unter WIN u. a. Multitaskern

out &H70,11
out &H71,OldStatRegB or 64      : ' periodischen RTC-Interrupt anschalten
out &Ha1,OldPIC2Value and not 1 : ' IRQ 8 anschalten
! sti                           ; Interrupts 'generell' zulassen
$event on                        ' Ab hier UEvent zulassen

cls
call Task.Create(11,codeptr32(Test2)) : ' Neuen TASK erstellen !!!
call Task.Create(6,codeptr32(Test3))  : ' Neuen TASK erstellen !!!
do until (inkey$=chr$(27))            : ' Warten, bis ESC gedrueckt ...
call Test
wend

TaskerStop:
$event off                ' UEvent verbieten
! cli                    ; Interrupts verbieten
out &Ha1,OldPIC2Value    : ' Alte IRQ-Maske fuer PIC 2
out &H70,11              : ' Interrupts so an- od. ausstellen, wie vorher
out &H71,OldStatRegB

out &H70,10
OldStageDiv?=inp(&H71) and &HF0
out &H70,10
out &H71,OldStageDiv? or &B0110 : ' Standard RTC-Interrupt-Speed

call SysIntSet(&H70,@IRQ8HandlerPtr) : ' Alten Interrupt setzen
! sti                                ; Interrupts wieder zulassen
if err>0 then
 print "ERROR: ",pbvErr,eradr        : ' Wenn Abbruch durch Fehler, dann ...
end if
end
$event on

$event off
TaskHandler:                            ' Handler f. UEVENT
 ! mov ax,word ptr TaskSwitchState???   ; Zaehler einlesen
 ! mov dx,word ptr TaskSwitchState???[2]
 ! add ax,1                             ; ... erhoehen
 ! adc dx,0
 ! mov word ptr TaskSwitchState???,ax   ; ... zurueckschreiben
 ! mov word ptr TaskSwitchState???[2],dx
 call Task.Switch
 return

IRQ8Handler:
 ! push ax
 ! mov ax,ss
 ! cmp cs:StackBaseLow[2],ax            ; Test wegen Stack-Segment
 ! pop ax
 ! je CheckSetUEvent
 ! jmp SetUEventError
CheckSetUEvent:
 ! cmp cs:StackBaseLow,sp               ; Test des Stack-Pointers
 ! jbe DoSetUEvent

SetUEventError:
 ! inc word ptr StackBaseError       ; Fehler: Interne PB-Routinen wurden
 ! jmp NoSetUEvent                   ;   verwendet !!! Fehler-Zaehler erhoehen

DoSetUEvent:
 ! db &H66                           ;
 ! pushf                             ; PUSHFD
 ! db &H66                           ;
 ! db &H60                           ; PUSHAD
 ! push ds
 ! push es
 ! call SetUEvent                    ; UEvent setzen
 ! pop es
 ! pop ds
 ! db &H66                           ;
 ! db &H61                           ; POPAD
 ! db &H66                           ;
 ! popf                              ; POPFD
NoSetUEvent:
 ! jmp dword ptr OldIRQ8Handler      ; Alten IRQ8-Handler aufrufen
OldIRQ8Handler:
 ! dd 0
StackBaseLow:
 ! dd 0
StackBaseError:
 ! dd 0
$event on                            ' UEvents normalerweise wieder zulassen

$event off
sub Task.Switch
 ! cli
 ! mov StackPtr??,sp                 ; Merken des Stack-Pointers
 ! mov StackSeg??,ss                 ; ... des Stack-Segments
 ! mov BasePtr??,bp                  ; ... und des Base-Pointers

 StackSeg??=0
 dim StackErrPtr as word ptr
 StackErrPtr=codeptr32(StackBaseError)
 OldX=pos(0):OldY=csrlin
 locate 20,1
 print "!"@StackErrPtr"!"TaskNumber _
   "!"TaskCount"!"TaskSwitchState???"!"; : ' Status-Infos anzeigen ...
 locate OldY,OldX

 StackDiff??=StackBase??-StackPtr??      : ' Stack-Groesse des Tasks errechnen
 TaskInfo(TaskNumber).StackPointer=StackPtr?? : ' Task-Info-Feld updaten
 TaskInfo(TaskNumber).BasePointer=BasePtr??
 TaskStack(TaskNumber)=space$(StackDiff??) : ' Platz f. Stack reservieren
 StringAddress???=strptr32(TaskStack(TaskNumber))
 ! mov si,StackPtr??
 ! les di,StringAddress???  ; String-Adresse einlesen
 ! mov cx,StackDiff??
 ! shr cx,1
 ! push ds
 ! mov ax,ss
 ! mov ds,ax
 ! rep movsw                 ; Stack-Inhalt nach TaskStack(TaskNumber) schr.
 if TaskCount>0 then                          ' Neben-Tasks beruecksichtigen
  TaskInfo(TaskNumber).PriorityCount=0        ' Prioritaeten-Zaehler des
                                    ' aktuellen Tasks auf '0' setzen
  for a=0 to %MaxTasks
   incr TaskInfo(a).PriorityCount,  TaskInfo(a).Priority           ' Prioritaeten-Zaehler jedes Tasks erhoehen
  next
  MaxValue=TaskInfo(0).PriorityCount ' Task mit hoechster Prioritaet suchen
  TaskNumber=0
  for a=1 to %MaxTasks
   if MaxValue<TaskInfo(a).PriorityCount then
    MaxValue=TaskInfo(a).PriorityCount
    TaskNumber=a
   end if
  next
 else
  TaskNumber=0
 end if
 StackPtr??=TaskInfo(TaskNumber).StackPointer   ' Mindest-Infos des neuen
 BasePtr??=TaskInfo(TaskNumber).BasePointer     '  Tasks setzen
 StackDataPtr???=strptr32(TaskStack(TaskNumber))
 StackDataLen??=len(TaskStack(TaskNumber))
 ! mov cx,StackDataLen??
 ! shr cx,1
 ! mov sp,StackPtr??                            ; SP setzen
 ! jcxz NoStackCopy
 ! mov bx,ds
 ! lds si,StackDataPtr???
 ! mov bp,BasePtr??                             ; BP setzen
 ! mov ax,ss
 ! mov es,ax
 ! mov di,sp
 ! rep movsw                                    ; Task-Stack wegschreiben !
 ! mov ds,bx
NoStackCopy:
 ! sti
end sub
$event on

$event off
sub Task.Create(Priority??,CallAddress???)
static TasksCreated
 if Priority??=0 then exit sub :' Aktiver Task hat IMMER Prioritaet > 0

 ! cli
 TasksCreatedOld=TasksCreated

 TaskSwitchStateOld???=TaskSwitchState
 call SetUEvent
$event on
 while TaskSwitchStateOld???=TaskSwitchState
 wend                                    : ' Auf Task-Wechsel warten !
$event off
 ! cli

 if TasksCreated=TasksCreatedOld then  ' Ungleich, wenn alter Task weiter
                                       ' abgearbeitet wird
  ' Noch alter Task, wird aber neuer TASK !!!
  incr TasksCreated                    ' Erhoehen, damit Bedingung 3 Zeilen
                                       '   hoeher bei altem Task falsch wird
  for a=1 to %MaxTasks
   if TaskInfo(a).Priority=0 then      ' Freie Task-ID suchen
    Found=a
    exit for
   end if
  next
  TaskStack(Found)=TaskStack(TaskNumber)                ' Alte Task-Infos
  TaskInfo (Found).StackPointer =TaskInfo (TaskNumber).StackPointer ' zu
  TaskInfo (Found).BasePointer  =TaskInfo (TaskNumber).BasePointer  ' den
  TaskInfo (Found).Priority     =Priority??             ' neuen kopieren !
  TaskInfo (Found).PriorityCount=0
  incr TaskCount                        ' Anzahl Neben-Tasks erhoehen
  TaskInfo (0).PriorityCount=0
  TaskNumber=Found                      ' Task-Nummer auf neuen Task setzen

  TaskSwitchStateOld???=TaskSwitchState
  call SetUEvent
$event on
  while TaskSwitchStateOld???=TaskSwitchState
  wend                                   : ' Auf Task-Wechsel warten !
$event off
  ! cli

  ! les di,CallAddress???
  ! sti
  ! call dword ptr es:[di]   ; ' Neuen TASK an angegebener Adresse aufrufen
  ! cli

  decr TaskCount                               : ' Anzahl Tasks verringern
  TaskInfo (TaskNumber).Priority=0             : ' Task 'abschalten'
  decr TasksCreated

  TaskSwitchStateOld???=TaskSwitchState
  call SetUEvent
$event on
  while TaskSwitchStateOld???=TaskSwitchState
  wend                                         : ' Auf Task-Wechsel warten !
$event off
  ! cli

  print "ERROR !"                              : ' Hier darf er schon nicht
                                               : '   mehr sein :-((
  exit far
 else
  ' Alter TASK !!!
  for a=1 to TaskCount+1                       : ' Ist sicherer ??? Warum ?
   TaskSwitchStateOld???=TaskSwitchState
   call SetUEvent
$event on
   while TaskSwitchStateOld???=TaskSwitchState
   wend                                        : ' Auf Task-Wechsel warten !
$event off
   ! cli
  next
 end if

 ! sti
end sub
$event on

sub SysIntSet(byval nr?,byval segofs???) : ' Interrupt-Adresse setzen
 ! pushf
 ! cli
 ! mov al,nr?
 ! xor ah,ah
 ! mov di,ax
 ! shl di,1
 ! shl di,1
 ! mov bx,word ptr segofs???
 ! mov cx,word ptr segofs???[2]
 ! xor dx,dx
 ! mov es,dx
 ! mov ax,bx
 ! stosw
 ! mov ax,cx
 ! stosw
 ! popf
end sub

sub SysIntGet(byval nr?,segofs???)         : ' Interrupt-Adresse auslesen
 h???=0
 ! pushf
 ! cli
 ! mov al,nr?
 ! xor ah,ah
 ! mov si,ax
 ! shl si,1
 ! shl si,1
 ! push ds
 ! xor dx,dx
 ! mov ds,dx
 ! lodsw
 ! mov dx,ax
 ! lodsw
 ! pop ds
 ! mov word ptr h???,dx
 ! mov word ptr h???[2],ax
 ! popf
 segofs???=h???
end sub

$event on
sub Test
static x???
' call Task.Tasking.Stop
 locate 10,1
 print "This counter runs in the FOREground with a Priority of";TaskInfo(TaskNumber).Priority;"(";x???;")"
' call Task.Tasking.Start
 incr x???
end sub
$event off

$event on
sub Test2
static x???
 while (x???<100000) and (not instat)
  incr x???
'  call Task.Tasking.Stop
  locate 12,1
  print "This counter runs in the BACKground with a Priority of";TaskInfo(TaskNumber).Priority;"(";x???;")"
'  call Task.Tasking.Start
 wend
 a$=inkey$
end sub
$event on

$event on
sub Test3
static x???
 while (x???<100000) and (not instat)
  incr x???
'  call Task.Tasking.Stop
  locate 14,1
  print "This counter runs in the BACKground with a Priority of";TaskInfo(TaskNumber).Priority;"(";x???;")"
'  call Task.Tasking.Start
 wend
 a$=inkey$
end sub
$event on

$event on