
/* "VIEW", a data viewing program,
   Copyright (C) 1987, 1990 California Institute of Technology.
   Original authors: Dave Gillespie, port by Rick Koshi
   Unix Port Maintainer: John Lazzaro
   Maintainers's address: lazzaro@hobiecat.cs.caltech.edu;
                          CB 425/ CU Boulder/Boulder CO 91125. 


This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation (Version 1, Feb 1989).

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; see the file COPYING.  If not, write to
the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */

/* Output from p2c, the Pascal-to-C translator */
/* From input file "viewmod.text" */


/* The View program
   by Dave Gillespie
 */



/*caged_date='I{ Last edit by $U on $X $]'*/
/* Last edit by dave on Mar 12, 1989 7:29 am */
/* Last edit by dave on Mar 12, 1989 5:51 am */
/* Last edit by dave on Jun 6, 1988 8:16 pm */
/* Last edit by dave on Jun 3, 1988 3:11 pm */
/* Last edit by dave on Jun 3, 1988 2:41 pm */
/* Last edit by dave on Jun 3, 1988 2:10 pm */
/* Last edit by dave on Mar 3, 1988 6:51 pm */
/* Last edit by dave on Feb 29, 1988 6:02 pm */
/* Last edit by dave on Feb 22, 1988 7:07 pm */
/* Last edit by dave on Feb 16, 1988 1:09 am */
/* Last edit by dave on Feb 12, 1988 5:55 pm */
/* Last edit by dave on Jan 26, 1988 8:10 am */
/* Last edit by dave on Jan 24, 1988 1:25 am */
/* Last edit by dave on Jan 23, 1988 9:09 pm */
/* Last edit by maryann on Jan 23, 1988 5:58 pm */
/* Last edit by dave on Jan 21, 1988 1:22 am */
/* Last edit by dave on Jan 20, 1988 11:46 pm */
/* Last edit by dave on Jan 19, 1988 11:47 pm */
/* Last edit by dave on Jan 18, 1988 11:00 pm */
/* Last edit by dave on Jan 14, 1988 5:30 pm */
/* Last edit by dave on Jan 13, 1988 11:48 pm */
/* Last edit by dave on Nov 30, 1987 2:53 pm */
/* Last edit by dave on Nov 27, 1987 6:14 pm */
/* Last edit by dave on Nov 26, 1987 4:24 pm */
/* Last edit by dave on Nov 25, 1987 1:08 am */
/* Last edit by dave on Nov 24, 1987 11:08 pm */
/* Last edit by dave on Nov 11, 1987 3:14 am */
/* Last edit by dave on Nov 9, 1987 11:49 pm */

#include <sys/types.h>
#include <sys/stat.h>

#include "global.h"


#define VIEWMOD_G
#include "viewmod.h"




/*homeless orphans*/

#ifndef MISC_H
#include <p2c/misc.h>
#endif

#ifndef SYSDEVS_H
#include <p2c/sysdevs.h>
#endif

#ifndef FILEPACK_H
#include <p2c/filepack.h>
#endif

#ifndef RND_H
#include <p2c/rnd.h>
#endif

#ifndef FS_H
#include <p2c/fs.h>
#endif

#ifndef CITINFOMOD_H
#include <p2c/citinfomod.h>
#endif

#ifndef MYLIB_H
#include <p2c/mylib.h>
#endif

#ifndef REGEX_H
#include <p2c/regex.h>
#endif

#ifndef NEWCRT_H
#include <p2c/newcrt.h>
#endif

#ifndef NEWKBD_H
#include <p2c/newkbd.h>
#endif

#ifndef NEWCI_H
#include <p2c/newci.h>
#endif

#ifndef LUNIX_PAS_H
#include <p2c/lunix_pas.h>
#endif

#ifndef VIEWCONF_H
#include "viewconf.h"
#endif



/*$if v_hasdebug$
   $debug$
$end$*/


#define logfilebase     "view"
#define logfileext      ".log"

#define maxinfiles      5
#define maxprocargs     10

#define argk_wvar       'A'
#define argk_var        'B'
#define argk_punc       'C'
#define argk_word       'D'
#define argk_rest       'E'





typedef struct cmdrec {
  struct cmdrec *left, *right;
  Char *name;
  struct cmdrec *alias;
  na_strlist *help;
  short prefix;
  boolean builtin, isctrl, active;
  na_strlist *owningtool;
  _PROCEDURE proc;
  struct procrec *procbase;
} cmdrec;

typedef struct funcrec {
  Char *name, *defn;
  ne_nexrec *nex;
  na_strlist *sym, *args;
  ne_datatype rtype;
  struct funcrec *next;
} funcrec;

typedef struct interprec {
  _PROCEDURE proc;
  _PROCEDURE pproc;
  _PROCEDURE dproc;
  Char *help;
} interprec;

typedef struct infilerec {
  Char *name;
  datetimerec date;
  na_strlist *base;
  struct infilerec *next;
} infilerec;

typedef struct procrec {
  na_strlist *start, *args;
  long nargs;
  Char *blockend;
  struct procrec *next;
} procrec;

typedef enum {
  fr_stdin, fr_file, fr_proc, fr_do
} framekinds;

typedef struct framerec {
  struct framerec *next;
  long stamp;
  boolean held, flag;
  na_strlist *prevline, *curline;
  framekinds kind;
  union {
    struct {
      na_strlist *savehist, *savehistlast;
    } U0;
    infilerec *filename;
    na_strlist *dstart;
    struct {
      cmdrec *procname;
      procrec *procproc;
      v_paramrec *locparams;
      cmdrec *locdefs;
      v_curverec *loccurves;
    } U2;
  } UU;
} framerec;


#ifndef strdup
extern char *strdup();
#endif

#define excp_line       0


Static FILE *logfile;
Static boolean logopen, logfirst;
Static framerec *instack, *errorframe;
Static long instamp, popstamp;
Static infilerec *infiles;
Static cmdrec *cmdbase, *addedcmd, *prevaddedcmd;
Static long numcmds, maxcmdname;
Static boolean builtinflag;
Static na_strlist *shorthelp, *seealso;
Static boolean abbrevsokay;
Static procrec *addedproc;
Static interprec *addedinterp;
Static na_strlist *addedfunc, *prevaddedfunc, *funchelp;
Static funcrec *funcbase;
Static double baseval;
Static na_strlist *curvesymtab, *suffixsymtab, *funcsymtab, *tools,
		  *toolfiles, *curtoolname, *initprocs;
Static long tempveclen;
Static boolean savetuflag, needresetstdin;
Static long readnesting;
Static boolean takeoverflag;
Static Char ck_cachestr[256];
Static v_curverec *ck_cachecp;
Static Char ck_cachemode;
Static long maxmemchunk, printedmemavail;



Static Void firstproc()
{
  /*placeholder*/
}


Void v_newvector(vec, len)
double **vec;
long len;
{
    char *m;
  len *= sizeof(double);
  if (len > maxmemchunk)
    maxmemchunk = len;
  if (!(m = Malloc(len))) fprintf(stderr,"Malloc returned 0\n");/*was malloc*/
  *vec = (double *) m;
}


Void v_disposevector(vec, len)
double **vec;
long len;
{
  Free(*vec);
}



boolean isequal(r1, r2)
double r1, r2;
{
  if (r1 == r2)
    return true;
  else
    return (fabs(r1 - r2) < P_rmax(fabs(r1), fabs(r2)) * v_p_epsilon->val.r);
}  /*rmax is from newasm*/


Static long dtdiff(dt1, dt2)
datetimerec dt1, dt2;
{
  if (dt1.date.year != dt2.date.year)
    return (P_isgn((long)(dt1.date.year - dt2.date.year)));
  else if (dt1.date.month != dt2.date.month)
    return (P_isgn((long)(dt1.date.month - dt2.date.month)));
  else if (dt1.date.day != dt2.date.day)
    return (P_isgn((long)(dt1.date.day - dt2.date.day)));
  else if (dt1.time.hour != dt2.time.hour)
    return (P_isgn((long)(dt1.time.hour - dt2.time.hour)));
  else if (dt1.time.minute != dt2.time.minute)
    return (P_isgn((long)(dt1.time.minute - dt2.time.minute)));
  else
    return (P_isgn((long)(dt1.time.centisecond - dt2.time.centisecond)));
}





/* Control blocks */

Static Void nullcontrolproc(cp)
v_controlrec *cp;
{
}


Void v_pushcontrol(p)
v_controlrec **p;
{
  Char STR2[256];

  *p = (v_controlrec *)Malloc(sizeof(v_controlrec));
  memset((Anyptr)(*p), 0, sizeof(v_controlrec));
  (*p)->mark = v_markinput();
  (*p)->aborthook.proc = (Anyptr)nullcontrolproc;
  (*p)->aborthook.link = (Anyptr)NULL;
  (*p)->pophook.proc = (Anyptr)nullcontrolproc;
  (*p)->pophook.link = (Anyptr)NULL;
  (*p)->breakhook.proc = (Anyptr)nullcontrolproc;
  (*p)->breakhook.link = (Anyptr)NULL;
  (*p)->continuehook.proc = (Anyptr)nullcontrolproc;
  (*p)->continuehook.link = (Anyptr)NULL;
  (*p)->recoverhook.proc = (Anyptr)nullcontrolproc;
  (*p)->recoverhook.link = (Anyptr)NULL;
  (*p)->canbreak = false;
  (*p)->cancontinue = false;
  (*p)->canrecover = false;
  (*p)->next = v_ctrlstack;
  v_ctrlstack = *p;
  if (v_p_trace->val.U1.i1 >= 2) {
    sprintf(STR2, "Push control frame %.8lX", (long)(*p));
    v_logwriteln(STR2);
  }
}


Static Void popcontrol()
{
  v_controlrec *cp;
  Char STR2[256];

  cp = v_ctrlstack;
  if (v_p_trace->val.U1.i1 >= 2) {
    sprintf(STR2, "Pop control frame %.8lX", (long)cp);
    v_logwriteln(STR2);
  }
  if (cp->pophook.link != NULL)
    (*(Void(*) PP((v_controlrec *cp, Anyptr _link)))cp->pophook.proc)(cp,
      cp->pophook.link);
  else
    (*(Void(*) PP((v_controlrec *cp)))cp->pophook.proc)(cp);
  v_ctrlstack = v_ctrlstack->next;
  Free(cp);
}





/* File system */

Static Void removeprocs(cmdp)
cmdrec *cmdp;
{
  framerec *fp;
  procrec *pp, *pp2;

  pp = cmdp->procbase;
  while (pp != NULL) {
    pp2 = pp;
    pp = pp->next;
    fp = instack;
    while (fp != NULL && (fp->kind != fr_proc || fp->UU.U2.procproc != pp2))
      fp = fp->next;
    if (fp == NULL) {
      strlist_empty(&pp2->start);
      strlist_empty(&pp2->args);
      Free(pp2);
    }  /*otherwise just lose it into space*/
  }
}


Local Void restoreloccurve(cp)
v_curverec *cp;
{
  v_curverec *cp2;

  cp2 = cp->next2;
  ne_dispose(&cp2->nex);
  strdispose(&cp2->expr);
  cp2->expr = cp->expr;
  cp2->exprtime = -2;
  v_unassigncurve(cp2);
  strdispose(&cp2->units);
  cp2->units = cp->units;
  v_setcurvekind(cp2, cp->kind);
  switch (cp2->kind) {

  case v_ck_num:
    cp2->yval = cp->yval;
    break;

  case v_ck_string:
    cp2->sval = cp->sval;
    break;

  case v_ck_curve:
    cp2->base = cp->base;
    cp2->vec = cp->vec;
    break;
  }
  v_fixcurvesym(cp2);
  v_change(cp2);
}

Local Void restorelocdef(cmdp)
cmdrec *cmdp;
{
  cmdrec *cmdp2;

  cmdp2 = cmdp->right;
  removeprocs(cmdp2);
  if (cmdp->active != cmdp2->active || cmdp->isctrl != cmdp2->isctrl)
    abbrevsokay = false;
  cmdp->left = cmdp2->left;
  cmdp->right = cmdp2->right;
  cmdp->prefix = cmdp2->prefix;
  *cmdp2 = *cmdp;
}

Local Void restorelocparam(pp)
v_paramrec *pp;
{
  Anyptr any;

  any = (Anyptr)pp->name;
  if (pp->kind->restproc.link != NULL)
    (*(Void(*) PP((v_paramrec *pp, v_paramrec *opp, Anyptr _link)))
      pp->kind->restproc.proc)((v_paramrec *)any, pp, pp->kind->restproc.link);
  else
    (*(Void(*) PP((v_paramrec *pp, v_paramrec *opp)))pp->kind->restproc.proc)(
      (v_paramrec *)any, pp);
}


Static Void popinput()
{
  framerec *p;
  cmdrec *cmdp, *cmdp2;
  v_paramrec *pp, *pp2;
  v_curverec *cp, *cp2;
  Char STR2[256];
  framerec *WITH;

  if (v_p_trace->val.U1.i1 >= 2) {
    sprintf(STR2, "Pop input frame %.8lX", (long)instack);
    v_logwriteln(STR2);
  }
  if (instack == NULL)
    return;
  WITH = instack;
  if (WITH->held)
    popstamp = WITH->stamp;
  switch (WITH->kind) {

  case fr_stdin:
    strlist_empty(&v_history);
    v_history = WITH->UU.U0.savehist;
    v_histlast = WITH->UU.U0.savehistlast;
    if (!newci_redirinput)
      needresetstdin = true;
    break;

  case fr_proc:
    cp = WITH->UU.U2.loccurves;
    while (cp != NULL) {
      cp2 = cp;
      cp = cp->next;
      restoreloccurve(cp2);
      Free(cp2);
    }
    cmdp = WITH->UU.U2.locdefs;
    while (cmdp != NULL) {
      cmdp2 = cmdp;
      cmdp = cmdp->left;
      restorelocdef(cmdp2);
      Free(cmdp2);
    }
    pp = WITH->UU.U2.locparams;
    while (pp != NULL) {
      pp2 = pp;
      pp = pp->next;
      restorelocparam(pp2);
      Free(pp2);
    }
    break;

  case fr_do:
    strlist_empty(&WITH->UU.dstart);
    break;
  }
  p = instack;
  instack = instack->next;
  Free(p);
}


Void v_fixstdin()
{
  if (needresetstdin) {
    rewind(stdin);
    needresetstdin = false;
  }
}


boolean v_eof()
{
  boolean done;
  framerec *WITH;

  done = false;
  while (!done && instack != NULL && !instack->held) {
    WITH = instack;
    switch (instack->kind) {

    case fr_stdin:
      v_fixstdin();
      if (WITH->curline == NULL && P_eof(stdin))
	v_popinput();
      else
	done = true;
      break;

    case fr_file:
    case fr_proc:
    case fr_do:
      if (WITH->curline == NULL)
	v_popinput();
      else
	done = true;
      break;

    default:
      done = true;
      break;
    }
  }
  return (instack == NULL || instack->held || v_exitflag);
}


Static Void splitinput(rest, buf, base, last, lnum)
Char *rest, *buf;
na_strlist **base, **last;
long lnum;
{
  Char quotech;
  long i, i0;
  na_strlist *l1;
  Char STR1[256];
  Char STR2[256];

  i = strposc(buf, '\t', 1L);
  while (i != 0) {
    buf[i - 1] = ' ';
    i = strposc(buf, '\t', i + 1);
  }
  if (*buf == ' ') {
    strcpy(STR1, strltrim(buf));
    strcpy(buf, STR1);
  }
  if (*buf == '\0' || *buf == '#')
    return;
  quotech = '\0';
  i = 1;
  i0 = 1;
  while (i <= strlen(buf)) {
    if (quotech != '\0') {
      if (buf[i - 1] == quotech)
	quotech = '\0';
    } else if (buf[i - 1] == '\'' || buf[i - 1] == '"')
      quotech = buf[i - 1];
    else if (i < strlen(buf)) {
      if (buf[i - 1] == ';' && buf[i] == ';') {
	strcat(rest, strpart(STR1, buf, (int)i0, (int)(i - 1)));
	strcpy(STR1, strltrim(strrtrim(strcpy(STR2, rest))));
	strcpy(rest, STR1);
	if (*rest != '\0') {
	  l1 = strlist_append(last, rest);
	  *last = l1;
	  if (*base == NULL)
	    *base = *last;
	  ((short *)(&(*last)->value))[0] = lnum;
	  *rest = '\0';
	}
	i++;
	i0 = i + 1;
      } else if (buf[i - 1] == '#' && buf[i] == '#') {
	buf[i - 1] = '\0';
/* p2c: viewmod.text, line 939:
 * Note: Modification of string length may translate incorrectly [146] */
      }
    }
    i++;
  }
  if (i0 > 1)
    strcpy(buf, buf + i0 - 1);
  if (*buf == ' ') {
    strcpy(STR1, strltrim(buf));
    strcpy(buf, STR1);
  }
  strcat(rest, buf);
  if (strends(rest, " "))
    strcpy(rest, strrtrim(strcpy(STR1, rest)));
  if (*rest == '\0')
    return;
  if (strends(rest, "\\\\") && quotech == '\0') {
    rest[strlen(rest) - 2] = '\0';
    sprintf(STR2, "%s ", strrtrim(strcpy(STR1, rest)));
    strcpy(rest, STR2);
    return;
  }
  l1 = strlist_append(last, rest);
  *last = l1;
  if (*base == NULL)
    *base = *last;
  ((short *)(&(*last)->value))[0] = lnum;
  *rest = '\0';
}


/* Local variables for readkbddef: */
struct LOC_readkbddef {
  boolean mytakeoverflag;
} ;

Local Void mytakeoveraction(LINK)
struct LOC_readkbddef *LINK;
{
  LINK->mytakeoverflag = true;
  nk_ungetkey('\015');
}



Static boolean readkbddef(buf, prompt, def, fvar)
Char *buf, *prompt, *def, *fvar;
{
  struct LOC_readkbddef V;
  boolean Result;
  Char savepr[256];
  v_curverec *cp;
  na_long handle;
  _PROCEDURE savetakeover;
  Char termch;
  long i, inlen;

  if (*fvar == '\0') {
    strcpy(savepr, prompt);
    if (P_eof(stdin))
      return false;
    do {
      savetakeover = v_takeoveraction;
      V.mytakeoverflag = false;
      fputs(savepr, stderr);
      TRY(try1);
	if (!newci_redirinput) {
	  v_takeoveraction.proc = (Anyptr)mytakeoveraction;
	  v_takeoveraction.link = (Anyptr)&V;
	}
	if (*def != '\0' && !newci_redirinput) {
	  strcpy(buf, def);
	  newci_inputstring(buf, im_default, "\015\004", &termch, true, &i);
	} else
	  {
	    fgets(buf, 256, stdin);
	    inlen = strlen(buf);
	    if ((inlen > 0) && (buf[inlen - 1] == '\n'))
	      buf[inlen - 1] = '\0';
	  }
	v_takeoveraction = savetakeover;
      RECOVER(try1);
	v_takeoveraction = savetakeover;
	_Escape(P_escapecode);
      ENDTRY(try1);
      if (V.mytakeoverflag)
	v_takeover();
    } while (V.mytakeoverflag);
    Result = (!P_eof(stdin) || *buf != '\0');
    if (P_eof(stdin))
      needresetstdin = true;
    return Result;
  } else {
    cp = v_findcurve(fvar);
    if (cp == NULL || cp->kind != v_ck_num)
      v_nosuchcurve(fvar);
    handle = (na_long)((long)floor(cp->yval + 0.5));
    if ((long)handle > 0 ||
	(long)handle < 0 && ((na_strlistrec *)handle)->kind != '\0')
      v_failmsg("Invalid file handle");
    if ((na_strlistrec *)handle == NULL) {
      *buf = '\0';
      return false;
    } else {
      strcpy(buf, ((na_strlistrec *)handle)->s);
      handle = (na_long)((na_strlistrec *)handle)->next;
      v_assigncurveconst((double)((long)handle), fvar);
      return true;
    }
  }
  return Result;
}


long v_memavail()
{
  return P_imax2(memavail() - 10000, 42L);
}


Void v_checkmemavail()
{
  long newmemavail;

  newmemavail = v_memavail();
  if (newmemavail / 5 < maxmemchunk && newmemavail / 9 < printedmemavail / 10) {
    printf("[WARNING: %ld bytes of memory left!]\n", newmemavail);
    printedmemavail = newmemavail;
  }
}


Void v_readln(prompt, buf)
Char *prompt;
Char *buf;
{
  na_strlist *l1;
  v_controlrec *cp;
  long i, nest;
  boolean done;
  Char def[2];
  Char buf2[256];
  framerec *WITH;
  Char STR1[256];

  nest = readnesting;
  readnesting = 0;
  if (v_eof())
    v_failmsg("Attempted to read past EOF");
  else {
    WITH = instack;
    switch (WITH->kind) {

    case fr_stdin:
      if (WITH->curline == NULL) {
	do {
	  *buf2 = '\0';
	  l1 = v_histlast;
	  do {
	    done = true;
	    if (strends(prompt, "> ")) {
	      v_checkmemavail();
	      sprintf(buf, "%.*s", (int)(strlen(prompt) - 2L), prompt);
	      cp = v_ctrlstack;
	      while (cp != NULL) {
		strcat(buf, ">");
		cp = cp->next;
	      }
	      for (i = 1; i <= nest; i++)
		strcat(buf, ">");
	      if (*buf2 != '\0')
		strcat(buf, ">");
	      strcat(buf, "> ");
	    } else
	      strcpy(buf, prompt);
	    *def = '\0';
	    if (!readkbddef(buf, buf, def, def))   /*kludge!*/
	      needresetstdin = false;
	    splitinput(buf2, buf, &v_history, &v_histlast, 0L);
	  } while (*buf2 != '\0');
	  if (v_histlast == l1) {
	    if (!strcmp(prompt, v_scanprompt) || P_eof(stdin)) {
	      WITH->prevline = NULL;
	      *buf = '\0';
	    } else
	      done = false;
	  } else {
	    if (l1 == NULL)
	      WITH->curline = v_history;
	    else
	      WITH->curline = l1->next;
	  }
	} while (!done);
      }
      if (WITH->curline != NULL) {
	WITH->prevline = WITH->curline;
	strcpy(buf, WITH->curline->s);
	WITH->curline = WITH->curline->next;
      }
      break;

    case fr_file:
    case fr_proc:
    case fr_do:
      WITH->prevline = WITH->curline;
      strcpy(buf, WITH->curline->s);
      WITH->curline = WITH->curline->next;
      break;

    default:
      *buf = '\0';
      break;
    }
  }
  if (v_p_trace->val.U1.i1 >= 1) {
    sprintf(STR1, "Command line: %s", buf);
    v_logwriteln(STR1);
  }
}


v_inputmarker v_markinput()
{
  v_inputmarker Result;
  framerec *fp;

  fp = instack;
  while (fp != NULL && fp->prevline == NULL)
    fp = fp->next;
  if (fp == NULL) {
    v_failmsg("Can't mark current input position");
    return Result;
  }
  if (fp->prevline == NULL)
    v_failmsg("No current line");
  Result.where = (na_long)fp->prevline;
  Result.stamp = (na_long)fp->stamp;
  return Result;
}


long v_inputlnum()
{
  v_inputmarker mark;

  mark = v_markinput();
  return (((short *)(&((na_strlistrec *)mark.where)->value))[0]);
}


Void v_gotoinputfile(mark)
v_inputmarker mark;
{
  framerec *fp;

  fp = instack;
  while (fp != NULL && fp->stamp != (long)mark.stamp)
    fp = fp->next;
  if (fp == NULL)
    v_failmsg("Illegal branch in command stream");
  while (instack != fp)
    v_popinput();
}


Void v_gotoinput(mark)
v_inputmarker mark;
{
  Char STR2[256];

  if (v_p_trace->val.U1.i1 >= 1) {
    sprintf(STR2, "Branch to line %d",
	    ((short *)(&((na_strlistrec *)mark.where)->value))[0]);
    v_logwriteln(STR2);
  }
  v_gotoinputfile(mark);
  instack->curline = (na_strlistrec *)mark.where;
}


Void v_scanword(wrd, nest)
Char *wrd;
long nest;
{
  Char buf[256], *sp;
  long i;
  framerec *WITH;

  do {
    sp = NULL;
    WITH = instack;
    switch (WITH->kind) {

    case fr_stdin:
      if (WITH->curline != NULL)
	sp = WITH->curline->s;
      else if (!P_eof(stdin)) {
	readnesting = nest + 1;
	v_readln(v_scanprompt, buf);
	if (WITH->prevline != NULL) {
	  WITH->curline = WITH->prevline;
	  sp = WITH->prevline->s;
	} else
	  sp = buf;
      }
      break;

    case fr_file:
    case fr_proc:
    case fr_do:
      if (WITH->curline != NULL)
	sp = WITH->curline->s;
      break;
    }
    if (sp == NULL)
      *wrd = '\0';
    else {
      i = strposc(sp, ' ', 1L) - 1;
      if (i < 0)
	i = strlen(sp);
      if (i > 255)
	wrd[0] = '\0';
      else {
	wrd[i] = '\0';
/* p2c: viewmod.text, line 1249:
 * Note: Modification of string length may translate incorrectly [146] */
	strmove(i, sp, 1, wrd, 1);
	misc_upc(wrd);   /*from MISC*/
      }
/* p2c: viewmod.text, line 1245:
 * Note: STRMAX of "wrd" wants VarStrings=1 [151] */
    }
  } while (sp != NULL && *wrd == '\0');
}


Void v_skipln()
{
  Char buf[256];
  framerec *WITH;

  WITH = instack;
  if (WITH->curline != NULL)
    WITH->curline = WITH->curline->next;
  else
    v_readln("", buf);
}



boolean v_readkbd(buf, prompt_, fvar_)
Char *buf;
Char *prompt_, *fvar_;
{
  Char prompt[256], fvar[256];
  Char def[2];

  strcpy(prompt, prompt_);
  strcpy(fvar, fvar_);
  v_checktakeover();
  v_fixstdin();
  *def = '\0';
  return (readkbddef(buf, prompt, def, fvar));
}


boolean v_readkbddef(buf, prompt_, def_, fvar_)
Char *buf;
Char *prompt_, *def_, *fvar_;
{
  Char prompt[256], def[256], fvar[256];

  strcpy(prompt, prompt_);
  strcpy(def, def_);
  strcpy(fvar, fvar_);
  v_checktakeover();
  v_fixstdin();
  return (readkbddef(buf, prompt, def, fvar));
}



Static Void pushinput()
{
  framerec *p;
  Char STR2[256];

  instamp++;
  p = (framerec *)Malloc(sizeof(framerec));
  p->kind = fr_stdin;
  p->stamp = instamp;
  p->held = false;
  p->prevline = NULL;
  p->curline = NULL;
  p->next = instack;
  instack = p;
  if (v_p_trace->val.U1.i1 >= 2) {
    sprintf(STR2, "Push input frame %.8lX", (long)p);
    v_logwriteln(STR2);
  }
}


Void v_pushinput_stdin()
{
  pushinput();
  instack->kind = fr_stdin;
  instack->UU.U0.savehist = v_history;
  instack->UU.U0.savehistlast = v_histlast;
  v_history = NULL;
  v_histlast = NULL;
}


Void v_setup_stdin()
{
  while (instack != NULL)
    v_popinput();
  v_pushinput_stdin();
}


