Annotation of OpenXM_contrib/pari-2.2/src/language/init.c, Revision 1.2
1.2 ! noro 1: /* $Id: init.c,v 1.164 2002/09/11 02:28:27 karim Exp $
1.1 noro 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: /* INITIALIZING THE SYSTEM, ERRORS */
19: /* */
20: /*******************************************************************/
21: #include <string.h>
22: #include "pari.h"
23: #include "anal.h"
24: #ifdef _WIN32
25: # ifndef WINCE
26: # include <process.h>
27: # endif
28: #endif
29:
30: /* Variables statiques communes : */
31: FILE *pari_outfile, *errfile, *logfile, *infile;
32: GEN *polun, *polx;
33: GEN gnil, gzero, gun, gdeux, ghalf, polvar, gi;
34: GEN gpi=NULL, geuler=NULL, bernzone=NULL;
35: GEN primetab; /* private primetable */
36: byteptr diffptr;
37: char *current_logfile, *current_psfile;
38: int gp_colors[c_LAST];
39: int disable_color = 1, added_newline = 1;
40:
41: int functions_tblsz = 135; /* size of functions_hash */
42: entree **varentries;
43:
44: void *global_err_data;
45: jmp_buf environnement;
46: long *ordvar;
1.2 ! noro 47: ulong DEBUGFILES, DEBUGLEVEL, DEBUGMEM, compatible;
! 48: ulong prec, precdl;
1.1 noro 49: ulong init_opts = INIT_JMPm | INIT_SIGm;
1.2 ! noro 50: gpmem_t bot = 0, top = 0, avma;
! 51: size_t memused;
! 52:
! 53: gp_data *GP_DATA = NULL;
1.1 noro 54:
55: void *foreignHandler; /* Handler for foreign commands. */
56: char foreignExprSwitch = 3; /* Just some unprobable char. */
57: GEN (*foreignExprHandler)(char*); /* Handler for foreign expressions.*/
58: entree * (*foreignAutoload)(char*, long); /* Autoloader */
59: void (*foreignFuncFree)(entree *); /* How to free external entree. */
60:
61: int (*default_exception_handler)(long);
62: int (*whatnow_fun)(char *, int);
1.2 ! noro 63: pariout_t DFLT_OUTPUT = { 'g', 0, -1, 1, 0, f_RAW };
1.1 noro 64:
1.2 ! noro 65: extern void delete_dirs(gp_path *p);
1.1 noro 66: extern void initout(int initerr);
67: extern int term_width(void);
68:
1.2 ! noro 69: #ifdef BOTH_GNUPLOT_AND_X11
! 70: /* Satisfy DLL dependencies: dummy only */
! 71: #define EXTERM_DLL_DPES *PL_markstack_ptr, PL_stack_max, *PL_Sv, *PL_stack_sp, \
! 72: *PL_tmps_floor, *PL_tmps_ix, *PL_markstack_max, *PL_stack_base, *PL_na, \
! 73: *PL_sv_yes, *PL_sv_no, *PL_curpad, *PL_op
! 74: extern int EXTERM_DLL_DPES;
! 75: int EXTERM_DLL_DPES;
! 76: #endif /* defined BOTH_GNUPLOT_AND_X11 */
! 77:
1.1 noro 78: typedef struct cell {
79: void *env;
80: void *data;
81: long flag;
82: } cell;
83:
84: static stack *err_catch_stack = NULL;
85: static long *err_catch_array;
86:
87: void
88: push_stack(stack **pts, void *a)
89: {
90: stack *v = (stack*) gpmalloc(sizeof(stack));
91: v->value = a;
92: v->prev = *pts; *pts = v;
93: }
94:
95: void *
96: pop_stack(stack **pts)
97: {
98: stack *s = *pts, *v;
99: void *a;
100: if (!s) return NULL; /* initial value */
101: v = s->prev; *pts = v;
102: a = s->value; free((void*)s);
103: return a;
104: }
105:
106: #ifdef STACK_CHECK
107: /*********************************************************************/
108: /* */
109: /* C STACK SIZE CONTROL */
110: /* (to avoid core dump on deep recursion) */
111: /* */
112: /*********************************************************************/
113:
114: /* adapted from Perl code written by Dominic Dunlop */
115: #include <sys/resource.h>
116: void *PARI_stack_limit = NULL;
117:
118: /* Set PARI_stack_limit to (a little above) the lowest safe address that can
119: * be used on the stack. Leave PARI_stack_limit at its initial value (NULL)
120: * to show no check should be made [init failed]. Assume stack grows downward.
121: */
122: static void
123: pari_init_stackcheck(void *stack_base)
124: {
125: struct rlimit rip;
126:
127: if (getrlimit(RLIMIT_STACK, &rip) || rip.rlim_cur == RLIM_INFINITY) return;
128: /* DEC cc doesn't like this line:
129: * PARI_stack_limit = stack_base - ((rip.rlim_cur/16)*15); */
130: PARI_stack_limit = (void*)((long)stack_base - (rip.rlim_cur/16)*15);
131: }
132: #endif /* STACK_CHECK */
133:
134: /*********************************************************************/
135: /* */
136: /* SYSTEM INITIALIZATION */
137: /* */
138: /*********************************************************************/
139: static int var_not_changed; /* altered in reorder() */
140: static int try_to_recover = 0;
141: static long next_bloc;
142: static GEN cur_bloc=NULL; /* current bloc in bloc list */
1.2 ! noro 143: static GEN universal_constants;
! 144:
! 145: #if __MWERKS__
! 146: static void *
! 147: macalloc(size_t size)
! 148: {
! 149: OSErr resultCode;
! 150: Handle newH = TempNewHandle((size),&resultCode);
! 151: if (!newH) return NULL;
! 152: HLock(newH); return (void*) *newH;
! 153: }
! 154: # define __gpmalloc(size) ((size) > 1000000)? macalloc(size): malloc((size))
! 155: #else
! 156: # define __gpmalloc(size) (malloc(size))
! 157: #endif
! 158:
! 159: char*
! 160: gpmalloc(size_t size)
! 161: {
! 162: if (size)
! 163: {
! 164: char *tmp = (char*)__gpmalloc(size);
! 165: if (!tmp) err(memer);
! 166: return tmp;
! 167: }
! 168: if (DEBUGMEM) err(warner,"mallocing NULL object");
! 169: return NULL;
! 170: }
! 171:
! 172: char*
! 173: gprealloc(void *pointer, size_t size)
! 174: {
! 175: char *tmp;
! 176:
! 177: if (!pointer) tmp = (char *) malloc(size);
! 178: else tmp = (char *) realloc(pointer,size);
! 179: if (!tmp) err(memer);
! 180: return tmp;
! 181: }
1.1 noro 182:
183: static void
1.2 ! noro 184: pari_handle_SIGINT(void)
1.1 noro 185: {
186: #ifdef _WIN32
187: if (++win32ctrlc >= 5) _exit(3);
188: #else
189: err(talker, "user interrupt");
190: #endif
191: }
192:
193: static void
194: pari_sighandler(int sig)
195: {
196: char *msg;
1.2 ! noro 197: (void)os_signal(sig,pari_sighandler);
1.1 noro 198: switch(sig)
199: {
200: #ifdef SIGBREAK
201: case SIGBREAK: pari_handle_SIGINT(); return;
202: #endif
203: #ifdef SIGINT
204: case SIGINT: pari_handle_SIGINT(); return;
205: #endif
206:
207: #ifdef SIGSEGV
208: case SIGSEGV:
209: msg="segmentation fault: bug in PARI or calling program";
210: break;
211: #endif
212:
213: #ifdef SIGBUS
214: case SIGBUS:
215: msg="bus error: bug in PARI or calling program";
216: break;
217: #endif
218:
219: #ifdef SIGFPE
220: case SIGFPE:
221: msg="floating point exception: bug in PARI or calling program";
222: break;
223: #endif
224:
225: #ifdef SIGPIPE
226: case SIGPIPE:
227: msg="broken pipe";
228: break;
229: #endif
230:
231: default:
232: msg="unknown signal";
233: }
234: err(talker,msg);
235: }
236:
237: #ifdef _WIN32
238: int win32ctrlc = 0;
239:
240: void
241: dowin32ctrlc()
242: {
243: win32ctrlc = 0;
244: err(talker,"user interrupt");
245: }
246: #endif
247:
248: /* Initialize hashtable */
249: static void
250: init_hashtable(entree **table, int tblsz)
251: {
252: entree *ep, *ep1, *last;
253: long i, v;
254:
255: for (i = 0; i < tblsz; i++)
256: {
257: last = NULL; ep = table[i]; table[i] = NULL;
258: for ( ; ep; ep = ep1)
259: {
260: ep1 = ep->next; v = EpVALENCE(ep);
261: if (v == EpVAR || v == EpINSTALL) /* keep this one */
262: {
263: if (last)
264: last->next = ep;
265: else
266: table[i] = ep;
267: last = ep; last->next = NULL;
268: }
269: else freeep(ep);
270: }
271: }
272: }
273:
274: static void
275: fill_hashtable(entree **table, entree *ep, char **helpmessage)
276: {
277: long n;
278:
279: for ( ; ep->name; ep++)
280: {
281: EpSETSTATIC(ep);
282: ep->help = helpmessage? *helpmessage++: NULL;
283: n = hashvalue(ep->name);
284: ep->next = table[n]; table[n] = ep;
285: ep->args = NULL;
286: }
287: }
288:
289: void
290: init_defaults(int force)
291: {
292: static int done=0;
293:
294: if (done && !force) return;
295: done = 1;
296:
297: #ifdef LONG_IS_64BIT
298: prec=4;
299: #else
300: prec=5;
301: #endif
302:
303: precdl = 16;
304: compatible = NONE;
305: DEBUGFILES = DEBUGLEVEL = DEBUGMEM = 0;
306:
307: current_psfile = pari_strdup("pari.ps");
308: current_logfile= pari_strdup("pari.log");
309: logfile = NULL;
310: initout(1); next_bloc=0;
311: }
312:
313: /* does elt belong to list, after position start (excluded) ? */
314: static int
315: list_isin(void **list, void *elt, int start)
316: {
317: long indelt=0;
318:
319: if (list)
320: {
321: while (*list)
322: {
323: if (indelt>start && *list==elt) return indelt;
324: list++; indelt++;
325: }
326: }
327: return -1;
328: }
329:
330: static void
331: list_prepend(void ***listptr, void *elt)
332: {
333: void **list=*listptr;
334: long nbelt=0;
335:
336: if (list)
337: while (list[nbelt]) nbelt++;
338: list = (void **) gpmalloc(sizeof(void *)*(nbelt+2));
339: list[0]=elt;
340: if (nbelt)
341: {
342: memcpy(list+1,*listptr,nbelt*sizeof(void *));
343: free(*listptr);
344: }
345: list[nbelt+1]=NULL; *listptr=list;
346: }
347:
348: /* Load modlist in hashtable hash. If force == 0, do not load twice the
349: * same list in the same hashtable, which would only destroy user variables.
350: * As it stands keep a complete history (instead of most recent changes).
351: */
352: int
353: gp_init_entrees(module *modlist, entree **hash, int force)
354: {
355: static void **oldmodlist=NULL, **oldhash=NULL;
356:
357: if (!force)
358: {
359: const long indhash = list_isin(oldhash,(void *)hash,-1);
360: if (indhash != -1 && oldmodlist[indhash]==modlist) return 0;
361: }
362: /* record the new pair (hash,modlist) */
363: list_prepend(&oldmodlist,(void *)modlist);
364: list_prepend(&oldhash,(void *)hash);
365:
366: init_hashtable(hash,functions_tblsz);
367: while (modlist && modlist->func)
368: {
369: fill_hashtable(hash, modlist->func, modlist->help);
370: modlist++;
371: }
372: return (hash == functions_hash);
373: }
374:
375: module *pari_modules = NULL;
376: module *pari_oldmodules = NULL;
377: module *pari_membermodules = NULL;
378: entree **functions_hash = NULL;
379: entree **funct_old_hash = NULL;
380: entree **members_hash = NULL;
381:
382: /* add to modlist the functions in func, with helpmsg help */
383: void
384: pari_addfunctions(module **modlist_p, entree *func, char **help)
385: {
386: module *modlist = *modlist_p;
387: int nbmodules = 0;
388:
389: while (modlist && modlist->func) { nbmodules++; modlist++; }
390: modlist = *modlist_p;
391: *modlist_p = (module*) gpmalloc(sizeof(module)*(nbmodules+2));
392: if (nbmodules)
393: {
394: memcpy(1+ *modlist_p, modlist, sizeof(module)*nbmodules);
395: free(modlist);
396: }
397: modlist = *modlist_p;
398: modlist->func = func;
399: modlist->help = help;
400:
401: modlist += nbmodules+1;
402: modlist->func = NULL;
403: modlist->help = NULL;
404: }
405:
406: void
407: pari_sig_init(void (*f)(int))
408: {
409: #ifdef SIGBUS
410: (void)os_signal(SIGBUS,f);
411: #endif
412: #ifdef SIGFPE
413: (void)os_signal(SIGFPE,f);
414: #endif
415: #ifdef SIGINT
416: (void)os_signal(SIGINT,f);
417: #endif
418: #ifdef SIGBREAK
419: (void)os_signal(SIGBREAK,f);
420: #endif
421: #ifdef SIGPIPE
422: (void)os_signal(SIGPIPE,f);
423: #endif
424: #ifdef SIGSEGV
425: (void)os_signal(SIGSEGV,f);
426: #endif
427: }
428:
429: static void
430: reset_traps(int warn)
431: {
432: long i;
433: if (warn) err(warner,"missing cell in err_catch_stack. Resetting all traps");
434: for (i=0; i <= noer; i++) err_catch_array[i] = 0;
435: }
436:
1.2 ! noro 437: static void
! 438: init_universal_constants(void)
! 439: {
! 440: /* 2 (gnil) + 2 (gzero) + 3 (gun) + 3 (gdeux) + 3 (half) + 3 (gi) */
! 441: GEN p = universal_constants = (long*) gpmalloc(16*sizeof(long));
! 442: gzero = p; p+=2; gnil = p; p+=2;
! 443: gzero[0] = gnil[0] = evaltyp(t_INT) | evallg(2);
! 444: gzero[1] = gnil[1] = evallgefint(2);
! 445:
! 446: gun = p; p+=3; gdeux = p; p+=3;
! 447: gun[0] = gdeux[0] = evaltyp(t_INT) | evallg(3);
! 448: gun[1] = gdeux[1] = evalsigne(1) | evallgefint(3);
! 449: gun[2] = 1; gdeux[2]= 2;
! 450:
! 451: ghalf = p; p+=3; gi = p; p+=3;
! 452: ghalf[0] = evaltyp(t_FRAC) | evallg(3);
! 453: ghalf[1] = un;
! 454: ghalf[2] = deux;
! 455: gi[0] = evaltyp(t_COMPLEX) | evallg(3);
! 456: gi[1] = zero;
! 457: gi[2] = un;
! 458: }
! 459:
! 460: static long
! 461: fix_size(size_t a)
! 462: {
! 463: /* BYTES_IN_LONG*ceil(a/BYTES_IN_LONG) */
! 464: size_t b = a+BYTES_IN_LONG - (((a-1) & (BYTES_IN_LONG-1)) + 1);
! 465: if (b > VERYBIGINT) err(talker,"stack too large");
! 466: if (b < 1024) b = 1024;
! 467: return b;
! 468: }
! 469:
! 470: static long
! 471: init_stack(size_t size)
! 472: {
! 473: size_t s = fix_size(size), old = 0;
! 474: if (bot)
! 475: {
! 476: old = top - bot;
! 477: free((void*)bot);
! 478: }
! 479: /* NOT gpmalloc, memer would be deadly */
! 480: bot = (gpmem_t)__gpmalloc(s);
! 481: if (!bot)
! 482: for (s = old;; s>>=1)
! 483: {
! 484: if (!s) err(memer); /* no way out. Die */
! 485: err(warner,"not enough memory, new stack %lu",s);
! 486: bot = (gpmem_t)__gpmalloc(s);
! 487: if (bot) break;
! 488: }
! 489: avma = top = bot+s;
! 490: memused = 0; return s;
! 491: }
! 492:
1.1 noro 493: /* initialise les donnees de la bibliotheque PARI. Peut être précédée d'un
494: * appel à pari_addfunctions si on ajoute d'autres fonctions au pool de base.
495: */
496: void
1.2 ! noro 497: pari_init(size_t parisize, ulong maxprime)
1.1 noro 498: {
1.2 ! noro 499: long i;
1.1 noro 500:
501: #ifdef STACK_CHECK
502: pari_init_stackcheck(&i);
503: #endif
504: init_defaults(0);
505: if (INIT_JMP && setjmp(environnement))
506: {
507: fprintferr(" *** Error in the PARI system. End of program.\n");
508: exit(1);
509: }
510: if (INIT_SIG) pari_sig_init(pari_sighandler);
1.2 ! noro 511: (void)init_stack(parisize);
1.1 noro 512: diffptr = initprimes(maxprime);
1.2 ! noro 513: init_universal_constants();
1.1 noro 514:
515: varentries = (entree**) gpmalloc((MAXVARN+1)*sizeof(entree*));
516: polvar = (GEN) gpmalloc((MAXVARN+1)*sizeof(long));
517: ordvar = (GEN) gpmalloc((MAXVARN+1)*sizeof(long));
518: polx = (GEN*) gpmalloc((MAXVARN+1)*sizeof(GEN));
519: polun = (GEN*) gpmalloc((MAXVARN+1)*sizeof(GEN));
520: polvar[0] = evaltyp(t_VEC) | evallg(1);
521: for (i=0; i <= MAXVARN; i++) { ordvar[i] = i; varentries[i] = NULL; }
522:
1.2 ! noro 523: (void)fetch_var(); /* create polx/polun[MAXVARN] */
1.1 noro 524: primetab = (GEN) gpmalloc(1 * sizeof(long));
525: primetab[0] = evaltyp(t_VEC) | evallg(1);
526:
527: pari_addfunctions(&pari_modules, functions_basic,helpmessages_basic);
528: functions_hash = (entree **) gpmalloc(sizeof(entree*)*functions_tblsz);
529: for (i = 0; i < functions_tblsz; i++) functions_hash[i] = NULL;
530:
531: pari_addfunctions(&pari_oldmodules, oldfonctions,oldhelpmessage);
532: funct_old_hash = (entree **) gpmalloc(sizeof(entree*)*functions_tblsz);
533: for (i = 0; i < functions_tblsz; i++) funct_old_hash[i] = NULL;
534: gp_init_entrees(pari_oldmodules, funct_old_hash, 1);
535:
536: if (new_fun_set)
537: gp_init_entrees(pari_modules, functions_hash, 1);
538: else
539: gp_init_entrees(pari_oldmodules, functions_hash, 1);
540:
541: pari_addfunctions(&pari_membermodules, gp_member_list, NULL);
542: members_hash = (entree **) gpmalloc(sizeof(entree*)*functions_tblsz);
543: for (i = 0; i < functions_tblsz; i++) members_hash[i] = NULL;
544: gp_init_entrees(pari_membermodules, members_hash, 1);
545:
546: whatnow_fun = NULL;
547: err_catch_array = (long *) gpmalloc((noer + 1) *sizeof(long));
548: reset_traps(0);
549: default_exception_handler = NULL;
550:
551: (void)manage_var(2,NULL); /* init nvar */
1.2 ! noro 552: var_not_changed = 1; (void)fetch_named_var("x", 0);
1.1 noro 553: try_to_recover=1;
554: }
555:
1.2 ! noro 556: static void
! 557: delete_hist(gp_hist *h)
! 558: {
! 559: if (h->res) free((void*)h->res);
! 560: }
! 561: static void
! 562: delete_pp(gp_pp *p)
! 563: {
! 564: if (p->cmd) free((void*)p->cmd);
! 565: }
! 566: static void
! 567: delete_path(gp_path *p)
! 568: {
! 569: delete_dirs(p);
! 570: free((void*)p->PATH);
! 571: }
! 572:
! 573: static void
! 574: free_gp_data(gp_data *D)
! 575: {
! 576: if (!D) return;
! 577: delete_hist(D->hist);
! 578: delete_path(D->path);
! 579: delete_pp(D->pp);
! 580: if (D->help) free((void*)D->help);
! 581: }
! 582:
1.1 noro 583: void
584: freeall(void)
585: {
586: long i;
587: entree *ep,*ep1;
588:
589: while (delete_var()) /* empty */;
590: for (i = 0; i < functions_tblsz; i++)
591: {
1.2 ! noro 592: for (ep = functions_hash[i]; ep; ep = ep1) { ep1 = ep->next; freeep(ep); }
! 593: for (ep = members_hash[i]; ep; ep = ep1) { ep1 = ep->next; freeep(ep); }
1.1 noro 594: }
1.2 ! noro 595: free((void*)varentries);
! 596: free((void*)ordvar);
! 597: free((void*)polvar);
! 598: free((void*)polx[MAXVARN]);
! 599: free((void*)polx);
! 600: free((void*)polun);
1.1 noro 601: free((void*)primetab);
602: free((void*)universal_constants);
603:
604: /* set first cell to 0 to inhibit recursion in all cases */
605: while (cur_bloc) { *cur_bloc=0; killbloc(cur_bloc); }
606: killallfiles(1);
607: free((void *)functions_hash);
1.2 ! noro 608: free((void *)bot);
! 609: free((void *)diffptr);
1.1 noro 610: free(current_logfile);
611: free(current_psfile);
612:
1.2 ! noro 613: free_gp_data(GP_DATA);
1.1 noro 614: }
615:
616: GEN
617: getheap(void)
618: {
619: long m=0,l=0;
620: GEN x;
621:
622: for (x = cur_bloc; x; x = (GEN)bl_prev(x))
623: {
624: m++; l+=4;
625: if (! x[0]) /* user function */
626: l += (strlen((char *)(x+2))) / sizeof(long);
627: else if (x==bernzone)
628: l += x[0];
629: else /* GEN */
630: l += taille(x);
631: }
632: x=cgetg(3,t_VEC); x[1]=lstoi(m); x[2]=lstoi(l);
633: return x;
634: }
635:
636: /* Return x, where:
637: * x[-3]: adress of next bloc
638: * x[-2]: adress of preceding bloc.
639: * x[-1]: number of allocated blocs.
640: * x[0..n-1]: malloc-ed memory.
641: */
642: GEN
643: newbloc(long n)
644: {
645: long *x = (long *) gpmalloc((n + BL_HEAD)*sizeof(long)) + BL_HEAD;
646:
647: bl_next(x) = 0; /* the NULL address */
648: bl_prev(x) = (long)cur_bloc;
649: bl_num(x) = next_bloc++;
650: if (n) *x = 0; /* initialize first cell to 0. See killbloc */
651: if (cur_bloc) bl_next(cur_bloc) = (long)x;
652: if (DEBUGMEM)
653: {
654: if (!n) err(warner,"mallocing NULL object in newbloc");
655: if (DEBUGMEM > 2)
1.2 ! noro 656: fprintferr("new bloc, size %6lu (no %ld): %08lx\n", n, next_bloc-1, x);
1.1 noro 657: }
658: return cur_bloc = x;
659: }
660:
1.2 ! noro 661: /* recursively look for clones in the container and kill them */
! 662: static void
! 663: inspect(GEN x)
! 664: {
! 665: long i, lx;
! 666: switch(typ(x)) /* HACK: if x is not a GEN, we have typ(x)=0 */
! 667: {
! 668: case t_VEC: case t_COL: case t_MAT:
! 669: lx = lg(x);
! 670: for (i=1;i<lx;i++) inspect((GEN)x[i]);
! 671: break;
! 672: case t_LIST:
! 673: lx = lgef(x);
! 674: for (i=2;i<lx;i++) inspect((GEN)x[i]);
! 675: break;
! 676: }
! 677: if (isclone(x)) gunclone(x); /* Don't inspect here! components are dead */
! 678: }
! 679:
! 680: /* If insp is set, recursively inspect x, killing all clones found. The GP
! 681: * expression x[i] = y is implemented as x[i] := gclone(y) and we need to
! 682: * reclaim the memory. Useless to inspect when x does not correspond to a GP
! 683: * variable [not dangerous, though] */
1.1 noro 684: void
1.2 ! noro 685: killbloc0(GEN x, int insp)
1.1 noro 686: {
687: if (!x || isonstack(x)) return;
688: if (bl_next(x)) bl_prev(bl_next(x)) = bl_prev(x);
689: else
690: {
691: cur_bloc = (GEN)bl_prev(x);
692: next_bloc = bl_num(x);
693: }
694: if (bl_prev(x)) bl_next(bl_prev(x)) = bl_next(x);
695: if (DEBUGMEM > 2)
696: fprintferr("killing bloc (no %ld): %08lx\n", bl_num(x), x);
1.2 ! noro 697: if (insp)
! 698: { /* FIXME: SIGINT should be blocked until inspect() returns */
! 699: unsetisclone(x); /* important: oo recursion otherwise */
! 700: inspect(x);
1.1 noro 701: }
702: free((void *)bl_base(x));
703: }
704: void
705: killbloc(GEN x) { killbloc0(x,1); }
706: void
707: gunclone(GEN x) { killbloc0(x,0); }
708:
709: /********************************************************************/
710: /** **/
711: /** VARIABLE ORDERING **/
712: /** **/
713: /********************************************************************/
714:
715: /* Substitution globale des composantes du vecteur y aux variables de x */
716: GEN
717: changevar(GEN x, GEN y)
718: {
1.2 ! noro 719: long tx, ty, lx, vx, vy, i;
! 720: gpmem_t av, tetpil;
1.1 noro 721: GEN p1,p2,z;
722:
723: if (var_not_changed && y==polvar) return x;
724: tx=typ(x); if (!is_recursive_t(tx)) return gcopy(x);
725: ty=typ(y); if (! is_vec_t(ty)) err(changer1);
726: if (is_scalar_t(tx))
727: {
728: if (tx!=t_POLMOD) return gcopy(x);
729: av=avma;
730: p1=changevar((GEN)x[1],y);
731: p2=changevar((GEN)x[2],y); tetpil=avma;
732: return gerepile(av,tetpil, gmodulcp(p2,p1));
733: }
734: if (is_rfrac_t(tx))
735: {
736: av=avma;
737: p1=changevar((GEN)x[1],y);
738: p2=changevar((GEN)x[2],y); tetpil=avma;
739: return gerepile(av,tetpil, gdiv(p1,p2));
740: }
741:
742: lx = (tx==t_POL)? lgef(x): lg(x);
743: if (tx == t_POL || tx == t_SER)
744: {
745: vx=varn(x)+1; if (vx>=lg(y)) return gcopy(x);
746: p1=(GEN)y[vx];
747: if (!signe(x))
748: {
749: vy=gvar(p1); if (vy>MAXVARN) err(changer1);
750: z=gcopy(x); setvarn(z,vy); return z;
751: }
752: av=avma; p2=changevar((GEN)x[lx-1],y);
753: for (i=lx-2; i>=2; i--)
754: {
755: p2 = gmul(p2,p1);
756: p2 = gadd(p2, changevar((GEN)x[i],y));
757: }
758: if (tx==t_SER)
759: {
760: p2 = gadd(p2, ggrando(p1,lx-2));
761: if (valp(x))
762: p2 = gmul(gpuigs(p1,valp(x)), p2);
763: }
764: return gerepileupto(av,p2);
765: }
766: z=cgetg(lx,tx);
767: for (i=1; i<lx; i++) z[i]=lchangevar((GEN)x[i],y);
768: return z;
769: }
770:
771: GEN
772: reorder(GEN x)
773: {
774: long tx,lx,i,n, nvar = manage_var(3,NULL);
775: int *var,*varsort,*t1;
776:
777: if (!x) return polvar;
778: tx=typ(x); lx=lg(x)-1;
779: if (! is_vec_t(tx)) err(typeer,"reorder");
780: if (! lx) return polvar;
781:
782: varsort = (int *) gpmalloc(lx*sizeof(int));
783: var = (int *) gpmalloc(lx*sizeof(int));
784: t1 = (int *) gpmalloc(nvar*sizeof(int));
785:
786: for (n=0; n<nvar; n++) t1[n] = 0;
787: for (n=0; n<lx; n++)
788: {
789: var[n] = i = gvar((GEN)x[n+1]);
790: varsort[n] = ordvar[var[n]]; /* position in polvar */
791: if (i >= nvar) err(talker,"variable out of range in reorder");
792: /* check if x is a permutation */
793: if (t1[i]) err(talker,"duplicated indeterminates in reorder");
794: t1[i] = 1;
795: }
796: qsort(varsort,lx,sizeof(int),(QSCOMP)pari_compare_int);
797:
798: for (n=0; n<lx; n++)
799: {
800: /* variables are numbered 0,1 etc... while polvar starts at 1. */
801: polvar[varsort[n]+1] = lpolx[var[n]];
802: ordvar[var[n]] = varsort[n];
803: }
804:
805: var_not_changed=1;
806: for (i=0; i<nvar; i++)
807: if (ordvar[i]!=i) { var_not_changed=0; break; }
808:
809: free(t1); free(var); free(varsort);
810: return polvar;
811: }
812:
813: /*******************************************************************/
814: /* */
815: /* ERROR RECOVERY */
816: /* */
817: /*******************************************************************/
818: extern int pop_val_if_newer(entree *ep, long loc);
819: extern void kill_from_hashlist(entree *ep);
820:
821: /* if flag = 0: record address of next bloc allocated.
822: * if flag = 1: (after an error) recover all memory allocated since last call
823: */
824: void
825: recover(int flag)
826: {
827: static long listloc;
828: long n;
829: entree *ep, *epnext;
830: void (*sigfun)(int);
831:
832: if (!flag) { listloc = next_bloc; return; }
833:
834: /* disable recover() and SIGINT. Better: sigint_[block|release] as in
835: * readline/rltty.c ? */
836: try_to_recover=0;
837: sigfun = os_signal(SIGINT, SIG_IGN);
838:
839: for (n = 0; n < functions_tblsz; n++)
840: for (ep = functions_hash[n]; ep; ep = epnext)
841: {
842: epnext = ep->next;
843: switch(EpVALENCE(ep))
844: {
845: case EpVAR:
846: while (pop_val_if_newer(ep,listloc)) /* empty */;
847: break;
848: case EpNEW:
849: kill_from_hashlist(ep);
850: break;
851: case EpUSER:
852: case EpALIAS:
853: case EpMEMBER:
854: if (bl_num(ep->value) >= listloc)
855: {
856: gunclone((GEN)ep->value);
857: ep->value = (void*)initial_value(ep);
858: kill_from_hashlist(ep);
859: }
860: }
861: }
862: #if 0
863: /* This causes SEGV on lists and GP-2.0 vectors: internal component is
864: * destroyed while global object is not updated. Two solutions:
865: * - comment it out: should not be a big memory problem except for huge
866: * vec. components. Has the added advantadge that the results computed so
867: * far are not lost.
868: *
869: * - tag every variable whose component has been modified in the last
870: * cycle. Untag it at the begining of each cycle. Maybe this should be
871: * done. But do we really want to destroy a huge global vector if one of
872: * its components was modified before the error ? (we don't copy the whole
873: * thing anymore). K.B.
874: */
875: {
876: GEN y;
877: for (x = cur_bloc; x && bl_num(x) >= listloc; x = y)
878: {
879: y = (GEN)bl_prev(x);
880: if (x != gpi && x != geuler && x != bernzone) killbloc(x);
881: }
882: }
883: #endif
884: try_to_recover=1;
1.2 ! noro 885: (void)os_signal(SIGINT, sigfun);
1.1 noro 886: }
887:
888: void
889: disable_dbg(long val)
890: {
891: static long oldval = -1;
892: if (val < 0)
893: {
894: if (oldval >= 0) { DEBUGLEVEL = oldval; oldval = -1; }
895: }
896: else if (DEBUGLEVEL)
897: { oldval = DEBUGLEVEL; DEBUGLEVEL = val; }
898: }
899:
900: #define MAX_PAST 25
901: #define STR_LEN 20
902: /* Outputs a beautiful error message (not \n terminated)
903: * msg is errmessage to print.
904: * s points to the offending chars.
905: * entry tells how much we can go back from s[0].
906: */
907: void
908: errcontext(char *msg, char *s, char *entry)
909: {
910: int past = (s-entry);
911: char str[STR_LEN + 2];
912: char *buf, *t, *pre;
913:
914: if (!s || !entry) { print_prefixed_text(msg," *** ",NULL); return; }
915:
916: t = buf = gpmalloc(strlen(msg) + MAX_PAST + 5 + 2 * 16);
917: sprintf(t,"%s: ", msg);
918: if (past <= 0) past = 0;
919: else
920: {
921: t += strlen(t);
922: if (past > MAX_PAST) { past=MAX_PAST; strcpy(t, "..."); t += 3; }
923: strcpy(t, term_get_color(c_OUTPUT));
924: t += strlen(t);
925: strncpy(t, s - past, past); t[past] = 0;
926: }
927:
928: t = str; if (!past) *t++ = ' ';
929: strncpy(t, s, STR_LEN); t[STR_LEN] = 0;
930: pre = gpmalloc(2 * 16 + 1);
931: strcpy(pre, term_get_color(c_ERR));
932: strcat(pre, " *** ");
933: print_prefixed_text(buf, pre, str);
934: free(buf); free(pre);
935: }
936:
937: void *
938: err_catch(long errnum, jmp_buf env, void *data)
939: {
1.2 ! noro 940: cell *v;
! 941: /* for fear of infinite recursion don't trap memory errors */
! 942: if (errnum == memer) err(talker, "can't trap memory errors");
1.1 noro 943: if (errnum < 0) errnum = noer;
1.2 ! noro 944: if (errnum > noer) err(talker, "no such error number: %ld", errnum);
! 945: v = (cell*)gpmalloc(sizeof(cell));
1.1 noro 946: v->data = data;
947: v->env = env;
948: v->flag = errnum;
949: err_catch_array[errnum]++;
950: push_stack(&err_catch_stack, (void*)v);
951: return (void*)v;
952: }
953:
1.2 ! noro 954: static void
! 955: pop_catch_cell(stack **s)
1.1 noro 956: {
1.2 ! noro 957: cell *c = (cell*)pop_stack(s);
! 958: if (c)
1.1 noro 959: {
1.2 ! noro 960: err_catch_array[c->flag]--;
! 961: free(c);
1.1 noro 962: }
963: }
964:
1.2 ! noro 965: /* kill last handler for error n */
! 966: static void
! 967: err_leave_default(long n)
1.1 noro 968: {
1.2 ! noro 969: stack *s = err_catch_stack, *lasts;
1.1 noro 970:
1.2 ! noro 971: if (n < 0) n = noer;
! 972: if (!s || !err_catch_array[n]) return;
! 973: for (lasts = NULL; s; lasts = s, s = s->prev)
! 974: if (((cell*)s->value)->flag == n) break;
! 975: pop_catch_cell(&s);
! 976: if (!lasts) err_catch_stack = s; else lasts->prev = s;
1.1 noro 977: }
978:
1.2 ! noro 979: /* reset traps younger than V (included) */
1.1 noro 980: void
1.2 ! noro 981: err_leave(void **V)
1.1 noro 982: {
1.2 ! noro 983: cell *v = (cell*)*V;
! 984: while (err_catch_stack)
1.1 noro 985: {
1.2 ! noro 986: cell *t = (cell*)err_catch_stack->value;
! 987: pop_catch_cell(&err_catch_stack);
! 988: if (t == v) return;
1.1 noro 989: }
1.2 ! noro 990: reset_traps(1);
! 991: }
! 992:
! 993: /* We know somebody is trapping n (from err_catch_array).
! 994: * Get last (most recent) handler for error n (or generic noer) killing all
! 995: * more recent non-applicable handlers (now obsolete) */
! 996: static cell *
! 997: err_seek(long n)
! 998: {
! 999: while (err_catch_stack)
1.1 noro 1000: {
1.2 ! noro 1001: cell *t = err_catch_stack->value;
! 1002: if (t->flag == n || t->flag == noer) return t;
! 1003: pop_catch_cell(&err_catch_stack);
1.1 noro 1004: }
1.2 ! noro 1005: reset_traps(1); return NULL;
1.1 noro 1006: }
1007:
1.2 ! noro 1008: /* untrapped error: find oldest trap depending from a longjmp, and kill
! 1009: * everything more recent */
1.1 noro 1010: void
1.2 ! noro 1011: err_clean(void)
1.1 noro 1012: {
1013: stack *s = err_catch_stack, *lasts = NULL;
1.2 ! noro 1014: for ( ; s; s = s->prev)
1.1 noro 1015: {
1.2 ! noro 1016: cell *c = (cell*)s->value;
! 1017: if (c->env) lasts = s;
1.1 noro 1018: }
1.2 ! noro 1019: if (lasts)
1.1 noro 1020: {
1.2 ! noro 1021: void *c = (void*)s->value;
! 1022: err_leave(&c);
1.1 noro 1023: }
1024: }
1025:
1026: static int
1027: is_warn(long num)
1028: {
1029: return num == warner || num == warnmem || num == warnfile || num == warnprec;
1030: }
1031:
1032: void
1033: err_recover(long numerr)
1034: {
1035: initout(0);
1036: disable_dbg(-1);
1037: killallfiles(0);
1038:
1039: if (pariErr->die) pariErr->die(); /* Caller wants to catch exceptions? */
1040: global_err_data = NULL;
1041: err_clean();
1042: fprintferr("\n"); flusherr();
1043: if (!environnement) exit(1);
1044:
1045: /* reclaim memory stored in "blocs" */
1046: if (try_to_recover) recover(1);
1047: longjmp(environnement, numerr);
1048: }
1049:
1050: void
1051: err(long numerr, ...)
1052: {
1053: char s[128], *ch1;
1054: int ret = 0;
1055: PariOUT *out = pariOut;
1056: va_list ap;
1057: cell *trapped = NULL;
1058:
1059: va_start(ap,numerr);
1060:
1.2 ! noro 1061: global_err_data = NULL;
1.1 noro 1062: if (err_catch_stack && !is_warn(numerr))
1063: {
1.2 ! noro 1064: if (!err_catch_array[numerr] && !err_catch_array[noer]) err_clean();
! 1065: else if ( (trapped = err_seek(numerr)) )
! 1066: {
! 1067: void *e = trapped->env;
! 1068: if (e)
! 1069: {
! 1070: if (numerr == invmoder)
! 1071: {
! 1072: (void)va_arg(ap, char*); /* junk 1st arg */
! 1073: global_err_data = (void*)va_arg(ap, GEN);
! 1074: }
! 1075: longjmp(e, numerr);
! 1076: }
! 1077: global_err_data = trapped->data;
1.1 noro 1078: }
1079: }
1080:
1081: if (!added_newline) { pariputc('\n'); added_newline=1; }
1082: pariflush(); pariOut = pariErr;
1083: pariflush(); term_color(c_ERR);
1084:
1085: if (numerr < talker)
1086: {
1087: strcpy(s, errmessage[numerr]);
1088: switch (numerr)
1089: {
1090: case obsoler:
1091: ch1 = va_arg(ap,char *);
1092: errcontext(s,ch1,va_arg(ap,char *));
1093: if (whatnow_fun)
1094: {
1095: term_color(c_NONE);
1096: print_text("\nFor full compatibility with GP 1.39, type \"default(compatible,3)\" (you can also set \"compatible = 3\" in your GPRC file)");
1097: pariputc('\n');
1098: ch1 = va_arg(ap,char *);
1099: (void)whatnow_fun(ch1, - va_arg(ap,int));
1100: }
1101: break;
1102:
1103: case openfiler:
1104: sprintf(s+strlen(s), "%s file", va_arg(ap,char*));
1105: ch1 = va_arg(ap,char *);
1106: errcontext(s,ch1,ch1); break;
1107:
1108: case talker2:
1109: case member:
1110: strcat(s,va_arg(ap, char*)); /* fall through */
1111: default:
1112: ch1 = va_arg(ap,char *);
1113: errcontext(s,ch1,va_arg(ap,char *));
1114: }
1115: }
1.2 ! noro 1116: else if (numerr == user)
! 1117: {
! 1118: GEN *g = va_arg(ap, GEN*);
! 1119: pariputsf(" ### user error: ");
! 1120: print0(g, f_RAW);
! 1121: }
1.1 noro 1122: else
1123: {
1124: pariputsf(" *** %s", errmessage[numerr]);
1125: switch (numerr)
1126: {
1127: case talker: case siginter: case invmoder:
1128: ch1=va_arg(ap, char*);
1129: vpariputs(ch1,ap); pariputc('.'); break;
1130:
1131: case impl:
1132: ch1=va_arg(ap, char*);
1133: pariputsf(" %s is not yet implemented.",ch1); break;
1134:
1135: case breaker: case typeer: case mattype1: case overwriter:
1136: case accurer: case infprecer: case negexper: case polrationer:
1137: case funder2: case constpoler: case notpoler: case redpoler:
1138: case zeropoler: case consister: case flagerr: case precer:
1139: pariputsf(" in %s.",va_arg(ap, char*)); break;
1140:
1141: case bugparier:
1142: pariputsf(" %s, please report",va_arg(ap, char*)); break;
1143:
1144: case operi: case operf:
1145: {
1146: char *f, *op = va_arg(ap, char*);
1.2 ! noro 1147: GEN x = va_arg(ap, GEN);
! 1148: GEN y = va_arg(ap, GEN);
1.1 noro 1149: if (*op == '+') f = "addition";
1150: else if (*op == '*') f = "multiplication";
1.2 ! noro 1151: else if (*op == '/' || *op == '%' || *op == '\\') f = "division";
1.1 noro 1152: else if (*op == 'g') { op = ","; f = "gcd"; }
1153: else { op = "-->"; f = "assignment"; }
1.2 ! noro 1154: pariputsf(" %s %s %s %s.",f,type_name(typ(x)),op,type_name(typ(y)));
1.1 noro 1155: break;
1156: }
1157:
1158: /* the following 4 are only warnings (they return) */
1159: case warnmem: case warner:
1160: pariputc(' '); ch1=va_arg(ap, char*);
1161: vpariputs(ch1,ap); pariputs(".\n");
1162: ret = 1; break;
1163:
1164: case warnprec:
1165: vpariputs(" in %s; new prec = %ld\n",ap);
1166: ret = 1; break;
1167:
1168: case warnfile:
1169: ch1=va_arg(ap, char*);
1170: pariputsf(" %s: %s", ch1, va_arg(ap, char*));
1171: ret = 1; break;
1172: }
1173: }
1174: term_color(c_NONE); va_end(ap);
1175: if (numerr==errpile)
1176: {
1.2 ! noro 1177: fprintferr("\n current stack size: %lu (%.3f Mbytes)\n",
1.1 noro 1178: top-bot, (top-bot)/1048576.);
1179: fprintferr(" [hint] you can increase GP stack with allocatemem()\n");
1180: }
1181: pariOut = out;
1182: if (ret || (trapped && default_exception_handler &&
1183: default_exception_handler(numerr))) { flusherr(); return; }
1184: err_recover(numerr);
1185: }
1186:
1.2 ! noro 1187: /* Try f (trapping error e), recover using r (break_loop, if NULL) */
! 1188: GEN
! 1189: trap0(char *e, char *r, char *f)
! 1190: {
! 1191: long numerr = -1;
! 1192: GEN x = gnil;
! 1193: char *F;
! 1194: if (!strcmp(e,"errpile")) numerr = errpile;
! 1195: else if (!strcmp(e,"typeer")) numerr = typeer;
! 1196: else if (!strcmp(e,"gdiver2")) numerr = gdiver2;
! 1197: else if (!strcmp(e,"invmoder")) numerr = invmoder;
! 1198: else if (!strcmp(e,"accurer")) numerr = accurer;
! 1199: else if (!strcmp(e,"archer")) numerr = archer;
! 1200: else if (*e) err(impl,"this trap keyword");
! 1201: /* TO BE CONTINUED */
! 1202:
! 1203: if (f && r)
! 1204: { /* explicit recovery text */
! 1205: char *a = get_analyseur();
! 1206: gpmem_t av = avma;
! 1207:
! 1208: CATCH(numerr) { x = NULL; }
! 1209: TRY { x = lisseq(f); } ENDCATCH;
! 1210: if (!x) { avma = av; x = lisseq(r); }
! 1211: set_analyseur(a); return x;
! 1212: }
! 1213:
! 1214: F = f? f: r; /* define a default handler */
! 1215: /* default will execute F (or start a break loop), then jump to
! 1216: * environnement */
! 1217: if (F)
! 1218: {
! 1219: if (!*F || (*F == '"' && F[1] == '"')) /* unset previous handler */
! 1220: {/* TODO: find a better interface
! 1221: * TODO: no leaked handler from the library should have survived
! 1222: */
! 1223: err_leave_default(numerr);
! 1224: return x;
! 1225: }
! 1226: F = pari_strdup(F);
! 1227: }
! 1228: (void)err_catch(numerr, NULL, F);
! 1229: return x;
! 1230: }
! 1231:
1.1 noro 1232: /*******************************************************************/
1233: /* */
1234: /* CLONING & COPY */
1235: /* Replicate an existing GEN */
1236: /* */
1237: /*******************************************************************/
1238: /* lontyp = 0 means non recursive type
1239: * otherwise:
1240: * lontyp = number of codewords
1241: * if not in stack, we don't copy the words in [lontyp,lontyp2[
1242: */
1243: const long lontyp[] = { 0,0,0,1,1,1,1,2,1,1, 2,2,0,1,1,1,1,1,1,1, 2,0,0 };
1244: static long lontyp2[] = { 0,0,0,2,1,1,1,3,2,2, 2,2,0,1,1,1,1,1,1,1, 2,0,0 };
1245:
1246: /* can't do a memcpy there: avma and x may overlap. memmove is slower */
1247: GEN
1248: gcopy(GEN x)
1249: {
1250: long tx=typ(x),lx,i;
1251: GEN y;
1252:
1253: if (tx == t_SMALL) return x;
1254: if (! is_recursive_t(tx))
1255: {
1256: if (tx == t_INT && !signe(x)) return gzero; /* very common case */
1257: lx = lg(x); y = new_chunk(lx);
1258: for (i=lx-1; i>=0; i--) y[i]=x[i];
1259: }
1260: else
1261: {
1262: lx = lg(x); y = new_chunk(lx);
1263: if (tx==t_POL || tx==t_LIST) lx = lgef(x);
1264: for (i=0; i<lontyp[tx]; i++) y[i]=x[i];
1265: for ( ; i<lontyp2[tx]; i++) copyifstack(x[i],y[i]);
1266: for ( ; i<lx; i++) y[i]=lcopy((GEN)x[i]);
1267: }
1.2 ! noro 1268: unsetisclone(y); return y;
1.1 noro 1269: }
1270:
1271: GEN
1272: gcopy_i(GEN x, long lx)
1273: {
1274: long tx=typ(x),i;
1275: GEN y;
1276:
1277: if (tx == t_SMALL) return x;
1278: y=cgetg(lx,tx);
1279: if (! is_recursive_t(tx))
1280: for (i=lx-1; i>0; i--) y[i]=x[i];
1281: else
1282: {
1283: for (i=1; i<lontyp[tx]; i++) y[i]=x[i];
1284: for ( ; i<lontyp2[tx]; i++) copyifstack(x[i],y[i]);
1285: for ( ; i<lx; i++) y[i]=lcopy((GEN)x[i]);
1286: }
1.2 ! noro 1287: unsetisclone(y); return y;
1.1 noro 1288: }
1289:
1290: GEN
1291: forcecopy(GEN x)
1292: {
1293: long tx=typ(x),lx,i;
1294: GEN y;
1295:
1296: if (tx == t_SMALL) return x;
1297: if (! is_recursive_t(tx))
1298: {
1299: if (tx == t_INT && !signe(x)) return gzero; /* very common case */
1300: lx = lg(x); y = new_chunk(lx);
1301: for (i=lx-1; i>=0; i--) y[i]=x[i];
1302: }
1303: else
1304: {
1305: lx = lg(x); y = new_chunk(lx);
1306: if (tx==t_POL || tx==t_LIST) lx = lgef(x);
1307: for (i=0; i<lontyp[tx]; i++) y[i]=x[i];
1308: for ( ; i<lx; i++) y[i]=(long)forcecopy((GEN)x[i]);
1309: }
1310: unsetisclone(y); return y;
1311: }
1312:
1.2 ! noro 1313: GEN
! 1314: dummycopy(GEN x)
! 1315: {
! 1316: long tx=typ(x), lx=lg(x),i;
! 1317: GEN y=new_chunk(lx);
! 1318:
! 1319: switch(tx)
! 1320: {
! 1321: case t_POLMOD:
! 1322: y[1]=x[1]; y[2]=(long)dummycopy((GEN)x[2]);
! 1323: break;
! 1324: case t_MAT:
! 1325: for (i=lx-1;i;i--) y[i]=(long)dummycopy((GEN)x[i]);
! 1326: break;
! 1327: default:
! 1328: for (i=lx-1;i;i--) y[i]=x[i];
! 1329: }
! 1330: y[0]=x[0]; return y;
! 1331: }
! 1332:
1.1 noro 1333: /* copy x as if avma = *AVMA, update *AVMA */
1334: GEN
1335: gcopy_av(GEN x, GEN *AVMA)
1336: {
1337: long i,lx,tx=typ(x);
1338: GEN y;
1339:
1.2 ! noro 1340: if (tx == t_SMALL) return x;
1.1 noro 1341: lx = lg(x); *AVMA = y = *AVMA - lx;
1342: if (! is_recursive_t(tx))
1343: {
1344: for (i=0; i<lx; i++) y[i] = x[i];
1345: }
1346: else
1347: {
1348: if (tx==t_POL || tx==t_LIST) lx = lgef(x);
1349: for (i=0; i<lontyp[tx]; i++) y[i] = x[i];
1350: for ( ; i<lx; i++) y[i] = (long)gcopy_av((GEN)x[i], AVMA);
1351: }
1352: unsetisclone(y); return y;
1353: }
1354:
1.2 ! noro 1355: /* same but use NULL to code an exact 0 */
! 1356: static GEN
! 1357: gcopy_av0(GEN x, GEN *AVMA)
! 1358: {
! 1359: long i,lx,tx=typ(x);
! 1360: GEN y;
! 1361:
! 1362: if (! is_recursive_t(tx))
! 1363: {
! 1364: if (tx == t_INT && !signe(x)) return NULL; /* special marker */
! 1365: if (tx == t_SMALL) return x;
! 1366: lx = lg(x); *AVMA = y = *AVMA - lx;
! 1367: for (i=0; i<lx; i++) y[i] = x[i];
! 1368: }
! 1369: else
! 1370: {
! 1371: lx = lg(x); *AVMA = y = *AVMA - lx;
! 1372: if (tx==t_POL || tx==t_LIST) lx = lgef(x);
! 1373: for (i=0; i<lontyp[tx]; i++) y[i] = x[i];
! 1374: for ( ; i<lx; i++) y[i] = (long)gcopy_av0((GEN)x[i], AVMA);
! 1375: }
! 1376: unsetisclone(y); return y;
! 1377: }
! 1378:
! 1379: /* size of a gcopy_av0 */
! 1380: static long
! 1381: taille0(GEN x)
1.1 noro 1382: {
1.2 ! noro 1383: long i,n,lx, tx = typ(x);
! 1384: if (!is_recursive_t(tx))
! 1385: {
! 1386: if (tx == t_INT && !signe(x)) return 0;
! 1387: n = lg(x);
! 1388: }
! 1389: else
! 1390: {
! 1391: n = lg(x);
! 1392: lx = (tx==t_POL || tx==t_LIST)? lgef(x): n;
! 1393: for (i=lontyp[tx]; i<lx; i++) n += taille0((GEN)x[i]);
! 1394: }
! 1395: return n;
! 1396: }
1.1 noro 1397:
1.2 ! noro 1398: long
! 1399: taille(GEN x)
! 1400: {
! 1401: long i,n,lx, tx = typ(x);
! 1402: n = lg(x);
! 1403: if (is_recursive_t(tx))
1.1 noro 1404: {
1.2 ! noro 1405: lx = (tx==t_POL || tx==t_LIST)? lgef(x): n;
! 1406: for (i=lontyp[tx]; i<lx; i++) n += taille((GEN)x[i]);
1.1 noro 1407: }
1.2 ! noro 1408: return n;
1.1 noro 1409: }
1410:
1.2 ! noro 1411: long
! 1412: taille2(GEN x) { return taille(x)<<TWOPOTBYTES_IN_LONG; }
! 1413:
1.1 noro 1414: GEN
1415: gclone(GEN x)
1416: {
1417: long i,lx,tx = typ(x), t = taille(x);
1418: GEN y = newbloc(t);
1419: if (!is_recursive_t(tx))
1420: {
1421: lx = (tx==t_INT)? lgefint(x): lg(x);
1422: for (i=0; i<lx; i++) y[i] = x[i];
1423: }
1424: else
1425: {
1426: GEN AVMA = y+t;
1427: lx = (tx==t_POL || tx==t_LIST)? lgef(x): lg(x);
1428: for (i=0; i<lontyp[tx]; i++) y[i] = x[i];
1429: for ( ; i<lx; i++) y[i] = (long)gcopy_av((GEN)x[i], &AVMA);
1430: }
1431: setisclone(y); return y;
1432: }
1433:
1434: void
1435: shiftaddress(GEN x, long dec)
1436: {
1.2 ! noro 1437: long i,lx,tx;
! 1438:
! 1439: tx = typ(x);
1.1 noro 1440: if (is_recursive_t(tx))
1441: {
1442: lx = (tx==t_POL || tx==t_LIST)? lgef(x): lg(x);
1443: for (i=lontyp[tx]; i<lx; i++) {
1.2 ! noro 1444: if (!x[i]) x[i] = zero;
! 1445: else
! 1446: {
! 1447: x[i] += dec;
! 1448: shiftaddress((GEN)x[i], dec);
! 1449: }
1.1 noro 1450: }
1451: }
1452: }
1453:
1.2 ! noro 1454: /* return a clone of x structured as a gcopy */
1.1 noro 1455: GENbin*
1456: copy_bin(GEN x)
1457: {
1.2 ! noro 1458: long t = taille0(x);
1.1 noro 1459: GENbin *p = (GENbin*)gpmalloc(sizeof(GENbin) + t*sizeof(long));
1460: GEN AVMA = GENbase(p) + t;
1461: p->len = t;
1.2 ! noro 1462: p->x = gcopy_av0(x, &AVMA);
1.1 noro 1463: p->base= AVMA; return p;
1464: }
1465:
1466: /* p from copy_bin. Copy p->x back to stack, then destroy p */
1467: GEN
1468: bin_copy(GENbin *p)
1469: {
1470: GEN x,y,base;
1471: long dx,len;
1472:
1.2 ! noro 1473: x = p->x; if (!x) { free(p); return gzero; }
1.1 noro 1474: len = p->len;
1475: base= p->base; dx = x - base;
1476: y = (GEN)memcpy((void*)new_chunk(len), (void*)GENbase(p), len*sizeof(long));
1.2 ! noro 1477: y += dx; shiftaddress(y, (y-x)*sizeof(long));
1.1 noro 1478: free(p); return y;
1479: }
1480:
1481: /*******************************************************************/
1482: /* */
1483: /* STACK MANAGEMENT */
1484: /* */
1485: /*******************************************************************/
1486: /* Inhibit some area gerepile-wise: declare it to be a non recursive
1487: * type, of length l. Thus gerepile won't inspect the zone, just copy it.
1488: * For the following situation:
1489: * z = cgetg(t,a); garbage of length l;
1490: * for (i=1; i<HUGE; i++) z[i] = ...
1491: * stackdummy(z,l); z += l; We lose l words but save a costly gerepile.
1492: */
1493: void
1.2 ! noro 1494: stackdummy(GEN z, long l) { z[0] = evaltyp(t_VECSMALL) | evallg(l); }
1.1 noro 1495:
1496: /* gerepileupto(av, forcecopy(x)) */
1497: GEN
1.2 ! noro 1498: gerepilecopy(gpmem_t av, GEN x)
1.1 noro 1499: {
1500: GENbin *p = copy_bin(x);
1501: avma = av; return bin_copy(p);
1502: }
1503:
1504: /* Takes an array of pointers to GENs, of length n. Copies all
1505: * objects to contiguous locations and cleans up the stack between
1506: * av and avma. */
1507: void
1.2 ! noro 1508: gerepilemany(gpmem_t av, GEN* gptr[], int n)
1.1 noro 1509: {
1510: GENbin **l = (GENbin**)gpmalloc(n*sizeof(GENbin*));
1.2 ! noro 1511: int i;
1.1 noro 1512: for (i=0; i<n; i++) l[i] = copy_bin(*(gptr[i]));
1513: avma = av;
1514: for (i=0; i<n; i++) *(gptr[i]) = bin_copy(l[i]);
1515: free(l);
1516: }
1517:
1518: void
1.2 ! noro 1519: gerepileall(gpmem_t av, int n, ...)
1.1 noro 1520: {
1.2 ! noro 1521: GENbin **l = (GENbin**)gpmalloc(n*sizeof(GENbin*));
! 1522: GEN **gptr = (GEN**) gpmalloc(n*sizeof(GEN*));
! 1523: int i;
! 1524: va_list a; va_start(a, n);
! 1525:
! 1526: for (i=0; i<n; i++) { gptr[i] = va_arg(a,GEN*); l[i] = copy_bin(*(gptr[i])); }
! 1527: avma = av;
! 1528: for (--i; i>=0; i--) *(gptr[i]) = bin_copy(l[i]);
! 1529: free(l); free(gptr);
! 1530: }
! 1531:
! 1532: void
! 1533: gerepilemanycoeffs(gpmem_t av, GEN x, int n)
! 1534: {
! 1535: int i;
1.1 noro 1536: for (i=0; i<n; i++) x[i] = (long)copy_bin((GEN)x[i]);
1537: avma = av;
1538: for (i=0; i<n; i++) x[i] = (long)bin_copy((GENbin*)x[i]);
1539: }
1540:
1541: void
1.2 ! noro 1542: gerepilemanycoeffs2(gpmem_t av, GEN x, int n, GEN y, int o)
1.1 noro 1543: {
1.2 ! noro 1544: int i;
1.1 noro 1545: for (i=0; i<n; i++) x[i] = (long)copy_bin((GEN)x[i]);
1546: for (i=0; i<o; i++) y[i] = (long)copy_bin((GEN)y[i]);
1547: avma = av;
1548: for (i=0; i<n; i++) x[i] = (long)bin_copy((GENbin*)x[i]);
1549: for (i=0; i<o; i++) y[i] = (long)bin_copy((GENbin*)y[i]);
1550: }
1551:
1552: /* Takes an array of pointers to GENs, of length n.
1553: * Cleans up the stack between av and tetpil, updating those GENs. */
1554: void
1.2 ! noro 1555: gerepilemanysp(gpmem_t av, gpmem_t tetpil, GEN* gptr[], int n)
1.1 noro 1556: {
1.2 ! noro 1557: const gpmem_t av2 = avma;
! 1558: const size_t dec = av-tetpil;
! 1559: int i;
1.1 noro 1560:
1561: (void)gerepile(av,tetpil,NULL);
1562: for (i=0; i<n; i++)
1563: {
1.2 ! noro 1564: gpmem_t *g1 = (gpmem_t*) gptr[i];
! 1565: if (*g1 < tetpil)
1.1 noro 1566: {
1.2 ! noro 1567: if (*g1 >= av2) *g1 += dec; /* Update address if in stack */
! 1568: else if (*g1 >= av) err(gerper);
1.1 noro 1569: }
1570: }
1571: }
1572:
1573: /* Takes an array of GENs (cast to longs), of length n.
1574: * Cleans up the stack between av and tetpil, updating those GENs. */
1575: void
1.2 ! noro 1576: gerepilemanyvec(gpmem_t av, gpmem_t tetpil, long *g, int n)
1.1 noro 1577: {
1.2 ! noro 1578: const gpmem_t av2 = avma;
! 1579: const size_t dec = av-tetpil;
! 1580: int i;
1.1 noro 1581:
1582: (void)gerepile(av,tetpil,NULL);
1583: for (i=0; i<n; i++,g++)
1.2 ! noro 1584: if ((gpmem_t)*g < tetpil)
1.1 noro 1585: {
1.2 ! noro 1586: if ((gpmem_t)*g >= av2) *g += dec;/* Update addresses if in stack */
! 1587: else if ((gpmem_t)*g >= av) err(gerper);
1.1 noro 1588: }
1589: }
1590:
1591: GEN
1.2 ! noro 1592: gerepileupto(gpmem_t av, GEN q)
1.1 noro 1593: {
1.2 ! noro 1594: if (!isonstack(q)) { avma = av; return q; } /* universal object */
1.1 noro 1595: /* empty garbage */
1.2 ! noro 1596: if (av <= (gpmem_t)q) return q;
1.1 noro 1597: /* The garbage is only empty when av==q. It's probably a mistake if
1598: * av < q. But "temporary variables" from sumiter are a problem since
1599: * ep->values are returned as-is by identifier() and they can be in the
1600: * stack: if we put a gerepileupto in lisseq(), we get an error. Maybe add,
1601: * if (DEBUGMEM) err(warner,"av>q in gerepileupto") ???
1602: */
1603:
1604: /* Beware: (long)(q+i) --> ((long)q)+i*sizeof(long) */
1.2 ! noro 1605: return gerepile(av, (gpmem_t) (q+lg(q)), q);
1.1 noro 1606: }
1607:
1608: /* internal */
1609: GEN
1.2 ! noro 1610: gerepileuptoleaf(gpmem_t av, GEN q)
1.1 noro 1611: {
1612: long i;
1613: GEN q0;
1614:
1.2 ! noro 1615: if (!isonstack(q) || av==(gpmem_t)q) { avma = av; return q; }
! 1616: i=lg(q); avma = (gpmem_t)(((GEN)av) - i);
1.1 noro 1617: q0 = (GEN)avma; while (--i >= 0) q0[i]=q[i];
1618: return q0;
1619: }
1620: /* internal */
1621: GEN
1.2 ! noro 1622: gerepileuptoint(gpmem_t av, GEN q)
1.1 noro 1623: {
1.2 ! noro 1624: if (!isonstack(q) || (GEN)av==q) { avma = av; return q; }
! 1625: avma = (gpmem_t)icopy_av(q, (GEN)av);
1.1 noro 1626: return (GEN)avma;
1627: }
1628:
1629: static int
1630: _ok_gerepileupto(GEN av, GEN x)
1631: {
1632: long i,lx,tx;
1633: if (!isonstack(x)) return 1;
1634: if (x > av)
1635: {
1636: err(warner,"bad object %Z",x);
1637: return 0;
1638: }
1639: tx = typ(x);
1640: if (! is_recursive_t(tx)) return 1;
1641:
1642: lx = (tx==t_POL || tx==t_LIST)? lgef(x): lg(x);
1643: for (i=lontyp[tx]; i<lx; i++)
1644: if (!_ok_gerepileupto(av, (GEN)x[i]))
1645: {
1646: err(warner,"bad component %ld in object %Z",i,x);
1647: return 0;
1648: }
1649: return 1;
1650: }
1651: /* check that x and all its components are out of stack, or have been
1652: * created after av */
1653: int
1654: ok_gerepileupto(GEN x) { return _ok_gerepileupto(x, x); }
1655:
1656: GEN
1.2 ! noro 1657: gerepile(gpmem_t av, gpmem_t tetpil, GEN q)
1.1 noro 1658: {
1.2 ! noro 1659: gpmem_t avmb;
! 1660: size_t dec = av - tetpil;
1.1 noro 1661: GEN ll,a,b;
1662:
1663: if (dec==0) return q;
1.2 ! noro 1664: if ((long)dec<0) err(talker,"lbot>ltop in gerepile");
1.1 noro 1665:
1.2 ! noro 1666: if ((gpmem_t)q >= avma && (gpmem_t)q < tetpil)
! 1667: q = (GEN) (((gpmem_t)q) + dec);
1.1 noro 1668:
1669: for (ll=(GEN)av, a=(GEN)tetpil; a > (GEN)avma; ) *--ll= *--a;
1.2 ! noro 1670: avmb = (gpmem_t)ll;
1.1 noro 1671: while (ll < (GEN)av)
1672: {
1673: const long tl=typ(ll);
1674:
1675: if (! is_recursive_t(tl)) { ll+=lg(ll); continue; }
1676: a = ll+lontyp[tl];
1677: if (tl==t_POL) { b=ll+lgef(ll); ll+=lg(ll); } else { ll+=lg(ll); b=ll; }
1678: for ( ; a<b; a++)
1.2 ! noro 1679: if ((gpmem_t)*a < av && (gpmem_t)*a >= avma)
1.1 noro 1680: {
1.2 ! noro 1681: if ((gpmem_t)*a < tetpil) *a += dec; else err(gerper);
1.1 noro 1682: }
1683: }
1684: avma = avmb; return q;
1685: }
1686:
1687: long
1.2 ! noro 1688: allocatemoremem(size_t newsize)
1.1 noro 1689: {
1690: if (!newsize)
1691: {
1.2 ! noro 1692: newsize = (top - bot) << 1;
! 1693: err(warner,"doubling stack size; new stack = %lu (%.3f Mbytes)",
1.1 noro 1694: newsize, newsize/1048576.);
1695: }
1.2 ! noro 1696: return init_stack(newsize);
1.1 noro 1697: }
1698:
1699: /* alternate stack management routine */
1700: stackzone *
1701: switch_stack(stackzone *z, long n)
1702: {
1703: if (!z)
1704: { /* create parallel stack */
1.2 ! noro 1705: size_t size = n*sizeof(long) + sizeof(stackzone);
1.1 noro 1706: z = (stackzone*) gpmalloc(size);
1.2 ! noro 1707: z->zonetop = ((gpmem_t)z) + size;
1.1 noro 1708: return z;
1709: }
1710:
1711: if (n)
1712: { /* switch to parallel stack */
1713: z->bot = bot;
1714: z->top = top;
1715: z->avma = avma;
1716: z->memused = memused;
1.2 ! noro 1717: bot = (gpmem_t) (z+1);
1.1 noro 1718: top = z->zonetop;
1719: avma = top;
1.2 ! noro 1720: memused = (size_t)-1;
1.1 noro 1721: }
1722: else
1723: { /* back to normalcy */
1724: bot = z->bot;
1725: top = z->top;
1726: avma = z->avma;
1727: memused = z->memused;
1728: }
1729: return NULL;
1730: }
1731:
1732: #ifdef MEMSTEP
1733: void
1734: checkmemory(GEN z)
1735: {
1.2 ! noro 1736: if (DEBUGMEM && memused != (size_t)-1 &&
1.1 noro 1737: ((GEN)memused > z + MEMSTEP || z > (GEN)memused + MEMSTEP))
1738: {
1.2 ! noro 1739: memused=(size_t)z;
1.1 noro 1740: #if MEMSTEP >= 1048576
1741: fprintferr("...%4.0lf Mbytes used\n",(top-memused)/1048576.);
1742: #else
1743: fprintferr("...%5.1lf Mbytes used\n",(top-memused)/1048576.);
1744: #endif
1745: }
1746: }
1747: #endif
1748:
1749: void
1.2 ! noro 1750: fill_stack(void)
1.1 noro 1751: {
1752: GEN x = ((GEN)bot);
1.2 ! noro 1753: while (x < (GEN)avma) *x++ = 0xfefefefeUL;
1.1 noro 1754: }
1755:
1756: /*******************************************************************/
1757: /* */
1758: /* TIMER */
1759: /* */
1760: /*******************************************************************/
1.2 ! noro 1761: long
! 1762: _get_time(pari_timer *T, long Ticks, long TickPerSecond)
! 1763: {
! 1764: long s = Ticks / TickPerSecond;
! 1765: long us = (long) (Ticks % TickPerSecond) * (1000000. / TickPerSecond);
! 1766: long delay = 1000 * (s - T->s) + (us - T->us) / 1000;
! 1767: T->us = us;
! 1768: T->s = s; return delay;
! 1769: }
1.1 noro 1770:
1771: #ifdef WINCE
1.2 ! noro 1772: long
! 1773: TIMER(pari_timer *T)
! 1774: {
! 1775: return _get_time(T, GetTickCount(), 1000);
! 1776: }
1.1 noro 1777: #elif defined(macintosh)
1778: # include <Events.h>
1.2 ! noro 1779: long
! 1780: TIMER(pari_timer *T)
! 1781: {
! 1782: return _get_time(T, TickCount(), 60);
! 1783: }
1.1 noro 1784: #elif USE_TIMES
1785:
1786: # include <sys/times.h>
1787: # include <sys/time.h>
1788: # include <time.h>
1.2 ! noro 1789: long
! 1790: TIMER(pari_timer *T)
! 1791: {
! 1792: struct tms t; times(&t);
! 1793: return _get_time(T, t.tms_utime, CLK_TCK);
! 1794: }
1.1 noro 1795: #elif USE_GETRUSAGE
1796:
1797: # include <sys/time.h>
1798: # include <sys/resource.h>
1.2 ! noro 1799: long
! 1800: TIMER(pari_timer *T)
! 1801: {
! 1802: struct rusage r;
! 1803: struct timeval t;
! 1804: long delay;
! 1805:
! 1806: getrusage(0,&r); t = r.ru_utime;
! 1807: delay = 1000 * (t.tv_sec - T->s) + (t.tv_usec - T->us) / 1000;
! 1808: T->us = t.tv_usec;
! 1809: T->s = t.tv_sec; return delay;
! 1810: }
1.1 noro 1811: #elif USE_FTIME
1812:
1813: # include <sys/timeb.h>
1.2 ! noro 1814: long
! 1815: TIMER(pari_timer *T)
! 1816: {
! 1817: struct timeb t;
! 1818: long delay;
! 1819:
! 1820: ftime(&t);
! 1821: delay = 1000 * (t.time - T->s) + (t.millitm - T->us / 1000);
! 1822: T->us = t.millitm * 1000;
! 1823: T->s = t.time; return delay;
! 1824: }
1.1 noro 1825: #else
1826:
1827: # include <time.h>
1828: # ifndef CLOCKS_PER_SEC
1829: # define CLOCKS_PER_SEC 1000000 /* may be false on YOUR system */
1830: # endif
1831: long
1.2 ! noro 1832: TIMER(pari_timer *T)
1.1 noro 1833: {
1.2 ! noro 1834: return _get_time(T, clock(), CLOCKS_PER_SEC);
1.1 noro 1835: }
1.2 ! noro 1836: #endif
! 1837: void
! 1838: TIMERstart(pari_timer *T) { (void)TIMER(T); }
1.1 noro 1839:
1840: long
1.2 ! noro 1841: timer(void) { static pari_timer T; return TIMER(&T);}
! 1842: long
! 1843: timer2(void) { static pari_timer T; return TIMER(&T);}
1.1 noro 1844:
1845: void
1.2 ! noro 1846: msgTIMER(pari_timer *T, char *format, ...)
1.1 noro 1847: {
1848: va_list args;
1849: PariOUT *out = pariOut; pariOut = pariErr;
1850:
1851: pariputs("Time "); va_start(args, format);
1852: vpariputs(format,args); va_end(args);
1.2 ! noro 1853: pariputsf(": %ld\n", TIMER(T)); pariflush();
1.1 noro 1854: pariOut = out;
1855: }
1856:
1857: void
1858: msgtimer(char *format, ...)
1859: {
1860: va_list args;
1861: PariOUT *out = pariOut; pariOut = pariErr;
1862:
1863: pariputs("Time "); va_start(args, format);
1864: vpariputs(format,args); va_end(args);
1.2 ! noro 1865: pariputsf(": %ld\n", timer2()); pariflush();
1.1 noro 1866: pariOut = out;
1867: }
1868:
1869: /*******************************************************************/
1870: /* */
1871: /* FUNCTIONS KNOWN TO THE ANALYZER */
1872: /* */
1873: /*******************************************************************/
1874: extern void alias0(char *s, char *old);
1875: extern GEN break0(long n);
1876: extern GEN next0(long n);
1877: extern GEN return0(GEN x);
1878:
1879: GEN
1880: geni(void) { return gi; }
1881:
1882: /* List of GP functions:
1883: * ---------------------
1884: * Format (struct entree) :
1885: * char *name : name (under GP).
1886: * ulong valence : used to form arg list, now often handled by code.
1887: * void *value : For PREDEFINED FUNCTIONS: C function to call.
1888: * For USER FUNCTIONS: pointer to defining data (bloc) =
1889: * entree*: NULL, list of entree (arguments), NULL
1890: * char* : function text
1891: * long menu : which help section do we belong to (See below).
1892: * char *code : argument list (See below).
1893: * entree *next : next entree (init to NULL, used in hashing code).
1894: * char *help : short help text (init to NULL).
1895: * void *args : For USER FUNCTIONS: default arguments (NULL terminated).
1896: * For VARIABLES: (esp. loop indexes): push_val history.
1897: * (while processing a loop, ep->value may not be a bloc)
1898: * menu:
1899: * -----
1900: * 1: Standard monadic or dyadic OPERATORS
1901: * 2: CONVERSIONS and similar elementary functions
1902: * 3: TRANSCENDENTAL functions
1903: * 4: NUMBER THEORETICAL functions
1904: * 5: Functions related to ELLIPTIC CURVES
1905: * 6: Functions related to general NUMBER FIELDS
1906: * 7: POLYNOMIALS and power series
1907: * 8: Vectors, matrices, LINEAR ALGEBRA and sets
1908: * 9: SUMS, products, integrals and similar functions
1909: * 10: GRAPHIC functions
1910: * 11: PROGRAMMING under GP
1911: *
1912: * code: describe function prototype. NULL = use valence instead.
1913: * -----
1914: * Arguments:
1915: * I input position (to be processed with lisseq) - a string with a
1916: * sequence of PARI expressions.
1917: * E input position (to be processed with lisexpr) - a string with a
1918: * PARI expression.
1919: * G GEN
1920: * L long
1921: * S symbol (i.e GP function name)
1922: * V variable (same as S, but valence must equal EpVAR/EpGVAR)
1923: * n variable number
1924: * & *GEN
1925: * F Fake *GEN (function requires a *GEN, but we don't use the resulting GEN)
1926: * f Fake *long
1927: * p real precision (prec for the C library)
1928: * P series precision (precdl dor the C library)
1929: * r raw input (treated as a string without quotes).
1930: * Quoted args are copied as strings. Stops at first unquoted ')' or ','.
1931: * Special chars can be quoted using '\'. Ex : aa"b\n)"c => "aab\n)c".
1932: * s expanded string. Example: pi"x"2 yields "3.142x2".
1933: * The unquoted components can be of any pari type (converted according to
1934: * the current output format)
1935: * s* any number of strings (see s)
1.2 ! noro 1936: * M Mnemonic or a flag (converted to a long); description follows
! 1937: * after \n at the end of the argument description
1.1 noro 1938: * D Has a default value. Format is "Dvalue,type," (the ending comma is
1939: * mandatory). Ex: D0,L, (arg is long, 0 by default).
1940: * Special syntax:
1941: * if type = G, &, I or V: D[G&IV] all send NULL.
1.2 ! noro 1942: * if type = n: Dn sends -1.
1.1 noro 1943: *
1944: * The user-given args are read first, then completed by the defaults
1945: *
1946: * Return type (first char or immediately after 'x'): GEN by default, otherwise
1947: * l Return long
1948: * v Return void
1949: *
1950: * Syntax requirements:
1951: * = Separator '=' required.
1952: *
1953: * Origin:
1954: * x Installed foreign function. Put the ep of the function as the
1955: * first argument, fill the rest with PARI arguments,
1956: * then call installedHandler with these arguments.
1957: * Should be the first char in the code.
1958: *
1959: ****************************************************************************
1960: * If new codes are added, change identifier and skipidentifier.
1961: *
1962: * Currently the following functions have no code word:
1963: * 'O' 50, 'if' 80, 'until' 82, 'while' 81, 'global' 88,
1964: *
1965: * Valence 0 reserved for functions without mandatory args.
1966: * Valence 99 reserved for codes which do not correspond 1-to-1 to valences.
1967: * Any other valence (what to do with 0?) should correspond to exactly
1968: * one code.
1969: */
1970: entree functions_basic[]={
1971: {"Euler",0,(void*)mpeuler,3,"p"},
1972: {"I",0,(void*)geni,3,""},
1973: {"List",0,(void*)gtolist,2,"DG"},
1974: {"Mat",0,(void*)gtomat,2,"DG"},
1975: {"Mod",25,(void*)Mod0,2,"GGD0,L,"},
1976: {"O",50,NULL,7,NULL},
1977: {"Pi",0,(void*)mppi,3,"p"},
1978: {"Pol",14,(void*)gtopoly,2,"GDn"},
1979: {"Polrev",14,(void*)gtopolyrev,2,"GDn"},
1980: {"Qfb",99,(void*)Qfb0,2,"GGGDGp"},
1981: {"Ser",14,(void*)gtoser,2,"GDn"},
1982: {"Set",0,(void*)gtoset,2,"DG"},
1983: {"Str",0,(void*)strtoGENstr,2,"D\"\",s,D0,L,"},
1984: {"Vec",0,(void*)gtovec,2,"DG"},
1985: {"Vecsmall",0,(void*)gtovecsmall,2,"DG"},
1986: {"abs",1,(void*)gabs,3,"Gp"},
1987: {"acos",1,(void*)gacos,3,"Gp"},
1988: {"acosh",1,(void*)gach,3,"Gp"},
1989: {"addprimes",0,(void*)addprimes,4,"DG"},
1990: {"agm",29,(void*)agm,3,"GGp"},
1991: {"algdep",99,(void*)algdep0,8,"GLD0,L,p"},
1992: {"alias",99,(void*)alias0,11,"vrr"},
1993: {"arg",1,(void*)garg,3,"Gp"},
1994: {"asin",1,(void*)gasin,3,"Gp"},
1995: {"asinh",1,(void*)gash,3,"Gp"},
1996: {"atan",1,(void*)gatan,3,"Gp"},
1997: {"atanh",1,(void*)gath,3,"Gp"},
1998: {"bernfrac",11,(void*)bernfrac,3,"L"},
1999: {"bernreal",99,(void*)bernreal,3,"Lp"},
2000: {"bernvec",11,(void*)bernvec,3,"L"},
1.2 ! noro 2001: {"besselh1",29,(void*)hbessel1,3,"GGp"},
! 2002: {"besselh2",29,(void*)hbessel2,3,"GGp"},
! 2003: {"besseli",29,(void*)ibessel,3,"GGp"},
! 2004: {"besselj",29,(void*)jbessel,3,"GGp"},
1.1 noro 2005: {"besseljh",29,(void*)jbesselh,3,"GGp"},
2006: {"besselk",99,(void*)kbessel0,3,"GGD0,L,p"},
1.2 ! noro 2007: {"besseln",29,(void*)nbessel,3,"GGp"},
1.1 noro 2008: {"bestappr",99,(void*)bestappr0,4,"GGDG"},
2009: {"bezout",2,(void*)vecbezout,4,"GG"},
2010: {"bezoutres",2,(void*)vecbezoutres,4,"GG"},
2011: {"bigomega",18,(void*)gbigomega,4,"G"},
2012: {"binary",18,(void*)binaire,2,"G"},
2013: {"binomial",21,(void*)binome,4,"GL"},
2014: {"bitand",2,(void*)gbitand,2,"GG"},
2015: {"bitneg",99,(void*)gbitneg,2,"GD-1,L,"},
2016: {"bitnegimply",2,(void*)gbitnegimply,2,"GG"},
2017: {"bitor",2,(void*)gbitor,2,"GG"},
1.2 ! noro 2018: {"bittest",99,(void*)gbittest3,2,"GGD1,L,"},
1.1 noro 2019: {"bitxor",2,(void*)gbitxor,2,"GG"},
2020: {"bnfcertify",10,(void*)certifybuchall,6,"lG"},
2021: {"bnfclassunit",99,(void*)bnfclassunit0,6,"GD0,L,DGp"},
2022: {"bnfclgp",99,(void*)classgrouponly,6,"GDGp"},
2023: {"bnfdecodemodule",2,(void*)decodemodule,6,"GG"},
2024: {"bnfinit",91,(void*)bnfinit0,6,"GD0,L,DGp"},
2025: {"bnfisintnorm",99,(void*)bnfisintnorm,6,"GG"},
2026: {"bnfisnorm",99,(void*)bnfisnorm,6,"GGD1,L,p"},
2027: {"bnfisprincipal",99,(void*)isprincipalall,6,"GGD1,L,"},
2028: {"bnfissunit",99,(void*)bnfissunit,6,"GGG"},
2029: {"bnfisunit",2,(void*)isunit,6,"GG"},
2030: {"bnfmake",1,(void*)bnfmake,6,"Gp"},
2031: {"bnfnarrow",18,(void*)buchnarrow,6,"G"},
2032: {"bnfreg",99,(void*)regulator,6,"GDGp"},
2033: {"bnfsignunit",18,(void*)signunits,6,"G"},
2034: {"bnfsunit",99,(void*)bnfsunit,6,"GGp"},
2035: {"bnfunit",18,(void*)buchfu,6,"G"},
1.2 ! noro 2036: {"bnrL1",99,(void*)bnrL1,6,"GDGD0,L,p"},
1.1 noro 2037: {"bnrclass",99,(void*)bnrclass0,6,"GGD0,L,"},
2038: {"bnrclassno",2,(void*)rayclassno,6,"GG"},
2039: {"bnrclassnolist",2,(void*)rayclassnolist,6,"GG"},
2040: {"bnrconductor",99,(void*)bnrconductor,6,"GDGDGD0,L,"},
2041: {"bnrconductorofchar",2,(void*)bnrconductorofchar,6,"GG"},
2042: {"bnrdisc",99,(void*)bnrdisc0,6,"GDGDGD0,L,"},
2043: {"bnrdisclist",99,(void*)bnrdisclist0,6,"GGDGD0,L,"},
2044: {"bnrinit",99,(void*)bnrinit0,6,"GGD0,L,"},
2045: {"bnrisconductor",99,(void*)bnrisconductor,6,"lGDGDG"},
2046: {"bnrisprincipal",99,(void*)isprincipalrayall,6,"GGD1,L,"},
2047: {"bnrrootnumber",99,(void*)bnrrootnumber,6,"GGD0,L,p"},
1.2 ! noro 2048: {"bnrstark",99,(void*)bnrstark,6,"GDGD0,L,p"},
1.1 noro 2049: {"break",0,(void*)break0,11,"D1,L,"},
2050: {"ceil",18,(void*)gceil,2,"G"},
2051: {"centerlift",99,(void*)centerlift0,2,"GDn"},
2052: {"changevar",2,(void*)changevar,2,"GG"},
2053: {"charpoly",99,(void*)charpoly0,8,"GDnD0,L,"},
2054: {"chinese",99,(void*)chinese,4,"GDG"},
2055: {"component",21,(void*)compo,2,"GL"},
2056: {"concat",99,(void*)concat,8,"GDG"},
2057: {"conj",18,(void*)gconj,2,"G"},
2058: {"conjvec",1,(void*)conjvec,2,"Gp"},
2059: {"content",18,(void*)content,4,"G"},
2060: {"contfrac",99,(void*)contfrac0,4,"GDGD0,L,"},
2061: {"contfracpnqn",18,(void*)pnqn,4,"G"},
2062: {"core",99,(void*)core0,4,"GD0,L,"},
2063: {"coredisc",99,(void*)coredisc0,4,"GD0,L,"},
2064: {"cos",1,(void*)gcos,3,"Gp"},
2065: {"cosh",1,(void*)gch,3,"Gp"},
2066: {"cotan",1,(void*)gcotan,3,"Gp"},
2067: {"denominator",18,(void*)denom,2,"G"},
2068: {"deriv",14,(void*)deriv,7,"GDn"},
2069: {"dilog",1,(void*)dilog,3,"Gp"},
2070: {"dirdiv",2,(void*)dirdiv,4,"GG"},
2071: {"direuler",99,(void*)direulerall,4,"V=GGEDG"},
2072: {"dirmul",2,(void*)dirmul,4,"GG"},
2073: {"dirzetak",2,(void*)dirzetak,6,"GG"},
2074: {"divisors",18,(void*)divisors,4,"G"},
1.2 ! noro 2075: {"divrem",2,(void*)divrem,1,"GGDn"},
1.1 noro 2076: {"eint1",99,(void*)veceint1,3,"GDGp"},
2077: {"elladd",3,(void*)addell,5,"GGG"},
2078: {"ellak",2,(void*)akell,5,"GG"},
2079: {"ellan",23,(void*)anell,5,"GL"},
2080: {"ellap",25,(void*)ellap0,5,"GGD0,L,"},
2081: {"ellbil",99,(void*)bilhell,5,"GGGp"},
2082: {"ellchangecurve",2,(void*)coordch,5,"GG"},
2083: {"ellchangepoint",2,(void*)pointch,5,"GG"},
2084: {"elleisnum",99,(void*)elleisnum,5,"GLD0,L,p"},
2085: {"elleta",1,(void*)elleta,5,"Gp"},
2086: {"ellglobalred",18,(void*)globalreduction,5,"G"},
2087: {"ellheight",99,(void*)ellheight0,5,"GGD0,L,p"},
2088: {"ellheightmatrix",29,(void*)mathell,5,"GGp"},
2089: {"ellinit",99,(void*)ellinit0,5,"GD0,L,p"},
2090: {"ellisoncurve",20,(void*)oncurve,5,"lGG"},
2091: {"ellj",1,(void*)jell,5,"Gp"},
2092: {"elllocalred",2,(void*)localreduction,5,"GG"},
2093: {"elllseries",99,(void*)lseriesell,5,"GGDGp"},
1.2 ! noro 2094: {"ellminimalmodel",99,(void*)ellminimalmodel,5,"GD&"},
1.1 noro 2095: {"ellorder",2,(void*)orderell,5,"GG"},
2096: {"ellordinate",29,(void*)ordell,5,"GGp"},
2097: {"ellpointtoz",29,(void*)zell,5,"GGp"},
2098: {"ellpow",99,(void*)powell,5,"GGG"},
2099: {"ellrootno",99,(void*)ellrootno,5,"lGDG"},
2100: {"ellsigma",99,(void*)ellsigma,5,"GGD0,L,p"},
2101: {"ellsub",99,(void*)subell,5,"GGG"},
2102: {"elltaniyama",18,(void*)taniyama,5,"G"},
2103: {"elltors",99,(void*)elltors0,5,"GD0,L,"},
2104: {"ellwp",99,(void*)ellwp0,5,"GDGD0,L,pP"},
2105: {"ellzeta",99,(void*)ellzeta,5,"GGp"},
2106: {"ellztopoint",29,(void*)pointell,5,"GGp"},
2107: {"erfc",1,(void*)gerfc,3,"Gp"},
2108: {"eta",99,(void*)eta0,3,"GD0,L,p"},
2109: {"eulerphi",18,(void*)gphi,4,"G"},
2110: {"eval",18,(void*)geval,7,"G"},
2111: {"exp",1,(void*)gexp,3,"Gp"},
2112: {"factor",99,(void*)factor0,4,"GD-1,L,"},
1.2 ! noro 2113: {"factorback",99,(void*)factorback0,4,"GDGDG"},
1.1 noro 2114: {"factorcantor",2,(void*)factcantor,4,"GG"},
2115: {"factorff",3,(void*)factmod9,4,"GGG"},
2116: {"factorial",99,(void*)mpfactr,4,"Lp"},
2117: {"factorint",99,(void*)factorint,4,"GD0,L,"},
2118: {"factormod",25,(void*)factormod0,4,"GGD0,L,"},
2119: {"factornf",2,(void*)polfnf,6,"GG"},
2120: {"factorpadic",99,(void*)factorpadic0,7,"GGLD0,L,"},
2121: {"ffinit",99,(void*)ffinit,4,"GLDn"},
2122: {"fibonacci",11,(void*)fibo,4,"L"},
2123: {"floor",18,(void*)gfloor,2,"G"},
2124: {"for",83,(void*)forpari,11,"vV=GGI"},
2125: {"fordiv",84,(void*)fordiv,11,"vGVI"},
2126: {"forprime",83,(void*)forprime,11,"vV=GGI"},
2127: {"forstep",86,(void*)forstep,11,"vV=GGGI"},
1.2 ! noro 2128: {"forsubgroup",99,(void*)forsubgroup,11,"vV=GDGI"},
1.1 noro 2129: {"forvec",87,(void*)forvec,11,"vV=GID0,L,"},
2130: {"frac",18,(void*)gfrac,2,"G"},
2131: {"galoisfixedfield",99,(void*)galoisfixedfield,6,"GGD0,L,Dn"},
2132: {"galoisinit",99,(void*)galoisinit,6,"GDGD0,L,"},
1.2 ! noro 2133: {"galoisisabelian",99,(void*)galoisisabelian,6,"GD0,L,"},
1.1 noro 2134: {"galoispermtopol",2,(void*)galoispermtopol,6,"GG"},
1.2 ! noro 2135: {"galoissubcyclo",99,(void*)galoissubcyclo,6,"GDGD0,L,Dn"},
! 2136: {"galoissubfields",99,(void*)galoissubfields,6,"GD0,L,Dn"},
! 2137: {"galoissubgroups",18,(void*)galoissubgroups,6,"G"},
1.1 noro 2138: {"gamma",1,(void*)ggamma,3,"Gp"},
2139: {"gammah",1,(void*)ggamd,3,"Gp"},
2140: {"gcd",99,(void*)gcd0,4,"GDGD0,L,"},
2141: {"getheap",0,(void*)getheap,11,""},
2142: {"getrand",0,(void*)getrand,11,"l"},
2143: {"getstack",0,(void*)getstack,11,"l"},
2144: {"gettime",0,(void*)gettime,11,"l"},
2145: {"hilbert",99,(void*)hil0,4,"lGGDG"},
2146: {"hyperu",99,(void*)hyperu,3,"GGGp"},
2147: {"idealadd",3,(void*)idealadd,6,"GGG"},
2148: {"idealaddtoone",99,(void*)idealaddtoone0,6,"GGDG"},
2149: {"idealappr",25,(void*)idealappr0,6,"GGD0,L,"},
2150: {"idealchinese",3,(void*)idealchinese,6,"GGG"},
2151: {"idealcoprime",3,(void*)idealcoprime,6,"GGG"},
2152: {"idealdiv",99,(void*)idealdiv0,6,"GGGD0,L,"},
2153: {"idealfactor",2,(void*)idealfactor,6,"GG"},
2154: {"idealhnf",99,(void*)idealhnf0,6,"GGDG"},
2155: {"idealintersect",3,(void*)idealintersect,6,"GGG"},
2156: {"idealinv",25,(void*)idealinv,6,"GG"},
2157: {"ideallist",99,(void*)ideallist0,6,"GLD4,L,"},
2158: {"ideallistarch",99,(void*)ideallistarch0,6,"GGDGD0,L,"},
2159: {"ideallog",3,(void*)zideallog,6,"GGG"},
2160: {"idealmin",99,(void*)minideal,6,"GGDGp"},
2161: {"idealmul",99,(void*)idealmul0,6,"GGGD0,L,p"},
2162: {"idealnorm",2,(void*)idealnorm,6,"GG"},
2163: {"idealpow",99,(void*)idealpow0,6,"GGGD0,L,p"},
2164: {"idealprimedec",29,(void*)primedec,6,"GG"},
2165: {"idealprincipal",2,(void*)principalideal,6,"GG"},
2166: {"idealred",99,(void*)ideallllred,6,"GGDGp"},
2167: {"idealstar",99,(void*)idealstar0,6,"GGD1,L,"},
2168: {"idealtwoelt",99,(void*)ideal_two_elt0,6,"GGDG"},
2169: {"idealval",30,(void*)idealval,6,"lGGG"},
2170: {"ideleprincipal",29,(void*)principalidele,6,"GGp"},
2171: {"if",80,NULL,11,NULL},
2172: {"imag",18,(void*)gimag,2,"G"},
2173: {"incgam",99,(void*)incgam0,3,"GGDGp"},
2174: {"incgamc",29,(void*)incgam3,3,"GGp"},
2175: {"intformal",14,(void*)integ,7,"GDn"},
2176: {"intnum",99,(void*)intnum0,9,"V=GGED0,L,p"},
2177: {"isfundamental",18,(void*)gisfundamental,4,"G"},
2178: {"isprime",99,(void*)gisprime,4,"GD0,L,"},
1.2 ! noro 2179: {"ispseudoprime",18,(void*)gispseudoprime,4,"GD0,L,"},
1.1 noro 2180: {"issquare",99,(void*)gcarrecomplet,4,"GD&"},
2181: {"issquarefree",18,(void*)gissquarefree,4,"G"},
2182: {"kronecker",2,(void*)gkronecker,4,"GG"},
2183: {"lcm",99,(void*)glcm0,4,"GDG"},
2184: {"length",10,(void*)glength,2,"lG"},
2185: {"lex",20,(void*)lexcmp,1,"lGG"},
2186: {"lift",99,(void*)lift0,2,"GDn"},
2187: {"lindep",99,(void*)lindep0,8,"GD0,L,p"},
2188: {"listcreate",11,(void*)listcreate,8,"L"},
2189: {"listinsert",99,(void*)listinsert,8,"GGL"},
2190: {"listkill",99,(void*)listkill,8,"vG"},
2191: {"listput",25,(void*)listput,8,"GGD0,L,"},
2192: {"listsort",99,(void*)listsort,8,"GD0,L,"},
2193: {"lngamma",1,(void*)glngamma,3,"Gp"},
1.2 ! noro 2194: {"log",99,(void*)log0,99,"GD0,M,p\nAGM==1"},
1.1 noro 2195: {"matadjoint",18,(void*)adj,8,"G"},
2196: {"matalgtobasis",2,(void*)matalgtobasis,6,"GG"},
2197: {"matbasistoalg",2,(void*)matbasistoalg,6,"GG"},
2198: {"matcompanion",18,(void*)assmat,8,"G"},
2199: {"matdet",99,(void*)det0,8,"GD0,L,"},
2200: {"matdetint",18,(void*)detint,8,"G"},
2201: {"matdiagonal",18,(void*)diagonal,8,"G"},
2202: {"mateigen",1,(void*)eigen,8,"Gp"},
2203: {"mathess",18,(void*)hess,8,"G"},
2204: {"mathilbert",11,(void*)mathilbert,8,"L"},
2205: {"mathnf",99,(void*)mathnf0,8,"GD0,L,"},
2206: {"mathnfmod",2,(void*)hnfmod,8,"GG"},
2207: {"mathnfmodid",2,(void*)hnfmodid,8,"GG"},
2208: {"matid",11,(void*)idmat,8,"L"},
2209: {"matimage",99,(void*)matimage0,8,"GD0,L,"},
2210: {"matimagecompl",18,(void*)imagecompl,8,"G"},
2211: {"matindexrank",18,(void*)indexrank,8,"G"},
2212: {"matintersect",2,(void*)intersect,8,"GG"},
2213: {"matinverseimage",2,(void*)inverseimage,8,"GG"},
2214: {"matisdiagonal",10,(void*)isdiagonal,8,"lG"},
2215: {"matker",99,(void*)matker0,8,"GD0,L,"},
2216: {"matkerint",99,(void*)matkerint0,8,"GD0,L,"},
2217: {"matmuldiagonal",2,(void*)matmuldiagonal,8,"GG"},
2218: {"matmultodiagonal",2,(void*)matmultodiagonal,8,"GG"},
2219: {"matpascal",99,(void*)matqpascal,8,"LDG"},
2220: {"matrank",10,(void*)rank,8,"lG"},
2221: {"matrix",49,(void*)matrice,8,"GGDVDVDI"},
2222: {"matrixqz",2,(void*)matrixqz0,8,"GG"},
2223: {"matsize",18,(void*)matsize,8,"G"},
2224: {"matsnf",99,(void*)matsnf0,8,"GD0,L,"},
2225: {"matsolve",2,(void*)gauss,8,"GG"},
2226: {"matsolvemod",99,(void*)matsolvemod0,8,"GGGD0,L,"},
2227: {"matsupplement",18,(void*)suppl,8,"G"},
2228: {"mattranspose",18,(void*)gtrans,8,"G"},
2229: {"max",2,(void*)gmax,1,"GG"},
2230: {"min",2,(void*)gmin,1,"GG"},
2231: {"modreverse",18,(void*)polymodrecip,6,"G"},
2232: {"moebius",18,(void*)gmu,4,"G"},
2233: {"newtonpoly",2,(void*)newtonpoly,6,"GG"},
2234: {"next",0,(void*)next0,11,"D1,L,"},
2235: {"nextprime",18,(void*)gnextprime,4,"G"},
2236: {"nfalgtobasis",2,(void*)algtobasis,6,"GG"},
2237: {"nfbasis",99,(void*)nfbasis0,6,"GD0,L,DG"},
2238: {"nfbasistoalg",2,(void*)basistoalg,6,"GG"},
2239: {"nfdetint",2,(void*)nfdetint,6,"GG"},
2240: {"nfdisc",99,(void*)nfdiscf0,6,"GD0,L,DG"},
2241: {"nfeltdiv",3,(void*)element_div,6,"GGG"},
2242: {"nfeltdiveuc",3,(void*)nfdiveuc,6,"GGG"},
2243: {"nfeltdivmodpr",4,(void*)element_divmodpr,6,"GGGG"},
2244: {"nfeltdivrem",3,(void*)nfdivres,6,"GGG"},
2245: {"nfeltmod",3,(void*)nfmod,6,"GGG"},
2246: {"nfeltmul",3,(void*)element_mul,6,"GGG"},
1.2 ! noro 2247: {"nfeltmulmodpr",4,(void*)element_mulmodpr,6,"GGGG"},
1.1 noro 2248: {"nfeltpow",3,(void*)element_pow,6,"GGG"},
2249: {"nfeltpowmodpr",4,(void*)element_powmodpr,6,"GGGG"},
2250: {"nfeltreduce",3,(void*)element_reduce,6,"GGG"},
1.2 ! noro 2251: {"nfeltreducemodpr",3,(void*)nfreducemodpr,6,"GGG"},
1.1 noro 2252: {"nfeltval",30,(void*)element_val,6,"lGGG"},
2253: {"nffactor",99,(void*)nffactor,6,"GG"},
2254: {"nffactormod",99,(void*)nffactormod,6,"GGG"},
2255: {"nfgaloisapply",3,(void*)galoisapply,6,"GGG"},
2256: {"nfgaloisconj",99,(void*)galoisconj0,6,"GD0,L,DGp"},
2257: {"nfhilbert",99,(void*)nfhilbert0,6,"lGGGDG"},
2258: {"nfhnf",2,(void*)nfhermite,6,"GG"},
2259: {"nfhnfmod",3,(void*)nfhermitemod,6,"GGG"},
2260: {"nfinit",99,(void*)nfinit0,6,"GD0,L,p"},
2261: {"nfisideal",20,(void*)isideal,6,"lGG"},
2262: {"nfisincl",2,(void*)nfisincl,6,"GG"},
2263: {"nfisisom",2,(void*)nfisisom,6,"GG"},
2264: {"nfkermodpr",3,(void*)nfkermodpr,6,"GGG"},
2265: {"nfmodprinit",2,(void*)nfmodprinit,6,"GG"},
2266: {"nfnewprec",1,(void*)nfnewprec,6,"Gp"},
2267: {"nfroots",99,(void*)nfroots,6,"GG"},
2268: {"nfrootsof1",18,(void*)rootsof1,6,"G"},
2269: {"nfsnf",2,(void*)nfsmith,6,"GG"},
2270: {"nfsolvemodpr",4,(void*)nfsolvemodpr,6,"GGGG"},
2271: {"nfsubfields",99,(void*)subfields0,6,"GDG"},
2272: {"norm",18,(void*)gnorm,2,"G"},
2273: {"norml2",18,(void*)gnorml2,2,"G"},
2274: {"numdiv",18,(void*)gnumbdiv,4,"G"},
2275: {"numerator",18,(void*)numer,2,"G"},
2276: {"numtoperm",24,(void*)numtoperm,2,"LG"},
2277: {"omega",18,(void*)gomega,4,"G"},
2278: {"padicappr",2,(void*)apprgen9,7,"GG"},
2279: {"padicprec",20,(void*)padicprec,2,"lGG"},
2280: {"permtonum",18,(void*)permtonum,2,"G"},
2281: {"polcoeff",99,(void*)polcoeff0,7,"GLDn"},
2282: {"polcompositum",25,(void*)polcompositum0,6,"GGD0,L,"},
2283: {"polcyclo",99,(void*)cyclo,7,"LDn"},
2284: {"poldegree",99,(void*)poldegree,7,"lGDn"},
2285: {"poldisc",99,(void*)poldisc0,7,"GDn"},
2286: {"poldiscreduced",18,(void*)reduceddiscsmith,7,"G"},
2287: {"polgalois",99,(void*)galois,6,"Gp"},
2288: {"polhensellift",99,(void*)polhensellift,7,"GGGL"},
2289: {"polinterpolate",31,(void*)polint,7,"GDGDGD&"},
2290: {"polisirreducible",18,(void*)gisirreducible,7,"G"},
2291: {"pollead",99,(void*)pollead,7,"GDn"},
2292: {"pollegendre",99,(void*)legendre,7,"LDn"},
2293: {"polrecip",18,(void*)polrecip,7,"G"},
1.2 ! noro 2294: {"polred",99,(void*)polred0,6,"GD0,L,DG"},
! 2295: {"polredabs",99,(void*)polredabs0,6,"GD0,L,"},
! 2296: {"polredord",1,(void*)ordred,6,"G"},
1.1 noro 2297: {"polresultant",99,(void*)polresultant0,7,"GGDnD0,L,"},
2298: {"polroots",99,(void*)roots0,7,"GD0,L,p"},
2299: {"polrootsmod",25,(void*)rootmod0,7,"GGD0,L,"},
2300: {"polrootspadic",32,(void*)rootpadic,7,"GGL"},
2301: {"polsturm",99,(void*)sturmpart,7,"lGDGDG"},
1.2 ! noro 2302: {"polsubcyclo",99,(void*)polsubcyclo,7,"LLDn"},
1.1 noro 2303: {"polsylvestermatrix",2,(void*)sylvestermatrix,7,"GG"},
2304: {"polsym",21,(void*)polsym,7,"GL"},
2305: {"poltchebi",99,(void*)tchebi,7,"LDn"},
2306: {"poltschirnhaus",18,(void*)tschirnhaus,6,"G"},
2307: {"polylog",99,(void*)polylog0,3,"LGD0,L,p"},
2308: {"polzagier",99,(void*)polzag,7,"LL"},
2309: {"precision",99,(void*)precision0,2,"GD0,L,"},
2310: {"precprime",18,(void*)gprecprime,4,"G"},
2311: {"prime",11,(void*)prime,4,"L"},
2312: {"primes",11,(void*)primes,4,"L"},
2313: {"prod",47,(void*)produit,9,"V=GGEDG"},
2314: {"prodeuler",37,(void*)prodeuler,9,"V=GGEp"},
2315: {"prodinf",99,(void*)prodinf0,9,"V=GED0,L,p"},
2316: {"psi",1,(void*)gpsi,3,"Gp"},
2317: {"qfbclassno",99,(void*)qfbclassno0,4,"GD0,L,"},
2318: {"qfbcompraw",2,(void*)compraw,4,"GG"},
2319: {"qfbhclassno",18,(void*)hclassno,4,"G"},
2320: {"qfbnucomp",3,(void*)nucomp,4,"GGG"},
2321: {"qfbnupow",2,(void*)nupow,4,"GG"},
2322: {"qfbpowraw",23,(void*)powraw,4,"GL"},
2323: {"qfbprimeform",29,(void*)primeform,4,"GGp"},
2324: {"qfbred",99,(void*)qfbred0,4,"GD0,L,DGDGDG"},
2325: {"qfgaussred",18,(void*)sqred,8,"G"},
2326: {"qfjacobi",1,(void*)jacobi,8,"Gp"},
2327: {"qflll",99,(void*)qflll0,8,"GD0,L,p"},
2328: {"qflllgram",99,(void*)qflllgram0,8,"GD0,L,p"},
2329: {"qfminim",33,(void*)qfminim0,8,"GGGD0,L,p"},
2330: {"qfperfection",18,(void*)perf,8,"G"},
2331: {"qfsign",18,(void*)signat,8,"G"},
2332: {"quadclassunit",96,(void*)quadclassunit0,4,"GD0,L,DGp"},
2333: {"quaddisc",18,(void*)quaddisc,4,"G"},
2334: {"quadgen",18,(void*)quadgen,4,"G"},
2335: {"quadhilbert",99,(void*)quadhilbert,4,"GDGp"},
2336: {"quadpoly",99,(void*)quadpoly0,4,"GDn"},
2337: {"quadray",99,(void*)quadray,4,"GGDGp"},
2338: {"quadregulator",1,(void*)gregula,4,"Gp"},
2339: {"quadunit",1,(void*)gfundunit,4,"Gp"},
2340: {"random",0,(void*)genrand,2,"DG"},
2341: {"real",18,(void*)greal,2,"G"},
2342: {"removeprimes",0,(void*)removeprimes,4,"DG"},
2343: {"reorder",0,(void*)reorder,11,"DG"},
2344: {"return",0,(void*)return0,11,"DG"},
2345: {"rnfalgtobasis",2,(void*)rnfalgtobasis,6,"GG"},
2346: {"rnfbasis",2,(void*)rnfbasis,6,"GG"},
2347: {"rnfbasistoalg",2,(void*)rnfbasistoalg,6,"GG"},
2348: {"rnfcharpoly",99,(void*)rnfcharpoly,6,"GGGDn"},
2349: {"rnfconductor",99,(void*)rnfconductor,6,"GGD0,L,"},
2350: {"rnfdedekind",99,(void*)rnfdedekind,6,"GGG"},
2351: {"rnfdet",99,(void*)rnfdet0,6,"GGDG"},
2352: {"rnfdisc",2,(void*)rnfdiscf,6,"GG"},
2353: {"rnfeltabstorel",2,(void*)rnfelementabstorel,6,"GG"},
2354: {"rnfeltdown",2,(void*)rnfelementdown,6,"GG"},
2355: {"rnfeltreltoabs",2,(void*)rnfelementreltoabs,6,"GG"},
2356: {"rnfeltup",2,(void*)rnfelementup,6,"GG"},
2357: {"rnfequation",25,(void*)rnfequation0,6,"GGD0,L,"},
2358: {"rnfhnfbasis",2,(void*)rnfhermitebasis,6,"GG"},
2359: {"rnfidealabstorel",2,(void*)rnfidealabstorel,6,"GG"},
2360: {"rnfidealdown",2,(void*)rnfidealdown,6,"GG"},
2361: {"rnfidealhnf",2,(void*)rnfidealhermite,6,"GG"},
2362: {"rnfidealmul",3,(void*)rnfidealmul,6,"GGG"},
2363: {"rnfidealnormabs",2,(void*)rnfidealnormabs,6,"GG"},
2364: {"rnfidealnormrel",2,(void*)rnfidealnormrel,6,"GG"},
2365: {"rnfidealreltoabs",2,(void*)rnfidealreltoabs,6,"GG"},
2366: {"rnfidealtwoelt",2,(void*)rnfidealtwoelement,6,"GG"},
2367: {"rnfidealup",2,(void*)rnfidealup,6,"GG"},
2368: {"rnfinit",29,(void*)rnfinitalg,6,"GGp"},
2369: {"rnfisfree",20,(void*)rnfisfree,6,"lGG"},
1.2 ! noro 2370: {"rnfisnorm",99,(void*)rnfisnorm,6,"GGD0,L,"},
! 2371: {"rnfisnorminit",99,(void*)rnfisnorminit,6,"GGD2,L,"},
! 2372: {"rnfkummer",99,(void*)rnfkummer,6,"GDGD0,L,p"},
1.1 noro 2373: {"rnflllgram",99,(void*)rnflllgram,6,"GGGp"},
2374: {"rnfnormgroup",2,(void*)rnfnormgroup,6,"GG"},
2375: {"rnfpolred",29,(void*)rnfpolred,6,"GGp"},
1.2 ! noro 2376: {"rnfpolredabs",99,(void*)rnfpolredabs,6,"GGD0,L,"},
1.1 noro 2377: {"rnfpseudobasis",2,(void*)rnfpseudobasis,6,"GG"},
2378: {"rnfsteinitz",2,(void*)rnfsteinitz,6,"GG"},
2379: {"round",99,(void*)round0,2,"GD&"},
2380: {"serconvol",2,(void*)convol,7,"GG"},
2381: {"serlaplace",18,(void*)laplace,7,"G"},
2382: {"serreverse",18,(void*)recip,7,"G"},
2383: {"setintersect",2,(void*)setintersect,8,"GG"},
2384: {"setisset",10,(void*)setisset,8,"lG"},
2385: {"setminus",2,(void*)setminus,8,"GG"},
2386: {"setrand",99,(void*)setrand,11,"lL"},
2387: {"setsearch",99,(void*)setsearch,8,"lGGD0,L,"},
2388: {"setunion",2,(void*)setunion,8,"GG"},
1.2 ! noro 2389: {"shift",99,(void*)gshift3,1,"GLD0,L,"},
1.1 noro 2390: {"shiftmul",99,(void*)gmul2n,1,"GL"},
2391: {"sigma",99,(void*)gsumdivk,4,"GD1,L,"},
2392: {"sign",10,(void*)gsigne,1,"lG"},
2393: {"simplify",18,(void*)simplify,2,"G"},
2394: {"sin",1,(void*)gsin,3,"Gp"},
2395: {"sinh",1,(void*)gsh,3,"Gp"},
2396: {"sizebyte",10,(void*)taille2,2,"lG"},
2397: {"sizedigit",10,(void*)sizedigit,2,"lG"},
2398: {"solve",37,(void*)zbrent,9,"V=GGEp"},
2399: {"sqr",18,(void*)gsqr,3,"G"},
2400: {"sqrt",1,(void*)gsqrt,3,"Gp"},
2401: {"sqrtint",18,(void*)racine,4,"G"},
2402: {"sqrtn",99,(void*)gsqrtn,3,"GGD&p"},
1.2 ! noro 2403: {"subgrouplist",99,(void*)subgrouplist0,6,"GDGD0,L,p"},
1.1 noro 2404: {"subst",99,(void*)gsubst0,7,"GGG"},
2405: {"sum",48,(void*)somme,9,"V=GGEDG"},
2406: {"sumalt",99,(void*)sumalt0,9,"V=GED0,L,p"},
2407: {"sumdiv",22,(void*)divsum,9,"GVE"},
2408: {"suminf",27,(void*)suminf,9,"V=GEp"},
2409: {"sumpos",99,(void*)sumpos0,9,"V=GED0,L,p"},
2410: {"tan",1,(void*)gtan,3,"Gp"},
2411: {"tanh",1,(void*)gth,3,"Gp"},
2412: {"taylor",12,(void*)tayl,7,"GnP"},
2413: {"teichmuller",18,(void*)teich,3,"G"},
2414: {"theta",29,(void*)theta,3,"GGp"},
2415: {"thetanullk",99,(void*)thetanullk,3,"GLp"},
2416: {"thue",99,(void*)thue,7,"GGDG"},
2417: {"thueinit",99,(void*)thueinit,7,"GD0,L,p"},
2418: {"trace",18,(void*)gtrace,8,"G"},
2419: {"truncate",99,(void*)trunc0,2,"GD&"},
2420: {"until",82,NULL,11,NULL},
2421: {"valuation",20,(void*)ggval,2,"lGG"},
2422: {"variable",18,(void*)gpolvar,2,"G"},
2423: {"vecextract",99,(void*)extract0,8,"GGDG"},
2424: {"vecmax",18,(void*)vecmax,1,"G"},
2425: {"vecmin",18,(void*)vecmin,1,"G"},
2426: {"vecsort",99,(void*)vecsort0,8,"GDGD0,L,"},
2427: {"vector",28,(void*)vecteur,8,"GDVDI"},
1.2 ! noro 2428: {"vectorsmall",28,(void*)vecteursmall,8,"GDVDI"},
1.1 noro 2429: {"vectorv",28,(void*)vvecteur,8,"GDVDI"},
2430: {"weber",99,(void*)weber0,3,"GD0,L,p"},
2431: {"while",81,NULL,11,NULL},
2432: {"zeta",1,(void*)gzeta,3,"Gp"},
2433: {"zetak",99,(void*)gzetakall,6,"GGD0,L,p"},
2434: {"zetakinit",1,(void*)initzeta,6,"Gp"},
2435: {"znlog",2,(void*)znlog,4,"GG"},
2436: {"znorder",18,(void*)order,4,"G"},
2437: {"znprimroot",18,(void*)ggener,4,"G"},
2438: {"znstar",18,(void*)znstar,4,"G"},
2439:
2440: /* DO NOT REMOVE THIS BLANK LINE: chname & helpsynchro depend on it */
2441: {NULL,0,NULL,0,NULL} /* sentinel */
2442: };
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to init.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 / language