/*******************************************************************/
/*******************************************************************/
/*                                                                 */
/*            Analyseur syntactique pour la calculette             */
/*                                                                 */
/*                       copyright Babe Cool                       */
/*                                                                 */
/*******************************************************************/
/*******************************************************************/
/* $Id: anal.c,v 2.0.0.2 1997/12/14 20:11:49 karim Exp karim $ */
#include "genpari.h"
#include "anal.h"
#include "nf.h"

#define separe(c) ((c)==';' || (c)==':')
typedef GEN (*PFGEN)(ANYARG);

static GEN    constante(void);
static GEN    expr(void);
static GEN    facteur(void);
static GEN    identifier(void);
static GEN    matrix_block(GEN p, entree *ep);
static GEN    read_member(GEN x);
static GEN    seq(void);
static GEN    truc(void);
static long   number(long *nb);
static void   doskipseq(char *s, int strict);
static void   skipconstante(void);
static void   skipexpr(void);
static void   skipfacteur(void);
static void   skipidentifier(void);
static void   skipseq(void);
static void   skipstring(void);
static long   skiptruc(void);
static entree *entry(void);
static entree *installep(void *f,char *name,int l,int v,int add,entree **table);
static entree *skipentry(void);

/* last time we began parsing an object of specified type */
typedef struct gpmark
{
  char *identifier, *symbol, *raw, *member, *start;
} gpmark;

static char *redefine_fun = NULL, *analyseur;
static long analyseurtetpil, skipping_fun_def;
static entree *check_new_fun;
static gpmark mark;

/*  Special characters:
 *     ' ', '\t', '\n', '\\' are forbidden internally (suppressed by filtre).
 *     { } are forbidden everywhere and will be used to denote optional
 *     lexemes in the sequel.
 *
 *  Definitions: The sequence
 *  { a }* means any number (possibly 0) of object a.
 *  { x|y } means an optional x or y.
 *
 *  seq : only this one can be empty.
 *     sequence of { expr{ :|; } }*
 *
 *  expr :
 *     expression = sequence of "facteurs" separated by binary operators
 *     whose priority are:
 *      1: *, /, \, \/, %, >>, <<                (highest)
 *      2: +, -
 *      3: <, <=, >, >=, !=, ==, <>
 *      4: &, &&, |, ||                  (lowest)
 *     read from left to right.
 *
 *  facteur :
 *      Optionnal leading sign (meaningfull only when "facteur" is enclosed
 *      in parentheses), followed by a "truc", then by any succession of the
 *      following:
 *
 *        ~, _, ', !
 *  or    ^ facteur
 *  or    matrix_block
 *  or    .member      (see gp_member_list)
 *
 *  truc:
 *      identifier
 *  or  constante
 *  or  ! truc
 *  or  matrix_block (no_affect=1)
 *  or  (expr)
 *  or  %{ ` }*  or %number
 *
 *  identifier:
 *      entry ( { expr } { ,expr }* )
 *      The () are optional when arg list is void.
 *
 *  matrix_block :
 *      [ A { { ; }A }*] where A = { expr } { { , }{ expr } }*
 *      All A must share the same length.
 *      If (no_affect=0 || ep !=NULL): follows an optionnal "= expr"
 *   or ++, --, op= where op is one of the operators in expr 1: and 2:
 *
 *  entry :
 *      any succesion of alphanumeric characters, the first of which is not
 *      a digit.
 *
 *  constante:
 *      number { . } { number } { e|E } { +|- } { number }.
 *
 *  number:
 *      any non-negative integer.
 */
char*
_analyseur(void)
{
  return analyseur;
}

/* Do not affect (analyseur,analyseurtetpil,mark.start) */
static GEN
lisseq0(char *t, int do_seq)
{
  const long av = avma, oldtetpil = analyseurtetpil;
  char *olds = analyseur, *olde = mark.start;
  GEN x,res;

  if (foreignExprHandler && *t == foreignExprSwitch)
      return (*foreignExprHandler)(t);

  check_new_fun=NULL; skipping_fun_def=0;
  mark.start = analyseur = t; analyseurtetpil = avma;
  res = do_seq? seq(): expr();
  if (check_break_status(NOACTION,&x)) 
    { avma=av; res = gcopy(x); }
  else
    res = gerepile(av,analyseurtetpil,res);
  analyseur = olds; mark.start = olde; analyseurtetpil = oldtetpil;
  return res;
}

GEN
lisseq(char *t)
{
  return lisseq0(t,1);
}

GEN
lisexpr(char *t)
{
  return lisseq0(t,0);
}

/* filtered lisexpr = remove blanks and comments */
GEN
flisexpr(char *t)
{
  char *tmp = gpmalloc(1 + strlen(t));
  GEN x;

  strcpy(tmp,t); filtre(tmp,f_INIT);
  x = lisseq0(tmp,0); free(tmp);
  return x;
}

/* check syntax, then execute */
GEN
readseq(char *c, int strict)
{
  check_new_fun=NULL; skipping_fun_def=0;
  doskipseq(c, strict); return lisseq(c);
}

entree *
install(void *f, char *name, char *code)
{
  long hash;
  entree *ep = is_entry_intern(name, functions_hash, &hash);
  
  if (ep) err(talker,"function already exists in install");
  ep = installep(f, name, strlen(name), EpINSTALL, 0, functions_hash + hash);
  ep->code = strcpy((char*) gpmalloc(strlen(code)+1), code);
  return ep;
}

static void
free_args(GEN *x)
{
  GEN *y=x;

  for ( ; *x; x++) 
    if (isclone(*x)) killbloc(*x);
  free((void *)y);
}

void
freeep(entree *ep)
{
  if (foreignFuncFree && ep->code && (*ep->code == 'x'))
    (*foreignFuncFree)(ep); /* function created by foreign interpreter */

  if (EpSTATIC(ep)) return; /* gp function loaded at init time */
  if (ep->help) free(ep->help);
  if (ep->code) free(ep->code);
  if (ep->args) free_args((GEN*)ep->args);
  free(ep);
}

/*******************************************************************/
/*                                                                 */
/*                            VARIABLES                            */
/*                                                                 */
/*******************************************************************/

typedef struct var_cell {
  struct var_cell *prev;
  GEN value;
} var_cell;

/* push_val and pop_val are private functions for use in sumiter and bibli2: 
 * we want a temporary value for ep, which is NOT a clone, to avoid
 * unnecessary gaffect calls.
 *
 * Assumptions:
 *   EpVALENCE(ep) = EpVAR
 *   ep->args initilized to NULL in installep()
 */
void
push_val(entree *ep, GEN a)
{
  var_cell *v = (var_cell*) gpmalloc(sizeof(var_cell));
  v->value  = (GEN)ep->value;
  v->prev   = (var_cell*) ep->args;

  ep->args  = (void*) v;
  ep->value = a;
}

void
pop_val(entree *ep)
{
  var_cell *v = (var_cell*) ep->args;

  if (!v) err(bugparier,"pop_val (no value)");
  ep->value = v->value;
  ep->args  = (void*) v->prev;
  free((void*)v);
}

static void
changevalue(entree *ep, GEN val)
{
  GEN y = gclone(val), x = (GEN)ep->value;

  ep->value = (void *)y;
  if (x == (GEN) initial_value(ep) || !isclone(x))
  {
    y[-1] = (long)x; /* push new value */
    return;
  }
  y[-1] = x[-1]; /* save initial value */
  killbloc(x);   /* destroy intermediate one */
}

static void
newvalue(entree *ep, GEN val)
{
  GEN y = gclone(val);
  y[-1] = (long) ep->value;
  ep->value = (void *)y;
}

/* x is a bloc, and not the initial value of some variable (monomial of
 * degree 1). kill it
 */
void
kill_entree_object(entree *ep)
{
  GEN x = (GEN)ep->value;
  ep->value = (void *)x[-1]; /* restore previous value */
  killbloc(x);               /* kill current */
}

/* to kill a variable's value. For a function, call directly
 * kill_entree_object() above.
 */
static void
killvalue(entree *ep)
{
  GEN x = (GEN)ep->value;

  /* don't kill the corresponding monomial of degree one */
  if (x == (GEN) initial_value(ep)) return;

  /* kill temporary variable from sumiter */
  if (is_temp_value(ep,x))
  { 
    if (ep->args) pop_val(ep);
    return;
  }

  kill_entree_object(ep);
}

/* Kill entree ep. This means : free all memory it occupies, remove it from
 * hashtable. If it's a variable set a "black hole" in polx[v], etc.
 * x = 0-th variable can NOT be killed (just the value). That's because the 
 * PARI code is broken at many places (use explicitly polx[0]).
 */
void
kill0(entree *ep)
{
  long hash, v;
  entree *ep1;

  if (EpSTATIC(ep)) err(killer1,mark.symbol,mark.start);
  switch(EpVALENCE(ep))
  {
    case EpVAR:  
      killvalue(ep); v = varn(ep->value);
      if (!v) return; /* never kill x */
      polx[v] = polun[v] = gnil;
      polvar[v+1] = (long)gnil;
      varentries[v] = NULL; break;
    case EpUSER: kill_entree_object(ep); break;
  }

  hash = hashvalue(ep->name);
  if (functions_hash[hash] == ep)
  {
    functions_hash[hash] = ep->next;
    freeep(ep); return;
  }

  for (ep1 = functions_hash[hash]; ep1; ep1 = ep1->next)
    if (ep1->next == ep)
    {
      ep1->next = ep->next;
      freeep(ep); break;
    }
  return;
}