Static infilerec *getfile(fn_, trylib)
Char *fn_;
boolean trylib;
{
  infilerec *Result;
  Char fn[256];
  FILE *f;
  long lnum, curlnum;
  boolean flag;
  Char buf[256], buf2[256];
  infilerec *ifp;
  na_strlist *first, *last;
  misc_catentry cat;
  datetimerec date;
  Char STR2[256];
  Char *TEMP;

  int temp_date;
  struct stat stat_buf;
  strcpy(fn, fn_);
  f = NULL;
  newci_fixfname(fn, "view", "");
  flag = false;
  TRY(try2);
    strcpy(buf, fn);
    if (f != NULL)
      f = freopen(fn, "r", f);
    else
      f = fopen(fn, "r");
    if (f == NULL) {
      P_escapecode = -10;
      P_ioresult = FileNotFound;
      goto _Ltry2;
    }
    flag = true;
  RECOVER2(try2,_Ltry2);
    if (P_escapecode != -10)
      _Escape(P_escapecode);
    if (*fn != '/' && *fn != '~' && trylib) {
      TRY(try3);
	sprintf(buf, "%s/%s", v_libdir, fn);
	if (f != NULL)
	  f = freopen(buf, "r", f);
	else
	  f = fopen(buf, "r");
	if (f == NULL) {
	  P_escapecode = -10;
	  P_ioresult = FileNotFound;
	  goto _Ltry3;
	}
	flag = true;
      RECOVER2(try3,_Ltry3);
	if (P_escapecode != -10)
	  _Escape(P_escapecode);
      ENDTRY(try3);
    }
  ENDTRY(try2);
  if (stat(fn, &stat_buf))
  temp_date = 0;
  else
  temp_date = stat_buf.st_mtime;
  lunix_intToDate(temp_date, &cat.clastdate, &cat.clasttime);
  if (flag) {
    date.date = cat.clastdate;
    date.time = cat.clasttime;
    ifp = infiles;
    while (ifp != NULL && strcmp(ifp->name, fn))
      ifp = ifp->next;
    if (ifp == NULL || dtdiff(ifp->date, date) != 0) {
      if (v_p_trace->val.U1.i1 >= 1) {
	sprintf(STR2, "Reading file %s", buf);
	v_logwriteln(STR2);
      }
      lnum = 0;
      first = NULL;
      last = NULL;
      *buf2 = '\0';
      while (!P_eof(f)) {
	lnum++;
	fgets(buf, 256, f);
	TEMP = strchr(buf, '\n');
	if (TEMP != NULL)
	  *TEMP = 0;
	if (*buf2 == '\0')
	  curlnum = lnum;
	splitinput(buf2, buf, &first, &last, curlnum);
      }
      if (*buf2 != '\0') {
	*buf = '\0';
	splitinput(buf2, buf, &first, &last, curlnum);
      }
      if (ifp == NULL) {
	ifp = (infilerec *)Malloc(sizeof(infilerec));
	ifp->name = strdup(fn);
	ifp->base = NULL;
	ifp->next = infiles;
	infiles = ifp;
      }
      strlist_empty(&ifp->base);
      ifp->base = first;
      ifp->date = date;
    }
    Result = ifp;
  } else
    Result = NULL;
  if (f != NULL)
    fclose(f);
  return Result;
}


na_strlist *v_getfile(fn, trylib)
Char *fn;
boolean trylib;
{
  infilerec *ifp;

  ifp = getfile(fn, trylib);
  if (ifp == NULL)
    return NULL;
  else
    return (ifp->base);
}


boolean v_pushinput_file(fn, trylib)
Char *fn;
boolean trylib;
{
  boolean Result;
  infilerec *ifp;

  ifp = getfile(fn, trylib);
  Result = (ifp != NULL);
  if (ifp == NULL)
    return Result;
  pushinput();
  instack->kind = fr_file;
  instack->UU.filename = ifp;
  instack->curline = ifp->base;
  return Result;
}


Void v_poptostdin()
{
  while (instack != NULL && instack->kind != fr_stdin)
    v_popinput();
  if (instack == NULL)
    v_pushinput_stdin();
  instack->curline = NULL;
  instack->prevline = NULL;
}


Void v_popinput_kbd()
{
  while (instack != NULL && instack->kind != fr_stdin)
    v_popinput();
  v_popinput();
}


Void v_popinput_proc()
{
  while (instack != NULL && instack->kind != fr_proc)
    v_popinput();
  v_popinput();
}


Void v_popinput_file()
{
  while (instack != NULL && instack->kind != fr_file)
    v_popinput();
  v_popinput();
}


long v_holdinput()
{
  long Result;

  if (instack == NULL || instack->next == NULL || instack->next->held)
    return 0;
  Result = instack->next->stamp;
  instack->next->held = true;
  return Result;
}


Void v_unholdinput(handle)
long handle;
{
  framerec *fp;

  fp = instack;
  while (fp != NULL && fp->stamp != handle)
    fp = fp->next;
  if (fp == NULL)
    return;
  while (instack != fp && instack != NULL)
    v_popinput();
  fp->held = false;
}


Static Void v_poptohold(handle)
long handle;
{
  framerec *fp;

  if (handle == 0) {
    while (instack != NULL && instack->next != NULL)
      v_popinput();
  } else {
    fp = instack;
    if (fp != NULL) {
      while (fp->next != NULL && fp->next->stamp != handle)
	fp = fp->next;
    }
    if (fp != NULL) {
      while (instack != fp && instack != NULL)
	v_popinput();
    }
  }
  if (instack != NULL && instack->kind == fr_stdin) {
    instack->curline = NULL;
    instack->prevline = NULL;
  }
}



Void v_poptopcontrols()
{
  long stamp;

  if (instack != NULL)
    stamp = instack->stamp;
  else
    stamp = 0;
  while (v_ctrlstack != NULL && (long)v_ctrlstack->mark.stamp >= stamp) {
    if (v_ctrlstack->aborthook.link != NULL)
      (*(Void(*) PP((v_controlrec *cp, Anyptr _link)))
	v_ctrlstack->aborthook.proc)(v_ctrlstack, v_ctrlstack->aborthook.link);
    else
      (*(Void(*) PP((v_controlrec *cp)))v_ctrlstack->aborthook.proc)(v_ctrlstack);
    popcontrol();
  }
}


Void v_popinput()
{
  v_poptopcontrols();
  popinput();
}


Anyptr v_topcontrolkind()
{
  if (v_ctrlstack == NULL)
    return NULL;
  else
    return (v_ctrlstack->kind);
}


Void v_popcontrol()
{
  if (v_ctrlstack == NULL)
    return;
  while (instack != NULL && instack->stamp > (long)v_ctrlstack->mark.stamp)
    popinput();
  popcontrol();
}





/* User-Defined Functions */

Void v_definefunc(name_, args_, expr)
Char *name_, *args_, *expr;
{
  Char name[256], args[256], wrd[256];
  funcrec *fp;
  na_strlist *arglist, *l1;
  ne_nexrec *nex;
  long i, nargs;
  ne_datatype *argarr;
  Char STR1[256];
  Char STR2[256];

  strcpy(name, name_);
  strcpy(args, args_);
  arglist = NULL;
  nargs = 0;
  do {
    v_strword(args, wrd);
    if (*wrd != '\0') {
      nargs++;
      l1 = strlist_append(&arglist, wrd);
      if (*args == ':') {
	v_needsep(args, ':');
	v_strword(args, wrd);
      } else
	strcpy(wrd, "n");
      if (strcicmp(wrd, "n") == 0)
	ne_makerealarg(l1, nargs);
      else if (strcicmp(wrd, "s") == 0)
	ne_makestrarg(l1, nargs);
      else {
	sprintf(STR1, "Unrecognized argument type: %s", wrd);
	v_failmsg(STR1);
      }
    }
  } while (*wrd != '\0');
  if (*args != '\0')
    v_failmsg("Stray characters in argument list");
  l1 = v_argsymtab;
  TRY(try4);
    v_argsymtab = arglist;
    ne_compile(expr, &nex, &v_nedesc);
    v_argsymtab = l1;
  RECOVER(try4);
    v_argsymtab = l1;
    _Escape(P_escapecode);
    /*           reescape;                    rhkoshi  */
  ENDTRY(try4);
  if (ne_exprtype(nex) == ne_integer)
    nex = ne_typecast(nex, ne_real);
  if (nex == NULL) {
    sprintf(STR1, "Unable to compile %s", expr);
    v_failmsg(STR1);
  }
  if ((ne_opkind)nex->op == ne_error) {
    v_nedesc.error = (unsigned)((ne_errorkind)nex->UU.err);
    ne_dispose(&nex);
    v_failneerr((ne_errorkind)v_nedesc.error);
  }
  strcpy(STR1, strltrim(strrtrim(strcpy(STR2, name))));
  strcpy(name, STR1);
  fp = funcbase;
  while (fp != NULL && strcmp(fp->name, name))
    fp = fp->next;
  if (fp == NULL) {
    fp = (funcrec *)Malloc(sizeof(funcrec));
    fp->name = strdup(name);
    l1 = strlist_insert(&funcsymtab, name);
    fp->defn = strdup(expr);
    fp->sym = l1;
    fp->next = funcbase;
    funcbase = fp;
  } else {
    strchange(&fp->defn, expr);
    ne_dispose(&fp->nex);
    strlist_empty(&fp->args);
    ne_disposesym(fp->sym);
  }
  fp->nex = nex;
  fp->rtype = ne_exprtype(nex);
  fp->args = arglist;
  na_alloc((Anyptr) &argarr, P_imax2(nargs, 1L) * sizeof(ne_datatype));
      /*avoid nil pointer*/
  l1 = arglist;
  for (i = 0; i < nargs; i++) {
    switch (l1->kind) {

    case ne_kind_realarg:
      argarr[i] = ne_real;
      break;

    case ne_kind_strarg:
      argarr[i] = ne_string;
      break;
    }
    l1 = l1->next;
  }
  switch (fp->rtype) {

  case ne_real:
    ne_makerealsfunc(fp->sym, nargs, argarr, &fp->nex);
    break;

  case ne_string:
    ne_makestrsfunc(fp->sym, nargs, argarr, &fp->nex);
    break;

  default:
    v_failmsg("Bad function type");
    break;
  }
  prevaddedfunc = addedfunc;
  addedfunc = fp->sym;
  addedcmd = NULL;
  na_free((Anyptr)&argarr);
}


#define width_          20


/* Local variables for v_listfuncs: */
struct LOC_v_listfuncs {
  long pos;
  boolean found;
} ;

Local Char *funcargs(Result, l1, LINK)
Char *Result;
na_strlist *l1;
struct LOC_v_listfuncs *LINK;
{
  Char wrd[256];
  ne_functionrec *nfp;
  long i, FORLIM;

  *wrd = '\0';
  nfp = (ne_functionrec *)l1->value;
  if (nfp->maxargs <= 0)
    return strcpy(Result, wrd);
  strcat(wrd, "(");
  FORLIM = nfp->nargs;
  for (i = 1; i <= FORLIM; i++) {
    if (i == nfp->minargs + 1)
      strcat(wrd, "[");
    if (i > 1)
      strcat(wrd, ",");
    switch (nfp->UU.U99.ptypes[i - 1]) {

    case ne_integer:
      strcat(wrd, "I");
      break;

    case ne_real:
      strcat(wrd, "N");
      break;

    case ne_string:
      strcat(wrd, "S");
      break;

    case ne_boolean:
      strcat(wrd, "B");
      break;

    default:
      strcat(wrd, "?");
      break;
    }
  }
  if (nfp->maxargs > nfp->nargs) {
    if (nfp->nargs == nfp->minargs)
      strcat(wrd, "[");
    if (nfp->nargs > 0)
      strcat(wrd, ",");
    strcat(wrd, "...");
  }
  if (nfp->minargs < nfp->maxargs)
    strcat(wrd, "]");
  strcat(wrd, ")");
  return strcpy(Result, wrd);
}

Local Void lfuncs(l1, isulined, LINK)
na_strlist *l1;
boolean isulined;
struct LOC_v_listfuncs *LINK;
{
  ne_functionrec *nfp;
  Char buf2[256];
  long fudge;
  Char STR1[256];

  while (l1 != NULL) {
    if ((l1->kind == ne_kind_strfunc || l1->kind == ne_kind_realfunc) &&
	strcmp(l1->s, "if"))
    {   /*yow*/
      fudge = 0;
      nfp = (ne_functionrec *)l1->value;
      if (l1->kind == ne_kind_realfunc)
	strcpy(buf2, "  ");
      else
	strcpy(buf2, "S ");
      strcat(buf2, l1->s);
      strcat(buf2, funcargs(STR1, l1, LINK));
      if (LINK->pos + width_ * 2 > nc_curWindow->width) {
	puts(buf2);
	LINK->pos = 0;
      } else {
	do {
	  strcat(buf2, " ");
/* p2c: viewmod.text, line 1812:
 * Note: Using % for possibly-negative arguments [317] */
	} while ((strlen(buf2) - fudge) % width_ != 0);
	fputs(buf2, stdout);
	LINK->pos += strlen(buf2) - fudge;
      }
    }
    l1 = l1->next;
  }
}

Local Void descfuncs(l1, wrd_, LINK)
na_strlist *l1;
Char *wrd_;
struct LOC_v_listfuncs *LINK;
{
  Char wrd[256];
  ne_functionrec *nfp;
  funcrec *fp;
  na_strlist *l2;
  Char STR1[256];
  Char STR2[256];

  strcpy(wrd, wrd_);
  while (l1 != NULL && strcmp(l1->s, wrd))
    l1 = l1->next;
  if (l1 == NULL ||
      l1->kind != ne_kind_strfunc && l1->kind != ne_kind_realfunc)
    return;
  nfp = (ne_functionrec *)l1->value;
  if (nfp->subnex) {
    fp = funcbase;
    while (fp != NULL && fp->sym != l1)
      fp = fp->next;
    if (fp != NULL) {
      l2 = fp->args;
      if (l2 != NULL) {
	strcat(wrd, "(");
	while (l2 != NULL) {
	  strcat(wrd, l2->s);
	  l2 = l2->next;
	  if (l2 != NULL)
	    strcat(wrd, ",");
	}
	strcat(wrd, ")");
      }
      sprintf(STR2, "%s = %s", wrd, fp->defn);
      v_logwriteln(STR2);
    } else {
      sprintf(STR2, "No information on %s", wrd);
      v_logwriteln(STR2);
    }
  } else {
    sprintf(STR2, "Function %s%s is a Pascal built-in",
	    wrd, funcargs(STR1, l1, LINK));
    v_logwriteln(STR2);
  }
  LINK->found = true;
}


Void v_listfuncs(buf_)
Char *buf_;
{
  struct LOC_v_listfuncs V;
  Char buf[256], wrd[256];
  Char STR1[256];

  strcpy(buf, buf_);
  if (*buf != '\0') {
    do {
      v_strword(buf, wrd);
      if (*wrd != '\0') {
	V.found = false;
	descfuncs(funcsymtab, wrd, &V);
	descfuncs(v_nedesc.symtab, wrd, &V);
	if (!V.found) {
	  sprintf(STR1, "No function called %s", wrd);
	  v_failmsg(STR1);
	}
      }
    } while (*wrd != '\0');
    return;
  }
  V.pos = 0;
  lfuncs(funcsymtab, true, &V);
  lfuncs(v_nedesc.symtab, false, &V);
  if (V.pos > 0)
    putchar('\n');
}

#undef width_





/* Expressions */

Char *v_neerrmsg(Result, err)
Char *Result;
ne_errorkind err;
{
  switch (err) {

  case ne_syntax:
    strcpy(Result, "Syntax error in expression");
    break;

  case ne_overflow:
    strcpy(Result, "Numeric overflow");
    break;

  case ne_underflow:
    strcpy(Result, "Numeric underflow");
    break;

  case ne_divzero:
    strcpy(Result, "Division by zero");
    break;

  case ne_strlong:
    strcpy(Result, "String too long");
    break;

  case ne_badtypes:
    strcpy(Result, "Data types don't match");
    break;

  case ne_undef:
    strcpy(Result, "No such name");
    break;

  case ne_badval:
    strcpy(Result, "Undefined value");
    break;

  default:
    strcpy(Result, "");
    break;
  }
  return Result;
}




Void v_scrapsymtab()
{
  /* obsolete */
}


Void v_addfuncname(name_, symp)
Char *name_;
na_strlist **symp;
{
  Char name[256];

  strcpy(name, name_);
  strlower(name, name);
  *symp = strlist_insert(&v_nedesc.symtab, name);
  strlist_remove(&funchelp, name);
  prevaddedfunc = addedfunc;
  addedfunc = *symp;
  addedcmd = NULL;
}


Void v_realfuncgen(name, t1, t2, proc)
Char *name;
ne_datatype t1, t2;
_PROCEDURE proc;
{
  na_strlist *l1;

  v_addfuncname(name, &l1);
  ne_makerealfunc(l1, t1, t2, ne_notype, proc);
}


Void v_realfuncgen3(name, t1, t2, t3, proc)
Char *name;
ne_datatype t1, t2, t3;
_PROCEDURE proc;
{
  na_strlist *l1;

  v_addfuncname(name, &l1);
  ne_makerealfunc(l1, t1, t2, t3, proc);
}


Void v_strfuncgen(name, t1, t2, proc)
Char *name;
ne_datatype t1, t2;
_PROCEDURE proc;
{
  na_strlist *l1;

  v_addfuncname(name, &l1);
  ne_makestrfunc(l1, t1, t2, ne_notype, proc);
}


Void v_strfuncgen3(name, t1, t2, t3, proc)
Char *name;
ne_datatype t1, t2, t3;
_PROCEDURE proc;
{
  na_strlist *l1;

  v_addfuncname(name, &l1);
  ne_makestrfunc(l1, t1, t2, t3, proc);
}


Void v_realfunc(name, proc)
Char *name;
_PROCEDURE proc;
{  /* f(r):r */
  v_realfuncgen(name, ne_real, ne_notype, proc);
}


Void v_realfunco2(name, proc)
Char *name;
_PROCEDURE proc;
{  /* f(r):r */
  v_realfuncgen(name, ne_real, ne_real, proc);
  v_setminargs(1L);
}


Void v_realfunc2(name, proc)
Char *name;
_PROCEDURE proc;
{  /* f(r,r):r */
  v_realfuncgen(name, ne_real, ne_real, proc);
}


Void v_staticfunc()
{
  ne_makestaticfunc(addedfunc);
}


Void v_setminargs(minargs)
long minargs;
{
  ne_setminargs(addedfunc, minargs);
}


Void v_setmaxargs(maxargs)
long maxargs;
{
  ne_setmaxargs(addedfunc, maxargs);
}



Static Void viewsymproc(name, desc, symptr)
Char *name;
ne_desc *desc;
na_strlist **symptr;
{
  if (!v_nedesc.isfunc) {
    *symptr = strlist_find(v_argsymtab, name);
    if (*symptr == NULL)
      *symptr = strlist_find(curvesymtab, name);
    if (*symptr == NULL)
      *symptr = strlist_find(suffixsymtab, name);
  } else
    *symptr = NULL;
  if (*symptr == NULL)
    *symptr = strlist_find(funcsymtab, name);
  if (*symptr == NULL)
    *symptr = strlist_find(v_nedesc.symtab, name);
}



Void v_setcurvekind(cp, kind)
v_curverec *cp;
v_curvekinds kind;
{
  if (cp->kind == kind)
    return;
  if (cp->kind == v_ck_none) {
    cp->symptr->s[0] = cp->name[0];
    if (v_curvebase == NULL)   /*add to linked list*/
      v_curvelast = cp;
    else
      v_curvebase->prev = cp;
    cp->next = v_curvebase;
    v_curvebase = cp;
    cp->prev = NULL;
  } else if (kind == v_ck_none) {
    cp->symptr->s[0] = '*';
    cp->symptr_x->s[0] = '*';
    cp->symptr_y->s[0] = '*';
    if (cp->next == NULL)   /*delete from linked list*/
      v_curvelast = cp->prev;
    else
      cp->next->prev = cp->prev;
    if (cp->prev == NULL)
      v_curvebase = cp->next;
    else
      cp->prev->next = cp->next;
  }
  cp->kind = kind;
  ck_cachestr[0] = '\0';
}


Void v_unassigncurve(cp)
v_curverec *cp;
{
  switch (cp->kind) {

  case v_ck_string:
    strdispose(&cp->sval);
    break;

  case v_ck_curve:
    v_disposevector(&cp->vec, cp->base->len);
    break;
  }
  v_setcurvekind(cp, v_ck_none);
}


Void v_fixcurvesym(cp)
v_curverec *cp;
{
  switch (cp->kind) {

  case v_ck_string:
    cp->symptr_x->s[0] = '*';
    cp->symptr_y->s[0] = '*';
    if (cp->symptr->kind != ne_kind_strptr)
      ne_makestrptrvar(cp->symptr, &cp->sval);
    break;

  case v_ck_num:
    cp->symptr_x->s[0] = '*';
    cp->symptr_y->s[0] = '*';
    if (cp->symptr->kind != ne_kind_realxptr)
      ne_makerealxvar(cp->symptr, &cp->yval);
    break;

  case v_ck_curve:
    cp->symptr_x->s[0] = cp->name[0];
    cp->symptr_y->s[0] = cp->name[0];
    if (cp->symptr->kind != ne_kind_realxptr)
      ne_makerealxvar(cp->symptr, &cp->yval);
    break;
  }
}


Void v_buildsymtab(t)
long t;
{
  /* obsolete */
}


Static Void buildsymtab()
{
  na_strlist *l1;

  l1 = strlist_insert(&curvesymtab, "base");
  ne_makerealxvar(l1, &baseval);
}


Void v_addfuncs(proc)
_PROCEDURE proc;
{
  /*obsolete form*/
  if (proc.link != NULL)
    (*(Void(*) PP((Anyptr _link)))proc.proc)(proc.link);
  else
    (*(Void(*) PV())proc.proc)();
}





/* Parsing command lines */

Void v_exstrword(buf, wrd)
Char *buf, *wrd;
{
  boolean inquote;
  long parcount;
  Char ch, quotech;

  inquote = false;
  quotech = '\0';
  parcount = 0;
  *wrd = '\0';
  while (*buf == ' ')
    strcpy(buf, buf + 1);
  while (*buf != '\0' &&
	 (inquote || parcount > 0 ||
	  (buf[0] != ')' && buf[0] != ',' && buf[0] != ']' && buf[0] != '[' &&
	   buf[0] != '@' && buf[0] != '=' && buf[0] != ';' && buf[0] != ':' &&
	   buf[0] != ' '))) {
    ch = buf[0];
    if (inquote) {
      if (ch == quotech)
	inquote = false;
    } else {
      if (ch == '"' || ch == '\'') {
	inquote = true;
	quotech = ch;
      } else if (ch == '{' || ch == '(')
	parcount++;
      else if (ch == '}' || ch == ')')
	parcount--;
    }
    sprintf(wrd + strlen(wrd), "%c", ch);
    strcpy(buf, buf + 1);
  }
  while (*buf == ' ')
    strcpy(buf, buf + 1);
  if (*buf == ',') {
    strcpy(buf, buf + 1);
    while (*buf == ' ')
      strcpy(buf, buf + 1);
  }
  if (!strncmp(buf, ":=", 2L))
    strcpy(buf, buf + 1);
}


Void v_strword(buf, wrd)
Char *buf, *wrd;
{
  long i;

  v_exstrword(buf, wrd);
  if (strlen(wrd) <= 1 || wrd[0] != '"' && wrd[0] != '\'' ||
      wrd[strlen(wrd) - 1] != wrd[0])
    return;
  wrd[strlen(wrd) - 1] = '\0';
  strcpy(wrd, wrd + 1);
  i = 0;
  do {
    if (wrd[0] == '"')
      i = strpos2(wrd, "\"\"", i + 1);
    else
      i = strpos2(wrd, "''", i + 1);
    if (i > 0)
      strcpy(wrd + i - 1, wrd + i);
  } while (i != 0);
}


boolean v_parseuexpr(wrd, nexr, units)
Char *wrd;
ne_nexrec *nexr;
Char *units;
{
  ne_nexrec *nex;
  Char STR1[256];

  v_arithidx = 0;
  v_arithbase = NULL;
  ne_compile(wrd, &nex, &v_nedesc);
  v_checkneeds(nex);
  if (!v_checkunits(nex, units))
    v_badunits();
  ne_evaluate(nex, nexr);
  ne_dispose(&nex);
  if ((ne_opkind)nexr->op == ne_error &&
      (ne_errorkind)nexr->UU.err != ne_badval) {
    v_errormsg(v_neerrmsg(STR1, (ne_errorkind)nexr->UU.err), false);
    return false;
  } else
    return true;
}


boolean v_parseexpr(wrd, nexr)
Char *wrd;
ne_nexrec *nexr;
{
  Char units[256];

  return (v_parseuexpr(wrd, nexr, units));
}


Void v_formatstr(nexr, buf, fmt1, fmt2)
ne_nexrec nexr;
Char *buf;
long fmt1, fmt2;
{
  long i;
  Char STR2[256];

  if (fmt1 > 255) {
/* p2c: viewmod.text, line 2249:
 * Note: STRMAX of "buf" wants VarStrings=1 [151] */
    fmt1 = 255;
/* p2c: viewmod.text, line 2250:
 * Note: STRMAX of "buf" wants VarStrings=1 [151] */
  }
  switch ((ne_opkind)nexr.op) {

  case ne_error:
    strcpy(buf, "X");
    if (fmt1 >= 2)
      sprintf(buf, "%*s%s", (int)(fmt1 - 1), "", strcpy(STR2, buf));
    break;

  case ne_ic:
    ma_strfmtreal(buf, (double)nexr.UU.i, fmt1, fmt2);
    break;

  case ne_rc:
    ma_strfmtreal(buf, nexr.UU.r, fmt1, fmt2);
    break;

  case ne_sc:
    strcpy(buf, nexr.UU.s);
    for (i = strlen(buf) + 1; i <= fmt1; i++)
      strcat(buf, " ");
    strdispose(&nexr.UU.s);
    break;
  }

}


boolean v_parseufmtstr(wrd, buf, units, fmt1, fmt2)
Char *wrd;
Char *buf, *units;
long fmt1, fmt2;
{
  ne_nexrec nexr;

  if (v_parseuexpr(wrd, &nexr, units)) {
    v_formatstr(nexr, buf, fmt1, fmt2);
    return true;
  } else
    return false;
}


boolean v_parseustr(wrd, buf, units)
Char *wrd;
Char *buf, *units;
{
  return (v_parseufmtstr(wrd, buf, units, -1L, -1L));
}


boolean v_parsefmtstr(wrd, buf, fmt1, fmt2)
Char *wrd;
Char *buf;
long fmt1, fmt2;
{
  Char units[256];

  return (v_parseufmtstr(wrd, buf, units, fmt1, fmt2));
}


boolean v_parsestr(wrd, buf)
Char *wrd;
Char *buf;
{
  Char units[256];

  return (v_parseufmtstr(wrd, buf, units, -1L, -1L));
}


boolean v_parseureal(wrd_, r, units)
Char *wrd_;
double *r;
Char *units;
{
  boolean Result;
  Char wrd[256];
  ne_nexrec nexr;
  long i;
  Char *STR1;
  Char STR2[256];

  strcpy(wrd, wrd_);
  Result = true;
  if (!v_parseuexpr(wrd, &nexr, units))
    return false;
  switch ((ne_opkind)nexr.op) {

  case ne_error:
    v_errormsg("Value is undefined", false);
    Result = false;
    break;

  case ne_ic:
    *r = nexr.UU.i;
    break;

  case ne_rc:
    *r = nexr.UU.r;
    break;

  case ne_sc:
    TRY(try5);
      strcpy(wrd, strltrim(strrtrim(strcpy(STR2, nexr.UU.s))));
      strdispose(&nexr.UU.s);
      *r = strtod(wrd, &STR1);
      i = STR1 - wrd + 1;
      if (i <= strlen(wrd)) {
	P_escapecode = -1;
	goto _Ltry5;
      }
    RECOVER2(try5,_Ltry5);
      if (P_escapecode == -20)
	_Escape(P_escapecode);
      v_errormsg("Syntax error in number", false);
      Result = false;
    ENDTRY(try5);
    break;
  }
  return Result;
}


