/*
    TASK.C
    Implement Yorick virtual machine.

    $Id: task.c,v 1.1 1993/08/27 18:32:09 munro Exp munro $
 */
/*    Copyright (c) 1994.  The Regents of the University of California.
                    All rights reserved.  */

#include "ydata.h"
#include "yio.h"
#include "pstdlib.h"
#include "play.h"

#include <string.h>

/* packages that need to clean up before Yorick exits should supply
   CleanUpForExit, then call the one they found */
extern void (*CleanUpForExit)(void);
void (*CleanUpForExit)(void)= 0;

extern int YpParse(void *func);  /* argument non-zero for YpReparse */

/* The offsetof macro may be defined in <stddef.h> (it is ANSI standard).  */
/* #define offsetof(structure, member)  ((long)&(((structure*)0)->member))
   (does not work on Crays) */
#ifndef offsetof
#define offsetof(structure, member) \
  ((long)((char *)&(((structure*)0)->member) - (char *)0))
#endif

/*--------------------------------------------------------------------------*/

extern BuiltIn Y_quit, Y_include, Y_require, Y_help, Y_exit, Y_error, Y_batch;

extern void YRun(void);
extern void YHalt(void);

extern int CheckForTasks(int wait);
extern void IncludeNow(void);
extern void ResetStack(int hard);

extern VMaction Eval, Return, PushVariable;

extern void ClearTasks(void);
extern int DoTask(void);

extern Function *FuncContaining(Instruction *pc);

/* If yAutoDebug!=0, debug mode will be entered automatically whenever
   a runtime error occurs.  Otherwise, you must type "debug".  */
extern int yAutoDebug;
int yAutoDebug= 0;

int yDebugLevel= 0;

/* most recent error message was built in yErrorMsg */
char yErrorMsg[132];
char yWarningMsg[132];

static int inYError= 0;

/* from fnctn.c */
extern Instruction *ClearStack(void);
extern Instruction *AbortReturn(void);

extern long ypBeginLine;

extern TextStream *NewTextStream(char *fullname,
				 void *stream, int permissions,
				 long line, long pos);

typedef struct DebugBlk DebugBlk;
extern DebugBlk *NewDebugBlk(Function *f, long pcerr, char *errFile,
			     long lnum);

/* stuff to implement catch */
extern BuiltIn Y_catch;
typedef struct Catcher Catcher;
struct Catcher {
  Instruction *task;
  Instruction *pc;  /* of conditional branch instruction */
  long isp;         /* sp-spBottom of returnSym for calling function */
  int category;     /* of error to be caught */
};
static long n_catchers= 0;
static long max_catchers= 0;
static Catcher *catchers= 0;
extern void YCatchDrop(long isp);        /* used in fnctn.c */
extern long ispCatch;                    /* used in fnctn.c */
long ispCatch= 0;
extern int y_catch_category;
int y_catch_category= 0x08;
static Catcher *CatchScan(const char *msg, int category);
static Catcher *CatchNew(void);
static int caughtTask= 0;

/* stuff to implement set_idler */
extern BuiltIn Y_set_idler;
extern Function *y_idler_function;
Function *y_idler_function= 0;

/*--------------------------------------------------------------------------*/

Instruction *pc= 0;

static int ym_state= 0;
extern int ym_dbenter;
int ym_dbenter = 0;
#define Y_QUITTING 1
#define Y_RUNNING 2
#define Y_SUSPENDED 4
#define Y_PENDING 8

void
YRun(void)
{
  register VMaction *Action;
  int run_state = ym_state & Y_RUNNING;
  ym_state |= Y_RUNNING;
  ym_dbenter = 0;

  while (!p_signalling) {
    Action = (pc++)->Action;
    Action();
  }
  if (p_signalling==-1 && !(ym_state&Y_RUNNING))
    p_signalling = 0;      /* p_signalling set by YHalt (?? see below) */

  /* reset Y_RUNNING to value on entry -- allows YRun to recurse */
  ym_state = (ym_state & ~Y_RUNNING) | run_state;

  if (p_signalling)
    p_abort();             /* p_signalling set by real signal */
}

extern void ym_escape(void);
void
ym_escape(void)
{
  Y_quit(0);
  if (p_signalling==-1) p_signalling = 0;
  p_abort();
}

