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