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