void
YHalt(void)
{
  ym_state &= ~Y_RUNNING;
  /* this may not be quite right -- a real signal might go unnoticed --
   * but may only be possible for SIGINT when machine is halting anyway
   * -- but if several other tasks queued, behavior might not be right */
  if (!p_signalling) p_signalling = -1;
}

/* if read() interrupted by uncaught error, have a serious problem */
extern void yr_reset(void);
extern char *y_read_prompt;
extern Instruction *ym_suspend(void);
extern void ym_resume(Instruction *pc);

static Instruction ym_stopper;

Instruction *
ym_suspend(void)
{
  Instruction *ipc = pc;
  if (caughtTask || (ym_state&(Y_SUSPENDED|Y_PENDING)))
    YError("ym_suspend called while suspended or in catch");
  ym_state |= Y_PENDING;
  ym_stopper.Action = YHalt;
  pc = &ym_stopper;
  return ipc;
}

void
ym_resume(Instruction *ipc)
{
  int was_suspended = (ym_state&Y_SUSPENDED);
  ym_state &= ~(Y_SUSPENDED|Y_PENDING);
  if (!was_suspended)
    YError("ym_resume called while not suspended");
  if (!ipc) YError("(BUG) ym_resume from null pc");
  pc = ipc;
  caughtTask = 1;
  /* protect against following sequence:
   * (1) task suspends during include file, causing y_on_idle to return 0
   *     this marks idler_eligible==0 in p_on_idle (alarms.c)
   * (2) event arrives (e.g.- expose) and is handled as a pending event
   *     before calling p_timeout; this event calls ym_resume
   * (3) p_timeout is called, which should resume execution, but cannot
   *     because idler_eligible has never been reset
   */
  p_timeout();
}

/*--------------------------------------------------------------------------*/

static Function **tasks= 0;
static int nTasks= 0;
static int maxTasks= 0;
static int ym_immediate_mode = 0;

static Function **ym_q = 0;
static int ym_q_n = 0, ym_q_mx = 0, ym_q_i = 0;

void ClearTasks(void)
{
  int i;
  ym_immediate_mode = 0;
  while (nTasks) { nTasks--;  Unref(tasks[nTasks]); }
  if (maxTasks>16) {
    maxTasks= 0;
    p_free(tasks);
    tasks= 0;
  }
  while (ym_q_n) {
    ym_q_n--;
    i = ym_q_i++;
    if (ym_q_i >= ym_q_mx) ym_q_i = 0;
    Unref(ym_q[i]);
  }
  if (ym_q_mx > 16) {
    ym_q_mx = ym_q_i = 0;
    p_free(ym_q);
    ym_q = 0;
  }
}

static void PushTask(Function *task);
static void PushTask(Function *task)
{
  if (p_signalling) p_abort();
  if (nTasks>=maxTasks) {
    int newSize= maxTasks+16;
    tasks= p_realloc(tasks, sizeof(Function *)*newSize);
    maxTasks= newSize;
  }
  tasks[nTasks++]= Ref(task);  /* WARNING-- this is the reference for when
				  DoTask pushes the task onto the stack--
				  you are still giving your reference to the
				  Function* away when you call PushTask */
}

void
ym_queue(Function *task)
{
  if (!ym_immediate_mode) {
    int j;
    if (p_signalling) p_abort();
    j = ym_q_i + ym_q_n;
    if (ym_q_n >= ym_q_mx) {
      int n = ym_q_mx + 16;
      ym_q = p_realloc(ym_q, sizeof(Function *)*n);
      ym_q_mx = n;
      for (n=ym_q_mx-16 ; n<j ; n++) {
        ym_q[n] = ym_q[n-ym_q_mx];
        ym_q[n-ym_q_mx] = 0;
      }
      for ( ; n<ym_q_mx ; n++) ym_q[n] = 0;
    }
    if (j >= ym_q_mx) j -= ym_q_mx;
    ym_q[j] = Ref(task); /* see note for PushTask */
    ym_q_n++;
  } else {
    PushTask(task);
  }
}

/* The task pseudo-code MUST be static, since YError may p_abort out
   of the DoTask procedure.  */
