(*
  .name       Threads
  .task       multithreading
  .release    1.0
  .language   Oberon-2
  .translator Amiga Oberon 3.11
  .system     AmigaOS 2.04/2.1/3.0
  .author     J. Barheine
  .address    Hochgrevestr. 3
  .copyright  (c) 1995 by J. Barheine
*)

(* .info: 06/09/93, 15:35:27, version 00 *)

MODULE Threads;

IMPORT
  SYS:= SYSTEM,

  Dos,
  Exec,
  K:= Kernel,
  OberonLib;

TYPE
  Waiting = UNTRACED POINTER TO WaitingDesc;
  Thread* = UNTRACED POINTER TO ThreadDesc;

  ThreadProc* = PROCEDURE (data: K.ANY): K.ANY;

  ThreadDesc* = RECORD (K.ANYDesc)
    next: Thread;                 (* link *)
    dosProcess: Dos.ProcessPtr;   (* AmigaOS-Thread *)
    done: BOOLEAN;                (* terminated? *)
    data: K.ANY;                  (* passed data *)
    result: K.ANY;                (* result of this thread *)
    taskTrapData: OberonLib.TaskTrapData;
    proc: ThreadProc;             (* The main thread procedure *)
    waiting: Waiting;             (* thread waiting for our termination *)
  END;

  WaitingDesc = RECORD (K.ANYDesc)
    next: Waiting;                (* link *)
    task: Exec.TaskPtr;           (* waiting task *)
  END;

VAR
  threadList: Thread;
  startThreadProc: Thread;
  sema: Exec.SignalSemaphore;
  wakeUpSig: INTEGER;
  defStackSize: LONGINT;
  dataIndex: INTEGER;  (* taskTrapData.user[] - index *)

PROCEDURE ChildHaltProc;

VAR
  p, q: Thread;

CONST
  rts = 4E75H;

BEGIN
  p:= SYS.VAL(Thread, OberonLib.execBase.thisTask.trapData.user[dataIndex]);
  Exec.ObtainSemaphore(sema);
  Exec.Forbid;
  p.done:= TRUE;
  WHILE p.waiting # NIL DO
    Exec.Signal(p.waiting.task, LONGSET{wakeUpSig});
    p.waiting:= p.waiting.next;
  END;
  IF p = threadList THEN
    threadList:= p.next
  ELSE
    q:= threadList;
    WHILE q.next # p DO q:= q.next END;
    q.next:= p.next;
  END;
  Exec.ReleaseSemaphore(sema);
  SYS.SETREG(15, OberonLib.execBase.thisTask.trapData.oldSP);
  SYS.INLINE(rts);
END ChildHaltProc;

PROCEDURE Call(p: Thread);

BEGIN
  p.result:= p.proc(p.data);
  ChildHaltProc;
END Call;

(* $StackChk- *)

PROCEDURE StartProc;

BEGIN
  startThreadProc:= SYS.VAL(Thread, OberonLib.execBase.thisTask.trapData.user[dataIndex]);
  Call(startThreadProc);
END StartProc;


PROCEDURE StartThread;  (* sets A5 and trapData.oldSP *)

BEGIN
  OberonLib.SetA5;
  (* $IF SmallData *)
  OberonLib.execBase.thisTask.trapData.oldSP:= SYS.REG(15);
  (* $ELSE *)
  OberonLib.execBase.thisTask.trapData.oldSP:= SYS.VAL(LONGINT, SYS.REG(15))-4;
  (* $END *)
  StartProc;
END StartThread;

(* $StackChk= *)

(* run proc in a seperate thread *)
PROCEDURE RunInThread* (proc: ThreadProc; data: K.ANY; priority: SHORTINT): Thread;

VAR
  p: Thread;
  msg: Dos.ProcessId;

BEGIN
  NEW(p);
  p.taskTrapData:= OberonLib.execBase.thisTask.trapData^;
  p.taskTrapData.haltProc:= ChildHaltProc;
  p.taskTrapData.user[dataIndex]:= SYS.VAL(SYS.ADDRESS, p);
  p.data:= data;
  p.proc:= proc;
  p.done:= FALSE;

  Exec.ObtainSemaphore(sema);
  Exec.Forbid;
  p.dosProcess:= Dos.CreateNewProcTags(Dos.npEntry, SYS.VAL(SYS.ADDRESS, StartThread),
                                      Dos.npStackSize, defStackSize,
                                      Dos.npPriority , priority);
  IF p.dosProcess # NIL THEN
    p.dosProcess.task.trapData:= SYS.ADR(p.taskTrapData);
    p.dosProcess.task.trapCode:= Exec.exec.thisTask.trapCode;
    p.next:= threadList;
    threadList:= p;
  ELSE
    p:= NIL;
  END;
  Exec.Permit;
  Exec.ReleaseSemaphore(sema);

  RETURN p;
END RunInThread;


(* wait for p to terminate *)
PROCEDURE (p: Thread) Wait* (): K.ANY;

VAR
  wait: Waiting;

BEGIN
  Exec.ObtainSemaphore(sema);
  IF ~p.done THEN
    NEW(wait);
    wait.task:= Exec.exec.thisTask;
    wait.next:= p.waiting;
    p.waiting:= wait;
    Exec.ReleaseSemaphore(sema);
    REPEAT UNTIL p.done OR (wakeUpSig IN Exec.Wait(LONGSET{wakeUpSig}));
  ELSE
    Exec.ReleaseSemaphore(sema);
  END;
  RETURN p.result;
END Wait;

(* check if p is still running *)
PROCEDURE (p: Thread) IsRunning* (): BOOLEAN;

BEGIN
  RETURN ~p.done
END IsRunning;

(* wait for all threads to terminate *)
PROCEDURE WaitForAllThreads* ;

VAR
  p: Thread;

BEGIN
  LOOP
    Exec.ObtainSemaphore(sema);
    p:= threadList;
    Exec.ReleaseSemaphore(sema);
    IF p = NIL THEN EXIT END;
    IF p.Wait()=NIL THEN END;
  END;
END WaitForAllThreads;

BEGIN
  Exec.InitSemaphore(sema);
  threadList:= NIL;
  defStackSize:= OberonLib.OldSP.stackSize;
  wakeUpSig:= Exec.AllocSignal(-1);
  dataIndex:= OberonLib.AllocUser();
  IF (wakeUpSig < 0) OR (dataIndex < 0) THEN HALT(20) END;

CLOSE
  WaitForAllThreads;

  IF wakeUpSig >= 0 THEN Exec.FreeSignal(wakeUpSig) END;
  IF dataIndex >= 0 THEN OberonLib.FreeUser(dataIndex) END;
END Threads.