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

    :Program.    Coroutines.mod
    :Contents.   Coroutine support NEWPROCESS, TRANSFER
    :Author.     Nicolas Benezan [bne]
    :Address.    Postwiesenstr. 2, D7000 Stuttgart 60
    :Phone.      711/333679
    :Copyright.  Publc Domain
    :Language.   Oberon
    :Translator. AMOC - AMiga Oberon Compiler V1.12 [fbs]
    :History.    V1.0 [bne] 07.Jun.1990
    :History.    V1.1 [bne] 09.Jun.1990 (+ RestoreStack, compiler 1.08)
    :History.    V1.2 [bne] 20.Jun.1990 (compiler 1.12)

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

MODULE Coroutines;

IMPORT e: Exec, ol: OberonLib, s: SYSTEM;

TYPE
  PROC* = PROCEDURE ();
  PROCESS* = POINTER TO ProcessFrame;
  ProcessFrame = STRUCT
    spLower: e.ADDRESS;
    task: e.TaskPtr;
    oldA5: LONGINT;
    return: PROC;
    dest: PROCESS;
    source: POINTER TO PROCESS;
    exit: PROC;
  END;

VAR
  MainStackBase: e.ADDRESS;
  HaltProc: PROCEDURE ();
  Task: e.TaskPtr;

(* $OvflChk- $RangeChk- $StackChk- $NilChk- $ReturnChk- $CaseChk- *)

PROCEDURE *Error;
  BEGIN
    HALT (20);
  END Error;

PROCEDURE NewProcess* (    Proc: PROC;
                           StackBase: e.ADDRESS;
                           StackSize: LONGINT;
                       VAR New: PROCESS);
  BEGIN
    New:= StackBase + StackSize - s.SIZE (ProcessFrame);
    New.spLower:= StackBase;
    New.task:= e.FindTask (NIL);
    New.return:= Proc;
    New.exit:= Error;
  END NewProcess;

PROCEDURE Transfer* (VAR Source: PROCESS;
                         Destination: PROCESS);
  VAR
    SpLower: e.ADDRESS;
    Task: e.TaskPtr;
  BEGIN
    Task:= e.FindTask (NIL);
    SpLower:= Task.spLower;
    Source:= s.REG (15);
    IF FALSE THEN END; (* trick: enforce reloading of lokal variables *)
    s.SETREG (15, Destination);
    Task.spLower:= SpLower;
  END Transfer;

PROCEDURE *RestoreStack;
  BEGIN
    Task.spLower:= MainStackBase;
    HaltProc;
  END RestoreStack;

BEGIN
  Task:= e.FindTask (NIL);
  MainStackBase:= Task.spLower;
  HaltProc:= ol.HaltProc;
  ol.HaltProc:= RestoreStack;
END Coroutines.