static Instruction taskCode[4];
static int taskCodeInit= 0;

int DoTask(void)
{
  extern Operations debugOps;
  if (caughtTask) {
    caughtTask= 0;
  } else if (nTasks>0 || ym_q_n>0) {
    Function *task;
    if (p_signalling) p_abort();
    if (nTasks > 0) {
      task = tasks[--nTasks];
    } else {
      task = ym_q[ym_q_i];
      ym_q[ym_q_i] = 0;
      ym_q_n--;
      if (++ym_q_i >= ym_q_mx) ym_q_i -= ym_q_mx;
    }

    CheckStack(1);
    (sp+1)->ops= &dataBlockSym;
    (sp+1)->value.db= (DataBlock *)task;  /* use owned by stack */
    sp++;

    pc= taskCode;     /* note that original pc is clobbered */
  }
  YRun();
  if (ym_state & Y_PENDING) {
    ym_state &= ~Y_PENDING;
    ym_state |= Y_SUSPENDED;
  } else if (sp->ops!=&dataBlockSym || sp->value.db->ops!=&debugOps) {
    /* actually, something is terribly wrong if this is not *main* */
    Drop(1);
  }
  return nTasks+ym_q_n;
}

/*--------------------------------------------------------------------------*/

extern int y_on_idle(void);
extern void y_on_exception(int signal, char *errmsg);
extern int y_on_quit(void);

extern void y_cleanup(void);

extern int nYpInputs;   /* from yinput.c */
extern int yImpossible;
int yImpossible= 0;

extern int yBatchMode;  /* may be set with -batch, see std0.c */
int yBatchMode= 0;

static int y_was_idle= 0;

static void ym_prompter(void);
extern char *y_read_prompt;     /* ascio.c */
/*extern int yg_blocking;*/         /* graph.c */

static void
ym_prompter(void)
{
  extern void y_do_prompt(void);  /* yorick.c */
  if (y_read_prompt) {
    if (y_read_prompt[0]) p_stdout(y_read_prompt);
  } else {
    y_do_prompt();
  }
}

int
y_on_idle(void)
{
  int more_work= 0;

  if (!taskCodeInit) {
    taskCode[0].Action= &Eval;
    taskCode[1].count= 0;
    taskCode[2].Action= &YHalt;
    taskCode[3].index= 0;
    taskCodeInit= 1;
  }

  if (ym_state & Y_QUITTING) {
  die_now:
    y_cleanup();
    p_quit();
    return 0;
  }
  if (!(nTasks+ym_q_n+caughtTask)) {
    if (nYpIncludes || nYpInputs) {
      ym_immediate_mode = 0;
      YpParse((void *)0);
    } else if (y_idler_function) {
      Function *f= y_idler_function;
      y_idler_function= 0;
      PushTask(f);
      Unref(f);
    }
  }

  if (nTasks+ym_q_n+caughtTask) DoTask();
  if (ym_state & Y_QUITTING) goto die_now;
  more_work= (nTasks+ym_q_n+caughtTask || nYpIncludes || nYpInputs ||
              y_idler_function);

  /* non-0 return means we want to run again
   * -- need to prompt if nothing left to do, but want to check
   *    for more input events before deciding
   * thus, first time we are out of tasks return non-0 anyway,
   * but prompt and return 0 second consecutive time we are out */
  if (more_work)
    {
      y_was_idle= 0;

      /* probably incorrect -- any tasks created before the suspend
       * but not yet run will be blocked
       * or maybe that's correct behavior?  what are the implied
       * dependencies of one task on another?
       */

      /* block on window,wait=1 or mouse() from #include file */
      /* if (yg_blocking) more_work=0; */
      /* block whenever suspended for any reason from #include file */
      if (ym_state&Y_SUSPENDED) more_work = 0;
      /* deliver prompt on read() or rdline() from #include file */
      if (y_read_prompt) ym_prompter();
    }
  else if (y_was_idle)
    y_was_idle=0, ym_prompter();
  else
    y_was_idle = more_work = !yBatchMode;
  if (!(nTasks+ym_q_n+caughtTask)) {
    extern void yg_before_wait(void);
    yg_before_wait();
  }
  return more_work;
}