/*******************************************************************/
/*                                                                 */
/*                              PARSER                             */
/*                                                                 */
/*******************************************************************/

static GEN
seq(void)
{
  const long av=avma, lim=(av+bot)>>1, oldtetpil=analyseurtetpil;
  GEN res=gnil;

  check_break_status(DOCLEAR,NULL);
  for(;;)
  {
    while (separe(*analyseur)) analyseur++;
    if (!*analyseur || *analyseur == ')' || *analyseur == ',') return res;
    res = expr();
    if (check_break_status(NOACTION,NULL)) return NULL;
    if (!separe(*analyseur)) return res;
    if (low_stack(lim, (av+bot)>>1))
    {
      if(DEBUGMEM>1) err(warnmem,"seq");
      if (is_universal_constant(res))
	analyseurtetpil = avma = av;
      else
	{ res=gerepileupto(av,forcecopy(res)); analyseurtetpil = oldtetpil; }
    }
  }
}

static GEN
gshiftplus(GEN x, GEN n)  { return gshift(x, itos(n)); }

static GEN
gshiftminus(GEN x, GEN n) { return gshift(x,-itos(n)); }

static GEN
expr(void)
{
  PFGEN func[] = { NULL,NULL,NULL,NULL };
  long niveau = 3;
  GEN aux,e,e1,e2,e3;

  check_break_status(DOCLEAR,NULL);
  e1=e2=e3=NULL;
  for(;;)
    switch(niveau)
    {
      case 3: aux=facteur();
	if (check_break_status(NOACTION,NULL)) return NULL;
	if (func[3]) 
	{
	  analyseurtetpil = avma;
	  e3 = ((GEN (*)(GEN,GEN))func[3])(e3,aux);
	}
	else
	  e3=aux;
	switch(*analyseur)
	{
	  case '*': analyseur++; func[3] = (PFGEN)&gmul; break;
	  case '/': analyseur++; func[3] = (PFGEN)&gdiv; break;
	  case '\\': analyseur++;
	    if (*analyseur == '/') { analyseur++; func[3]=(PFGEN)&gdivround; }
	    else func[3] = (PFGEN)&gdivent;
	    break;
	  case '%': analyseur++; func[3] = (PFGEN)&gmod; break;

	  case '<': case '>':
	    if (analyseur[1]==*analyseur)
	    {
	      func[3] = (*analyseur == '<')? (PFGEN)&gshiftplus
	                                   : (PFGEN)&gshiftminus;
	      analyseur +=2; break;
	    }
	    /* fall through */
	  default: niveau--; func[3]=NULL;
	}
	break;
      case 2:
	if (!e3) { niveau++; break; }
	if (func[2])
	{
	  analyseurtetpil = avma;
	  e2 = ((GEN (*)(GEN,GEN))func[2])(e2,e3);
	}
	else
	  e2=e3;
	e3=NULL;
	switch(*analyseur)
	{
	  case '+': analyseur++; func[2]=(PFGEN)&gadd; niveau++; break;
	  case '-': analyseur++; func[2]=(PFGEN)&gsub; niveau++; break;
	  default: niveau--; func[2]=NULL;
	}
	break;
      case 1:
	if (!e2) { niveau++; break; }
	if (func[1])
	{
	  analyseurtetpil = avma;
	  e1 = ((GEN (*)(GEN,GEN))func[1])(e1,e2);
	}
	else
	  e1=e2;
	e2=NULL;
	switch(*analyseur)
	{
	  case '<': analyseur++;
	    switch(*analyseur)
	    {
	      case '=': analyseur++; func[1]=(PFGEN)&gle; break;
	      case '>': analyseur++; func[1]=(PFGEN)&gne; break;
	      default : func[1]=(PFGEN)&glt;
	    }
	    niveau++; break;
	  case '>': analyseur++;
	    if (*analyseur == '=') { analyseur++; func[1]=(PFGEN)&gge; }
	    else func[1]=(PFGEN)&ggt;
	    niveau++; break;
	  case '=':
	    if (analyseur[1] == '=')
	      { analyseur+=2; func[1]=(PFGEN)&geq; niveau++; }
	    break;
	  case '!':
	    if (analyseur[1] == '=')
	      { analyseur+=2; func[1]=(PFGEN)&gne; niveau++; }
	    break;
	  default: niveau--; func[1]=NULL;
	}
	break;
      case 0:
	if (!e1) { niveau++; break; }
	if (func[0])
	  e=gcmp0(e1) ? gzero: gun;
	else
	  e=e1;
	e1=NULL;
	switch(*analyseur)
	{
	  case '&':
	    if (*++analyseur == '&') analyseur++;
	    if (gcmp0(e)) { skipexpr(); return gzero; }
	    func[0]=(PFGEN)1; niveau++;
	    break;
	  case '|':
	    if (*++analyseur == '|') analyseur++;
	    if (!gcmp0(e)) { skipexpr(); return gun; }
	    func[0]=(PFGEN)1; niveau++;
	    break;
	  default: return e;
	}
    }
}

/********************************************************************/
/**                                                                **/
/**                        CHECK FUNCTIONS                         **/
/**                                                                **/
/********************************************************************/

/* if current identifier was a function in 1.39.15, raise "obsolete" error */
static void
err_new_fun()
{
  char *s = NULL, str[128], msg[128];

  if (check_new_fun)
  { 
    if (check_new_fun != NOT_CREATED_YET) 
    {
      s = strcpy(str,check_new_fun->name);
      kill0(check_new_fun);
    }
    check_new_fun=NULL;
  }
  if (compatible != NONE) return;

  if (!s) /* guess that the offending function was last identifier */
  { 
    char *v, *u = str, *lim = str + 127;
    v = s = mark.identifier;
    while (is_keyword_char(*v) && u < lim) *u++ = *v++;
    *u = 0;
  }
  if (! is_entry(s,funct_old_hash)) return;

  sprintf(msg,"obsolete function; see whatnow(%s):\n  ",str);
  err(talker2, msg, mark.identifier, mark.start);
}

static void
match(char c)
{
  if (*analyseur != c)
  {
    char str[64];

    if (check_new_fun && (c == '(' || c == '=' || c == ',')) err_new_fun();
    sprintf(str,"expected character: '%c'\n  ***   instead of: ",c);
    err(talker2,str,analyseur,mark.start);
  }
  analyseur++;
}

static long
readlong()
{
  long m;
  const long av = avma;
  const char *old = analyseur;
  const GEN arg = expr();

  if (did_break) err(breaker,"here (reading long)");
  if (typ(arg) != t_INT) err(caseer,old,mark.start);
  m = itos(arg); avma=av;
  return m;
}

static long
check_array_index(long max)
{
  const char *old = analyseur;
  const long c = readlong();

  if (c < 1 || c >= max) err(arrayer1,old,mark.start);
  return c;
}

static int
readvar()
{
  const char *old = analyseur;
  entree *ep;

  if (!isalpha(*analyseur)) err(varer1,old,mark.start); 
  ep = entry();
  if (EpVALENCE(ep) != EpVAR) err(varer1,old,mark.start);
  return varn(initial_value(ep));
}

/* allright !=0 means function was called without () */
static int
do_switch(int allright, int matchcomma)
{
  if (allright || !*analyseur || *analyseur == ')' || separe(*analyseur))
    return 1;
  if (*analyseur == ',') /* we just read an arg, or first arg */
  {
    if (!matchcomma && analyseur[-1] == '(') return 1; /* first arg */
    if (analyseur[1] == ',' || analyseur[1] == ')')
      { analyseur++; return 1; }
  }
  return 0;
}

/********************************************************************/
/**                                                                **/
/**                          READ FUNCTIONS                        **/
/**                                                                **/
/********************************************************************/

static GEN
facteur(void)
{
  const char *old = analyseur;
  GEN x,p1;
  int plus=1;

  switch(*analyseur)
  {
    case '+': analyseur++; break;
    case '-': plus=0; analyseur++; break;
  }
  x=truc();
  if (check_break_status(NOACTION,NULL))
    return NULL;

  for(;;)
    switch(*analyseur)
    {
      case '.':
	analyseur++; x = read_member(x); break;
      case '^':
	analyseur++; p1=facteur(); analyseurtetpil=avma;
        if (did_break) err(breaker,"here (after ^)");
	x=gpui(x,p1,prec); break;
      case '\'':
	analyseur++; analyseurtetpil=avma; x=deriv(x,gvar9(x)); break;
      case '~':
	analyseur++; analyseurtetpil=avma; x=gtrans(x); break;
      case '[':
        x=matrix_block(x,NULL); break;
      case '!':
	if (analyseur[1] != '=')
	{
	  if (typ(x) != t_INT) err(caseer,old,mark.start);
	  analyseur++; analyseurtetpil=avma;
	  x=mpfact(itos(x)); break;
	} /* Fall through */

      default:
        if (plus || x==gnil) return x;
	analyseurtetpil = avma; return gneg(x);
    }
}

