qpkt(taskwait()) REPEAT


{ LET link, id, type, res1, res2 = notinuse, bouncetaskid, ?, ?, ?
  LET pkt = @link
  writef("Sending a packet 10 million times to task %n*n", bouncetaskid)
  FOR i = 1 TO 10_000_000 DO
  { qpkt(pkt)   // Send the packet
    taskwait()  // Wait for it to return
  }
  writef("Done*n")
}


LET sendpkt(link, id, type, r1, r2, a1, a2, a3, a4, a5, a6) = VALOF
{ UNLESS qpkt(@link)        DO abort(181)
  UNLESS taskwait() = @link DO abort(182)
  result2 := r2
  RESULTIS r1
}



{ writef("Sending a packet 10 million times to task %n*n", bouncetask)
  FOR i = 1 TO 1_000_000 DO sendpkt(notinuse, bouncetaskid)
  writef("Done*n")
}


LET delay(ticks) BE sendpkt(notinuse, clkdevid, ?,?,?, ticks)
\end{verbatim}
}


Although most of the flavour of Cintpos derives from the {\tt
  qpkt-taskwait} mechanism, it is worth briefly noting the other
kernel primitives. Tasks can be created and deleted using {\tt
  createtask} and {\tt deletetask}. The priority of a task can be
changed using {\tt changepri}. A task can be suspended by a call of
{\tt hold} causing it to stop execution until explicitly released by a
call of {\tt release}. These are analogous to the deprecated functions
{\tt suspend} and {\tt resume} in Java. Tasks each have a field of 32
flag bits that can be set and tested using {\tt setflags} and {\tt
  testflags}, and memory can be allocated and freed using {\tt getvec}
and {\tt freevec} which are somewhat similar to the C functions {\tt
  malloc} and {\tt free}.  Modules of compiled code can be loaded and
unloaded using {\tt loadseg} and {\tt unloadseg}.



c := fn(cowait(c)) REPEAT


bounce_co := createco(bouncefn, 200)
sender_co := createco(senderfn, 200)

LET bouncefn(val) BE val := cowait(val) REPEAT

LET senderfn(count) BE
{ writef("Calling the bounce coroutine %n times*n", count)
  FOR i = 1 TO count DO callco(bounce_co, i)
  writes("done*n")
}


callco(senderfn, 10_000_000)

LET gomultievent(maincofn, size) = VALOF
{ LET mainco = createco(maincofn, size)
  LET oldsendpkt, wkq = sendpkt, 0
  UNLESS mainco RESULTIS FALSE // Unsuccessful return
  multi_count, mainco_busy := 1,  FALSE
  sendpkt,    pktlist     := sndpkt, 0
  callco(mainco, 0)            // Ask mainco to start everything up

  WHILE multi_count>0 DO       // Start of the multi-event loop
  { LET pkt = taskwait()       // Wait for a packet
    LET co  = findpkt(pkt)     // Find which coroutine, if any, owns it
    IF co DO { callco(co, pkt); LOOP }
    IF mainco_busy DO          // If the main coroutine is busy
    { LET p = @wkq             // append the packet onto the
      WHILE !p DO p := !p      // end of the work queue
      !pkt, !p := 0, pkt
      LOOP
    }
    { callco(mainco, pkt)      // Give the packet to the main coroutine
      IF mainco_busy | wkq=0 BREAK
      pkt := wkq               // De-queue a waiting request
      wkq := !pkt
      !pkt := notinuse
    } REPEAT                   // Process the waiting request
  }

  sendpkt := oldsendpkt        // Return to single event mode
  deleteco(mainco)             // and delete the main coroutine
  RESULTIS TRUE                // Successful return
}

\item {\tt multi\_count.} This holds an indication of the amout of
  work still to be done in multi-event mode. It is typically
  incremented whenever a multi-event coroutine is created and
  decremented when it dies.  On reaching zero the task can return to
  single-event mode.
  
\item{\tt mainco\_busy.} This is initialised to {\tt FALSE} and is
  only {\tt TRUE} when the main coroutine is busy processing a request
  packet. it determines whether a new request packet can be processed
  now or must be queued.
  
\item {\tt pktlist.} This holds an initially empty list of nodes
  giving the mapping between packets and the coroutines that own them.
  This list is used by {\tt findpkt(}{\em pkt}{\tt)} to find the
  coroutine, if any, that is waiting for the given packet.

