home *** CD-ROM | disk | FTP | other *** search
/ RISC DISC 2 / RISC_DISC_2.iso / pd_share / program / code / pari / c / gp < prev    next >
Encoding:
Text File  |  1991-12-19  |  14.3 KB  |  487 lines
  1. /*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/
  2. /*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/
  3. /*@                                                               @*/
  4. /*@                        PARI CALCULATOR                        @*/
  5. /*@                                                               @*/
  6. /*@                      copyright Babe Cool                      @*/
  7. /*@                                                               @*/
  8. /*@                                                               @*/
  9. /*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/
  10. /*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/
  11.  
  12. #include "genpari.h"
  13.  
  14. long    champ, dec, nbchi, avloc, avglob;
  15. long    prettyp = 1, chrono = 0;
  16. char    prompt[79], format;
  17.  
  18. #define NUMGLOB sizeof(globales)/4
  19.   
  20.   static char *globales[] = {"precision", "serieslength", "format", "prompt"};
  21.  
  22. void escape();
  23. void commands(), gentypes(), aide(), globs();
  24. long timer();
  25.  
  26. char* findsep(t)
  27.      char **t;
  28. {
  29.   char *s1;
  30.   static char s2[80];
  31.   int i;
  32.   
  33.   for(s1 = *t, i = 0; (i < 79) && (*s1) && (!separe(*s1)); i++) s2[i] = *s1++;
  34.   while ((*s1) && (!separe(*s1))) s1++;
  35.   s2[i] = 0; *t = s1;
  36.   return s2;
  37. }
  38.  
  39. void checkok(t)
  40.      char *t;
  41. {
  42.   char c = *t;
  43.   if((c) && (!separe(c))) err(caracer1,t);
  44. }
  45.  
  46. long getint(ch, n)
  47.      char *ch;
  48.      long n;
  49. {
  50.   long av = avma;
  51.   filtre(ch);
  52.   if (*ch) n = itos(readexpr(&ch));
  53.   avma = av; return n;
  54. }
  55. void usage(s)
  56.      char *s;
  57. {
  58.   pariputs("   ### usage: ");
  59.   pariputs(s);
  60.   pariputs("[-s stacksize] [-p primelimit] [-b buffersize]\n");
  61.   exit(0);
  62. }
  63.  
  64. main(argc,argv) 
  65.      long argc;
  66.      char **argv;
  67.      
  68. {
  69.   
  70.   long  i,typy, parisize, primelimit, silent;
  71.   static long tloc,listloc;
  72.   char  *buffer, *tch, *tch2, thestring[100];
  73.   GEN  z;
  74.   long tmpparibuffsize=0;
  75.  
  76. #ifdef macintosh
  77.   strcpy(prompt,"?\n"); parisize = 1000000; primelimit = 200000;
  78. #else
  79. #ifdef RISC_OS
  80.   strcpy(prompt,"? "); parisize = 1000000; primelimit = 200000;
  81. #else
  82.   strcpy(prompt,"? "); parisize = 4000000; primelimit = 500000;
  83. #endif
  84. #endif
  85.   for(i = 1; i < argc; i++)
  86.     {
  87.       tch = argv[i++];
  88.       if ((i == argc) || (*tch++ != '-')) usage(argv[0]);
  89.       if (*tch == 's') parisize = atoi(argv[i]);
  90.       else if (*tch == 'p') primelimit = atoi(argv[i]);
  91.       else if (*tch == 'b') tmpparibuffsize = atoi(argv[i]);
  92.       else usage(argv[0]);
  93.     }
  94.   
  95.   printversion();
  96.   pariputs("\n    Authors: C. Batut, D. Bernardi, H. Cohen and M. Olivier\n\n");
  97.   init(parisize, primelimit);
  98.   if(tmpparibuffsize) paribuffsize=tmpparibuffsize;
  99.   buffer = (char *)malloc(paribuffsize);
  100.  
  101.   avglob = avloc = avma;
  102.   tglobal=0;chrono=0;
  103.   prec=5;precdl=16;dec=28;nbchi=28;champ=0;format='g';
  104.   
  105.   pariputs("Type \\d, \\c, \\t, or ?command for help, \\q to exit, # for timing\n\n");
  106.   globs(parisize,primelimit);
  107.   
  108.   for(;;)
  109.     {
  110.       avloc = avma; tloc = tglobal; listloc = marklist();
  111.       if (setjmp(environnement)) {avma = avloc; tglobal = tloc; recover(listloc);}
  112.       if(infile==stdin) pariputs(prompt);
  113.       if (!fgets(buffer, paribuffsize, infile)) {switchin(NULL); continue;}
  114.       if (pariecho) pariputs(buffer); else if (logfile) fputs(buffer, logfile);
  115.       tch = buffer + 1;
  116.       switch(buffer[0])
  117.     {
  118.     case '#':
  119.       checkok(tch);
  120.       pariputs((chrono = !chrono) ? "    timer on\n" : "    timer off\n");
  121.       continue;
  122.     case '?': aide(findsep(&tch)); pariputc('\n'); continue;
  123.     case '\\': escape(tch,parisize,primelimit); continue;
  124.     case '{':
  125.       for(;;)
  126.         {
  127.           tch2 = buffer + strlen(buffer) - 1;
  128.           if (*tch2 == '\n') tch2--;
  129.           if (*tch2 == '}') {*tch2-- = 0; break;}
  130.           if (*tch2 != '\\') tch2++;
  131.           if(!fgets(tch2, paribuffsize - (tch2 - buffer), infile)) break;
  132.           if(pariecho) pariputs(tch2); else if (logfile) fputs(tch2, logfile);
  133.         }
  134.       break;
  135.     default:
  136.       for(tch--;;)
  137.         {
  138.           tch2 = buffer + strlen(buffer) - 1;
  139.           if (*tch2 == '\n') tch2--;
  140.           if (*tch2 != '\\') {tch2[1] = 0; break;}
  141.           if(!fgets(tch2, paribuffsize - (tch2 - buffer), infile)) break;
  142.           if(pariecho) pariputs(tch2); else if (logfile) fputs(tch2, logfile);
  143.         }                            
  144.       break;
  145.     }
  146.       silent = separe(*tch2);
  147.       filtre(tch);
  148.       fflush(outfile); if (logfile) fflush(logfile);
  149.       if (chrono) timer();
  150.       z = readseq(&tch);
  151.       nbchi=dec=glbfmt[2];
  152.       if (*tch) {pariputs("  unused characters: "); pariputs(tch); pariputc('\n');}
  153.       if (chrono)
  154.     {
  155.       long delay = timer();
  156.       pariputs("time = ");
  157.       if (delay >= 3600000)
  158.         {
  159.           sprintf(thestring, "%dh, ", delay / 3600000);
  160.           delay %= 3600000;
  161.           pariputs(thestring);
  162.         }
  163.       if (delay >= 60000)
  164.         {
  165.           sprintf(thestring, "%dmn, ", delay / 60000);
  166.           delay %= 60000;
  167.           pariputs(thestring);
  168.         }
  169.       if (delay >= 1000)
  170.         {
  171.           sprintf(thestring, "%d,", delay / 1000);
  172.           delay %= 1000;
  173.           pariputs(thestring);
  174.               if (delay < 100) pariputc('0');
  175.               if (delay < 10) pariputc('0');
  176.         }
  177.       sprintf(thestring, "%d ms\n", delay);
  178.       pariputs(thestring);
  179.     }
  180.       if (z == gnil) continue;
  181.       g[0] = g[++tglobal] = isonstack(z) ? z : gcopy(z);
  182.       typy=typ(z);
  183.       if (!separe(*tch2))
  184.     {
  185.       sprintf(thestring, "%%%d = ",tglobal);
  186.       pariputs(thestring);
  187.       if ((typy > 16) && (prettyp==2)) pariputc('\n');;
  188.       if(nbchi < 0)
  189.         if(prettyp==2) sor(z, format, -1, champ);
  190.         else if(prettyp) matbrute(z, format, -1);
  191.         else brute(z, format, -1);
  192.       else
  193.         if (typy < 3) ecrire(z, format, nbchi, 0);
  194.         else 
  195.           if(prettyp==2) sor(z, format, nbchi, champ);
  196.           else if(prettyp) matbrute(z, format, nbchi);
  197.           else brute(z, format, nbchi);
  198.       pariputc('\n'); 
  199.     }
  200.     } /* for(;;) */
  201. } /* main */
  202.  
  203. /********************************************************************/
  204. /********************************************************************/
  205. /**                                                                **/
  206. /**                    COMMANDES COMMENCANT PAR \                  **/
  207. /**                                                                **/
  208. /**                     ET ANALOGUES DANS ANAL.C                   **/
  209. /**                                                                **/
  210. /********************************************************************/
  211. /********************************************************************/
  212.  
  213. void escape(tch,parisize,primelimit)
  214.      char *tch;
  215.      long parisize,primelimit;
  216. {
  217.   int i, d;
  218.   char c, *s1, *s2, thestring[50];
  219.   
  220.   for (i=0;i<NUMGLOB;i++)
  221.     {
  222.       s1 = tch;
  223.       s2 = globales[i];
  224.       while ((*s2) && (*s1 == *s2)) {s1++; s2++;}
  225.       while (isspace(*s1)) s1++;
  226.       if (!*s2 && (*s1++ == '=')) 
  227.     switch (i) 
  228.       {
  229.       case 0: 
  230.         glbfmt[2] = nbchi = dec = getint(s1, dec);
  231.         prec = dec * K1 + 3;
  232.         sprintf(thestring, "   precision = %d significant digits\n",dec);
  233.         pariputs(thestring);
  234.         return;
  235.       case 1:
  236.         precdl = getint(s1);
  237.         sprintf(thestring, "   series precision = %d significant terms\n",precdl);
  238.         pariputs(thestring);
  239.         return;
  240.       case 2:
  241.         format = *s1++;
  242.         if(isdigit(*s1))
  243.           for(champ = 0; isdigit(*s1); s1++)
  244.         champ = 10 * champ + *s1 - '0';
  245.         if(*s1++ == '.')
  246.           if(*s1 == '-')
  247.         nbchi = -1;
  248.           else
  249.         if(isdigit(*s1))
  250.           for(nbchi = 0; isdigit(*s1); s1++)
  251.             nbchi = 10 * nbchi + *s1 - '0';
  252.         sprintf(thestring, "   real format = %c%d.%d\n", format, champ, nbchi);
  253.         pariputs(thestring);
  254.         glbfmt[0] = format; glbfmt[1] = champ; glbfmt[2] = nbchi;
  255.         return;
  256.       case 3:
  257.         strcpy(prompt, findsep(&s1));
  258. #ifdef macintosh
  259.         strcat(prompt,"\n");
  260. #else
  261.         strcat(prompt," ");
  262. #endif
  263.         return;
  264.       }
  265.     }
  266.   c = *tch++;
  267.   switch (isupper(c) ? tolower(c) : c)
  268.     {
  269.     case 'a': brute(g[getint(tch, tglobal)], format, -1);pariputc('\n');break;
  270.     case 'b': sor(g[getint(tch, tglobal)], format, -1, champ);pariputc('\n');
  271.       break;
  272.     case 'c': checkok(tch); commands(); break;
  273.     case 'd': checkok(tch); globs(parisize,primelimit); break;
  274.     case 'e': checkok(tch); pariecho = !pariecho; break;
  275.     case 'k': checkok(tch);
  276.       avma = avloc = avglob;
  277.       tglobal = chrono = 0;
  278.       gpi = geuler = bernzone = (GEN)0;
  279.       prec = 5; precdl = 16; dec = 28; nbchi = 28; champ = 0; format = 'g';
  280. #ifdef macintosh
  281.       strcpy(prompt,"?\n");
  282. #else
  283.       strcpy(prompt,"? ");
  284. #endif
  285.       for (i = 0; i < STACKSIZE; i++) g[i] = gzero;
  286.       globs(parisize,primelimit);
  287.       break;
  288.     case 'l': checkok(tch); fliplog(); break;
  289.     case 'm': matbrute(g[getint(tch, tglobal)], format, -1);pariputc('\n');
  290.       break;
  291.     case 'p': checkok(tch); prettyp = (prettyp==2)?0:prettyp+1;
  292.       if(prettyp==2) 
  293.     {
  294.       sprintf(thestring, "   default format: prettyprint\n");
  295.       pariputs(thestring);
  296.     }
  297.       else if(prettyp)
  298.     {
  299.       sprintf(thestring, "   default format: prettymatrix\n");
  300.       pariputs(thestring);
  301.     }
  302.       else
  303.     {
  304.       sprintf(thestring, "   default format: raw\n");
  305.       pariputs(thestring);
  306.     }
  307.       break;
  308.     case 'q': exit(0);
  309.     case 'r': while(isspace(*tch)) tch++; switchin(findsep(&tch)); break;
  310.     case 's': etatpile(getint(tch, 0)); break;
  311.     case 't': checkok(tch); gentypes(); break;
  312.     case 'v': checkok(tch); printversion(); break;
  313.     case 'w':
  314.       while(isspace(*tch)) tch++;
  315.       for (d = 0; isdigit(*tch);) d = 10 * d + *tch++ - '0';
  316.       while(isspace(*tch)) tch++;
  317.       switchout(findsep(&tch));
  318.       brute(g[d ? d : tglobal], format, -1);
  319.       pariputc('\n'); switchout(NULL); break;
  320.     case 'x': voir(g[tglobal], getint(tch, -1)); break;
  321.     case '\\': break;
  322.     default: err(caracer1,tch+1);
  323.     }
  324. }
  325.  
  326. /********************************************************************/
  327. /********************************************************************/
  328. /**                                                                **/
  329. /**           AFFICHAGE TYPES, COMMANDES AIDES ET GLOBALES         **/
  330. /**                                                                **/
  331. /********************************************************************/
  332. /********************************************************************/
  333.  
  334. void gentypes()
  335.      
  336. {
  337.   pariputs("\n      List of the PARI types :");
  338.   pariputs("\n     -------------------------\n\n");
  339.   pariputs("  1  :long integers     [ cod1 ] [ cod2 ] [ man1 ] ... [ manl ]\n");
  340.   pariputs("  2  :long real numbers [ cod1 ] [ cod2 ] [ man1 ] ... [ manl ]\n");
  341.   pariputs("  3  :integermods       [ code ] [ mod  ] [ integer ]\n");
  342.   pariputs("  4  :irred. rationals  [ code ] [ num. ] [ den. ] \n");
  343.   pariputs("  5  :rational numbers  [ code ] [ num. ] [ den. ] \n");
  344.   pariputs("  6  :complex numbers   [ code ] [ real ] [ imag ] \n");
  345.   pariputs("  7  :p-adic numbers    [ cod1 ] [ cod2 ] [ p ] [ p^r ] [ integer]\n");
  346.   pariputs("  8  :quadratic numbers [ cod1 ] [ mod  ] [ real ] [ imag ]\n");
  347.   pariputs("  9  :polymods          [ code ] [ mod  ] [ polynomial ]\n");
  348.   pariputs(" -------------------------------------------------------------\n");
  349.   pariputs("  10 :polynomials       [ cod1 ] [ cod2 ] [ man1 ] ... [ manl ]\n");
  350.   pariputs("  11 :power series      [ cod1 ] [ cod2 ] [ man1 ] ... [ manl ]\n");
  351.   pariputs("  13 :irred. rat. func. [ code ] [ num. ] [ den. ]\n");
  352.   pariputs("  14 :rational function [ code ] [ num. ] [ den. ]\n");
  353.   pariputs("  17 :row vector        [ code ] [  x1  ] ... [  xl  ]  \n");
  354.   pariputs("  18 :column vector     [ code ] [  x1  ] ... [  xl  ]  \n");
  355.   pariputs("  19 :matrix            [ code ] [ col1 ] ... [ coll ]\n");
  356. }
  357.  
  358. void commands()
  359. {
  360.   int i, w, lig = 0, col = 0;
  361.   
  362.   pariputc('\n');
  363.   for (i = 0; i < NUMFUNC; i++)
  364.     {
  365.       w = strlen(fonctions[i].name);
  366.       if ((col == 72) || (col + w >= 80))
  367.       {
  368.         pariputc('\n'); col = 0;
  369.         if (!(++lig % 10)) pariputc('\n');
  370.         if (!(lig % 20)) {pariputs("---- (type return to continue) ----\n");getchar();}
  371.       }
  372.       pariputs(fonctions[i].name);
  373.       col += w;
  374.       do {pariputc(' '); col++;} while (col % 12);
  375.     }
  376.   pariputc('\n');
  377. }
  378.  
  379. void globs(parisize,primelimit)
  380.      long parisize,primelimit;
  381. {
  382.   int i, j;
  383.   char thestring[70];
  384.   
  385.   for (i = 0; i < NUMGLOB; i++)
  386.     {
  387.       pariputc('\\'); pariputs(globales[i]);
  388.       for(j = strlen(globales[i]); j < 15; j++) pariputc(' ');
  389.       pariputs("= ");
  390.       switch (i)
  391.     {
  392.     case 0: sprintf(thestring, "%d",dec);break;
  393.     case 1: sprintf(thestring, "%d",precdl);break;
  394.     case 2: sprintf(thestring, "%c%d.%d",format,champ,nbchi);break;
  395.     case 3: sprintf(thestring, "%s",prompt);break;
  396.     }
  397.       pariputs(thestring); pariputc('\n');
  398.     }
  399.   sprintf(thestring, "stacksize = %ld, prime limit = %ld, buffersize = %ld",parisize, primelimit, paribuffsize);pariputs(thestring);
  400.   pariputc('\n');
  401. }
  402.  
  403. void aide(s)
  404.      char *s;
  405.      
  406. {
  407.   long  i, n, nparam;
  408.   char  *u = s;
  409.   entree *ep, **q;
  410.   
  411.   if (!*s) {commands(); return;}
  412.   for (n=0;n<NUMFUNC;n++)
  413.     if(!strcmp(fonctions[n].name,s))
  414.       {pariputs(helpmessage[n]); pariputc('.'); return;}
  415.   for(n = 0; isalnum(*u); u++) n = n << 1 ^ *u;
  416.   if (n < 0) n = -n; n %= TBLSZ;
  417.   for(ep = hashtable[n]; ep; ep = ep->next)
  418.     if(!strcmp(ep->name,s))
  419.       {
  420.     if (ep->valence != 100) break;
  421.     q = (entree **)(ep->value);
  422.     nparam = (long)*q++;
  423.     pariputs(ep->name);
  424.     pariputc('(');
  425.     for(i = 0; i < nparam; i++)
  426.       {
  427.         if(i) pariputc(',');
  428.         pariputs((*q++)->name);
  429.       }
  430.     pariputs(")= ");
  431.     pariputs(q);
  432.     return;
  433.       }
  434.   pariputs("Unknown function\n");
  435. }
  436.  
  437. /********************************************************************/
  438. /********************************************************************/
  439. /**                                                                **/
  440. /**                       MESURE DU TEMPS                          **/
  441. /**                                                                **/
  442. /********************************************************************/
  443. /********************************************************************/
  444.  
  445. #ifdef macintosh
  446.  
  447. pascal unsigned long TickCount(void) = 0xA975;
  448.      
  449. long timer()
  450. {
  451.   static long oldticks;
  452.   long ticks = TickCount();
  453.   long delay = ticks - oldticks;
  454.   oldticks = ticks;
  455.   return 50 * delay / 3;
  456. }
  457.  
  458. #else
  459.  
  460. #ifdef RISC_OS
  461. #include <time.h>
  462. long timer()
  463. { static long oldcsec;
  464.          long newcsec=clock();
  465.          long delay=(newcsec-oldcsec)*10;
  466.          oldcsec=newcsec;
  467.          return delay;
  468. }
  469. #else
  470.  
  471. long timer()
  472. {
  473.   static long oldmusec;
  474.   static long oldsec;
  475.   long delay;
  476.   struct rusage r;
  477.   struct timeval t;
  478.   getrusage(0,&r);t=r.ru_utime;
  479.   delay = 1000 * (t.tv_sec - oldsec) + (t.tv_usec - oldmusec) / 1000;
  480.   oldmusec = t.tv_usec;
  481.   oldsec = t.tv_sec;
  482.   return delay;
  483. }
  484.  
  485. #endif
  486. #endif
  487.