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