void Y_quit(int nArgs)
{
  ym_state|= Y_QUITTING;
  ResetStack(0);
  YHalt();
}

int
y_on_quit(void)
{
  return 0;
}

static volatile int detectRecursion= 0;
static IOStream *yclean_file= 0;

void
y_cleanup(void)
{
  if (detectRecursion) {
    if (detectRecursion < 2) {
      detectRecursion = 3;
      RemoveIOLink(yBinaryFiles, yclean_file);
    } else {
      yBinaryFiles = 0;
    }
    detectRecursion = 0;
  }
  /* attempt to close all binary files properly */
  while (yBinaryFiles) {
    yclean_file = yBinaryFiles->ios;
    yclean_file->references = 0;
    detectRecursion = 1;
    Unref(yclean_file);
    detectRecursion = 2;
    RemoveIOLink(yBinaryFiles, yclean_file);
  }

  if (CleanUpForExit) CleanUpForExit();
}

void RunTaskNow(Function *task)
{
  Instruction *pcHere = pc;
  int t0 = nTasks;
  if (ym_state & Y_SUSPENDED)
    YError("RunTaskNow called while suspended waiting for event");
  PushTask(Ref(task));
  ym_immediate_mode = 1;
  while (nTasks>t0 && !(ym_state&(Y_QUITTING|Y_SUSPENDED))) DoTask();
  ym_immediate_mode = 0;
  if (ym_state & Y_SUSPENDED)
    YError("(read, pause, wait=1, etc.) suspended during RunTaskNow");
  pc = pcHere;           /* may have been clobbered by DoTask */
  if (ym_state&Y_QUITTING) YHalt();
}

void IncludeNow(void)
{
  Instruction *pcHere= pc;
  int i0= nYpIncludes;
  int t0= nTasks;
  if (ym_state & Y_SUSPENDED)
    YError("IncludeNow called while suspended waiting for event");
  ym_immediate_mode = 1;
  for (;;) {
    while (nTasks<=t0 && (nYpIncludes>i0 || (nYpIncludes==i0 &&
	   ypIncludes[i0-1].file))) YpParse((void *)0);
    while (nTasks>t0 && !(ym_state&(Y_QUITTING|Y_SUSPENDED))) DoTask();
    if ((ym_state&Y_QUITTING) || nYpIncludes<i0 ||
        !ypIncludes[i0-1].file) break;
  }
  ym_immediate_mode = 0;
  if (ym_state & Y_SUSPENDED)
    YError("(read, pause, wait=1, etc.) suspended during IncludeNow");
  pc= pcHere;           /* may have been clobbered by DoTask */
  if (ym_state&Y_QUITTING) YHalt();
}

void Y_include(int nArgs)
{
  long now;
  char *name;
  if (nArgs!=1 && nArgs!=2)
    YError("include function takes exactly one or two arguments");
  if (nArgs>1) now= YGetInteger(sp);
  else now= 0;
  name= YGetString(sp-nArgs+1);
  if (now>=0 && !YpPushInclude(name))
    YError("missing include file specified in include function");
  else if (now<0)
    YpPush(name);          /* defer until all pending input parsed */
  Drop(nArgs);
  if (now>0) IncludeNow(); /* parse and maybe execute file to be included
			      -- without now, this won't happen until the
			      next line is parsed naturally */
}

void Y_require(int nArgs)
{
  char *full, *name, *tail= 0;
  long i;
  if (nArgs!=1) YError("require function takes exactly one argument");
  full= YGetString(sp);
  name= YNameTail(full);
  for (i=0 ; i<sourceTab.nItems ; i++) {
    tail= YNameTail(sourceTab.names[i]);
    if (name && tail && strcmp(tail, name)==0) break;
    p_free(tail);
    tail= 0;
  }
  p_free(name);
  p_free(tail);
  if (i>=sourceTab.nItems && !YpPushInclude(full))
    YError("missing include file specified in require function");
  Drop(nArgs);
  if (i>=sourceTab.nItems)
    IncludeNow();   /* parse and maybe execute file to be included */
}

/*--------------------------------------------------------------------------*/

static int findingFunc= 0;

