OpenXM_contrib/pari-2.2/src/gp/gp.c - diff

Return to gp.c CVS log

Up to [local] / OpenXM_contrib / pari-2.2 / src / gp

Diff for /OpenXM_contrib/pari-2.2/src/gp/Attic/gp.c between version 1.1 and 1.2

version 1.1, 2001/10/02 11:17:06

version 1.2, 2002/09/11 07:26:55

Line 32 Foundation, Inc., 59 Temple Place - Suite 330, Boston,

#include "gp.h"

#ifdef READLINE

extern void init_readline();

extern void init_readline(void);

long use_readline = 1;

int readline_init = 1;

BEGINEXTERN

# if defined(__cplusplus) && defined(__SUNPRO_CC)

/* readline.h gives a bad definition of readline() */

extern char* readline(char*); /* bad prototype for readline() in readline.h */

extern char*readline(char*);

# else

# ifdef READLINE_LIBRARY

# include <readline.h>

Line 47 BEGINEXTERN

Line 45 BEGINEXTERN

# endif

extern int isatty(int);

extern void add_history(char*);

ENDEXTERN

#endif

char* _analyseur(void);

extern void err_clean(void);

void _set_analyseur(char *s);

extern void gp_output(GEN z, gp_data *G);

void err_recover(long numerr);

extern void errcontext(char *msg, char *s, char *entry);

void free_graph(void);

extern void free_graph(void);

void gp_expand_path(char *v);

extern void gp_expand_path(gp_path *p);

int gp_init_entrees(module *modlist, entree **hash, int force);

extern int gp_init_entrees(module *modlist, entree **hash, int force);

long gptimer(void);

extern void init_defaults(int force);

void init80(long n);

extern void init_graph(void);

void init_defaults(int force);

extern void pari_sig_init(void (*f)(int));

void initout(int initerr);

extern int whatnow(char *s, int flag);

void init_graph(void);

void init_lim_lines(char *s, long max);

extern void install0(char *name, char *code, char *gpname, char *lib);

void pari_sig_init(void (*f)(int));

int whatnow(char *s, int flag);

#if 0 /* to debug TeXmacs interface */

static char *DFT_PRETTYPRINTER = "tex2mail -TeX -noindent -ragged -by_par";

#define DATA_BEGIN ((char) 'B')

#define DATA_END ((char) 'E')

#else

#define DATA_BEGIN ((char) 2)

#define DATA_END ((char) 5)

#endif

#define DATA_ESCAPE ((char) 27)

#define MAX_PROMPT_LEN 128

#define DFT_PROMPT "? "

#define BREAK_LOOP_PROMPT "> "

#define COMMENTPROMPT "comment> "

#define CONTPROMPT ""

#define DFT_INPROMPT ""

static GEN *hist;

static char prompt[MAX_PROMPT_LEN], prompt_cont[MAX_PROMPT_LEN];

static char *help_prg,*path;

static char prompt[MAX_PROMPT_LEN];

static char thestring[256];

static char *prettyprinter;

static char *prettyprinter_dft = "tex2mail -TeX -noindent -ragged -by_par";

static pariFILE *prettyprinter_file;

static long prettyp, test_mode, quiet_mode, gpsilent, simplifyflag;

static long chrono, pariecho, primelimit, parisize, strictmatch;

static long tglobal, histsize, paribufsize, lim_lines;

static int tm_is_waiting = 0, handle_C_C = 0;

static gp_format fmt;

typedef struct Buffer {

static int tm_is_waiting = 0, handle_C_C = 0, gpsilent = 0;

char *buf;

long len;

jmp_buf env;

int flenv;

} Buffer;

static ulong paribufsize, primelimit;

#define current_buffer (bufstack?((Buffer*)(bufstack->value)):NULL)

static stack *bufstack = NULL;

#define LBRACE '{'

#define RBRACE '}'

#define pariputs_opt(s) if (!quiet_mode) pariputs(s)

#define skip_space(s) while (isspace((int)*s)) s++

#define skip_alpha(s) while (isalpha((int)*s)) s++

#define ask_filtre(t) filtre("",NULL,t)

static void

usage(char *s)

Line 127 usage(char *s)

Line 96 usage(char *s)

exit(0);

}

/* must be called BEFORE pari_init() */

static void

gp_preinit(int force)

init_hist(gp_hist *H, size_t l, ulong total)

{

static char *dflt;

H->total = total;

char *help;

H->size = l;

long i;

H->res = (GEN *) gpmalloc(l * sizeof(GEN));

memset(H->res,0, l * sizeof(GEN));

}

if (force)

static void

{

init_path(gp_path *path)

#if !defined(macintosh) || defined(__MWERKS__)

{

primelimit = 500000; parisize = 1000000*sizeof(long);

char *p;

dflt = DFT_PROMPT;

#if defined(__EMX__) || defined(__CYGWIN32__)

p = ".;C:;C:/gp";

#elif defined(UNIX)

p = ".:~:~/gp";

#else

primelimit = 200000; parisize = 1000000;

p = ".";

dflt = "?\n";

#endif

}

path->PATH = pari_strdup(p);

strcpy(prompt, dflt);

path->dirs = NULL;

}

#if defined(UNIX) || defined(__EMX__)

static char *

# if defined(__EMX__) || defined(__CYGWIN32__)

init_help()

path = pari_strdup(".;C:;C:/gp");

{

# else

char *h = os_getenv("GPHELP");

path = pari_strdup(".:~:~/gp");

# endif

help = getenv("GPHELP");

# ifdef GPHELP

if (!help) help = GPHELP;

if (!h) h = GPHELP;

# endif

if (h) h = pari_strdup(h);

return h;

}

static pariout_t *

init_fmt()

{

pariout_t *f = &DFLT_OUTPUT;

f->prettyp= f_PRETTYMAT;

#ifdef LONG_IS_64BIT

f->sigd = 38;

#else

path = pari_strdup(".");

f->sigd = 28;

help = NULL;

#endif

help_prg = help? pari_strdup(help): NULL;

return f;

prettyp = f_PRETTYMAT;

}

strictmatch = simplifyflag = 1;

tglobal = 0;

static void

init_pp(gp_pp *p)

{

p->cmd = pari_strdup(DFT_PRETTYPRINTER);

p->file = NULL;

}

/* must be called BEFORE pari_init() */

static void

gp_preinit(void)

{

static gp_data __GP_DATA;

static gp_hist __HIST;

static gp_pp __PP;

static gp_path __PATH;

static pari_timer __T;

long i;

bufstack = NULL;

secure = test_mode = under_emacs = under_texmacs = chrono = pariecho = 0;

prettyprinter = prettyprinter_dft;

primelimit = 500000;

prettyprinter_file = NULL;

bot = (gpmem_t)0;

fmt.format = 'g'; fmt.field = 0;

top = (gpmem_t)(1000000*sizeof(long));

#ifdef LONG_IS_64BIT

strcpy(prompt, DFT_PROMPT);

fmt.nb = 38;

strcpy(prompt_cont, CONTPROMPT);

paribufsize = 1024;

for (i=0; i<c_LAST; i++) gp_colors[i] = c_NONE;

GP_DATA = &__GP_DATA;

#ifdef READLINE

GP_DATA->flags = (STRICTMATCH | SIMPLIFY | USE_READLINE);

#else

fmt.nb = 28;

GP_DATA->flags = (STRICTMATCH | SIMPLIFY);

#endif

lim_lines = 0;

GP_DATA->lim_lines = 0;

histsize = 5000; paribufsize = 1024;

GP_DATA->T = &__T;

i = histsize*sizeof(GEN);

GP_DATA->hist = &__HIST;

hist = (GEN *) gpmalloc(i); memset(hist,0,i);

GP_DATA->pp = &__PP;

for (i=0; i<c_LAST; i++) gp_colors[i] = c_NONE;

GP_DATA->path = &__PATH;

GP_DATA->help = init_help();

GP_DATA->fmt = init_fmt();

init_hist(GP_DATA->hist, 5000, 0);

init_path(GP_DATA->path);

init_pp(GP_DATA->pp);

}

#ifdef MAXPATHLEN

Line 189 gp_preinit(int force)

Line 198 gp_preinit(int force)

#endif

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

/* Return all chars, up to next separator */

/* Return all chars, up to next separator

* [as strtok but must handle verbatim character string]

* If 'colon' is set, allow ';' and ':' as separator, only ';' otherwise */

static char*

get_sep0(char *t, int colon)

{

static char buf[GET_SEP_SIZE], *lim = buf + GET_SEP_SIZE-1;

static char buf[GET_SEP_SIZE], *lim = buf + (GET_SEP_SIZE-1);

char *s = buf;

int outer=1;

int outer = 1;

for(;;)

{

Line 207 get_sep0(char *t, int colon)

Line 218 get_sep0(char *t, int colon)

case '\0':

return buf;

case ';':

if (outer) { s[-1]=0; return buf; } break;

if (outer) { s[-1] = 0; return buf; } break;

case ':':

if (outer && colon) { s[-1]=0; return buf; } break;

if (outer && colon) { s[-1] = 0; return buf; } break;

}

if (s == lim) err(talker,"buffer overflow in get_sep");

}

Line 227 get_sep_colon_ok(char *t)

Line 238 get_sep_colon_ok(char *t)

return get_sep0(t,0);

}

/* as above, t must be writeable, return 1 if we modified t */

/* "atoul" + optional [km] suffix */

static int

static ulong

get_sep2(char *t)

my_int(char *s)

