/* (C) Copyright International Business Machines Corporation 23 January */
/* 1990.  All Rights Reserved. */
/*  */
/* See the file USERAGREEMENT distributed with this software for full */
/* terms and conditions of use. */
/* File: schedule.c */
/* Author: David F. Bacon */
#ifndef lint
static char sccsinfo[] = "@(#)schedule.c	1.8 3/13/90";
#endif

#include "ops.h"
#include "cherm.h"
#include "storage.h"
#include "trigger.h"

#include "predefined.cd"


#define CURPROC sched->ready

/* trigger handling for recursive invocations of mainloop */

trig *trigger_stack = nil;

/*****************************************************************************/
/*                         Scheduling Routines                               */
/*****************************************************************************/

/* These are the only routines that touch the scheduling queues */

void
init_scheduling(sched)
schedblock *sched;
{
  void suspend(), wakeup(), wakeup_proc(), kill_proc(), add_proc(); 
  void make_current(), advance();

				/* no processes exist yet */
  sched->ready = sched->blocked_nokey = sched->blocked = nil;
  sched->newprocs = nil;	/* no procs waiting to enter */
  sched->suspend = suspend;
  sched->wakeup = wakeup;
  sched->wakeup_proc = wakeup_proc;
  sched->kill = kill_proc;
  sched->add = add_proc;
  sched->make_current = make_current;
  sched->advance = advance;
}


/* Suspend the given proc with the given key.  Use a null key if you */
/* intend to wake this process up explicitly by giving its pcb.  Use */
/* a non-null key if you really intend to wake it via the key value */
static void
suspend(sched, proc, key)
schedblock *sched;
pcb *proc;
char *key;
{
  void unlink_proc(), link_proc();

  switch(proc->state) {
  case KILLED:
    nilerror("suspend", "Attempt to suspend a dead process");
    abort_nili("suspend");
  case BLOCKED:
    if (key is nil)
      /* if already suspended on nil key, leave it as is.  If */
      /* suspeneded on non-nil key, we can still leave it as is and */
      /* will be able to wake it up with wakeup_proc() if desired */
      /* later anyway.  So either way we do nothing. */
      ;
    else
      /* If already suspended on same key, do nothing.  If already */
      /* suspended on other non-nil key, this is an error.  If already */
      /* suspended on a nil key, just move it to the blocked-on-key */
      /* list.  It can still be awakened via wakeup_proc for prior */
      /* nil-key suspend. */
      if (proc->wake_key isnt key)
	if (proc->wake_key isnt nil) {
	  nilerror("suspend", "Attempt to suspend process on two keys");
	  abort_nili("suspend");
	}
	else {
	  if (proc isnt CURPROC)
	    unlink_proc(sched, proc); /* unlink proc from nil-key list */
	  proc->wake_key = key;	/* install wakeup key */
	  if (proc isnt CURPROC)
	    link_proc(sched, proc); /* add to currect queue if not current */
	}
    break;
  case READY:
  case REVIVED:
    if (proc isnt CURPROC)	/* remove proc from current list */
      unlink_proc(sched, proc);
    proc->wake_key = key;	/* set wakeup key and scheduling state */
    proc->state = BLOCKED;
    if (proc isnt CURPROC)
      link_proc(sched,proc);	/* add to correct queue if not current */
    break;
  }
}

/* Wake up all processes waiting on the given key.  A null key is */
/* invalid, since processes blocked on a null key must be revived */
/* explicitly using wakeup_proc(). */
static void
wakeup(sched, key)
schedblock *sched;
char *key;
{
  void wakeup_proc();

  pcb *p, *next = nil;

  if (key is nil) {
    nilerror("wakeup", "Attempt to wake up processes blocked on null key");
    abort_nili("wakeup");
  }
  for (p = sched->blocked; p isnt nil; p = next) {
    if ((next = p->next) is sched->blocked)
      next = nil;		/* last entry on list */
    if (p->wake_key is key)
      wakeup_proc(sched, p);
  }

  /* current process may have been blocked on this cycle */
  if (CURPROC isnt nil)
    if (CURPROC->state is BLOCKED and CURPROC->wake_key is key)
      wakeup_proc(sched, CURPROC);
}

