=================================================================== RCS file: /home/cvs/OpenXM_contrib/pari-2.2/src/gp/Attic/gp.c,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -u -p -r1.1.1.1 -r1.2 --- OpenXM_contrib/pari-2.2/src/gp/Attic/gp.c 2001/10/02 11:17:06 1.1.1.1 +++ OpenXM_contrib/pari-2.2/src/gp/Attic/gp.c 2002/09/11 07:26:55 1.2 @@ -1,4 +1,4 @@ -/* $Id: gp.c,v 1.1.1.1 2001/10/02 11:17:06 noro Exp $ +/* $Id: gp.c,v 1.2 2002/09/11 07:26:55 noro Exp $ Copyright (C) 2000 The PARI group. @@ -32,13 +32,11 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, #include "gp.h" #ifdef READLINE - extern void init_readline(); - long use_readline = 1; + extern void init_readline(void); int readline_init = 1; BEGINEXTERN # if defined(__cplusplus) && defined(__SUNPRO_CC) - /* readline.h gives a bad definition of readline() */ - extern char*readline(char*); + extern char* readline(char*); /* bad prototype for readline() in readline.h */ # else # ifdef READLINE_LIBRARY # include @@ -47,68 +45,39 @@ BEGINEXTERN # endif # endif extern int isatty(int); - extern void add_history(char*); ENDEXTERN #endif -char* _analyseur(void); -void _set_analyseur(char *s); -void err_recover(long numerr); -void free_graph(void); -void gp_expand_path(char *v); -int gp_init_entrees(module *modlist, entree **hash, int force); -long gptimer(void); -void init80(long n); -void init_defaults(int force); -void initout(int initerr); -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); +extern void err_clean(void); +extern void gp_output(GEN z, gp_data *G); +extern void errcontext(char *msg, char *s, char *entry); +extern void free_graph(void); +extern void gp_expand_path(gp_path *p); +extern int gp_init_entrees(module *modlist, entree **hash, int force); +extern void init_defaults(int force); +extern void init_graph(void); +extern void pari_sig_init(void (*f)(int)); +extern int whatnow(char *s, int flag); -#if 0 /* to debug TeXmacs interface */ -#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) +static char *DFT_PRETTYPRINTER = "tex2mail -TeX -noindent -ragged -by_par"; #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 *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; +static char prompt[MAX_PROMPT_LEN], prompt_cont[MAX_PROMPT_LEN]; -typedef struct Buffer { - char *buf; - long len; - jmp_buf env; - int flenv; -} Buffer; +static int tm_is_waiting = 0, handle_C_C = 0, gpsilent = 0; +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) @@ -127,59 +96,99 @@ 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; - char *help; - long i; + H->total = total; + H->size = l; + H->res = (GEN *) gpmalloc(l * sizeof(GEN)); + memset(H->res,0, l * sizeof(GEN)); +} - if (force) - { -#if !defined(macintosh) || defined(__MWERKS__) - primelimit = 500000; parisize = 1000000*sizeof(long); - dflt = DFT_PROMPT; +static void +init_path(gp_path *path) +{ + char *p; +#if defined(__EMX__) || defined(__CYGWIN32__) + p = ".;C:;C:/gp"; +#elif defined(UNIX) + p = ".:~:~/gp"; #else - primelimit = 200000; parisize = 1000000; - dflt = "?\n"; + p = "."; #endif - } - strcpy(prompt, dflt); + path->PATH = pari_strdup(p); + path->dirs = NULL; +} -#if defined(UNIX) || defined(__EMX__) -# if defined(__EMX__) || defined(__CYGWIN32__) - path = pari_strdup(".;C:;C:/gp"); -# else - path = pari_strdup(".:~:~/gp"); -# endif - help = getenv("GPHELP"); +static char * +init_help() +{ + char *h = os_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("."); - help = NULL; + f->sigd = 28; #endif - help_prg = help? pari_strdup(help): NULL; - prettyp = f_PRETTYMAT; - strictmatch = simplifyflag = 1; - tglobal = 0; + return f; +} + +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; - prettyprinter_file = NULL; - fmt.format = 'g'; fmt.field = 0; -#ifdef LONG_IS_64BIT - fmt.nb = 38; + + primelimit = 500000; + bot = (gpmem_t)0; + top = (gpmem_t)(1000000*sizeof(long)); + strcpy(prompt, DFT_PROMPT); + strcpy(prompt_cont, CONTPROMPT); + + paribufsize = 1024; + for (i=0; iflags = (STRICTMATCH | SIMPLIFY | USE_READLINE); #else - fmt.nb = 28; + GP_DATA->flags = (STRICTMATCH | SIMPLIFY); #endif - lim_lines = 0; - histsize = 5000; paribufsize = 1024; - i = histsize*sizeof(GEN); - hist = (GEN *) gpmalloc(i); memset(hist,0,i); - for (i=0; ilim_lines = 0; + GP_DATA->T = &__T; + GP_DATA->hist = &__HIST; + GP_DATA->pp = &__PP; + 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 @@ -189,13 +198,15 @@ 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(;;) { @@ -207,9 +218,9 @@ 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"); } @@ -227,48 +238,49 @@ get_sep_colon_ok(char *t) return get_sep0(t,0); } -/* as above, t must be writeable, return 1 if we modified t */ -static int -get_sep2(char *t) +/* "atoul" + optional [km] suffix */ +static ulong +my_int(char *s) { - int outer=1; - char *s = t; + ulong n = 0; + char *p = s; - for(;;) + while (isdigit((int)*p)) { n = 10*n + (*p++ - '0'); } + switch(*p) { - switch (*s++) - { - case '"': - if (outer || s[-2] != '\\') outer = !outer; - break; - case '\0': - return 0; - default: - if (outer && separe(*s)) { *s=0; return 1; } - } + case 'k': case 'K': n *= 1000; p++; break; + case 'm': case 'M': n *= 1000000; p++; break; } + 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); - long n=atol(p); + char *p = get_sep(s); + long n; + int minus = 0; + + if (*p == '-') { minus = 1; p++; } + if (!isdigit((int)*p)) return dflt; - if (*p == '-') p++; - while(isdigit((int)*p)) { p++; dflt=n; } - switch(*p) - { - 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; + n = (long)my_int(p); + if (n < 0) err(talker2,"integer too large in get_int",s,s); + return minus? -n: n; } +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; @@ -276,81 +288,14 @@ 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); } + 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; @@ -366,7 +311,7 @@ del_buffer(Buffer *b) } static void -pop_buffer() +pop_buffer(void) { Buffer *b = (Buffer*) pop_stack(&bufstack); del_buffer(b); @@ -384,7 +329,7 @@ kill_all_buffers(Buffer *B) } static void -jump_to_buffer() +jump_to_buffer(void) { Buffer *b; while ( (b = current_buffer) ) @@ -416,53 +361,86 @@ 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]", - s, Min, Max); - err(talker2, thestring, v,v); + char s[128]; + sprintf(s, "default: incorrect value for %s [%lu-%lu]", s, Min, Max); + 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) - msg++; /* single msg, always printed */ - else - msg += n; /* one per possible value */ - pariputsf(" %s = %ld %s\n", s, n, *msg); + if (!*msg) msg++; /* single msg, always printed */ + else msg += n; /* one per possible value */ + pariputsf(" %s = %lu %s\n", s, n, *msg); } - else if (Max != 1 || Min != 0) - pariputsf(" %s = %ld\n", s, n); - else /* toggle */ - { - if (n==1) pariputsf(" %s = 1 (on)\n", s); - else pariputsf(" %s = 0 (off)\n", s); - } /* fall through */ + else + pariputsf(" %s = %lu\n", s, n); default: return gnil; } } @@ -471,21 +449,23 @@ 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; @@ -496,35 +476,37 @@ 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); - return strtoGENstr(thestring,0); + char s[128]; + 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; } @@ -549,12 +531,12 @@ 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; } @@ -562,8 +544,9 @@ 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) @@ -574,37 +557,38 @@ 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"); + if (n == c_NONE) + 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); - if (c < c_LAST - 1) { *s++=','; *s++=' '; } + t += strlen(t); + if (c < c_LAST - 1) { *t++=','; *t++=' '; } } - if (flag==d_RETURN) return strtoGENstr(thestring,0); - pariputsf(" colors = \"%s\"\n",thestring); + if (flag==d_RETURN) return strtoGENstr(s,0); + pariputsf(" colors = \"%s\"\n",s); } return gnil; } @@ -618,8 +602,8 @@ sd_compatible(char *v, int flag) "(use old functions, don't ignore case)", "(use old functions, ignore case)", NULL }; - long old = compatible; - GEN r = sd_numeric(v,flag,"compatible",&compatible, 0,3,msg); + ulong old = compatible; + GEN r = sd_ulong(v,flag,"compatible",&compatible, 0,3,msg); if (old != compatible && flag != d_INITRC) { @@ -633,90 +617,87 @@ 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 == '0') - err(talker, "Too late to switch off readline mode"); -# 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); + if (!readline_init && *v && *v != '0') { + init_readline(); + readline_init = 1; + } #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; - GEN r = sd_numeric(v,flag,"histsize",&n, 1, + gp_hist *H = GP_DATA->hist; + 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); - GEN *gg = (GEN *) gpmalloc(i); memset(gg,0,i); + const ulong total = H->total; + long g, h, k, kmin; + GEN *resG = H->res, *resH; /* G = old data, H = new one */ + size_t sG = H->size, sH; - if (tglobal) - { - long k = (tglobal-1) % n; - long kmin = k - min(n,histsize), j = k; + init_hist(H, n, total); + if (!total) return r; - i = (tglobal-1) % histsize; - while (k > kmin) - { - gg[j] = hist[i]; - hist[i] = NULL; - if (!i) i = histsize; - if (!j) j = n; - i--; j--; k--; - } - while (hist[i]) - { - gunclone(hist[i]); - if (!i) i = histsize; - i--; - } + resH = H->res; + sH = H->size; + /* copy relevant history entries */ + g = (total-1) % sG; + h = k = (total-1) % sH; + kmin = k - min(sH, sG); + for ( ; k > kmin; k--, g--, h--) + { + resH[h] = resG[g]; + resG[g] = NULL; + if (!g) g = sG; + if (!h) h = sH; } - 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; } @@ -724,24 +705,24 @@ sd_histsize(char *v, int flag) static GEN sd_log(char *v, int flag) { - long vlog = logfile? 1: 0, old = vlog; - GEN r = sd_numeric(v,flag,"log",&vlog, 0,1,NULL); - if (vlog != old) - { - if (vlog) - { + int old = GP_DATA->flags; + GEN r = sd_gptoggle(v,flag,"log",LOG); + if (GP_DATA->flags != old) + { /* toggled LOG */ + 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; } @@ -749,16 +730,17 @@ sd_log(char *v, int flag) static GEN sd_output(char *v, int flag) { - char *msg[] = {"(raw)", "(prettymatrix)", "(prettyprint)", "(external prettyprint)", NULL}; - return sd_numeric(v,flag,"output",&prettyp, 0,3,msg); + char *msg[] = {"(raw)", "(prettymatrix)", "(prettyprint)", + "(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(); } @@ -766,12 +748,12 @@ allocatemem0(unsigned long newsize) static GEN sd_parisize(char *v, int flag) { - long n = parisize; - GEN r = sd_numeric(v,flag,"parisize",&n, 10000,VERYBIGINT,NULL); - if (n != parisize) + ulong n = top-bot; + GEN r = sd_ulong(v,flag,"parisize",&n, 10000,VERYBIGINT,NULL); + 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; } @@ -779,8 +761,8 @@ sd_parisize(char *v, int flag) static GEN sd_primelimit(char *v, int flag) { - long n = primelimit; - GEN r = sd_numeric(v,flag,"primelimit",&n, 0,VERYBIGINT,NULL); + ulong n = primelimit; + GEN r = sd_ulong(v,flag,"primelimit",&n, 0,VERYBIGINT,NULL); if (n != primelimit) { if (flag != d_INITRC) @@ -795,25 +777,28 @@ 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); - *f = pari_strdup(thestring); free(old); + l = strlen(v) + 256; + 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); @@ -837,6 +822,10 @@ 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", ¤t_psfile); } @@ -850,11 +839,11 @@ sd_help(char *v, int flag) char *str; if (*v) { - if (secure) err_secure("help",v); - if (help_prg) free(help_prg); - help_prg = expand_tilde(v); + if (GP_DATA->flags & SECURE) err_secure("help",v); + if (GP_DATA->help) free(GP_DATA->help); + 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); @@ -864,30 +853,32 @@ 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; - path = pari_strdup(v); free(old); + free((void*)p->PATH); + 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 (!strcmp(v,"yes")) v = prettyprinter_dft; - if (old && strcmp(old,v) && prettyprinter_file) + if (GP_DATA->flags & SECURE) err_secure("prettyprinter",v); + if (!strcmp(v,"yes")) v = DFT_PRETTYPRINTER; + if (old && strcmp(old,v) && pp->file) { pariFILE *f; if (cancel) f = NULL; @@ -900,35 +891,47 @@ sd_prettyprinter(char *v, int flag) return gnil; } } - pari_fclose(prettyprinter_file); - prettyprinter_file = f; + pari_fclose(pp->file); + pp->file = f; } - prettyprinter = cancel? NULL: pari_strdup(v); - if (old && old != prettyprinter_dft) free(old); + pp->cmd = cancel? NULL: pari_strdup(v); + 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}, @@ -944,12 +947,14 @@ 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}, @@ -962,12 +967,12 @@ 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 @@ -980,7 +985,7 @@ 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); @@ -993,21 +998,21 @@ 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); } @@ -1053,20 +1058,19 @@ 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; - if (s >= olds) + list[s] = ep->name; + if (++s >= size) { - int news = olds + (LIST_LEN + 1)*sizeof(char *); - list = (char**) gprealloc(list,news,olds); - olds = news; + size += (LIST_LEN + 1)*sizeof(char *); + list = (char**) gprealloc(list,size); } } list[s]=NULL; print_fun_list(list,term_height()-4); free(list); @@ -1133,7 +1137,7 @@ print_user_member(entree *ep) } static void -user_fun() +user_fun(void) { entree *ep; int hash; @@ -1148,7 +1152,7 @@ user_fun() } static void -user_member() +user_member(void) { entree *ep; int hash; @@ -1165,21 +1169,23 @@ user_member() static void center(char *s) { - long i, pad = term_width() - strlen(s); - char *u = thestring; + long i, l = strlen(s), pad = term_width() - l; + char *buf, *u; if (pad<0) pad=0; else pad >>= 1; + u = buf = (char*)gpmalloc(l + pad + 2); for (i=0; ihelp) 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(str,"%s -fromgp %s %c%s%s%c",help_prg,opt, SHELL_Q,s,ar,SHELL_Q); + sprintf(ar,"@%d",num); + 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); - while (fgets(buf,MAX_LINE_LEN,f)) + free(str); + free(s); + while (fgets(buf, nbof(buf), f)) { if (!strncmp("ugly_kludge_done",buf,16)) break; - buf[MAX_LINE_LEN]=0; pariputs(buf); - if (++li > nbli) { hit_return(); li = 0; } + pariputs(buf); + if (nl_read(buf) && ++li > nbli) { hit_return(); li = 0; } } pari_fclose(z); } @@ -1444,14 +1456,14 @@ 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 */ + /* 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; } @@ -1578,7 +1590,7 @@ 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); } @@ -1601,18 +1613,17 @@ print_hash_list(char *s) } static char * -what_readline() +what_readline(void) { #ifdef READLINE - if (use_readline) - return "v"READLINE" enabled"; - else -#endif + return (GP_DATA->flags & USE_READLINE)? "v"READLINE" enabled": "disabled"; +#else return "disabled"; +#endif } static void -print_version() +print_version(void) { char buf[64]; @@ -1623,10 +1634,10 @@ print_version() } static void -gp_head() +gp_head(void) { print_version(); pariputs("\n"); - center("Copyright (C) 2000 The PARI Group"); + center("Copyright (C) 2002 The PARI Group"); print_text("\nPARI/GP is free software, covered by the GNU General Public \ License, and comes WITHOUT ANY WARRANTY WHATSOEVER"); pariputs("\n\ @@ -1635,151 +1646,29 @@ 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); @@ -1821,19 +1710,30 @@ 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 'm': matbrute(x, fmt.format, -1); break; - case 'B': if (tex2mail_output(x,0)) return; /* fall through */ - case 'b': sor (x, fmt.format, -1, fmt.field); break; - case 'x': voir(x, get_int(s, -1)); + case 'B': + { /* prettyprinter */ + gp_data G = *GP_DATA; /* copy */ + gp_hist h = *(G.hist); /* copy */ + 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; @@ -1843,7 +1743,7 @@ 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) @@ -1875,7 +1775,16 @@ 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; ihist, (GEN)x[i]); + } + } break; case 's': etatpile(0); break; case 't': gentypes(); break; @@ -1889,7 +1798,7 @@ 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); } @@ -1898,10 +1807,10 @@ escape0(char *tch) static void escape(char *tch) { - char *old = _analyseur(); - _set_analyseur(tch); /* for error messages */ + char *old = get_analyseur(); + set_analyseur(tch); /* for error messages */ escape0(tch); - _set_analyseur(old); + set_analyseur(old); } /********************************************************************/ /* */ @@ -1912,22 +1821,20 @@ escape(char *tch) # include #endif -static int -get_preproc_value(char *s) +static int get_line_from_file(char *prompt, filtre_t *F, FILE *file); +#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; - if (!strncmp(s,"READL",5)) - { -#ifdef READLINE - if (use_readline) - return 1; - else -#endif - return 0; - } - return -1; + F->data = data; + F->in_string = 0; + F->in_comment = 0; + F->downcase = 0; } +/* LOCATE GPRC */ + /* return $HOME or the closest we can find */ static char * get_home(int *free_it) @@ -1954,17 +1861,13 @@ static FILE * gprc_chk(char *s) { FILE *f = fopen(s, "r"); - if (f && !quiet_mode) - { - fprintferr("Reading GPRC: %s ...", s); - added_newline = 0; - } + if (f && !(GP_DATA->flags & QUIET)) fprintferr("Reading GPRC: %s ...", s); return f; } /* Look for [._]gprc: $GPRC, then in $HOME, /, C:/ */ static FILE * -gprc_get() +gprc_get(void) { FILE *f = NULL; char *str, *s, c; @@ -1998,71 +1901,158 @@ gprc_get() return f; } -static int get_line_from_file(char *prompt, Buffer *b, FILE *file); -#define err_gprc(s,t,u) { fprintferr("\n"); err(talker2,s,t,u); } +/* PREPROCESSOR */ +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)) - { - del_buffer(b); - if (!quiet_mode) fprintferr("Done.\n\n"); - fclose(file); flist[find] = NULL; - return flist; + if (!get_line_from_file(NULL,&F,file)) break; + s = b->buf; + if (*s == '#') + { /* preprocessor directive */ + int z, NOT = 0; + 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++; - s += strlen(s1); /* point to next expr */ - 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)) + nexts = next_expr(s); + if (!strncmp(s,"read",4)) { /* read file */ - s1 += 4; + s += 4; if (find == fnum-1) { - long n = fnum << 1; - flist = (char**)gprealloc(flist, n*sizeof(char*), - fnum*sizeof(char*)); - fnum = n; + fnum <<= 1; + flist = (char**)gprealloc(flist, fnum*sizeof(char*)); } - flist[find++] = s2 = gpmalloc(strlen(s1) + 1); - if (*s1 == '"') (void)readstring(s1, s2); - else strcpy(s2,s1); + flist[find++] = t = gpmalloc(strlen(s) + 1); + if (*s == '"') (void)readstring(s, t); + else strcpy(t,s); } else { /* set default */ - s2 = s1; while (*s2 && *s2 != '=') s2++; - if (*s2 != '=') err_gprc("missing '='",s2,b->buf); - *s2++ = 0; - if (*s2 == '"') (void)readstring(s2, s2); - setdefault(s1,s2,d_INITRC); + t = s; while (*t && *t != '=') t++; + if (*t != '=') err_gprc("missing '='",t,b->buf); + *t++ = 0; + if (*t == '"') (void)readstring(t, t); + setdefault(s,t,d_INITRC); } } } + del_buffer(b); + if (!(GP_DATA->flags & QUIET)) fprintferr("Done.\n\n"); + fclose(file); flist[find] = NULL; + return flist; } /********************************************************************/ @@ -2072,15 +2062,16 @@ 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; @@ -2091,7 +2082,7 @@ 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) { @@ -2116,16 +2107,16 @@ 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 } @@ -2141,42 +2132,35 @@ gp_sighandler(int sig) case SIGBREAK: gp_handle_SIGINT(); return; #endif #ifdef SIGINT - case SIGINT: gp_handle_SIGINT(); return; + case SIGINT: gp_handle_SIGINT(); return; #endif #ifdef SIGSEGV - case SIGSEGV: - msg="GP (Segmentation Fault)"; - break; + case SIGSEGV: msg = "GP (Segmentation Fault)"; break; #endif - #ifdef SIGBUS - case SIGBUS: - msg="GP (Bus Error)"; - break; + case SIGBUS: msg = "GP (Bus Error)"; break; #endif - #ifdef SIGFPE - case SIGFPE: - msg="GP (Floating Point Exception)"; - break; + case SIGFPE: 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; - prettyprinter_file = NULL; /* to avoid oo recursion on error */ + GP_DATA->pp->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"; + default: msg = "signal handling"; break; } - err(bugparier,msg); + err(bugparier, msg); } static void @@ -2194,37 +2178,34 @@ 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 -unblock_SIGINT() +static char * +fgets_texmacs(char *s, int n, FILE *f) { -#ifdef USE_SIGRELSE - sigrelse(SIGINT); -#elif USE_SIGSETMASK - sigsetmask(0); -#endif + tm_start_output(); tm_end_output(); /* tell TeXmacs we need input */ + return fgets(s,n,f); } /* 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; @@ -2233,9 +2214,7 @@ file_input(Buffer *b, char **s0, FILE *file, int TeXma used0 = used; for(;;) { - long left = b->len - used, ls; - /* if from TeXmacs, tell him we need input */ - if (TeXmacs) { tm_start_output(); tm_end_output(); } + long left = b->len - used, l; if (left < 512) { @@ -2244,289 +2223,246 @@ 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 */ - ls = strlen(s); first = 0; - if (ls+1 < left || s[ls-1] == '\n') return *s0; /* \n */ - used += ls; - } -} + if (! IM->fgets(s, left, IM->file)) + return first? NULL: *s0; /* EOF */ -#ifdef READLINE -static char * -gprl_input(Buffer *b, char **s0, char *prompt) -{ - 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; + l = strlen(s); first = 0; + if (l+1 < left || s[l-1] == '\n') return *s0; /* \n */ + used += l; } - return s; } -#endif -static void -input_loop(Buffer *b, char *buf0, FILE *file, char *prompt) +/* Read a "complete line" and filter it. Return: 0 if EOF, 1 otherwise */ +int +input_loop(filtre_t *F, input_method *IM) { - const int TeXmacs = (under_texmacs && file == stdin); - const int f_flag = prompt? f_REG: f_REG | f_KEEPCASE; - char *end, *s = b->buf, *buf = buf0; - int wait_for_brace = 0; - int wait_for_input = 0; + Buffer *b = (Buffer*)F->data; + char *to_read, *s = b->buf; + /* 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; - if (!ask_filtre(f_COMMENT)) - { /* not in comment */ - skip_space(t); - if (*t == LBRACE) { t++; wait_for_input = wait_for_brace = 1; } - } - end = filtre(t,s, f_flag); + F->s = to_read; + F->t = s; + (void)filtre0(F); + if (IM->free) free(to_read); - if (!*s) { if (!wait_for_input) break; } - else - { - if (*(b->buf) == '?') break; + if (! F->more_input) 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 - if (!file) { free(buf); buf = gprl_input(b,&s,""); } - else -#endif - buf = file_input(b,&s,file,TeXmacs); - if (!buf) break; + s = F->end; + if (IM->prompt) IM->prompt = do_prompt(F->in_comment, prompt_cont); + to_read = IM->getline(b,&s, IM); + if (!to_read) 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); - char *buf, *s = b->buf; + const int TeXmacs = ((GP_DATA->flags & TEXMACS) && file == stdin); + char *s; + input_method IM; - handle_C_C = 0; - while (! (buf = file_input(b,&s,file,TeXmacs)) ) - { /* EOF */ - if (!handle_C_C) - { - if (TeXmacs) tm_start_output(); - return 0; - } - /* received ^C in fgets, retry (as is "\n" were input) */ + IM.file = file; + IM.fgets= TeXmacs? &fgets_texmacs: &fgets; + IM.prompt = NULL; + IM.getline= &file_input; + IM.free = 0; + if (! input_loop(F,&IM)) + { + if (TeXmacs) tm_start_output(); + 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 - && (under_emacs || isatty(fileno(stdin)))); + return (infile == stdin && !(f & TEXMACS) + && (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) - { - char *old = s-1; - if (*s == '#') { pariputs(do_time(ti_LAST)); s++; } - if (*s) err(caracer1,s,old); + { /* if "#" or "##" timer metacommand. Otherwise let the parser get it */ + if (*s == '#') s++; + if (*s) return 0; + 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; - VOLATILE GEN z = gnil; + gp_hist *H = GP_DATA->hist; + 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; - j = tglobal - tloc; i = (tglobal-1)%histsize; - while (j) - { - gunclone(hist[i]); hist[i]=NULL; - if (!i) i = histsize; - i--; j--; - } - tglobal = tloc; prettyp = outtyp; + avma = top; + prune_history(H, tloc); + GP_DATA->fmt->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; - r = read_line(do_prompt(), b); - if (!disable_color) term_color(c_NONE); - if (!r) - { -#ifdef _WIN32 - Sleep(10); if (win32ctrlc) dowin32ctrlc(); -#endif - if (popinfile()) gp_quit(); - if (!ismain) { pop_buffer(); return z; } - } - else if (!check_meta(b->buf)) break; + #ifdef _WIN32 + Sleep(10); if (win32ctrlc) dowin32ctrlc(); + #endif + if (popinfile()) gp_quit(); + if (ismain) continue; + pop_buffer(); return z; } + if (check_meta(b->buf)) continue; + if (ismain) { - char c = b->buf[strlen(b->buf) - 1]; - gpsilent = separe(c); - (void)gptimer(); + gpsilent = is_silent(b->buf); + TIMERstart(GP_DATA->T); } - av = avma; - z = readseq(b->buf, strictmatch); - if (!added_newline) pariputc('\n'); /* last output was print1() */ + z = readseq(b->buf, GP_DATA->flags & STRICTMATCH); 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); - i = tglobal % histsize; tglobal++; - 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'); } + if (GP_DATA->flags & CHRONO) + pariputs(do_time(ti_REGULAR)); else - { - if (under_texmacs) - texmacs_output(z,tglobal); - else if (prettyp != f_PRETTY || !tex2mail_output(z,tglobal)) - normal_output(z,tglobal); - } - pariflush(); + do_time(ti_NOPRINT); + if (z == gnil) continue; + + if (GP_DATA->flags & SIMPLIFY) z = simplify_i(z); + z = set_hist_entry(H, z); + if (!gpsilent) gp_output(z, GP_DATA); } } @@ -2541,7 +2477,7 @@ 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); } @@ -2554,29 +2490,29 @@ 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; - else - flag = silent()? d_SILENT: d_ACKNOWLEDGE; - return setdefault(a,b,flag); + return setdefault(a,b, flag? d_RETURN + : silent()? d_SILENT: d_ACKNOWLEDGE); } 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; @@ -2593,26 +2529,15 @@ 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()); @@ -2624,14 +2549,19 @@ 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(); - t = oldb->buf; - /* something fishy, probably a ^C, or we overran analyseur */ - if (!s || !s[-1] || s < t || s >= t + oldb->len) s = NULL; + old = s = get_analyseur(); + t = NULL; + if (bufstack->prev) + { + 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'); @@ -2640,28 +2570,29 @@ break_loop(long numerr) infile = stdin; for(;;) { - int flag; - if (! read_line("> ", b)) break; - if (!(flag = check_meta(b->buf))) + GEN x; + if (! read_line(&F, BREAK_LOOP_PROMPT)) break; + 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 (did_break()) + if (numerr == siginter && did_break() == br_NEXT) { - if (numerr == siginter && did_break() == br_NEXT) - { - (void)loop_break(); /* clear status flag */ - go_on = 1; - } - break; + (void)loop_break(); /* clear status flag */ + go_on = 1; } - if (x == gnil) continue; - - term_color(c_OUTPUT); gp_output(x); - term_color(c_NONE); pariputc('\n'); + break; } - 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; } @@ -2679,22 +2610,8 @@ 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) -{ - if (!s) return; - *d = get_int(s, 0); - if (*d <= 0) err(talker,"arguments must be positive integers"); -} +testuint(char *s, ulong *d) { if (s) *d = get_uint(s); } static char * read_arg(int *nread, char *t, long argc, char **argv) @@ -2725,31 +2642,31 @@ 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; - testint(p, &primelimit); - testint(s, &parisize); - if (under_emacs || under_texmacs) disable_color=1; - pari_outfile=stdout; return pre; + testuint(b, &paribufsize); if (paribufsize < 10) paribufsize = 10; + testuint(p, &primelimit); + testuint(s, (ulong*)&top); + if (GP_DATA->flags & (EMACS|TEXMACS)) disable_color = 1; + pari_outfile = stdout; return pre; } #ifdef WINCE @@ -2766,7 +2683,7 @@ 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"); @@ -2780,33 +2697,32 @@ 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; - pari_init(parisize, primelimit); + init_graph(); + INIT_SIG_off; + pari_init(top-bot, primelimit); INIT_SIG_on; pari_sig_init(gp_sighandler); #ifdef READLINE - if (use_readline) { - init_readline(); - readline_init = 1; + 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; - FILE *l=logfile; + ulong f = GP_DATA->flags; + 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 */ }