boolean v_parsereal(wrd, r)
Char *wrd;
double *r;
{
  Char units[256];

  return (v_parseureal(wrd, r, units));
}


boolean v_parseinteger(wrd, i)
Char *wrd;
long *i;
{
  double r;

  if (v_parsereal(wrd, &r)) {
    *i = (long)floor(r + 0.5);
    return true;
  } else
    return false;
}



boolean v_parsecondition(wrd, b)
Char *wrd;
boolean *b;
{
  ne_nexrec nexr;

  if (v_parseexpr(wrd, &nexr)) {
    switch ((ne_opkind)nexr.op) {

    case ne_error:
      *b = false;
      break;

    case ne_ic:
      *b = (nexr.UU.i != 0);
      break;

    case ne_rc:
      *b = (nexr.UU.r != 0.0);
      break;

    case ne_sc:
      *b = (*nexr.UU.s != '\0');
      strdispose(&nexr.UU.s);
      break;
    }
    return true;
  } else
    return false;
}





/* Messing around with curves */

Void v_change(cp)
v_curverec *cp;
{
  cp->chgtime = v_timestamp;
  v_timestamp++;
}


Void v_makecurve(cp, bp, vec, units, name_)
v_curverec **cp;
v_baserec *bp;
double *vec;
Char *units, *name_;
{
  Char name[256];
  Char ch;
  v_curverec **cpp;
  Char buf[256];
  Char STR1[256], STR2[256];

  strcpy(name, name_);
  if (*name == '\0')
    v_failmsg("Curve name is blank");
  ch = toupper(name[0]);
  if (ch == ' ' || strends(name, " ")) {
    strcpy(STR1, strltrim(strrtrim(strcpy(STR2, name))));
    strcpy(name, STR1);
    if (*name == '\0')
      v_failmsg("Curve name is blank");
    ch = toupper(name[0]);
  }
  if (ch < 'A' || ch > 'Z')
    ch = '@';
  cpp = &v_curvetree[ch - '@'];
  while (*cpp != NULL && strcmp((*cpp)->name, name)) {
    if (strcmp((*cpp)->name, name) < 0)
      cpp = &(*cpp)->lnext;
    else
      cpp = &(*cpp)->rnext;
  }
  if (*cpp == NULL) {
    *cp = (v_curverec *)Malloc(sizeof(v_curverec));
    *cpp = *cp;
    (*cp)->lnext = NULL;
    (*cp)->rnext = NULL;
    (*cp)->name = strdup(name);
    (*cp)->kind = v_ck_none;
    (*cp)->dest = NULL;
    (*cp)->units = NULL;
    (*cp)->expr = NULL;
    (*cp)->nex = NULL;
    (*cp)->checktime = -1;
    (*cp)->sval = NULL;
    (*cp)->symptr = strlist_insert(&curvesymtab, (*cp)->name);
    sprintf(STR1, "%s_y", (*cp)->name);
    (*cp)->symptr_y = strlist_insert(&suffixsymtab, STR1);
    ne_makerealxvar((*cp)->symptr_y, &(*cp)->yval);
    sprintf(STR1, "%s_x", (*cp)->name);
    (*cp)->symptr_x = strlist_insert(&suffixsymtab, STR1);
    ne_makerealxvar((*cp)->symptr_x, &(*cp)->xval);
    ck_cachestr[0] = '\0';
  } else {
    *cp = *cpp;
    if (v_p_novice->val.U1.i1 != 0 && (*cp)->kind == v_ck_curve) {
      fprintf(stderr, "Do you really want to overwrite %s? ", name);
      fgets(buf, 256, stdin);
      if (strcibegins(buf, "n"))
	v_failmsg("Curve overwrite aborted");
    }
    switch ((*cp)->kind) {

    case v_ck_string:
      strdispose(&(*cp)->sval);
      break;

    case v_ck_curve:
      v_disposevector(&(*cp)->vec, (*cp)->base->len);
      break;
    }
    strdispose(&(*cp)->expr);
    ne_dispose(&(*cp)->nex);
  }
  strchange(&(*cp)->units, units);
  (*cp)->exprtime = -2;   /*must be less than -1*/
  (*cp)->savetime = -1;
  if (bp != NULL)
    v_setcurvekind(*cp, v_ck_curve);
  else
    v_setcurvekind(*cp, v_ck_none);
  (*cp)->base = bp;
  (*cp)->vec = vec;
  (*cp)->xval = 0.0;
  (*cp)->yval = 0.0;
  v_fixcurvesym(*cp);
  v_change(*cp);
}



Void v_addcurve(len, xvec, yvec, xunit, yunit, name)
long len;
double *xvec, *yvec;
Char *xunit, *yunit, *name;
{
  v_baserec *bp;
  v_curverec *cp;
  double *vec;
  long i;
  boolean found, sorted;
  Char STR1[256];

  if (xvec == NULL) {
    bp = NULL;
    vec = NULL;
  } else {
    i = 2;
    while (i <= len && xvec[i - 2] < xvec[i - 1])
      i++;
    sorted = (i > len);
    bp = v_basebase;
    found = false;
    while (bp != NULL && !found) {
      if (bp->len == len && bp->sorted == sorted &&
	  strcicmp(bp->units, xunit) == 0) {
	i = 1;
	while (i <= len && isequal(bp->vec[i - 1], xvec[i - 1]))
	  i++;
	if (i > len)
	  found = true;
      }
      if (!found)
	bp = bp->next;
    }
    if (bp == NULL) {   /*must make a new base*/
      bp = (v_baserec *)Malloc(sizeof(v_baserec));
      bp->len = len;
      bp->sorted = sorted;
      bp->units = strdup(xunit);
      v_newvector(&bp->vec, len);
      for (i = 0; i < len; i++)
	bp->vec[i] = xvec[i];
      bp->next = v_basebase;
      v_basebase = bp;
    }
    v_newvector(&vec, len);
    for (i = 0; i < len; i++)
      vec[i] = yvec[i];
  }
  v_makecurve(&cp, bp, vec, yunit, name);
  if (v_p_trace->val.U1.i1 >= 2) {
    sprintf(STR1, "Creating curve %s", cp->name);
    v_logwriteln(STR1);
  }
}  /*v_addcurve*/


typedef long permutation[1000000L];


/* Local variables for v_sortcurve: */
struct LOC_v_sortcurve {
  double *xvec;
} ;

static int sortcomp(a, b, LINK)
na_long a, b;
struct LOC_v_sortcurve *LINK;
{
  double ra, rb;

  ra = LINK->xvec[(long)a - 1];
  rb = LINK->xvec[(long)b - 1];
  if (ra > rb) {
    return 1;
  }
  if (ra != rb)
    return -1;
  else
    return 0;
}



Void v_sortcurve(cp)
v_curverec *cp;
{
  struct LOC_v_sortcurve V;
  v_baserec *bp;
  double *vec;
  long *pp;
  long i, j, len;
  boolean found;
  _PROCEDURE TEMP;

  if (cp->expr != NULL)
    v_failmsg("Can't sort a computed curve");
  if (cp->kind != v_ck_curve || cp->base->sorted)
    return;
  len = cp->base->len;
  V.xvec = cp->base->vec;
  na_alloc((Anyptr)&pp, len * sizeof(long));
  for (i = 1; i <= len; i++)
    pp[i - 1] = i;
  i = 2;
  while (i <= len && V.xvec[i - 2] <= V.xvec[i - 1])
    i++;
  if (i <= len) {
    TEMP.proc = (Anyptr)sortcomp;
    TEMP.link = (Anyptr)&V;
    /*  v_logwriteln('Warning: basis values are out of order, sorting...');  */
    na_qsort((na_long *)pp, len, TEMP);
  }
  j = 1;
  for (i = 2; i <= len; i++) {
    if (!isequal(V.xvec[pp[i - 1] - 1], V.xvec[pp[j - 1] - 1])) {
      j++;
      if (i != j)
	pp[j - 1] = pp[i - 1];
    }
  }
  if (j < len) {
    v_logwriteln("Warning: duplicate basis values have been removed");
    len = j;
  }
  bp = v_basebase;
  found = false;
  while (bp != NULL && !found) {
    if (bp->len == len && strcicmp(bp->units, cp->base->units) == 0) {
      i = 1;
      while (i <= len && isequal(bp->vec[i - 1], V.xvec[pp[i - 1] - 1]))
	i++;
      if (i > len)
	found = true;
    }
    if (!found)
      bp = bp->next;
  }
  if (bp == NULL) {   /*must make a new base*/
    bp = (v_baserec *)Malloc(sizeof(v_baserec));
    bp->len = len;
    bp->units = strdup(cp->base->units);
    v_newvector(&bp->vec, len);
    for (i = 0; i < len; i++)
      bp->vec[i] = V.xvec[pp[i] - 1];
    bp->next = v_basebase;
    v_basebase = bp;
  }
  v_newvector(&vec, len);
  for (i = 0; i < len; i++)
    vec[i] = cp->vec[pp[i] - 1];
  v_disposevector(&cp->vec, cp->base->len);
  cp->vec = vec;
  cp->base = bp;
  i = len;   /* assuming v_badvalue is very positive */
  while (i >= 1 && bp->vec[i - 1] > v_badvalue)
    i--;
  bp->sorted = (i < 1 || bp->vec[i - 1] != v_badvalue);
  if (!bp->sorted)
    v_logwriteln("Warning: basis contains undefined values");
  na_free((Anyptr)&pp);
}  /*v_sortcurve*/


Void v_checksorted(bp)
v_baserec *bp;
{
  if (!bp->sorted)
    v_failmsg("Basis must be sorted for this operation");
}


Void v_addcurveexpr(expr, name)
Char *expr, *name;
{
  v_curverec *cp;
  Char STR1[256];

  v_makecurve(&cp, NULL, NULL, "", name);
  cp->expr = strdup(expr);
  v_setcurvekind(cp, v_ck_num);   /*just to get it into symbol table*/
  cp->yval = 0.0;
  if (v_p_trace->val.U1.i1 >= 2) {
    sprintf(STR1, "Defining %s == %s", cp->name, expr);
    v_logwriteln(STR1);
  }
}


Void v_addcurveconst(val, yunit, name)
double val;
Char *yunit, *name;
{
  v_curverec *cp;
  Char STR3[256];

  v_makecurve(&cp, NULL, NULL, yunit, name);
  v_setcurvekind(cp, v_ck_num);
  cp->yval = val;
  v_fixcurvesym(cp);
  if (v_p_trace->val.U1.i1 >= 2) {
    sprintf(STR3, "Defining %s = %g", cp->name, val);
    v_logwriteln(STR3);
  }
}


Void v_assigncurveconst(val, name)
double val;
Char *name;
{
  v_curverec *cp;
  Char STR3[256];

  cp = v_findcurve(name);
  if (cp == NULL || cp->expr != NULL || cp->kind != v_ck_num) {
    v_addcurveconst(val, "", name);
    return;
  }
  if (v_p_trace->val.U1.i1 >= 2) {
    sprintf(STR3, "Changing %s = %g", cp->name, val);
    v_logwriteln(STR3);
  }
  cp->yval = val;
  v_change(cp);
}


Void v_addcurvestr(val, name)
Char *val, *name;
{
  v_curverec *cp;
  Char STR2[256];

  v_makecurve(&cp, NULL, NULL, "", name);
  v_setcurvekind(cp, v_ck_string);
  cp->sval = strdup(val);
  v_fixcurvesym(cp);
  if (v_p_trace->val.U1.i1 >= 2) {
    sprintf(STR2, "Defining %s = \"%s\"", cp->name, val);
    v_logwriteln(STR2);
  }
}


Void v_assigncurvestr(val, name)
Char *val, *name;
{
  v_curverec *cp;
  Char STR2[256];

  cp = v_findcurve(name);
  if (cp == NULL || cp->expr != NULL || cp->kind != v_ck_string) {
    v_addcurvestr(val, name);
    return;
  }
  strchange(&cp->sval, val);
  v_change(cp);
  if (v_p_trace->val.U1.i1 >= 2) {
    sprintf(STR2, "Changing %s = \"%s\"", cp->name, val);
    v_logwriteln(STR2);
  }
}



Void v_deletecurve(cp)
v_curverec **cp;
{
  Char STR1[256];

  if (v_p_trace->val.U1.i1 >= 2) {
    sprintf(STR1, "Deleting %s", (*cp)->name);
    v_logwriteln(STR1);
  }
  strdispose(&(*cp)->units);
  strdispose(&(*cp)->expr);
  ne_dispose(&(*cp)->nex);
  v_unassigncurve(*cp);
}


v_curverec *v_findcurve(name)
Char *name;
{
  Char ch;
  v_curverec *cp;

  if (*name == '\0')
    v_failmsg("Curve name is blank");
  ch = toupper(name[0]);
  if (ch < 'A' || ch > 'Z')
    ch = '@';
  cp = v_curvetree[ch - '@'];
  while (cp != NULL && strcmp(cp->name, name)) {
    if (strcmp(cp->name, name) < 0)
      cp = cp->lnext;
    else
      cp = cp->rnext;
  }
  if (cp != NULL && cp->kind != v_ck_none)
    return cp;
  else
    return NULL;
}


/* Local variables for v_curvelist: */
struct LOC_v_curvelist {
  v_curverec **cbase;
  v_clmode mode;
  Char rex[256];
  v_curverec *cplast;
  boolean any;
} ;

Local Void docurve(cp, LINK)
v_curverec *cp;
struct LOC_v_curvelist *LINK;
{
  if (cp == NULL)
    return;
  docurve(cp->lnext, LINK);
  if (cp->kind != v_ck_none && re_compare(cp->name, LINK->rex)) {
    if (!cp->used) {
      if (LINK->cplast == NULL)
	*LINK->cbase = cp;
      else {
	LINK->cplast->next2 = cp;
	if (LINK->mode == v_clone)
	  v_failmsg("Must have exactly one curve name");
      }
      cp->next2 = NULL;
      cp->used = true;
      LINK->cplast = cp;
    }
    LINK->any = true;
  }
  docurve(cp->rnext, LINK);
}


Void v_curvelist(buf, cbase_, mode_)
Char *buf;
v_curverec **cbase_;
v_clmode mode_;
{
  struct LOC_v_curvelist V;
  Char wrd[256];
  v_curverec *cp;
  Char ch;

  V.cbase = cbase_;
  V.mode = mode_;
  cp = v_curvebase;
  while (cp != NULL) {
    cp->used = false;
    cp = cp->next;
  }
  V.cplast = NULL;
  *V.cbase = NULL;
  do {
    v_strword(buf, wrd);
    if (*wrd != '\0') {
      re_compile(wrd, V.rex, v_rechars);
      V.any = false;
      for (ch = '@'; ch <= 'Z'; ch++)
	docurve(v_curvetree[ch - '@'], &V);
      /*  if not any then
            v_nosuchcurve(wrd);  */
    }
  } while (*wrd != '\0');
  if (*V.cbase == NULL && V.mode != v_clopt)
    v_needcurvename();
}


/* Local variables for v_ncurvelist: */
struct LOC_v_ncurvelist {
  v_curverec **cbase;
  v_clmode mode;
  Char rex[256];
  v_curverec *cplast;
  long style, astyle;
  boolean any;
} ;

Local Void docurve_(cp, LINK)
v_curverec *cp;
struct LOC_v_ncurvelist *LINK;
{
  if (cp == NULL)
    return;
  docurve_(cp->lnext, LINK);
  if (cp->kind != v_ck_none && re_compare(cp->name, LINK->rex)) {
    if (!cp->used) {
      TRY(try6);
	v_needcurve(cp);
	if (LINK->cplast == NULL)
	  *LINK->cbase = cp;
	else {
	  LINK->cplast->next2 = cp;
	  if (LINK->mode == v_clone)
	    v_failmsg("Must have exactly one curve name");
	}
	cp->next2 = NULL;
	cp->used = true;
	cp->style = LINK->style;
	cp->astyle = LINK->astyle;
	LINK->cplast = cp;
      RECOVER(try6);
	if (P_escapecode != -1)
	  _Escape(P_escapecode);
      ENDTRY(try6);
    }
    LINK->any = true;
  }
  docurve_(cp->rnext, LINK);
}


Void v_ncurvelist(buf, cbase_, mode_)
Char *buf;
v_curverec **cbase_;
v_clmode mode_;
{
  struct LOC_v_ncurvelist V;
  Char wrd[256], wrd2[256];
  v_curverec *cp;
  Char ch;

  V.cbase = cbase_;
  V.mode = mode_;
  cp = v_curvebase;
  while (cp != NULL) {
    cp->used = false;
    cp = cp->next;
  }
  V.cplast = NULL;
  *V.cbase = NULL;
  do {
    v_strword(buf, wrd);
    if (*wrd != '\0') {
      V.style = 0;
      V.astyle = 1;
      if (*buf == '@') {
	strcpy(buf, buf + 1);
	v_strword(buf, wrd2);
	if (!v_parseinteger(wrd2, &V.style))
	  v_fail();
      }
      if (*buf == '@') {
	strcpy(buf, buf + 1);
	v_strword(buf, wrd2);
	if (!v_parseinteger(wrd2, &V.astyle))
	  v_fail();
      }
      re_compile(wrd, V.rex, v_rechars);
      V.any = false;
      for (ch = '@'; ch <= 'Z'; ch++)
	docurve_(v_curvetree[ch - '@'], &V);
      /*  if not any then
            v_nosuchcurve(wrd);  */
    }
  } while (*wrd != '\0');
  if (*V.cbase == NULL && V.mode != v_clopt)
    v_needcurvename();
}


/* Local variables for v_desteqsrc2: */
struct LOC_v_desteqsrc2 {
  Char dest[256];
  v_curverec **cbase;
  Char srex[256], drex[256];
  v_curverec *cplast;
} ;

Local Void docurve__(cp, LINK)
v_curverec *cp;
struct LOC_v_desteqsrc2 *LINK;
{
  Char dbuf[256];
  v_curverec *cp2;
  long i, j;

  if (cp == NULL)
    return;
  docurve__(cp->lnext, LINK);
  if (cp->kind != v_ck_none) {
    strcpy(dbuf, cp->name);
    i = 1;
    re_replace(dbuf, LINK->srex, LINK->drex, &i, &j);
    if (i == 1 && j == strlen(dbuf)) {
      TRY(try7);
	v_needcurve(cp);
	if (LINK->cplast == NULL)
	  *LINK->cbase = cp;
	else
	  LINK->cplast->next2 = cp;
	cp->next2 = NULL;
	LINK->cplast = cp;
	if (*LINK->dest != '\0') {
	  cp2 = *LINK->cbase;
	  while (cp2 != cp && strcmp(cp2->dest, dbuf))
	    cp2 = cp2->next2;
	  if (cp2 != cp || *dbuf == '\0')
	    v_failmsg("Incorrect use of wildcards");
	  cp->dest = strdup(dbuf);
	}
      RECOVER(try7);
	if (P_escapecode != -1)
	  _Escape(P_escapecode);
      ENDTRY(try7);
    }
  }
  docurve__(cp->rnext, LINK);
}


Void v_desteqsrc2(dest_, src, cbase_)
Char *dest_, *src;
v_curverec **cbase_;
{
  struct LOC_v_desteqsrc2 V;
  v_curverec *cp;
  Char ch;

  strcpy(V.dest, dest_);
  V.cbase = cbase_;
  re_compile(src, V.srex, v_rechars);
  re_compile(V.dest, V.drex, v_rechars);
  cp = v_curvebase;
  while (cp != NULL) {
    strdispose(&cp->dest);
    cp->dest = NULL;
    cp = cp->next;
  }
  *V.cbase = NULL;
  V.cplast = NULL;
  for (ch = '@'; ch <= 'Z'; ch++)
    docurve__(v_curvetree[ch - '@'], &V);
  /*  if cbase = nil then
        v_nosuchcurve(src);  */
}


Void v_desteqsrc(buf, cbase, mode)
Char *buf;
v_curverec **cbase;
v_clmode mode;
{
  Char src[256], dest[256];

  v_strword(buf, dest);
  if (*dest == '\0')
    v_needcurvename();
  if (*buf == '=') {
    v_needsep(buf, '=');
    v_strword(buf, src);
    if (*src == '\0')
      v_needcurvename();
  } else {
    if (mode != v_clopt)
      v_needsep(buf, '=');
    strcpy(src, dest);
    *dest = '\0';
  }
  v_desteqsrc2(dest, src, cbase);
}







/* Maintaining the log file */

Static Void ilogwrite(msg)
Char *msg;
{
  Char STR2[256];
  Char username[L_cuserid];

  if (!(v_initdone && *(Char *)v_p_logfile->val.U99.l1 != '\0'))
    return;
  if (!logopen) {
    TRY(try8);
      if (logfirst) {
	if (logfile != NULL)
	  logfile = freopen((Char *)v_p_logfile->val.U99.l1, "w", logfile);
	else
	  logfile = fopen((Char *)v_p_logfile->val.U99.l1, "w");
	if (logfile == NULL) {
	  P_escapecode = -10;
	  P_ioresult = FileNotFound;
	  goto _Ltry8;
	}
	cuserid(username);
	fprintf(logfile, "# View log file written on %s by %s\n",
		strdate(STR2, ""), username);
	logfirst = false;
      } else {
	if (logfile != NULL)
	  logfile = freopen((Char *)v_p_logfile->val.U99.l1, "a", logfile);
	else
	  logfile = fopen((Char *)v_p_logfile->val.U99.l1, "a");
	if (logfile == NULL) {
	  P_escapecode = -10;
	  P_ioresult = FileNotFound;
	  goto _Ltry8;
	}
      }
      logopen = true;
    RECOVER2(try8,_Ltry8);
      if (P_escapecode != -10)
	_Escape(P_escapecode);
      if (v_p_quiet->val.U1.i1 == 0) {
	if (logfirst)
	  printf("(Unable to open log file)\n");
	else
	  printf("(Unable to reopen log file)\n");
      }
      v_setstrparam(v_p_logfile, "");
    ENDTRY(try8);
  }
  if (logopen)
    fprintf(logfile, "%s\n", msg);
}


Void v_loginput(msg_)
Char *msg_;
{
  Char msg[256];

  strcpy(msg, msg_);
  ilogwrite(msg);
}


Void v_logwrite(msg_)
Char *msg_;
{
  Char msg[256];
  Char STR1[256];

  strcpy(msg, msg_);
  sprintf(msg, "# %s", strcpy(STR1, msg));
  ilogwrite(msg);
}


Void v_logwriteln(msg)
Char *msg;
{
  if (v_p_quiet->val.U1.i1 == 0)
    puts(msg);
  v_logwrite(msg);
}


Void v_logreadln(prompt, buf)
Char *prompt;
Char *buf;
{
  v_readln(prompt, buf);
  if (*buf != '\0')
    v_loginput(buf);
}


Void v_closelog()
{
  if (logopen) {
    if (logfile != NULL)
      fclose(logfile);
    logfile = NULL;
  }
  logopen = false;
  if (v_closefileshook.link != NULL)
    (*(Void(*) PP((Anyptr _link)))v_closefileshook.proc)(v_closefileshook.link);
  else
    (*(Void(*) PV())v_closefileshook.proc)();
}


Void v_halt()
{
  _Escape(0);
}


Void v_fail()
{
  _Escape(-1);
}


Void v_clearerror()
{
  *v_lasterrormsg = '\0';
  *v_lasterrorstr = '\0';
}


Void v_errormsg(msg_, outer)
Char *msg_;
boolean outer;
{
  Char msg[256];
  framerec *frame;
  na_strlist *l1;
  long i;
  Char STR1[256], STR2[256];

  strcpy(msg, msg_);
  if (v_p_trace->val.U1.i1 >= 1) {
    sprintf(STR1, "Generated error: %s", msg);
    v_logwriteln(STR1);
  }
  v_writeerror();
  strcpy(v_lasterrormsg, msg);
  if (*msg != '\0') {
    i = strpos2(msg, "~~", 1L);
    while (i > 0) {
      strcpy(msg + i - 1, msg + i + 1);
      sprintf(STR2, "%s%s", strupper(STR1, v_cmdname), msg + i - 1);
      strcpy(msg + i - 1, STR2);
      i = strpos2(msg, "~~", i + strlen(v_cmdname));
    }
    frame = errorframe;
    if (frame != NULL && outer && frame->next != NULL)
      frame = frame->next;
    if (frame != NULL) {
      switch (frame->kind) {

      case fr_file:
      case fr_proc:
	if (frame->prevline != NULL)
	  l1 = frame->prevline;
	else
	  l1 = frame->curline;
	if (l1 != NULL)
	  sprintf(msg + strlen(msg), " at line %d of ",
		  ((short *)(&l1->value))[0]);
	else
	  strcat(msg, " in ");
	if (frame->kind == fr_file)
	  strcat(msg, frame->UU.filename->name);
	else
	  strcat(msg, frame->UU.U2.procname->name);
	break;
      }
    }
  }
  strcpy(v_lasterrorstr, msg);
}


Void v_writeerrmsg(msg)
Char *msg;
{
  if (v_p_quiet->val.U1.i1 == 0)
    puts(msg);
  v_logwrite(msg);
}


Void v_writeerror()
{
  if (*v_lasterrorstr != '\0')
    v_writeerrmsg(v_lasterrorstr);
  v_clearerror();
}


Void v_failmsg(msg)
Char *msg;
{
  v_errormsg(msg, false);
  v_fail();
}


Void v_failneerr(err)
ne_errorkind err;
{
  Char STR1[256];

  v_failmsg(v_neerrmsg(STR1, err));
}


Void v_needcurvename()
{
  v_failmsg("Need a variable name");
}


Void v_nosuchcurve(name)
Char *name;
{
  Char STR1[256];

  if (*name == '\0')
    v_needcurvename();
  else {
    sprintf(STR1, "No such variable as %s", name);
    v_failmsg(STR1);
  }
}


Void v_cantcombine()
{
  v_failmsg("Can't combine curves with different bases");
}


Void v_notvector()
{
  v_failmsg("Variable must be a curve");
}


Void v_badunits()
{
  v_failmsg("Inconsistent units");
}


Void v_nosuchparam()
{
  v_failmsg("No such parameter name");
}


Void v_misplacedcmd()
{
  v_failmsg("Misplaced ~~");
}


Void v_unrecognizedoption()
{
  v_failmsg("Unrecognized ~~ option");
}


Void v_needsep(buf, ch)
Char *buf;
Char ch;
{
  Char STR1[256];
  Char STR2[10];

  if (*buf == '\0' || buf[0] != ch) {
    sprintf(STR2, "Missing %c", ch);
    v_failmsg(STR2);
  }
  strcpy(buf, buf + 1);
  strcpy(STR1, strltrim(buf));
  strcpy(buf, STR1);
}


Void v_checktoomany(buf_)
Char *buf_;
{
  Char buf[256];
  Char STR1[256];

  strcpy(buf, buf_);
  if (*buf == ' ') {
    strcpy(STR1, strltrim(buf));
    strcpy(buf, STR1);
  }
  if (*buf == '\0')
    return;
  if (buf[0] == '"' || buf[0] == '\'' || buf[0] == '(' || buf[0] == '+' ||
      buf[0] == '-' || isalnum(buf[0]))
    v_failmsg("Too many arguments on ~~ command");
  else {
    sprintf(STR1, "Extra '%.1s' on ~~ command", buf);
    v_failmsg(STR1);
  }
}