/* Wake up the given process */
static void
wakeup_proc(sched, proc)
schedblock *sched;
pcb *proc;
{
  void unlink_proc(), link_proc();

  /* make sure schedblock is non-null, since there are a number of */
  /* places in the interpreter where nil is passed to finalization */
  /* routines and such, when it is known that no processes can be */
  /* revived by the operation */
  if (sched is nil) {
    nilerror("wakeup_proc", 
	     "Null schedblock... wakeup wasn't supposed to happen here");
    abort_nili("wakeup_proc");
  }

  switch(proc->state) {
  case READY:
  case REVIVED:
    /* nothing to do... maybe this should abort as a sanity check? */
    break;
  case KILLED:
    /* can't revive a dead proc */
    nilerror("wakeup_proc", "Attempt to revive a dead process");
    abort_nili("wakeup_proc");
  case BLOCKED:
    /* remove process from its blocking queue, and revive it */
    if (proc isnt CURPROC)
      unlink_proc(sched, proc);
    proc->state = REVIVED;
    if (proc isnt CURPROC)
      link_proc(sched, proc);
    break;
  }
}

/* Kill the given process by removing it from scheduler queues and */
/* discarding the pcb.  If the pcb is the primary pcb for a procedure, */
/* we don't discard the pcb since it might be re-used */

static void
kill_proc(sched, proc)
schedblock *sched;
pcb *proc;
{
  void unlink_proc();

  if (proc->state is KILLED) {
    nilerror("kill_proc", "Attempt to kill a dead process");
    abort_nili("kill_proc");
  }
  if (proc is CURPROC)		/* can't immediately unlink current proc */
    proc->state = KILLED;	/* but we can mark it as dead */
  else {
    unlink_proc(sched, proc);	/* remove proc from whatever list it's on */
    if (proc->type isnt ProcedurePrimaryFree)
      dispose(proc, pcb);	/* and discard the pcb */
  }
}

/* Add a new process to the ready list */
static void
add_proc(sched, proc)
schedblock *sched;
pcb *proc;
{
  proc->state = REVIVED;
  link_proc(sched, proc);
}

/* Make the given process the current process on the ready queue */
static void
make_current(sched, proc)
schedblock *sched;
pcb *proc;
{
  void unlink_proc();

  if (proc->state isnt READY) {
    nilerror("make_current", "Attempt to make non-READY process current");
    abort_nili("make_current");
  }
  if (CURPROC isnt proc) {
    unlink_proc(sched, proc);	/* unlink from current position */
    /* Note: ready list is guaranteed nonempty here */
    proc->next = sched->ready;	/* and add to the front (link_proc */
    proc->prev = sched->ready->prev; /* adds elsewhere) */
    proc->next->prev = proc;
    proc->prev->next = proc;
    sched->ready = proc;
  }
}

/* Call this routine at the end of each scheduled operation to perform */
/* any deferred updates required on the scheduling queues and to */
/* select a process to be scheduled next */

static void
advance(sched)
schedblock *sched;
{
  void unlink_proc(), link_proc(), pull_trigger();

  pcb *p, *next;
  status trigger_happy = FALSE;

  /* check whether the process sitting at the top of the trigger stack */
  /* will get revived this time around */
  if (trigger_stack isnt nil) {
    for (p = sched->newprocs; p isnt nil; p = next) {
      if ((next = p->next) is sched->newprocs)
	next = nil;
      if (p is trigger_stack->trigger)
	trigger_happy = TRUE;
    }
    /* current proc might also be revived (but this is weird) */
    if (CURPROC isnt nil)
      if (CURPROC->state is REVIVED and CURPROC is trigger_stack->trigger)
	trigger_happy = TRUE;
  }
  /* add any new or revived procs to the ready list by splicing the */
  /* lists together (ready list is guaranteed nonempty here) */
  if (sched->newprocs isnt nil) {
    /* change all REVIVED process states to READY */
    for (p = sched->newprocs; p isnt nil; p = next) {
      if ((next = p->next) is sched->newprocs)
	next = nil;
      p->state = READY;
    }
    if (CURPROC is nil)
      CURPROC = sched->newprocs;
    else {
      /* splice the lists */
      p = sched->newprocs->prev;
      CURPROC->prev->next = sched->newprocs;
      p->next = CURPROC;
      sched->newprocs->prev = CURPROC->prev;
      CURPROC->prev = p;
    }
    /* and empty the revival queue */
    sched->newprocs = nil;
  }

  /* if current proc is no longer READY, we need to adjust the queues */
  /* accordingly */
  if (CURPROC isnt nil) {
    if (CURPROC->state is REVIVED) /* might have been newly awakened */
      CURPROC->state = READY;
    if (CURPROC->state isnt READY) {
      /* can't use unlink_proc because state is inconsistent with */
      /* current queue */
      if ((p = CURPROC)->next is CURPROC)
	CURPROC = nil;
      else {
	p->next->prev = p->prev;
	CURPROC = p->prev->next = p->next;
      }
      if (p->state is KILLED) {
	/* don't discard free primary pcb for procedure, as it may get */
	/* re-used */
	if (p->type isnt ProcedurePrimaryFree)
	  dispose(p, pcb);
      }
      else
	link_proc(sched, p);
    }
    else
      /* old CURPROC is still ready... cycle ready list to next ready */
      /* proc */
      CURPROC = CURPROC->next;
  }
  /* pull the current trigger if its process was revived */
  if (trigger_happy)
    pull_trigger();
}