AND sndpkt(link, id, type, r1, r2, a1, a2, a3, a4, a5, a6) = VALOF
{ LET ocis, ocos, ocurrentdir = cis, cos, currentdir
  // The following three variables form the pktlist node.
  LET next, pkt, co = pktlist, @link, currco
  pktlist := @next // Insert [next,pkt,co] as first node in pktlist
  UNLESS qpkt(pkt)    DO abort(181) // Dispatch the packet
  UNLESS cowait()=pkt DO abort(182) // and wait for the reply.
  // Restore the saved global state
  cis, cos, currentdir := ocis, ocos, ocurrentdir 
  result2 := r2    // Recover the two results
  RESULTIS r1
}



LET findpkt(pkt) = VALOF
{ LET a = @pktlist  // a is the address of the next link word
  { LET p = !a
    UNLESS p RESULTIS 0             // The packet was not found.
    IF p!1 = pkt DO { !a := !p      // Remove from pktlist and
                      RESULTIS p!2  // return the coroutine.
                    }
    a := p
  } REPEAT
}


kill_co := createco(deleteco, 100)

resumeco(kill_co, currco)


LET die() BE resumeco(kill_co, currco)


If {\tt kill\_co} is required it could conveniently be created and
deleted by the main coroutine of {\tt gomultievent}.


LET coread(ptr) = VALOF TEST !ptr
  THEN { LET cptr = !ptr
         !ptr := 0         // Clear the channel word
         RESULTIS resumeco(cptr, currco) // Get value from cowrite
       }
  ELSE { !ptr := currco    // Set channel word to this coroutine
         RESULTIS cowait() // Wait for value from cowrite
       }

LET cowrite(ptr, val) BE TEST !ptr
  THEN { LET cptr = !ptr
         !ptr := 0
         callco(cptr, val)      // Send val to the waiting coread
       }
  ELSE { !ptr := currco         // Wait for coread to be ready
         callco(cowait(), val)) // Send val to coread
       }





LET lock_logfile() BE
  TEST log_wait_queue = 0
  THEN log_wait_queue := -1            // Mark as locked
  ELSE { LET link, co = 0, currco      // Make lock node [link, co]
         TEST log_wait_queue=-1
         THEN log_wait_queue := @link  // Make a list of length one
         ELSE { LET p = log_wait_queue // or append the lock node
                WHILE !p DO p := !p    // to the end of the queue.
                !p := @link
              }
         cowait() // Suspend until unlock_logfile() is called
         // We now own the lock and log_wait_queue will be non zero
         }


LET unlock_logfile() BE
  TEST log_wait_queue = -1
  THEN log_wait_queue := 0             // Mark as unlocked
  ELSE { LET co = log_wait_queue!1     // Dequeue the first lock node
         log_wait_queue := !log_wait_queue
         UNLESS log_wait_queue DO log_wait_queue := -1
         callco(co) // Give control to the first coroutine
       }


UNTIL <complicated condition> DO wait(@condwaitlist)


notify(@condwaitlist)


LET wait(ptr) BE
{ // These form a waitlist node [link, cptr]
  LET link, cptr = !ptr, currco
  !ptr := @link  // Insert the node at the head of the list
  cowait()       // Suspend until the waiting condition
}                // may have changed.

LET notify(ptr) BE
{ // Wakeup all coroutines on the given  wait list 
  // so that they can each re-evaluate the condition.
  LET p = !ptr
  !ptr := 0  // Clear the condition wait list
  WHILE p DO { LET cptr = p!1; p := !p; callco(cptr) }
}




// This is a benchmark program for the coroutine mechanism

// Implemented in BCPL by Martin Richards (c) March 2004


GET "libhdr"

GLOBAL {
  kill_co: ug        // The killer coroutine
  source_co
  tracing
}

LET start() = VALOF
{ LET argv = VEC 50
  //LET k, n = 10_000, 10000
  LET k, n = 10_000, 500
  LET cptr = 0

  UNLESS rdargs("-k,-n,-t/S", argv, 50)
  { writef("Bad arguments for cobench*n")
    RETURN
  }

  IF argv!0 DO k := str2numb(argv!0)      // -k
  IF argv!1 DO n := str2numb(argv!1)      // -n
  tracing := argv!2                       // -t

  writef("*nCobench sending %n numbers via %n copy coroutines*n*n", k, n)

  kill_co := createco(deleteco, 200)

  cptr := createco(sinkfn, 200)

  FOR i = 1 TO n DO
  { LET co = createco(copyfn, 200)
    callco(co, cptr)
    cptr := co
  }

  source_co := createco(sourcefn, 200)
  callco(source_co, cptr)

  IF tracing DO writef("All coroutines created*n*n")

  callco(source_co, k) // Tell sourceco to send k numbers 

  deleteco(kill_co)

  writef("*nCobench done*n")
  RESULTIS 0
}