static GEN
truc(void)
{
  long i,j, n=0, p=0, m=1, sizetab;
  GEN *table,p1;
  char *old;

  if (*analyseur == '!')
  {
    analyseur++; i = gcmp0(truc());
    if (did_break) err(breaker,"here (after !)");
    return i ? gun : gzero;
  }
  if (isalpha(*analyseur)) return identifier();

  analyseurtetpil = avma;
  if (*analyseur == '"') return strtoGEN(analyseur,-1);
  if (isdigit(*analyseur) || *analyseur == '.') return constante();
  switch(*analyseur++)
  {
    case '(': p1=expr(); match(')'); return p1;

    case '[':
      if (*analyseur == ';' && analyseur[1] == ']')
	{ analyseur+=2; return cgetg(1,t_MAT); }

      old=analyseur; analyseur--; sizetab=skiptruc(); analyseur=old;
      table = (GEN*) newbloc((sizetab+1)*sizeof(GEN));

      if (*analyseur != ']') table[++n]=expr();
      while (*analyseur == ',') { analyseur++; table[++n]=expr(); }
      if (did_break) err(breaker,"here (in array context)");
      switch (*analyseur++)
      {
	case ']':
	  analyseurtetpil = avma;
	  p1=cgetg(n+1,t_VEC);
	  for (i=1; i<=n; i++)
	    p1[i]=lcopy(table[i]);
	  break;

	case ';':
	  m = n;
	  do 
	    table[++n]=expr();
	  while (*analyseur++!=']');
          if (did_break) err(breaker,"here (in array context)");
	  p=n/m; analyseurtetpil=avma;
	  p1=cgetg(m+1,t_MAT);
	  for (j=1; j<=m; j++)
	  {
	    p1[j]=lgetg(p+1,t_COL);
	    for (i=1; i<=p; i++)
	      coeff(p1,i,j) = lcopy(table[(i-1)*m+j]);
	  }
	  break;

	default:
          /* can only occur in library mode */
          err(talker,"incorrect vector or matrix");
          return NULL; /* not reached */
      }
      killbloc((GEN)table); return p1;

    case '%':
      old=analyseur-1; p=0;
      if (! gp_history_fun)
	err(talker2,"history not available in library mode: ",old,mark.start);
      while ( *analyseur == '`') { analyseur++; p++; }
      return p ? gp_history_fun(p         ,1,old,mark.start)
               : gp_history_fun(number(&n),0,old,mark.start);
  }
  err(caracer1,analyseur-1,mark.start);
  return NULL; /* not reached */
}

#define can_repeat_op(c) ((c) == '+' || (c) == '-') /* valid x opop, eg x++ */

static GEN
matrix_block(GEN p, entree *ep)
{
  long tx,full_col,full_row,c,r,cp1;
  char *old;
  GEN res, p1;

  tx = full_row = 0; p1 = p;
  while (*analyseur == '[')
  {
    full_row = 0; p = p1; tx=typ(p);
    analyseur++;
    switch(tx)
    {
      case t_LIST:
        c = check_array_index(lgef(p)-1) + 1;
        p1 = (GEN) p[c];
        match(']'); break;

      case t_VEC: case t_COL:
        c = check_array_index(lg(p));
        p1 = (GEN) p[c];
        match(']'); break;

      case t_MAT:
        if (lg(p)==1) err(arrayer1,analyseur,mark.start); /* 0x0 matrix */
        if (*analyseur==',') /* whole column */
        {
          full_col=1; analyseur++;
          c = check_array_index(lg(p));
          p1 = (GEN) p[c];
          match(']'); break;
        }
        full_col = 0;

        r = check_array_index(lg(p[1]));
        match(',');
        if (*analyseur == ']') /* whole row */
        { 
          analyseur++; full_row=1;
          if (*analyseur != '[') break;

          p1 = cgetg(lg(p),t_VEC);
          for (c=1; c<lg(p); c++) p1[c] = coeff(p,r,c);
          break;
        }

        c=check_array_index(lg(p));
        p1 = gcoeff(p,r,c);
        match(']'); break;

      default:
        err(caracer1,analyseur-1,mark.start);
    }
  }
  analyseurtetpil = avma; old = analyseur;

  if (*analyseur == '=') /* affectation or equality test */
  {
     if (analyseur[1] == '=')  /* test */
     { 
       if (!full_row) return p1;
       res = cgetg(lg(p),t_VEC);
       for (c=1; c<lg(p); c++) res[c] = coeff(p,r,c);
       return res;
     }
     cp1 = *p1; analyseur++; old=analyseur; res=expr();
  }
  else if (can_repeat_op(*analyseur) && *analyseur == analyseur[1])
  {
    /* a++, a-- */
    if (full_row) err(gadderf,"Scalar","vector/matrix");
    if (typ(p1)==t_INT)
      res = (*analyseur == '+')? addis(p1,1): subis(p1,1);
    else
      res = (*analyseur == '+')? gadd(p1,gun): gsub(p1,gun);
    cp1 = *p1; analyseur += 2;
  }
  else
  {
    GEN (*f)(GEN,GEN) = NULL;

    if (full_row)
    {
      p1 = cgetg(lg(p),t_VEC);
      for (c=1; c<lg(p); c++) p1[c] = coeff(p,r,c);
    }

    if (!*analyseur) return (ep && !full_row) ? p1: gcopy(p1);

    /* op= constructs ? */
    if (analyseur[1] != '=')
    {
      if (analyseur[2] == '=')
        switch(*analyseur)
        {
          case '>' :
            if (analyseur[1]=='>') f = &gshiftminus;
            break;
          case '<' :
            if (analyseur[1]=='<') f = &gshiftplus;
            break;
          case '\\':
            if (analyseur[1]=='/') f = &gdivround;
            break;
        }
      if (!f) return (ep && !full_row) ? p1: gcopy(p1);
      analyseur+=3;
    }
    else
    {
      switch(*analyseur)
      {
	case '+' : f = &gadd   ; break;
	case '-' : f = &gsub   ; break;
	case '*' : f = &gmul   ; break;
	case '/' : f = &gdiv   ; break; 
	case '\\': f = &gdivent; break; 
	case '%' : f = &gmod   ; break; 
	default: return (ep && !full_row) ? p1: gcopy(p1);
      }
      analyseur+=2; 
    }
    cp1=*p1; old=analyseur; res = f(p1,expr());
  }
  /* affectation */
  if (!ep) err(caracer1,analyseur,mark.start);
  if (did_break) err(breaker,"here (affectation)");

  if (!tx) /* simple variable */
  {
    changevalue(ep,res);
    return (GEN) ep->value;
  }

  if (tx == t_MAT)
  {
    if (full_row) /* whole row; r = row number */
    {
      if (typ(res) != t_VEC || lg(res) != lg(p))
	err(caseer2,old,mark.start);

      for (c=1; c<lg(p); c++)
      {
        p1 = gcoeff(p,r,c); if (isclone(p1)) killbloc(p1);
        coeff(p,r,c) = lclone((GEN)res[c]);
      }
      return res;
    }
    if (full_col) /* whole column; c = column number */
    {
      if (typ(res) != t_COL || lg(res) != lg((GEN) p[1]))
	err(caseer2,old,mark.start);
      /* sanity check in case v[i] = f(), where f destroys v */
      if (*p1 != cp1) 
        err(talker2,"variable on the left-hand side was affected during this function\n  ***   call. Check whether it is modified as a side effect there:\n     ", old, mark.start);

      for (r=1; r<lg(p1); r++)
        if (isclone(p1[r])) killbloc((GEN)p1[r]); 
      p[c] = lclone(res); return res;
    }
    /* single element: r=row, c=column */
    res=gclone(res); coeff(p,r,c)=(long)res;
  }
  else /* vector or list */
  {
    res=gclone(res); p[c]=(long)res;
  }
  /* sanity check in case v[i] = f(), where f destroys v */
  if (*p1 != cp1) 
    err(talker2,"variable on the left-hand side was affected during this function\n  ***   call. Check whether it is modified as a side effect there:\n     ", old, mark.start);
  if (isclone(p1)) killbloc(p1); 
  return res;
}

/* if lim == 0 read the whole string. Else stop at lim or non-escaped '"' */
static char *
translate(char **src, char *s, char *lim, long do_test)
{
  char *t = *src;
  while (*t)
  {
    while (*t == '\\')
    {
      switch(*++t)
      {
	case 'e':  *s='\033'; break; /* escape */
	case 'n':  *s='\n'; break;
	case 't':  *s='\t'; break;
	default:   *s=*t;
      }
      t++; s++;
    }
    if (lim)
    {
      if (*t == '"') break;
      if (do_test && s >= lim) err(talker,"string too long");
    }
    *s++ = *t++;
  }
  *s=0; *src=t; return s;
}

/*  Read a "string" from src (analyseur if src == NULL). Format then copy it,
 *  starting at s. Return pointer to the \0 ending the string.
 */
char *
readstring(char *src, char *s, char *lim)
{
  char *old;

  if (src) { old=analyseur; analyseur=src; }
  match('"'); s = translate(&analyseur,s,lim,1); match('"');
  if (src) analyseur=old;
  return s;
}

/* n = strlen(s) or < 0, in which case we read and update analyseur */
GEN
strtoGEN(char *s, long n)
{
  char *old = s, *lim = NULL;
  GEN p;

  if (n < 0)
  { 
    skipstring(); n = analyseur-old - 2; /* don't count the enclosing '"' */
    lim = old; old++; /* skip '"' */
  }
  n++; /* ending '\0' */
  n = (n+BYTES_IN_LONG) >> TWOPOTBYTES_IN_LONG;
  p = cgetg(n+1, t_STR);
  translate(&old, GSTR(p), lim, 0);
  return p;
}

static GEN
call_fun(entree **p)
{
  GEN x, res = lisseq((char *)p);

  if (check_break_status(DOFUNCTION, &x)) res = x;
  if (! is_universal_constant(res))
  {
    /* make result safe */
    analyseurtetpil=avma;
    res = forcecopy(res);     
  }
  while (*--p) killvalue(*p); /* pop ancient values for formal parameters */
  return res;
}

