/*******************************************************************/
/*******************************************************************/
/**                                                               **/
/**                        PARI CALCULATOR                        **/
/**                                                               **/
/**                      copyright Babe Cool                      **/
/**                                                               **/
/*******************************************************************/
/*******************************************************************/
/* $Id: gp.c,v 2.0.0.2 1997/12/14 20:11:49 karim Exp karim $ */
#include <time.h>
#include <sys/time.h>
#include <sys/types.h>
#include "genpari.h"
#include "anal.h"
#include "gp.h"

#ifdef HAS_TIOCGWINSZ
#  include <sys/termios.h>
#endif

#ifndef READLINE
   void init_readline(int i) { return; }
#else
   void init_readline (int under_emacs);
BEGINEXTERN
#  include <readline.h>
   extern int isatty(int);
   extern void add_history();
ENDEXTERN
#endif

char*  _analyseur(void);
void   err_recover(long numerr);
char** gp_expand_path(char *v);
int    gp_init_entrees(module *modlist, entree **hash, int force);
void   aide(char *s, int long_help);
void   init80(long n);
void   init_graph(void);
void   free_graph(void);
void   init_defaults(int force);
long   gptimer(void);
void   write1(char *s, GEN x);

static void escape(char *tch);
static void setdefault(char *a, char *b, int status);
static void setdtimer(char *v, int silent);
static void gp_head();

#define MAX_PATH_LEN 1024
#define MAX_PROMPT_LEN 128
#define MAX_BUFFER 64
static GEN *g;
static char path[MAX_PATH_LEN],*bufferlist[MAX_BUFFER];
static char prompt[MAX_PROMPT_LEN], thestring[256], *help_prg;
static long prettyp, test_mode, under_emacs, gpsilent, simplifyflag;
static long chrono, pariecho, primelimit, parisize, strictmatch;
static long bufferindex, tglobal, histsize, paribuffsize;
static gp_format fmt;

#define LBRACE '{'
#define RBRACE '}'

static void
usage(char *s)
{
  printf("### Usage: "); printf(s);
  printf(" [-f] [-s stacksize] [-p primelimit] [-b buffersize]\n\n");
  exit(0);
}

/* must be called BEFORE init() */
static void
gp_preinit(int force)
{
  static char *dflt;
  char *help;
  long i;

  if (force)
  {
    parisize = 4000000; primelimit = 500000;
    dflt = "? ";
#ifdef macintosh
# ifndef __MWERKS__
    dflt = "?\n";
    parisize = 1000000; primelimit = 200000;
# endif
#else
# ifdef LONG_IS_64BIT 
    parisize = 10000000;
# endif
#endif
  }
  strcpy(prompt, dflt);

#ifdef UNIX
  strcpy(path,".:~:~/gp");
  help = getenv("GPHELP");
# ifdef GPHELP
    if (!help) help = GPHELP;
# endif
#else
  strcpy(path,".");
  help = NULL;
#endif
  if (!help) help_prg = NULL;
  else
  {
    help_prg = gpmalloc(1+strlen(help));
    strcpy(help_prg,help);
  }

  prettyp = f_PRETTYMAT;
  strictmatch = simplifyflag = 1;
  tglobal = bufferindex = 0;
  test_mode = under_emacs = chrono = pariecho = 0; 
  fmt.format = 'g'; fmt.field = 0;
#ifdef LONG_IS_64BIT
  fmt.nb = 38;
#else
  fmt.nb = 28;
#endif
  histsize = 5000; paribuffsize = 30000;
  g = (GEN *) gpmalloc(sizeof(GEN)*(histsize+1));
  for (i=0; i<=histsize;i++) g[i]=NULL;
  for (i=0; i<c_LAST; i++) gp_colors[i] = c_NONE;
}

#define GET_SEP_SIZE 128
#define separe(c)  ((c)==';' || (c)==':')

/* Return all chars, up to next separator */
static char*
get_sep(char *t)
{
  static char s[GET_SEP_SIZE];
  int i=0, outer=1, I=GET_SEP_SIZE-1;
  char c;
  
  while (i<I)
  {
    c = s[i++] = *t++;
    if (c == '"' && (outer || s[i-2] != '\\')) outer = !outer;
    if (!*t || (outer && separe(*t)) ) break;
  }
 /* if (i==GET_SEP_SIZE) ... */
  s[i]=0; return s;
}

static long
get_int(char *s, long dflt)
{
  char *p=get_sep(s);
  long n=atol(p);

  if (*p == '-') p++;
  while(isdigit(*p)) { p++; dflt=n; }
  if (*p) 
    err(talker2,"I was expecting an integer here: ", s, s);
  return dflt;
}

/********************************************************************/
/*                                                                  */
/*                         GESTION du .gprc                         */
/*                                                                  */
/********************************************************************/

static void
err_initrc(char *s)
{
  pariputs("   ### in gprc: ");
  pariputs(s); pariputc('\n');
  exit(1);
}

#ifndef UNIX
  static char *gp_initrc() { return NULL; }
#else
#  define _INCLUDE_POSIX_SOURCE
#  include <pwd.h>
#  include <unistd.h>
#  include <sys/types.h>

#define BIGENOUGH 8192
static char *
gp_initrc()
{
  char  str[BIGENOUGH], *precmd, *v, *lim, *env = getenv("GPRC");
  FILE *file;

  if (env) sprintf(str,"%s",env);
  else
  {
    env = getenv("HOME");
    if (! env)
    {
      struct passwd *p = getpwuid(geteuid());
      if (!p) return NULL;
      env = p->pw_dir;
    }
    sprintf(str,"%s/.gprc",env);
  }
  if (! (file=fopen(str,"r")) ) return NULL;

  precmd = (char *) malloc(BIGENOUGH);
  v = precmd; lim = v + BIGENOUGH;
  *precmd=0; errfile=stderr; try_to_recover=0;
  for(;;)
  {
    long len;
    char *s1,*s2, *s=str;

    if (!fgets(s,BIGENOUGH,file)) break;
    if (strlen(s) >= BIGENOUGH-1)
      err_initrc("Try inserting some <RET> in your gprc file.");
    do
    {
      filtre(s,f_INIT); s1=get_sep(s); len=strlen(s1); 
      if (!len) continue;
      if (len > GET_SEP_SIZE) err_initrc("Line too long.");
      s+=len; 
      if (!strncmp(s1,"read\"",5))
      {
	char *p = s1+4;

	sprintf(v,"read(\""); v+=6;
	v = readstring(p,v,lim);
	sprintf(v,"\");"); v+=3;
	continue;
      }
      s2=s1; while (*s2 && *s2 != '=') s2++;
      if (*s2 != '=') err_initrc("Missing '='.");
      *s2++ = 0; setdefault(s1,s2,d_INITRC);
    } while (*s++);
  }
  fclose(file); try_to_recover=1;
  return precmd;
}
#undef BIGENOUGH
#endif

/********************************************************************/
/*                                                                  */
/*                           GP MAIN LOOP                           */
/*                                                                  */
/********************************************************************/

static long
get_history(char *s, int check)
{
  char *p=get_sep(s);
  long n=atol(p);

  if (check)
  {
    if (*p == '-') p++;
    while(isdigit(*p)) p++;
    if (*p) 
      err(talker2,"I was expecting an integer here: ", s, s);
  }
  if (!n) n=tglobal;
  if (!tglobal || n>tglobal) return 0;
  if (n <= tglobal-histsize) return -1;
  return n;
}

/* status = ti_NOPRINT   don't print.
 * status = ti_REGULAR   print elapsed time. (usual chrono = 1)
 * status = ti_LAST      print last elapsed time. (##)
 * status = ti_INTERRUPT received a SIGINT.
 */
static char *
do_time(long status)
{
  static long last = 0;
  long delay = gptimer();

  switch(status)
  {
    case ti_NOPRINT:
      last=delay; return NULL;
    case ti_REGULAR:
      sprintf(thestring,"time = "); break;
    case ti_LAST:
      sprintf(thestring,"  ***   last result computed in ");
      delay=last; break;
    case ti_INTERRUPT:
      sprintf(thestring,"user interrupt after "); break;
  }
  last = delay;

  strcat(thestring, term_get_color(c_TIME));
  if (delay >= 3600000)
  {
    sprintf(thestring + strlen(thestring), "%ldh, ", delay / 3600000);
    delay %= 3600000;
  }
  if (delay >= 60000)
  {
    sprintf(thestring + strlen(thestring), "%ldmn, ", delay / 60000);
    delay %= 60000;
  }
  if (delay >= 1000)
  {
    sprintf(thestring + strlen(thestring), "%ld,", delay / 1000);
    delay %= 1000;
    if (delay < 100)
      sprintf(thestring + strlen(thestring), "%s", (delay<10)? "00": "0");
  }
  sprintf(thestring + strlen(thestring), "%ld ms", delay);
  strcat(thestring, term_get_color(c_NONE));
  return thestring;
}

static void
gp_sighandler(int sig)
{
  char *msg;
  switch(sig)
  {
    case SIGINT:
      if (infile != stdin)
      {
	int file_depth = switchin(NULL);
	if (file_depth == -1) { freeall(); exit(0); }
      }
      msg = do_time(ti_INTERRUPT);
      break;

    case SIGSEGV:
      msg="segmentation fault: bug in GP (please report)";
      break;

#ifdef SIGBUS
    case SIGBUS:
      msg="bus error: bug in GP (please report)";
      break;
#endif
    default:
      msg="bug in signal handling (please report)";
  }
  signal(sig,gp_sighandler);
  err(talker,msg);
}

static void
fix_buffer(char **buf, char **s, long *ptr_old, long toadd)
{
  long len = *s - *buf, newlen = len+toadd;
  char *gpbuffer;

  if (newlen <= paribuffsize) return;

  gpbuffer = gprealloc(*buf,newlen,*ptr_old);
  *ptr_old = paribuffsize = newlen;
  *s = gpbuffer+len; *buf = gpbuffer;
  bufferlist[bufferindex] = gpbuffer;
}

static void
gp_output(GEN z)
{
  long tz=typ(z);

  if (fmt.nb >= 0 && is_intreal_t(tz))
    ecrire(z, fmt.format, fmt.nb, fmt.field);
  else
    switch(prettyp)
    {
      case f_RAW      : brute(z, fmt.format, fmt.nb); break;
      case f_PRETTYMAT: matbrute(z, fmt.format, fmt.nb); break;
      case f_PRETTY   : sor(z, fmt.format, fmt.nb, fmt.field); break;
      case f_TEX      : texe(z, fmt.format, fmt.nb); break;
    }
}

void
gp_quit()
{
  free_graph(); freeall();
  while (bufferindex) free((void *)bufferlist[--bufferindex]);
  if (INIT_SIG)
  {
    signal(SIGINT,SIG_DFL);
    signal(SIGSEGV,SIG_DFL);
#ifdef SIGBUS
    signal(SIGBUS,SIG_DFL);
#endif
  }
  term_color(c_NONE);
  pariputs("Good bye!\n"); exit(0);
}