/* Error trapping */

Static boolean v_recover()
{
  boolean Result;
  v_controlrec *cp, *cp2;
  Char STR2[256];

  cp = v_ctrlstack;
  while (cp != NULL && !cp->canrecover)
    cp = cp->next;
  if (cp == NULL)
    return false;
  while (v_ctrlstack != cp && v_ctrlstack != NULL)
    v_popcontrol();
  if (v_p_trace->val.U1.i1 >= 2) {
    sprintf(STR2, "Invoking recovery handler %.8lX", (long)cp);
    v_logwriteln(STR2);
  }
  TRY(try9);
    if (cp->recoverhook.link != NULL)
      (*(Void(*) PP((v_controlrec *cp, Anyptr _link)))cp->recoverhook.proc)(
	cp, cp->recoverhook.link);
    else
      (*(Void(*) PP((v_controlrec *cp)))cp->recoverhook.proc)(cp);
    Result = true;
  RECOVER(try9);
    if (P_escapecode == 0)
      return true;
    else if (P_escapecode == -1) {
      cp2 = v_ctrlstack;
      while (cp2 != cp && cp2 != NULL)
	cp2 = cp2->next;
      if (cp2 != cp)
	return (v_recover());
      while (v_ctrlstack != cp && v_ctrlstack != NULL)
	v_popcontrol();
      v_popcontrol();
      return (v_recover());
    } else
      _Escape(P_escapecode);
  ENDTRY(try9);
  return Result;
}






/* Miscellanous data checking */

boolean v_isvalid(cp, n)
v_curverec *cp;
long n;
{
  return (n >= 1 && n <= cp->base->len &&
	  cp->base->vec[n - 1] != v_badvalue && cp->vec[n - 1] != v_badvalue);
}


Void v_checkcurve(cp)
v_curverec *cp;
{
  long i, FORLIM;

  if (cp->kind != v_ck_curve)
    return;
  FORLIM = cp->base->len;
  for (i = 1; i <= FORLIM; i++) {
    if (!v_isvalid(cp, i))
      v_failmsg("Curve contains undefined data points");
  }
}


Void v_stretchtempvecs(len)
long len;
{
  double *vec;
  long newlen;
  Char STR2[256];

  if (len <= tempveclen)
    return;
  if (tempveclen == 0)
    newlen = len + 8;
  else
    newlen = tempveclen * 4;
  if (v_p_trace->val.U1.i1 >= 1) {
    sprintf(STR2, "Stretching tempvecs to %ld", newlen);
    v_logwriteln(STR2);
  }
  v_newvector(&vec, newlen);
  if (v_tempxvec != NULL) {
    memmove((Anyptr)vec, (Anyptr)v_tempxvec, tempveclen * sizeof(double));
    v_disposevector(&v_tempxvec, tempveclen);
  }
  v_tempxvec = vec;
  v_newvector(&vec, newlen);
  if (v_tempyvec != NULL) {
    memmove((Anyptr)vec, (Anyptr)v_tempyvec, tempveclen * sizeof(double));
    v_disposevector(&v_tempyvec, tempveclen);
  }
  v_tempyvec = vec;
  tempveclen = newlen;
}





/* Loading and saving */

/* file format:
      first line is version number = 1
      header is followed by records of the form:

         'pairs'
         <curve-name>
         <x-units>
         <y-units>
         <x> <y>
         <x> <y> ...
         <blank line or eof>

         'expr'
         <curve-name>
         <expression>
         <extra ignored lines>
         <extra ignored lines> ...
         <blank line or eof>

         'string'
         <curve-name>
         *<value>*
         <extra ignored lines>
         <extra ignored lines> ...
         <blank line or eof>

         'const'
         <curve-name>
         <y-units>
         <value>
         <extra ignored lines>
         <extra ignored lines> ...
         <blank line or eof>
*/

/* Return value:  0  file succefully loaded
                 1  file not found
                 2  not a data file */

long v_vloadfile(fn_)
Char *fn_;
{
  long Result;
  Char fn[256];
  FILE *f;
  Char buf[256], name[256], xunit[256], yunit[256], expr[256];
  v_curverec *cp;
  long len, version, i;
  double xval, yval;
  boolean crash;
  Char *TEMP;
  Char STR1[256], *STR2, STR3[256];

  strcpy(fn, fn_);
  f = NULL;
  crash = false;
  Result = 0;
  TRY(try10);
    newci_fixfname(fn, "dat", "");
    if (f != NULL)
      f = freopen(fn, "r", f);
    else
      f = fopen(fn, "r");
    if (f == NULL) {
      P_escapecode = -10;
      P_ioresult = FileNotFound;
      goto _Ltry10;
    }
  RECOVER2(try10,_Ltry10);
    if (P_escapecode != -10)
      _Escape(P_escapecode);
    Result = 1;
    crash = true;
  ENDTRY(try10);
  if (!crash) {
    TRY(try11);
      fscanf(f, "%ld%*[^\n]", &version);
      getc(f);
      if (version > 1) {
	P_escapecode = 2;
	goto _Ltry11;
      }
    RECOVER2(try11,_Ltry11);
      if (P_escapecode != -10 && P_escapecode != 2)
	_Escape(P_escapecode);
      Result = 2;
      crash = true;
    ENDTRY(try11);
  }
  while (!crash && !P_eof(f)) {
    fgets(buf, 256, f);
    TEMP = strchr(buf, '\n');
    if (TEMP != NULL)
      *TEMP = 0;
    if (*buf == '\0' || *buf == '#')
      continue;
    /*ignore it*/
    if (!strcmp(buf, "1"))
      continue;
    /*ignore extra version numbers*/
    if (!strcmp(buf, "pairs")) {
      fgets(name, 256, f);
      TEMP = strchr(name, '\n');
      if (TEMP != NULL)
	*TEMP = 0;
      fgets(xunit, 256, f);
      TEMP = strchr(xunit, '\n');
      if (TEMP != NULL)
	*TEMP = 0;
      sprintf(STR1, "%c", v_blankline);
      if (!strcmp(xunit, STR1))
	*xunit = '\0';
      fgets(yunit, 256, f);
      TEMP = strchr(yunit, '\n');
      if (TEMP != NULL)
	*TEMP = 0;
      sprintf(STR1, "%c", v_blankline);
      if (!strcmp(yunit, STR1))
	*yunit = '\0';
      len = 0;
      while (!P_eof(f) && !P_eoln(f)) {
	fgets(buf, 256, f);
	TEMP = strchr(buf, '\n');
	if (TEMP != NULL)
	  *TEMP = 0;
/* p2c: viewmod.text, line 3449:
 * Note: Null character at end of sprintf control string [148] */
	strcpy(STR1, buf);
	strcpy(buf, STR1);
	i = 1;
	while (buf[i - 1] == ' ')
	  i++;
	if (buf[i - 1] == 'x' || buf[i - 1] == 'X') {
	  xval = v_badvalue;
	  i++;
	} else if (buf[i - 1] == '(' && strcisubcmp(6L, buf, i, "(none)", 1L)) {
	  xval = v_badvalue;
	  i += 6;
	} else {
	  xval = strtod(buf + i - 1, &STR2);
	  i = STR2 - buf + 1;
	}
	while (buf[i - 1] == ' ')
	  i++;
	if (buf[i - 1] == 'x' || buf[i - 1] == 'X') {
	  yval = v_badvalue;
	  i++;
	} else if (buf[i - 1] == '(' && strcisubcmp(6L, buf, i, "(none)", 1L)) {
	  yval = v_badvalue;
	  i += 6;
	} else {
	  yval = strtod(buf + i - 1, &STR2);
	  i = STR2 - buf + 1;
	}
	len++;
	v_stretchtempvecs(len);
	v_tempxvec[len - 1] = xval;
	v_tempyvec[len - 1] = yval;
      }
      v_addcurve(len, v_tempxvec, v_tempyvec, xunit, yunit, name);
      cp = v_findcurve(name);
      if (cp != NULL)   /*hope this is true!*/
	cp->savetime = cp->chgtime;
      continue;
    }
    if (!strcmp(buf, "expr")) {
      fgets(name, 256, f);
      TEMP = strchr(name, '\n');
      if (TEMP != NULL)
	*TEMP = 0;
      fgets(expr, 256, f);
      TEMP = strchr(expr, '\n');
      if (TEMP != NULL)
	*TEMP = 0;
      while (!P_eof(f) && !P_eoln(f)) {
	fscanf(f, "%*[^\n]");
	getc(f);
      }
      v_addcurveexpr(expr, name);
      continue;
    }
    if (!strcmp(buf, "string")) {
      fgets(name, 256, f);
      TEMP = strchr(name, '\n');
      if (TEMP != NULL)
	*TEMP = 0;
      fgets(buf, 256, f);
      TEMP = strchr(buf, '\n');
      if (TEMP != NULL)
	*TEMP = 0;
      if (*buf == '*' && strends(buf, "*") && strlen(buf) >= 2) {
	buf[strlen(buf) - 1] = '\0';
	strcpy(buf, buf + 1);
      }
      v_addcurvestr(buf, name);
      continue;
    }
    if (strcmp(buf, "const")) {
      sprintf(STR3, "Record type %s unknown", buf);
      v_errormsg(STR3, false);
      crash = true;
      Result = 2;
      continue;
    }
    fgets(name, 256, f);
    TEMP = strchr(name, '\n');
    if (TEMP != NULL)
      *TEMP = 0;
    fgets(yunit, 256, f);
    TEMP = strchr(yunit, '\n');
    if (TEMP != NULL)
      *TEMP = 0;
    sprintf(STR1, "%c", v_blankline);
    if (!strcmp(yunit, STR1))
      *yunit = '\0';
    fgets(buf, 256, f);
    TEMP = strchr(buf, '\n');
    if (TEMP != NULL)
      *TEMP = 0;
    while (!P_eof(f) && !P_eoln(f)) {
      fscanf(f, "%*[^\n]");
      getc(f);
    }
    yval = strtod(buf, &STR2);
    i = STR2 - buf + 1;
    v_addcurveconst(yval, yunit, name);
  }
  if (f != NULL)
    fclose(f);
  return Result;
}


/* Local variables for v_aloadfile: */
struct LOC_v_aloadfile {
  FILE *f;
  Char buf[256];
  long lnum;
  boolean eofok;
} ;

Local Void readline(LINK)
struct LOC_v_aloadfile *LINK;
{
  Char *TEMP;

  *LINK->buf = '\0';
  while (*LINK->buf == '\0' && !P_eof(LINK->f)) {
    fgets(LINK->buf, 256, LINK->f);
    TEMP = strchr(LINK->buf, '\n');
    if (TEMP != NULL)
      *TEMP = 0;
    LINK->lnum++;
  }
  if (*LINK->buf == '\0' && !LINK->eofok)
    v_failmsg("Premature end of dump file");
}

Local Void noise(LINK)
struct LOC_v_aloadfile *LINK;
{
  Char STR2[256];

  if (LINK->lnum < 3)
    v_failmsg("File is not an AnaLOG dump file");
  else {
    sprintf(STR2, "Noisy file at line %ld", LINK->lnum);
    v_failmsg(STR2);
  }
}



/* AnaLOG file format:  (subset of Mass's format)

   <blank line>
   <filename> (
   (DATA:
   (TITLE: TIME )     or    (TITLE: //<signal>/)
   (POINTS:
   <value>
   <value>
   <value>
   ))
   (DATA:   (next plot)
   ...
   ))
   )

   followed by possible repetition(s) of the whole thing.
*/

long v_aloadfile(fn_)
Char *fn_;
{
  struct LOC_v_aloadfile V;
  long Result;
  Char fn[256], name[256], xunit[256], yunit[256];
  long len, i, j;
  double val;
  boolean crash, havetime, istime;
  Char *STR1, STR3[256];

  strcpy(fn, fn_);
  V.f = NULL;
  crash = false;
  Result = 0;
  TRY(try12);
    newci_fixfname(fn, "text", "");
    if (V.f != NULL)
      V.f = freopen(fn, "r", V.f);
    else
      V.f = fopen(fn, "r");
    if (V.f == NULL) {
      P_escapecode = -10;
      P_ioresult = FileNotFound;
      goto _Ltry12;
    }
  RECOVER2(try12,_Ltry12);
    if (P_escapecode != -10)
      _Escape(P_escapecode);
    Result = 1;
    crash = true;
  ENDTRY(try12);
  V.lnum = 0;
  if (!crash) {
    TRY(try13);
      V.eofok = true;
      readline(&V);
      if (!strends(V.buf, "(")) {
	P_escapecode = 2;
	goto _Ltry13;
      }
    RECOVER2(try13,_Ltry13);
      if (P_escapecode != -10 && P_escapecode != 2)
	_Escape(P_escapecode);
      Result = 2;
      crash = true;
    ENDTRY(try13);
  }
  if (!crash) {
    V.eofok = false;
    while (!P_eof(V.f)) {
      if (!strends(V.buf, "("))
	noise(&V);
      readline(&V);
      havetime = false;
      while (!strcmp(V.buf, "(DATA:")) {
	readline(&V);
	strword(V.buf, name);
	if (strcmp(name, "(TITLE:"))
	  noise(&V);
	if (!strcmp(V.buf, "TIME )")) {
	  istime = true;
	  havetime = true;
	  strcpy(xunit, "sec");
	} else {
	  if (strncmp(V.buf, "\\\\", 2L) || !strends(V.buf, "\\)"))
	    noise(&V);
	  strpart(name, V.buf, 3, (int)(strlen(V.buf) - 2L));
	  if (!havetime)
	    v_failmsg("First vector must be TIME");
	  istime = false;
	  *yunit = '\0';
	}
	readline(&V);
	if (strcmp(V.buf, "(POINTS:"))
	  noise(&V);
	readline(&V);
	i = 0;
	while (strcmp(V.buf, "))")) {
	  val = strtod(V.buf, &STR1);
	  j = STR1 - V.buf + 1;
	  i++;
	  v_stretchtempvecs(i);
	  if (istime)
	    v_tempxvec[i - 1] = val;
	  else
	    v_tempyvec[i - 1] = val;
	  readline(&V);
	}
	if (istime)
	  len = i;
	else {
	  if (i != len) {
	    sprintf(STR3, "Curve %s does not match TIME", name);
	    v_failmsg(STR3);
	  }
	  v_addcurve(len, v_tempxvec, v_tempyvec, xunit, yunit, name);
	}
	readline(&V);
      }
      if (strcmp(V.buf, ")"))
	noise(&V);
      V.eofok = true;
      readline(&V);
      V.eofok = false;
    }
  }
  if (V.f != NULL)
    fclose(V.f);
  return Result;
}



/* Load a file in any format */

long v_loadfile(fn)
Char *fn;
{
  long res;

  res = v_vloadfile(fn);
  if (res != 0)
    res = v_aloadfile(fn);
  return res;
}





/* Write out data in a nice-looking format */

Void v_measurevec(vec, len, minwid, wid, prec)
double *vec;
long len, minwid, *wid, *prec;
{
  long i, j, maxexp, maxlog, wid10, wid12, ival2;
  double val, val2, maxv, maxp;
  boolean hasneg;

  *wid = 0;
  *prec = 0;
  wid10 = P_imax2(10L, minwid);
  wid12 = P_imax2(12L, minwid);
  maxv = 10.0;
  maxlog = 1;
  i = 1;
  while (i <= len && *prec >= 0) {
    val = fabs(vec[i - 1]);
    if (val != v_badvalue && val != 0) {
      if (val >= 1e9 || val < 1e-3)
	*prec = -1;
      else {
	val2 = ma_rfrac(val);
	ival2 = (long)floor(val2 * 1e9 + 0.5);
	j = 9;
	while (j > 0 && ival2 % 10 == 0) {
/* p2c: viewmod.text, line 3731:
 * Note: Using % for possibly-negative arguments [317] */
	  j--;
	  ival2 /= 10;
	}
	if (j > *prec)
	  *prec = j;
	if (val >= 0.1) {
	  if (val < 1)   /*leading 0 takes a space*/
	    val = 1.0;
	  if (vec[i - 1] < 0)   /*account for minus sign*/
	    val *= 10;
	  while (val >= maxv) {
	    maxv *= 10;
	    maxlog++;
	  }
	}
	if (*prec + maxlog > wid10 + 4)   /*losing too much precision*/
	  *prec = -1;
      }
    }
    i++;
  }
  if (*prec < 0) {
    maxp = 1.0;
    *prec = 0;
    maxexp = 1;
    hasneg = false;
    for (i = 0; i < len; i++) {
      val = vec[i];
      if (val < 0) {
	hasneg = true;
	val = -val;
      }
      if (val != v_badvalue && val != 0) {
	j = (long)ma_log(val);
	if (j >= 0) {   /*avoid roundoff errors if possible*/
	  val /= ma_ytoi(10.0, j);
	  if (j >= 10) {
	    if (j >= 100)
	      maxexp = P_imax2(maxexp, 3L);
	    else
	      maxexp = P_imax2(maxexp, 2L);
	  }
	} else {
	  val *= ma_ytoi(10.0, -j);
	  if (j <= -10) {
	    if (j <= -100)
	      maxexp = P_imax2(maxexp, 4L);
	    else
	      maxexp = P_imax2(maxexp, 3L);
	  } else
	    maxexp = P_imax2(maxexp, 2L);
	}
	while (*prec < 10 && !ma_isint(val * maxp)) {
	  maxp *= 10;
	  (*prec)++;
	}
      }
    }
    if (hasneg)
      maxexp++;
    if (*prec == 0) {
      *prec = 99;
      *wid = P_imax2(maxexp + 2, minwid);
      return;
    }
    *wid = P_imax2(*prec + maxexp + 3, minwid);
    while (*wid > wid12) {
      (*prec)--;
      *wid = P_imax2(*prec + maxexp + 3, minwid);
    }
    if (*prec <= 0)
      *prec = 99;
    else
      *prec += 100;
    return;
  }
  if (*prec == 0) {
    *prec = -1;
    *wid = P_imax2(maxlog, minwid);
    return;
  }
  *wid = P_imax2(*prec + maxlog + 1, minwid);
  while (*wid > wid10) {
    (*prec)--;
    *wid = P_imax2(*prec + maxlog + 1, minwid);
  }
  if (*prec <= 0)
    *prec = -1;
}


Char *v_fmtreal(Result, val, wid, prec)
Char *Result;
double val;
long wid, prec;
{
  if (val == v_badvalue) {
    if (wid < 6) {
      sprintf(Result, "%*s", (int)wid, "X");
      return Result;
    } else {
      sprintf(Result, "%*s", (int)wid, "(none)");
      return Result;
    }
  } else if (prec >= 99)
    return (ma_strfmtreal2(Result, val, wid, prec - 100, 0L, 0.0, ma_minreal));
  else
    return (ma_strfmtreal2(Result, val, wid, prec, 0L, 0.0, ma_maxreal_));

  /*scientific notation*/
  /*fixed point notation*/
}


#define curversion      1


/* Local variables for savecurves: */
struct LOC_savecurves {
  FILE *f;
  long bwid, bprec, cwid, cprec;
  boolean nicemode;
} ;

Local Void savecurve(cp, LINK)
v_curverec *cp;
struct LOC_savecurves *LINK;
{
  v_baserec *bp;
  long i;
  Char STR2[256];
  long FORLIM;
  Char STR3[256];

  cp->savetime = cp->chgtime;
  if (cp->expr != NULL) {
    fprintf(LINK->f, "expr\n");
    fprintf(LINK->f, "%s\n", cp->name);
    fprintf(LINK->f, "%s\n", cp->expr);
    if (cp->units == NULL || *cp->units == '\0')
      fprintf(LINK->f, "%c\n", v_blankline);
    else
      fprintf(LINK->f, "%s\n", cp->units);
    bp = cp->base;
    if (bp == NULL)   /*for user's information only*/
      fprintf(LINK->f, "%g\n", cp->yval);
    else if (cp->vec != NULL) {
      FORLIM = bp->len;
      for (i = 0; i < FORLIM; i++) {
	if (bp->vec[i] == v_badvalue)
	  putc('x', LINK->f);
	else
	  fprintf(LINK->f, "%g", bp->vec[i]);
	putc(' ', LINK->f);
	if (cp->vec[i] == v_badvalue)
	  putc('x', LINK->f);
	else
	  fprintf(LINK->f, "%g", cp->vec[i]);
	putc('\n', LINK->f);
      }
    }
  } else {
    switch (cp->kind) {

    case v_ck_none:
      /* blank case */
      break;

    case v_ck_string:
      fprintf(LINK->f, "string\n");
      fprintf(LINK->f, "%s\n", cp->name);
      fprintf(LINK->f, "*%s*\n", cp->sval);
      break;

    case v_ck_num:
      fprintf(LINK->f, "const\n");
      fprintf(LINK->f, "%s\n", cp->name);
      if (*cp->units == '\0')
	fprintf(LINK->f, "%c\n", v_blankline);
      else
	fprintf(LINK->f, "%s\n", cp->units);
      fprintf(LINK->f, "%g\n", cp->yval);
      break;

    case v_ck_curve:   /*shouldn't happen*/
      bp = cp->base;
      fprintf(LINK->f, "pairs\n");
      fprintf(LINK->f, "%s\n", cp->name);
      if (*bp->units == '\0')
	fprintf(LINK->f, "%c\n", v_blankline);
      else
	fprintf(LINK->f, "%s\n", bp->units);
      if (*cp->units == '\0')
	fprintf(LINK->f, "%c\n", v_blankline);
      else
	fprintf(LINK->f, "%s\n", cp->units);
      if (LINK->nicemode) {
	v_measurevec(bp->vec, bp->len, 0L, &LINK->bwid, &LINK->bprec);
	v_measurevec(cp->vec, bp->len, 0L, &LINK->cwid, &LINK->cprec);
	FORLIM = bp->len;
	for (i = 0; i < FORLIM; i++)
	  fprintf(LINK->f, "%s %s\n",
		  v_fmtreal(STR2, bp->vec[i], LINK->bwid, LINK->bprec),
		  v_fmtreal(STR3, cp->vec[i], LINK->cwid, LINK->cprec));
      } else {
	FORLIM = bp->len;
	for (i = 0; i < FORLIM; i++) {
	  if (bp->vec[i] == v_badvalue)
	    putc('x', LINK->f);
	  else
	    fprintf(LINK->f, "%g", bp->vec[i]);
	  putc(' ', LINK->f);
	  if (cp->vec[i] == v_badvalue)
	    putc('x', LINK->f);
	  else
	    fprintf(LINK->f, "%g", cp->vec[i]);
	  putc('\n', LINK->f);
	}
      }
      break;

    default:
      sprintf(STR3, "Can't save %s", cp->name);
      v_logwriteln(STR3);
      break;
    }
  }
  putc('\n', LINK->f);
}





/* Save curves to a file */

Static Void savecurves(fn, buf, appending)
Char *fn, *buf;
boolean appending;
{
  struct LOC_savecurves V;
  Char wrd[256];
  v_curverec *cp;
  long ver;
  Char STR1[256], STR3[256];
  Char username[L_cuserid];

  V.f = NULL;
  if (*fn == '\0') {
    strcpy(fn, fn + 1);
    V.nicemode = true;
  } else
    V.nicemode = false;
  v_curvelist(buf, &cp, v_clopt);
  v_checktoomany(buf);
  if (*fn == '\0')
    v_failmsg("File name required");
  newci_fixfname(fn, "dat", "");
  if (appending) {
    TRY(try14);
      if (V.f != NULL)
	V.f = freopen(fn, "r", V.f);
      else
	V.f = fopen(fn, "r");
      if (V.f == NULL) {
	P_escapecode = -10;
	P_ioresult = FileNotFound;
	goto _Ltry14;
      }
      TRY(try15);
	fscanf(V.f, "%ld", &ver);
	if (ver != curversion)
	  v_failmsg("File has wrong version number");
	if (V.f != NULL)
	  fclose(V.f);
	V.f = NULL;
	if (V.f != NULL)
	  V.f = freopen(fn, "a", V.f);
	else
	  V.f = fopen(fn, "a");
	if (V.f == NULL) {
	  P_escapecode = -10;
	  P_ioresult = FileNotFound;
	  goto _Ltry15;
	}
	cuserid(username);
	fprintf(V.f, "\n# Appended from View on %s by %s\n",
		strdate(STR1, ""), username);
      RECOVER2(try15,_Ltry15);
	if (P_escapecode != -10)
	  goto _Ltry14;
	v_failmsg("File is not in View format");
      ENDTRY(try15);
    RECOVER2(try14,_Ltry14);
      if (P_escapecode != -10)
	_Escape(P_escapecode);
      if (V.f != NULL)
	V.f = freopen(fn, "w", V.f);
      else
	V.f = fopen(fn, "w");
      if (V.f == NULL)
	_EscIO(FileNotFound);
      fprintf(V.f, "%ld\n", (long)curversion);
      cuserid(username);
      fprintf(V.f, "# Written from View on %s by %s\n",
	      strdate(STR3, ""), username);
    ENDTRY(try14);
  } else {
    if (access(fn, F_OK) == 0) {
      strcpy(wrd, fn);
      newci_forcefname(wrd, "odat", "");
                        unlink(wrd);
      TRY(try16);
	if (link(fn, wrd))
	_Escape(-10);
	else
	unlink(fn);
	if (v_p_quiet->val.U1.i1 == 0) {
	  sprintf(STR1, "[Saving old file as %s]", wrd);
	  v_logwriteln(STR1);
	}
      RECOVER(try16);
	if (P_escapecode != -10)
	  _Escape(P_escapecode);
	TRY(try17);
	  fp_change(fn, wrd);
	RECOVER(try17);
	  if (P_escapecode != -10)
	    _Escape(P_escapecode);
	  if (v_p_quiet->val.U1.i1 == 0) {
	    sprintf(STR3, "[Couldn't make %s]", wrd);
	    v_logwriteln(STR3);
	  }
	ENDTRY(try17);
      ENDTRY(try16);
    }
    if (V.f != NULL)
      V.f = freopen(fn, "w", V.f);
    else
      V.f = fopen(fn, "w");
    if (V.f == NULL)
      _EscIO(FileNotFound);
    fprintf(V.f, "%ld\n", (long)curversion);
    cuserid(username);
    fprintf(V.f, "# Written from View on %s by %s\n",
	    strdate(STR3, ""), username);
  }
  putc('\n', V.f);
  if (cp == NULL) {
    if (v_p_quiet->val.U1.i1 == 0)
      printf("Saving all curves:");
    cp = v_curvebase;
    while (cp != NULL) {
      if (v_p_quiet->val.U1.i1 == 0)
	printf(" %s", cp->name);
      savecurve(cp, &V);
      cp = cp->next;
    }
    if (v_p_quiet->val.U1.i1 == 0)
      putchar('\n');
  } else {
    while (cp != NULL) {
      savecurve(cp, &V);
      cp = cp->next2;
    }
  }
  if (V.f != NULL)
    fclose(V.f);
  V.f = NULL;
  if (V.f != NULL)
    fclose(V.f);
}

#undef curversion


Void v_savecurves(fn_, buf_)
Char *fn_, *buf_;
{
  Char fn[256], buf[256];

  strcpy(fn, fn_);
  strcpy(buf, buf_);
  savecurves(fn, buf, false);
}


