(**********************************************************************

    :Program.    TaskSupport.mod
    :Contents.   multitasking, creates true Dos-processes
    :Support.    Bernd Preusing's module "MultiTasking" helped me a lot!
    :Author.     Nicolas Benezan [bne]
    :Address.    Postwiesenstr. 2, D7000 Stuttgart 60
    :Phone.      711/333679
    :Copyright.  Public Domain
    :Language.   Modula-2, INLINE code
    :Translator. M2Amiga A+L V3.27d! Check LaunchTask() if other V. !!!
    :History.    V1.0 [bne] 09.Jan.1990 (exec tasks only)
    :History.    V1.1 [bne] 10.Jan.1990 (+ dos processes)

**********************************************************************)

IMPLEMENTATION MODULE TaskSupport;

FROM Arts        IMPORT stackTop, TermProcedure;
FROM Dos         IMPORT FileHandlePtr, Process, ProcessId, ProcessPtr;
FROM Exec        IMPORT AddHead, AddTask, AllocEntry, Byte, execBase,
                        FindTask, Forbid, MemEntry, MemList, MemReqs,
                        MemReqSet, MinList, MinNode, MsgPortAction,
                        NodeType, Permit, Remove, RemTask, sigChild,
                        sigDos, Signal, Task, TaskFlags, TaskFlagSet,
                        TaskPtr, Wait;
FROM ExecSupport IMPORT CreatePort, DeletePort, NewList;
FROM SYSTEM      IMPORT ADDRESS, ADR, BPTR, CAST, INLINE, LONGSET, REG,
                        SETREG;

TYPE
  TaskMemList = RECORD
    memList: MemList;
    taskEntry: MemEntry;
    stackEntry: MemEntry;
    argEntry: MemEntry;
  END;
  TaskMemListPtr = POINTER TO TaskMemList;
  TaskExtension = RECORD
    node: MinNode;
    stack: ADDRESS;
    proc: TaskProc;
    arg: ADDRESS;
    me: TaskPtr;
    father: TaskPtr;
  END;
  TaskExtensionPtr = POINTER TO TaskExtension;
  MinExtension = RECORD
    node: MinNode;
    stack: ADDRESS;
  END;

VAR
  TaskList: MinList;
  MainExtension: MinExtension;
  MainProcess: ProcessPtr;
  GlobVec, WindowPtr: ADDRESS;
  StdIn, StdOut: FileHandlePtr;
  ConsoleTask, FileSystemTask: ProcessId;

(* $R- $S- $V- *)
CONST
  RTS = 04E75H;

PROCEDURE LaunchTask (ThisTask{11}: TaskPtr;
                      Unused{10}: ADDRESS;
                      FakeReg{8}: TaskExtensionPtr); (* $E- *)
  BEGIN
    FakeReg:= ThisTask^.userData;
    stackTop:= FakeReg^.stack;
    INLINE (RTS);
  END LaunchTask;

PROCEDURE SwitchTask (ThisTask{11}: TaskPtr;
                      Unused{10}: ADDRESS;
                      FakeReg{8}: TaskExtensionPtr); (* $E- *)
  BEGIN
    FakeReg:= ThisTask^.userData;
    FakeReg^.stack:= stackTop;
    INLINE (RTS);
  END SwitchTask;
(* $R= $S= $V= *)

PROCEDURE RemoveTask (ExtensionPtr: TaskExtensionPtr);
  BEGIN
    Forbid;
    Remove (ExtensionPtr);
    RemTask (ExtensionPtr^.me);
    Permit;
  END RemoveTask;

PROCEDURE StartTask;
  VAR
    ExtensionPtr: TaskExtensionPtr;
    ThisProcess: ProcessPtr;
  BEGIN
    ThisProcess:= CAST (ProcessPtr, FindTask (NIL));
    ExtensionPtr:= ThisProcess^.task.userData;
    WITH ExtensionPtr^ DO
      ThisProcess^.returnAddr:= REG (15);
      Signal (father, LONGSET{sigChild});
      proc (arg);
    END;
    RemoveTask (ExtensionPtr);
  END StartTask;