entree *
do_alias(entree *ep)
{
  while (ep->valence == EpALIAS) ep = (entree *) ep->value;
  return ep;
}

#define TOTAL_STRING_ARG 4096 /* Total length of string args */
#define match_comma() if (matchcomma) match(','); else matchcomma = 1

static GEN
identifier(void)
{
  long m,i,av,matchcomma;
  char *ch1, *old;
  entree *ep;
  GEN res;

  mark.identifier = analyseur; ep = entry();
  if (EpVALENCE(ep)==EpVAR) /* variable */
  {
    if (*analyseur == ')' || *analyseur ==',')
      return (GEN)ep->value; /* optimized for simple variables */

    return matrix_block((GEN) ep->value,ep);
  }

  ep=do_alias(ep); matchcomma=0;
  if (ep->code)
  {
    static char buffer[TOTAL_STRING_ARG], *bp = buffer;
    static char *limit = buffer+TOTAL_STRING_ARG-2;
    int ret = RET_GEN, allright=0;
    long fake;
    char *old_fun = current_function, *s = ep->code, *bpinit = bp;
    char *sinit, *oldanalyseur = NULL;
    GEN *fakepGEN = NULL, fakeGEN, argvec[9];
    void *call = ep->value;

    current_function=ep->name;
    if (*analyseur != '(')
    {
      /* if no mandatory argument, no () needed */
      if (EpVALENCE(ep) != 0)  match('('); /* error */

      if (!*s || (!s[1] && *s == 'p'))
      {
	res = ((GEN (*)(long))ep->value)(prec);
	current_function=old_fun; return res;
      }
      allright=1; /* no arg was given, but valence is ok */
    } else analyseur++;

    i=0;
    /* Optimized for G and p. */
    while (*s == 'G')
    {
      match_comma(); argvec[i++] = expr(); s++;
      if (did_break) err(breaker,"here (argument reading)");
    }
    if (*s == 'p') { argvec[i++] = (GEN) prec; s++; }

    while (*s)
    {
      switch (*s++)
      {
	case 'G': /* GEN */
	  match_comma(); argvec[i++] = expr();
          if (did_break) err(breaker,"here (argument reading)");
          break;

	case 'L': /* long */
	  match_comma(); argvec[i++] = (GEN) readlong(); break;

	case 'n': /* var number */
	  match_comma(); argvec[i++] = (GEN) readvar(); break;

	case 'V': /* variable */
	case 'S': /* symbol */
	  match_comma(); mark.symbol=analyseur;
	  argvec[i++] = (GEN)entry(); break;

	case  'I': /* Input position */
	  match_comma();
	  argvec[i++] = (GEN) analyseur;
	  skipseq(); break;

	case 'r': /* raw */
	  match_comma(); mark.raw = analyseur; sinit = bp;
	  while (*analyseur)
	  {
	    if (bp > limit) break;
	    while (*analyseur == '"')
	      bp = readstring(NULL,bp,limit);
	    if (*analyseur == ',' || *analyseur == ')') break;
	    *bp++ = *analyseur++;
	  }
	  if (bp > limit) err(talker,"arg. string too long ");
	  *bp++ = 0; argvec[i++] = (GEN) sinit;
	  break;

	case 's': /* expanded string; empty arg yields "" */
	  match_comma();
	  if (*s == '*') /* any number of string objects */
	  {
            long n=0;
	    s++; res = cgeti(256);
	    while (*analyseur)
	    {
	      while (*analyseur == '"')
		res[n++] = (long) strtoGEN(analyseur,-1);
	      if (*analyseur == ')' || *analyseur == ';') break;
	      if (*analyseur == ',')
                analyseur++; 
              else
                res[n++] = (long) expr();
              if (n>255) err(talker,"too many objects in print");
	    }
            res[n] = 0; /* end the sequence with NULL */
	  }
	  else
	  { 
            res = (GEN) bp;
	    while (*analyseur && bp <= limit)
	    {
	      if (*analyseur == '"')
		bp = readstring(NULL,bp,limit);
	      else if (*analyseur == ',' || *analyseur == ')') break;
	      else
	      { /* expand string */
		long len, av = avma;
		char *tmp = GENtostr(expr()), *tbp;
                
                len = strlen(tmp); tbp = bp + len;
                if (tbp>limit) break;
		memcpy(bp,tmp,len*sizeof(long)); /* ignore trailing \0 */
		free(tmp); avma=av; bp = tbp;
	      }
	    }
            if (bp > limit) err(talker,"string too long");
            *bp++ = 0;
	  }
	  analyseurtetpil = avma;
	  argvec[i++] = res; break;

	case 'p': /* precision */
	  argvec[i++] = (GEN) prec; break;

	case '=':
	  match('='); matchcomma = 0; break;

	case 'D': /* Has a default value */
	  if (do_switch(allright,matchcomma))
	  {
            if (*s == 'G') { argvec[i++]=NULL; s++; break; }
	    oldanalyseur = analyseur;
	    analyseur = s; matchcomma = 0;
	  }
          else
            if (*s == 'G') break;
	  while (*s++ != ',');
	  break;

	 case 'P': /* series precision */
	   argvec[i++] = (GEN) precdl; break;

	 case 'f': /* Fake *long argument */
	   argvec[i++] = (GEN) &fake; break;

	 case 'F': /* Fake *GEN argument */
	   argvec[i++] = (GEN) &fakeGEN; fakepGEN = &fakeGEN; break;

	 case 'x': /* Foreign function */
	   argvec[i++] = (GEN) ep; call = foreignHandler; break;

	 case 'l': /* Return long */
	   ret = RET_INT; break;

	 case 'v': /* Return void */
	   ret = RET_VOID; break;

	 case ',': /* Clean up default */
	   if (oldanalyseur)
	   {
	     analyseur = oldanalyseur;
	     oldanalyseur = NULL;
	     matchcomma=1;
	   }
	   break;
	 default: err(bugparier,"identifier (unknown code)");
      }
    }

    for ( ;i<9;i++) argvec[i]=NULL; /* unitialized read otherwise */
    switch (ret)
    {
      case RET_GEN:
	analyseurtetpil = avma;
	res = ((PFGEN)call)(argvec[0], argvec[1], argvec[2], argvec[3],
	          argvec[4], argvec[5], argvec[6], argvec[7], argvec[8]);
	break;

      case RET_INT:
	m = ((long (*)(ANYARG))call)(argvec[0], argvec[1], argvec[2], argvec[3],
		  argvec[4], argvec[5], argvec[6], argvec[7], argvec[8]);
	analyseurtetpil = avma; res=stoi(m); break;

      case RET_VOID:
	((void (*)(ANYARG))call)(argvec[0], argvec[1], argvec[2], argvec[3],
	          argvec[4], argvec[5], argvec[6], argvec[7], argvec[8]);
	analyseurtetpil = avma; res=gnil; break;
    }
    if (fakepGEN) cgiv(fakeGEN);
    if (!allright) match(')');
    current_function = old_fun;
    bp = bpinit; return res;
  }

  if (EpVALENCE(ep) < EpUSER) /* fonctions predefinies */
  {
    res = gnil; match('(');
    switch(EpVALENCE(ep))
    {
      case 50: /* O */
        res=truc(); m=1;
        if (did_break) err(breaker,"here (in O()))");
	if (*analyseur=='^') { analyseur++; m = readlong(); }
	analyseurtetpil = avma;
	res = ggrando(res,m); break;

      case 80: /* if then else */
        av=avma; m=gcmp0(expr()); 
        if (did_break) err(breaker,"test expressions");
        analyseurtetpil = avma = av; match(',');
	if (m) /* false */
	{
	  skipseq();
	  if (*analyseur == ')') res=gnil;
	  else { match(','); res = seq(); }
	  if (check_break_status(NOACTION,NULL))
	    skipseq();
	}
	else /* true */
	{
	  res = seq();
	  if (check_break_status(NOACTION,NULL))
	    skipseq();
          if (*analyseur != ')')
            { match(','); skipseq(); }
	} 
	break;

      case 81: /* while do */
        analyseurtetpil = av = avma; ch1 = analyseur;
	for(;;)
	{
	  if (gcmp0(expr()))
	  {
	    match(','); skipseq(); break;
	  }
	  avma = av; match(','); seq();
	  if (check_break_status(DOLOOP,NULL))
	    { skipseq(); break; }
	  analyseur = ch1;
	}
	analyseurtetpil = avma = av;
	break;

      case 82: /* repeat until*/
        analyseurtetpil = av = avma; ch1 = analyseur;
	skipexpr();
	for(;;)
	{
	  avma = av; match(','); seq();
	  if (check_break_status(DOLOOP,NULL))
	    { skipseq(); break; }

	  analyseur = ch1;
	  if (!gcmp0(expr()))
	  {
	    match(','); skipseq(); break;
	  }
	}
	analyseurtetpil = avma = av;
	break;

      default: err(valencer1);
    }
    match(')'); return res;
  }

  switch (EpVALENCE(ep))
  {
    GEN *tmparg, *argdef; /* argdef = default args (NULL terminated) */
    entree **p;
    char *ch2;
    long nparam;

    case EpUSER: /* user-defined functions */
      argdef = (GEN*) ep->args; p = (entree**) ep->value;
      p++; /* skip the initial NULL, p points at first formal parameter */

      if (*analyseur != '(') /* no args */
      {
	if ( *analyseur != '='  ||  analyseur[1] == '=' )
	{
	  while (*argdef) newvalue(*p++,*argdef++);
	  return call_fun(p);
	}
	match('('); /* ==> error */
      }
      if (analyseur != redefine_fun)
      {
        ch1 = analyseur; analyseur++; matchcomma=0;

        nparam = EpNPARAM(ep); 
        tmparg = (GEN*) gpmalloc((1+nparam)*sizeof(GEN));
        for (i=0;i<nparam;i++)
          if (do_switch(0,matchcomma))
            { matchcomma=1 ; tmparg[i] = argdef[i]; } /* defaut arg */
          else
            { match_comma(); tmparg[i] = expr(); }  /* user suplied */
        /* can't do it immediately. args may use former parameter values */
        for (i=0;i<nparam;i++) newvalue(p[i],tmparg[i]);
        free(tmparg);

        if (*analyseur == ')')
          if (analyseur[1] != '=' || analyseur[2] == '=')
          { 
            /* p + nparam points to function body */
            analyseur++; return call_fun(p + nparam);
          }

        /* Redefine function (should not happen) */
        p += nparam; while (*--p) killvalue(*p);
        if (*analyseur != ',' && *analyseur != ')') skipexpr();
        while (*analyseur == ',') { analyseur++; skipexpr(); }
        match(')');

        if ( *analyseur != '='  ||  analyseur[1] == '=' )
          err(nparamer1,mark.identifier,mark.start);
        matchcomma=0; analyseur = ch1; analyseurtetpil = avma;
      }
      redefine_fun = NULL;
      free_args((GEN*)ep->args); kill_entree_object(ep);

    /* Fall through */

    case EpNEW: /* new function */
    {
      long len;
      entree **newfun;

      nparam=0; check_new_fun = ep;

      /* checking arguments */
      match('('); ch1 = analyseur;
      while (*analyseur != ')')
      {
	old=analyseur; nparam++; match_comma();
	if (!isalpha(*analyseur))
        {
	  err_new_fun();
	  err(paramer1, mark.identifier, mark.start);
	}

	if (EpVALENCE(skipentry()) != EpVAR)
        {
	  err_new_fun();
	  err(paramer1,old,mark.start);
	}
	if (*analyseur == '=') { analyseur++; skipexpr(); }
      }
      match(')'); match('=');

      /* checking function definition */
      {
        char *oldredef = redefine_fun;
        skipping_fun_def++;
        ch2 = analyseur; skipseq(); len = analyseur-ch2;
        skipping_fun_def--; redefine_fun = oldredef;
      }

      /* function  is ok. record it */
      ch2 = analyseur;
      newfun = (entree**) newbloc( nparam + (len>>TWOPOTBYTES_IN_LONG) + 4);
      /* a function's former value is the variable with same name */
      newfun[-1] = (entree *)ep->value;
      ep->value = (void *)newfun;
      newfun++; /* this bloc is no GEN, leave the first cell alone ( = 0) */

	/* record default args */
      argdef = (GEN*) gpmalloc((nparam+1)*sizeof(GEN));
      ep->args = (void*) argdef;
      analyseur = ch1; matchcomma=0;
      for (i = 0; i < nparam; i++)
      {
	old=analyseur; match_comma(); *newfun++ = entry();
	if (*analyseur == '=')
	{ 
	  analyseur++; argdef[i] = gclone(expr());
	}
	else argdef[i] = gzero;
      }
      argdef[i] = NULL; 
      analyseur+=2; /* match(')') && match('='); */

	/* record text */
      strncpy((char *)newfun, analyseur, len);
      ((char *) newfun)[len] = 0;

      ep->valence = EpUSER | (nparam << PARAMSHIFT);
      check_new_fun=NULL; analyseur = ch2;
      analyseurtetpil=avma; return gnil;
    }
  }
  err(valencer1); return NULL; /* not reached */
}