Void v_appendcurves(fn_, buf_)
Char *fn_, *buf_;
{
  Char fn[256], buf[256];

  strcpy(fn, fn_);
  strcpy(buf, buf_);
  savecurves(fn, buf, true);
}


boolean v_checkneedsave()
{
  v_curverec *cp;
  boolean flag;

  cp = v_curvebase;
  while (cp != NULL && (cp->savetime >= cp->chgtime || cp->kind != v_ck_curve))
    cp = cp->next;
  if (cp != NULL) {
    printf("Warning: the following curves have not been saved:\n");
    flag = false;
    while (cp != NULL) {
      if (cp->kind == v_ck_curve && cp->savetime < cp->chgtime) {
	if (flag)
	  printf(", ");
	fputs(cp->name, stdout);
	flag = true;
      }
      cp = cp->next;
    }
    putchar('\n');
    return true;
  } else
    return false;
}






/* Handle curve dependencies */

Void v_checkcurvename(name, cp, mode)
Char *name;
v_curverec **cp;
Char *mode;
{
  long len;
  Char STR1[256];

  if (!strcmp(name, ck_cachestr)) {
    *cp = ck_cachecp;
    if (ck_cachemode != '\0')
      *mode = ck_cachemode;
    return;
  }
  *cp = v_findcurve(name);
  strcpy(ck_cachestr, name);
  ck_cachecp = *cp;
  ck_cachemode = '\0';
  len = strlen(name);
  if (*cp != NULL || len <= 2 || name[len - 2] != '_')
    return;
  sprintf(STR1, "%.*s", (int)(len - 2), name);
  *cp = v_findcurve(STR1);
  if (*cp == NULL)
    return;
  *mode = name[len - 1];
  ck_cachecp = *cp;
  ck_cachemode = *mode;
}


Local Void evalbase(nex)
ne_nexrec *nex;
{
  v_curverec *cp;
  Char ch;
  long i, FORLIM;

  FORLIM = nex->nargs;
  for (i = 0; i < FORLIM; i++)
    evalbase(nex->UU.U99.pvals[i]);
  if ((ne_opkind)nex->op != ne_rp && (ne_opkind)nex->op != ne_rxp &&
      (ne_opkind)nex->op != ne_sp)
    return;
  ch = 'y';
  v_checkcurvename(nex->UU.U11.rps->s, &cp, &ch);
  if (cp != NULL && ch == 'y')
    v_needcurve(cp);
}


Void v_checkneeds(nex)
ne_nexrec *nex;
{
  evalbase(nex);
}


Void v_initcheckbase(bp)
v_baserec **bp;
{
  v_curverec *cp;

  cp = v_curvebase;
  while (cp != NULL) {
    cp->used = false;
    cp->usedy = false;
    cp = cp->next;
  }
}


/*traverse the expression tree and check consistency*/
boolean v_checkbase(bp, nex)
v_baserec **bp;
ne_nexrec *nex;
{
  boolean good;
  Char ch;
  v_curverec *cp;
  long i, FORLIM;

  good = true;
  FORLIM = nex->nargs;
  for (i = 0; i < FORLIM; i++) {
    if (good)
      good = v_checkbase(bp, nex->UU.U99.pvals[i]);
  }
  if (!good)
    return good;
  switch ((ne_opkind)nex->op) {

  case ne_rp:
  case ne_rxp:
    ch = ' ';
    v_checkcurvename(nex->UU.U11.rps->s, &cp, &ch);
    if (cp != NULL) {   /*it's a curve name*/
      if (ch == ' ' || ch == 'y' || ch == 'x') {
	if (cp->kind != v_ck_curve)
	  good = (ch == ' ');
	else {
	  if (ch == 'x')
	    cp->used = true;
	  else
	    cp->usedy = true;
	  if (*bp == NULL)
	    *bp = cp->base;
	  else if (cp->base != *bp)
	    good = false;
	}
      }
    }
    break;
  }
  return good;
}  /*v_checkbase*/


Void v_aftercheckbase(cbase)
v_curverec **cbase;
{
  v_curverec *cp;

  *cbase = NULL;
  cp = v_curvebase;
  while (cp != NULL) {
    if (cp->used || cp->usedy) {
      cp->next3 = *cbase;
      *cbase = cp;
    }
    cp = cp->next;
  }
}


typedef Char stringarray[100000L][256];


boolean v_checkunits(nex, units)
ne_nexrec *nex;
Char *units;
{
  Char (*unitarr)[256];
  Char ch;
  v_curverec *cp;
  long i;
  boolean good;
  long FORLIM;


  na_alloc((Anyptr)&unitarr, nex->nargs * 256L); 
  good = true;
  FORLIM = nex->nargs;
  for (i = 0; i < FORLIM; i++) {
    if (good)
      good = v_checkunits(nex->UU.U99.pvals[i], unitarr[i]);
  }
  if (!good) {
    na_free((Anyptr)&unitarr);
    return good;}
  units[0] = '\0';
  switch ((ne_opkind)nex->op) {

  case ne_rp:
  case ne_rxp:
    ch = 'y';
    v_checkcurvename(nex->UU.U11.rps->s, &cp, &ch);
    if (cp != NULL) {   /*it's a curve name*/
      if (ch == 'x') {
	if (cp->kind != v_ck_curve)
	  v_failmsg("Trying to refer to constant_x");
	else
	  strcpy(units, cp->base->units);
      } else if (ch == 'y')
	strcpy(units, cp->units);
    }
    break;

  /* should look at other operators and actually build up */
  /* the proper units -- some other time! */
  default:
    if (nex->nargs != 0) {
      i = 1;
      while (i < nex->nargs && *unitarr[i - 1] == '\0')
	i++;
      strcpy(units, unitarr[i - 1]);
    }
    break;
  }
  na_free((Anyptr)&unitarr);
  return good;
}


Static Void compileexpr(buf_, nex, bp)
Char *buf_;
ne_nexrec **nex;
v_baserec **bp;
{
  Char buf[256];
  v_curverec *cp;
  long i;
  Char STR1[256];
  Char STR2[256];

/* p2c: viewmod.text, line 4324:
 * Note: Null character at end of sprintf control string [148] */
  strcpy(buf, buf_);
  strcpy(STR1, buf);
  strcpy(buf, STR1);
  i = 1;
  ne_intcompile(buf, &i, nex, &v_nedesc);
  *bp = NULL;
  if (buf[i - 1] == ':') {
    strcpy(buf, buf + i);
    buf[strlen(buf) - 1] = '\0';   /*remove the #0*/
    strcpy(STR1, strltrim(strrtrim(strcpy(STR2, buf))));
    strcpy(buf, STR1);
    cp = v_findcurve(buf);
    if (cp == NULL)
      v_nosuchcurve(buf);
    *bp = cp->base;
    if (*bp == NULL)
      v_notvector();
    return;
  }
  if (buf[i - 1] != '\0') {
    ne_dispose(nex);
    *nex = ne_makeerror(ne_syntax);
  }
}


Void v_curveexpr(wrd, nex, bp, cbase, units)
Char *wrd;
ne_nexrec **nex;
v_baserec **bp;
v_curverec **cbase;
Char *units;
{
  compileexpr(wrd, nex, bp);
  if ((ne_opkind)(*nex)->op == ne_error)
    v_failneerr((ne_errorkind)(*nex)->UU.err);
  v_checkneeds(*nex);
  v_initcheckbase(bp);
  if (!v_checkbase(bp, *nex))
    v_cantcombine();
  v_aftercheckbase(cbase);
  if (!v_checkunits(*nex, units))
    v_badunits();
  ne_constantlist(nex, &v_nedesc, NULL);
}



Void v_evaluate(nex, bp, cbase, vec)
ne_nexrec *nex;
v_baserec *bp;
v_curverec *cbase;
double *vec;
{
  v_curverec *cp;
  ne_nexrec nexr;
  long i;
  long errs;
  ne_errorkind err;
  long FORLIM;
  Char STR1[256];
  Char STR2[256];

  errs = 0;
  v_arithbase = bp;
  FORLIM = bp->len;
  for (i = 0; i < FORLIM; i++) {
    v_arithidx = i + 1;
    baseval = bp->vec[i];
    cp = cbase;
    while (cp != NULL) {
      if (cp->kind == v_ck_curve) {
	cp->xval = baseval;
	cp->yval = cp->vec[i];
      }
      cp = cp->next3;
    }
    ne_evaluate(nex, &nexr);
    switch ((ne_opkind)nexr.op) {

    case ne_error:
      if (((1L << nexr.UU.err) & ((1L << ((long)ne_syntax)) |
	     (1L << ((long)ne_undef)) | (1L << ((long)ne_badtypes)))) != 0)
	v_failneerr((ne_errorkind)nexr.UU.err);
      else {
	vec[i] = v_badvalue;
	if ((ne_errorkind)nexr.UU.err != ne_badval)
	  errs |= 1L << nexr.UU.err;
      }
      break;

    case ne_ic:
      vec[i] = nexr.UU.i;
      break;

    case ne_rc:
      vec[i] = nexr.UU.r;
      break;

    default:
      v_failmsg("Illegal data type");
      break;
    }
  }
  cp = cbase;
  while (cp != NULL) {
    if (cp->kind == v_ck_curve) {
      cp->xval = 0.0;
      cp->yval = 0.0;
    }
    cp = cp->next3;
  }
  if (v_p_quiet->val.U1.i1 != 0)
    return;
  for (err = ne_noerror;
       (long)err <= (long)ne_badval;
       err = (ne_errorkind)((long)err + 1)) {
    if (((1L << ((long)err)) & errs) != 0) {
      sprintf(STR2, "Warning: %s", v_neerrmsg(STR1, err));
      v_errormsg(STR2, false);
    }
  }
}



Void v_assignment(wrd, buf_)
Char *wrd, *buf_;
{
  Char buf[256], units[256];
  ne_nexrec *nex;
  v_baserec *bp;
  v_curverec *cp, *cbase;
  double *vec;
  long i;
  Char STR1[256], STR2[256];

  strcpy(buf, buf_);
  v_needsep(buf, '=');
  if (strends(wrd, ")")) {
    i = strposc(wrd, '(', 1L);
    if (i < 2)
      v_failmsg("Bad parentheses in function definition");
    if (*buf == '=')
      v_failmsg("== not supported in function definitions");
    sprintf(STR1, "%.*s", (int)(i - 1), wrd);
    v_definefunc(STR1, strpart(STR2, wrd, (int)(i + 1),
			       (int)(strlen(wrd) - 1L)), buf);
    return;
  }
  if (*buf == '=') {
    v_needsep(buf, '=');
    if (*buf != '\0')
      v_addcurveexpr(buf, wrd);
    else
      v_failmsg("Nothing after the == sign");
    return;
  }
  if (*buf == '\0') {
    v_failmsg("Nothing after the = sign");
    return;
  }
  v_curveexpr(buf, &nex, &bp, &cbase, units);
  if (bp == NULL) {
    if (ne_exprtype(nex) == ne_string)
      v_assigncurvestr(ne_sevaluate(STR1, nex, &v_nedesc), wrd);
    else if (*units != '\0')
      v_addcurveconst(ne_revaluate(nex, &v_nedesc), units, wrd);
    else
      v_assigncurveconst(ne_revaluate(nex, &v_nedesc), wrd);
  } else {
    v_newvector(&vec, bp->len);
    v_evaluate(nex, bp, cbase, vec);
    v_writeerror();
    v_makecurve(&cp, bp, vec, units, wrd);
  }
  ne_dispose(&nex);
}


/* Local variables for v_needcurve: */
struct LOC_v_needcurve {
  long checktime;
} ;

Local Void needcurve PP((v_curverec *cp, struct LOC_v_needcurve *LINK));

/* Local variables for needcurve: */
struct LOC_needcurve {
  struct LOC_v_needcurve *LINK;
  long time;
} ;

Local Void findtime(nex, LINK)
ne_nexrec *nex;
struct LOC_needcurve *LINK;
{
  v_curverec *cp2;
  Char ch;
  long i;
  ne_functionrec *nfp;
  long FORLIM;

  if (nex == NULL)
    return;
  FORLIM = nex->nargs;
  for (i = 0; i < FORLIM; i++)
    findtime(nex->UU.U99.pvals[i], LINK);
  switch ((ne_opkind)nex->op) {

  case ne_rp:
  case ne_rxp:
  case ne_sp:
    ch = 'y';
    v_checkcurvename(nex->UU.U11.rps->s, &cp2, &ch);
    if (cp2 != NULL) {
      if (ch == 'y') {
	needcurve(cp2, LINK->LINK);
	if (cp2->chgtime > LINK->time)
	  LINK->time = cp2->chgtime;
      }
    }
    break;

  case ne_rf:
  case ne_sf:
    nfp = nex->UU.U15.fp;
    if (nfp->subnex)
      findtime(*nfp->UU.nexp, LINK);
    break;
  }
}

Local Void needcurve(cp, LINK)
v_curverec *cp;
struct LOC_v_needcurve *LINK;
{
  struct LOC_needcurve V;
  Char units[256];
  v_curverec *cbase;
  v_baserec *bp;
  double *sparevec;
  ne_nexrec *oldnex;
  boolean flash;
  Char STR2[256], STR3[256];

  V.LINK = LINK;
  if (cp->expr == NULL)
    return;
  if (cp->checktime == LINK->checktime) {
    sprintf(STR2, "Variable %s is recursively defined", cp->name);
    v_failmsg(STR2);
  }
  cp->checktime = LINK->checktime;
  oldnex = cp->nex;
  compileexpr(cp->expr, &cp->nex, &bp);
  if ((ne_opkind)cp->nex->op == ne_error) {
    sprintf(STR3, "Error in expression for %s: %s",
	    cp->name, v_neerrmsg(STR2, (ne_errorkind)cp->nex->UU.err));
    v_failmsg(STR3);
  }
  V.time = -1;
  findtime(cp->nex, &V);
  LINK->checktime = v_timestamp;
  v_timestamp++;
  ne_dispose(&oldnex);
  if (V.time <= cp->exprtime)
    return;
  v_initcheckbase(&bp);
  if (!v_checkbase(&bp, cp->nex))
    v_cantcombine();
  v_aftercheckbase(&cbase);
  if (!v_checkunits(cp->nex, units))
    v_badunits();
  ne_constantlist(&cp->nex, &v_nedesc, NULL);
  if (cp->kind == v_ck_curve && cp->base == bp) {
    sparevec = cp->vec;
    v_setcurvekind(cp, v_ck_none);
  } else
    sparevec = NULL;
  v_unassigncurve(cp);
  flash = false;
  if (v_p_trace->val.U1.i1 >= 2) {
    sprintf(STR2, "Recomputing curve %s", cp->name);
    v_logwriteln(STR2);
  } else {
    if (v_p_quiet->val.U1.i1 == 0 && bp != NULL) {
      flash = true;
      fprintf(stderr, "Recomputing %s\015", cp->name);
    }
    sprintf(STR2, "Recomputing %s", cp->name);
    v_logwrite(STR2);
  }
  if (bp == NULL) {
    if (ne_exprtype(cp->nex) == ne_string) {
      v_setcurvekind(cp, v_ck_string);
      cp->sval = strdup(ne_sevaluate(STR2, cp->nex, &v_nedesc));
    } else {
      v_setcurvekind(cp, v_ck_num);
      cp->yval = ne_revaluate(cp->nex, &v_nedesc);
    }
  } else {
    if (sparevec != NULL)
      cp->vec = sparevec;
    else
      v_newvector(&cp->vec, bp->len);
    cp->base = bp;
    v_setcurvekind(cp, v_ck_curve);
    v_evaluate(cp->nex, bp, cbase, cp->vec);
    v_writeerror();
  }
  v_fixcurvesym(cp);
  if (flash)
    fprintf(stderr, "\015\t");
  strchange(&cp->units, units);
  cp->exprtime = v_timestamp;
  v_change(cp);
}



Void v_needcurve(cp)
v_curverec *cp;
{
  struct LOC_v_needcurve V;

  V.checktime = v_timestamp;
  v_timestamp++;
  needcurve(cp, &V);
}



Static Void debstr(s)
Char *s;
{
  long i, FORLIM;

  if (v_p_quiet->val.U1.i1 != 0)
    return;
  FORLIM = strlen(s);
  for (i = 0; i < FORLIM; i++) {
    if (s[i] < ' ')
      printf("");
    else if ((s[i] & (~127)) != 0)
      putchar(255);
    else
      putchar(s[i]);
/* p2c: viewmod.text, line 4633:
 * Note: Null character at end of sprintf control string [148] */
  }
  putchar('\n');

/* p2c: viewmod.text, line 4635: Note: Character >= 128 encountered [281] */
}







/* Parameters */

Static Void defparamchproc(pp, val)
v_paramrec *pp;
Char *val;
{
  if (pp->kind->kind == v_pk_other)
    v_failmsg("Bad change to parameter");
}


Static Void defparamnchproc(pp, r)
v_paramrec *pp;
double *r;
{
  if (pp->kind->kind == v_pk_other)
    v_failmsg("Bad change to parameter");
}


Static Void defparamhelpproc(pp)
v_paramrec *pp;
{
  if (pp->kind->helpstr != NULL) {
    puts(pp->kind->helpstr);
    return;
  }
  switch (pp->kind->kind) {

  case v_pk_real:
    printf("Enter any real number\n");
    break;

  case v_pk_int:
    printf("Enter any integer\n");
    break;

  case v_pk_str:
    printf("Enter any string\n");
    break;

  default:
    printf("No help for parameter %s\n", pp->name);
    break;
  }
}


Static Void defparamfmtproc(pp, val)
v_paramrec *pp;
Char *val;
{
  switch (pp->kind->kind) {

  case v_pk_real:
    sprintf(val, "%g", pp->val.r);
    break;

  case v_pk_int:
    sprintf(val, "%ld", pp->val.U1.i1);
    break;

  case v_pk_str:
    if ((Char *)pp->val.U99.l1 == NULL)
      *val = '\0';
    else
      strcpy(val, (Char *)(&pp->val.U99.l1));
    break;

  default:
    strcpy(val, "???");
    break;
  }
}


Static Void defparamnfmtproc(pp, r)
v_paramrec *pp;
double *r;
{
  long i;
  Char STR1[256], *STR2;

  switch (pp->kind->kind) {

  case v_pk_real:
    *r = pp->val.r;
    break;

  case v_pk_int:
    *r = pp->val.U1.i1;
    break;

  case v_pk_str:
    if ((Char *)pp->val.U99.l1 == NULL || *(Char *)pp->val.U99.l1 == '\0')
      *r = 0.0;
    else {
      strcpy(STR1, (Char *)(&pp->val.U99.l1)); 
      *r = strtod(STR1, &STR2);
      i = STR2 - STR1 + 1;
    }
    break;

  default:
    *r = 0.0;
    break;
  }
}


Static Void defparamcopyproc(pp, opp)
v_paramrec *pp, *opp;
{
  switch (pp->kind->kind) {

  case v_pk_str:
    if ((Char *)opp->val.U99.l1 != NULL)
      *(Char **)((Char **)(&pp->val.U99.l1)) = strdup((Char *)opp->val.U99.l1);
    pp->val.U1.i2 = opp->val.U1.i2;
    break;

  default:
    pp->val = opp->val;
    break;
  }
}


Static Void defparamrestproc(pp, opp)
v_paramrec *pp, *opp;
{
  switch (pp->kind->kind) {

  case v_pk_str:
    strdispose((Char **)((Char **)(&pp->val.U99.l1)));
    pp->val.U99.l1 = (na_long)((Char *)opp->val.U99.l1);
    break;

  default:
    pp->val = opp->val;
    break;
  }
}


Void v_addparamkind(pk, kind)
v_paramkindrec **pk;
v_paramkinds kind;
{
  *pk = (v_paramkindrec *)Malloc(sizeof(v_paramkindrec));
  (*pk)->kind = kind;
  (*pk)->chproc.proc = (Anyptr)defparamchproc;
  (*pk)->chproc.link = (Anyptr)NULL;
  (*pk)->nchproc.proc = (Anyptr)defparamnchproc;
  (*pk)->nchproc.link = (Anyptr)NULL;
  (*pk)->fmtproc.proc = (Anyptr)defparamfmtproc;
  (*pk)->fmtproc.link = (Anyptr)NULL;
  (*pk)->nfmtproc.proc = (Anyptr)defparamnfmtproc;
  (*pk)->nfmtproc.link = (Anyptr)NULL;
  (*pk)->helpproc.proc = (Anyptr)defparamhelpproc;
  (*pk)->helpproc.link = (Anyptr)NULL;
  (*pk)->helpstr = NULL;
  (*pk)->copyproc.proc = (Anyptr)defparamcopyproc;
  (*pk)->copyproc.link = (Anyptr)NULL;
  (*pk)->restproc.proc = (Anyptr)defparamrestproc;
  (*pk)->restproc.link = (Anyptr)NULL;
}


Void v_deriveparamkind(pk, pk2)
v_paramkindrec **pk, *pk2;
{
  v_addparamkind(pk, pk2->kind);
  (*pk)->chproc = pk2->chproc;
  (*pk)->nchproc = pk2->nchproc;
  (*pk)->fmtproc = pk2->fmtproc;
  (*pk)->nfmtproc = pk2->nfmtproc;
  (*pk)->helpproc = pk2->helpproc;
  (*pk)->helpstr = pk2->helpstr;
  (*pk)->copyproc = pk2->copyproc;
  (*pk)->restproc = pk2->restproc;
}



Void v_addparam(name_, pp, pk)
Char *name_;
v_paramrec **pp;
v_paramkindrec *pk;
{
  Char name[256];
  v_paramrec **ppp;
  Char STR2[256];

  strcpy(name, name_);
  if (pk == NULL)
    pk = v_paramstrkind;
  strlower(name, name);
  ppp = &v_parambase;
  while (*ppp != NULL && strcmp((*ppp)->name, name) < 0)
    ppp = &(*ppp)->next;
  if (*ppp != NULL && !strcmp((*ppp)->name, name) &&
      (*ppp)->owningtool != curtoolname) {
    sprintf(STR2, "Parameter name %s already exists", name);
    v_failmsg(STR2);
  }
  if (*ppp == NULL || strcmp((*ppp)->name, name)) {
    *pp = (v_paramrec *)Malloc(sizeof(v_paramrec));
    (*pp)->next = *ppp;
    *ppp = *pp;
    (*pp)->name = strdup(name);
  } else
    *pp = *ppp;
  (*pp)->owningtool = curtoolname;
  (*pp)->kind = pk;
  (*pp)->val.U1.i1 = 0;
  (*pp)->val.U1.i2 = 0;
}


Void v_addstrparam(name, pp, val)
Char *name;
v_paramrec **pp;
Char *val;
{
  v_addparam(name, pp, v_paramstrkind);
  *(Char **)((Char **)(&(*pp)->val.U99.l1)) = strdup(val);
}


Void v_addrostrparam(name, pp, val)
Char *name;
v_paramrec **pp;
Char *val;
{
  v_addparam(name, pp, v_paramrostrkind);
  *(Char **)((Char **)(&(*pp)->val.U99.l1)) = strdup(val);
}


Void v_addrealparam(name, pp, r)
Char *name;
v_paramrec **pp;
double r;
{
  v_addparam(name, pp, v_paramrealkind);
  (*pp)->val.r = r;
}


Void v_addintparam(name, pp, i)
Char *name;
v_paramrec **pp;
long i;
{
  v_addparam(name, pp, v_paramintkind);
  (*pp)->val.U1.i1 = i;
}


v_paramrec *v_findparam(name_)
Char *name_;
{
  Char name[256];
  v_paramrec *pp;

  strcpy(name, name_);
  strlower(name, name);
  pp = v_parambase;
  while (pp != NULL && strcmp(pp->name, name) < 0)
    pp = pp->next;
  if (pp == NULL)
    return NULL;
  else if (!strcmp(pp->name, name))
    return pp;
  else if (strbegins(pp->name, name) &&
	   (pp->next == NULL || !strbegins(pp->next->name, name)))
    return pp;   /*abbreviation*/
  else
    return NULL;
}


Void v_setstrparam(pp, val_)
v_paramrec *pp;
Char *val_;
{
  Char val[256];
  double r;

  strcpy(val, val_);
  if (pp == NULL)
    v_nosuchparam();
  switch (pp->kind->kind) {

  case v_pk_real:
  case v_pk_int:
    if (!v_parsereal(val, &r))
      v_fail();
    v_setrealparam(pp, r);
    break;

  case v_pk_str:
    if (pp->kind->chproc.link != NULL)
      (*(Void(*) PP((v_paramrec *pp, Char *val, Anyptr _link)))
	pp->kind->chproc.proc)(pp, val, pp->kind->chproc.link);
    else
      (*(Void(*) PP((v_paramrec *pp, Char *val)))pp->kind->chproc.proc)(pp, val);
    if ((Char *)pp->val.U99.l1 == NULL)
      *(Char **)((Char **)(&pp->val.U99.l1)) = strdup(val);
    else if (strcmp(val, (Char *)pp->val.U99.l1))
      strchange((Char **)((Char **)(&pp->val.U99.l1)), val);
    break;

  default:
    if (pp->kind->chproc.link != NULL)
      (*(Void(*) PP((v_paramrec *pp, Char *val, Anyptr _link)))
	pp->kind->chproc.proc)(pp, val, pp->kind->chproc.link);
    else
      (*(Void(*) PP((v_paramrec *pp, Char *val)))pp->kind->chproc.proc)(pp, val);
    break;
  }
}


Char *v_getstrparam(Result, pp)
Char *Result;
v_paramrec *pp;
{
  Char buf[256];

  if (pp == NULL)
    v_nosuchparam();
  *buf = '\0';
  if (pp->kind->fmtproc.link != NULL)
    (*(Void(*) PP((v_paramrec *pp, Char *val, Anyptr _link)))
      pp->kind->fmtproc.proc)(pp, buf, pp->kind->fmtproc.link);
  else
    (*(Void(*) PP((v_paramrec *pp, Char *val)))pp->kind->fmtproc.proc)(pp, buf);
  return strcpy(Result, buf);
}


Void v_setrealparam(pp, r)
v_paramrec *pp;
double r;
{
  Char STR1[256];

  if (pp == NULL)
    v_nosuchparam();
  switch (pp->kind->kind) {

  case v_pk_real:
    if (pp->kind->nchproc.link != NULL)
      (*(Void(*) PP((v_paramrec *pp, double *r, Anyptr _link)))
	pp->kind->nchproc.proc)(pp, &r, pp->kind->nchproc.link);
    else
      (*(Void(*) PP((v_paramrec *pp, double *r)))pp->kind->nchproc.proc)(pp, &r);
    pp->val.r = r;
    break;

  case v_pk_int:
    if (pp->kind->nchproc.link != NULL)
      (*(Void(*) PP((v_paramrec *pp, double *r, Anyptr _link)))
	pp->kind->nchproc.proc)(pp, &r, pp->kind->nchproc.link);
    else
      (*(Void(*) PP((v_paramrec *pp, double *r)))pp->kind->nchproc.proc)(pp, &r);
    pp->val.U1.i1 = (long)floor(r + 0.5);
    break;

  case v_pk_str:
    sprintf(STR1, "%g", r);
    v_setstrparam(pp, STR1);
    break;

  default:
    if (pp->kind->nchproc.link != NULL)
      (*(Void(*) PP((v_paramrec *pp, double *r, Anyptr _link)))
	pp->kind->nchproc.proc)(pp, &r, pp->kind->nchproc.link);
    else
      (*(Void(*) PP((v_paramrec *pp, double *r)))pp->kind->nchproc.proc)(pp, &r);
    break;
  }
}


