[fpc-pascal]Porting to Free pascal this little Turbo Pascal code
Jérémie LEFRANCOIS
j.lefrancois at altran-tech.net
Fri Jul 30 10:43:31 CEST 2004
Anybody capable of providing me an answer on how to get this working with Free
Pascal (under DOS) ?
The trick is that the Base Pointer and Segment Stack are saved and restored.
That is what I am trying to do . Note FreePascal only accepts ASM blocks.
And also I do not know what instruction $89/$2e $8c/$16 $8b/$2e $8e/$16 $90/$90/
$90 refer to.
Regards.
================ beginning of the code =================
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;
Implementation
(* PROBLEM NEXT LINE *)
Procedure SaveFrame; Inline($89/$2e/BP_save/$8c/$16/SS_save);
(* PROBLEM NEXT LINE *)
Procedure LoadFrame; Inline($8b/$2e/BP_load/$8e/$16/SS_load);
{$F+}
Procedure Fork;
Begin
(* PROBLEM NEXT LINE *)
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-}
End. { Unit }
================ end of the code =================
More information about the fpc-pascal
mailing list