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