/* Utility routines */

/* Unlink the given process from whatever queue it's on... its */
/* current state and key must be consistent with the list on which it */
/* currently resides. */
static void
unlink_proc(sched, proc)
schedblock *sched;
pcb *proc;
{
  pcb *next;

  /* unlink the pcb, being careful about a single-entry queue */
  if (proc isnt proc->next) {
    next = proc->prev->next = proc->next;
    proc->next->prev = proc->prev;
  }
  else
    next = nil;

  /* fix head pointer in schedblock if we unlinked the head */
  switch (proc->state) {
  case READY:
    if (proc is CURPROC)
      CURPROC = next;
    break;
  case BLOCKED:
    if (proc->wake_key is nil) {
      if (proc is sched->blocked_nokey)
	sched->blocked_nokey = next;
    }
    else {
      if (proc is sched->blocked)
	sched->blocked = next;
    }
    break;
  case REVIVED:
    if (proc is sched->newprocs)
      sched->newprocs = next;
    break;
  case KILLED:
    nilerror("unlink_proc", "Attempted to unlink a dead process from sched Q");
    abort_nili("unlink_proc");
  }
}

/* Link the given process onto whichever queue it belongs to.  The */
/* process is placed at the tail end of the queue (so the head's prev */
/* pointer points to it), so it will be the last visited via a forward */
/* scan.  The proc must not already be linked into the queue. */ 

static void
link_proc(sched, proc)
schedblock *sched;
pcb *proc;
{
  pcb **head;

  switch (proc->state) {
  case READY:
    head = &sched->ready;
    break;
  case BLOCKED:
    if (proc->wake_key is nil)
      head = &sched->blocked_nokey;
    else
      head = &sched->blocked;
    break;
  case REVIVED:
    head = &sched->newprocs;
    break;
  case KILLED:
    nilerror("link_proc", "Attempt to link a dead pcb onto a sched Q");
    abort_nili("link_proc");
  }
  if (*head is nil)
    /* queue was empty, we become the single member */
    *head = proc->next = proc->prev = proc;
  else {
    /* link in with existing members */
    proc->next = *head;
    proc->prev = (*head)->prev;
    proc->prev->next = proc;
    proc->next->prev = proc;
  }
}


/*****************************************************************************/
/*                  Recursive Interpreter Call Support                       */
/*****************************************************************************/

void
set_trigger(proc, jbuf)
pcb *proc;
JumpBuf jbuf;
{
    trig *t;


    if ((t = new(trig)) is nil) {
	nilerror("set_trigger","unable to allocate a trigger");
	abort_nili("set_trigger");
    }
    cdr(t) = trigger_stack;
    trigger_stack = t;

    t->trigger = proc;
    CopyJumpBuf(t->jbuffer, jbuf);

    if ((t->Exception = new(object)) is nil) {
	nilerror("set_trigger","couldn't allocate a trigger exception object");
	abort_nili("set_trigger");
    }
    set_bottom(t->Exception);
    (void) unite(t->Exception, Bottom, handler_type__others);
}


void
pull_trigger()
{
    trig *t;
    JumpBuf jbuf;
    object *Exception;

    t = trigger_stack;		/* pop off the top one. */
    trigger_stack = cdr(t);

    CopyJumpBuf(jbuf, t->jbuffer); /* pull jump buffer out of heap storage */
    Exception = t->Exception;
    { dispose(t, trig); }	/* discard heap storage (what a bore) */

    VLongJmp(jbuf, Exception);
}


void
set_trigger_error(proc, errtype, errval)
pcb *proc;
dfd_enumeration errtype;
valcell errval;
{
    if (trigger_stack->trigger is proc) 
				/* caused by return_exception or discard cm */
      set_obj_to_error(trigger_stack->Exception, errtype, errval);
    else {			/* should never happen.... */
	nilerror("set_trigger_error", 
		 "Error raised in non-Hermes process that is not at top of trigger stack.");
	abort_nili("set_trigger_error");
    }
}
