Code coverage tests

This page documents the degree to which the PARI/GP source code is tested by our public test suite, distributed with the source distribution in directory src/test/. This is measured by the gcov utility; we then process gcov output using the lcov frond-end.

We test a few variants depending on Configure flags on the pari.math.u-bordeaux.fr machine (x86_64 architecture), and agregate them in the final report:

The target is to exceed 90% coverage for all mathematical modules (given that branches depending on DEBUGLEVEL or DEBUGMEM are not covered). This script is run to produce the results below.

LCOV - code coverage report
Current view: top level - language - gplib.c (source / functions) Hit Total Coverage
Test: PARI/GP v2.18.1 lcov report (development 30370-b9c4b6d044) Lines: 578 1032 56.0 %
Date: 2025-07-05 09:22:59 Functions: 68 104 65.4 %
Legend: Lines: hit not hit

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

Generated by: LCOV version 1.16