{

int outer=1;

ulong n = 0;

char *s = t;

char *p = s;

for(;;)

while (isdigit((int)*p)) { n = 10*n + (*p++ - '0'); }

switch(*p)

{

switch (*s++)

case 'k': case 'K': n *= 1000; p++; break;

{

case 'm': case 'M': n *= 1000000; p++; break;

case '"':

if (outer || s[-2] != '\\') outer = !outer;

break;

case '\0':

return 0;

default:

if (outer && separe(*s)) { *s=0; return 1; }

}

if (*p) err(talker2,"I was expecting an integer here", s, s);

return n;

}

static long

get_int(char *s, long dflt)

{

char *p=get_sep(s);

char *p = get_sep(s);

long n=atol(p);

long n;

int minus = 0;

if (*p == '-') { minus = 1; p++; }

if (!isdigit((int)*p)) return dflt;

if (*p == '-') p++;

n = (long)my_int(p);

while(isdigit((int)*p)) { p++; dflt=n; }

if (n < 0) err(talker2,"integer too large in get_int",s,s);

switch(*p)

return minus? -n: n;

{

case 'k': case 'K': dflt *= 1000; p++; break;

case 'm': case 'M': dflt *= 1000000; p++; break;

}

if (*p) err(talker2,"I was expecting an integer here", s, s);

return dflt;

}

static ulong

get_uint(char *s)

{

char *p = get_sep(s);

if (*p == '-') err(talker2,"arguments must be positive integers",s,s);

return my_int(p);

}

/* tell TeXmacs GP will start outputing data */

static void

tm_start_output()

tm_start_output(void)

{

if (!tm_is_waiting) { printf("%cverbatim:",DATA_BEGIN); fflush(stdout); }

tm_is_waiting = 1;

Line 276 tm_start_output()

Line 288 tm_start_output()

/* tell TeXmacs GP is done and is waiting for new data */

static void

tm_end_output()

tm_end_output(void)

{

if (tm_is_waiting) { printf("%c", DATA_END); fflush(stdout); }

tm_is_waiting = 0;

}

static void

gp_output(GEN x)

{

long tx=typ(x);

if (fmt.nb >= 0 && is_intreal_t(tx))

ecrire(x, fmt.format, fmt.nb, fmt.field);

else

switch(prettyp)

{

case f_PRETTYMAT: matbrute(x, fmt.format, fmt.nb); break;

case f_PRETTY:

case f_PRETTYOLD: sor(x, fmt.format, fmt.nb, fmt.field); break;

case f_RAW : brute(x, fmt.format, fmt.nb); break;

case f_TEX : texe(x, fmt.format, fmt.nb); break;

}

/* 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)); /* otherwise it's surrounded by "" */

else

gp_output(*g);

if (added_newline) pariputc('\n');

prettyp=old; pariflush();

}

/* write a sequence of (NULL terminated) GEN, to file s */

void

write0(char *s, GEN *g, long flag)

{

int i = added_newline;

s = expand_tilde(s);

if (secure)

{

fprintferr("[secure mode]: about to write to '%s'. OK ? (^C if not)\n",s);

hit_return();

}

switchout(s); free(s);

print0(g,flag); added_newline = i;

switchout(NULL);

}

void

gpwritebin(char *s, GEN x)

{

s = expand_tilde(s);

if (secure)

{

fprintferr("[secure mode]: about to write to '%s'. OK ? (^C if not)\n",s);

hit_return();

}

writebin(s,x); free(s);

}

Buffer *

new_buffer()

new_buffer(void)

{

Buffer *b = (Buffer*) gpmalloc(sizeof(Buffer));

b->len = paribufsize;

Line 366 del_buffer(Buffer *b)

Line 311 del_buffer(Buffer *b)

}

static void

pop_buffer()

pop_buffer(void)

{

Buffer *b = (Buffer*) pop_stack(&bufstack);

del_buffer(b);

Line 384 kill_all_buffers(Buffer *B)

Line 329 kill_all_buffers(Buffer *B)

}

static void

jump_to_buffer()

jump_to_buffer(void)

{

Buffer *b;

while ( (b = current_buffer) )

Line 416 jump_to_given_buffer(Buffer *buf)

Line 361 jump_to_given_buffer(Buffer *buf)

/* */

/********************************************************************/

static void

do_strftime(char *s, char *buf)

do_strftime(char *s, char *buf, long max)

{

#ifdef HAS_STRFTIME

time_t t = time(NULL);

strftime(buf,MAX_PROMPT_LEN-1,s,localtime(&t));

strftime(buf,max,s,localtime(&t));

#else

strcpy(buf,s);

#endif

}

static GEN

sd_numeric(char *v, int flag, char *s, long *ptn, long Min, long Max,

sd_toggle(char *v, int flag, char *s, int *ptn)

{

int state = *ptn;

if (*v)

{

int n = (int)get_int(v,0);

if (n == state) return gnil;

if (n != !state)

{

char s[128];

sprintf(s, "default: incorrect value for %s [0:off / 1:on]", s);

err(talker2, s, v,v);

}

state = *ptn = n;

}

switch(flag)

{

case d_RETURN: return utoi(state);

case d_ACKNOWLEDGE:

if (state) pariputsf(" %s = 1 (on)\n", s);

else pariputsf(" %s = 0 (off)\n", s);

break;

}

return gnil;

}

static GEN

sd_gptoggle(char *v, int flag, char *s, ulong FLAG)

{

int n = (GP_DATA->flags & FLAG)? 1: 0, old = n;

GEN z = sd_toggle(v, flag, s, &n);

if (n != old)

{

if (n) GP_DATA->flags |= FLAG;

else GP_DATA->flags &= ~FLAG;

}

return z;

}

static GEN

sd_ulong(char *v, int flag, char *s, ulong *ptn, ulong Min, ulong Max,

char **msg)

{

long n;

ulong n;

if (*v == 0) n = *ptn;

else

{

n = get_int(v,0);

n = (ulong)get_int(v,0);

if (*ptn == n) return gnil;

if (n > Max || n < Min)

{

sprintf(thestring, "default: incorrect value for %s [%ld-%ld]",

char s[128];

s, Min, Max);

sprintf(s, "default: incorrect value for %s [%lu-%lu]", s, Min, Max);

err(talker2, thestring, v,v);

err(talker2, s, v,v);

}

*ptn = n;

}

switch(flag)

{

case d_RETURN: return stoi(n);

case d_RETURN: return utoi(n);

case d_ACKNOWLEDGE:

if (msg)

{

if (!*msg)

if (!*msg) msg++; /* single msg, always printed */

msg++; /* single msg, always printed */

else msg += n; /* one per possible value */

else

pariputsf(" %s = %lu %s\n", s, n, *msg);

msg += n; /* one per possible value */

pariputsf(" %s = %ld %s\n", s, n, *msg);

}

else if (Max != 1 || Min != 0)

else

pariputsf(" %s = %ld\n", s, n);

pariputsf(" %s = %lu\n", s, n);

else /* toggle */

{

if (n==1) pariputsf(" %s = 1 (on)\n", s);

else pariputsf(" %s = 0 (off)\n", s);

} /* fall through */

default: return gnil;

}

Line 471 sd_numeric(char *v, int flag, char *s, long *ptn, long

Line 449 sd_numeric(char *v, int flag, char *s, long *ptn, long

static GEN

sd_realprecision(char *v, int flag)

{

pariout_t *fmt = GP_DATA->fmt;

if (*v)

{

long newnb = get_int(v, fmt.nb);

long newnb = get_int(v, fmt->sigd);

long newprec = (long) (newnb*pariK1 + 3);

if (fmt.nb == newnb && prec == newprec) return gnil;

if (fmt->sigd == newnb && prec == newprec) return gnil;

if (newnb < 0) err(talker,"default: negative real precision");

fmt.nb = newnb; prec = newprec;

fmt->sigd = newnb; prec = newprec;

}

if (flag == d_RETURN) return stoi(fmt.nb);

if (flag == d_RETURN) return stoi(fmt->sigd);

if (flag == d_ACKNOWLEDGE)

{

long n = PRECDIGIT;

pariputsf(" realprecision = %ld significant digits", n);

if (n != fmt.nb) pariputsf(" (%ld digits displayed)", fmt.nb);

if (n != fmt->sigd)

pariputsf(" (%ld digits displayed)", fmt->sigd);

pariputc('\n');

}

return gnil;

Line 496 static GEN

Line 476 static GEN

sd_seriesprecision(char *v, int flag)

{

char *msg[] = {NULL, "significant terms"};

return sd_numeric(v,flag,"seriesprecision",&precdl, 0,LGBITS,msg);

return sd_ulong(v,flag,"seriesprecision",&precdl, 0,LGBITS,msg);

}

static GEN

sd_format(char *v, int flag)

{

pariout_t *fmt = GP_DATA->fmt;

if (*v)

{

char c = *v;

if (c!='e' && c!='f' && c!='g')

err(talker2,"default: inexistent format",v,v);

fmt.format = c; v++;

fmt->format = c; v++;

if (isdigit((int)*v))

{ fmt.field=atol(v); while (isdigit((int)*v)) v++; }

{ fmt->fieldw=atol(v); while (isdigit((int)*v)) v++; }

if (*v++ == '.')

{

if (*v == '-') fmt.nb = -1;

if (*v == '-') fmt->sigd = -1;

else

if (isdigit((int)*v)) fmt.nb=atol(v);

if (isdigit((int)*v)) fmt->sigd=atol(v);

}

if (flag == d_RETURN)

{

sprintf(thestring, "%c%ld.%ld", fmt.format, fmt.field, fmt.nb);

char s[128];

return strtoGENstr(thestring,0);

sprintf(s, "%c%ld.%ld", fmt->format, fmt->fieldw, fmt->sigd);

return strtoGENstr(s,0);

}

if (flag == d_ACKNOWLEDGE)

pariputsf(" format = %c%ld.%ld\n", fmt.format, fmt.field, fmt.nb);

pariputsf(" format = %c%ld.%ld\n", fmt->format, fmt->fieldw, fmt->sigd);

return gnil;

}

Line 549 gp_get_color(char **st)

Line 531 gp_get_color(char **st)

c = (atoi(a[2])<<8) | atoi(a[0]) | (atoi(a[1])<<4);

trans = (*(a[1]) == 0);

v = s + 1;

}

else { c = c_NONE; trans = 0; }

}

if (trans) c = c | (1<<12);

while (*v && *v++ != ',') /* empty */;

if (c != c_NONE) disable_color=0;

if (c != c_NONE) disable_color = 0;

*st = v; return c;

}

Line 562 static GEN

Line 544 static GEN

sd_colors(char *v, int flag)

{

long c,l;

if (*v && !under_emacs && !under_texmacs)

if (*v && !(GP_DATA->flags & (EMACS|TEXMACS)))

{

char *v0;

disable_color=1;

l = strlen(v);

if (l <= 2 && strncmp(v, "no", l) == 0)

Line 574 sd_colors(char *v, int flag)

Line 557 sd_colors(char *v, int flag)

v = "1, 6, 3, 4, 5, 2, 3"; /* Assume recent ReadLine. */

if (l <= 6 && strncmp(v, "boldfg", l) == 0) /* Good for darkbg consoles */

v = "[1,,1], [5,,1], [3,,1], [7,,1], [6,,1], [2,,1], [3,,1]";

v = filtre(v,NULL, f_INIT|f_REG);

v0 = v = filtre(v, 0);

for (c=c_ERR; c < c_LAST; c++)

gp_colors[c] = gp_get_color(&v);

free(v0);

}

if (flag == d_ACKNOWLEDGE || flag == d_RETURN)

{

char *s = thestring;

char s[128], *t = s;

int col[3], n;

for (*s=0,c=c_ERR; c < c_LAST; c++)

for (*t=0,c=c_ERR; c < c_LAST; c++)

{

n = gp_colors[c];

if (n == c_NONE)

sprintf(s,"no");

sprintf(t,"no");

else

{

decode_color(n,col);

if (n & (1<<12))

{

if (col[0])

sprintf(s,"[%d,,%d]",col[1],col[0]);

sprintf(t,"[%d,,%d]",col[1],col[0]);

else

sprintf(s,"%d",col[1]);

sprintf(t,"%d",col[1]);

}

else

sprintf(s,"[%d,%d,%d]",col[1],col[2],col[0]);

sprintf(t,"[%d,%d,%d]",col[1],col[2],col[0]);

}

s += strlen(s);

t += strlen(t);

if (c < c_LAST - 1) { *s++=','; *s++=' '; }

if (c < c_LAST - 1) { *t++=','; *t++=' '; }

}

if (flag==d_RETURN) return strtoGENstr(thestring,0);

if (flag==d_RETURN) return strtoGENstr(s,0);

pariputsf(" colors = \"%s\"\n",thestring);

pariputsf(" colors = \"%s\"\n",s);

}

return gnil;

}

Line 618 sd_compatible(char *v, int flag)

Line 602 sd_compatible(char *v, int flag)

"(use old functions, don't ignore case)",

"(use old functions, ignore case)", NULL

};

long old = compatible;

ulong old = compatible;

GEN r = sd_numeric(v,flag,"compatible",&compatible, 0,3,msg);

GEN r = sd_ulong(v,flag,"compatible",&compatible, 0,3,msg);

if (old != compatible && flag != d_INITRC)

{

Line 633 sd_compatible(char *v, int flag)

Line 617 sd_compatible(char *v, int flag)

static GEN

sd_secure(char *v, int flag)

{

if (*v && secure)

if (*v && (GP_DATA->flags & SECURE))

{

fprintferr("[secure mode]: Do you want to modify the 'secure' flag? (^C if not)\n");

hit_return();

}

return sd_numeric(v,flag,"secure",&secure, 0,1,NULL);

return sd_gptoggle(v,flag,"secure", SECURE);

}

static GEN

sd_buffersize(char *v, int flag)

{ return sd_numeric(v,flag,"buffersize",&paribufsize, 1,

{ return sd_ulong(v,flag,"buffersize",&paribufsize, 1,

(VERYBIGINT / sizeof(long)) - 1,NULL); }

static GEN

sd_debug(char *v, int flag)

{ return sd_numeric(v,flag,"debug",&DEBUGLEVEL, 0,20,NULL); }

{ return sd_ulong(v,flag,"debug",&DEBUGLEVEL, 0,20,NULL); }

static GEN

sd_rl(char *v, int flag)

{

#ifdef READLINE

# if 0 /* Works - even when init_readline() was called */

if (!readline_init && *v && *v != '0') {

if (readline_init && *v == '0')

init_readline();

err(talker, "Too late to switch off readline mode");

readline_init = 1;

# endif

}

if (!readline_init && *v && *v != '0') {

init_readline();

readline_init = 1;

}

return sd_numeric(v,flag,"readline",&use_readline, 0,20,NULL);

#else /* !( defined READLINE ) */

long dummy;

return sd_numeric(v,flag,"readline",&dummy, 0,20,NULL);

#endif

return sd_gptoggle(v,flag,"readline", USE_READLINE);

}

static GEN

sd_debugfiles(char *v, int flag)

{ return sd_numeric(v,flag,"debugfiles",&DEBUGFILES, 0,20,NULL); }

{ return sd_ulong(v,flag,"debugfiles",&DEBUGFILES, 0,20,NULL); }

static GEN

sd_debugmem(char *v, int flag)

{ return sd_numeric(v,flag,"debugmem",&DEBUGMEM, 0,20,NULL); }

{ return sd_ulong(v,flag,"debugmem",&DEBUGMEM, 0,20,NULL); }

static GEN

sd_echo(char *v, int flag)

{ return sd_numeric(v,flag,"echo",&pariecho, 0,1,NULL); }

{ return sd_gptoggle(v,flag,"echo", ECHO); }

static GEN

sd_lines(char *v, int flag)

{ return sd_numeric(v,flag,"lines",&lim_lines, 0,VERYBIGINT,NULL); }

{ return sd_ulong(v,flag,"lines",&(GP_DATA->lim_lines), 0,VERYBIGINT,NULL); }

static GEN

sd_histsize(char *v, int flag)

{

long n = histsize;

gp_hist *H = GP_DATA->hist;

GEN r = sd_numeric(v,flag,"histsize",&n, 1,

ulong n = H->size;

GEN r = sd_ulong(v,flag,"histsize",&n, 1,

(VERYBIGINT / sizeof(long)) - 1,NULL);

if (n != histsize)

if (n != H->size)

{

long i = n*sizeof(GEN);

const ulong total = H->total;

GEN *gg = (GEN *) gpmalloc(i); memset(gg,0,i);

long g, h, k, kmin;

GEN *resG = H->res, *resH; /* G = old data, H = new one */

size_t sG = H->size, sH;

if (tglobal)

init_hist(H, n, total);

{

if (!total) return r;

long k = (tglobal-1) % n;

long kmin = k - min(n,histsize), j = k;

i = (tglobal-1) % histsize;

resH = H->res;

while (k > kmin)

sH = H->size;

{

/* copy relevant history entries */

gg[j] = hist[i];

g = (total-1) % sG;

hist[i] = NULL;

h = k = (total-1) % sH;

if (!i) i = histsize;

kmin = k - min(sH, sG);

if (!j) j = n;

for ( ; k > kmin; k--, g--, h--)

i--; j--; k--;

{

}

resH[h] = resG[g];

while (hist[i])

resG[g] = NULL;

{

if (!g) g = sG;

gunclone(hist[i]);

if (!h) h = sH;

if (!i) i = histsize;

i--;

}

free((void*)hist); hist=gg; histsize=n;

/* clean up */

for ( ; resG[g]; g--)

{

gunclone(resG[g]);

if (!g) g = sG;

}

free((void*)resG);

}

return r;

}

Line 724 sd_histsize(char *v, int flag)

Line 705 sd_histsize(char *v, int flag)

static GEN

sd_log(char *v, int flag)

{

long vlog = logfile? 1: 0, old = vlog;

int old = GP_DATA->flags;

GEN r = sd_numeric(v,flag,"log",&vlog, 0,1,NULL);

GEN r = sd_gptoggle(v,flag,"log",LOG);

if (vlog != old)

if (GP_DATA->flags != old)

{

{ /* toggled LOG */

if (vlog)

if (old & LOG)

{

{ /* close log */

if (flag == d_ACKNOWLEDGE)

pariputsf(" [logfile was \"%s\"]\n", current_logfile);

fclose(logfile); logfile = NULL;

}

else

{ /* open log */

logfile = fopen(current_logfile, "a");

if (!logfile) err(openfiler,"logfile",current_logfile);

#ifndef WINCE

setbuf(logfile,(char *)NULL);

#endif

}

else

{

if (flag == d_ACKNOWLEDGE)

pariputsf(" [logfile was \"%s\"]\n", current_logfile);

fclose(logfile); logfile=NULL;

}

return r;

}

Line 749 sd_log(char *v, int flag)

Line 730 sd_log(char *v, int flag)

static GEN

sd_output(char *v, int flag)

{

char *msg[] = {"(raw)", "(prettymatrix)", "(prettyprint)", "(external prettyprint)", NULL};

char *msg[] = {"(raw)", "(prettymatrix)", "(prettyprint)",

return sd_numeric(v,flag,"output",&prettyp, 0,3,msg);

"(external prettyprint)", NULL};

ulong n = GP_DATA->fmt->prettyp;

GEN z = sd_ulong(v,flag,"output", &n, 0,3,msg);

GP_DATA->fmt->prettyp = n; return z;

}

extern void err_clean();

void

allocatemem0(unsigned long newsize)

allocatemem0(size_t newsize)

{

parisize = allocatemoremem(newsize);

(void)allocatemoremem(newsize);

err_clean();

jump_to_buffer();

}

Line 766 allocatemem0(unsigned long newsize)

Line 748 allocatemem0(unsigned long newsize)

static GEN

sd_parisize(char *v, int flag)

{

long n = parisize;

ulong n = top-bot;

GEN r = sd_numeric(v,flag,"parisize",&n, 10000,VERYBIGINT,NULL);

GEN r = sd_ulong(v,flag,"parisize",&n, 10000,VERYBIGINT,NULL);

if (n != parisize)

if (n != (ulong)top-bot)

{

if (!bot) top = (gpmem_t)n; /* no stack allocated yet */

if (flag != d_INITRC) allocatemem0(n);

parisize = n;

}

return r;

}

Line 779 sd_parisize(char *v, int flag)

Line 761 sd_parisize(char *v, int flag)

static GEN

sd_primelimit(char *v, int flag)

{

long n = primelimit;

ulong n = primelimit;

GEN r = sd_numeric(v,flag,"primelimit",&n, 0,VERYBIGINT,NULL);

GEN r = sd_ulong(v,flag,"primelimit",&n, 0,VERYBIGINT,NULL);

if (n != primelimit)

{

if (flag != d_INITRC)

Line 795 sd_primelimit(char *v, int flag)

Line 777 sd_primelimit(char *v, int flag)

static GEN

sd_simplify(char *v, int flag)

{ return sd_numeric(v,flag,"simplify",&simplifyflag, 0,1,NULL); }

{ return sd_gptoggle(v,flag,"simplify", SIMPLIFY); }

static GEN

sd_strictmatch(char *v, int flag)

{ return sd_numeric(v,flag,"strictmatch",&strictmatch, 0,1,NULL); }

{ return sd_gptoggle(v,flag,"strictmatch", STRICTMATCH); }

static GEN

sd_timer(char *v, int flag)

{ return sd_numeric(v,flag,"timer",&chrono, 0,1,NULL); }

{ return sd_gptoggle(v,flag,"timer", CHRONO); }

static GEN

sd_filename(char *v, int flag, char *s, char **f)

{

if (*v)

{

char *old = *f;

char *s, *old = *f;

long l;

v = expand_tilde(v);

do_strftime(v,thestring); free(v);

l = strlen(v) + 256;

*f = pari_strdup(thestring); free(old);

s = malloc(l);

do_strftime(v,s, l-1); free(v);

*f = pari_strdup(s); free(s); free(old);

}

if (flag == d_RETURN) return strtoGENstr(*f,0);

if (flag == d_ACKNOWLEDGE) pariputsf(" %s = \"%s\"\n",s,*f);

Line 837 sd_logfile(char *v, int flag)

Line 822 sd_logfile(char *v, int flag)

}

static GEN

sd_new_galois_format(char *v, int flag)

{ return sd_toggle(v,flag,"new_galois_format", &new_galois_format); }

static GEN

sd_psfile(char *v, int flag)

{ return sd_filename(v, flag, "psfile", &current_psfile); }

Line 850 sd_help(char *v, int flag)

Line 839 sd_help(char *v, int flag)

char *str;

if (*v)

{

if (secure) err_secure("help",v);

if (GP_DATA->flags & SECURE) err_secure("help",v);

if (help_prg) free(help_prg);

if (GP_DATA->help) free(GP_DATA->help);

help_prg = expand_tilde(v);

GP_DATA->help = expand_tilde(v);

}

str = help_prg? help_prg: "none";

str = GP_DATA->help? GP_DATA->help: "none";

if (flag == d_RETURN) return strtoGENstr(str,0);

if (flag == d_ACKNOWLEDGE)

pariputsf(" help = \"%s\"\n", str);

Line 864 sd_help(char *v, int flag)

Line 853 sd_help(char *v, int flag)

static GEN

sd_path(char *v, int flag)

{

gp_path *p = GP_DATA->path;

if (*v)

{

char *old = path;

free((void*)p->PATH);

path = pari_strdup(v); free(old);

p->PATH = pari_strdup(v);

if (flag == d_INITRC) return gnil;

gp_expand_path(path);

gp_expand_path(p);

}

if (flag == d_RETURN) return strtoGENstr(path,0);

if (flag == d_RETURN) return strtoGENstr(p->PATH,0);

if (flag == d_ACKNOWLEDGE)

pariputsf(" path = \"%s\"\n",path);

pariputsf(" path = \"%s\"\n",p->PATH);

return gnil;

}

static GEN

sd_prettyprinter(char *v, int flag)

{

if (*v && !under_texmacs)

gp_pp *pp = GP_DATA->pp;

if (*v && !(GP_DATA->flags & TEXMACS))

{

char *old = prettyprinter;

char *old = pp->cmd;

int cancel = (!strcmp(v,"no"));

if (secure) err_secure("prettyprinter",v);

if (GP_DATA->flags & SECURE) err_secure("prettyprinter",v);

if (!strcmp(v,"yes")) v = prettyprinter_dft;

if (!strcmp(v,"yes")) v = DFT_PRETTYPRINTER;

if (old && strcmp(old,v) && prettyprinter_file)

if (old && strcmp(old,v) && pp->file)

{

pariFILE *f;

if (cancel) f = NULL;

Line 900 sd_prettyprinter(char *v, int flag)

Line 891 sd_prettyprinter(char *v, int flag)

return gnil;

}

pari_fclose(prettyprinter_file);

pari_fclose(pp->file);

prettyprinter_file = f;

pp->file = f;

}

prettyprinter = cancel? NULL: pari_strdup(v);

pp->cmd = cancel? NULL: pari_strdup(v);

if (old && old != prettyprinter_dft) free(old);

if (old) free(old);

if (flag == d_INITRC) return gnil;

}

if (flag == d_RETURN) return strtoGEN(prettyprinter? prettyprinter: "");

if (flag == d_RETURN) return strtoGEN(pp->cmd? pp->cmd: "");

if (flag == d_ACKNOWLEDGE)

pariputsf(" prettyprinter = \"%s\"\n",prettyprinter? prettyprinter: "");

pariputsf(" prettyprinter = \"%s\"\n",pp->cmd? pp->cmd: "");

return gnil;

}

static GEN

sd_prompt(char *v, int flag)

sd_prompt_set(char *v, int flag, char *how, char *p)

{

if (*v)

{

strncpy(prompt,v,MAX_PROMPT_LEN);

strncpy(p,v,MAX_PROMPT_LEN);

#ifdef macintosh

strcat(prompt,"\n");

strcat(p,"\n");

#endif

}

if (flag == d_RETURN) return strtoGENstr(prompt,0);

if (flag == d_RETURN) return strtoGENstr(p,0);

if (flag == d_ACKNOWLEDGE)

pariputsf(" prompt = \"%s\"\n",prompt);

pariputsf(" prompt%s = \"%s\"\n", how, p);

return gnil;

}

static GEN

sd_prompt(char *v, int flag)

{

return sd_prompt_set(v, flag, "", prompt);

}

static GEN

sd_prompt_cont(char *v, int flag)

{

return sd_prompt_set(v, flag, "_cont", prompt_cont);

}

default_type gp_default_list[] =

{

{"buffersize",(void*)sd_buffersize},

Line 944 default_type gp_default_list[] =

Line 947 default_type gp_default_list[] =

{"lines",(void*)sd_lines},

{"log",(void*)sd_log},

{"logfile",(void*)sd_logfile},

{"new_galois_format",(void*)sd_new_galois_format},

{"output",(void*)sd_output},

{"parisize",(void*)sd_parisize},

{"path",(void*)sd_path},

{"primelimit",(void*)sd_primelimit},

{"prettyprinter",(void*)sd_prettyprinter},

{"prompt",(void*)sd_prompt},

{"prompt_cont",(void*)sd_prompt_cont},

{"psfile",(void*)sd_psfile},

{"realprecision",(void*)sd_realprecision},

{"readline",(void*)sd_rl},

Line 962 default_type gp_default_list[] =

Line 967 default_type gp_default_list[] =

};

static void

help_default()

help_default(void)

{

default_type *dft;

for (dft=gp_default_list; dft->fun; dft++)

((void (*)(ANYARG)) dft->fun)("", d_ACKNOWLEDGE);

((void (*)(char*,int)) dft->fun)("", d_ACKNOWLEDGE);

}

static GEN

Line 980 setdefault(char *s,char *v, int flag)

Line 985 setdefault(char *s,char *v, int flag)

if (!strcmp(s,dft->name))

{

if (flag == d_EXISTS) return gun;

return ((GEN (*)(ANYARG)) dft->fun)(v,flag);

return ((GEN (*)(char*,int)) dft->fun)(v,flag);

}

if (flag == d_EXISTS) return gzero;

err(talker,"unknown default: %s",s);

Line 993 setdefault(char *s,char *v, int flag)

Line 998 setdefault(char *s,char *v, int flag)

/** **/

/********************************************************************/

static int

has_ext_help()

has_ext_help(void)

{

if (help_prg)

if (GP_DATA->help)

{

char *buf = pari_strdup(help_prg), *s = buf;

char *buf = pari_strdup(GP_DATA->help), *s = buf;

FILE *file;

while (*s && *s != ' ') s++;

*s = 0; file = fopen(buf,"r");

if (file) { fclose(file); return 1; }

free(buf);

if (file) { fclose(file); return 1; }

}

return 0;

}

static int

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

Line 1053 print_fun_list(char **list, int nbli)

Line 1058 print_fun_list(char **list, int nbli)

static void

commands(int n)

{

int hashpos, s = 0, olds = LIST_LEN;

int hashpos, s = 0, size = LIST_LEN;

entree *ep;

char **list = (char **) gpmalloc((olds+1)*sizeof(char *));

char **list = (char **) gpmalloc((size+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;

list[s] = ep->name;

if (s >= olds)

if (++s >= size)

{

int news = olds + (LIST_LEN + 1)*sizeof(char *);

size += (LIST_LEN + 1)*sizeof(char *);

list = (char**) gprealloc(list,news,olds);

list = (char**) gprealloc(list,size);

olds = news;

}

list[s]=NULL; print_fun_list(list,term_height()-4); free(list);

Line 1133 print_user_member(entree *ep)

Line 1137 print_user_member(entree *ep)

}

static void

user_fun()

user_fun(void)

{

entree *ep;

int hash;

Line 1148 user_fun()

Line 1152 user_fun()

}

static void

user_member()

user_member(void)

{

entree *ep;

int hash;

Line 1165 user_member()

Line 1169 user_member()

static void

center(char *s)

{

long i, pad = term_width() - strlen(s);

long i, l = strlen(s), pad = term_width() - l;

char *u = thestring;

char *buf, *u;

if (pad<0) pad=0; else pad >>= 1;

u = buf = (char*)gpmalloc(l + pad + 2);

for (i=0; i<pad; i++) *u++ = ' ';

while (*s) *u++ = *s++;

*u++='\n'; *u=0; pariputs(thestring);

*u++ = '\n'; *u = 0;

pariputs(buf); free(buf);

}

static void

community()

community(void)

{

long len = strlen(GPMISCDIR) + 1024;

char *s = gpmalloc(len);

char *s = (char*)gpmalloc(len);

sprintf(s, "The standard distribution of GP/PARI includes a reference \

manual, a tutorial, a reference card and quite a few examples. They should \

have been installed in the directory '%s'. If not you should ask the person \

Line 1347 filter_quotes(char *s)

Line 1353 filter_quotes(char *s)

int doubquote = 0;

char *str, *t;

for (i=0; i < l; i++)

switch(s[i])

{

case '\'': quote++; break;

Line 1358 filter_quotes(char *s)

Line 1364 filter_quotes(char *s)

+ doubquote * (strlen(DOUBQUOTE)-1)

+ backquote * (strlen(BACKQUOTE)-1) + 1);

t = str;

for (i=0; i < l; i++)

switch(s[i])

{

case '\'': t = _cat(t, QUOTE); break;

Line 1369 filter_quotes(char *s)

Line 1375 filter_quotes(char *s)

*t = 0; return str;

}

#define MAX_LINE_LEN 255

static int

nl_read(char *s) { size_t l = strlen(s); return s[l-1] == '\n'; }

#define nbof(a) sizeof(a) / sizeof(a[0])

/* query external help program for s. num < 0 [keyword] or chapter number */

static void

external_help(char *s, int num)

{

long nbli = term_height()-3, li = 0;

char buf[MAX_LINE_LEN+1], *str, *opt = "", *ar = "";

char buf[256], ar[32], *str, *opt = "";

pariFILE *z;

FILE *f;

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

if (!GP_DATA->help) err(talker,"no external help program");

s = filter_quotes(s);

str = gpmalloc(strlen(help_prg) + strlen(s) + 64);

str = gpmalloc(strlen(GP_DATA->help) + strlen(s) + 64);

*ar = 0;

if (num < 0)

opt = "-k";

else if (s[strlen(s)-1] != '@')

{ ar = thestring; sprintf(ar,"@%d",num); }

sprintf(ar,"@%d",num);

sprintf(str,"%s -fromgp %s %c%s%s%c",help_prg,opt, SHELL_Q,s,ar,SHELL_Q);

sprintf(str,"%s -fromgp %s %c%s%s%c",GP_DATA->help,opt, SHELL_Q,s,ar,SHELL_Q);

z = try_pipe(str,0); f = z->file;

free(str); free(s);

free(str);

while (fgets(buf,MAX_LINE_LEN,f))

free(s);

while (fgets(buf, nbof(buf), f))

{

if (!strncmp("ugly_kludge_done",buf,16)) break;

buf[MAX_LINE_LEN]=0; pariputs(buf);

pariputs(buf);

if (++li > nbli) { hit_return(); li = 0; }

if (nl_read(buf) && ++li > nbli) { hit_return(); li = 0; }

}

pari_fclose(z);

}

Line 1444 aide0(char *s, int flag)

Line 1456 aide0(char *s, int flag)

s = get_sep(s);

if (isdigit((int)*s))

{

n=atoi(s);

n = atoi(s);

if (n == 12) { community(); return; }

if (n<0 || n > 12)

if (n < 0 || n > 12)

err(talker2,"no such section in help: ?",s,s);

if (long_help) external_help(s,3); else commands(n);

return;

}

/* Get meaningful entry on \ps 5 */

if (*s == '\\') { s1 = s+1; skip_alpha(s1); *s1 = '\0';}

if (flag & h_APROPOS) { external_help(s,-1); return; }

Line 1578 print_hash_list(char *s)

Line 1590 print_hash_list(char *s)

for(; n<=m; n++)

{

pariputsf("*** hashcode = %ld\n",n);

pariputsf("*** hashcode = %lu\n",n);

for (ep=functions_hash[n]; ep; ep=ep->next)

print_entree(ep,n);

}

Line 1601 print_hash_list(char *s)

Line 1613 print_hash_list(char *s)

}

static char *

what_readline()

what_readline(void)

{

#ifdef READLINE

if (use_readline)

return (GP_DATA->flags & USE_READLINE)? "v"READLINE" enabled": "disabled";

return "v"READLINE" enabled";

#else

else

#endif

return "disabled";

#endif

}

static void

print_version()

print_version(void)

{

char buf[64];

Line 1623 print_version()

Line 1634 print_version()

}

static void

gp_head()

gp_head(void)

{

print_version(); pariputs("\n");

print_text("\nPARI/GP is free software, covered by the GNU General Public \

License, and comes WITHOUT ANY WARRANTY WHATSOEVER");

pariputs("\n\

Line 1635 Type ?12 for how to get moral (and possibly technical)

Line 1646 Type ?12 for how to get moral (and possibly technical)

sd_realprecision ("",d_ACKNOWLEDGE);

sd_seriesprecision("",d_ACKNOWLEDGE);

sd_format ("",d_ACKNOWLEDGE);

pariputsf("\nparisize = %ld, primelimit = %ld\n", parisize, primelimit);

pariputsf("\nparisize = %lu, primelimit = %lu\n", top-bot, primelimit);

}

static void

void

fix_buffer(Buffer *b, long newlbuf)

{

b->buf = gprealloc(b->buf, newlbuf, b->len);

b->len = paribufsize = newlbuf;

b->buf = gprealloc(b->buf, b->len);

}

void

gp_quit()

gp_quit(void)

{

free_graph(); freeall();

kill_all_buffers(NULL);

if (INIT_SIG) pari_sig_init(SIG_DFL);

term_color(c_NONE);

pariputs_opt("Goodbye!\n");

if (under_texmacs) tm_end_output();

if (GP_DATA->flags & TEXMACS) tm_end_output();

exit(0);

}

/* history management function:

* flag < 0, called from freeall()

* flag = 0, called from %num in anal.c:truc()

* flag > 0, called from %` in anal.c:truc(), p > 0

static GEN

gp_history(long p, long flag, char *old, char *entrypoint)

{

int er1 = 0;

if (flag < 0) { free((void *)hist); return NULL; }

if (!tglobal) er1 = 1;

if (flag)

{

p = tglobal - p;

if (p <= 0) er1 = 1;

}

else if (p > tglobal)

err(talker2,"I can't see into the future",old,entrypoint);

if (!p) p = tglobal;

if (tglobal - p >= histsize) er1 = 1;

p = (p-1) % histsize;

if (er1 || !hist[p])

err(talker2,"I can't remember before the big bang",old,entrypoint);

return hist[p];

}

extern char *GENtostr0(GEN x, void(*do_out)(GEN));

static void

texmacs_output(GEN z, long n)

{

char *sz = GENtostr0(z, &outtex);

printf("%clatex:", DATA_BEGIN);

printf("\\magenta\\%%%ld = $\\blue ", n);

printf("%s$%c", sz,DATA_END); free(sz);

fflush(stdout);

}

/* Wait for prettyprinter for finish, to prevent new prompt from overwriting

* the output. Fill the output buffer, wait until it is read.

* Better than sleep(2): give possibility to print */

static void

prettyp_wait()

{

char *s = " \n";

int i = 400;

pariputs("\n\n"); pariflush(); /* start translation */

while (--i) pariputs(s);

pariputs("\n"); pariflush();

}

/* initialise external prettyprinter (tex2mail) */

static int

prettyp_init()

{

if (!prettyprinter_file)

prettyprinter_file = try_pipe(prettyprinter, mf_OUT | mf_TEST);

if (prettyprinter_file) return 1;

err(warner,"broken prettyprinter: '%s'",prettyprinter);

if (prettyprinter != prettyprinter_dft) free(prettyprinter);

prettyprinter = NULL; return 0;

}

/* n = history number. if n = 0 no history */

static int

tex2mail_output(GEN z, long n)

{

FILE *o_out;

int o_prettyp;

if (!(prettyprinter && prettyp_init())) return 0;

o_out = pari_outfile; /* save state */

o_prettyp = prettyp;

/* Emit first: there may be lines before the prompt */

if (n) term_color(c_OUTPUT);

pariflush();

pari_outfile = prettyprinter_file->file;

prettyp = f_TEX;

/* history number */

if (n)

{

if (*term_get_color(c_HIST) || *term_get_color(c_OUTPUT))

{

char col1[80];

strcpy(col1, term_get_color(c_HIST));

sprintf(thestring, "\\LITERALnoLENGTH{%s}\\%%%ld = \\LITERALnoLENGTH{%s}",

col1, n, term_get_color(c_OUTPUT));

}

else

sprintf(thestring, "\\%%%ld = ", n);

pariputs_opt(thestring);

}

/* output */

gp_output(z);

/* flush and restore */

prettyp_wait();

prettyp = o_prettyp;

pari_outfile = o_out;

if (n) term_color(c_NONE);

return 1;

}

static void

normal_output(GEN z, long n)

{

/* history number */

term_color(c_HIST);

sprintf(thestring, "%%%ld = ", n);

pariputs_opt(thestring);

/* output */

term_color(c_OUTPUT);

init_lim_lines(thestring,lim_lines);

gp_output(z);

init_lim_lines(NULL,lim_lines);

term_color(c_NONE); pariputc('\n');

}

static GEN

gpreadbin(char *s)

{

GEN x = readbin(s,infile);

Line 1821 escape0(char *tch)

Line 1710 escape0(char *tch)

d = atol(s); if (*s == '-') s++;

while (isdigit((int)*s)) s++;

}

x = gp_history(d, 0, tch+1,tch-1);

x = gp_history(GP_DATA->hist, d, tch+1,tch-1);

switch (c)

{

case 'a': brute (x, fmt.format, -1); break;

case 'B':

case 'm': matbrute(x, fmt.format, -1); break;

{ /* prettyprinter */

case 'B': if (tex2mail_output(x,0)) return; /* fall through */

gp_data G = *GP_DATA; /* copy */

case 'b': sor (x, fmt.format, -1, fmt.field); break;

gp_hist h = *(G.hist); /* copy */

case 'x': voir(x, get_int(s, -1));

pariout_t f = *(G.fmt); /* copy */

G.hist = &h; h.total = 0; /* no hist number */

G.fmt = &f; f.prettyp = f_PRETTY;

G.flags &= ~(TEST|TEXMACS);

G.lim_lines = 0;

gp_output(x, &G); break;

}

case 'a': brute (x, GP_DATA->fmt->format, -1); break;

case 'm': matbrute(x, GP_DATA->fmt->format, -1); break;

case 'b': sor(x, GP_DATA->fmt->format, -1, GP_DATA->fmt->fieldw); break;

case 'x': voir(x, get_int(s, -1)); break;

case 'w':

{

GEN g[2]; g[0] = x; g[1] = NULL;

s = get_sep_colon_ok(s); if (!*s) s = current_logfile;

write0(s, g, f_RAW); return;

write0(s, g); return;

}

pariputc('\n'); return;

Line 1843 escape0(char *tch)

Line 1743 escape0(char *tch)

case 'd': help_default(); break;

case 'e':

s = get_sep(s);

if (!*s) s = pariecho?"0":"1";

if (!*s) s = (GP_DATA->flags & ECHO)? "0": "1";

sd_echo(s,d_ACKNOWLEDGE); break;

case 'g':

switch (*s)

Line 1875 escape0(char *tch)

Line 1775 escape0(char *tch)

case 'r':

s = get_sep_colon_ok(s);

switchin(s);

if (file_is_binary(infile)) gpreadbin(s);

if (file_is_binary(infile))

{

GEN x = gpreadbin(s);

if (isclone(x)) /* many BIN_GEN */

{

long i, l = lg(x);

err(warner,"setting %ld history entries", l-1);

for (i=1; i<l; i++) (void)set_hist_entry(GP_DATA->hist, (GEN)x[i]);

}

break;

case 's': etatpile(0); break;

case 't': gentypes(); break;

Line 1889 escape0(char *tch)

Line 1798 escape0(char *tch)

case 'v': print_version(); break;

case 'y':

s = get_sep(s);

if (!*s) s = simplifyflag?"0":"1";

if (!*s) s = (GP_DATA->flags & SIMPLIFY)? "0": "1";

sd_simplify(s,d_ACKNOWLEDGE); break;

default: err(caracer1,tch-1,tch-2);

}

Line 1898 escape0(char *tch)

Line 1807 escape0(char *tch)

static void

escape(char *tch)

{

char *old = _analyseur();

char *old = get_analyseur();

_set_analyseur(tch); /* for error messages */

set_analyseur(tch); /* for error messages */

escape0(tch);

_set_analyseur(old);

set_analyseur(old);

}

/********************************************************************/

/* */

Line 1912 escape(char *tch)

Line 1821 escape(char *tch)

# include <pwd.h>

#endif

static int

static int get_line_from_file(char *prompt, filtre_t *F, FILE *file);

get_preproc_value(char *s)

#define err_gprc(s,t,u) { fprintferr("\n"); err(talker2,s,t,u); }

static void

init_filtre(filtre_t *F, void *data)

{

if (!strncmp(s,"EMACS",5)) return under_emacs || under_texmacs;

F->data = data;

if (!strncmp(s,"READL",5))

F->in_string = 0;

{

F->in_comment = 0;

#ifdef READLINE

F->downcase = 0;

if (use_readline)

return 1;

else

#endif

return 0;

}

return -1;

}

/* LOCATE GPRC */

/* return $HOME or the closest we can find */

static char *

get_home(int *free_it)

Line 1954 static FILE *

Line 1861 static FILE *

gprc_chk(char *s)

{

FILE *f = fopen(s, "r");

if (f && !quiet_mode)

if (f && !(GP_DATA->flags & QUIET)) fprintferr("Reading GPRC: %s ...", s);

{

fprintferr("Reading GPRC: %s ...", s);

added_newline = 0;

}

return f;

}

/* Look for [._]gprc: $GPRC, then in $HOME, /, C:/ */

static FILE *

gprc_get()

gprc_get(void)

{

FILE *f = NULL;

char *str, *s, c;

Line 1998 gprc_get()

Line 1901 gprc_get()

return f;

}

static int get_line_from_file(char *prompt, Buffer *b, FILE *file);

/* PREPROCESSOR */

#define err_gprc(s,t,u) { fprintferr("\n"); err(talker2,s,t,u); }

static ulong

read_uint(char **s)

{

long v = atol(*s);

if (!isdigit((int)**s)) err_gprc("not an integer", *s, *s);

while (isdigit((int)**s)) (*s)++;

return v;

}

static ulong

read_dot_uint(char **s)

{

if (**s != '.') return 0;

(*s)++; return read_uint(s);

}

/* read a.b.c */

static long

read_version(char **s)

{

long a, b, c;

a = read_uint(s);

b = read_dot_uint(s);

c = read_dot_uint(s);

return PARI_VERSION(a,b,c);

}

static int

get_preproc_value(char **s)

{

if (!strncmp(*s,"EMACS",5))

{

*s += 5;

return GP_DATA->flags & (EMACS|TEXMACS);

}

if (!strncmp(*s,"READL",5))

{

*s += 5;

return GP_DATA->flags & USE_READLINE;

}

if (!strncmp(*s,"VERSION",7))

{

int less = 0, orequal = 0;

long d;

*s += 7;

switch(**s)

{

case '<': (*s)++; less = 1; break;

case '>': (*s)++; less = 0; break;

default: return -1;

}

if (**s == '=') { (*s)++; orequal = 1; }

d = PARI_VERSION_CODE - read_version(s);

if (!d) return orequal;

return less? (d < 0): (d > 0);

}

return -1;

}

/* PARSE GPRC */

/* 1) replace next separator by '\0' (t must be writeable)

* 2) return the next expression ("" if none)

* see get_sep0() */

static char *

next_expr(char *t)

{

int outer = 1;

char *s = t;

for(;;)

{

char c;

switch ((c = *s++))

{

case '"':

if (outer || (s >= t+2 && s[-2] != '\\')) outer = !outer;

break;

case '\0':

return "";

default:

if (outer && separe(c)) { s[-1] = 0; return s; }

}

static char **

gp_initrc()

gp_initrc(void)

{

char **flist, *s,*s1,*s2;

char **flist, *nexts,*s,*t;

FILE *file = gprc_get();

long fnum = 4, find = 0;

Buffer *b;

filtre_t F;

if (!file) return NULL;

flist = (char **) gpmalloc(fnum * sizeof(char*));

b = new_buffer();

init_filtre(&F, (void*)b);

for(;;)

{

if (!get_line_from_file(NULL,b,file))

if (!get_line_from_file(NULL,&F,file)) break;

{

s = b->buf;

del_buffer(b);

if (*s == '#')

if (!quiet_mode) fprintferr("Done.\n\n");

{ /* preprocessor directive */

fclose(file); flist[find] = NULL;

int z, NOT = 0;

return flist;

s++;

if (strncmp(s,"if",2)) err_gprc("unknown directive",s,b->buf);

s += 2;

if (!strncmp(s,"not",3)) { NOT = !NOT; s += 3; }

if (*s == '!') { NOT = !NOT; s++; }

t = s;

z = get_preproc_value(&s);

if (z < 0) err_gprc("unknown preprocessor variable",t,b->buf);

if (NOT) z = !z;

if (!*s)

{ /* make sure at least an expr follows the directive */

if (!get_line_from_file(NULL,&F,file)) break;

s = b->buf;

}

if (!z) continue; /* dump current line */

}

for (s = b->buf; *s; )

/* parse line */

for ( ; *s; s = nexts)

{

s1 = s; if (get_sep2(s)) s++;

nexts = next_expr(s);

s += strlen(s1); /* point to next expr */

if (!strncmp(s,"read",4))

if (*s1 == '#')

{ /* preprocessor directive */

int z, NOT = 0;

s1++;

if (strncmp(s1,"if",2)) err_gprc("unknown directive",s1,b->buf);

s1 += 2;

if (!strncmp(s1,"not",3)) { NOT = !NOT; s1 += 3; }

if (*s1 == '!') { NOT = !NOT; s1++; }

z = get_preproc_value(s1);

if (z < 0) err_gprc("unknown preprocessor variable",s1,b->buf);

if (NOT) z = !z;

if (!z) continue;

s1 += 5;

}

if (!strncmp(s1,"read",4))

{ /* read file */

s1 += 4;

s += 4;

if (find == fnum-1)

{

long n = fnum << 1;

fnum <<= 1;

flist = (char**)gprealloc(flist, n*sizeof(char*),

flist = (char**)gprealloc(flist, fnum*sizeof(char*));

fnum*sizeof(char*));

fnum = n;

}

flist[find++] = s2 = gpmalloc(strlen(s1) + 1);

flist[find++] = t = gpmalloc(strlen(s) + 1);

if (*s1 == '"') (void)readstring(s1, s2);

if (*s == '"') (void)readstring(s, t);

else strcpy(s2,s1);

else strcpy(t,s);

}

else

{ /* set default */

s2 = s1; while (*s2 && *s2 != '=') s2++;

t = s; while (*t && *t != '=') t++;

if (*s2 != '=') err_gprc("missing '='",s2,b->buf);

if (*t != '=') err_gprc("missing '='",t,b->buf);

*s2++ = 0;

*t++ = 0;

if (*s2 == '"') (void)readstring(s2, s2);

if (*t == '"') (void)readstring(t, t);

setdefault(s1,s2,d_INITRC);

setdefault(s,t,d_INITRC);

}

del_buffer(b);

if (!(GP_DATA->flags & QUIET)) fprintferr("Done.\n\n");

fclose(file); flist[find] = NULL;

return flist;

}

/********************************************************************/

Line 2072 gp_initrc()

Line 2062 gp_initrc()

/********************************************************************/

/* flag:

* ti_NOPRINT don't print

* ti_REGULAR print elapsed time (chrono = 1)

* ti_REGULAR print elapsed time (flags & CHRONO)

* ti_LAST print last elapsed time (##)

* ti_INTERRUPT received a SIGINT

static char *

do_time(long flag)

{

static char buf[64];

static long last = 0;

long delay = (flag == ti_LAST)? last: gptimer();

long delay = (flag == ti_LAST)? last: TIMER(GP_DATA->T);

char *s;

last = delay;

Line 2091 do_time(long flag)

Line 2082 do_time(long flag)

case ti_LAST: s = " *** last result computed in "; break;

default: return NULL;

}

strcpy(thestring,s); s=thestring+strlen(s);

strcpy(buf,s); s = buf+strlen(s);

strcpy(s, term_get_color(c_TIME)); s+=strlen(s);

if (delay >= 3600000)

{

Line 2116 do_time(long flag)

Line 2107 do_time(long flag)

sprintf(s, "%ld ms", delay); s+=strlen(s);

strcpy(s, term_get_color(c_NONE));

if (flag != ti_INTERRUPT) { s+=strlen(s); *s++='.'; *s++='\n'; *s=0; }

return thestring;

return buf;

}

static void

gp_handle_SIGINT()

gp_handle_SIGINT(void)

{

#ifdef _WIN32

if (++win32ctrlc >= 5) _exit(3);

#else

if (under_texmacs) tm_start_output();

if (GP_DATA->flags & TEXMACS) tm_start_output();

err(siginter, do_time(ti_INTERRUPT));

#endif

}

Line 2141 gp_sighandler(int sig)

Line 2132 gp_sighandler(int sig)

case SIGBREAK: gp_handle_SIGINT(); return;

#endif

#ifdef SIGINT

case SIGINT: gp_handle_SIGINT(); return;

#endif

#ifdef SIGSEGV

case SIGSEGV:

case SIGSEGV: msg = "GP (Segmentation Fault)"; break;

msg="GP (Segmentation Fault)";

break;

#endif

#ifdef SIGBUS

case SIGBUS:

case SIGBUS: msg = "GP (Bus Error)"; break;

msg="GP (Bus Error)";

break;

#endif

#ifdef SIGFPE

case SIGFPE:

case SIGFPE: msg = "GP (Floating Point Exception)"; break;

msg="GP (Floating Point Exception)";

break;

#endif

#ifdef SIGPIPE

case SIGPIPE:

if (prettyprinter_file && pari_outfile == prettyprinter_file->file)

{

pariFILE *f = GP_DATA->pp->file;

if (f && pari_outfile == f->file)

{

pariFILE *f = prettyprinter_file;

GP_DATA->pp->file = NULL; /* to avoid oo recursion on error */

prettyprinter_file = NULL; /* to avoid oo recursion on error */

pari_outfile = stdout; pari_fclose(f);

}

err(talker, "Broken Pipe, resetting file stack...");

return; /* not reached */

}

#endif

default: msg = "signal handling"; break;

default:

msg="signal handling";

}

err(bugparier,msg);

err(bugparier, msg);

}

static void

Line 2194 brace_color(char *s, int c, int force)

Line 2178 brace_color(char *s, int c, int force)

}

static char *

do_prompt()

do_prompt(int in_comment, char *p)

{

static char buf[MAX_PROMPT_LEN + 24]; /* + room for color codes */

char *s;

if (test_mode) return prompt;

if (GP_DATA->flags & TEST) return prompt;

s = buf; *s = 0;

/* escape sequences bug readline, so use special bracing (if available) */

brace_color(s, c_PROMPT, 0);

s += strlen(s);

if (filtre(s,NULL, f_COMMENT))

if (in_comment)

strcpy(s, COMMENTPROMPT);

else

do_strftime(prompt,s);

do_strftime(p,s, MAX_PROMPT_LEN-1);

s += strlen(s);

brace_color(s, c_INPUT, 1); return buf;

}

static void

static char *

unblock_SIGINT()

fgets_texmacs(char *s, int n, FILE *f)

{

#ifdef USE_SIGRELSE

tm_start_output(); tm_end_output(); /* tell TeXmacs we need input */

sigrelse(SIGINT);

return fgets(s,n,f);

#elif USE_SIGSETMASK

sigsetmask(0);

#endif

}

/* Read from file (up to '\n' or EOF) and copy at s0 (points in b->buf) */

static char *

file_input(Buffer *b, char **s0, FILE *file, int TeXmacs)

file_input(Buffer *b, char **s0, input_method *IM)

{

int first = 1;

char *s = *s0;

Line 2233 file_input(Buffer *b, char **s0, FILE *file, int TeXma

Line 2214 file_input(Buffer *b, char **s0, FILE *file, int TeXma

used0 = used;

for(;;)

{

long left = b->len - used, ls;

long left = b->len - used, l;

/* if from TeXmacs, tell him we need input */

if (TeXmacs) { tm_start_output(); tm_end_output(); }

if (left < 512)

{

Line 2244 file_input(Buffer *b, char **s0, FILE *file, int TeXma

Line 2223 file_input(Buffer *b, char **s0, FILE *file, int TeXma

*s0 = b->buf + used0;

}

s = b->buf + used;

if (! fgets(s, left, file)) return first? NULL: *s0; /* EOF */

if (! IM->fgets(s, left, IM->file))

ls = strlen(s); first = 0;

return first? NULL: *s0; /* EOF */

if (ls+1 < left || s[ls-1] == '\n') return *s0; /* \n */

used += ls;

}

#ifdef READLINE

l = strlen(s); first = 0;

static char *

if (l+1 < left || s[l-1] == '\n') return *s0; /* \n */

gprl_input(Buffer *b, char **s0, char *prompt)

used += l;

{

long used = *s0 - b->buf;

long left = b->len - used;

char *s;

if (! (s = readline(prompt)) ) return NULL; /* EOF */

if ((ulong)left < strlen(s))

{

fix_buffer(b, b->len << 1);

*s0 = b->buf + used;

}

return s;

}

#endif

static void

/* Read a "complete line" and filter it. Return: 0 if EOF, 1 otherwise */

input_loop(Buffer *b, char *buf0, FILE *file, char *prompt)

int

input_loop(filtre_t *F, input_method *IM)

{

const int TeXmacs = (under_texmacs && file == stdin);

Buffer *b = (Buffer*)F->data;

const int f_flag = prompt? f_REG: f_REG | f_KEEPCASE;

char *to_read, *s = b->buf;

char *end, *s = b->buf, *buf = buf0;

int wait_for_brace = 0;

int wait_for_input = 0;

/* read first line */

handle_C_C = 0;

while (! (to_read = IM->getline(b,&s,IM)) )

{ /* EOF */

if (!handle_C_C) { check_filtre(F); return 0; }

/* received ^C in getline and coming back from break_loop();

* retry (as if "\n" were input) */

handle_C_C = 0;

}

/* buffer is not empty, init filter */

(void)ask_filtre(f_INIT);

F->in_string = 0;

F->more_input= 0;

F->wait_for_brace = 0;

for(;;)

{

char *t = buf;

F->s = to_read;

if (!ask_filtre(f_COMMENT))

F->t = s;

{ /* not in comment */

(void)filtre0(F);

skip_space(t);

if (IM->free) free(to_read);

if (*t == LBRACE) { t++; wait_for_input = wait_for_brace = 1; }

}

end = filtre(t,s, f_flag);

if (!*s) { if (!wait_for_input) break; }

if (! F->more_input) break;

else

{

if (*(b->buf) == '?') break;

s = end-1; /* *s = last input char */

if (*s == '\\')

{

}

else if (*s == '=')

{

wait_for_input = 1; s++;

}

else

{

if (!wait_for_brace) break;

if (*s == RBRACE) { *s=0; break; }

s++;

}

/* read continuation line */

#ifdef READLINE

s = F->end;

if (!file) { free(buf); buf = gprl_input(b,&s,""); }

if (IM->prompt) IM->prompt = do_prompt(F->in_comment, prompt_cont);

else

to_read = IM->getline(b,&s, IM);

#endif

if (!to_read) break;

buf = file_input(b,&s,file,TeXmacs);

if (!buf) break;

}

if (!file && buf) free(buf);

return 1;

}

/* prompt = NULL --> from gprc. Return 1 if new input, and 0 if EOF */

static int

get_line_from_file(char *prompt, Buffer *b, FILE *file)

get_line_from_file(char *prompt, filtre_t *F, FILE *file)

{

const int TeXmacs = (under_texmacs && file == stdin);

const int TeXmacs = ((GP_DATA->flags & TEXMACS) && file == stdin);

char *buf, *s = b->buf;

char *s;

input_method IM;

handle_C_C = 0;

IM.file = file;

while (! (buf = file_input(b,&s,file,TeXmacs)) )

IM.fgets= TeXmacs? &fgets_texmacs: &fgets;

{ /* EOF */

IM.prompt = NULL;

if (!handle_C_C)

IM.getline= &file_input;

{

IM.free = 0;

if (TeXmacs) tm_start_output();

if (! input_loop(F,&IM))

return 0;

{

}

if (TeXmacs) tm_start_output();

/* received ^C in fgets, retry (as is "\n" were input) */

return 0;

}

input_loop(b,buf,file,prompt);

s = ((Buffer*)F->data)->buf;

if (*s && prompt) /* don't echo if from gprc */

{

if (pariecho)

if (GP_DATA->flags & ECHO)

{ pariputs(prompt); pariputs(s); pariputc('\n'); }

else

if (logfile) fprintf(logfile, "%s%s\n",prompt,s);

pariflush();

}

if (under_texmacs) tm_start_output();

if (GP_DATA->flags & TEXMACS) tm_start_output();

return 1;

}

/* request one line interactively.

* Return 0: EOF

* 1: got one line from readline or infile */

#ifndef READLINE

static int

get_line_from_user(char *prompt, Buffer *b)

get_line_from_user(char *prompt, filtre_t *F)

{

pariputs(prompt);

return get_line_from_file(prompt,b,infile);

return get_line_from_file(prompt,F,infile);

}

#else

static int

get_line_from_user(char *prompt, Buffer *b)

{

if (use_readline)

{

static char *previous_hist = NULL;

char *buf, *s = b->buf;

if (! (buf = gprl_input(b,&s, prompt)) )

{ /* EOF */

pariputs("\n"); return 0;

}

input_loop(b,buf,NULL,prompt);

unblock_SIGINT(); /* bug in readline 2.0: need to unblock ^C */

if (*s)

{

/* update history (don't add the same entry twice) */

if (!previous_hist || strcmp(s,previous_hist))

{

if (previous_hist) free(previous_hist);

previous_hist = pari_strdup(s); add_history(s);

}

/* update logfile */

if (logfile) fprintf(logfile, "%s%s\n",prompt,s);

}

return 1;

}

else

{

pariputs(prompt);

return get_line_from_file(prompt,b,infile);

}

#endif

static int

is_interactive()

is_interactive(void)

{

ulong f = GP_DATA->flags;

#if defined(UNIX) || defined(__EMX__)

return (infile == stdin && !under_texmacs

return (infile == stdin && !(f & TEXMACS)

&& (under_emacs || isatty(fileno(stdin))));

&& (f & EMACS || isatty(fileno(stdin))));

#else

return (infile == stdin && !under_texmacs);

return (infile == stdin && !(f & TEXMACS));

#endif

}

extern int get_line_from_readline(char *prompt, filtre_t *F);

/* return 0 if no line could be read (EOF) */

static int

read_line(char *promptbuf, Buffer *b)

read_line(filtre_t *F, char *PROMPT)

{

int res;

if (compatible == OLDALL) F->downcase = 1;

if (is_interactive())

return get_line_from_user(promptbuf, b);

{

if (!PROMPT) PROMPT = do_prompt(F->in_comment, prompt);

#ifdef READLINE

if (GP_DATA->flags & USE_READLINE)

res = get_line_from_readline(PROMPT, F);

else

#endif

res = get_line_from_user(PROMPT, F);

if (!disable_color) { term_color(c_NONE); pariflush(); }

}

else

return get_line_from_file(DFT_PROMPT,b,infile);

res = get_line_from_file(DFT_PROMPT,F,infile);

return res;

}

static void

static int

chron(char *s)

{

if (*s)

{

{ /* if "#" or "##" timer metacommand. Otherwise let the parser get it */

char *old = s-1;

if (*s == '#') s++;

if (*s == '#') { pariputs(do_time(ti_LAST)); s++; }

if (*s) return 0;

if (*s) err(caracer1,s,old);

pariputs(do_time(ti_LAST));

}

else { chrono = 1-chrono; sd_timer("",d_ACKNOWLEDGE); }

else { GP_DATA->flags ^= CHRONO; sd_timer("",d_ACKNOWLEDGE); }

return 1;

}

/* return 0: can't interpret *buf as a metacommand

* 1: did interpret *buf as a metacommand or empty command */

static int

check_meta(char *buf)

{

switch(*buf++)

{

case '?': aide(buf, h_REGULAR); break;

case '#': chron(buf); break;

case '#': return chron(buf);

case '\\': escape(buf); break;

case '\0': return 2;

case '\0': break;

default: return 0;

}

return 1;

}

/* kill all history entries since loc */

static void

prune_history(gp_hist *H, long loc)

{

long i, j;

i = (H->total-1) % H->size;

j = H->total - loc;

for ( ; j > 0; i--,j--)

{

if (H->res[i])

{

gunclone(H->res[i]);

H->res[i] = NULL;

}

if (!i) i = H->size;

}

H->total = loc;

}

static int

is_silent(char *s) { char c = s[strlen(s) - 1]; return separe(c); }

/* If there are other buffers open (bufstack != NULL), we are doing an

* immediate read (with read, extern...) */

static GEN

gp_main_loop(int ismain)

{

long av, i,j;

gp_hist *H = GP_DATA->hist;

VOLATILE GEN z = gnil;

gpmem_t av = avma;

GEN z = gnil;

Buffer *b = new_buffer();

filtre_t F;

if (!setjmp(b->env))

{

b->flenv = 1;

push_stack(&bufstack, (void*)b);

}

for(; ; setjmp(b->env))

init_filtre(&F, (void*)b);

for (; ; setjmp(b->env), avma = av)

{

if (ismain)

{

static long tloc, outtyp;

tloc = tglobal; outtyp = prettyp; recover(0);

tloc = H->total;

outtyp = GP_DATA->fmt->prettyp;

recover(0);

if (setjmp(environnement))

{

{ /* recover from error */

char *s = (char*)global_err_data;

if (s && *s) outerr(lisseq(s));

avma = top; parisize = top - bot;

avma = top;

j = tglobal - tloc; i = (tglobal-1)%histsize;

prune_history(H, tloc);

while (j)

GP_DATA->fmt->prettyp = outtyp;

{

gunclone(hist[i]); hist[i]=NULL;

if (!i) i = histsize;

i--; j--;

}

tglobal = tloc; prettyp = outtyp;

kill_all_buffers(b);

}

added_newline = 1;

if (paribufsize != b->len) fix_buffer(b, paribufsize);

for(;;)

if (! read_line(&F, NULL))

{

int r;

#ifdef _WIN32

r = read_line(do_prompt(), b);

Sleep(10); if (win32ctrlc) dowin32ctrlc();

if (!disable_color) term_color(c_NONE);

#endif

if (!r)

if (popinfile()) gp_quit();

{

if (ismain) continue;

#ifdef _WIN32

pop_buffer(); return z;

Sleep(10); if (win32ctrlc) dowin32ctrlc();

#endif

if (popinfile()) gp_quit();

if (!ismain) { pop_buffer(); return z; }

}

else if (!check_meta(b->buf)) break;

}

if (check_meta(b->buf)) continue;

if (ismain)

{

char c = b->buf[strlen(b->buf) - 1];

gpsilent = is_silent(b->buf);

gpsilent = separe(c);

TIMERstart(GP_DATA->T);

(void)gptimer();

}

av = avma;

z = readseq(b->buf, GP_DATA->flags & STRICTMATCH);

z = readseq(b->buf, strictmatch);

if (!added_newline) pariputc('\n'); /* last output was print1() */

if (! ismain) continue;

if (chrono) pariputs(do_time(ti_REGULAR)); else do_time(ti_NOPRINT);

if (z == gnil) continue;

if (simplifyflag) z = simplify_i(z);

if (GP_DATA->flags & CHRONO)

i = tglobal % histsize; tglobal++;

pariputs(do_time(ti_REGULAR));

if (hist[i]) gunclone(hist[i]);

hist[i] = z = gclone(z); avma = av;

if (gpsilent) continue;

if (test_mode) { init80(0); gp_output(z); pariputc('\n'); }

else

{

do_time(ti_NOPRINT);

if (under_texmacs)

if (z == gnil) continue;

texmacs_output(z,tglobal);

else if (prettyp != f_PRETTY || !tex2mail_output(z,tglobal))

if (GP_DATA->flags & SIMPLIFY) z = simplify_i(z);

normal_output(z,tglobal);

z = set_hist_entry(H, z);

}

if (!gpsilent) gp_output(z, GP_DATA);

pariflush();

}

Line 2541 read0(char *s)

Line 2477 read0(char *s)

static void

check_secure(char *s)

{

if (secure)

if (GP_DATA->flags & SECURE)

err(talker, "[secure mode]: system commands not allowed\nTried to run '%s'",s);

}

Line 2554 extern0(char *s)

Line 2490 extern0(char *s)

}

static int

silent()

silent(void)

{

if (gpsilent) return 1;

{ char c = _analyseur()[1]; return separe(c); }

{ char c = get_analyseur()[1]; return separe(c); }

}

GEN

default0(char *a, char *b, long flag)

{

if (flag) flag=d_RETURN;

return setdefault(a,b, flag? d_RETURN

else

: silent()? d_SILENT: d_ACKNOWLEDGE);

flag = silent()? d_SILENT: d_ACKNOWLEDGE;

return setdefault(a,b,flag);

}

GEN

input0()

input0(void)

{

Buffer *b = new_buffer();

filtre_t F;

GEN x;

init_filtre(&F, (void*)b);

push_stack(&bufstack, (void*)b);

while (! get_line_from_file(DFT_INPROMPT,b,infile))

while (! get_line_from_file(DFT_INPROMPT,&F,infile))

if (popinfile()) { fprintferr("no input ???"); gp_quit(); }

x = lisseq(b->buf);

pop_buffer(); return x;

Line 2593 system0(char *s)

Line 2529 system0(char *s)

#endif

}

void

error0(GEN *g)

{

term_color(c_ERR);

if (!added_newline) pariputc('\n');

pariputs("### User error:\n\n ");

print0(g,f_RAW); term_color(c_NONE);

err_recover(talker);

}

void errcontext(char *msg, char *s, char *entry);

int

break_loop(long numerr)

{

static FILE *oldinfile = NULL;

static char *old = NULL;

static Buffer *b = NULL;

VOLATILE int go_on = 0;

int go_on = 0;

char *s, *t, *msg;

filtre_t F;

if (b) jump_to_given_buffer(b);

push_stack(&bufstack, (void*)new_buffer());

Line 2624 break_loop(long numerr)

Line 2549 break_loop(long numerr)

}

else

{

Buffer *oldb = (Buffer*)bufstack->prev->value;

msg = "Starting break loop (type 'break' to go back to GP)";

old = s = _analyseur();

old = s = get_analyseur();

t = oldb->buf;

t = NULL;

/* something fishy, probably a ^C, or we overran analyseur */

if (bufstack->prev)

if (!s || !s[-1] || s < t || s >= t + oldb->len) s = NULL;

{

Buffer *oldb = (Buffer*)bufstack->prev->value;

t = oldb->buf;

/* something fishy, probably a ^C, or we overran analyseur */

if (!s || !s[-1] || s < t || s >= t + oldb->len) s = NULL;

}

b->flenv = 1; oldinfile = infile;

}

init_filtre(&F, (void*)b);

term_color(c_ERR); pariputc('\n');

errcontext(msg, s, t); if (s) pariputc('\n');

Line 2640 break_loop(long numerr)

Line 2570 break_loop(long numerr)

infile = stdin;

for(;;)

{

int flag;

GEN x;

if (! read_line("> ", b)) break;

if (! read_line(&F, BREAK_LOOP_PROMPT)) break;

if (!(flag = check_meta(b->buf)))

if (check_meta(b->buf))

{ /* break loop initiated by ^C? Empty input --> continue computation */

if (numerr == siginter && *(b->buf) == 0) { handle_C_C=go_on=1; break; }

continue;

}

x = lisseq(b->buf);

if (did_break())

{

GEN x = lisseq(b->buf);

if (numerr == siginter && did_break() == br_NEXT)

if (did_break())

{

if (numerr == siginter && did_break() == br_NEXT)

(void)loop_break(); /* clear status flag */

{

go_on = 1;

(void)loop_break(); /* clear status flag */

go_on = 1;

}

break;

}

if (x == gnil) continue;

break;

term_color(c_OUTPUT); gp_output(x);

term_color(c_NONE); pariputc('\n');

}

if (numerr == siginter && flag == 2) { handle_C_C = go_on = 1; break; }

if (x == gnil || is_silent(b->buf)) continue;

term_color(c_OUTPUT); gen_output(x, GP_DATA->fmt);

term_color(c_NONE); pariputc('\n');

}

if (old && !s) _set_analyseur(old);

if (old && !s) set_analyseur(old);

b = NULL; infile = oldinfile;

pop_buffer(); return go_on;

}

Line 2679 gp_exception_handler(long numerr)

Line 2610 gp_exception_handler(long numerr)

return 0;

}

long

setprecr(long n)

{

long m = fmt.nb;

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

return m;

}

static void

testint(char *s, long *d)

testuint(char *s, ulong *d) { if (s) *d = get_uint(s); }

{

if (!s) return;

*d = get_int(s, 0);

if (*d <= 0) err(talker,"arguments must be positive integers");

}

static char *

read_arg(int *nread, char *t, long argc, char **argv)

Line 2725 read_opt(long argc, char **argv)

Line 2642 read_opt(long argc, char **argv)

case 'e':

if (strncmp(t,"macs",4)) usage(argv[0]);

under_emacs = 1; break;

GP_DATA->flags |= EMACS; break;

case 'q':

quiet_mode = 1; break;

GP_DATA->flags |= QUIET; break;

case 't':

if (strncmp(t,"est",3)) usage(argv[0]);

disable_color = 1; test_mode = 1; /* fall through */

disable_color = 1; GP_DATA->flags |= TEST; /* fall through */

case 'f':

initrc = 0; break;

case '-':

if (strcmp(t, "version") == 0) { print_version(); exit(0); }

if (strcmp(t, "texmacs") == 0) { under_texmacs = 1; break; }

if (strcmp(t, "texmacs") == 0) { GP_DATA->flags |= TEXMACS; break; }

/* fall through */

default:

usage(argv[0]);

}

if (under_texmacs) tm_start_output();

if (GP_DATA->flags & TEXMACS) tm_start_output();

pre = initrc? gp_initrc(): NULL;

/* override the values from gprc */

testint(b, &paribufsize); if (paribufsize < 10) paribufsize = 10;

testuint(b, &paribufsize); if (paribufsize < 10) paribufsize = 10;

testint(p, &primelimit);

testuint(p, &primelimit);

testint(s, &parisize);

testuint(s, (ulong*)&top);

if (under_emacs || under_texmacs) disable_color=1;

if (GP_DATA->flags & (EMACS|TEXMACS)) disable_color = 1;

pari_outfile=stdout; return pre;

pari_outfile = stdout; return pre;

}

#ifdef WINCE

Line 2766 main(int argc, char **argv)

Line 2683 main(int argc, char **argv)

#endif

char **flist;

init_defaults(1); gp_preinit(1);

init_defaults(1); gp_preinit();

if (setjmp(environnement))

{

pariputs("### Errors on startup, exiting...\n\n");

Line 2780 main(int argc, char **argv)

Line 2697 main(int argc, char **argv)

pari_addfunctions(&pari_modules, functions_highlevel,helpmessages_highlevel);

pari_addfunctions(&pari_oldmodules, functions_oldgp,helpmessages_oldgp);

init_graph(); INIT_SIG_off;

init_graph();

pari_init(parisize, primelimit);

INIT_SIG_off;

pari_init(top-bot, primelimit);

INIT_SIG_on;

pari_sig_init(gp_sighandler);

#ifdef READLINE

if (use_readline) {

if (GP_DATA->flags & USE_READLINE) {

init_readline();

readline_init = 1;

}

#endif

gp_history_fun = gp_history;

whatnow_fun = whatnow;

output_fun = gp_output;

default_exception_handler = gp_exception_handler;

gp_expand_path(path);

gp_expand_path(GP_DATA->path);

if (!quiet_mode) gp_head();

if (!(GP_DATA->flags & QUIET)) gp_head();

if (flist)

{

long c=chrono, e=pariecho;

ulong f = GP_DATA->flags;

FILE *l=logfile;

FILE *l = logfile;

char **s = flist;

chrono=0; pariecho=0; logfile=NULL;

GP_DATA->flags &= ~(CHRONO|ECHO); logfile = NULL;

for ( ; *s; s++) { read0(*s); free(*s); }

chrono=c; pariecho=e; logfile=l; free(flist);

GP_DATA->flags = f; logfile = l; free(flist);

}

(void)gptimer(); (void)timer(); (void)timer2();

TIMERstart(GP_DATA->T); (void)timer(); (void)timer2();

(void)gp_main_loop(1);

gp_quit(); return 0; /* not reached */

}

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>