Function *FuncContaining(Instruction *pc)
{
  Function *func= 0;

  if (!findingFunc && pc) {
    long i= -1;
    findingFunc= 1;
    for (;; i++) {
      while (pc[i].Action) i++;
      if (pc[i-1].Action==&Return) break;
    }
    i++;
    /* Now pc[i] is the Instruction generated by following line
       in parse.c (YpFunc):
          vmCode[nextPC].index= codeSize= nPos+nKey+nLocal+ nextPC;
       (nextPC does NOT include the parameters or locals)
     */
    i-= pc[i].index;
    if (i<0) {
      /* see also Pointee function in ydata.c */
      func= (Function *)((char *)(pc+i) - offsetof(Function, code));
      findingFunc= 0;
    }
  }

  if (findingFunc) {
    /* may get here after a disaster causing an interrupt above, as well
       as after scanning from a garbled initial pc */
    findingFunc= 0;
    YputsErr("(BUG) lost function produced following error:");
  }
  return func;
}

/*--------------------------------------------------------------------------*/

void ResetStack(int hard)
{
  Instruction *pcRet;
  while ((pcRet= AbortReturn())) if (pcRet==&taskCode[2] && !hard) break;
}

/*--------------------------------------------------------------------------*/

static int y_do_not_abort = 0;

void
y_on_exception(int signal, char *errmsg)
{
  /* signal==PSIG_SOFT for call to p_abort, otherwise this is real signal */
  if (signal != PSIG_SOFT) {
    y_do_not_abort = 1;
    if (signal==PSIG_INT)
      {
        y_catch_category= 0x04;
        YError("Keyboard interrupt received (SIGINT)");
      }
    else if (signal==PSIG_FPE)
      {
        y_catch_category= 0x01;
        YError("Floating point interrupt (SIGFPE)");
      }
    else if (signal==PSIG_SEGV)
      YError("Segmentation violation interrupt (SIGSEGV)");
    else if (signal==PSIG_ILL)
      YError("Illegal instruction interrupt (SIGILL)");
    else if (signal==PSIG_BUS)
      YError("Misaligned address interrupt (SIGBUS)");
    else if (signal==PSIG_IO)
      YError((errmsg&&errmsg[0])? errmsg : "I/O interrupt (SIGIO)");
    else
      YError((errmsg&&errmsg[0])? errmsg :
             "Unrecognized signal delivered to y_on_exception");
  }
  if (ym_state&Y_QUITTING) {
    y_cleanup();
    p_quit();
  }
}

void YWarning(const char *msg)
{
  strcpy(yWarningMsg, "WARNING ");
  strncat(yWarningMsg, msg, 120);
  YputsErr(yWarningMsg);
}

static char *includeFile= 0;
static long mainIndex= -1;
Instruction *yErrorPC= 0;   /* for dbup function in debug.c */