PROCEDURE CreateTask (Proc: TaskProc;
                      InitArg: ADDRESS;
                      Name: ADDRESS;
                      StackSize: LONGINT;
                      Priority: Byte): TaskPtr;
  CONST
    NodeTypeMsgPort = msgPort;
  VAR
    NewProcess: ProcessPtr; (* forget Dos.CreateProc ! *)
    TaskMem: TaskMemList;
    TaskMemPtr: TaskMemListPtr;
    ExtensionPtr: TaskExtensionPtr;
  BEGIN
    WITH TaskMem DO
      memList.numEntries:= 3;
      taskEntry.reqs  := MemReqSet{public, memClear};
      taskEntry.length:= SIZE (Process);
      stackEntry.reqs  := MemReqSet{memClear};
      stackEntry.length:= StackSize;
      argEntry.reqs  := MemReqSet{memClear};
      argEntry.length:= SIZE (TaskExtension);
    END;
    TaskMemPtr:= CAST (TaskMemListPtr, AllocEntry (ADR (TaskMem)));
    IF LONGINT (TaskMemPtr) > 0 THEN
      WITH TaskMemPtr^ DO
        NewProcess:= taskEntry.addr;
        ExtensionPtr:= argEntry.addr;
        WITH NewProcess^ DO
          WITH task DO
            spLower  := stackEntry.addr;
            spUpper  := spLower;
            INC (spUpper, StackSize);
            spReg    := spUpper;
            node.type:= process;
            node.pri := Priority;
            node.name:= Name;
            NewList (ADR (memEntry));
            AddHead (ADR (memEntry), TaskMemPtr);
            launch   := CAST (PROC, ADR (LaunchTask));
            switch   := CAST (PROC, ADR (SwitchTask));
            userData := ExtensionPtr;
          END;
          WITH msgPort DO
            node.type:= NodeTypeMsgPort;
            flags:= signal;
            sigBit:= sigDos;
            sigTask:= ADR (task);
            NewList (ADR (msgList));
          END;
          stackSize     := StackSize;
          globVec       := GlobVec;
          stackBase     := BPTR (task.spUpper);
          cis           := StdIn;
          cos           := StdOut;
          consoleTask   := ConsoleTask;
          fileSystemTask:= FileSystemTask;
          windowPtr     := WindowPtr;
          WITH ExtensionPtr^ DO
            stack:= LONGINT (task.spLower) + 512;
            proc:= Proc;
            arg:= InitArg;
            me:= ADR (task);
            father:= FindTask (NIL);
          END;
        END;
        Forbid;
        AddHead (ADR (TaskList), ExtensionPtr);
        AddTask (ADR (NewProcess^.task), ADR (StartTask), NIL);
        NewProcess^.task.flags:= TaskFlagSet{launch, switch};
        Permit;
        SETREG (0, Wait (LONGSET{sigChild}));
      END;
      RETURN ADR (NewProcess^.task)
    END;
    RETURN NIL
  END CreateTask;

PROCEDURE DeleteTask (Task: TaskPtr);
  VAR
    Node: TaskExtensionPtr;
  BEGIN
    Forbid;
    Node:= CAST (TaskExtensionPtr, TaskList.head);
    WHILE Node^.node.succ # NIL DO
      IF Node^.me = Task THEN
        RemoveTask (Node);
        Permit;
        RETURN
      END;
      Node:= CAST (TaskExtensionPtr, Node^.node.succ);
    END;
    Permit;
  END DeleteTask;

PROCEDURE Cleanup;
  BEGIN
    WHILE TaskList.head^.succ # NIL DO
      RemoveTask (CAST (TaskExtensionPtr, TaskList.head));
    END;
  END Cleanup;

PROCEDURE InstallLaunchSwitch;
  CONST
    LaunchSwitchFlags = TaskFlagSet{launch, switch};
  BEGIN
    Forbid;
    MainExtension.stack:= stackTop;
    WITH MainProcess^.task DO
      userData:= ADR (MainExtension);
      launch:= CAST (PROC, ADR (LaunchTask));
      switch:= CAST (PROC, ADR (SwitchTask));
      flags:= flags + LaunchSwitchFlags;
    END;
    Permit;
  END InstallLaunchSwitch;

BEGIN
  MainProcess:= CAST (ProcessPtr, FindTask (NIL));
  WITH MainProcess^ DO
    GlobVec       := globVec;
    StdIn         := cis;
    StdOut        := cos;
    ConsoleTask   := consoleTask;
    FileSystemTask:= fileSystemTask;
    WindowPtr     := windowPtr;
  END;
  NewList (ADR (TaskList));
  TermProcedure (Cleanup);
  InstallLaunchSwitch;
END TaskSupport.