static char *
do_prompt()
{
#ifdef UNIX /* This is probably standard Ansi C. */
  static char promptbuf[128];
  char *s = promptbuf;
  time_t t = time(NULL);

  /* escape sequences bug readline, so use special bracing if available
   * (cf readline.h). Otherwise, first check if relevant colours disabled,
   * then hope for the best...
   */
  if (gp_colors[c_PROMPT] == c_NONE && gp_colors[c_INPUT] == c_NONE)
    strftime(s,79,prompt,localtime(&t));
  else
  {
#  ifdef RL_PROMPT_START_IGNORE
    sprintf(s,"%c%s%c", RL_PROMPT_START_IGNORE, 
                        term_get_color(c_PROMPT),
                        RL_PROMPT_END_IGNORE);
#  else
    strcpy(s, term_get_color(c_PROMPT));
#  endif
    s += strlen(s);
    strftime(s,79,prompt,localtime(&t));
    s += strlen(s);
#  ifdef RL_PROMPT_START_IGNORE
    sprintf(s,"%c%s%c", RL_PROMPT_START_IGNORE, 
                        term_get_color(c_INPUT),
                        RL_PROMPT_END_IGNORE);
#  else
    strcpy(s, term_get_color(c_INPUT));
#  endif
  }
  return promptbuf;
#else
  return prompt;
#endif
}

static int
init_brace_then_filtre(char *tch)
{
  int wait_for_brace = 0;
  char *s=tch;

  while (isspace(*tch)) tch++;
  if (*tch == LBRACE) {*tch=' '; wait_for_brace = 1;}
  if (filtre(s,f_COMMENT)) wait_for_brace = 0;
  filtre(s,f_INIT); return wait_for_brace;
}

/*  GP main loop.
 *  status != MAIN: we are doing an immediate read (with \r, read, etc.)
 *  status == SILENT: keep silent.
 */
static GEN
gp_main_loop(long status)
{
  static long tloc,listloc;
  long av, len, oldsize=paribuffsize;
  int done_already, wait_for_brace, read_done;
#ifdef READLINE
  int already_hist = 0;
#endif
  char *gpbuffer, *tch, *promptbuf;
  GEN z = gnil;

  if (bufferindex >= MAX_BUFFER) err(talker,"Too many nested files");
  bufferlist[bufferindex++] = gpbuffer = (char *) gpmalloc(paribuffsize);
  for(;;)
  {
    added_newline = 1;
    promptbuf = test_mode? prompt: do_prompt();
    /* setdefault can't change the buffer on the fly ==> check every loop. */
    fix_buffer(&gpbuffer,&gpbuffer,&oldsize,paribuffsize);
    if (status == MAIN)
    {
      tloc = tglobal; listloc = marklist();
      if (setjmp(environnement))
      {
	avma = top; tglobal = tloc;
	try_to_recover=0; recover(listloc); try_to_recover=1;
	len = (tglobal % histsize) + 2;
	for (  ; len<=histsize; len++) g[len]=NULL;
	parisize = top - bot;
      }
    }

#ifdef READLINE
#define BIGENOUGH 1024
    if (isatty(fileno(infile)) || (under_emacs && !bufferindex))
    {
      static char tmp_history[BIGENOUGH], previous_hist[BIGENOUGH];
      char *rlbuffer, *index = tmp_history, *lim = index+BIGENOUGH-1;

      done_already=1;
      if (logfile) fputs(promptbuf, logfile);
      for(;;)
      {
	rlbuffer = readline(promptbuf);
	if (!rlbuffer) /* EOF */
	{
	  pariputs("\n"); strcpy(gpbuffer,"\\q");
	  wait_for_brace=0; break;
	}

	/* skip empty lines and comments */
	if (*rlbuffer && strncmp(rlbuffer,"\\\\",2)) break;
	promptbuf = do_prompt();
      } 

      if (rlbuffer)
      {
	len = strlen(rlbuffer);
	if (index+len>=lim)
	  err(talker,"line too big. you should write it to a file instead");
	strcpy(index,rlbuffer); index+=len;
	wait_for_brace = init_brace_then_filtre(rlbuffer);
	fix_buffer(&gpbuffer, &gpbuffer, &oldsize, strlen(rlbuffer)+1);
	strcpy(gpbuffer,rlbuffer); free(rlbuffer);
      }

      /* gpbuffer is never empty at this point */
      tch = gpbuffer;
      if (*tch != '?')
	for(;;)
	{ 
	  tch = gpbuffer + strlen(gpbuffer) - 1;
	  if (wait_for_brace && *tch == RBRACE) {*tch=0; break;}

	  if (*tch != '\\')
	  {
	    /* Recall: comments have already been suppressed */
	    if (!wait_for_brace) break;
	    tch++;
	  } else *tch=0;

	  /* read continuation line */
	  rlbuffer = readline(""); if (!rlbuffer) break;
	  len = strlen(rlbuffer);
	  if (index+len>=lim)
	    err(talker,"line too long. write it to a file first");
	  strcpy(index,rlbuffer); index+=len;
	  filtre(rlbuffer,f_REG);
	  fix_buffer(&gpbuffer, &tch, &oldsize, strlen(rlbuffer)+1);
	  strcpy(tch,rlbuffer); free(rlbuffer);
	}
      
      /* don't add the same history entry twice consecutively */
      if (!already_hist || strcmp(tmp_history, previous_hist))
      {
        strcpy(previous_hist, tmp_history);
        add_history(tmp_history); already_hist = 1;
      }
      /* bug in readline 2.0, which does not unblock ^C */
# ifdef USE_SIGRELSE
      sigrelse(SIGINT);
# elif USE_SIGSETMASK
      sigsetmask(0);
# endif
    }
    else
#undef BIGENOUGH
#endif /* defined(READLINE) */
    {
      done_already = 0;
      if (infile==stdin) pariputs(promptbuf);
      if (!fgets(gpbuffer, paribuffsize, infile))
      {
	int file_depth = switchin(NULL);
	if (file_depth == -1) gp_quit();
	if (status != MAIN) break; 
        continue;
      }
      read_done = (gpbuffer[strlen(gpbuffer)-1] == '\n');
      wait_for_brace = init_brace_then_filtre(gpbuffer);
      if (! *gpbuffer) /* buffer empty */
      {
	if (! wait_for_brace) continue;
	do
	{
	  fgets(gpbuffer, paribuffsize, infile);
	  filtre(gpbuffer,f_REG);
	} while (! *gpbuffer);
      }
    }
    if (pariecho) pariputsf("%s\n",gpbuffer);

    switch(*gpbuffer)
    {
      case '?':
      {
        int flag = h_REGULAR; char *s = gpbuffer + 1;
        if (*s=='?') { flag = h_LONG; s++; }
	aide(s,flag); pariputc('\n'); continue;
      }
      case '\\':
	escape(gpbuffer+1); continue;

      case '#':
        tch = gpbuffer+1;
	if (*tch)
	{
	  int last=0;

	  if (*tch == '#') { tch++; last=1; }
	  if (*tch && !separe(*tch))
	    err(caracer1,tch,gpbuffer);
	  if (last)
	  {
	    pariputs(do_time(ti_LAST));
	    pariputs(".\n"); continue;
	  }
	}
	chrono=1-chrono; setdtimer("",d_ACKNOWLEDGE); continue;

      default:
        if (done_already) break;
	for(;;)
	{
	  tch = gpbuffer + strlen(gpbuffer) - 1;

	  if (wait_for_brace && *tch == RBRACE) {*tch=0; break;}
	  if (*tch != '\\')
	  {
	    if (!wait_for_brace && read_done) break;
	    tch++;
	  } 
	  len = paribuffsize - (tch-gpbuffer);
	  if (len <= 1024)
	  {
	    fix_buffer(&gpbuffer, &tch, &oldsize, paribuffsize);
	    len = paribuffsize - (tch-gpbuffer);
	  }
	  if (!fgets(tch, len, infile)) break;
	  read_done = (gpbuffer[strlen(gpbuffer)-1] == '\n');
	  filtre(tch,f_REG);
          if (pariecho) pariputsf("%s\n",tch);
	}
    }
    tch = gpbuffer + strlen(gpbuffer) - 1;
    gpsilent = (*tch == ';' || *tch == ':' || status == SILENT);
    tch = gpbuffer; pariflush();

    if (!tglobal) timer2();
    gptimer(); av=avma; z = readseq(tch, strictmatch);
    if (chrono)
    { 
      pariputs(do_time(ti_REGULAR)); pariputs(".\n");
    }
    else do_time(ti_NOPRINT);
    if (z == gnil)
    {
      if (!added_newline) pariputc('\n'); /* last output was print1() */
      continue;
    }
    if (simplifyflag) z=simplify(z);

    len = (tglobal % histsize) + 1;
    if (g[len]) killbloc(g[len]);
    g[len] = z = gclone(z); 
    tglobal++; avma=av;

    if (!gpsilent)
    {
      if (test_mode)
      {
        pariputs("% = "); init80(4);
      }
      else 
      {
        if (DEBUGLEVEL > 4)
          fprintferr("prec = [%ld, %ld, %ld]\n",
            prec,precdl,defaultpadicprecision);
        term_color(c_HIST);
        pariputsf("%%%ld = ",tglobal);
        term_color(c_NONE);
      }
      term_color(c_OUTPUT);
      gp_output(z); pariputc('\n'); 
      term_color(c_NONE);
    }
  }
  free(gpbuffer); bufferindex--;
  return z;
}

/* history management function.
 *   If type = -2, called from freeall()
 *   If type = 0 , called from %num in anal.c:truc()
 *   If type > 0 , called from %` in anal.c:truc()
 */
static GEN
gp_history(long p, long type, char *old, char *entrypoint)
{
  long i;

  if (type==-2) { free((void *)g); return NULL; }
  if (!tglobal) err(referer1,old,entrypoint);
  if (type)
  {
    i = (tglobal-1)%histsize + 1 - p;
    if (p >= min(tglobal,histsize) || ! g[i]) err(referer1,old,entrypoint);
    return g[i];
  }
  if (!p) p = tglobal;
  else if (p > tglobal) err(referer2,old,entrypoint);
  i = (p-1)%histsize + 1;
  if (p <= tglobal-histsize || !g[i]) err(referer1,old,entrypoint);
  return g[i];
}

static void
testint(char *s, long *d)
{
  if (!s) return;
  *d = atol(s);
  if (*d <= 0)
    { pariputs("arguments must be positive integers\n"); exit(1); }
}

static char*
read_opt(long argc, char **argv)
{
  char *b=NULL, *p=NULL, *s=NULL, *pre=prompt;
  int i=1;

  outfile=stderr;
  while (i<argc)
  {
    char *tch = argv[i++];

    if (*tch++ != '-') usage(argv[0]);
    switch(*tch)
    {
      case 'b':
	if (i==argc) 
        {
          if (!isdigit(tch[1])) usage(argv[0]);
          b = tch + 1;
        }
        else b = argv[i++];
        break;
      case 'p':
	if (i==argc) 
        {
          if (!isdigit(tch[1])) usage(argv[0]);
          p = tch + 1;
        }
        else p = argv[i++];
	break;
      case 's':
	if (i==argc) 
        {
          if (!isdigit(tch[1])) usage(argv[0]);
          s = tch + 1;
        }
        else s = argv[i++];
	break;

      case 'e': 
	if (!strncmp(tch,"emacs",5)) under_emacs = 1;
        break;
      case 't': 
	if (strncmp(tch,"test",4)) break;
        disable_color = 1;
        test_mode = 1; /* fall through */
      case 'f':
	pre = NULL; break;
      default:
	usage(argv[0]);
    }
  }
  if (pre) pre = gp_initrc();

  /* override the values from gprc */
  testint(b, &paribuffsize);
  testint(p, &primelimit);
  testint(s, &parisize);
  if (under_emacs) { strcpy(prompt, "? "); disable_color = 1; }
  outfile=stdout; return pre;
}