void
YError(const char *msg)
{
  long beginLine= ypBeginLine;
  Instruction *pcDebug= pc;
  Function *func;
  char *name;
  DebugBlk *dbg;
  Instruction *pcUp= yErrorPC;
  int category;
  int no_abort = y_do_not_abort;

  int recursing= inYError;
  inYError++;
  yErrorPC= 0;
  y_do_not_abort = 0;

  category= y_catch_category;
  y_catch_category= 0x08;

  ym_state &= ~Y_PENDING;
  ym_dbenter = 0;

  if (y_idler_function) {
    /* remove any idler on error - catch can reset if desired */
    Function *f= y_idler_function;
    y_idler_function= 0;
    Unref(f);
  }

  if (recursing>8 || yImpossible>8) {
    YputsErr("****FATAL**** YError looping -- quitting now");
    ym_state|= Y_QUITTING;
    if (!no_abort) p_abort();
    return;
  }
  yImpossible++;  /* zeroed only by GetNextLine and after CatchScan */

  if (!caughtTask && CatchScan(msg, category)) {
    /* resume at catch PC if this error has been caught --
     * is this really proof against catastrophic looping? */
    inYError= 0;
    yImpossible= 0;
    caughtTask= 1;
    if (!no_abort) p_abort();
    return;
  } else if (caughtTask) {
    caughtTask= 0;
    YputsErr("****OOPS**** error on read resume or throw/catch");
  }

  func= (((ym_state&Y_RUNNING)||no_abort) && !recursing &&
         pcUp!=&taskCode[2])? FuncContaining(pcDebug) : 0;
  name= func? globalTable.names[func->code[0].index] : "VM idle or lost";

  /* Clear out include stack, but remember current include file name.
     If the error happened while executing a main program which came from
     the include file, then includeFile will be the filename, and
     ypBeginLine will be the line number at which the errant main
     program began.  (No other line number information will be available
     for a main program?)  */
  if (!recursing) {
    char *tmp= includeFile;
    includeFile= 0;
    p_free(tmp);
    if (nYpIncludes) {
      includeFile= p_strcpy(ypIncludes[nYpIncludes-1].filename);
      YpClearIncludes();
    }
  } else if (nYpIncludes) YpClearIncludes();

  /* Clean up any Array temporaries (used for data format conversions).  */
  if (recursing<2) ClearTmpArray();

  /* Clear out any pending keyboard input or tasks.  */
  if (recursing<3) {
    p_qclear();
    ClearTasks();
  } else if (nTasks+ym_q_n) {
    YputsErr("WARNING unable to free task pointers in YError");
    nTasks = ym_q_n = 0;
  }

  /* Print error message, with name of current Yorick function prepended:
        ERROR (yorick_function) msg passed to YError
	ERROR (VM idle or lost) msg passed to YError
     The second form is used when the virtual machine is idle at the
     time of the error.  */
  if (!pcUp || recursing)
    strcpy(yErrorMsg, "ERROR (");
  else
    strcpy(yErrorMsg, "Up to (");
  strncat(yErrorMsg, name, 40);
  strcat(yErrorMsg, ") ");
  if (!pcUp || recursing)
    strncat(yErrorMsg, msg, 80);
  YputsErr(yErrorMsg);

  if (recursing) {
    func= 0;
    YputsErr("WARNING aborting on recursive calls to YError");
  } else if (ym_state&Y_SUSPENDED) {
    func= 0;
    if (y_read_prompt)
      YputsErr("WARNING aborting on YError during keyboard read()");
    else
      YputsErr("WARNING aborting on YError after mouse() pause() or wait=1");
  }

  if (func) {
    /* Try to find the source code for this function.  */
    long index= func->code[0].index;
    if (mainIndex<0) mainIndex= Globalize("*main*", 0L);
    if (index==mainIndex) {
      name= includeFile;
    } else {
      char *mess= YpReparse(func);
      if (nTasks+ym_q_n) ClearTasks();
      if (mess[0]!='*') {
	/* reparse succeeded, skip to filename */
	name= 0;
	while (mess[0] && mess[0]!=':') mess++;
	if (mess[0]) do { mess++; } while (mess[0] && mess[0]!=':');
	if (mess[0]) {
	  mess++;
	  if (mess[0]==' ') mess++;
	  if (mess[0]) name= mess;
	}
      } else {
	/* reparse failed */
	name= 0;
      }
      beginLine= 0;  /* used only for *main* from includeFile */
    }

    /* Push debug info (function and code index) onto stack.  */
    ClearStack();
    CheckStack(2);
    dbg= NewDebugBlk(func, pcDebug-func->code, name, beginLine);
    if (dbg) {
      PushDataBlock(dbg);
    } else {
      ResetStack(0);
      YputsErr("Function corrupted, cannot enter debug mode.");
    }

    if (!yBatchMode && !pcUp && (!yAutoDebug || yDebugLevel>1)) {
      if (yDebugLevel>1) {
	YputsErr(" To enter recursive debug level, type <RETURN> now");
      } else {
	YputsErr(" To enter debug mode, type <RETURN> now"
		 " (then dbexit to get out)");
      }
      ym_dbenter = 1;
    }

  } else {
    extern void yg_got_expose(void);
    /* Clear the stack back to the most recent debugging level,
     * or completely clear if aborting a read() operation.  */
    if (recursing<5) ResetStack(y_read_prompt!=0);
    else {
      YputsErr("****SEVERE**** YError unable to reset stack -- "
	       "probably lost variables");
      sp= spBottom;
    }
    ym_state &= ~Y_SUSPENDED;
    if (y_read_prompt) yr_reset();
    yg_got_expose();  /* in case window,wait=1 or pause */
    p_clr_alarm(0, 0);
  }

  if (ym_state&Y_QUITTING) {
    YputsErr("****TERMINATING**** on error after main loop exit");
    if (!no_abort) p_abort();
    return;
  }

  if (yBatchMode || !strncmp(msg,"(FATAL)",7)) {
    if (yBatchMode) YputsErr("yorick: quitting on error in batch mode");
    else YputsErr("yorick: quitting on fatal error");
    ResetStack(0);
    ym_state|= Y_QUITTING;
  }

  /* Go back to the main loop.  */
  inYError= 0;
  if (!no_abort) p_abort();
}