double v_getrealparam(pp)
v_paramrec *pp;
{
  double r;

  if (pp == NULL)
    v_nosuchparam();
  r = 0.0;
  if (pp->kind->nfmtproc.link != NULL)
    (*(Void(*) PP((v_paramrec *pp, double *r, Anyptr _link)))
      pp->kind->nfmtproc.proc)(pp, &r, pp->kind->nfmtproc.link);
  else
    (*(Void(*) PP((v_paramrec *pp, double *r)))pp->kind->nfmtproc.proc)(pp, &r);
  return r;
}


Void v_setintparam(pp, i)
v_paramrec *pp;
long i;
{
  v_setrealparam(pp, (double)i);
}


long v_getintparam(pp)
v_paramrec *pp;
{
  return ((long)floor(v_getrealparam(pp) + 0.5));
}



Static Void boolchproc(pp, val)
v_paramrec *pp;
Char *val;
{
  double r;

  strlower(val, val);
  if (*val == '\0' || val[0] == '1' || val[0] == 'n' || val[0] == 'f' ||
      !strcmp(val, "off"))
    r = 0.0;
  else if (val[0] == '0' || val[0] == 'y' || val[0] == 't' ||
	   !strcmp(val, "on"))
    r = 1.0;
  else
    v_failmsg("Value must be True or False");
  if (pp->kind->nchproc.link != NULL)
    (*(Void(*) PP((v_paramrec *pp, double *r, Anyptr _link)))
      pp->kind->nchproc.proc)(pp, &r, pp->kind->nchproc.link);
  else
    (*(Void(*) PP((v_paramrec *pp, double *r)))pp->kind->nchproc.proc)(pp, &r);
}


Static Void boolnchproc(pp, r)
v_paramrec *pp;
double *r;
{
  pp->val.U1.i1 = (*r != 0.0);
}


Static Void pboolnchproc(pp, r)
v_paramrec *pp;
double *r;
{
  long val;
  _PROCEDURE tempp;

  val = (long)floor(*r + 0.5);
  tempp = pp->val.pr;
  /*      push_var(val);  */
  if (tempp.link != NULL)
    (*(Void(*) PP((long *i, Anyptr _link)))tempp.proc)(&val, tempp.link);
  else
    (*(Void(*) PP((long *i)))tempp.proc)(&val);
}


Static Void boolfmtproc(pp, val)
v_paramrec *pp;
Char *val;
{
  double r;

  r = 0.0;
  if (pp->kind->nfmtproc.link != NULL)
    (*(Void(*) PP((v_paramrec *pp, double *r, Anyptr _link)))
      pp->kind->nfmtproc.proc)(pp, &r, pp->kind->nfmtproc.link);
  else
    (*(Void(*) PP((v_paramrec *pp, double *r)))pp->kind->nfmtproc.proc)(pp, &r);
  if (r == 0) {
    strcpy(val, "False");
    return;
  }
  if (r == 1)
    strcpy(val, "True");
  else
    sprintf(val, "%g?", r);
}


Static Void boolnfmtproc(pp, r)
v_paramrec *pp;
double *r;
{
  *r = pp->val.U1.i1;
}


Static Void pboolnfmtproc(pp, r)
v_paramrec *pp;
double *r;
{
  long val;
  _PROCEDURE tempp;

  val = -1;
  /*      push_var(val);  */
  tempp = pp->val.pr;
  if (tempp.link != NULL)
    (*(Void(*) PP((long *i, Anyptr _link)))tempp.proc)(&val, tempp.link);
  else
    (*(Void(*) PP((long *i)))tempp.proc)(&val);
  *r = val;
}


Void v_setboolparam(pp, b)
v_paramrec *pp;
boolean b;
{
  v_setintparam(pp, (long)b);
}


boolean v_getboolparam(pp)
v_paramrec *pp;
{
  return (v_getintparam(pp) != 0);
}


Void v_addboolparam(name, pp, b)
Char *name;
v_paramrec **pp;
boolean b;
{
  v_addparam(name, pp, v_paramboolkind);
  (*pp)->val.U1.i1 = b;
}


Static Void v_addpboolparam(name, pp, pr)
Char *name;
v_paramrec **pp;
_PROCEDURE pr;
{
  na_long l1;

  v_addparam(name, pp, v_parampboolkind);
  l1 = (Anyptr)(&pr);
  (*pp)->val.pr = ((na_quadword *)l1)->pr;
}


Static Void fnchproc(pp, val)
v_paramrec *pp;
Char *val;
{
  if ((Char *)pp->val.U99.l2 != NULL)
    newci_fixfname(val, (Char *)pp->val.U99.l2, "");
  strupper(val, val);
}


Static Void fnhelpproc(pp)
v_paramrec *pp;
{
  printf("Enter a file name");
  if ((Char *)pp->val.U99.l2 != NULL)
    printf(" (default .%s)", (Char *)pp->val.U99.l2);
  putchar('\n');
}


Static Void rostrchproc(pp, val)
v_paramrec *pp;
Char *val;
{
  v_failmsg("Can't change this parameter");
}


Static Void initparamkinds()
{
  v_addparamkind(&v_paramstrkind, v_pk_str);
  v_addparamkind(&v_paramrealkind, v_pk_real);
  v_addparamkind(&v_paramintkind, v_pk_int);
  v_addparamkind(&v_paramboolkind, v_pk_other);
  v_paramboolkind->chproc.proc = (Anyptr)boolchproc;
  v_paramboolkind->chproc.link = (Anyptr)NULL;
  v_paramboolkind->nchproc.proc = (Anyptr)boolnchproc;
  v_paramboolkind->nchproc.link = (Anyptr)NULL;
  v_paramboolkind->fmtproc.proc = (Anyptr)boolfmtproc;
  v_paramboolkind->fmtproc.link = (Anyptr)NULL;
  v_paramboolkind->nfmtproc.proc = (Anyptr)boolnfmtproc;
  v_paramboolkind->nfmtproc.link = (Anyptr)NULL;
  v_paramboolkind->helpstr = strdup("Enter True or False (or Yes/No, On/Off, 1/0)");
  v_deriveparamkind(&v_parampboolkind, v_paramboolkind);
  v_parampboolkind->nchproc.proc = (Anyptr)pboolnchproc;
  v_parampboolkind->nchproc.link = (Anyptr)NULL;
  v_parampboolkind->nfmtproc.proc = (Anyptr)pboolnfmtproc;
  v_parampboolkind->nfmtproc.link = (Anyptr)NULL;
  v_addparamkind(&v_paramfnkind, v_pk_str);
  v_paramfnkind->chproc.proc = (Anyptr)fnchproc;
  v_paramfnkind->chproc.link = (Anyptr)NULL;
  v_paramfnkind->helpproc.proc = (Anyptr)fnhelpproc;
  v_paramfnkind->helpproc.link = (Anyptr)NULL;
  v_addparamkind(&v_paramrostrkind, v_pk_str);
  v_paramrostrkind->chproc.proc = (Anyptr)rostrchproc;
  v_paramrostrkind->chproc.link = (Anyptr)NULL;
  v_paramrostrkind->helpstr = strdup("This is a read-only parameter");
}






/* Interpolation */

Static Void nullpinterp(buf, int_)
Char *buf;
v_interpolator *int_;
{
}


Static Void nulldinterp(int_)
v_interpolator *int_;
{
}


Void v_addinterp(name, proc, help)
Char *name;
_PROCEDURE proc;
Char *help;
{
  na_strlist *l1;

  l1 = strlist_add(&v_interpolators, name);
  addedinterp = (interprec *)Malloc(sizeof(interprec));
  l1->value = (Anyptr)addedinterp;
  addedinterp->proc = proc;
  addedinterp->pproc.proc = (Anyptr)nullpinterp;
  addedinterp->pproc.link = (Anyptr)NULL;
  addedinterp->dproc.proc = (Anyptr)nulldinterp;
  addedinterp->dproc.link = (Anyptr)NULL;
  addedinterp->help = strdup(help);
}


Void v_addintparse(pproc, dproc)
_PROCEDURE pproc;
_PROCEDURE dproc;
{
  addedinterp->pproc = pproc;
  addedinterp->dproc = dproc;
}


Void v_listinterps()
{
  na_strlist *l1;
  interprec *interp;
  long i;

  l1 = v_interpolators;
  while (l1 != NULL) {
    fputs(l1->s, stdout);
    for (i = strlen(l1->s); i <= 20; i++)
      putchar(' ');
    putchar(' ');
    interp = (interprec *)l1->value;
    puts(interp->help);
    l1 = l1->next;
  }
}


v_interpolator v_parseinterp(buf)
Char *buf;
{
  na_strlist *l1;
  Char wrd[256];
  v_interpolator int_;
  interprec *interp;
  Char STR1[256];

  if (*buf == '[') {
    strcpy(buf, buf + 1);
    v_strword(buf, wrd);
    l1 = strlist_cifind(v_interpolators, wrd);
    if (l1 == NULL) {
      sprintf(STR1, "Unrecognized interpolation type: %s", wrd);
      v_failmsg(STR1);
    }
    interp = (interprec *)l1->value;
    int_.interp = (Anyptr)interp;
    int_.user = (na_long)0;
    if (interp->pproc.link != NULL)
      (*(Void(*) PP((Char *buf, v_interpolator *int_, Anyptr _link)))
	interp->pproc.proc)(buf, &int_, interp->pproc.link);
    else
      (*(Void(*) PP((Char *buf, v_interpolator *int_)))interp->pproc.proc)(
	buf, &int_);
    v_needsep(buf, ']');
    return int_;
  }
  strcpy(wrd, "linear");
  l1 = strlist_cifind(v_interpolators, wrd);
  interp = (interprec *)l1->value;
  int_.interp = (Anyptr)interp;
  int_.user = (na_long)0;
  return int_;
}


Void v_disposeinterp(int_)
v_interpolator *int_;
{
  interprec *interp;

  interp = (interprec *)int_->interp;
  if (interp->dproc.link != NULL)
    (*(Void(*) PP((v_interpolator *int_, Anyptr _link)))interp->dproc.proc)(
      int_, interp->dproc.link);
  else
    (*(Void(*) PP((v_interpolator *int_)))interp->dproc.proc)(int_);
  int_->interp = NULL;
  int_->user = (na_long)0;
}


double v_interp(int_, cp, x)
v_interpolator *int_;
v_curverec *cp;
double x;
{
  double Result;
  interprec *interp;
  double val;

  switch (cp->kind) {

  case v_ck_num:
    Result = cp->yval;
    break;

  case v_ck_curve:
    interp = (interprec *)int_->interp;
    if (interp->proc.link != NULL)
      (*(Void(*) PP((v_curverec *cp, double x, na_long user, double *val,
		     Anyptr _link)))interp->proc.proc)(cp, x, int_->user,
	&val, interp->proc.link);
    else
      (*(Void(*) PP((v_curverec *cp, double x, na_long user, double *val)))
	interp->proc.proc)(cp, x, int_->user, &val);
    Result = val;
    break;

  default:
    v_failmsg("Bad data type for interpolation");
    break;
  }
  return Result;
}






/* Maintaining the command table */

Static Void defcmdproc(buf)
Char *buf;
{
  Char STR1[256];
  Char STR3[256];

  sprintf(STR3, "Bad arguments to %s command", strupper(STR1, v_cmdname));
  v_failmsg(STR3);
}


Static Void makecmd(cmdp, name_)
cmdrec **cmdp;
Char *name_;
{
  Char name[256];
  cmdrec **cmdpp;
  na_strlist *l1, *l2;

  strcpy(name, name_);
  strlower(name, name);
  cmdpp = &cmdbase;
  while (*cmdpp != NULL && strcmp((*cmdpp)->name, name)) {
    if (strcmp((*cmdpp)->name, name) > 0)
      cmdpp = &(*cmdpp)->left;
    else
      cmdpp = &(*cmdpp)->right;
  }
  if (*cmdpp == NULL) {
    *cmdp = (cmdrec *)Malloc(sizeof(cmdrec));
    (*cmdp)->name = strdup(name);
    (*cmdp)->left = NULL;
    (*cmdp)->right = NULL;
    (*cmdp)->active = false;
    *cmdpp = *cmdp;
  } else {
    *cmdp = *cmdpp;
    if ((*cmdp)->active) {
      if ((*cmdp)->isctrl && (*cmdp)->builtin)
	v_failmsg("Can't redefine a control command");
      l1 = (*cmdp)->help;
      if (l1 != NULL) {
	while (l1->next != NULL)
	  l1 = l1->next;
	if (strcmp(l1->s, "-----"))
	  l2 = strlist_append(&l1->next, "-----");
      }
      if ((*cmdp)->isctrl)
	abbrevsokay = false;
    }
  }
  if (!(*cmdp)->active) {
    (*cmdp)->active = true;
    (*cmdp)->prefix = strlen(name);
    (*cmdp)->help = NULL;
    (*cmdp)->proc.proc = (Anyptr)defcmdproc;
    (*cmdp)->proc.link = (Anyptr)NULL;
    (*cmdp)->owningtool = NULL;
    (*cmdp)->procbase = NULL;
    abbrevsokay = false;
  }
  (*cmdp)->alias = NULL;
  (*cmdp)->isctrl = false;
  (*cmdp)->builtin = builtinflag;
}


Void v_addhelpline(left_, right)
Char *left_, *right;
{
  Char left[256];
  na_strlist *l1;

  strcpy(left, left_);
  if (!strcmp(left, "*")) {
    l1 = strlist_add(&seealso, right);
    return;
  }
  if (*right != '\0') {
    do {
      strcat(left, " ");
    } while (strlen(left) < 24);
    strcat(left, right);
  }
  l1 = strlist_add(&shorthelp, left);
}


Void v_addcmd(name_, proc, shorthelp, shorthelp2_)
Char *name_;
_PROCEDURE proc;
Char *shorthelp, *shorthelp2_;
{
  Char name[256], shorthelp2[256];
  cmdrec *cmdp;

  strcpy(name, name_);
  strcpy(shorthelp2, shorthelp2_);
  strlower(name, name);
  if (!strcmp(shorthelp, "*"))
    strcpy(shorthelp2, name);
  if (*shorthelp != '\0')
    v_addhelpline(shorthelp, shorthelp2);
  makecmd(&cmdp, name);
  cmdp->proc = proc;
  cmdp->owningtool = curtoolname;
  cmdp->procbase = NULL;
  prevaddedcmd = addedcmd;
  addedcmd = cmdp;
  addedfunc = NULL;
  v_cmdid = (Anyptr)cmdp;
}


Void v_isctrl()
{
  addedcmd->isctrl = true;
}


Void v_addhelp(msg)
Char *msg;
{
  na_strlist *l1, *l2;

  if (addedcmd != NULL) {
    l1 = strlist_append(&addedcmd->help, msg);
    return;
  }
  if (addedfunc == NULL)
    return;
  l1 = strlist_find(funchelp, addedfunc->s);
  if (l1 == NULL)
    l1 = strlist_insert(&funchelp, addedfunc->s);
  l2 = strlist_append((na_strlistrec **)(&l1->value), msg);
}


Void v_samehelp()
{
  na_strlist *l1, *l2;

  if (addedcmd != NULL) {
    addedcmd->help = prevaddedcmd->help;
    return;
  }
  if (addedfunc == NULL)
    return;
  l1 = strlist_find(funchelp, addedfunc->s);
  if (l1 == NULL)
    l1 = strlist_insert(&funchelp, addedfunc->s);
  l2 = strlist_find(funchelp, prevaddedfunc->s);
  if (l2 != NULL)
    l1->value = (na_long)((na_strlistrec *)l2->value);
}


/* Local variables for reevalcmd: */
struct LOC_reevalcmd {
  cmdrec *cmdp;
  Char pref[256];
} ;

Local Void checkcmds(cmdp2, LINK)
cmdrec *cmdp2;
struct LOC_reevalcmd *LINK;
{
  Char STR1[256];

  if (cmdp2 == NULL)
    return;
  if (cmdp2 != LINK->cmdp && cmdp2->active) {
    if (!strbegins(cmdp2->name, LINK->cmdp->name)) {
      while (strbegins(cmdp2->name, LINK->pref) &&
	     strlen(LINK->pref) < strlen(LINK->cmdp->name)) {
	sprintf(STR1, "%s%c",
		LINK->pref, LINK->cmdp->name[strlen(LINK->pref)]);
	strcpy(LINK->pref, STR1);
      }
    }
  }
  checkcmds(cmdp2->left, LINK);
  checkcmds(cmdp2->right, LINK);
}  /*checkcmds*/

Local Void reevalcmd(cmdp_)
cmdrec *cmdp_;
{
  struct LOC_reevalcmd V;
  cmdrec *WITH;

  V.cmdp = cmdp_;
  if (V.cmdp == NULL)
    return;
  WITH = V.cmdp;
  if (WITH->active) {
    if (WITH->isctrl)
      WITH->prefix = strlen(WITH->name);
    else {
      sprintf(V.pref, "%.1s", WITH->name);
      checkcmds(cmdbase, &V);
      WITH->prefix = strlen(V.pref);
    }
    if (*WITH->name != '_') {
      numcmds++;
      maxcmdname = P_imax2(maxcmdname, (long)strlen(WITH->name));
    }
  }
  reevalcmd(WITH->left);
  reevalcmd(WITH->right);
}  /*reevalcmd*/



Static Void reevalabbrevs(canflash)
boolean canflash;
{
  boolean flash;

  if (!abbrevsokay) {
    flash = false;
    if (v_p_trace->val.U1.i1 >= 2)
      v_logwriteln("Reevaluating command abbreviations");
    else if (v_p_quiet->val.U1.i1 == 0 && canflash) {
      fprintf(stderr, "Reevaluating abbreviations table\n");
      flash = true;
    }
    numcmds = 0;
    maxcmdname = 1;
    reevalcmd(cmdbase);
    if (flash)
      fprintf(stderr, "\015\t");
  }
  abbrevsokay = true;
}



Static cmdrec *findcmd(name, abbrevs)
Char *name;
boolean abbrevs;
{
  cmdrec *cmdp;
  long len;

  cmdp = cmdbase;
  len = strlen(name);
  while (cmdp != NULL && (len < cmdp->prefix || !strbegins(cmdp->name, name))) {
    if (strcmp(name, cmdp->name) < 0)
      cmdp = cmdp->left;
    else
      cmdp = cmdp->right;
  }
  if (cmdp != NULL && cmdp->active && (abbrevs || !strcmp(cmdp->name, name))) {
    if (!(abbrevs && cmdp->alias != NULL))
      return cmdp;
    while (cmdp->alias != NULL)
      cmdp = cmdp->alias;
    if (!cmdp->active)
      cmdp = NULL;
    return cmdp;
  } else
    return NULL;
}


/* Local variables for checkambig: */
struct LOC_checkambig {
  Char name[256], buf[256];
} ;

Local Void look(cmdp, LINK)
cmdrec *cmdp;
struct LOC_checkambig *LINK;
{
  if (cmdp == NULL)
    return;
  look(cmdp->left, LINK);
  if (cmdp->active && strbegins(cmdp->name, LINK->name))
    sprintf(LINK->buf + strlen(LINK->buf), "%s, ", cmdp->name);
  look(cmdp->right, LINK);
}



Static Char *checkambig(Result, name_)
Char *Result, *name_;
{
  struct LOC_checkambig V;

  strcpy(V.name, name_);
  *V.buf = '\0';
  look(cmdbase, &V);
  if (strends(V.buf, ", "))
    V.buf[strlen(V.buf) - 2] = '\0';
  return strcpy(Result, V.buf);
}



Static Void cantfindcmd(wrd_)
Char *wrd_;
{
  Char wrd[256];
  Char STR1[256], STR2[256];

  strcpy(wrd, wrd_);
  strcpy(wrd, checkambig(STR1, wrd));
  if (*wrd == '\0') {
    v_failmsg("No such command.  Type \"?\" or \"??\" for help.");
    return;
  }
  if (strposc(wrd, ',', 1L) == 0) {
    sprintf(STR2, "Must spell out %s in full", wrd);
    v_failmsg(STR2);
  } else {
    sprintf(STR2, "This command is ambiguous for: %s", wrd);
    v_failmsg(STR2);
  }
}



Void v_addalias(nname, oname_)
Char *nname, *oname_;
{
  Char oname[256];
  cmdrec *ncp, *ocp;

  strcpy(oname, oname_);
  ocp = findcmd(oname, false);
  if (ocp == NULL)
    cantfindcmd(oname);
  if (ocp->isctrl)
    v_failmsg("Can't alias a control command");
  makecmd(&ncp, nname);
  if (ncp != ocp)
    ncp->alias = ocp;
}






/* User-defined commands */

Void v_scanbody(body, opening_, closing_)
na_strlist **body;
Char *opening_, *closing_;
{
  Char opening[256], closing[256];
  long nest;
  na_strlist **last, *l1;
  Char buf[256];
  Char STR1[256];

  strcpy(opening, opening_);
  strcpy(closing, closing_);
  strupper(opening, opening);
  strupper(closing, closing);
  *body = NULL;
  last = body;
  nest = 0;
  do {
    v_scanword(buf, nest);
    if (*buf == '\0') {
      sprintf(STR1, "Missing %s", closing);
      v_failmsg(STR1);
    }
    if (!strcmp(buf, opening))
      nest++;
    else if (!strcmp(buf, closing))
      nest--;
    if (nest >= 0) {
      v_readln("", buf);
      v_doexpansions(buf, nest + 1);
      l1 = strlist_append(last, buf);
      ((short *)(&l1->value))[0] = v_inputlnum();
      last = &l1->next;
    } else
      v_readln("", buf);
  } while (nest >= 0);
}


Local Void syntax()
{
  v_failmsg("Syntax error in argument list specification");
}


Static Void definecmd(pp, args_, body)
procrec **pp;
Char *args_;
na_strlist *body;
{
  Char args[256];
  na_strlist *l1;
  long i, j, count, nesting;
  Char quotech, prevkind;
  Char wrd[256];
  Char STR1[256];

  strcpy(args, args_);
  *pp = (procrec *)Malloc(sizeof(procrec));
  addedproc = *pp;
  (*pp)->start = body;
  (*pp)->args = NULL;
  (*pp)->blockend = NULL;
  quotech = '\0';
  count = 0;
  prevkind = '\0';
  while (*args != '\0') {
    if (args[0] == ' ') {
      strcpy(args, args + 1);
      continue;
    }
    if ((args[0] == '\'' || args[0] == '"') && quotech == '\0') {
      quotech = args[0];
      strcpy(args, args + 1);
      continue;
    }
    if (args[0] == quotech && quotech != '\0') {
      quotech = '\0';
      strcpy(args, args + 1);
      continue;
    }
    if (P_inset(args[0], v_nedesc.startident)) {
      *wrd = '\0';
      while (*args != '\0' && P_inset(args[0], v_nedesc.ident)) {
	sprintf(wrd + strlen(wrd), "%c", args[0]);
	strcpy(args, args + 1);
      }
      if (quotech != '\0')
	strupper(wrd, wrd);
      l1 = strlist_append(&(*pp)->args, wrd);
      count++;
      if (quotech == '\0') {
	if (prevkind == argk_var)
	  syntax();
	prevkind = argk_wvar;
      } else
	prevkind = argk_word;
      l1->kind = prevkind;
      continue;
    }
    if (args[0] == '{' && quotech == '\0') {
      i = strposc(args, '}', 1L);
      if (i < 3)
	syntax();
      if (!P_inset(args[1], v_nedesc.startident))
	syntax();
      for (j = 2; j <= i - 2; j++) {
	if (!P_inset(args[j], v_nedesc.ident))
	  syntax();
      }
      l1 = strlist_append(&(*pp)->args, strpart(STR1, args, 2, (int)(i - 1)));
      count++;
      strcpy(args, args + i);
      if (prevkind == argk_var)
	syntax();
      strcpy(STR1, strltrim(args));
      strcpy(args, STR1);
      if (*args == '\0')
	prevkind = argk_rest;
      else
	prevkind = argk_var;
      l1->kind = prevkind;
      continue;
    }
    *wrd = '\0';
    nesting = 0;
    while (*args != '\0' && !P_inset(args[0], v_nedesc.startident) &&
	   args[0] != ' ' && args[0] != '\'' && args[0] != '"' &&
	   (quotech != '\0' || args[0] != '}' && args[0] != '{')) {
      sprintf(wrd + strlen(wrd), "%c", toupper(args[0]));
      if (quotech == '\0') {
	if (args[0] == '{' || args[0] == '[' || args[0] == '(')
	  nesting++;
	else if (args[0] == '}' || args[0] == ']' || args[0] == ')')
	  nesting = P_imax2(nesting - 1, 0L);
      }
      strcpy(args, args + 1);
    }
    if (*args != '\0' && (args[0] == '\'' || args[0] == '"') &&
	args[0] != quotech)
      syntax();
    l1 = strlist_append(&(*pp)->args, wrd);
    count++;
    prevkind = argk_punc;
    l1->kind = prevkind;
    ((short *)(&l1->value))[0] = nesting;
  }
  if (quotech != '\0')
    syntax();
  (*pp)->nargs = count;
  if (v_p_trace->val.U1.i1 < 1)
    return;
  strcpy(wrd, "Args:");
  l1 = (*pp)->args;
  while (l1 != NULL) {
    strcat(wrd, " ");
    switch (l1->kind) {

    case argk_punc:
      strcat(wrd, l1->s);
      break;

    case argk_word:
      sprintf(wrd + strlen(wrd), "\"%s\"", strlower(STR1, l1->s));
      break;

    case argk_wvar:
      strcat(wrd, l1->s);
      break;

    default:
      sprintf(wrd + strlen(wrd), "{%s}", l1->s);
      break;
    }
    l1 = l1->next;
  }
  if ((*pp)->args == NULL)
    strcat(wrd, "<none>");
  v_logwriteln(wrd);
}


Void v_definebefore(name, args, body)
Char *name, *args;
na_strlist *body;
{
  cmdrec *cp;
  procrec *pp;
  Char STR1[256];

  if (v_p_trace->val.U1.i1 >= 1) {
    sprintf(STR1, "Defining command %s", name);
    v_logwriteln(STR1);
  }
  makecmd(&cp, name);
  addedcmd = cp;
  addedfunc = NULL;
  definecmd(&pp, args, body);
  pp->next = cp->procbase;
  cp->procbase = pp;
}


Void v_defineafter(name, args, body)
Char *name, *args;
na_strlist *body;
{
  cmdrec *cp;
  procrec *pp, **ppp;
  Char STR1[256];

  if (v_p_trace->val.U1.i1 >= 1) {
    sprintf(STR1, "Defining command %s", name);
    v_logwriteln(STR1);
  }
  makecmd(&cp, name);
  addedcmd = cp;
  addedfunc = NULL;
  ppp = &cp->procbase;
  while (*ppp != NULL)
    ppp = &(*ppp)->next;
  definecmd(&pp, args, body);
  pp->next = NULL;
  *ppp = pp;
}


Void v_isblockcmd(endcmd)
Char *endcmd;
{
  Char STR1[256];

  addedproc->blockend = strdup(strlower(STR1, endcmd));
}


Void v_undefine(name_)
Char *name_;
{
  Char name[256];
  cmdrec *cmdp;
  Char STR1[256];

  strcpy(name, name_);
  strlower(name, name);
  cmdp = findcmd(name, false);
  if (cmdp == NULL)
    return;
  if (cmdp->isctrl && cmdp->builtin)
    v_failmsg("Can't undefine a control command");
  if (v_p_trace->val.U1.i1 >= 1) {
    sprintf(STR1, "Undefining command %s", name);
    v_logwriteln(STR1);
  }
  cmdp->active = false;
  removeprocs(cmdp);
}