AND sourcefn(nextco) BE
{ LET k = cowait()
  LET channel = 0
  LET out_chan_ptr = @channel

  callco(nextco, out_chan_ptr)
 
  IF tracing DO
    writef("sourcefn: co=%n out_chan_ptr=%n k=%n*n*n", currco, out_chan_ptr, k)

  FOR val = 1 TO k DO
  { IF tracing DO writef("sourcefn: co=%n sending number %n*n", currco, val)
    cowrite(out_chan_ptr, val)
  }
  IF tracing DO writef("sourcefn: co=%n sending number %n*n", currco, 0)
  cowrite(out_chan_ptr, 0)
  IF tracing DO writef("sourcefn: co=%n dying*n", currco)
  die()
}

AND copyfn(nextco) BE
{ LET channel = 0
  LET in_chan_ptr, out_chan_ptr = cowait(), @channel
  callco(nextco, out_chan_ptr)
  IF tracing DO writef("copyfn:   co=%n in_chan_ptr=%n out_chan_ptr=%n*n",
                        currco, in_chan_ptr, out_chan_ptr)

  { LET val = coread(in_chan_ptr)
    IF tracing DO writef("copyfn:   co=%n copying number %n*n", currco, val)
    cowrite(out_chan_ptr, val)
    UNLESS val BREAK
  } REPEAT

  IF tracing DO writef("copyfn:   co=%n dying*n", currco)
  die()
}

AND sinkfn(in_chan_ptr) BE
{ IF tracing DO writef("sinkfn:   co=%n in_chan_ptr=%n*n", currco, in_chan_ptr)

  { LET val = coread(in_chan_ptr)
    IF tracing DO writef("sinkfn:   co=%n recving number %n*n", currco, val)
    UNLESS val BREAK
  } REPEAT

  IF tracing DO writef("sinkfn:   co=%n dying*n", currco)
  die()
}

AND coread(ptr) = VALOF
{ LET cptr = !ptr
  TEST cptr
  THEN { !ptr := 0             // Clear the channel word
         RESULTIS resumeco(cptr, currco)
       }
  ELSE { !ptr := currco    // Set channel word to this coroutine
         RESULTIS cowait() // Wait for value from cowrite
       }
}

AND cowrite(ptr, val) BE
{ LET cptr = !ptr
  TEST cptr
  THEN { !ptr := 0
         callco(cptr, val) // Send val to coread
       }
  ELSE { !ptr := currco
          callco(cowait(), val)
       }
}

AND die() BE RETURN //resumeco(kill_co, currco)




import Cortn.*;

public class Cobench
{

    static int k = 10000;
    static int n = 100;
    static boolean tracing = false;

    public static void main(String[] args)
    {
	try {

	    for (int i = 0; i < args.length; i++) {
		// System.out.println("arg[i] = " + args[i]);
		if (args[i].equals("-k")) {
		    k = Integer.parseInt(args[++i]);
		    continue;
		}
		
		if (args[i].equals("-n")) {
		    n = Integer.parseInt(args[++i]);
		    continue;
		}

		if (args[i].equals("-t")) {
		    tracing = true;
		    continue;
		}
	    }
	    
	} 
	catch (NumberFormatException e) {
	    System.err.println("Integer argument expected");
	}

	Cortn s = new root("root");
    }
}

abstract class ChannelCortn extends Cortn
{ 
    public ChannelCortn(String name) {
	super(name);
    }

    public Object coread(Channel chan) {
	Cortn cptr = chan.cptr;
        if (cptr!=null) {
	    chan.cptr = null;
	    return resumeco(cptr, this);
	} else {
	    chan.cptr = this;
	    return cowait(null);
	}
    }

    public void cowrite(Channel chan, Object val) {
	Cortn cptr = chan.cptr;
	if(cptr!=null) {
	    chan.cptr = null;
	    callco(cptr, val);
	} else {
	    chan.cptr = this;
	    callco((Cortn)cowait(null), val);
	}
    }
}