int
main(long argc, char **argv)
{
  char *precmd;

  init_defaults(1); gp_preinit(1); 
#ifdef __MWERKS__
  argc = ccommand(&argv);
#endif
  precmd = read_opt(argc,argv);
  pari_addfunctions(&pari_modules, functions_gp,helpmessages_gp);
  pari_addfunctions(&pari_oldmodules, functions_oldgp,helpmessages_oldgp);

  init_graph(); INIT_SIG_off;
  pari_init(parisize, primelimit);

#ifdef SIGBUS
  signal(SIGBUS,gp_sighandler);
#endif
  signal(SIGINT,gp_sighandler);
  signal(SIGSEGV,gp_sighandler);

  init_readline(under_emacs);
  gp_history_fun = gp_history;
  gp_expand_path(path);

  gp_head(); 
  if (precmd)
  {
    long tmp=chrono;
    chrono=0; lisseq(precmd);
    free(precmd); chrono=tmp;
  }
  gp_main_loop(MAIN);
  gp_quit(); return 0; /* not reached */
}

/********************************************************************/
/*                                                                  */
/*                       GESTION des DEFAULTS                       */
/*                                                                  */
/********************************************************************/

static void
setdrealprecision(char *v, int status)
{
  if (*v)
  {
    long newnb = get_int(v, fmt.nb);

    if (fmt.nb==newnb) return;
    fmt.nb=newnb;

    prec = (long) (fmt.nb*pariK1 + 3);
  }
  if (status != d_ACKNOWLEDGE) return;
  pariputsf("   realprecision = %ld significant digits\n",fmt.nb);
}

static void
setdseriesprecision(char *v, int status)
{
  if (*v)
  {
    long newprecdl = get_int(v, precdl);
    if (precdl==newprecdl) return;
    precdl=newprecdl;
  }
  if (status != d_ACKNOWLEDGE) return;
  pariputsf("   seriesprecision = %ld significant terms\n",precdl);
}

static void 
setdformat(char *v, int status)
{
  if (*v)
  {
    char c = *v;

    if (c!='e' && c!='f' && c!='g')
      err(talker2,"bad format: ",v,v);
    fmt.format = c; v++;

    if (isdigit(*v)) 
      { fmt.field=atol(v); while (isdigit(*v)) v++; }
    if (*v++ == '.')
    {
      if (*v == '-') fmt.nb = -1;
      else
	if (isdigit(*v)) fmt.nb=atol(v);
    }
  }
  if (status != d_ACKNOWLEDGE) return;
  pariputsf("   format = %c%ld.%ld\n", fmt.format, fmt.field, fmt.nb);
}

static void
setdprompt(char *v, int status)
{
  if (*v)
  {
    if (status == d_INITRC) readstring(v,v,v + GET_SEP_SIZE);
    strncpy(prompt,v,MAX_PROMPT_LEN);
#ifdef macintosh
    strcat(prompt,"\n");
#endif
  }
  if (status != d_ACKNOWLEDGE) return;
  pariputsf("   prompt = \"%s\"\n",prompt);
}

static void
setdpath(char *v, int status)
{
  if (*v)
  {
    if (status == d_INITRC) readstring(v,v,v + GET_SEP_SIZE);
    if (strlen(v) >= MAX_PATH_LEN) err(talker,"Path too long");
    strcpy(path,v); if (status == d_INITRC) return;
    gp_expand_path(path);
  }
  if (status != d_ACKNOWLEDGE) return;
  pariputsf("   path = \"%s\"\n",path);
}

static void
setdcolors(char *v, int status)
{
  long c,n;
  if (*v)
  {
    if (status == d_INITRC) readstring(v,v,v + GET_SEP_SIZE);
    disable_color=1;
    for (c=c_ERR; c < c_LAST; c++)
    {
      while (isspace(*v)) v++;
      n = atol(v); if (!isdigit(*v)) n = c_NONE;
      if (n != c_NONE) disable_color=0;
      while (*v && *v++ != ',') /* empty */;
      gp_colors[c] = n;
    }
  }
  if (status != d_ACKNOWLEDGE) return;
  pariputs("   colors = \"");
  for (c=c_ERR; c < c_LAST; c++)
  {
    pariputsf("%d",gp_colors[c]);
    if (c < c_LAST - 1) pariputs(", ");
  }
  pariputs("\"\n");
}

static void 
setdoutput(char *v, int status)
{
  if (*v)
  {
    long newprettyp=get_int(v,0);
    while (isdigit(*v)) v++;
    if (newprettyp>2 || newprettyp<0)
      err(talker,"setdefault: expected value 0, 1, or 2");
    if (prettyp==newprettyp) return;
    prettyp=newprettyp;
  }
  if (status != d_ACKNOWLEDGE) return;
  switch(prettyp)
  {
    case f_PRETTY   : pariputs("   output = 2 (prettyprint)\n"); break;
    case f_PRETTYMAT: pariputs("   output = 1 (prettymatrix)\n"); break;
    case f_RAW      : pariputs("   output = 0 (raw)\n");
  }
}

#define test_flag(l,v) \
  if ((l)>1 || (l)<0) \
    err(talker,"setdefault: expected value 0 or 1.")

static void 
setdtimer(char *v, int status)
{
  if (*v)
  {
    long newchrono=get_int(v,0);
    while (isdigit(*v)) v++;
    test_flag(newchrono,v);
    if (chrono==newchrono) return;
    chrono=newchrono;
  }
  if (status != d_ACKNOWLEDGE) return;
  pariputs( (chrono)
    ? "   timer = 1 (on)\n"
    : "   timer = 0 (off)\n"
  );
}

static void 
setdecho(char *v, int status)
{
  if (*v)
  {
    long newecho=get_int(v,0);
    while (isdigit(*v)) v++;
    test_flag(newecho,v);
    if (pariecho==newecho) return;
    pariecho=newecho;
  }
  if (status != d_ACKNOWLEDGE) return;
  pariputs( (pariecho)
    ? "   echo = 1 (on)\n"
    : "   echo = 0 (off)\n"
  );
}

static void 
setdsimplify(char *v, int status)
{
  if (*v)
  {
    long l=get_int(v,0);
    while (isdigit(*v)) v++;
    test_flag(l,v);
    if (simplifyflag==l) return;
    simplifyflag=l;
  }
  if (status != d_ACKNOWLEDGE) return;
  pariputs( (simplifyflag)
    ? "   simplify = 1 (automatic simplification on)\n"
    : "   simplify = 0 (automatic simplification off)\n"
  );
}

static void
setdlog(char *v, int status)
{
  if (*v)
  {
    long l=get_int(v,0);
    while (isdigit(*v)) v++;
    test_flag(l,v);
    if (l)
    {
      logfile = fopen(current_logfile, "a");
      if (!logfile) 
        err(openfiler,"logfile",current_logfile);
    } else { fclose(logfile); logfile=NULL; }
  }
  if (status != d_ACKNOWLEDGE) return;
  pariputs( logfile ? "   log = 1 (logging on)\n"
                    : "   log = 0 (logging off)\n"
  );
}

static void
setdstrictmatch(char *v, int status)
{
  if (*v)
  {
    long l=get_int(v,0);
    while (isdigit(*v)) v++;
    test_flag(l,v);
    strictmatch = l;
  }
  if (status != d_ACKNOWLEDGE) return;
  pariputs( strictmatch? "   strictmatch = 1 (on)\n"
                       : "   strictmatch = 0 (off)\n"
  );
}

static void
setdlogfile(char *v, int status)
{
  if (*v)
  {
    if (status == d_INITRC) readstring(v,v,v + GET_SEP_SIZE);
    v=expand_tilde(v,thestring);
    strncpy(current_logfile,v,128);
    current_logfile[127]=0;
    if (logfile) { fclose(logfile); setdlog("1",d_INITRC); }
  }
  if (status != d_ACKNOWLEDGE) return;
  pariputsf("   logfile = \"%s\"\n",current_logfile);
}

static void
setdpsfile(char *v, int status)
{
  if (*v)
  {
    if (status == d_INITRC) readstring(v,v,v + GET_SEP_SIZE);
    v=expand_tilde(v,thestring);
    strncpy(current_psfile,v,128);
    current_logfile[127]=0;
  }
  if (status != d_ACKNOWLEDGE) return;
  pariputsf("   psfile = \"%s\"\n",current_psfile);
}

static void
setddebug(char *v, int status)
{
  if (*v)
  {
    long newdebug=get_int(v,0);
    if (DEBUGLEVEL==newdebug) return;
    DEBUGLEVEL=newdebug;
  }
  if (status != d_ACKNOWLEDGE) return;
  pariputsf("   debug = %ld\n", DEBUGLEVEL);
}

static void
setddebugmem(char *v, int status)
{
  if (*v)
  {
    long newdebug=get_int(v,0);
    if (DEBUGMEM==newdebug) return;
    DEBUGMEM=newdebug;
  }
  if (status != d_ACKNOWLEDGE) return;
  pariputsf("   debugmem = %ld\n", DEBUGMEM);
}

static void
setdcompatible(char *v, int status)
{
  if (*v)
  {
    long res, newcompat=get_int(v,0);
    if (compatible==newcompat) return;
    compatible=newcompat;
    if (status == d_INITRC) return;
    if (new_fun_set)
      res = gp_init_entrees(pari_modules, functions_hash, 0);
    else
      res = gp_init_entrees(pari_oldmodules, functions_hash, 0);
    if (res)
      err(warner,"user functions re-initialized");
  }
  if (status != d_ACKNOWLEDGE) return;
  switch(compatible)
  {
    case NONE: 
      pariputs("   compatible = 0 (no backward compatibility)\n");
      break;
    case WARN:
      pariputs("   compatible = 1 (warn when using obsolete functions)\n");
      break;
    case OLDFUN:
      pariputs("   compatible = 2 (use old functions, don't ignore case)\n");
      break;
    case OLDALL:
      pariputs("   compatible = 3 (use old functions, ignore case )\n");
      break;
  }
}

static void
setdprimelimit(char *v, int status)
{
  if (*v)
  {
    long tmp=get_int(v,0);
    unsigned char *ptr;

    if (primelimit==tmp) return;
    if (status != d_INITRC) {ptr=initprimes(tmp); free(diffptr); diffptr=ptr;}
    primelimit=tmp;
  }
  if (status != d_ACKNOWLEDGE) return;
  pariputsf("   primelimit = %ld\n", primelimit);
}

static void
setdparisize(char *v, int status)
{
  if (*v)
  {
    long newsize=get_int(v,0);
    if (parisize==newsize) return;
    if (status != d_INITRC)
    {
      allocatemoremem(newsize);
      parisize=newsize;
      if (parisize && status == d_ACKNOWLEDGE)
	pariputsf("   parisize = %ld\n", parisize);
      longjmp(environnement,errpile);
    }
    parisize=newsize;
  }
  if (status != d_ACKNOWLEDGE) return;
  pariputsf("   parisize = %ld\n", parisize);
}

static void
setdbuffersize(char *v, int status)
{
  if (*v)
  {
    long newsize=get_int(v,0);
    if (paribuffsize==newsize) return;
    paribuffsize=newsize;
  }
  if (status != d_ACKNOWLEDGE) return;
  pariputsf("   buffersize = %ld\n", paribuffsize);
}

