Annotation of OpenXM_contrib/pari-2.2/src/gp/gp.c, Revision 1.1
1.1 ! noro 1: /* $Id: gp.c,v 1.83 2001/09/29 18:32:02 karim Exp $
! 2:
! 3: Copyright (C) 2000 The PARI group.
! 4:
! 5: This file is part of the PARI/GP package.
! 6:
! 7: PARI/GP is free software; you can redistribute it and/or modify it under the
! 8: terms of the GNU General Public License as published by the Free Software
! 9: Foundation. It is distributed in the hope that it will be useful, but WITHOUT
! 10: ANY WARRANTY WHATSOEVER.
! 11:
! 12: Check the License for details. You should have received a copy of it, along
! 13: with the package; see the file 'COPYING'. If not, write to the Free Software
! 14: Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
! 15:
! 16: /*******************************************************************/
! 17: /** **/
! 18: /** PARI CALCULATOR **/
! 19: /** **/
! 20: /*******************************************************************/
! 21: #include "pari.h"
! 22: #ifdef _WIN32
! 23: # include <windows.h>
! 24: # ifndef WINCE
! 25: # include <process.h>
! 26: # endif
! 27: #endif
! 28: #ifdef HAS_STRFTIME
! 29: # include <time.h>
! 30: #endif
! 31: #include "../language/anal.h"
! 32: #include "gp.h"
! 33:
! 34: #ifdef READLINE
! 35: extern void init_readline();
! 36: long use_readline = 1;
! 37: int readline_init = 1;
! 38: BEGINEXTERN
! 39: # if defined(__cplusplus) && defined(__SUNPRO_CC)
! 40: /* readline.h gives a bad definition of readline() */
! 41: extern char*readline(char*);
! 42: # else
! 43: # ifdef READLINE_LIBRARY
! 44: # include <readline.h>
! 45: # else
! 46: # include <readline/readline.h>
! 47: # endif
! 48: # endif
! 49: extern int isatty(int);
! 50: extern void add_history(char*);
! 51: ENDEXTERN
! 52: #endif
! 53:
! 54: char* _analyseur(void);
! 55: void _set_analyseur(char *s);
! 56: void err_recover(long numerr);
! 57: void free_graph(void);
! 58: void gp_expand_path(char *v);
! 59: int gp_init_entrees(module *modlist, entree **hash, int force);
! 60: long gptimer(void);
! 61: void init80(long n);
! 62: void init_defaults(int force);
! 63: void initout(int initerr);
! 64: void init_graph(void);
! 65: void init_lim_lines(char *s, long max);
! 66: extern void install0(char *name, char *code, char *gpname, char *lib);
! 67: void pari_sig_init(void (*f)(int));
! 68: int whatnow(char *s, int flag);
! 69:
! 70: #if 0 /* to debug TeXmacs interface */
! 71: #define DATA_BEGIN ((char) 'B')
! 72: #define DATA_END ((char) 'E')
! 73: #else
! 74: #define DATA_BEGIN ((char) 2)
! 75: #define DATA_END ((char) 5)
! 76: #endif
! 77: #define DATA_ESCAPE ((char) 27)
! 78:
! 79: #define MAX_PROMPT_LEN 128
! 80: #define DFT_PROMPT "? "
! 81: #define COMMENTPROMPT "comment> "
! 82: #define DFT_INPROMPT ""
! 83: static GEN *hist;
! 84: static char *help_prg,*path;
! 85: static char prompt[MAX_PROMPT_LEN];
! 86: static char thestring[256];
! 87: static char *prettyprinter;
! 88: static char *prettyprinter_dft = "tex2mail -TeX -noindent -ragged -by_par";
! 89: static pariFILE *prettyprinter_file;
! 90: static long prettyp, test_mode, quiet_mode, gpsilent, simplifyflag;
! 91: static long chrono, pariecho, primelimit, parisize, strictmatch;
! 92: static long tglobal, histsize, paribufsize, lim_lines;
! 93: static int tm_is_waiting = 0, handle_C_C = 0;
! 94: static gp_format fmt;
! 95:
! 96: typedef struct Buffer {
! 97: char *buf;
! 98: long len;
! 99: jmp_buf env;
! 100: int flenv;
! 101: } Buffer;
! 102:
! 103: #define current_buffer (bufstack?((Buffer*)(bufstack->value)):NULL)
! 104: static stack *bufstack = NULL;
! 105:
! 106: #define LBRACE '{'
! 107: #define RBRACE '}'
! 108: #define pariputs_opt(s) if (!quiet_mode) pariputs(s)
! 109: #define skip_space(s) while (isspace((int)*s)) s++
! 110: #define skip_alpha(s) while (isalpha((int)*s)) s++
! 111: #define ask_filtre(t) filtre("",NULL,t)
! 112:
! 113: static void
! 114: usage(char *s)
! 115: {
! 116: printf("### Usage: %s [options]\n", s);
! 117: printf("Options are:\n");
! 118: printf("\t[-b buffersize]\tDeprecated\n");
! 119: printf("\t[-emacs]\tRun as if in Emacs shell\n");
! 120: printf("\t[-f]\t\tFaststart: do not read .gprc\n");
! 121: printf("\t[--help]\tPrint this message\n");
! 122: printf("\t[-q]\t\tQuiet mode: do not print banner and history numbers\n");
! 123: printf("\t[-p primelimit]\tPrecalculate primes up to the limit\n");
! 124: printf("\t[-s stacksize]\tStart with the PARI stack of given size (in bytes)\n");
! 125: printf("\t[-test]\t\tTest mode. As -q, plus wrap long lines\n");
! 126: printf("\t[--version]\tOutput version info and exit\n\n");
! 127: exit(0);
! 128: }
! 129:
! 130: /* must be called BEFORE pari_init() */
! 131: static void
! 132: gp_preinit(int force)
! 133: {
! 134: static char *dflt;
! 135: char *help;
! 136: long i;
! 137:
! 138: if (force)
! 139: {
! 140: #if !defined(macintosh) || defined(__MWERKS__)
! 141: primelimit = 500000; parisize = 1000000*sizeof(long);
! 142: dflt = DFT_PROMPT;
! 143: #else
! 144: primelimit = 200000; parisize = 1000000;
! 145: dflt = "?\n";
! 146: #endif
! 147: }
! 148: strcpy(prompt, dflt);
! 149:
! 150: #if defined(UNIX) || defined(__EMX__)
! 151: # if defined(__EMX__) || defined(__CYGWIN32__)
! 152: path = pari_strdup(".;C:;C:/gp");
! 153: # else
! 154: path = pari_strdup(".:~:~/gp");
! 155: # endif
! 156: help = getenv("GPHELP");
! 157: # ifdef GPHELP
! 158: if (!help) help = GPHELP;
! 159: # endif
! 160: #else
! 161: path = pari_strdup(".");
! 162: help = NULL;
! 163: #endif
! 164: help_prg = help? pari_strdup(help): NULL;
! 165: prettyp = f_PRETTYMAT;
! 166: strictmatch = simplifyflag = 1;
! 167: tglobal = 0;
! 168: bufstack = NULL;
! 169: secure = test_mode = under_emacs = under_texmacs = chrono = pariecho = 0;
! 170: prettyprinter = prettyprinter_dft;
! 171: prettyprinter_file = NULL;
! 172: fmt.format = 'g'; fmt.field = 0;
! 173: #ifdef LONG_IS_64BIT
! 174: fmt.nb = 38;
! 175: #else
! 176: fmt.nb = 28;
! 177: #endif
! 178: lim_lines = 0;
! 179: histsize = 5000; paribufsize = 1024;
! 180: i = histsize*sizeof(GEN);
! 181: hist = (GEN *) gpmalloc(i); memset(hist,0,i);
! 182: for (i=0; i<c_LAST; i++) gp_colors[i] = c_NONE;
! 183: }
! 184:
! 185: #ifdef MAXPATHLEN
! 186: # define GET_SEP_SIZE MAXPATHLEN
! 187: #else
! 188: # define GET_SEP_SIZE 128
! 189: #endif
! 190: #define separe(c) ((c)==';' || (c)==':')
! 191:
! 192: /* Return all chars, up to next separator */
! 193: static char*
! 194: get_sep0(char *t, int colon)
! 195: {
! 196: static char buf[GET_SEP_SIZE], *lim = buf + GET_SEP_SIZE-1;
! 197: char *s = buf;
! 198: int outer=1;
! 199:
! 200: for(;;)
! 201: {
! 202: switch(*s++ = *t++)
! 203: {
! 204: case '"':
! 205: if (outer || (s >= buf+2 && s[-2] != '\\')) outer = !outer;
! 206: break;
! 207: case '\0':
! 208: return buf;
! 209: case ';':
! 210: if (outer) { s[-1]=0; return buf; } break;
! 211: case ':':
! 212: if (outer && colon) { s[-1]=0; return buf; } break;
! 213: }
! 214: if (s == lim) err(talker,"buffer overflow in get_sep");
! 215: }
! 216: }
! 217:
! 218: static char*
! 219: get_sep(char *t)
! 220: {
! 221: return get_sep0(t,1);
! 222: }
! 223:
! 224: static char*
! 225: get_sep_colon_ok(char *t)
! 226: {
! 227: return get_sep0(t,0);
! 228: }
! 229:
! 230: /* as above, t must be writeable, return 1 if we modified t */
! 231: static int
! 232: get_sep2(char *t)
! 233: {
! 234: int outer=1;
! 235: char *s = t;
! 236:
! 237: for(;;)
! 238: {
! 239: switch (*s++)
! 240: {
! 241: case '"':
! 242: if (outer || s[-2] != '\\') outer = !outer;
! 243: break;
! 244: case '\0':
! 245: return 0;
! 246: default:
! 247: if (outer && separe(*s)) { *s=0; return 1; }
! 248: }
! 249: }
! 250: }
! 251:
! 252: static long
! 253: get_int(char *s, long dflt)
! 254: {
! 255: char *p=get_sep(s);
! 256: long n=atol(p);
! 257:
! 258: if (*p == '-') p++;
! 259: while(isdigit((int)*p)) { p++; dflt=n; }
! 260: switch(*p)
! 261: {
! 262: case 'k': case 'K': dflt *= 1000; p++; break;
! 263: case 'm': case 'M': dflt *= 1000000; p++; break;
! 264: }
! 265: if (*p) err(talker2,"I was expecting an integer here", s, s);
! 266: return dflt;
! 267: }
! 268:
! 269: /* tell TeXmacs GP will start outputing data */
! 270: static void
! 271: tm_start_output()
! 272: {
! 273: if (!tm_is_waiting) { printf("%cverbatim:",DATA_BEGIN); fflush(stdout); }
! 274: tm_is_waiting = 1;
! 275: }
! 276:
! 277: /* tell TeXmacs GP is done and is waiting for new data */
! 278: static void
! 279: tm_end_output()
! 280: {
! 281: if (tm_is_waiting) { printf("%c", DATA_END); fflush(stdout); }
! 282: tm_is_waiting = 0;
! 283: }
! 284:
! 285: static void
! 286: gp_output(GEN x)
! 287: {
! 288: long tx=typ(x);
! 289:
! 290: if (fmt.nb >= 0 && is_intreal_t(tx))
! 291: ecrire(x, fmt.format, fmt.nb, fmt.field);
! 292: else
! 293: switch(prettyp)
! 294: {
! 295: case f_PRETTYMAT: matbrute(x, fmt.format, fmt.nb); break;
! 296: case f_PRETTY:
! 297: case f_PRETTYOLD: sor(x, fmt.format, fmt.nb, fmt.field); break;
! 298: case f_RAW : brute(x, fmt.format, fmt.nb); break;
! 299: case f_TEX : texe(x, fmt.format, fmt.nb); break;
! 300: }
! 301: }
! 302:
! 303: /* print a sequence of (NULL terminated) GEN */
! 304: void
! 305: print0(GEN *g, long flag)
! 306: {
! 307: int old=prettyp;
! 308:
! 309: if (flag < NBFORMATS) added_newline=1;
! 310: else
! 311: { flag -= NBFORMATS; added_newline=0; }
! 312: prettyp=flag;
! 313:
! 314: for( ; *g; g++)
! 315: if (typ(*g)==t_STR)
! 316: pariputs(GSTR(*g)); /* otherwise it's surrounded by "" */
! 317: else
! 318: gp_output(*g);
! 319:
! 320: if (added_newline) pariputc('\n');
! 321: prettyp=old; pariflush();
! 322: }
! 323:
! 324: /* write a sequence of (NULL terminated) GEN, to file s */
! 325: void
! 326: write0(char *s, GEN *g, long flag)
! 327: {
! 328: int i = added_newline;
! 329: s = expand_tilde(s);
! 330: if (secure)
! 331: {
! 332: fprintferr("[secure mode]: about to write to '%s'. OK ? (^C if not)\n",s);
! 333: hit_return();
! 334: }
! 335: switchout(s); free(s);
! 336: print0(g,flag); added_newline = i;
! 337: switchout(NULL);
! 338: }
! 339:
! 340: void
! 341: gpwritebin(char *s, GEN x)
! 342: {
! 343: s = expand_tilde(s);
! 344: if (secure)
! 345: {
! 346: fprintferr("[secure mode]: about to write to '%s'. OK ? (^C if not)\n",s);
! 347: hit_return();
! 348: }
! 349: writebin(s,x); free(s);
! 350: }
! 351:
! 352: Buffer *
! 353: new_buffer()
! 354: {
! 355: Buffer *b = (Buffer*) gpmalloc(sizeof(Buffer));
! 356: b->len = paribufsize;
! 357: b->buf = gpmalloc(b->len);
! 358: b->flenv = 0; return b;
! 359: }
! 360:
! 361: void
! 362: del_buffer(Buffer *b)
! 363: {
! 364: if (!b) return;
! 365: free(b->buf); free((void*)b);
! 366: }
! 367:
! 368: static void
! 369: pop_buffer()
! 370: {
! 371: Buffer *b = (Buffer*) pop_stack(&bufstack);
! 372: del_buffer(b);
! 373: }
! 374:
! 375: /* kill all buffers until B is met or nothing is left */
! 376: static void
! 377: kill_all_buffers(Buffer *B)
! 378: {
! 379: for(;;) {
! 380: Buffer *b = current_buffer;
! 381: if (b == B || !b) break;
! 382: pop_buffer();
! 383: }
! 384: }
! 385:
! 386: static void
! 387: jump_to_buffer()
! 388: {
! 389: Buffer *b;
! 390: while ( (b = current_buffer) )
! 391: {
! 392: if (b->flenv) break;
! 393: pop_buffer();
! 394: }
! 395: if (!b) longjmp(environnement, 0);
! 396: longjmp(b->env, 0);
! 397: }
! 398:
! 399: static void
! 400: jump_to_given_buffer(Buffer *buf)
! 401: {
! 402: Buffer *b;
! 403: while ( (b = current_buffer) )
! 404: {
! 405: if (b == buf) break;
! 406: pop_buffer();
! 407: }
! 408: if (!b->env) { b = NULL; err(warner,"no environmnent tied to buffer"); }
! 409: if (!b) longjmp(environnement, 0);
! 410: longjmp(b->env, 0);
! 411: }
! 412:
! 413: /********************************************************************/
! 414: /* */
! 415: /* DEFAULTS */
! 416: /* */
! 417: /********************************************************************/
! 418: static void
! 419: do_strftime(char *s, char *buf)
! 420: {
! 421: #ifdef HAS_STRFTIME
! 422: time_t t = time(NULL);
! 423: strftime(buf,MAX_PROMPT_LEN-1,s,localtime(&t));
! 424: #else
! 425: strcpy(buf,s);
! 426: #endif
! 427: }
! 428:
! 429: static GEN
! 430: sd_numeric(char *v, int flag, char *s, long *ptn, long Min, long Max,
! 431: char **msg)
! 432: {
! 433: long n;
! 434: if (*v == 0) n = *ptn;
! 435: else
! 436: {
! 437: n = get_int(v,0);
! 438: if (*ptn == n) return gnil;
! 439: if (n > Max || n < Min)
! 440: {
! 441: sprintf(thestring, "default: incorrect value for %s [%ld-%ld]",
! 442: s, Min, Max);
! 443: err(talker2, thestring, v,v);
! 444: }
! 445: *ptn = n;
! 446: }
! 447: switch(flag)
! 448: {
! 449: case d_RETURN: return stoi(n);
! 450: case d_ACKNOWLEDGE:
! 451: if (msg)
! 452: {
! 453: if (!*msg)
! 454: msg++; /* single msg, always printed */
! 455: else
! 456: msg += n; /* one per possible value */
! 457: pariputsf(" %s = %ld %s\n", s, n, *msg);
! 458: }
! 459: else if (Max != 1 || Min != 0)
! 460: pariputsf(" %s = %ld\n", s, n);
! 461: else /* toggle */
! 462: {
! 463: if (n==1) pariputsf(" %s = 1 (on)\n", s);
! 464: else pariputsf(" %s = 0 (off)\n", s);
! 465: } /* fall through */
! 466: default: return gnil;
! 467: }
! 468: }
! 469:
! 470: #define PRECDIGIT (long)((prec-2.)*pariK)
! 471: static GEN
! 472: sd_realprecision(char *v, int flag)
! 473: {
! 474: if (*v)
! 475: {
! 476: long newnb = get_int(v, fmt.nb);
! 477: long newprec = (long) (newnb*pariK1 + 3);
! 478:
! 479: if (fmt.nb == newnb && prec == newprec) return gnil;
! 480: if (newnb < 0) err(talker,"default: negative real precision");
! 481: fmt.nb = newnb; prec = newprec;
! 482: }
! 483: if (flag == d_RETURN) return stoi(fmt.nb);
! 484: if (flag == d_ACKNOWLEDGE)
! 485: {
! 486: long n = PRECDIGIT;
! 487: pariputsf(" realprecision = %ld significant digits", n);
! 488: if (n != fmt.nb) pariputsf(" (%ld digits displayed)", fmt.nb);
! 489: pariputc('\n');
! 490: }
! 491: return gnil;
! 492: }
! 493: #undef PRECDIGIT
! 494:
! 495: static GEN
! 496: sd_seriesprecision(char *v, int flag)
! 497: {
! 498: char *msg[] = {NULL, "significant terms"};
! 499: return sd_numeric(v,flag,"seriesprecision",&precdl, 0,LGBITS,msg);
! 500: }
! 501:
! 502: static GEN
! 503: sd_format(char *v, int flag)
! 504: {
! 505: if (*v)
! 506: {
! 507: char c = *v;
! 508: if (c!='e' && c!='f' && c!='g')
! 509: err(talker2,"default: inexistent format",v,v);
! 510: fmt.format = c; v++;
! 511:
! 512: if (isdigit((int)*v))
! 513: { fmt.field=atol(v); while (isdigit((int)*v)) v++; }
! 514: if (*v++ == '.')
! 515: {
! 516: if (*v == '-') fmt.nb = -1;
! 517: else
! 518: if (isdigit((int)*v)) fmt.nb=atol(v);
! 519: }
! 520: }
! 521: if (flag == d_RETURN)
! 522: {
! 523: sprintf(thestring, "%c%ld.%ld", fmt.format, fmt.field, fmt.nb);
! 524: return strtoGENstr(thestring,0);
! 525: }
! 526: if (flag == d_ACKNOWLEDGE)
! 527: pariputsf(" format = %c%ld.%ld\n", fmt.format, fmt.field, fmt.nb);
! 528: return gnil;
! 529: }
! 530:
! 531: static long
! 532: gp_get_color(char **st)
! 533: {
! 534: char *s, *v = *st;
! 535: int c, trans;
! 536: if (isdigit((int)*v))
! 537: { c = atol(v); trans = 1; } /* color on transparent background */
! 538: else
! 539: {
! 540: if (*v == '[')
! 541: {
! 542: char *a[3];
! 543: int i = 0;
! 544: for (a[0] = s = ++v; *s && *s != ']'; s++)
! 545: if (*s == ',') { *s = 0; a[++i] = s+1; }
! 546: if (*s != ']') err(talker2,"expected character: ']'",s, *st);
! 547: *s = 0; for (i++; i<3; i++) a[i] = "";
! 548: /* properties | color | background */
! 549: c = (atoi(a[2])<<8) | atoi(a[0]) | (atoi(a[1])<<4);
! 550: trans = (*(a[1]) == 0);
! 551: v = s + 1;
! 552: }
! 553: else { c = c_NONE; trans = 0; }
! 554: }
! 555: if (trans) c = c | (1<<12);
! 556: while (*v && *v++ != ',') /* empty */;
! 557: if (c != c_NONE) disable_color=0;
! 558: *st = v; return c;
! 559: }
! 560:
! 561: static GEN
! 562: sd_colors(char *v, int flag)
! 563: {
! 564: long c,l;
! 565: if (*v && !under_emacs && !under_texmacs)
! 566: {
! 567: disable_color=1;
! 568: l = strlen(v);
! 569: if (l <= 2 && strncmp(v, "no", l) == 0)
! 570: v = "";
! 571: if (l <= 6 && strncmp(v, "darkbg", l) == 0)
! 572: v = "1, 5, 3, 7, 6, 2, 3"; /* Assume recent ReadLine. */
! 573: if (l <= 7 && strncmp(v, "lightbg", l) == 0)
! 574: v = "1, 6, 3, 4, 5, 2, 3"; /* Assume recent ReadLine. */
! 575: if (l <= 6 && strncmp(v, "boldfg", l) == 0) /* Good for darkbg consoles */
! 576: v = "[1,,1], [5,,1], [3,,1], [7,,1], [6,,1], [2,,1], [3,,1]";
! 577: v = filtre(v,NULL, f_INIT|f_REG);
! 578: for (c=c_ERR; c < c_LAST; c++)
! 579: gp_colors[c] = gp_get_color(&v);
! 580: }
! 581: if (flag == d_ACKNOWLEDGE || flag == d_RETURN)
! 582: {
! 583: char *s = thestring;
! 584: int col[3], n;
! 585: for (*s=0,c=c_ERR; c < c_LAST; c++)
! 586: {
! 587: n = gp_colors[c];
! 588: if (n == c_NONE)
! 589: sprintf(s,"no");
! 590: else
! 591: {
! 592: decode_color(n,col);
! 593: if (n & (1<<12))
! 594: {
! 595: if (col[0])
! 596: sprintf(s,"[%d,,%d]",col[1],col[0]);
! 597: else
! 598: sprintf(s,"%d",col[1]);
! 599: }
! 600: else
! 601: sprintf(s,"[%d,%d,%d]",col[1],col[2],col[0]);
! 602: }
! 603: s += strlen(s);
! 604: if (c < c_LAST - 1) { *s++=','; *s++=' '; }
! 605: }
! 606: if (flag==d_RETURN) return strtoGENstr(thestring,0);
! 607: pariputsf(" colors = \"%s\"\n",thestring);
! 608: }
! 609: return gnil;
! 610: }
! 611:
! 612: static GEN
! 613: sd_compatible(char *v, int flag)
! 614: {
! 615: char *msg[] = {
! 616: "(no backward compatibility)",
! 617: "(warn when using obsolete functions)",
! 618: "(use old functions, don't ignore case)",
! 619: "(use old functions, ignore case)", NULL
! 620: };
! 621: long old = compatible;
! 622: GEN r = sd_numeric(v,flag,"compatible",&compatible, 0,3,msg);
! 623:
! 624: if (old != compatible && flag != d_INITRC)
! 625: {
! 626: int res = gp_init_entrees(new_fun_set? pari_modules: pari_oldmodules,
! 627: functions_hash, 0);
! 628: if (res) err(warner,"user functions re-initialized");
! 629: }
! 630: return r;
! 631: }
! 632:
! 633: static GEN
! 634: sd_secure(char *v, int flag)
! 635: {
! 636: if (*v && secure)
! 637: {
! 638: fprintferr("[secure mode]: Do you want to modify the 'secure' flag? (^C if not)\n");
! 639: hit_return();
! 640: }
! 641: return sd_numeric(v,flag,"secure",&secure, 0,1,NULL);
! 642: }
! 643:
! 644: static GEN
! 645: sd_buffersize(char *v, int flag)
! 646: { return sd_numeric(v,flag,"buffersize",&paribufsize, 1,
! 647: (VERYBIGINT / sizeof(long)) - 1,NULL); }
! 648: static GEN
! 649: sd_debug(char *v, int flag)
! 650: { return sd_numeric(v,flag,"debug",&DEBUGLEVEL, 0,20,NULL); }
! 651:
! 652: static GEN
! 653: sd_rl(char *v, int flag)
! 654: {
! 655: #ifdef READLINE
! 656: # if 0 /* Works - even when init_readline() was called */
! 657: if (readline_init && *v == '0')
! 658: err(talker, "Too late to switch off readline mode");
! 659: # endif
! 660: if (!readline_init && *v && *v != '0') {
! 661: init_readline();
! 662: readline_init = 1;
! 663: }
! 664: return sd_numeric(v,flag,"readline",&use_readline, 0,20,NULL);
! 665: #else /* !( defined READLINE ) */
! 666: long dummy;
! 667: return sd_numeric(v,flag,"readline",&dummy, 0,20,NULL);
! 668: #endif
! 669: }
! 670:
! 671: static GEN
! 672: sd_debugfiles(char *v, int flag)
! 673: { return sd_numeric(v,flag,"debugfiles",&DEBUGFILES, 0,20,NULL); }
! 674:
! 675: static GEN
! 676: sd_debugmem(char *v, int flag)
! 677: { return sd_numeric(v,flag,"debugmem",&DEBUGMEM, 0,20,NULL); }
! 678:
! 679: static GEN
! 680: sd_echo(char *v, int flag)
! 681: { return sd_numeric(v,flag,"echo",&pariecho, 0,1,NULL); }
! 682:
! 683: static GEN
! 684: sd_lines(char *v, int flag)
! 685: { return sd_numeric(v,flag,"lines",&lim_lines, 0,VERYBIGINT,NULL); }
! 686:
! 687: static GEN
! 688: sd_histsize(char *v, int flag)
! 689: {
! 690: long n = histsize;
! 691: GEN r = sd_numeric(v,flag,"histsize",&n, 1,
! 692: (VERYBIGINT / sizeof(long)) - 1,NULL);
! 693: if (n != histsize)
! 694: {
! 695: long i = n*sizeof(GEN);
! 696: GEN *gg = (GEN *) gpmalloc(i); memset(gg,0,i);
! 697:
! 698: if (tglobal)
! 699: {
! 700: long k = (tglobal-1) % n;
! 701: long kmin = k - min(n,histsize), j = k;
! 702:
! 703: i = (tglobal-1) % histsize;
! 704: while (k > kmin)
! 705: {
! 706: gg[j] = hist[i];
! 707: hist[i] = NULL;
! 708: if (!i) i = histsize;
! 709: if (!j) j = n;
! 710: i--; j--; k--;
! 711: }
! 712: while (hist[i])
! 713: {
! 714: gunclone(hist[i]);
! 715: if (!i) i = histsize;
! 716: i--;
! 717: }
! 718: }
! 719: free((void*)hist); hist=gg; histsize=n;
! 720: }
! 721: return r;
! 722: }
! 723:
! 724: static GEN
! 725: sd_log(char *v, int flag)
! 726: {
! 727: long vlog = logfile? 1: 0, old = vlog;
! 728: GEN r = sd_numeric(v,flag,"log",&vlog, 0,1,NULL);
! 729: if (vlog != old)
! 730: {
! 731: if (vlog)
! 732: {
! 733: logfile = fopen(current_logfile, "a");
! 734: if (!logfile) err(openfiler,"logfile",current_logfile);
! 735: #ifndef WINCE
! 736: setbuf(logfile,(char *)NULL);
! 737: #endif
! 738: }
! 739: else
! 740: {
! 741: if (flag == d_ACKNOWLEDGE)
! 742: pariputsf(" [logfile was \"%s\"]\n", current_logfile);
! 743: fclose(logfile); logfile=NULL;
! 744: }
! 745: }
! 746: return r;
! 747: }
! 748:
! 749: static GEN
! 750: sd_output(char *v, int flag)
! 751: {
! 752: char *msg[] = {"(raw)", "(prettymatrix)", "(prettyprint)", "(external prettyprint)", NULL};
! 753: return sd_numeric(v,flag,"output",&prettyp, 0,3,msg);
! 754: }
! 755:
! 756: extern void err_clean();
! 757:
! 758: void
! 759: allocatemem0(unsigned long newsize)
! 760: {
! 761: parisize = allocatemoremem(newsize);
! 762: err_clean();
! 763: jump_to_buffer();
! 764: }
! 765:
! 766: static GEN
! 767: sd_parisize(char *v, int flag)
! 768: {
! 769: long n = parisize;
! 770: GEN r = sd_numeric(v,flag,"parisize",&n, 10000,VERYBIGINT,NULL);
! 771: if (n != parisize)
! 772: {
! 773: if (flag != d_INITRC) allocatemem0(n);
! 774: parisize = n;
! 775: }
! 776: return r;
! 777: }
! 778:
! 779: static GEN
! 780: sd_primelimit(char *v, int flag)
! 781: {
! 782: long n = primelimit;
! 783: GEN r = sd_numeric(v,flag,"primelimit",&n, 0,VERYBIGINT,NULL);
! 784: if (n != primelimit)
! 785: {
! 786: if (flag != d_INITRC)
! 787: {
! 788: byteptr ptr = initprimes(n);
! 789: free(diffptr); diffptr = ptr;
! 790: }
! 791: primelimit = n;
! 792: }
! 793: return r;
! 794: }
! 795:
! 796: static GEN
! 797: sd_simplify(char *v, int flag)
! 798: { return sd_numeric(v,flag,"simplify",&simplifyflag, 0,1,NULL); }
! 799:
! 800: static GEN
! 801: sd_strictmatch(char *v, int flag)
! 802: { return sd_numeric(v,flag,"strictmatch",&strictmatch, 0,1,NULL); }
! 803:
! 804: static GEN
! 805: sd_timer(char *v, int flag)
! 806: { return sd_numeric(v,flag,"timer",&chrono, 0,1,NULL); }
! 807:
! 808: static GEN
! 809: sd_filename(char *v, int flag, char *s, char **f)
! 810: {
! 811: if (*v)
! 812: {
! 813: char *old = *f;
! 814: v = expand_tilde(v);
! 815: do_strftime(v,thestring); free(v);
! 816: *f = pari_strdup(thestring); free(old);
! 817: }
! 818: if (flag == d_RETURN) return strtoGENstr(*f,0);
! 819: if (flag == d_ACKNOWLEDGE) pariputsf(" %s = \"%s\"\n",s,*f);
! 820: return gnil;
! 821: }
! 822:
! 823: static GEN
! 824: sd_logfile(char *v, int flag)
! 825: {
! 826: GEN r = sd_filename(v, flag, "logfile", ¤t_logfile);
! 827: if (*v && logfile)
! 828: {
! 829: fclose(logfile);
! 830: logfile = fopen(current_logfile, "a");
! 831: if (!logfile) err(openfiler,"logfile",current_logfile);
! 832: #ifndef WINCE
! 833: setbuf(logfile,(char *)NULL);
! 834: #endif
! 835: }
! 836: return r;
! 837: }
! 838:
! 839: static GEN
! 840: sd_psfile(char *v, int flag)
! 841: { return sd_filename(v, flag, "psfile", ¤t_psfile); }
! 842:
! 843: static void
! 844: err_secure(char *d, char *v)
! 845: { err(talker,"[secure mode]: can't modify '%s' default (to %s)",d,v); }
! 846:
! 847: static GEN
! 848: sd_help(char *v, int flag)
! 849: {
! 850: char *str;
! 851: if (*v)
! 852: {
! 853: if (secure) err_secure("help",v);
! 854: if (help_prg) free(help_prg);
! 855: help_prg = expand_tilde(v);
! 856: }
! 857: str = help_prg? help_prg: "none";
! 858: if (flag == d_RETURN) return strtoGENstr(str,0);
! 859: if (flag == d_ACKNOWLEDGE)
! 860: pariputsf(" help = \"%s\"\n", str);
! 861: return gnil;
! 862: }
! 863:
! 864: static GEN
! 865: sd_path(char *v, int flag)
! 866: {
! 867: if (*v)
! 868: {
! 869: char *old = path;
! 870: path = pari_strdup(v); free(old);
! 871: if (flag == d_INITRC) return gnil;
! 872: gp_expand_path(path);
! 873: }
! 874: if (flag == d_RETURN) return strtoGENstr(path,0);
! 875: if (flag == d_ACKNOWLEDGE)
! 876: pariputsf(" path = \"%s\"\n",path);
! 877: return gnil;
! 878: }
! 879:
! 880: static GEN
! 881: sd_prettyprinter(char *v, int flag)
! 882: {
! 883: if (*v && !under_texmacs)
! 884: {
! 885: char *old = prettyprinter;
! 886: int cancel = (!strcmp(v,"no"));
! 887:
! 888: if (secure) err_secure("prettyprinter",v);
! 889: if (!strcmp(v,"yes")) v = prettyprinter_dft;
! 890: if (old && strcmp(old,v) && prettyprinter_file)
! 891: {
! 892: pariFILE *f;
! 893: if (cancel) f = NULL;
! 894: else
! 895: {
! 896: f = try_pipe(v, mf_OUT | mf_TEST);
! 897: if (!f)
! 898: {
! 899: err(warner,"broken prettyprinter: '%s'",v);
! 900: return gnil;
! 901: }
! 902: }
! 903: pari_fclose(prettyprinter_file);
! 904: prettyprinter_file = f;
! 905: }
! 906: prettyprinter = cancel? NULL: pari_strdup(v);
! 907: if (old && old != prettyprinter_dft) free(old);
! 908: if (flag == d_INITRC) return gnil;
! 909: }
! 910: if (flag == d_RETURN) return strtoGEN(prettyprinter? prettyprinter: "");
! 911: if (flag == d_ACKNOWLEDGE)
! 912: pariputsf(" prettyprinter = \"%s\"\n",prettyprinter? prettyprinter: "");
! 913: return gnil;
! 914: }
! 915:
! 916: static GEN
! 917: sd_prompt(char *v, int flag)
! 918: {
! 919: if (*v)
! 920: {
! 921: strncpy(prompt,v,MAX_PROMPT_LEN);
! 922: #ifdef macintosh
! 923: strcat(prompt,"\n");
! 924: #endif
! 925: }
! 926: if (flag == d_RETURN) return strtoGENstr(prompt,0);
! 927: if (flag == d_ACKNOWLEDGE)
! 928: pariputsf(" prompt = \"%s\"\n",prompt);
! 929: return gnil;
! 930: }
! 931:
! 932: default_type gp_default_list[] =
! 933: {
! 934: {"buffersize",(void*)sd_buffersize},
! 935: {"colors",(void*)sd_colors},
! 936: {"compatible",(void*)sd_compatible},
! 937: {"debug",(void*)sd_debug},
! 938: {"debugfiles",(void*)sd_debugfiles},
! 939: {"debugmem",(void*)sd_debugmem},
! 940: {"echo",(void*)sd_echo},
! 941: {"format",(void*)sd_format},
! 942: {"help",(void*)sd_help},
! 943: {"histsize",(void*)sd_histsize},
! 944: {"lines",(void*)sd_lines},
! 945: {"log",(void*)sd_log},
! 946: {"logfile",(void*)sd_logfile},
! 947: {"output",(void*)sd_output},
! 948: {"parisize",(void*)sd_parisize},
! 949: {"path",(void*)sd_path},
! 950: {"primelimit",(void*)sd_primelimit},
! 951: {"prettyprinter",(void*)sd_prettyprinter},
! 952: {"prompt",(void*)sd_prompt},
! 953: {"psfile",(void*)sd_psfile},
! 954: {"realprecision",(void*)sd_realprecision},
! 955: {"readline",(void*)sd_rl},
! 956: {"secure",(void*)sd_secure},
! 957: {"seriesprecision",(void*)sd_seriesprecision},
! 958: {"simplify",(void*)sd_simplify},
! 959: {"strictmatch",(void*)sd_strictmatch},
! 960: {"timer",(void *)sd_timer},
! 961: {NULL,NULL} /* sentinel */
! 962: };
! 963:
! 964: static void
! 965: help_default()
! 966: {
! 967: default_type *dft;
! 968:
! 969: for (dft=gp_default_list; dft->fun; dft++)
! 970: ((void (*)(ANYARG)) dft->fun)("", d_ACKNOWLEDGE);
! 971: }
! 972:
! 973: static GEN
! 974: setdefault(char *s,char *v, int flag)
! 975: {
! 976: default_type *dft;
! 977:
! 978: if (!*s) { help_default(); return gnil; }
! 979: for (dft=gp_default_list; dft->fun; dft++)
! 980: if (!strcmp(s,dft->name))
! 981: {
! 982: if (flag == d_EXISTS) return gun;
! 983: return ((GEN (*)(ANYARG)) dft->fun)(v,flag);
! 984: }
! 985: if (flag == d_EXISTS) return gzero;
! 986: err(talker,"unknown default: %s",s);
! 987: return NULL; /* not reached */
! 988: }
! 989:
! 990: /********************************************************************/
! 991: /** **/
! 992: /** HELP **/
! 993: /** **/
! 994: /********************************************************************/
! 995: static int
! 996: has_ext_help()
! 997: {
! 998: if (help_prg)
! 999: {
! 1000: char *buf = pari_strdup(help_prg), *s = buf;
! 1001: FILE *file;
! 1002:
! 1003: while (*s && *s != ' ') s++;
! 1004: *s = 0; file = fopen(buf,"r");
! 1005: if (file) { fclose(file); return 1; }
! 1006: free(buf);
! 1007: }
! 1008: return 0;
! 1009: }
! 1010:
! 1011: static int
! 1012: compare_str(char **s1, char **s2) { return strcmp(*s1, *s2); }
! 1013:
! 1014: /* Print all elements of list in columns, pausing every nbli lines
! 1015: * if nbli is non-zero.
! 1016: * list is a NULL terminated list of function names
! 1017: */
! 1018: void
! 1019: print_fun_list(char **list, int nbli)
! 1020: {
! 1021: long i=0, j=0, maxlen=0, nbcol,len, w = term_width();
! 1022: char **l;
! 1023:
! 1024: while (list[i]) i++;
! 1025: qsort (list, i, sizeof(char *), (QSCOMP)compare_str);
! 1026:
! 1027: for (l=list; *l; l++)
! 1028: {
! 1029: len = strlen(*l);
! 1030: if (len > maxlen) maxlen=len;
! 1031: }
! 1032: maxlen++; nbcol= w / maxlen;
! 1033: if (nbcol * maxlen == w) nbcol--;
! 1034: if (!nbcol) nbcol = 1;
! 1035:
! 1036: pariputc('\n'); i=0;
! 1037: for (l=list; *l; l++)
! 1038: {
! 1039: pariputs(*l); i++;
! 1040: if (i >= nbcol)
! 1041: {
! 1042: i=0; pariputc('\n');
! 1043: if (nbli && j++ > nbli) { j = 0; hit_return(); }
! 1044: continue;
! 1045: }
! 1046: len = maxlen - strlen(*l);
! 1047: while (len--) pariputc(' ');
! 1048: }
! 1049: if (i) pariputc('\n');
! 1050: }
! 1051:
! 1052: #define LIST_LEN 1023
! 1053: static void
! 1054: commands(int n)
! 1055: {
! 1056: int hashpos, s = 0, olds = LIST_LEN;
! 1057: entree *ep;
! 1058: char **list = (char **) gpmalloc((olds+1)*sizeof(char *));
! 1059:
! 1060: for (hashpos = 0; hashpos < functions_tblsz; hashpos++)
! 1061: for (ep = functions_hash[hashpos]; ep; ep = ep->next)
! 1062: if ((n<0 && ep->menu) || ep->menu == n)
! 1063: {
! 1064: list[s++] = ep->name;
! 1065: if (s >= olds)
! 1066: {
! 1067: int news = olds + (LIST_LEN + 1)*sizeof(char *);
! 1068: list = (char**) gprealloc(list,news,olds);
! 1069: olds = news;
! 1070: }
! 1071: }
! 1072: list[s]=NULL; print_fun_list(list,term_height()-4); free(list);
! 1073: }
! 1074:
! 1075: static void
! 1076: print_def_arg(GEN x)
! 1077: {
! 1078: if (x == gzero) return;
! 1079: pariputc('=');
! 1080: if (typ(x)==t_STR)
! 1081: pariputs(GSTR(x)); /* otherwise it's surrounded by "" */
! 1082: else
! 1083: bruteall(x,'g',-1,1);
! 1084: }
! 1085:
! 1086: static void
! 1087: print_user_fun(entree *ep)
! 1088: {
! 1089: gp_args *f= (gp_args*)ep->args;
! 1090: GEN q = (GEN)ep->value, *arg = f->arg;
! 1091: int i, narg;
! 1092:
! 1093: q++; /* skip initial NULL */
! 1094: pariputs(ep->name); pariputc('(');
! 1095: narg = f->narg;
! 1096: for (i=1; i<=narg; i++, arg++)
! 1097: {
! 1098: entree *ep = varentries[*q++];
! 1099: pariputs(ep? ep->name:"#");
! 1100: print_def_arg(*arg);
! 1101: if (i == narg) { arg++; break; }
! 1102: pariputs(", ");
! 1103: }
! 1104: pariputs(") = ");
! 1105: narg = f->nloc;
! 1106: if (narg)
! 1107: {
! 1108: pariputs("local(");
! 1109: for (i=1; i<=narg; i++, arg++)
! 1110: {
! 1111: entree *ep = varentries[*q++];
! 1112: pariputs(ep? ep->name:"#");
! 1113: print_def_arg(*arg);
! 1114: if (i == narg) break;
! 1115: pariputs(", ");
! 1116: }
! 1117: pariputs("); ");
! 1118: }
! 1119: pariputs((char*)q);
! 1120: }
! 1121:
! 1122: static void
! 1123: print_user_member(entree *ep)
! 1124: {
! 1125: GEN q = (GEN)ep->value;
! 1126: entree *ep2;
! 1127:
! 1128: q++; /* skip initial NULL */
! 1129: ep2 = varentries[*q++];
! 1130: pariputs(ep2? ep2->name:"#");
! 1131: pariputsf(".%s = ", ep->name);
! 1132: pariputs((char*)q);
! 1133: }
! 1134:
! 1135: static void
! 1136: user_fun()
! 1137: {
! 1138: entree *ep;
! 1139: int hash;
! 1140:
! 1141: for (hash = 0; hash < functions_tblsz; hash++)
! 1142: for (ep = functions_hash[hash]; ep; ep = ep->next)
! 1143: if (EpVALENCE(ep) == EpUSER)
! 1144: {
! 1145: pariputc(LBRACE); print_user_fun(ep);
! 1146: pariputc(RBRACE); pariputs("\n\n");
! 1147: }
! 1148: }
! 1149:
! 1150: static void
! 1151: user_member()
! 1152: {
! 1153: entree *ep;
! 1154: int hash;
! 1155:
! 1156: for (hash = 0; hash < functions_tblsz; hash++)
! 1157: for (ep = members_hash[hash]; ep; ep = ep->next)
! 1158: if (EpVALENCE(ep) == EpMEMBER)
! 1159: {
! 1160: pariputc(LBRACE); print_user_member(ep);
! 1161: pariputc(RBRACE); pariputs("\n\n");
! 1162: }
! 1163: }
! 1164:
! 1165: static void
! 1166: center(char *s)
! 1167: {
! 1168: long i, pad = term_width() - strlen(s);
! 1169: char *u = thestring;
! 1170:
! 1171: if (pad<0) pad=0; else pad >>= 1;
! 1172: for (i=0; i<pad; i++) *u++ = ' ';
! 1173: while (*s) *u++ = *s++;
! 1174: *u++='\n'; *u=0; pariputs(thestring);
! 1175: }
! 1176:
! 1177: static void
! 1178: community()
! 1179: {
! 1180: long len = strlen(GPMISCDIR) + 1024;
! 1181: char *s = gpmalloc(len);
! 1182:
! 1183: sprintf(s, "The standard distribution of GP/PARI includes a reference \
! 1184: manual, a tutorial, a reference card and quite a few examples. They should \
! 1185: have been installed in the directory '%s'. If not you should ask the person \
! 1186: who installed PARI on your system where they can be found. You can also \
! 1187: download them from the PARI WWW site 'http://www.parigp-home.de/'",
! 1188: GPMISCDIR);
! 1189: print_text(s); free(s);
! 1190:
! 1191: pariputs("\nThree mailing lists are devoted to PARI:\n\
! 1192: - pari-announce (moderated) to announce major version changes.\n\
! 1193: - pari-dev for everything related to the development of PARI, including\n\
! 1194: suggestions, technical questions, bug reports and patch submissions.\n\
! 1195: - pari-users for everything else!\n");
! 1196: print_text("\
! 1197: To subscribe, send an empty message to <listname>-subscribe@list.cr.yp.to. You \
! 1198: can only send messages to the lists you have subscribed to! An archive is kept \
! 1199: at the WWW site mentioned above. You can also reach the authors directly by \
! 1200: email: pari@math.u-bordeaux.fr (answer not guaranteed)."); }
! 1201:
! 1202: static void
! 1203: gentypes(void)
! 1204: {
! 1205: pariputs("List of the PARI types:\n\
! 1206: t_INT : long integers [ cod1 ] [ cod2 ] [ man_1 ] ... [ man_k ]\n\
! 1207: t_REAL : long real numbers [ cod1 ] [ cod2 ] [ man_1 ] ... [ man_k ]\n\
! 1208: t_INTMOD : integermods [ code ] [ mod ] [ integer ]\n\
! 1209: t_FRAC : irred. rationals [ code ] [ num. ] [ den. ]\n\
! 1210: t_FRACN : rational numbers [ code ] [ num. ] [ den. ]\n\
! 1211: t_COMPLEX: complex numbers [ code ] [ real ] [ imag ]\n\
! 1212: t_PADIC : p-adic numbers [ cod1 ] [ cod2 ] [ p ] [ p^r ] [ int ]\n\
! 1213: t_QUAD : quadratic numbers [ cod1 ] [ mod ] [ real ] [ imag ]\n\
! 1214: t_POLMOD : poly mod [ code ] [ mod ] [ polynomial ]\n\
! 1215: -------------------------------------------------------------\n\
! 1216: t_POL : polynomials [ cod1 ] [ cod2 ] [ man_1 ] ... [ man_k ]\n\
! 1217: t_SER : power series [ cod1 ] [ cod2 ] [ man_1 ] ... [ man_k ]\n\
! 1218: t_RFRAC : irred. rat. func. [ code ] [ num. ] [ den. ]\n\
! 1219: t_RFRACN : rational function [ code ] [ num. ] [ den. ]\n\
! 1220: t_QFR : real qfb [ code ] [ a ] [ b ] [ c ] [ del ]\n\
! 1221: t_QFI : imaginary qfb [ code ] [ a ] [ b ] [ c ]\n\
! 1222: t_VEC : row vector [ code ] [ x_1 ] ... [ x_k ]\n\
! 1223: t_COL : column vector [ code ] [ x_1 ] ... [ x_k ]\n\
! 1224: t_MAT : matrix [ code ] [ col_1 ] ... [ col_k ]\n\
! 1225: t_LIST : list [ code ] [ cod2 ] [ x_1 ] ... [ x_k ]\n\
! 1226: t_STR : string [ code ] [ man_1 ] ... [ man_k ]\n\
! 1227: \n");
! 1228: }
! 1229:
! 1230: static void
! 1231: menu_commands(void)
! 1232: {
! 1233: pariputs("Help topics:\n\
! 1234: 0: list of user-defined identifiers (variable, alias, function)\n\
! 1235: 1: Standard monadic or dyadic OPERATORS\n\
! 1236: 2: CONVERSIONS and similar elementary functions\n\
! 1237: 3: TRANSCENDENTAL functions\n\
! 1238: 4: NUMBER THEORETICAL functions\n\
! 1239: 5: Functions related to ELLIPTIC CURVES\n\
! 1240: 6: Functions related to general NUMBER FIELDS\n\
! 1241: 7: POLYNOMIALS and power series\n\
! 1242: 8: Vectors, matrices, LINEAR ALGEBRA and sets\n\
! 1243: 9: SUMS, products, integrals and similar functions\n\
! 1244: 10: GRAPHIC functions\n\
! 1245: 11: PROGRAMMING under GP\n\
! 1246: 12: The PARI community\n\
! 1247: \n\
! 1248: Further help (list of relevant functions): ?n (1<=n<=11).\n\
! 1249: Also:\n\
! 1250: ? functionname (short on-line help)\n\
! 1251: ?\\ (keyboard shortcuts)\n\
! 1252: ?. (member functions)\n");
! 1253: if (has_ext_help()) pariputs("\
! 1254: Extended help looks available:\n\
! 1255: ?? (opens the full user's manual in a dvi previewer)\n\
! 1256: ?? tutorial (same with the GP tutorial)\n\
! 1257: ?? refcard (same with the GP reference card)\n\
! 1258: \n\
! 1259: ?? keyword (long help text about \"keyword\" from the user's manual)\n\
! 1260: ??? keyword (a propos: list of related functions).");
! 1261: }
! 1262:
! 1263: static void
! 1264: slash_commands(void)
! 1265: {
! 1266: pariputs("# : enable/disable timer\n\
! 1267: ## : print time for last result\n\
! 1268: \\\\ : comment up to end of line\n\
! 1269: \\a {n} : print result in raw format (readable by PARI)\n\
! 1270: \\b {n} : print result in beautified format\n\
! 1271: \\c : list all commands (same effect as ?*)\n\
! 1272: \\d : print all defaults\n\
! 1273: \\e {n} : enable/disable echo (set echo=n)\n\
! 1274: \\g {n} : set debugging level\n\
! 1275: \\gf{n} : set file debugging level\n\
! 1276: \\gm{n} : set memory debugging level\n\
! 1277: \\h {m-n}: hashtable information\n\
! 1278: \\l {f} : enable/disable logfile (set logfile=f)\n\
! 1279: \\m {n} : print result in prettymatrix format\n\
! 1280: \\o {n} : change output method (0=raw, 1=prettymatrix, 2=prettyprint)\n\
! 1281: \\p {n} : change real precision\n\
! 1282: \\ps{n} : change series precision\n\
! 1283: \\q : quit completely this GP session\n\
! 1284: \\r {f} : read in a file\n\
! 1285: \\s {n} : print stack information\n\
! 1286: \\t : print the list of PARI types\n\
! 1287: \\u : print the list of user-defined functions\n\
! 1288: \\um : print the list of user-defined member functions\n\
! 1289: \\v : print current version of GP\n\
! 1290: \\w {nf} : write to a file\n\
! 1291: \\x {n} : print complete inner structure of result\n\
! 1292: \\y {n} : disable/enable automatic simplification (set simplify=n)\n\
! 1293: \n\
! 1294: {f}=optional filename. {n}=optional integer\n");
! 1295: }
! 1296:
! 1297: static void
! 1298: member_commands(void)
! 1299: {
! 1300: pariputs("Member functions, followed by relevant objects\n\n\
! 1301: a1-a6, b2-b8, c4-c6 : coeff. of the curve. ell\n\
! 1302: area : area ell\n\
! 1303: bnf : big number field bnf, bnr\n\
! 1304: clgp : class group bnf, bnr\n\
! 1305: cyc : cyclic decomposition (SNF) clgp bnf, bnr\n\
! 1306: diff, codiff: different and codifferent nf, bnf, bnr\n\
! 1307: disc : discriminant ell, nf, bnf, bnr\n\
! 1308: e, f : inertia/residues degree prid\n\
! 1309: fu : fundamental units bnf, bnr\n\
! 1310: futu : [u,w] where u=unit group, w=torsion bnf, bnr\n\
! 1311: gen : generators prid, clgp bnf, bnr\n\
! 1312: j : j-invariant ell\n\
! 1313: mod : modulus\n\
! 1314: nf : number field bnf, bnr\n\
! 1315: no : number of elements clgp bnf, bnr\n\
! 1316: omega, eta: [omega1,omega2] and [eta1, eta2] ell\n\
! 1317: p : rational prime contained in prid prid\n\
! 1318: pol : defining polynomial nf, bnf, bnr\n\
! 1319: reg : regulator bnf, bnr\n\
! 1320: roots: roots ell nf, bnf, bnr\n\
! 1321: sign : signature nf, bnf, bnr\n\
! 1322: t2 : t2 matrix nf, bnf, bnr\n\
! 1323: tate : Tate's [u^2,u,q] ell\n\
! 1324: tu : torsion unit and its order bnf, bnr\n\
! 1325: tufu : [w,u] where u=unit group, w=torsion bnf, bnr\n\
! 1326: w : Mestre's w ell\n\
! 1327: zk : integral basis nf, bnf, bnr\n\
! 1328: zkst : structure of (Z_K/m)^* (valid for idealstar also) bnr\n");
! 1329: }
! 1330:
! 1331: #define QUOTE "_QUOTE"
! 1332: #define DOUBQUOTE "_DOUBQUOTE"
! 1333: #define BACKQUOTE "_BACKQUOTE"
! 1334:
! 1335: static char *
! 1336: _cat(char *s, char *t)
! 1337: {
! 1338: *s = 0; strcat(s,t); return s + strlen(t);
! 1339: }
! 1340:
! 1341: static char *
! 1342: filter_quotes(char *s)
! 1343: {
! 1344: int i, l = strlen(s);
! 1345: int quote = 0;
! 1346: int backquote = 0;
! 1347: int doubquote = 0;
! 1348: char *str, *t;
! 1349:
! 1350: for (i=0; i < l; i++)
! 1351: switch(s[i])
! 1352: {
! 1353: case '\'': quote++; break;
! 1354: case '`' : backquote++; break;
! 1355: case '"' : doubquote++;
! 1356: }
! 1357: str = (char*)gpmalloc(l + quote * (strlen(QUOTE)-1)
! 1358: + doubquote * (strlen(DOUBQUOTE)-1)
! 1359: + backquote * (strlen(BACKQUOTE)-1) + 1);
! 1360: t = str;
! 1361: for (i=0; i < l; i++)
! 1362: switch(s[i])
! 1363: {
! 1364: case '\'': t = _cat(t, QUOTE); break;
! 1365: case '`' : t = _cat(t, BACKQUOTE); break;
! 1366: case '"' : t = _cat(t, DOUBQUOTE); break;
! 1367: default: *t++ = s[i];
! 1368: }
! 1369: *t = 0; return str;
! 1370: }
! 1371:
! 1372: #define MAX_LINE_LEN 255
! 1373: static void
! 1374: external_help(char *s, int num)
! 1375: {
! 1376: long nbli = term_height()-3, li = 0;
! 1377: char buf[MAX_LINE_LEN+1], *str, *opt = "", *ar = "";
! 1378: pariFILE *z;
! 1379: FILE *f;
! 1380:
! 1381: if (!help_prg) err(talker,"no external help program");
! 1382: s = filter_quotes(s);
! 1383: str = gpmalloc(strlen(help_prg) + strlen(s) + 64);
! 1384: if (num < 0)
! 1385: opt = "-k";
! 1386: else if (s[strlen(s)-1] != '@')
! 1387: { ar = thestring; sprintf(ar,"@%d",num); }
! 1388: sprintf(str,"%s -fromgp %s %c%s%s%c",help_prg,opt, SHELL_Q,s,ar,SHELL_Q);
! 1389: z = try_pipe(str,0); f = z->file;
! 1390: free(str); free(s);
! 1391: while (fgets(buf,MAX_LINE_LEN,f))
! 1392: {
! 1393: if (!strncmp("ugly_kludge_done",buf,16)) break;
! 1394: buf[MAX_LINE_LEN]=0; pariputs(buf);
! 1395: if (++li > nbli) { hit_return(); li = 0; }
! 1396: }
! 1397: pari_fclose(z);
! 1398: }
! 1399:
! 1400: char *keyword_list[]={
! 1401: "operator",
! 1402: "user",
! 1403: "member",
! 1404: "integer",
! 1405: "real",
! 1406: "readline",
! 1407: "refcard",
! 1408: "tutorial",
! 1409: "nf",
! 1410: "bnf",
! 1411: "bnr",
! 1412: "ell",
! 1413: NULL
! 1414: };
! 1415:
! 1416: static int
! 1417: ok_external_help(char *s)
! 1418: {
! 1419: long n;
! 1420: if (!*s) return 1;
! 1421: if (!isalpha((int)*s)) return 3; /* operator or section number */
! 1422: if (!strncmp(s,"t_",2)) return 2; /* type name */
! 1423:
! 1424: for (n=0; keyword_list[n]; n++)
! 1425: if (!strcmp(s,keyword_list[n])) return 3;
! 1426: return 0;
! 1427: }
! 1428:
! 1429: /* don't mess readline display */
! 1430: static void
! 1431: aide_print(char *s1, char *s2, int flag)
! 1432: {
! 1433: if ((flag & h_RL) == 0) err(talker, "%s: %s", s1, s2);
! 1434: pariputsf("%s: %s\n", s1, s2);
! 1435: }
! 1436:
! 1437: static void
! 1438: aide0(char *s, int flag)
! 1439: {
! 1440: long n, long_help = flag & h_LONG;
! 1441: entree *ep,*ep1;
! 1442: char *s1;
! 1443:
! 1444: s = get_sep(s);
! 1445: if (isdigit((int)*s))
! 1446: {
! 1447: n=atoi(s);
! 1448: if (n == 12) { community(); return; }
! 1449: if (n<0 || n > 12)
! 1450: err(talker2,"no such section in help: ?",s,s);
! 1451: if (long_help) external_help(s,3); else commands(n);
! 1452: return;
! 1453: }
! 1454: /* Get meaningful entry on \ps 5 */
! 1455: if (*s == '\\') { s1 = s+1; skip_alpha(s1); *s1 = '\0';}
! 1456:
! 1457: if (flag & h_APROPOS) { external_help(s,-1); return; }
! 1458: if (long_help && (n = ok_external_help(s))) { external_help(s,n); return; }
! 1459: switch (*s)
! 1460: {
! 1461: case '*' : commands(-1); return;
! 1462: case '\0': menu_commands(); return;
! 1463: case '\\': slash_commands(); return;
! 1464: case '.' : member_commands(); return;
! 1465: }
! 1466: ep = is_entry(s);
! 1467: if (ep && long_help)
! 1468: {
! 1469: if (!strcmp(ep->name, "default"))
! 1470: {
! 1471: char *t = s+7, *e;
! 1472: skip_space(t);
! 1473: if (*t == '(') {
! 1474: t++; skip_space(t);
! 1475: e = t; skip_alpha(e); *e = '\0'; /* safe: get_sep() made it a copy */
! 1476: if (is_default(t)) { external_help(t, 2); return; }
! 1477: }
! 1478: }
! 1479: }
! 1480: if (!ep)
! 1481: {
! 1482: n = is_default(s)? 2: 3;
! 1483: if (long_help)
! 1484: external_help(s,n);
! 1485: else
! 1486: {
! 1487: if (n == 2) { aide_print(s,"default",h_RL); return; }
! 1488: n = whatnow(s,1);
! 1489: if (n) err(obsoler,s,s, s,n);
! 1490: aide_print(s,"unknown identifier",flag);
! 1491: }
! 1492: return;
! 1493: }
! 1494:
! 1495: ep1 = ep; ep = do_alias(ep);
! 1496: if (ep1 != ep) pariputsf("%s is aliased to:\n\n",s);
! 1497:
! 1498: switch(EpVALENCE(ep))
! 1499: {
! 1500: case EpUSER:
! 1501: if (!ep->help || long_help) print_user_fun(ep);
! 1502: if (!ep->help) return;
! 1503: if (long_help) { pariputs("\n\n"); long_help=0; }
! 1504: break;
! 1505:
! 1506: case EpGVAR:
! 1507: case EpVAR:
! 1508: if (!ep->help) { aide_print(s, "user defined variable",h_RL); return; }
! 1509: long_help=0; break;
! 1510:
! 1511: case EpINSTALL:
! 1512: if (!ep->help) { aide_print(s, "installed function",h_RL); return; }
! 1513: long_help=0; break;
! 1514: }
! 1515: if (long_help) { external_help(ep->name,3); return; }
! 1516: if (ep->help) { print_text(ep->help); return; }
! 1517:
! 1518: err(bugparier,"aide (no help found)");
! 1519: }
! 1520:
! 1521: void
! 1522: aide(char *s, int flag)
! 1523: {
! 1524: if ((flag & h_RL) == 0)
! 1525: {
! 1526: if (*s == '?') { flag |= h_LONG; s++; }
! 1527: if (*s == '?') { flag |= h_APROPOS; s++; }
! 1528: }
! 1529: term_color(c_HELP); aide0(s,flag); term_color(c_NONE);
! 1530: if ((flag & h_RL) == 0) pariputc('\n');
! 1531: }
! 1532:
! 1533: /********************************************************************/
! 1534: /** **/
! 1535: /** METACOMMANDS **/
! 1536: /** **/
! 1537: /********************************************************************/
! 1538:
! 1539: static void
! 1540: print_entree(entree *ep, long hash)
! 1541: {
! 1542: pariputsf(" %s ",ep->name); pariputsf(VOIR_STRING1,(ulong)ep);
! 1543: pariputsf(":\n hash = %3ld, valence = %3ld, menu = %2ld, code = %s\n",
! 1544: hash, ep->valence, ep->menu, ep->code? ep->code: "NULL");
! 1545: if (ep->next)
! 1546: {
! 1547: pariputsf(" next = %s ",(ep->next)->name);
! 1548: pariputsf(VOIR_STRING1,(ulong)(ep->next));
! 1549: }
! 1550: pariputs("\n");
! 1551: }
! 1552:
! 1553: static void
! 1554: print_hash_list(char *s)
! 1555: {
! 1556: long m,n;
! 1557: entree *ep;
! 1558:
! 1559: if (isalpha((int)*s))
! 1560: {
! 1561: ep = is_entry_intern(s,functions_hash,&n);
! 1562: if (!ep) err(talker,"no such function");
! 1563: print_entree(ep,n); return;
! 1564: }
! 1565: if (isdigit((int)*s) || *s == '$')
! 1566: {
! 1567: m = functions_tblsz-1; n = atol(s);
! 1568: if (*s=='$') n = m;
! 1569: if (m<n) err(talker,"invalid range in print_entree");
! 1570: while (isdigit((int)*s)) s++;
! 1571:
! 1572: if (*s++ != '-') m = n;
! 1573: else
! 1574: {
! 1575: if (*s !='$') m = min(atol(s),m);
! 1576: if (m<n) err(talker,"invalid range in print_entree");
! 1577: }
! 1578:
! 1579: for(; n<=m; n++)
! 1580: {
! 1581: pariputsf("*** hashcode = %ld\n",n);
! 1582: for (ep=functions_hash[n]; ep; ep=ep->next)
! 1583: print_entree(ep,n);
! 1584: }
! 1585: return;
! 1586: }
! 1587: if (*s=='-')
! 1588: {
! 1589: for (n=0; n<functions_tblsz; n++)
! 1590: {
! 1591: m=0;
! 1592: for (ep=functions_hash[n]; ep; ep=ep->next) m++;
! 1593: pariputsf("%3ld:%3ld ",n,m);
! 1594: if (n%9 == 8) pariputc('\n');
! 1595: }
! 1596: pariputc('\n'); return;
! 1597: }
! 1598: for (n=0; n<functions_tblsz; n++)
! 1599: for (ep=functions_hash[n]; ep; ep=ep->next)
! 1600: print_entree(ep,n);
! 1601: }
! 1602:
! 1603: static char *
! 1604: what_readline()
! 1605: {
! 1606: #ifdef READLINE
! 1607: if (use_readline)
! 1608: return "v"READLINE" enabled";
! 1609: else
! 1610: #endif
! 1611: return "disabled";
! 1612: }
! 1613:
! 1614: static void
! 1615: print_version()
! 1616: {
! 1617: char buf[64];
! 1618:
! 1619: center(PARIVERSION); center(PARIINFO);
! 1620: sprintf(buf,"(readline %s, extended help%s available)", what_readline(),
! 1621: has_ext_help()? "": " not");
! 1622: center(buf);
! 1623: }
! 1624:
! 1625: static void
! 1626: gp_head()
! 1627: {
! 1628: print_version(); pariputs("\n");
! 1629: center("Copyright (C) 2000 The PARI Group");
! 1630: print_text("\nPARI/GP is free software, covered by the GNU General Public \
! 1631: License, and comes WITHOUT ANY WARRANTY WHATSOEVER");
! 1632: pariputs("\n\
! 1633: Type ? for help, \\q to quit.\n\
! 1634: Type ?12 for how to get moral (and possibly technical) support.\n\n");
! 1635: sd_realprecision ("",d_ACKNOWLEDGE);
! 1636: sd_seriesprecision("",d_ACKNOWLEDGE);
! 1637: sd_format ("",d_ACKNOWLEDGE);
! 1638: pariputsf("\nparisize = %ld, primelimit = %ld\n", parisize, primelimit);
! 1639: }
! 1640:
! 1641: static void
! 1642: fix_buffer(Buffer *b, long newlbuf)
! 1643: {
! 1644: b->buf = gprealloc(b->buf, newlbuf, b->len);
! 1645: b->len = paribufsize = newlbuf;
! 1646: }
! 1647:
! 1648: void
! 1649: gp_quit()
! 1650: {
! 1651: free_graph(); freeall();
! 1652: kill_all_buffers(NULL);
! 1653: if (INIT_SIG) pari_sig_init(SIG_DFL);
! 1654: term_color(c_NONE);
! 1655: pariputs_opt("Goodbye!\n");
! 1656: if (under_texmacs) tm_end_output();
! 1657: exit(0);
! 1658: }
! 1659:
! 1660: /* history management function:
! 1661: * flag < 0, called from freeall()
! 1662: * flag = 0, called from %num in anal.c:truc()
! 1663: * flag > 0, called from %` in anal.c:truc(), p > 0
! 1664: */
! 1665: static GEN
! 1666: gp_history(long p, long flag, char *old, char *entrypoint)
! 1667: {
! 1668: int er1 = 0;
! 1669: if (flag < 0) { free((void *)hist); return NULL; }
! 1670: if (!tglobal) er1 = 1;
! 1671: if (flag)
! 1672: {
! 1673: p = tglobal - p;
! 1674: if (p <= 0) er1 = 1;
! 1675: }
! 1676: else if (p > tglobal)
! 1677: err(talker2,"I can't see into the future",old,entrypoint);
! 1678: if (!p) p = tglobal;
! 1679: if (tglobal - p >= histsize) er1 = 1;
! 1680: p = (p-1) % histsize;
! 1681: if (er1 || !hist[p])
! 1682: err(talker2,"I can't remember before the big bang",old,entrypoint);
! 1683: return hist[p];
! 1684: }
! 1685:
! 1686: extern char *GENtostr0(GEN x, void(*do_out)(GEN));
! 1687:
! 1688: static void
! 1689: texmacs_output(GEN z, long n)
! 1690: {
! 1691: char *sz = GENtostr0(z, &outtex);
! 1692: printf("%clatex:", DATA_BEGIN);
! 1693: printf("\\magenta\\%%%ld = $\\blue ", n);
! 1694: printf("%s$%c", sz,DATA_END); free(sz);
! 1695: fflush(stdout);
! 1696: }
! 1697:
! 1698: /* Wait for prettyprinter for finish, to prevent new prompt from overwriting
! 1699: * the output. Fill the output buffer, wait until it is read.
! 1700: * Better than sleep(2): give possibility to print */
! 1701: static void
! 1702: prettyp_wait()
! 1703: {
! 1704: char *s = " \n";
! 1705: int i = 400;
! 1706:
! 1707: pariputs("\n\n"); pariflush(); /* start translation */
! 1708: while (--i) pariputs(s);
! 1709: pariputs("\n"); pariflush();
! 1710: }
! 1711:
! 1712: /* initialise external prettyprinter (tex2mail) */
! 1713: static int
! 1714: prettyp_init()
! 1715: {
! 1716: if (!prettyprinter_file)
! 1717: prettyprinter_file = try_pipe(prettyprinter, mf_OUT | mf_TEST);
! 1718: if (prettyprinter_file) return 1;
! 1719:
! 1720: err(warner,"broken prettyprinter: '%s'",prettyprinter);
! 1721: if (prettyprinter != prettyprinter_dft) free(prettyprinter);
! 1722: prettyprinter = NULL; return 0;
! 1723: }
! 1724:
! 1725: /* n = history number. if n = 0 no history */
! 1726: static int
! 1727: tex2mail_output(GEN z, long n)
! 1728: {
! 1729: FILE *o_out;
! 1730: int o_prettyp;
! 1731:
! 1732: if (!(prettyprinter && prettyp_init())) return 0;
! 1733: o_out = pari_outfile; /* save state */
! 1734: o_prettyp = prettyp;
! 1735:
! 1736: /* Emit first: there may be lines before the prompt */
! 1737: if (n) term_color(c_OUTPUT);
! 1738: pariflush();
! 1739: pari_outfile = prettyprinter_file->file;
! 1740: prettyp = f_TEX;
! 1741:
! 1742: /* history number */
! 1743: if (n)
! 1744: {
! 1745: if (*term_get_color(c_HIST) || *term_get_color(c_OUTPUT))
! 1746: {
! 1747: char col1[80];
! 1748: strcpy(col1, term_get_color(c_HIST));
! 1749: sprintf(thestring, "\\LITERALnoLENGTH{%s}\\%%%ld = \\LITERALnoLENGTH{%s}",
! 1750: col1, n, term_get_color(c_OUTPUT));
! 1751: }
! 1752: else
! 1753: sprintf(thestring, "\\%%%ld = ", n);
! 1754: pariputs_opt(thestring);
! 1755: }
! 1756: /* output */
! 1757: gp_output(z);
! 1758:
! 1759: /* flush and restore */
! 1760: prettyp_wait();
! 1761: prettyp = o_prettyp;
! 1762: pari_outfile = o_out;
! 1763: if (n) term_color(c_NONE);
! 1764: return 1;
! 1765: }
! 1766:
! 1767: static void
! 1768: normal_output(GEN z, long n)
! 1769: {
! 1770: /* history number */
! 1771: term_color(c_HIST);
! 1772: sprintf(thestring, "%%%ld = ", n);
! 1773: pariputs_opt(thestring);
! 1774: /* output */
! 1775: term_color(c_OUTPUT);
! 1776: init_lim_lines(thestring,lim_lines);
! 1777: gp_output(z);
! 1778: init_lim_lines(NULL,lim_lines);
! 1779: term_color(c_NONE); pariputc('\n');
! 1780: }
! 1781:
! 1782: static GEN
! 1783: gpreadbin(char *s)
! 1784: {
! 1785: GEN x = readbin(s,infile);
! 1786: popinfile(); return x;
! 1787: }
! 1788:
! 1789: static void
! 1790: escape0(char *tch)
! 1791: {
! 1792: char *s, c;
! 1793:
! 1794: if (compatible != NONE)
! 1795: {
! 1796: s = tch;
! 1797: while (*s)
! 1798: if (*s++ == '=')
! 1799: {
! 1800: GEN (*f)(char*, int) = NULL;
! 1801: int len = (s-tch) - 1;
! 1802:
! 1803: if (!strncmp(tch,"precision",len)) f = sd_realprecision;
! 1804: else if (!strncmp(tch,"serieslength",len)) f = sd_seriesprecision;
! 1805: else if (!strncmp(tch,"format",len)) f = sd_format;
! 1806: else if (!strncmp(tch,"prompt",len)) f = sd_prompt;
! 1807: if (f) { f(get_sep(s), d_ACKNOWLEDGE); return; }
! 1808: break;
! 1809: }
! 1810: }
! 1811: s = tch;
! 1812: switch ((c = *s++))
! 1813: {
! 1814: case 'w': case 'x': case 'a': case 'b': case 'B': case 'm':
! 1815: { /* history things */
! 1816: long d;
! 1817: GEN x;
! 1818: if (c != 'w' && c != 'x') d = get_int(s,0);
! 1819: else
! 1820: {
! 1821: d = atol(s); if (*s == '-') s++;
! 1822: while (isdigit((int)*s)) s++;
! 1823: }
! 1824: x = gp_history(d, 0, tch+1,tch-1);
! 1825: switch (c)
! 1826: {
! 1827: case 'a': brute (x, fmt.format, -1); break;
! 1828: case 'm': matbrute(x, fmt.format, -1); break;
! 1829: case 'B': if (tex2mail_output(x,0)) return; /* fall through */
! 1830: case 'b': sor (x, fmt.format, -1, fmt.field); break;
! 1831: case 'x': voir(x, get_int(s, -1));
! 1832: case 'w':
! 1833: {
! 1834: GEN g[2]; g[0] = x; g[1] = NULL;
! 1835: s = get_sep_colon_ok(s); if (!*s) s = current_logfile;
! 1836: write0(s, g, f_RAW); return;
! 1837: }
! 1838: }
! 1839: pariputc('\n'); return;
! 1840: }
! 1841:
! 1842: case 'c': commands(-1); break;
! 1843: case 'd': help_default(); break;
! 1844: case 'e':
! 1845: s = get_sep(s);
! 1846: if (!*s) s = pariecho?"0":"1";
! 1847: sd_echo(s,d_ACKNOWLEDGE); break;
! 1848: case 'g':
! 1849: switch (*s)
! 1850: {
! 1851: case 'm': sd_debugmem(++s,d_ACKNOWLEDGE); break;
! 1852: case 'f': sd_debugfiles(++s,d_ACKNOWLEDGE); break;
! 1853: default : sd_debug(s,d_ACKNOWLEDGE); break;
! 1854: }
! 1855: break;
! 1856: case 'h': print_hash_list(s); break;
! 1857: case 'l':
! 1858: s = get_sep_colon_ok(s);
! 1859: if (*s)
! 1860: {
! 1861: sd_logfile(s,d_ACKNOWLEDGE);
! 1862: if (logfile) break;
! 1863: }
! 1864: sd_log(logfile?"0":"1",d_ACKNOWLEDGE);
! 1865: break;
! 1866: case 'o': sd_output(s,d_ACKNOWLEDGE); break;
! 1867: case 'p':
! 1868: switch (*s)
! 1869: {
! 1870: case 's': sd_seriesprecision(++s,d_ACKNOWLEDGE); break;
! 1871: default : sd_realprecision(s,d_ACKNOWLEDGE); break;
! 1872: }
! 1873: break;
! 1874: case 'q': gp_quit(); break;
! 1875: case 'r':
! 1876: s = get_sep_colon_ok(s);
! 1877: switchin(s);
! 1878: if (file_is_binary(infile)) gpreadbin(s);
! 1879: break;
! 1880: case 's': etatpile(0); break;
! 1881: case 't': gentypes(); break;
! 1882: case 'u':
! 1883: switch (*s)
! 1884: {
! 1885: case 'm': user_member(); break;
! 1886: default: user_fun();
! 1887: }
! 1888: break;
! 1889: case 'v': print_version(); break;
! 1890: case 'y':
! 1891: s = get_sep(s);
! 1892: if (!*s) s = simplifyflag?"0":"1";
! 1893: sd_simplify(s,d_ACKNOWLEDGE); break;
! 1894: default: err(caracer1,tch-1,tch-2);
! 1895: }
! 1896: }
! 1897:
! 1898: static void
! 1899: escape(char *tch)
! 1900: {
! 1901: char *old = _analyseur();
! 1902: _set_analyseur(tch); /* for error messages */
! 1903: escape0(tch);
! 1904: _set_analyseur(old);
! 1905: }
! 1906: /********************************************************************/
! 1907: /* */
! 1908: /* GPRC */
! 1909: /* */
! 1910: /********************************************************************/
! 1911: #if defined(UNIX) || defined(__EMX__)
! 1912: # include <pwd.h>
! 1913: #endif
! 1914:
! 1915: static int
! 1916: get_preproc_value(char *s)
! 1917: {
! 1918: if (!strncmp(s,"EMACS",5)) return under_emacs || under_texmacs;
! 1919: if (!strncmp(s,"READL",5))
! 1920: {
! 1921: #ifdef READLINE
! 1922: if (use_readline)
! 1923: return 1;
! 1924: else
! 1925: #endif
! 1926: return 0;
! 1927: }
! 1928: return -1;
! 1929: }
! 1930:
! 1931: /* return $HOME or the closest we can find */
! 1932: static char *
! 1933: get_home(int *free_it)
! 1934: {
! 1935: char *drv, *pth = os_getenv("HOME");
! 1936: if (pth) return pth;
! 1937: if ((drv = os_getenv("HOMEDRIVE"))
! 1938: && (pth = os_getenv("HOMEPATH")))
! 1939: { /* looks like WinNT */
! 1940: char *buf = gpmalloc(strlen(pth) + strlen(drv) + 1);
! 1941: sprintf(buf, "%s%s",drv,pth);
! 1942: *free_it = 1; return buf;
! 1943: }
! 1944: #if defined(__EMX__) || defined(UNIX)
! 1945: {
! 1946: struct passwd *p = getpwuid(geteuid());
! 1947: if (p) return p->pw_dir;
! 1948: }
! 1949: #endif
! 1950: return ".";
! 1951: }
! 1952:
! 1953: static FILE *
! 1954: gprc_chk(char *s)
! 1955: {
! 1956: FILE *f = fopen(s, "r");
! 1957: if (f && !quiet_mode)
! 1958: {
! 1959: fprintferr("Reading GPRC: %s ...", s);
! 1960: added_newline = 0;
! 1961: }
! 1962: return f;
! 1963: }
! 1964:
! 1965: /* Look for [._]gprc: $GPRC, then in $HOME, /, C:/ */
! 1966: static FILE *
! 1967: gprc_get()
! 1968: {
! 1969: FILE *f = NULL;
! 1970: char *str, *s, c;
! 1971: long l;
! 1972: #ifdef macintosh
! 1973: f = gprc_chk("gprc");
! 1974: #else
! 1975: s = os_getenv("GPRC");
! 1976: if (s) f = gprc_chk(s);
! 1977: if (!f)
! 1978: {
! 1979: int free_it = 0;
! 1980: s = get_home(&free_it); l = strlen(s); c = s[l-1];
! 1981: str = strcpy(gpmalloc(l+7), s);
! 1982: if (free_it) free(s);
! 1983: s = str + l;
! 1984: if (c != '/' && c != '\\') *s++ = '/';
! 1985: #ifdef UNIX
! 1986: *s = '.'; /* .gprc */
! 1987: #else
! 1988: *s = '_'; /* _gprc */
! 1989: #endif
! 1990: strcpy(s+1, "gprc");
! 1991: f = gprc_chk(str); /* in $HOME */
! 1992: if (!f) f = gprc_chk(s); /* in . */
! 1993: if (!f) f = gprc_chk("/etc/gprc");
! 1994: if (!f) f = gprc_chk("C:/_gprc");
! 1995: free(str);
! 1996: }
! 1997: #endif
! 1998: return f;
! 1999: }
! 2000:
! 2001: static int get_line_from_file(char *prompt, Buffer *b, FILE *file);
! 2002: #define err_gprc(s,t,u) { fprintferr("\n"); err(talker2,s,t,u); }
! 2003:
! 2004: static char **
! 2005: gp_initrc()
! 2006: {
! 2007: char **flist, *s,*s1,*s2;
! 2008: FILE *file = gprc_get();
! 2009: long fnum = 4, find = 0;
! 2010: Buffer *b;
! 2011:
! 2012: if (!file) return NULL;
! 2013: flist = (char **) gpmalloc(fnum * sizeof(char*));
! 2014: b = new_buffer();
! 2015: for(;;)
! 2016: {
! 2017: if (!get_line_from_file(NULL,b,file))
! 2018: {
! 2019: del_buffer(b);
! 2020: if (!quiet_mode) fprintferr("Done.\n\n");
! 2021: fclose(file); flist[find] = NULL;
! 2022: return flist;
! 2023: }
! 2024: for (s = b->buf; *s; )
! 2025: {
! 2026: s1 = s; if (get_sep2(s)) s++;
! 2027: s += strlen(s1); /* point to next expr */
! 2028: if (*s1 == '#')
! 2029: { /* preprocessor directive */
! 2030: int z, NOT = 0;
! 2031: s1++;
! 2032: if (strncmp(s1,"if",2)) err_gprc("unknown directive",s1,b->buf);
! 2033: s1 += 2;
! 2034: if (!strncmp(s1,"not",3)) { NOT = !NOT; s1 += 3; }
! 2035: if (*s1 == '!') { NOT = !NOT; s1++; }
! 2036: z = get_preproc_value(s1);
! 2037: if (z < 0) err_gprc("unknown preprocessor variable",s1,b->buf);
! 2038: if (NOT) z = !z;
! 2039: if (!z) continue;
! 2040: s1 += 5;
! 2041: }
! 2042: if (!strncmp(s1,"read",4))
! 2043: { /* read file */
! 2044: s1 += 4;
! 2045: if (find == fnum-1)
! 2046: {
! 2047: long n = fnum << 1;
! 2048: flist = (char**)gprealloc(flist, n*sizeof(char*),
! 2049: fnum*sizeof(char*));
! 2050: fnum = n;
! 2051: }
! 2052: flist[find++] = s2 = gpmalloc(strlen(s1) + 1);
! 2053: if (*s1 == '"') (void)readstring(s1, s2);
! 2054: else strcpy(s2,s1);
! 2055: }
! 2056: else
! 2057: { /* set default */
! 2058: s2 = s1; while (*s2 && *s2 != '=') s2++;
! 2059: if (*s2 != '=') err_gprc("missing '='",s2,b->buf);
! 2060: *s2++ = 0;
! 2061: if (*s2 == '"') (void)readstring(s2, s2);
! 2062: setdefault(s1,s2,d_INITRC);
! 2063: }
! 2064: }
! 2065: }
! 2066: }
! 2067:
! 2068: /********************************************************************/
! 2069: /* */
! 2070: /* GP MAIN LOOP */
! 2071: /* */
! 2072: /********************************************************************/
! 2073: /* flag:
! 2074: * ti_NOPRINT don't print
! 2075: * ti_REGULAR print elapsed time (chrono = 1)
! 2076: * ti_LAST print last elapsed time (##)
! 2077: * ti_INTERRUPT received a SIGINT
! 2078: */
! 2079: static char *
! 2080: do_time(long flag)
! 2081: {
! 2082: static long last = 0;
! 2083: long delay = (flag == ti_LAST)? last: gptimer();
! 2084: char *s;
! 2085:
! 2086: last = delay;
! 2087: switch(flag)
! 2088: {
! 2089: case ti_REGULAR: s = "time = "; break;
! 2090: case ti_INTERRUPT: s = "user interrupt after "; break;
! 2091: case ti_LAST: s = " *** last result computed in "; break;
! 2092: default: return NULL;
! 2093: }
! 2094: strcpy(thestring,s); s=thestring+strlen(s);
! 2095: strcpy(s, term_get_color(c_TIME)); s+=strlen(s);
! 2096: if (delay >= 3600000)
! 2097: {
! 2098: sprintf(s, "%ldh, ", delay / 3600000); s+=strlen(s);
! 2099: delay %= 3600000;
! 2100: }
! 2101: if (delay >= 60000)
! 2102: {
! 2103: sprintf(s, "%ldmn, ", delay / 60000); s+=strlen(s);
! 2104: delay %= 60000;
! 2105: }
! 2106: if (delay >= 1000)
! 2107: {
! 2108: sprintf(s, "%ld,", delay / 1000); s+=strlen(s);
! 2109: delay %= 1000;
! 2110: if (delay < 100)
! 2111: {
! 2112: sprintf(s, "%s", (delay<10)? "00": "0");
! 2113: s+=strlen(s);
! 2114: }
! 2115: }
! 2116: sprintf(s, "%ld ms", delay); s+=strlen(s);
! 2117: strcpy(s, term_get_color(c_NONE));
! 2118: if (flag != ti_INTERRUPT) { s+=strlen(s); *s++='.'; *s++='\n'; *s=0; }
! 2119: return thestring;
! 2120: }
! 2121:
! 2122: static void
! 2123: gp_handle_SIGINT()
! 2124: {
! 2125: #ifdef _WIN32
! 2126: if (++win32ctrlc >= 5) _exit(3);
! 2127: #else
! 2128: if (under_texmacs) tm_start_output();
! 2129: err(siginter, do_time(ti_INTERRUPT));
! 2130: #endif
! 2131: }
! 2132:
! 2133: static void
! 2134: gp_sighandler(int sig)
! 2135: {
! 2136: char *msg;
! 2137: os_signal(sig,gp_sighandler);
! 2138: switch(sig)
! 2139: {
! 2140: #ifdef SIGBREAK
! 2141: case SIGBREAK: gp_handle_SIGINT(); return;
! 2142: #endif
! 2143: #ifdef SIGINT
! 2144: case SIGINT: gp_handle_SIGINT(); return;
! 2145: #endif
! 2146:
! 2147: #ifdef SIGSEGV
! 2148: case SIGSEGV:
! 2149: msg="GP (Segmentation Fault)";
! 2150: break;
! 2151: #endif
! 2152:
! 2153: #ifdef SIGBUS
! 2154: case SIGBUS:
! 2155: msg="GP (Bus Error)";
! 2156: break;
! 2157: #endif
! 2158:
! 2159: #ifdef SIGFPE
! 2160: case SIGFPE:
! 2161: msg="GP (Floating Point Exception)";
! 2162: break;
! 2163: #endif
! 2164:
! 2165: #ifdef SIGPIPE
! 2166: case SIGPIPE:
! 2167: if (prettyprinter_file && pari_outfile == prettyprinter_file->file)
! 2168: {
! 2169: pariFILE *f = prettyprinter_file;
! 2170: prettyprinter_file = NULL; /* to avoid oo recursion on error */
! 2171: pari_outfile = stdout; pari_fclose(f);
! 2172: }
! 2173: err(talker, "Broken Pipe, resetting file stack...");
! 2174: #endif
! 2175:
! 2176: default:
! 2177: msg="signal handling";
! 2178: }
! 2179: err(bugparier,msg);
! 2180: }
! 2181:
! 2182: static void
! 2183: brace_color(char *s, int c, int force)
! 2184: {
! 2185: if (disable_color || (gp_colors[c] == c_NONE && !force)) return;
! 2186: #ifdef RL_PROMPT_START_IGNORE
! 2187: *s++ = RL_PROMPT_START_IGNORE;
! 2188: #endif
! 2189: strcpy(s, term_get_color(c));
! 2190: #ifdef RL_PROMPT_START_IGNORE
! 2191: s+=strlen(s);
! 2192: *s++ = RL_PROMPT_END_IGNORE; *s = 0;
! 2193: #endif
! 2194: }
! 2195:
! 2196: static char *
! 2197: do_prompt()
! 2198: {
! 2199: static char buf[MAX_PROMPT_LEN + 24]; /* + room for color codes */
! 2200: char *s;
! 2201:
! 2202: if (test_mode) return prompt;
! 2203: s = buf; *s = 0;
! 2204: /* escape sequences bug readline, so use special bracing (if available) */
! 2205: brace_color(s, c_PROMPT, 0);
! 2206: s += strlen(s);
! 2207: if (filtre(s,NULL, f_COMMENT))
! 2208: strcpy(s, COMMENTPROMPT);
! 2209: else
! 2210: do_strftime(prompt,s);
! 2211: s += strlen(s);
! 2212: brace_color(s, c_INPUT, 1); return buf;
! 2213: }
! 2214:
! 2215: static void
! 2216: unblock_SIGINT()
! 2217: {
! 2218: #ifdef USE_SIGRELSE
! 2219: sigrelse(SIGINT);
! 2220: #elif USE_SIGSETMASK
! 2221: sigsetmask(0);
! 2222: #endif
! 2223: }
! 2224:
! 2225: /* Read from file (up to '\n' or EOF) and copy at s0 (points in b->buf) */
! 2226: static char *
! 2227: file_input(Buffer *b, char **s0, FILE *file, int TeXmacs)
! 2228: {
! 2229: int first = 1;
! 2230: char *s = *s0;
! 2231: long used0, used = s - b->buf;
! 2232:
! 2233: used0 = used;
! 2234: for(;;)
! 2235: {
! 2236: long left = b->len - used, ls;
! 2237: /* if from TeXmacs, tell him we need input */
! 2238: if (TeXmacs) { tm_start_output(); tm_end_output(); }
! 2239:
! 2240: if (left < 512)
! 2241: {
! 2242: fix_buffer(b, b->len << 1);
! 2243: left = b->len - used;
! 2244: *s0 = b->buf + used0;
! 2245: }
! 2246: s = b->buf + used;
! 2247: if (! fgets(s, left, file)) return first? NULL: *s0; /* EOF */
! 2248: ls = strlen(s); first = 0;
! 2249: if (ls+1 < left || s[ls-1] == '\n') return *s0; /* \n */
! 2250: used += ls;
! 2251: }
! 2252: }
! 2253:
! 2254: #ifdef READLINE
! 2255: static char *
! 2256: gprl_input(Buffer *b, char **s0, char *prompt)
! 2257: {
! 2258: long used = *s0 - b->buf;
! 2259: long left = b->len - used;
! 2260: char *s;
! 2261:
! 2262: if (! (s = readline(prompt)) ) return NULL; /* EOF */
! 2263: if ((ulong)left < strlen(s))
! 2264: {
! 2265: fix_buffer(b, b->len << 1);
! 2266: *s0 = b->buf + used;
! 2267: }
! 2268: return s;
! 2269: }
! 2270: #endif
! 2271:
! 2272: static void
! 2273: input_loop(Buffer *b, char *buf0, FILE *file, char *prompt)
! 2274: {
! 2275: const int TeXmacs = (under_texmacs && file == stdin);
! 2276: const int f_flag = prompt? f_REG: f_REG | f_KEEPCASE;
! 2277: char *end, *s = b->buf, *buf = buf0;
! 2278: int wait_for_brace = 0;
! 2279: int wait_for_input = 0;
! 2280:
! 2281: /* buffer is not empty, init filter */
! 2282: (void)ask_filtre(f_INIT);
! 2283: for(;;)
! 2284: {
! 2285: char *t = buf;
! 2286: if (!ask_filtre(f_COMMENT))
! 2287: { /* not in comment */
! 2288: skip_space(t);
! 2289: if (*t == LBRACE) { t++; wait_for_input = wait_for_brace = 1; }
! 2290: }
! 2291: end = filtre(t,s, f_flag);
! 2292:
! 2293: if (!*s) { if (!wait_for_input) break; }
! 2294: else
! 2295: {
! 2296: if (*(b->buf) == '?') break;
! 2297:
! 2298: s = end-1; /* *s = last input char */
! 2299: if (*s == '\\')
! 2300: {
! 2301: }
! 2302: else if (*s == '=')
! 2303: {
! 2304: wait_for_input = 1; s++;
! 2305: }
! 2306: else
! 2307: {
! 2308: if (!wait_for_brace) break;
! 2309: if (*s == RBRACE) { *s=0; break; }
! 2310: s++;
! 2311: }
! 2312: }
! 2313: /* read continuation line */
! 2314: #ifdef READLINE
! 2315: if (!file) { free(buf); buf = gprl_input(b,&s,""); }
! 2316: else
! 2317: #endif
! 2318: buf = file_input(b,&s,file,TeXmacs);
! 2319: if (!buf) break;
! 2320: }
! 2321: if (!file && buf) free(buf);
! 2322: }
! 2323:
! 2324: /* prompt = NULL --> from gprc. Return 1 if new input, and 0 if EOF */
! 2325: static int
! 2326: get_line_from_file(char *prompt, Buffer *b, FILE *file)
! 2327: {
! 2328: const int TeXmacs = (under_texmacs && file == stdin);
! 2329: char *buf, *s = b->buf;
! 2330:
! 2331: handle_C_C = 0;
! 2332: while (! (buf = file_input(b,&s,file,TeXmacs)) )
! 2333: { /* EOF */
! 2334: if (!handle_C_C)
! 2335: {
! 2336: if (TeXmacs) tm_start_output();
! 2337: return 0;
! 2338: }
! 2339: /* received ^C in fgets, retry (as is "\n" were input) */
! 2340: }
! 2341: input_loop(b,buf,file,prompt);
! 2342:
! 2343: if (*s && prompt) /* don't echo if from gprc */
! 2344: {
! 2345: if (pariecho)
! 2346: { pariputs(prompt); pariputs(s); pariputc('\n'); }
! 2347: else
! 2348: if (logfile) fprintf(logfile, "%s%s\n",prompt,s);
! 2349: pariflush();
! 2350: }
! 2351: if (under_texmacs) tm_start_output();
! 2352: return 1;
! 2353: }
! 2354:
! 2355: /* request one line interactively.
! 2356: * Return 0: EOF
! 2357: * 1: got one line from readline or infile */
! 2358: #ifndef READLINE
! 2359: static int
! 2360: get_line_from_user(char *prompt, Buffer *b)
! 2361: {
! 2362: pariputs(prompt);
! 2363: return get_line_from_file(prompt,b,infile);
! 2364: }
! 2365: #else
! 2366: static int
! 2367: get_line_from_user(char *prompt, Buffer *b)
! 2368: {
! 2369: if (use_readline)
! 2370: {
! 2371: static char *previous_hist = NULL;
! 2372: char *buf, *s = b->buf;
! 2373:
! 2374: if (! (buf = gprl_input(b,&s, prompt)) )
! 2375: { /* EOF */
! 2376: pariputs("\n"); return 0;
! 2377: }
! 2378: input_loop(b,buf,NULL,prompt);
! 2379: unblock_SIGINT(); /* bug in readline 2.0: need to unblock ^C */
! 2380:
! 2381: if (*s)
! 2382: {
! 2383: /* update history (don't add the same entry twice) */
! 2384: if (!previous_hist || strcmp(s,previous_hist))
! 2385: {
! 2386: if (previous_hist) free(previous_hist);
! 2387: previous_hist = pari_strdup(s); add_history(s);
! 2388: }
! 2389: /* update logfile */
! 2390: if (logfile) fprintf(logfile, "%s%s\n",prompt,s);
! 2391: }
! 2392: return 1;
! 2393: }
! 2394: else
! 2395: {
! 2396: pariputs(prompt);
! 2397: return get_line_from_file(prompt,b,infile);
! 2398: }
! 2399: }
! 2400: #endif
! 2401:
! 2402: static int
! 2403: is_interactive()
! 2404: {
! 2405: #if defined(UNIX) || defined(__EMX__)
! 2406: return (infile == stdin && !under_texmacs
! 2407: && (under_emacs || isatty(fileno(stdin))));
! 2408: #else
! 2409: return (infile == stdin && !under_texmacs);
! 2410: #endif
! 2411: }
! 2412:
! 2413: /* return 0 if no line could be read (EOF) */
! 2414: static int
! 2415: read_line(char *promptbuf, Buffer *b)
! 2416: {
! 2417: if (is_interactive())
! 2418: return get_line_from_user(promptbuf, b);
! 2419: else
! 2420: return get_line_from_file(DFT_PROMPT,b,infile);
! 2421: }
! 2422:
! 2423: static void
! 2424: chron(char *s)
! 2425: {
! 2426: if (*s)
! 2427: {
! 2428: char *old = s-1;
! 2429: if (*s == '#') { pariputs(do_time(ti_LAST)); s++; }
! 2430: if (*s) err(caracer1,s,old);
! 2431: }
! 2432: else { chrono = 1-chrono; sd_timer("",d_ACKNOWLEDGE); }
! 2433: }
! 2434:
! 2435: static int
! 2436: check_meta(char *buf)
! 2437: {
! 2438: switch(*buf++)
! 2439: {
! 2440: case '?': aide(buf, h_REGULAR); break;
! 2441: case '#': chron(buf); break;
! 2442: case '\\': escape(buf); break;
! 2443: case '\0': return 2;
! 2444: default: return 0;
! 2445: }
! 2446: return 1;
! 2447: }
! 2448:
! 2449: /* If there are other buffers open (bufstack != NULL), we are doing an
! 2450: * immediate read (with read, extern...) */
! 2451: static GEN
! 2452: gp_main_loop(int ismain)
! 2453: {
! 2454: long av, i,j;
! 2455: VOLATILE GEN z = gnil;
! 2456: Buffer *b = new_buffer();
! 2457: if (!setjmp(b->env))
! 2458: {
! 2459: b->flenv = 1;
! 2460: push_stack(&bufstack, (void*)b);
! 2461: }
! 2462: for(; ; setjmp(b->env))
! 2463: {
! 2464: if (ismain)
! 2465: {
! 2466: static long tloc, outtyp;
! 2467: tloc = tglobal; outtyp = prettyp; recover(0);
! 2468: if (setjmp(environnement))
! 2469: {
! 2470: char *s = (char*)global_err_data;
! 2471: if (s && *s) outerr(lisseq(s));
! 2472: avma = top; parisize = top - bot;
! 2473: j = tglobal - tloc; i = (tglobal-1)%histsize;
! 2474: while (j)
! 2475: {
! 2476: gunclone(hist[i]); hist[i]=NULL;
! 2477: if (!i) i = histsize;
! 2478: i--; j--;
! 2479: }
! 2480: tglobal = tloc; prettyp = outtyp;
! 2481: kill_all_buffers(b);
! 2482: }
! 2483: }
! 2484: added_newline = 1;
! 2485: if (paribufsize != b->len) fix_buffer(b, paribufsize);
! 2486:
! 2487: for(;;)
! 2488: {
! 2489: int r;
! 2490: r = read_line(do_prompt(), b);
! 2491: if (!disable_color) term_color(c_NONE);
! 2492: if (!r)
! 2493: {
! 2494: #ifdef _WIN32
! 2495: Sleep(10); if (win32ctrlc) dowin32ctrlc();
! 2496: #endif
! 2497: if (popinfile()) gp_quit();
! 2498: if (!ismain) { pop_buffer(); return z; }
! 2499: }
! 2500: else if (!check_meta(b->buf)) break;
! 2501: }
! 2502: if (ismain)
! 2503: {
! 2504: char c = b->buf[strlen(b->buf) - 1];
! 2505: gpsilent = separe(c);
! 2506: (void)gptimer();
! 2507: }
! 2508: av = avma;
! 2509: z = readseq(b->buf, strictmatch);
! 2510: if (!added_newline) pariputc('\n'); /* last output was print1() */
! 2511: if (! ismain) continue;
! 2512: if (chrono) pariputs(do_time(ti_REGULAR)); else do_time(ti_NOPRINT);
! 2513: if (z == gnil) continue;
! 2514:
! 2515: if (simplifyflag) z = simplify_i(z);
! 2516: i = tglobal % histsize; tglobal++;
! 2517: if (hist[i]) gunclone(hist[i]);
! 2518: hist[i] = z = gclone(z); avma = av;
! 2519: if (gpsilent) continue;
! 2520:
! 2521: if (test_mode) { init80(0); gp_output(z); pariputc('\n'); }
! 2522: else
! 2523: {
! 2524: if (under_texmacs)
! 2525: texmacs_output(z,tglobal);
! 2526: else if (prettyp != f_PRETTY || !tex2mail_output(z,tglobal))
! 2527: normal_output(z,tglobal);
! 2528: }
! 2529: pariflush();
! 2530: }
! 2531: }
! 2532:
! 2533: GEN
! 2534: read0(char *s)
! 2535: {
! 2536: switchin(s);
! 2537: if (file_is_binary(infile)) return gpreadbin(s);
! 2538: return gp_main_loop(0);
! 2539: }
! 2540:
! 2541: static void
! 2542: check_secure(char *s)
! 2543: {
! 2544: if (secure)
! 2545: err(talker, "[secure mode]: system commands not allowed\nTried to run '%s'",s);
! 2546: }
! 2547:
! 2548: GEN
! 2549: extern0(char *s)
! 2550: {
! 2551: check_secure(s);
! 2552: infile = try_pipe(s, mf_IN)->file;
! 2553: return gp_main_loop(0);
! 2554: }
! 2555:
! 2556: static int
! 2557: silent()
! 2558: {
! 2559: if (gpsilent) return 1;
! 2560: { char c = _analyseur()[1]; return separe(c); }
! 2561: }
! 2562:
! 2563: GEN
! 2564: default0(char *a, char *b, long flag)
! 2565: {
! 2566: if (flag) flag=d_RETURN;
! 2567: else
! 2568: flag = silent()? d_SILENT: d_ACKNOWLEDGE;
! 2569: return setdefault(a,b,flag);
! 2570: }
! 2571:
! 2572: GEN
! 2573: input0()
! 2574: {
! 2575: Buffer *b = new_buffer();
! 2576: GEN x;
! 2577:
! 2578: push_stack(&bufstack, (void*)b);
! 2579: while (! get_line_from_file(DFT_INPROMPT,b,infile))
! 2580: if (popinfile()) { fprintferr("no input ???"); gp_quit(); }
! 2581: x = lisseq(b->buf);
! 2582: pop_buffer(); return x;
! 2583: }
! 2584:
! 2585: void
! 2586: system0(char *s)
! 2587: {
! 2588: #if defined(UNIX) || defined(__EMX__)
! 2589: check_secure(s);
! 2590: system(s);
! 2591: #else
! 2592: err(archer);
! 2593: #endif
! 2594: }
! 2595:
! 2596: void
! 2597: error0(GEN *g)
! 2598: {
! 2599: term_color(c_ERR);
! 2600: if (!added_newline) pariputc('\n');
! 2601: pariputs("### User error:\n\n ");
! 2602: print0(g,f_RAW); term_color(c_NONE);
! 2603: err_recover(talker);
! 2604: }
! 2605:
! 2606: void errcontext(char *msg, char *s, char *entry);
! 2607:
! 2608: int
! 2609: break_loop(long numerr)
! 2610: {
! 2611: static FILE *oldinfile = NULL;
! 2612: static char *old = NULL;
! 2613: static Buffer *b = NULL;
! 2614: VOLATILE int go_on = 0;
! 2615: char *s, *t, *msg;
! 2616:
! 2617: if (b) jump_to_given_buffer(b);
! 2618: push_stack(&bufstack, (void*)new_buffer());
! 2619: b = current_buffer; /* buffer created above */
! 2620: if (setjmp(b->env))
! 2621: {
! 2622: msg = "back to break loop";
! 2623: s = t = NULL;
! 2624: }
! 2625: else
! 2626: {
! 2627: Buffer *oldb = (Buffer*)bufstack->prev->value;
! 2628: msg = "Starting break loop (type 'break' to go back to GP)";
! 2629: old = s = _analyseur();
! 2630: t = oldb->buf;
! 2631: /* something fishy, probably a ^C, or we overran analyseur */
! 2632: if (!s || !s[-1] || s < t || s >= t + oldb->len) s = NULL;
! 2633: b->flenv = 1; oldinfile = infile;
! 2634: }
! 2635:
! 2636: term_color(c_ERR); pariputc('\n');
! 2637: errcontext(msg, s, t); if (s) pariputc('\n');
! 2638: term_color(c_NONE);
! 2639: if (numerr == siginter) pariputs("['' or 'next' will continue]\n");
! 2640: infile = stdin;
! 2641: for(;;)
! 2642: {
! 2643: int flag;
! 2644: if (! read_line("> ", b)) break;
! 2645: if (!(flag = check_meta(b->buf)))
! 2646: {
! 2647: GEN x = lisseq(b->buf);
! 2648: if (did_break())
! 2649: {
! 2650: if (numerr == siginter && did_break() == br_NEXT)
! 2651: {
! 2652: (void)loop_break(); /* clear status flag */
! 2653: go_on = 1;
! 2654: }
! 2655: break;
! 2656: }
! 2657: if (x == gnil) continue;
! 2658:
! 2659: term_color(c_OUTPUT); gp_output(x);
! 2660: term_color(c_NONE); pariputc('\n');
! 2661: }
! 2662: if (numerr == siginter && flag == 2) { handle_C_C = go_on = 1; break; }
! 2663: }
! 2664: if (old && !s) _set_analyseur(old);
! 2665: b = NULL; infile = oldinfile;
! 2666: pop_buffer(); return go_on;
! 2667: }
! 2668:
! 2669: int
! 2670: gp_exception_handler(long numerr)
! 2671: {
! 2672: char *s = (char*)global_err_data;
! 2673: if (s && *s) { fprintferr("\n"); outerr(lisseq(s)); }
! 2674: else
! 2675: {
! 2676: if (numerr == errpile) avma = top;
! 2677: return break_loop(numerr);
! 2678: }
! 2679: return 0;
! 2680: }
! 2681:
! 2682: long
! 2683: setprecr(long n)
! 2684: {
! 2685: long m = fmt.nb;
! 2686:
! 2687: if (n>0) {fmt.nb = n; prec = (long)(n*pariK1 + 3);}
! 2688: return m;
! 2689: }
! 2690:
! 2691: static void
! 2692: testint(char *s, long *d)
! 2693: {
! 2694: if (!s) return;
! 2695: *d = get_int(s, 0);
! 2696: if (*d <= 0) err(talker,"arguments must be positive integers");
! 2697: }
! 2698:
! 2699: static char *
! 2700: read_arg(int *nread, char *t, long argc, char **argv)
! 2701: {
! 2702: int i = *nread;
! 2703: if (isdigit((int)*t)) return t;
! 2704: if (*t || i==argc) usage(argv[0]);
! 2705: *nread = i+1; return argv[i];
! 2706: }
! 2707:
! 2708: static char**
! 2709: read_opt(long argc, char **argv)
! 2710: {
! 2711: char *b=NULL, *p=NULL, *s=NULL, **pre;
! 2712: int i=1, initrc=1;
! 2713:
! 2714: pari_outfile=stderr;
! 2715: while (i<argc)
! 2716: {
! 2717: char *t = argv[i++];
! 2718:
! 2719: if (*t++ != '-') usage(argv[0]);
! 2720: switch(*t++)
! 2721: {
! 2722: case 'b': b = read_arg(&i,t,argc,argv); break;
! 2723: case 'p': p = read_arg(&i,t,argc,argv); break;
! 2724: case 's': s = read_arg(&i,t,argc,argv); break;
! 2725:
! 2726: case 'e':
! 2727: if (strncmp(t,"macs",4)) usage(argv[0]);
! 2728: under_emacs = 1; break;
! 2729: case 'q':
! 2730: quiet_mode = 1; break;
! 2731: case 't':
! 2732: if (strncmp(t,"est",3)) usage(argv[0]);
! 2733: disable_color = 1; test_mode = 1; /* fall through */
! 2734: case 'f':
! 2735: initrc = 0; break;
! 2736: case '-':
! 2737: if (strcmp(t, "version") == 0) { print_version(); exit(0); }
! 2738: if (strcmp(t, "texmacs") == 0) { under_texmacs = 1; break; }
! 2739: /* fall through */
! 2740: default:
! 2741: usage(argv[0]);
! 2742: }
! 2743: }
! 2744: if (under_texmacs) tm_start_output();
! 2745: pre = initrc? gp_initrc(): NULL;
! 2746:
! 2747: /* override the values from gprc */
! 2748: testint(b, &paribufsize); if (paribufsize < 10) paribufsize = 10;
! 2749: testint(p, &primelimit);
! 2750: testint(s, &parisize);
! 2751: if (under_emacs || under_texmacs) disable_color=1;
! 2752: pari_outfile=stdout; return pre;
! 2753: }
! 2754:
! 2755: #ifdef WINCE
! 2756: int
! 2757: WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance,
! 2758: LPWSTR lpCmdLine, int nShowCmd)
! 2759: {
! 2760: char **argv = NULL;
! 2761: int argc = 1;
! 2762: #else
! 2763: int
! 2764: main(int argc, char **argv)
! 2765: {
! 2766: #endif
! 2767: char **flist;
! 2768:
! 2769: init_defaults(1); gp_preinit(1);
! 2770: if (setjmp(environnement))
! 2771: {
! 2772: pariputs("### Errors on startup, exiting...\n\n");
! 2773: exit(1);
! 2774: }
! 2775: #ifdef __MWERKS__
! 2776: argc = ccommand(&argv);
! 2777: #endif
! 2778: flist = read_opt(argc,argv);
! 2779: pari_addfunctions(&pari_modules, functions_gp,helpmessages_gp);
! 2780: pari_addfunctions(&pari_modules, functions_highlevel,helpmessages_highlevel);
! 2781: pari_addfunctions(&pari_oldmodules, functions_oldgp,helpmessages_oldgp);
! 2782:
! 2783: init_graph(); INIT_SIG_off;
! 2784: pari_init(parisize, primelimit);
! 2785: INIT_SIG_on;
! 2786: pari_sig_init(gp_sighandler);
! 2787: #ifdef READLINE
! 2788: if (use_readline) {
! 2789: init_readline();
! 2790: readline_init = 1;
! 2791: }
! 2792: #endif
! 2793: gp_history_fun = gp_history;
! 2794: whatnow_fun = whatnow;
! 2795: output_fun = gp_output;
! 2796: default_exception_handler = gp_exception_handler;
! 2797: gp_expand_path(path);
! 2798:
! 2799: if (!quiet_mode) gp_head();
! 2800: if (flist)
! 2801: {
! 2802: long c=chrono, e=pariecho;
! 2803: FILE *l=logfile;
! 2804: char **s = flist;
! 2805: chrono=0; pariecho=0; logfile=NULL;
! 2806: for ( ; *s; s++) { read0(*s); free(*s); }
! 2807: chrono=c; pariecho=e; logfile=l; free(flist);
! 2808: }
! 2809: (void)gptimer(); (void)timer(); (void)timer2();
! 2810: (void)gp_main_loop(1);
! 2811: gp_quit(); return 0; /* not reached */
! 2812: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to gp.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / pari-2.2 / src / gp