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