UNIT mtask;


{MTASK 2.0, a simple multi-tasker unit for Turbo Pascal 5.

Written in November, 1988, and donated to the public domain by:

   Wayne E. Conrad
   2627 North 51st Ave, #219
   Phoenix, AZ  85035
   BBS: (602) 484-9356, 300/1200/2400, 24 hours/day

This unit provides Turbo Pascal 5 with what I call "request driven"
multi-tasking.  Switching from the current task to another task is done
whenever the current task requests a task switch by calling procedure
"switch_task."  No interrupt driven context switching is done, because
it's a hassle.

See accompanying files for documentation and examples.}


{$F+}  {Most procedures in this unit must be FAR}


INTERFACE


{Result codes.  0 is "no error"}

CONST
  heap_full       = 1;   {Unable to allocate heap for the task's stack}
  too_many_tasks  = 2;   {Maximum number of tasks are already running}
  invalid_task_id = 3;   {There is no task with that ID number}


{This is the procedure type for a task.  The parent task can pass any
type of variable to  the child task.}

TYPE
  task_proc = PROCEDURE (VAR param);


{See the IMPLEMENTATION section for descriptions of these procedures and
functions.}

PROCEDURE create_task
  (
  task      : task_proc;
  VAR param ;
  stack_size: Word;
  VAR id    : Word;
  VAR result: Word
  );
PROCEDURE terminate_task (id: Word; VAR result: Word);
PROCEDURE switch_task;
FUNCTION current_task_id: Word;
FUNCTION number_of_tasks: Word;


IMPLEMENTATION


{The maximum number of tasks.  Modify to suit your needs.}

CONST
  max_tasks = 16;


{This record contains all the information about a task, as follows:

  stack_ptr:   Saved stack segment (ss) and stack pointer (sp) registers

  stack_org:   If the stack is stored on the heap, this is the address of
               the beginning of the block of memory allocated for the stack.

  stack_bytes: Size of stack on the heap, or 0 if the stack is not on the
               heap.  If the stack is not on the heap, then this field is 0.

  bp:          Saved value of base pointer (BP) register.

  id:          The id number of the task

Note that DS (Data Segment register) is not stored.  We can get away with
this by assuming that all tasks will use the same data segment.}

TYPE
  task_rec =
    RECORD
    stack_ptr  : Pointer;
    stack_org  : Pointer;
    stack_bytes: Word;
    bp         : Word;
    id         : Word;
    END;


{The number of tasks in the system}

VAR
  ntasks: Word;


{Information for each task.}

VAR
  task_info: ARRAY [1..max_tasks] OF task_rec;


{The last task ID assigned.  If we haven't rolled the id's over, then
this allows us to assign task ID's without checking to see what id's have
been assigned.}

VAR
  last_id    : Word;
  id_rollover: Boolean;


{This is the task number of the currently executing task}

VAR
  current_task: Word;


{This is the record type of the initial contents of the stack when a task
is created.  When the task is first switched to, it will be from within
the switch_task, terminate_task, or terminate_current_task procedure.  At
the end of switch_task, BP will be popped, then a far return will be
done.  The far return will transfer to the beginning of task.  The task
can access the parameter "task_param," which is a pointer to whatever
data structure that the creator of this task wanted to pass to the new
task.  When the task finally exits, a far return to "end_task" will be
done.  The exception is the main task, which ends the program completely
if it exits.}

TYPE
  initial_stack_rec_ptr = ^initial_stack_rec;
  initial_stack_rec =
    RECORD
    bp        : Word;
    task_addr : task_proc;
    end_task  : Pointer;
    task_param: Pointer;
    END;


{Given a task ID, return the task number, or 0 if there is no task with
that ID.}

FUNCTION find_task (target_id: Word): Word;
VAR
  n: Word;
BEGIN
  n := 1;
  WHILE (n <= ntasks) AND (task_info [n].id <> target_id) DO
    Inc (n);
  IF (n > ntasks) THEN
    n := 0;
  find_task := n
END;


{Remove a task's information from the task info array, and decrement the
number of tasks.}

PROCEDURE delete_task_info (task_num: Word);
VAR
  i: Word;
BEGIN
  FOR i := task_num TO ntasks - 1 DO
    task_info [i] := task_info [i + 1];
  Dec (ntasks)
END;


{Terminate the current task.  If the current task is the only task, then
the program is halted.  If the current task's stack was allocated from
the heap, it is freed.}

PROCEDURE terminate_current_task;


{These are defined as constants to force them into the data segment.
They can't be local, because local variables are stored on the stack and
we're going to switch to a different task (and therefore to a different
stack) before we're done with these variables.}

CONST
  old_stack_org  : Pointer = NIL;
  old_stack_bytes: Word = 0;


VAR
  task_num : Word;
  new_stack: Pointer;
  new_bp   : Word;


BEGIN {terminate_current_task}

  {If we're the last task left, then exit to DOS}

  IF ntasks <= 1 THEN
    Halt;

  {Remember where the task's stack is so that we can free it up if it's
  on the heap.  We can't free it now, because we're still using it!}

  WITH task_info [current_task] DO
    BEGIN
    old_stack_org   := stack_org;
    old_stack_bytes := stack_bytes
    END;

  {Remove the task's information from the task info array}

  delete_task_info (current_task);
  IF current_task > ntasks THEN
    current_task := 1;

  {Switch to the next task.  The stack_ptr and bp are transfered into
  local variables because it's much easier to access simple variables in
  INLINE code than it is to access array variables.}

  WITH task_info [current_task] DO
    BEGIN
    new_stack := stack_ptr;
    new_bp    := bp
    END;
  INLINE
    (
    $8b/$86/>new_stack+0/     {MOV  AX,[BP].NEW_STACK+0}
    $8b/$96/>new_stack+2/     {MOV  DX,[BP].NEW_STACK+2}
    $8b/$ae/>new_bp/          {MOV  BP,[BP].NEW_BP}
    $fa/                      {CLI}
    $8e/$d2/                  {MOV  SS,DX}
    $8b/$e0/                  {MOV  SP,AX}
    $fb                       {STI}
    );

  {If the task we just got rid of had its heap on the stack, then release
  that memory back to the free pool.}

  IF old_stack_bytes > 0 THEN
    FreeMem (old_stack_org, old_stack_bytes)

END;


{Terminate a task.  If task_id is 0, then the current task is deleted.
Possible result codes are:

  0                   No error
  invalid_task_id     There is no task with that ID number}

PROCEDURE terminate_task (id: Word; VAR result: Word);


  {Delete a task.  Do not use to delete the current task!}

  PROCEDURE delete_task (task_num: Word);
  BEGIN
    WITH task_info [task_num] DO
      IF stack_bytes > 0 THEN
        FreeMem (stack_org, stack_bytes);
    delete_task_info (task_num);
    IF current_task > task_num THEN
      Dec (current_task)
  END;


VAR
  task_num: Word;

BEGIN {terminate_task}
  result := 0;
  IF id = 0 THEN
    terminate_current_task
  ELSE
    BEGIN
    task_num := find_task (id);
    IF task_num = 0 THEN
      result := invalid_task_id
    ELSE
      IF task_num = current_task THEN
        terminate_current_task
      ELSE
        delete_task (task_num)
    END
END;


{Create a new task and pass parameter "param" to it.  Stack space for the
task is allocated from the heap, and the stack is initialized so that
procedure "new_task" will be executed with parameter "param".  Result
codes are:

  0                  No error occured
  heap_full          Unable to allocate heap for the task's stack
  too_many_tasks     Maximum number of tasks are already running

If an error occurs, then id is not set.  Otherwise, id is the task id of
the newly created task.}

PROCEDURE create_task
  (
  task      : task_proc;
  VAR param ;
  stack_size: Word;
  VAR id    : Word;
  VAR result: Word
  );


{This is the task number of the task we're creating}

VAR
  task_num: Word;


  {Allocate stack space for the task.  The minimum allowable requested
  stack size is 512 bytes.  For some reason, the stack-check procedure in
  Turbo's run-time library has that limit hard-coded into it.

  stack_org is set to the address of the beginning of the block of memory
  allocated for the stack.

  stack_bytes is set to the size of the block of memory allocated for the
  stack.}

  PROCEDURE create_stack;
  BEGIN
    IF stack_size < 512 THEN
      stack_size := 512;
    IF stack_size > MaxAvail THEN
      result := heap_full
    ELSE
      WITH task_info [task_num] DO
        BEGIN
        GetMem (stack_org, stack_size);
        stack_bytes := stack_size
        END
  END;


  {Initialize the stack and the stack pointer.  The structure
  "initial_stack_rec" is placed at the top of the stack area, with the
  stack pointer pointing to its lowest element.  See the comments for
  initial_stack_rec for what the stuff in initial_stack_rec actually
  does.}

  PROCEDURE init_stack;
  VAR
    stack_ofs: Word;
  BEGIN
    WITH task_info [task_num] DO
      BEGIN
      stack_ofs := Ofs (stack_org^) + stack_bytes - Sizeof (initial_stack_rec);
      stack_ptr := Ptr (Seg (stack_org^), stack_ofs);
      bp := Ofs (stack_ptr^);
      WITH initial_stack_rec_ptr (stack_ptr)^ DO
        BEGIN
        task_param := @param;
        task_addr  := task;
        end_task   := @terminate_current_task;
        bp         := 0
        END
      END
  END;


  {Find an unused task id and assign it to the new task}

  PROCEDURE assign_task_id;


    {Increment "last_id" to (hopefully) turn it into the task_id we're
    going to assign.  If it rolls over, set it to 2 (task 1 will always
    exist, since it's the root task) and remember that we've rolled
    over.}

    PROCEDURE increment_last_id;
    BEGIN
      IF last_id = 65535 THEN
        BEGIN
        last_id := 2;
        id_rollover := True
        END
      ELSE
        Inc (last_id)
    END;


  BEGIN {assign_task_id}
    increment_last_id;
    IF id_rollover THEN
      WHILE (find_task (last_id) <> 0) DO
        increment_last_id;
    id := last_id;
    task_info [task_num].id := id
  END;


BEGIN {create_task}
  result := 0;
  IF ntasks >= max_tasks THEN
    result := too_many_tasks
  ELSE
    BEGIN
    task_num := Succ (ntasks);
    create_stack;
    IF result = 0 THEN
      BEGIN
      init_stack;
      assign_task_id;
      Inc (ntasks)
      END
    END
END;


{Switch to the next task}

PROCEDURE switch_task;

VAR
  new_stack: Pointer;
  old_bp   : Word;
  new_bp   : Word;

BEGIN

  {Only switch if there are other tasks to switch to}

  IF ntasks > 1 THEN
    BEGIN

    {Save the current value of SS, SP, and BP for this task}

    INLINE
      (
      $89/$ae/>old_bp           {MOV  OLD_BP,BP}
      );
    WITH task_info [current_task] DO
      BEGIN
      stack_ptr := Ptr (Sseg, Sptr);
      bp        := old_bp
      END;

    {Switch to the next task.  The bit with new_stack and new_bp are
    because it's easier to write INLINE code to access a simple variable
    than it is to access a record of an array.}

    IF current_task >= ntasks THEN
      current_task := 1
    ELSE
      Inc (current_task);
    WITH task_info [current_task] DO
      BEGIN
      new_stack := stack_ptr;
      new_bp    := bp
      END;
    INLINE
      (
      $8b/$86/>new_stack+0/     {MOV  AX,[BP].NEW_STACK+0}
      $8b/$96/>new_stack+2/     {MOV  DX,[BP].NEW_STACK+2}
      $8b/$ae/>new_bp/          {MOV  BP,[BP].NEW_BP}
      $Fa/                      {CLI}
      $8e/$d2/                  {MOV  SS,DX}
      $8b/$e0/                  {MOV  SP,AX}
      $fb                       {STI}
      )
    END
END;


{Return the id number of the currently executing task}

FUNCTION current_task_id: Word;
BEGIN
  current_task_id := task_info [current_task].id
END;


{Return the number of tasks}

FUNCTION number_of_tasks: Word;
BEGIN
  number_of_tasks := ntasks
END;


{Initialize this unit.  The task list is initialized to contain the
current task, whose task id is 1.}

PROCEDURE init_mtask;
VAR
  id: Word;
BEGIN
  ntasks := 1;
  current_task := 1;
  WITH task_info [current_task] DO
    BEGIN
    stack_org   := NIL;
    stack_bytes := 0;
    id          := 1
    END;
  last_id := 1;
  id_rollover := False
END;


BEGIN {mtask}
  init_mtask
END.