[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]