home *** CD-ROM | disk | FTP | other *** search
- Unit Tasker;
- {$R- ,$S- ,$N-}
- {
- Non-Preemptive MultiTasking Unit
- for Turbo Pascal Version 4
-
- Author : Michael Warot
- Date : November 1987
- Purpose : Simple multi-tasking for turbo pascal 4.0
- }
- Interface
-
- Const
- MaxProc = 20;
-
- Type
- ProcState = (Dead,Live,Pause,Sleep);
-
- SpaceRec = Array[0..$1000] of Byte;
- SpacePtr = ^SpaceRec;
-
- Task_Rec = Record
- ID : Word; { Process Number }
- Base, { BP save area }
- Stack : Word; { SS save area }
- State : ProcState; { Is it a live process ? }
- End; { Record }
- Var
- BP_save,SS_save : Word;
- BP_load,SS_load : Word;
-
- New_Ptr : SpacePtr;
-
- Procs : Array[0..MaxProc] of Task_Rec;
- LastP : Word;
- NextP : Word;
- ThisP : Word;
- LiveCount : Word; { How many thing happening? }
-
- {$F+}
- Procedure Fork;
- Procedure Yield;
- Procedure KillProc;
- Function Child_Process:Boolean;
- Procedure Init_Tasking;
-
- Implementation
-
- Procedure SaveFrame; Inline($89/$2e/BP_save/$8c/$16/SS_save);
-
- Procedure LoadFrame; Inline($8b/$2e/BP_load/$8e/$16/SS_load);
-
- {$F+}
- Procedure Fork;
- Begin
- inline($90/$90/$90);
- SaveFrame;
- If (ThisP = 0) and (LastP < MaxProc) then
- begin
-
- Procs[ThisP].ID := ThisP;
- Procs[ThisP].Base := BP_Save;
- Procs[ThisP].Stack := SS_Save;
- Procs[ThisP].State := Live;
-
- Inc(NextP);
- Inc(LastP);
-
- New(New_Ptr);
-
- Procs[NextP].ID := NextP;
- Procs[NextP].Base := ofs(new_ptr^[$0f00]);
- Procs[NextP].Stack := seg(new_ptr^[$0f00]);
- Procs[NextP].State := Live;
- Move(Ptr(SS_save,BP_Save)^,new_ptr^[$0f00],$10);
-
- Inc(LiveCount);
- end; { if root process }
-
- bp_load := bp_save;
- ss_load := ss_save;
-
- LoadFrame;
- End; { Fork }
- {$F-}
-
- {$F+}
- Procedure Yield;
- Begin
- SaveFrame;
-
- Procs[ThisP].Base := BP_Save;
- Procs[ThisP].Stack := SS_Save;
-
- If LiveCount > 1 then
- begin
- repeat
- ThisP := NextP;
- NextP := Succ(NextP); If NextP > LastP then NextP := 0;
- until Procs[ThisP].State <> Dead;
- end;
-
- bp_load := Procs[ThisP].Base;
- ss_load := Procs[ThisP].Stack;
- LoadFrame;
- End; { Yield }
- {$F-}
-
- Procedure KillProc;
- Begin
- If LiveCount > 1 then
- begin
- Procs[ThisP].State := Dead;
- LiveCount := Pred(LiveCount);
- Yield;
- end
- else
- Halt(0);
- End; { KillProc }
-
- Function Child_Process : Boolean;
- Begin
- Child_Process := ThisP <> 0;
- End;
-
- Procedure Init_Tasking;
- Begin
- LastP := 0;
- ThisP := 0;
- NextP := 0;
- LiveCount := 1; { This task! }
- End;
-
- End. { Unit }