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