Static Void checkaddlocal()
{
  if (instack == NULL || instack->kind != fr_proc)
    v_failmsg("Can't define local variables except in a procedure");
}



Void v_addlocaldef(name_)
Char *name_;
{
  Char name[256];
  cmdrec *cmdp, *cmdp2;

  strcpy(name, name_);
  checkaddlocal();
  strlower(name, name);
  cmdp = cmdbase;
  while (cmdp != NULL && strcmp(cmdp->name, name)) {
    if (strcmp(name, cmdp->name) < 0)
      cmdp = cmdp->left;
    else
      cmdp = cmdp->right;
  }
  if (cmdp == NULL) {
    makecmd(&cmdp, name);
    cmdp->active = false;
  } else {
    cmdp2 = instack->UU.U2.locdefs;
    while (cmdp2 != NULL && cmdp2->right != cmdp)
      cmdp2 = cmdp2->left;
    if (cmdp2 != NULL)
      cmdp = NULL;
  }
  if (cmdp == NULL)
    return;
  cmdp2 = (cmdrec *)Malloc(sizeof(cmdrec));
  *cmdp2 = *cmdp;
  cmdp2->right = cmdp;
  cmdp2->left = instack->UU.U2.locdefs;
  instack->UU.U2.locdefs = cmdp2;
  cmdp->alias = NULL;
  cmdp->help = NULL;
  cmdp->builtin = builtinflag;
  cmdp->isctrl = false;
  cmdp->active = true;
  cmdp->owningtool = NULL;
  cmdp->procbase = NULL;
  cmdp->proc.proc = (Anyptr)defcmdproc;
  cmdp->proc.link = (Anyptr)NULL;
  if (!cmdp2->active || cmdp2->isctrl)
    abbrevsokay = false;
}



Void v_addlocalparam(name_)
Char *name_;
{
  Char name[256];
  v_paramrec *pp, *pp2;
  Anyptr any;

  strcpy(name, name_);
  checkaddlocal();
  pp = v_findparam(name);
  if (pp == NULL)
    v_nosuchparam();
  else {
    pp2 = instack->UU.U2.locparams;
    any = (Anyptr)pp;
    while (pp2 != NULL && pp2->name != (Char *)any)
      pp2 = pp2->next;
    if (pp2 != NULL)   /*don't add to list if already there!*/
      pp = NULL;
  }
  if (pp == NULL)
    return;
  pp2 = (v_paramrec *)Malloc(sizeof(v_paramrec));
  *pp2 = *pp;
  pp2->val.U1.i1 = 0;
  pp2->val.U1.i2 = 0;
  if (pp->kind->copyproc.link != NULL)
    (*(Void(*) PP((v_paramrec *pp, v_paramrec *opp, Anyptr _link)))
      pp->kind->copyproc.proc)(pp2, pp, pp->kind->copyproc.link);
  else
    (*(Void(*) PP((v_paramrec *pp, v_paramrec *opp)))pp->kind->copyproc.proc)(
      pp2, pp);
  pp2->name = (Char *)any;
  pp2->next = instack->UU.U2.locparams;
  instack->UU.U2.locparams = pp2;
}



Void v_addlocalcurve(name)
Char *name;
{
  v_curverec *cp, *cp2;

  checkaddlocal();
  cp = v_findcurve(name);
  if (cp == NULL)
    v_makecurve(&cp, NULL, NULL, "", name);
  else {
    cp2 = instack->UU.U2.loccurves;
    while (cp2 != NULL && cp2->next2 != cp)
      cp2 = cp2->next;
    if (cp2 != NULL)   /*don't add to list if already there!*/
      cp = NULL;
  }
  if (cp == NULL)
    return;
  ne_dispose(&cp->nex);
  cp2 = (v_curverec *)Malloc(sizeof(v_curverec));
  *cp2 = *cp;
  cp2->next2 = cp;
  cp2->next = instack->UU.U2.loccurves;
  instack->UU.U2.loccurves = cp2;
  cp->units = strdup("");
  cp->expr = NULL;
  v_setcurvekind(cp, v_ck_none);
}




/* Shell escapes */

Void v_shellescape(buf_, opts_)
Char *buf_, *opts_;
{
  Char buf[256], opts[256];
  long saveesc, saveior;
  Char STR1[256];

  strcpy(buf, buf_);
  strcpy(opts, opts_);
  strcpy(STR1, strltrim(buf));
  strcpy(buf, STR1);
  if (v_preshellescape.link != NULL)
    (*(Void(*) PP((Anyptr _link)))v_preshellescape.proc)(v_preshellescape.link);
  else
    (*(Void(*) PV())v_preshellescape.proc)();
  v_closelog();
  TRY(try18);
    newci_fullshellescape(buf, opts);
    if (v_postshellescape.link != NULL)
      (*(Void(*) PP((Anyptr _link)))v_postshellescape.proc)(v_postshellescape.link);
    else
      (*(Void(*) PV())v_postshellescape.proc)();
  RECOVER(try18);
    saveesc = P_escapecode;
    saveior = P_ioresult;
    if (v_postshellescape.link != NULL)
      (*(Void(*) PP((Anyptr _link)))v_postshellescape.proc)(v_postshellescape.link);
    else
      (*(Void(*) PV())v_postshellescape.proc)();
    P_ioresult = saveior;
    _Escape((int)saveesc);
  ENDTRY(try18);
}





/* The help command */

Static Void writecmddef(f, cmdp, lnums)
FILE **f;
cmdrec *cmdp;
boolean lnums;
{
  long i;
  procrec *pp;
  na_strlist *l1;
  boolean hasbr, hassq, hasdq;
  Char STR1[256];

  i = 1;
  pp = cmdp->procbase;
  while (pp != NULL) {
    if (i > 1)
      putc('\n', *f);
    fprintf(*f, "define ");
    if (i > 1)
      fprintf(*f, "[after] ");
    if (pp->blockend != NULL)
      fprintf(*f, "[block:%s] ", pp->blockend);
    fputs(cmdp->name, *f);
    l1 = pp->args;
    while (l1 != NULL) {
      putc(' ', *f);
      switch (l1->kind) {

      case argk_punc:
	hasbr = (strposc(l1->s, '{', 1L) != 0 || strposc(l1->s, '}', 1L) != 0);
	hassq = (strposc(l1->s, '\'', 1L) != 0);
	hasdq = (strposc(l1->s, '"', 1L) != 0);
	if (!hasbr && !hassq && !hasdq)
	  fputs(l1->s, *f);
	else if (hassq)
	  fprintf(*f, "\"%s\"", l1->s);
	else
	  fprintf(*f, "'%s'", l1->s);
	break;

      case argk_word:
	fprintf(*f, "\"%s\"", strlower(STR1, l1->s));
	break;

      case argk_wvar:
	fputs(l1->s, *f);
	break;

      default:
	fprintf(*f, "{%s}", l1->s);
	break;
      }
      l1 = l1->next;
    }
    putc('\n', *f);
    l1 = pp->start;
    while (l1 != NULL) {
      if (lnums)
	fprintf(*f, "%3d ", ((short *)(&l1->value))[0]);
      else
	fprintf(*f, "   ");
      fprintf(*f, "%s\n", l1->s);
      l1 = l1->next;
    }
    fprintf(*f, "enddef\n");
    i++;
    pp = pp->next;
  }
  if (cmdp->owningtool == NULL || cmdp->owningtool->kind == '\002')
    return;
  if (i > 1)
    putc('\n', *f);
  if (cmdp->builtin)
    fprintf(*f, "# Also has a built-in definition\n");
  else
    fprintf(*f, "# Final definition is in Pascal tool %s\n",
	    cmdp->owningtool->s);
}


/* Local variables for v_givehelp: */
struct LOC_v_givehelp {
  long num, colwid, stride;
  Char buf[256];
} ;

Local Void listcmds(cmdp, LINK)
cmdrec *cmdp;
struct LOC_v_givehelp *LINK;
{
  if (cmdp == NULL)
    return;
  listcmds(cmdp->left, LINK);
  if (cmdp->active) {
    if (LINK->num == 0) {
      sprintf(LINK->buf + strlen(LINK->buf), "%.*s", cmdp->prefix, cmdp->name);
      strcat(LINK->buf, cmdp->name + cmdp->prefix);
      sprintf(LINK->buf + strlen(LINK->buf), "%*s",
	      (int)(LINK->colwid - strlen(cmdp->name)), "");
    }
    LINK->num++;
    if (LINK->num == LINK->stride)
      LINK->num = 0;
  }
  listcmds(cmdp->right, LINK);
}  /*listcmds*/



Void v_givehelp(wrd_)
Char *wrd_;
{
  struct LOC_v_givehelp V;
  Char wrd[256];
  cmdrec *cmdp;
  procrec *pp;
  v_paramrec *parp;
  na_strlist *l1;
  long i, cols;
  Char lwrd[256];
  Char STR1[256], STR2[256];
  long FORLIM;
  FILE *TEMP;

  strcpy(wrd, wrd_);
  reevalabbrevs(true);
  if (*wrd == '\0') {  /*brief help-list*/
    l1 = shorthelp;
    while (l1 != NULL) {
      puts(l1->s);
      l1 = l1->next;
    }
    printf("See also:");
    l1 = seealso;
    i = 9;
    while (l1 != NULL) {
      i += strlen(l1->s) + 2;
      if (i >= P_imin2((long)nc_curWindow->width, 90L)) {
	printf("\n%10s", "");
	i = strlen(l1->s) + 12;
      } else
	putchar(' ');
      fputs(l1->s, stdout);
      if (l1->next != NULL)
	putchar(',');
      l1 = l1->next;
    }
    printf("\nType \"? help\" for more.\n");
    return;
  }
  if (!strcmp(wrd, "?")) {  /*list of all commands*/
    printf("Available commands:\n");
    V.colwid = maxcmdname + 3;
    cols = P_imax2(nc_curWindow->width / V.colwid, 1L);
    V.stride = (numcmds + cols - 1) / cols;
    FORLIM = V.stride;
    for (i = 0; i < FORLIM; i++) {
      V.num = -i;
      strcpy(V.buf, "  ");
      listcmds(cmdbase, &V);
      puts(strrtrim(strcpy(STR2, V.buf)));
    }
    return;
  }
  if (*wrd == '?') {  /*source listing for one command*/
    strcpy(wrd, wrd + 1);
    strcpy(STR2, strltrim(wrd));
    strcpy(wrd, STR2);
    strlower(lwrd, wrd);
    cmdp = findcmd(lwrd, true);
    if (cmdp != NULL) {
      pp = cmdp->procbase;
      if (pp != NULL) {
	TEMP = stdout;
/* p2c: viewmod.text, line 6085:
 * Note: Taking address of stdout; consider setting VarFiles = 0 [144] */
	writecmddef(&TEMP, cmdp, true);
	return;
      }
      if (cmdp->owningtool == NULL || cmdp->owningtool->kind == '\002') {
	printf("Command has no definition\n");
	return;
      }
      if (cmdp->builtin)
	printf("Command is built-in to View\n");
      else
	printf("Command is defined in Pascal tool %s\n", cmdp->owningtool->s);
      return;
    }
    if (strlist_find(funcsymtab, wrd) != NULL ||
	strlist_find(v_nedesc.symtab, wrd) != NULL)
      v_listfuncs(wrd);
    else
      cantfindcmd(wrd);
    return;
  }
  strlower(lwrd, wrd);
  cmdp = findcmd(lwrd, true);
  parp = v_findparam(lwrd);
  if (cmdp != NULL && parp != NULL) {
    if (strcicmp(parp->name, lwrd) == 0 && strcicmp(cmdp->name, lwrd) != 0)
      cmdp = NULL;
    else
      parp = NULL;
  }
  if (cmdp != NULL) {
    if (cmdp->help != NULL) {
      l1 = cmdp->help;
      while (l1 != NULL) {
	puts(l1->s);
	l1 = l1->next;
      }
      return;
    }
    if (cmdp->procbase != NULL) {
      pp = cmdp->procbase;
      while (pp != NULL) {
	fputs(cmdp->name, stdout);
	l1 = pp->args;
	while (l1 != NULL) {
	  putchar(' ');
	  switch (l1->kind) {

	  case argk_punc:
	    fputs(l1->s, stdout);
	    break;

	  case argk_word:
	    printf("\"%s\"", strlower(STR1, l1->s));
	    break;

	  default:
	    if (!strcmp(l1->s, "rest") && l1->kind == argk_rest)
	      printf("...");
	    else
	      printf("<%s>", l1->s);
	    break;
	  }
	  l1 = l1->next;
	}
	putchar('\n');
	if (pp->blockend != NULL)
	  puts(pp->blockend);
	pp = pp->next;
      }
      printf("  No further help for this command.\n");
      return;
    }
    if (v_hashelp)
      printf("No help for %s\n", cmdp->name);
    else
      printf("Help has been omitted from this version of View\n");
    return;
  }
  if (parp != NULL) {
    if (parp->kind->helpproc.link != NULL)
      (*(Void(*) PP((v_paramrec *pp, Anyptr _link)))parp->kind->helpproc.proc)(
	parp, parp->kind->helpproc.link);
    else
      (*(Void(*) PP((v_paramrec *pp)))parp->kind->helpproc.proc)(parp);
    if (parp->owningtool == NULL)
      return;
    if (!strcmp(parp->owningtool->s, "*")) {
      printf("This parameter is built-in to View\n");
      return;
    }
    if (parp->owningtool->kind == '\002')
      printf("This parameter belongs to tool %s\n", parp->owningtool->s);
    else
      printf("This parameter belongs to Pascal tool %s\n",
	     parp->owningtool->s);
    return;
  }
  if (strlist_find(funcsymtab, wrd) == NULL &&
      strlist_find(v_nedesc.symtab, wrd) == NULL) {
    cantfindcmd(wrd);
    return;
  }
  l1 = strlist_find(funchelp, wrd);
  if (l1 != NULL)
    l1 = (na_strlistrec *)l1->value;
  if (l1 == NULL) {
    printf("No help for function %s\n", wrd);
    return;
  }
  while (l1 != NULL) {
    puts(l1->s);
    l1 = l1->next;
  }

  /*help information for one command*/
}



Void v_savecmds(fn, buf_)
Char *fn, *buf_;
{
  Char buf[256], wrd[256];
  FILE *f;
  cmdrec *cmdp;
  Char STR2[256];
  Char username[L_cuserid];

  strcpy(buf, buf_);
  f = NULL;
  if (f != NULL)
    f = freopen(fn, "w", f);
  else
    f = fopen(fn, "w");
  if (f == NULL)
    _EscIO(FileNotFound);
  cuserid(username);
  fprintf(f, "# written from View on %s by %s\n\n",
	  strdate(STR2, ""), username);
  do {
    v_strword(buf, wrd);
    if (*wrd != '\0') {
      strlower(wrd, wrd);
      cmdp = findcmd(wrd, false);
      if (cmdp == NULL)
	fprintf(f, "# Can't find %s\n", wrd);
      else
	writecmddef(&f, cmdp, false);
      putc('\n', f);
    }
  } while (*wrd != '\0');
  if (f != NULL)
    fclose(f);
  f = NULL;
  if (f != NULL)
    fclose(f);
}






/* Main command loop */


Void v_doexpansions(buf, level)
Char *buf;
long level;
{
  long i, i0, i1, i2, i3, icolon, icolon2, nest, pnest, count, fwid, ddig,
       fromval, toval, lenval;
  Char quotech, bquotech, opparen, clparen;
  boolean changed, nortrim;
  long flags[5];
  v_paramrec *pp;
  Char sbuf[256], res[256], rdef[256];
  long SET[5];
  Char STR1[20];
  Char STR2[256], *STR3, STR4[256];

  changed = false;
  i = 1;
  quotech = '\0';
  nortrim = false;
  while (i <= strlen(buf)) {
    if (buf[i - 1] == '\'' || buf[i - 1] == '"') {
      if (quotech == '\0')
	quotech = buf[i - 1];
      else if (buf[i - 1] == quotech)
	quotech = '\0';
    } else if (buf[i - 1] == '$' && quotech != '\'') {
      *sbuf = '\0';
      if (i == strlen(buf)) {
	if (level == 0) {
	  buf[i - 1] = '\0';
/* p2c: viewmod.text, line 6255:
 * Note: Modification of string length may translate incorrectly [146] */
	  nortrim = true;
	}
      } else if (buf[i] == '(' || buf[i] == '{') {
	opparen = buf[i];
	if (opparen == '(')
	  clparen = ')';
	else
	  clparen = '}';
	i0 = i + 2;
	count = 1;
	while (i0 <= strlen(buf) && buf[i0 - 1] == opparen) {
	  count++;
	  i0++;
	}
	i3 = i0;
	if (count > level) {
	  bquotech = '\0';
	  nest = 0;
	  pnest = 0;
	  icolon = -1;
	  icolon2 = -1;
	  P_expset(flags, 0L);
	  fwid = -1;
	  ddig = -1;
	  fromval = -1;
	  toval = -1;
	  lenval = -1;
	  while (i3 <= strlen(buf) &&
		 (buf[i3 - 1] != clparen || nest > 0 || bquotech != '\0')) {
	    if (bquotech != '\0') {
	      if (buf[i3 - 1] == bquotech)
		bquotech = '\0';
	    } else if (buf[i3 - 1] == '\'' || buf[i3 - 1] == '"')
	      bquotech = buf[i3 - 1];
	    else if (buf[i3 - 1] == opparen)
	      nest++;
	    else if (buf[i3 - 1] == clparen)
	      nest--;
	    else if (buf[i3 - 1] == '[' || buf[i3 - 1] == '{' ||
		     buf[i3 - 1] == '(')
	      pnest++;
	    else if (buf[i3 - 1] == ']' || buf[i3 - 1] == '}' ||
		     buf[i3 - 1] == ')')
	      pnest--;
	    else if (buf[i3 - 1] == ':' && nest == 0 && pnest == 0) {
	      if (icolon < 0)
		icolon = i3;
	      else if (icolon2 < 0)
		icolon2 = i3;
	    }
	    i3++;
	  }
	  if (i3 > strlen(buf)) {
	    sprintf(STR1, "Missing %c character", clparen);
	    v_failmsg(STR1);
	  }
	  i2 = i3;
	  while (count > 1) {
	    i3++;
	    if (i3 > strlen(buf) || buf[i3 - 1] != clparen) {
	      if (opparen == '(')
		v_failmsg("Mismatched $(( )) marks");
	      else
		v_failmsg("Mismatched ${{ }} marks");
	    }
	    count--;
	  }
	  if (icolon >= 0) {
	    if (icolon2 < 0)
	      strpart(sbuf, buf, (int)(icolon + 1), (int)(i2 - 1));
	    else
	      strpart(sbuf, buf, (int)(icolon + 1), (int)(icolon2 - 1));
	    v_doexpansions(sbuf, level);
/* p2c: viewmod.text, line 6334:
 * Note: Null character at end of sprintf control string [148] */
	    strcpy(STR2, sbuf);
	    strcpy(sbuf, STR2);
	    i1 = 1;
	    while (sbuf[i1 - 1] == ' ' || sbuf[i1 - 1] == ',')
	      i1++;
	    while (sbuf[i1 - 1] != '\0') {
	      if (isdigit(sbuf[i1 - 1]) ||
		  ((sbuf[i1 - 1] == '-' || sbuf[i1 - 1] == '+') &&
		   isdigit(sbuf[i1]))) {
		count = strtol(sbuf + i1 - 1, &STR3, 10);
		i1 = STR3 - sbuf + 1;
	      } else
		count = -1;
	      switch (sbuf[i1 - 1]) {

	      case 'e':
	      case 'n':
	      case 'q':
	      case 't':
	      case 'u':
	      case 'l':
	      case 'p':
	      case 'v':
		P_addset(flags, sbuf[i1 - 1]);
		break;

	      case 'w':
		fwid = count;
		break;

	      case 'd':
		ddig = count;
		break;

	      case 'F':
		fromval = count;
		break;

	      case 'T':
		toval = count;
		break;

	      case 'L':
		lenval = count;
		break;

	      default:
		v_failmsg("Bad format character");
		break;
	      }
	      do {
		i1++;
	      } while (sbuf[i1 - 1] == ',' || sbuf[i1 - 1] == ' ');
	    }
	  }
	  if (icolon < 0)
	    strpart(sbuf, buf, (int)i0, (int)(i2 - 1));
	  else
	    strpart(sbuf, buf, (int)i0, (int)(icolon - 1));
	  if (icolon2 < 0)
	    *rdef = '\0';
	  else
	    strpart(rdef, buf, (int)(icolon2 + 1), (int)(i2 - 1));
	  strcpy(buf + i - 1, buf + i3);
	  v_doexpansions(sbuf, level);
	  if (*sbuf == '\0' || P_inset('v', flags))
	    strcpy(res, sbuf);
	  else if (opparen == '(' || P_inset('p', flags)) {
	    pp = v_findparam(sbuf);
	    if (pp != NULL) {
	      if (P_inset('n', flags))
		ma_strfmtreal(res, v_getrealparam(pp), fwid, ddig);
	      else
		v_getstrparam(res, pp);
	    } else if (P_inset('e', flags))
	      *res = '\0';
	    else {
	      sprintf(STR2, "No such parameter as %s", sbuf);
	      v_failmsg(STR2);
	    }
	  } else {
	    if (!v_parsefmtstr(sbuf, res, fwid, ddig)) {
	      if (P_inset('e', flags)) {
		v_clearerror();
		*res = '\0';
	      } else
		v_fail();
	    }
	  }
	  if (P_inset('t', flags) || P_inset('n', flags)) {
	    strcpy(STR2, strltrim(strrtrim(strcpy(STR4, res))));
	    strcpy(res, STR2);
	  }
	  if (P_inset('u', flags))
	    strupper(res, res);
	  if (P_inset('l', flags))
	    strlower(res, res);
	  if (P_inset('n', flags)) {
	    i1 = 1;
	    while (i1 <= strlen(res)) {
	      if (res[i1 - 1] == '+' || res[i1 - 1] == ' ')
		strcpy(res + i1 - 1, res + i1);
	      else {
		if (!(res[i1 - 1] == '.' || res[i1 - 1] == 'E' ||
		      res[i1 - 1] == 'e' || isdigit(res[i1 - 1])))
		  res[i1 - 1] = '_';
		i1++;
	      }
	    }
	    if (*res == '.')
	      sprintf(res, "0%s", strcpy(STR2, res));
	  }
	  if (fromval >= 0) {
	    if (toval >= 0)
	      strcpy(res, strpart(STR2, res, (int)fromval, (int)toval));
	    else if (lenval >= 0)
	      strcpy(res, strsub(STR2, res, (int)fromval, (int)lenval));
	    else {
	      strcpy(STR2, res + fromval - 1);
	      strcpy(res, STR2);
	    }
	  } else if (toval >= 0)
	    sprintf(res, "%.*s", (int)toval, strcpy(STR2, res));
	  else if (lenval >= 0)
	    sprintf(res, "%.*s", (int)lenval, strcpy(STR2, res));
	  if (*res == '\0' && *rdef != '\0') {
	    v_doexpansions(rdef, level);
	    strcpy(res, rdef);
	  } else if (P_inset('q', flags)) {
	    i1 = strposc(res, '\'', 1L);
	    if (i1 == 0) {
	      sprintf(res, "'%s", strcpy(STR2, res));
	      strcat(res, "'");
	    } else if (strposc(res, '"', 1L) == 0 &&
		       strposc(res, '$', 1L) == 0) {
	      sprintf(res, "\"%s", strcpy(STR2, res));
	      strcat(res, "\"");
	    } else {
	      while (i1 > 0) {
		sprintf(STR2, "'%s", res + i1 - 1);
		strcpy(res + i1 - 1, STR2);
		i1 = strposc(res, '\'', i1 + 2);
	      }
	      sprintf(res, "'%s", strcpy(STR2, res));
	      strcat(res, "'");
	    }
	  }
	  sprintf(STR2, "%s%s", res, buf + i - 1);
	  strcpy(buf + i - 1, STR2);
	  i += strlen(res) - 1;
	  changed = true;
	}
      } else if (P_inset(buf[i], v_nedesc.startident)) {
	if (level == 0) {
	  i3 = i + 1;
	  while (i3 <= strlen(buf) && P_inset(buf[i3 - 1], v_nedesc.ident) &&
		 buf[i3 - 1] != '#')
	    i3++;
	  strpart(sbuf, buf, (int)(i + 1), (int)(i3 - 1));
	  strcpy(buf + i - 1, buf + i3 - 1);
	  if (!v_parsestr(sbuf, res))
	    v_fail();
	  sprintf(STR2, "%s%s", res, buf + i - 1);
	  strcpy(buf + i - 1, STR2);
	  i += strlen(res) - 1;
	  changed = true;
	}
      } else {
	if (level == 0)   /*let i increment past char*/
	  strcpy(buf + i - 1, buf + i);
	else
	  i++;
	/*increment i past char*/
      }
    }
    i++;
  }
  if (*buf == ' ') {
    strcpy(STR2, strltrim(buf));
    strcpy(buf, STR2);
  }
  if (!nortrim && strends(buf, " "))
    strcpy(buf, strrtrim(strcpy(STR2, buf)));
  if (changed && v_p_trace->val.U1.i1 >= 1) {
    sprintf(STR2, "Transformed to: %s", buf);
    v_logwriteln(STR2);
  }

  /*quote a single character*/
}


typedef long intarr[];


Local Void interrmsg(buf_)
Char *buf_;
{
  Char buf[256];

  strcpy(buf, buf_);
  if (excp_line != -1)
    sprintf(buf + strlen(buf), " [line %ld]", (long)excp_line);
  v_errormsg(buf, false);
}

