Line data Source code
1 : /* Copyright (C) 2000 The PARI group.
2 :
3 : This file is part of the PARI/GP package.
4 :
5 : PARI/GP is free software; you can redistribute it and/or modify it under the
6 : terms of the GNU General Public License as published by the Free Software
7 : Foundation; either version 2 of the License, or (at your option) any later
8 : version. It is distributed in the hope that it will be useful, but WITHOUT
9 : ANY WARRANTY WHATSOEVER.
10 :
11 : Check the License for details. You should have received a copy of it, along
12 : with the package; see the file 'COPYING'. If not, write to the Free Software
13 : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
14 : #include "pari.h"
15 : #include "paripriv.h"
16 :
17 : #ifdef _WIN32
18 : # include "../systems/mingw/mingw.h"
19 : #endif
20 :
21 : /* Return all chars, up to next separator
22 : * [as strtok but must handle verbatim character string] */
23 : char*
24 1517 : get_sep(const char *t)
25 : {
26 1517 : char *buf = stack_malloc(strlen(t)+1);
27 1517 : char *s = buf;
28 1517 : int outer = 1;
29 :
30 : for(;;)
31 : {
32 5499 : switch(*s++ = *t++)
33 : {
34 112 : case '"':
35 112 : outer = !outer; break;
36 1510 : case '\0':
37 1510 : return buf;
38 0 : case ';':
39 0 : if (outer) { s[-1] = 0; return buf; }
40 0 : break;
41 7 : case '\\': /* gobble next char */
42 7 : if (! (*s++ = *t++) ) return buf;
43 : }
44 : }
45 : }
46 :
47 : /* "atoul" + optional [kmg] suffix */
48 : static ulong
49 1120 : my_int(char *s)
50 : {
51 1120 : ulong n = 0;
52 1120 : char *p = s;
53 :
54 3357 : while (isdigit((unsigned char)*p)) {
55 : ulong m;
56 2237 : if (n > (~0UL / 10)) pari_err(e_SYNTAX,"integer too large",s,s);
57 2237 : n *= 10; m = n;
58 2237 : n += *p++ - '0';
59 2237 : if (n < m) pari_err(e_SYNTAX,"integer too large",s,s);
60 : }
61 1120 : if (n)
62 : {
63 1071 : switch(*p)
64 : {
65 0 : case 'k': case 'K': n = umuluu_or_0(n,1000UL); p++; break;
66 305 : case 'm': case 'M': n = umuluu_or_0(n,1000000UL); p++; break;
67 0 : case 'g': case 'G': n = umuluu_or_0(n,1000000000UL); p++; break;
68 : #ifdef LONG_IS_64BIT
69 0 : case 't': case 'T': n = umuluu_or_0(n,1000000000000UL); p++; break;
70 : #endif
71 : }
72 1071 : if (!n) pari_err(e_SYNTAX,"integer too large",s,s);
73 : }
74 1120 : if (*p) pari_err(e_SYNTAX,"I was expecting an integer here", s, s);
75 1120 : return n;
76 : }
77 :
78 : long
79 44 : get_int(const char *s, long dflt)
80 : {
81 44 : pari_sp av = avma;
82 44 : char *p = get_sep(s);
83 : long n;
84 44 : int minus = 0;
85 :
86 44 : if (*p == '-') { minus = 1; p++; }
87 44 : if (!isdigit((unsigned char)*p)) return gc_long(av, dflt);
88 :
89 44 : n = (long)my_int(p);
90 44 : if (n < 0) pari_err(e_SYNTAX,"integer too large",s,s);
91 44 : return gc_long(av, minus? -n: n);
92 : }
93 :
94 : ulong
95 1076 : get_uint(const char *s)
96 : {
97 1076 : pari_sp av = avma;
98 1076 : char *p = get_sep(s);
99 1076 : if (*p == '-') pari_err(e_SYNTAX,"arguments must be positive integers",s,s);
100 1076 : return gc_ulong(av, my_int(p));
101 : }
102 :
103 : #if defined(__EMX__) || defined(_WIN32) || defined(__CYGWIN32__)
104 : # define PATH_SEPARATOR ';' /* beware DOSish 'C:' disk drives */
105 : #else
106 : # define PATH_SEPARATOR ':'
107 : #endif
108 :
109 : static const char *
110 1816 : pari_default_path(void) {
111 : #if PATH_SEPARATOR == ';'
112 : return ".;C:;C:/gp";
113 : #elif defined(UNIX)
114 1816 : return ".:~:~/gp";
115 : #else
116 : return ".";
117 : #endif
118 : }
119 :
120 : static void
121 7224 : delete_dirs(gp_path *p)
122 : {
123 7224 : char **v = p->dirs, **dirs;
124 7224 : if (v)
125 : {
126 3612 : p->dirs = NULL; /* in case of error */
127 9030 : for (dirs = v; *dirs; dirs++) pari_free(*dirs);
128 3612 : pari_free(v);
129 : }
130 7224 : }
131 :
132 : static void
133 3612 : expand_path(gp_path *p)
134 : {
135 3612 : char **dirs, *s, *v = p->PATH;
136 3612 : int i, n = 0;
137 :
138 3612 : delete_dirs(p);
139 3612 : if (*v)
140 : {
141 1806 : char *v0 = v = pari_strdup(v);
142 1806 : while (*v == PATH_SEPARATOR) v++; /* empty leading path components */
143 : /* First count non-empty path components. N.B. ignore empty ones */
144 16254 : for (s=v; *s; s++)
145 14448 : if (*s == PATH_SEPARATOR) { /* implies s > v */
146 3612 : *s = 0; /* path component */
147 3612 : if (s[-1] && s[1]) n++; /* ignore if previous is empty OR we are last */
148 : }
149 1806 : dirs = (char**) pari_malloc((n + 2)*sizeof(char *));
150 :
151 7224 : for (s=v, i=0; i<=n; i++)
152 : {
153 : char *end, *f;
154 5418 : while (!*s) s++; /* skip empty path components */
155 5418 : f = end = s + strlen(s);
156 5418 : while (f > s && *--f == '/') *f = 0; /* skip trailing '/' */
157 5418 : dirs[i] = path_expand(s);
158 5418 : s = end + 1; /* next path component */
159 : }
160 1806 : pari_free((void*)v0);
161 : }
162 : else
163 : {
164 1806 : dirs = (char**) pari_malloc(sizeof(char *));
165 1806 : i = 0;
166 : }
167 3612 : dirs[i] = NULL; p->dirs = dirs;
168 3612 : }
169 : void
170 1806 : pari_init_paths(void)
171 : {
172 1806 : expand_path(GP_DATA->path);
173 1806 : expand_path(GP_DATA->sopath);
174 1806 : }
175 :
176 : static void
177 3612 : delete_path(gp_path *p) { delete_dirs(p); free(p->PATH); }
178 : void
179 1806 : pari_close_paths(void)
180 : {
181 1806 : delete_path(GP_DATA->path);
182 1806 : delete_path(GP_DATA->sopath);
183 1806 : }
184 :
185 : /********************************************************************/
186 : /* */
187 : /* DEFAULTS */
188 : /* */
189 : /********************************************************************/
190 :
191 : long
192 0 : getrealprecision(void)
193 : {
194 0 : return GP_DATA->fmt->sigd;
195 : }
196 :
197 : long
198 0 : setrealprecision(long n, long *prec)
199 : {
200 0 : GP_DATA->fmt->sigd = n;
201 0 : *prec = ndec2prec(n);
202 0 : precreal = prec2nbits(*prec);
203 0 : return n;
204 : }
205 :
206 : GEN
207 44 : sd_toggle(const char *v, long flag, const char *s, int *ptn)
208 : {
209 44 : int state = *ptn;
210 44 : if (v)
211 : {
212 44 : int n = (int)get_int(v,0);
213 44 : if (n == state) return gnil;
214 44 : if (n != !state)
215 : {
216 0 : char *t = stack_malloc(64 + strlen(s));
217 0 : (void)sprintf(t, "default: incorrect value for %s [0:off / 1:on]", s);
218 0 : pari_err(e_SYNTAX, t, v,v);
219 : }
220 44 : state = *ptn = n;
221 : }
222 44 : switch(flag)
223 : {
224 0 : case d_RETURN: return utoi(state);
225 0 : case d_ACKNOWLEDGE:
226 0 : if (state) pari_printf(" %s = 1 (on)\n", s);
227 0 : else pari_printf(" %s = 0 (off)\n", s);
228 0 : break;
229 : }
230 44 : return gnil;
231 : }
232 :
233 : static void
234 1076 : sd_ulong_init(const char *v, const char *s, ulong *ptn, ulong Min, ulong Max)
235 : {
236 1076 : if (v)
237 : {
238 1076 : ulong n = get_uint(v);
239 1076 : if (n > Max || n < Min)
240 : {
241 2 : char *buf = stack_malloc(strlen(s) + 2 * 20 + 40);
242 2 : (void)sprintf(buf, "default: incorrect value for %s [%lu-%lu]",
243 : s, Min, Max);
244 2 : pari_err(e_SYNTAX, buf, v,v);
245 : }
246 1074 : *ptn = n;
247 : }
248 1074 : }
249 :
250 : /* msg is NULL or NULL-terminated array with msg[0] != NULL. */
251 : GEN
252 625 : sd_ulong(const char *v, long flag, const char *s, ulong *ptn, ulong Min, ulong Max,
253 : const char **msg)
254 : {
255 625 : ulong n = *ptn;
256 625 : sd_ulong_init(v, s, ptn, Min, Max);
257 623 : switch(flag)
258 : {
259 0 : case d_RETURN:
260 0 : return utoi(*ptn);
261 151 : case d_ACKNOWLEDGE:
262 151 : if (!v || *ptn != n) {
263 151 : if (!msg) /* no specific message */
264 144 : pari_printf(" %s = %lu\n", s, *ptn);
265 7 : else if (!msg[1]) /* single message, always printed */
266 7 : pari_printf(" %s = %lu %s\n", s, *ptn, msg[0]);
267 : else /* print (new)-n-th message */
268 0 : pari_printf(" %s = %lu %s\n", s, *ptn, msg[*ptn]);
269 : }
270 151 : break;
271 : }
272 623 : return gnil;
273 : }
274 :
275 : static void
276 21 : err_intarray(char *t, char *p, const char *s)
277 : {
278 21 : char *b = stack_malloc(64 + strlen(s));
279 21 : sprintf(b, "incorrect value for %s", s);
280 21 : pari_err(e_SYNTAX, b, p, t);
281 0 : }
282 : static GEN
283 39 : parse_intarray(const char *v, const char *s)
284 : {
285 39 : pari_sp av = avma;
286 39 : char *p, *t = gp_filter(v);
287 : long i, l;
288 : GEN w;
289 39 : if (*t != '[') err_intarray(t, t, s);
290 32 : if (t[1] == ']') return gc_const(av, cgetalloc(1, t_VECSMALL));
291 125 : for (p = t+1, l=2; *p; p++)
292 111 : if (*p == ',') l++;
293 70 : else if (*p < '0' || *p > '9') break;
294 32 : if (*p != ']') err_intarray(t, p, s);
295 18 : w = cgetalloc(l, t_VECSMALL);
296 70 : for (p = t+1, i=0; *p; p++)
297 : {
298 52 : long n = 0;
299 97 : while (*p >= '0' && *p <= '9') n = 10*n + (*p++ -'0');
300 52 : w[++i] = n;
301 : }
302 18 : return gc_const(av, w);
303 : }
304 : GEN
305 39 : sd_intarray(const char *v, long flag, GEN *pz, const char *s)
306 : {
307 39 : if (v) { GEN z = *pz; *pz = parse_intarray(v, s); pari_free(z); }
308 18 : switch(flag)
309 : {
310 0 : case d_RETURN: return zv_to_ZV(*pz);
311 0 : case d_ACKNOWLEDGE: pari_printf(" %s = %Ps\n", s, zv_to_ZV(*pz));
312 : }
313 18 : return gnil;
314 : }
315 :
316 : GEN
317 430 : sd_realprecision(const char *v, long flag)
318 : {
319 430 : pariout_t *fmt = GP_DATA->fmt;
320 430 : if (v)
321 : {
322 430 : ulong newnb = fmt->sigd;
323 : long prec;
324 430 : sd_ulong_init(v, "realprecision", &newnb, 1, prec2ndec(LGBITS));
325 451 : if (fmt->sigd == (long)newnb) return gnil;
326 416 : if (fmt->sigd >= 0) fmt->sigd = newnb;
327 416 : prec = ndec2nbits(newnb);
328 416 : if (prec == precreal) return gnil;
329 395 : precreal = prec;
330 : }
331 395 : if (flag == d_RETURN) return stoi(nbits2ndec(precreal));
332 395 : if (flag == d_ACKNOWLEDGE)
333 : {
334 179 : long n = nbits2ndec(precreal);
335 179 : pari_printf(" realprecision = %ld significant digits", n);
336 179 : if (fmt->sigd < 0)
337 0 : pari_puts(" (all digits displayed)");
338 179 : else if (n != fmt->sigd)
339 21 : pari_printf(" (%ld digits displayed)", fmt->sigd);
340 179 : pari_putc('\n');
341 : }
342 395 : return gnil;
343 : }
344 :
345 : GEN
346 21 : sd_realbitprecision(const char *v, long flag)
347 : {
348 21 : pariout_t *fmt = GP_DATA->fmt;
349 21 : if (v)
350 : {
351 21 : ulong newnb = precreal;
352 : long n;
353 21 : sd_ulong_init(v, "realbitprecision", &newnb, 1, prec2nbits(LGBITS));
354 21 : if ((long)newnb == precreal) return gnil;
355 21 : n = nbits2ndec(newnb);
356 21 : if (!n) n = 1;
357 21 : if (fmt->sigd >= 0) fmt->sigd = n;
358 21 : precreal = (long) newnb;
359 : }
360 21 : if (flag == d_RETURN) return stoi(precreal);
361 21 : if (flag == d_ACKNOWLEDGE)
362 : {
363 14 : pari_printf(" realbitprecision = %ld significant bits", precreal);
364 14 : if (fmt->sigd < 0)
365 0 : pari_puts(" (all digits displayed)");
366 : else
367 14 : pari_printf(" (%ld decimal digits displayed)", fmt->sigd);
368 14 : pari_putc('\n');
369 : }
370 21 : return gnil;
371 : }
372 :
373 : GEN
374 35 : sd_seriesprecision(const char *v, long flag)
375 : {
376 35 : const char *msg[] = {"significant terms", NULL};
377 35 : return sd_ulong(v,flag,"seriesprecision",&precdl, 1,LGBITS,msg);
378 : }
379 :
380 : static long
381 28 : gp_get_color(char **st)
382 : {
383 28 : char *s, *v = *st;
384 : int trans;
385 : long c;
386 28 : if (isdigit((unsigned)*v))
387 28 : { c = atol(v); trans = 1; } /* color on transparent background */
388 : else
389 : {
390 0 : if (*v == '[')
391 : {
392 : const char *a[3];
393 0 : long i = 0;
394 0 : for (a[0] = s = ++v; *s && *s != ']'; s++)
395 0 : if (*s == ',') { *s = 0; a[++i] = s+1; }
396 0 : if (*s != ']') pari_err(e_SYNTAX,"expected character: ']'",s, *st);
397 0 : *s = 0; for (i++; i<3; i++) a[i] = "";
398 : /* properties | color | background */
399 0 : c = (atoi(a[2])<<8) | atoi(a[0]) | (atoi(a[1])<<4);
400 0 : trans = (*(a[1]) == 0);
401 0 : v = s + 1;
402 : }
403 0 : else { c = c_NONE; trans = 0; }
404 : }
405 28 : if (trans) c = c | (1L<<12);
406 56 : while (*v && *v++ != ',') /* empty */;
407 28 : if (c != c_NONE) disable_color = 0;
408 28 : *st = v; return c;
409 : }
410 :
411 : /* 1: error, 2: history, 3: prompt, 4: input, 5: output, 6: help, 7: timer */
412 : GEN
413 4 : sd_colors(const char *v, long flag)
414 : {
415 : long c,l;
416 4 : if (v && !(GP_DATA->flags & (gpd_EMACS|gpd_TEXMACS)))
417 : {
418 4 : pari_sp av = avma;
419 : char *s;
420 4 : disable_color=1;
421 4 : l = strlen(v);
422 4 : if (l <= 2 && strncmp(v, "no", l) == 0)
423 0 : v = "";
424 4 : else if (l <= 6 && strncmp(v, "darkbg", l) == 0)
425 0 : v = "1, 5, 3, 7, 6, 2, 3"; /* assume recent readline. */
426 4 : else if (l <= 7 && strncmp(v, "lightbg", l) == 0)
427 4 : v = "1, 6, 3, 4, 5, 2, 3"; /* assume recent readline. */
428 0 : else if (l <= 8 && strncmp(v, "brightfg", l) == 0) /* windows console */
429 0 : v = "9, 13, 11, 15, 14, 10, 11";
430 0 : else if (l <= 6 && strncmp(v, "boldfg", l) == 0) /* darkbg console */
431 0 : v = "[1,,1], [5,,1], [3,,1], [7,,1], [6,,1], , [2,,1]";
432 4 : s = gp_filter(v);
433 32 : for (c=c_ERR; c < c_LAST; c++) gp_colors[c] = gp_get_color(&s);
434 4 : set_avma(av);
435 : }
436 4 : if (flag == d_ACKNOWLEDGE || flag == d_RETURN)
437 : {
438 0 : char s[128], *t = s;
439 : long col[3], n;
440 0 : for (*t=0,c=c_ERR; c < c_LAST; c++)
441 : {
442 0 : n = gp_colors[c];
443 0 : if (n == c_NONE)
444 0 : sprintf(t,"no");
445 : else
446 : {
447 0 : decode_color(n,col);
448 0 : if (n & (1L<<12))
449 : {
450 0 : if (col[0])
451 0 : sprintf(t,"[%ld,,%ld]",col[1],col[0]);
452 : else
453 0 : sprintf(t,"%ld",col[1]);
454 : }
455 : else
456 0 : sprintf(t,"[%ld,%ld,%ld]",col[1],col[2],col[0]);
457 : }
458 0 : t += strlen(t);
459 0 : if (c < c_LAST - 1) { *t++=','; *t++=' '; }
460 : }
461 0 : if (flag==d_RETURN) return strtoGENstr(s);
462 0 : pari_printf(" colors = \"%s\"\n",s);
463 : }
464 4 : return gnil;
465 : }
466 :
467 : GEN
468 7 : sd_format(const char *v, long flag)
469 : {
470 7 : pariout_t *fmt = GP_DATA->fmt;
471 7 : if (v)
472 : {
473 7 : char c = *v;
474 7 : if (c!='e' && c!='f' && c!='g')
475 0 : pari_err(e_SYNTAX,"default: inexistent format",v,v);
476 7 : fmt->format = c; v++;
477 :
478 7 : if (isdigit((unsigned char)*v))
479 0 : { while (isdigit((unsigned char)*v)) v++; } /* FIXME: skip obsolete field width */
480 7 : if (*v++ == '.')
481 : {
482 7 : if (*v == '-') fmt->sigd = -1;
483 : else
484 7 : if (isdigit((unsigned char)*v)) fmt->sigd=atol(v);
485 : }
486 : }
487 7 : if (flag == d_RETURN)
488 : {
489 0 : char *s = stack_malloc(64);
490 0 : (void)sprintf(s, "%c.%ld", fmt->format, fmt->sigd);
491 0 : return strtoGENstr(s);
492 : }
493 7 : if (flag == d_ACKNOWLEDGE)
494 0 : pari_printf(" format = %c.%ld\n", fmt->format, fmt->sigd);
495 7 : return gnil;
496 : }
497 :
498 : GEN
499 0 : sd_compatible(const char *v, long flag)
500 : {
501 0 : const char *msg[] = {
502 : "(no backward compatibility)",
503 : "(no backward compatibility)",
504 : "(no backward compatibility)",
505 : "(no backward compatibility)", NULL
506 : };
507 0 : ulong junk = 0;
508 0 : return sd_ulong(v,flag,"compatible",&junk, 0,3,msg);
509 : }
510 :
511 : GEN
512 0 : sd_secure(const char *v, long flag)
513 : {
514 0 : if (v && GP_DATA->secure)
515 0 : pari_ask_confirm("[secure mode]: About to modify the 'secure' flag");
516 0 : return sd_toggle(v,flag,"secure", &(GP_DATA->secure));
517 : }
518 :
519 : GEN
520 28 : sd_debug(const char *v, long flag)
521 : {
522 28 : GEN r = sd_ulong(v,flag,"debug",&DEBUGLEVEL, 0,20,NULL);
523 28 : if (v) setalldebug(DEBUGLEVEL);
524 28 : return r;
525 : }
526 :
527 : GEN
528 21 : sd_debugfiles(const char *v, long flag)
529 21 : { return sd_ulong(v,flag,"debugfiles",&DEBUGLEVEL_io, 0,20,NULL); }
530 :
531 : GEN
532 0 : sd_debugmem(const char *v, long flag)
533 0 : { return sd_ulong(v,flag,"debugmem",&DEBUGMEM, 0,20,NULL); }
534 :
535 : /* set D->hist to size = s / total = t */
536 : static void
537 1830 : init_hist(gp_data *D, size_t s, ulong t)
538 : {
539 1830 : gp_hist *H = D->hist;
540 1830 : H->total = t;
541 1830 : H->size = s;
542 1830 : H->v = (gp_hist_cell*)pari_calloc(s * sizeof(gp_hist_cell));
543 1830 : }
544 : GEN
545 14 : sd_histsize(const char *s, long flag)
546 : {
547 14 : gp_hist *H = GP_DATA->hist;
548 14 : ulong n = H->size;
549 14 : GEN r = sd_ulong(s,flag,"histsize",&n, 1,
550 : (LONG_MAX / sizeof(long)) - 1,NULL);
551 14 : if (n != H->size)
552 : {
553 14 : const ulong total = H->total;
554 : long g, h, k, kmin;
555 14 : gp_hist_cell *v = H->v, *w; /* v = old data, w = new one */
556 14 : size_t sv = H->size, sw;
557 :
558 14 : init_hist(GP_DATA, n, total);
559 14 : if (!total) return r;
560 :
561 14 : w = H->v;
562 14 : sw= H->size;
563 : /* copy relevant history entries */
564 14 : g = (total-1) % sv;
565 14 : h = k = (total-1) % sw;
566 14 : kmin = k - minss(sw, sv);
567 28 : for ( ; k > kmin; k--, g--, h--)
568 : {
569 14 : w[h] = v[g];
570 14 : v[g].z = NULL;
571 14 : if (!g) g = sv;
572 14 : if (!h) h = sw;
573 : }
574 : /* clean up */
575 84 : for ( ; v[g].z; g--)
576 : {
577 70 : gunclone(v[g].z);
578 70 : if (!g) g = sv;
579 : }
580 14 : pari_free((void*)v);
581 : }
582 14 : return r;
583 : }
584 :
585 : static void
586 0 : TeX_define(const char *s, const char *def) {
587 0 : fprintf(pari_logfile, "\\ifx\\%s\\undefined\n \\def\\%s{%s}\\fi\n", s,s,def);
588 0 : }
589 : static void
590 0 : TeX_define2(const char *s, const char *def) {
591 0 : fprintf(pari_logfile, "\\ifx\\%s\\undefined\n \\def\\%s#1#2{%s}\\fi\n", s,s,def);
592 0 : }
593 :
594 : static FILE *
595 0 : open_logfile(const char *s) {
596 0 : FILE *log = fopen(s, "a");
597 0 : if (!log) pari_err_FILE("logfile",s);
598 0 : setbuf(log,(char *)NULL);
599 0 : return log;
600 : }
601 :
602 : GEN
603 0 : sd_log(const char *v, long flag)
604 : {
605 0 : const char *msg[] = {
606 : "(off)",
607 : "(on)",
608 : "(on with colors)",
609 : "(TeX output)", NULL
610 : };
611 0 : ulong s = pari_logstyle;
612 0 : GEN res = sd_ulong(v,flag,"log", &s, 0, 3, msg);
613 :
614 0 : if (!s != !pari_logstyle) /* Compare converts to boolean */
615 : { /* toggled LOG */
616 0 : if (pari_logstyle)
617 : { /* close log */
618 0 : if (flag == d_ACKNOWLEDGE)
619 0 : pari_printf(" [logfile was \"%s\"]\n", current_logfile);
620 0 : if (pari_logfile) { fclose(pari_logfile); pari_logfile = NULL; }
621 : }
622 : else
623 : {
624 0 : pari_logfile = open_logfile(current_logfile);
625 0 : if (flag == d_ACKNOWLEDGE)
626 0 : pari_printf(" [logfile is \"%s\"]\n", current_logfile);
627 0 : else if (flag == d_INITRC)
628 0 : pari_printf("Logging to %s\n", current_logfile);
629 : }
630 : }
631 0 : if (pari_logfile && s != pari_logstyle && s == logstyle_TeX)
632 : {
633 0 : TeX_define("PARIbreak",
634 : "\\hskip 0pt plus \\hsize\\relax\\discretionary{}{}{}");
635 0 : TeX_define("PARIpromptSTART", "\\vskip\\medskipamount\\bgroup\\bf");
636 0 : TeX_define("PARIpromptEND", "\\egroup\\bgroup\\tt");
637 0 : TeX_define("PARIinputEND", "\\egroup");
638 0 : TeX_define2("PARIout",
639 : "\\vskip\\smallskipamount$\\displaystyle{\\tt\\%#1} = #2$");
640 : }
641 : /* don't record new value until we are sure everything is fine */
642 0 : pari_logstyle = s; return res;
643 : }
644 :
645 : GEN
646 0 : sd_TeXstyle(const char *v, long flag)
647 : {
648 0 : const char *msg[] = { "(bits 0x2/0x4 control output of \\left/\\PARIbreak)",
649 : NULL };
650 0 : ulong n = GP_DATA->fmt->TeXstyle;
651 0 : GEN z = sd_ulong(v,flag,"TeXstyle", &n, 0, 7, msg);
652 0 : GP_DATA->fmt->TeXstyle = n; return z;
653 : }
654 :
655 : GEN
656 7 : sd_nbthreads(const char *v, long flag)
657 7 : { return sd_ulong(v,flag,"nbthreads",&pari_mt_nbthreads, 1,LONG_MAX,NULL); }
658 :
659 : GEN
660 0 : sd_output(const char *v, long flag)
661 : {
662 0 : const char *msg[] = {"(raw)", "(prettymatrix)", "(prettyprint)",
663 : "(external prettyprint)", NULL};
664 0 : ulong n = GP_DATA->fmt->prettyp;
665 0 : GEN z = sd_ulong(v,flag,"output", &n, 0,3,msg);
666 0 : GP_DATA->fmt->prettyp = n;
667 0 : GP_DATA->fmt->sp = (n != f_RAW);
668 0 : return z;
669 : }
670 :
671 : GEN
672 0 : sd_parisizemax(const char *v, long flag)
673 : {
674 0 : ulong size = pari_mainstack->vsize, n = size;
675 0 : GEN r = sd_ulong(v,flag,"parisizemax",&n, 0,LONG_MAX,NULL);
676 0 : if (n != size) {
677 0 : if (flag == d_INITRC)
678 0 : paristack_setsize(pari_mainstack->rsize, n);
679 : else
680 0 : parivstack_resize(n);
681 : }
682 0 : return r;
683 : }
684 :
685 : GEN
686 314 : sd_parisize(const char *v, long flag)
687 : {
688 314 : ulong rsize = pari_mainstack->rsize, n = rsize;
689 314 : GEN r = sd_ulong(v,flag,"parisize",&n, 10000,LONG_MAX,NULL);
690 312 : if (n != rsize) {
691 312 : if (flag == d_INITRC)
692 0 : paristack_setsize(n, pari_mainstack->vsize);
693 : else
694 312 : paristack_newrsize(n);
695 : }
696 0 : return r;
697 : }
698 :
699 : GEN
700 0 : sd_threadsizemax(const char *v, long flag)
701 : {
702 0 : ulong size = GP_DATA->threadsizemax, n = size;
703 0 : GEN r = sd_ulong(v,flag,"threadsizemax",&n, 0,LONG_MAX,NULL);
704 0 : if (n != size)
705 0 : GP_DATA->threadsizemax = n;
706 0 : return r;
707 : }
708 :
709 : GEN
710 0 : sd_threadsize(const char *v, long flag)
711 : {
712 0 : ulong size = GP_DATA->threadsize, n = size;
713 0 : GEN r = sd_ulong(v,flag,"threadsize",&n, 0,LONG_MAX,NULL);
714 0 : if (n != size)
715 0 : GP_DATA->threadsize = n;
716 0 : return r;
717 : }
718 :
719 : GEN
720 14 : sd_primelimit(const char *v, long flag)
721 14 : { return sd_ulong(v,flag,"primelimit",&(GP_DATA->primelimit),
722 : 0,2*(ulong)(LONG_MAX-1024) + 1,NULL); }
723 :
724 : GEN
725 0 : sd_simplify(const char *v, long flag)
726 0 : { return sd_toggle(v,flag,"simplify", &(GP_DATA->simplify)); }
727 :
728 : GEN
729 0 : sd_strictmatch(const char *v, long flag)
730 0 : { return sd_toggle(v,flag,"strictmatch", &(GP_DATA->strictmatch)); }
731 :
732 : GEN
733 7 : sd_strictargs(const char *v, long flag)
734 7 : { return sd_toggle(v,flag,"strictargs", &(GP_DATA->strictargs)); }
735 :
736 : GEN
737 4 : sd_string(const char *v, long flag, const char *s, char **pstr)
738 : {
739 4 : char *old = *pstr;
740 4 : if (v)
741 : {
742 4 : char *str, *ev = path_expand(v);
743 4 : long l = strlen(ev) + 256;
744 4 : str = (char *) pari_malloc(l);
745 4 : strftime_expand(ev,str, l-1); pari_free(ev);
746 4 : if (GP_DATA->secure)
747 : {
748 0 : char *msg=pari_sprintf("[secure mode]: About to change %s to '%s'",s,str);
749 0 : pari_ask_confirm(msg);
750 0 : pari_free(msg);
751 : }
752 4 : if (old) pari_free(old);
753 4 : *pstr = old = pari_strdup(str);
754 4 : pari_free(str);
755 : }
756 0 : else if (!old) old = (char*)"<undefined>";
757 4 : if (flag == d_RETURN) return strtoGENstr(old);
758 4 : if (flag == d_ACKNOWLEDGE) pari_printf(" %s = \"%s\"\n",s,old);
759 4 : return gnil;
760 : }
761 :
762 : GEN
763 0 : sd_logfile(const char *v, long flag)
764 : {
765 0 : GEN r = sd_string(v, flag, "logfile", ¤t_logfile);
766 0 : if (v && pari_logfile)
767 : {
768 0 : FILE *log = open_logfile(current_logfile);
769 0 : fclose(pari_logfile); pari_logfile = log;
770 : }
771 0 : return r;
772 : }
773 :
774 : GEN
775 0 : sd_factor_add_primes(const char *v, long flag)
776 0 : { return sd_toggle(v,flag,"factor_add_primes", &factor_add_primes); }
777 :
778 : GEN
779 0 : sd_factor_proven(const char *v, long flag)
780 0 : { return sd_toggle(v,flag,"factor_proven", &factor_proven); }
781 :
782 : GEN
783 28 : sd_new_galois_format(const char *v, long flag)
784 28 : { return sd_toggle(v,flag,"new_galois_format", &new_galois_format); }
785 :
786 : GEN
787 40 : sd_datadir(const char *v, long flag)
788 : {
789 : const char *str;
790 40 : if (v)
791 : {
792 7 : mt_broadcast(snm_closure(is_entry("default"),
793 : mkvec2(strtoGENstr("datadir"), strtoGENstr(v))));
794 7 : if (pari_datadir) pari_free(pari_datadir);
795 7 : pari_datadir = path_expand(v);
796 : }
797 40 : str = pari_datadir? pari_datadir: "none";
798 40 : if (flag == d_RETURN) return strtoGENstr(str);
799 7 : if (flag == d_ACKNOWLEDGE)
800 0 : pari_printf(" datadir = \"%s\"\n", str);
801 7 : return gnil;
802 : }
803 :
804 : static GEN
805 0 : sd_PATH(const char *v, long flag, const char* s, gp_path *p)
806 : {
807 0 : if (v)
808 : {
809 0 : mt_broadcast(snm_closure(is_entry("default"),
810 : mkvec2(strtoGENstr(s), strtoGENstr(v))));
811 0 : pari_free((void*)p->PATH);
812 0 : p->PATH = pari_strdup(v);
813 0 : if (flag == d_INITRC) return gnil;
814 0 : expand_path(p);
815 : }
816 0 : if (flag == d_RETURN) return strtoGENstr(p->PATH);
817 0 : if (flag == d_ACKNOWLEDGE)
818 0 : pari_printf(" %s = \"%s\"\n", s, p->PATH);
819 0 : return gnil;
820 : }
821 : GEN
822 0 : sd_path(const char *v, long flag)
823 0 : { return sd_PATH(v, flag, "path", GP_DATA->path); }
824 : GEN
825 0 : sd_sopath(char *v, int flag)
826 0 : { return sd_PATH(v, flag, "sopath", GP_DATA->sopath); }
827 :
828 : static const char *DFT_PRETTYPRINTER = "tex2mail -TeX -noindent -ragged -by_par";
829 : GEN
830 0 : sd_prettyprinter(const char *v, long flag)
831 : {
832 0 : gp_pp *pp = GP_DATA->pp;
833 0 : if (v && !(GP_DATA->flags & gpd_TEXMACS))
834 : {
835 0 : char *old = pp->cmd;
836 0 : int cancel = (!strcmp(v,"no"));
837 :
838 0 : if (GP_DATA->secure)
839 0 : pari_err(e_MISC,"[secure mode]: can't modify 'prettyprinter' default (to %s)",v);
840 0 : if (!strcmp(v,"yes")) v = DFT_PRETTYPRINTER;
841 0 : if (old && strcmp(old,v) && pp->file)
842 : {
843 : pariFILE *f;
844 0 : if (cancel) f = NULL;
845 : else
846 : {
847 0 : f = try_pipe(v, mf_OUT);
848 0 : if (!f)
849 : {
850 0 : pari_warn(warner,"broken prettyprinter: '%s'",v);
851 0 : return gnil;
852 : }
853 : }
854 0 : pari_fclose(pp->file);
855 0 : pp->file = f;
856 : }
857 0 : pp->cmd = cancel? NULL: pari_strdup(v);
858 0 : if (old) pari_free(old);
859 0 : if (flag == d_INITRC) return gnil;
860 : }
861 0 : if (flag == d_RETURN)
862 0 : return strtoGENstr(pp->cmd? pp->cmd: "");
863 0 : if (flag == d_ACKNOWLEDGE)
864 0 : pari_printf(" prettyprinter = \"%s\"\n",pp->cmd? pp->cmd: "");
865 0 : return gnil;
866 : }
867 :
868 : /* compare entrees s1 s2 according to the attached function name */
869 : static int
870 0 : compare_name(const void *s1, const void *s2) {
871 0 : entree *e1 = *(entree**)s1, *e2 = *(entree**)s2;
872 0 : return strcmp(e1->name, e2->name);
873 : }
874 : static void
875 0 : defaults_list(pari_stack *s)
876 : {
877 : entree *ep;
878 : long i;
879 0 : for (i = 0; i < functions_tblsz; i++)
880 0 : for (ep = defaults_hash[i]; ep; ep = ep->next) pari_stack_pushp(s, ep);
881 0 : }
882 : /* ep attached to function f of arity 2. Call f(v,flag) */
883 : static GEN
884 839 : call_f2(entree *ep, const char *v, long flag)
885 839 : { return ((GEN (*)(const char*,long))ep->value)(v, flag); }
886 : GEN
887 839 : setdefault(const char *s, const char *v, long flag)
888 : {
889 : entree *ep;
890 839 : if (!s)
891 : { /* list all defaults */
892 : pari_stack st;
893 : entree **L;
894 : long i;
895 0 : pari_stack_init(&st, sizeof(*L), (void**)&L);
896 0 : defaults_list(&st);
897 0 : qsort (L, st.n, sizeof(*L), compare_name);
898 0 : for (i = 0; i < st.n; i++) (void)call_f2(L[i], NULL, d_ACKNOWLEDGE);
899 0 : pari_stack_delete(&st);
900 0 : return gnil;
901 : }
902 839 : ep = pari_is_default(s);
903 839 : if (!ep)
904 : {
905 0 : pari_err(e_MISC,"unknown default: %s",s);
906 : return NULL; /* LCOV_EXCL_LINE */
907 : }
908 839 : return call_f2(ep, v, flag);
909 : }
910 :
911 : GEN
912 821 : default0(const char *a, const char *b) { return setdefault(a,b, b? d_SILENT: d_RETURN); }
913 :
914 : /********************************************************************/
915 : /* */
916 : /* INITIALIZE GP_DATA */
917 : /* */
918 : /********************************************************************/
919 : /* initialize path */
920 : static void
921 3632 : init_path(gp_path *path, const char *v)
922 : {
923 3632 : path->PATH = pari_strdup(v);
924 3632 : path->dirs = NULL;
925 3632 : }
926 :
927 : /* initialize D->fmt */
928 : static void
929 1816 : init_fmt(gp_data *D)
930 : {
931 : static pariout_t DFLT_OUTPUT = { 'g', 38, 1, f_PRETTYMAT, 0 };
932 1816 : D->fmt = &DFLT_OUTPUT;
933 1816 : }
934 :
935 : /* initialize D->pp */
936 : static void
937 1816 : init_pp(gp_data *D)
938 : {
939 1816 : gp_pp *p = D->pp;
940 1816 : p->cmd = pari_strdup(DFT_PRETTYPRINTER);
941 1816 : p->file = NULL;
942 1816 : }
943 :
944 : static char *
945 1816 : init_help(void)
946 : {
947 1816 : char *h = os_getenv("GPHELP");
948 1816 : if (!h) h = (char*)paricfg_gphelp;
949 : #ifdef _WIN32
950 : win32_set_pdf_viewer();
951 : #endif
952 1816 : if (h) h = pari_strdup(h);
953 1816 : return h;
954 : }
955 :
956 : static void
957 1816 : init_graphs(gp_data *D)
958 : {
959 1816 : const char *cols[] = { "",
960 : "white","black","blue","violetred","red","green","grey","gainsboro"
961 : };
962 1816 : const long N = 8;
963 1816 : GEN c = cgetalloc(3, t_VECSMALL), s;
964 : long i;
965 1816 : c[1] = 4;
966 1816 : c[2] = 5;
967 1816 : D->graphcolors = c;
968 1816 : c = (GEN)pari_malloc((N+1 + 4*N)*sizeof(long));
969 1816 : c[0] = evaltyp(t_VEC)|evallg(N+1);
970 16344 : for (i = 1, s = c+N+1; i <= N; i++, s += 4)
971 : {
972 14528 : GEN lp = s;
973 14528 : lp[0] = evaltyp(t_STR)|evallg(4);
974 14528 : strcpy(GSTR(lp), cols[i]);
975 14528 : gel(c,i) = lp;
976 : }
977 1816 : D->colormap = c;
978 1816 : }
979 :
980 : gp_data *
981 1816 : default_gp_data(void)
982 : {
983 : static gp_data __GPDATA, *D = &__GPDATA;
984 : static gp_hist __HIST;
985 : static gp_pp __PP;
986 : static gp_path __PATH, __SOPATH;
987 : static pari_timer __T, __Tw;
988 :
989 1816 : D->flags = 0;
990 1816 : D->primelimit = 1UL << 20;
991 :
992 : /* GP-specific */
993 1816 : D->breakloop = 1;
994 1816 : D->echo = 0;
995 1816 : D->lim_lines = 0;
996 1816 : D->linewrap = 0;
997 1816 : D->recover = 1;
998 1816 : D->chrono = 0;
999 :
1000 1816 : D->strictargs = 0;
1001 1816 : D->strictmatch = 1;
1002 1816 : D->simplify = 1;
1003 1816 : D->secure = 0;
1004 1816 : D->use_readline= 0;
1005 1816 : D->T = &__T;
1006 1816 : D->Tw = &__Tw;
1007 1816 : D->hist = &__HIST;
1008 1816 : D->pp = &__PP;
1009 1816 : D->path = &__PATH;
1010 1816 : D->sopath=&__SOPATH;
1011 1816 : init_fmt(D);
1012 1816 : init_hist(D, 5000, 0);
1013 1816 : init_path(D->path, pari_default_path());
1014 1816 : init_path(D->sopath, "");
1015 1816 : init_pp(D);
1016 1816 : init_graphs(D);
1017 1816 : D->plothsizes = cgetalloc(1, t_VECSMALL);
1018 1816 : D->prompt_comment = (char*)"comment> ";
1019 1816 : D->prompt = pari_strdup("? ");
1020 1816 : D->prompt_cont = pari_strdup("");
1021 1816 : D->help = init_help();
1022 1816 : D->readline_state = DO_ARGS_COMPLETE;
1023 1816 : D->histfile = NULL;
1024 1816 : return D;
1025 : }
|
