{ MULT.PAS : Non-Preemptive multitasking for Turbo Pascal V5.x.
This unit is not intended for programs that do I/O with the keyboard and
screen. Screen output from different tasks will be intermixed; Read, ReadLn,
or ReadKey will hang all tasks until the completion of the input operation.
For full device support (keyboard, mouse, screen) with windows, use
MULTIWIN.PAS with WINDOW.PAS available from the author, with documentation
after 11-1-89.

Remember, this is NON-Preemptive multitasking - you must call WAIT (see
below) to share the CPU. The mainline task should be terminated with a
call to STOP (see below). If the mainline is allowed to fall through and
MultiExitProc is not installed, the entire program will stop. }

{ NOTE: Tasks may use the numeric coprocessor (real or emulated) and overlays
freely. The IdleRoutine should not use the real 8087 or overlays, but may
use 8087 emulation. An event handler must conform to the restrictions of
its _caller_. For example, an event handler which is called from another
task has no restrictions, but an event handler called from the IdleRoutine
mustn't use overlays or the 8087. In addition, an event handler must never
call WAIT, even indirectly. Interrupt handlers which may be entered
asynchronously are, as usual, forbidden to use much of anything except as
noted below. Overlay support was implemented for TP 5.0 and 5.5 and may not
work on any other release. }

{ Copyright 1989 by: Edwin T. Floyd
All rights reserved
Non-commercial use permitted.

Author: Edwin T. Floyd [76067,747]
#9 Adams Park Court
Columbus, GA 31909
(404) 322-0076 }

{$A+,B-,D-,E-,F+,I-,L-,N-,O-,R-,S-,V+}
Unit MULTI;
Interface

Const
MaxTasks = 32; { Maximum number of active tasks }
MaxResources = 8; { Maximum number of resource queues }
MaxOverlays = 20; { Maximum number of overlay units supported }
WaitStackSize = 2048; { Size in bytes of wait-dispatch stack }
MainName = 'MAINLINE'; { Name of mainline task }
Forever = -1; { Wait time for unending wait }

Type
TaskType = 0..MaxTasks;
ResourceType = 1..MaxResources;
EventMessageType = (MsgStop, MsgKeystroke, MsgBreak, MsgMouse, MsgUser);
{ MULTI only implements MsgStop }
DispatchHookType = (HookInit, HookIn, HookOut, HookStop, HookWake);
LockHookType = (HookLock, HookUnlock, HookLockNext);
EventMessage =
Record
MsgType : EventMessageType; { Event type }
MsgFlag : Byte; { User message subtype }
MsgLen : Word; { Length of message data }
MsgData : Pointer; { Pointer to message data }
End;
SpawnRoutineType = Procedure(Param : Pointer);
EventRoutineType = Procedure(Task : TaskType; Var Event : EventMessage;
Param : Pointer);
IdleRoutineType = Procedure(Timeout : LongInt);
HookRoutineType = Procedure(Task : TaskType; Entry : DispatchHookType);
LockRoutineType = Procedure(Var Task : TaskType; Res : ResourceType;
Entry : LockHookType);
TaskNameType = String[8];

Var
MultiExitChain : Pointer; { ExitProc to restore after MultiExitProc }
DispatchHook : HookRoutineType; { Dispatch hook for add-ons (i.e. MultiWin) }
LockHook : LockRoutineType; { Lock hook for add-ons (i.e. MultiWin) }
IdleRoutine : IdleRoutineType; { Routine to call when waiting }
MRCTaskId : TaskType; { Task Id of most recently created task }

{ Unless otherwise indicated in a "**:" note, any routine below may be called
from an interrupt handler or an event handler. }

Procedure Spawn(Routine : SpawnRoutineType; Param : Pointer; StkSize : Word;
Name : TaskNameType);
{ Create a new task. If successful, new task Identifier is placed in
MRCTaskId. Otherwise, MRCTaskId is set to zero. **: Spawn calls GetMem to
allocate a control block and stack on the Heap. Do NOT call Spawn from an
INTERRUPT handler! }

Function TaskExists(Task : TaskType) : Boolean;
{ Returns TRUE if Task is active. }

Function TaskName(Task : TaskType) : TaskNameType;
{ Returns the name assigned to Task }