static void
setdhelp(char *v, int status)
{
  if (*v)
  {
    if (status == d_INITRC) readstring(v,v,v + GET_SEP_SIZE);
    if (help_prg) free(help_prg);
    v=expand_tilde(v,thestring);
    help_prg = gpmalloc(1+strlen(v));
    strcpy(help_prg,v);
  }
  if (status != d_ACKNOWLEDGE) return;
  pariputsf("   help = \"%s\"\n",help_prg? help_prg:"none");
}

static void
setdhistsize(char *v, int status)
{
  if (*v)
  {
    long i,newsize = get_int(v,0);
    GEN *gg;

    if (newsize==histsize) return;
    if (newsize<1)
      err(talker,"history size must be positive");
    gg = (GEN *) gpmalloc((newsize+1)*sizeof(GEN));
    for (i=0; i<=newsize; i++) gg[i]=NULL;

    if (tglobal)
    {
      long j = (tglobal-1)%newsize + 1;
      long jmin = j - min(newsize,histsize);

      i = (tglobal-1)%histsize + 1;
      for ( ; j>jmin; j--) { gg[j]=g[i]; i--; }
      for ( ; g[i]; i--) killbloc(g[i]);
    }
    free((void*)g); g=gg; histsize=newsize;
  }
  if (status != d_ACKNOWLEDGE) return;
  pariputsf("   histsize = %ld\n",histsize);
}

default_type gp_default_list[] =
{
  {"buffersize",(void*)setdbuffersize},
  {"colors",(void*)setdcolors},
  {"compatible",(void*)setdcompatible},
  {"debug",(void*)setddebug},
  {"debugmem",(void*)setddebugmem},
  {"echo",(void*)setdecho},
  {"format",(void*)setdformat},
  {"help",(void*)setdhelp},
  {"histsize",(void*)setdhistsize},
  {"log",(void*)setdlog},
  {"logfile",(void*)setdlogfile},
  {"output",(void*)setdoutput},
  {"parisize",(void*)setdparisize},
  {"path",(void*)setdpath},
  {"primelimit",(void*)setdprimelimit},
  {"prompt",(void*)setdprompt},
  {"psfile",(void*)setdpsfile},
  {"realprecision",(void*)setdrealprecision},
  {"seriesprecision",(void*)setdseriesprecision},
  {"simplify",(void*)setdsimplify},
  {"strictmatch",(void*)setdstrictmatch},
  {"timer",(void *)setdtimer},
  {NULL,NULL} /* sentinel */
};

static void
help_default()
{
  long n=0;
  default_type dflt;

  do
  {
    dflt=gp_default_list[n++];
    ((void (*)(ANYARG)) dflt.fun)("", d_ACKNOWLEDGE);
  } while (gp_default_list[n].name);
}

/* status = 0: print a message
 * status = 1: don't print a message
 * status = 2: don't print a message (from gprc)
 */
static void
setdefault(char *s,char *v, int status)
{
  long n=0;
  default_type dflt;

  if (!*s) { help_default(); return; }

  do
  {
    dflt=gp_default_list[n++];
    if (!strcmp(s,dflt.name))
    {
      ((void (*)(ANYARG)) dflt.fun)(v,status);
      return;
    }
  } while (gp_default_list[n].name);

  err(talker,"Unknown default: %s",s);
}

/********************************************************************/
/**                                                                **/
/**                    COMMANDES COMMENCANT PAR \                  **/
/**                                                                **/
/**                     ET ANALOGUES DANS ANAL.C                   **/
/**                                                                **/
/********************************************************************/

static void
killall()
{
  long i;
  
  free_graph();
  for (i=1;i<lg(primetab);i++) killbloc((GEN)primetab[i]);
  setlg(primetab,1);

  gpi = geuler = bernzone = NULL;
  for(i=0; i<MAXVARN-1; i++) ordvar[i]=i;
#if 0
  setlg(polvar,1);
  for(i=1; i<MAXVARN; i++)
    polvar[i] = evaltyp(t_VEC) | evallg(1);  
#endif

  init_defaults(1); gp_preinit(0); init_graph(); 
  gp_init_entrees(pari_modules, functions_hash, 1);
}  

static void
print_entree(entree *ep, long hash)
{
  pariputsf(" %s ",ep->name); pariputsf(VOIR_STRING1,(ulong)ep);
  pariputs(":\n");
  pariputsf("   hash = %3ld, valence = %3ld, menu = %2ld, code = %s\n",
          hash, ep->valence, ep->menu, ep->code? ep->code: "NULL");
  if (ep->next)
  {
    pariputsf("   next = %s ",(ep->next)->name);
    pariputsf(VOIR_STRING1,(ulong)(ep->next));
  }
  pariputs("\n");
}

static void
print_hash_list(char *s)
{
  long m,n;
  entree *ep;

  if (isalpha(*s))
  {
    ep = is_entry_intern(s,functions_hash,&n);
    if (!ep) err(talker,"no such function !");

    print_entree(ep,n);
    return;
  }

  if (isdigit(*s) || *s == '$')
  {
    m = functions_tblsz-1; n = atol(s);
    if (*s=='$') n = m;
    if (m<n) err(talker,"invalid range in print_entree");
    while (isdigit(*s)) s++;

    if (*s++ != '-') m = n;
    else
    {
      if (*s !='$') m = min(atol(s),m);
      if (m<n) err(talker,"invalid range in print_entree");
    }
    
    for(; n<=m; n++)
    {
      pariputsf("*** hashcode = %ld\n",n);
      for (ep=functions_hash[n]; ep; ep=ep->next)
	print_entree(ep,n);
    }
    return;
  }

  if (*s=='-')
  {
    for (n=0; n<functions_tblsz; n++)
    {
      m=0;
      for (ep=functions_hash[n]; ep; ep=ep->next) m++;
      pariputsf("%3ld:%3ld ",n,m);
      if (n%9 == 8) pariputc('\n');
    }
    pariputc('\n'); return;
  }

  for (n=0; n<functions_tblsz; n++)
    for (ep=functions_hash[n]; ep; ep=ep->next)
      print_entree(ep,n);
}

/********************************************************************/
/**                                                                **/
/**          AFFICHAGE TYPES, COMMANDES AIDES ET GLOBALES          **/
/**                                                                **/
/********************************************************************/

static int
compare_str(char **s1, char **s2)
{
  return (strcmp (*s1, *s2));
}

static int
term_width_intern()
{ 
  char *str;
#ifdef HAS_TIOCGWINSZ
  struct winsize s;
  if (!under_emacs && !ioctl(0, TIOCGWINSZ, &s)) return s.ws_col;
#endif
#ifdef UNIX
  if ((str = getenv("COLUMNS"))) return atoi(str);
#endif
  return 0;
}

static int
term_height_intern()
{ 
  char *str;
#ifdef HAS_TIOCGWINSZ
  struct winsize s;
  if (!under_emacs && !ioctl(0, TIOCGWINSZ, &s)) return s.ws_row;
#endif
#ifdef UNIX
  if ((str = getenv("ROWS"))) return atoi(str);
#endif
  return 0;
}

#define MAX_TERM_WIDTH 255
#define DFT_TERM_WIDTH  80
#define DFT_TERM_HEIGHT 20

static int
term_width()
{
  int n = term_width_intern();
  return (n>1)? n: DFT_TERM_WIDTH;
}

static int
term_height()
{
  int n = term_height_intern();
  return (n>1)? n: DFT_TERM_HEIGHT;
}

/* Print all elements of list in columns, pausing every nbli lines
 * if nbli is non-zero.
 *
 * list is a NULL terminated list of function names
 */
void 
print_fun_list(char **list, int nbli)
{
  long i=0, j=0, maxlen=0, nbcol,len,v, w = term_width();

  while (list[i]) i++;
  qsort (list, i, sizeof(char *), (int(*)(ANYARG)) compare_str);

  for (v=0; list[v]; v++)
  {
    len = strlen(list[v]);
    if (len > maxlen) maxlen=len;
  }
  maxlen+=1; nbcol= w / maxlen;
  if (nbcol * maxlen == w) nbcol--;
  if (!nbcol) nbcol = 1;

  pariputc('\n'); i=0;
  for (v=0; list[v]; v++)
  {
    pariputs(list[v]); i++;
    if (i >= nbcol)
    {
      i=0; pariputc('\n');
      if (nbli && j++ > nbli)
      {
	pariputs("---- (type return to continue) ----\n");
	getchar(); j=0;
      }
      continue;
    }
    len = maxlen - strlen(list[v]);
    while (len--) pariputc(' ');
  }
  if (i) pariputc('\n');
}

#define LIST_LEN 1023
static void
commands(int n)
{
  int hashpos, s = 0, olds = LIST_LEN;
  entree *ep;
  char **list = (char **) gpmalloc((olds+1)*sizeof(char *));

  for (hashpos = 0; hashpos < functions_tblsz; hashpos++)
    for (ep = functions_hash[hashpos]; ep; ep = ep->next)
      if ((n<0 && ep->menu) || ep->menu == n)
      {
        list[s++] = ep->name;
        if (s >= olds)
        {
	  int news = olds + (LIST_LEN + 1)*sizeof(char *);
          gprealloc(list,news,olds);
	  olds = news;
        }
      }
  list[s]=NULL; print_fun_list(list,term_height()-4); free(list);
}

static void
print_user_fun(entree *ep)
{
  GEN *arg = (GEN*)ep->args;
  entree **q = (entree **)(ep->value);

  q++; /* skip initial NULL */
  pariputs(ep->name); pariputc('(');
  while (*arg)
  {
    pariputs((*q)->name); q++;
    pariputc('='); bruteall(*arg,'g',-1,1); arg++;
    if (! *arg) break;
    pariputs(", ");
  }
  pariputs(") = "); pariputs((char*)q);
}

static void 
user_fun()
{
  entree *ep;
  int hashpos;

  for (hashpos = 0; hashpos < functions_tblsz; hashpos++)
    for (ep = functions_hash[hashpos]; ep; ep = ep->next)
      if (EpVALENCE(ep) == EpUSER)
      {
	pariputc(LBRACE);
	print_user_fun(ep);
	pariputc(RBRACE);
	pariputs("\n\n");
      }
}

static void
gentypes(void)
{
  pariputs("\n\
  List of the PARI types:                                               \n\
  ------------------------                                              \n\
  t_INT    : long integers     [ cod1 ] [ cod2 ] [ man_1 ] ... [ man_k ]\n\
  t_REAL   : long real numbers [ cod1 ] [ cod2 ] [ man_1 ] ... [ man_k ]\n\
  t_INTMOD : integermods       [ code ] [ mod  ] [ integer ]            \n\
  t_FRAC   : irred. rationals  [ code ] [ num. ] [ den. ]               \n\
  t_FRACN  : rational numbers  [ code ] [ num. ] [ den. ]               \n\
  t_COMPLEX: complex numbers   [ code ] [ real ] [ imag ]               \n\
  t_PADIC  : p-adic numbers    [ cod1 ] [ cod2 ] [ p ] [ p^r ] [ int ]  \n\
  t_QUAD   : quadratic numbers [ cod1 ] [ mod  ] [ real ] [ imag ]      \n\
  t_POLMOD : poly mod          [ code ] [ mod  ] [ polynomial ]         \n\
  -------------------------------------------------------------         \n\
  t_POL    : polynomials       [ cod1 ] [ cod2 ] [ man_1 ] ... [ man_k ]\n\
  t_SER    : power series      [ cod1 ] [ cod2 ] [ man_1 ] ... [ man_k ]\n\
  t_RFRAC  : irred. rat. func. [ code ] [ num. ] [ den. ]               \n\
  t_RFRACN : rational function [ code ] [ num. ] [ den. ]               \n\
  t_QFR    : real qfb          [ code ] [ a ] [ b ] [ c ] [ del ]       \n\
  t_QFI    : imaginary qfb     [ code ] [ a ] [ b ] [ c ]               \n\
  t_VEC    : row vector        [ code ] [  x_1  ] ... [  x_k  ]         \n\
  t_COL    : column vector     [ code ] [  x_1  ] ... [  x_k  ]         \n\
  t_MAT    : matrix            [ code ] [ col_1 ] ... [ col_k ]         \n\
  t_LIST   : list              [ code ] [ cod2 ] [ x_1 ] ... [ x_k ]    \n\
  t_STR    : string            [ code ] [ man_1 ] ... [ man_k ]         \n\
\n");
}