static long
number(long *nb)
{
  int m=0;
  for (*nb = 0; (*nb < 9) && isdigit(*analyseur); (*nb)++)
    m = 10*m + (*analyseur++ - '0');
  return m;
}

static GEN
constante()
{
  static long pw10[] = { 1, 10, 100, 1000, 10000, 100000, 1000000,
                        10000000, 100000000, 1000000000 };
  long l,m=0,n=0,plus=1,nb, av = avma, limite = (av+bot)>>1;
  GEN z,y;

  y = stoi(number(&nb));
  while (isdigit(*analyseur))
  {
    m = number(&nb); y = mulsi(pw10[nb], y);
    y = addsi(m, y);
    if (low_stack(limite, (av+bot)>>1)) y = gerepileupto(av,y);
  }
  if ( *analyseur!='.' && *analyseur!='e' && *analyseur!='E' ) return y;
  if (*analyseur=='.')
  {
    analyseur++;
    while (isdigit(*analyseur))
    {
      m = number(&nb); y = mulsi(pw10[nb], y);
      y = addsi(m, y);
      if (low_stack(limite, (av+bot)>>1)) y = gerepileupto(av,y);
      n -= nb;
    }
  }
  l=lgef(y); if (l<prec) l=prec;
  z=cgetr(l); affir(y,z);
  if (*analyseur == 'e' || *analyseur == 'E')
  {
    char *old=analyseur;
    switch(*++analyseur)
    {
      case '-': plus=0; /* fall through */
      case '+': analyseur++;
    }
    m = number(&nb);
    if (isdigit(*analyseur)) err(expter1,old,mark.start);
    if (plus) n += m; else n -= m;
  }
  if (n)
  {
    y=cgetr(l); affsr(10,y); y = gpuigs(y, labs(n));
    z = n > 0 ?  mulrr(z,y) : divrr(z,y);
  }
  return z;
}

/********************************************************************/
/**                                                                **/
/**                   HASH TABLE MANIPULATIONS                     **/
/**                                                                **/
/********************************************************************/

long
is_keyword_char(char c) { return isalnum(c) || (c=='_'); }


/* return hashing value for identifier s (analyseur is s = NULL) */
long
hashvalue(char *s)
{
  long update, n = 0;

  if (!s) { s = analyseur; update = 1; } else update = 0;
  while (is_keyword_char(*s)) { n = (n<<1) ^ *s; s++; }
  if (update) analyseur = s;
  if (n < 0) n = -n;
  return n % functions_tblsz;
}

/* Looking for entry in hashtable. ep1 is the cell's first element */
static entree *
findentry(char *name, long len, entree *ep1)
{
  entree *ep;

  for (ep = ep1; ep; ep = ep->next)
    if (!strncmp(ep->name, name, len) && !(ep->name)[len]) return ep;

  if (foreignAutoload) /* Try to autoload. */
    if (foreignAutoload(name, len))
    {
      for (ep = ep1; ep; ep = ep->next)
        if (!strncmp(ep->name, name, len) && !(ep->name)[len]) return ep;
      err(talker,"foreignAutoload reported success, but installed nothing");
    }
  return NULL; /* not found */
}

entree *
is_entry_intern(char *s, entree **table, long *pthash)
{
  char *old = analyseur;
  long hash, len;
  
  analyseur = s; hash = hashvalue(NULL);
  len = analyseur - s; analyseur = old; 
  if (pthash) *pthash = hash;
  return findentry(s,len,table[hash]);
}

static entree *
installep(void *f, char *name, int len, int valence, int add, entree **table)
{
  entree *ep = (entree *) gpmalloc(sizeof(entree) + add + len+1);
  const entree *ep1 = initial_value(ep);
  char *u = (char *) ep1 + add;

  ep->name    = u; strncpy(u, name,len); u[len]=0;
  ep->args    = NULL; ep->help = NULL; ep->code = NULL;
  ep->value   = f? f: (void *) ep1;
  ep->next    = *table;
  ep->valence = valence;
  ep->menu    = 0;
  return *table = ep;
}

long
manage_var(long n, entree *ep)
{
  static long max_avail = MAXVARN; /* first user variable not yet used */
  static long nvar; /* first GP free variable */
  long var;
  GEN p;

  if (n) /* special behaviour */
  {
    switch(n)
    {
      case 2: return nvar=0;
      case 3: return nvar;
    }

    /* user wants to delete one of his variables */
    if (max_avail == MAXVARN-1) return 0; /* nothing to delete */
    max_avail++;
    free(polx[max_avail]); /* frees both polun and polx */
    return max_avail+1;
  }

  if (nvar == max_avail) err(trucer1,mark.identifier,mark.start);
  if (ep)
  {
    p = (GEN)ep->value;
    var=nvar++;
  }
  else
  {
    p = (GEN) gpmalloc(7*sizeof(long));
    var=max_avail--;
  }

  /* create polx[var] */
  p[0] = evaltyp(t_POL) | evallg(4);
  p[1] = evalsigne(1) | evallgef(4) | evalvarn(var);
  p[2] = zero; p[3] = un;
  polx[var] = p;

  /* create polun[nvar] */
  p += 4;
  p[0] = evaltyp(t_POL) | evallg(3);
  p[1] = evalsigne(1) | evallgef(3) | evalvarn(var);
  p[2] = un;
  polun[var] = p;

  varentries[var] = ep;
  if (ep) { polvar[nvar] = (long) ep->value; setlg(polvar, nvar+1); }
  return var;
}

long
fetch_var()
{
  return manage_var(0,NULL);
}

long
delete_var()
{
  return manage_var(1,NULL);
}

/* Find entry or create it */
static entree *
entry(void)
{
  char *old = analyseur;
  const long hash = hashvalue(NULL), len = analyseur - old;
  entree *ep = findentry(old,len,functions_hash[hash]);
  long val,n;

  if (ep) return ep;
  if (compatible == WARN)
  {
    ep = findentry(old,len,funct_old_hash[hash]);
    if (ep) return ep; /* the warning was done in skipentry() */
  }

  /* ep does not exist. Create it */
  if (*analyseur == '(') 
    { n=0; val=EpNEW; } 
  else
    { n=7*sizeof(long); val=EpVAR; }
  ep = installep(NULL,old,len,val,n, functions_hash + hash);

  if (n) manage_var(0,ep); /* Variable */
  return ep;
}

