[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