static void
menu_commands(void)
{
  pariputs("\n\
  0: list of user-defined identifiers (variable, alias, function)\n\
  1: Standard monadic or dyadic OPERATORS           \n\
  2: CONVERSIONS and similar elementary functions   \n\
  3: TRANSCENDENTAL functions                       \n\
  4: NUMBER THEORETICAL functions                   \n\
  5: Functions related to ELLIPTIC CURVES           \n\
  6: Functions related to general NUMBER FIELDS     \n\
  7: POLYNOMIALS and power series                   \n\
  8: Vectors, matrices, LINEAR ALGEBRA and sets     \n\
  9: SUMS, products, integrals and similar functions\n\
 10: GRAPHIC functions                              \n\
 11: PROGRAMMING under GP                           \n\
\n\
Further help: ?n (1<=n<=11). Also available:       \n\
  ? functionname (short on-line help)              \n\
  ?\\             (keyboard shortcuts)             \n\
  ?.             ( member functions )              \n\
and finally ?? keyword for extended help.\n");
}

static void
slash_commands(void)
{
  pariputs("\
 #       : enable/disable timer                          \n\
 ##      : print time for last result                    \n\
 \\\\      : comment up to end of line                   \n\
 \\a {n}  : print result in raw format (readable by PARI)\n\
 \\b {n}  : print result in beautified format            \n\
 \\c      : list all commands (same effect as ?*)        \n\
 \\d      : print all defaults                           \n\
 \\e      : enable/disable echo                          \n\
 \\g {n}  : set debugging level                          \n\
 \\gm{n}  : set memory debugging level                   \n\
 \\h {n-n}: hashtable information                        \n\
 \\k      : kill current GP session but do not exit      \n\
 \\l      : enable/disable logfile                       \n\
 \\m {n}  : print result in prettymatrix format          \n\
 \\p {n}  : change real precision                        \n\
 \\ps{n}  : change series precision                      \n\
 \\q      : quit completely this GP session              \n\
 \\r {f}  : read a file                                  \n\
 \\s {n}  : print stack information                      \n\
 \\t      : print the list of PARI types                 \n\
 \\u      : print the list of user-defined functions     \n\
 \\v      : print current version of GP                  \n\
 \\w {nf} : write to a file                              \n\
 \\x      : print complete inner structure of last result\n\
 \\y      : disable/enable automatic simplification      \n\
\n\
 {f}=optional filename. {n}=optional integer\n");
}

static void
member_commands(void)
{
  pariputs("\n\
  Member functions, followed by relevant objects\n\n\
  a1-a6, b2-b8, c4-c6 : coeff. of the curve.            ell              \n\
  area : area                                           ell              \n\
  bnf  : big number field                                        bnf, bnr\n\
  clgp : classgroup                                              bnf, bnr\n\
  cyc  : cyclic decomposition (SNF)               clgp           bnf, bnr\n\
  diff, codiff : different and codifferent                   nf, bnf, bnr\n\
  disc : discriminant                                   ell, nf, bnf, bnr\n\
  fu   : fundamental units                                       bnf, bnr\n\
  futu : [u,w] where u=unit group, w=torsion                     bnf, bnr\n\
  gen  : generators                               clgp           bnf, bnr\n\
  j    : j-invariant                                    ell              \n\
  mod  : modulus                                                         \n\
  nf   : number field                                        nf, bnf, bnr\n\
  no   : number of elements                       clgp           bnf, bnr\n\
  omega, eta : [omega1,omega2] and [eta1, eta2]         ell              \n\
  pol  : defining polynomial                                 nf, bnf, bnr\n\
  reg  : regulator                                               bnf, bnr\n\
  roots: roots                                          ell  nf, bnf, bnr\n\
  sign : signature                                           nf, bnf, bnr\n\
  t2   : t2 matrix                                           nf, bnf, bnr\n\
  tate : Tate's [u^2,u,q]                               ell              \n\
  tu   : torsion units                                           bnf, bnr\n\
  tufu : [w,u] where u=unit group, w=torsion                     bnf, bnr\n\
  w    : Mestre's w                                     ell              \n\
  zk   : integral basis                                      nf, bnf, bnr\n\
  zkst : structure of (Z_K/m)^* (valid for idealstar also)            bnr\n");
}

#define is_blank_or_null(c) (!(c) || is_blank(c))
#define is_blank(c) ((c) == ' ' || (c) == '\n')

static void
print_help(char *s)
{
  long oldlen=0, linelen=0, w = term_width();
  char word[MAX_TERM_WIDTH+1], oldword[MAX_TERM_WIDTH+1], *u=word;

  oldword[0]='\0';
  while ((*u++ = *s++))
  {
    if is_blank_or_null(*s)
    {
      while (is_blank(*s)) s++;
      linelen+=oldlen;
      if (linelen >= w) { pariputc('\n'); linelen=oldlen; }
      pariputs(oldword); *u++=' '; *u='\0'; oldlen=u-word;
      if (*s) { strcpy(oldword,word);  u=word; }
    }
  }
  *(u-2)='.'; if (linelen+oldlen >= w) pariputc('\n');
  pariputs(word); pariputc('\n');
}

#ifdef UNIX

static void
external_help(char *s)
{
  char buf[1024];
  FILE *file;

  if (!help_prg)
    err(talker,"No available external help program");

  sprintf(thestring,"%s -fromgp %c%s%c",help_prg,SHELL_Q,s,SHELL_Q);
  file = (FILE *) popen(thestring,"r");
  if (!file) err(talker,"%s %s failed !",GPHELP,s);

  while (fgets(buf,1023,file)) 
  {
    buf[1023]=0;
    if (!strncmp("ugly_kludge_done",buf,16)) break;
    pariputs(buf);
  }
  pclose(file);
}

#else

void
external_help(char *s) { err(archer); }

#endif

char *keyword_list[]={
  "readline",
  "nf",
  "bnf",
  "bnr",
  "ell",
  NULL
};

static int
check_keyword(char *s)
{
  long n=0;

  if (!isalpha(*s)) return 1; /* operator or section number */

#if 0
  if (!strncmp(s,"t_",2)) return 1; /* type name . Chapter 2 !!!*/
#endif

  for (n=0; keyword_list[n]; n++)
    if (!strcmp(s,keyword_list[n]))
      return 1;
  return 0;
}

static void
aide0(char *s, int flag)
{
  long n, long_help = flag & h_LONG;
  entree *ep,*ep1;

  s = get_sep(s);
  if (isdigit(*s))
  {
    n=atoi(s);
    if (n<0 || n > 11)
      err(talker2,"no such section in help: ?",s,s);
    commands(n); return;
  }
  if (*s && long_help && check_keyword(s))
    { external_help(s); return; }
  switch (*s)
  {
    case '*' : commands(-1); return;
    case '\0': menu_commands(); return;
    case '\\': slash_commands(); return;
    case '.' : member_commands(); return;
  }
  ep = is_entry(s, functions_hash);
  if (!ep) 
  { /* Not found; don't mess readline display */
    if (flag & h_RL) return;
    err(talker,"unknown identifier");
  }
  if (flag & h_RL) pariputc('\n');

  ep1 = ep;  ep = do_alias(ep);
  if (ep1 != ep) { pariputs(s); pariputs(" is aliased to:\n\n"); }

  switch(EpVALENCE(ep))
  {
    case EpUSER:
      print_user_fun(ep);
      if (!ep->help) return;
      pariputs("\n\n"); long_help=0; break;
  
    case EpVAR:
      if (!ep->help)
      {
        if (flag & h_RL) 
          { pariputs("user defined variable\n"); return; }
        err(talker,"user defined variable");
      }
      long_help=0; break;

    case EpINSTALL:
      if (!ep->help)
      {
        if (flag & h_RL)
          { pariputs("installed function\n"); return; }
        err(talker,"installed function");
      }
      long_help=0; break;
  }
  if (long_help) { external_help(s); return; }
  if (ep->help) { print_help(ep->help); return; }

  err(bugparier,"aide (no help found)");
}

void
aide(char *s, int flag)
{
  term_color(c_HELP); aide0(s,flag); term_color(c_NONE);
}

#define center(s) pariputs(centerstring(s))
static char *
centerstring(char *s)
{
  long i, pad = term_width() - strlen(s);
  char *u = thestring;
  
  if (pad<0) pad=0; else pad >>= 1;
  for(i=0; i<pad; i++) *u++ = ' ';
  while(*s) *u++ = *s++;
  *u++='\n'; *u=0; return thestring;
}

#define BIGENOUGH 256
static void
print_version()
{
  int help = 0, rl = 0;
  char buf[BIGENOUGH], *rl_s, *help_s;

  center(PARIVERSION); center(PARIINFO);
#ifdef READLINE
  rl = 1;
#endif
#ifdef UNIX
  if (help_prg)
  {
    char *s = help_prg, *sbuf = buf, *lim = buf + BIGENOUGH;
    FILE *file;

    while (*s && *s != ' ' && sbuf < lim-1) *sbuf++ = *s++;
    *sbuf = 0; file = (FILE *) fopen(buf,"r");
    if (file) { help = 1; fclose(file); }
  }
#endif
  rl_s   = rl? "enabled": "disabled";
  help_s = help? "": " not";
  sprintf(buf,"(readline %s, extended help%s available)", rl_s, help_s);
  center(buf);
}
#undef BIGENOUGH

static void
gp_head()
{
  print_version(); pariputs("\n");
  center("Copyright 1989-1997 by");
  center("C. Batut, K. Belabas, D. Bernardi, H. Cohen and M. Olivier.");
  pariputs("\nType ? for help.\n\n");

  setdrealprecision("",d_ACKNOWLEDGE);
  setdseriesprecision("",d_ACKNOWLEDGE);
  setdformat("",d_ACKNOWLEDGE);
  pariputsf("\nparisize = %ld, primelimit = %ld, buffersize = %ld\n",
               parisize, primelimit, paribuffsize);
}