/********************************************************************/
/**                                                                **/
/**                          SKIP FUNCTIONS                        **/
/**                                                                **/
/********************************************************************/

/* as skipseq without modifying analyseur && al */
static void
doskipseq(char *c, int strict)
{
  char *olds = analyseur;

  mark.start = c; analyseur = c; skipseq();
  if (*analyseur) 
  {
    if (strict) err(talker2,"unused characters: ", analyseur, c);
    err(warner, "unused characters: %s", analyseur);
  }
  analyseur = olds;
}

static void
skipstring()
{
  match('"');
  while (*analyseur)
    switch (*analyseur++)
    {
      case '"': return;
      case '\\': analyseur++;
    }
  match('"');
}

static void
skip_matrix_block(int no_affect)
{
  while (*analyseur == '[')
  {
    analyseur++;
    if (*analyseur == ',') { analyseur++; skipexpr(); }
    else
    {
      skipexpr();
      if (*analyseur == ',')
	if (*++analyseur != ']') skipexpr();
    }
    match(']');
  }

  if (*analyseur == '=' && analyseur[1] != '=')
  {
    if (no_affect) err(caracer1,analyseur,mark.start);
    analyseur++; skipexpr(); return;
  }
  if (can_repeat_op(*analyseur) && (*analyseur == analyseur[1]))
  {
    if (no_affect) err(caracer1,analyseur,mark.start);
    analyseur+=2; return;
  }
  if (!*analyseur) return;
  if (analyseur[1] != '=')
  {
    switch(*analyseur)
    {
      case '>': case '<':
	if (analyseur[1] != *analyseur || analyseur[2] != '=') return;
	if (no_affect) err(caracer1,analyseur,mark.start);
	analyseur+=3; skipexpr(); return;
      case '\\':
	if (analyseur[1] != '/' || analyseur[2] != '=') return;
	if (no_affect) err(caracer1,analyseur,mark.start);
	analyseur+=3; skipexpr(); return;
    }
    return;
  }
  
  switch(*analyseur)
  {
    case '+': case '-': case '*': case '/': case '\\': case '%':
      if (no_affect) err(caracer1,analyseur,mark.start);
      analyseur+=2; skipexpr(); return;
  }
}

static void
skipseq(void)
{
  for(;;)
  {
    while (separe(*analyseur)) analyseur++;
    if (!*analyseur || *analyseur == ')' || *analyseur == ',') return;
    skipexpr(); if (!separe(*analyseur)) return;
  }
}

static void
skipexpr(void)
{
  long niveau=3,e1,e2,e3;

  e1=e2=e3=0;
  for(;;)
    switch(niveau)
    {
      case 3:
	e3=1; skipfacteur();
	switch(*analyseur)
	{
	  case '*': case '/': case '%':
	    analyseur++; break;
	  case '\\':
	    if (*++analyseur == '/') analyseur++; break;
	  case '<': case '>':
	    if (analyseur[1]==*analyseur) { analyseur +=2; break; }
	    /* fall through */
	  default: niveau--;
	}
	break;

      case 2:
	if (!e3) { niveau++; break; }
	e3=0; e2=1;
	switch(*analyseur)
	{
	  case '+': case '-':
	    analyseur++; niveau++; break;
	  default: niveau--;
	}
	break;

      case 1:
	if (!e2) { niveau++; break; }
	e2=0; e1=1;
	switch(*analyseur)
	{
	  case '<':
	    switch(*++analyseur)
	    {
	      case '=': case '>': analyseur++;
	      default : niveau++;
	    }
	    break;
	  case '>':
	    if (*++analyseur == '=') analyseur++;
	    niveau++; break;
	  case '=': case '!':
	    if (analyseur[1] == '=') { analyseur+=2; niveau++; }
	    break;
	  default: niveau--;
	}
	break;

      case 0:
	if (!e1) { niveau++; break; }
	e1=0;
	switch(*analyseur)
	{
	  case '&': if (*++analyseur == '&') analyseur++; niveau++; break;
	  case '|': if (*++analyseur == '|') analyseur++; niveau++; break;
	  default: return;
	}
    }
}

static void
skipfacteur(void)
{
  if (*analyseur == '+' || *analyseur == '-') analyseur++;
  skiptruc();
  for(;;)
    switch(*analyseur)
    {
      case '.':
	analyseur++; while (isalnum(*analyseur)) analyseur++; break;
      case '^':
	analyseur++; skipfacteur(); break;
      case '~': case '\'':
	analyseur++; break;
      case '[':
	skip_matrix_block(1); break;
      case '!':
	if (analyseur[1] != '=') { analyseur++; break; }
      default: return;
    }
}

/* return the number of elements we need to read if array/matrix */
static long
skiptruc(void)
{
  long n=0;
  char *old;

  if (*analyseur == '"') { skipstring(); return 0; }
  if (*analyseur == '!') { analyseur++; skiptruc(); return 0; }
  if (isalpha(*analyseur)) { skipidentifier(); return 0; }
  if (isdigit(*analyseur) || *analyseur== '.') { skipconstante(); return 0; }
  switch(*analyseur++)
  {
    case '(':
      skipexpr(); match(')'); return 0;
    case '[':
      old = analyseur-1;
      if (*analyseur == ';' && analyseur[1] == ']')  /* 0 x 0 matrix */
        { analyseur+=2; return 0; }
      if (*analyseur != ']')
      {
	do { n++; skipexpr(); old=analyseur; }
	while (*analyseur++ == ',');
	analyseur--;
      }
      switch (*analyseur)
      {
	case ']': analyseur++; return n;
	case ';':
	{
	  long m, norig=n; /* number of elts in first line */
	  old=analyseur;
	  do {
	    m=n;
	    do { n++; analyseur++; skipexpr(); }
	    while (*analyseur != ';' && *analyseur != ']');
	    if (n-m != norig) err(recter1,old,mark.start);
	  } while (*analyseur != ']');
	  analyseur++; return n;
	 }
	default:
	  err(vectmater1,old,mark.start);
	  return 0; /* not reached */
      }
    case '%':
      if (*analyseur == '`') { while (*++analyseur == '`'); return 0; }
      number(&n); return 0;
  }
  err(caracer1,analyseur-1,mark.start);
  return 0; /* not reached */
}

static void
skipidentifier(void)
{
  long matchcomma=0;
  entree *ep;
  char *old;

  mark.identifier = analyseur; ep = do_alias(skipentry());
  if (ep->code)
  {
    char *s = ep->code;

    if (*analyseur != '(')
    {
      if (EpVALENCE(ep) == 0) return; /* no mandatory argument */
      match('('); /* ==> error */
    }
    analyseur++;

    /* Optimized for G and p. */
    while (*s == 'G') { match_comma(); skipexpr(); s++; }
    if (*s == 'p') s++;
    while (*s) switch (*s++)
    {
      case 'G': case 'n': case 'L':
	  match_comma();
	  if (*analyseur == ',' || *analyseur == ')') break;
	  skipexpr(); break;
      case 'I':
	  match_comma(); skipseq(); break;
      case 'r':
      {
	  match_comma();
	  while (*analyseur)
	  {
	    while (*analyseur == '"') skipstring();
	    if (*analyseur == ',' || *analyseur == ')') break;
	    analyseur++;
	  }
	  break;
      }
      case 's':
      {
	  match_comma();
	  if (*s == '*')
	  {
	    while (*analyseur)
	    {
	      while (*analyseur == '"') skipstring();
	      if (*analyseur == ')') break;
	      if (*analyseur == ',') analyseur++;
	      else skipexpr();
	    }
	    s++; if (*s == 'p' || *s == 't') s++;
	    break;
	  }

	  while (*analyseur)
	  {
	    while (*analyseur == '"') skipstring();
	    if (*analyseur == ')' || *analyseur == ',') break;
	    skipexpr();
	  }
	  break;
      }
      case 'V': case 'S':
	  match_comma(); old = analyseur;
	  if (!isalpha(*analyseur)) err(varer1,old,mark.start);
	  if (EpVALENCE(skipentry()) != EpVAR && *(s-1) == 'V')
	    err(varer1,old,mark.start);
	  break;

      case 'p': case 'P': case 'l': case 'v': case 'f': case 'F': case 'x':
	  break;

      case 'D':
	  if ( *analyseur == ')' ) { analyseur++; return; }
          if (*s == 'G') break;
	  while (*s++ != ',');
	  break;
      case '=':
	  match('='); matchcomma = 0; break;
      case ',':
          matchcomma=1; break;
      default:
	  err(bugparier,"skipidentifier (unknown code)");
    }
    match(')');
    return;
  }
  if (EpVALENCE(ep) < EpUSER) /* fonctions predefinies */
  {
    if (!EpVALENCE(ep) && (*analyseur != '(')) return;
    match('(');
    switch(EpVALENCE(ep))
    {
      case 50: skiptruc();
	if (*analyseur == '^') { analyseur++; skipfacteur(); };
	break;
      case 80: skipexpr(); match(','); skipseq();
          if (*analyseur != ')') { match(','); skipseq(); }
	  break;
      case 81: case 82: skipexpr(); match(','); skipseq(); break;
      default: err(valencer1);
    }
    match(')'); return;
  }
  switch (EpVALENCE(ep))
  {
    case EpVAR: /* variables */
      skip_matrix_block(0); return;

    case EpUSER: /* fonctions utilisateur */
    {
      char *ch1 = analyseur;
      GEN *arg = (GEN*) ep->args;

      if (*analyseur != '(')
      {
	if ( *analyseur != '='  ||  analyseur[1] == '=' ) return;
	match('('); /* error */
      }
      analyseur++;  /* skip '(' */
      while (*arg++)
      {
	if (do_switch(0,matchcomma)) matchcomma=1;
	else { match_comma(); skipexpr(); }
      }

      if (*analyseur == ')')
	if ( analyseur[1] != '=' || analyseur[2] == '=' )
	  { analyseur++; return; }

      /* here we are redefining a user function */
      old = analyseur;
      if (*analyseur != ',' && *analyseur != ')') skipexpr();
      while (*analyseur == ',') { analyseur++; skipexpr(); }
      match(')');

      if (*analyseur != '=' || analyseur[1] == '=')
        if (skipping_fun_def) return;
	else
	  err(nparamer1,old,mark.start);
      analyseur = ch1; matchcomma = 0;
      if (!redefine_fun) redefine_fun = analyseur;
    } /* fall through */

    case EpNEW: /* nouvelle fonction */
      if (check_new_fun && ! skipping_fun_def)
      {
	err_new_fun(); /* ep not created yet: no need to kill it */
	err(paramer1, mark.identifier, mark.start);
      }
      check_new_fun = NOT_CREATED_YET; match('(');
      while (*analyseur != ')') { match_comma(); skipexpr(); };
      match(')');
      if (*analyseur == '=')
      { 
	skipping_fun_def++;
	analyseur++; skipseq();
	skipping_fun_def--;
      }
      check_new_fun=NULL; return;

    default: err(valencer1);
  }
}