class root extends ChannelCortn
{
    public root(String name) {
	super(name);
    }

    public void run() {
	fn(new Integer(-1));
    }

    public Object fn(Object c) {
	int k = Cobench.k;
	int n = Cobench.n;
	Cortn cptr;

	System.out.println("Cobench sending " + k +
                           " numbers via " + n +
                           " copy coroutines");

	cptr = new Sinkfn(this, "sinkco");

        for(int i = 1; i<= n; i++) {
	    Cortn co = new Copyfn(this, "copyco");
	    callco(co, cptr);
	    cptr = co;
	}

        Cortn source_co = new Sourcefn(this, "sourcefn");
        callco(source_co, cptr);

	if(Cobench.tracing)
	    System.out.println("All coroutines created");

        callco(source_co, new Integer(k)); // Tell source_co to send k numbers

        System.out.println("Cobench done");

	System.exit(0);
	return null;
  }
}

class Channel {
    Cortn cptr;
}

class Sourcefn extends ChannelCortn
{
    public Sourcefn(Cortn parent, String name) {
	super(name);
    }

    public Object fn(Object c) {
        Cortn nextco = (Cortn)c;
	Channel channel = new Channel();
	int k = ((Integer)cowait(null)).intValue();
	if(Cobench.tracing) {
	    System.out.println("sourcefn: k = " + k);
	}
	callco(nextco, channel);

	for(int i=1; i<=k; i++) {
	    if(Cobench.tracing)
		System.out.println("sourcefn: sending value " + i);
	    cowrite(channel, new Integer(i));
	}
	if(Cobench.tracing)
	    System.out.println("sourcefn: sending value " + 0);
	cowrite(channel, new Integer(0));
	return null;
    }
}

class Copyfn extends ChannelCortn
{
    public Copyfn(Cortn parent, String name) {
	super(name);
    }

    public Object fn(Object c) {
        Cortn nextco = (Cortn) c;
	Channel in_channel = (Channel) cowait(null);
	Channel out_channel = new Channel();
	callco(nextco, out_channel);

        while(true) {
	    Object val = coread(in_channel);
	    int k = ((Integer)val).intValue();
	    if(Cobench.tracing)
		System.out.println("sourcefn: copying value " + k);
	    cowrite(out_channel, val);
            if(k==0) break;
	}

	return null;
    }
}

class Sinkfn extends ChannelCortn
{
    public Sinkfn(Cortn parent, String name) {
	super(name);
    }

    public Object fn(Object c) {
	Channel in_channel = (Channel)c;

        while(true) {
	    Object val = coread(in_channel);
	    int k = ((Integer)val).intValue();
	    if(Cobench.tracing)
		System.out.println("sourcefn: receiving value " + k);
            if(k==0) break;
	}

	return null;
    }
}








package Cortn;

public abstract class Cortn extends Thread
{ protected Cortn parent; // This coroutine's parent
  protected Object val;   // The value given to this coroutine
                          // when it was last given control
  protected String name = "no name";
  protected boolean forcewakeup;

  // internal support functions

  public synchronized void wakeup(Cortn parent, Object val)
  { // Wake up this coroutine
    // giving it the specified parent
    // and transferring the value val
    if (parent != null) this.parent = parent;
    this.val = val;
    forcewakeup = true;
    notify(); // Ensure this object's thread is not waiting
  }

  protected synchronized Object gotosleep()
  { // Cause this object's thread to wait
    // (unless just given a forcewakeup)
    if (!forcewakeup) {
      try { notify(); wait(); }
      catch(Exception e) {}
    }
    forcewakeup = false;
    return val;
  }

  // conventional coroutine API

  public Object callco(Cortn target, Object val)
  { target.wakeup(this, val);
    return gotosleep();
  }

  public Object resumeco(Cortn target, Object val)
  { target.wakeup(null, val);
    return gotosleep();
  }

  public Object cowait(Object val)
  { if (parent != null) parent.wakeup(null, val);
    return gotosleep();
  }

  public Cortn(String name)
  { this.name = name;

    synchronized(this) {
      start(); // Start this objects coroutine thread
      try { wait(); }
      catch(Exception e) {}
    }
  }

  public void run()
  { Object c = new Integer(-1);
    while(true) c = fn(cowait(c));
  }

  public abstract Object fn(Object c);
}