static void
escape(char *tch)
{
  char *s = tch;
  long check = 1;

  if (compatible != NONE)
  {
    while (*s && *s != '=') s++;
    if (*s)
    {
      int done = 1, len = s-tch;
      
      s = get_sep(s+1);
      if (!strncmp(tch,"precision",len))
	setdrealprecision(s,d_ACKNOWLEDGE);
      else if (!strncmp(tch,"serieslength",len))
	setdseriesprecision(s,d_ACKNOWLEDGE);
      else if (!strncmp(tch,"format",len))
	setdformat(s,d_ACKNOWLEDGE);
      else if (!strncmp(tch,"prompt",len))
	setdprompt(s,d_ACKNOWLEDGE);
      else done=0;

      if (done) return;
    }
  }

  s = tch+1;
  switch (*tch++)
  {
    case 'x': s = "";           
    case 'w': check = 0;
    case 'a': case 'b': case 'm': /* history things, fall through */
    {
      long d = get_history(s,check);

      if (d<0) err(referer1,tch,tch-2);
      if (!d) err(referer2,tch,tch-2);

      switch (tch[-1])
      {
	case 'a': brute   (g[d], fmt.format, -1); break;
	case 'm': matbrute(g[d], fmt.format, -1); break;
	case 'b': sor     (g[d], fmt.format, -1, fmt.field); break;

	case 'x': voir(g[d], get_int(tch, -1)); return;
        case 'w':
	  while (isdigit(*tch)) tch++;
	  write1(get_sep(tch), g[d]); return;
      }
      pariputc('\n'); return;
    }

    case 'c': commands(-1); break;
    case 'd': help_default(); break;
    case 'e': setdecho(pariecho?"0":"1",d_ACKNOWLEDGE); break;
    case 'g':
      switch (*tch)
      {
        case 'm': setddebugmem(++tch,d_ACKNOWLEDGE); break;
        default : setddebug(tch,d_ACKNOWLEDGE); break;
      }
      break;
    case 'h': print_hash_list(tch); break;
    case 'k': killall(); gp_head(); break;
    case 'l': setdlog(logfile?"0":"1",d_ACKNOWLEDGE); break;
    case 'p':
      switch (*tch)
      {
        case 's': setdseriesprecision(++tch,d_ACKNOWLEDGE); break;
        default : setdrealprecision(tch,d_ACKNOWLEDGE); break;
      }
      break;
    case 'q': gp_quit(); break;
    case 'r': switchin_byname(get_sep(tch)); break;
    case 's': etatpile(0); break;
    case 't': gentypes(); break;
    case 'u': user_fun(); break;
    case 'v': print_version(); break;
    case 'y': setdsimplify(simplifyflag?"0":"1",d_ACKNOWLEDGE); break;
    default: err(caracer1,tch-1,tch-2);
  }
}

typedef struct whatnow_t
{
  char *name, *oldarg, *newarg;
} whatnow_t;

#define STILL NULL
#define OUT (char *) 1

