Annotation of OpenXM_contrib/pari/src/gp/gp.c, Revision 1.1.1.1
1.1 maekawa 1: /*******************************************************************/
2: /** **/
3: /** PARI CALCULATOR **/
4: /** **/
5: /*******************************************************************/
6: /* $Id: gp.c,v 1.1.1.1 1999/09/16 13:47:41 karim Exp $ */
7: #include "pari.h"
8: #ifdef _WIN32
9: # include <windows.h>
10: # ifndef WINCE
11: # include <process.h>
12: # endif
13: #endif
14: #ifdef HAS_STRFTIME
15: # include <time.h>
16: #endif
17: #include "../language/anal.h"
18: #include "gp.h"
19:
20: #ifdef READLINE
21: void init_readline();
22: BEGINEXTERN
23: # if defined(__cplusplus) && defined(__SUNPRO_CC)
24: /* readline.h gives a bad definition of readline() */
25: extern char*readline(char*);
26: # else
27: # ifdef READLINE_LIBRARY
28: # include <readline.h>
29: # else
30: # include <readline/readline.h>
31: # endif
32: # endif
33: extern int isatty(int);
34: extern void add_history(char*);
35: ENDEXTERN
36: #endif
37:
38: char* _analyseur(void);
39: void err_recover(long numerr);
40: void free_graph(void);
41: void gp_expand_path(char *v);
42: int gp_init_entrees(module *modlist, entree **hash, int force);
43: long gptimer(void);
44: void init80(long n);
45: void init_defaults(int force);
46: void init_graph(void);
47: void init_lim_lines(char *s, long max);
48: void pari_sig_init(void (*f)(int));
49: int whatnow(char *s, int flag);
50:
51: #define MAX_PROMPT_LEN 128
52: #define DFT_PROMPT "? "
53: #define COMMENTPROMPT "comment> "
54: #define DFT_INPROMPT ""
55: static GEN *hist;
56: static jmp_buf local_environnement[MAX_BUFFER];
57: static char *help_prg,*path,*buflist[MAX_BUFFER];
58: static char prompt[MAX_PROMPT_LEN];
59: static char thestring[256];
60: static long prettyp, test_mode, quiet_mode, gpsilent, simplifyflag;
61: static long secure;
62: static long chrono, pariecho, primelimit, parisize, strictmatch;
63: static long bufindex, tglobal, histsize, paribufsize, lim_lines;
64: static gp_format fmt;
65:
66: #define LBRACE '{'
67: #define RBRACE '}'
68: #define pariputs_opt(s) if (!quiet_mode) pariputs(s)
69:
70: void
71: hit_return()
72: {
73: char tmp[16];
74: pariputs("---- (type return to continue) ----");
75: do fgets(tmp,16,stdin); while (tmp[strlen(tmp)-1] != '\n');
76: /* \n has to be echoed later if we are under emacs (E. Kowalski) */
77: pariputc('\n');
78: }
79:
80: static void
81: usage(char *s)
82: {
83: printf("### Usage: %s [options]\n", s);
84: printf("Options are:\n");
85: printf("\t[-b buffersize]\tDeprecated\n");
86: printf("\t[-emacs]\tRun as if in Emacs shell\n");
87: printf("\t[-f]\t\tFaststart: do not read .gprc\n");
88: printf("\t[--help]\tPrint this message\n");
89: printf("\t[-q]\t\tQuiet mode: do not print banner and history numbers\n");
90: printf("\t[-p primelimit]\tPrecalculate primes up to the limit\n");
91: printf("\t[-s stacksize]\tStart with the PARI stack of given size (in bytes)\n");
92: printf("\t[-test]\t\tTest mode. As -q, plus wrap long lines\n");
93: printf("\t[--version]\tOutput version info and exit\n\n");
94: exit(0);
95: }
96:
97: /* must be called BEFORE pari_init() */
98: static void
99: gp_preinit(int force)
100: {
101: static char *dflt;
102: char *help;
103: long i;
104:
105: if (force)
106: {
107: #if !defined(macintosh) || defined(__MWERKS__)
108: primelimit = 500000; parisize = 1000000*sizeof(long);
109: dflt = DFT_PROMPT;
110: #else
111: primelimit = 200000; parisize = 1000000;
112: dflt = "?\n";
113: #endif
114: }
115: strcpy(prompt, dflt);
116:
117: #if defined(UNIX) || defined(__EMX__)
118: # ifdef __EMX__
119: path = pari_strdup(".;C:/;C:/gp");
120: # else
121: path = pari_strdup(".:~:~/gp");
122: # endif
123: help = getenv("GPHELP");
124: # ifdef GPHELP
125: if (!help) help = GPHELP;
126: # endif
127: #else
128: path = pari_strdup(".");
129: help = NULL;
130: #endif
131: help_prg = help? pari_strdup(help): NULL;
132: prettyp = f_PRETTYMAT;
133: strictmatch = simplifyflag = 1;
134: tglobal = 0;
135: bufindex = -1;
136: secure = test_mode = under_emacs = chrono = pariecho = 0;
137: fmt.format = 'g'; fmt.field = 0;
138: #ifdef LONG_IS_64BIT
139: fmt.nb = 38;
140: #else
141: fmt.nb = 28;
142: #endif
143: lim_lines = 0;
144: histsize = 5000; paribufsize = 1024;
145: i = histsize*sizeof(GEN);
146: hist = (GEN *) gpmalloc(i); memset(hist,0,i);
147: for (i=0; i<c_LAST; i++) gp_colors[i] = c_NONE;
148: }
149:
150: #define GET_SEP_SIZE 128
151: #define separe(c) ((c)==';' || (c)==':')
152:
153: /* Return all chars, up to next separator */
154: static char*
155: get_sep(char *t)
156: {
157: static char buf[GET_SEP_SIZE], *lim = buf + GET_SEP_SIZE-1;
158: char *s = buf;
159: int outer=1;
160:
161: for(;;)
162: {
163: switch(*s++ = *t++)
164: {
165: case '"':
166: if (outer || s[-2] != '\\') outer = !outer;
167: break;
168: case '\0':
169: return buf;
170: default:
171: if (outer && separe(*t)) { *s=0; return buf; }
172: }
173: if (s == lim) err(talker,"buffer overflow in get_sep");
174: }
175: }
176:
177: /* as above, t must be writeable, return 1 if we modified t */
178: static int
179: get_sep2(char *t)
180: {
181: int outer=1;
182: char *s = t;
183:
184: for(;;)
185: {
186: switch (*s++)
187: {
188: case '"':
189: if (outer || s[-2] != '\\') outer = !outer;
190: break;
191: case '\0':
192: return 0;
193: default:
194: if (outer && separe(*s)) { *s=0; return 1; }
195: }
196: }
197: }
198:
199: static long
200: get_int(char *s, long dflt)
201: {
202: char *p=get_sep(s);
203: long n=atol(p);
204:
205: if (*p == '-') p++;
206: while(isdigit((int)*p)) { p++; dflt=n; }
207: if (*p) err(talker2,"I was expecting an integer here", s, s);
208: return dflt;
209: }
210:
211: static void
212: gp_output(GEN x)
213: {
214: long tx=typ(x);
215:
216: if (fmt.nb >= 0 && is_intreal_t(tx))
217: ecrire(x, fmt.format, fmt.nb, fmt.field);
218: else
219: switch(prettyp)
220: {
221: case f_PRETTYMAT: matbrute(x, fmt.format, fmt.nb); break;
222: case f_PRETTY : sor(x, fmt.format, fmt.nb, fmt.field); break;
223: case f_RAW : brute(x, fmt.format, fmt.nb); break;
224: case f_TEX : texe(x, fmt.format, fmt.nb); break;
225: }
226: }
227:
228: /* print a sequence of (NULL terminated) GEN */
229: void
230: print0(GEN *g, long flag)
231: {
232: int old=prettyp;
233:
234: if (flag < NBFORMATS) added_newline=1;
235: else
236: { flag -= NBFORMATS; added_newline=0; }
237: prettyp=flag;
238:
239: for( ; *g; g++)
240: if (typ(*g)==t_STR)
241: pariputs(GSTR(*g)); /* otherwise it's surrounded by "" */
242: else
243: gp_output(*g);
244:
245: if (added_newline) pariputc('\n');
246: prettyp=old; pariflush();
247: }
248:
249: /* write a sequence of (NULL terminated) GEN, to file s */
250: void
251: write0(char *s, GEN *g, long flag)
252: {
253: int i = added_newline;
254: s = expand_tilde(s); switchout(s); free(s);
255: print0(g,flag); added_newline = i;
256: switchout(NULL);
257: }
258:
259: /********************************************************************/
260: /* */
261: /* DEFAULTS */
262: /* */
263: /********************************************************************/
264: static void
265: do_strftime(char *s, char *buf)
266: {
267: #ifdef HAS_STRFTIME
268: time_t t = time(NULL);
269: strftime(buf,MAX_PROMPT_LEN-1,s,localtime(&t));
270: #else
271: strcpy(buf,s);
272: #endif
273: }
274:
275: static GEN
276: sd_numeric(char *v, int flag, char *s, long *ptn, long Min, long Max,
277: char **msg)
278: {
279: long n;
280: if (*v == 0) n = *ptn;
281: else
282: {
283: n = get_int(v,0);
284: if (*ptn == n) return gnil;
285: if (n > Max || n < Min)
286: {
287: sprintf(thestring, "default: incorrect value for %s [%ld-%ld]",
288: s, Min, Max);
289: err(talker2, thestring, v,v);
290: }
291: *ptn = n;
292: }
293: switch(flag)
294: {
295: case d_RETURN: return stoi(n);
296: case d_ACKNOWLEDGE:
297: if (msg)
298: {
299: if (!*msg)
300: msg++; /* single msg, always printed */
301: else
302: msg += n; /* one per possible value */
303: pariputsf(" %s = %ld %s\n", s, n, *msg);
304: }
305: else if (Max != 1 || Min != 0)
306: pariputsf(" %s = %ld\n", s, n);
307: else /* toggle */
308: {
309: if (n==1) pariputsf(" %s = 1 (on)\n", s);
310: else pariputsf(" %s = 0 (off)\n", s);
311: } /* fall through */
312: default: return gnil;
313: }
314: }
315:
316: #define PRECDIGIT (long)((prec-2.)*pariK)
317: static GEN
318: sd_realprecision(char *v, int flag)
319: {
320: if (*v)
321: {
322: long newnb = get_int(v, fmt.nb);
323: long newprec = (long) (newnb*pariK1 + 3);
324:
325: if (fmt.nb == newnb && prec == newprec) return gnil;
326: if (newnb < 0) err(talker,"default: negative real precision");
327: fmt.nb = newnb; prec = newprec;
328: }
329: if (flag == d_RETURN) return stoi(fmt.nb);
330: if (flag == d_ACKNOWLEDGE)
331: {
332: long n = PRECDIGIT;
333: pariputsf(" realprecision = %ld significant digits", n);
334: if (n != fmt.nb) pariputsf(" (%ld digits displayed)", fmt.nb);
335: pariputc('\n');
336: }
337: return gnil;
338: }
339: #undef PRECDIGIT
340:
341: static GEN
342: sd_seriesprecision(char *v, int flag)
343: {
344: char *msg[] = {NULL, "significant terms"};
345: return sd_numeric(v,flag,"seriesprecision",&precdl, 0,LGBITS,msg);
346: }
347:
348: static GEN
349: sd_format(char *v, int flag)
350: {
351: if (*v)
352: {
353: char c = *v;
354: if (c!='e' && c!='f' && c!='g')
355: err(talker2,"default: inexistent format",v,v);
356: fmt.format = c; v++;
357:
358: if (isdigit((int)*v))
359: { fmt.field=atol(v); while (isdigit((int)*v)) v++; }
360: if (*v++ == '.')
361: {
362: if (*v == '-') fmt.nb = -1;
363: else
364: if (isdigit((int)*v)) fmt.nb=atol(v);
365: }
366: }
367: if (flag == d_RETURN)
368: {
369: sprintf(thestring, "%c%ld.%ld", fmt.format, fmt.field, fmt.nb);
370: return strtoGENstr(thestring,0);
371: }
372: if (flag == d_ACKNOWLEDGE)
373: pariputsf(" format = %c%ld.%ld\n", fmt.format, fmt.field, fmt.nb);
374: return gnil;
375: }
376:
377: static long
378: gp_get_color(char **st)
379: {
380: char *s, *v = *st;
381: int c, trans = 1;
382: if (!isdigit((int)*v))
383: {
384: if (*v == '[')
385: {
386: char *a[3];
387: int i = 0;
388: for (a[0] = s = ++v; *s && *s != ']'; s++)
389: if (*s == ',') { *s = 0; a[++i] = s+1; }
390: if (*s != ']') err(talker2,"expected character: ']'",s, *st);
391: *s = 0; for (i++; i<3; i++) a[i] = "";
392: /* properties | color | background */
393: c = (atoi(a[2])<<8) | atoi(a[0]) | (atoi(a[1])<<4);
394: trans = (*(a[1]) == 0);
395: v = s + 1;
396: }
397: else { c = c_NONE; trans = 0; }
398: }
399: else c = atol(v); /* color on transparent background */
400: if (trans) c = -c;
401: while (*v && *v++ != ',') /* empty */;
402: if (c != c_NONE) disable_color=0;
403: *st = v; return c;
404: }
405:
406: static GEN
407: sd_colors(char *v, int flag)
408: {
409: long c,l;
410: if (*v && !under_emacs)
411: {
412: char *tmp;
413: disable_color=1;
414: l = strlen(v);
415: if (l <= 2 && strncmp(v, "no", l) == 0)
416: v = "";
417: if (l <= 3 && strncmp(v, "yes", l) == 0)
418: v = "1, 5, 3, 7, 6, 2, 3"; /* Assume recent ReadLine. */
419: tmp = v = pari_strdup(v); filtre(v, f_INIT|f_REG);
420: for (c=c_ERR; c < c_LAST; c++)
421: gp_colors[c] = gp_get_color(&v);
422: free(tmp);
423: }
424: if (flag == d_ACKNOWLEDGE || flag == d_RETURN)
425: {
426: char *s = thestring;
427: int col[3], n;
428: for (*s=0,c=c_ERR; c < c_LAST; c++)
429: {
430: n = gp_colors[c];
431: if (n == c_NONE)
432: sprintf(s,"no");
433: else
434: {
435: decode_color(abs(n),col);
436: if (n < 0)
437: {
438: if (col[0])
439: sprintf(s,"[%d,,%d]",col[1],col[0]);
440: else
441: sprintf(s,"%d",col[1]);
442: }
443: else
444: sprintf(s,"[%d,%d,%d]",col[1],col[2],col[0]);
445: }
446: s += strlen(s);
447: if (c < c_LAST - 1) { *s++=','; *s++=' '; }
448: }
449: if (flag==d_RETURN) return strtoGENstr(thestring,0);
450: pariputsf(" colors = \"%s\"\n",thestring);
451: }
452: return gnil;
453: }
454:
455: static GEN
456: sd_compatible(char *v, int flag)
457: {
458: char *msg[] = {
459: "(no backward compatibility)",
460: "(warn when using obsolete functions)",
461: "(use old functions, don't ignore case)",
462: "(use old functions, ignore case)", NULL
463: };
464: long old = compatible;
465: GEN r = sd_numeric(v,flag,"compatible",&compatible, 0,3,msg);
466:
467: if (old != compatible && flag != d_INITRC)
468: {
469: int res = gp_init_entrees(new_fun_set? pari_modules: pari_oldmodules,
470: functions_hash, 0);
471: if (res) err(warner,"user functions re-initialized");
472: }
473: return r;
474: }
475:
476: static GEN
477: sd_secure(char *v, int flag)
478: {
479: if (secure)
480: {
481: fprintferr("Do you want to modify the 'secure' flag? (^C if not)\n");
482: hit_return();
483: }
484: return sd_numeric(v,flag,"secure",&secure, 0,1,NULL);
485: }
486:
487: static GEN
488: sd_buffersize(char *v, int flag)
489: { return sd_numeric(v,flag,"buffersize",&paribufsize, 0,
490: (VERYBIGINT / sizeof(long)) - 1,NULL); }
491: static GEN
492: sd_debug(char *v, int flag)
493: { return sd_numeric(v,flag,"debug",&DEBUGLEVEL, 0,20,NULL); }
494:
495: static GEN
496: sd_debugfiles(char *v, int flag)
497: { return sd_numeric(v,flag,"debugfiles",&DEBUGFILES, 0,20,NULL); }
498:
499: static GEN
500: sd_debugmem(char *v, int flag)
501: { return sd_numeric(v,flag,"debugmem",&DEBUGMEM, 0,20,NULL); }
502:
503: static GEN
504: sd_echo(char *v, int flag)
505: { return sd_numeric(v,flag,"echo",&pariecho, 0,1,NULL); }
506:
507: static GEN
508: sd_lines(char *v, int flag)
509: { return sd_numeric(v,flag,"lines",&lim_lines, 0,VERYBIGINT,NULL); }
510:
511: static GEN
512: sd_histsize(char *v, int flag)
513: {
514: long n = histsize;
515: GEN r = sd_numeric(v,flag,"histsize",&n, 1,
516: (VERYBIGINT / sizeof(long)) - 1,NULL);
517: if (n != histsize)
518: {
519: long i = n*sizeof(GEN);
520: GEN *gg = (GEN *) gpmalloc(i); memset(gg,0,i);
521:
522: if (tglobal)
523: {
524: long k = (tglobal-1) % n;
525: long kmin = k - min(n,histsize), j = k;
526:
527: i = (tglobal-1) % histsize;
528: while (k > kmin)
529: {
530: gg[j] = hist[i];
531: hist[i] = NULL;
532: if (!i) i = histsize;
533: if (!j) j = n;
534: i--; j--; k--;
535: }
536: while (hist[i])
537: {
538: gunclone(hist[i]);
539: if (!i) i = histsize;
540: i--;
541: }
542: }
543: free((void*)hist); hist=gg; histsize=n;
544: }
545: return r;
546: }
547:
548: static GEN
549: sd_log(char *v, int flag)
550: {
551: long vlog = logfile? 1: 0, old = vlog;
552: GEN r = sd_numeric(v,flag,"log",&vlog, 0,1,NULL);
553: if (vlog != old)
554: {
555: if (vlog)
556: {
557: logfile = fopen(current_logfile, "a");
558: if (!logfile) err(openfiler,"logfile",current_logfile);
559: #ifndef WINCE
560: setbuf(logfile,(char *)NULL);
561: #endif
562: }
563: else
564: {
565: if (flag == d_ACKNOWLEDGE)
566: pariputsf(" [logfile was \"%s\"]\n", current_logfile);
567: fclose(logfile); logfile=NULL;
568: }
569: }
570: return r;
571: }
572:
573: static GEN
574: sd_output(char *v, int flag)
575: {
576: char *msg[] = {"(raw)", "(prettymatrix)", "(prettyprint)", NULL};
577: return sd_numeric(v,flag,"output",&prettyp, 0,2,msg);
578: }
579:
580: static GEN
581: sd_parisize(char *v, int flag)
582: {
583: long n = parisize;
584: GEN r = sd_numeric(v,flag,"parisize",&n, 10000,VERYBIGINT,NULL);
585: if (n != parisize)
586: {
587: if (flag != d_INITRC)
588: {
589: parisize = allocatemoremem(n);
590: longjmp(local_environnement[bufindex], 0);
591: }
592: parisize = n;
593: }
594: return r;
595: }
596:
597: static GEN
598: sd_primelimit(char *v, int flag)
599: {
600: long n = primelimit;
601: GEN r = sd_numeric(v,flag,"primelimit",&n, 0,VERYBIGINT,NULL);
602: if (n != primelimit)
603: {
604: if (flag != d_INITRC)
605: {
606: byteptr ptr = initprimes(n);
607: free(diffptr); diffptr = ptr;
608: }
609: primelimit = n;
610: }
611: return r;
612: }
613:
614: static GEN
615: sd_simplify(char *v, int flag)
616: { return sd_numeric(v,flag,"simplify",&simplifyflag, 0,1,NULL); }
617:
618: static GEN
619: sd_strictmatch(char *v, int flag)
620: { return sd_numeric(v,flag,"strictmatch",&strictmatch, 0,1,NULL); }
621:
622: static GEN
623: sd_timer(char *v, int flag)
624: { return sd_numeric(v,flag,"timer",&chrono, 0,1,NULL); }
625:
626: static GEN
627: sd_filename(char *v, int flag, char *s, char **f)
628: {
629: if (*v)
630: {
631: char *old = *f;
632: v = expand_tilde(v);
633: do_strftime(v,thestring); free(v);
634: *f = pari_strdup(thestring); free(old);
635: }
636: if (flag == d_RETURN) return strtoGENstr(*f,0);
637: if (flag == d_ACKNOWLEDGE) pariputsf(" %s = \"%s\"\n",s,*f);
638: return gnil;
639: }
640:
641: static GEN
642: sd_logfile(char *v, int flag)
643: {
644: GEN r = sd_filename(v, flag, "logfile", ¤t_logfile);
645: if (*v && logfile)
646: {
647: fclose(logfile);
648: logfile = fopen(current_logfile, "a");
649: if (!logfile) err(openfiler,"logfile",current_logfile);
650: #ifndef WINCE
651: setbuf(logfile,(char *)NULL);
652: #endif
653: }
654: return r;
655: }
656:
657: static GEN
658: sd_psfile(char *v, int flag)
659: { return sd_filename(v, flag, "psfile", ¤t_psfile); }
660:
661: static GEN
662: sd_help(char *v, int flag)
663: {
664: char *str;
665: if (*v)
666: {
667: if (help_prg) free(help_prg);
668: help_prg = expand_tilde(v);
669: }
670: str = help_prg? help_prg: "none";
671: if (flag == d_RETURN) return strtoGENstr(str,0);
672: if (flag == d_ACKNOWLEDGE)
673: pariputsf(" help = \"%s\"\n", str);
674: return gnil;
675: }
676:
677: static GEN
678: sd_path(char *v, int flag)
679: {
680: if (*v)
681: {
682: char *old = path;
683: path = pari_strdup(v); free(old);
684: if (flag == d_INITRC) return gnil;
685: gp_expand_path(path);
686: }
687: if (flag == d_RETURN) return strtoGENstr(path,0);
688: if (flag == d_ACKNOWLEDGE)
689: pariputsf(" path = \"%s\"\n",path);
690: return gnil;
691: }
692:
693: static GEN
694: sd_prompt(char *v, int flag)
695: {
696: if (*v)
697: {
698: strncpy(prompt,v,MAX_PROMPT_LEN);
699: #ifdef macintosh
700: strcat(prompt,"\n");
701: #endif
702: }
703: if (flag == d_RETURN) return strtoGENstr(prompt,0);
704: if (flag == d_ACKNOWLEDGE)
705: pariputsf(" prompt = \"%s\"\n",prompt);
706: return gnil;
707: }
708:
709: default_type gp_default_list[] =
710: {
711: {"buffersize",(void*)sd_buffersize},
712: {"colors",(void*)sd_colors},
713: {"compatible",(void*)sd_compatible},
714: {"debug",(void*)sd_debug},
715: {"debugfiles",(void*)sd_debugfiles},
716: {"debugmem",(void*)sd_debugmem},
717: {"echo",(void*)sd_echo},
718: {"format",(void*)sd_format},
719: {"help",(void*)sd_help},
720: {"histsize",(void*)sd_histsize},
721: {"lines",(void*)sd_lines},
722: {"log",(void*)sd_log},
723: {"logfile",(void*)sd_logfile},
724: {"output",(void*)sd_output},
725: {"parisize",(void*)sd_parisize},
726: {"path",(void*)sd_path},
727: {"primelimit",(void*)sd_primelimit},
728: {"prompt",(void*)sd_prompt},
729: {"psfile",(void*)sd_psfile},
730: {"realprecision",(void*)sd_realprecision},
731: {"secure",(void*)sd_secure},
732: {"seriesprecision",(void*)sd_seriesprecision},
733: {"simplify",(void*)sd_simplify},
734: {"strictmatch",(void*)sd_strictmatch},
735: {"timer",(void *)sd_timer},
736: {NULL,NULL} /* sentinel */
737: };
738:
739: static void
740: help_default()
741: {
742: default_type *dft;
743:
744: for (dft=gp_default_list; dft->fun; dft++)
745: ((void (*)(ANYARG)) dft->fun)("", d_ACKNOWLEDGE);
746: }
747:
748: static GEN
749: setdefault(char *s,char *v, int flag)
750: {
751: default_type *dft;
752:
753: if (!*s) { help_default(); return gnil; }
754: for (dft=gp_default_list; dft->fun; dft++)
755: if (!strcmp(s,dft->name))
756: {
757: if (flag == d_EXISTS) return gun;
758: return ((GEN (*)(ANYARG)) dft->fun)(v,flag);
759: }
760: if (flag == d_EXISTS) return gzero;
761: err(talker,"unknown default: %s",s);
762: return NULL; /* not reached */
763: }
764:
765: /********************************************************************/
766: /** **/
767: /** HELP **/
768: /** **/
769: /********************************************************************/
770: static int
771: has_ext_help()
772: {
773: if (help_prg)
774: {
775: char *buf = pari_strdup(help_prg), *s = buf;
776: FILE *file;
777:
778: while (*s && *s != ' ') s++;
779: *s = 0; file = (FILE *) fopen(buf,"r");
780: if (file) { fclose(file); return 1; }
781: free(buf);
782: }
783: return 0;
784: }
785:
786: static int
787: compare_str(char **s1, char **s2) { return strcmp(*s1, *s2); }
788:
789: /* Print all elements of list in columns, pausing every nbli lines
790: * if nbli is non-zero.
791: * list is a NULL terminated list of function names
792: */
793: void
794: print_fun_list(char **list, int nbli)
795: {
796: long i=0, j=0, maxlen=0, nbcol,len, w = term_width();
797: char **l;
798:
799: while (list[i]) i++;
800: qsort (list, i, sizeof(char *), (QSCOMP)compare_str);
801:
802: for (l=list; *l; l++)
803: {
804: len = strlen(*l);
805: if (len > maxlen) maxlen=len;
806: }
807: maxlen++; nbcol= w / maxlen;
808: if (nbcol * maxlen == w) nbcol--;
809: if (!nbcol) nbcol = 1;
810:
811: pariputc('\n'); i=0;
812: for (l=list; *l; l++)
813: {
814: pariputs(*l); i++;
815: if (i >= nbcol)
816: {
817: i=0; pariputc('\n');
818: if (nbli && j++ > nbli) { j = 0; hit_return(); }
819: continue;
820: }
821: len = maxlen - strlen(*l);
822: while (len--) pariputc(' ');
823: }
824: if (i) pariputc('\n');
825: }
826:
827: #define LIST_LEN 1023
828: static void
829: commands(int n)
830: {
831: int hashpos, s = 0, olds = LIST_LEN;
832: entree *ep;
833: char **list = (char **) gpmalloc((olds+1)*sizeof(char *));
834:
835: for (hashpos = 0; hashpos < functions_tblsz; hashpos++)
836: for (ep = functions_hash[hashpos]; ep; ep = ep->next)
837: if ((n<0 && ep->menu) || ep->menu == n)
838: {
839: list[s++] = ep->name;
840: if (s >= olds)
841: {
842: int news = olds + (LIST_LEN + 1)*sizeof(char *);
843: list = (char**) gprealloc(list,news,olds);
844: olds = news;
845: }
846: }
847: list[s]=NULL; print_fun_list(list,term_height()-4); free(list);
848: }
849:
850: static void
851: print_user_fun(entree *ep)
852: {
853: gp_args *f= (gp_args*)ep->args;
854: GEN q = (GEN)ep->value, *arg = f->arg;
855: int i, narg;
856:
857:
858: q++; /* skip initial NULL */
859: pariputs(ep->name); pariputc('(');
860: narg = f->narg;
861: for (i=1; i<=narg; i++, arg++)
862: {
863: entree *ep = varentries[*q++];
864: pariputs(ep? ep->name:"#");
865: if (!gcmp0(*arg)) { pariputc('='); bruteall(*arg,'g',-1,1); }
866: if (i == narg) { arg++; break; }
867: pariputs(", ");
868: }
869: pariputs(") = ");
870: narg = f->nloc;
871: if (narg)
872: {
873: pariputs("local(");
874: for (i=1; i<=narg; i++, arg++)
875: {
876: entree *ep = varentries[*q++];
877: pariputs(ep? ep->name:"#");
878: if (!gcmp0(*arg)) { pariputc('='); bruteall(*arg,'g',-1,1); }
879: if (i == narg) break;
880: pariputs(", ");
881: }
882: pariputs("); ");
883: }
884: pariputs((char*)q);
885: }
886:
887: static void
888: print_user_member(entree *ep)
889: {
890: GEN q = (GEN)ep->value;
891: entree *ep2;
892:
893: q++; /* skip initial NULL */
894: ep2 = varentries[*q++];
895: pariputs(ep2? ep2->name:"#");
896: pariputsf(".%s = ", ep->name);
897: pariputs((char*)q);
898: }
899:
900: static void
901: user_fun()
902: {
903: entree *ep;
904: int hash;
905:
906: for (hash = 0; hash < functions_tblsz; hash++)
907: for (ep = functions_hash[hash]; ep; ep = ep->next)
908: if (EpVALENCE(ep) == EpUSER)
909: {
910: pariputc(LBRACE); print_user_fun(ep);
911: pariputc(RBRACE); pariputs("\n\n");
912: }
913: }
914:
915: static void
916: user_member()
917: {
918: entree *ep;
919: int hash;
920:
921: for (hash = 0; hash < functions_tblsz; hash++)
922: for (ep = members_hash[hash]; ep; ep = ep->next)
923: if (EpVALENCE(ep) == EpMEMBER)
924: {
925: pariputc(LBRACE); print_user_member(ep);
926: pariputc(RBRACE); pariputs("\n\n");
927: }
928: }
929:
930: static void
931: community()
932: {
933: pariputs("The standard distribution of GP/PARI includes a reference manual, a tutorial\n\
934: and a reference card and you should ask the person who installed PARI on\n\
935: your system where they can be found. You can also download them\n\
936: from the PARI WWW site http://hasse.mathematik.tu-muenchen.de/ntsw/pari/\n\
937: \n\
938: Three mailing lists are devoted to PARI:\n\
939: - pari-announce (moderated) to announce major version changes.\n\
940: - pari-dev for everything related to the development of PARI, including\n\
941: suggestions, technical questions, bug reports and patch submissions.\n\
942: - pari-users for everything else !\n\
943: To subscribe, send an empty message to <list name>-subscribe@list.cr.yp.to\n\
944: You can only send messages to these lists if you have subscribed !\n\
945: An archive is kept at the address\n\
946: http://hasse.mathematik.tu-muenchen.de/ntsw/pari/lists/archive\n\n\
947: In case you don't want to subscribe, you can reach the authors directly by\n\
948: email: pari@math.u-bordeaux.fr (answer not guaranteed).");
949: }
950:
951: static void
952: gentypes(void)
953: {
954: pariputs("List of the PARI types:\n\
955: t_INT : long integers [ cod1 ] [ cod2 ] [ man_1 ] ... [ man_k ]\n\
956: t_REAL : long real numbers [ cod1 ] [ cod2 ] [ man_1 ] ... [ man_k ]\n\
957: t_INTMOD : integermods [ code ] [ mod ] [ integer ]\n\
958: t_FRAC : irred. rationals [ code ] [ num. ] [ den. ]\n\
959: t_FRACN : rational numbers [ code ] [ num. ] [ den. ]\n\
960: t_COMPLEX: complex numbers [ code ] [ real ] [ imag ]\n\
961: t_PADIC : p-adic numbers [ cod1 ] [ cod2 ] [ p ] [ p^r ] [ int ]\n\
962: t_QUAD : quadratic numbers [ cod1 ] [ mod ] [ real ] [ imag ]\n\
963: t_POLMOD : poly mod [ code ] [ mod ] [ polynomial ]\n\
964: -------------------------------------------------------------\n\
965: t_POL : polynomials [ cod1 ] [ cod2 ] [ man_1 ] ... [ man_k ]\n\
966: t_SER : power series [ cod1 ] [ cod2 ] [ man_1 ] ... [ man_k ]\n\
967: t_RFRAC : irred. rat. func. [ code ] [ num. ] [ den. ]\n\
968: t_RFRACN : rational function [ code ] [ num. ] [ den. ]\n\
969: t_QFR : real qfb [ code ] [ a ] [ b ] [ c ] [ del ]\n\
970: t_QFI : imaginary qfb [ code ] [ a ] [ b ] [ c ]\n\
971: t_VEC : row vector [ code ] [ x_1 ] ... [ x_k ]\n\
972: t_COL : column vector [ code ] [ x_1 ] ... [ x_k ]\n\
973: t_MAT : matrix [ code ] [ col_1 ] ... [ col_k ]\n\
974: t_LIST : list [ code ] [ cod2 ] [ x_1 ] ... [ x_k ]\n\
975: t_STR : string [ code ] [ man_1 ] ... [ man_k ]\n\
976: \n");
977: }
978:
979: static void
980: menu_commands(void)
981: {
982: pariputs("Help topics:\n\
983: 0: list of user-defined identifiers (variable, alias, function)\n\
984: 1: Standard monadic or dyadic OPERATORS\n\
985: 2: CONVERSIONS and similar elementary functions\n\
986: 3: TRANSCENDENTAL functions\n\
987: 4: NUMBER THEORETICAL functions\n\
988: 5: Functions related to ELLIPTIC CURVES\n\
989: 6: Functions related to general NUMBER FIELDS\n\
990: 7: POLYNOMIALS and power series\n\
991: 8: Vectors, matrices, LINEAR ALGEBRA and sets\n\
992: 9: SUMS, products, integrals and similar functions\n\
993: 10: GRAPHIC functions\n\
994: 11: PROGRAMMING under GP\n\
995: 12: The PARI community\n\
996: \n\
997: Further help (list of relevant functions): ?n (1<=n<=11).\n\
998: Also:\n\
999: ? functionname (short on-line help)\n\
1000: ?\\ (keyboard shortcuts)\n\
1001: ?. (member functions)\n");
1002: if (has_ext_help()) pariputs("\
1003: Extended help looks available:\n\
1004: ?? (opens the full user's manual in a dvi previewer)\n\
1005: ?? tutorial (same with the GP tutorial)\n\
1006: ?? refcard (same with the GP reference card)\n\
1007: \n\
1008: ?? keyword (long help text about \"keyword\" from the user's manual)\n\
1009: ??? keyword (a propos: list of related functions).");
1010: }
1011:
1012: static void
1013: slash_commands(void)
1014: {
1015: pariputs("# : enable/disable timer\n\
1016: ## : print time for last result\n\
1017: \\\\ : comment up to end of line\n\
1018: \\a {n} : print result in raw format (readable by PARI)\n\
1019: \\b {n} : print result in beautified format\n\
1020: \\c : list all commands (same effect as ?*)\n\
1021: \\d : print all defaults\n\
1022: \\e {n} : enable/disable echo (set echo=n)\n\
1023: \\g {n} : set debugging level\n\
1024: \\gf{n} : set file debugging level\n\
1025: \\gm{n} : set memory debugging level\n\
1026: \\h {m-n}: hashtable information\n\
1027: \\l {f} : enable/disable logfile (set logfile=f)\n\
1028: \\m {n} : print result in prettymatrix format\n\
1029: \\p {n} : change real precision\n\
1030: \\ps{n} : change series precision\n\
1031: \\q : quit completely this GP session\n\
1032: \\r {f} : read in a file\n\
1033: \\s {n} : print stack information\n\
1034: \\t : print the list of PARI types\n\
1035: \\u : print the list of user-defined functions\n\
1036: \\um : print the list of user-defined member functions\n\
1037: \\v : print current version of GP\n\
1038: \\w {nf} : write to a file\n\
1039: \\x {n} : print complete inner structure of result\n\
1040: \\y {n} : disable/enable automatic simplification (set simplify=n)\n\
1041: \n\
1042: {f}=optional filename. {n}=optional integer\n");
1043: }
1044:
1045: static void
1046: member_commands(void)
1047: {
1048: pariputs("Member functions, followed by relevant objects\n\n\
1049: a1-a6, b2-b8, c4-c6 : coeff. of the curve. ell\n\
1050: area : area ell\n\
1051: bnf : big number field bnf, bnr\n\
1052: clgp : class group bnf, bnr\n\
1053: cyc : cyclic decomposition (SNF) clgp bnf, bnr\n\
1054: diff, codiff: different and codifferent nf, bnf, bnr\n\
1055: disc : discriminant ell, nf, bnf, bnr\n\
1056: e, f : inertia/residues degree prid\n\
1057: fu : fundamental units bnf, bnr\n\
1058: futu : [u,w] where u=unit group, w=torsion bnf, bnr\n\
1059: gen : generators prid, clgp bnf, bnr\n\
1060: j : j-invariant ell\n\
1061: mod : modulus\n\
1062: nf : number field bnf, bnr\n\
1063: no : number of elements clgp bnf, bnr\n\
1064: omega, eta: [omega1,omega2] and [eta1, eta2] ell\n\
1065: p : rational prime contained in prid prid\n\
1066: pol : defining polynomial nf, bnf, bnr\n\
1067: reg : regulator bnf, bnr\n\
1068: roots: roots ell nf, bnf, bnr\n\
1069: sign : signature nf, bnf, bnr\n\
1070: t2 : t2 matrix nf, bnf, bnr\n\
1071: tate : Tate's [u^2,u,q] ell\n\
1072: tu : torsion unit and its order bnf, bnr\n\
1073: tufu : [w,u] where u=unit group, w=torsion bnf, bnr\n\
1074: w : Mestre's w ell\n\
1075: zk : integral basis nf, bnf, bnr\n\
1076: zkst : structure of (Z_K/m)^* (valid for idealstar also) bnr\n");
1077: }
1078:
1079: #define MAX_LINE_LEN 255
1080: static void
1081: external_help(char *s, int num)
1082: {
1083: long nbli = term_height()-3, li = 0;
1084: char buf[MAX_LINE_LEN+1], *str, *opt = "", *ar = "";
1085: pariFILE *z;
1086: FILE *f;
1087:
1088: if (!help_prg) err(talker,"no external help program");
1089: str = gpmalloc(strlen(help_prg) + strlen(s) + 64);
1090: if (num < 0)
1091: opt = "-k";
1092: else if (s[strlen(s)-1] != '@')
1093: { ar = thestring; sprintf(ar,"@%d",num); }
1094: sprintf(str,"%s -fromgp %s %c%s%s%c",help_prg,opt, SHELL_Q,s,ar,SHELL_Q);
1095: z = try_pipe(str,0); f = z->file;
1096: free(str);
1097: while (fgets(buf,MAX_LINE_LEN,f))
1098: {
1099: if (!strncmp("ugly_kludge_done",buf,16)) break;
1100: buf[MAX_LINE_LEN]=0; pariputs(buf);
1101: if (++li > nbli) { hit_return(); li = 0; }
1102: }
1103: pari_fclose(z);
1104: }
1105:
1106: char *keyword_list[]={
1107: "operator",
1108: "user",
1109: "member",
1110: "integer",
1111: "real",
1112: "readline",
1113: "refcard",
1114: "tutorial",
1115: "nf",
1116: "bnf",
1117: "bnr",
1118: "ell",
1119: NULL
1120: };
1121:
1122: static int
1123: ok_external_help(char *s)
1124: {
1125: long n;
1126: if (!*s) return 1;
1127: if (!isalpha((int)*s)) return 3; /* operator or section number */
1128: if (!strncmp(s,"t_",2)) return 2; /* type name */
1129:
1130: for (n=0; keyword_list[n]; n++)
1131: if (!strcmp(s,keyword_list[n])) return 3;
1132: return 0;
1133: }
1134:
1135: /* don't mess readline display */
1136: static void
1137: aide_err(char *s1, char *s2, int flag)
1138: {
1139: if ((flag & h_RL) == 0) err(talker, "%s: %s", s1, s2);
1140: pariputsf("%s: %s\n", s1, s2);
1141: }
1142:
1143: static void
1144: aide0(char *s, int flag)
1145: {
1146: long n, long_help = flag & h_LONG;
1147: entree *ep,*ep1;
1148:
1149: s = get_sep(s);
1150: if (isdigit((int)*s))
1151: {
1152: n=atoi(s);
1153: if (n == 12) { community(); return; }
1154: if (n<0 || n > 12)
1155: err(talker2,"no such section in help: ?",s,s);
1156: if (long_help) external_help(s,3); else commands(n);
1157: return;
1158: }
1159: if (flag & h_APROPOS) { external_help(s,-1); return; }
1160: if (long_help && (n = ok_external_help(s))) { external_help(s,n); return; }
1161: switch (*s)
1162: {
1163: case '*' : commands(-1); return;
1164: case '\0': menu_commands(); return;
1165: case '\\': slash_commands(); return;
1166: case '.' : member_commands(); return;
1167: }
1168: ep = is_entry(s);
1169: if (!ep)
1170: {
1171: n = whatnow(s,1);
1172: if (n) err(obsoler,s,s, s,n);
1173: if (long_help)
1174: {
1175: n = setdefault(s,"",d_EXISTS) == gun? 2: 3;
1176: external_help(s,n);
1177: }
1178: else
1179: aide_err(s,"unknown identifier",flag);
1180: return;
1181: }
1182:
1183: ep1 = ep; ep = do_alias(ep);
1184: if (ep1 != ep) pariputsf("%s is aliased to:\n\n",s);
1185:
1186: switch(EpVALENCE(ep))
1187: {
1188: case EpUSER:
1189: print_user_fun(ep); if (!ep->help) return;
1190: pariputs("\n\n"); long_help=0; break;
1191:
1192: case EpGVAR:
1193: case EpVAR:
1194: if (!ep->help) { aide_err(s, "user defined variable",flag); return; }
1195: long_help=0; break;
1196:
1197: case EpINSTALL:
1198: if (!ep->help) { aide_err(s, "installed function",flag); return; }
1199: long_help=0; break;
1200: }
1201: if (long_help) { external_help(ep->name,3); return; }
1202: if (ep->help) { print_text(ep->help); return; }
1203:
1204: err(bugparier,"aide (no help found)");
1205: }
1206:
1207: void
1208: aide(char *s, int flag)
1209: {
1210: if ((flag & h_RL) == 0)
1211: {
1212: if (*s == '?') { flag |= h_LONG; s++; }
1213: if (*s == '?') { flag |= h_APROPOS; s++; }
1214: }
1215: term_color(c_HELP); aide0(s,flag); term_color(c_NONE);
1216: if ((flag & h_RL) == 0) pariputc('\n');
1217: }
1218:
1219: /********************************************************************/
1220: /** **/
1221: /** METACOMMANDS **/
1222: /** **/
1223: /********************************************************************/
1224:
1225: static void
1226: print_entree(entree *ep, long hash)
1227: {
1228: pariputsf(" %s ",ep->name); pariputsf(VOIR_STRING1,(ulong)ep);
1229: pariputsf(":\n hash = %3ld, valence = %3ld, menu = %2ld, code = %s\n",
1230: hash, ep->valence, ep->menu, ep->code? ep->code: "NULL");
1231: if (ep->next)
1232: {
1233: pariputsf(" next = %s ",(ep->next)->name);
1234: pariputsf(VOIR_STRING1,(ulong)(ep->next));
1235: }
1236: pariputs("\n");
1237: }
1238:
1239: static void
1240: print_hash_list(char *s)
1241: {
1242: long m,n;
1243: entree *ep;
1244:
1245: if (isalpha((int)*s))
1246: {
1247: ep = is_entry_intern(s,functions_hash,&n);
1248: if (!ep) err(talker,"no such function");
1249: print_entree(ep,n); return;
1250: }
1251: if (isdigit((int)*s) || *s == '$')
1252: {
1253: m = functions_tblsz-1; n = atol(s);
1254: if (*s=='$') n = m;
1255: if (m<n) err(talker,"invalid range in print_entree");
1256: while (isdigit((int)*s)) s++;
1257:
1258: if (*s++ != '-') m = n;
1259: else
1260: {
1261: if (*s !='$') m = min(atol(s),m);
1262: if (m<n) err(talker,"invalid range in print_entree");
1263: }
1264:
1265: for(; n<=m; n++)
1266: {
1267: pariputsf("*** hashcode = %ld\n",n);
1268: for (ep=functions_hash[n]; ep; ep=ep->next)
1269: print_entree(ep,n);
1270: }
1271: return;
1272: }
1273: if (*s=='-')
1274: {
1275: for (n=0; n<functions_tblsz; n++)
1276: {
1277: m=0;
1278: for (ep=functions_hash[n]; ep; ep=ep->next) m++;
1279: pariputsf("%3ld:%3ld ",n,m);
1280: if (n%9 == 8) pariputc('\n');
1281: }
1282: pariputc('\n'); return;
1283: }
1284: for (n=0; n<functions_tblsz; n++)
1285: for (ep=functions_hash[n]; ep; ep=ep->next)
1286: print_entree(ep,n);
1287: }
1288:
1289:
1290: static void
1291: center(char *s)
1292: {
1293: long i, pad = term_width() - strlen(s);
1294: char *u = thestring;
1295:
1296: if (pad<0) pad=0; else pad >>= 1;
1297: for (i=0; i<pad; i++) *u++ = ' ';
1298: while (*s) *u++ = *s++;
1299: *u++='\n'; *u=0; pariputs(thestring);
1300: }
1301:
1302: static char *
1303: what_readline()
1304: {
1305: #ifdef READLINE
1306: return "v"READLINE" enabled";
1307: #else
1308: return "disabled";
1309: #endif
1310: }
1311:
1312: static void
1313: print_version()
1314: {
1315: char buf[64];
1316:
1317: center(PARIVERSION); center(PARIINFO);
1318: sprintf(buf,"(readline %s, extended help%s available)", what_readline(),
1319: has_ext_help()? "": " not");
1320: center(buf);
1321: }
1322:
1323: static void
1324: gp_head()
1325: {
1326: print_version(); pariputs("\n");
1327: center("Copyright (C) 1989-1999 by");
1328: center("C. Batut, K. Belabas, D. Bernardi, H. Cohen and M. Olivier.");
1329: pariputs("\n\
1330: Type ? for help, \\q to quit.\n\
1331: Type ?12 for how to get moral (and possibly technical) support.\n\n");
1332: sd_realprecision ("",d_ACKNOWLEDGE);
1333: sd_seriesprecision("",d_ACKNOWLEDGE);
1334: sd_format ("",d_ACKNOWLEDGE);
1335: pariputsf("\nparisize = %ld, primelimit = %ld\n", parisize, primelimit);
1336: }
1337:
1338: void
1339: gp_quit()
1340: {
1341: free_graph(); freeall();
1342: while (bufindex) free((void *)buflist[bufindex--]);
1343: #ifdef WINCE
1344: #else
1345: if (INIT_SIG)
1346: {
1347: #ifdef SIGBUS
1348: signal(SIGBUS,SIG_DFL);
1349: #endif
1350: signal(SIGSEGV,SIG_DFL);
1351: signal(SIGINT,SIG_DFL);
1352: #ifdef SIGBREAK
1353: signal(SIGBREAK,SIG_DFL);
1354: #endif
1355: }
1356: #endif
1357: term_color(c_NONE);
1358: pariputs_opt("Good bye!\n"); exit(0);
1359: }
1360:
1361: /* history management function:
1362: * flag < 0, called from freeall()
1363: * flag = 0, called from %num in anal.c:truc()
1364: * flag > 0, called from %` in anal.c:truc(), p > 0
1365: */
1366: static GEN
1367: gp_history(long p, long flag, char *old, char *entrypoint)
1368: {
1369: int er1 = 0;
1370: if (flag < 0) { free((void *)hist); return NULL; }
1371: if (!tglobal) er1 = 1;
1372: if (flag)
1373: {
1374: p = tglobal - p;
1375: if (p <= 0) er1 = 1;
1376: }
1377: else if (p > tglobal)
1378: err(talker2,"I can't see into the future",old,entrypoint);
1379: if (!p) p = tglobal;
1380: if (tglobal - p >= histsize) er1 = 1;
1381: p = (p-1) % histsize;
1382: if (er1 || !hist[p])
1383: err(talker2,"I can't remember before the big bang",old,entrypoint);
1384: return hist[p];
1385: }
1386:
1387: static void
1388: escape(char *tch)
1389: {
1390: char *s, c;
1391:
1392: if (compatible != NONE)
1393: {
1394: s = tch;
1395: while (*s)
1396: if (*s++ == '=')
1397: {
1398: GEN (*f)(char*, int) = NULL;
1399: int len = (s-tch) - 1;
1400:
1401: if (!strncmp(tch,"precision",len)) f = sd_realprecision;
1402: else if (!strncmp(tch,"serieslength",len)) f = sd_seriesprecision;
1403: else if (!strncmp(tch,"format",len)) f = sd_format;
1404: else if (!strncmp(tch,"prompt",len)) f = sd_prompt;
1405: if (f) { f(get_sep(s), d_ACKNOWLEDGE); return; }
1406: break;
1407: }
1408: }
1409: s = tch;
1410: switch ((c = *s++))
1411: {
1412: case 'w': case 'x': case 'a': case 'b': case 'm': /* history things */
1413: {
1414: long d;
1415: GEN x;
1416: if (c != 'w' && c != 'x') d = get_int(s,0);
1417: else
1418: {
1419: d = atol(s); if (*s == '-') s++;
1420: while (isdigit((int)*s)) s++;
1421: }
1422: x = gp_history(d, 0, tch+1,tch-1);
1423: switch (c)
1424: {
1425: case 'a': brute (x, fmt.format, -1); break;
1426: case 'm': matbrute(x, fmt.format, -1); break;
1427: case 'b': sor (x, fmt.format, -1, fmt.field); break;
1428: case 'x': voir(x, get_int(s, -1)); return;
1429: case 'w':
1430: {
1431: GEN g[2]; g[0] = x; g[1] = NULL;
1432: s = get_sep(s); if (!*s) s = current_logfile;
1433: write0(s, g, f_RAW); return;
1434: }
1435: }
1436: pariputc('\n'); return;
1437: }
1438:
1439: case 'c': commands(-1); break;
1440: case 'd': help_default(); break;
1441: case 'e':
1442: s = get_sep(s);
1443: if (!*s) s = pariecho?"0":"1";
1444: sd_echo(s,d_ACKNOWLEDGE); break;
1445: case 'g':
1446: switch (*s)
1447: {
1448: case 'm': sd_debugmem(++s,d_ACKNOWLEDGE); break;
1449: case 'f': sd_debugfiles(++s,d_ACKNOWLEDGE); break;
1450: default : sd_debug(s,d_ACKNOWLEDGE); break;
1451: }
1452: break;
1453: case 'h': print_hash_list(s); break;
1454: case 'l':
1455: s = get_sep(s);
1456: if (*s)
1457: {
1458: sd_logfile(s,d_ACKNOWLEDGE);
1459: if (logfile) break;
1460: }
1461: sd_log(logfile?"0":"1",d_ACKNOWLEDGE);
1462: break;
1463: case 'p':
1464: switch (*s)
1465: {
1466: case 's': sd_seriesprecision(++s,d_ACKNOWLEDGE); break;
1467: default : sd_realprecision(s,d_ACKNOWLEDGE); break;
1468: }
1469: break;
1470: case 'q': gp_quit(); break;
1471: case 'r': switchin(get_sep(s)); break;
1472: case 's': etatpile(0); break;
1473: case 't': gentypes(); break;
1474: case 'u':
1475: switch (*s)
1476: {
1477: case 'm': user_member(); break;
1478: default: user_fun();
1479: }
1480: break;
1481: case 'v': print_version(); break;
1482: case 'y':
1483: s = get_sep(s);
1484: if (!*s) s = simplifyflag?"0":"1";
1485: sd_simplify(s,d_ACKNOWLEDGE); break;
1486: default: err(caracer1,tch-1,tch-2);
1487: }
1488: }
1489:
1490: /********************************************************************/
1491: /* */
1492: /* GPRC */
1493: /* */
1494: /********************************************************************/
1495: #if defined(UNIX) || defined(__EMX__)
1496: # include <pwd.h>
1497: #endif
1498:
1499: static int
1500: get_preproc_value(char *s)
1501: {
1502: if (!strncmp(s,"EMACS",5)) return under_emacs;
1503: if (!strncmp(s,"READL",5))
1504: {
1505: #ifdef READLINE
1506: return 1;
1507: #else
1508: return 0;
1509: #endif
1510: }
1511: return -1;
1512: }
1513:
1514: /* return $HOME or the closest we can find */
1515: static char *
1516: get_home(int *free_it)
1517: {
1518: #ifdef WINCE
1519: return ".";
1520: #else
1521: #ifndef macintosh /* getenv() for Mac ? */
1522: char *drv, *pth = getenv("HOME");
1523: if (pth) return pth;
1524: if ((drv = getenv("HOMEDRIVE"))
1525: && (pth = getenv("HOMEPATH")))
1526: { /* looks like WinNT */
1527: char *buf = gpmalloc(strlen(pth) + strlen(drv) + 1);
1528: sprintf(buf, "%s%s",drv,pth);
1529: *free_it = 1; return buf;
1530: }
1531: #endif
1532: #endif
1533: #if defined(__EMX__) || defined(UNIX)
1534: {
1535: struct passwd *p = getpwuid(geteuid());
1536: if (p) return p->pw_dir;
1537: }
1538: #endif
1539: return ".";
1540: }
1541:
1542: static FILE *
1543: gprc_chk(char *s)
1544: {
1545: FILE *f = fopen(s, "r");
1546: if (f && !quiet_mode) fprintferr("Reading GPRC: %s ...", s);
1547: return f;
1548: }
1549:
1550: /* Look for [._]gprc: $GPRC, then in $HOME, /, C:/ */
1551: static FILE *
1552: gprc_get()
1553: {
1554: FILE *f = NULL;
1555: char *str, *s, c;
1556: long l;
1557: #ifdef macintosh
1558: f = gprc_chk("gprc");
1559: #else
1560: #ifdef WINCE
1561: s = NULL;
1562: #else
1563: s = getenv("GPRC");
1564: #endif
1565: if (s) f = gprc_chk(s);
1566: if (!f)
1567: {
1568: int free_it = 0;
1569: s = get_home(&free_it); l = strlen(s); c = s[l-1];
1570: str = strcpy(gpmalloc(l+7), s);
1571: if (free_it) free(s);
1572: s = str + l;
1573: if (c != '/' && c != '\\') *s++ = '/';
1574: #ifdef UNIX
1575: *s = '.'; /* .gprc */
1576: #else
1577: *s = '_'; /* _gprc */
1578: #endif
1579: strcpy(s+1, "gprc");
1580: f = gprc_chk(str); /* in $HOME */
1581: if (!f) f = gprc_chk(s); /* in . */
1582: if (!f) f = gprc_chk("/etc/gprc");
1583: if (!f) f = gprc_chk("C:/_gprc");
1584: free(str);
1585: }
1586: #endif
1587: return f;
1588: }
1589:
1590: static int
1591: init_brace(char *s)
1592: {
1593: while (isspace((int)*s)) s++;
1594: if (*s == LBRACE) { *s=' '; return 1; }
1595: return 0;
1596: }
1597:
1598: /* return 1 if we deleted a '{' */
1599: static int
1600: init_filtre(char *s)
1601: {
1602: if (filtre(s, f_INIT)) return 0; /* in comment */
1603: return init_brace(s);
1604: }
1605:
1606: static void
1607: fix_buffer(long newlbuf, char **ptbuf, long *ptlbuf)
1608: {
1609: buflist[bufindex] = *ptbuf = gprealloc(*ptbuf,newlbuf,*ptlbuf);
1610: *ptlbuf = paribufsize = newlbuf;
1611: }
1612:
1613: /* prompt = NULL --> from gprc */
1614: static int
1615: get_line_from_file(FILE *file, char **ptbuf, long *ptlbuf, char *prompt)
1616: {
1617: int f_flag = prompt? f_REG | f_KEEPCASE: f_REG;
1618: int wait_for_brace;
1619: long len = *ptlbuf;
1620: char *s = *ptbuf;
1621:
1622: if (!fgets(s, len, file)) return 0;
1623: wait_for_brace = init_filtre(s);
1624: for(;;)
1625: {
1626: int read_more = (s[strlen(s)-1] != '\n');
1627: char *end = filtre(s, f_flag);
1628: if (*s)
1629: {
1630: if (read_more) s = end;
1631: else if (end[-1] == '\\')
1632: {
1633: if (*s=='?') break;
1634: s = end-1;
1635: }
1636: else if (end[-1] == '='&& *s != '?')
1637: {
1638: s = end;
1639: }
1640: else
1641: {
1642: if (!wait_for_brace) break;
1643: if (end[-1] == RBRACE) {end[-1]=0; break;}
1644: s = end;
1645: }
1646: len = *ptlbuf - (s - *ptbuf);
1647: if (len < 512)
1648: {
1649: long n = *ptlbuf << 1, l = s - *ptbuf;
1650: len += *ptlbuf;
1651: fix_buffer(n, ptbuf, ptlbuf);
1652: s = *ptbuf + l;
1653: }
1654: }
1655: if (!fgets(s, len, file)) break;
1656: if (!read_more && !wait_for_brace)
1657: wait_for_brace = init_filtre(s);
1658: }
1659: if (prompt && *ptbuf)
1660: {
1661: if (pariecho) { pariputs(prompt); pariputs(*ptbuf); pariputc('\n'); }
1662: else if (logfile) fprintf(logfile, "%s%s\n",prompt,*ptbuf);
1663: pariflush();
1664: }
1665: return 1;
1666: }
1667:
1668: #define err_gprc(s,t,u) { fprintferr("\n"); err(talker2,s,t,u); }
1669:
1670: static char **
1671: gp_initrc()
1672: {
1673: char **flist, *buf, *s,*s1,*s2;
1674: FILE *file = gprc_get();
1675: long fnum = 4, find = 0, *ptlbuf = &paribufsize;
1676:
1677: if (!file) return NULL;
1678: flist = (char **) gpmalloc(fnum * sizeof(char*));
1679: buflist[++bufindex] = buf = gpmalloc(*ptlbuf);
1680: for(;;)
1681: {
1682: if (! get_line_from_file(file, &buf, ptlbuf, NULL))
1683: {
1684: if (!quiet_mode) fprintferr("Done.\n\n");
1685: fclose(file); free(buflist[bufindex--]);
1686: flist[find] = NULL; return flist;
1687: }
1688: for (s = buf; *s; )
1689: {
1690: s1 = s; if (get_sep2(s)) s++;
1691: s += strlen(s1); /* point to next expr */
1692: if (*s1 == '#')
1693: { /* preprocessor directive */
1694: int z, NOT = 0;
1695: s1++;
1696: if (strncmp(s1,"if",2)) err_gprc("unknown directive",s1,buf);
1697: s1 += 2;
1698: if (!strncmp(s1,"not",3)) { NOT = !NOT; s1 += 3; }
1699: if (*s1 == '!') { NOT = !NOT; s1++; }
1700: z = get_preproc_value(s1);
1701: if (z < 0) err_gprc("unknown preprocessor variable",s1,buf);
1702: if (NOT) z = !z;
1703: if (!z) continue;
1704: s1 += 5;
1705: }
1706: if (!strncmp(s1,"read",4))
1707: { /* read file */
1708: s1 += 4;
1709: if (find == fnum-1)
1710: {
1711: long n = fnum << 1;
1712: flist = (char**)gprealloc(flist, n*sizeof(char*),
1713: fnum*sizeof(char*));
1714: fnum = n;
1715: }
1716: flist[find++] = s2 = gpmalloc(strlen(s1) + 1);
1717: if (*s1 == '"') (void)readstring(s1, s2);
1718: else strcpy(s2,s1);
1719: }
1720: else
1721: { /* set default */
1722: s2 = s1; while (*s2 && *s2 != '=') s2++;
1723: if (*s2 != '=') err_gprc("missing '='",s2,buf);
1724: *s2++ = 0;
1725: if (*s2 == '"') (void)readstring(s2, s2);
1726: setdefault(s1,s2,d_INITRC);
1727: }
1728: }
1729: }
1730: }
1731:
1732: /********************************************************************/
1733: /* */
1734: /* GP MAIN LOOP */
1735: /* */
1736: /********************************************************************/
1737: /* flag:
1738: * ti_NOPRINT don't print
1739: * ti_REGULAR print elapsed time (chrono = 1)
1740: * ti_LAST print last elapsed time (##)
1741: * ti_INTERRUPT received a SIGINT
1742: */
1743: static char *
1744: do_time(long flag)
1745: {
1746: static long last = 0;
1747: long delay = (flag == ti_LAST)? last: gptimer();
1748: char *s;
1749:
1750: last = delay;
1751: switch(flag)
1752: {
1753: case ti_NOPRINT: return NULL;
1754: case ti_REGULAR: s = "time = "; break;
1755: case ti_INTERRUPT: s = "user interrupt after "; break;
1756: case ti_LAST: s = " *** last result computed in "; break;
1757: }
1758: strcpy(thestring,s); s=thestring+strlen(s);
1759: strcpy(s, term_get_color(c_TIME)); s+=strlen(s);
1760: if (delay >= 3600000)
1761: {
1762: sprintf(s, "%ldh, ", delay / 3600000); s+=strlen(s);
1763: delay %= 3600000;
1764: }
1765: if (delay >= 60000)
1766: {
1767: sprintf(s, "%ldmn, ", delay / 60000); s+=strlen(s);
1768: delay %= 60000;
1769: }
1770: if (delay >= 1000)
1771: {
1772: sprintf(s, "%ld,", delay / 1000); s+=strlen(s);
1773: delay %= 1000;
1774: if (delay < 100)
1775: {
1776: sprintf(s, "%s", (delay<10)? "00": "0");
1777: s+=strlen(s);
1778: }
1779: }
1780: sprintf(s, "%ld ms", delay); s+=strlen(s);
1781: strcpy(s, term_get_color(c_NONE));
1782: if (flag != ti_INTERRUPT) { s+=strlen(s); *s++='.'; *s++='\n'; *s=0; }
1783: return thestring;
1784: }
1785:
1786: #ifndef WINCE
1787: static void
1788: gp_sighandler(int sig)
1789: {
1790: char *msg;
1791: switch(sig)
1792: {
1793: case SIGINT:
1794: #ifdef _WIN32
1795: # ifdef SIGBREAK
1796: case SIGBREAK:
1797: # endif
1798: if (++win32ctrlc >= 5) _exit(3);
1799: signal(sig,gp_sighandler);
1800: return;
1801: #endif
1802: msg = do_time(ti_INTERRUPT);
1803: break;
1804:
1805: case SIGSEGV:
1806: msg="segmentation fault: bug in GP (please report)";
1807: break;
1808:
1809: #ifdef SIGBUS
1810: case SIGBUS:
1811: msg="bus error: bug in GP (please report)";
1812: break;
1813: #endif
1814: default:
1815: msg="bug in signal handling (please report)";
1816: }
1817: signal(sig,gp_sighandler);
1818: err(talker,msg);
1819: }
1820: #endif
1821: static void
1822: brace_color(char *s, int c)
1823: {
1824: if (gp_colors[c] == c_NONE) return;
1825: #ifdef RL_PROMPT_START_IGNORE
1826: *s++ = RL_PROMPT_START_IGNORE;
1827: #endif
1828: strcpy(s, term_get_color(c));
1829: #ifdef RL_PROMPT_START_IGNORE
1830: s+=strlen(s);
1831: *s++ = RL_PROMPT_END_IGNORE; *s = 0;
1832: #endif
1833: }
1834:
1835: static char *
1836: do_prompt()
1837: {
1838: static char buf[MAX_PROMPT_LEN + 24]; /* + room for color codes */
1839: char *s = buf;
1840:
1841: *s = 0;
1842: /* escape sequences bug readline, so use special bracing (if available) */
1843: brace_color(s, c_PROMPT);
1844: s += strlen(s);
1845: if (filtre(s, f_COMMENT))
1846: strcpy(s, COMMENTPROMPT);
1847: else
1848: do_strftime(prompt,s);
1849: s += strlen(s);
1850: brace_color(s, c_INPUT); return buf;
1851: }
1852:
1853: static int
1854: read_line(char *promptbuf, char **ptbuf, long *ptlbuf)
1855: {
1856: if (infile == stdin /* interactive use */
1857: #if defined(UNIX) || defined(__EMX__)
1858: && (under_emacs || isatty(fileno(stdin)))
1859: #endif
1860: )
1861: {
1862: #ifdef READLINE
1863: static char *previous_hist = NULL;
1864: char *rlbuffer = readline(promptbuf), *s = *ptbuf;
1865: int wait_for_brace, wait_for_input;
1866:
1867: if (!rlbuffer) { pariputs("\n"); return 0; } /* EOF */
1868: wait_for_input = wait_for_brace = init_filtre(rlbuffer);
1869: for(;;)
1870: {
1871: long len = s - *ptbuf;
1872: char *end = filtre(rlbuffer, f_READL);
1873: long l = end - rlbuffer;
1874:
1875: if (len + l > *ptlbuf)
1876: {
1877: fix_buffer(len+l+1, ptbuf, ptlbuf);
1878: s = *ptbuf + len;
1879: }
1880: strcpy(s,rlbuffer); free(rlbuffer);
1881: if (!*s) { if (!wait_for_input) break; }
1882: else
1883: {
1884: s += l-1; /* *s = last input char */
1885: if (wait_for_brace && *s == RBRACE) {*s=0; break;}
1886: if (*s == '\\')
1887: {
1888: if (*rlbuffer == '?') break;
1889: }
1890: else if (*s == '=' && s[1-l] != '?')
1891: {
1892: wait_for_input = 1; s++;
1893: }
1894: else
1895: {
1896: if (!wait_for_brace) break;
1897: s++;
1898: }
1899: }
1900: /* read continuation line */
1901: if (!(rlbuffer = readline(""))) break;
1902: if (wait_for_input && !wait_for_brace)
1903: wait_for_brace = init_brace(rlbuffer);
1904: }
1905: /* bug in readline 2.0: need to unblock ^C */
1906: # ifdef USE_SIGRELSE
1907: sigrelse(SIGINT);
1908: # elif USE_SIGSETMASK
1909: sigsetmask(0);
1910: # endif
1911: s = *ptbuf;
1912: if (*s)
1913: {
1914: /* update history (don't add the same entry twice) */
1915: if (!previous_hist || strcmp(s,previous_hist))
1916: {
1917: if (previous_hist) free(previous_hist);
1918: previous_hist = pari_strdup(s); add_history(s);
1919: }
1920: /* update logfile */
1921: if (logfile) fprintf(logfile, "%s%s\n",promptbuf,s);
1922: }
1923: return 1;
1924: #else
1925: pariputs(promptbuf);
1926: #endif /* defined(READLINE) */
1927: }
1928: else promptbuf = DFT_PROMPT;
1929: return get_line_from_file(infile, ptbuf, ptlbuf, promptbuf);
1930: }
1931:
1932: static void
1933: chron(char *s)
1934: {
1935: if (*s)
1936: {
1937: char *old = s-1;
1938: if (*s == '#') { pariputs(do_time(ti_LAST)); s++; }
1939: if (*s) err(caracer1,s,old);
1940: }
1941: else { chrono = 1-chrono; sd_timer("",d_ACKNOWLEDGE); }
1942: }
1943:
1944: /* bufindex != 0: we are doing an immediate read (with read, extern...) */
1945: static GEN
1946: gp_main_loop()
1947: {
1948: long av, i,j, lbuf = paribufsize;
1949: char *buf, *promptbuf = prompt;
1950: GEN z = gnil;
1951:
1952: if (bufindex == MAX_BUFFER) err(talker,"too many nested files");
1953: buflist[++bufindex] = buf = (char *) gpmalloc(lbuf);
1954: for(;;)
1955: {
1956: if (! bufindex)
1957: {
1958: static long tloc, outtyp;
1959: tloc = tglobal; outtyp = prettyp; recover(0);
1960: if (setjmp(environnement))
1961: {
1962: avma = top; parisize = top - bot;
1963: j = tglobal - tloc; i = (tglobal-1)%histsize;
1964: while (j)
1965: {
1966: gunclone(hist[i]); hist[i]=NULL;
1967: if (!i) i = histsize;
1968: i--; j--;
1969: }
1970: tglobal = tloc; prettyp = outtyp;
1971: while (bufindex) free((void *)buflist[bufindex--]);
1972: killallfiles(0);
1973: }
1974: }
1975: setjmp(local_environnement[bufindex]);
1976: added_newline = 1;
1977: if (paribufsize != lbuf)
1978: fix_buffer(paribufsize, &buf, &lbuf);
1979:
1980: for(;;)
1981: {
1982: if (! test_mode) promptbuf = do_prompt();
1983: if (! read_line(promptbuf, &buf, &lbuf))
1984: {
1985: #ifdef _WIN32
1986: Sleep(10); if (win32ctrlc) dowin32ctrlc();
1987: #endif
1988: if (popinfile()) gp_quit();
1989: if (bufindex) { free(buflist[bufindex--]); return z; }
1990: }
1991: else switch(*buf)
1992: {
1993: case '?': aide(buf+1, h_REGULAR); break;
1994: case '#': chron(buf+1); break;
1995: case '\\': escape(buf+1); break;
1996: case '\0': break;
1997: default: goto WORK;
1998: }
1999: }
2000: WORK:
2001: if (! bufindex)
2002: {
2003: char c = buf[strlen(buf) - 1];
2004: gpsilent = separe(c);
2005: }
2006: if (bufindex == 0) (void)gptimer();
2007: av = avma;
2008: z = readseq(buf, strictmatch);
2009: if (!added_newline) pariputc('\n'); /* last output was print1() */
2010: if (bufindex) continue;
2011: if (chrono) pariputs(do_time(ti_REGULAR)); else do_time(ti_NOPRINT);
2012: if (z == gnil) continue;
2013:
2014: if (simplifyflag) z = simplify(z);
2015: i = tglobal % histsize; tglobal++;
2016: if (hist[i]) gunclone(hist[i]);
2017: hist[i] = z = gclone(z); avma = av;
2018: if (gpsilent) continue;
2019:
2020: if (test_mode) { init80(0); gp_output(z); }
2021: else
2022: {
2023: PariOUT *old = pariOut;
2024: if (DEBUGLEVEL > 4) fprintferr("prec = [%ld, %ld]\n", prec,precdl);
2025: term_color(c_HIST);
2026: sprintf(thestring, "%%%ld = ",tglobal);
2027: pariputs_opt(thestring);
2028: term_color(c_OUTPUT);
2029: init_lim_lines(thestring,lim_lines);
2030: gp_output(z); pariOut=old;
2031: term_color(c_NONE);
2032: }
2033: pariputc('\n'); pariflush();
2034: }
2035: }
2036:
2037: GEN
2038: read0(char *s)
2039: {
2040: switchin(s);
2041: return gp_main_loop();
2042: }
2043:
2044: static void
2045: check_secure(char *s)
2046: {
2047: if (secure)
2048: err(talker, "secure mode: system commands not allowed\nTried to run '%s'",s);
2049: }
2050:
2051: GEN
2052: extern0(char *s)
2053: {
2054: check_secure(s);
2055: infile = try_pipe(s, mf_IN)->file;
2056: return gp_main_loop();
2057: }
2058:
2059: static int
2060: silent()
2061: {
2062: if (gpsilent) return 1;
2063: { char c = _analyseur()[1]; return separe(c); }
2064: }
2065:
2066: GEN
2067: default0(char *a, char *b, long flag)
2068: {
2069: if (flag) flag=d_RETURN;
2070: else
2071: flag = silent()? d_SILENT: d_ACKNOWLEDGE;
2072: return setdefault(a,b,flag);
2073: }
2074:
2075: void
2076: allocatemem0(unsigned long newsize)
2077: {
2078: parisize = allocatemoremem(newsize);
2079: longjmp(local_environnement[bufindex], 0);
2080: }
2081:
2082: GEN
2083: input0()
2084: {
2085: long *ptlbuf = &paribufsize;
2086: char *buf;
2087: GEN x;
2088:
2089: if (bufindex == MAX_BUFFER) err(talker,"too many nested files");
2090: buflist[++bufindex] = buf = gpmalloc(*ptlbuf);
2091: while (! get_line_from_file(infile, &buf, ptlbuf, DFT_INPROMPT))
2092: if (popinfile()) { fprintferr("no input ???"); gp_quit(); }
2093: x = lisseq(buf);
2094: free(buflist[bufindex--]);
2095: return x;
2096: }
2097:
2098: void
2099: system0(char *s)
2100: {
2101: #if defined(UNIX) || defined(__EMX__)
2102: check_secure(s);
2103: system(s);
2104: #else
2105: err(archer);
2106: #endif
2107: }
2108:
2109: void
2110: error0(GEN *g)
2111: {
2112: term_color(c_ERR);
2113: if (!added_newline) pariputc('\n');
2114: pariputs("### User error:\n\n ");
2115: print0(g,f_RAW); term_color(c_NONE);
2116: err_recover(talker);
2117: }
2118:
2119: long
2120: setprecr(long n)
2121: {
2122: long m = fmt.nb;
2123:
2124: if (n>0) {fmt.nb = n; prec = (long)(n*pariK1 + 3);}
2125: return m;
2126: }
2127:
2128: static void
2129: testint(char *s, long *d)
2130: {
2131: if (!s) return;
2132: *d = atol(s);
2133: if (*d <= 0) err(talker,"arguments must be positive integers");
2134: }
2135:
2136: static char *
2137: read_arg(int *nread, char *t, long argc, char **argv)
2138: {
2139: int i = *nread;
2140: if (isdigit((int)*t)) return t;
2141: if (*t || i==argc) usage(argv[0]);
2142: *nread = i+1; return argv[i];
2143: }
2144:
2145: static char**
2146: read_opt(long argc, char **argv)
2147: {
2148: char *b=NULL, *p=NULL, *s=NULL, **pre=(char**)1;
2149: int i=1;
2150:
2151: pari_outfile=stderr;
2152: while (i<argc)
2153: {
2154: char *t = argv[i++];
2155:
2156: if (*t++ != '-') usage(argv[0]);
2157: switch(*t++)
2158: {
2159: case 'b': b = read_arg(&i,t,argc,argv); break;
2160: case 'p': p = read_arg(&i,t,argc,argv); break;
2161: case 's': s = read_arg(&i,t,argc,argv); break;
2162:
2163: case 'e':
2164: if (strncmp(t,"macs",4)) usage(argv[0]);
2165: under_emacs = 1; break;
2166: case 'q':
2167: quiet_mode = 1; break;
2168: case 't':
2169: if (strncmp(t,"est",3)) usage(argv[0]);
2170: disable_color = 1; test_mode = 1; /* fall through */
2171: case 'f':
2172: pre = NULL; break;
2173: case '-':
2174: if (strcmp(t, "version") == 0) {
2175: print_version();
2176: exit(0);
2177: }
2178: /* fall through */
2179: default:
2180: usage(argv[0]);
2181: }
2182: }
2183: if (pre) pre = gp_initrc();
2184:
2185: /* override the values from gprc */
2186: testint(b, &paribufsize); if (paribufsize < 10) paribufsize = 10;
2187: testint(p, &primelimit);
2188: testint(s, &parisize);
2189: if (under_emacs) disable_color=1;
2190: pari_outfile=stdout; return pre;
2191: }
2192:
2193: #ifdef WINCE
2194: int
2195: WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance,
2196: LPWSTR lpCmdLine, int nShowCmd)
2197: {
2198: char **argv = NULL;
2199: int argc = 1;
2200: #else
2201: int
2202: main(int argc, char **argv)
2203: {
2204: #endif
2205: char **flist;
2206:
2207: init_defaults(1); gp_preinit(1);
2208: if (setjmp(environnement))
2209: {
2210: pariputs("### Errors on startup, exiting...\n\n");
2211: exit(1);
2212: }
2213: #ifdef __MWERKS__
2214: argc = ccommand(&argv);
2215: #endif
2216: flist = read_opt(argc,argv);
2217: pari_addfunctions(&pari_modules, functions_gp,helpmessages_gp);
2218: pari_addfunctions(&pari_modules, functions_highlevel,helpmessages_highlevel);
2219: pari_addfunctions(&pari_oldmodules, functions_oldgp,helpmessages_oldgp);
2220:
2221: init_graph(); INIT_SIG_off;
2222: pari_init(parisize, primelimit);
2223: #ifndef WINCE
2224: pari_sig_init(gp_sighandler);
2225: #endif
2226: #ifdef READLINE
2227: init_readline();
2228: #endif
2229: gp_history_fun = gp_history;
2230: whatnow_fun = whatnow;
2231: gp_expand_path(path);
2232:
2233: if (!quiet_mode) gp_head();
2234: if (flist)
2235: {
2236: long c=chrono, b=bufindex, e=pariecho;
2237: FILE *l=logfile;
2238: char **s = flist;
2239: bufindex = 0; chrono=0; pariecho=0; logfile=NULL;
2240: for ( ; *s; s++) { read0(*s); free(*s); }
2241: bufindex = b; chrono=c; pariecho=e; logfile=l; free(flist);
2242: }
2243: gptimer(); timer2();
2244: (void)gp_main_loop();
2245: gp_quit(); return 0; /* not reached */
2246: }
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 / src / gp