source: git/Singular/extra.cc @ fdca1c0

spielwiese
Last change on this file since fdca1c0 was fdca1c0, checked in by Viktor Levandovskyy <levandov@…>, 23 years ago
* levandov/hannes: preparations for HAVE_PLURAL (Makefile.in extra.cc pInline2.h structs.h gring.cc gring.h) git-svn-id: file:///usr/local/Singular/svn/trunk@4722 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 32.8 KB
Line 
1/*****************************************
2*  Computer Algebra System SINGULAR      *
3*****************************************/
4/* $Id: extra.cc,v 1.150 2000-11-13 14:50:21 levandov Exp $ */
5/*
6* ABSTRACT: general interface to internals of Singular ("system" command)
7*/
8
9#include <stdlib.h>
10#include <stdio.h>
11#include <string.h>
12#include <ctype.h>
13#include <signal.h>
14#include "mod2.h"
15
16#ifndef __MWERKS__
17#ifdef TIME_WITH_SYS_TIME
18# include <time.h>
19# ifdef HAVE_SYS_TIME_H
20#   include <sys/time.h>
21# endif
22#else
23# ifdef HAVE_SYS_TIME_H
24#   include <sys/time.h>
25# else
26#   include <time.h>
27# endif
28#endif
29#ifdef HAVE_SYS_TIMES_H
30#include <sys/times.h>
31#endif
32
33#endif
34#include <unistd.h>
35
36#include "tok.h"
37#include "ipid.h"
38#include "polys.h"
39#include "kutil.h"
40#include "cntrlc.h"
41#include "stairc.h"
42#include "ipshell.h"
43#include "algmap.h"
44#include "modulop.h"
45#include "febase.h"
46#include "matpol.h"
47#include "longalg.h"
48#include "ideals.h"
49#include "kstd1.h"
50#include "syz.h"
51#include "sdb.h"
52#include "feOpt.h"
53#include "distrib.h"
54#include "prCopy.h"
55#include "mpr_complex.h"
56
57#include "walk.h"
58
59#ifdef HAVE_SPECTRUM
60#include "spectrum.h"
61#endif
62
63#ifdef HAVE_PLURAL
64#include "gring.h"
65#endif
66
67// Define to enable many more system commands
68#ifndef MAKE_DISTRIBUTION
69#define HAVE_EXTENDED_SYSTEM
70#endif
71
72#ifdef HAVE_FACTORY
73#define SI_DONT_HAVE_GLOBAL_VARS
74#include "clapsing.h"
75#include "clapconv.h"
76#include "kstdfac.h"
77#endif
78
79#include "silink.h"
80#ifdef HAVE_MPSR
81#include "mpsr.h"
82#include "MPT_GP.h"
83#endif
84#include "walk.h"
85
86/*
87 *   New function/system-calls that will be included as dynamic module
88 * should be inserted here.
89 * - without HAVE_DYNAMIC_LOADING: these functions comes as system("....");
90 * - with    HAVE_DYNAMIC_LOADING: these functions are loaded as module.
91 */
92#ifndef HAVE_DYNAMIC_LOADING
93#ifdef HAVE_PCV
94#include "pcv.h"
95#endif
96#endif /* not HAVE_DYNAMIC_LOADING */
97
98// see clapsing.cc for a description of the `FACTORY_*' options
99
100#ifdef FACTORY_GCD_STAT
101#include "gcd_stat.h"
102#endif
103
104#ifdef FACTORY_GCD_TIMING
105#define TIMING
106#include "timing.h"
107TIMING_DEFINE_PRINTPROTO( contentTimer );
108TIMING_DEFINE_PRINTPROTO( algContentTimer );
109TIMING_DEFINE_PRINTPROTO( algLcmTimer );
110#endif
111
112void piShowProcList();
113#ifndef MAKE_DISTRIBUTION
114static BOOLEAN jjEXTENDED_SYSTEM(leftv res, leftv h);
115#endif
116
117
118//void emStart();
119/*2
120*  the "system" command
121*/
122BOOLEAN jjSYSTEM(leftv res, leftv args)
123{
124  if(args->Typ() == STRING_CMD)
125  {
126    const char *sys_cmd=(char *)(args->Data());
127    leftv h=args->next;
128// ONLY documented system calls go here
129// Undocumented system calls go down into #ifdef HAVE_EXTENDED_SYSTEM
130/*==================== nblocks ==================================*/
131    if (strcmp(sys_cmd, "nblocks") == 0)
132    {
133      ring r;
134      if (h == NULL)
135      {
136        if (currRingHdl != NULL)
137        {
138          r = IDRING(currRingHdl);
139        }
140        else
141        {
142          WerrorS("no ring active");
143          return TRUE;
144        }
145      }
146      else
147      {
148        if (h->Typ() != RING_CMD)
149        {
150          WerrorS("ring expected");
151          return TRUE;
152        }
153        r = (ring) h->Data();
154      }
155      res->rtyp = INT_CMD;
156      res->data = (void*) (rBlocks(r) - 1);
157      return FALSE;
158    }
159/*==================== version ==================================*/
160    if(strcmp(sys_cmd,"version")==0)
161    {
162      res->rtyp=INT_CMD;
163      res->data=(void *)SINGULAR_VERSION;
164      return FALSE;
165    }
166    else
167/*==================== gen ==================================*/
168    if(strcmp(sys_cmd,"gen")==0)
169    {
170      res->rtyp=INT_CMD;
171      res->data=(void *)npGen;
172      return FALSE;
173    }
174    else
175/*==================== sh ==================================*/
176    if(strcmp(sys_cmd,"sh")==0)
177    {
178      res->rtyp=INT_CMD;
179      #ifndef __MWERKS__
180      if (h==NULL) res->data = (void *)system("sh");
181      else if (h->Typ()==STRING_CMD)
182        res->data = (void*) system((char*)(h->Data()));
183      else
184        WerrorS("string expected");
185      #else
186      res->data=(void *)0;
187      #endif
188      return FALSE;
189    }
190    else
191/*==================== uname ==================================*/
192    if(strcmp(sys_cmd,"uname")==0)
193    {
194      res->rtyp=STRING_CMD;
195      res->data = omStrDup(S_UNAME);
196      return FALSE;
197    }
198    else
199/*==================== with ==================================*/
200    if(strcmp(sys_cmd,"with")==0)
201    {
202      if (h==NULL)
203      {
204        res->rtyp=STRING_CMD;
205        res->data=(void *)omStrDup(versionString());
206        return FALSE;
207      }
208      else if (h->Typ()==STRING_CMD)
209      {
210        #define TEST_FOR(A) if(strcmp(s,A)==0) res->data=(void *)1; else
211        char *s=(char *)h->Data();
212        res->rtyp=INT_CMD;
213        #ifdef HAVE_DBM
214          TEST_FOR("DBM")
215        #endif
216        #ifdef HAVE_DLD
217          TEST_FOR("DLD")
218        #endif
219        #ifdef HAVE_FACTORY
220          TEST_FOR("factory")
221        #endif
222        #ifdef HAVE_LIBFAC_P
223          TEST_FOR("libfac")
224        #endif
225        #ifdef HAVE_MPSR
226          TEST_FOR("MP")
227        #endif
228        #ifdef HAVE_READLINE
229          TEST_FOR("readline")
230        #endif
231        #ifdef HAVE_TCL
232          TEST_FOR("tcl")
233        #endif
234        #ifdef TEST_MAC_ORDER
235          TEST_FOR("MAC_ORDER");
236        #endif
237        #ifdef HAVE_NAMESPACES
238          TEST_FOR("Namespaces");
239        #endif
240        #ifdef HAVE_DYNAMIC_LOADING
241          TEST_FOR("DynamicLoading");
242        #endif
243          ;
244        return FALSE;
245        #undef TEST_FOR
246      }
247      return TRUE;
248    }
249    else
250/*==================== browsers ==================================*/
251    if (strcmp(sys_cmd,"browsers")==0)
252    {
253      res->rtyp = STRING_CMD;
254      char* b = StringSetS("");
255      feStringAppendBrowsers(0);
256      res->data = omStrDup(b);
257      return FALSE;
258    }
259    else
260/*==================== pid ==================================*/
261    if (strcmp(sys_cmd,"pid")==0)
262    {
263      res->rtyp=INT_CMD;
264    #ifndef MSDOS
265    #ifndef __MWERKS__
266      res->data=(void *)getpid();
267    #else
268      res->data=(void *)1;
269    #endif
270    #else
271      res->data=(void *)1;
272    #endif
273      return FALSE;
274    }
275    else
276/*==================== getenv ==================================*/
277    if (strcmp(sys_cmd,"getenv")==0)
278    {
279      if ((h!=NULL) && (h->Typ()==STRING_CMD))
280      {
281        res->rtyp=STRING_CMD;
282        char *r=getenv((char *)h->Data());
283        if (r==NULL) r="";
284        res->data=(void *)omStrDup(r);
285        return FALSE;
286      }
287      else
288      {
289        WerrorS("string expected");
290        return TRUE;
291      }
292    }
293    else
294/*==================== setenv ==================================*/
295    if (strcmp(sys_cmd,"setenv")==0)
296    {
297#ifdef HAVE_SETENV
298      if (h!=NULL && h->Typ()==STRING_CMD && h->Data() != NULL &&
299          h->next != NULL && h->next->Typ() == STRING_CMD
300          && h->next->Data() != NULL)
301      {
302        res->rtyp=STRING_CMD;
303        setenv((char *)h->Data(), (char *)h->next->Data(), 1);
304        res->data=(void *)omStrDup((char *)h->next->Data());
305        feReInitResources();
306        return FALSE;
307      }
308      else
309      {
310        WerrorS("two strings expected");
311        return TRUE;
312      }
313#else
314      WerrorS("setenv not supported on this platform");
315      return TRUE;
316#endif
317    }
318    else
319/*==================== Singular ==================================*/
320    if (strcmp(sys_cmd, "Singular") == 0)
321    {
322      res->rtyp=STRING_CMD;
323      char *r=feResource("Singular");
324      if (r != NULL)
325        res->data = (void*) omStrDup( r );
326      else
327        res->data = (void*) omStrDup("");
328      return FALSE;
329    }
330    else
331/*==================== options ==================================*/
332    if (strstr(sys_cmd, "--") == sys_cmd)
333    {
334      if (strcmp(sys_cmd, "--") == 0)
335      {
336        fePrintOptValues();
337        return FALSE;
338      }
339
340      feOptIndex opt = feGetOptIndex(&sys_cmd[2]);
341      if (opt == FE_OPT_UNDEF)
342      {
343        Werror("Unknown option %s", sys_cmd);
344        Werror("Use 'system(\"--\");' for listing of available options");
345        return TRUE;
346      }
347
348      // for Untyped Options (help version),
349      // setting it just triggers action
350      if (feOptSpec[opt].type == feOptUntyped)
351      {
352        feSetOptValue(opt,NULL);
353        return FALSE;
354      }
355
356      if (h == NULL)
357      {
358        if (feOptSpec[opt].type == feOptString)
359        {
360          res->rtyp = STRING_CMD;
361          if (feOptSpec[opt].value != NULL)
362            res->data = omStrDup((char*) feOptSpec[opt].value);
363          else
364            res->data = omStrDup("");
365        }
366        else
367        {
368          res->rtyp = INT_CMD;
369          res->data = feOptSpec[opt].value;
370        }
371        return FALSE;
372      }
373
374      if (h->Typ() != STRING_CMD &&
375          h->Typ() != INT_CMD)
376      {
377        Werror("Need string or int argument to set option value");
378        return TRUE;
379      }
380      char* errormsg;
381      if (h->Typ() == INT_CMD)
382      {
383        if (feOptSpec[opt].type == feOptString)
384        {
385          Werror("Need string argument to set value of option %s", sys_cmd);
386          return TRUE;
387        }
388        errormsg = feSetOptValue(opt, (int) h->Data());
389        if (errormsg != NULL)
390          Werror("Option '--%s=%d' %s", sys_cmd, (int) h->Data(), errormsg);
391      }
392      else
393      {
394        errormsg = feSetOptValue(opt, (char*) h->Data());
395        if (errormsg != NULL)
396          Werror("Option '--%s=%s' %s", sys_cmd, (char*) h->Data(), errormsg);
397      }
398      if (errormsg != NULL) return TRUE;
399      return FALSE;
400    }
401    else
402/*==================== HC ==================================*/
403    if (strcmp(sys_cmd,"HC")==0)
404    {
405      res->rtyp=INT_CMD;
406      res->data=(void *)HCord;
407      return FALSE;
408    }
409    else
410/*==================== random ==================================*/
411    if(strcmp(sys_cmd,"random")==0)
412    {
413      if ((h!=NULL) &&(h->Typ()==INT_CMD))
414      {
415        siRandomStart=(int)h->Data();
416#ifdef buildin_rand
417        siSeed=siRandomStart;
418#else
419        srand((unsigned int)siRandomStart);
420#endif
421#ifdef HAVE_FACTORY
422        factoryseed(siRandomStart);
423#endif
424        return FALSE;
425      }
426      else if (h != NULL)
427      {
428        WerrorS("int expected");
429        return TRUE;
430      }
431      res->rtyp=INT_CMD;
432      res->data=(void*) siRandomStart;
433      return FALSE;
434    }
435/*==================== complexNearZero ======================*/
436    if(strcmp(sys_cmd,"complexNearZero")==0)
437    {
438      if (h->Typ()==NUMBER_CMD )
439      {
440        if ( h->next!=NULL && h->next->Typ()==INT_CMD )
441        {
442          if ( !rField_is_long_C() )
443            {
444              Werror( "unsupported ground field!");
445              return TRUE;
446            }
447          else
448            {
449              res->rtyp=INT_CMD;
450              res->data=(void*)complexNearZero((gmp_complex*)h->Data(),(int)h->next->Data());
451              return FALSE;
452            }
453        }
454        else
455        {
456          Werror( "expected <int> as third parameter!");
457          return TRUE;
458        }
459      }
460      else
461      {
462        Werror( "expected <number> as second parameter!");
463        return TRUE;
464      }
465    }
466/*==================== getPrecDigits ======================*/
467    if(strcmp(sys_cmd,"getPrecDigits")==0)
468    {
469      if ( !rField_is_long_C() && !rField_is_long_R() )
470      {
471        Werror( "unsupported ground field!");
472        return TRUE;
473      }
474      res->rtyp=INT_CMD;
475      res->data=(void*)getGMPFloatDigits();
476      return FALSE;
477    }
478/*==================== neworder =============================*/
479// should go below
480#ifdef HAVE_LIBFAC_P
481    if(strcmp(sys_cmd,"neworder")==0)
482    {
483      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
484      {
485        res->rtyp=STRING_CMD;
486        res->data=(void *)singclap_neworder((ideal)h->Data());
487        return FALSE;
488      }
489      else
490        WerrorS("ideal expected");
491    }
492    else
493#endif
494/*==================== pcv ==================================*/
495#ifndef HAVE_DYNAMIC_LOADING
496#ifdef HAVE_PCV
497    if(strcmp(sys_cmd,"pcvLAddL")==0)
498    {
499      return pcvLAddL(res,h);
500    }
501    else
502    if(strcmp(sys_cmd,"pcvPMulL")==0)
503    {
504      return pcvPMulL(res,h);
505    }
506    else
507    if(strcmp(sys_cmd,"pcvMinDeg")==0)
508    {
509      return pcvMinDeg(res,h);
510    }
511    else
512    if(strcmp(sys_cmd,"pcvP2CV")==0)
513    {
514      return pcvP2CV(res,h);
515    }
516    else
517    if(strcmp(sys_cmd,"pcvCV2P")==0)
518    {
519      return pcvCV2P(res,h);
520    }
521    else
522    if(strcmp(sys_cmd,"pcvDim")==0)
523    {
524      return pcvDim(res,h);
525    }
526    else
527    if(strcmp(sys_cmd,"pcvBasis")==0)
528    {
529      return pcvBasis(res,h);
530    }
531    else
532#endif
533#endif /* HAVE_DYNAMIC_LOADING */
534/*==================== contributors =============================*/
535   if(strcmp(sys_cmd,"contributors") == 0)
536   {
537     res->rtyp=STRING_CMD;
538     res->data=(void *)omStrDup(
539       "Olaf Bachmann, Hubert Grassmann, Kai Krueger, Wolfgang Neumann, Thomas Nuessler, Wilfred Pohl, Jens Schmidt, Thomas Siebert, Ruediger Stobbe, Moritz Wenk, Tim Wichmann");
540     return FALSE;
541   }
542   else
543/*==================== spectrum =============================*/
544   #ifdef HAVE_SPECTRUM
545   if(strcmp(sys_cmd,"spectrum") == 0)
546   {
547     if (h->Typ()!=POLY_CMD)
548     {
549       WerrorS("poly expected");
550       return TRUE;
551     }
552     if (h->next==NULL)
553       return spectrumProc(res,h);
554     if (h->next->Typ()!=INT_CMD)
555     {
556       WerrorS("poly,int expected");
557       return TRUE;
558     }
559     if(((int)h->next->Data())==1)
560       return spectrumfProc(res,h);
561     return spectrumProc(res,h);
562   }
563   else
564/*==================== semic =============================*/
565   if(strcmp(sys_cmd,"semic") == 0)
566   {
567     if ((h->next!=NULL)
568     && (h->Typ()==LIST_CMD)
569     && (h->next->Typ()==LIST_CMD))
570     {
571       if (h->next->next==NULL)
572         return semicProc(res,h,h->next);
573       else if (h->next->next->Typ()==INT_CMD)
574         return semicProc3(res,h,h->next,h->next->next);
575     }
576     return TRUE;
577   }
578   else
579/*==================== spadd =============================*/
580   if(strcmp(sys_cmd,"spadd") == 0)
581   {
582     if ((h->next!=NULL)
583     && (h->Typ()==LIST_CMD)
584     && (h->next->Typ()==LIST_CMD))
585     {
586       if (h->next->next==NULL)
587         return spaddProc(res,h,h->next);
588     }
589     return TRUE;
590   }
591   else
592/*==================== spmul =============================*/
593   if(strcmp(sys_cmd,"spmul") == 0)
594   {
595     if ((h->next!=NULL)
596     && (h->Typ()==LIST_CMD)
597     && (h->next->Typ()==INT_CMD))
598     {
599       if (h->next->next==NULL)
600         return spmulProc(res,h,h->next);
601     }
602     return TRUE;
603   }
604   else
605   #endif
606/*================= Extended system call ========================*/
607   {
608     #ifndef MAKE_DISTRIBUTION
609     return(jjEXTENDED_SYSTEM(res, args));
610     #else
611     Werror( "system(\"%s\",...) %s", sys_cmd, feNotImplemented );
612     #endif
613   }
614  } /* typ==string */
615  return TRUE;
616}
617
618
619
620#ifdef HAVE_EXTENDED_SYSTEM
621// You can put your own system calls here
622#include "fglmcomb.cc"
623#include "fglm.h"
624#ifdef HAVE_NEWTON
625#include <hc_newton.h>
626#endif
627#include "mpsr.h"
628
629   
630static BOOLEAN jjEXTENDED_SYSTEM(leftv res, leftv h)
631{
632  if(h->Typ() == STRING_CMD)
633  {
634    char *sys_cmd=(char *)(h->Data());
635    h=h->next;
636#ifdef RDEBUG
637/*==================== poly debug ==================================*/
638    if(strcmp(sys_cmd,"p")==0)
639    {
640      pDebugPrint((poly)h->Data());
641      return FALSE;
642    }
643    else
644/*==================== ring debug ==================================*/
645    if(strcmp(sys_cmd,"r")==0)
646    {
647      rDebugPrint((ring)h->Data());
648      return FALSE;
649    }
650    else
651#endif
652/*==================== mtrack ==================================*/
653    if(strcmp(sys_cmd,"mtrack")==0)
654    {
655#ifdef OM_TRACK
656      om_Opts.MarkAsStatic = 1;
657      FILE *fd = NULL;
658      int max = 5;
659      while (h != NULL)
660      {
661        omMarkAsStaticAddr(h);
662        if (fd == NULL && h->Typ()==STRING_CMD)
663        {
664          fd = fopen((char*) h->Data(), "w");
665          if (fd == NULL)
666            Warn("Can not open %s for writing og mtrack. Using stdout");
667        }
668        if (h->Typ() == INT_CMD)
669        {
670          max = (int) h->Data();
671        }
672        h = h->Next();
673      }
674      omPrintUsedTrackAddrs((fd == NULL ? stdout : fd), max);
675      if (fd != NULL) fclose(fd);
676      om_Opts.MarkAsStatic = 0;
677      return FALSE;
678#else
679     WerrorS("mtrack not supported without OM_TRACK");
680     return TRUE;
681#endif
682    }
683/*==================== mtrack_all ==================================*/
684    if(strcmp(sys_cmd,"mtrack_all")==0)
685    {
686#ifdef OM_TRACK
687      om_Opts.MarkAsStatic = 1;
688      FILE *fd = NULL;
689      if ((h!=NULL) &&(h->Typ()==STRING_CMD))
690      {
691        fd = fopen((char*) h->Data(), "w");
692        if (fd == NULL)
693          Warn("Can not open %s for writing og mtrack. Using stdout");
694        omMarkAsStaticAddr(h);
695      }
696      // OB: TBC print to fd
697      omPrintUsedAddrs((fd == NULL ? stdout : fd), 5);
698      if (fd != NULL) fclose(fd);
699      om_Opts.MarkAsStatic = 0;
700      return FALSE;
701#else
702     WerrorS("mtrack not supported without OM_TRACK");
703     return TRUE;
704#endif
705    }
706    else
707/*==================== backtrace ==================================*/
708    if(strcmp(sys_cmd,"backtrace")==0)
709    {
710#ifndef OM_NDEBUG
711      omPrintCurrentBackTrace(stdout);
712      return FALSE;
713#else
714     WerrorS("btrack not supported without OM_TRACK");
715     return TRUE;
716#endif
717    }
718    else
719/*==================== naIdeal ==================================*/
720    if(strcmp(sys_cmd,"naIdeal")==0)
721    {
722      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
723      {
724        naSetIdeal((ideal)h->Data());
725        return FALSE;
726      }
727      else
728         WerrorS("ideal expected");
729    }
730    else
731/*==================== isSqrFree =============================*/
732#ifdef HAVE_FACTORY
733    if(strcmp(sys_cmd,"isSqrFree")==0)
734    {
735      if ((h!=NULL) &&(h->Typ()==POLY_CMD))
736      {
737        res->rtyp=INT_CMD;
738        res->data=(void *)singclap_isSqrFree((poly)h->Data());
739        return FALSE;
740      }
741      else
742        WerrorS("poly expected");
743    }
744    else
745#endif
746/*==================== pDivStat =============================*/
747#if defined(PDEBUG) || defined(PDIV_DEBUG)
748    if(strcmp(sys_cmd,"pDivStat")==0)
749    {
750      extern void pPrintDivisbleByStat();
751      pPrintDivisbleByStat();
752      return FALSE;
753    }
754    else
755#endif
756/*==================== alarm ==================================*/
757#ifndef __MWERKS__
758#ifndef MSDOS
759#ifndef atarist
760#ifdef unix
761    if(strcmp(sys_cmd,"alarm")==0)
762    {
763      if ((h!=NULL) &&(h->Typ()==INT_CMD))
764      {
765        // standard variant -> SIGALARM (standard: abort)
766        //alarm((unsigned)h->next->Data());
767        // process time (user +system): SIGVTALARM
768        struct itimerval t,o;
769        memset(&t,0,sizeof(t));
770        t.it_value.tv_sec     =(unsigned)h->Data();
771        setitimer(ITIMER_VIRTUAL,&t,&o);
772        return FALSE;
773      }
774      else
775        WerrorS("int expected");
776    }
777    else
778#endif
779#endif
780#endif
781#endif
782/*==================== red =============================*/
783#if 0
784    if(strcmp(sys_cmd,"red")==0)
785    {
786      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
787      {
788        res->rtyp=IDEAL_CMD;
789        res->data=(void *)kStdred((ideal)h->Data(),NULL,testHomog,NULL);
790        setFlag(res,FLAG_STD);
791        return FALSE;
792      }
793      else
794        WerrorS("ideal expected");
795    }
796    else
797#endif
798/*==================== algfetch =====================*/
799    if (strcmp(sys_cmd,"algfetch")==0)
800    {
801      int k;
802      idhdl w;
803      ideal i0, i1;
804      ring r0=(ring)h->Data();
805      leftv v = h->next;
806      w = r0->idroot->get(v->Name(),myynest);
807      if (w!=NULL)
808      {
809        if (IDTYP(w)==IDEAL_CMD)
810        {
811          i0 = IDIDEAL(w);
812          i1 = idInit(IDELEMS(i0),i0->rank);
813          for (k=0; k<IDELEMS(i1); k++)
814          {
815            i1->m[k] = maAlgpolyFetch(r0, i0->m[k]);
816          }
817          res->rtyp = IDEAL_CMD;
818          res->data = (void*)i1;
819          return FALSE;
820        }
821        else if (IDTYP(w)==POLY_CMD)
822        {
823          res->rtyp = POLY_CMD;
824          res->data = (void*)maAlgpolyFetch(r0,IDPOLY(w));
825          return FALSE;
826        }
827        else
828          WerrorS("`system(\"algfetch\",<ideal>/<poly>)` expected");
829      }
830      else
831        Werror("`%s` not found in `%s`",v->Name(),h->Name());
832    }
833    else
834/*==================== algmap =======================*/
835    if (strcmp(sys_cmd,"algmap")==0)
836    {
837      int k;
838      idhdl w;
839      ideal i0, i1, i, j;
840      ring r0=(ring)h->Data();
841      leftv v = h->next;
842      w = r0->idroot->get(v->Name(),myynest);
843      i0 = IDIDEAL(w);
844      v = v->next;
845      i = (ideal)v->Data();
846      v = v->next;
847      j = (ideal)v->Data();
848      i1 = idInit(IDELEMS(i0),i0->rank);
849      for (k=0; k<IDELEMS(i1); k++)
850      {
851        i1->m[k] = maAlgpolyMap(r0, i0->m[k], i, j);
852      }
853      res->rtyp = IDEAL_CMD;
854      res->data = (void*)i1;
855      return FALSE;
856    }
857    else
858#ifdef HAVE_FACTORY
859/*==================== fastcomb =============================*/
860    if(strcmp(sys_cmd,"fastcomb")==0)
861    {
862      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
863      {
864        int i=0;
865        if (h->next!=NULL)
866        {
867          if (h->next->Typ()!=POLY_CMD)
868          {
869            Warn("Wrong types for poly= comb(ideal,poly)");
870          }
871        }
872        res->rtyp=POLY_CMD;
873        res->data=(void *) fglmLinearCombination(
874                           (ideal)h->Data(),(poly)h->next->Data());
875        return FALSE;
876      }
877      else
878        WerrorS("ideal expected");
879    }
880    else
881/*==================== comb =============================*/
882    if(strcmp(sys_cmd,"comb")==0)
883    {
884      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
885      {
886        int i=0;
887        if (h->next!=NULL)
888        {
889          if (h->next->Typ()!=POLY_CMD)
890          {
891              Warn("Wrong types for poly= comb(ideal,poly)");
892          }
893        }
894        res->rtyp=POLY_CMD;
895        res->data=(void *)fglmNewLinearCombination(
896                            (ideal)h->Data(),(poly)h->next->Data());
897        return FALSE;
898      }
899      else
900        WerrorS("ideal expected");
901    }
902    else
903#endif
904#ifdef FACTORY_GCD_TEST
905/*=======================gcd Testerei ================================*/
906    if ( ! strcmp( sys_cmd, "setgcd" ) ) {
907        if ( (h != NULL) && (h->Typ() == INT_CMD) ) {
908            CFPrimitiveGcdUtil::setAlgorithm( (int)h->Data() );
909            return FALSE;
910        } else
911            WerrorS("int expected");
912    }
913    else
914#endif
915
916#ifdef FACTORY_GCD_TIMING
917    if ( ! strcmp( sys_cmd, "gcdtime" ) ) {
918        TIMING_PRINT( contentTimer, "time used for content: " );
919        TIMING_PRINT( algContentTimer, "time used for algContent: " );
920        TIMING_PRINT( algLcmTimer, "time used for algLcm: " );
921        TIMING_RESET( contentTimer );
922        TIMING_RESET( algContentTimer );
923        TIMING_RESET( algLcmTimer );
924        return FALSE;
925    }
926    else
927#endif
928
929#ifdef FACTORY_GCD_STAT
930    if ( ! strcmp( sys_cmd, "gcdstat" ) ) {
931        printGcdTotal();
932        printContTotal();
933        resetGcdTotal();
934        resetContTotal();
935        return FALSE;
936    }
937    else
938#endif
939/*==================== lib ==================================*/
940    if(strcmp(sys_cmd,"LIB")==0)
941    {
942#ifdef HAVE_NAMESPACES
943      idhdl hh=namespaceroot->get((char*)h->Data(),0);
944#else /* HAVE_NAMESPACES */
945      idhdl hh=idroot->get((char*)h->Data(),0);
946#endif /* HAVE_NAMESPACES */
947      if ((hh!=NULL)&&(IDTYP(hh)==PROC_CMD))
948      {
949        res->rtyp=STRING_CMD;
950        char *r=iiGetLibName(IDPROC(hh));
951        if (r==NULL) r="";
952        res->data=omStrDup(r);
953        return FALSE;
954      }
955      else
956        Warn("`%s` not found",(char*)h->Data());
957    }
958    else
959#ifdef HAVE_NAMESPACES
960/*==================== nspush ===================================*/
961    if(strcmp(sys_cmd,"nspush")==0)
962    {
963      if (h->Typ()==PACKAGE_CMD)
964      {
965        idhdl hh=(idhdl)h->data;
966        namespaceroot = namespaceroot->push(IDPACKAGE(hh), IDID(hh));
967        return FALSE;
968      }
969      else
970        Warn("argument 2 is not a package");
971    }
972    else
973/*==================== nspop ====================================*/
974    if(strcmp(sys_cmd,"nspop")==0)
975    {
976      namespaceroot->pop();
977      return FALSE;
978    }
979    else
980#endif /* HAVE_NAMESPACES */
981/*==================== nsstack ===================================*/
982    if(strcmp(sys_cmd,"nsstack")==0)
983    {
984      namehdl nshdl = namespaceroot;
985      for( ; nshdl->isroot != TRUE; nshdl = nshdl->next) {
986        Print("NSstack: %s:%d, nesting=%d\n", nshdl->name, nshdl->lev, nshdl->myynest);
987      }
988      Print("NSstack: %s:%d, nesting=%d\n", nshdl->name, nshdl->lev, nshdl->myynest);
989      return FALSE;
990    }
991    else
992/*==================== proclist =================================*/
993    if(strcmp(sys_cmd,"proclist")==0)
994    {
995      piShowProcList();
996      return FALSE;
997    }
998    else
999/* ==================== newton ================================*/
1000#ifdef HAVE_NEWTON
1001    if(strcmp(sys_cmd,"newton")==0)
1002    {
1003      if ((h->Typ()!=POLY_CMD)
1004      || (h->next->Typ()!=INT_CMD)
1005      || (h->next->next->Typ()!=INT_CMD))
1006      {
1007        WerrorS("system(\"newton\",<poly>,<int>,<int>) expected");
1008        return TRUE;
1009      }
1010      poly  p=(poly)(h->Data());
1011      int l=pLength(p);
1012      short *points=(short *)omAlloc(currRing->N*l*sizeof(short));
1013      int i,j,k;
1014      k=0;
1015      poly pp=p;
1016      for (i=0;pp!=NULL;i++)
1017      {
1018        for(j=1;j<=currRing->N;j++)
1019        {
1020          points[k]=pGetExp(pp,j);
1021          k++;
1022        }
1023        pIter(pp);
1024      }
1025      hc_ERG r=hc_KOENIG(currRing->N,      // dimension
1026                l,      // number of points
1027                (short*) points,   // points: x_1, y_1,z_1, x_2,y_2,z2,...
1028                currRing->OrdSgn==-1,
1029                (int) (h->next->Data()),      // 1: Milnor, 0: Newton
1030                (int) (h->next->next->Data()) // debug
1031               );
1032      //----<>---Output-----------------------
1033
1034
1035//  PrintS("Bin jetzt in extra.cc bei der Auswertung.\n"); // **********
1036
1037
1038      lists L=(lists)omAllocBin(slists_bin);
1039      L->Init(6);
1040      L->m[0].rtyp=STRING_CMD;               // newtonnumber;
1041      L->m[0].data=(void *)omStrDup(r.nZahl);
1042      L->m[1].rtyp=INT_CMD;
1043      L->m[1].data=(void *)r.achse;          // flag for unoccupied axes
1044      L->m[2].rtyp=INT_CMD;
1045      L->m[2].data=(void *)r.deg;            // #degenerations
1046      if ( r.deg != 0)              // only if degenerations exist
1047      {
1048        L->m[3].rtyp=INT_CMD;
1049        L->m[3].data=(void *)r.anz_punkte;     // #points
1050        //---<>--number of points------
1051        int anz = r.anz_punkte;    // number of points
1052        int dim = (currRing->N);     // dimension
1053        intvec* v = new intvec( anz*dim );
1054        for (i=0; i<anz*dim; i++)    // copy points
1055          (*v)[i] = r.pu[i];
1056        L->m[4].rtyp=INTVEC_CMD;
1057        L->m[4].data=(void *)v;
1058        //---<>--degenerations---------
1059        int deg = r.deg;    // number of points
1060        intvec* w = new intvec( r.speicher );  // necessary memeory
1061        i=0;               // start copying
1062        do
1063        {
1064          (*w)[i] = r.deg_tab[i];
1065          i++;
1066        }
1067        while (r.deg_tab[i-1] != -2);   // mark for end of list
1068        L->m[5].rtyp=INTVEC_CMD;
1069        L->m[5].data=(void *)w;
1070      }
1071      else
1072      {
1073        L->m[3].rtyp=INT_CMD; L->m[3].data=(char *)0;
1074        L->m[4].rtyp=DEF_CMD;
1075        L->m[5].rtyp=DEF_CMD;
1076      }
1077
1078      res->data=(void *)L;
1079      res->rtyp=LIST_CMD;
1080      // free all pointer in r:
1081      delete[] r.nZahl;
1082      delete[] r.pu;
1083      delete[] r.deg_tab;      // Ist das ein Problem??
1084
1085      omFreeSize((ADDRESS)points,currRing->N*l*sizeof(short));
1086      return FALSE;
1087    }
1088    else
1089#endif
1090/*==================== gp =================*/
1091#ifdef HAVE_MPSR
1092    if (strcmp(sys_cmd, "gp") == 0)
1093    {
1094      if (h->Typ() != LINK_CMD)
1095      {
1096        WerrorS("No Link arg");
1097        return FALSE;
1098      }
1099      si_link l = (si_link) h->Data();
1100      if (strcmp(l->m->type, "MPfile") != 0)
1101      {
1102        WerrorS("No MPfile link");
1103        return TRUE;
1104      }
1105      if( ! SI_LINK_R_OPEN_P(l)) // open r ?
1106      {
1107        if (slOpen(l, SI_LINK_READ)) return TRUE;
1108      }
1109
1110      MP_Link_pt link = (MP_Link_pt) l->data;
1111      if (MP_InitMsg(link) != MP_Success)
1112      {
1113        WerrorS("Can not Init");
1114      }
1115      MPT_Tree_pt tree = NULL;
1116      if (MPT_GetTree(link, &tree) != MPT_Success)
1117      {
1118        WerrorS("Can not get tree");
1119        return TRUE;
1120      }
1121      MPT_GP_pt gp_tree = MPT_GetGP(tree);
1122      if (gp_tree == NULL || ! gp_tree->IsOk(gp_tree))
1123      {
1124        WerrorS("gp error");
1125        return TRUE;
1126      }
1127      delete gp_tree;
1128      MPT_DeleteTree(tree);
1129      return FALSE;
1130    }
1131    else
1132#endif
1133/*==================== sdb_flags =================*/
1134    if (strcmp(sys_cmd, "sdb_flags") == 0)
1135    {
1136      if ((h!=NULL) && (h->Typ()==INT_CMD))
1137      {
1138        sdb_flags=(int)h->Data();
1139      }
1140      else
1141      {
1142        WerrorS("system(\"sdb_flags\",`int`) expected");
1143        return TRUE;
1144      }
1145      return FALSE;
1146    }
1147    else
1148/*==================== sdb_edit =================*/
1149    if (strcmp(sys_cmd, "sdb_edit") == 0)
1150    {
1151      if ((h!=NULL) && (h->Typ()==PROC_CMD))
1152      {
1153        procinfov p=(procinfov)h->Data();
1154        sdb_edit(p);
1155      }
1156      else
1157      {
1158        WerrorS("system(\"sdb_edit\",`proc`) expected");
1159        return TRUE;
1160      }
1161      return FALSE;
1162    }
1163    else
1164/*==================== GF =================*/
1165#if 0
1166    if (strcmp(sys_cmd, "GF") == 0)
1167    {
1168      int c=rChar(currRing);
1169      setCharacteristic( c, 2);
1170      CanonicalForm F( convSingGFClapGF( (poly)h->Data() ) );
1171      res->rtyp=POLY_CMD;
1172      res->data=convClapGFSingGF( F );
1173      return FALSE;
1174    }
1175    else
1176#endif
1177/*==================== stdX =================*/
1178    if (strcmp(sys_cmd, "std") == 0)
1179    {
1180      ideal i1;
1181      int i2;
1182      if ((h!=NULL) && (h->Typ()==MODUL_CMD))
1183      {
1184        i1=(ideal)h->CopyD();
1185        h=h->next;
1186      }
1187      else return TRUE;
1188      if ((h!=NULL) && (h->Typ()==INT_CMD))
1189      {
1190        i2=(int)h->Data();
1191      }
1192      else return TRUE;
1193      res->rtyp=MODUL_CMD;
1194      res->data=idXXX(i1,i2);
1195      return FALSE;
1196    }
1197    else
1198#ifdef HAVE_PLURAL
1199/*==================== PLURAL =================*/
1200    if (strcmp(sys_cmd, "PLURAL") == 0)
1201    {
1202      matrix C;
1203      matrix D;
1204
1205      if ((h!=NULL) && (h->Typ()==MATRIX_CMD))
1206      {
1207        C=(matrix)h->CopyD();
1208        h=h->next;
1209      }
1210      else return TRUE;
1211      if ((h!=NULL) && (h->Typ()==MATRIX_CMD))
1212      {
1213        D=(matrix)h->CopyD();
1214      }
1215      else return TRUE;
1216      if (currRing->nc==NULL)
1217      {
1218        currRing->nc=(nc_struct *)omAlloc0(sizeof(nc_struct));
1219        currRing->nc->MT=(matrix *)omAlloc0(pVariables*(pVariables-1)/2*sizeof(matrix));
1220        currRing->nc->MTsize=(int *)omAlloc0(pVariables*(pVariables-1)/2*sizeof(int));
1221      }
1222      else
1223      {
1224        WarnS("redefining algebra structure");
1225      }
1226      currRing->nc->type=nc_general;
1227      currRing->nc->C=C;
1228      currRing->nc->D=D;
1229      {
1230        int i,j;
1231        poly p;
1232        short DefMTsize=7;
1233        int nv=pVariables;
1234        for(i=1;i<nv;i++)
1235        {
1236          for(j=i+1;j<=nv;j++)
1237          { 
1238            currRing->nc->MTsize[UPMATELEM(i,j)]=DefMTsize; /* default sizes */
1239            currRing->nc->MT[UPMATELEM(i,j)]=mpNew(DefMTsize,DefMTsize);
1240            p=pOne();
1241            pSetCoeff(p,nCopy(pGetCoeff(MATELEM(currRing->nc->C,i,j))));
1242            pSetExp(p,i,1);
1243            pSetExp(p,j,1);
1244            pSetm(p);
1245            p=pAdd(p,pCopy(MATELEM(currRing->nc->D,i,j)));
1246            MATELEM(currRing->nc->MT[UPMATELEM(i,j)],1,1)=p;
1247            /* set MT[i,j,1,1] to c_i_j*x_i*x_j + D_i_j */
1248          }
1249        }
1250      }
1251      // set p_Procs:
1252//      currRing->p_Procs->pp_Mult_mm =nc_pp_Mult_mm;
1253//      currRing->p_Procs->p_Mult_mm =nc_p_Mult_mm;
1254//      currRing->p_Procs->p_Minus_mm_Mult_qq =nc_p_Minus_mm_Mult_qq;
1255
1256      return FALSE;
1257    }
1258    else
1259#endif
1260#ifdef HAVE_WALK
1261/*==================== walk stuff =================*/
1262    if (strcmp(sys_cmd, "walkNextWeight") == 0)
1263    {
1264      if (h == NULL || h->Typ() != INTVEC_CMD ||
1265          h->next == NULL || h->next->Typ() != INTVEC_CMD ||
1266          h->next->next == NULL || h->next->next->Typ() != IDEAL_CMD)
1267      {
1268        Werror("system(\"walkNextWeight\", intvec, intvec, ideal) expected");
1269        return TRUE;
1270      }
1271
1272      if (((intvec*) h->Data())->length() != currRing->N ||
1273          ((intvec*) h->next->Data())->length() != currRing->N)
1274      {
1275        Werror("system(\"walkNextWeight\" ...) intvecs not of length %d\n",
1276               currRing->N);
1277        return TRUE;
1278      }
1279      res->data = (void*) walkNextWeight(((intvec*) h->Data()),
1280                                         ((intvec*) h->next->Data()),
1281                                         (ideal) h->next->next->Data());
1282      if (res->data == (void*) 0 || res->data == (void*) 1)
1283      {
1284        res->rtyp = INT_CMD;
1285      }
1286      else
1287      {
1288        res->rtyp = INTVEC_CMD;
1289      }
1290      return FALSE;
1291    }
1292    else if (strcmp(sys_cmd, "walkInitials") == 0)
1293    {
1294      if (h == NULL || h->Typ() != IDEAL_CMD)
1295      {
1296        WerrorS("system(\"walkInitials\", ideal) expected");
1297        return TRUE;
1298      }
1299
1300      res->data = (void*) walkInitials((ideal) h->Data());
1301      res->rtyp = IDEAL_CMD;
1302      return FALSE;
1303    }
1304    else
1305#endif
1306
1307/*==================== Error =================*/
1308      Werror( "system(\"%s\",...) %s", sys_cmd, feNotImplemented );
1309  }
1310  return TRUE;
1311}
1312#endif // HAVE_EXTENDED_SYSTEM
Note: See TracBrowser for help on using the repository browser.