/* generated by PERL script ../util/dico */
static const whatnow_t whatnowlist[]={
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{"elladd","(e,z1,z2)","(e,z1,z2)"},
{STILL,0,0},
{"matadjoint","(x)","(x)"},
{STILL,0,0},
{"ellak","(e,n)","(e,n)"},
{STILL,0,0},
{"algdep","(x,n,dec)","(x,n,dec)"},
{"nfalgtobasis","(nf,x)","(nf,x)"},
{"ellan","(e,n)","(e,n)"},
{"ellap","(e,n)","(e,n)"},
{"ellap","(e,n)","(e,n,1)"},
{"padicappr","(x,a)","(x,a)"},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{"matcompanion","(x)","(x)"},
{STILL,0,0},
{STILL,0,0},
{"nfbasis","(x)","(x)"},
{"nfbasis","(x)","(x,2)"},
{"nfbasistoalg","(nf,x)","(nf,x)"},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{"ellbil","(e,z1,z2)","(e,z1,z2)"},
{"binomial","(x,y)","(x,y)"},
{STILL,0,0},
{STILL,0,0},
{"contfrac","(x,lmax)","(x,,lmax)"},
{"factor","(x,lim)","(x,lim)"},
{"bnfcertify","(bnf)","(bnf)"},
{"bnfunit","(bnf)","(bnf)"},
{"bnfclassunit","(P)","(P,2)"},
{"bnfclassunit","(P)","(P,1)"},
{"bnfclassunit","(P)","(P)"},
{"quadclassunit","(D,c1,c2,g)","(D,,[c1,c2,g])"},
{"bnfinit","(P)","(P,2)"},
{"bnfinit","(P)","(P,1)"},
{"bnfinit","(P)","(P)"},
{"bnfnarrow","(bnf)","(bnf)"},
{"bnrclass","(bnf,ideal)","(bnf,ideal)"},
{"bnrclass","(bnf,ideal)","(bnf,ideal,1)"},
{"bnrclass","(bnf,ideal)","(bnf,ideal,2)"},
{"quadclassunit","(D)","(D)"},
{"sizebyte","(x)","(x)"},
{STILL,0,0},
{STILL,0,0},
{"contfrac","(x)","(x)"},
{"contfrac","(b,x)","(x,b)"},
{STILL,0,0},
{"charpoly","(x,y)","(x,y)"},
{"charpoly","(x,y)","(x,y,1)"},
{"charpoly","(x,y)","(x,y,2)"},
{"ellchangecurve","(x,y)","(x,y)"},
{STILL,0,0},
{"ellchangepoint","(x,y)","(x,y)"},
{"qfbclassno","(x)","(x)"},
{"qfbclassno","(x)","(x,1)"},
{"polcoeff","(x,s)","(x,s)"},
{"x*y","(x,y)",""},
{"component","(x,s)","(x,s)"},
{"polcompositum","(pol1,pol2)","(pol1,pol2)"},
{"polcompositum","(pol1,pol2)","(pol1,pol2,1)"},
{"qfbcompraw","(x,y)","(x,y)"},
{STILL,0,0},
{"bnrconductor","(a1)","(a1)"},
{"bnrconductorofchar","(bnr,chi)","(bnr,chi)"},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{"serconvol","(x,y)","(x,y)"},
{STILL,0,0},
{"core","(x)","(x,1)"},
{STILL,0,0},
{"coredisc","(x)","(x,1)"},
{STILL,0,0},
{STILL,0,0},
{"truncate","(x)","(x,1)"},
{"polcyclo","(n)","(n)"},
{"factorback","(fa)","(fa)"},
{"bnfdecodemodule","(nf,fa)","(nf,fa)"},
{"poldegree","(x)","(x)"},
{"denominator","(x)","(x)"},
{"lindep","(x)","(x,-1)"},
{STILL,0,0},
{"matdet","(x)","(x)"},
{"matdet","(x)","(x,1)"},
{"matdetint","(x)","(x)"},
{"matdiagonal","(x)","(x)"},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{"poldisc","(x)","(x)"},
{"nfdisc","(x)","(x)"},
{"nfdisc","(x)","(x,2)"},
{"bnrdisc","(bnr,subgroup)","(bnr,subgroup)"},
{"bnrdisc","(bnr)","(bnr,,,2)"},
{"bnrdisclist","(bnf,list)","(bnf,list)"},
{"bnrdisclist","(bnf,arch,bound)","(bnf,bound,arch)"},
{"bnrdisclist","(bnf,bound)","(bnf,bound,,1)"},
{"bnrdisclist","(bnf,bound)","(bnf,bound)"},
{"bnrdisc","(bnr,subgroup)","(bnr,subgroup,,1)"},
{"bnrdisc","(bnr,subgroup)","(bnr,subgroup,,3)"},
{STILL,0,0},
{"divrem","(x,y)","(x,y)"},
{"sumdiv","(n,X,expr)","(n,X,expr)"},
{"mateigen","(x)","(x)"},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{"Euler","",""},
{STILL,0,0},
{STILL,0,0},
{"vecextract","(x,y)","(x,y)"},
{"factorial","(x)","(x)"},
{"factorcantor","(x,p)","(x,p)"},
{"factorff","(x,p,a)","(x,p,a)"},
{"factormod","(x,p)","(x,p)"},
{STILL,0,0},
{"nfbasis","(x,p)","(x,,p)"},
{"nfdisc","(x,p)","(x,,p)"},
{"polred","(x,p)","(x,,p)"},
{"polred","(x,p)","(x,2,p)"},
{STILL,0,0},
{STILL,0,0},
{"factorpadic","(x,p,r)","(x,p,r,1)"},
{"factor","(x,l,hint)","(x)"},
{"factor","(x,l,hint)","(x)"},
{"fibonacci","(x)","(x)"},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{"ffinit","(p,n)","(p,n)"},
{STILL,0,0},
{"polgalois","(x)","(x)"},
{"nfgaloisapply","(nf,aut,x)","(nf,aut,x)"},
{"nfgaloisconj","(nf)","(nf)"},
{"nfgaloisconj","(nf)","(nf,2)"},
{"nfgaloisconj","","(nf,1)"},
{"gammah","(x)","(x)"},
{STILL,0,0},
{"matsolve","(a,b)","(a,b)"},
{"matsolvemod","(M,D,Y)","(M,D,Y)"},
{"matsolvemod","(M,D,Y)","(M,D,Y,1)"},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{"ellglobalred","(x,y)","(x,y)"},
{OUT,0,0},
{"qfbhclassno","(x)","(x)"},
{"ellheight","(e,x)","(e,x)"},
{"ellheight","(e,x)","(e,x,1)"},
{"mathnf","(x)","(x,1)"},
{"mathnf","(x)","(x,1)"},
{"mathnf","(x)","(x,2)"},
{"mathnfmod","(x,d)","(x,d)"},
{"mathnfmodid","(x,d)","(x,d)"},
{"mathnf","(x)","(x,3)"},
{"mathess","(x)","(x)"},
{"hilbert","(x,y)","(x,y)"},
{"mathilbert","(n)","(n)"},
{"hilbert","(x,y,p)","(x,y,p)"},
{"vector","(n,X,expr)","(n,X,expr)"},
{STILL,0,0},
{"I","",""},
{STILL,0,0},
{"idealaddtoone","(nf,list)","(nf,list)"},
{"idealaddtoone","(nf,x,y)","(nf,x,y)"},
{STILL,0,0},
{"idealappr","(nf,x)","(nf,x,1)"},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{"idealdiv","(nf,x,y)","(nf,x,y,1)"},
{STILL,0,0},
{"idealhnf","(nf,x)","(nf,x)"},
{"idealhnf","(nf,x)","(nf,x)"},
{STILL,0,0},
{STILL,0,0},
{"idealinv","(nf,x)","(nf,x,1)"},
{STILL,0,0},
{STILL,0,0},
{"ideallistarch","(nf,list,arch)","(nf,list,arch,1)"},
{"ideallist","(nf,list)","(nf,list,2)"},
{"ideallistarch","","(nf,list,arch,2)"},
{"ideallistarch","","(nf,list,arch,3)"},
{"ideallist","","(nf,list,3)"},
{"ideallist","(nf,bound)","(nf,bound)"},
{"ideallist","(nf,bound)","(nf,bound,1)"},
{"idealred","(nf,x,vdir)","(nf,x,vdir)"},
{STILL,0,0},
{"idealmul","(nf,x,y)","(nf,x,y,1)"},
{STILL,0,0},
{STILL,0,0},
{"idealpow","(nf,x,y)","(nf,x,y,1)"},
{STILL,0,0},
{"idealtwoelt","(nf,x,a)","(nf,x,a)"},
{STILL,0,0},
{"matid","(n)","(n)"},
{STILL,0,0},
{STILL,0,0},
{"matimage","(x)","(x)"},
{"matimage","(x)","(x,1)"},
{"matimagecompl","(x)","(x)"},
{STILL,0,0},
{OUT,0,0},
{OUT,0,0},
{OUT,0,0},
{"incgam","(s,x,y)","(s,x,y)"},
{"matindexrank","(x)","(x)"},
{"vecindexsort","(x)","(x)"},
{"nfinit","(pol)","(pol)"},
{"nfinit","(x)","(x,2)"},
{"nfinit","(x)","(x,3)"},
{"ellinit","(x)","(x)"},
{"zetakinit","(x)","(x)"},
{"intformal","(x,y)","(x,y)"},
{"matintersect","(x,y)","(x,y)"},
{"intnum","(x=a,b,s)","(x=a,b,s,1)"},
{"intnum","(x=a,b,s)","(x=a,b,s,2)"},
{STILL,0,0},
{"intnum","(x=a,b,s)","(x=a,b,s,3)"},
{"matinverseimage","(x,y)","(x,y)"},
{"matisdiagonal","(x)","(x)"},
{"isfundamental","(x)","(x)"},
{"nfisideal","(nf,x)","(nf,x)"},
{"nfisincl","(x,y)","(x,y)"},
{"nfisincl","(nf1,nf2)","(nf1,nf2,1)"},
{"polisirreducible","(x)","(x)"},
{"nfisisom","(x,y)","(x,y)"},
{"nfisisom","(nf1,nf2)","(nf1,nf2,1)"},
{"ellisoncurve","(e,x)","(e,x)"},
{STILL,0,0},
{"bnfisprincipal","(bnf,x)","(bnf,x,0)"},
{"bnfisprincipal","(bnf,x)","(bnf,x,2)"},
{"bnfisprincipal","(bnf,x)","(bnf,x)"},
{"bnfisprincipal","(bnf,x)","(bnf,x,3)"},
{"bnrisprincipal","(bnf,x)","(bnf,x)"},
{STILL,0,0},
{"ispseudoprime","(x)","(x)"},
{"sqrtint","(x)","(x)"},
{"setisset","(x)","(x)"},
{"issquarefree","(x)","(x)"},
{STILL,0,0},
{"bnfisunit","(bnf,x)","(bnf,x)"},
{"qfjacobi","(x)","(x)"},
{"besseljh","(n,x)","(n,x)"},
{"ellj","(x)","(x)"},
{"polkaramul","(x,y,k)","(x,y,k)"},
{"besselk","(nu,x)","(nu,x)"},
{"besselk","(nu,x)","(nu,x,1)"},
{"matker","(x)","(x)"},
{"matker","(x)","(x,1)"},
{"matkerint","(x)","(x)"},
{"matkerint","(x)","(x,1)"},
{"matkerint","(x)","(x,2)"},
{"kronecker","(x,y)","(x,y)"},
{OUT,0,0},
{"zetak","(nfz,s)","(nfz,s,1)"},
{"serlaplace","(x)","(x)"},
{STILL,0,0},
{"pollegendre","(n)","(n)"},
{STILL,0,0},
{STILL,0,0},
{"veclexsort","(x)","(x)"},
{STILL,0,0},
{STILL,0,0},
{"lindep","(x)","(x,1)"},
{"qflll","(x)","(x)"},
{"qflll","(x)","(x,7)"},
{"qflll","(x)","(x,8)"},
{"qflllgram","(x)","(x)"},
{"qflllgram","(x)","(x,7)"},
{"qflllgram","(x)","(x,8)"},
{"qflllgram","(x)","(x,1)"},
{"qflllgram","(x)","(x,4)"},
{"qflllgram","(x)","(x,5)"},
{"qflll","(x)","(x,1)"},
{"qflll","(x)","(x,2)"},
{"qflll","(x)","(x,4)"},
{"qflll","(x)","(x,5)"},
{"qflll","(x)","(x,3)"},
{"log","(x)","(x)"},
{STILL,0,0},
{"elllocalred","(e)","(e)"},
{STILL,0,0},
{"log","(x)","(x,1)"},
{"elllseries","(e,s,N,A)","(e,s,N,A)"},
{"bnfmake","(sbnf)","(sbnf)"},
{"Mat","(x)","(x)"},
{"vecextract","(x,y,z)","(x,y,z)"},
{"ellheightmatrix","(e,x)","(e,x)"},
{STILL,0,0},
{STILL,0,0},
{"matrixqz","(x,p)","(x,-1)"},
{"matrixqz","(x,p)","(x,-2)"},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{"idealmin","(nf,ix,vdir)","(nf,ix,vdir)"},
{"qfminim","(x,bound,maxnum)","(x,bound,maxnum)"},
{"qfminim","(x,bound)","(x,bound,,1)"},
{"Mod","(x,y)","(x,y)"},
{"Mod","(x,y,p)","(x,y,1)"},
{STILL,0,0},
{"gcd","(x,y)","(x,y,1)"},
{"moebius","(n)","(n)"},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{"nfeltdiv","(nf,a,b)","(nf,a,b)"},
{"nfeltdiveuc","(nf,a,b)","(nf,a,b)"},
{"nfeltdivrem","(nf,a,b)","(nf,a,b)"},
{"nfhnf","(nf,x)","(nf,x)"},
{"nfhnfmod","(nf,x,detx)","(nf,x,detx)"},
{"nfeltmod","(nf,a,b)","(nf,a,b)"},
{"nfeltmul","(nf,a,b)","(nf,a,b)"},
{"nfeltpow","(nf,a,k)","(nf,a,k)"},
{"nfeltreduce","(nf,a,id)","(nf,a,id)"},
{"nfsnf","(nf,x)","(nf,x)"},
{"nfeltval","(nf,a,pr)","(nf,a,pr)"},
{STILL,0,0},
{STILL,0,0},
{"qfbnucomp","(x,y,l)","(x,y,l)"},
{STILL,0,0},
{"numerator","(x)","(x)"},
{"qfbnupow","(x,n)","(x,n)"},
{"O","(x)","(x)"},
{STILL,0,0},
{"ellordinate","(e,x)","(e,x)"},
{"znorder","(x)","(x)"},
{"ellorder","(e,x)","(e,x)"},
{"polredord","(x)","(x)"},
{STILL,0,0},
{"matpascal","(n)","(n)"},
{"qfperfection","(a)","(a)"},
{"numtoperm","(n,k)","(n,k)"},
{"permtonum","(vect)","(vect)"},
{"qfbprimeform","(x,p)","(x,p)"},
{"eulerphi","(x)","(x)"},
{"Pi","",""},
{"contfracpnqn","(x)","(x)"},
{"ellztopoint","(e,z)","(e,z)"},
{"polinterpolate","(xa,ya,x)","(xa,ya,p)"},
{STILL,0,0},
{"polred","(x)","(x,2)"},
{STILL,0,0},
{"polredabs","(x)","(x,1)"},
{"polredabs","(x)","(x,4)"},
{"polredabs","(x)","(x,8)"},
{"polredabs","(x)","(x,2)"},
{STILL,0,0},
{"variable","(x)","(x)"},
{"Pol","(x,v)","(x,v)"},
{STILL,0,0},
{"polylog","(m,x)","(m,x,1)"},
{"polylog","(m,x)","(m,x,2)"},
{"polylog","(m,x)","(m,x,3)"},
{"Polrev","(x,v)","(x,v)"},
{"polzagier","(n,m)","(n,m)"},
{"ellpow","(e,x,n)","(e,x,n)"},
{"qfbpowraw","(x,n)","(x,n)"},
{"precision","(x,n)","(x,n)"},
{STILL,0,0},
{STILL,0,0},
{"idealprimedec","(nf,p)","(nf,p)"},
{STILL,0,0},
{"znprimroot","(n)","(n)"},
{"idealprincipal","(nf,x)","(nf,x)"},
{"ideleprincipal","(nf,x)","(nf,x)"},
{"prod","(x,X=a,b,expr)","(X=a,b,expr,x)"},
{STILL,0,0},
{STILL,0,0},
{"prodinf","(X=a,expr)","(X=a,expr,1)"},
{STILL,0,0},
{"Qfb","(a,b,c)","(a,b,c)"},
{"Qfb","(a,b,c,d)","(a,b,c,d)"},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{"matrank","(x)","(x)"},
{"bnrclassno","(bnf,x)","(bnf,x)"},
{"bnrclassnolist","(bnf,liste)","(bnf,liste)"},
{STILL,0,0},
{"polrecip","(x)","(x)"},
{"qfbred","(x)","(x)"},
{"qfbred","(x)","(x)"},
{"qfbred","(x,d)","(x,2,,d)"},
{"poldiscreduced","(f)","(f)"},
{"quadregulator","(x)","(x)"},
{STILL,0,0},
{"polresultant","(x,y)","(x,y)"},
{"polresultant","(x,y)","(x,y,1)"},
{"serreverse","(x)","(x)"},
{"qfbred","(x)","(x,1)"},
{"qfbred","(x,d)","(x,3,,d)"},
{"round","(x)","(x,1)"},
{STILL,0,0},
{"rnfdisc","(nf,pol)","(nf,pol)"},
{STILL,0,0},
{"rnfequation","(nf,pol)","(nf,pol,1)"},
{"rnfhnfbasis","(bnf,order)","(bnf,order)"},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{"polrootsmod","(x,p)","(x,p)"},
{"polrootsmod","(x,p)","(x,p,1)"},
{"polrootspadic","(x,p,r)","(x,p,r)"},
{"polroots","(x)","(x)"},
{"nfrootsof1","(nf)","(nf)"},
{"polroots","(x)","(x,1)"},
{STILL,0,0},
{STILL,0,0},
{"Ser","(x,v)","(x,v)"},
{"Set","(x)","(x)"},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{"sigma","(x,k)","(x,k)"},
{STILL,0,0},
{"qfsign","(x)","(x)"},
{"bnfsignunit","(bnf)","(bnf)"},
{"factormod","(x,p)","(x,p,1)"},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{"sizedigit","(x)","(x)"},
{"nfbasis","(x)","(x,1)"},
{"bnfinit","(x)","(x,3)"},
{"nfdisc","(x)","(x,1)"},
{"factor","(x)","(x,0)"},
{"ellinit","(x)","(x,1)"},
{"polred","(x)","(x,1)"},
{"polred","(x)","(x,3)"},
{"matsnf","(x)","(x)"},
{"matsnf","(x)","(x,1)"},
{"matsnf","(x)","(x,4)"},
{"matsnf","(x)","(x,2)"},
{STILL,0,0},
{"vecsort","(x)","(x)"},
{STILL,0,0},
{"qfgaussred","(x)","(x)"},
{STILL,0,0},
{"gcd","(x,y)","(x,y,2)"},
{"polsturm","(x)","(x)"},
{"polsturm","(x,a,b)","(x,a,b)"},
{"polsubcyclo","(p,d)","(p,d)"},
{"ellsub","(e,a,b)","(e,a,b)"},
{STILL,0,0},
{"sum","(x,X=a,b,expr)","(X=a,b,expr,x)"},
{STILL,0,0},
{"sumalt","(X=a,expr)","(X=a,expr,1)"},
{STILL,0,0},
{STILL,0,0},
{"sumpos","(X=a,expr)","(X=a,expr,1)"},
{"matsupplement","(x)","(x)"},
{"polsylvestermatrix","(x,y)","(x,y)"},
{STILL,0,0},
{STILL,0,0},
{"elltaniyama","(e)","(e)"},
{STILL,0,0},
{"poltchebi","(n)","(n)"},
{"teichmuller","(x)","(x)"},
{STILL,0,0},
{STILL,0,0},
{OUT,0,0},
{OUT,0,0},
{"elltors","(e)","(e)"},
{STILL,0,0},
{"mattranspose","(x)","(x)"},
{"truncate","(x)","(x)"},
{"poltschirnhaus","(x)","(x)"},
{OUT,0,0},
{"quadunit","(x)","(x)"},
{STILL,0,0},
{STILL,0,0},
{"Vec","(x)","(x)"},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{STILL,0,0},
{"vectorv","(n,X,expr)","(n,X,expr)"},
{"ellwp","(e)","(e)"},
{"weber","(x)","(x)"},
{"weber","(x)","(x,2)"},
{STILL,0,0},
{"ellpointtoz","(e,P)","(e,P)"},
{STILL,0,0},
{STILL,0,0},
{"ideallog","(nf,x,bid)","(nf,x,bid)"},
{"idealstar","(nf,I)","(nf,I)"},
{"idealstar","(nf,id)","(nf,id,1)"},
{"idealstar","(nf,id)","(nf,id,2)"},
{STILL,0,0},

{STILL,0,0},
{"plotbox","(x,a)","(x,a)"},
{"plotcolor","(w,c)","(w,c)"},
{"plotcursor","(w)","(w)"},
{STILL,0,0},
{"plotdraw","(list)","(list)"},
{"plotinit","(w,x,y)","(w,x,y)"},
{STILL,0,0},
{"plotkill","(w)","(w)"},
{"plotlines","(w,x2,y2)","(w,x2,y2)"},
{"plotlines","(w,x2,y2)","(w,x2,y2)"},
{"plotmove","(w,x,y)","(w,x,y)"},
{STILL,0,0},
{STILL,0,0},
{"ploth","(X=a,b,expr)","(X=a,b,expr,1)"},
{"ploth","(X=a,b,expr)","(X=a,b,expr)"},
{STILL,0,0},
{"plotpoints","(w,x,y)","(w,x,y)"},
{"plotpoints","(w,x,y)","(w,x,y)"},
{"psdraw","(list)","(list)"},
{"psploth","(X=a,b,expr)","(X=a,b,expr)"},
{"psploth","(X=a,b,expr)","(X=a,b,expr,1)"},
{"psplothraw","(listx,listy)","(listx,listy)"},
{"printp","(x)","(x)"},
{"printp1","(x)","(x)"},
{STILL,0,0},
{STILL,0,0},
{"input","(x)","(x)"},
{"plotrbox","(w,dx,dy)","(w,dx,dy)"},
{"plotrline","(w,dx,dy)","(w,dx,dy)"},
{"plotrlines","(w,dx,dy)","(w,dx,dy,1)"},
{"plotrmove","(w,dx,dy)","(w,dx,dy)"},
{"plotrpoint","(w,dx,dy)","(w,dx,dy)"},
{"plotrpoints","(w,dx,dy)","(w,dx,dy)"},
{"plotscale","(w,x1,x2,y1,y2)","(w,x1,x2,y1,y2)"},
{"default","(n)","(realprecision,n)"},
{"default","(n)","(seriesprecision,n)"},
{"type","(x,t)","(x,t)"},
{"plotstring","(w,x)","(w,x)"},
{STILL,0,0},
{"printtex","(x)","(x)"},
{"type","(x,t)","(x,t)"},
};

