Annotation of OpenXM_contrib/pari/src/gp/gp.c, Revision 1.1
1.1 ! maekawa 1: /*******************************************************************/
! 2: /** **/
! 3: /** PARI CALCULATOR **/
! 4: /** **/
! 5: /*******************************************************************/
! 6: /* $Id: gp.c,v 1.1.1.1 1999/09/16 13:47:41 karim Exp $ */
! 7: #include "pari.h"
! 8: #ifdef _WIN32
! 9: # include <windows.h>
! 10: # ifndef WINCE
! 11: # include <process.h>
! 12: # endif
! 13: #endif
! 14: #ifdef HAS_STRFTIME
! 15: # include <time.h>
! 16: #endif
! 17: #include "../language/anal.h"
! 18: #include "gp.h"
! 19:
! 20: #ifdef READLINE
! 21: void init_readline();
! 22: BEGINEXTERN
! 23: # if defined(__cplusplus) && defined(__SUNPRO_CC)
! 24: /* readline.h gives a bad definition of readline() */
! 25: extern char*readline(char*);
! 26: # else
! 27: # ifdef READLINE_LIBRARY
! 28: # include <readline.h>
! 29: # else
! 30: # include <readline/readline.h>
! 31: # endif
! 32: # endif
! 33: extern int isatty(int);
! 34: extern void add_history(char*);
! 35: ENDEXTERN
! 36: #endif
! 37:
! 38: char* _analyseur(void);
! 39: void err_recover(long numerr);
! 40: void free_graph(void);
! 41: void gp_expand_path(char *v);
! 42: int gp_init_entrees(module *modlist, entree **hash, int force);
! 43: long gptimer(void);
! 44: void init80(long n);
! 45: void init_defaults(int force);
! 46: void init_graph(void);
! 47: void init_lim_lines(char *s, long max);
! 48: void pari_sig_init(void (*f)(int));
! 49: int whatnow(char *s, int flag);
! 50:
! 51: #define MAX_PROMPT_LEN 128
! 52: #define DFT_PROMPT "? "
! 53: #define COMMENTPROMPT "comment> "
! 54: #define DFT_INPROMPT ""
! 55: static GEN *hist;
! 56: static jmp_buf local_environnement[MAX_BUFFER];
! 57: static char *help_prg,*path,*buflist[MAX_BUFFER];
! 58: static char prompt[MAX_PROMPT_LEN];
! 59: static char thestring[256];
! 60: static long prettyp, test_mode, quiet_mode, gpsilent, simplifyflag;
! 61: static long secure;
! 62: static long chrono, pariecho, primelimit, parisize, strictmatch;
! 63: static long bufindex, tglobal, histsize, paribufsize, lim_lines;
! 64: static gp_format fmt;
! 65:
! 66: #define LBRACE '{'
! 67: #define RBRACE '}'
! 68: #define pariputs_opt(s) if (!quiet_mode) pariputs(s)
! 69:
! 70: void
! 71: hit_return()
! 72: {
! 73: char tmp[16];
! 74: pariputs("---- (type return to continue) ----");
! 75: do fgets(tmp,16,stdin); while (tmp[strlen(tmp)-1] != '\n');
! 76: /* \n has to be echoed later if we are under emacs (E. Kowalski) */
! 77: pariputc('\n');
! 78: }
! 79:
! 80: static void
! 81: usage(char *s)
! 82: {
! 83: printf("### Usage: %s [options]\n", s);
! 84: printf("Options are:\n");
! 85: printf("\t[-b buffersize]\tDeprecated\n");
! 86: printf("\t[-emacs]\tRun as if in Emacs shell\n");
! 87: printf("\t[-f]\t\tFaststart: do not read .gprc\n");
! 88: printf("\t[--help]\tPrint this message\n");
! 89: printf("\t[-q]\t\tQuiet mode: do not print banner and history numbers\n");
! 90: printf("\t[-p primelimit]\tPrecalculate primes up to the limit\n");
! 91: printf("\t[-s stacksize]\tStart with the PARI stack of given size (in bytes)\n");
! 92: printf("\t[-test]\t\tTest mode. As -q, plus wrap long lines\n");
! 93: printf("\t[--version]\tOutput version info and exit\n\n");
! 94: exit(0);
! 95: }
! 96:
! 97: /* must be called BEFORE pari_init() */
! 98: static void
! 99: gp_preinit(int force)
! 100: {
! 101: static char *dflt;
! 102: char *help;
! 103: long i;
! 104:
! 105: if (force)
! 106: {
! 107: #if !defined(macintosh) || defined(__MWERKS__)
! 108: primelimit = 500000; parisize = 1000000*sizeof(long);
! 109: dflt = DFT_PROMPT;
! 110: #else
! 111: primelimit = 200000; parisize = 1000000;
! 112: dflt = "?\n";
! 113: #endif
! 114: }
! 115: strcpy(prompt, dflt);
! 116:
! 117: #if defined(UNIX) || defined(__EMX__)
! 118: # ifdef __EMX__
! 119: path = pari_strdup(".;C:/;C:/gp");
! 120: # else
! 121: path = pari_strdup(".:~:~/gp");
! 122: # endif
! 123: help = getenv("GPHELP");
! 124: # ifdef GPHELP
! 125: if (!help) help = GPHELP;
! 126: # endif
! 127: #else
! 128: path = pari_strdup(".");
! 129: help = NULL;
! 130: #endif
! 131: help_prg = help? pari_strdup(help): NULL;
! 132: prettyp = f_PRETTYMAT;
! 133: strictmatch = simplifyflag = 1;
! 134: tglobal = 0;
! 135: bufindex = -1;
! 136: secure = test_mode = under_emacs = chrono = pariecho = 0;
! 137: fmt.format = 'g'; fmt.field = 0;
! 138: #ifdef LONG_IS_64BIT
! 139: fmt.nb = 38;
! 140: #else
! 141: fmt.nb = 28;
! 142: #endif
! 143: lim_lines = 0;
! 144: histsize = 5000; paribufsize = 1024;
! 145: i = histsize*sizeof(GEN);
! 146: hist = (GEN *) gpmalloc(i); memset(hist,0,i);
! 147: for (i=0; i<c_LAST; i++) gp_colors[i] = c_NONE;
! 148: }
! 149:
! 150: #define GET_SEP_SIZE 128
! 151: #define separe(c) ((c)==';' || (c)==':')
! 152:
! 153: /* Return all chars, up to next separator */
! 154: static char*
! 155: get_sep(char *t)
! 156: {
! 157: static char buf[GET_SEP_SIZE], *lim = buf + GET_SEP_SIZE-1;
! 158: char *s = buf;
! 159: int outer=1;
! 160:
! 161: for(;;)
! 162: {
! 163: switch(*s++ = *t++)
! 164: {
! 165: case '"':
! 166: if (outer || s[-2] != '\\') outer = !outer;
! 167: break;
! 168: case '\0':
! 169: return buf;
! 170: default:
! 171: if (outer && separe(*t)) { *s=0; return buf; }
! 172: }
! 173: if (s == lim) err(talker,"buffer overflow in get_sep");
! 174: }
! 175: }
! 176:
! 177: /* as above, t must be writeable, return 1 if we modified t */
! 178: static int
! 179: get_sep2(char *t)
! 180: {
! 181: int outer=1;
! 182: char *s = t;
! 183:
! 184: for(;;)
! 185: {
! 186: switch (*s++)
! 187: {
! 188: case '"':
! 189: if (outer || s[-2] != '\\') outer = !outer;
! 190: break;
! 191: case '\0':
! 192: return 0;
! 193: default:
! 194: if (outer && separe(*s)) { *s=0; return 1; }
! 195: }
! 196: }
! 197: }
! 198:
! 199: static long
! 200: get_int(char *s, long dflt)
! 201: {
! 202: char *p=get_sep(s);
! 203: long n=atol(p);
! 204:
! 205: if (*p == '-') p++;
! 206: while(isdigit((int)*p)) { p++; dflt=n; }
! 207: if (*p) err(talker2,"I was expecting an integer here", s, s);
! 208: return dflt;
! 209: }
! 210:
! 211: static void
! 212: gp_output(GEN x)
! 213: {
! 214: long tx=typ(x);
! 215:
! 216: if (fmt.nb >= 0 && is_intreal_t(tx))
! 217: ecrire(x, fmt.format, fmt.nb, fmt.field);
! 218: else
! 219: switch(prettyp)
! 220: {
! 221: case f_PRETTYMAT: matbrute(x, fmt.format, fmt.nb); break;
! 222: case f_PRETTY : sor(x, fmt.format, fmt.nb, fmt.field); break;
! 223: case f_RAW : brute(x, fmt.format, fmt.nb); break;
! 224: case f_TEX : texe(x, fmt.format, fmt.nb); break;
! 225: }
! 226: }
! 227:
! 228: /* print a sequence of (NULL terminated) GEN */
! 229: void
! 230: print0(GEN *g, long flag)
! 231: {
! 232: int old=prettyp;
! 233:
! 234: if (flag < NBFORMATS) added_newline=1;
! 235: else
! 236: { flag -= NBFORMATS; added_newline=0; }
! 237: prettyp=flag;
! 238:
! 239: for( ; *g; g++)
! 240: if (typ(*g)==t_STR)
! 241: pariputs(GSTR(*g)); /* otherwise it's surrounded by "" */
! 242: else
! 243: gp_output(*g);
! 244:
! 245: if (added_newline) pariputc('\n');
! 246: prettyp=old; pariflush();
! 247: }
! 248:
! 249: /* write a sequence of (NULL terminated) GEN, to file s */
! 250: void
! 251: write0(char *s, GEN *g, long flag)
! 252: {
! 253: int i = added_newline;
! 254: s = expand_tilde(s); switchout(s); free(s);
! 255: print0(g,flag); added_newline = i;
! 256: switchout(NULL);
! 257: }
! 258:
! 259: /********************************************************************/
! 260: /* */
! 261: /* DEFAULTS */
! 262: /* */
! 263: /********************************************************************/
! 264: static void
! 265: do_strftime(char *s, char *buf)
! 266: {
! 267: #ifdef HAS_STRFTIME
! 268: time_t t = time(NULL);
! 269: strftime(buf,MAX_PROMPT_LEN-1,s,localtime(&t));
! 270: #else
! 271: strcpy(buf,s);
! 272: #endif
! 273: }
! 274:
! 275: static GEN
! 276: sd_numeric(char *v, int flag, char *s, long *ptn, long Min, long Max,
! 277: char **msg)
! 278: {
! 279: long n;
! 280: if (*v == 0) n = *ptn;
! 281: else
! 282: {
! 283: n = get_int(v,0);
! 284: if (*ptn == n) return gnil;
! 285: if (n > Max || n < Min)
! 286: {
! 287: sprintf(thestring, "default: incorrect value for %s [%ld-%ld]",
! 288: s, Min, Max);
! 289: err(talker2, thestring, v,v);
! 290: }
! 291: *ptn = n;
! 292: }
! 293: switch(flag)
! 294: {
! 295: case d_RETURN: return stoi(n);
! 296: case d_ACKNOWLEDGE:
! 297: if (msg)
! 298: {
! 299: if (!*msg)
! 300: msg++; /* single msg, always printed */
! 301: else
! 302: msg += n; /* one per possible value */
! 303: pariputsf(" %s = %ld %s\n", s, n, *msg);
! 304: }
! 305: else if (Max != 1 || Min != 0)
! 306: pariputsf(" %s = %ld\n", s, n);
! 307: else /* toggle */
! 308: {
! 309: if (n==1) pariputsf(" %s = 1 (on)\n", s);
! 310: else pariputsf(" %s = 0 (off)\n", s);
! 311: } /* fall through */
! 312: default: return gnil;
! 313: }
! 314: }
! 315:
! 316: #define PRECDIGIT (long)((prec-2.)*pariK)
! 317: static GEN
! 318: sd_realprecision(char *v, int flag)
! 319: {
! 320: if (*v)
! 321: {
! 322: long newnb = get_int(v, fmt.nb);
! 323: long newprec = (long) (newnb*pariK1 + 3);
! 324:
! 325: if (fmt.nb == newnb && prec == newprec) return gnil;
! 326: if (newnb < 0) err(talker,"default: negative real precision");
! 327: fmt.nb = newnb; prec = newprec;
! 328: }
! 329: if (flag == d_RETURN) return stoi(fmt.nb);
! 330: if (flag == d_ACKNOWLEDGE)
! 331: {
! 332: long n = PRECDIGIT;
! 333: pariputsf(" realprecision = %ld significant digits", n);
! 334: if (n != fmt.nb) pariputsf(" (%ld digits displayed)", fmt.nb);
! 335: pariputc('\n');
! 336: }
! 337: return gnil;
! 338: }
! 339: #undef PRECDIGIT
! 340:
! 341: static GEN
! 342: sd_seriesprecision(char *v, int flag)
! 343: {
! 344: char *msg[] = {NULL, "significant terms"};
! 345: return sd_numeric(v,flag,"seriesprecision",&precdl, 0,LGBITS,msg);
! 346: }
! 347:
! 348: static GEN
! 349: sd_format(char *v, int flag)
! 350: {
! 351: if (*v)
! 352: {
! 353: char c = *v;
! 354: if (c!='e' && c!='f' && c!='g')
! 355: err(talker2,"default: inexistent format",v,v);
! 356: fmt.format = c; v++;
! 357:
! 358: if (isdigit((int)*v))
! 359: { fmt.field=atol(v); while (isdigit((int)*v)) v++; }
! 360: if (*v++ == '.')
! 361: {
! 362: if (*v == '-') fmt.nb = -1;
! 363: else
! 364: if (isdigit((int)*v)) fmt.nb=atol(v);
! 365: }
! 366: }
! 367: if (flag == d_RETURN)
! 368: {
! 369: sprintf(thestring, "%c%ld.%ld", fmt.format, fmt.field, fmt.nb);
! 370: return strtoGENstr(thestring,0);
! 371: }
! 372: if (flag == d_ACKNOWLEDGE)
! 373: pariputsf(" format = %c%ld.%ld\n", fmt.format, fmt.field, fmt.nb);
! 374: return gnil;
! 375: }
! 376:
! 377: static long
! 378: gp_get_color(char **st)
! 379: {
! 380: char *s, *v = *st;
! 381: int c, trans = 1;
! 382: if (!isdigit((int)*v))
! 383: {
! 384: if (*v == '[')
! 385: {
! 386: char *a[3];
! 387: int i = 0;
! 388: for (a[0] = s = ++v; *s && *s != ']'; s++)
! 389: if (*s == ',') { *s = 0; a[++i] = s+1; }
! 390: if (*s != ']') err(talker2,"expected character: ']'",s, *st);
! 391: *s = 0; for (i++; i<3; i++) a[i] = "";
! 392: /* properties | color | background */
! 393: c = (atoi(a[2])<<8) | atoi(a[0]) | (atoi(a[1])<<4);
! 394: trans = (*(a[1]) == 0);
! 395: v = s + 1;
! 396: }
! 397: else { c = c_NONE; trans = 0; }
! 398: }
! 399: else c = atol(v); /* color on transparent background */
! 400: if (trans) c = -c;
! 401: while (*v && *v++ != ',') /* empty */;
! 402: if (c != c_NONE) disable_color=0;
! 403: *st = v; return c;
! 404: }
! 405:
! 406: static GEN
! 407: sd_colors(char *v, int flag)
! 408: {
! 409: long c,l;
! 410: if (*v && !under_emacs)
! 411: {
! 412: char *tmp;
! 413: disable_color=1;
! 414: l = strlen(v);
! 415: if (l <= 2 && strncmp(v, "no", l) == 0)
! 416: v = "";
! 417: if (l <= 3 && strncmp(v, "yes", l) == 0)
! 418: v = "1, 5, 3, 7, 6, 2, 3"; /* Assume recent ReadLine. */
! 419: tmp = v = pari_strdup(v); filtre(v, f_INIT|f_REG);
! 420: for (c=c_ERR; c < c_LAST; c++)
! 421: gp_colors[c] = gp_get_color(&v);
! 422: free(tmp);
! 423: }
! 424: if (flag == d_ACKNOWLEDGE || flag == d_RETURN)
! 425: {
! 426: char *s = thestring;
! 427: int col[3], n;
! 428: for (*s=0,c=c_ERR; c < c_LAST; c++)
! 429: {
! 430: n = gp_colors[c];
! 431: if (n == c_NONE)
! 432: sprintf(s,"no");
! 433: else
! 434: {
! 435: decode_color(abs(n),col);
! 436: if (n < 0)
! 437: {
! 438: if (col[0])
! 439: sprintf(s,"[%d,,%d]",col[1],col[0]);
! 440: else
! 441: sprintf(s,"%d",col[1]);
! 442: }
! 443: else
! 444: sprintf(s,"[%d,%d,%d]",col[1],col[2],col[0]);
! 445: }
! 446: s += strlen(s);
! 447: if (c < c_LAST - 1) { *s++=','; *s++=' '; }
! 448: }
! 449: if (flag==d_RETURN) return strtoGENstr(thestring,0);
! 450: pariputsf(" colors = \"%s\"\n",thestring);
! 451: }
! 452: return gnil;
! 453: }
! 454:
! 455: static GEN
! 456: sd_compatible(char *v, int flag)
! 457: {
! 458: char *msg[] = {
! 459: "(no backward compatibility)",
! 460: "(warn when using obsolete functions)",
! 461: "(use old functions, don't ignore case)",
! 462: "(use old functions, ignore case)", NULL
! 463: };
! 464: long old = compatible;
! 465: GEN r = sd_numeric(v,flag,"compatible",&compatible, 0,3,msg);
! 466:
! 467: if (old != compatible && flag != d_INITRC)
! 468: {
! 469: int res = gp_init_entrees(new_fun_set? pari_modules: pari_oldmodules,
! 470: functions_hash, 0);
! 471: if (res) err(warner,"user functions re-initialized");
! 472: }
! 473: return r;
! 474: }
! 475:
! 476: static GEN
! 477: sd_secure(char *v, int flag)
! 478: {
! 479: if (secure)
! 480: {
! 481: fprintferr("Do you want to modify the 'secure' flag? (^C if not)\n");
! 482: hit_return();
! 483: }
! 484: return sd_numeric(v,flag,"secure",&secure, 0,1,NULL);
! 485: }
! 486:
! 487: static GEN
! 488: sd_buffersize(char *v, int flag)
! 489: { return sd_numeric(v,flag,"buffersize",&paribufsize, 0,
! 490: (VERYBIGINT / sizeof(long)) - 1,NULL); }
! 491: static GEN
! 492: sd_debug(char *v, int flag)
! 493: { return sd_numeric(v,flag,"debug",&DEBUGLEVEL, 0,20,NULL); }
! 494:
! 495: static GEN
! 496: sd_debugfiles(char *v, int flag)
! 497: { return sd_numeric(v,flag,"debugfiles",&DEBUGFILES, 0,20,NULL); }
! 498:
! 499: static GEN
! 500: sd_debugmem(char *v, int flag)
! 501: { return sd_numeric(v,flag,"debugmem",&DEBUGMEM, 0,20,NULL); }
! 502:
! 503: static GEN
! 504: sd_echo(char *v, int flag)
! 505: { return sd_numeric(v,flag,"echo",&pariecho, 0,1,NULL); }
! 506:
! 507: static GEN
! 508: sd_lines(char *v, int flag)
! 509: { return sd_numeric(v,flag,"lines",&lim_lines, 0,VERYBIGINT,NULL); }
! 510:
! 511: static GEN
! 512: sd_histsize(char *v, int flag)
! 513: {
! 514: long n = histsize;
! 515: GEN r = sd_numeric(v,flag,"histsize",&n, 1,
! 516: (VERYBIGINT / sizeof(long)) - 1,NULL);
! 517: if (n != histsize)
! 518: {
! 519: long i = n*sizeof(GEN);
! 520: GEN *gg = (GEN *) gpmalloc(i); memset(gg,0,i);
! 521:
! 522: if (tglobal)
! 523: {
! 524: long k = (tglobal-1) % n;
! 525: long kmin = k - min(n,histsize), j = k;
! 526:
! 527: i = (tglobal-1) % histsize;
! 528: while (k > kmin)
! 529: {
! 530: gg[j] = hist[i];
! 531: hist[i] = NULL;
! 532: if (!i) i = histsize;
! 533: if (!j) j = n;
! 534: i--; j--; k--;
! 535: }
! 536: while (hist[i])
! 537: {
! 538: gunclone(hist[i]);
! 539: if (!i) i = histsize;
! 540: i--;
! 541: }
! 542: }
! 543: free((void*)hist); hist=gg; histsize=n;
! 544: }
! 545: return r;
! 546: }
! 547:
! 548: static GEN
! 549: sd_log(char *v, int flag)
! 550: {
! 551: long vlog = logfile? 1: 0, old = vlog;
! 552: GEN r = sd_numeric(v,flag,"log",&vlog, 0,1,NULL);
! 553: if (vlog != old)
! 554: {
! 555: if (vlog)
! 556: {
! 557: logfile = fopen(current_logfile, "a");
! 558: if (!logfile) err(openfiler,"logfile",current_logfile);
! 559: #ifndef WINCE
! 560: setbuf(logfile,(char *)NULL);
! 561: #endif
! 562: }
! 563: else
! 564: {
! 565: if (flag == d_ACKNOWLEDGE)
! 566: pariputsf(" [logfile was \"%s\"]\n", current_logfile);
! 567: fclose(logfile); logfile=NULL;
! 568: }
! 569: }
! 570: return r;
! 571: }
! 572:
! 573: static GEN
! 574: sd_output(char *v, int flag)
! 575: {
! 576: char *msg[] = {"(raw)", "(prettymatrix)", "(prettyprint)", NULL};
! 577: return sd_numeric(v,flag,"output",&prettyp, 0,2,msg);
! 578: }
! 579:
! 580: static GEN
! 581: sd_parisize(char *v, int flag)
! 582: {
! 583: long n = parisize;
! 584: GEN r = sd_numeric(v,flag,"parisize",&n, 10000,VERYBIGINT,NULL);
! 585: if (n != parisize)
! 586: {
! 587: if (flag != d_INITRC)
! 588: {
! 589: parisize = allocatemoremem(n);
! 590: longjmp(local_environnement[bufindex], 0);
! 591: }
! 592: parisize = n;
! 593: }
! 594: return r;
! 595: }
! 596:
! 597: static GEN
! 598: sd_primelimit(char *v, int flag)
! 599: {
! 600: long n = primelimit;
! 601: GEN r = sd_numeric(v,flag,"primelimit",&n, 0,VERYBIGINT,NULL);
! 602: if (n != primelimit)
! 603: {
! 604: if (flag != d_INITRC)
! 605: {
! 606: byteptr ptr = initprimes(n);
! 607: free(diffptr); diffptr = ptr;
! 608: }
! 609: primelimit = n;
! 610: }
! 611: return r;
! 612: }
! 613:
! 614: static GEN
! 615: sd_simplify(char *v, int flag)
! 616: { return sd_numeric(v,flag,"simplify",&simplifyflag, 0,1,NULL); }
! 617:
! 618: static GEN
! 619: sd_strictmatch(char *v, int flag)
! 620: { return sd_numeric(v,flag,"strictmatch",&strictmatch, 0,1,NULL); }
! 621:
! 622: static GEN
! 623: sd_timer(char *v, int flag)
! 624: { return sd_numeric(v,flag,"timer",&chrono, 0,1,NULL); }
! 625:
! 626: static GEN
! 627: sd_filename(char *v, int flag, char *s, char **f)
! 628: {
! 629: if (*v)
! 630: {
! 631: char *old = *f;
! 632: v = expand_tilde(v);
! 633: do_strftime(v,thestring); free(v);
! 634: *f = pari_strdup(thestring); free(old);
! 635: }
! 636: if (flag == d_RETURN) return strtoGENstr(*f,0);
! 637: if (flag == d_ACKNOWLEDGE) pariputsf(" %s = \"%s\"\n",s,*f);
! 638: return gnil;
! 639: }
! 640:
! 641: static GEN
! 642: sd_logfile(char *v, int flag)
! 643: {
! 644: GEN r = sd_filename(v, flag, "logfile", ¤t_logfile);
! 645: if (*v && logfile)
! 646: {
! 647: fclose(logfile);
! 648: logfile = fopen(current_logfile, "a");
! 649: if (!logfile) err(openfiler,"logfile",current_logfile);
! 650: #ifndef WINCE
! 651: setbuf(logfile,(char *)NULL);
! 652: #endif
! 653: }
! 654: return r;
! 655: }
! 656:
! 657: static GEN
! 658: sd_psfile(char *v, int flag)
! 659: { return sd_filename(v, flag, "psfile", ¤t_psfile); }
! 660:
! 661: static GEN
! 662: sd_help(char *v, int flag)
! 663: {
! 664: char *str;
! 665: if (*v)
! 666: {
! 667: if (help_prg) free(help_prg);
! 668: help_prg = expand_tilde(v);
! 669: }
! 670: str = help_prg? help_prg: "none";
! 671: if (flag == d_RETURN) return strtoGENstr(str,0);
! 672: if (flag == d_ACKNOWLEDGE)
! 673: pariputsf(" help = \"%s\"\n", str);
! 674: return gnil;
! 675: }
! 676:
! 677: static GEN
! 678: sd_path(char *v, int flag)
! 679: {
! 680: if (*v)
! 681: {
! 682: char *old = path;
! 683: path = pari_strdup(v); free(old);
! 684: if (flag == d_INITRC) return gnil;
! 685: gp_expand_path(path);
! 686: }
! 687: if (flag == d_RETURN) return strtoGENstr(path,0);
! 688: if (flag == d_ACKNOWLEDGE)
! 689: pariputsf(" path = \"%s\"\n",path);
! 690: return gnil;
! 691: }
! 692:
! 693: static GEN
! 694: sd_prompt(char *v, int flag)
! 695: {
! 696: if (*v)
! 697: {
! 698: strncpy(prompt,v,MAX_PROMPT_LEN);
! 699: #ifdef macintosh
! 700: strcat(prompt,"\n");
! 701: #endif
! 702: }
! 703: if (flag == d_RETURN) return strtoGENstr(prompt,0);
! 704: if (flag == d_ACKNOWLEDGE)
! 705: pariputsf(" prompt = \"%s\"\n",prompt);
! 706: return gnil;
! 707: }
! 708:
! 709: default_type gp_default_list[] =
! 710: {
! 711: {"buffersize",(void*)sd_buffersize},
! 712: {"colors",(void*)sd_colors},
! 713: {"compatible",(void*)sd_compatible},
! 714: {"debug",(void*)sd_debug},
! 715: {"debugfiles",(void*)sd_debugfiles},
! 716: {"debugmem",(void*)sd_debugmem},
! 717: {"echo",(void*)sd_echo},
! 718: {"format",(void*)sd_format},
! 719: {"help",(void*)sd_help},
! 720: {"histsize",(void*)sd_histsize},
! 721: {"lines",(void*)sd_lines},
! 722: {"log",(void*)sd_log},
! 723: {"logfile",(void*)sd_logfile},
! 724: {"output",(void*)sd_output},
! 725: {"parisize",(void*)sd_parisize},
! 726: {"path",(void*)sd_path},
! 727: {"primelimit",(void*)sd_primelimit},
! 728: {"prompt",(void*)sd_prompt},
! 729: {"psfile",(void*)sd_psfile},
! 730: {"realprecision",(void*)sd_realprecision},
! 731: {"secure",(void*)sd_secure},
! 732: {"seriesprecision",(void*)sd_seriesprecision},
! 733: {"simplify",(void*)sd_simplify},
! 734: {"strictmatch",(void*)sd_strictmatch},
! 735: {"timer",(void *)sd_timer},
! 736: {NULL,NULL} /* sentinel */
! 737: };
! 738:
! 739: static void
! 740: help_default()
! 741: {
! 742: default_type *dft;
! 743:
! 744: for (dft=gp_default_list; dft->fun; dft++)
! 745: ((void (*)(ANYARG)) dft->fun)("", d_ACKNOWLEDGE);
! 746: }
! 747:
! 748: static GEN
! 749: setdefault(char *s,char *v, int flag)
! 750: {
! 751: default_type *dft;
! 752:
! 753: if (!*s) { help_default(); return gnil; }
! 754: for (dft=gp_default_list; dft->fun; dft++)
! 755: if (!strcmp(s,dft->name))
! 756: {
! 757: if (flag == d_EXISTS) return gun;
! 758: return ((GEN (*)(ANYARG)) dft->fun)(v,flag);
! 759: }
! 760: if (flag == d_EXISTS) return gzero;
! 761: err(talker,"unknown default: %s",s);
! 762: return NULL; /* not reached */
! 763: }
! 764:
! 765: /********************************************************************/
! 766: /** **/
! 767: /** HELP **/
! 768: /** **/
! 769: /********************************************************************/
! 770: static int
! 771: has_ext_help()
! 772: {
! 773: if (help_prg)
! 774: {
! 775: char *buf = pari_strdup(help_prg), *s = buf;
! 776: FILE *file;
! 777:
! 778: while (*s && *s != ' ') s++;
! 779: *s = 0; file = (FILE *) fopen(buf,"r");
! 780: if (file) { fclose(file); return 1; }
! 781: free(buf);
! 782: }
! 783: return 0;
! 784: }
! 785:
! 786: static int
! 787: compare_str(char **s1, char **s2) { return strcmp(*s1, *s2); }
! 788:
! 789: /* Print all elements of list in columns, pausing every nbli lines
! 790: * if nbli is non-zero.
! 791: * list is a NULL terminated list of function names
! 792: */
! 793: void
! 794: print_fun_list(char **list, int nbli)
! 795: {
! 796: long i=0, j=0, maxlen=0, nbcol,len, w = term_width();
! 797: char **l;
! 798:
! 799: while (list[i]) i++;
! 800: qsort (list, i, sizeof(char *), (QSCOMP)compare_str);
! 801:
! 802: for (l=list; *l; l++)
! 803: {
! 804: len = strlen(*l);
! 805: if (len > maxlen) maxlen=len;
! 806: }
! 807: maxlen++; nbcol= w / maxlen;
! 808: if (nbcol * maxlen == w) nbcol--;
! 809: if (!nbcol) nbcol = 1;
! 810:
! 811: pariputc('\n'); i=0;
! 812: for (l=list; *l; l++)
! 813: {
! 814: pariputs(*l); i++;
! 815: if (i >= nbcol)
! 816: {
! 817: i=0; pariputc('\n');
! 818: if (nbli && j++ > nbli) { j = 0; hit_return(); }
! 819: continue;
! 820: }
! 821: len = maxlen - strlen(*l);
! 822: while (len--) pariputc(' ');
! 823: }
! 824: if (i) pariputc('\n');
! 825: }
! 826:
! 827: #define LIST_LEN 1023
! 828: static void
! 829: commands(int n)
! 830: {
! 831: int hashpos, s = 0, olds = LIST_LEN;
! 832: entree *ep;
! 833: char **list = (char **) gpmalloc((olds+1)*sizeof(char *));
! 834:
! 835: for (hashpos = 0; hashpos < functions_tblsz; hashpos++)
! 836: for (ep = functions_hash[hashpos]; ep; ep = ep->next)
! 837: if ((n<0 && ep->menu) || ep->menu == n)
! 838: {
! 839: list[s++] = ep->name;
! 840: if (s >= olds)
! 841: {
! 842: int news = olds + (LIST_LEN + 1)*sizeof(char *);
! 843: list = (char**) gprealloc(list,news,olds);
! 844: olds = news;
! 845: }
! 846: }
! 847: list[s]=NULL; print_fun_list(list,term_height()-4); free(list);
! 848: }
! 849:
! 850: static void
! 851: print_user_fun(entree *ep)
! 852: {
! 853: gp_args *f= (gp_args*)ep->args;
! 854: GEN q = (GEN)ep->value, *arg = f->arg;
! 855: int i, narg;
! 856:
! 857:
! 858: q++; /* skip initial NULL */
! 859: pariputs(ep->name); pariputc('(');
! 860: narg = f->narg;
! 861: for (i=1; i<=narg; i++, arg++)
! 862: {
! 863: entree *ep = varentries[*q++];
! 864: pariputs(ep? ep->name:"#");
! 865: if (!gcmp0(*arg)) { pariputc('='); bruteall(*arg,'g',-1,1); }
! 866: if (i == narg) { arg++; break; }
! 867: pariputs(", ");
! 868: }
! 869: pariputs(") = ");
! 870: narg = f->nloc;
! 871: if (narg)
! 872: {
! 873: pariputs("local(");
! 874: for (i=1; i<=narg; i++, arg++)
! 875: {
! 876: entree *ep = varentries[*q++];
! 877: pariputs(ep? ep->name:"#");
! 878: if (!gcmp0(*arg)) { pariputc('='); bruteall(*arg,'g',-1,1); }
! 879: if (i == narg) break;
! 880: pariputs(", ");
! 881: }
! 882: pariputs("); ");
! 883: }
! 884: pariputs((char*)q);
! 885: }
! 886:
! 887: static void
! 888: print_user_member(entree *ep)
! 889: {
! 890: GEN q = (GEN)ep->value;
! 891: entree *ep2;
! 892:
! 893: q++; /* skip initial NULL */
! 894: ep2 = varentries[*q++];
! 895: pariputs(ep2? ep2->name:"#");
! 896: pariputsf(".%s = ", ep->name);
! 897: pariputs((char*)q);
! 898: }
! 899:
! 900: static void
! 901: user_fun()
! 902: {
! 903: entree *ep;
! 904: int hash;
! 905:
! 906: for (hash = 0; hash < functions_tblsz; hash++)
! 907: for (ep = functions_hash[hash]; ep; ep = ep->next)
! 908: if (EpVALENCE(ep) == EpUSER)
! 909: {
! 910: pariputc(LBRACE); print_user_fun(ep);
! 911: pariputc(RBRACE); pariputs("\n\n");
! 912: }
! 913: }
! 914:
! 915: static void
! 916: user_member()
! 917: {
! 918: entree *ep;
! 919: int hash;
! 920:
! 921: for (hash = 0; hash < functions_tblsz; hash++)
! 922: for (ep = members_hash[hash]; ep; ep = ep->next)
! 923: if (EpVALENCE(ep) == EpMEMBER)
! 924: {
! 925: pariputc(LBRACE); print_user_member(ep);
! 926: pariputc(RBRACE); pariputs("\n\n");
! 927: }
! 928: }
! 929:
! 930: static void
! 931: community()
! 932: {
! 933: pariputs("The standard distribution of GP/PARI includes a reference manual, a tutorial\n\
! 934: and a reference card and you should ask the person who installed PARI on\n\
! 935: your system where they can be found. You can also download them\n\
! 936: from the PARI WWW site http://hasse.mathematik.tu-muenchen.de/ntsw/pari/\n\
! 937: \n\
! 938: Three mailing lists are devoted to PARI:\n\
! 939: - pari-announce (moderated) to announce major version changes.\n\
! 940: - pari-dev for everything related to the development of PARI, including\n\
! 941: suggestions, technical questions, bug reports and patch submissions.\n\
! 942: - pari-users for everything else !\n\
! 943: To subscribe, send an empty message to <list name>-subscribe@list.cr.yp.to\n\
! 944: You can only send messages to these lists if you have subscribed !\n\
! 945: An archive is kept at the address\n\
! 946: http://hasse.mathematik.tu-muenchen.de/ntsw/pari/lists/archive\n\n\
! 947: In case you don't want to subscribe, you can reach the authors directly by\n\
! 948: email: pari@math.u-bordeaux.fr (answer not guaranteed).");
! 949: }
! 950:
! 951: static void
! 952: gentypes(void)
! 953: {
! 954: pariputs("List of the PARI types:\n\
! 955: t_INT : long integers [ cod1 ] [ cod2 ] [ man_1 ] ... [ man_k ]\n\
! 956: t_REAL : long real numbers [ cod1 ] [ cod2 ] [ man_1 ] ... [ man_k ]\n\
! 957: t_INTMOD : integermods [ code ] [ mod ] [ integer ]\n\
! 958: t_FRAC : irred. rationals [ code ] [ num. ] [ den. ]\n\
! 959: t_FRACN : rational numbers [ code ] [ num. ] [ den. ]\n\
! 960: t_COMPLEX: complex numbers [ code ] [ real ] [ imag ]\n\
! 961: t_PADIC : p-adic numbers [ cod1 ] [ cod2 ] [ p ] [ p^r ] [ int ]\n\
! 962: t_QUAD : quadratic numbers [ cod1 ] [ mod ] [ real ] [ imag ]\n\
! 963: t_POLMOD : poly mod [ code ] [ mod ] [ polynomial ]\n\
! 964: -------------------------------------------------------------\n\
! 965: t_POL : polynomials [ cod1 ] [ cod2 ] [ man_1 ] ... [ man_k ]\n\
! 966: t_SER : power series [ cod1 ] [ cod2 ] [ man_1 ] ... [ man_k ]\n\
! 967: t_RFRAC : irred. rat. func. [ code ] [ num. ] [ den. ]\n\
! 968: t_RFRACN : rational function [ code ] [ num. ] [ den. ]\n\
! 969: t_QFR : real qfb [ code ] [ a ] [ b ] [ c ] [ del ]\n\
! 970: t_QFI : imaginary qfb [ code ] [ a ] [ b ] [ c ]\n\
! 971: t_VEC : row vector [ code ] [ x_1 ] ... [ x_k ]\n\
! 972: t_COL : column vector [ code ] [ x_1 ] ... [ x_k ]\n\
! 973: t_MAT : matrix [ code ] [ col_1 ] ... [ col_k ]\n\
! 974: t_LIST : list [ code ] [ cod2 ] [ x_1 ] ... [ x_k ]\n\
! 975: t_STR : string [ code ] [ man_1 ] ... [ man_k ]\n\
! 976: \n");
! 977: }
! 978:
! 979: static void
! 980: menu_commands(void)
! 981: {
! 982: pariputs("Help topics:\n\
! 983: 0: list of user-defined identifiers (variable, alias, function)\n\
! 984: 1: Standard monadic or dyadic OPERATORS\n\
! 985: 2: CONVERSIONS and similar elementary functions\n\
! 986: 3: TRANSCENDENTAL functions\n\
! 987: 4: NUMBER THEORETICAL functions\n\
! 988: 5: Functions related to ELLIPTIC CURVES\n\
! 989: 6: Functions related to general NUMBER FIELDS\n\
! 990: 7: POLYNOMIALS and power series\n\
! 991: 8: Vectors, matrices, LINEAR ALGEBRA and sets\n\
! 992: 9: SUMS, products, integrals and similar functions\n\
! 993: 10: GRAPHIC functions\n\
! 994: 11: PROGRAMMING under GP\n\
! 995: 12: The PARI community\n\
! 996: \n\
! 997: Further help (list of relevant functions): ?n (1<=n<=11).\n\
! 998: Also:\n\
! 999: ? functionname (short on-line help)\n\
! 1000: ?\\ (keyboard shortcuts)\n\
! 1001: ?. (member functions)\n");
! 1002: if (has_ext_help()) pariputs("\
! 1003: Extended help looks available:\n\
! 1004: ?? (opens the full user's manual in a dvi previewer)\n\
! 1005: ?? tutorial (same with the GP tutorial)\n\
! 1006: ?? refcard (same with the GP reference card)\n\
! 1007: \n\
! 1008: ?? keyword (long help text about \"keyword\" from the user's manual)\n\
! 1009: ??? keyword (a propos: list of related functions).");
! 1010: }
! 1011:
! 1012: static void
! 1013: slash_commands(void)
! 1014: {
! 1015: pariputs("# : enable/disable timer\n\
! 1016: ## : print time for last result\n\
! 1017: \\\\ : comment up to end of line\n\
! 1018: \\a {n} : print result in raw format (readable by PARI)\n\
! 1019: \\b {n} : print result in beautified format\n\
! 1020: \\c : list all commands (same effect as ?*)\n\
! 1021: \\d : print all defaults\n\
! 1022: \\e {n} : enable/disable echo (set echo=n)\n\
! 1023: \\g {n} : set debugging level\n\
! 1024: \\gf{n} : set file debugging level\n\
! 1025: \\gm{n} : set memory debugging level\n\
! 1026: \\h {m-n}: hashtable information\n\
! 1027: \\l {f} : enable/disable logfile (set logfile=f)\n\
! 1028: \\m {n} : print result in prettymatrix format\n\
! 1029: \\p {n} : change real precision\n\
! 1030: \\ps{n} : change series precision\n\
! 1031: \\q : quit completely this GP session\n\
! 1032: \\r {f} : read in a file\n\
! 1033: \\s {n} : print stack information\n\
! 1034: \\t : print the list of PARI types\n\
! 1035: \\u : print the list of user-defined functions\n\
! 1036: \\um : print the list of user-defined member functions\n\
! 1037: \\v : print current version of GP\n\
! 1038: \\w {nf} : write to a file\n\
! 1039: \\x {n} : print complete inner structure of result\n\
! 1040: \\y {n} : disable/enable automatic simplification (set simplify=n)\n\
! 1041: \n\
! 1042: {f}=optional filename. {n}=optional integer\n");
! 1043: }
! 1044:
! 1045: static void
! 1046: member_commands(void)
! 1047: {
! 1048: pariputs("Member functions, followed by relevant objects\n\n\
! 1049: a1-a6, b2-b8, c4-c6 : coeff. of the curve. ell\n\
! 1050: area : area ell\n\
! 1051: bnf : big number field bnf, bnr\n\
! 1052: clgp : class group bnf, bnr\n\
! 1053: cyc : cyclic decomposition (SNF) clgp bnf, bnr\n\
! 1054: diff, codiff: different and codifferent nf, bnf, bnr\n\
! 1055: disc : discriminant ell, nf, bnf, bnr\n\
! 1056: e, f : inertia/residues degree prid\n\
! 1057: fu : fundamental units bnf, bnr\n\
! 1058: futu : [u,w] where u=unit group, w=torsion bnf, bnr\n\
! 1059: gen : generators prid, clgp bnf, bnr\n\
! 1060: j : j-invariant ell\n\
! 1061: mod : modulus\n\
! 1062: nf : number field bnf, bnr\n\
! 1063: no : number of elements clgp bnf, bnr\n\
! 1064: omega, eta: [omega1,omega2] and [eta1, eta2] ell\n\
! 1065: p : rational prime contained in prid prid\n\
! 1066: pol : defining polynomial nf, bnf, bnr\n\
! 1067: reg : regulator bnf, bnr\n\
! 1068: roots: roots ell nf, bnf, bnr\n\
! 1069: sign : signature nf, bnf, bnr\n\
! 1070: t2 : t2 matrix nf, bnf, bnr\n\
! 1071: tate : Tate's [u^2,u,q] ell\n\
! 1072: tu : torsion unit and its order bnf, bnr\n\
! 1073: tufu : [w,u] where u=unit group, w=torsion bnf, bnr\n\
! 1074: w : Mestre's w ell\n\
! 1075: zk : integral basis nf, bnf, bnr\n\
! 1076: zkst : structure of (Z_K/m)^* (valid for idealstar also) bnr\n");
! 1077: }
! 1078:
! 1079: #define MAX_LINE_LEN 255
! 1080: static void
! 1081: external_help(char *s, int num)
! 1082: {
! 1083: long nbli = term_height()-3, li = 0;
! 1084: char buf[MAX_LINE_LEN+1], *str, *opt = "", *ar = "";
! 1085: pariFILE *z;
! 1086: FILE *f;
! 1087:
! 1088: if (!help_prg) err(talker,"no external help program");
! 1089: str = gpmalloc(strlen(help_prg) + strlen(s) + 64);
! 1090: if (num < 0)
! 1091: opt = "-k";
! 1092: else if (s[strlen(s)-1] != '@')
! 1093: { ar = thestring; sprintf(ar,"@%d",num); }
! 1094: sprintf(str,"%s -fromgp %s %c%s%s%c",help_prg,opt, SHELL_Q,s,ar,SHELL_Q);
! 1095: z = try_pipe(str,0); f = z->file;
! 1096: free(str);
! 1097: while (fgets(buf,MAX_LINE_LEN,f))
! 1098: {
! 1099: if (!strncmp("ugly_kludge_done",buf,16)) break;
! 1100: buf[MAX_LINE_LEN]=0; pariputs(buf);
! 1101: if (++li > nbli) { hit_return(); li = 0; }
! 1102: }
! 1103: pari_fclose(z);
! 1104: }
! 1105:
! 1106: char *keyword_list[]={
! 1107: "operator",
! 1108: "user",
! 1109: "member",
! 1110: "integer",
! 1111: "real",
! 1112: "readline",
! 1113: "refcard",
! 1114: "tutorial",
! 1115: "nf",
! 1116: "bnf",
! 1117: "bnr",
! 1118: "ell",
! 1119: NULL
! 1120: };
! 1121:
! 1122: static int
! 1123: ok_external_help(char *s)
! 1124: {
! 1125: long n;
! 1126: if (!*s) return 1;
! 1127: if (!isalpha((int)*s)) return 3; /* operator or section number */
! 1128: if (!strncmp(s,"t_",2)) return 2; /* type name */
! 1129:
! 1130: for (n=0; keyword_list[n]; n++)
! 1131: if (!strcmp(s,keyword_list[n])) return 3;
! 1132: return 0;
! 1133: }
! 1134:
! 1135: /* don't mess readline display */
! 1136: static void
! 1137: aide_err(char *s1, char *s2, int flag)
! 1138: {
! 1139: if ((flag & h_RL) == 0) err(talker, "%s: %s", s1, s2);
! 1140: pariputsf("%s: %s\n", s1, s2);
! 1141: }
! 1142:
! 1143: static void
! 1144: aide0(char *s, int flag)
! 1145: {
! 1146: long n, long_help = flag & h_LONG;
! 1147: entree *ep,*ep1;
! 1148:
! 1149: s = get_sep(s);
! 1150: if (isdigit((int)*s))
! 1151: {
! 1152: n=atoi(s);
! 1153: if (n == 12) { community(); return; }
! 1154: if (n<0 || n > 12)
! 1155: err(talker2,"no such section in help: ?",s,s);
! 1156: if (long_help) external_help(s,3); else commands(n);
! 1157: return;
! 1158: }
! 1159: if (flag & h_APROPOS) { external_help(s,-1); return; }
! 1160: if (long_help && (n = ok_external_help(s))) { external_help(s,n); return; }
! 1161: switch (*s)
! 1162: {
! 1163: case '*' : commands(-1); return;
! 1164: case '\0': menu_commands(); return;
! 1165: case '\\': slash_commands(); return;
! 1166: case '.' : member_commands(); return;
! 1167: }
! 1168: ep = is_entry(s);
! 1169: if (!ep)
! 1170: {
! 1171: n = whatnow(s,1);
! 1172: if (n) err(obsoler,s,s, s,n);
! 1173: if (long_help)
! 1174: {
! 1175: n = setdefault(s,"",d_EXISTS) == gun? 2: 3;
! 1176: external_help(s,n);
! 1177: }
! 1178: else
! 1179: aide_err(s,"unknown identifier",flag);
! 1180: return;
! 1181: }
! 1182:
! 1183: ep1 = ep; ep = do_alias(ep);
! 1184: if (ep1 != ep) pariputsf("%s is aliased to:\n\n",s);
! 1185:
! 1186: switch(EpVALENCE(ep))
! 1187: {
! 1188: case EpUSER:
! 1189: print_user_fun(ep); if (!ep->help) return;
! 1190: pariputs("\n\n"); long_help=0; break;
! 1191:
! 1192: case EpGVAR:
! 1193: case EpVAR:
! 1194: if (!ep->help) { aide_err(s, "user defined variable",flag); return; }
! 1195: long_help=0; break;
! 1196:
! 1197: case EpINSTALL:
! 1198: if (!ep->help) { aide_err(s, "installed function",flag); return; }
! 1199: long_help=0; break;
! 1200: }
! 1201: if (long_help) { external_help(ep->name,3); return; }
! 1202: if (ep->help) { print_text(ep->help); return; }
! 1203:
! 1204: err(bugparier,"aide (no help found)");
! 1205: }
! 1206:
! 1207: void
! 1208: aide(char *s, int flag)
! 1209: {
! 1210: if ((flag & h_RL) == 0)
! 1211: {
! 1212: if (*s == '?') { flag |= h_LONG; s++; }
! 1213: if (*s == '?') { flag |= h_APROPOS; s++; }
! 1214: }
! 1215: term_color(c_HELP); aide0(s,flag); term_color(c_NONE);
! 1216: if ((flag & h_RL) == 0) pariputc('\n');
! 1217: }
! 1218:
! 1219: /********************************************************************/
! 1220: /** **/
! 1221: /** METACOMMANDS **/
! 1222: /** **/
! 1223: /********************************************************************/
! 1224:
! 1225: static void
! 1226: print_entree(entree *ep, long hash)
! 1227: {
! 1228: pariputsf(" %s ",ep->name); pariputsf(VOIR_STRING1,(ulong)ep);
! 1229: pariputsf(":\n hash = %3ld, valence = %3ld, menu = %2ld, code = %s\n",
! 1230: hash, ep->valence, ep->menu, ep->code? ep->code: "NULL");
! 1231: if (ep->next)
! 1232: {
! 1233: pariputsf(" next = %s ",(ep->next)->name);
! 1234: pariputsf(VOIR_STRING1,(ulong)(ep->next));
! 1235: }
! 1236: pariputs("\n");
! 1237: }
! 1238:
! 1239: static void
! 1240: print_hash_list(char *s)
! 1241: {
! 1242: long m,n;
! 1243: entree *ep;
! 1244:
! 1245: if (isalpha((int)*s))
! 1246: {
! 1247: ep = is_entry_intern(s,functions_hash,&n);
! 1248: if (!ep) err(talker,"no such function");
! 1249: print_entree(ep,n); return;
! 1250: }
! 1251: if (isdigit((int)*s) || *s == '$')
! 1252: {
! 1253: m = functions_tblsz-1; n = atol(s);
! 1254: if (*s=='$') n = m;
! 1255: if (m<n) err(talker,"invalid range in print_entree");
! 1256: while (isdigit((int)*s)) s++;
! 1257:
! 1258: if (*s++ != '-') m = n;
! 1259: else
! 1260: {
! 1261: if (*s !='$') m = min(atol(s),m);
! 1262: if (m<n) err(talker,"invalid range in print_entree");
! 1263: }
! 1264:
! 1265: for(; n<=m; n++)
! 1266: {
! 1267: pariputsf("*** hashcode = %ld\n",n);
! 1268: for (ep=functions_hash[n]; ep; ep=ep->next)
! 1269: print_entree(ep,n);
! 1270: }
! 1271: return;
! 1272: }
! 1273: if (*s=='-')
! 1274: {
! 1275: for (n=0; n<functions_tblsz; n++)
! 1276: {
! 1277: m=0;
! 1278: for (ep=functions_hash[n]; ep; ep=ep->next) m++;
! 1279: pariputsf("%3ld:%3ld ",n,m);
! 1280: if (n%9 == 8) pariputc('\n');
! 1281: }
! 1282: pariputc('\n'); return;
! 1283: }
! 1284: for (n=0; n<functions_tblsz; n++)
! 1285: for (ep=functions_hash[n]; ep; ep=ep->next)
! 1286: print_entree(ep,n);
! 1287: }
! 1288:
! 1289:
! 1290: static void
! 1291: center(char *s)
! 1292: {
! 1293: long i, pad = term_width() - strlen(s);
! 1294: char *u = thestring;
! 1295:
! 1296: if (pad<0) pad=0; else pad >>= 1;
! 1297: for (i=0; i<pad; i++) *u++ = ' ';
! 1298: while (*s) *u++ = *s++;
! 1299: *u++='\n'; *u=0; pariputs(thestring);
! 1300: }
! 1301:
! 1302: static char *
! 1303: what_readline()
! 1304: {
! 1305: #ifdef READLINE
! 1306: return "v"READLINE" enabled";
! 1307: #else
! 1308: return "disabled";
! 1309: #endif
! 1310: }
! 1311:
! 1312: static void
! 1313: print_version()
! 1314: {
! 1315: char buf[64];
! 1316:
! 1317: center(PARIVERSION); center(PARIINFO);
! 1318: sprintf(buf,"(readline %s, extended help%s available)", what_readline(),
! 1319: has_ext_help()? "": " not");
! 1320: center(buf);
! 1321: }
! 1322:
! 1323: static void
! 1324: gp_head()
! 1325: {
! 1326: print_version(); pariputs("\n");
! 1327: center("Copyright (C) 1989-1999 by");
! 1328: center("C. Batut, K. Belabas, D. Bernardi, H. Cohen and M. Olivier.");
! 1329: pariputs("\n\
! 1330: Type ? for help, \\q to quit.\n\
! 1331: Type ?12 for how to get moral (and possibly technical) support.\n\n");
! 1332: sd_realprecision ("",d_ACKNOWLEDGE);
! 1333: sd_seriesprecision("",d_ACKNOWLEDGE);
! 1334: sd_format ("",d_ACKNOWLEDGE);
! 1335: pariputsf("\nparisize = %ld, primelimit = %ld\n", parisize, primelimit);
! 1336: }
! 1337:
! 1338: void
! 1339: gp_quit()
! 1340: {
! 1341: free_graph(); freeall();
! 1342: while (bufindex) free((void *)buflist[bufindex--]);
! 1343: #ifdef WINCE
! 1344: #else
! 1345: if (INIT_SIG)
! 1346: {
! 1347: #ifdef SIGBUS
! 1348: signal(SIGBUS,SIG_DFL);
! 1349: #endif
! 1350: signal(SIGSEGV,SIG_DFL);
! 1351: signal(SIGINT,SIG_DFL);
! 1352: #ifdef SIGBREAK
! 1353: signal(SIGBREAK,SIG_DFL);
! 1354: #endif
! 1355: }
! 1356: #endif
! 1357: term_color(c_NONE);
! 1358: pariputs_opt("Good bye!\n"); exit(0);
! 1359: }
! 1360:
! 1361: /* history management function:
! 1362: * flag < 0, called from freeall()
! 1363: * flag = 0, called from %num in anal.c:truc()
! 1364: * flag > 0, called from %` in anal.c:truc(), p > 0
! 1365: */
! 1366: static GEN
! 1367: gp_history(long p, long flag, char *old, char *entrypoint)
! 1368: {
! 1369: int er1 = 0;
! 1370: if (flag < 0) { free((void *)hist); return NULL; }
! 1371: if (!tglobal) er1 = 1;
! 1372: if (flag)
! 1373: {
! 1374: p = tglobal - p;
! 1375: if (p <= 0) er1 = 1;
! 1376: }
! 1377: else if (p > tglobal)
! 1378: err(talker2,"I can't see into the future",old,entrypoint);
! 1379: if (!p) p = tglobal;
! 1380: if (tglobal - p >= histsize) er1 = 1;
! 1381: p = (p-1) % histsize;
! 1382: if (er1 || !hist[p])
! 1383: err(talker2,"I can't remember before the big bang",old,entrypoint);
! 1384: return hist[p];
! 1385: }
! 1386:
! 1387: static void
! 1388: escape(char *tch)
! 1389: {
! 1390: char *s, c;
! 1391:
! 1392: if (compatible != NONE)
! 1393: {
! 1394: s = tch;
! 1395: while (*s)
! 1396: if (*s++ == '=')
! 1397: {
! 1398: GEN (*f)(char*, int) = NULL;
! 1399: int len = (s-tch) - 1;
! 1400:
! 1401: if (!strncmp(tch,"precision",len)) f = sd_realprecision;
! 1402: else if (!strncmp(tch,"serieslength",len)) f = sd_seriesprecision;
! 1403: else if (!strncmp(tch,"format",len)) f = sd_format;
! 1404: else if (!strncmp(tch,"prompt",len)) f = sd_prompt;
! 1405: if (f) { f(get_sep(s), d_ACKNOWLEDGE); return; }
! 1406: break;
! 1407: }
! 1408: }
! 1409: s = tch;
! 1410: switch ((c = *s++))
! 1411: {
! 1412: case 'w': case 'x': case 'a': case 'b': case 'm': /* history things */
! 1413: {
! 1414: long d;
! 1415: GEN x;
! 1416: if (c != 'w' && c != 'x') d = get_int(s,0);
! 1417: else
! 1418: {
! 1419: d = atol(s); if (*s == '-') s++;
! 1420: while (isdigit((int)*s)) s++;
! 1421: }
! 1422: x = gp_history(d, 0, tch+1,tch-1);
! 1423: switch (c)
! 1424: {
! 1425: case 'a': brute (x, fmt.format, -1); break;
! 1426: case 'm': matbrute(x, fmt.format, -1); break;
! 1427: case 'b': sor (x, fmt.format, -1, fmt.field); break;
! 1428: case 'x': voir(x, get_int(s, -1)); return;
! 1429: case 'w':
! 1430: {
! 1431: GEN g[2]; g[0] = x; g[1] = NULL;
! 1432: s = get_sep(s); if (!*s) s = current_logfile;
! 1433: write0(s, g, f_RAW); return;
! 1434: }
! 1435: }
! 1436: pariputc('\n'); return;
! 1437: }
! 1438:
! 1439: case 'c': commands(-1); break;
! 1440: case 'd': help_default(); break;
! 1441: case 'e':
! 1442: s = get_sep(s);
! 1443: if (!*s) s = pariecho?"0":"1";
! 1444: sd_echo(s,d_ACKNOWLEDGE); break;
! 1445: case 'g':
! 1446: switch (*s)
! 1447: {
! 1448: case 'm': sd_debugmem(++s,d_ACKNOWLEDGE); break;
! 1449: case 'f': sd_debugfiles(++s,d_ACKNOWLEDGE); break;
! 1450: default : sd_debug(s,d_ACKNOWLEDGE); break;
! 1451: }
! 1452: break;
! 1453: case 'h': print_hash_list(s); break;
! 1454: case 'l':
! 1455: s = get_sep(s);
! 1456: if (*s)
! 1457: {
! 1458: sd_logfile(s,d_ACKNOWLEDGE);
! 1459: if (logfile) break;
! 1460: }
! 1461: sd_log(logfile?"0":"1",d_ACKNOWLEDGE);
! 1462: break;
! 1463: case 'p':
! 1464: switch (*s)
! 1465: {
! 1466: case 's': sd_seriesprecision(++s,d_ACKNOWLEDGE); break;
! 1467: default : sd_realprecision(s,d_ACKNOWLEDGE); break;
! 1468: }
! 1469: break;
! 1470: case 'q': gp_quit(); break;
! 1471: case 'r': switchin(get_sep(s)); break;
! 1472: case 's': etatpile(0); break;
! 1473: case 't': gentypes(); break;
! 1474: case 'u':
! 1475: switch (*s)
! 1476: {
! 1477: case 'm': user_member(); break;
! 1478: default: user_fun();
! 1479: }
! 1480: break;
! 1481: case 'v': print_version(); break;
! 1482: case 'y':
! 1483: s = get_sep(s);
! 1484: if (!*s) s = simplifyflag?"0":"1";
! 1485: sd_simplify(s,d_ACKNOWLEDGE); break;
! 1486: default: err(caracer1,tch-1,tch-2);
! 1487: }
! 1488: }
! 1489:
! 1490: /********************************************************************/
! 1491: /* */
! 1492: /* GPRC */
! 1493: /* */
! 1494: /********************************************************************/
! 1495: #if defined(UNIX) || defined(__EMX__)
! 1496: # include <pwd.h>
! 1497: #endif
! 1498:
! 1499: static int
! 1500: get_preproc_value(char *s)
! 1501: {
! 1502: if (!strncmp(s,"EMACS",5)) return under_emacs;
! 1503: if (!strncmp(s,"READL",5))
! 1504: {
! 1505: #ifdef READLINE
! 1506: return 1;
! 1507: #else
! 1508: return 0;
! 1509: #endif
! 1510: }
! 1511: return -1;
! 1512: }
! 1513:
! 1514: /* return $HOME or the closest we can find */
! 1515: static char *
! 1516: get_home(int *free_it)
! 1517: {
! 1518: #ifdef WINCE
! 1519: return ".";
! 1520: #else
! 1521: #ifndef macintosh /* getenv() for Mac ? */
! 1522: char *drv, *pth = getenv("HOME");
! 1523: if (pth) return pth;
! 1524: if ((drv = getenv("HOMEDRIVE"))
! 1525: && (pth = getenv("HOMEPATH")))
! 1526: { /* looks like WinNT */
! 1527: char *buf = gpmalloc(strlen(pth) + strlen(drv) + 1);
! 1528: sprintf(buf, "%s%s",drv,pth);
! 1529: *free_it = 1; return buf;
! 1530: }
! 1531: #endif
! 1532: #endif
! 1533: #if defined(__EMX__) || defined(UNIX)
! 1534: {
! 1535: struct passwd *p = getpwuid(geteuid());
! 1536: if (p) return p->pw_dir;
! 1537: }
! 1538: #endif
! 1539: return ".";
! 1540: }
! 1541:
! 1542: static FILE *
! 1543: gprc_chk(char *s)
! 1544: {
! 1545: FILE *f = fopen(s, "r");
! 1546: if (f && !quiet_mode) fprintferr("Reading GPRC: %s ...", s);
! 1547: return f;
! 1548: }
! 1549:
! 1550: /* Look for [._]gprc: $GPRC, then in $HOME, /, C:/ */
! 1551: static FILE *
! 1552: gprc_get()
! 1553: {
! 1554: FILE *f = NULL;
! 1555: char *str, *s, c;
! 1556: long l;
! 1557: #ifdef macintosh
! 1558: f = gprc_chk("gprc");
! 1559: #else
! 1560: #ifdef WINCE
! 1561: s = NULL;
! 1562: #else
! 1563: s = getenv("GPRC");
! 1564: #endif
! 1565: if (s) f = gprc_chk(s);
! 1566: if (!f)
! 1567: {
! 1568: int free_it = 0;
! 1569: s = get_home(&free_it); l = strlen(s); c = s[l-1];
! 1570: str = strcpy(gpmalloc(l+7), s);
! 1571: if (free_it) free(s);
! 1572: s = str + l;
! 1573: if (c != '/' && c != '\\') *s++ = '/';
! 1574: #ifdef UNIX
! 1575: *s = '.'; /* .gprc */
! 1576: #else
! 1577: *s = '_'; /* _gprc */
! 1578: #endif
! 1579: strcpy(s+1, "gprc");
! 1580: f = gprc_chk(str); /* in $HOME */
! 1581: if (!f) f = gprc_chk(s); /* in . */
! 1582: if (!f) f = gprc_chk("/etc/gprc");
! 1583: if (!f) f = gprc_chk("C:/_gprc");
! 1584: free(str);
! 1585: }
! 1586: #endif
! 1587: return f;
! 1588: }
! 1589:
! 1590: static int
! 1591: init_brace(char *s)
! 1592: {
! 1593: while (isspace((int)*s)) s++;
! 1594: if (*s == LBRACE) { *s=' '; return 1; }
! 1595: return 0;
! 1596: }
! 1597:
! 1598: /* return 1 if we deleted a '{' */
! 1599: static int
! 1600: init_filtre(char *s)
! 1601: {
! 1602: if (filtre(s, f_INIT)) return 0; /* in comment */
! 1603: return init_brace(s);
! 1604: }
! 1605:
! 1606: static void
! 1607: fix_buffer(long newlbuf, char **ptbuf, long *ptlbuf)
! 1608: {
! 1609: buflist[bufindex] = *ptbuf = gprealloc(*ptbuf,newlbuf,*ptlbuf);
! 1610: *ptlbuf = paribufsize = newlbuf;
! 1611: }
! 1612:
! 1613: /* prompt = NULL --> from gprc */
! 1614: static int
! 1615: get_line_from_file(FILE *file, char **ptbuf, long *ptlbuf, char *prompt)
! 1616: {
! 1617: int f_flag = prompt? f_REG | f_KEEPCASE: f_REG;
! 1618: int wait_for_brace;
! 1619: long len = *ptlbuf;
! 1620: char *s = *ptbuf;
! 1621:
! 1622: if (!fgets(s, len, file)) return 0;
! 1623: wait_for_brace = init_filtre(s);
! 1624: for(;;)
! 1625: {
! 1626: int read_more = (s[strlen(s)-1] != '\n');
! 1627: char *end = filtre(s, f_flag);
! 1628: if (*s)
! 1629: {
! 1630: if (read_more) s = end;
! 1631: else if (end[-1] == '\\')
! 1632: {
! 1633: if (*s=='?') break;
! 1634: s = end-1;
! 1635: }
! 1636: else if (end[-1] == '='&& *s != '?')
! 1637: {
! 1638: s = end;
! 1639: }
! 1640: else
! 1641: {
! 1642: if (!wait_for_brace) break;
! 1643: if (end[-1] == RBRACE) {end[-1]=0; break;}
! 1644: s = end;
! 1645: }
! 1646: len = *ptlbuf - (s - *ptbuf);
! 1647: if (len < 512)
! 1648: {
! 1649: long n = *ptlbuf << 1, l = s - *ptbuf;
! 1650: len += *ptlbuf;
! 1651: fix_buffer(n, ptbuf, ptlbuf);
! 1652: s = *ptbuf + l;
! 1653: }
! 1654: }
! 1655: if (!fgets(s, len, file)) break;
! 1656: if (!read_more && !wait_for_brace)
! 1657: wait_for_brace = init_filtre(s);
! 1658: }
! 1659: if (prompt && *ptbuf)
! 1660: {
! 1661: if (pariecho) { pariputs(prompt); pariputs(*ptbuf); pariputc('\n'); }
! 1662: else if (logfile) fprintf(logfile, "%s%s\n",prompt,*ptbuf);
! 1663: pariflush();
! 1664: }
! 1665: return 1;
! 1666: }
! 1667:
! 1668: #define err_gprc(s,t,u) { fprintferr("\n"); err(talker2,s,t,u); }
! 1669:
! 1670: static char **
! 1671: gp_initrc()
! 1672: {
! 1673: char **flist, *buf, *s,*s1,*s2;
! 1674: FILE *file = gprc_get();
! 1675: long fnum = 4, find = 0, *ptlbuf = &paribufsize;
! 1676:
! 1677: if (!file) return NULL;
! 1678: flist = (char **) gpmalloc(fnum * sizeof(char*));
! 1679: buflist[++bufindex] = buf = gpmalloc(*ptlbuf);
! 1680: for(;;)
! 1681: {
! 1682: if (! get_line_from_file(file, &buf, ptlbuf, NULL))
! 1683: {
! 1684: if (!quiet_mode) fprintferr("Done.\n\n");
! 1685: fclose(file); free(buflist[bufindex--]);
! 1686: flist[find] = NULL; return flist;
! 1687: }
! 1688: for (s = buf; *s; )
! 1689: {
! 1690: s1 = s; if (get_sep2(s)) s++;
! 1691: s += strlen(s1); /* point to next expr */
! 1692: if (*s1 == '#')
! 1693: { /* preprocessor directive */
! 1694: int z, NOT = 0;
! 1695: s1++;
! 1696: if (strncmp(s1,"if",2)) err_gprc("unknown directive",s1,buf);
! 1697: s1 += 2;
! 1698: if (!strncmp(s1,"not",3)) { NOT = !NOT; s1 += 3; }
! 1699: if (*s1 == '!') { NOT = !NOT; s1++; }
! 1700: z = get_preproc_value(s1);
! 1701: if (z < 0) err_gprc("unknown preprocessor variable",s1,buf);
! 1702: if (NOT) z = !z;
! 1703: if (!z) continue;
! 1704: s1 += 5;
! 1705: }
! 1706: if (!strncmp(s1,"read",4))
! 1707: { /* read file */
! 1708: s1 += 4;
! 1709: if (find == fnum-1)
! 1710: {
! 1711: long n = fnum << 1;
! 1712: flist = (char**)gprealloc(flist, n*sizeof(char*),
! 1713: fnum*sizeof(char*));
! 1714: fnum = n;
! 1715: }
! 1716: flist[find++] = s2 = gpmalloc(strlen(s1) + 1);
! 1717: if (*s1 == '"') (void)readstring(s1, s2);
! 1718: else strcpy(s2,s1);
! 1719: }
! 1720: else
! 1721: { /* set default */
! 1722: s2 = s1; while (*s2 && *s2 != '=') s2++;
! 1723: if (*s2 != '=') err_gprc("missing '='",s2,buf);
! 1724: *s2++ = 0;
! 1725: if (*s2 == '"') (void)readstring(s2, s2);
! 1726: setdefault(s1,s2,d_INITRC);
! 1727: }
! 1728: }
! 1729: }
! 1730: }
! 1731:
! 1732: /********************************************************************/
! 1733: /* */
! 1734: /* GP MAIN LOOP */
! 1735: /* */
! 1736: /********************************************************************/
! 1737: /* flag:
! 1738: * ti_NOPRINT don't print
! 1739: * ti_REGULAR print elapsed time (chrono = 1)
! 1740: * ti_LAST print last elapsed time (##)
! 1741: * ti_INTERRUPT received a SIGINT
! 1742: */
! 1743: static char *
! 1744: do_time(long flag)
! 1745: {
! 1746: static long last = 0;
! 1747: long delay = (flag == ti_LAST)? last: gptimer();
! 1748: char *s;
! 1749:
! 1750: last = delay;
! 1751: switch(flag)
! 1752: {
! 1753: case ti_NOPRINT: return NULL;
! 1754: case ti_REGULAR: s = "time = "; break;
! 1755: case ti_INTERRUPT: s = "user interrupt after "; break;
! 1756: case ti_LAST: s = " *** last result computed in "; break;
! 1757: }
! 1758: strcpy(thestring,s); s=thestring+strlen(s);
! 1759: strcpy(s, term_get_color(c_TIME)); s+=strlen(s);
! 1760: if (delay >= 3600000)
! 1761: {
! 1762: sprintf(s, "%ldh, ", delay / 3600000); s+=strlen(s);
! 1763: delay %= 3600000;
! 1764: }
! 1765: if (delay >= 60000)
! 1766: {
! 1767: sprintf(s, "%ldmn, ", delay / 60000); s+=strlen(s);
! 1768: delay %= 60000;
! 1769: }
! 1770: if (delay >= 1000)
! 1771: {
! 1772: sprintf(s, "%ld,", delay / 1000); s+=strlen(s);
! 1773: delay %= 1000;
! 1774: if (delay < 100)
! 1775: {
! 1776: sprintf(s, "%s", (delay<10)? "00": "0");
! 1777: s+=strlen(s);
! 1778: }
! 1779: }
! 1780: sprintf(s, "%ld ms", delay); s+=strlen(s);
! 1781: strcpy(s, term_get_color(c_NONE));
! 1782: if (flag != ti_INTERRUPT) { s+=strlen(s); *s++='.'; *s++='\n'; *s=0; }
! 1783: return thestring;
! 1784: }
! 1785:
! 1786: #ifndef WINCE
! 1787: static void
! 1788: gp_sighandler(int sig)
! 1789: {
! 1790: char *msg;
! 1791: switch(sig)
! 1792: {
! 1793: case SIGINT:
! 1794: #ifdef _WIN32
! 1795: # ifdef SIGBREAK
! 1796: case SIGBREAK:
! 1797: # endif
! 1798: if (++win32ctrlc >= 5) _exit(3);
! 1799: signal(sig,gp_sighandler);
! 1800: return;
! 1801: #endif
! 1802: msg = do_time(ti_INTERRUPT);
! 1803: break;
! 1804:
! 1805: case SIGSEGV:
! 1806: msg="segmentation fault: bug in GP (please report)";
! 1807: break;
! 1808:
! 1809: #ifdef SIGBUS
! 1810: case SIGBUS:
! 1811: msg="bus error: bug in GP (please report)";
! 1812: break;
! 1813: #endif
! 1814: default:
! 1815: msg="bug in signal handling (please report)";
! 1816: }
! 1817: signal(sig,gp_sighandler);
! 1818: err(talker,msg);
! 1819: }
! 1820: #endif
! 1821: static void
! 1822: brace_color(char *s, int c)
! 1823: {
! 1824: if (gp_colors[c] == c_NONE) return;
! 1825: #ifdef RL_PROMPT_START_IGNORE
! 1826: *s++ = RL_PROMPT_START_IGNORE;
! 1827: #endif
! 1828: strcpy(s, term_get_color(c));
! 1829: #ifdef RL_PROMPT_START_IGNORE
! 1830: s+=strlen(s);
! 1831: *s++ = RL_PROMPT_END_IGNORE; *s = 0;
! 1832: #endif
! 1833: }
! 1834:
! 1835: static char *
! 1836: do_prompt()
! 1837: {
! 1838: static char buf[MAX_PROMPT_LEN + 24]; /* + room for color codes */
! 1839: char *s = buf;
! 1840:
! 1841: *s = 0;
! 1842: /* escape sequences bug readline, so use special bracing (if available) */
! 1843: brace_color(s, c_PROMPT);
! 1844: s += strlen(s);
! 1845: if (filtre(s, f_COMMENT))
! 1846: strcpy(s, COMMENTPROMPT);
! 1847: else
! 1848: do_strftime(prompt,s);
! 1849: s += strlen(s);
! 1850: brace_color(s, c_INPUT); return buf;
! 1851: }
! 1852:
! 1853: static int
! 1854: read_line(char *promptbuf, char **ptbuf, long *ptlbuf)
! 1855: {
! 1856: if (infile == stdin /* interactive use */
! 1857: #if defined(UNIX) || defined(__EMX__)
! 1858: && (under_emacs || isatty(fileno(stdin)))
! 1859: #endif
! 1860: )
! 1861: {
! 1862: #ifdef READLINE
! 1863: static char *previous_hist = NULL;
! 1864: char *rlbuffer = readline(promptbuf), *s = *ptbuf;
! 1865: int wait_for_brace, wait_for_input;
! 1866:
! 1867: if (!rlbuffer) { pariputs("\n"); return 0; } /* EOF */
! 1868: wait_for_input = wait_for_brace = init_filtre(rlbuffer);
! 1869: for(;;)
! 1870: {
! 1871: long len = s - *ptbuf;
! 1872: char *end = filtre(rlbuffer, f_READL);
! 1873: long l = end - rlbuffer;
! 1874:
! 1875: if (len + l > *ptlbuf)
! 1876: {
! 1877: fix_buffer(len+l+1, ptbuf, ptlbuf);
! 1878: s = *ptbuf + len;
! 1879: }
! 1880: strcpy(s,rlbuffer); free(rlbuffer);
! 1881: if (!*s) { if (!wait_for_input) break; }
! 1882: else
! 1883: {
! 1884: s += l-1; /* *s = last input char */
! 1885: if (wait_for_brace && *s == RBRACE) {*s=0; break;}
! 1886: if (*s == '\\')
! 1887: {
! 1888: if (*rlbuffer == '?') break;
! 1889: }
! 1890: else if (*s == '=' && s[1-l] != '?')
! 1891: {
! 1892: wait_for_input = 1; s++;
! 1893: }
! 1894: else
! 1895: {
! 1896: if (!wait_for_brace) break;
! 1897: s++;
! 1898: }
! 1899: }
! 1900: /* read continuation line */
! 1901: if (!(rlbuffer = readline(""))) break;
! 1902: if (wait_for_input && !wait_for_brace)
! 1903: wait_for_brace = init_brace(rlbuffer);
! 1904: }
! 1905: /* bug in readline 2.0: need to unblock ^C */
! 1906: # ifdef USE_SIGRELSE
! 1907: sigrelse(SIGINT);
! 1908: # elif USE_SIGSETMASK
! 1909: sigsetmask(0);
! 1910: # endif
! 1911: s = *ptbuf;
! 1912: if (*s)
! 1913: {
! 1914: /* update history (don't add the same entry twice) */
! 1915: if (!previous_hist || strcmp(s,previous_hist))
! 1916: {
! 1917: if (previous_hist) free(previous_hist);
! 1918: previous_hist = pari_strdup(s); add_history(s);
! 1919: }
! 1920: /* update logfile */
! 1921: if (logfile) fprintf(logfile, "%s%s\n",promptbuf,s);
! 1922: }
! 1923: return 1;
! 1924: #else
! 1925: pariputs(promptbuf);
! 1926: #endif /* defined(READLINE) */
! 1927: }
! 1928: else promptbuf = DFT_PROMPT;
! 1929: return get_line_from_file(infile, ptbuf, ptlbuf, promptbuf);
! 1930: }
! 1931:
! 1932: static void
! 1933: chron(char *s)
! 1934: {
! 1935: if (*s)
! 1936: {
! 1937: char *old = s-1;
! 1938: if (*s == '#') { pariputs(do_time(ti_LAST)); s++; }
! 1939: if (*s) err(caracer1,s,old);
! 1940: }
! 1941: else { chrono = 1-chrono; sd_timer("",d_ACKNOWLEDGE); }
! 1942: }
! 1943:
! 1944: /* bufindex != 0: we are doing an immediate read (with read, extern...) */
! 1945: static GEN
! 1946: gp_main_loop()
! 1947: {
! 1948: long av, i,j, lbuf = paribufsize;
! 1949: char *buf, *promptbuf = prompt;
! 1950: GEN z = gnil;
! 1951:
! 1952: if (bufindex == MAX_BUFFER) err(talker,"too many nested files");
! 1953: buflist[++bufindex] = buf = (char *) gpmalloc(lbuf);
! 1954: for(;;)
! 1955: {
! 1956: if (! bufindex)
! 1957: {
! 1958: static long tloc, outtyp;
! 1959: tloc = tglobal; outtyp = prettyp; recover(0);
! 1960: if (setjmp(environnement))
! 1961: {
! 1962: avma = top; parisize = top - bot;
! 1963: j = tglobal - tloc; i = (tglobal-1)%histsize;
! 1964: while (j)
! 1965: {
! 1966: gunclone(hist[i]); hist[i]=NULL;
! 1967: if (!i) i = histsize;
! 1968: i--; j--;
! 1969: }
! 1970: tglobal = tloc; prettyp = outtyp;
! 1971: while (bufindex) free((void *)buflist[bufindex--]);
! 1972: killallfiles(0);
! 1973: }
! 1974: }
! 1975: setjmp(local_environnement[bufindex]);
! 1976: added_newline = 1;
! 1977: if (paribufsize != lbuf)
! 1978: fix_buffer(paribufsize, &buf, &lbuf);
! 1979:
! 1980: for(;;)
! 1981: {
! 1982: if (! test_mode) promptbuf = do_prompt();
! 1983: if (! read_line(promptbuf, &buf, &lbuf))
! 1984: {
! 1985: #ifdef _WIN32
! 1986: Sleep(10); if (win32ctrlc) dowin32ctrlc();
! 1987: #endif
! 1988: if (popinfile()) gp_quit();
! 1989: if (bufindex) { free(buflist[bufindex--]); return z; }
! 1990: }
! 1991: else switch(*buf)
! 1992: {
! 1993: case '?': aide(buf+1, h_REGULAR); break;
! 1994: case '#': chron(buf+1); break;
! 1995: case '\\': escape(buf+1); break;
! 1996: case '\0': break;
! 1997: default: goto WORK;
! 1998: }
! 1999: }
! 2000: WORK:
! 2001: if (! bufindex)
! 2002: {
! 2003: char c = buf[strlen(buf) - 1];
! 2004: gpsilent = separe(c);
! 2005: }
! 2006: if (bufindex == 0) (void)gptimer();
! 2007: av = avma;
! 2008: z = readseq(buf, strictmatch);
! 2009: if (!added_newline) pariputc('\n'); /* last output was print1() */
! 2010: if (bufindex) continue;
! 2011: if (chrono) pariputs(do_time(ti_REGULAR)); else do_time(ti_NOPRINT);
! 2012: if (z == gnil) continue;
! 2013:
! 2014: if (simplifyflag) z = simplify(z);
! 2015: i = tglobal % histsize; tglobal++;
! 2016: if (hist[i]) gunclone(hist[i]);
! 2017: hist[i] = z = gclone(z); avma = av;
! 2018: if (gpsilent) continue;
! 2019:
! 2020: if (test_mode) { init80(0); gp_output(z); }
! 2021: else
! 2022: {
! 2023: PariOUT *old = pariOut;
! 2024: if (DEBUGLEVEL > 4) fprintferr("prec = [%ld, %ld]\n", prec,precdl);
! 2025: term_color(c_HIST);
! 2026: sprintf(thestring, "%%%ld = ",tglobal);
! 2027: pariputs_opt(thestring);
! 2028: term_color(c_OUTPUT);
! 2029: init_lim_lines(thestring,lim_lines);
! 2030: gp_output(z); pariOut=old;
! 2031: term_color(c_NONE);
! 2032: }
! 2033: pariputc('\n'); pariflush();
! 2034: }
! 2035: }
! 2036:
! 2037: GEN
! 2038: read0(char *s)
! 2039: {
! 2040: switchin(s);
! 2041: return gp_main_loop();
! 2042: }
! 2043:
! 2044: static void
! 2045: check_secure(char *s)
! 2046: {
! 2047: if (secure)
! 2048: err(talker, "secure mode: system commands not allowed\nTried to run '%s'",s);
! 2049: }
! 2050:
! 2051: GEN
! 2052: extern0(char *s)
! 2053: {
! 2054: check_secure(s);
! 2055: infile = try_pipe(s, mf_IN)->file;
! 2056: return gp_main_loop();
! 2057: }
! 2058:
! 2059: static int
! 2060: silent()
! 2061: {
! 2062: if (gpsilent) return 1;
! 2063: { char c = _analyseur()[1]; return separe(c); }
! 2064: }
! 2065:
! 2066: GEN
! 2067: default0(char *a, char *b, long flag)
! 2068: {
! 2069: if (flag) flag=d_RETURN;
! 2070: else
! 2071: flag = silent()? d_SILENT: d_ACKNOWLEDGE;
! 2072: return setdefault(a,b,flag);
! 2073: }
! 2074:
! 2075: void
! 2076: allocatemem0(unsigned long newsize)
! 2077: {
! 2078: parisize = allocatemoremem(newsize);
! 2079: longjmp(local_environnement[bufindex], 0);
! 2080: }
! 2081:
! 2082: GEN
! 2083: input0()
! 2084: {
! 2085: long *ptlbuf = &paribufsize;
! 2086: char *buf;
! 2087: GEN x;
! 2088:
! 2089: if (bufindex == MAX_BUFFER) err(talker,"too many nested files");
! 2090: buflist[++bufindex] = buf = gpmalloc(*ptlbuf);
! 2091: while (! get_line_from_file(infile, &buf, ptlbuf, DFT_INPROMPT))
! 2092: if (popinfile()) { fprintferr("no input ???"); gp_quit(); }
! 2093: x = lisseq(buf);
! 2094: free(buflist[bufindex--]);
! 2095: return x;
! 2096: }
! 2097:
! 2098: void
! 2099: system0(char *s)
! 2100: {
! 2101: #if defined(UNIX) || defined(__EMX__)
! 2102: check_secure(s);
! 2103: system(s);
! 2104: #else
! 2105: err(archer);
! 2106: #endif
! 2107: }
! 2108:
! 2109: void
! 2110: error0(GEN *g)
! 2111: {
! 2112: term_color(c_ERR);
! 2113: if (!added_newline) pariputc('\n');
! 2114: pariputs("### User error:\n\n ");
! 2115: print0(g,f_RAW); term_color(c_NONE);
! 2116: err_recover(talker);
! 2117: }
! 2118:
! 2119: long
! 2120: setprecr(long n)
! 2121: {
! 2122: long m = fmt.nb;
! 2123:
! 2124: if (n>0) {fmt.nb = n; prec = (long)(n*pariK1 + 3);}
! 2125: return m;
! 2126: }
! 2127:
! 2128: static void
! 2129: testint(char *s, long *d)
! 2130: {
! 2131: if (!s) return;
! 2132: *d = atol(s);
! 2133: if (*d <= 0) err(talker,"arguments must be positive integers");
! 2134: }
! 2135:
! 2136: static char *
! 2137: read_arg(int *nread, char *t, long argc, char **argv)
! 2138: {
! 2139: int i = *nread;
! 2140: if (isdigit((int)*t)) return t;
! 2141: if (*t || i==argc) usage(argv[0]);
! 2142: *nread = i+1; return argv[i];
! 2143: }
! 2144:
! 2145: static char**
! 2146: read_opt(long argc, char **argv)
! 2147: {
! 2148: char *b=NULL, *p=NULL, *s=NULL, **pre=(char**)1;
! 2149: int i=1;
! 2150:
! 2151: pari_outfile=stderr;
! 2152: while (i<argc)
! 2153: {
! 2154: char *t = argv[i++];
! 2155:
! 2156: if (*t++ != '-') usage(argv[0]);
! 2157: switch(*t++)
! 2158: {
! 2159: case 'b': b = read_arg(&i,t,argc,argv); break;
! 2160: case 'p': p = read_arg(&i,t,argc,argv); break;
! 2161: case 's': s = read_arg(&i,t,argc,argv); break;
! 2162:
! 2163: case 'e':
! 2164: if (strncmp(t,"macs",4)) usage(argv[0]);
! 2165: under_emacs = 1; break;
! 2166: case 'q':
! 2167: quiet_mode = 1; break;
! 2168: case 't':
! 2169: if (strncmp(t,"est",3)) usage(argv[0]);
! 2170: disable_color = 1; test_mode = 1; /* fall through */
! 2171: case 'f':
! 2172: pre = NULL; break;
! 2173: case '-':
! 2174: if (strcmp(t, "version") == 0) {
! 2175: print_version();
! 2176: exit(0);
! 2177: }
! 2178: /* fall through */
! 2179: default:
! 2180: usage(argv[0]);
! 2181: }
! 2182: }
! 2183: if (pre) pre = gp_initrc();
! 2184:
! 2185: /* override the values from gprc */
! 2186: testint(b, &paribufsize); if (paribufsize < 10) paribufsize = 10;
! 2187: testint(p, &primelimit);
! 2188: testint(s, &parisize);
! 2189: if (under_emacs) disable_color=1;
! 2190: pari_outfile=stdout; return pre;
! 2191: }
! 2192:
! 2193: #ifdef WINCE
! 2194: int
! 2195: WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance,
! 2196: LPWSTR lpCmdLine, int nShowCmd)
! 2197: {
! 2198: char **argv = NULL;
! 2199: int argc = 1;
! 2200: #else
! 2201: int
! 2202: main(int argc, char **argv)
! 2203: {
! 2204: #endif
! 2205: char **flist;
! 2206:
! 2207: init_defaults(1); gp_preinit(1);
! 2208: if (setjmp(environnement))
! 2209: {
! 2210: pariputs("### Errors on startup, exiting...\n\n");
! 2211: exit(1);
! 2212: }
! 2213: #ifdef __MWERKS__
! 2214: argc = ccommand(&argv);
! 2215: #endif
! 2216: flist = read_opt(argc,argv);
! 2217: pari_addfunctions(&pari_modules, functions_gp,helpmessages_gp);
! 2218: pari_addfunctions(&pari_modules, functions_highlevel,helpmessages_highlevel);
! 2219: pari_addfunctions(&pari_oldmodules, functions_oldgp,helpmessages_oldgp);
! 2220:
! 2221: init_graph(); INIT_SIG_off;
! 2222: pari_init(parisize, primelimit);
! 2223: #ifndef WINCE
! 2224: pari_sig_init(gp_sighandler);
! 2225: #endif
! 2226: #ifdef READLINE
! 2227: init_readline();
! 2228: #endif
! 2229: gp_history_fun = gp_history;
! 2230: whatnow_fun = whatnow;
! 2231: gp_expand_path(path);
! 2232:
! 2233: if (!quiet_mode) gp_head();
! 2234: if (flist)
! 2235: {
! 2236: long c=chrono, b=bufindex, e=pariecho;
! 2237: FILE *l=logfile;
! 2238: char **s = flist;
! 2239: bufindex = 0; chrono=0; pariecho=0; logfile=NULL;
! 2240: for ( ; *s; s++) { read0(*s); free(*s); }
! 2241: bufindex = b; chrono=c; pariecho=e; logfile=l; free(flist);
! 2242: }
! 2243: gptimer(); timer2();
! 2244: (void)gp_main_loop();
! 2245: gp_quit(); return 0; /* not reached */
! 2246: }
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 / src / gp