/*--------------------------------------------------------------------------*/

static Function *help_worker= 0;

void Y_help(int nArgs)
{
  Symbol *stack= sp-nArgs+1;
  long index, worker_arg;
  int nAbove;
  p_file *file;

  worker_arg= Globalize("help_topic", 0L);

  while (stack<=sp && !stack->ops) stack+=2;  /* skip any keywords */
  nAbove= sp-stack;
  if (nAbove>=0) {
    /* a legal argument has been supplied */
    if (stack->ops==&referenceSym) {
      index= stack->index;
      ReplaceRef(stack);
    } else {
      index= -1;
    }
    if (stack->ops==&dataBlockSym) {
      DataBlock *db= stack->value.db;
      Operations *ops= db->ops;
      if (ops==&functionOps) {
	Function *f= (Function *)db;
	index= f->code[0].index;
      } else if (ops==&structDefOps) {
	StructDef *base= (StructDef *)db;
	while (base->model) base= base->model;
	index= Globalize(yStructTable.names[base->index], 0L);
      } else if (ops==&builtinOps) {
	BIFunction *f= (BIFunction *)db;
	index= f->index;
      }
    }
    Drop(nAbove);
    nArgs-= nAbove+1;
  } else {
    /* no legal arguments, help function itself is target */
    BIFunction *f= (BIFunction *)(sp-nArgs)->value.db;
    index= f->index;
    PushDataBlock(Ref(&nilDB));
  }

  /* move help topic argument off stack into help_topic extern variable */
  PopTo(&globTab[worker_arg]);  /* help_topic */
  Drop(nArgs);  /* only argument of any conceivable value just saved */

  if (!help_worker) {
    long help_index= Globalize("help_worker", 0L);
    if (globTab[help_index].ops!=&dataBlockSym ||
	(help_worker= (Function *)Ref(globTab[help_index].value.db))->ops
	!=&functionOps)
      YError("(BUG) help_worker function not found -- help unavailable");
  }

  /* create help_file extern variable */
  if (index>=0 && (file= OpenSource(index)))
    PushDataBlock(NewTextStream(p_strcpy(ypIncludes[nYpIncludes-1].filename),
				file, 1, ypBeginLine-1, p_ftell(file)));
  else
    PushDataBlock(Ref(&nilDB));
  worker_arg= Globalize("help_file", 0L);
  PopTo(&globTab[worker_arg]);  /* help_file */

  RunTaskNow(help_worker);
}

/*--------------------------------------------------------------------------*/

void Y_exit(int nArgs)
{
  char *msg= 0;
  if (nArgs>1) YError("exit takes exactly zero or one argument");
  if (nArgs==1 && YNotNil(sp)) msg= YGetString(sp);
  if (msg) YputsOut(msg);
  else YputsOut("EXIT called, back to main loop");
  ResetStack(0);
  p_abort();
}

void Y_error(int nArgs)
{
  char *msg= 0;
  if (nArgs>1) YError("error takes exactly zero or one argument");
  if (nArgs==1 && YNotNil(sp)) msg= YGetString(sp);
  y_catch_category= 0x10;
  if (msg) YError(msg);
  else YError("<interpreted error function called>");
}

void Y_batch(int nArgs)
{
  int flag= 2;
  if (nArgs>1) YError("batch takes exactly zero or one argument");
  if (nArgs==1 && YNotNil(sp)) {
    flag= (YGetInteger(sp)!=0);
    Drop(1);
  }
  PushIntValue(yBatchMode);
  if (flag!=2) yBatchMode= flag;
}

