[fpc-pascal]Porting to Free pascal this little Turbo Pascal code

Nelson M. Sicuro nelson at desktopsistemas.com.br
Fri Jul 30 13:33:18 CEST 2004


In my humble experience with FreePascal, I know that you cannot mess with  
segment registers as you do in 16 bits mode. This code of yours need to be  
rewrited from scratch to be in 32 bits mode, without using the segment  
registers and the inline functions (replaced with asm statements).
Anyway, this code seems unsafe to run in 32 bits anyway.
Most 32 bits environments are indeed capable of multitask programming,  
take a look at the DOS 32 bit extenders that FreePascal uses.

Best regards,
Nelson

> 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 =================
>
> _______________________________________________
> fpc-pascal maillist  -  fpc-pascal at lists.freepascal.org
> http://lists.freepascal.org/mailman/listinfo/fpc-pascal
>






More information about the fpc-pascal mailing list