(*********************************************************************)
(* Title:	Threads of Control - Implementation		     *)
(* LastEdit:	"Wed Oct 31 16:58:05 1984" by Mick Jordan	     *)
(* Author: 	Mick Jordan					     *)
(* 		Copyright (C) 1984 by Acorn Research Centre	     *)
(*********************************************************************)

(* An implementation in terms of coroutines *)

IMPLEMENTATION MODULE Threads;
FROM SYSTEM IMPORT NEWPROCESS, PROCESS, WORD, ADDRESS, SIZE, TRANSFER;

FROM Storage IMPORT ALLOCATE, DEALLOCATE;

TYPE
    CoRoutine = PROCESS;
    Stack = POINTER TO ARRAY [0..1023] OF WORD;

    ThreadStatus = (Alive, Finished, Dead);
    Thread = POINTER TO ThreadState;
    ThreadState = RECORD
            link: Thread;            (* to next thread in list *)
            joinQueue: Thread;       (* list of processes waiting to Join *)
            state: CoRoutine;
            realForkee: Forkee;      (* user supplied procedure *)
            status: ThreadStatus;
            priority: Priority;
            stack: Stack;
            argOrResult: WORD;
        END (* record *);

    Mutex = POINTER TO RECORD
            isLocked: BOOLEAN;
            queue: Thread;
        END (* record *);

    Condition = POINTER TO RECORD
            wakeupWaiting: BOOLEAN;
            queue: Thread;
        END (* record *);

    ReadyQueue = ARRAY Priority OF Thread;

CONST
    StandardPriority = 10;
    
VAR currentThread: Thread;
    readyQueue: ReadyQueue;

PROCEDURE InitMutex(VAR mutex: Mutex);
    BEGIN
        NEW(mutex);
        WITH mutex^ DO
            isLocked := FALSE;
            queue := NIL;
        END (* with *);
    END InitMutex;

PROCEDURE InitCondition(VAR cv: Condition);
    BEGIN
        NEW(cv);
        WITH cv^ DO
            wakeupWaiting := FALSE;
            queue := NIL;
        END (* with *);
    END InitCondition;

PROCEDURE Acquire(VAR mutex: Mutex);
    BEGIN
        IF mutex^.isLocked THEN
            Queue.InsertAtTail(mutex^.queue, currentThread);
        ELSE
            mutex^.isLocked := TRUE;
            Queue.InsertAtTail(readyQueue[currentThread^.priority],
                               currentThread);
        END (* if *);
        RunNext;
    END Acquire;

PROCEDURE Release(VAR mutex: Mutex);
    VAR
        thread: Thread;
    BEGIN
        IF mutex^.queue # NIL THEN
            thread := Queue.RemoveFromHead(mutex^.queue);
            Queue.InsertAtTail(readyQueue[thread^.priority], thread);
        ELSE
            mutex^.isLocked := FALSE;
        END (* if *);
        Queue.InsertAtTail(readyQueue[currentThread^.priority], 
         currentThread);
        RunNext;
    END Release;

PROCEDURE Wait(VAR mutex: Mutex; VAR condition: Condition);
    VAR
        thread: Thread;
    BEGIN
        IF condition^.wakeupWaiting THEN
            condition^.wakeupWaiting := FALSE;
        ELSE
            Queue.InsertAtTail(condition^.queue, currentThread);
            (* release mutex *)
           IF mutex^.queue # NIL THEN
                thread := Queue.RemoveFromHead(mutex^.queue);
                Queue.InsertAtTail(readyQueue[thread^.priority], thread);
            ELSE
                mutex^.isLocked := FALSE;
            END (* if *);
            RunNext;
            Acquire(mutex);
        END;
    END Wait;

PROCEDURE Signal(VAR cv: Condition);
    VAR
        thread: Thread;
    BEGIN
        IF cv^.queue = NIL THEN
            cv^.wakeupWaiting := TRUE;
        ELSE
            thread := Queue.RemoveFromHead(cv^.queue);
            Queue.InsertAtTail(readyQueue[thread^.priority], thread);
        END (* if *);
        Queue.InsertAtTail(readyQueue[currentThread^.priority],
                           currentThread);
        RunNext;
    END Signal;

PROCEDURE Broadcast(VAR cv: Condition);
    VAR
        thread: Thread;
    BEGIN
        IF cv^.queue = NIL THEN
            cv^.wakeupWaiting := TRUE;
        ELSE
            thread := Queue.RemoveFromHead(cv^.queue);
            WHILE thread # NIL DO
                Queue.InsertAtTail(readyQueue[thread^.priority], thread);
                thread := Queue.RemoveFromHead(cv^.queue);
            END (* while *);
        END (* if *);
        Queue.InsertAtTail(readyQueue[currentThread^.priority],
                           currentThread);
        RunNext;
    END Broadcast;

PROCEDURE Fork(forkee: Forkee; forkeeArg: ForkeeArg): Thread;
    VAR
        thread: Thread;
    BEGIN
        NEW(thread);
        WITH thread^ DO
          NEW(stack);
          NEWPROCESS(RunForkee, ADDRESS(stack), SIZE(stack^), state);
          argOrResult := forkeeArg;
          realForkee := forkee;
          joinQueue := NIL;
          priority := currentThread^.priority;
          status := Alive;
        END;
        Queue.InsertAtTail(readyQueue[thread^.priority], thread);
        Queue.InsertAtTail(readyQueue[currentThread^.priority], 
                           currentThread);
        RunNext;
        RETURN thread
    END Fork;