/*--------------------------------------------------------------------------*/

static Catcher *CatchNew(void)
{
  if (n_catchers>=max_catchers) {
    catchers= p_realloc(catchers, (max_catchers+16)*sizeof(Catcher));
    max_catchers+= 16;
  }
  catchers[n_catchers].task= 0;
  catchers[n_catchers].pc= 0;
  catchers[n_catchers].isp= 0;
  catchers[n_catchers].category= 0;
  return &catchers[n_catchers++];
}

void YCatchDrop(long isp)
{
  while (n_catchers>0 && catchers[n_catchers-1].isp>=isp) {
    n_catchers--;
    catchers[n_catchers].category= 0;
  }

  if (n_catchers>0) ispCatch= catchers[n_catchers-1].isp;
  else ispCatch= 0;

  if ((max_catchers>>6) > n_catchers) {
    /* attempt to limit damage from runaway catch calls */
    catchers= p_realloc(catchers, (max_catchers>>6)*sizeof(Catcher));
    max_catchers>>= 6;
  }
}

static Catcher *CatchScan(const char *msg, int category)
{
  long i= n_catchers-1;
  while (i>=0 && !(category&catchers[i].category)) {
    if (catchers[i].task != &taskCode[2]) i= 0;
    i--;
  }

  if (i>=0) {
    char tmsg[84];
    Array *array;
    long cmsg;
    Instruction *pcRet;
    Symbol *spCatch= spBottom + catchers[i].isp;
    catchers[i].category= 0;  /* disable this catcher */

    /* note: msg itself might be on stack! */
    strncpy(tmsg, msg, 80);
    tmsg[80]= '\0';

    for (;;) {
      ClearStack();
      if (spCatch >= sp) break;
      pcRet= AbortReturn();
      if (!pcRet || pcRet==&taskCode[2]) YError("(BUG) impossible catch");
    }
    if (spCatch!=sp) YError("(BUG) impossible catch or corrupt stack");
    pc= catchers[i].pc;
    PushIntValue(1);

    /* set catch_message variable (after stack cleared) */
    cmsg= Globalize("catch_message", 0L);
    if (globTab[cmsg].ops==&dataBlockSym) {
      globTab[cmsg].ops= &intScalar;
      Unref(globTab[cmsg].value.db);
    }
    array= NewArray(&stringStruct, (Dimension *)0);
    globTab[cmsg].value.db= (DataBlock *)array;
    globTab[cmsg].ops= &dataBlockSym;
    array->value.q[0]= p_strcpy(tmsg);

    return &catchers[i];

  } else {
    return 0;
  }
}

extern VMaction BranchFalse, BranchTrue;

void Y_catch(int nArgs)
{
  Catcher *catcher= 0;
  long i= n_catchers-1;
  long isp= (sp-2) - spBottom;
  int category;
  if (nArgs!=1) YError("catch takes exactly one argument");
  category= YGetInteger(sp);
  if ((sp-2)->ops != &returnSym ||
      (pc->Action!=&BranchFalse && pc->Action!=&BranchTrue))
    YError("catch() must be the condition in an if or while statement");

  while (i>=0 && catchers[i].task==&taskCode[2] && catchers[i].isp==isp) {
    if (catchers[i].pc==pc) {
      catcher= &catchers[i];
      break;
    }
    i--;
  }
  if (!catcher) catcher= CatchNew();
  catcher->task= &taskCode[2];
  catcher->pc= pc;
  catcher->isp= ispCatch= isp;
  catcher->category= category;

  PushIntValue(0);
}

/*--------------------------------------------------------------------------*/

void Y_set_idler(int nArgs)
{
  Function *f;
  if (nArgs>1)
    YError("set_idler function takes exactly zero or one argument");

  if (nArgs>0 && YNotNil(sp)) {
    f= (Function *)sp->value.db;
    if (sp->ops!=&dataBlockSym || f->ops!=&functionOps)
      YError("expecting function as argument");
    y_idler_function= Ref(f);

  } else if (y_idler_function) {
    f= y_idler_function;
    y_idler_function= 0;
    Unref(f);
  }
}

/*--------------------------------------------------------------------------*/
