[Back to DOS SWAG index] [Back to Main SWAG index] [Original]

    Unit Multi;
    {--------------------------------------------------------------------------------}
    {                                                                                }
    { Hilfsfunktionen zur quasi-Multitaskingverarbeitung unter Turbo Pascal          }
    {                                                                                }
    { (c) 1994 by Hegel Udo                                                          }
    {                                                                                }
    {--------------------------------------------------------------------------------}
    Interface
    {--------------------------------------------------------------------------------}
    Type
      StartProc = Procedure;
    {--------------------------------------------------------------------------------}
    Procedure AddTask (Start : StartProc;StackSize : Word);
    Procedure Transfer;
    {--------------------------------------------------------------------------------}
    Implementation
    {--------------------------------------------------------------------------------}
    Uses
      Dos;
    {--------------------------------------------------------------------------------}
    Type
      TaskPtr   = ^TaskRec;
      TaskRec   = Record
        StackSize : Word;
        Stack     : Pointer;
        SPSave    : Word;
        SSSave    : Word;
        BPSave    : Word;
        Next      : TaskPtr;
      end;
    {--------------------------------------------------------------------------------}
    Const
      MinStack = 1024;
      MaxStack = 32768;
    {--------------------------------------------------------------------------------}
    Var
      Tasks    : TaskPtr;
      AktTask  : TaskPtr;
      OldExit  : Pointer;
    {--------------------------------------------------------------------------------}
    Procedure AddTask (Start : StartProc;StackSize : Word);
    Type
      OS = Record
        O,S : Word;
      end;
    Var
      W  : ^TaskPtr;
      SS : Word;
      SP : Word;
    begin
      W := @Tasks;
      While Assigned (W^) do W := @W^^.Next;
      New (W^);
      if StackSize < MinStack then StackSize := MinStack;
      if StackSize > MaxStack then StackSize := MaxStack;
      W^^.StackSize := StackSize;
      GetMem (W^^.Stack,StackSize);
      SS := OS(W^^.Stack).S;
      SP := OS(W^^.Stack).O+StackSize-4;
      Move (Start,Ptr(SS,SP)^,4);
      W^^.SPSave := SP;
      W^^.SSSave := SS;
      W^^.BPSave := W^^.SPSave;
      W^^.Next := NIL;
    end;
    {--------------------------------------------------------------------------------}
    Procedure Transfer; Assembler;
    Asm
      LES SI,AktTask                               { Alter Status sichern }
      MOV ES:[SI].TaskRec.SPSave,SP
      MOV ES:[SI].TaskRec.SSSave,SS
      MOV ES:[SI].TaskRec.BPSave,BP
      MOV AX,Word Ptr ES:[SI].TaskRec.Next         { Neue Task bestimmen }
      OR  AX,Word Ptr ES:[SI].TaskRec.Next+2
      JE  @InitNew
      LES SI,ES:[SI].TaskRec.Next
      JMP @DoJob
    @InitNew:
      LES SI,Tasks
    @DoJob:
      MOV Word Ptr AktTask,SI                      { Neue Task Sichern }
      MOV Word Ptr AktTask+2,ES
      CLI                                          { Status wieder hertstellen }
      MOV SP,ES:[SI].TaskRec.SPSave
      MOV SS,ES:[SI].TaskRec.SSSave
      STI
      MOV BP,ES:[SI].TaskRec.BPSave
    end;
    {--------------------------------------------------------------------------------}
    BEGIN
      New (Tasks);              { Hauptprogramm als Task anmelden }
      Tasks^.StackSize := 0;
      Tasks^.Stack := NIL;
      Tasks^.Next := NIL;
      AktTask := Tasks;
    END.

    { --------------------------   DEMO PROGRAM ---------------------- }

    Program Multi_Demo;

    Uses
      DOS, Crt, Multi;

    TYPE

          ScreenState = (free, used);          { Is screen position free? }
          WindowType  = Record                 { Window descriptor }
                          X,
                          Y,
                          Xsize,
                          Ysize  : Integer;
                        End;

    var   screen      : Array(.0..81,0..26.) of ScreenState;
          WindowTable : Array(.1..20.) of WindowType;
          i,j,                                 { Index variables }
          NoWindows   : Integer;               { No. of windows on screen }

    Procedure MakeWindow(X, Y, Xsize, Ysize: Integer; Heading: String);

    { Reserves screenspace for window and draws border around it }

       const NEcorner = #187;                { Characters for double-line border }
             SEcorner = #188;
             SWcorner = #200;
             NWcorner = #201;
             Hor      = #205;
             Vert     = #186;

       var   i,j : Integer;

       Begin
         Window(1,1,80,25);

         { Reserve screen space }
         For i:=X to X+Xsize-1 Do
           For j:=Y to Y+Ysize-1 Do screen(.i,j.):=used;

         { Draw border - sides }
         i:=X;
         For j:=Y+1 to Y+Ysize-2 Do
         Begin
           GotoXY(i,j);
           Write(Vert);
         End;

         i:=X+Xsize-1;
         For j:=Y+1 to Y+Ysize-2 Do
         Begin
           GotoXY(i,j);
           Write(Vert);
         End;

         j:=Y;
         For i:=X+1 to X+Xsize-2 Do
         Begin
           GotoXY(i,j);
           Write(Hor);
         End;

         j:=Y+Ysize-1;
         For i:=X+1 to X+Xsize-2 Do
         Begin
           GotoXY(i,j);
           Write(Hor);
         End;

         { Draw border - corners }
         GotoXY(X,Y);
         Write(NWcorner);
         GotoXY(X+Xsize-1,Y);
         Write(NEcorner);
         GotoXY(X+Xsize-1,Y+Ysize-1);
         Write(SEcorner);
         GotoXY(X,Y+Ysize-1);
         Write(SWcorner);

         { Make Heading }
         GotoXY(X+(Xsize-Length(Heading)) div 2,Y);
         Write(heading);

         { Save in table }
         NoWindows:=NoWindows+1;
         WindowTable(.NoWindows.).X:=X;
         WindowTable(.NoWindows.).Y:=Y;
         WindowTable(.NoWindows.).Xsize:=Xsize;
         WindowTable(.NoWindows.).Ysize:=Ysize;

       End; { MakeWindow }

    Procedure SelectWindow(i : Integer);

       { Specifies which window will receive subsequent output }

       Begin
         With WindowTable(.i.) Do
         Begin
           Window(X+1,Y+1,X+Xsize-2,Y+Ysize-2);
         End;
       End; { SelectWindow }

    Procedure RemoveWindow(n: Integer);

       { Removes window number n }

       var i,j : Integer;

       Begin
         SelectWindow(n);
         With WindowTable(.n.) Do
         Begin
           Window(X,Y,X+Xsize,Y+Ysize);
           For i:=X to X+Xsize Do
             For j:=Y to Y+Ysize Do screen(.i,j.):=free;
         End; { With }
         ClrScr;
       End; { SelectWindow }

    Procedure Task1;Far;
    VAR
        SR : SearchRec;
    begin
      MakeWindow(27, 2,18,4,' Sub Task 1 ');
      REPEAT
        FINDFIRST('*.*',anyfile,SR);
        WHILE DOSERROR = 0 DO
              BEGIN
              Transfer;
              SelectWindow(2);
              WriteLn(SR.Name : 12);
              FINDNEXT(SR);
              Delay(10);
              END;
      UNTIL FALSE;
    end;

    Procedure Task2;Far;
    VAR
        SR : SearchRec;
    begin
      MakeWindow(27, 7,18,4,' Sub Task 2 ');
      REPEAT
        FINDFIRST('\TURBO\TP\*.*',anyfile,SR);
        WHILE DOSERROR = 0 DO
              BEGIN
              Transfer;
              SelectWindow(3);
              WriteLn(SR.Name : 12);
              FINDNEXT(SR);
              Delay(10);
              END;
      UNTIL FALSE;
    end;

    Procedure Task3;Far;
    VAR
        SR : SearchRec;
    begin
      MakeWindow(27,12,18,4,' Sub Task 3 ');
      REPEAT
        FINDFIRST('\TURBO\*.*',anyfile,SR);
        WHILE DOSERROR = 0 DO
              BEGIN
              Transfer;
              SelectWindow(4);
              WriteLn(SR.Name : 12);
              FINDNEXT(SR);
              Delay(10);
              END;
      UNTIL FALSE;
    end;

    Procedure Task4;Far;
    VAR
        SR : SearchRec;
    begin
      MakeWindow(27,17,18,4,' Sub Task 4 ');
      REPEAT
        FINDFIRST('\*.*',anyfile,SR);
        WHILE DOSERROR = 0 DO
              BEGIN
              Transfer;
              SelectWindow(5);
              WriteLn(SR.Name : 12);
              FINDNEXT(SR);
              Delay(10);
              END;
      UNTIL FALSE;
    end;

    BEGIN
      ClrScr;
      MakeWindow( 5,21,75,4,' Multi-Program Demo ');
      SelectWindow(1);
      WriteLn(' This is the MAIN task window and we will start 4 others too');
      AddTask (Task1,8192);
      AddTask (Task2,8192);
      AddTask (Task3,8192);
      AddTask (Task4,8192);
      REPEAT
        Transfer;
      UNTIL KEYPRESSED;
    END.

[Back to DOS SWAG index] [Back to Main SWAG index] [Original]