PROCEDURE CurrentThread(): Thread;
    BEGIN
      RETURN(currentThread);
    END CurrentThread;
  
PROCEDURE RunForkee;
(* This procedure is the place that the first TRANSFER
takes place to.  Now we can call the 'forkee' with the
argument passed in 'Fork'
*)
  VAR
    thread: Thread;
  BEGIN
    WITH currentThread^ DO
      argOrResult := realForkee(argOrResult);
      (* another thread may have tried to Join *)
      IF joinQueue # NIL THEN
        thread := Queue.RemoveFromHead(joinQueue);
        WHILE thread # NIL DO
          Queue.InsertAtTail(readyQueue[thread^.priority], thread);
          thread := Queue.RemoveFromHead(joinQueue);
        END;
      END;
      (* we can now safely destroy currentThread.
      Actually we cant dispose the ThreadState cos RunNext
      needs it to do the transfer.
      *)
      status := Finished;
      DISPOSE(stack);
      (* DISPOSE(currentThread); *)
    END;
    RunNext;
  END RunForkee;

PROCEDURE Join(thread: Thread): ForkeeReturn;
  BEGIN
    IF thread^.status = Alive THEN
        Queue.InsertAtTail(thread^.joinQueue, currentThread);
        RunNext;
    ELSE
        currentThread^.argOrResult := thread^.argOrResult;
    END;
    (* when control returns here 'thread' must have completed,
       and 'RunForkee' will have copied its result to
       (what is now) currentThread^.argOrResult 
    *)
    RETURN currentThread^.argOrResult
  END Join;

PROCEDURE GetPriority(thread: Thread): Priority;
  BEGIN
    RETURN(thread^.priority);
  END GetPriority;

PROCEDURE SetPriority(thread: Thread; priority: Priority);
  VAR
    currentPriority: Priority;
    tail, current, prev: Thread;
  BEGIN
    (* If the thread is not in the ready queue, then I claim (with Mick's
       assiatance) that nothing needs to be done.  If it is not ready
       then it is running or blocked in which case it will be placed on
       the proper ready queue when the time comes.  
       If it is on the ready queue, then it needs to be moved to the
       right queue now.
    *)
    currentPriority := thread^.priority;
    tail := readyQueue[currentPriority];
    IF (currentPriority # priority) AND (tail # NIL) THEN
      (* Try to find the thread on the ready queue *)
      current := tail^.link;
      prev := tail;
      WHILE (current # thread) AND (current # tail) DO
        prev := current;
        current := current^.link;
      END;
      
      IF current = thread THEN
        (* remove current from queue *)
        IF prev = current THEN
          (* single item queue - now empty *)
          readyQueue[currentPriority] := NIL;
        ELSE
          prev^.link := current^.link;
        END;
        
        thread^.priority := priority;
        Queue.InsertAtTail(readyQueue[priority], thread);
      END;
    END;
    Queue.InsertAtTail(readyQueue[currentThread^.priority], 
                       currentThread);
    RunNext;
  END SetPriority;
  
PROCEDURE RunNext;
    VAR
        oldThread: Thread;
        i: Priority;
    BEGIN
        oldThread := currentThread;
        i := HighestPriority;
        (* We are theoretically guaranteed that there is at least one process
           additionally eventually i will get a range fault or some bogus 
           thread will be found at a random address preceding the readyQueue.
        *)
        WHILE readyQueue[i] = NIL DO
          INC(i);
        END;
        IF i > LowestPriority THEN
            HALT  (* Empty ready queue *)
        ELSE
            currentThread := Queue.RemoveFromHead(readyQueue[i]);
            TRANSFER(oldThread^.state, currentThread^.state);
        END;
    END RunNext;

(* ----------------------------------------------------------------------- *)

MODULE Queue;

IMPORT Thread;

EXPORT QUALIFIED InsertAtTail, RemoveFromHead;

PROCEDURE InsertAtTail(VAR q: Thread; p: Thread);
    BEGIN
        IF q = NIL THEN
            p^.link := p;
        ELSE
            p^.link := q^.link; (* connect to head *)
            q^.link := p;       (* connect old tail to new *)
        END (* if *);
        q := p;
    END InsertAtTail;

PROCEDURE RemoveFromHead(VAR q: Thread): Thread;
    VAR
        head: Thread;
    BEGIN
        IF q = NIL THEN
            head := NIL
        ELSE
            head := q^.link;
            q^.link := head^.link;
            IF head = q THEN
                q := NIL;
            END (* if *);
        END (* if *);
        RETURN head;
    END RemoveFromHead;

END Queue;

PROCEDURE InitReadyQueue();
  VAR
    i: Priority;
  BEGIN
    FOR i:= HighestPriority TO LowestPriority DO
      readyQueue[i] := nilThread;
    END;
  END InitReadyQueue;
  
BEGIN
    nilThread := NIL;
    InitReadyQueue();
    
    (* create anonymous main thread *)
    NEW(currentThread);
    WITH currentThread^ DO
      joinQueue := NIL;
      status := Alive;
      priority := StandardPriority;
    END;
END Threads.