Local boolean trycommand(cmdp, pp, buf)
cmdrec *cmdp;
procrec *pp;
Char *buf;
{
  long *argfirst, *arglast;
  long num, i, ipunc, j, blen, llen, nnext, nestlev;
  boolean okay, done, spaceterm;
  Char quotech, kind, knext;
  Char uwrd[256], term[256], nestings[256];
  na_strlist *body, *l1, *l2;
  Char STR1[256];

  na_alloc((Anyptr)&argfirst, pp->nargs * sizeof(long));
  na_alloc((Anyptr)&arglast, pp->nargs * sizeof(long));
  okay = true;
  num = 0;
  i = 1;
  blen = strlen(buf);
  l1 = pp->args;
  while (l1 != NULL && okay) {
    llen = strlen(l1->s);
    kind = l1->kind;
    l2 = l1->next;
    if (l2 == NULL)
      knext = ' ';
    else
      knext = l2->kind;
    switch (kind) {

    case argk_punc:
      if (i + llen - 1 > blen)
	okay = false;
      else {
	for (j = 1; j <= llen; j++) {
	  if (buf[i + j - 2] != l1->s[j - 1])
	    okay = false;
	}
      }
      i += llen;
      break;

    case argk_word:
      if (i + llen - 1 > blen ||
	  i + llen <= blen && P_inset(buf[i + llen - 1], v_nedesc.ident))
	okay = false;
      else {
	for (j = 1; j <= llen; j++) {
	  if (buf[i + j - 2] != l1->s[j - 1] &&
	      toupper(buf[i + j - 2]) != l1->s[j - 1])
	    okay = false;
	}
      }
      i += llen;
      break;

    case argk_wvar:
    case argk_var:
      num++;
      argfirst[num - 1] = i;
      if (i > blen)
	okay = false;
      else {
	if (knext == argk_var && l2->next != NULL) {
	  spaceterm = true;
	  l2 = l2->next;
	  knext = l2->kind;
	} else
	  spaceterm = false;
	switch (knext) {

	case argk_punc:
	  strcpy(term, l1->next->s);
	  nnext = ((short *)(&l1->next->value))[0];
	  break;

	case argk_word:
	  strcpy(term, l1->next->s);
	  nnext = 0;
	  break;

	default:
	  spaceterm = true;
	  strcpy(term, " ");
	  nnext = 0;
	  break;
	}
	*uwrd = '\0';
	*nestings = '\0';
	nestlev = 0;
	quotech = '\0';
	ipunc = LONG_MAX;
	done = false;
	while (i <= blen && okay && !done) {
	  nestlev = strlen(nestings);
	  sprintf(uwrd + strlen(uwrd), "%c", toupper(buf[i - 1]));
	  if (quotech != '\0') {
	    if (buf[i - 1] == quotech)
	      quotech = '\0';
	  } else if (buf[i - 1] == '\'' || buf[i - 1] == '"')
	    quotech = buf[i - 1];
	  else if (buf[i - 1] == '(') {
	    strcat(nestings, ")");
	    nestlev++;
	  } else if (buf[i - 1] == '[') {
	    strcat(nestings, "]");
	    nestlev++;
	  } else if (buf[i - 1] == '{') {
	    strcat(nestings, "}");
	    nestlev++;
	  } else if (buf[i - 1] == '}' || buf[i - 1] == ']' ||
		     buf[i - 1] == ')') {
	    if (nestlev > 0) {
	      if (kind == argk_word &&
		  nestings[strlen(nestings) - 1] != buf[i - 1])
		okay = false;
	      else
		nestings[strlen(nestings) - 1] = '\0';
	    } else if (ipunc == LONG_MAX)
	      ipunc = i;
	  } else if (*nestings == '\0' &&
		     (buf[i - 1] == ']' || buf[i - 1] == '[' ||
		      buf[i - 1] == '@' || buf[i - 1] == '=' ||
		      buf[i - 1] == ';' || buf[i - 1] == ':' ||
		      buf[i - 1] == ',' || buf[i - 1] == ' ') &&
		     ipunc == LONG_MAX)
	    ipunc = i;
	  i++;
	  if (quotech != '\0') {
	    done = false;
	    continue;
	  }
	  if (spaceterm && (uwrd[strlen(uwrd) - 1] == ',' ||
			    uwrd[strlen(uwrd) - 1] == ' ') &&
	      *nestings == '\0') {
	    done = true;
	    i--;
	    continue;
	  }
	  if (nestlev != nnext) {
	    done = false;
	    continue;
	  }
	  if (!strends(uwrd, term)) {
	    done = false;
	    continue;
	  }
	  if (knext != argk_word) {
	    done = true;
	    i -= strlen(term);
	    continue;
	  }
	  if (strlen(uwrd) <= strlen(term) &&
	      P_inset(uwrd[strlen(uwrd) - strlen(term) - 1], v_nedesc.ident))
	    done = false;
	  else if (i <= blen && P_inset(buf[i - 1], v_nedesc.ident))
	    done = false;
	  else {
	    done = true;
	    i -= strlen(term);
	  }
	}
	if (okay && !done &&
	    (i <= blen || strcmp(term, " ") || *nestings != '\0' ||
	     quotech != '\0'))
	      /*special case of last word on line*/
		okay = false;
	if (okay) {
	  j = i - 1;
	  while (j >= argfirst[num - 1] && buf[j - 1] == ' ')
	    j--;
	  if (j >= argfirst[num - 1] && buf[j - 1] == ',' && spaceterm) {
	    j--;
	    while (j >= argfirst[num - 1] && buf[j - 1] == ' ')
	      j--;
	  }
	}
	if (okay) {
	  if (kind == argk_wvar && (ipunc <= j || j < argfirst[num - 1]))
	    okay = false;   /*no punc chars, and non-blank*/
	  else
	    arglast[num - 1] = j;
	}
      }
      break;

    case argk_rest:
      num++;
      argfirst[num - 1] = i;
      arglast[num - 1] = blen;
      i = blen + 1;
      break;
    }
    if (okay) {
      while (i <= blen && buf[i - 1] == ' ')
	i++;
      if (i <= blen && buf[i - 1] == ',' && kind == argk_wvar &&
	  (knext == argk_rest || knext == argk_wvar || knext == argk_var ||
	   knext == ' ')) {
	i++;
	while (i <= blen && buf[i - 1] == ' ')
	  i++;
      }
    }
    l1 = l1->next;
  }
  if (i <= blen)
    okay = false;
  if (!okay)
    {
      na_free((Anyptr)&argfirst);
      na_free((Anyptr)&arglast);
      return okay;
    }
  if (pp->blockend != NULL)
    v_scanbody(&body, cmdp->name, pp->blockend);
  v_eof();   /* optimize tail recursion */
  pushinput();
  instack->kind = fr_proc;
  instack->UU.U2.procname = cmdp;
  instack->UU.U2.procproc = pp;
  instack->curline = pp->start;
  instack->UU.U2.loccurves = NULL;
  instack->UU.U2.locdefs = NULL;
  instack->UU.U2.locparams = NULL;
  i = 1;
  l1 = pp->args;
  while (l1 != NULL) {
    if (l1->kind == argk_rest || l1->kind == argk_wvar || l1->kind == argk_var) {
      v_addlocalcurve(l1->s);
      v_assigncurvestr(strpart(STR1, buf, (int)argfirst[i - 1],
			       (int)arglast[i - 1]), l1->s);
      i++;
    }
    l1 = l1->next;
  }
  if (pp->blockend != NULL) {
    sprintf(STR1, "%sbody", cmdp->name);
    v_addlocaldef(STR1);
    sprintf(STR1, "%sbody", cmdp->name);
    v_definebefore(STR1, "", body);
  }
  na_free((Anyptr)&argfirst);
  na_free((Anyptr)&arglast);
  return okay;
}



Static boolean docommand(buf)
Char *buf;
{
  boolean Result;
  Char wrd[256], lwrd[256];
  cmdrec *cmdp;
  procrec *pp;
  long i;
  boolean flag, builtincmd;
  Char *savecmdname;
  framerec *saveerrorframe;
  Char STR1[256];
  Char STR2[256];

  savecmdname = v_cmdname;
  saveerrorframe = errorframe;
  v_clearerror();
  TRY(try19);
    v_doexpansions(buf, 0L);
    if (*buf != '\0')
      v_loginput(buf);
    if (*buf == '!') {
      strcpy(buf, buf + 1);
      v_shellescape(buf, "");
      v_halt();
    }
    if (*buf == '?') {
      strcpy(buf, buf + 1);
      strcpy(STR1, strltrim(buf));
      strcpy(buf, STR1);
      v_givehelp(buf);
      v_halt();
    }
    v_strword(buf, wrd);
    if (*wrd != '\0') {
      builtincmd = false;
      do {
	flag = false;
	if (strcicmp(wrd, "builtin") == 0) {
	  builtincmd = true;
	  v_strword(buf, wrd);
	} else
	  flag = true;
      } while (!flag);
      strlower(lwrd, wrd);
      cmdp = findcmd(lwrd, false);
      if ((cmdp == NULL || !cmdp->isctrl) && *buf == '=') {
	sprintf(buf, "%s%s", wrd, strcpy(STR1, buf));
	strcpy(wrd, "let");
	strcpy(lwrd, wrd);
	cmdp = findcmd(lwrd, false);
      }
      if (cmdp == NULL || cmdp->alias != NULL) {
	reevalabbrevs(true);
	cmdp = findcmd(wrd, true);
      }
      if (cmdp == NULL)
	cantfindcmd(wrd);
      v_cmdname = cmdp->name;
      if (!builtincmd) {
	pp = cmdp->procbase;   /*look for definitions*/
	while (pp != NULL && !trycommand(cmdp, pp, buf))
	  pp = pp->next;
      } else
	pp = NULL;
      if (pp == NULL) {   /*do a built-in command*/
	if (cmdp->proc.link != NULL)
	  (*(Void(*) PP((Char *buf, Anyptr _link)))cmdp->proc.proc)(buf,
	    cmdp->proc.link);
	else
	  (*(Void(*) PP((Char *buf)))cmdp->proc.proc)(buf);
      }
    }
    v_cmdname = savecmdname;
    errorframe = saveerrorframe;
    Result = true;
  RECOVER(try19);
    v_cmdname = savecmdname;
    errorframe = saveerrorframe;
    Result = (P_escapecode == 0);
    switch (P_escapecode) {

    case -1:
    case 0:
      /* blank case */
      break;

    case -2:
      interrmsg("Out of memory");
      break;

    case -3:
      interrmsg("Reference to NIL pointer");
      break;

    case -4:
      interrmsg("Integer overflow");
      break;

    case -5:
      interrmsg("Divide by zero");
      break;

    case -6:
      interrmsg("Arithmetic overflow");
      break;

    case -7:
      interrmsg("Arithmetic underflow");
      break;

    case -8:
      interrmsg("Value range error");
      break;

    case -9:
      interrmsg("CASE value range error");
      break;

    case -10:
      misc_getioerrmsg(buf, P_ioresult);
      interrmsg(buf);
      break;

    case -11:
      interrmsg("CPU bus error");
      break;

    case -12:
      interrmsg("CPU access to odd address");
      break;

    case -20:
      interrmsg("[STOP]");
      break;

    default:
      i = P_escapecode;
      misc_printerror((long)P_escapecode, P_ioresult);
      sprintf(STR2, "Escape code = %ld", i);
      interrmsg(STR2);
      break;
    }
  ENDTRY(try19);
  return Result;
}  /*docommand*/



Static boolean doinputstream(prompt, session)
Char *prompt;
boolean session;
{
  Char buf[256];
  boolean flag;
  long hhandle, curpopstamp;
  framerec *fp;
  long saveesc, saveior;

  hhandle = v_holdinput();
  curpopstamp = -1;
  TRY(try20);
    flag = true;
    while (flag && !v_eof() && !v_exitflag) {
      if (popstamp != curpopstamp && hhandle != 0)
      {  /*may have been popped out from under us*/
	fp = instack;
	while (fp != NULL && fp->stamp != hhandle)
	  fp = fp->next;
	if (fp == NULL)
	  v_halt();
	curpopstamp = popstamp;
      }
      if (v_checktakeover())
	continue;
      v_readln(prompt, buf);
      errorframe = instack;
      if (docommand(buf) || v_recover())
	continue;
      if (!session) {
	flag = false;
	break;
      }
      v_writeerror();
      v_poptohold(hhandle);
      v_poptopcontrols();
    }
  RECOVER(try20);
    saveesc = P_escapecode;
    saveior = P_ioresult;
    v_unholdinput(hhandle);
    P_ioresult = saveior;
    _Escape((int)saveesc);
  ENDTRY(try20);
  v_unholdinput(hhandle);
  return flag;
}



boolean v_doinputstream(prompt)
Char *prompt;
{
  return (doinputstream(prompt, false));
}


Void v_doinputsession(prompt)
Char *prompt;
{
  doinputstream(prompt, true);
}



Static Void deftakeoveraction()
{
  takeoverflag = true;
}



Void v_takeover()
{
  takeoverflag = false;
  nc_setGraphics(false);
  printf("Type QUIT to continue original program, ABORT to abort.\n");
  v_pushinput_stdin();
  v_doinputsession("view_break> ");
}


boolean v_checktakeover()
{
  boolean Result;

  Result = takeoverflag;
  if (takeoverflag)
    v_takeover();
  return Result;
}


boolean v_peektakeover()
{
  return takeoverflag;
}



boolean v_docommand(buf_)
Char *buf_;
{
  Char buf[256], buf2[256];
  na_strlist *last;

  strcpy(buf, buf_);
  pushinput();
  instack->kind = fr_do;
  instack->UU.dstart = NULL;
  last = NULL;
  *buf2 = '\0';
  splitinput(buf2, buf, &instack->UU.dstart, &last, 0L);
  *buf = '\0';
  splitinput(buf2, buf, &instack->UU.dstart, &last, 0L);
  if (instack->UU.dstart == NULL) {
    v_popinput();
    return true;
  } else {
    instack->curline = instack->UU.dstart;
    return (v_doinputstream("view_do> "));
  }
}


boolean v_sourcefile(fn, trylib)
Char *fn;
boolean trylib;
{
  return (v_pushinput_file(fn, trylib) && v_doinputstream(v_viewprompt));
}







/* Initialization */




Void v_inittools(list)
void (**list)();
{
  while (*list)
    (**(list++))();
}






Static boolean ispermed(fn)
Char *fn;
{
  Char vname[256], path[256], fname[256], STR1[256];

  fs_fstripname(fn, vname, path, fname);
  return (newci_findprogram(strupper(STR1, fname)));
}


/* Local variables for v_use: */
struct LOC_v_use {
  boolean hadcode, flag;
  long result;
} ;

Local Void usecode(buf, LINK)
Char *buf;
struct LOC_v_use *LINK;
{
  if (LINK->result < 0)
    LINK->result = 1;
  LINK->hadcode = true;
  markuser();
/* p2c: viewmod.text, line 7152:
 * Warning: Symbol 'MARKUSER' is not defined [221] */
  newci_loadprogram(buf);
  newci_markuserflag = false;
           plot_initfonts();
}

Local Void useview(buf, LINK)
Char *buf;
struct LOC_v_use *LINK;
{
  if (LINK->result < 0)
    LINK->result = 1;
  LINK->flag = (LINK->flag && v_sourcefile(buf, false));
}



long v_use(fname, tname_)
Char *fname, *tname_;
{
  struct LOC_v_use V;
  long Result;
  Char tname[256];
  na_strlist *l1, *savecurtoolname, *toolsl;
  Char cfname[256], vfname[256];
  boolean cexists, vexists;
  long i;
  Char STR1[256], STR2[256];

  strcpy(tname, tname_);
  savecurtoolname = curtoolname;
  TRY(try21);
    v_clearerror();
    strupper(tname, tname);
    V.flag = true;
    V.result = -1;
    if (*tname == '\0' || strlist_cifind(tools, tname) == NULL) {
      if (*fname != '\0') {
	V.hadcode = false;
	if (strlist_cifind(toolfiles, fname) == NULL) {
	  strcpy(cfname, fname);
	  newci_fixfname(cfname, "code", "");
	  if (!strends(strupper(STR1, cfname), ".CODE"))
	    *cfname = '\0';
	  strcpy(vfname, fname);
	  newci_fixfname(vfname, "view", "");
	  cexists = (*cfname != '\0' &&
		     (ispermed(cfname) || access(cfname, F_OK) == 0));
	  vexists = (access(vfname, F_OK) == 0);
	  toolsl = NULL;
	  l1 = strlist_append(&toolsl, strupper(STR1, fname));
	  if (cexists)
	    toolsl->kind = '\001';
	  else
	    toolsl->kind = '\002';
	  curtoolname = toolsl;
	  V.flag = false;
	  if (cexists || vexists) {
	    V.flag = true;
	    if (cexists && !ispermed(cfname))
	      usecode(cfname, &V);
	    if (vexists)
	      useview(vfname, &V);
	  } else if (*cfname != '/' && *cfname != '~') {
	    sprintf(STR1, "%s/%s", v_libdir, vfname);
	    vexists = (access(STR1, F_OK) == 0);
	    cexists = (*cfname != '\0' &&
		       access((sprintf(STR1, "%s/%s", v_libdir, cfname), STR1),
			      F_OK) == 0);
	    if (cexists || vexists) {
	      if (cexists)
		toolsl->kind = '\001';
	      V.flag = true;
	      if (cexists) {
		sprintf(STR1, "%s/%s", v_libdir, cfname);
		usecode(STR1, &V);
	      }
	      if (vexists) {
		sprintf(STR1, "%s/%s", v_libdir, vfname);
		useview(STR1, &V);
	      }
	    }
	  }
	  if (V.flag) {
	    toolsl->next = toolfiles;
	    toolfiles = toolsl;
	  }
	}
      } else {
	V.hadcode = true;
	v_inittools(curves_tool_list);
	v_inittools(tool_list_1);
	v_inittools(tool_list_2);
	v_inittools(tool_list_3);
	v_inittools(tool_list_4);
	v_inittools(tool_list_5);
	v_inittools(tool_list_6);
	v_inittools(tool_list_7);
	v_inittools(tool_list_8);
	v_inittools(tool_list_9);
	v_inittools(tool_list_10);
	v_inittools(tool_list_11);
	v_inittools(tool_list_12);
	v_inittools(tool_list_13);
	v_inittools(tool_list_14);
	v_inittools(tool_list_15);
	v_inittools(tool_list_16);
	v_inittools(tool_list_17);
	v_inittools(tool_list_18);
	v_inittools(tool_list_19);
	v_inittools(tool_list_20);
	
      }
    }
    curtoolname = savecurtoolname;
    if (V.flag && (*tname == '\0' || strlist_cifind(tools, tname) != NULL))
      Result = V.result;
    else
      Result = 0;
  RECOVER(try21);
    i = P_escapecode;
    curtoolname = savecurtoolname;
    if (i < 100 || i >= 130)
      _Escape((int)i);
    switch (i) {

    case 112:
      sprintf(STR1, "Not enough memory to load %s", cfname);
      v_failmsg(STR1);
      break;

    case 116:
      sprintf(STR1, "%s is not a codefile", cfname);
      v_failmsg(STR1);
      break;

    case 117:
      sprintf(STR1, "Not enough global space to load %s", cfname);
      v_failmsg(STR1);
      break;

    case 123:
      sprintf(STR1, "Unresolved external references in %s", cfname);
      v_failmsg(STR1);
      break;

    default:
      sprintf(STR2, "Error [%ld] loading %s", i, cfname);
      v_failmsg(STR2);
      break;
    }
  ENDTRY(try21);
  return Result;
}



Static Void nullclosehook()
{
}


Static Void nullpreshellescape()
{
}


Static Void nullpostshellescape()
{
}


Static Void logfilechproc(pp, val)
v_paramrec *pp;
Char *val;
{
  if (logopen) {
    if (logfile != NULL)
      fclose(logfile);
    logfile = NULL;
  }
  logopen = false;
  if (v_paramfnkind->chproc.link != NULL)
    (*(Void(*) PP((v_paramrec *pp, Char *val, Anyptr _link)))
      v_paramfnkind->chproc.proc)(pp, val, v_paramfnkind->chproc.link);
  else
    (*(Void(*) PP((v_paramrec *pp, Char *val)))v_paramfnkind->chproc.proc)(pp,
      val);
}


Static Void ramnchproc(pp, r)
v_paramrec *pp;
double *r;
{
  v_failmsg("Can't change this parameter");
}


Static Void ramfmtproc(pp, val)
v_paramrec *pp;
Char *val;
{
  sprintf(val, "%ld", v_memavail());
}


Static Void ramnfmtproc(pp, r)
v_paramrec *pp;
double *r;
{
  *r = v_memavail();
}


Void v_initialize(logfname, quiet)
Char *logfname;
boolean quiet;
{
  Char logfn[256];
  v_paramkindrec *pk;
  v_paramrec *pp;
  long i, dot;
  na_strlist *l1;
  Char ch;
  Char STR1[256];
  long SET[3];
  Char STR2[256];
  Char username[L_cuserid];

  v_exitflag = false;
  v_initdone = false;
  curtoolname = NULL;
  l1 = strlist_append(&curtoolname, "*");
  v_timestamp = 0;
  logopen = false;
  logfirst = true;
  v_parambase = NULL;
  initparamkinds();
  v_addrealparam("epsilon", &v_p_epsilon, 1e-5);
  v_addintparam("seed", &v_p_seed, 0L);
  v_addstrparam("errormsg", &v_p_errormsg, "");
  v_addstrparam("errorstr", &v_p_errorstr, "");
  v_addboolparam("debug", &v_p_debug, false);
  v_addintparam("trace", &v_p_trace, 0L);
  v_addboolparam("quiet", &v_p_quiet, quiet);
  v_addboolparam("novice", &v_p_novice, false);
  v_deriveparamkind(&pk, v_paramfnkind);
  pk->chproc.proc = (Anyptr)logfilechproc;
  pk->chproc.link = (Anyptr)NULL;
  v_addparam("logfile", &v_p_logfile, pk);
  *(Char **)((Char **)(&v_p_logfile->val.U99.l2)) = strdup("LOG");
  v_setstrparam(v_p_logfile, "");
  v_addrostrparam("version", &pp, v_version);
  v_addrostrparam("machine", &pp, strupper(STR1, "UiO"));
  cuserid(username);
  v_addrostrparam("user", &pp, (char *) username);
  v_deriveparamkind(&pk, v_paramintkind);
  pk->nchproc.proc = (Anyptr)ramnchproc;
  pk->nchproc.link = (Anyptr)NULL;
  pk->fmtproc.proc = (Anyptr)ramfmtproc;
  pk->fmtproc.link = (Anyptr)NULL;
  pk->nfmtproc.proc = (Anyptr)ramnfmtproc;
  pk->nfmtproc.link = (Anyptr)NULL;
  pk->helpstr = strdup("This is a read-only parameter");
  v_addparam("ram", &v_p_ram, pk);
  ma_initrandom(&v_randseed);
  v_lasterrormsg = (Char *)Malloc(256);
  *v_lasterrormsg = '\0';
  v_lasterrorstr = (Char *)Malloc(256);
  *v_lasterrorstr = '\0';
  v_preshellescape.proc = (Anyptr)nullpreshellescape;
  v_preshellescape.link = (Anyptr)NULL;
  v_postshellescape.proc = (Anyptr)nullpostshellescape;
  v_postshellescape.link = (Anyptr)NULL;
  v_takeoveraction.proc = (Anyptr)deftakeoveraction;
  v_takeoveraction.link = (Anyptr)NULL;
  takeoverflag = false;
  infiles = NULL;
  instamp = 0;
  popstamp = -1;
  instack = NULL;
  errorframe = NULL;
  v_ctrlstack = NULL;
  readnesting = 0;
  v_basebase = NULL;
  v_curvebase = NULL;
  v_curvelast = NULL;
  for (ch = '@'; ch <= 'Z'; ch++)
    v_curvetree[ch - '@'] = NULL;
  *ck_cachestr = '\0';
  funcbase = NULL;
  v_history = NULL;
  v_histlast = NULL;
  needresetstdin = false;
  baseval = 0.0;
  v_unitbase = NULL;
  v_closefileshook.proc = (Anyptr)nullclosehook;
  v_closefileshook.link = (Anyptr)NULL;
  l1 = strlist_append(&v_unitbase, "10");
  l1->value = (na_long)1;
  v_unitcount = 2;
  v_unitalias = NULL;
  /*$if false$
      strlist_add(v_unitalias, l1, '1');
      strnew(l1^.value.sp, ne_unitzero);
$end$*/
  v_tempxvec = NULL;
  v_tempyvec = NULL;
  tempveclen = 0;
  v_rechars = (Char *)Malloc(256);
  strcpy(v_rechars, re_shellchars);
  for (i = 0; i <= 2; i++) {
    v_alimited[i] = false;
    v_alog[i] = false;
    v_anotation[i] = 0;
    v_amax[i] = 0.0;
    v_amin[i] = 0.0;
  }
  for (i = 0; i <= v_maxstyle; i++) {
    v_lstyle[i] = 0;
    v_pstyle[i] = -1;
  }
  v_lstyle[1] = 2;
  v_pstyle[1] = -1;
  v_arithidx = 0;
  v_arithbase = NULL;
  ne_init(&v_nedesc);
  P_addset(v_nedesc.ident, '.');
  P_addset(v_nedesc.ident, '#');
  v_nedesc.casesens = true;
  v_nedesc.builtin = false;
  v_nedesc.symproc.proc = (Anyptr)viewsymproc;
  v_nedesc.symproc.link = (Anyptr)NULL;
  funchelp = NULL;
  curvesymtab = NULL;
  suffixsymtab = NULL;
  funcsymtab = NULL;
  v_argsymtab = NULL;
  buildsymtab();
        plot_initfonts();
  savetuflag = ma_trapuf(false);
  printedmemavail = LONG_MAX;
  maxmemchunk = 1000;
  cmdbase = NULL;
  numcmds = 0;
  maxcmdname = 1;
  addedcmd = NULL;
  prevaddedcmd = NULL;
  addedfunc = NULL;
  prevaddedfunc = NULL;
  addedproc = NULL;
  v_cmdid = NULL;
  v_cmdname = NULL;
  abbrevsokay = false;
  shorthelp = NULL;
  seealso = NULL;
  v_interpolators = NULL;
  addedinterp = NULL;
  tools = NULL;
  toolfiles = NULL;
  *logfn = '\0';
  if (*logfname != '\0') {
    i = 0;
    dot = strposb(logfname, ".", 255L);
    if (dot < strposb(logfname, "/", 255L))
      dot = 0;
    do {
      strcpy(logfn, logfname);
      if (i > 0) {
	sprintf(STR2, "%ld%s", i, logfn + dot - 1);
	strcpy(logfn + dot - 1, STR2);
      }
      if (access(logfn, F_OK) == 0) {
	TRY(try22);
	  if (logfile != NULL)
	    logfile = freopen(logfn, "r", logfile);
	  else
	    logfile = fopen(logfn, "r");
	  if (logfile == NULL) {
	    P_escapecode = -10;
	    P_ioresult = FileNotFound;
	    goto _Ltry22;
	  }
	  if (logfile != NULL) {
	    /*try exclusive access*/
	    fclose(logfile);
	  }
	  logfile = NULL;
	RECOVER2(try22,_Ltry22);
	  if (P_escapecode != -10)
	    _Escape(P_escapecode);
	  *logfn = '\0';
	  i++;
	ENDTRY(try22);
      }
    } while (*logfn == '\0' && i <= 10 && dot != 0);
    if (v_p_quiet->val.U1.i1 == 0) {
      if (*logfn == '\0')
	printf("[Unable to write log file]\n");
      else if (i > 0)
	printf("[Writing to log file %s]\n", logfn);
    }
  }
  v_setstrparam(v_p_logfile, logfn);
  builtinflag = true;
     v_inittools(builtin_tool_list);
  builtinflag = false;
  v_inittools(curves_tool_list);
  v_inittools(tool_list_1);
  v_inittools(tool_list_2);
  v_inittools(tool_list_3);
  v_inittools(tool_list_4);
  v_inittools(tool_list_5);
  v_inittools(tool_list_6);
  v_inittools(tool_list_7);
  v_inittools(tool_list_8);
  v_inittools(tool_list_9);
  v_inittools(tool_list_10);
  v_inittools(tool_list_11);
  v_inittools(tool_list_12);
  v_inittools(tool_list_13);
  v_inittools(tool_list_14);
  v_inittools(tool_list_15);
  v_inittools(tool_list_16);
  v_inittools(tool_list_17);
  v_inittools(tool_list_18);
  v_inittools(tool_list_19);
  v_inittools(tool_list_20);
  curtoolname = NULL;
  reevalabbrevs(false);
}


Void v_cleanup()
{
  na_strlist *l1;
  _PROCEDURE proc;
  Char STR1[256];

  l1 = tools;
  while (l1 != NULL) {
    sprintf(STR1, "%s%s", (Char *)l1->value, v_exitsuffix);
    if (newci_findprocedure(STR1, &proc)) {
      TRY(try23);
	if (proc.link != NULL)
	  (*(Void(*) PP((Anyptr _link)))proc.proc)(proc.link);
	else
	  (*(Void(*) PV())proc.proc)();
      RECOVER(try23);
	if (P_escapecode == -20)
	  _Escape(P_escapecode);
      ENDTRY(try23);
    }
    l1 = l1->next;
  }
  ma_trapuf(savetuflag);
  v_closelog();
}




/*viewmod*/






/* End. */
