Annotation of OpenXM_contrib/pari-2.2/src/gp/gp.c, Revision 1.2
1.2 ! noro 1: /* $Id: gp.c,v 1.139 2002/09/11 02:30:28 karim Exp $
1.1 noro 2:
3: Copyright (C) 2000 The PARI group.
4:
5: This file is part of the PARI/GP package.
6:
7: PARI/GP is free software; you can redistribute it and/or modify it under the
8: terms of the GNU General Public License as published by the Free Software
9: Foundation. It is distributed in the hope that it will be useful, but WITHOUT
10: ANY WARRANTY WHATSOEVER.
11:
12: Check the License for details. You should have received a copy of it, along
13: with the package; see the file 'COPYING'. If not, write to the Free Software
14: Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
15:
16: /*******************************************************************/
17: /** **/
18: /** PARI CALCULATOR **/
19: /** **/
20: /*******************************************************************/
21: #include "pari.h"
22: #ifdef _WIN32
23: # include <windows.h>
24: # ifndef WINCE
25: # include <process.h>
26: # endif
27: #endif
28: #ifdef HAS_STRFTIME
29: # include <time.h>
30: #endif
31: #include "../language/anal.h"
32: #include "gp.h"
33:
34: #ifdef READLINE
1.2 ! noro 35: extern void init_readline(void);
1.1 noro 36: int readline_init = 1;
37: BEGINEXTERN
38: # if defined(__cplusplus) && defined(__SUNPRO_CC)
1.2 ! noro 39: extern char* readline(char*); /* bad prototype for readline() in readline.h */
1.1 noro 40: # else
41: # ifdef READLINE_LIBRARY
42: # include <readline.h>
43: # else
44: # include <readline/readline.h>
45: # endif
46: # endif
47: extern int isatty(int);
48: ENDEXTERN
49: #endif
50:
1.2 ! noro 51: extern void err_clean(void);
! 52: extern void gp_output(GEN z, gp_data *G);
! 53: extern void errcontext(char *msg, char *s, char *entry);
! 54: extern void free_graph(void);
! 55: extern void gp_expand_path(gp_path *p);
! 56: extern int gp_init_entrees(module *modlist, entree **hash, int force);
! 57: extern void init_defaults(int force);
! 58: extern void init_graph(void);
! 59: extern void pari_sig_init(void (*f)(int));
! 60: extern int whatnow(char *s, int flag);
! 61:
! 62: static char *DFT_PRETTYPRINTER = "tex2mail -TeX -noindent -ragged -by_par";
1.1 noro 63:
64: #define MAX_PROMPT_LEN 128
65: #define DFT_PROMPT "? "
1.2 ! noro 66: #define BREAK_LOOP_PROMPT "> "
1.1 noro 67: #define COMMENTPROMPT "comment> "
1.2 ! noro 68: #define CONTPROMPT ""
1.1 noro 69: #define DFT_INPROMPT ""
1.2 ! noro 70: static char prompt[MAX_PROMPT_LEN], prompt_cont[MAX_PROMPT_LEN];
! 71:
! 72: static int tm_is_waiting = 0, handle_C_C = 0, gpsilent = 0;
! 73:
! 74: static ulong paribufsize, primelimit;
1.1 noro 75:
76: #define current_buffer (bufstack?((Buffer*)(bufstack->value)):NULL)
77: static stack *bufstack = NULL;
78:
79: #define skip_space(s) while (isspace((int)*s)) s++
80: #define skip_alpha(s) while (isalpha((int)*s)) s++
81:
82: static void
83: usage(char *s)
84: {
85: printf("### Usage: %s [options]\n", s);
86: printf("Options are:\n");
87: printf("\t[-b buffersize]\tDeprecated\n");
88: printf("\t[-emacs]\tRun as if in Emacs shell\n");
89: printf("\t[-f]\t\tFaststart: do not read .gprc\n");
90: printf("\t[--help]\tPrint this message\n");
91: printf("\t[-q]\t\tQuiet mode: do not print banner and history numbers\n");
92: printf("\t[-p primelimit]\tPrecalculate primes up to the limit\n");
93: printf("\t[-s stacksize]\tStart with the PARI stack of given size (in bytes)\n");
94: printf("\t[-test]\t\tTest mode. As -q, plus wrap long lines\n");
95: printf("\t[--version]\tOutput version info and exit\n\n");
96: exit(0);
97: }
98:
99: static void
1.2 ! noro 100: init_hist(gp_hist *H, size_t l, ulong total)
1.1 noro 101: {
1.2 ! noro 102: H->total = total;
! 103: H->size = l;
! 104: H->res = (GEN *) gpmalloc(l * sizeof(GEN));
! 105: memset(H->res,0, l * sizeof(GEN));
! 106: }
1.1 noro 107:
1.2 ! noro 108: static void
! 109: init_path(gp_path *path)
! 110: {
! 111: char *p;
! 112: #if defined(__EMX__) || defined(__CYGWIN32__)
! 113: p = ".;C:;C:/gp";
! 114: #elif defined(UNIX)
! 115: p = ".:~:~/gp";
1.1 noro 116: #else
1.2 ! noro 117: p = ".";
1.1 noro 118: #endif
1.2 ! noro 119: path->PATH = pari_strdup(p);
! 120: path->dirs = NULL;
! 121: }
1.1 noro 122:
1.2 ! noro 123: static char *
! 124: init_help()
! 125: {
! 126: char *h = os_getenv("GPHELP");
1.1 noro 127: # ifdef GPHELP
1.2 ! noro 128: if (!h) h = GPHELP;
1.1 noro 129: # endif
1.2 ! noro 130: if (h) h = pari_strdup(h);
! 131: return h;
! 132: }
! 133:
! 134: static pariout_t *
! 135: init_fmt()
! 136: {
! 137: pariout_t *f = &DFLT_OUTPUT;
! 138: f->prettyp= f_PRETTYMAT;
! 139: #ifdef LONG_IS_64BIT
! 140: f->sigd = 38;
1.1 noro 141: #else
1.2 ! noro 142: f->sigd = 28;
1.1 noro 143: #endif
1.2 ! noro 144: return f;
! 145: }
! 146:
! 147: static void
! 148: init_pp(gp_pp *p)
! 149: {
! 150: p->cmd = pari_strdup(DFT_PRETTYPRINTER);
! 151: p->file = NULL;
! 152: }
! 153:
! 154: /* must be called BEFORE pari_init() */
! 155: static void
! 156: gp_preinit(void)
! 157: {
! 158: static gp_data __GP_DATA;
! 159: static gp_hist __HIST;
! 160: static gp_pp __PP;
! 161: static gp_path __PATH;
! 162: static pari_timer __T;
! 163: long i;
! 164:
1.1 noro 165: bufstack = NULL;
1.2 ! noro 166:
! 167: primelimit = 500000;
! 168: bot = (gpmem_t)0;
! 169: top = (gpmem_t)(1000000*sizeof(long));
! 170: strcpy(prompt, DFT_PROMPT);
! 171: strcpy(prompt_cont, CONTPROMPT);
! 172:
! 173: paribufsize = 1024;
! 174: for (i=0; i<c_LAST; i++) gp_colors[i] = c_NONE;
! 175:
! 176: GP_DATA = &__GP_DATA;
! 177: #ifdef READLINE
! 178: GP_DATA->flags = (STRICTMATCH | SIMPLIFY | USE_READLINE);
1.1 noro 179: #else
1.2 ! noro 180: GP_DATA->flags = (STRICTMATCH | SIMPLIFY);
1.1 noro 181: #endif
1.2 ! noro 182: GP_DATA->lim_lines = 0;
! 183: GP_DATA->T = &__T;
! 184: GP_DATA->hist = &__HIST;
! 185: GP_DATA->pp = &__PP;
! 186: GP_DATA->path = &__PATH;
! 187: GP_DATA->help = init_help();
! 188: GP_DATA->fmt = init_fmt();
! 189: init_hist(GP_DATA->hist, 5000, 0);
! 190: init_path(GP_DATA->path);
! 191: init_pp(GP_DATA->pp);
1.1 noro 192: }
193:
194: #ifdef MAXPATHLEN
195: # define GET_SEP_SIZE MAXPATHLEN
196: #else
197: # define GET_SEP_SIZE 128
198: #endif
199: #define separe(c) ((c)==';' || (c)==':')
200:
1.2 ! noro 201: /* Return all chars, up to next separator
! 202: * [as strtok but must handle verbatim character string]
! 203: * If 'colon' is set, allow ';' and ':' as separator, only ';' otherwise */
1.1 noro 204: static char*
205: get_sep0(char *t, int colon)
206: {
1.2 ! noro 207: static char buf[GET_SEP_SIZE], *lim = buf + (GET_SEP_SIZE-1);
1.1 noro 208: char *s = buf;
1.2 ! noro 209: int outer = 1;
1.1 noro 210:
211: for(;;)
212: {
213: switch(*s++ = *t++)
214: {
215: case '"':
216: if (outer || (s >= buf+2 && s[-2] != '\\')) outer = !outer;
217: break;
218: case '\0':
219: return buf;
220: case ';':
1.2 ! noro 221: if (outer) { s[-1] = 0; return buf; } break;
1.1 noro 222: case ':':
1.2 ! noro 223: if (outer && colon) { s[-1] = 0; return buf; } break;
1.1 noro 224: }
225: if (s == lim) err(talker,"buffer overflow in get_sep");
226: }
227: }
228:
229: static char*
230: get_sep(char *t)
231: {
232: return get_sep0(t,1);
233: }
234:
235: static char*
236: get_sep_colon_ok(char *t)
237: {
238: return get_sep0(t,0);
239: }
240:
1.2 ! noro 241: /* "atoul" + optional [km] suffix */
! 242: static ulong
! 243: my_int(char *s)
1.1 noro 244: {
1.2 ! noro 245: ulong n = 0;
! 246: char *p = s;
1.1 noro 247:
1.2 ! noro 248: while (isdigit((int)*p)) { n = 10*n + (*p++ - '0'); }
! 249: switch(*p)
1.1 noro 250: {
1.2 ! noro 251: case 'k': case 'K': n *= 1000; p++; break;
! 252: case 'm': case 'M': n *= 1000000; p++; break;
1.1 noro 253: }
1.2 ! noro 254: if (*p) err(talker2,"I was expecting an integer here", s, s);
! 255: return n;
1.1 noro 256: }
257:
258: static long
259: get_int(char *s, long dflt)
260: {
1.2 ! noro 261: char *p = get_sep(s);
! 262: long n;
! 263: int minus = 0;
! 264:
! 265: if (*p == '-') { minus = 1; p++; }
! 266: if (!isdigit((int)*p)) return dflt;
! 267:
! 268: n = (long)my_int(p);
! 269: if (n < 0) err(talker2,"integer too large in get_int",s,s);
! 270: return minus? -n: n;
! 271: }
1.1 noro 272:
1.2 ! noro 273: static ulong
! 274: get_uint(char *s)
! 275: {
! 276: char *p = get_sep(s);
! 277: if (*p == '-') err(talker2,"arguments must be positive integers",s,s);
! 278: return my_int(p);
1.1 noro 279: }
280:
281: /* tell TeXmacs GP will start outputing data */
282: static void
1.2 ! noro 283: tm_start_output(void)
1.1 noro 284: {
285: if (!tm_is_waiting) { printf("%cverbatim:",DATA_BEGIN); fflush(stdout); }
286: tm_is_waiting = 1;
287: }
288:
289: /* tell TeXmacs GP is done and is waiting for new data */
290: static void
1.2 ! noro 291: tm_end_output(void)
1.1 noro 292: {
1.2 ! noro 293: if (tm_is_waiting) { printf("%c", DATA_END); fflush(stdout); }
1.1 noro 294: tm_is_waiting = 0;
295: }
296:
297: Buffer *
1.2 ! noro 298: new_buffer(void)
1.1 noro 299: {
300: Buffer *b = (Buffer*) gpmalloc(sizeof(Buffer));
301: b->len = paribufsize;
302: b->buf = gpmalloc(b->len);
303: b->flenv = 0; return b;
304: }
305:
306: void
307: del_buffer(Buffer *b)
308: {
309: if (!b) return;
310: free(b->buf); free((void*)b);
311: }
312:
313: static void
1.2 ! noro 314: pop_buffer(void)
1.1 noro 315: {
316: Buffer *b = (Buffer*) pop_stack(&bufstack);
317: del_buffer(b);
318: }
319:
320: /* kill all buffers until B is met or nothing is left */
321: static void
322: kill_all_buffers(Buffer *B)
323: {
324: for(;;) {
325: Buffer *b = current_buffer;
326: if (b == B || !b) break;
327: pop_buffer();
328: }
329: }
330:
331: static void
1.2 ! noro 332: jump_to_buffer(void)
1.1 noro 333: {
334: Buffer *b;
335: while ( (b = current_buffer) )
336: {
337: if (b->flenv) break;
338: pop_buffer();
339: }
340: if (!b) longjmp(environnement, 0);
341: longjmp(b->env, 0);
342: }
343:
344: static void
345: jump_to_given_buffer(Buffer *buf)
346: {
347: Buffer *b;
348: while ( (b = current_buffer) )
349: {
350: if (b == buf) break;
351: pop_buffer();
352: }
353: if (!b->env) { b = NULL; err(warner,"no environmnent tied to buffer"); }
354: if (!b) longjmp(environnement, 0);
355: longjmp(b->env, 0);
356: }
357:
358: /********************************************************************/
359: /* */
360: /* DEFAULTS */
361: /* */
362: /********************************************************************/
363: static void
1.2 ! noro 364: do_strftime(char *s, char *buf, long max)
1.1 noro 365: {
366: #ifdef HAS_STRFTIME
367: time_t t = time(NULL);
1.2 ! noro 368: strftime(buf,max,s,localtime(&t));
1.1 noro 369: #else
370: strcpy(buf,s);
371: #endif
372: }
373:
374: static GEN
1.2 ! noro 375: sd_toggle(char *v, int flag, char *s, int *ptn)
! 376: {
! 377: int state = *ptn;
! 378: if (*v)
! 379: {
! 380: int n = (int)get_int(v,0);
! 381: if (n == state) return gnil;
! 382: if (n != !state)
! 383: {
! 384: char s[128];
! 385: sprintf(s, "default: incorrect value for %s [0:off / 1:on]", s);
! 386: err(talker2, s, v,v);
! 387: }
! 388: state = *ptn = n;
! 389: }
! 390: switch(flag)
! 391: {
! 392: case d_RETURN: return utoi(state);
! 393: case d_ACKNOWLEDGE:
! 394: if (state) pariputsf(" %s = 1 (on)\n", s);
! 395: else pariputsf(" %s = 0 (off)\n", s);
! 396: break;
! 397: }
! 398: return gnil;
! 399: }
! 400:
! 401: static GEN
! 402: sd_gptoggle(char *v, int flag, char *s, ulong FLAG)
! 403: {
! 404: int n = (GP_DATA->flags & FLAG)? 1: 0, old = n;
! 405: GEN z = sd_toggle(v, flag, s, &n);
! 406: if (n != old)
! 407: {
! 408: if (n) GP_DATA->flags |= FLAG;
! 409: else GP_DATA->flags &= ~FLAG;
! 410: }
! 411: return z;
! 412: }
! 413:
! 414: static GEN
! 415: sd_ulong(char *v, int flag, char *s, ulong *ptn, ulong Min, ulong Max,
1.1 noro 416: char **msg)
417: {
1.2 ! noro 418: ulong n;
1.1 noro 419: if (*v == 0) n = *ptn;
420: else
421: {
1.2 ! noro 422: n = (ulong)get_int(v,0);
1.1 noro 423: if (*ptn == n) return gnil;
424: if (n > Max || n < Min)
425: {
1.2 ! noro 426: char s[128];
! 427: sprintf(s, "default: incorrect value for %s [%lu-%lu]", s, Min, Max);
! 428: err(talker2, s, v,v);
1.1 noro 429: }
430: *ptn = n;
431: }
432: switch(flag)
433: {
1.2 ! noro 434: case d_RETURN: return utoi(n);
1.1 noro 435: case d_ACKNOWLEDGE:
436: if (msg)
437: {
1.2 ! noro 438: if (!*msg) msg++; /* single msg, always printed */
! 439: else msg += n; /* one per possible value */
! 440: pariputsf(" %s = %lu %s\n", s, n, *msg);
! 441: }
! 442: else
! 443: pariputsf(" %s = %lu\n", s, n);
1.1 noro 444: default: return gnil;
445: }
446: }
447:
448: #define PRECDIGIT (long)((prec-2.)*pariK)
449: static GEN
450: sd_realprecision(char *v, int flag)
451: {
1.2 ! noro 452: pariout_t *fmt = GP_DATA->fmt;
1.1 noro 453: if (*v)
454: {
1.2 ! noro 455: long newnb = get_int(v, fmt->sigd);
1.1 noro 456: long newprec = (long) (newnb*pariK1 + 3);
457:
1.2 ! noro 458: if (fmt->sigd == newnb && prec == newprec) return gnil;
1.1 noro 459: if (newnb < 0) err(talker,"default: negative real precision");
1.2 ! noro 460: fmt->sigd = newnb; prec = newprec;
1.1 noro 461: }
1.2 ! noro 462: if (flag == d_RETURN) return stoi(fmt->sigd);
1.1 noro 463: if (flag == d_ACKNOWLEDGE)
464: {
465: long n = PRECDIGIT;
466: pariputsf(" realprecision = %ld significant digits", n);
1.2 ! noro 467: if (n != fmt->sigd)
! 468: pariputsf(" (%ld digits displayed)", fmt->sigd);
1.1 noro 469: pariputc('\n');
470: }
471: return gnil;
472: }
473: #undef PRECDIGIT
474:
475: static GEN
476: sd_seriesprecision(char *v, int flag)
477: {
478: char *msg[] = {NULL, "significant terms"};
1.2 ! noro 479: return sd_ulong(v,flag,"seriesprecision",&precdl, 0,LGBITS,msg);
1.1 noro 480: }
481:
482: static GEN
483: sd_format(char *v, int flag)
484: {
1.2 ! noro 485: pariout_t *fmt = GP_DATA->fmt;
1.1 noro 486: if (*v)
487: {
488: char c = *v;
489: if (c!='e' && c!='f' && c!='g')
490: err(talker2,"default: inexistent format",v,v);
1.2 ! noro 491: fmt->format = c; v++;
1.1 noro 492:
493: if (isdigit((int)*v))
1.2 ! noro 494: { fmt->fieldw=atol(v); while (isdigit((int)*v)) v++; }
1.1 noro 495: if (*v++ == '.')
496: {
1.2 ! noro 497: if (*v == '-') fmt->sigd = -1;
1.1 noro 498: else
1.2 ! noro 499: if (isdigit((int)*v)) fmt->sigd=atol(v);
1.1 noro 500: }
501: }
502: if (flag == d_RETURN)
503: {
1.2 ! noro 504: char s[128];
! 505: sprintf(s, "%c%ld.%ld", fmt->format, fmt->fieldw, fmt->sigd);
! 506: return strtoGENstr(s,0);
1.1 noro 507: }
508: if (flag == d_ACKNOWLEDGE)
1.2 ! noro 509: pariputsf(" format = %c%ld.%ld\n", fmt->format, fmt->fieldw, fmt->sigd);
1.1 noro 510: return gnil;
511: }
512:
513: static long
514: gp_get_color(char **st)
515: {
516: char *s, *v = *st;
517: int c, trans;
518: if (isdigit((int)*v))
519: { c = atol(v); trans = 1; } /* color on transparent background */
520: else
521: {
522: if (*v == '[')
523: {
524: char *a[3];
525: int i = 0;
526: for (a[0] = s = ++v; *s && *s != ']'; s++)
527: if (*s == ',') { *s = 0; a[++i] = s+1; }
528: if (*s != ']') err(talker2,"expected character: ']'",s, *st);
529: *s = 0; for (i++; i<3; i++) a[i] = "";
530: /* properties | color | background */
531: c = (atoi(a[2])<<8) | atoi(a[0]) | (atoi(a[1])<<4);
532: trans = (*(a[1]) == 0);
533: v = s + 1;
1.2 ! noro 534: }
1.1 noro 535: else { c = c_NONE; trans = 0; }
536: }
537: if (trans) c = c | (1<<12);
538: while (*v && *v++ != ',') /* empty */;
1.2 ! noro 539: if (c != c_NONE) disable_color = 0;
1.1 noro 540: *st = v; return c;
541: }
542:
543: static GEN
544: sd_colors(char *v, int flag)
545: {
546: long c,l;
1.2 ! noro 547: if (*v && !(GP_DATA->flags & (EMACS|TEXMACS)))
1.1 noro 548: {
1.2 ! noro 549: char *v0;
1.1 noro 550: disable_color=1;
551: l = strlen(v);
552: if (l <= 2 && strncmp(v, "no", l) == 0)
553: v = "";
554: if (l <= 6 && strncmp(v, "darkbg", l) == 0)
555: v = "1, 5, 3, 7, 6, 2, 3"; /* Assume recent ReadLine. */
556: if (l <= 7 && strncmp(v, "lightbg", l) == 0)
557: v = "1, 6, 3, 4, 5, 2, 3"; /* Assume recent ReadLine. */
558: if (l <= 6 && strncmp(v, "boldfg", l) == 0) /* Good for darkbg consoles */
559: v = "[1,,1], [5,,1], [3,,1], [7,,1], [6,,1], [2,,1], [3,,1]";
1.2 ! noro 560: v0 = v = filtre(v, 0);
1.1 noro 561: for (c=c_ERR; c < c_LAST; c++)
562: gp_colors[c] = gp_get_color(&v);
1.2 ! noro 563: free(v0);
1.1 noro 564: }
565: if (flag == d_ACKNOWLEDGE || flag == d_RETURN)
566: {
1.2 ! noro 567: char s[128], *t = s;
1.1 noro 568: int col[3], n;
1.2 ! noro 569: for (*t=0,c=c_ERR; c < c_LAST; c++)
1.1 noro 570: {
571: n = gp_colors[c];
1.2 ! noro 572: if (n == c_NONE)
! 573: sprintf(t,"no");
1.1 noro 574: else
575: {
576: decode_color(n,col);
577: if (n & (1<<12))
578: {
579: if (col[0])
1.2 ! noro 580: sprintf(t,"[%d,,%d]",col[1],col[0]);
1.1 noro 581: else
1.2 ! noro 582: sprintf(t,"%d",col[1]);
1.1 noro 583: }
584: else
1.2 ! noro 585: sprintf(t,"[%d,%d,%d]",col[1],col[2],col[0]);
1.1 noro 586: }
1.2 ! noro 587: t += strlen(t);
! 588: if (c < c_LAST - 1) { *t++=','; *t++=' '; }
1.1 noro 589: }
1.2 ! noro 590: if (flag==d_RETURN) return strtoGENstr(s,0);
! 591: pariputsf(" colors = \"%s\"\n",s);
1.1 noro 592: }
593: return gnil;
594: }
595:
596: static GEN
597: sd_compatible(char *v, int flag)
598: {
599: char *msg[] = {
600: "(no backward compatibility)",
601: "(warn when using obsolete functions)",
602: "(use old functions, don't ignore case)",
603: "(use old functions, ignore case)", NULL
604: };
1.2 ! noro 605: ulong old = compatible;
! 606: GEN r = sd_ulong(v,flag,"compatible",&compatible, 0,3,msg);
1.1 noro 607:
608: if (old != compatible && flag != d_INITRC)
609: {
610: int res = gp_init_entrees(new_fun_set? pari_modules: pari_oldmodules,
611: functions_hash, 0);
612: if (res) err(warner,"user functions re-initialized");
613: }
614: return r;
615: }
616:
617: static GEN
618: sd_secure(char *v, int flag)
619: {
1.2 ! noro 620: if (*v && (GP_DATA->flags & SECURE))
1.1 noro 621: {
622: fprintferr("[secure mode]: Do you want to modify the 'secure' flag? (^C if not)\n");
623: hit_return();
624: }
1.2 ! noro 625: return sd_gptoggle(v,flag,"secure", SECURE);
1.1 noro 626: }
627:
628: static GEN
629: sd_buffersize(char *v, int flag)
1.2 ! noro 630: { return sd_ulong(v,flag,"buffersize",&paribufsize, 1,
1.1 noro 631: (VERYBIGINT / sizeof(long)) - 1,NULL); }
632: static GEN
633: sd_debug(char *v, int flag)
1.2 ! noro 634: { return sd_ulong(v,flag,"debug",&DEBUGLEVEL, 0,20,NULL); }
1.1 noro 635:
636: static GEN
637: sd_rl(char *v, int flag)
638: {
639: #ifdef READLINE
1.2 ! noro 640: if (!readline_init && *v && *v != '0') {
! 641: init_readline();
! 642: readline_init = 1;
! 643: }
1.1 noro 644: #endif
1.2 ! noro 645: return sd_gptoggle(v,flag,"readline", USE_READLINE);
1.1 noro 646: }
647:
648: static GEN
649: sd_debugfiles(char *v, int flag)
1.2 ! noro 650: { return sd_ulong(v,flag,"debugfiles",&DEBUGFILES, 0,20,NULL); }
1.1 noro 651:
652: static GEN
653: sd_debugmem(char *v, int flag)
1.2 ! noro 654: { return sd_ulong(v,flag,"debugmem",&DEBUGMEM, 0,20,NULL); }
1.1 noro 655:
656: static GEN
657: sd_echo(char *v, int flag)
1.2 ! noro 658: { return sd_gptoggle(v,flag,"echo", ECHO); }
1.1 noro 659:
660: static GEN
661: sd_lines(char *v, int flag)
1.2 ! noro 662: { return sd_ulong(v,flag,"lines",&(GP_DATA->lim_lines), 0,VERYBIGINT,NULL); }
1.1 noro 663:
664: static GEN
665: sd_histsize(char *v, int flag)
666: {
1.2 ! noro 667: gp_hist *H = GP_DATA->hist;
! 668: ulong n = H->size;
! 669: GEN r = sd_ulong(v,flag,"histsize",&n, 1,
1.1 noro 670: (VERYBIGINT / sizeof(long)) - 1,NULL);
1.2 ! noro 671: if (n != H->size)
1.1 noro 672: {
1.2 ! noro 673: const ulong total = H->total;
! 674: long g, h, k, kmin;
! 675: GEN *resG = H->res, *resH; /* G = old data, H = new one */
! 676: size_t sG = H->size, sH;
! 677:
! 678: init_hist(H, n, total);
! 679: if (!total) return r;
! 680:
! 681: resH = H->res;
! 682: sH = H->size;
! 683: /* copy relevant history entries */
! 684: g = (total-1) % sG;
! 685: h = k = (total-1) % sH;
! 686: kmin = k - min(sH, sG);
! 687: for ( ; k > kmin; k--, g--, h--)
! 688: {
! 689: resH[h] = resG[g];
! 690: resG[g] = NULL;
! 691: if (!g) g = sG;
! 692: if (!h) h = sH;
! 693: }
! 694: /* clean up */
! 695: for ( ; resG[g]; g--)
1.1 noro 696: {
1.2 ! noro 697: gunclone(resG[g]);
! 698: if (!g) g = sG;
1.1 noro 699: }
1.2 ! noro 700: free((void*)resG);
1.1 noro 701: }
702: return r;
703: }
704:
705: static GEN
706: sd_log(char *v, int flag)
707: {
1.2 ! noro 708: int old = GP_DATA->flags;
! 709: GEN r = sd_gptoggle(v,flag,"log",LOG);
! 710: if (GP_DATA->flags != old)
! 711: { /* toggled LOG */
! 712: if (old & LOG)
! 713: { /* close log */
! 714: if (flag == d_ACKNOWLEDGE)
! 715: pariputsf(" [logfile was \"%s\"]\n", current_logfile);
! 716: fclose(logfile); logfile = NULL;
! 717: }
! 718: else
! 719: { /* open log */
1.1 noro 720: logfile = fopen(current_logfile, "a");
721: if (!logfile) err(openfiler,"logfile",current_logfile);
722: #ifndef WINCE
723: setbuf(logfile,(char *)NULL);
724: #endif
725: }
726: }
727: return r;
728: }
729:
730: static GEN
731: sd_output(char *v, int flag)
732: {
1.2 ! noro 733: char *msg[] = {"(raw)", "(prettymatrix)", "(prettyprint)",
! 734: "(external prettyprint)", NULL};
! 735: ulong n = GP_DATA->fmt->prettyp;
! 736: GEN z = sd_ulong(v,flag,"output", &n, 0,3,msg);
! 737: GP_DATA->fmt->prettyp = n; return z;
1.1 noro 738: }
739:
740: void
1.2 ! noro 741: allocatemem0(size_t newsize)
1.1 noro 742: {
1.2 ! noro 743: (void)allocatemoremem(newsize);
1.1 noro 744: err_clean();
745: jump_to_buffer();
746: }
747:
748: static GEN
749: sd_parisize(char *v, int flag)
750: {
1.2 ! noro 751: ulong n = top-bot;
! 752: GEN r = sd_ulong(v,flag,"parisize",&n, 10000,VERYBIGINT,NULL);
! 753: if (n != (ulong)top-bot)
1.1 noro 754: {
1.2 ! noro 755: if (!bot) top = (gpmem_t)n; /* no stack allocated yet */
1.1 noro 756: if (flag != d_INITRC) allocatemem0(n);
757: }
758: return r;
759: }
760:
761: static GEN
762: sd_primelimit(char *v, int flag)
763: {
1.2 ! noro 764: ulong n = primelimit;
! 765: GEN r = sd_ulong(v,flag,"primelimit",&n, 0,VERYBIGINT,NULL);
1.1 noro 766: if (n != primelimit)
767: {
768: if (flag != d_INITRC)
769: {
770: byteptr ptr = initprimes(n);
771: free(diffptr); diffptr = ptr;
772: }
773: primelimit = n;
774: }
775: return r;
776: }
777:
778: static GEN
779: sd_simplify(char *v, int flag)
1.2 ! noro 780: { return sd_gptoggle(v,flag,"simplify", SIMPLIFY); }
1.1 noro 781:
782: static GEN
783: sd_strictmatch(char *v, int flag)
1.2 ! noro 784: { return sd_gptoggle(v,flag,"strictmatch", STRICTMATCH); }
1.1 noro 785:
786: static GEN
787: sd_timer(char *v, int flag)
1.2 ! noro 788: { return sd_gptoggle(v,flag,"timer", CHRONO); }
1.1 noro 789:
790: static GEN
791: sd_filename(char *v, int flag, char *s, char **f)
792: {
793: if (*v)
794: {
1.2 ! noro 795: char *s, *old = *f;
! 796: long l;
1.1 noro 797: v = expand_tilde(v);
1.2 ! noro 798: l = strlen(v) + 256;
! 799: s = malloc(l);
! 800: do_strftime(v,s, l-1); free(v);
! 801: *f = pari_strdup(s); free(s); free(old);
1.1 noro 802: }
803: if (flag == d_RETURN) return strtoGENstr(*f,0);
804: if (flag == d_ACKNOWLEDGE) pariputsf(" %s = \"%s\"\n",s,*f);
805: return gnil;
806: }
807:
808: static GEN
809: sd_logfile(char *v, int flag)
810: {
811: GEN r = sd_filename(v, flag, "logfile", ¤t_logfile);
812: if (*v && logfile)
813: {
814: fclose(logfile);
815: logfile = fopen(current_logfile, "a");
816: if (!logfile) err(openfiler,"logfile",current_logfile);
817: #ifndef WINCE
818: setbuf(logfile,(char *)NULL);
819: #endif
820: }
821: return r;
822: }
823:
824: static GEN
1.2 ! noro 825: sd_new_galois_format(char *v, int flag)
! 826: { return sd_toggle(v,flag,"new_galois_format", &new_galois_format); }
! 827:
! 828: static GEN
1.1 noro 829: sd_psfile(char *v, int flag)
830: { return sd_filename(v, flag, "psfile", ¤t_psfile); }
831:
832: static void
833: err_secure(char *d, char *v)
834: { err(talker,"[secure mode]: can't modify '%s' default (to %s)",d,v); }
835:
836: static GEN
837: sd_help(char *v, int flag)
838: {
839: char *str;
840: if (*v)
841: {
1.2 ! noro 842: if (GP_DATA->flags & SECURE) err_secure("help",v);
! 843: if (GP_DATA->help) free(GP_DATA->help);
! 844: GP_DATA->help = expand_tilde(v);
1.1 noro 845: }
1.2 ! noro 846: str = GP_DATA->help? GP_DATA->help: "none";
1.1 noro 847: if (flag == d_RETURN) return strtoGENstr(str,0);
848: if (flag == d_ACKNOWLEDGE)
849: pariputsf(" help = \"%s\"\n", str);
850: return gnil;
851: }
852:
853: static GEN
854: sd_path(char *v, int flag)
855: {
1.2 ! noro 856: gp_path *p = GP_DATA->path;
1.1 noro 857: if (*v)
858: {
1.2 ! noro 859: free((void*)p->PATH);
! 860: p->PATH = pari_strdup(v);
1.1 noro 861: if (flag == d_INITRC) return gnil;
1.2 ! noro 862: gp_expand_path(p);
1.1 noro 863: }
1.2 ! noro 864: if (flag == d_RETURN) return strtoGENstr(p->PATH,0);
1.1 noro 865: if (flag == d_ACKNOWLEDGE)
1.2 ! noro 866: pariputsf(" path = \"%s\"\n",p->PATH);
1.1 noro 867: return gnil;
868: }
869:
870: static GEN
871: sd_prettyprinter(char *v, int flag)
872: {
1.2 ! noro 873: gp_pp *pp = GP_DATA->pp;
! 874: if (*v && !(GP_DATA->flags & TEXMACS))
1.1 noro 875: {
1.2 ! noro 876: char *old = pp->cmd;
1.1 noro 877: int cancel = (!strcmp(v,"no"));
878:
1.2 ! noro 879: if (GP_DATA->flags & SECURE) err_secure("prettyprinter",v);
! 880: if (!strcmp(v,"yes")) v = DFT_PRETTYPRINTER;
! 881: if (old && strcmp(old,v) && pp->file)
1.1 noro 882: {
883: pariFILE *f;
884: if (cancel) f = NULL;
885: else
886: {
887: f = try_pipe(v, mf_OUT | mf_TEST);
888: if (!f)
889: {
890: err(warner,"broken prettyprinter: '%s'",v);
891: return gnil;
892: }
893: }
1.2 ! noro 894: pari_fclose(pp->file);
! 895: pp->file = f;
1.1 noro 896: }
1.2 ! noro 897: pp->cmd = cancel? NULL: pari_strdup(v);
! 898: if (old) free(old);
1.1 noro 899: if (flag == d_INITRC) return gnil;
900: }
1.2 ! noro 901: if (flag == d_RETURN) return strtoGEN(pp->cmd? pp->cmd: "");
1.1 noro 902: if (flag == d_ACKNOWLEDGE)
1.2 ! noro 903: pariputsf(" prettyprinter = \"%s\"\n",pp->cmd? pp->cmd: "");
1.1 noro 904: return gnil;
905: }
906:
907: static GEN
1.2 ! noro 908: sd_prompt_set(char *v, int flag, char *how, char *p)
1.1 noro 909: {
910: if (*v)
911: {
1.2 ! noro 912: strncpy(p,v,MAX_PROMPT_LEN);
1.1 noro 913: #ifdef macintosh
1.2 ! noro 914: strcat(p,"\n");
1.1 noro 915: #endif
916: }
1.2 ! noro 917: if (flag == d_RETURN) return strtoGENstr(p,0);
1.1 noro 918: if (flag == d_ACKNOWLEDGE)
1.2 ! noro 919: pariputsf(" prompt%s = \"%s\"\n", how, p);
1.1 noro 920: return gnil;
921: }
922:
1.2 ! noro 923: static GEN
! 924: sd_prompt(char *v, int flag)
! 925: {
! 926: return sd_prompt_set(v, flag, "", prompt);
! 927: }
! 928:
! 929: static GEN
! 930: sd_prompt_cont(char *v, int flag)
! 931: {
! 932: return sd_prompt_set(v, flag, "_cont", prompt_cont);
! 933: }
! 934:
1.1 noro 935: default_type gp_default_list[] =
936: {
937: {"buffersize",(void*)sd_buffersize},
938: {"colors",(void*)sd_colors},
939: {"compatible",(void*)sd_compatible},
940: {"debug",(void*)sd_debug},
941: {"debugfiles",(void*)sd_debugfiles},
942: {"debugmem",(void*)sd_debugmem},
943: {"echo",(void*)sd_echo},
944: {"format",(void*)sd_format},
945: {"help",(void*)sd_help},
946: {"histsize",(void*)sd_histsize},
947: {"lines",(void*)sd_lines},
948: {"log",(void*)sd_log},
949: {"logfile",(void*)sd_logfile},
1.2 ! noro 950: {"new_galois_format",(void*)sd_new_galois_format},
1.1 noro 951: {"output",(void*)sd_output},
952: {"parisize",(void*)sd_parisize},
953: {"path",(void*)sd_path},
954: {"primelimit",(void*)sd_primelimit},
955: {"prettyprinter",(void*)sd_prettyprinter},
956: {"prompt",(void*)sd_prompt},
1.2 ! noro 957: {"prompt_cont",(void*)sd_prompt_cont},
1.1 noro 958: {"psfile",(void*)sd_psfile},
959: {"realprecision",(void*)sd_realprecision},
960: {"readline",(void*)sd_rl},
961: {"secure",(void*)sd_secure},
962: {"seriesprecision",(void*)sd_seriesprecision},
963: {"simplify",(void*)sd_simplify},
964: {"strictmatch",(void*)sd_strictmatch},
965: {"timer",(void *)sd_timer},
966: {NULL,NULL} /* sentinel */
967: };
968:
969: static void
1.2 ! noro 970: help_default(void)
1.1 noro 971: {
972: default_type *dft;
973:
974: for (dft=gp_default_list; dft->fun; dft++)
1.2 ! noro 975: ((void (*)(char*,int)) dft->fun)("", d_ACKNOWLEDGE);
1.1 noro 976: }
977:
978: static GEN
979: setdefault(char *s,char *v, int flag)
980: {
981: default_type *dft;
982:
983: if (!*s) { help_default(); return gnil; }
984: for (dft=gp_default_list; dft->fun; dft++)
985: if (!strcmp(s,dft->name))
986: {
987: if (flag == d_EXISTS) return gun;
1.2 ! noro 988: return ((GEN (*)(char*,int)) dft->fun)(v,flag);
1.1 noro 989: }
990: if (flag == d_EXISTS) return gzero;
991: err(talker,"unknown default: %s",s);
992: return NULL; /* not reached */
993: }
994:
995: /********************************************************************/
996: /** **/
997: /** HELP **/
998: /** **/
999: /********************************************************************/
1000: static int
1.2 ! noro 1001: has_ext_help(void)
1.1 noro 1002: {
1.2 ! noro 1003: if (GP_DATA->help)
1.1 noro 1004: {
1.2 ! noro 1005: char *buf = pari_strdup(GP_DATA->help), *s = buf;
1.1 noro 1006: FILE *file;
1007:
1008: while (*s && *s != ' ') s++;
1009: *s = 0; file = fopen(buf,"r");
1.2 ! noro 1010: free(buf);
1.1 noro 1011: if (file) { fclose(file); return 1; }
1012: }
1013: return 0;
1014: }
1.2 ! noro 1015:
1.1 noro 1016: static int
1017: compare_str(char **s1, char **s2) { return strcmp(*s1, *s2); }
1018:
1019: /* Print all elements of list in columns, pausing every nbli lines
1020: * if nbli is non-zero.
1021: * list is a NULL terminated list of function names
1022: */
1023: void
1024: print_fun_list(char **list, int nbli)
1025: {
1026: long i=0, j=0, maxlen=0, nbcol,len, w = term_width();
1027: char **l;
1028:
1029: while (list[i]) i++;
1030: qsort (list, i, sizeof(char *), (QSCOMP)compare_str);
1031:
1032: for (l=list; *l; l++)
1033: {
1034: len = strlen(*l);
1035: if (len > maxlen) maxlen=len;
1036: }
1037: maxlen++; nbcol= w / maxlen;
1038: if (nbcol * maxlen == w) nbcol--;
1039: if (!nbcol) nbcol = 1;
1040:
1041: pariputc('\n'); i=0;
1042: for (l=list; *l; l++)
1043: {
1044: pariputs(*l); i++;
1045: if (i >= nbcol)
1046: {
1047: i=0; pariputc('\n');
1048: if (nbli && j++ > nbli) { j = 0; hit_return(); }
1049: continue;
1050: }
1051: len = maxlen - strlen(*l);
1052: while (len--) pariputc(' ');
1053: }
1054: if (i) pariputc('\n');
1055: }
1056:
1057: #define LIST_LEN 1023
1058: static void
1059: commands(int n)
1060: {
1.2 ! noro 1061: int hashpos, s = 0, size = LIST_LEN;
1.1 noro 1062: entree *ep;
1.2 ! noro 1063: char **list = (char **) gpmalloc((size+1)*sizeof(char *));
1.1 noro 1064:
1065: for (hashpos = 0; hashpos < functions_tblsz; hashpos++)
1066: for (ep = functions_hash[hashpos]; ep; ep = ep->next)
1067: if ((n<0 && ep->menu) || ep->menu == n)
1068: {
1.2 ! noro 1069: list[s] = ep->name;
! 1070: if (++s >= size)
1.1 noro 1071: {
1.2 ! noro 1072: size += (LIST_LEN + 1)*sizeof(char *);
! 1073: list = (char**) gprealloc(list,size);
1.1 noro 1074: }
1075: }
1076: list[s]=NULL; print_fun_list(list,term_height()-4); free(list);
1077: }
1078:
1079: static void
1080: print_def_arg(GEN x)
1081: {
1082: if (x == gzero) return;
1083: pariputc('=');
1084: if (typ(x)==t_STR)
1085: pariputs(GSTR(x)); /* otherwise it's surrounded by "" */
1086: else
1087: bruteall(x,'g',-1,1);
1088: }
1089:
1090: static void
1091: print_user_fun(entree *ep)
1092: {
1093: gp_args *f= (gp_args*)ep->args;
1094: GEN q = (GEN)ep->value, *arg = f->arg;
1095: int i, narg;
1096:
1097: q++; /* skip initial NULL */
1098: pariputs(ep->name); pariputc('(');
1099: narg = f->narg;
1100: for (i=1; i<=narg; i++, arg++)
1101: {
1102: entree *ep = varentries[*q++];
1103: pariputs(ep? ep->name:"#");
1104: print_def_arg(*arg);
1105: if (i == narg) { arg++; break; }
1106: pariputs(", ");
1107: }
1108: pariputs(") = ");
1109: narg = f->nloc;
1110: if (narg)
1111: {
1112: pariputs("local(");
1113: for (i=1; i<=narg; i++, arg++)
1114: {
1115: entree *ep = varentries[*q++];
1116: pariputs(ep? ep->name:"#");
1117: print_def_arg(*arg);
1118: if (i == narg) break;
1119: pariputs(", ");
1120: }
1121: pariputs("); ");
1122: }
1123: pariputs((char*)q);
1124: }
1125:
1126: static void
1127: print_user_member(entree *ep)
1128: {
1129: GEN q = (GEN)ep->value;
1130: entree *ep2;
1131:
1132: q++; /* skip initial NULL */
1133: ep2 = varentries[*q++];
1134: pariputs(ep2? ep2->name:"#");
1135: pariputsf(".%s = ", ep->name);
1136: pariputs((char*)q);
1137: }
1138:
1139: static void
1.2 ! noro 1140: user_fun(void)
1.1 noro 1141: {
1142: entree *ep;
1143: int hash;
1144:
1145: for (hash = 0; hash < functions_tblsz; hash++)
1146: for (ep = functions_hash[hash]; ep; ep = ep->next)
1147: if (EpVALENCE(ep) == EpUSER)
1148: {
1149: pariputc(LBRACE); print_user_fun(ep);
1150: pariputc(RBRACE); pariputs("\n\n");
1151: }
1152: }
1153:
1154: static void
1.2 ! noro 1155: user_member(void)
1.1 noro 1156: {
1157: entree *ep;
1158: int hash;
1159:
1160: for (hash = 0; hash < functions_tblsz; hash++)
1161: for (ep = members_hash[hash]; ep; ep = ep->next)
1162: if (EpVALENCE(ep) == EpMEMBER)
1163: {
1164: pariputc(LBRACE); print_user_member(ep);
1165: pariputc(RBRACE); pariputs("\n\n");
1166: }
1167: }
1168:
1169: static void
1170: center(char *s)
1171: {
1.2 ! noro 1172: long i, l = strlen(s), pad = term_width() - l;
! 1173: char *buf, *u;
1.1 noro 1174:
1175: if (pad<0) pad=0; else pad >>= 1;
1.2 ! noro 1176: u = buf = (char*)gpmalloc(l + pad + 2);
1.1 noro 1177: for (i=0; i<pad; i++) *u++ = ' ';
1178: while (*s) *u++ = *s++;
1.2 ! noro 1179: *u++ = '\n'; *u = 0;
! 1180: pariputs(buf); free(buf);
1.1 noro 1181: }
1182:
1183: static void
1.2 ! noro 1184: community(void)
1.1 noro 1185: {
1186: long len = strlen(GPMISCDIR) + 1024;
1.2 ! noro 1187: char *s = (char*)gpmalloc(len);
! 1188:
1.1 noro 1189: sprintf(s, "The standard distribution of GP/PARI includes a reference \
1190: manual, a tutorial, a reference card and quite a few examples. They should \
1191: have been installed in the directory '%s'. If not you should ask the person \
1192: who installed PARI on your system where they can be found. You can also \
1193: download them from the PARI WWW site 'http://www.parigp-home.de/'",
1194: GPMISCDIR);
1195: print_text(s); free(s);
1196:
1197: pariputs("\nThree mailing lists are devoted to PARI:\n\
1198: - pari-announce (moderated) to announce major version changes.\n\
1199: - pari-dev for everything related to the development of PARI, including\n\
1200: suggestions, technical questions, bug reports and patch submissions.\n\
1201: - pari-users for everything else!\n");
1202: print_text("\
1203: To subscribe, send an empty message to <listname>-subscribe@list.cr.yp.to. You \
1204: can only send messages to the lists you have subscribed to! An archive is kept \
1205: at the WWW site mentioned above. You can also reach the authors directly by \
1206: email: pari@math.u-bordeaux.fr (answer not guaranteed)."); }
1207:
1208: static void
1209: gentypes(void)
1210: {
1211: pariputs("List of the PARI types:\n\
1212: t_INT : long integers [ cod1 ] [ cod2 ] [ man_1 ] ... [ man_k ]\n\
1213: t_REAL : long real numbers [ cod1 ] [ cod2 ] [ man_1 ] ... [ man_k ]\n\
1214: t_INTMOD : integermods [ code ] [ mod ] [ integer ]\n\
1215: t_FRAC : irred. rationals [ code ] [ num. ] [ den. ]\n\
1216: t_FRACN : rational numbers [ code ] [ num. ] [ den. ]\n\
1217: t_COMPLEX: complex numbers [ code ] [ real ] [ imag ]\n\
1218: t_PADIC : p-adic numbers [ cod1 ] [ cod2 ] [ p ] [ p^r ] [ int ]\n\
1219: t_QUAD : quadratic numbers [ cod1 ] [ mod ] [ real ] [ imag ]\n\
1220: t_POLMOD : poly mod [ code ] [ mod ] [ polynomial ]\n\
1221: -------------------------------------------------------------\n\
1222: t_POL : polynomials [ cod1 ] [ cod2 ] [ man_1 ] ... [ man_k ]\n\
1223: t_SER : power series [ cod1 ] [ cod2 ] [ man_1 ] ... [ man_k ]\n\
1224: t_RFRAC : irred. rat. func. [ code ] [ num. ] [ den. ]\n\
1225: t_RFRACN : rational function [ code ] [ num. ] [ den. ]\n\
1226: t_QFR : real qfb [ code ] [ a ] [ b ] [ c ] [ del ]\n\
1227: t_QFI : imaginary qfb [ code ] [ a ] [ b ] [ c ]\n\
1228: t_VEC : row vector [ code ] [ x_1 ] ... [ x_k ]\n\
1229: t_COL : column vector [ code ] [ x_1 ] ... [ x_k ]\n\
1230: t_MAT : matrix [ code ] [ col_1 ] ... [ col_k ]\n\
1231: t_LIST : list [ code ] [ cod2 ] [ x_1 ] ... [ x_k ]\n\
1232: t_STR : string [ code ] [ man_1 ] ... [ man_k ]\n\
1233: \n");
1234: }
1235:
1236: static void
1237: menu_commands(void)
1238: {
1239: pariputs("Help topics:\n\
1240: 0: list of user-defined identifiers (variable, alias, function)\n\
1241: 1: Standard monadic or dyadic OPERATORS\n\
1242: 2: CONVERSIONS and similar elementary functions\n\
1243: 3: TRANSCENDENTAL functions\n\
1244: 4: NUMBER THEORETICAL functions\n\
1245: 5: Functions related to ELLIPTIC CURVES\n\
1246: 6: Functions related to general NUMBER FIELDS\n\
1247: 7: POLYNOMIALS and power series\n\
1248: 8: Vectors, matrices, LINEAR ALGEBRA and sets\n\
1249: 9: SUMS, products, integrals and similar functions\n\
1250: 10: GRAPHIC functions\n\
1251: 11: PROGRAMMING under GP\n\
1252: 12: The PARI community\n\
1253: \n\
1254: Further help (list of relevant functions): ?n (1<=n<=11).\n\
1255: Also:\n\
1256: ? functionname (short on-line help)\n\
1257: ?\\ (keyboard shortcuts)\n\
1258: ?. (member functions)\n");
1259: if (has_ext_help()) pariputs("\
1260: Extended help looks available:\n\
1261: ?? (opens the full user's manual in a dvi previewer)\n\
1262: ?? tutorial (same with the GP tutorial)\n\
1263: ?? refcard (same with the GP reference card)\n\
1264: \n\
1265: ?? keyword (long help text about \"keyword\" from the user's manual)\n\
1266: ??? keyword (a propos: list of related functions).");
1267: }
1268:
1269: static void
1270: slash_commands(void)
1271: {
1272: pariputs("# : enable/disable timer\n\
1273: ## : print time for last result\n\
1274: \\\\ : comment up to end of line\n\
1275: \\a {n} : print result in raw format (readable by PARI)\n\
1276: \\b {n} : print result in beautified format\n\
1277: \\c : list all commands (same effect as ?*)\n\
1278: \\d : print all defaults\n\
1279: \\e {n} : enable/disable echo (set echo=n)\n\
1280: \\g {n} : set debugging level\n\
1281: \\gf{n} : set file debugging level\n\
1282: \\gm{n} : set memory debugging level\n\
1283: \\h {m-n}: hashtable information\n\
1284: \\l {f} : enable/disable logfile (set logfile=f)\n\
1285: \\m {n} : print result in prettymatrix format\n\
1286: \\o {n} : change output method (0=raw, 1=prettymatrix, 2=prettyprint)\n\
1287: \\p {n} : change real precision\n\
1288: \\ps{n} : change series precision\n\
1289: \\q : quit completely this GP session\n\
1290: \\r {f} : read in a file\n\
1291: \\s {n} : print stack information\n\
1292: \\t : print the list of PARI types\n\
1293: \\u : print the list of user-defined functions\n\
1294: \\um : print the list of user-defined member functions\n\
1295: \\v : print current version of GP\n\
1296: \\w {nf} : write to a file\n\
1297: \\x {n} : print complete inner structure of result\n\
1298: \\y {n} : disable/enable automatic simplification (set simplify=n)\n\
1299: \n\
1300: {f}=optional filename. {n}=optional integer\n");
1301: }
1302:
1303: static void
1304: member_commands(void)
1305: {
1306: pariputs("Member functions, followed by relevant objects\n\n\
1307: a1-a6, b2-b8, c4-c6 : coeff. of the curve. ell\n\
1308: area : area ell\n\
1309: bnf : big number field bnf, bnr\n\
1310: clgp : class group bnf, bnr\n\
1311: cyc : cyclic decomposition (SNF) clgp bnf, bnr\n\
1312: diff, codiff: different and codifferent nf, bnf, bnr\n\
1313: disc : discriminant ell, nf, bnf, bnr\n\
1314: e, f : inertia/residues degree prid\n\
1315: fu : fundamental units bnf, bnr\n\
1316: futu : [u,w] where u=unit group, w=torsion bnf, bnr\n\
1317: gen : generators prid, clgp bnf, bnr\n\
1318: j : j-invariant ell\n\
1319: mod : modulus\n\
1320: nf : number field bnf, bnr\n\
1321: no : number of elements clgp bnf, bnr\n\
1322: omega, eta: [omega1,omega2] and [eta1, eta2] ell\n\
1323: p : rational prime contained in prid prid\n\
1324: pol : defining polynomial nf, bnf, bnr\n\
1325: reg : regulator bnf, bnr\n\
1326: roots: roots ell nf, bnf, bnr\n\
1327: sign : signature nf, bnf, bnr\n\
1328: t2 : t2 matrix nf, bnf, bnr\n\
1329: tate : Tate's [u^2,u,q] ell\n\
1330: tu : torsion unit and its order bnf, bnr\n\
1331: tufu : [w,u] where u=unit group, w=torsion bnf, bnr\n\
1332: w : Mestre's w ell\n\
1333: zk : integral basis nf, bnf, bnr\n\
1334: zkst : structure of (Z_K/m)^* (valid for idealstar also) bnr\n");
1335: }
1336:
1337: #define QUOTE "_QUOTE"
1338: #define DOUBQUOTE "_DOUBQUOTE"
1339: #define BACKQUOTE "_BACKQUOTE"
1340:
1341: static char *
1342: _cat(char *s, char *t)
1343: {
1344: *s = 0; strcat(s,t); return s + strlen(t);
1345: }
1346:
1347: static char *
1348: filter_quotes(char *s)
1349: {
1350: int i, l = strlen(s);
1351: int quote = 0;
1352: int backquote = 0;
1353: int doubquote = 0;
1354: char *str, *t;
1355:
1.2 ! noro 1356: for (i=0; i < l; i++)
1.1 noro 1357: switch(s[i])
1358: {
1359: case '\'': quote++; break;
1360: case '`' : backquote++; break;
1361: case '"' : doubquote++;
1362: }
1363: str = (char*)gpmalloc(l + quote * (strlen(QUOTE)-1)
1364: + doubquote * (strlen(DOUBQUOTE)-1)
1365: + backquote * (strlen(BACKQUOTE)-1) + 1);
1366: t = str;
1.2 ! noro 1367: for (i=0; i < l; i++)
1.1 noro 1368: switch(s[i])
1369: {
1370: case '\'': t = _cat(t, QUOTE); break;
1371: case '`' : t = _cat(t, BACKQUOTE); break;
1372: case '"' : t = _cat(t, DOUBQUOTE); break;
1373: default: *t++ = s[i];
1374: }
1375: *t = 0; return str;
1376: }
1377:
1.2 ! noro 1378: static int
! 1379: nl_read(char *s) { size_t l = strlen(s); return s[l-1] == '\n'; }
! 1380:
! 1381: #define nbof(a) sizeof(a) / sizeof(a[0])
! 1382: /* query external help program for s. num < 0 [keyword] or chapter number */
1.1 noro 1383: static void
1384: external_help(char *s, int num)
1385: {
1386: long nbli = term_height()-3, li = 0;
1.2 ! noro 1387: char buf[256], ar[32], *str, *opt = "";
1.1 noro 1388: pariFILE *z;
1389: FILE *f;
1390:
1.2 ! noro 1391: if (!GP_DATA->help) err(talker,"no external help program");
1.1 noro 1392: s = filter_quotes(s);
1.2 ! noro 1393: str = gpmalloc(strlen(GP_DATA->help) + strlen(s) + 64);
! 1394: *ar = 0;
1.1 noro 1395: if (num < 0)
1396: opt = "-k";
1397: else if (s[strlen(s)-1] != '@')
1.2 ! noro 1398: sprintf(ar,"@%d",num);
! 1399: sprintf(str,"%s -fromgp %s %c%s%s%c",GP_DATA->help,opt, SHELL_Q,s,ar,SHELL_Q);
1.1 noro 1400: z = try_pipe(str,0); f = z->file;
1.2 ! noro 1401: free(str);
! 1402: free(s);
! 1403: while (fgets(buf, nbof(buf), f))
1.1 noro 1404: {
1405: if (!strncmp("ugly_kludge_done",buf,16)) break;
1.2 ! noro 1406: pariputs(buf);
! 1407: if (nl_read(buf) && ++li > nbli) { hit_return(); li = 0; }
1.1 noro 1408: }
1409: pari_fclose(z);
1410: }
1411:
1412: char *keyword_list[]={
1413: "operator",
1414: "user",
1415: "member",
1416: "integer",
1417: "real",
1418: "readline",
1419: "refcard",
1420: "tutorial",
1421: "nf",
1422: "bnf",
1423: "bnr",
1424: "ell",
1425: NULL
1426: };
1427:
1428: static int
1429: ok_external_help(char *s)
1430: {
1431: long n;
1432: if (!*s) return 1;
1433: if (!isalpha((int)*s)) return 3; /* operator or section number */
1434: if (!strncmp(s,"t_",2)) return 2; /* type name */
1435:
1436: for (n=0; keyword_list[n]; n++)
1437: if (!strcmp(s,keyword_list[n])) return 3;
1438: return 0;
1439: }
1440:
1441: /* don't mess readline display */
1442: static void
1443: aide_print(char *s1, char *s2, int flag)
1444: {
1445: if ((flag & h_RL) == 0) err(talker, "%s: %s", s1, s2);
1446: pariputsf("%s: %s\n", s1, s2);
1447: }
1448:
1449: static void
1450: aide0(char *s, int flag)
1451: {
1452: long n, long_help = flag & h_LONG;
1453: entree *ep,*ep1;
1454: char *s1;
1455:
1456: s = get_sep(s);
1457: if (isdigit((int)*s))
1458: {
1.2 ! noro 1459: n = atoi(s);
1.1 noro 1460: if (n == 12) { community(); return; }
1.2 ! noro 1461: if (n < 0 || n > 12)
1.1 noro 1462: err(talker2,"no such section in help: ?",s,s);
1463: if (long_help) external_help(s,3); else commands(n);
1464: return;
1465: }
1.2 ! noro 1466: /* Get meaningful entry on \ps 5 */
1.1 noro 1467: if (*s == '\\') { s1 = s+1; skip_alpha(s1); *s1 = '\0';}
1468:
1469: if (flag & h_APROPOS) { external_help(s,-1); return; }
1470: if (long_help && (n = ok_external_help(s))) { external_help(s,n); return; }
1471: switch (*s)
1472: {
1473: case '*' : commands(-1); return;
1474: case '\0': menu_commands(); return;
1475: case '\\': slash_commands(); return;
1476: case '.' : member_commands(); return;
1477: }
1478: ep = is_entry(s);
1479: if (ep && long_help)
1480: {
1481: if (!strcmp(ep->name, "default"))
1482: {
1483: char *t = s+7, *e;
1484: skip_space(t);
1485: if (*t == '(') {
1486: t++; skip_space(t);
1487: e = t; skip_alpha(e); *e = '\0'; /* safe: get_sep() made it a copy */
1488: if (is_default(t)) { external_help(t, 2); return; }
1489: }
1490: }
1491: }
1492: if (!ep)
1493: {
1494: n = is_default(s)? 2: 3;
1495: if (long_help)
1496: external_help(s,n);
1497: else
1498: {
1499: if (n == 2) { aide_print(s,"default",h_RL); return; }
1500: n = whatnow(s,1);
1501: if (n) err(obsoler,s,s, s,n);
1502: aide_print(s,"unknown identifier",flag);
1503: }
1504: return;
1505: }
1506:
1507: ep1 = ep; ep = do_alias(ep);
1508: if (ep1 != ep) pariputsf("%s is aliased to:\n\n",s);
1509:
1510: switch(EpVALENCE(ep))
1511: {
1512: case EpUSER:
1513: if (!ep->help || long_help) print_user_fun(ep);
1514: if (!ep->help) return;
1515: if (long_help) { pariputs("\n\n"); long_help=0; }
1516: break;
1517:
1518: case EpGVAR:
1519: case EpVAR:
1520: if (!ep->help) { aide_print(s, "user defined variable",h_RL); return; }
1521: long_help=0; break;
1522:
1523: case EpINSTALL:
1524: if (!ep->help) { aide_print(s, "installed function",h_RL); return; }
1525: long_help=0; break;
1526: }
1527: if (long_help) { external_help(ep->name,3); return; }
1528: if (ep->help) { print_text(ep->help); return; }
1529:
1530: err(bugparier,"aide (no help found)");
1531: }
1532:
1533: void
1534: aide(char *s, int flag)
1535: {
1536: if ((flag & h_RL) == 0)
1537: {
1538: if (*s == '?') { flag |= h_LONG; s++; }
1539: if (*s == '?') { flag |= h_APROPOS; s++; }
1540: }
1541: term_color(c_HELP); aide0(s,flag); term_color(c_NONE);
1542: if ((flag & h_RL) == 0) pariputc('\n');
1543: }
1544:
1545: /********************************************************************/
1546: /** **/
1547: /** METACOMMANDS **/
1548: /** **/
1549: /********************************************************************/
1550:
1551: static void
1552: print_entree(entree *ep, long hash)
1553: {
1554: pariputsf(" %s ",ep->name); pariputsf(VOIR_STRING1,(ulong)ep);
1555: pariputsf(":\n hash = %3ld, valence = %3ld, menu = %2ld, code = %s\n",
1556: hash, ep->valence, ep->menu, ep->code? ep->code: "NULL");
1557: if (ep->next)
1558: {
1559: pariputsf(" next = %s ",(ep->next)->name);
1560: pariputsf(VOIR_STRING1,(ulong)(ep->next));
1561: }
1562: pariputs("\n");
1563: }
1564:
1565: static void
1566: print_hash_list(char *s)
1567: {
1568: long m,n;
1569: entree *ep;
1570:
1571: if (isalpha((int)*s))
1572: {
1573: ep = is_entry_intern(s,functions_hash,&n);
1574: if (!ep) err(talker,"no such function");
1575: print_entree(ep,n); return;
1576: }
1577: if (isdigit((int)*s) || *s == '$')
1578: {
1579: m = functions_tblsz-1; n = atol(s);
1580: if (*s=='$') n = m;
1581: if (m<n) err(talker,"invalid range in print_entree");
1582: while (isdigit((int)*s)) s++;
1583:
1584: if (*s++ != '-') m = n;
1585: else
1586: {
1587: if (*s !='$') m = min(atol(s),m);
1588: if (m<n) err(talker,"invalid range in print_entree");
1589: }
1590:
1591: for(; n<=m; n++)
1592: {
1.2 ! noro 1593: pariputsf("*** hashcode = %lu\n",n);
1.1 noro 1594: for (ep=functions_hash[n]; ep; ep=ep->next)
1595: print_entree(ep,n);
1596: }
1597: return;
1598: }
1599: if (*s=='-')
1600: {
1601: for (n=0; n<functions_tblsz; n++)
1602: {
1603: m=0;
1604: for (ep=functions_hash[n]; ep; ep=ep->next) m++;
1605: pariputsf("%3ld:%3ld ",n,m);
1606: if (n%9 == 8) pariputc('\n');
1607: }
1608: pariputc('\n'); return;
1609: }
1610: for (n=0; n<functions_tblsz; n++)
1611: for (ep=functions_hash[n]; ep; ep=ep->next)
1612: print_entree(ep,n);
1613: }
1614:
1615: static char *
1.2 ! noro 1616: what_readline(void)
1.1 noro 1617: {
1618: #ifdef READLINE
1.2 ! noro 1619: return (GP_DATA->flags & USE_READLINE)? "v"READLINE" enabled": "disabled";
! 1620: #else
! 1621: return "disabled";
1.1 noro 1622: #endif
1623: }
1624:
1625: static void
1.2 ! noro 1626: print_version(void)
1.1 noro 1627: {
1628: char buf[64];
1629:
1630: center(PARIVERSION); center(PARIINFO);
1631: sprintf(buf,"(readline %s, extended help%s available)", what_readline(),
1632: has_ext_help()? "": " not");
1633: center(buf);
1634: }
1635:
1636: static void
1.2 ! noro 1637: gp_head(void)
1.1 noro 1638: {
1639: print_version(); pariputs("\n");
1.2 ! noro 1640: center("Copyright (C) 2002 The PARI Group");
1.1 noro 1641: print_text("\nPARI/GP is free software, covered by the GNU General Public \
1642: License, and comes WITHOUT ANY WARRANTY WHATSOEVER");
1643: pariputs("\n\
1644: Type ? for help, \\q to quit.\n\
1645: Type ?12 for how to get moral (and possibly technical) support.\n\n");
1646: sd_realprecision ("",d_ACKNOWLEDGE);
1647: sd_seriesprecision("",d_ACKNOWLEDGE);
1648: sd_format ("",d_ACKNOWLEDGE);
1.2 ! noro 1649: pariputsf("\nparisize = %lu, primelimit = %lu\n", top-bot, primelimit);
1.1 noro 1650: }
1651:
1.2 ! noro 1652: void
1.1 noro 1653: fix_buffer(Buffer *b, long newlbuf)
1654: {
1655: b->len = paribufsize = newlbuf;
1.2 ! noro 1656: b->buf = gprealloc(b->buf, b->len);
1.1 noro 1657: }
1658:
1659: void
1.2 ! noro 1660: gp_quit(void)
1.1 noro 1661: {
1662: free_graph(); freeall();
1663: kill_all_buffers(NULL);
1664: if (INIT_SIG) pari_sig_init(SIG_DFL);
1665: term_color(c_NONE);
1666: pariputs_opt("Goodbye!\n");
1.2 ! noro 1667: if (GP_DATA->flags & TEXMACS) tm_end_output();
1.1 noro 1668: exit(0);
1669: }
1670:
1671: static GEN
1672: gpreadbin(char *s)
1673: {
1674: GEN x = readbin(s,infile);
1675: popinfile(); return x;
1676: }
1677:
1678: static void
1679: escape0(char *tch)
1680: {
1681: char *s, c;
1682:
1683: if (compatible != NONE)
1684: {
1685: s = tch;
1686: while (*s)
1687: if (*s++ == '=')
1688: {
1689: GEN (*f)(char*, int) = NULL;
1690: int len = (s-tch) - 1;
1691:
1692: if (!strncmp(tch,"precision",len)) f = sd_realprecision;
1693: else if (!strncmp(tch,"serieslength",len)) f = sd_seriesprecision;
1694: else if (!strncmp(tch,"format",len)) f = sd_format;
1695: else if (!strncmp(tch,"prompt",len)) f = sd_prompt;
1696: if (f) { f(get_sep(s), d_ACKNOWLEDGE); return; }
1697: break;
1698: }
1699: }
1700: s = tch;
1701: switch ((c = *s++))
1702: {
1703: case 'w': case 'x': case 'a': case 'b': case 'B': case 'm':
1704: { /* history things */
1705: long d;
1706: GEN x;
1707: if (c != 'w' && c != 'x') d = get_int(s,0);
1708: else
1709: {
1710: d = atol(s); if (*s == '-') s++;
1711: while (isdigit((int)*s)) s++;
1712: }
1.2 ! noro 1713: x = gp_history(GP_DATA->hist, d, tch+1,tch-1);
1.1 noro 1714: switch (c)
1715: {
1.2 ! noro 1716: case 'B':
! 1717: { /* prettyprinter */
! 1718: gp_data G = *GP_DATA; /* copy */
! 1719: gp_hist h = *(G.hist); /* copy */
! 1720: pariout_t f = *(G.fmt); /* copy */
! 1721:
! 1722: G.hist = &h; h.total = 0; /* no hist number */
! 1723: G.fmt = &f; f.prettyp = f_PRETTY;
! 1724: G.flags &= ~(TEST|TEXMACS);
! 1725: G.lim_lines = 0;
! 1726: gp_output(x, &G); break;
! 1727: }
! 1728: case 'a': brute (x, GP_DATA->fmt->format, -1); break;
! 1729: case 'm': matbrute(x, GP_DATA->fmt->format, -1); break;
! 1730: case 'b': sor(x, GP_DATA->fmt->format, -1, GP_DATA->fmt->fieldw); break;
! 1731: case 'x': voir(x, get_int(s, -1)); break;
1.1 noro 1732: case 'w':
1733: {
1734: GEN g[2]; g[0] = x; g[1] = NULL;
1735: s = get_sep_colon_ok(s); if (!*s) s = current_logfile;
1.2 ! noro 1736: write0(s, g); return;
1.1 noro 1737: }
1738: }
1739: pariputc('\n'); return;
1740: }
1741:
1742: case 'c': commands(-1); break;
1743: case 'd': help_default(); break;
1744: case 'e':
1745: s = get_sep(s);
1.2 ! noro 1746: if (!*s) s = (GP_DATA->flags & ECHO)? "0": "1";
1.1 noro 1747: sd_echo(s,d_ACKNOWLEDGE); break;
1748: case 'g':
1749: switch (*s)
1750: {
1751: case 'm': sd_debugmem(++s,d_ACKNOWLEDGE); break;
1752: case 'f': sd_debugfiles(++s,d_ACKNOWLEDGE); break;
1753: default : sd_debug(s,d_ACKNOWLEDGE); break;
1754: }
1755: break;
1756: case 'h': print_hash_list(s); break;
1757: case 'l':
1758: s = get_sep_colon_ok(s);
1759: if (*s)
1760: {
1761: sd_logfile(s,d_ACKNOWLEDGE);
1762: if (logfile) break;
1763: }
1764: sd_log(logfile?"0":"1",d_ACKNOWLEDGE);
1765: break;
1766: case 'o': sd_output(s,d_ACKNOWLEDGE); break;
1767: case 'p':
1768: switch (*s)
1769: {
1770: case 's': sd_seriesprecision(++s,d_ACKNOWLEDGE); break;
1771: default : sd_realprecision(s,d_ACKNOWLEDGE); break;
1772: }
1773: break;
1774: case 'q': gp_quit(); break;
1775: case 'r':
1776: s = get_sep_colon_ok(s);
1777: switchin(s);
1.2 ! noro 1778: if (file_is_binary(infile))
! 1779: {
! 1780: GEN x = gpreadbin(s);
! 1781: if (isclone(x)) /* many BIN_GEN */
! 1782: {
! 1783: long i, l = lg(x);
! 1784: err(warner,"setting %ld history entries", l-1);
! 1785: for (i=1; i<l; i++) (void)set_hist_entry(GP_DATA->hist, (GEN)x[i]);
! 1786: }
! 1787: }
1.1 noro 1788: break;
1789: case 's': etatpile(0); break;
1790: case 't': gentypes(); break;
1791: case 'u':
1792: switch (*s)
1793: {
1794: case 'm': user_member(); break;
1795: default: user_fun();
1796: }
1797: break;
1798: case 'v': print_version(); break;
1799: case 'y':
1800: s = get_sep(s);
1.2 ! noro 1801: if (!*s) s = (GP_DATA->flags & SIMPLIFY)? "0": "1";
1.1 noro 1802: sd_simplify(s,d_ACKNOWLEDGE); break;
1803: default: err(caracer1,tch-1,tch-2);
1804: }
1805: }
1806:
1807: static void
1808: escape(char *tch)
1809: {
1.2 ! noro 1810: char *old = get_analyseur();
! 1811: set_analyseur(tch); /* for error messages */
1.1 noro 1812: escape0(tch);
1.2 ! noro 1813: set_analyseur(old);
1.1 noro 1814: }
1815: /********************************************************************/
1816: /* */
1817: /* GPRC */
1818: /* */
1819: /********************************************************************/
1820: #if defined(UNIX) || defined(__EMX__)
1821: # include <pwd.h>
1822: #endif
1823:
1.2 ! noro 1824: static int get_line_from_file(char *prompt, filtre_t *F, FILE *file);
! 1825: #define err_gprc(s,t,u) { fprintferr("\n"); err(talker2,s,t,u); }
! 1826:
! 1827: static void
! 1828: init_filtre(filtre_t *F, void *data)
1.1 noro 1829: {
1.2 ! noro 1830: F->data = data;
! 1831: F->in_string = 0;
! 1832: F->in_comment = 0;
! 1833: F->downcase = 0;
1.1 noro 1834: }
1835:
1.2 ! noro 1836: /* LOCATE GPRC */
! 1837:
1.1 noro 1838: /* return $HOME or the closest we can find */
1839: static char *
1840: get_home(int *free_it)
1841: {
1842: char *drv, *pth = os_getenv("HOME");
1843: if (pth) return pth;
1844: if ((drv = os_getenv("HOMEDRIVE"))
1845: && (pth = os_getenv("HOMEPATH")))
1846: { /* looks like WinNT */
1847: char *buf = gpmalloc(strlen(pth) + strlen(drv) + 1);
1848: sprintf(buf, "%s%s",drv,pth);
1849: *free_it = 1; return buf;
1850: }
1851: #if defined(__EMX__) || defined(UNIX)
1852: {
1853: struct passwd *p = getpwuid(geteuid());
1854: if (p) return p->pw_dir;
1855: }
1856: #endif
1857: return ".";
1858: }
1859:
1860: static FILE *
1861: gprc_chk(char *s)
1862: {
1863: FILE *f = fopen(s, "r");
1.2 ! noro 1864: if (f && !(GP_DATA->flags & QUIET)) fprintferr("Reading GPRC: %s ...", s);
1.1 noro 1865: return f;
1866: }
1867:
1868: /* Look for [._]gprc: $GPRC, then in $HOME, /, C:/ */
1869: static FILE *
1.2 ! noro 1870: gprc_get(void)
1.1 noro 1871: {
1872: FILE *f = NULL;
1873: char *str, *s, c;
1874: long l;
1875: #ifdef macintosh
1876: f = gprc_chk("gprc");
1877: #else
1878: s = os_getenv("GPRC");
1879: if (s) f = gprc_chk(s);
1880: if (!f)
1881: {
1882: int free_it = 0;
1883: s = get_home(&free_it); l = strlen(s); c = s[l-1];
1884: str = strcpy(gpmalloc(l+7), s);
1885: if (free_it) free(s);
1886: s = str + l;
1887: if (c != '/' && c != '\\') *s++ = '/';
1888: #ifdef UNIX
1889: *s = '.'; /* .gprc */
1890: #else
1891: *s = '_'; /* _gprc */
1892: #endif
1893: strcpy(s+1, "gprc");
1894: f = gprc_chk(str); /* in $HOME */
1895: if (!f) f = gprc_chk(s); /* in . */
1896: if (!f) f = gprc_chk("/etc/gprc");
1897: if (!f) f = gprc_chk("C:/_gprc");
1898: free(str);
1899: }
1900: #endif
1901: return f;
1902: }
1903:
1.2 ! noro 1904: /* PREPROCESSOR */
! 1905:
! 1906: static ulong
! 1907: read_uint(char **s)
! 1908: {
! 1909: long v = atol(*s);
! 1910: if (!isdigit((int)**s)) err_gprc("not an integer", *s, *s);
! 1911: while (isdigit((int)**s)) (*s)++;
! 1912: return v;
! 1913: }
! 1914: static ulong
! 1915: read_dot_uint(char **s)
! 1916: {
! 1917: if (**s != '.') return 0;
! 1918: (*s)++; return read_uint(s);
! 1919: }
! 1920: /* read a.b.c */
! 1921: static long
! 1922: read_version(char **s)
! 1923: {
! 1924: long a, b, c;
! 1925: a = read_uint(s);
! 1926: b = read_dot_uint(s);
! 1927: c = read_dot_uint(s);
! 1928: return PARI_VERSION(a,b,c);
! 1929: }
! 1930:
! 1931: static int
! 1932: get_preproc_value(char **s)
! 1933: {
! 1934: if (!strncmp(*s,"EMACS",5))
! 1935: {
! 1936: *s += 5;
! 1937: return GP_DATA->flags & (EMACS|TEXMACS);
! 1938: }
! 1939: if (!strncmp(*s,"READL",5))
! 1940: {
! 1941: *s += 5;
! 1942: return GP_DATA->flags & USE_READLINE;
! 1943: }
! 1944: if (!strncmp(*s,"VERSION",7))
! 1945: {
! 1946: int less = 0, orequal = 0;
! 1947: long d;
! 1948: *s += 7;
! 1949: switch(**s)
! 1950: {
! 1951: case '<': (*s)++; less = 1; break;
! 1952: case '>': (*s)++; less = 0; break;
! 1953: default: return -1;
! 1954: }
! 1955: if (**s == '=') { (*s)++; orequal = 1; }
! 1956: d = PARI_VERSION_CODE - read_version(s);
! 1957: if (!d) return orequal;
! 1958: return less? (d < 0): (d > 0);
! 1959: }
! 1960: return -1;
! 1961: }
! 1962:
! 1963: /* PARSE GPRC */
! 1964:
! 1965: /* 1) replace next separator by '\0' (t must be writeable)
! 1966: * 2) return the next expression ("" if none)
! 1967: * see get_sep0() */
! 1968: static char *
! 1969: next_expr(char *t)
! 1970: {
! 1971: int outer = 1;
! 1972: char *s = t;
! 1973:
! 1974: for(;;)
! 1975: {
! 1976: char c;
! 1977: switch ((c = *s++))
! 1978: {
! 1979: case '"':
! 1980: if (outer || (s >= t+2 && s[-2] != '\\')) outer = !outer;
! 1981: break;
! 1982: case '\0':
! 1983: return "";
! 1984: default:
! 1985: if (outer && separe(c)) { s[-1] = 0; return s; }
! 1986: }
! 1987: }
! 1988: }
1.1 noro 1989:
1990: static char **
1.2 ! noro 1991: gp_initrc(void)
1.1 noro 1992: {
1.2 ! noro 1993: char **flist, *nexts,*s,*t;
1.1 noro 1994: FILE *file = gprc_get();
1995: long fnum = 4, find = 0;
1996: Buffer *b;
1.2 ! noro 1997: filtre_t F;
1.1 noro 1998:
1999: if (!file) return NULL;
2000: flist = (char **) gpmalloc(fnum * sizeof(char*));
2001: b = new_buffer();
1.2 ! noro 2002: init_filtre(&F, (void*)b);
1.1 noro 2003: for(;;)
2004: {
1.2 ! noro 2005: if (!get_line_from_file(NULL,&F,file)) break;
! 2006: s = b->buf;
! 2007: if (*s == '#')
! 2008: { /* preprocessor directive */
! 2009: int z, NOT = 0;
! 2010: s++;
! 2011: if (strncmp(s,"if",2)) err_gprc("unknown directive",s,b->buf);
! 2012: s += 2;
! 2013: if (!strncmp(s,"not",3)) { NOT = !NOT; s += 3; }
! 2014: if (*s == '!') { NOT = !NOT; s++; }
! 2015: t = s;
! 2016: z = get_preproc_value(&s);
! 2017: if (z < 0) err_gprc("unknown preprocessor variable",t,b->buf);
! 2018: if (NOT) z = !z;
! 2019: if (!*s)
! 2020: { /* make sure at least an expr follows the directive */
! 2021: if (!get_line_from_file(NULL,&F,file)) break;
! 2022: s = b->buf;
! 2023: }
! 2024: if (!z) continue; /* dump current line */
! 2025: }
! 2026: /* parse line */
! 2027: for ( ; *s; s = nexts)
1.1 noro 2028: {
1.2 ! noro 2029: nexts = next_expr(s);
! 2030: if (!strncmp(s,"read",4))
1.1 noro 2031: { /* read file */
1.2 ! noro 2032: s += 4;
1.1 noro 2033: if (find == fnum-1)
2034: {
1.2 ! noro 2035: fnum <<= 1;
! 2036: flist = (char**)gprealloc(flist, fnum*sizeof(char*));
1.1 noro 2037: }
1.2 ! noro 2038: flist[find++] = t = gpmalloc(strlen(s) + 1);
! 2039: if (*s == '"') (void)readstring(s, t);
! 2040: else strcpy(t,s);
1.1 noro 2041: }
2042: else
2043: { /* set default */
1.2 ! noro 2044: t = s; while (*t && *t != '=') t++;
! 2045: if (*t != '=') err_gprc("missing '='",t,b->buf);
! 2046: *t++ = 0;
! 2047: if (*t == '"') (void)readstring(t, t);
! 2048: setdefault(s,t,d_INITRC);
1.1 noro 2049: }
2050: }
2051: }
1.2 ! noro 2052: del_buffer(b);
! 2053: if (!(GP_DATA->flags & QUIET)) fprintferr("Done.\n\n");
! 2054: fclose(file); flist[find] = NULL;
! 2055: return flist;
1.1 noro 2056: }
2057:
2058: /********************************************************************/
2059: /* */
2060: /* GP MAIN LOOP */
2061: /* */
2062: /********************************************************************/
2063: /* flag:
2064: * ti_NOPRINT don't print
1.2 ! noro 2065: * ti_REGULAR print elapsed time (flags & CHRONO)
1.1 noro 2066: * ti_LAST print last elapsed time (##)
2067: * ti_INTERRUPT received a SIGINT
2068: */
2069: static char *
2070: do_time(long flag)
2071: {
1.2 ! noro 2072: static char buf[64];
1.1 noro 2073: static long last = 0;
1.2 ! noro 2074: long delay = (flag == ti_LAST)? last: TIMER(GP_DATA->T);
1.1 noro 2075: char *s;
2076:
2077: last = delay;
2078: switch(flag)
2079: {
2080: case ti_REGULAR: s = "time = "; break;
2081: case ti_INTERRUPT: s = "user interrupt after "; break;
2082: case ti_LAST: s = " *** last result computed in "; break;
2083: default: return NULL;
2084: }
1.2 ! noro 2085: strcpy(buf,s); s = buf+strlen(s);
1.1 noro 2086: strcpy(s, term_get_color(c_TIME)); s+=strlen(s);
2087: if (delay >= 3600000)
2088: {
2089: sprintf(s, "%ldh, ", delay / 3600000); s+=strlen(s);
2090: delay %= 3600000;
2091: }
2092: if (delay >= 60000)
2093: {
2094: sprintf(s, "%ldmn, ", delay / 60000); s+=strlen(s);
2095: delay %= 60000;
2096: }
2097: if (delay >= 1000)
2098: {
2099: sprintf(s, "%ld,", delay / 1000); s+=strlen(s);
2100: delay %= 1000;
2101: if (delay < 100)
2102: {
2103: sprintf(s, "%s", (delay<10)? "00": "0");
2104: s+=strlen(s);
2105: }
2106: }
2107: sprintf(s, "%ld ms", delay); s+=strlen(s);
2108: strcpy(s, term_get_color(c_NONE));
2109: if (flag != ti_INTERRUPT) { s+=strlen(s); *s++='.'; *s++='\n'; *s=0; }
1.2 ! noro 2110: return buf;
1.1 noro 2111: }
2112:
2113: static void
1.2 ! noro 2114: gp_handle_SIGINT(void)
1.1 noro 2115: {
2116: #ifdef _WIN32
2117: if (++win32ctrlc >= 5) _exit(3);
2118: #else
1.2 ! noro 2119: if (GP_DATA->flags & TEXMACS) tm_start_output();
1.1 noro 2120: err(siginter, do_time(ti_INTERRUPT));
2121: #endif
2122: }
2123:
2124: static void
2125: gp_sighandler(int sig)
2126: {
2127: char *msg;
2128: os_signal(sig,gp_sighandler);
2129: switch(sig)
2130: {
2131: #ifdef SIGBREAK
2132: case SIGBREAK: gp_handle_SIGINT(); return;
2133: #endif
2134: #ifdef SIGINT
1.2 ! noro 2135: case SIGINT: gp_handle_SIGINT(); return;
1.1 noro 2136: #endif
2137:
2138: #ifdef SIGSEGV
1.2 ! noro 2139: case SIGSEGV: msg = "GP (Segmentation Fault)"; break;
1.1 noro 2140: #endif
2141: #ifdef SIGBUS
1.2 ! noro 2142: case SIGBUS: msg = "GP (Bus Error)"; break;
1.1 noro 2143: #endif
2144: #ifdef SIGFPE
1.2 ! noro 2145: case SIGFPE: msg = "GP (Floating Point Exception)"; break;
1.1 noro 2146: #endif
2147:
2148: #ifdef SIGPIPE
2149: case SIGPIPE:
1.2 ! noro 2150: {
! 2151: pariFILE *f = GP_DATA->pp->file;
! 2152: if (f && pari_outfile == f->file)
1.1 noro 2153: {
1.2 ! noro 2154: GP_DATA->pp->file = NULL; /* to avoid oo recursion on error */
1.1 noro 2155: pari_outfile = stdout; pari_fclose(f);
2156: }
2157: err(talker, "Broken Pipe, resetting file stack...");
1.2 ! noro 2158: return; /* not reached */
! 2159: }
1.1 noro 2160: #endif
1.2 ! noro 2161: default: msg = "signal handling"; break;
1.1 noro 2162: }
1.2 ! noro 2163: err(bugparier, msg);
1.1 noro 2164: }
2165:
2166: static void
2167: brace_color(char *s, int c, int force)
2168: {
2169: if (disable_color || (gp_colors[c] == c_NONE && !force)) return;
2170: #ifdef RL_PROMPT_START_IGNORE
2171: *s++ = RL_PROMPT_START_IGNORE;
2172: #endif
2173: strcpy(s, term_get_color(c));
2174: #ifdef RL_PROMPT_START_IGNORE
2175: s+=strlen(s);
2176: *s++ = RL_PROMPT_END_IGNORE; *s = 0;
2177: #endif
2178: }
2179:
2180: static char *
1.2 ! noro 2181: do_prompt(int in_comment, char *p)
1.1 noro 2182: {
2183: static char buf[MAX_PROMPT_LEN + 24]; /* + room for color codes */
2184: char *s;
1.2 ! noro 2185:
! 2186: if (GP_DATA->flags & TEST) return prompt;
1.1 noro 2187: s = buf; *s = 0;
2188: /* escape sequences bug readline, so use special bracing (if available) */
2189: brace_color(s, c_PROMPT, 0);
2190: s += strlen(s);
1.2 ! noro 2191: if (in_comment)
1.1 noro 2192: strcpy(s, COMMENTPROMPT);
2193: else
1.2 ! noro 2194: do_strftime(p,s, MAX_PROMPT_LEN-1);
1.1 noro 2195: s += strlen(s);
2196: brace_color(s, c_INPUT, 1); return buf;
2197: }
2198:
1.2 ! noro 2199: static char *
! 2200: fgets_texmacs(char *s, int n, FILE *f)
1.1 noro 2201: {
1.2 ! noro 2202: tm_start_output(); tm_end_output(); /* tell TeXmacs we need input */
! 2203: return fgets(s,n,f);
1.1 noro 2204: }
2205:
2206: /* Read from file (up to '\n' or EOF) and copy at s0 (points in b->buf) */
2207: static char *
1.2 ! noro 2208: file_input(Buffer *b, char **s0, input_method *IM)
1.1 noro 2209: {
2210: int first = 1;
2211: char *s = *s0;
2212: long used0, used = s - b->buf;
2213:
2214: used0 = used;
2215: for(;;)
2216: {
1.2 ! noro 2217: long left = b->len - used, l;
1.1 noro 2218:
2219: if (left < 512)
2220: {
2221: fix_buffer(b, b->len << 1);
2222: left = b->len - used;
2223: *s0 = b->buf + used0;
2224: }
2225: s = b->buf + used;
1.2 ! noro 2226: if (! IM->fgets(s, left, IM->file))
! 2227: return first? NULL: *s0; /* EOF */
! 2228:
! 2229: l = strlen(s); first = 0;
! 2230: if (l+1 < left || s[l-1] == '\n') return *s0; /* \n */
! 2231: used += l;
1.1 noro 2232: }
2233: }
2234:
1.2 ! noro 2235: /* Read a "complete line" and filter it. Return: 0 if EOF, 1 otherwise */
! 2236: int
! 2237: input_loop(filtre_t *F, input_method *IM)
1.1 noro 2238: {
1.2 ! noro 2239: Buffer *b = (Buffer*)F->data;
! 2240: char *to_read, *s = b->buf;
! 2241:
! 2242: /* read first line */
! 2243: handle_C_C = 0;
! 2244: while (! (to_read = IM->getline(b,&s,IM)) )
! 2245: { /* EOF */
! 2246: if (!handle_C_C) { check_filtre(F); return 0; }
! 2247: /* received ^C in getline and coming back from break_loop();
! 2248: * retry (as if "\n" were input) */
! 2249: handle_C_C = 0;
1.1 noro 2250: }
2251:
2252: /* buffer is not empty, init filter */
1.2 ! noro 2253: F->in_string = 0;
! 2254: F->more_input= 0;
! 2255: F->wait_for_brace = 0;
1.1 noro 2256: for(;;)
2257: {
1.2 ! noro 2258: F->s = to_read;
! 2259: F->t = s;
! 2260: (void)filtre0(F);
! 2261: if (IM->free) free(to_read);
1.1 noro 2262:
1.2 ! noro 2263: if (! F->more_input) break;
1.1 noro 2264:
2265: /* read continuation line */
1.2 ! noro 2266: s = F->end;
! 2267: if (IM->prompt) IM->prompt = do_prompt(F->in_comment, prompt_cont);
! 2268: to_read = IM->getline(b,&s, IM);
! 2269: if (!to_read) break;
1.1 noro 2270: }
1.2 ! noro 2271: return 1;
1.1 noro 2272: }
2273:
2274: /* prompt = NULL --> from gprc. Return 1 if new input, and 0 if EOF */
2275: static int
1.2 ! noro 2276: get_line_from_file(char *prompt, filtre_t *F, FILE *file)
1.1 noro 2277: {
1.2 ! noro 2278: const int TeXmacs = ((GP_DATA->flags & TEXMACS) && file == stdin);
! 2279: char *s;
! 2280: input_method IM;
1.1 noro 2281:
1.2 ! noro 2282: IM.file = file;
! 2283: IM.fgets= TeXmacs? &fgets_texmacs: &fgets;
! 2284: IM.prompt = NULL;
! 2285: IM.getline= &file_input;
! 2286: IM.free = 0;
! 2287: if (! input_loop(F,&IM))
! 2288: {
! 2289: if (TeXmacs) tm_start_output();
! 2290: return 0;
1.1 noro 2291: }
2292:
1.2 ! noro 2293: s = ((Buffer*)F->data)->buf;
1.1 noro 2294: if (*s && prompt) /* don't echo if from gprc */
2295: {
1.2 ! noro 2296: if (GP_DATA->flags & ECHO)
1.1 noro 2297: { pariputs(prompt); pariputs(s); pariputc('\n'); }
2298: else
2299: if (logfile) fprintf(logfile, "%s%s\n",prompt,s);
2300: pariflush();
2301: }
1.2 ! noro 2302: if (GP_DATA->flags & TEXMACS) tm_start_output();
1.1 noro 2303: return 1;
2304: }
2305:
2306: static int
1.2 ! noro 2307: get_line_from_user(char *prompt, filtre_t *F)
1.1 noro 2308: {
2309: pariputs(prompt);
1.2 ! noro 2310: return get_line_from_file(prompt,F,infile);
1.1 noro 2311: }
2312:
2313: static int
1.2 ! noro 2314: is_interactive(void)
1.1 noro 2315: {
1.2 ! noro 2316: ulong f = GP_DATA->flags;
1.1 noro 2317: #if defined(UNIX) || defined(__EMX__)
1.2 ! noro 2318: return (infile == stdin && !(f & TEXMACS)
! 2319: && (f & EMACS || isatty(fileno(stdin))));
1.1 noro 2320: #else
1.2 ! noro 2321: return (infile == stdin && !(f & TEXMACS));
1.1 noro 2322: #endif
2323: }
2324:
1.2 ! noro 2325: extern int get_line_from_readline(char *prompt, filtre_t *F);
! 2326:
1.1 noro 2327: /* return 0 if no line could be read (EOF) */
2328: static int
1.2 ! noro 2329: read_line(filtre_t *F, char *PROMPT)
1.1 noro 2330: {
1.2 ! noro 2331: int res;
! 2332: if (compatible == OLDALL) F->downcase = 1;
1.1 noro 2333: if (is_interactive())
1.2 ! noro 2334: {
! 2335: if (!PROMPT) PROMPT = do_prompt(F->in_comment, prompt);
! 2336: #ifdef READLINE
! 2337: if (GP_DATA->flags & USE_READLINE)
! 2338: res = get_line_from_readline(PROMPT, F);
! 2339: else
! 2340: #endif
! 2341: res = get_line_from_user(PROMPT, F);
! 2342: if (!disable_color) { term_color(c_NONE); pariflush(); }
! 2343: }
1.1 noro 2344: else
1.2 ! noro 2345: res = get_line_from_file(DFT_PROMPT,F,infile);
! 2346: return res;
1.1 noro 2347: }
2348:
1.2 ! noro 2349: static int
1.1 noro 2350: chron(char *s)
2351: {
2352: if (*s)
1.2 ! noro 2353: { /* if "#" or "##" timer metacommand. Otherwise let the parser get it */
! 2354: if (*s == '#') s++;
! 2355: if (*s) return 0;
! 2356: pariputs(do_time(ti_LAST));
1.1 noro 2357: }
1.2 ! noro 2358: else { GP_DATA->flags ^= CHRONO; sd_timer("",d_ACKNOWLEDGE); }
! 2359: return 1;
1.1 noro 2360: }
2361:
1.2 ! noro 2362: /* return 0: can't interpret *buf as a metacommand
! 2363: * 1: did interpret *buf as a metacommand or empty command */
1.1 noro 2364: static int
2365: check_meta(char *buf)
2366: {
2367: switch(*buf++)
2368: {
2369: case '?': aide(buf, h_REGULAR); break;
1.2 ! noro 2370: case '#': return chron(buf);
1.1 noro 2371: case '\\': escape(buf); break;
1.2 ! noro 2372: case '\0': break;
1.1 noro 2373: default: return 0;
2374: }
2375: return 1;
2376: }
2377:
1.2 ! noro 2378: /* kill all history entries since loc */
! 2379: static void
! 2380: prune_history(gp_hist *H, long loc)
! 2381: {
! 2382: long i, j;
! 2383: i = (H->total-1) % H->size;
! 2384: j = H->total - loc;
! 2385: for ( ; j > 0; i--,j--)
! 2386: {
! 2387: if (H->res[i])
! 2388: {
! 2389: gunclone(H->res[i]);
! 2390: H->res[i] = NULL;
! 2391: }
! 2392: if (!i) i = H->size;
! 2393: }
! 2394: H->total = loc;
! 2395: }
! 2396:
! 2397: static int
! 2398: is_silent(char *s) { char c = s[strlen(s) - 1]; return separe(c); }
! 2399:
1.1 noro 2400: /* If there are other buffers open (bufstack != NULL), we are doing an
2401: * immediate read (with read, extern...) */
2402: static GEN
2403: gp_main_loop(int ismain)
2404: {
1.2 ! noro 2405: gp_hist *H = GP_DATA->hist;
! 2406: gpmem_t av = avma;
! 2407: GEN z = gnil;
1.1 noro 2408: Buffer *b = new_buffer();
1.2 ! noro 2409: filtre_t F;
! 2410:
1.1 noro 2411: if (!setjmp(b->env))
2412: {
2413: b->flenv = 1;
2414: push_stack(&bufstack, (void*)b);
2415: }
1.2 ! noro 2416: init_filtre(&F, (void*)b);
! 2417:
! 2418: for (; ; setjmp(b->env), avma = av)
1.1 noro 2419: {
2420: if (ismain)
2421: {
2422: static long tloc, outtyp;
1.2 ! noro 2423: tloc = H->total;
! 2424: outtyp = GP_DATA->fmt->prettyp;
! 2425: recover(0);
1.1 noro 2426: if (setjmp(environnement))
1.2 ! noro 2427: { /* recover from error */
1.1 noro 2428: char *s = (char*)global_err_data;
2429: if (s && *s) outerr(lisseq(s));
1.2 ! noro 2430: avma = top;
! 2431: prune_history(H, tloc);
! 2432: GP_DATA->fmt->prettyp = outtyp;
1.1 noro 2433: kill_all_buffers(b);
2434: }
2435: }
2436: if (paribufsize != b->len) fix_buffer(b, paribufsize);
2437:
1.2 ! noro 2438: if (! read_line(&F, NULL))
1.1 noro 2439: {
1.2 ! noro 2440: #ifdef _WIN32
! 2441: Sleep(10); if (win32ctrlc) dowin32ctrlc();
! 2442: #endif
! 2443: if (popinfile()) gp_quit();
! 2444: if (ismain) continue;
! 2445: pop_buffer(); return z;
1.1 noro 2446: }
1.2 ! noro 2447: if (check_meta(b->buf)) continue;
! 2448:
1.1 noro 2449: if (ismain)
2450: {
1.2 ! noro 2451: gpsilent = is_silent(b->buf);
! 2452: TIMERstart(GP_DATA->T);
! 2453: }
! 2454: z = readseq(b->buf, GP_DATA->flags & STRICTMATCH);
1.1 noro 2455: if (! ismain) continue;
1.2 ! noro 2456:
! 2457: if (GP_DATA->flags & CHRONO)
! 2458: pariputs(do_time(ti_REGULAR));
! 2459: else
! 2460: do_time(ti_NOPRINT);
1.1 noro 2461: if (z == gnil) continue;
2462:
1.2 ! noro 2463: if (GP_DATA->flags & SIMPLIFY) z = simplify_i(z);
! 2464: z = set_hist_entry(H, z);
! 2465: if (!gpsilent) gp_output(z, GP_DATA);
1.1 noro 2466: }
2467: }
2468:
2469: GEN
2470: read0(char *s)
2471: {
2472: switchin(s);
2473: if (file_is_binary(infile)) return gpreadbin(s);
2474: return gp_main_loop(0);
2475: }
2476:
2477: static void
2478: check_secure(char *s)
2479: {
1.2 ! noro 2480: if (GP_DATA->flags & SECURE)
1.1 noro 2481: err(talker, "[secure mode]: system commands not allowed\nTried to run '%s'",s);
2482: }
2483:
2484: GEN
2485: extern0(char *s)
2486: {
2487: check_secure(s);
2488: infile = try_pipe(s, mf_IN)->file;
2489: return gp_main_loop(0);
2490: }
2491:
2492: static int
1.2 ! noro 2493: silent(void)
1.1 noro 2494: {
2495: if (gpsilent) return 1;
1.2 ! noro 2496: { char c = get_analyseur()[1]; return separe(c); }
1.1 noro 2497: }
2498:
2499: GEN
2500: default0(char *a, char *b, long flag)
2501: {
1.2 ! noro 2502: return setdefault(a,b, flag? d_RETURN
! 2503: : silent()? d_SILENT: d_ACKNOWLEDGE);
1.1 noro 2504: }
2505:
2506: GEN
1.2 ! noro 2507: input0(void)
1.1 noro 2508: {
2509: Buffer *b = new_buffer();
1.2 ! noro 2510: filtre_t F;
1.1 noro 2511: GEN x;
2512:
1.2 ! noro 2513: init_filtre(&F, (void*)b);
1.1 noro 2514: push_stack(&bufstack, (void*)b);
1.2 ! noro 2515: while (! get_line_from_file(DFT_INPROMPT,&F,infile))
1.1 noro 2516: if (popinfile()) { fprintferr("no input ???"); gp_quit(); }
2517: x = lisseq(b->buf);
2518: pop_buffer(); return x;
2519: }
2520:
2521: void
2522: system0(char *s)
2523: {
2524: #if defined(UNIX) || defined(__EMX__)
2525: check_secure(s);
2526: system(s);
2527: #else
2528: err(archer);
2529: #endif
2530: }
2531:
2532: int
2533: break_loop(long numerr)
2534: {
2535: static FILE *oldinfile = NULL;
2536: static char *old = NULL;
2537: static Buffer *b = NULL;
1.2 ! noro 2538: int go_on = 0;
1.1 noro 2539: char *s, *t, *msg;
1.2 ! noro 2540: filtre_t F;
1.1 noro 2541:
2542: if (b) jump_to_given_buffer(b);
2543: push_stack(&bufstack, (void*)new_buffer());
2544: b = current_buffer; /* buffer created above */
2545: if (setjmp(b->env))
2546: {
2547: msg = "back to break loop";
2548: s = t = NULL;
2549: }
2550: else
2551: {
2552: msg = "Starting break loop (type 'break' to go back to GP)";
1.2 ! noro 2553: old = s = get_analyseur();
! 2554: t = NULL;
! 2555: if (bufstack->prev)
! 2556: {
! 2557: Buffer *oldb = (Buffer*)bufstack->prev->value;
! 2558: t = oldb->buf;
! 2559: /* something fishy, probably a ^C, or we overran analyseur */
! 2560: if (!s || !s[-1] || s < t || s >= t + oldb->len) s = NULL;
! 2561: }
1.1 noro 2562: b->flenv = 1; oldinfile = infile;
2563: }
1.2 ! noro 2564: init_filtre(&F, (void*)b);
1.1 noro 2565:
2566: term_color(c_ERR); pariputc('\n');
2567: errcontext(msg, s, t); if (s) pariputc('\n');
2568: term_color(c_NONE);
2569: if (numerr == siginter) pariputs("['' or 'next' will continue]\n");
2570: infile = stdin;
2571: for(;;)
2572: {
1.2 ! noro 2573: GEN x;
! 2574: if (! read_line(&F, BREAK_LOOP_PROMPT)) break;
! 2575: if (check_meta(b->buf))
! 2576: { /* break loop initiated by ^C? Empty input --> continue computation */
! 2577: if (numerr == siginter && *(b->buf) == 0) { handle_C_C=go_on=1; break; }
! 2578: continue;
! 2579: }
! 2580: x = lisseq(b->buf);
! 2581: if (did_break())
1.1 noro 2582: {
1.2 ! noro 2583: if (numerr == siginter && did_break() == br_NEXT)
1.1 noro 2584: {
1.2 ! noro 2585: (void)loop_break(); /* clear status flag */
! 2586: go_on = 1;
1.1 noro 2587: }
1.2 ! noro 2588: break;
! 2589: }
! 2590: if (x == gnil || is_silent(b->buf)) continue;
1.1 noro 2591:
1.2 ! noro 2592: term_color(c_OUTPUT); gen_output(x, GP_DATA->fmt);
! 2593: term_color(c_NONE); pariputc('\n');
1.1 noro 2594: }
1.2 ! noro 2595: if (old && !s) set_analyseur(old);
1.1 noro 2596: b = NULL; infile = oldinfile;
2597: pop_buffer(); return go_on;
2598: }
2599:
2600: int
2601: gp_exception_handler(long numerr)
2602: {
2603: char *s = (char*)global_err_data;
2604: if (s && *s) { fprintferr("\n"); outerr(lisseq(s)); }
2605: else
2606: {
2607: if (numerr == errpile) avma = top;
2608: return break_loop(numerr);
2609: }
2610: return 0;
2611: }
2612:
2613: static void
1.2 ! noro 2614: testuint(char *s, ulong *d) { if (s) *d = get_uint(s); }
1.1 noro 2615:
2616: static char *
2617: read_arg(int *nread, char *t, long argc, char **argv)
2618: {
2619: int i = *nread;
2620: if (isdigit((int)*t)) return t;
2621: if (*t || i==argc) usage(argv[0]);
2622: *nread = i+1; return argv[i];
2623: }
2624:
2625: static char**
2626: read_opt(long argc, char **argv)
2627: {
2628: char *b=NULL, *p=NULL, *s=NULL, **pre;
2629: int i=1, initrc=1;
2630:
2631: pari_outfile=stderr;
2632: while (i<argc)
2633: {
2634: char *t = argv[i++];
2635:
2636: if (*t++ != '-') usage(argv[0]);
2637: switch(*t++)
2638: {
2639: case 'b': b = read_arg(&i,t,argc,argv); break;
2640: case 'p': p = read_arg(&i,t,argc,argv); break;
2641: case 's': s = read_arg(&i,t,argc,argv); break;
2642:
2643: case 'e':
2644: if (strncmp(t,"macs",4)) usage(argv[0]);
1.2 ! noro 2645: GP_DATA->flags |= EMACS; break;
1.1 noro 2646: case 'q':
1.2 ! noro 2647: GP_DATA->flags |= QUIET; break;
1.1 noro 2648: case 't':
2649: if (strncmp(t,"est",3)) usage(argv[0]);
1.2 ! noro 2650: disable_color = 1; GP_DATA->flags |= TEST; /* fall through */
1.1 noro 2651: case 'f':
2652: initrc = 0; break;
2653: case '-':
2654: if (strcmp(t, "version") == 0) { print_version(); exit(0); }
1.2 ! noro 2655: if (strcmp(t, "texmacs") == 0) { GP_DATA->flags |= TEXMACS; break; }
1.1 noro 2656: /* fall through */
2657: default:
2658: usage(argv[0]);
2659: }
2660: }
1.2 ! noro 2661: if (GP_DATA->flags & TEXMACS) tm_start_output();
1.1 noro 2662: pre = initrc? gp_initrc(): NULL;
2663:
2664: /* override the values from gprc */
1.2 ! noro 2665: testuint(b, &paribufsize); if (paribufsize < 10) paribufsize = 10;
! 2666: testuint(p, &primelimit);
! 2667: testuint(s, (ulong*)&top);
! 2668: if (GP_DATA->flags & (EMACS|TEXMACS)) disable_color = 1;
! 2669: pari_outfile = stdout; return pre;
1.1 noro 2670: }
2671:
2672: #ifdef WINCE
2673: int
2674: WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance,
2675: LPWSTR lpCmdLine, int nShowCmd)
2676: {
2677: char **argv = NULL;
2678: int argc = 1;
2679: #else
2680: int
2681: main(int argc, char **argv)
2682: {
2683: #endif
2684: char **flist;
2685:
1.2 ! noro 2686: init_defaults(1); gp_preinit();
1.1 noro 2687: if (setjmp(environnement))
2688: {
2689: pariputs("### Errors on startup, exiting...\n\n");
2690: exit(1);
2691: }
2692: #ifdef __MWERKS__
2693: argc = ccommand(&argv);
2694: #endif
2695: flist = read_opt(argc,argv);
2696: pari_addfunctions(&pari_modules, functions_gp,helpmessages_gp);
2697: pari_addfunctions(&pari_modules, functions_highlevel,helpmessages_highlevel);
2698: pari_addfunctions(&pari_oldmodules, functions_oldgp,helpmessages_oldgp);
2699:
1.2 ! noro 2700: init_graph();
! 2701: INIT_SIG_off;
! 2702: pari_init(top-bot, primelimit);
1.1 noro 2703: INIT_SIG_on;
2704: pari_sig_init(gp_sighandler);
2705: #ifdef READLINE
1.2 ! noro 2706: if (GP_DATA->flags & USE_READLINE) {
! 2707: init_readline();
! 2708: readline_init = 1;
1.1 noro 2709: }
2710: #endif
2711: whatnow_fun = whatnow;
2712: default_exception_handler = gp_exception_handler;
1.2 ! noro 2713: gp_expand_path(GP_DATA->path);
1.1 noro 2714:
1.2 ! noro 2715: if (!(GP_DATA->flags & QUIET)) gp_head();
1.1 noro 2716: if (flist)
2717: {
1.2 ! noro 2718: ulong f = GP_DATA->flags;
! 2719: FILE *l = logfile;
1.1 noro 2720: char **s = flist;
1.2 ! noro 2721: GP_DATA->flags &= ~(CHRONO|ECHO); logfile = NULL;
1.1 noro 2722: for ( ; *s; s++) { read0(*s); free(*s); }
1.2 ! noro 2723: GP_DATA->flags = f; logfile = l; free(flist);
1.1 noro 2724: }
1.2 ! noro 2725: TIMERstart(GP_DATA->T); (void)timer(); (void)timer2();
1.1 noro 2726: (void)gp_main_loop(1);
2727: gp_quit(); return 0; /* not reached */
2728: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to gp.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / pari-2.2 / src / gp