static void
skipconstante(void)
{
  while (isdigit(*analyseur)) analyseur++;
  if ( *analyseur!='.' && *analyseur!='e' && *analyseur!='E' ) return;
  if (*analyseur=='.') analyseur++;
  while (isdigit(*analyseur)) analyseur++;
  if ( *analyseur=='e'  ||  *analyseur=='E' )
  {
    analyseur++;
    if ( *analyseur=='+' || *analyseur=='-' ) analyseur++;
    while (isdigit(*analyseur)) analyseur++;
  }
}

static entree *
skipentry(void)
{
  static entree fakeEpNEW = { "",EpNEW,0,0,0,NULL,NULL,NULL };
  static entree fakeEpVAR = { "",EpVAR,0,0,0,NULL,NULL,NULL };
  char *old = analyseur;
  const long hash = hashvalue(NULL), len = analyseur - old;
  entree *ep = findentry(old,len,functions_hash[hash]);

  if (ep) return ep;
  if (compatible == WARN)
  {
    ep = findentry(old,len,funct_old_hash[hash]);
    if (ep)
    {
      err(warner,"using obsolete function %s",ep->name);
      return ep;
    }
  }
  return (*analyseur == '(') ? &fakeEpNEW : &fakeEpVAR;
}

/********************************************************************/
/**                                                                **/
/**                          MEMBER FUNCTIONS                      **/
/**                                                                **/
/********************************************************************/

static GEN
bnf(GEN x)
{
  int t; x = get_bnf(x,&t);
  if (!x) err(member,"bnf",mark.member,mark.start);
  return x;
}

static GEN
nf(GEN x)
{
  int t; x = get_nf(x,&t);
  if (!x) err(member,"nf",mark.member,mark.start);
  return x;
}

/* integral basis */
static GEN
zk(GEN x)
{
  int t; GEN y = get_nf(x,&t);
  if (!y)
  {
    switch(t)
    {
      case typ_CLA: return gmael(x,1,4);
      case typ_Q: y = cgetg(3,t_VEC);
        y[1]=un; y[2]=lpolx[varn(x[1])]; return y;
    }
    err(member,"zk",mark.member,mark.start);
  }
  return (GEN)y[7];
}

static GEN
disc(GEN x) /* discriminant */
{
  int t; GEN y = get_nf(x,&t);
  if (!y)
  {
    switch(t)
    {
      case typ_Q  : return discsr((GEN)x[1]);
      case typ_CLA: return gmael3(x,1,3,1);
      case typ_ELL: return (GEN)x[12];
    }
    err(member,"disc",mark.member,mark.start);
  }
  return (GEN)y[3];
}

static GEN
pol(GEN x) /* polynomial */
{
  int t; GEN y = get_nf(x,&t);
  if (!y)
  {
    switch(t)
    {
      case typ_CLA: return gmael(x,1,1);
      case typ_POL: return x;
      case typ_Q  : return (GEN)x[1];
    }
    err(member,"pol",mark.member,mark.start);
  }
  return (GEN)y[1];
}

static GEN
mod(GEN x) /* modulus */
{
  switch(typ(x))
  {
    case t_INTMOD: case t_POLMOD: case t_QUAD: break;
    default: err(member,"mod",mark.member,mark.start);
  }
  return (GEN)x[1];
}

static GEN
sign(GEN x) /* signature */
{
  int t; GEN y = get_nf(x,&t);
  if (!y)
  {
    if (t == typ_CLA) return gmael(x,1,2);
    err(member,"sign",mark.member,mark.start);
  }
  return (GEN)y[2];
}

static GEN
t2(GEN x) /* T2 matrix */
{
  int t; x = get_nf(x,&t);
  if (!x) err(member,"t2",mark.member,mark.start);
  return gmael(x,5,3);
}

static GEN
diff(GEN x) /* different */
{
  int t; x = get_nf(x,&t);
  if (!x) err(member,"diff",mark.member,mark.start);
  return gmael(x,5,5);
}

static GEN
codiff(GEN x) /* codifferent */
{
  int t; x = get_nf(x,&t);
  if (!x) err(member,"codiff",mark.member,mark.start);
  return gdiv(gmael(x,5,7), absi((GEN) x[3]));
}

static GEN
mroots(GEN x) /* roots */
{
  int t; GEN y = get_nf(x,&t);
  if (!y)
  {
    if (t == typ_ELL) return (GEN)x[14];
    err(member,"roots",mark.member,mark.start);
  }
  return (GEN)y[6];
}

static GEN
clgp(GEN x) /* class group (3-component row vector) */
{
  int t; GEN y = get_bnf(x,&t);
  if (!y)
  {
    switch(t)
    {
      case typ_QUA:
        y = cgetg(4,t_VEC);
        for(t=1; t<4; t++) y[t] = x[t];
        return y;
      case typ_CLA: return gmael(x,1,5);
    }
    if (typ(x)==t_VEC)
      switch(lg(x))
      {
        case 3: /* no gen */
        case 4: return x;
      }
    err(member,"clgp",mark.member,mark.start);
  }
  if (t==typ_BNR) return (GEN)x[5];
  return gmael(y,8,1);
}

static GEN
reg(GEN x) /* regulator */
{
  int t; GEN y = get_bnf(x,&t);
  if (!y)
  {
    switch(t)
    {
      case typ_CLA: return gmael(x,1,6);
      case typ_QUA: return (GEN)x[4];
    }
    err(member,"reg",mark.member,mark.start);
  }
  if (t == typ_BNR) err(impl,"ray regulator");
  return gmael(x,8,2);
}

static GEN
fu(GEN x) /* fundamental units */
{
  int t; GEN y = get_bnf(x,&t);
  if (!y)
  {
    switch(t)
    {
      case typ_CLA: x = (GEN)x[1]; if (lg(x)<11) break;
        return gmodulcp((GEN)x[9],(GEN)x[1]);
      case typ_Q:
        x = discsr((GEN)x[1]);
        return (signe(x)<0)? cgetg(1,t_VEC): fundunit(x);
    }
    err(member,"fu",mark.member,mark.start);
  }
  if (t == typ_BNR) err(impl,"ray units");
  x = y; y=(GEN)y[8]; 
  y = (lg(y)==5)? (GEN)buchfu(x)[1]: (GEN)y[5];
  return gmodulcp(y, gmael(x,7,1));
}

/* torsion units. return [w,e] where w is the number of roots of 1, and e a
 * polymod generator */
static GEN
tu(GEN x)
{
  int t; GEN y = get_bnf(x,&t), res = cgetg(3,t_VEC);
  if (!y)
  {
    switch(t)
    {
      case typ_Q:
        y = discsr((GEN)x[1]);
        if (signe(y)<0 && cmpis(y,-4)>=0)
          y = stoi((itos(y) == -4)? 4: 6);
        else
        { y = gdeux; x=negi(gun); }
        res[1] = (long)y; 
        res[2] = (long)x; return res;
      case typ_CLA:
        if (lg(x[1])==11) break;
      default: err(member,"tu",mark.member,mark.start);
    }
    x = (GEN) x[1]; y=(GEN)x[8];
  }
  else
  {
    if (t == typ_BNR) err(impl,"ray torsion units");
    x = y; y=(GEN)y[8];
    if (lg(y) > 5) y = (GEN)y[4];
    else
    {
      y = rootsof1(x);
      y[2] = lmul(gmael(x,7,7), (GEN)y[2]);
    }
    x = (GEN)x[7];
  }
  res[2] = lmodulcp((GEN)y[2], (GEN)x[1]);
  res[1] = y[1]; return res;
}

static GEN
futu(GEN x) /*  concatenation of fu and tu, w is lost */
{
  GEN fuc = fu(x);
  return concat(fuc, (GEN)tu(x)[2]);
}

