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 :
15 : /*******************************************************************/
16 : /** **/
17 : /** LIBRARY ROUTINES FOR PARI CALCULATOR **/
18 : /** **/
19 : /*******************************************************************/
20 : #ifdef _WIN32
21 : # include "../systems/mingw/pwinver.h"
22 : # include <windows.h>
23 : # include "../systems/mingw/mingw.h"
24 : # include <process.h>
25 : #endif
26 :
27 : #include "pari.h"
28 : #include "paripriv.h"
29 :
30 : /********************************************************************/
31 : /** **/
32 : /** STRINGS **/
33 : /** **/
34 : /********************************************************************/
35 :
36 : void
37 28 : pari_skip_space(char **s) {
38 28 : char *t = *s;
39 28 : while (isspace((unsigned char)*t)) t++;
40 28 : *s = t;
41 28 : }
42 : void
43 0 : pari_skip_alpha(char **s) {
44 0 : char *t = *s;
45 0 : while (isalpha((unsigned char)*t)) t++;
46 0 : *s = t;
47 0 : }
48 :
49 : /*******************************************************************/
50 : /** **/
51 : /** BUFFERS **/
52 : /** **/
53 : /*******************************************************************/
54 : static Buffer **bufstack;
55 : static pari_stack s_bufstack;
56 : void
57 1900 : pari_init_buffers(void)
58 1900 : { pari_stack_init(&s_bufstack, sizeof(Buffer*), (void**)&bufstack); }
59 :
60 : void
61 1964 : pop_buffer(void)
62 : {
63 1964 : if (s_bufstack.n)
64 1964 : delete_buffer( bufstack[ --s_bufstack.n ] );
65 1964 : }
66 :
67 : /* kill all buffers until B is met or nothing is left */
68 : void
69 15340 : kill_buffers_upto(Buffer *B)
70 : {
71 17237 : while (s_bufstack.n) {
72 15347 : if (bufstack[ s_bufstack.n-1 ] == B) break;
73 1897 : pop_buffer();
74 : }
75 15340 : }
76 : void
77 0 : kill_buffers_upto_including(Buffer *B)
78 : {
79 0 : while (s_bufstack.n) {
80 0 : if (bufstack[ s_bufstack.n-1 ] == B) { pop_buffer(); break; }
81 0 : pop_buffer();
82 : }
83 0 : }
84 :
85 : static int disable_exception_handler = 0;
86 : #define BLOCK_EH_START \
87 : { \
88 : int block=disable_exception_handler;\
89 : disable_exception_handler = 1;
90 :
91 : #define BLOCK_EH_END \
92 : disable_exception_handler = block;\
93 : }
94 : /* numerr < 0: from SIGINT */
95 : int
96 13019 : gp_handle_exception(long numerr)
97 : {
98 13019 : if (disable_exception_handler)
99 0 : disable_exception_handler = 0;
100 13019 : else if (GP_DATA->breakloop && cb_pari_break_loop
101 56 : && cb_pari_break_loop(numerr))
102 0 : return 1;
103 13012 : return 0;
104 : }
105 :
106 : /********************************************************************/
107 : /** **/
108 : /** HELP **/
109 : /** **/
110 : /********************************************************************/
111 : void
112 0 : pari_hit_return(void)
113 : {
114 : int c;
115 0 : if (GP_DATA->flags & (gpd_EMACS|gpd_TEXMACS)) return;
116 0 : BLOCK_EH_START
117 0 : pari_puts("/*-- (type RETURN to continue) --*/");
118 0 : pari_flush();
119 : /* if called from a readline callback, may be in a funny TTY mode */
120 0 : do c = fgetc(stdin); while (c >= 0 && c != '\n' && c != '\r');
121 0 : pari_putc('\n');
122 0 : BLOCK_EH_END
123 : }
124 :
125 : static int
126 13 : has_ext_help(void) { return (GP_DATA->help && *GP_DATA->help); }
127 :
128 : static int
129 173 : compare_str(const void *s1, const void*s2)
130 173 : { return strcmp(*(char**)s1, *(char**)s2); }
131 :
132 : /* Print all elements of list in columns, pausing every nbli lines
133 : * if nbli is nonzero. list is a NULL terminated list of function names */
134 : void
135 7 : print_fun_list(char **list, long nbli)
136 : {
137 7 : long i=0, j=0, maxlen=0, nbcol,len, w = term_width();
138 : char **l;
139 :
140 77 : while (list[i]) i++;
141 7 : qsort (list, i, sizeof(char *), compare_str);
142 :
143 77 : for (l=list; *l; l++)
144 : {
145 70 : len = strlen(*l);
146 70 : if (len > maxlen) maxlen=len;
147 : }
148 7 : maxlen++; nbcol= w / maxlen;
149 7 : if (nbcol * maxlen == w) nbcol--;
150 7 : if (!nbcol) nbcol = 1;
151 :
152 7 : pari_putc('\n'); i=0;
153 77 : for (l=list; *l; l++)
154 : {
155 70 : pari_puts(*l); i++;
156 70 : if (i >= nbcol)
157 : {
158 7 : i=0; pari_putc('\n');
159 7 : if (nbli && j++ > nbli) { j = 0; pari_hit_return(); }
160 7 : continue;
161 : }
162 63 : len = maxlen - strlen(*l);
163 329 : while (len--) pari_putc(' ');
164 : }
165 7 : if (i) pari_putc('\n');
166 7 : }
167 :
168 : static const char *help_sections[] = {
169 : "user-defined functions (aliases, installed and user functions)",
170 : "PROGRAMMING under GP",
171 : "Standard monadic or dyadic OPERATORS",
172 : "CONVERSIONS and similar elementary functions",
173 : "functions related to COMBINATORICS",
174 : "basic NUMBER THEORY",
175 : "POLYNOMIALS and power series",
176 : "Vectors, matrices, LINEAR ALGEBRA and sets",
177 : "TRANSCENDENTAL functions",
178 : "SUMS, products, integrals and similar functions",
179 : "General NUMBER FIELDS",
180 : "Associative and central simple ALGEBRAS",
181 : "ELLIPTIC and HYPERELLIPTIC curves",
182 : "L-FUNCTIONS",
183 : "HYPERGEOMETRIC MOTIVES",
184 : "MODULAR FORMS",
185 : "MODULAR SYMBOLS",
186 : "GRAPHIC functions"
187 : };
188 :
189 : static const long MAX_SECTION = numberof(help_sections) - 1;
190 :
191 : static void
192 7 : commands(long n)
193 : {
194 : long i;
195 : entree *ep;
196 : char **t_L;
197 : pari_stack s_L;
198 :
199 7 : pari_stack_init(&s_L, sizeof(*t_L), (void**)&t_L);
200 952 : for (i = 0; i < functions_tblsz; i++)
201 10647 : for (ep = functions_hash[i]; ep; ep = ep->next)
202 : {
203 : long m;
204 9702 : switch (EpVALENCE(ep))
205 : {
206 21 : case EpVAR:
207 21 : if (typ((GEN)ep->value) == t_CLOSURE) break;
208 : /* fall through */
209 28 : case EpNEW: continue;
210 : }
211 9674 : m = ep->menu;
212 9674 : if (m == n || (n < 0 && m && m <= MAX_SECTION))
213 70 : pari_stack_pushp(&s_L, (void*)ep->name);
214 : }
215 7 : pari_stack_pushp(&s_L, NULL);
216 7 : print_fun_list(t_L, term_height()-4);
217 7 : pari_stack_delete(&s_L);
218 7 : }
219 :
220 : void
221 32 : pari_center(const char *s)
222 : {
223 32 : pari_sp av = avma;
224 32 : long i, l = strlen(s), pad = term_width() - l;
225 : char *buf, *u;
226 :
227 32 : if (pad<0) pad=0; else pad >>= 1;
228 32 : u = buf = stack_malloc(l + pad + 2);
229 468 : for (i=0; i<pad; i++) *u++ = ' ';
230 1714 : while (*s) *u++ = *s++;
231 32 : *u++ = '\n'; *u = 0;
232 32 : pari_puts(buf); set_avma(av);
233 32 : }
234 :
235 : static void
236 0 : community(void)
237 : {
238 : const char *pari_docdir;
239 : #if defined(_WIN32)
240 : /* for some reason, the documentation on windows is not in datadir */
241 : if (paricfg_datadir[0]=='@' && paricfg_datadir[1]==0)
242 : pari_docdir = win32_basedir();
243 : else
244 : #endif
245 0 : pari_docdir = pari_datadir;
246 :
247 0 : print_text("The PARI/GP distribution includes a reference manual, a \
248 : tutorial, a reference card and quite a few examples. They have been installed \
249 : in the directory ");
250 0 : pari_puts(" ");
251 0 : pari_puts(pari_docdir);
252 0 : pari_puts("\nYou can also download them from http://pari.math.u-bordeaux.fr/.\
253 : \n\nThree mailing lists are devoted to PARI:\n\
254 : - pari-announce (moderated) to announce major version changes.\n\
255 : - pari-dev for everything related to the development of PARI, including\n\
256 : suggestions, technical questions, bug reports and patch submissions.\n\
257 : - pari-users for everything else!\n\
258 : To subscribe, send an empty message to\n\
259 : <pari_list_name>-request@pari.math.u-bordeaux.fr\n\
260 : with a Subject: field containing the word 'subscribe'.\n\n");
261 0 : print_text("An archive is kept at the WWW site mentioned above. You can also \
262 0 : reach the authors at pari@math.u-bordeaux.fr (answer not guaranteed)."); }
263 :
264 : static void
265 7 : gentypes(void)
266 : {
267 7 : pari_puts("List of the PARI types:\n\
268 : t_INT : long integers [ cod1 ] [ cod2 ] [ man_1 ] ... [ man_k ]\n\
269 : t_REAL : long real numbers [ cod1 ] [ cod2 ] [ man_1 ] ... [ man_k ]\n\
270 : t_INTMOD : integermods [ code ] [ mod ] [ integer ]\n\
271 : t_FRAC : irred. rationals [ code ] [ num. ] [ den. ]\n\
272 : t_FFELT : finite field elt. [ code ] [ cod2 ] [ elt ] [ mod ] [ p ]\n\
273 : t_COMPLEX: complex numbers [ code ] [ real ] [ imag ]\n\
274 : t_PADIC : p-adic numbers [ cod1 ] [ cod2 ] [ p ] [ p^r ] [ int ]\n\
275 : t_QUAD : quadratic numbers [ cod1 ] [ mod ] [ real ] [ imag ]\n\
276 : t_POLMOD : poly mod [ code ] [ mod ] [ polynomial ]\n\
277 : -------------------------------------------------------------\n\
278 : t_POL : polynomials [ cod1 ] [ cod2 ] [ man_1 ] ... [ man_k ]\n\
279 : t_SER : power series [ cod1 ] [ cod2 ] [ man_1 ] ... [ man_k ]\n\
280 : t_RFRAC : irred. rat. func. [ code ] [ num. ] [ den. ]\n\
281 : t_QFB : qfb [ code ] [ a ] [ b ] [ c ] [ disc ]\n\
282 : t_VEC : row vector [ code ] [ x_1 ] ... [ x_k ]\n\
283 : t_COL : column vector [ code ] [ x_1 ] ... [ x_k ]\n\
284 : t_MAT : matrix [ code ] [ col_1 ] ... [ col_k ]\n\
285 : t_LIST : list [ cod1 ] [ cod2 ] [ vec ]\n\
286 : t_STR : string [ code ] [ man_1 ] ... [ man_k ]\n\
287 : t_VECSMALL: vec. small ints [ code ] [ x_1 ] ... [ x_k ]\n\
288 : t_CLOSURE: functions [ code ] [ arity ] [ proto ] [ operand ] ... \n\
289 : t_ERROR : error context [ code ] [ errnum ] [ dat_1 ] ... [ dat_k ]\n\
290 : t_INFINITY: a*infinity [ code ] [ a ]\n\
291 : \n");
292 7 : }
293 :
294 : static void
295 7 : menu_commands(void)
296 : {
297 : ulong i;
298 7 : pari_puts("Help topics: for a list of relevant subtopics, type ?n for n in\n");
299 133 : for (i = 0; i <= MAX_SECTION; i++)
300 126 : pari_printf(" %2lu: %s\n", i, help_sections[i]);
301 7 : pari_printf(" %2lu: The PARI community\n", i);
302 7 : pari_puts("Also:\n\
303 : ? functionname (short on-line help)\n\
304 : ?\\ (keyboard shortcuts)\n\
305 : ?. (member functions)\n");
306 7 : if (has_ext_help()) pari_puts("\
307 : Extended help (if available):\n\
308 : ?? (opens the full user's manual in a dvi previewer)\n\
309 : ?? tutorial / refcard / libpari (tutorial/reference card/libpari manual)\n\
310 : ?? refcard-ell (or -lfun/-mf/-nf: specialized reference card)\n\
311 : ?? keyword (long help text about \"keyword\" from the user's manual)\n\
312 : ??? keyword (a propos: list of related functions).");
313 7 : }
314 :
315 : static void
316 7 : slash_commands(void)
317 : {
318 7 : pari_puts("# : enable/disable timer\n\
319 : ## : print time for last result\n\
320 : \\\\ : comment up to end of line\n\
321 : \\a {n} : print result in raw format (readable by PARI)\n\
322 : \\B {n} : print result in beautified format\n\
323 : \\c : list all commands (same effect as ?*)\n\
324 : \\d : print all defaults\n\
325 : \\e {n} : enable/disable echo (set echo=n)\n\
326 : \\g {n} : set debugging level\n\
327 : \\gf{n} : set file debugging level\n\
328 : \\gm{n} : set memory debugging level\n\
329 : \\h {m-n}: hashtable information\n\
330 : \\l {f} : enable/disable logfile (set logfile=f)\n\
331 : \\m {n} : print result in prettymatrix format\n\
332 : \\o {n} : set output method (0=raw, 1=prettymatrix, 2=prettyprint, 3=2-dim)\n\
333 : \\p {n} : change real precision\n\
334 : \\pb{n} : change real bit precision\n\
335 : \\ps{n} : change series precision\n\
336 : \\q : quit completely this GP session\n\
337 : \\qf : quit reading current file\n\
338 : \\r {f} : read in a file\n\
339 : \\s : print stack information\n\
340 : \\t : print the list of PARI types\n\
341 : \\u : print the list of user-defined functions\n\
342 : \\um : print the list of user-defined member functions\n\
343 : \\uv : print the list of user-defined variables, excluding closures\n\
344 : \\v : print current version of GP\n\
345 : \\w {nf} : write to a file\n\
346 : \\x {n} : print complete inner structure of result\n\
347 : \\y {n} : disable/enable automatic simplification (set simplify=n)\n\
348 : \\z {n} : disable/enable doctest mode\n\
349 : \n\
350 : {f}=optional filename. {n}=optional integer\n");
351 7 : }
352 :
353 : static void
354 7 : member_commands(void)
355 : {
356 7 : pari_puts("\
357 : Member functions, followed by relevant objects\n\n\
358 : a1-a6, b2-b8, c4-c6 : coeff. of the curve. ell\n\
359 : area : area ell\n\
360 : bid : big ideal bid, bnr\n\
361 : bnf : big number field bnf,bnr\n\
362 : clgp : class group quad,bid, bnf,bnr\n\
363 : cyc : cyclic decomposition quad,bid, clgp,ell, bnf,bnr\n\
364 : diff, codiff: different and codifferent nf,bnf,bnr\n\
365 : disc : discriminant ell,nf,bnf,bnr,rnf\n\
366 : e, f : inertia/residue degree prid\n\
367 : fu : fundamental units bnf\n\
368 : gen : generators bid,prid,clgp,ell, bnf,bnr, gal\n\
369 : group: group ell, gal\n\
370 : index: index nf,bnf,bnr\n\
371 : j : j-invariant ell\n");
372 : /* split: some compilers can't handle long constant strings */
373 7 : pari_puts("\
374 : mod : modulus bid, bnr, gal\n\
375 : nf : number field nf,bnf,bnr,rnf\n\
376 : no : number of elements quad,bid, clgp,ell, bnf,bnr\n\
377 : normfu: quad\n\
378 : omega, eta: [w1,w2] and [eta1, eta2] ell\n\
379 : orders: relative orders of generators gal\n\
380 : p : rational prime prid, ell,nf,bnf,bnr,rnf,gal\n\
381 : pol : defining polynomial nf,bnf,bnr, gal\n\
382 : polabs: defining polynomial over Q rnf\n\
383 : reg : regulator quad, bnf\n\
384 : roots: roots ell,nf,bnf,bnr, gal\n\
385 : sign,r1,r2 : signature nf,bnf,bnr\n\
386 : t2 : t2 matrix nf,bnf,bnr\n\
387 : tate : Tate's [u^2, u, q, [a,b], L, Ei] ell\n\
388 : tu : torsion unit and its order bnf\n\
389 : zk : integral basis nf,bnf,bnr,rnf\n\
390 : zkst : structure of (Z_K/m)* bid, bnr\n");
391 7 : }
392 :
393 : #define QUOTE "_QUOTE"
394 : #define DOUBQUOTE "_DOUBQUOTE"
395 : #define BACKQUOTE "_BACKQUOTE"
396 :
397 : static char *
398 0 : _cat(char *s, const char *t)
399 : {
400 0 : *s = 0; strcat(s,t); return s + strlen(t);
401 : }
402 :
403 : static char *
404 0 : filter_quotes(const char *s)
405 : {
406 0 : int i, l = strlen(s);
407 0 : int quote = 0;
408 0 : int backquote = 0;
409 0 : int doubquote = 0;
410 : char *str, *t;
411 :
412 0 : for (i=0; i < l; i++)
413 0 : switch(s[i])
414 : {
415 0 : case '\'': quote++; break;
416 0 : case '`' : backquote++; break;
417 0 : case '"' : doubquote++;
418 : }
419 0 : str = (char*)pari_malloc(l + quote * (strlen(QUOTE)-1)
420 0 : + doubquote * (strlen(DOUBQUOTE)-1)
421 0 : + backquote * (strlen(BACKQUOTE)-1) + 1);
422 0 : t = str;
423 0 : for (i=0; i < l; i++)
424 0 : switch(s[i])
425 : {
426 0 : case '\'': t = _cat(t, QUOTE); break;
427 0 : case '`' : t = _cat(t, BACKQUOTE); break;
428 0 : case '"' : t = _cat(t, DOUBQUOTE); break;
429 0 : default: *t++ = s[i];
430 : }
431 0 : *t = 0; return str;
432 : }
433 :
434 : static int
435 0 : nl_read(char *s) { size_t l = strlen(s); return s[l-1] == '\n'; }
436 :
437 : /* query external help program for s. num < 0 [keyword] or chapter number */
438 : static void
439 0 : external_help(const char *s, long num)
440 : {
441 0 : long nbli = term_height()-3, li = 0;
442 : char buf[256], *str;
443 0 : const char *opt = "", *ar = "";
444 0 : char *t, *help = GP_DATA->help;
445 : pariFILE *z;
446 : FILE *f;
447 0 : if (cb_pari_long_help) { cb_pari_long_help(s, num); return; }
448 :
449 0 : if (!has_ext_help()) pari_err(e_MISC,"no external help program");
450 0 : t = filter_quotes(s);
451 0 : if (num < 0)
452 0 : opt = "-k";
453 0 : else if (t[strlen(t)-1] != '@')
454 0 : ar = stack_sprintf("@%d",num);
455 : #ifdef _WIN32
456 : if (*help == '@')
457 : {
458 : const char *basedir = win32_basedir();
459 : help = stack_sprintf("%c:& cd %s & %s", *basedir, basedir, help+1);
460 : }
461 : #endif
462 0 : str = stack_sprintf("%s -fromgp %s %c%s%s%c",
463 : help, opt, SHELL_Q, t, ar, SHELL_Q);
464 0 : z = try_pipe(str,0); f = z->file;
465 0 : pari_free(t);
466 0 : while (fgets(buf, numberof(buf), f))
467 : {
468 0 : if (!strncmp("ugly_kludge_done",buf,16)) break;
469 0 : pari_puts(buf);
470 0 : if (nl_read(buf) && ++li > nbli) { pari_hit_return(); li = 0; }
471 : }
472 0 : pari_fclose(z);
473 : }
474 :
475 : const char **
476 0 : gphelp_keyword_list(void)
477 : {
478 : static const char *L[]={
479 : "operator",
480 : "libpari",
481 : "member",
482 : "integer",
483 : "real",
484 : "readline",
485 : "refcard",
486 : "refcard-nf",
487 : "refcard-ell",
488 : "refcard-mf",
489 : "refcard-lfun",
490 : "tutorial",
491 : "tutorial-mf",
492 : "mf",
493 : "nf",
494 : "bnf",
495 : "bnr",
496 : "ell",
497 : "rnf",
498 : "hgm",
499 : "HGM",
500 : "ideal",
501 : "idele",
502 : "CFT",
503 : "bid",
504 : "modulus",
505 : "prototype",
506 : "Lmath",
507 : "Ldata",
508 : "Linit",
509 : "character",
510 : "sums",
511 : "products",
512 : "integrals",
513 : "gchar",
514 : "grossencharacter",
515 : "Grossencharacter",
516 : NULL};
517 0 : return L;
518 : }
519 :
520 : static int
521 0 : ok_external_help(char **s)
522 : {
523 : const char **L;
524 : long n;
525 0 : if (!**s) return 1;
526 0 : if (!isalpha((unsigned char)**s)) return 3; /* operator or section number */
527 0 : if (!strncmp(*s,"t_",2)) { *s += 2; return 2; } /* type name */
528 :
529 0 : L = gphelp_keyword_list();
530 0 : for (n=0; L[n]; n++)
531 0 : if (!strcmp(*s,L[n])) return 3;
532 0 : return 0;
533 : }
534 :
535 : static void
536 113 : cut_trailing_garbage(char *s)
537 : {
538 : char c;
539 573 : while ( (c = *s++) )
540 : {
541 474 : if (c == '\\' && ! *s++) return; /* gobble next char, return if none. */
542 474 : if (!is_keyword_char(c) && c != '@') { s[-1] = 0; return; }
543 : }
544 : }
545 :
546 : static void
547 7 : digit_help(char *s, long flag)
548 : {
549 7 : long n = atoi(s);
550 7 : if (n < 0 || n > MAX_SECTION+4)
551 0 : pari_err(e_SYNTAX,"no such section in help: ?",s,s);
552 7 : if (n == MAX_SECTION+1)
553 0 : community();
554 7 : else if (flag & h_LONG)
555 0 : external_help(s,3);
556 : else
557 7 : commands(n);
558 7 : return;
559 : }
560 :
561 : long
562 2 : pari_community(void)
563 : {
564 2 : return MAX_SECTION+1;
565 : }
566 :
567 : static void
568 39 : simple_help(const char *s1, const char *s2) { pari_printf("%s: %s\n", s1, s2); }
569 :
570 : static void
571 21 : default_help(char *s, long flag)
572 : {
573 21 : if (flag & h_LONG)
574 0 : external_help(stack_strcat("se:def,",s),3);
575 : else
576 21 : simple_help(s,"default");
577 21 : }
578 :
579 : static void
580 155 : help(const char *s0, int flag)
581 : {
582 155 : const long long_help = flag & h_LONG;
583 : long n;
584 : entree *ep;
585 155 : char *s = get_sep(s0);
586 :
587 229 : if (isdigit((unsigned char)*s)) { digit_help(s,flag); return; }
588 148 : if (flag & h_APROPOS) { external_help(s,-1); return; }
589 : /* Get meaningful answer on '\ps 5' (e.g. from <F1>) */
590 148 : if (*s == '\\' && isalpha((unsigned char)*(s+1)))
591 0 : { char *t = s+1; pari_skip_alpha(&t); *t = '\0'; }
592 148 : if (isalpha((unsigned char)*s))
593 : {
594 113 : char *t = s;
595 113 : if (!strncmp(s, "default", 7))
596 : { /* special-case ?default(dft_name), e.g. default(log) */
597 14 : t += 7; pari_skip_space(&t);
598 14 : if (*t == '(')
599 : {
600 14 : t++; pari_skip_space(&t);
601 14 : cut_trailing_garbage(t);
602 14 : if (pari_is_default(t)) { default_help(t,flag); return; }
603 : }
604 : }
605 99 : if (!strncmp(s, "refcard-", 8)) t += 8;
606 99 : else if (!strncmp(s, "tutorial-", 9)) t += 9;
607 99 : if (strncmp(s, "se:", 3)) cut_trailing_garbage(t);
608 : }
609 :
610 134 : if (long_help && (n = ok_external_help(&s))) { external_help(s,n); return; }
611 134 : switch (*s)
612 : {
613 0 : case '*' : commands(-1); return;
614 7 : case '\0': menu_commands(); return;
615 7 : case '\\': slash_commands(); return;
616 7 : case '.' : member_commands(); return;
617 : }
618 113 : ep = is_entry(s);
619 113 : if (!ep)
620 : {
621 14 : if (pari_is_default(s))
622 7 : default_help(s,flag);
623 7 : else if (long_help)
624 0 : external_help(s,3);
625 7 : else if (!cb_pari_whatnow || !cb_pari_whatnow(pariOut, s,1))
626 7 : simple_help(s,"unknown identifier");
627 14 : return;
628 : }
629 :
630 99 : if (EpVALENCE(ep) == EpALIAS)
631 : {
632 14 : pari_printf("%s is aliased to:\n\n",s);
633 14 : ep = do_alias(ep);
634 : }
635 99 : switch(EpVALENCE(ep))
636 : {
637 35 : case EpVAR:
638 35 : if (!ep->help)
639 : {
640 21 : if (typ((GEN)ep->value)!=t_CLOSURE)
641 7 : simple_help(s, "user defined variable");
642 : else
643 : {
644 14 : GEN str = closure_get_text((GEN)ep->value);
645 14 : if (typ(str) == t_VEC)
646 14 : pari_printf("%s =\n %Ps\n", ep->name, ep->value);
647 : }
648 21 : return;
649 : }
650 14 : break;
651 :
652 4 : case EpINSTALL:
653 4 : if (!ep->help) { simple_help(s, "installed function"); return; }
654 4 : break;
655 :
656 18 : case EpNEW:
657 18 : if (!ep->help) { simple_help(s, "new identifier"); return; };
658 14 : break;
659 :
660 42 : default: /* built-in function */
661 42 : if (!ep->help) pari_err_BUG("gp_help (no help found)"); /*paranoia*/
662 42 : if (long_help) { external_help(ep->name,3); return; }
663 : }
664 74 : print_text(ep->help);
665 : }
666 :
667 : void
668 155 : gp_help(const char *s, long flag)
669 : {
670 155 : pari_sp av = avma;
671 155 : if ((flag & h_RL) == 0)
672 : {
673 155 : if (*s == '?') { flag |= h_LONG; s++; }
674 155 : if (*s == '?') { flag |= h_APROPOS; s++; }
675 : }
676 155 : term_color(c_HELP); help(s,flag); term_color(c_NONE);
677 155 : if ((flag & h_RL) == 0) pari_putc('\n');
678 155 : set_avma(av);
679 155 : }
680 :
681 : /********************************************************************/
682 : /** **/
683 : /** GP HEADER **/
684 : /** **/
685 : /********************************************************************/
686 : static char *
687 6 : what_readline(void)
688 : {
689 : #ifdef READLINE
690 6 : const char *v = READLINE;
691 6 : char *s = stack_malloc(3 + strlen(v) + 8);
692 6 : (void)sprintf(s, "v%s %s", v, GP_DATA->use_readline? "enabled": "disabled");
693 6 : return s;
694 : #else
695 : return (char*)"not compiled in";
696 : #endif
697 : }
698 :
699 : static char *
700 6 : what_cc(void)
701 : {
702 : char *s;
703 : #ifdef GCC_VERSION
704 : # ifdef __cplusplus
705 : s = stack_malloc(6 + strlen(GCC_VERSION) + 1);
706 : (void)sprintf(s, "(C++) %s", GCC_VERSION);
707 : # else
708 6 : s = stack_strdup(GCC_VERSION);
709 : # endif
710 : #else
711 : # ifdef _MSC_VER
712 : s = stack_malloc(32);
713 : (void)sprintf(s, "MSVC-%i", _MSC_VER);
714 : # else
715 : s = NULL;
716 : # endif
717 : #endif
718 6 : return s;
719 : }
720 :
721 : static char *
722 20 : convert_time(char *s, long delay)
723 : {
724 : /* Do not do month and year: ambiguous definition and overflows 32 bits. */
725 20 : if (delay >= 86400000)
726 : {
727 7 : sprintf(s, "%ldd, ", delay / 86400000); s+=strlen(s);
728 7 : delay %= 86400000;
729 : }
730 20 : if (delay >= 3600000)
731 : {
732 14 : sprintf(s, "%ldh, ", delay / 3600000); s+=strlen(s);
733 14 : delay %= 3600000;
734 : }
735 20 : if (delay >= 60000)
736 : {
737 14 : sprintf(s, "%ldmin, ", delay / 60000); s+=strlen(s);
738 14 : delay %= 60000;
739 : }
740 20 : if (delay >= 1000)
741 : {
742 20 : sprintf(s, "%ld,", delay / 1000); s+=strlen(s);
743 20 : delay %= 1000;
744 20 : if (delay < 100)
745 : {
746 4 : sprintf(s, "%s", (delay<10)? "00": "0");
747 4 : s+=strlen(s);
748 : }
749 : }
750 20 : sprintf(s, "%ld ms", delay); s+=strlen(s);
751 20 : return s;
752 : }
753 :
754 : /* Format a time of 'delay' ms */
755 : const char *
756 0 : gp_format_time(long delay)
757 : {
758 0 : char *buf = stack_malloc(64), *s = buf;
759 0 : term_get_color(s, c_TIME);
760 0 : s = convert_time(s + strlen(s), delay);
761 0 : term_get_color(s, c_NONE); return buf;
762 : }
763 :
764 : GEN
765 14 : strtime(long delay)
766 : {
767 14 : long n = nchar2nlong(64);
768 14 : GEN x = cgetg(n+1, t_STR);
769 14 : char *buf = GSTR(x), *t = buf + 64, *s = convert_time(buf, delay);
770 581 : s++; while (s < t) *s++ = 0; /* pacify valgrind */
771 14 : return x;
772 : }
773 :
774 : /********************************************************************/
775 : /* */
776 : /* GPRC */
777 : /* */
778 : /********************************************************************/
779 : /* LOCATE GPRC */
780 : static void
781 0 : err_gprc(const char *s, char *t, char *u)
782 : {
783 0 : err_printf("\n");
784 0 : pari_err(e_SYNTAX,s,t,u);
785 0 : }
786 :
787 : /* return $HOME or the closest we can find */
788 : static const char *
789 4 : get_home(int *free_it)
790 : {
791 4 : char *drv, *pth = os_getenv("HOME");
792 4 : if (pth) return pth;
793 0 : if ((drv = os_getenv("HOMEDRIVE"))
794 0 : && (pth = os_getenv("HOMEPATH")))
795 : { /* looks like WinNT */
796 0 : char *buf = (char*)pari_malloc(strlen(pth) + strlen(drv) + 1);
797 0 : sprintf(buf, "%s%s",drv,pth);
798 0 : *free_it = 1; return buf;
799 : }
800 0 : pth = pari_get_homedir("");
801 0 : return pth? pth: ".";
802 : }
803 :
804 : static FILE *
805 12 : gprc_chk(const char *s)
806 : {
807 12 : FILE *f = fopen(s, "r");
808 12 : if (f && !(GP_DATA->flags & gpd_QUIET)) err_printf("Reading GPRC: %s\n", s);
809 12 : return f;
810 : }
811 :
812 : /* Look for [._]gprc: $GPRC, then in $HOME, ., /etc, pari_datadir */
813 : static FILE *
814 4 : gprc_get(void)
815 : {
816 4 : FILE *f = NULL;
817 4 : const char *gprc = os_getenv("GPRC");
818 4 : if (gprc) f = gprc_chk(gprc);
819 4 : if (!f)
820 : {
821 4 : int free_it = 0;
822 4 : const char *home = get_home(&free_it);
823 : char *str, *s, c;
824 : long l;
825 4 : l = strlen(home); c = home[l-1];
826 : /* + "/gprc.txt" + \0*/
827 4 : str = strcpy((char*)pari_malloc(l+10), home);
828 4 : if (free_it) pari_free((void*)home);
829 4 : s = str + l;
830 4 : if (c != '/' && c != '\\') *s++ = '/';
831 : #ifndef _WIN32
832 4 : strcpy(s, ".gprc");
833 : #else
834 : strcpy(s, "gprc.txt");
835 : #endif
836 4 : f = gprc_chk(str); /* in $HOME */
837 4 : if (!f) f = gprc_chk(s); /* in . */
838 : #ifndef _WIN32
839 4 : if (!f) f = gprc_chk("/etc/gprc");
840 : #else
841 : if (!f) /* in basedir */
842 : {
843 : const char *basedir = win32_basedir();
844 : char *t = (char *) pari_malloc(strlen(basedir)+strlen(s)+2);
845 : sprintf(t, "%s/%s", basedir, s);
846 : f = gprc_chk(t); free(t);
847 : }
848 : #endif
849 4 : pari_free(str);
850 : }
851 4 : return f;
852 : }
853 :
854 : /* PREPROCESSOR */
855 :
856 : static ulong
857 0 : read_uint(char **s)
858 : {
859 0 : long v = atol(*s);
860 0 : if (!isdigit((unsigned char)**s)) err_gprc("not an integer", *s, *s);
861 0 : while (isdigit((unsigned char)**s)) (*s)++;
862 0 : return v;
863 : }
864 : static ulong
865 0 : read_dot_uint(char **s)
866 : {
867 0 : if (**s != '.') return 0;
868 0 : (*s)++; return read_uint(s);
869 : }
870 : /* read a.b.c */
871 : static long
872 0 : read_version(char **s)
873 : {
874 : long a, b, c;
875 0 : a = read_uint(s);
876 0 : b = read_dot_uint(s);
877 0 : c = read_dot_uint(s);
878 0 : return PARI_VERSION(a,b,c);
879 : }
880 :
881 : static int
882 4 : get_preproc_value(char **s)
883 : {
884 4 : if (!strncmp(*s,"EMACS",5)) {
885 4 : *s += 5;
886 4 : return GP_DATA->flags & (gpd_EMACS|gpd_TEXMACS);
887 : }
888 0 : if (!strncmp(*s,"READL",5)) {
889 0 : *s += 5;
890 0 : return GP_DATA->use_readline;
891 : }
892 0 : if (!strncmp(*s,"VERSION",7)) {
893 0 : int less = 0, orequal = 0;
894 : long d;
895 0 : *s += 7;
896 0 : switch(**s)
897 : {
898 0 : case '<': (*s)++; less = 1; break;
899 0 : case '>': (*s)++; less = 0; break;
900 0 : default: return -1;
901 : }
902 0 : if (**s == '=') { (*s)++; orequal = 1; }
903 0 : d = paricfg_version_code - read_version(s);
904 0 : if (!d) return orequal;
905 0 : return less? (d < 0): (d > 0);
906 : }
907 0 : if (!strncmp(*s,"BITS_IN_LONG",12)) {
908 0 : *s += 12;
909 0 : if ((*s)[0] == '=' && (*s)[1] == '=')
910 : {
911 0 : *s += 2;
912 0 : return BITS_IN_LONG == read_uint(s);
913 : }
914 : }
915 0 : return -1;
916 : }
917 :
918 : /* PARSE GPRC */
919 :
920 : /* 1) replace next separator by '\0' (t must be writable)
921 : * 2) return the next expression ("" if none)
922 : * see get_sep() */
923 : static char *
924 12 : next_expr(char *t)
925 : {
926 12 : int outer = 1;
927 12 : char *s = t;
928 :
929 : for(;;)
930 184 : {
931 : char c;
932 196 : switch ((c = *s++))
933 : {
934 8 : case '"':
935 8 : if (outer || (s >= t+2 && s[-2] != '\\')) outer = !outer;
936 8 : break;
937 12 : case '\0':
938 12 : return (char*)"";
939 176 : default:
940 176 : if (outer && c == ';') { s[-1] = 0; return s; }
941 : }
942 : }
943 : }
944 :
945 : Buffer *
946 1964 : filtered_buffer(filtre_t *F)
947 : {
948 1964 : Buffer *b = new_buffer();
949 1964 : init_filtre(F, b);
950 1964 : pari_stack_pushp(&s_bufstack, (void*)b);
951 1964 : return b;
952 : }
953 :
954 : /* parse src of the form s=t (or s="t"), set *ps to s, and *pt to t.
955 : * modifies src (replaces = by \0) */
956 : void
957 18 : parse_key_val(char *src, char **ps, char **pt)
958 : {
959 : char *s_end, *t;
960 130 : t = src; while (*t && *t != '=') t++;
961 18 : if (*t != '=') err_gprc("missing '='",t,src);
962 18 : s_end = t;
963 18 : t++;
964 18 : if (*t == '"') (void)pari_translate_string(t, t, src);
965 18 : *s_end = 0; *ps = src; *pt = t;
966 18 : }
967 : /* parse src of the form (s,t) (or "s", or "t"), set *ps to s, and *pt to t. */
968 : static void
969 0 : parse_key_val_paren(char *src, char **ps, char **pt)
970 : {
971 : char *s, *t, *s_end, *t_end;
972 0 : s = t = src + 1; while (*t && *t != ',') t++;
973 0 : if (*t != ',') err_gprc("missing ','",t,src);
974 0 : s_end = t;
975 0 : t++; while (*t && *t != ')') t++;
976 0 : if (*t != ')') err_gprc("missing ')'",t,src);
977 0 : if (t[1]) err_gprc("unexpected character",t+1,src);
978 0 : t_end = t; t = s_end + 1;
979 0 : if (*t == '"') (void)pari_translate_string(t, t, src);
980 0 : if (*s == '"') (void)pari_translate_string(s, s, src);
981 0 : *s_end = 0; *t_end = 0; *ps = s; *pt = t;
982 0 : }
983 :
984 : void
985 4 : gp_initrc(pari_stack *p_A)
986 : {
987 4 : FILE *file = gprc_get();
988 : Buffer *b;
989 : filtre_t F;
990 4 : VOLATILE long c = 0;
991 : jmp_buf *env;
992 : pari_stack s_env;
993 :
994 4 : if (!file) return;
995 4 : b = filtered_buffer(&F);
996 4 : pari_stack_init(&s_env, sizeof(*env), (void**)&env);
997 4 : (void)pari_stack_new(&s_env);
998 : for(;;)
999 172 : {
1000 : char *nexts, *s, *t;
1001 176 : if (setjmp(env[s_env.n-1])) err_printf("...skipping line %ld.\n", c);
1002 176 : c++;
1003 176 : if (!get_line_from_file(NULL,&F,file)) break;
1004 172 : s = b->buf;
1005 172 : if (*s == '#')
1006 : { /* preprocessor directive */
1007 4 : int z, NOT = 0;
1008 4 : s++;
1009 4 : if (strncmp(s,"if",2)) err_gprc("unknown directive",s,b->buf);
1010 4 : s += 2;
1011 4 : if (!strncmp(s,"not",3)) { NOT = !NOT; s += 3; }
1012 4 : if (*s == '!') { NOT = !NOT; s++; }
1013 4 : t = s;
1014 4 : z = get_preproc_value(&s);
1015 4 : if (z < 0) err_gprc("unknown preprocessor variable",t,b->buf);
1016 4 : if (NOT) z = !z;
1017 4 : if (!*s)
1018 : { /* make sure at least an expr follows the directive */
1019 0 : if (!get_line_from_file(NULL,&F,file)) break;
1020 0 : s = b->buf;
1021 : }
1022 4 : if (!z) continue; /* dump current line */
1023 : }
1024 : /* parse line */
1025 184 : for ( ; *s; s = nexts)
1026 : {
1027 12 : nexts = next_expr(s);
1028 12 : if (!strncmp(s,"read",4) && (s[4] == ' ' || s[4] == '\t' || s[4] == '"'))
1029 : { /* read file */
1030 0 : s += 4;
1031 0 : t = (char*)pari_malloc(strlen(s) + 1);
1032 0 : if (*s == '"') (void)pari_translate_string(s, t, s-4); else strcpy(t,s);
1033 0 : pari_stack_pushp(p_A,t);
1034 : }
1035 12 : else if (!strncmp(s, "default(", 8))
1036 : {
1037 0 : s += 7; parse_key_val_paren(s, &s,&t);
1038 0 : (void)setdefault(s,t,d_INITRC);
1039 : }
1040 12 : else if (!strncmp(s, "setdebug(", 9))
1041 : {
1042 0 : s += 8; parse_key_val_paren(s, &s,&t);
1043 0 : setdebug(s, atol(t));
1044 : }
1045 : else
1046 : { /* set default */
1047 12 : parse_key_val(s, &s,&t);
1048 12 : (void)setdefault(s,t,d_INITRC);
1049 : }
1050 : }
1051 : }
1052 4 : pari_stack_delete(&s_env);
1053 4 : pop_buffer();
1054 4 : if (!(GP_DATA->flags & gpd_QUIET)) err_printf("GPRC Done.\n\n");
1055 4 : fclose(file);
1056 : }
1057 :
1058 : void
1059 0 : gp_load_gprc(void)
1060 : {
1061 : pari_stack sA;
1062 : char **A;
1063 : long i;
1064 0 : pari_stack_init(&sA,sizeof(*A),(void**)&A);
1065 0 : gp_initrc(&sA);
1066 0 : for (i = 0; i < sA.n; pari_free(A[i]),i++)
1067 : {
1068 0 : pari_CATCH(CATCH_ALL) { err_printf("... skipping file '%s'\n", A[i]); }
1069 0 : pari_TRY { gp_read_file(A[i]); } pari_ENDCATCH;
1070 : }
1071 0 : pari_stack_delete(&sA);
1072 0 : }
1073 :
1074 : /********************************************************************/
1075 : /* */
1076 : /* PROMPTS */
1077 : /* */
1078 : /********************************************************************/
1079 : /* if prompt is coloured, tell readline to ignore the ANSI escape sequences */
1080 : /* s must be able to store 14 chars (including final \0) */
1081 : #ifdef READLINE
1082 : static void
1083 0 : readline_prompt_color(char *s, int c)
1084 : {
1085 : #ifdef _WIN32
1086 : (void)s; (void)c;
1087 : #else
1088 0 : *s++ = '\001'; /*RL_PROMPT_START_IGNORE*/
1089 0 : term_get_color(s, c);
1090 0 : s += strlen(s);
1091 0 : *s++ = '\002'; /*RL_PROMPT_END_IGNORE*/
1092 0 : *s = 0;
1093 : #endif
1094 0 : }
1095 : #endif
1096 : /* s must be able to store 14 chars (including final \0) */
1097 : static void
1098 0 : brace_color(char *s, int c, int force)
1099 : {
1100 0 : if (disable_color || (gp_colors[c] == c_NONE && !force)) return;
1101 : #ifdef READLINE
1102 0 : if (GP_DATA->use_readline)
1103 0 : readline_prompt_color(s, c);
1104 : else
1105 : #endif
1106 0 : term_get_color(s, c);
1107 : }
1108 :
1109 : /* strlen(prompt) + 28 chars */
1110 : static const char *
1111 0 : color_prompt(const char *prompt)
1112 : {
1113 0 : long n = strlen(prompt);
1114 0 : char *t = stack_malloc(n + 28), *s = t;
1115 0 : *s = 0;
1116 : /* escape sequences bug readline, so use special bracing (if available) */
1117 0 : brace_color(s, c_PROMPT, 0);
1118 0 : s += strlen(s); memcpy(s, prompt, n);
1119 0 : s += n; *s = 0;
1120 0 : brace_color(s, c_INPUT, 1);
1121 0 : return t;
1122 : }
1123 :
1124 : const char *
1125 7713 : gp_format_prompt(const char *prompt)
1126 : {
1127 7713 : if (GP_DATA->flags & gpd_TEST)
1128 7713 : return prompt;
1129 : else
1130 : {
1131 : char b[256]; /* longer is truncated */
1132 0 : strftime_expand(prompt, b, sizeof(b));
1133 0 : return color_prompt(b);
1134 : }
1135 : }
1136 :
1137 : /********************************************************************/
1138 : /* */
1139 : /* GP MAIN LOOP */
1140 : /* */
1141 : /********************************************************************/
1142 : static int
1143 265183 : is_interactive(void)
1144 265183 : { return cb_pari_is_interactive? cb_pari_is_interactive(): 0; }
1145 :
1146 : static char *
1147 0 : strip_prompt(const char *s)
1148 : {
1149 0 : long l = strlen(s);
1150 0 : char *t, *t0 = stack_malloc(l+1);
1151 0 : t = t0;
1152 0 : for (; *s; s++)
1153 : {
1154 : /* RL_PROMPT_START_IGNORE / RL_PROMPT_END_IGNORE */
1155 0 : if (*s == 1 || *s == 2) continue;
1156 0 : if (*s == '\x1b') /* skip ANSI color escape sequence */
1157 : {
1158 0 : while (*++s != 'm')
1159 0 : if (!*s) goto end;
1160 0 : continue;
1161 : }
1162 0 : *t = *s; t++;
1163 : }
1164 0 : end:
1165 0 : *t = 0; return t0;
1166 : }
1167 : static void
1168 6878 : update_logfile(const char *prompt, const char *s)
1169 : {
1170 : pari_sp av;
1171 : const char *p;
1172 6878 : if (!pari_logfile) return;
1173 0 : av = avma;
1174 0 : p = strip_prompt(prompt); /* raw prompt */
1175 :
1176 0 : switch (pari_logstyle) {
1177 0 : case logstyle_TeX:
1178 0 : fprintf(pari_logfile,
1179 : "\\PARIpromptSTART|%s\\PARIpromptEND|%s\\PARIinputEND|%%\n",
1180 : p, s);
1181 0 : break;
1182 0 : case logstyle_plain:
1183 0 : fprintf(pari_logfile,"%s%s\n",p, s);
1184 0 : break;
1185 0 : case logstyle_color:
1186 0 : fprintf(pari_logfile,"%s%s%s%s%s\n",term_get_color(NULL,c_PROMPT), p,
1187 : term_get_color(NULL,c_INPUT), s,
1188 : term_get_color(NULL,c_NONE));
1189 0 : break;
1190 : }
1191 0 : set_avma(av);
1192 : }
1193 :
1194 : void
1195 121098 : gp_echo_and_log(const char *prompt, const char *s)
1196 : {
1197 121098 : if (!is_interactive())
1198 : {
1199 121098 : if (!GP_DATA->echo) return;
1200 : /* not pari_puts(): would duplicate in logfile */
1201 6878 : fputs(prompt, pari_outfile);
1202 6878 : fputs(s, pari_outfile);
1203 6878 : fputc('\n', pari_outfile);
1204 6878 : pari_set_last_newline(1);
1205 : }
1206 6878 : update_logfile(prompt, s);
1207 6878 : pari_flush();
1208 : }
1209 :
1210 : /* prompt = NULL --> from gprc. Return 1 if new input, and 0 if EOF */
1211 : int
1212 144268 : get_line_from_file(const char *prompt, filtre_t *F, FILE *file)
1213 : {
1214 : char *s;
1215 : input_method IM;
1216 :
1217 144268 : IM.file = (void*)file;
1218 144268 : if (file==stdin && cb_pari_fgets_interactive)
1219 0 : IM.myfgets = (fgets_t)cb_pari_fgets_interactive;
1220 : else
1221 144268 : IM.myfgets = (fgets_t)&fgets;
1222 144268 : IM.getline = &file_input;
1223 144268 : IM.free = 0;
1224 144268 : if (! input_loop(F,&IM))
1225 : {
1226 1894 : if (file==stdin && cb_pari_start_output) cb_pari_start_output();
1227 1894 : return 0;
1228 : }
1229 142374 : s = F->buf->buf;
1230 : /* don't log if from gprc or empty input */
1231 142374 : if (*s && prompt && GP_DATA->echo != 2) gp_echo_and_log(prompt, s);
1232 142374 : return 1;
1233 : }
1234 :
1235 : /* return 0 if no line could be read (EOF). If PROMPT = NULL, expand and
1236 : * color default prompt; otherwise, use PROMPT as-is. */
1237 : int
1238 144085 : gp_read_line(filtre_t *F, const char *PROMPT)
1239 : {
1240 : static const char *DFT_PROMPT = "? ";
1241 144085 : Buffer *b = (Buffer*)F->buf;
1242 : const char *p;
1243 : int res, interactive;
1244 144085 : if (b->len > 100000) fix_buffer(b, 100000);
1245 144085 : interactive = is_interactive();
1246 144085 : if (interactive || pari_logfile || GP_DATA->echo)
1247 : {
1248 7832 : p = PROMPT;
1249 7832 : if (!p) {
1250 7650 : p = F->in_comment? GP_DATA->prompt_comment: GP_DATA->prompt;
1251 7650 : p = gp_format_prompt(p);
1252 : }
1253 : }
1254 : else
1255 136253 : p = DFT_PROMPT;
1256 :
1257 144085 : if (interactive)
1258 : {
1259 0 : BLOCK_EH_START
1260 0 : if (!pari_last_was_newline()) pari_putc('\n');
1261 0 : if (cb_pari_get_line_interactive)
1262 0 : res = cb_pari_get_line_interactive(p, GP_DATA->prompt_cont, F);
1263 : else {
1264 0 : pari_puts(p); pari_flush();
1265 0 : res = get_line_from_file(p, F, pari_infile);
1266 : }
1267 0 : BLOCK_EH_END
1268 : }
1269 : else
1270 : { /* in case UI fakes noninteractivity, e.g. TeXmacs */
1271 144085 : if (cb_pari_start_output && cb_pari_get_line_interactive)
1272 0 : res = cb_pari_get_line_interactive(p, GP_DATA->prompt_cont, F);
1273 : else
1274 144085 : res = get_line_from_file(p, F, pari_infile);
1275 : }
1276 144085 : if (!strcmp(b->buf,"\\qf")) return 0;
1277 144085 : if (!disable_color && p != DFT_PROMPT &&
1278 0 : (gp_colors[c_PROMPT] != c_NONE || gp_colors[c_INPUT] != c_NONE))
1279 : {
1280 0 : term_color(c_NONE); pari_flush();
1281 : }
1282 144085 : return res;
1283 : }
1284 :
1285 : /********************************************************************/
1286 : /* */
1287 : /* EXCEPTION HANDLER */
1288 : /* */
1289 : /********************************************************************/
1290 : static THREAD pari_timer ti_alarm;
1291 :
1292 : #if defined(_WIN32) || defined(SIGALRM)
1293 : static void
1294 6 : gp_alarm_fun(void) {
1295 : char buf[64];
1296 6 : if (cb_pari_start_output) cb_pari_start_output();
1297 6 : convert_time(buf, timer_get(&ti_alarm));
1298 6 : pari_err(e_ALARM, buf);
1299 0 : }
1300 : #endif /* SIGALRM */
1301 :
1302 : void
1303 0 : gp_sigint_fun(void) {
1304 : char buf[150];
1305 : #if defined(_WIN32)
1306 : if (win32alrm) { win32alrm = 0; gp_alarm_fun(); return;}
1307 : #endif
1308 0 : if (cb_pari_start_output) cb_pari_start_output();
1309 0 : convert_time(buf, timer_get(GP_DATA->T));
1310 0 : if (pari_mt_nbthreads > 1)
1311 : {
1312 0 : sprintf(buf + strlen(buf), " cpu time, ");
1313 0 : convert_time(buf + strlen(buf), walltimer_get(GP_DATA->Tw));
1314 0 : sprintf(buf + strlen(buf), " real time");
1315 : }
1316 0 : pari_sigint(buf);
1317 0 : }
1318 :
1319 : #ifdef SIGALRM
1320 : void
1321 8 : gp_alarm_handler(int sig)
1322 : {
1323 : #ifndef HAS_SIGACTION
1324 : /*SYSV reset the signal handler in the handler*/
1325 : (void)os_signal(sig,gp_alarm_handler);
1326 : #endif
1327 8 : if (PARI_SIGINT_block) PARI_SIGINT_pending=sig;
1328 6 : else gp_alarm_fun();
1329 2 : return;
1330 : }
1331 : #endif /* SIGALRM */
1332 :
1333 : /********************************************************************/
1334 : /* */
1335 : /* GP-SPECIFIC ROUTINES */
1336 : /* */
1337 : /********************************************************************/
1338 : void
1339 84 : gp_allocatemem(GEN z)
1340 : {
1341 : ulong newsize;
1342 84 : if (!z) newsize = 0;
1343 : else {
1344 84 : if (typ(z) != t_INT) pari_err_TYPE("allocatemem",z);
1345 84 : newsize = itou(z);
1346 84 : if (signe(z) < 0) pari_err_DOMAIN("allocatemem","size","<",gen_0,z);
1347 : }
1348 84 : if (pari_mainstack->vsize)
1349 0 : paristack_resize(newsize);
1350 : else
1351 84 : paristack_newrsize(newsize);
1352 0 : }
1353 :
1354 : GEN
1355 7 : gp_input(void)
1356 : {
1357 : filtre_t F;
1358 7 : Buffer *b = filtered_buffer(&F);
1359 : GEN x;
1360 :
1361 7 : while (! get_line_from_file("",&F,pari_infile))
1362 0 : if (popinfile()) { err_printf("no input ???"); cb_pari_quit(1); }
1363 7 : x = readseq(b->buf);
1364 7 : pop_buffer(); return x;
1365 : }
1366 :
1367 : static GEN
1368 121 : closure_alarmer(GEN C, long s)
1369 : {
1370 : struct pari_evalstate state;
1371 : VOLATILE GEN x;
1372 121 : if (!s) { pari_alarm(0); return closure_evalgen(C); }
1373 121 : evalstate_save(&state);
1374 : #if !defined(HAS_ALARM) && !defined(_WIN32)
1375 : pari_err(e_ARCH,"alarm");
1376 : #endif
1377 121 : pari_CATCH(CATCH_ALL) /* We need to stop the timer after any error */
1378 : {
1379 6 : GEN E = pari_err_last();
1380 6 : if (err_get_num(E) != e_ALARM) { pari_alarm(0); pari_err(0, E); }
1381 6 : x = evalstate_restore_err(&state);
1382 : }
1383 121 : pari_TRY { pari_alarm(s); x = closure_evalgen(C); pari_alarm(0); } pari_ENDCATCH;
1384 121 : return x;
1385 : }
1386 :
1387 : void
1388 120534 : pari_alarm(long s)
1389 : {
1390 120534 : if (s < 0) pari_err_DOMAIN("alarm","delay","<",gen_0,stoi(s));
1391 120534 : if (s) timer_start(&ti_alarm);
1392 : #ifdef _WIN32
1393 : win32_alarm(s);
1394 : #elif defined(HAS_ALARM)
1395 120534 : alarm(s);
1396 : #else
1397 : if (s) pari_err(e_ARCH,"alarm");
1398 : #endif
1399 120534 : }
1400 :
1401 : GEN
1402 121 : gp_alarm(long s, GEN code)
1403 : {
1404 121 : if (!code) { pari_alarm(s); return gnil; }
1405 121 : return closure_alarmer(code,s);
1406 : }
1407 :
1408 : /*******************************************************************/
1409 : /** **/
1410 : /** EXTERNAL PRETTYPRINTER **/
1411 : /** **/
1412 : /*******************************************************************/
1413 : /* Wait for prettinprinter to finish, to prevent new prompt from overwriting
1414 : * the output. Fill the output buffer, wait until it is read.
1415 : * Better than sleep(2): give possibility to print */
1416 : static void
1417 0 : prettyp_wait(FILE *out)
1418 : {
1419 0 : const char *s = " \n";
1420 0 : long i = 2000;
1421 :
1422 0 : fputs("\n\n", out); fflush(out); /* start translation */
1423 0 : while (--i) fputs(s, out);
1424 0 : fputs("\n", out); fflush(out);
1425 0 : }
1426 :
1427 : /* initialise external prettyprinter (tex2mail) */
1428 : static int
1429 0 : prettyp_init(void)
1430 : {
1431 0 : gp_pp *pp = GP_DATA->pp;
1432 0 : if (!pp->cmd) return 0;
1433 0 : if (pp->file || (pp->file = try_pipe(pp->cmd, mf_OUT))) return 1;
1434 :
1435 0 : pari_warn(warner,"broken prettyprinter: '%s'",pp->cmd);
1436 0 : pari_free(pp->cmd); pp->cmd = NULL;
1437 0 : sd_output("1", d_SILENT);
1438 0 : return 0;
1439 : }
1440 : /* assume prettyp_init() was called */
1441 : static void
1442 0 : prettyp_GEN(GEN z)
1443 : {
1444 0 : FILE *log = pari_logfile, *out = GP_DATA->pp->file->file;
1445 0 : pariout_t T = *(GP_DATA->fmt); /* copy */
1446 : /* output */
1447 0 : T.prettyp = f_TEX;
1448 0 : fputGEN_pariout(z, &T, out);
1449 : /* flush and restore, output to logfile */
1450 0 : prettyp_wait(out);
1451 0 : if (log) {
1452 0 : if (pari_logstyle == logstyle_TeX) {
1453 0 : T.TeXstyle |= TEXSTYLE_BREAK;
1454 0 : fputGEN_pariout(z, &T, log);
1455 0 : fputc('%', log);
1456 : } else {
1457 0 : T.prettyp = f_RAW;
1458 0 : fputGEN_pariout(z, &T, log);
1459 : }
1460 0 : fputc('\n', log); fflush(log);
1461 : }
1462 0 : }
1463 : /* assume prettyp_init() was called. */
1464 : static void
1465 0 : prettyp_output(long n)
1466 : {
1467 0 : FILE *log = pari_logfile, *out = GP_DATA->pp->file->file;
1468 0 : pari_sp av = avma;
1469 0 : const char *c_hist = term_get_color(NULL, c_HIST);
1470 0 : const char *c_out = term_get_color(NULL, c_OUTPUT);
1471 0 : GEN z = pari_get_hist(n);
1472 : /* Emit first: there may be lines before the prompt */
1473 0 : term_color(c_OUTPUT); pari_flush();
1474 : /* history number */
1475 0 : if (!(GP_DATA->flags & gpd_QUIET))
1476 : {
1477 0 : if (*c_hist || *c_out)
1478 0 : fprintf(out, "\\LITERALnoLENGTH{%s}\\%%%ld =\\LITERALnoLENGTH{%s} ",
1479 : c_hist, n, c_out);
1480 : else
1481 0 : fprintf(out, "\\%%%ld = ", n);
1482 : }
1483 0 : if (log) switch (pari_logstyle)
1484 : {
1485 0 : case logstyle_plain:
1486 0 : fprintf(log, "%%%ld = ", n);
1487 0 : break;
1488 0 : case logstyle_color:
1489 0 : fprintf(log, "%s%%%ld = %s", c_hist, n, c_out);
1490 0 : break;
1491 0 : case logstyle_TeX:
1492 0 : fprintf(log, "\\PARIout{%ld}", n);
1493 0 : break;
1494 : }
1495 0 : set_avma(av); prettyp_GEN(z);
1496 0 : term_color(c_NONE); pari_flush();
1497 0 : }
1498 :
1499 : /*******************************************************************/
1500 : /** **/
1501 : /** FORMAT GP OUTPUT **/
1502 : /** **/
1503 : /*******************************************************************/
1504 :
1505 : #define COLOR_LEN 16
1506 :
1507 : static void
1508 2 : str_lim_lines(pari_str *S, char *s, long n, long max_lin)
1509 : {
1510 : long lin, col, width;
1511 : char COL[COLOR_LEN];
1512 : char c;
1513 2 : if (!*s) return;
1514 2 : width = term_width();
1515 2 : lin = 1;
1516 2 : col = n;
1517 :
1518 2 : if (lin > max_lin) return;
1519 4 : while ( (c = *s++) )
1520 : {
1521 2 : if (lin >= max_lin)
1522 2 : if (c == '\n' || col >= width-5)
1523 : {
1524 0 : pari_sp av = avma;
1525 0 : str_puts(S, term_get_color(COL, c_ERR)); set_avma(av);
1526 0 : str_puts(S,"[+++]"); return;
1527 : }
1528 2 : if (c == '\n') { col = -1; lin++; }
1529 2 : else if (col == width) { col = 0; lin++; }
1530 2 : pari_set_last_newline(c=='\n');
1531 2 : col++; str_putc(S, c);
1532 : }
1533 : }
1534 : void
1535 4 : str_display_hist(pari_str *S, long n)
1536 : {
1537 4 : long l = 0;
1538 : char col[COLOR_LEN];
1539 : char *s;
1540 : /* history number */
1541 4 : if (n)
1542 : {
1543 : char buf[64];
1544 4 : if (!(GP_DATA->flags & gpd_QUIET))
1545 : {
1546 2 : str_puts(S, term_get_color(col, c_HIST));
1547 2 : sprintf(buf, "%%%ld = ", n);
1548 2 : str_puts(S, buf);
1549 2 : l = strlen(buf);
1550 : }
1551 : }
1552 : /* output */
1553 4 : str_puts(S, term_get_color(col, c_OUTPUT));
1554 4 : s = GENtostr(pari_get_hist(n));
1555 4 : if (GP_DATA->lim_lines)
1556 2 : str_lim_lines(S, s, l, GP_DATA->lim_lines);
1557 : else
1558 2 : str_puts(S, s);
1559 4 : pari_free(s);
1560 4 : str_puts(S,term_get_color(col, c_NONE));
1561 4 : }
1562 :
1563 : static void
1564 4 : gp_classic_output(long n)
1565 : {
1566 4 : pari_sp av = avma;
1567 : pari_str S;
1568 4 : str_init(&S, 1);
1569 4 : str_display_hist(&S, n);
1570 4 : str_putc(&S, 0);
1571 4 : pari_puts(S.string);
1572 4 : pari_putc('\n'); pari_flush();
1573 4 : set_avma(av);
1574 4 : }
1575 :
1576 : void
1577 60569 : gp_display_hist(long n)
1578 : {
1579 60569 : if (cb_pari_display_hist)
1580 60565 : cb_pari_display_hist(n);
1581 4 : else if (GP_DATA->fmt->prettyp == f_PRETTY && prettyp_init())
1582 0 : prettyp_output(n);
1583 : else
1584 4 : gp_classic_output(n);
1585 60569 : }
1586 :
1587 : /*******************************************************************/
1588 : /** **/
1589 : /** GP-SPECIFIC DEFAULTS **/
1590 : /** **/
1591 : /*******************************************************************/
1592 :
1593 : static long
1594 0 : atocolor(const char *s)
1595 : {
1596 0 : long l = atol(s);
1597 0 : if (l & ~0xff) pari_err(e_MISC, "invalid 8bit RGB code: %ld", l);
1598 0 : return l;
1599 : }
1600 :
1601 : GEN
1602 4 : sd_graphcolormap(const char *v, long flag)
1603 : {
1604 : char *p, *q;
1605 : long i, j, l, a, s, *lp;
1606 :
1607 4 : if (v)
1608 : {
1609 4 : pari_sp av = avma;
1610 4 : char *t = gp_filter(v);
1611 4 : if (*t != '[' || t[strlen(t)-1] != ']')
1612 0 : pari_err(e_SYNTAX, "incorrect value for graphcolormap", t, t);
1613 76 : for (s = 0, p = t+1, l = 2, a=0; *p; p++)
1614 72 : if (*p == '[')
1615 : {
1616 0 : a++;
1617 0 : while (*++p != ']')
1618 0 : if (!*p || *p == '[')
1619 0 : pari_err(e_SYNTAX, "incorrect value for graphcolormap", p, t);
1620 : }
1621 72 : else if (*p == '"')
1622 : {
1623 36 : s += sizeof(long)+1;
1624 236 : while (*p && *++p != '"') s++;
1625 36 : if (!*p) pari_err(e_SYNTAX, "incorrect value for graphcolormap", p, t);
1626 36 : s = (s+sizeof(long)-1) & ~(sizeof(long)-1);
1627 : }
1628 36 : else if (*p == ',')
1629 32 : l++;
1630 4 : if (l < 4)
1631 0 : pari_err(e_MISC, "too few colors (< 4) in graphcolormap");
1632 4 : if (GP_DATA->colormap) pari_free(GP_DATA->colormap);
1633 4 : GP_DATA->colormap = (GEN)pari_malloc((l+4*a)*sizeof(long) + s);
1634 4 : GP_DATA->colormap[0] = evaltyp(t_VEC)|evallg(l);
1635 76 : for (p = t+1, i = 1, lp = GP_DATA->colormap+l; i < l; p++)
1636 72 : switch(*p)
1637 : {
1638 36 : case '"':
1639 36 : gel(GP_DATA->colormap, i) = lp;
1640 236 : q = ++p; while (*q != '"') q++;
1641 36 : *q = 0;
1642 36 : j = 1 + nchar2nlong(q-p+1);
1643 36 : lp[0] = evaltyp(t_STR)|evallg(j);
1644 36 : strncpy(GSTR(lp), p, q-p+1);
1645 36 : lp += j; p = q;
1646 36 : break;
1647 0 : case '[': {
1648 : const char *ap[3];
1649 0 : gel(GP_DATA->colormap, i) = lp;
1650 0 : lp[0] = evaltyp(t_VECSMALL)|_evallg(4);
1651 0 : for (ap[0] = ++p, j=0; *p && *p != ']'; p++)
1652 0 : if (*p == ',' && j<2) { *p++ = 0; ap[++j] = p; }
1653 0 : while (j<2) ap[++j] = "0";
1654 0 : if (j>2 || *p != ']')
1655 : {
1656 : char buf[100];
1657 0 : sprintf(buf, "incorrect value for graphcolormap[%ld]: ", i);
1658 0 : pari_err(e_SYNTAX, buf, p, t);
1659 : }
1660 0 : *p = '\0';
1661 0 : lp[1] = atocolor(ap[0]);
1662 0 : lp[2] = atocolor(ap[1]);
1663 0 : lp[3] = atocolor(ap[2]);
1664 0 : lp += 4;
1665 0 : break;
1666 : }
1667 36 : case ',':
1668 : case ']':
1669 36 : i++;
1670 36 : break;
1671 0 : default:
1672 0 : pari_err(e_SYNTAX, "incorrect value for graphcolormap", p, t);
1673 : }
1674 4 : set_avma(av);
1675 : }
1676 4 : if (flag == d_RETURN || flag == d_ACKNOWLEDGE)
1677 : {
1678 0 : GEN C = cgetg(lg(GP_DATA->colormap), t_VEC);
1679 0 : long i, l = lg(C);
1680 0 : for (i = 1; i < l; i++)
1681 : {
1682 0 : GEN c = gel(GP_DATA->colormap, i);
1683 0 : gel(C, i) = (typ(c) == t_STR)? gcopy(c): zv_to_ZV(c);
1684 : }
1685 0 : if (flag == d_RETURN) return C;
1686 0 : pari_printf(" graphcolormap = %Ps\n", C);
1687 : }
1688 4 : return gnil;
1689 : }
1690 :
1691 : GEN
1692 4 : sd_graphcolors(const char *v, long flag)
1693 4 : { return sd_intarray(v, flag, &(GP_DATA->graphcolors), "graphcolors"); }
1694 : GEN
1695 35 : sd_plothsizes(const char *v, long flag)
1696 35 : { return sd_intarray(v, flag, &(GP_DATA->plothsizes), "plothsizes"); }
1697 :
1698 : GEN
1699 0 : sd_help(const char *v, long flag)
1700 : {
1701 : const char *str;
1702 0 : if (v)
1703 : {
1704 0 : if (GP_DATA->secure)
1705 0 : pari_err(e_MISC,"[secure mode]: can't modify 'help' default (to %s)",v);
1706 0 : if (GP_DATA->help) pari_free((void*)GP_DATA->help);
1707 : #ifndef _WIN32
1708 0 : GP_DATA->help = path_expand(v);
1709 : #else
1710 : GP_DATA->help = pari_strdup(v);
1711 : #endif
1712 : }
1713 0 : str = GP_DATA->help? GP_DATA->help: "none";
1714 0 : if (flag == d_RETURN) return strtoGENstr(str);
1715 0 : if (flag == d_ACKNOWLEDGE)
1716 0 : pari_printf(" help = \"%s\"\n", str);
1717 0 : return gnil;
1718 : }
1719 :
1720 : static GEN
1721 0 : sd_prompt_set(const char *v, long flag, const char *how, char **p)
1722 : {
1723 0 : if (v) {
1724 0 : if (*p) free(*p);
1725 0 : *p = pari_strdup(v);
1726 : }
1727 0 : if (flag == d_RETURN) return strtoGENstr(*p);
1728 0 : if (flag == d_ACKNOWLEDGE)
1729 0 : pari_printf(" prompt%s = \"%s\"\n", how, *p);
1730 0 : return gnil;
1731 : }
1732 : GEN
1733 0 : sd_prompt(const char *v, long flag)
1734 0 : { return sd_prompt_set(v, flag, "", &(GP_DATA->prompt)); }
1735 : GEN
1736 0 : sd_prompt_cont(const char *v, long flag)
1737 0 : { return sd_prompt_set(v, flag, "_cont", &(GP_DATA->prompt_cont)); }
1738 :
1739 : GEN
1740 7 : sd_breakloop(const char *v, long flag)
1741 7 : { return sd_toggle(v,flag,"breakloop", &(GP_DATA->breakloop)); }
1742 : GEN
1743 0 : sd_doctest(const char *v, long flag)
1744 0 : { return sd_ulong(v,flag,"doctest",&(GP_DATA->doctest), 0,1,NULL); }
1745 : GEN
1746 186 : sd_echo(const char *v, long flag)
1747 186 : { return sd_ulong(v,flag,"echo", &(GP_DATA->echo), 0,2,NULL); }
1748 : GEN
1749 2 : sd_timer(const char *v, long flag)
1750 2 : { return sd_toggle(v,flag,"timer", &(GP_DATA->chrono)); }
1751 : GEN
1752 0 : sd_recover(const char *v, long flag)
1753 0 : { return sd_toggle(v,flag,"recover", &(GP_DATA->recover)); }
1754 :
1755 : GEN
1756 0 : sd_psfile(const char *v, long flag)
1757 0 : { return sd_string(v, flag, "psfile", ¤t_psfile); }
1758 :
1759 : GEN
1760 6 : sd_lines(const char *v, long flag)
1761 6 : { return sd_ulong(v,flag,"lines",&(GP_DATA->lim_lines), 0,LONG_MAX,NULL); }
1762 : GEN
1763 0 : sd_linewrap(const char *v, long flag)
1764 : {
1765 0 : ulong old = GP_DATA->linewrap, n = GP_DATA->linewrap;
1766 0 : GEN z = sd_ulong(v,flag,"linewrap",&n, 0,LONG_MAX,NULL);
1767 0 : if (old)
1768 0 : { if (!n) resetout(1); }
1769 : else
1770 0 : { if (n) init_linewrap(n); }
1771 0 : GP_DATA->linewrap = n; return z;
1772 : }
1773 :
1774 : /* readline-specific defaults */
1775 : GEN
1776 0 : sd_readline(const char *v, long flag)
1777 : {
1778 0 : const char *msg[] = {
1779 : "(bits 0x2/0x4 control matched-insert/arg-complete)", NULL};
1780 0 : ulong state = GP_DATA->readline_state;
1781 0 : GEN res = sd_ulong(v,flag,"readline", &GP_DATA->readline_state, 0, 7, msg);
1782 :
1783 0 : if (state != GP_DATA->readline_state)
1784 0 : (void)sd_toggle(GP_DATA->readline_state? "1": "0", d_SILENT, "readline", &(GP_DATA->use_readline));
1785 0 : return res;
1786 : }
1787 : GEN
1788 4 : sd_histfile(const char *v, long flag)
1789 : {
1790 4 : char *old = GP_DATA->histfile;
1791 4 : GEN r = sd_string(v, flag, "histfile", &GP_DATA->histfile);
1792 4 : if (v && !*v)
1793 : {
1794 0 : free(GP_DATA->histfile);
1795 0 : GP_DATA->histfile = NULL;
1796 : }
1797 4 : else if (GP_DATA->histfile != old && (!old || strcmp(old,GP_DATA->histfile)))
1798 : {
1799 4 : if (cb_pari_init_histfile) cb_pari_init_histfile();
1800 : }
1801 4 : return r;
1802 : }
1803 :
1804 : /********************************************************************/
1805 : /** **/
1806 : /** METACOMMANDS **/
1807 : /** **/
1808 : /********************************************************************/
1809 : void
1810 6 : pari_print_version(void)
1811 : {
1812 6 : pari_sp av = avma;
1813 6 : char *buf, *ver = what_cc();
1814 6 : const char *kver = pari_kernel_version();
1815 6 : const char *date = paricfg_compiledate, *mt = paricfg_mt_engine;
1816 6 : ulong t = pari_mt_nbthreads;
1817 :
1818 6 : pari_center(paricfg_version);
1819 6 : buf = stack_malloc(strlen(paricfg_buildinfo) + 2 + strlen(kver));
1820 6 : (void)sprintf(buf, paricfg_buildinfo, kver);
1821 6 : pari_center(buf);
1822 6 : buf = stack_malloc(128 + strlen(date) + (ver? strlen(ver): 0));
1823 6 : if (ver) (void)sprintf(buf, "compiled: %s, %s", date, ver);
1824 0 : else (void)sprintf(buf, "compiled: %s", date);
1825 6 : pari_center(buf);
1826 6 : if (t > 1) sprintf(buf, "threading engine: %s, nbthreads = %lu",mt,t);
1827 6 : else sprintf(buf, "threading engine: %s",mt);
1828 6 : pari_center(buf);
1829 6 : ver = what_readline();
1830 6 : buf = stack_malloc(strlen(ver) + 64);
1831 6 : (void)sprintf(buf, "(readline %s, extended help%s enabled)", ver,
1832 6 : has_ext_help()? "": " not");
1833 6 : pari_center(buf); set_avma(av);
1834 6 : }
1835 :
1836 : static int
1837 7 : cmp_epname(void *E, GEN e, GEN f)
1838 : {
1839 : (void)E;
1840 7 : return strcmp(((entree*)e)->name, ((entree*)f)->name);
1841 : }
1842 : /* if fun is set print only closures, else only non-closures
1843 : * if member is set print only member functions, else only non-members */
1844 : static void
1845 7 : print_all_user_obj(int fun, int member)
1846 : {
1847 7 : pari_sp av = avma;
1848 7 : long i, iL = 0, lL = 1024;
1849 7 : GEN L = cgetg(lL+1, t_VECSMALL);
1850 : entree *ep;
1851 952 : for (i = 0; i < functions_tblsz; i++)
1852 10654 : for (ep = functions_hash[i]; ep; ep = ep->next)
1853 9709 : if (EpVALENCE(ep) == EpVAR && fun == (typ((GEN)ep->value) == t_CLOSURE))
1854 : {
1855 14 : const char *f = ep->name;
1856 14 : if (member == (f[0] == '_' && f[1] == '.'))
1857 : {
1858 14 : if (iL >= lL) { lL *= 2; L = vecsmall_lengthen(L, lL); }
1859 14 : L[++iL] = (long)ep;
1860 : }
1861 : }
1862 7 : if (iL)
1863 : {
1864 7 : setlg(L, iL+1);
1865 7 : gen_sort_inplace(L, NULL, &cmp_epname, NULL);
1866 21 : for (i = 1; i <= iL; i++)
1867 : {
1868 14 : ep = (entree*)L[i];
1869 14 : pari_printf("%s =\n %Ps\n\n", ep->name, ep->value);
1870 : }
1871 : }
1872 7 : set_avma(av);
1873 7 : }
1874 :
1875 : /* get_sep, removing enclosing quotes */
1876 : static char *
1877 133 : get_name(const char *s)
1878 : {
1879 133 : char *t = get_sep(s);
1880 133 : if (*t == '"')
1881 : {
1882 56 : long n = strlen(t)-1;
1883 56 : if (t[n] == '"') { t[n] = 0; t++; }
1884 : }
1885 133 : return t;
1886 : }
1887 : static void
1888 56 : ack_debug(const char *s, long d) {pari_printf(" debug(\"%s\") = %ld\n",s,d);}
1889 : static void
1890 42 : ack_setdebug(const char *s, long d) {setdebug(s, d); ack_debug(s, d);}
1891 :
1892 : static void
1893 484 : escape(const char *tch, int ismain)
1894 : {
1895 484 : const char *s = tch;
1896 : long d;
1897 : char c;
1898 : GEN x;
1899 484 : switch ((c = *s++))
1900 : {
1901 0 : case 'w': case 'x': case 'a': case 'b': case 'B': case 'm':
1902 : { /* history things */
1903 0 : if (c != 'w' && c != 'x') d = get_int(s,0);
1904 : else
1905 : {
1906 0 : d = atol(s); if (*s == '-') s++;
1907 0 : while (isdigit((unsigned char)*s)) s++;
1908 : }
1909 0 : x = pari_get_hist(d);
1910 0 : switch (c)
1911 : {
1912 0 : case 'B': /* prettyprinter */
1913 0 : if (prettyp_init())
1914 : {
1915 0 : pari_flush(); prettyp_GEN(x);
1916 0 : pari_flush(); break;
1917 : }
1918 : case 'b': /* fall through */
1919 0 : case 'm': matbrute(x, GP_DATA->fmt->format, -1); break;
1920 0 : case 'a': brute(x, GP_DATA->fmt->format, -1); break;
1921 0 : case 'x': dbgGEN(x, get_int(s, -1)); break;
1922 0 : case 'w':
1923 0 : s = get_name(s); if (!*s) s = current_logfile;
1924 0 : write0(s, mkvec(x)); return;
1925 : }
1926 0 : pari_putc('\n'); return;
1927 : }
1928 :
1929 0 : case 'c': commands(-1); break;
1930 0 : case 'd': (void)setdefault(NULL,NULL,d_SILENT); break;
1931 109 : case 'e':
1932 109 : s = get_sep(s);
1933 109 : if (!*s) s = (GP_DATA->echo)? "0": "1";
1934 109 : (void)sd_echo(s,d_ACKNOWLEDGE); break;
1935 112 : case 'g':
1936 112 : if (isdigit((unsigned char)*s))
1937 : {
1938 35 : const char *t = s + 1;
1939 35 : if (isdigit((unsigned char)*t)) t++; /* atol(s) < 99 */
1940 35 : t = get_name(t);
1941 35 : if (*t) { d = atol(s); ack_setdebug(t, d); break; }
1942 : }
1943 77 : else if (*s == '"' || isalpha((unsigned char)*s))
1944 : {
1945 77 : char *t = get_name(s);
1946 77 : if (t[1] && !isdigit((unsigned char)t[1]))
1947 42 : {
1948 56 : char *T = t + strlen(t) - 1;
1949 56 : if (isdigit((unsigned char)*T))
1950 : {
1951 21 : if (isdigit((unsigned char)T[-1])) T--; /* < 99 */
1952 21 : d = atol(T); *T = 0;
1953 21 : ack_setdebug(get_name(t), d); /* get_name in case of ".." */
1954 : }
1955 : else
1956 : {
1957 35 : x = setdebug(t, -1); ack_debug(t, itos(x));
1958 : }
1959 : }
1960 21 : else switch (*t)
1961 : {
1962 0 : case 'm':
1963 0 : s++; (void)sd_debugmem(*s? s: NULL,d_ACKNOWLEDGE); break;
1964 21 : case 'f':
1965 21 : s++; (void)sd_debugfiles(*s? s: NULL,d_ACKNOWLEDGE); break;
1966 : }
1967 63 : break;
1968 : }
1969 14 : (void)sd_debug(*s? s: NULL,d_ACKNOWLEDGE); break;
1970 : break;
1971 0 : case 'h': print_functions_hash(s); break;
1972 0 : case 'l':
1973 0 : s = get_name(s);
1974 0 : if (*s)
1975 : {
1976 0 : if (pari_logfile) { (void)sd_logfile(s,d_ACKNOWLEDGE);break; }
1977 0 : (void)sd_logfile(s,d_SILENT);
1978 : }
1979 0 : (void)sd_log(pari_logfile?"0":"1",d_ACKNOWLEDGE);
1980 0 : break;
1981 0 : case 'o': (void)sd_output(*s? s: NULL,d_ACKNOWLEDGE); break;
1982 249 : case 'p':
1983 249 : switch (*s)
1984 : {
1985 7 : case 's': s++;
1986 7 : (void)sd_seriesprecision(*s? s: NULL,d_ACKNOWLEDGE); break;
1987 14 : case 'b' : s++;
1988 14 : (void)sd_realbitprecision(*s? s: NULL,d_ACKNOWLEDGE); break;
1989 228 : default :
1990 228 : (void)sd_realprecision(*s? s: NULL,d_ACKNOWLEDGE); break;
1991 : }
1992 249 : break;
1993 0 : case 'q': cb_pari_quit(0); break;
1994 0 : case 'r':
1995 0 : s = get_name(s);
1996 0 : if (!ismain) { (void)gp_read_file(s); break; }
1997 0 : switchin(s);
1998 0 : if (file_is_binary(pari_infile))
1999 : {
2000 0 : pari_sp av = avma;
2001 : int vector;
2002 0 : GEN x = readbin(s,pari_infile, &vector);
2003 0 : popinfile();
2004 0 : if (!x) pari_err_FILE("input file",s);
2005 0 : if (vector) /* many BIN_GEN */
2006 : {
2007 0 : long i, l = lg(x);
2008 0 : pari_warn(warner,"setting %ld history entries", l-1);
2009 0 : for (i=1; i<l; i++) pari_add_hist(gel(x,i), 0, 0);
2010 : }
2011 0 : set_avma(av);
2012 : }
2013 0 : break;
2014 0 : case 's': dbg_pari_heap(); break;
2015 7 : case 't': gentypes(); break;
2016 7 : case 'u':
2017 7 : switch(*s)
2018 : {
2019 0 : case 'v':
2020 0 : if (*++s) break;
2021 0 : print_all_user_obj(0, 0); return;
2022 0 : case 'm':
2023 0 : if (*++s) break;
2024 0 : print_all_user_obj(1, 1); return;
2025 7 : case '\0':
2026 7 : print_all_user_obj(1, 0); return;
2027 : }
2028 0 : pari_err(e_SYNTAX,"unexpected character", s,tch-1); break;
2029 0 : case 'v':
2030 0 : if (*s) pari_err(e_SYNTAX,"unexpected character", s,tch-1);
2031 0 : pari_print_version(); break;
2032 0 : case 'y':
2033 0 : s = get_sep(s);
2034 0 : if (!*s) s = (GP_DATA->simplify)? "0": "1";
2035 0 : (void)sd_simplify(s,d_ACKNOWLEDGE); break;
2036 0 : case 'z':
2037 0 : s = get_sep(s);
2038 0 : if (!*s) s = (GP_DATA->doctest)? "0": "1";
2039 0 : (void)sd_doctest(s,d_ACKNOWLEDGE); break;
2040 0 : default: pari_err(e_SYNTAX,"unexpected character", tch,tch-1);
2041 : }
2042 : }
2043 :
2044 : static int
2045 557 : chron(const char *s)
2046 : {
2047 557 : if (*s)
2048 : { /* if "#" or "##" timer metacommand. Otherwise let the parser get it */
2049 : const char *t;
2050 557 : if (*s == '#') s++;
2051 557 : if (*s) return 0;
2052 0 : if (pari_nb_hist()==0)
2053 0 : pari_printf(" *** no last result.\n");
2054 : else
2055 : {
2056 0 : t = gp_format_time(pari_get_histtime(0));
2057 0 : if (pari_mt_nbthreads==1)
2058 0 : pari_printf(" *** last result computed in %s.\n", t);
2059 : else
2060 : {
2061 0 : const char *r = gp_format_time(pari_get_histrtime(0));
2062 0 : pari_printf(" *** last result: cpu time %s, real time %s.\n", t,r);
2063 : }
2064 : }
2065 : }
2066 0 : else { GP_DATA->chrono ^= 1; (void)sd_timer(NULL,d_ACKNOWLEDGE); }
2067 0 : return 1;
2068 : }
2069 :
2070 : /* return 0: can't interpret *buf as a metacommand
2071 : * 1: did interpret *buf as a metacommand or empty command */
2072 : int
2073 946423 : gp_meta(const char *buf, int ismain)
2074 : {
2075 946423 : switch(*buf++)
2076 : {
2077 155 : case '?': gp_help(buf, h_REGULAR); break;
2078 557 : case '#': return chron(buf);
2079 484 : case '\\': escape(buf, ismain); break;
2080 21097 : case '\0': break;
2081 924130 : default: return 0;
2082 : }
2083 21715 : return 1;
2084 : }
2085 :
2086 : void
2087 7 : pari_breakpoint(void)
2088 : {
2089 7 : if (!pari_last_was_newline()) pari_putc('\n');
2090 7 : closure_err(0);
2091 7 : if (cb_pari_break_loop && cb_pari_break_loop(-1)) return;
2092 0 : cb_pari_err_recover(e_MISC);
2093 : }
|