/* If silent != 0: silently return 1 if function changed, 0 otherwise.
 * Else be verbose.
 */
int
whatnow(char *s, int silent)
{
  long n=0;
  char *def, str[128];
  whatnow_t wp;
  entree *ep;

  do 
    def = (oldfonctions[n++]).name;
  while (def && strcmp(def,s));
  if (!def)
  {
    int m=0;
    do
      def = (functions_oldgp[m++]).name;
    while (def && strcmp(def,s));
    if (!def)
    {
      if (silent) return 0;
      err(talker,"As far as I can recall, this one never existed !");
    }
    n += m - 1;
  }
  wp=whatnowlist[n-1]; def=wp.name;
  switch((int) def)
  {
    case (int) STILL:
      if (silent) return 0;
      err(talker,"This function did not change !");
    case (int) OUT: 
      if (silent) return 1;
      err(talker,"This function was suppressed !");
  }
  if (silent) return 1;
  if (!strcmp(def,"x*y"))
  {
    sprintf(str,"  %s is now called *.\n\n",s);
    pariputs(str);
    sprintf(str,"    %s%s ===> %s%s\n\n",s,wp.oldarg,wp.name,wp.newarg);
    pariputs(str); return 1;
  }
  ep = is_entry(wp.name,functions_hash);
  if (!ep) err(bugparier,"whatnow");

  if (strcmp(s,ep->name))
    sprintf(str,"  %s is now called %s.\n\n",s,ep->name);
  else
    sprintf(str,"  The syntax changed:\n\n");
  pariputs(str);
  sprintf(str,"    %s%s ===> %s%s\n\n",s,wp.oldarg,wp.name,wp.newarg);
  pariputs(str); print_help(ep->help); pariputc('\n');
  return 1;
}

static int
silent()
{
  char c;
  if (gpsilent) return 1;
  c = _analyseur()[1]; return separe(c);
}

GEN
read0(char *s)
{
  switchin_byname(s);
  return gp_main_loop(silent()? SILENT: REGULAR);
}

GEN
extern0(char *cmd)
{
  FILE *file = try_pipe(cmd);
 
  switchin(file);
  return gp_main_loop(silent()? SILENT: REGULAR);
}

void
default0(char *a, char *b)
{
  setdefault(a,b,silent()? d_SILENT: d_ACKNOWLEDGE);
}

GEN
allocatemem0(unsigned long newsize)
{
  allocatemoremem(newsize);
  parisize=newsize;
  longjmp(environnement,errpile);
  return NULL; /* not reached */
}

/* print a sequence of (NULL terminated) GEN */
void
print0(GEN *g, long flag)
{ 
  int old=prettyp;

  if (flag < NBFORMATS) added_newline=1;
  else 
    { flag -= NBFORMATS; added_newline=0; }
  prettyp=flag;

  for( ; *g; g++) 
    if (typ(*g)==t_STR)
      pariputs(GSTR(*g));
    else 
      gp_output(*g);

  if (added_newline) pariputc('\n');
  pariflush(); prettyp=old;
}

GEN
input0()
{
  char *buffer = (char *) gpmalloc(paribuffsize);
  GEN res;

  while (!fgets(buffer, paribuffsize, infile)) switchin(NULL);
  if (pariecho) pariputs(buffer);
  else if (logfile) fputs(buffer, logfile);
  res=lisseq(buffer); free(buffer);

  return res;
}

static long
get_type_num(char *st)
{
  if (isdigit(*st))
  {
    char *s = st;
    while (*s && isdigit(*s)) s++;
    if (! *s) return atol(st);

    err(talker,"Unknown type: %s",s);
  }

  if (!strncmp(st,"t_",2)) st += 2; /* skip initial part */

  switch(strlen(st))
  {
    case 3:
      if (!strcmp(st,"INT")) return t_INT;
      if (!strcmp(st,"POL")) return t_POL;
      if (!strcmp(st,"SER")) return t_SER;
      if (!strcmp(st,"QFR")) return t_QFR;
      if (!strcmp(st,"QFI")) return t_QFI;
      if (!strcmp(st,"VEC")) return t_VEC;
      if (!strcmp(st,"COL")) return t_COL;
      if (!strcmp(st,"MAT")) return t_MAT;
      if (!strcmp(st,"STR")) return t_STR;
      break;

    case 4:
      if (!strcmp(st,"REAL")) return t_REAL;
      if (!strcmp(st,"FRAC")) return t_FRAC;
      if (!strcmp(st,"QUAD")) return t_QUAD;
      if (!strcmp(st,"LIST")) return t_LIST;
      break;

    case 5:
      if (!strcmp(st,"FRACN")) return t_FRACN;
      if (!strcmp(st,"PADIC")) return t_PADIC;
      if (!strcmp(st,"RFRAC")) return t_RFRAC;
      break;

    case 6:
      if (!strcmp(st,"INTMOD")) return t_INTMOD;
      if (!strcmp(st,"POLMOD")) return t_POLMOD;
      if (!strcmp(st,"RFRACN")) return t_RFRACN;
      break;

    case 7:
      if (!strcmp(st,"COMPLEX")) return t_COMPLEX;
      break;
  }
  err(talker,"Unknown type: t_%s",st);
  return 0; /* not reached */
}

static GEN
get_type_name(long t)
{
  char *s;
  switch(t)
  {
    case t_INT    : s="t_INT";     break;
    case t_REAL   : s="t_REAL";    break;
    case t_INTMOD : s="t_INTMOD";  break;
    case t_FRAC   : s="t_FRAC";    break;
    case t_FRACN  : s="t_FRACN";   break;
    case t_COMPLEX: s="t_COMPLEX"; break;
    case t_PADIC  : s="t_PADIC";   break;
    case t_QUAD   : s="t_QUAD";    break;
    case t_POLMOD : s="t_POLMOD";  break;
    case t_POL    : s="t_POL";     break;
    case t_SER    : s="t_SER";     break;
    case t_RFRAC  : s="t_RFRAC";   break;
    case t_RFRACN : s="t_RFRACN";  break;
    case t_QFR    : s="t_QFR";     break;
    case t_QFI    : s="t_QFI";     break;
    case t_VEC    : s="t_VEC";     break;
    case t_COL    : s="t_COL";     break;
    case t_MAT    : s="t_MAT";     break;
    case t_LIST   : s="t_LIST";    break;
    case t_STR    : s="t_STR";     break;
  }
  return strtoGEN(s,strlen(s));
}

GEN
type0(GEN x, char *st)
{
  if (! *st) return get_type_name(typ(x));
  x = gcopy(x); settyp(x,get_type_num(st));
  return x;
}

void
write1(char *s, GEN x)
{
  s = *s? expand_tilde(s,thestring): current_logfile;
  switchout(s);
  bruteall(x,fmt.format,-1,0);
  pariputc('\n'); switchout(NULL);
}

/* write a sequence of (NULL terminated) GEN, to file s */
void
write0(char *s, GEN *g, long flag)
{ 
  int old=prettyp;

  s = expand_tilde(s,thestring);
  switchout(s); prettyp=flag;
  for( ; *g; g++) 
    if (typ(*g)==t_STR)
      pariputs(GSTR(*g));
    else 
      gp_output(*g);

  pariputc('\n'); pariflush();
  prettyp=old; switchout(NULL);
}

void
system0(char *s)
{
#ifdef UNIX
  system(s);
#else
  err(archer);
#endif
}

void
error0(GEN *g)
{
  term_color(c_ERR);
  pariputs("###   User error:\n\n   ");
  print0(g,f_RAW); term_color(c_NONE);
  err_recover(talker);
}

void
addhelp(entree *ep, char *s)
{
  if (ep->help && ! EpSTATIC(ep)) free(ep->help);
  ep->help = (char*) gpmalloc(strlen(s) + 1);
  strcpy(ep->help, s);
}

long
setprecr(long n)
{
  long m = fmt.nb;

  if(n>0) {fmt.nb = n; prec = (long)(n*pariK1 + 3);}
  return m;
}

#ifdef HAS_DLOPEN
#include <dlfcn.h>
void 
install0(char *name, char *code, char *gpname, char *lib)
{
  void *f, *handle;

  if (! *lib) lib = DL_DFLT_NAME;
  if (! *gpname) gpname=name;
  
  handle = dlopen(lib,RTLD_LAZY);
  if (!handle)
  {
    const char *s = dlerror(); if (s) fprintferr("%s\n\n",s);
    err(talker,"couldn't open dynamic library '%s'",lib);
  }
  f = dlsym(handle,name);
  if (!f)
    err(talker,"couldn't find symbol '%s' in library '%s'",name,lib);
  install(f,gpname,code);
}
#else
void 
install0(char *name, char *code, char *gpname, char *lib)
{
  err(archer);
}
#endif