static GEN
tufu(GEN x) /*  concatenation of tu and fu, w is lost */
{
  GEN fuc = fu(x);
  return concat((GEN) tu(x)[2], fuc);
}

static GEN
zkst(GEN bid)
/* structure of (Z_K/m)^*, where bid is a idealstarinit (with or without gen)
   or a bnrinit (with or without gen) */
{
  if (typ(bid)==t_VEC)
    switch(lg(bid))
    {
      case 6: return (GEN) bid[2];   /* idealstarinit */
      case 7: return gmael(bid,2,2); /* bnrinit */
    }
  err(member,"zkst",mark.member,mark.start);
  return NULL; /* not reached */
}

static GEN
no(GEN clg) /* number of elements of a group (of type clgp) */
{
  clg = clgp(clg);
  if (typ(clg)!=t_VEC  || (lg(clg)!=3 && lg(clg)!=4))
    err(member,"no",mark.member,mark.start);
  return (GEN) clg[1];
}

static GEN
cyc(GEN clg) /* cyclic decomposition (SNF) of a group (of type clgp) */
{
  clg = clgp(clg);
  if (typ(clg)!=t_VEC  || (lg(clg)!=3 && lg(clg)!=4))
    err(member,"cyc",mark.member,mark.start);
  return (GEN) clg[2];
}

static GEN
gen(GEN clg) /* SNF generators of a group (of type clgp) */
{
  clg = clgp(clg);
  if (typ(clg)!=t_VEC || lg(clg)!=4)
    err(member,"gen",mark.member,mark.start);
  return (GEN) clg[3];
}

#define is_ell(x) (typ(x) == t_VEC && lg(x)>=14)
#define is_bigell(x) (typ(x) == t_VEC && lg(x)>=20)

static GEN
a1(GEN x)
{
  if (!is_ell(x)) err(member,"a1",mark.member,mark.start);
  return (GEN)x[1];
}

static GEN
a2(GEN x)
{
  if (!is_ell(x)) err(member,"a2",mark.member,mark.start);
  return (GEN)x[2];
}

static GEN
a3(GEN x)
{
  if (!is_ell(x)) err(member,"a3",mark.member,mark.start);
  return (GEN)x[3];
}

static GEN
a4(GEN x)
{
  if (!is_ell(x)) err(member,"a4",mark.member,mark.start);
  return (GEN)x[4];
}

static GEN
a6(GEN x)
{
  if (!is_ell(x)) err(member,"a6",mark.member,mark.start);
  return (GEN)x[5];
}

static GEN
b2(GEN x)
{
  if (!is_ell(x)) err(member,"b2",mark.member,mark.start);
  return (GEN)x[6];
}

static GEN
b4(GEN x)
{
  if (!is_ell(x)) err(member,"b4",mark.member,mark.start);
  return (GEN)x[7];
}

static GEN
b6(GEN x)
{
  if (!is_ell(x)) err(member,"b6",mark.member,mark.start);
  return (GEN)x[8];
}

static GEN
b8(GEN x)
{
  if (!is_ell(x)) err(member,"b8",mark.member,mark.start);
  return (GEN)x[9];
}

static GEN
c4(GEN x)
{
  if (!is_ell(x)) err(member,"c4",mark.member,mark.start);
  return (GEN)x[10];
}

static GEN
c6(GEN x)
{
  if (!is_ell(x)) err(member,"c6",mark.member,mark.start);
  return (GEN)x[11];
}

static GEN
j(GEN x)
{
  if (!is_ell(x)) err(member,"j",mark.member,mark.start);
  return (GEN)x[13];
}

static GEN
momega(GEN x)
{
  GEN y;

  if (!is_bigell(x)) err(member,"omega",mark.member,mark.start);
  if (gcmp0((GEN)x[19])) err(talker,"curve not defined over R");
  y=cgetg(3,t_VEC); y[1]=x[15]; y[2]=x[16];
  return y;
}

static GEN
meta(GEN x)
{
  GEN y;

  if (!is_bigell(x)) err(member,"eta",mark.member,mark.start);
  if (gcmp0((GEN)x[19])) err(talker,"curve not defined over R");
  y=cgetg(3,t_VEC); y[1]=x[17]; y[2]=x[18];
  return y;
}

static GEN
area(GEN x)
{
  if (!is_bigell(x)) err(member,"area",mark.member,mark.start);
  if (gcmp0((GEN)x[19])) err(talker,"curve not defined over R");
  return (GEN)x[19];
}

static GEN
tate(GEN x)
{
  GEN z = cgetg(3,t_VEC);
  if (!is_bigell(x)) err(member,"tate",mark.member,mark.start);
  if (!gcmp0((GEN)x[19])) err(talker,"curve not defined over a p-adic field");
  z[1]=x[15];
  z[2]=x[16];
  z[3]=x[17]; return z;
}

static GEN
w(GEN x)
{
  if (!is_bigell(x)) err(member,"tate",mark.member,mark.start);
  if (!gcmp0((GEN)x[19])) err(talker,"curve not defined over a p-adic field");
  return (GEN)x[18];
}

/*
 * Only letters and digits in member names. AT MOST 8 of THEM
 * (or modify gp_rl.c::pari_completion)
 */
default_type gp_member_list[] =
{
  { "a1",(void*)a1 },
  { "a2",(void*)a2 },
  { "a3",(void*)a3 },
  { "a4",(void*)a4 },
  { "a6",(void*)a6 },
  { "area",(void*)area },
  { "b2",(void*)b2 },
  { "b4",(void*)b4 },
  { "b6",(void*)b6 },
  { "b8",(void*)b8 },
  { "bnf",(void*)bnf },
  { "c4",(void*)c4 },
  { "c6",(void*)c6 },
  { "clgp",(void*)clgp },
  { "codiff",(void*)codiff },
  { "cyc",(void*)cyc },
  { "diff",(void*)diff },
  { "disc",(void*)disc },
  { "eta",(void*)meta },
  { "fu",(void*)fu },
  { "futu",(void*)futu },
  { "gen",(void*)gen },
  { "j",(void*)j },
  { "mod",(void*)mod },
  { "nf",(void*)nf },
  { "no",(void*)no },
  { "omega",(void*)momega },
  { "pol",(void*)pol },
  { "reg",(void*)reg },
  { "roots",(void*)mroots },
  { "sign",(void*)sign },
  { "tate",(void*)tate },
  { "t2",(void*)t2 },
  { "tu",(void*)tu },
  { "tufu",(void*)tufu },
  { "w",(void*)w },
  { "zk",(void*)zk },
  { "zkst",(void*)zkst },

  { NULL,NULL }
};

static GEN
read_member(GEN x)
{
  static char buf[10];
  default_type dflt;
  long n;

  mark.member = analyseur;
  for (n=0; isalnum(*analyseur) && n<9; n++)
    buf[n] = *analyseur++;
  buf[n]=0; n=0;
  do
  {
    dflt=gp_member_list[n++];
    if (!strcmp(buf,dflt.name))
      return ((GEN (*)(ANYARG)) dflt.fun)(x);
  } while (gp_member_list[n].name);

  err(talker2,"Unknown member function : ",mark.member,mark.start);
  return NULL; /* not reached */
}

/********************************************************************/
/**                                                                **/
/**                        SIMPLE GP FUNCTIONS                     **/
/**                                                                **/
/********************************************************************/

long
check_break_status(long action, GEN *x)
{
  static long status, count;
  static GEN res;

  if (action == NOACTION)
  {
    if (x) *x = res;
    return status;
  }

  switch(action)
  {
    case DOCLEAR:
      status = br_NONE;
      if (res != gnil) killbloc(res);
      res = gnil; return 0;
    case DOBREAK:
      status = br_BREAK; count = (long) x; return 1;
    case DONEXT:
      status = br_NEXT; return 1;
    case DORETURN:
      status = br_RETURN; res = gclone(*x); return 1;

    case DOLOOP: /* for, while, sum */
      switch(status)
      {
	case br_NEXT:
	  status=br_NONE; /* fall through */
	case br_NONE:
	  return 0;

        case br_BREAK:
	  count--;
	  if (!count) status=br_NONE; /* fall through */
        case br_RETURN:
	  return 1;
      }

    case DOFUNCTION:
      switch(status)
      {
	case br_NEXT:
	  status=br_NONE; /* fall through */
	case br_NONE:
	  return 0;

        case br_BREAK: /* possibly "bad break" ?? */
	  status=br_NONE; *x = gnil; return 1;

        case br_RETURN:
	  status=br_NONE; *x = res; return 1;
      }
  }
  return 0; /* not reached */
}

void
return0(GEN x)
{
  check_break_status(DORETURN, &x);
}

void
next0()
{
  check_break_status(DONEXT, NULL);
}

void
break0(long n)
{
  if (n < 1)
    err(talker2,"positive integer expected: ",mark.identifier,mark.start);
  check_break_status(DOBREAK, (GEN *)n);
}

void
alias0(char *s, char *old)
{
  entree *ep;
  long hash;
  
  ep = is_entry(old, functions_hash);
  if (!ep) err(talker2,"unknown function: ",mark.raw,mark.start);
  if (EpVALENCE(ep)==EpVAR)
    err(talker2,"only functions can be aliased: ",mark.raw,mark.start);

  if (is_entry_intern(s, functions_hash, &hash))
    err(talker2, "can't replace an existing symbol by an alias:\n   ",
        mark.raw, mark.start);
  ep = do_alias(ep);
  installep((void *)ep, s, strlen(s), EpALIAS, 0, functions_hash + hash);
}