Function TaskParent(Task : TaskType) : TaskType;
{ Returns the TaskId of the task which spawned a task }

Procedure Adopt(Task, NewParent : TaskType);
{ Set the parent of a task (the parent receives a stop message when the
task terminates). }

Function FindTask(Name : TaskNameType) : TaskType;
{ Returns the TaskId of the named task if it exists, returns 0 otherwise }

Function TaskCount : Byte;
{ Returns number of active tasks. }

Function MyTaskId : TaskType;
{ Returns identifier of currently executing task. **: This returns 0 if
called from an interrupt or event handler while all tasks are waiting.
This always returns 0 if called from the IdleRoutine. MyTaskId = 0
disables some of the following procedures (see notes below). }

Procedure Wait(Time : LongInt);
{ Wait until Wake is called for this task, or Time (in sec/100)
has elapsed (if Time >= 0). **: DO NOT CALL FROM INTERRUPT or
EVENT HANDLER! }

Procedure Wake(Task : TaskType);
{ Awaken a waiting task before it's timeout has expired. }

Procedure StopTask(Task : TaskType);
{ Stop task, release its resources. **: This is safe to call from an
Interrupt or Event handler ONLY if Task <> MyTaskId! }

Procedure Stop;
{ Stop current task, equivalent to StopTask(MyTaskId). **: DO NOT CALL FROM
INTERRUPT or EVENT HANDLER! }

Procedure StopAll(ExitCode : Word);
{ Stop all tasks and exit. **: DO NOT CALL FROM INTERRUPT or EVENT HANDLER! }

Procedure FreezeTask(Task : TaskType);
{ Freeze a task. (you can't freeze MyTaskId) }

Procedure ThawTask(Task : TaskType);
{ Un-freeze a frozen task }

Procedure GetExitProc(Var Routine : SpawnRoutineType; Var Param : Pointer);
{ Returns the entry point and parameter of the exit routine for the current
task. **: Won't work if MyTaskId = 0. }

Procedure SetExitProc(Routine : SpawnRoutineType; Param : Pointer);
{ Establish an exit routine for current task. Note: This exit routine
is activated upon termination of the current task only. See MultiExitProc
below for information on a system exit routine. **: Won't work if
MyTaskId = 0. }

Procedure GetEventProc(Var Routine : EventRoutineType; Var Param : Pointer);
{ Returns the entry point and param of the event handler for the current
task. A task should call this before calling SetEventProc and save the
entry point and param of the previous event handler so that the new event
handler may relay non-user messages. **: Won't work if MyTaskId = 0. }

Procedure SetEventProc(Routine : EventRoutineType; Param : Pointer);
{ Establish an event handler routine for the current task. Note: User event
handlers should relay all messages except MsgType = MsgUser to the previous
event handler. **: Won't work if MyTaskId = 0. }

Procedure CallEventProc(Task : TaskType; Var Event : EventMessage);
{ Call the event routine associated with the indicated task. Note:
EventMessage.MsgType MsgStop..MsgMouse are reserved system messages; task
initiated messages should be MsgType = MsgUser. }

Function Lock(Res : ResourceType; Timeout : LongInt) : Boolean;
{ Reserve a serial resource. **: Lock may call Wait, so DO NOT CALL FROM
INTERRUPT or EVENT HANDLER! }

Procedure Unlock(Res : ResourceType);
{ Release a serial resource. **: Does nothing if MyTaskId = 0. }

Function Preempt(Res : ResourceType; Task : TaskType) : TaskType;
{ Unconditionally reserve a serial resource for the indicated task. Returns
the TaskId of the previous owner. }

Function ResourceOwner(Res : ResourceType) : TaskType;
{ Returns the TaskId of the current owner of the resource. Returns 0 (zero)
if no task has locked the resource. }

Function TimeNow : LongInt;
{ Returns the time in hundredths of a second since the beginning of the day
in which the first call to TimeNow was made. TimeNow is actually only as
accurate as the BIOS clock tick which occurs about once each 5.5 hundredths
of a second. This function is used by the dispatcher. }

Procedure MultiExitProc;
{ Exit proc which terminates the current task with an error message but
allows the remaining tasks to continue. Do not call this procedure
directly. Do this to activate MultiExitProc:

MultiExitChain := ExitProc;
ExitProc := @MultiExitProc; }

Implementation
Uses Dos;