source: git/Singular/extra.cc @ e68029

spielwiese
Last change on this file since e68029 was e68029, checked in by Hans Schoenemann <hannes@…>, 2 years ago
rref for smatrix and ntl
  • Property mode set to 100644
File size: 116.9 KB
Line 
1/*****************************************
2*  Computer Algebra System SINGULAR      *
3*****************************************/
4/*
5* ABSTRACT: general interface to internals of Singular ("system" command)
6* jjSYSTEM: official commands, must be documented in the manual,
7*           #defines must be local to each command
8* jjEXTENDED_SYSTEM: tests, temporary comands etc.
9*/
10
11#define HAVE_WALK 1
12
13#include "kernel/mod2.h"
14#include "misc/sirandom.h"
15#include "resources/omFindExec.h"
16
17#ifdef HAVE_CCLUSTER
18#include "ccluster/ccluster.h"
19#endif
20
21#include "factory/factory.h"
22
23#ifdef TIME_WITH_SYS_TIME
24# include <time.h>
25# ifdef HAVE_SYS_TIME_H
26#   include <sys/time.h>
27# endif
28#else
29# ifdef HAVE_SYS_TIME_H
30#   include <sys/time.h>
31# else
32#   include <time.h>
33# endif
34#endif
35#ifdef HAVE_SYS_TIMES_H
36#include <sys/times.h>
37#endif
38
39#include <unistd.h>
40
41#include "misc/options.h"
42
43// #include "coeffs/ffields.h"
44#include "coeffs/coeffs.h"
45#include "coeffs/mpr_complex.h"
46
47
48#include "resources/feResource.h"
49#include "polys/monomials/ring.h"
50#include "kernel/polys.h"
51
52#include "polys/monomials/maps.h"
53#include "polys/matpol.h"
54
55#include "polys/weight.h"
56
57#ifdef HAVE_SHIFTBBA
58#include "polys/shiftop.h"
59#endif
60
61#include "coeffs/bigintmat.h"
62#include "kernel/fast_mult.h"
63#include "kernel/digitech.h"
64#include "kernel/combinatorics/stairc.h"
65#include "kernel/ideals.h"
66#include "kernel/GBEngine/kstd1.h"
67#include "kernel/GBEngine/syz.h"
68#include "kernel/GBEngine/kutil.h"
69#include "kernel/GBEngine/kverify.h"
70
71#include "kernel/linear_algebra/linearAlgebra.h"
72
73#include "kernel/combinatorics/hutil.h"
74
75// for tests of t-rep-GB
76#include "kernel/GBEngine/tgb.h"
77
78#include "kernel/linear_algebra/minpoly.h"
79
80#include "numeric/mpr_base.h"
81
82#include "tok.h"
83#include "ipid.h"
84#include "lists.h"
85#include "cntrlc.h"
86#include "ipshell.h"
87#include "sdb.h"
88#include "feOpt.h"
89#include "fehelp.h"
90#include "distrib.h"
91
92#include "misc_ip.h"
93
94#include "attrib.h"
95
96#include "links/silink.h"
97#include "links/ssiLink.h"
98#include "walk.h"
99#include "Singular/newstruct.h"
100#include "Singular/blackbox.h"
101#include "Singular/pyobject_setup.h"
102
103
104#ifdef HAVE_RINGS
105#include "kernel/GBEngine/ringgb.h"
106#endif
107
108#ifdef HAVE_F5
109#include "kernel/GBEngine/f5gb.h"
110#endif
111
112#ifdef HAVE_WALK
113#include "walk.h"
114#endif
115
116#ifdef HAVE_SPECTRUM
117#include "kernel/spectrum/spectrum.h"
118#endif
119
120#ifdef HAVE_PLURAL
121#include "polys/nc/nc.h"
122#include "polys/nc/ncSAMult.h" // for CMultiplier etc classes
123#include "polys/nc/sca.h"
124#include "kernel/GBEngine/nc.h"
125#include "ipconv.h"
126#ifdef HAVE_RATGRING
127#include "kernel/GBEngine/ratgring.h"
128#endif
129#endif
130
131#ifdef __CYGWIN__ /* only for the DLLTest */
132/* #include "WinDllTest.h" */
133#ifdef HAVE_DL
134#include "polys/mod_raw.h"
135#endif
136#endif
137
138// Define to enable many more system commands
139//#undef MAKE_DISTRIBUTION
140#ifndef MAKE_DISTRIBUTION
141#define HAVE_EXTENDED_SYSTEM 1
142#endif
143
144#include "polys/flintconv.h"
145#include "polys/clapconv.h"
146#include "kernel/GBEngine/kstdfac.h"
147
148#include "polys/clapsing.h"
149
150#ifdef HAVE_EIGENVAL
151#include "eigenval_ip.h"
152#endif
153
154#ifdef HAVE_GMS
155#include "gms.h"
156#endif
157
158#ifdef HAVE_SIMPLEIPC
159#include "Singular/links/simpleipc.h"
160#endif
161
162#ifdef HAVE_PCV
163#include "pcv.h"
164#endif
165
166#ifndef MAKE_DISTRIBUTION
167static BOOLEAN jjEXTENDED_SYSTEM(leftv res, leftv h);
168#endif
169
170/* expects a SINGULAR square matrix with number entries
171   where currRing is expected to be over some field F_p;
172   returns a long** matrix with the "same", i.e.,
173   appropriately mapped entries;
174   leaves singularMatrix unmodified */
175unsigned long** singularMatrixToLongMatrix(matrix singularMatrix)
176{
177  int n = singularMatrix->rows();
178  assume(n == singularMatrix->cols());
179  unsigned long **longMatrix = 0;
180  longMatrix = new unsigned long *[n] ;
181  for (int i = 0 ; i < n; i++)
182    longMatrix[i] = new unsigned long [n];
183  number entry;
184  for (int r = 0; r < n; r++)
185    for (int c = 0; c < n; c++)
186    {
187      poly p=MATELEM(singularMatrix, r + 1, c + 1);
188      int entryAsInt;
189      if (p!=NULL)
190      {
191        entry = p_GetCoeff(p, currRing);
192        entryAsInt = n_Int(entry, currRing->cf);
193        if (entryAsInt < 0) entryAsInt += n_GetChar(currRing->cf);
194      }
195      else
196        entryAsInt=0;
197      longMatrix[r][c] = (unsigned long)entryAsInt;
198    }
199  return longMatrix;
200}
201
202/* expects an array of unsigned longs with valid indices 0..degree;
203   returns the following poly, where x denotes the first ring variable
204   of currRing, and d = degree:
205      polyCoeffs[d] * x^d + polyCoeffs[d-1] * x^(d-1) + ... + polyCoeffs[0]
206   leaves polyCoeffs unmodified */
207poly longCoeffsToSingularPoly(unsigned long *polyCoeffs, const int degree)
208{
209  poly result = NULL;
210  for (int i = 0; i <= degree; i++)
211  {
212    if ((int)polyCoeffs[i] != 0)
213    {
214      poly term = p_ISet((int)polyCoeffs[i], currRing);
215      if (i > 0)
216      {
217        p_SetExp(term, 1, i, currRing);
218        p_Setm(term, currRing);
219      }
220      result = p_Add_q(result, term, currRing);
221    }
222  }
223  return result;
224}
225
226/*2
227*  the "system" command
228*/
229BOOLEAN jjSYSTEM(leftv res, leftv args)
230{
231  if(args->Typ() == STRING_CMD)
232  {
233    const char *sys_cmd=(char *)(args->Data());
234    leftv h=args->next;
235// ONLY documented system calls go here
236// Undocumented system calls go down into jjEXTENDED_SYSTEM (#ifdef HAVE_EXTENDED_SYSTEM)
237/*==================== nblocks ==================================*/
238    if (strcmp(sys_cmd, "nblocks") == 0)
239    {
240      ring r;
241      if (h == NULL)
242      {
243        if (currRingHdl != NULL)
244        {
245          r = IDRING(currRingHdl);
246        }
247        else
248        {
249          WerrorS("no ring active");
250          return TRUE;
251        }
252      }
253      else
254      {
255        if (h->Typ() != RING_CMD)
256        {
257          WerrorS("ring expected");
258          return TRUE;
259        }
260        r = (ring) h->Data();
261      }
262      res->rtyp = INT_CMD;
263      res->data = (void*) (long)(rBlocks(r) - 1);
264      return FALSE;
265    }
266/*==================== version ==================================*/
267    if(strcmp(sys_cmd,"version")==0)
268    {
269      res->rtyp=INT_CMD;
270      res->data=(void *)SINGULAR_VERSION;
271      return FALSE;
272    }
273    else
274/*==================== alarm ==================================*/
275      if(strcmp(sys_cmd,"alarm")==0)
276      {
277        if ((h!=NULL) &&(h->Typ()==INT_CMD))
278        {
279          // standard variant -> SIGALARM (standard: abort)
280          //alarm((unsigned)h->next->Data());
281          // process time (user +system): SIGVTALARM
282          struct itimerval t,o;
283          memset(&t,0,sizeof(t));
284          t.it_value.tv_sec     =(unsigned)((unsigned long)h->Data());
285          setitimer(ITIMER_VIRTUAL,&t,&o);
286          return FALSE;
287        }
288        else
289          WerrorS("int expected");
290      }
291      else
292/*==================== content ==================================*/
293    if(strcmp(sys_cmd,"content")==0)
294    {
295      if ((h!=NULL) && ((h->Typ()==POLY_CMD)||(h->Typ()==VECTOR_CMD)))
296      {
297        int t=h->Typ();
298        poly p=(poly)h->CopyD();
299        if (p!=NULL)
300        {
301           if (!nCoeff_is_Ring(currRing->cf)) p_Cleardenom(p,currRing);
302          p_Content(p,currRing);
303        }
304        res->data=(void *)p;
305        res->rtyp=t;
306        return FALSE;
307      }
308      return TRUE;
309    }
310    else
311/*==================== cpu ==================================*/
312    if(strcmp(sys_cmd,"cpu")==0)
313    {
314      long cpu=1; //feOptValue(FE_OPT_CPUS);
315      #ifdef _SC_NPROCESSORS_ONLN
316      cpu=sysconf(_SC_NPROCESSORS_ONLN);
317      #elif defined(_SC_NPROCESSORS_CONF)
318      cpu=sysconf(_SC_NPROCESSORS_CONF);
319      #endif
320      res->data=(void *)cpu;
321      res->rtyp=INT_CMD;
322      return FALSE;
323    }
324    else
325/*==================== executable ==================================*/
326    if(strcmp(sys_cmd,"executable")==0)
327    {
328      if ((h!=NULL) && (h->Typ()==STRING_CMD))
329      {
330        char tbuf[MAXPATHLEN];
331        char *s=omFindExec((char*)h->Data(),tbuf);
332        if(s==NULL) s=(char*)"";
333        res->data=(void *)omStrDup(s);
334        res->rtyp=STRING_CMD;
335        return FALSE;
336      }
337      return TRUE;
338    }
339    else
340  /*==================== flatten =============================*/
341    if(strcmp(sys_cmd,"flatten")==0)
342    {
343      if ((h!=NULL) &&(h->Typ()==SMATRIX_CMD))
344      {
345        res->data=(char*)sm_Flatten((ideal)h->Data(),currRing);
346        res->rtyp=SMATRIX_CMD;
347        return FALSE;
348      }
349      else
350        WerrorS("smatrix expected");
351    }
352    else
353  /*==================== unflatten =============================*/
354    if(strcmp(sys_cmd,"unflatten")==0)
355    {
356      const short t1[]={2,SMATRIX_CMD,INT_CMD};
357      if (iiCheckTypes(h,t1,1))
358      {
359        res->data=(char*)sm_UnFlatten((ideal)h->Data(),(int)(long)h->next->Data(),currRing);
360        res->rtyp=SMATRIX_CMD;
361        return res->data==NULL;
362      }
363      else return TRUE;
364    }
365    else
366  /*==================== neworder =============================*/
367    if(strcmp(sys_cmd,"neworder")==0)
368    {
369      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
370      {
371        res->rtyp=STRING_CMD;
372        res->data=(void *)singclap_neworder((ideal)h->Data(), currRing);
373        return FALSE;
374      }
375      else
376        WerrorS("ideal expected");
377    }
378    else
379/*===== nc_hilb ===============================================*/
380   // Hilbert series of non-commutative monomial algebras
381    if(strcmp(sys_cmd,"nc_hilb") == 0)
382    {
383      ideal i; int lV;
384      bool ig = FALSE;
385      bool mgrad = FALSE;
386      bool autop = FALSE;
387      int trunDegHs=0;
388      if((h != NULL)&&(h->Typ() == IDEAL_CMD))
389        i = (ideal)h->Data();
390      else
391      {
392        WerrorS("nc_Hilb:ideal expected");
393        return TRUE;
394      }
395      h = h->next;
396      if((h != NULL)&&(h->Typ() == INT_CMD))
397        lV = (int)(long)h->Data();
398      else
399      {
400        WerrorS("nc_Hilb:int expected");
401        return TRUE;
402      }
403      h = h->next;
404      while(h != NULL)
405      {
406        if((int)(long)h->Data() == 1)
407          ig = TRUE;
408        else if((int)(long)h->Data() == 2)
409          mgrad = TRUE;
410        else if(h->Typ()==STRING_CMD)
411           autop = TRUE;
412        else if(h->Typ() == INT_CMD)
413          trunDegHs = (int)(long)h->Data();
414        h = h->next;
415      }
416      if(h != NULL)
417      {
418        WerrorS("nc_Hilb:int 1,2, total degree for the truncation, and a string                  for printing the details are expected");
419        return TRUE;
420      }
421
422      HilbertSeries_OrbitData(i, lV, ig, mgrad, autop, trunDegHs);
423      return(FALSE);
424    }
425    else
426/* ====== verify ============================*/
427    if(strcmp(sys_cmd,"verifyGB")==0)
428    {
429      if (rIsNCRing(currRing))
430      {
431        WerrorS("system(\"verifyGB\",<ideal>,..) expects a commutative ring");
432        return TRUE;
433      }
434      if (h->Typ()!=IDEAL_CMD)
435      {
436        WerrorS("expected system(\"verifyGB\",<ideal>,..)");
437        return TRUE;
438      }
439      ideal F=(ideal)h->Data();
440      if (h->next==NULL)
441      {
442        #ifdef HAVE_VSPACE
443        int cpus = (long) feOptValue(FE_OPT_CPUS);
444        if (cpus>1)
445          res->data=(char*)(long) kVerify2(F,currRing->qideal);
446        else
447        #endif
448          res->data=(char*)(long) kVerify1(F,currRing->qideal);
449      }
450      else return TRUE;
451      res->rtyp=INT_CMD;
452      return FALSE;
453    }
454    else
455/*===== rcolon ===============================================*/
456  if(strcmp(sys_cmd,"rcolon") == 0)
457  {
458    const short t1[]={3,IDEAL_CMD,POLY_CMD,INT_CMD};
459    if (iiCheckTypes(h,t1,1))
460    {
461      ideal i = (ideal)h->Data();
462      h = h->next;
463      poly w=(poly)h->Data();
464      h = h->next;
465      int lV = (int)(long)h->Data();
466      res->rtyp = IDEAL_CMD;
467      res->data = RightColonOperation(i, w, lV);
468      return(FALSE);
469    }
470    else
471      return TRUE;
472  }
473  else
474
475/*==================== sh ==================================*/
476    if(strcmp(sys_cmd,"sh")==0)
477    {
478      if (feOptValue(FE_OPT_NO_SHELL))
479      {
480        WerrorS("shell execution is disallowed in restricted mode");
481        return TRUE;
482      }
483      res->rtyp=INT_CMD;
484      if (h==NULL) res->data = (void *)(long) system("sh");
485      else if (h->Typ()==STRING_CMD)
486        res->data = (void*)(long) system((char*)(h->Data()));
487      else
488        WerrorS("string expected");
489      return FALSE;
490    }
491    else
492/*========reduce procedure like the global one but with jet bounds=======*/
493    if(strcmp(sys_cmd,"reduce_bound")==0)
494    {
495      poly p;
496      ideal pid=NULL;
497      const short t1[]={3,POLY_CMD,IDEAL_CMD,INT_CMD};
498      const short t2[]={3,IDEAL_CMD,IDEAL_CMD,INT_CMD};
499      const short t3[]={3,VECTOR_CMD,MODUL_CMD,INT_CMD};
500      const short t4[]={3,MODUL_CMD,MODUL_CMD,INT_CMD};
501      if ((iiCheckTypes(h,t1,0))||((iiCheckTypes(h,t3,0))))
502      {
503        p = (poly)h->CopyD();
504      }
505      else if  ((iiCheckTypes(h,t2,0))||(iiCheckTypes(h,t4,1)))
506      {
507        pid = (ideal)h->CopyD();
508      }
509      else return TRUE;
510      //int htype;
511      res->rtyp= h->Typ(); /*htype*/
512      ideal q = (ideal)h->next->CopyD();
513      int bound = (int)(long)h->next->next->Data();
514      if (pid==NULL) /*(htype == POLY_CMD || htype == VECTOR_CMD)*/
515        res->data = (char *)kNFBound(q,currRing->qideal,p,bound);
516      else /*(htype == IDEAL_CMD || htype == MODUL_CMD)*/
517        res->data = (char *)kNFBound(q,currRing->qideal,pid,bound);
518      return FALSE;
519    }
520    else
521/*==================== uname ==================================*/
522    if(strcmp(sys_cmd,"uname")==0)
523    {
524      res->rtyp=STRING_CMD;
525      res->data = omStrDup(S_UNAME);
526      return FALSE;
527    }
528    else
529/*==================== with ==================================*/
530    if(strcmp(sys_cmd,"with")==0)
531    {
532      if (h==NULL)
533      {
534        res->rtyp=STRING_CMD;
535        res->data=(void *)versionString();
536        return FALSE;
537      }
538      else if (h->Typ()==STRING_CMD)
539      {
540        #define TEST_FOR(A) if(strcmp(s,A)==0) res->data=(void *)1; else
541        char *s=(char *)h->Data();
542        res->rtyp=INT_CMD;
543        #ifdef HAVE_DBM
544          TEST_FOR("DBM")
545        #endif
546        #ifdef HAVE_DLD
547          TEST_FOR("DLD")
548        #endif
549          //TEST_FOR("factory")
550          //TEST_FOR("libfac")
551        #ifdef HAVE_READLINE
552          TEST_FOR("readline")
553        #endif
554        #ifdef TEST_MAC_ORDER
555          TEST_FOR("MAC_ORDER")
556        #endif
557        // unconditional since 3-1-0-6
558          TEST_FOR("Namespaces")
559        #ifdef HAVE_DYNAMIC_LOADING
560          TEST_FOR("DynamicLoading")
561        #endif
562        #ifdef HAVE_EIGENVAL
563          TEST_FOR("eigenval")
564        #endif
565        #ifdef HAVE_GMS
566          TEST_FOR("gms")
567        #endif
568        #ifdef OM_NDEBUG
569          TEST_FOR("om_ndebug")
570        #endif
571        #ifdef SING_NDEBUG
572          TEST_FOR("ndebug")
573        #endif
574          {};
575          return FALSE;
576        #undef TEST_FOR
577      }
578      return TRUE;
579    }
580    else
581  /*==================== browsers ==================================*/
582    if (strcmp(sys_cmd,"browsers")==0)
583    {
584      res->rtyp = STRING_CMD;
585      StringSetS("");
586      feStringAppendBrowsers(0);
587      res->data = StringEndS();
588      return FALSE;
589    }
590    else
591  /*==================== pid ==================================*/
592    if (strcmp(sys_cmd,"pid")==0)
593    {
594      res->rtyp=INT_CMD;
595      res->data=(void *)(long) getpid();
596      return FALSE;
597    }
598    else
599  /*==================== getenv ==================================*/
600    if (strcmp(sys_cmd,"getenv")==0)
601    {
602      if ((h!=NULL) && (h->Typ()==STRING_CMD))
603      {
604        res->rtyp=STRING_CMD;
605        const char *r=getenv((char *)h->Data());
606        if (r==NULL) r="";
607        res->data=(void *)omStrDup(r);
608        return FALSE;
609      }
610      else
611      {
612        WerrorS("string expected");
613        return TRUE;
614      }
615    }
616    else
617  /*==================== setenv ==================================*/
618    if (strcmp(sys_cmd,"setenv")==0)
619    {
620  #ifdef HAVE_SETENV
621      const short t[]={2,STRING_CMD,STRING_CMD};
622      if (iiCheckTypes(h,t,1))
623      {
624        res->rtyp=STRING_CMD;
625        setenv((char *)h->Data(), (char *)h->next->Data(), 1);
626        res->data=(void *)omStrDup((char *)h->next->Data());
627        feReInitResources();
628        return FALSE;
629      }
630      else
631      {
632        return TRUE;
633      }
634  #else
635      WerrorS("setenv not supported on this platform");
636      return TRUE;
637  #endif
638    }
639    else
640  /*==================== Singular ==================================*/
641    if (strcmp(sys_cmd, "Singular") == 0)
642    {
643      res->rtyp=STRING_CMD;
644      const char *r=feResource("Singular");
645      if (r == NULL) r="";
646      res->data = (void*) omStrDup( r );
647      return FALSE;
648    }
649    else
650    if (strcmp(sys_cmd, "SingularLib") == 0)
651    {
652      res->rtyp=STRING_CMD;
653      const char *r=feResource("SearchPath");
654      if (r == NULL) r="";
655      res->data = (void*) omStrDup( r );
656      return FALSE;
657    }
658    else
659    if (strcmp(sys_cmd, "SingularBin") == 0)
660    {
661      res->rtyp=STRING_CMD;
662      const char *r=feResource('r');
663      if (r == NULL) r="/usr/local";
664      int l=strlen(r);
665      /* where to find Singular's programs: */
666      #define SINGULAR_PROCS_DIR "/libexec/singular/MOD"
667      int ll=si_max((int)strlen(SINGULAR_PROCS_DIR),(int)strlen(LIBEXEC_DIR));
668      char *s=(char*)omAlloc(l+ll+2);
669      if ((strstr(r,".libs/..")==NULL)   /*not installed Singular (libtool)*/
670      &&(strstr(r,"Singular/..")==NULL)) /*not installed Singular (static)*/
671      {
672        strcpy(s,r);
673        strcat(s,SINGULAR_PROCS_DIR);
674        if (access(s,X_OK)==0)
675        {
676          strcat(s,"/");
677        }
678        else
679        {
680          /*second try: LIBEXEC_DIR*/
681          strcpy(s,LIBEXEC_DIR);
682          if (access(s,X_OK)==0)
683          {
684            strcat(s,"/");
685          }
686          else
687          {
688            s[0]='\0';
689          }
690        }
691      }
692      else
693      {
694        const char *r=feResource('b');
695        if (r == NULL)
696        {
697          s[0]='\0';
698        }
699        else
700        {
701          strcpy(s,r);
702          strcat(s,"/");
703        }
704      }
705      res->data = (void*)s;
706      return FALSE;
707    }
708    else
709  /*==================== options ==================================*/
710    if (strstr(sys_cmd, "--") == sys_cmd)
711    {
712      if (strcmp(sys_cmd, "--") == 0)
713      {
714        fePrintOptValues();
715        return FALSE;
716      }
717      feOptIndex opt = feGetOptIndex(&sys_cmd[2]);
718      if (opt == FE_OPT_UNDEF)
719      {
720        Werror("Unknown option %s", sys_cmd);
721        WerrorS("Use 'system(\"--\");' for listing of available options");
722        return TRUE;
723      }
724      // for Untyped Options (help version),
725      // setting it just triggers action
726      if (feOptSpec[opt].type == feOptUntyped)
727      {
728        feSetOptValue(opt,0);
729        return FALSE;
730      }
731      if (h == NULL)
732      {
733        if (feOptSpec[opt].type == feOptString)
734        {
735          res->rtyp = STRING_CMD;
736          const char *r=(const char*)feOptSpec[opt].value;
737          if (r == NULL) r="";
738          res->data = omStrDup(r);
739        }
740        else
741        {
742          res->rtyp = INT_CMD;
743          res->data = feOptSpec[opt].value;
744        }
745        return FALSE;
746      }
747      if (h->Typ() != STRING_CMD &&
748          h->Typ() != INT_CMD)
749      {
750        WerrorS("Need string or int argument to set option value");
751        return TRUE;
752      }
753      const char* errormsg;
754      if (h->Typ() == INT_CMD)
755      {
756        if (feOptSpec[opt].type == feOptString)
757        {
758          Werror("Need string argument to set value of option %s", sys_cmd);
759          return TRUE;
760        }
761        errormsg = feSetOptValue(opt, (int)((long) h->Data()));
762        if (errormsg != NULL)
763          Werror("Option '--%s=%d' %s", sys_cmd, (int) ((long)h->Data()), errormsg);
764      }
765      else
766      {
767        errormsg = feSetOptValue(opt, (char*) h->Data());
768        if (errormsg != NULL)
769          Werror("Option '--%s=%s' %s", sys_cmd, (char*) h->Data(), errormsg);
770      }
771      if (errormsg != NULL) return TRUE;
772      return FALSE;
773    }
774    else
775  /*==================== HC ==================================*/
776    if (strcmp(sys_cmd,"HC")==0)
777    {
778      res->rtyp=INT_CMD;
779      res->data=(void *)(long) HCord;
780      return FALSE;
781    }
782    else
783  /*==================== random ==================================*/
784    if(strcmp(sys_cmd,"random")==0)
785    {
786      const short t[]={1,INT_CMD};
787      if (h!=NULL)
788      {
789        if (iiCheckTypes(h,t,1))
790        {
791          siRandomStart=(int)((long)h->Data());
792          siSeed=siRandomStart;
793          factoryseed(siRandomStart);
794          return FALSE;
795        }
796        else
797        {
798          return TRUE;
799        }
800      }
801      res->rtyp=INT_CMD;
802      res->data=(void*)(long) siSeed;
803      return FALSE;
804    }
805    else
806  /*======================= demon_list =====================*/
807    if (strcmp(sys_cmd,"denom_list")==0)
808    {
809      res->rtyp=LIST_CMD;
810      extern lists get_denom_list();
811      res->data=(lists)get_denom_list();
812      return FALSE;
813    }
814    else
815    /*==================== complexNearZero ======================*/
816    if(strcmp(sys_cmd,"complexNearZero")==0)
817    {
818      const short t[]={2,NUMBER_CMD,INT_CMD};
819      if (iiCheckTypes(h,t,1))
820      {
821        if ( !rField_is_long_C(currRing) )
822        {
823          WerrorS( "unsupported ground field!");
824          return TRUE;
825        }
826        else
827        {
828          res->rtyp=INT_CMD;
829          res->data=(void*)complexNearZero((gmp_complex*)h->Data(),
830                             (int)((long)(h->next->Data())));
831          return FALSE;
832        }
833      }
834      else
835      {
836        return TRUE;
837      }
838    }
839    else
840  /*==================== getPrecDigits ======================*/
841    if(strcmp(sys_cmd,"getPrecDigits")==0)
842    {
843      if ( (currRing==NULL)
844      ||  (!rField_is_long_C(currRing) && !rField_is_long_R(currRing)))
845      {
846        WerrorS( "unsupported ground field!");
847        return TRUE;
848      }
849      res->rtyp=INT_CMD;
850      res->data=(void*)(long)gmp_output_digits;
851      //if (gmp_output_digits!=getGMPFloatDigits())
852      //{ Print("%d, %d\n",getGMPFloatDigits(),gmp_output_digits);}
853      return FALSE;
854    }
855    else
856  /*==================== lduDecomp ======================*/
857    if(strcmp(sys_cmd, "lduDecomp")==0)
858    {
859      const short t[]={1,MATRIX_CMD};
860      if (iiCheckTypes(h,t,1))
861      {
862        matrix aMat = (matrix)h->Data();
863        matrix pMat; matrix lMat; matrix dMat; matrix uMat;
864        poly l; poly u; poly prodLU;
865        lduDecomp(aMat, pMat, lMat, dMat, uMat, l, u, prodLU);
866        lists L = (lists)omAllocBin(slists_bin);
867        L->Init(7);
868        L->m[0].rtyp = MATRIX_CMD; L->m[0].data=(void*)pMat;
869        L->m[1].rtyp = MATRIX_CMD; L->m[1].data=(void*)lMat;
870        L->m[2].rtyp = MATRIX_CMD; L->m[2].data=(void*)dMat;
871        L->m[3].rtyp = MATRIX_CMD; L->m[3].data=(void*)uMat;
872        L->m[4].rtyp = POLY_CMD; L->m[4].data=(void*)l;
873        L->m[5].rtyp = POLY_CMD; L->m[5].data=(void*)u;
874        L->m[6].rtyp = POLY_CMD; L->m[6].data=(void*)prodLU;
875        res->rtyp = LIST_CMD;
876        res->data = (char *)L;
877        return FALSE;
878      }
879      else
880      {
881        return TRUE;
882      }
883    }
884    else
885  /*==================== lduSolve ======================*/
886    if(strcmp(sys_cmd, "lduSolve")==0)
887    {
888      /* for solving a linear equation system A * x = b, via the
889           given LDU-decomposition of the matrix A;
890           There is one valid parametrisation:
891           1) exactly eight arguments P, L, D, U, l, u, lTimesU, b;
892              P, L, D, and U realise the LDU-decomposition of A, that is,
893              P * A = L * D^(-1) * U, and P, L, D, and U satisfy the
894              properties decribed in method 'luSolveViaLDUDecomp' in
895              linearAlgebra.h; see there;
896              l, u, and lTimesU are as described in the same location;
897              b is the right-hand side vector of the linear equation system;
898           The method will return a list of either 1 entry or three entries:
899           1) [0] if there is no solution to the system;
900           2) [1, x, H] if there is at least one solution;
901              x is any solution of the given linear system,
902              H is the matrix with column vectors spanning the homogeneous
903              solution space.
904           The method produces an error if matrix and vector sizes do not
905           fit. */
906      const short t[]={7,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD,POLY_CMD,POLY_CMD,MATRIX_CMD};
907      if (!iiCheckTypes(h,t,1))
908      {
909        return TRUE;
910      }
911      if (rField_is_Ring(currRing))
912      {
913        WerrorS("field required");
914        return TRUE;
915      }
916      matrix pMat  = (matrix)h->Data();
917      matrix lMat  = (matrix)h->next->Data();
918      matrix dMat  = (matrix)h->next->next->Data();
919      matrix uMat  = (matrix)h->next->next->next->Data();
920      poly l       = (poly)  h->next->next->next->next->Data();
921      poly u       = (poly)  h->next->next->next->next->next->Data();
922      poly lTimesU = (poly)  h->next->next->next->next->next->next->Data();
923      matrix bVec  = (matrix)h->next->next->next->next->next->next->next->Data();
924      matrix xVec; int solvable; matrix homogSolSpace;
925      if (pMat->rows() != pMat->cols())
926      {
927        Werror("first matrix (%d x %d) is not quadratic",
928                 pMat->rows(), pMat->cols());
929        return TRUE;
930      }
931      if (lMat->rows() != lMat->cols())
932      {
933        Werror("second matrix (%d x %d) is not quadratic",
934                 lMat->rows(), lMat->cols());
935        return TRUE;
936      }
937      if (dMat->rows() != dMat->cols())
938      {
939        Werror("third matrix (%d x %d) is not quadratic",
940                 dMat->rows(), dMat->cols());
941        return TRUE;
942      }
943      if (dMat->cols() != uMat->rows())
944      {
945        Werror("third matrix (%d x %d) and fourth matrix (%d x %d) %s",
946                 dMat->rows(), dMat->cols(), uMat->rows(), uMat->cols(),
947                 "do not t");
948        return TRUE;
949      }
950      if (uMat->rows() != bVec->rows())
951      {
952        Werror("fourth matrix (%d x %d) and vector (%d x 1) do not fit",
953                 uMat->rows(), uMat->cols(), bVec->rows());
954        return TRUE;
955      }
956      solvable = luSolveViaLDUDecomp(pMat, lMat, dMat, uMat, l, u, lTimesU,
957                                       bVec, xVec, homogSolSpace);
958
959      /* build the return structure; a list with either one or
960           three entries */
961      lists ll = (lists)omAllocBin(slists_bin);
962      if (solvable)
963      {
964        ll->Init(3);
965        ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)solvable;
966        ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)xVec;
967        ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)homogSolSpace;
968      }
969      else
970      {
971        ll->Init(1);
972        ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)solvable;
973      }
974      res->rtyp = LIST_CMD;
975      res->data=(char*)ll;
976      return FALSE;
977    }
978    else
979  /*==== countedref: reference and shared ====*/
980    if (strcmp(sys_cmd, "shared") == 0)
981    {
982      #ifndef SI_COUNTEDREF_AUTOLOAD
983      void countedref_shared_load();
984      countedref_shared_load();
985      #endif
986      res->rtyp = NONE;
987      return FALSE;
988    }
989    else if (strcmp(sys_cmd, "reference") == 0)
990    {
991      #ifndef SI_COUNTEDREF_AUTOLOAD
992      void countedref_reference_load();
993      countedref_reference_load();
994      #endif
995      res->rtyp = NONE;
996      return FALSE;
997    }
998    else
999/*==================== semaphore =================*/
1000#ifdef HAVE_SIMPLEIPC
1001    if (strcmp(sys_cmd,"semaphore")==0)
1002    {
1003      if((h!=NULL) && (h->Typ()==STRING_CMD) && (h->next!=NULL) && (h->next->Typ()==INT_CMD))
1004      {
1005        int v=1;
1006        if ((h->next->next!=NULL)&& (h->next->next->Typ()==INT_CMD))
1007          v=(int)(long)h->next->next->Data();
1008        res->data=(char *)(long)simpleipc_cmd((char *)h->Data(),(int)(long)h->next->Data(),v);
1009        res->rtyp=INT_CMD;
1010        return FALSE;
1011      }
1012      else
1013      {
1014        WerrorS("Usage: system(\"semaphore\",<cmd>,int)");
1015        return TRUE;
1016      }
1017    }
1018    else
1019#endif
1020/*==================== reserved port =================*/
1021    if (strcmp(sys_cmd,"reserve")==0)
1022    {
1023      int ssiReservePort(int clients);
1024      const short t[]={1,INT_CMD};
1025      if (iiCheckTypes(h,t,1))
1026      {
1027        res->rtyp=INT_CMD;
1028        int p=ssiReservePort((int)(long)h->Data());
1029        res->data=(void*)(long)p;
1030        return (p==0);
1031      }
1032      return TRUE;
1033    }
1034    else
1035/*==================== reserved link =================*/
1036    if (strcmp(sys_cmd,"reservedLink")==0)
1037    {
1038      res->rtyp=LINK_CMD;
1039      si_link p=ssiCommandLink();
1040      res->data=(void*)p;
1041      return (p==NULL);
1042    }
1043    else
1044/*==================== install newstruct =================*/
1045    if (strcmp(sys_cmd,"install")==0)
1046    {
1047      const short t[]={4,STRING_CMD,STRING_CMD,PROC_CMD,INT_CMD};
1048      if (iiCheckTypes(h,t,1))
1049      {
1050        return newstruct_set_proc((char*)h->Data(),(char*)h->next->Data(),
1051                                (int)(long)h->next->next->next->Data(),
1052                                (procinfov)h->next->next->Data());
1053      }
1054      return TRUE;
1055    }
1056    else
1057/*==================== newstruct =================*/
1058    if (strcmp(sys_cmd,"newstruct")==0)
1059    {
1060      const short t[]={1,STRING_CMD};
1061      if (iiCheckTypes(h,t,1))
1062      {
1063        int id=0;
1064        char *n=(char*)h->Data();
1065        blackboxIsCmd(n,id);
1066        if (id>0)
1067        {
1068          blackbox *bb=getBlackboxStuff(id);
1069          if (BB_LIKE_LIST(bb))
1070          {
1071            newstruct_desc desc=(newstruct_desc)bb->data;
1072            newstructShow(desc);
1073            return FALSE;
1074          }
1075          else Werror("'%s' is not a newstruct",n);
1076        }
1077        else Werror("'%s' is not a blackbox object",n);
1078      }
1079      return TRUE;
1080    }
1081    else
1082/*==================== blackbox =================*/
1083    if (strcmp(sys_cmd,"blackbox")==0)
1084    {
1085      printBlackboxTypes();
1086      return FALSE;
1087    }
1088    else
1089  /*================= absBiFact ======================*/
1090    #if defined(HAVE_FLINT) || defined(HAVE_NTL)
1091    if (strcmp(sys_cmd, "absFact") == 0)
1092    {
1093      const short t[]={1,POLY_CMD};
1094      if (iiCheckTypes(h,t,1)
1095      && (currRing!=NULL)
1096      && (getCoeffType(currRing->cf)==n_transExt))
1097      {
1098        res->rtyp=LIST_CMD;
1099        intvec *v=NULL;
1100        ideal mipos= NULL;
1101        int n= 0;
1102        ideal f=singclap_absFactorize((poly)(h->Data()), mipos, &v, n, currRing);
1103        if (f==NULL) return TRUE;
1104        ivTest(v);
1105        lists l=(lists)omAllocBin(slists_bin);
1106        l->Init(4);
1107        l->m[0].rtyp=IDEAL_CMD;
1108        l->m[0].data=(void *)f;
1109        l->m[1].rtyp=INTVEC_CMD;
1110        l->m[1].data=(void *)v;
1111        l->m[2].rtyp=IDEAL_CMD;
1112        l->m[2].data=(void*) mipos;
1113        l->m[3].rtyp=INT_CMD;
1114        l->m[3].data=(void*) (long) n;
1115        res->data=(void *)l;
1116        return FALSE;
1117      }
1118      else return TRUE;
1119    }
1120    else
1121    #endif
1122  /* =================== LLL via NTL ==============================*/
1123  #ifdef HAVE_NTL
1124    if (strcmp(sys_cmd, "LLL") == 0)
1125    {
1126      if (h!=NULL)
1127      {
1128        res->rtyp=h->Typ();
1129        if (h->Typ()==MATRIX_CMD)
1130        {
1131          res->data=(char *)singntl_LLL((matrix)h->Data(), currRing);
1132          return FALSE;
1133        }
1134        else if (h->Typ()==INTMAT_CMD)
1135        {
1136          res->data=(char *)singntl_LLL((intvec*)h->Data());
1137          return FALSE;
1138        }
1139        else return TRUE;
1140      }
1141      else return TRUE;
1142    }
1143    else
1144  #endif
1145  /* =================== LLL via Flint ==============================*/
1146  #ifdef HAVE_FLINT
1147  #if __FLINT_RELEASE >= 20500
1148    if (strcmp(sys_cmd, "LLL_Flint") == 0)
1149    {
1150      if (h!=NULL)
1151      {
1152        if(h->next == NULL)
1153        {
1154            res->rtyp=h->Typ();
1155            if (h->Typ()==BIGINTMAT_CMD)
1156            {
1157              res->data=(char *)singflint_LLL((bigintmat*)h->Data(), NULL);
1158              return FALSE;
1159            }
1160            else if (h->Typ()==INTMAT_CMD)
1161            {
1162              res->data=(char *)singflint_LLL((intvec*)h->Data(), NULL);
1163              return FALSE;
1164            }
1165            else return TRUE;
1166        }
1167        if(h->next->Typ()!= INT_CMD)
1168        {
1169            WerrorS("matrix,int or bigint,int expected");
1170            return TRUE;
1171        }
1172        if(h->next->Typ()== INT_CMD)
1173        {
1174            if(((int)((long)(h->next->Data())) != 0) && (int)((long)(h->next->Data()) != 1))
1175            {
1176                WerrorS("int is different from 0, 1");
1177                return TRUE;
1178            }
1179            res->rtyp=h->Typ();
1180            if((long)(h->next->Data()) == 0)
1181            {
1182                if (h->Typ()==BIGINTMAT_CMD)
1183                {
1184                  res->data=(char *)singflint_LLL((bigintmat*)h->Data(), NULL);
1185                  return FALSE;
1186                }
1187                else if (h->Typ()==INTMAT_CMD)
1188                {
1189                  res->data=(char *)singflint_LLL((intvec*)h->Data(), NULL);
1190                  return FALSE;
1191                }
1192                else return TRUE;
1193            }
1194            // This will give also the transformation matrix U s.t. res = U * m
1195            if((long)(h->next->Data()) == 1)
1196            {
1197                if (h->Typ()==BIGINTMAT_CMD)
1198                {
1199                  bigintmat* m = (bigintmat*)h->Data();
1200                  bigintmat* T = new bigintmat(m->rows(),m->rows(),m->basecoeffs());
1201                  for(int i = 1; i<=m->rows(); i++)
1202                  {
1203                    n_Delete(&(BIMATELEM(*T,i,i)),T->basecoeffs());
1204                    BIMATELEM(*T,i,i)=n_Init(1, T->basecoeffs());
1205                  }
1206                  m = singflint_LLL(m,T);
1207                  lists L = (lists)omAllocBin(slists_bin);
1208                  L->Init(2);
1209                  L->m[0].rtyp = BIGINTMAT_CMD;  L->m[0].data = (void*)m;
1210                  L->m[1].rtyp = BIGINTMAT_CMD;  L->m[1].data = (void*)T;
1211                  res->data=L;
1212                  res->rtyp=LIST_CMD;
1213                  return FALSE;
1214                }
1215                else if (h->Typ()==INTMAT_CMD)
1216                {
1217                  intvec* m = (intvec*)h->Data();
1218                  intvec* T = new intvec(m->rows(),m->rows(),(int)0);
1219                  for(int i = 1; i<=m->rows(); i++)
1220                    IMATELEM(*T,i,i)=1;
1221                  m = singflint_LLL(m,T);
1222                  lists L = (lists)omAllocBin(slists_bin);
1223                  L->Init(2);
1224                  L->m[0].rtyp = INTMAT_CMD;  L->m[0].data = (void*)m;
1225                  L->m[1].rtyp = INTMAT_CMD;  L->m[1].data = (void*)T;
1226                  res->data=L;
1227                  res->rtyp=LIST_CMD;
1228                  return FALSE;
1229                }
1230                else return TRUE;
1231            }
1232        }
1233
1234      }
1235      else return TRUE;
1236    }
1237    else
1238  #endif
1239  #endif
1240/* ====== rref ============================*/
1241  #if defined(HAVE_FLINT) || defined(HAVE_NTL)
1242  if(strcmp(sys_cmd,"rref")==0)
1243  {
1244    const short t1[]={1,MATRIX_CMD};
1245    const short t2[]={1,SMATRIX_CMD};
1246    if (iiCheckTypes(h,t1,0))
1247    {
1248      matrix M=(matrix)h->Data();
1249      #if defined(HAVE_FLINT)
1250      res->data=(void*)singflint_rref(M,currRing);
1251      #elif defined(HAVE_NTL)
1252      res->data=(void*)singntl_rref(M,currRing);
1253      #endif
1254      res->rtyp=MATRIX_CMD;
1255      return FALSE;
1256    }
1257    else if (iiCheckTypes(h,t2,1))
1258    {
1259      ideal M=(ideal)h->Data();
1260      #if defined(HAVE_FLINT)
1261      res->data=(void*)singflint_rref(M,currRing);
1262      #elif defined(HAVE_NTL)
1263      res->data=(void*)singntl_rref(M,currRing);
1264      #endif
1265      res->rtyp=SMATRIX_CMD;
1266      return FALSE;
1267    }
1268    else
1269    {
1270      WerrorS("expected system(\"rref\",<matrix>/<smatrix>)");
1271      return TRUE;
1272    }
1273  }
1274  else
1275  #endif
1276  /*==================== pcv ==================================*/
1277  #ifdef HAVE_PCV
1278    if(strcmp(sys_cmd,"pcvLAddL")==0)
1279    {
1280      return pcvLAddL(res,h);
1281    }
1282    else
1283    if(strcmp(sys_cmd,"pcvPMulL")==0)
1284    {
1285      return pcvPMulL(res,h);
1286    }
1287    else
1288    if(strcmp(sys_cmd,"pcvMinDeg")==0)
1289    {
1290      return pcvMinDeg(res,h);
1291    }
1292    else
1293    if(strcmp(sys_cmd,"pcvP2CV")==0)
1294    {
1295      return pcvP2CV(res,h);
1296    }
1297    else
1298    if(strcmp(sys_cmd,"pcvCV2P")==0)
1299    {
1300      return pcvCV2P(res,h);
1301    }
1302    else
1303    if(strcmp(sys_cmd,"pcvDim")==0)
1304    {
1305      return pcvDim(res,h);
1306    }
1307    else
1308    if(strcmp(sys_cmd,"pcvBasis")==0)
1309    {
1310      return pcvBasis(res,h);
1311    }
1312    else
1313  #endif
1314  /*==================== hessenberg/eigenvalues ==================================*/
1315  #ifdef HAVE_EIGENVAL
1316    if(strcmp(sys_cmd,"hessenberg")==0)
1317    {
1318      return evHessenberg(res,h);
1319    }
1320    else
1321  #endif
1322  /*==================== eigenvalues ==================================*/
1323  #ifdef HAVE_EIGENVAL
1324    if(strcmp(sys_cmd,"eigenvals")==0)
1325    {
1326      return evEigenvals(res,h);
1327    }
1328    else
1329  #endif
1330  /*==================== rowelim ==================================*/
1331  #ifdef HAVE_EIGENVAL
1332    if(strcmp(sys_cmd,"rowelim")==0)
1333    {
1334      return evRowElim(res,h);
1335    }
1336    else
1337  #endif
1338  /*==================== rowcolswap ==================================*/
1339  #ifdef HAVE_EIGENVAL
1340    if(strcmp(sys_cmd,"rowcolswap")==0)
1341    {
1342      return evSwap(res,h);
1343    }
1344    else
1345  #endif
1346  /*==================== Gauss-Manin system ==================================*/
1347  #ifdef HAVE_GMS
1348    if(strcmp(sys_cmd,"gmsnf")==0)
1349    {
1350      return gmsNF(res,h);
1351    }
1352    else
1353  #endif
1354  /*==================== contributors =============================*/
1355    if(strcmp(sys_cmd,"contributors") == 0)
1356    {
1357      res->rtyp=STRING_CMD;
1358      res->data=(void *)omStrDup(
1359         "Olaf Bachmann, Michael Brickenstein, Hubert Grassmann, Kai Krueger, Victor Levandovskyy, Wolfgang Neumann, Thomas Nuessler, Wilfred Pohl, Jens Schmidt, Mathias Schulze, Thomas Siebert, Ruediger Stobbe, Moritz Wenk, Tim Wichmann");
1360      return FALSE;
1361    }
1362    else
1363  /*==================== spectrum =============================*/
1364    #ifdef HAVE_SPECTRUM
1365    if(strcmp(sys_cmd,"spectrum") == 0)
1366    {
1367      if ((h==NULL) || (h->Typ()!=POLY_CMD))
1368      {
1369        WerrorS("poly expected");
1370        return TRUE;
1371      }
1372      if (h->next==NULL)
1373        return spectrumProc(res,h);
1374      if (h->next->Typ()!=INT_CMD)
1375      {
1376        WerrorS("poly,int expected");
1377        return TRUE;
1378      }
1379      if(((long)h->next->Data())==1L)
1380         return spectrumfProc(res,h);
1381      return spectrumProc(res,h);
1382    }
1383    else
1384  /*==================== semic =============================*/
1385    if(strcmp(sys_cmd,"semic") == 0)
1386    {
1387      if ((h->next!=NULL)
1388      && (h->Typ()==LIST_CMD)
1389      && (h->next->Typ()==LIST_CMD))
1390      {
1391        if (h->next->next==NULL)
1392          return semicProc(res,h,h->next);
1393        else if (h->next->next->Typ()==INT_CMD)
1394          return semicProc3(res,h,h->next,h->next->next);
1395      }
1396      return TRUE;
1397    }
1398    else
1399  /*==================== spadd =============================*/
1400    if(strcmp(sys_cmd,"spadd") == 0)
1401    {
1402      const short t[]={2,LIST_CMD,LIST_CMD};
1403      if (iiCheckTypes(h,t,1))
1404      {
1405        return spaddProc(res,h,h->next);
1406      }
1407      return TRUE;
1408    }
1409    else
1410  /*==================== spmul =============================*/
1411    if(strcmp(sys_cmd,"spmul") == 0)
1412    {
1413      const short t[]={2,LIST_CMD,INT_CMD};
1414      if (iiCheckTypes(h,t,1))
1415      {
1416        return spmulProc(res,h,h->next);
1417      }
1418      return TRUE;
1419    }
1420    else
1421  #endif
1422/*==================== tensorModuleMult ========================= */
1423  #define HAVE_SHEAFCOH_TRICKS 1
1424
1425  #ifdef HAVE_SHEAFCOH_TRICKS
1426    if(strcmp(sys_cmd,"tensorModuleMult")==0)
1427    {
1428      const short t[]={2,INT_CMD,MODUL_CMD};
1429  //      WarnS("tensorModuleMult!");
1430      if (iiCheckTypes(h,t,1))
1431      {
1432        int m = (int)( (long)h->Data() );
1433        ideal M = (ideal)h->next->Data();
1434        res->rtyp=MODUL_CMD;
1435        res->data=(void *)id_TensorModuleMult(m, M, currRing);
1436        return FALSE;
1437      }
1438      return TRUE;
1439    }
1440    else
1441  #endif
1442  /*==================== twostd  =================*/
1443  #ifdef HAVE_PLURAL
1444    if (strcmp(sys_cmd, "twostd") == 0)
1445    {
1446      ideal I;
1447      if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
1448      {
1449        I=(ideal)h->CopyD();
1450        res->rtyp=IDEAL_CMD;
1451        if (rIsPluralRing(currRing)) res->data=twostd(I);
1452        else res->data=I;
1453        setFlag(res,FLAG_TWOSTD);
1454        setFlag(res,FLAG_STD);
1455      }
1456      else return TRUE;
1457      return FALSE;
1458    }
1459    else
1460  #endif
1461  /*==================== lie bracket =================*/
1462  #ifdef HAVE_PLURAL
1463    if (strcmp(sys_cmd, "bracket") == 0)
1464    {
1465      const short t[]={2,POLY_CMD,POLY_CMD};
1466      if (iiCheckTypes(h,t,1))
1467      {
1468        poly p=(poly)h->CopyD();
1469        h=h->next;
1470        poly q=(poly)h->Data();
1471        res->rtyp=POLY_CMD;
1472        if (rIsPluralRing(currRing))  res->data=nc_p_Bracket_qq(p,q, currRing);
1473        return FALSE;
1474      }
1475      return TRUE;
1476    }
1477    else
1478  #endif
1479  /*==================== env ==================================*/
1480  #ifdef HAVE_PLURAL
1481    if (strcmp(sys_cmd, "env")==0)
1482    {
1483      if ((h!=NULL) && (h->Typ()==RING_CMD))
1484      {
1485        ring r = (ring)h->Data();
1486        res->data = rEnvelope(r);
1487        res->rtyp = RING_CMD;
1488        return FALSE;
1489      }
1490      else
1491      {
1492        WerrorS("`system(\"env\",<ring>)` expected");
1493        return TRUE;
1494      }
1495    }
1496    else
1497  #endif
1498/* ============ opp ======================== */
1499  #ifdef HAVE_PLURAL
1500    if (strcmp(sys_cmd, "opp")==0)
1501    {
1502      if ((h!=NULL) && (h->Typ()==RING_CMD))
1503      {
1504        ring r=(ring)h->Data();
1505        res->data=rOpposite(r);
1506        res->rtyp=RING_CMD;
1507        return FALSE;
1508      }
1509      else
1510      {
1511        WerrorS("`system(\"opp\",<ring>)` expected");
1512        return TRUE;
1513      }
1514    }
1515    else
1516  #endif
1517  /*==================== oppose ==================================*/
1518  #ifdef HAVE_PLURAL
1519    if (strcmp(sys_cmd, "oppose")==0)
1520    {
1521      if ((h!=NULL) && (h->Typ()==RING_CMD)
1522      && (h->next!= NULL))
1523      {
1524        ring Rop = (ring)h->Data();
1525        h   = h->next;
1526        idhdl w;
1527        if ((w=Rop->idroot->get(h->Name(),myynest))!=NULL)
1528        {
1529          poly p = (poly)IDDATA(w);
1530          res->data = pOppose(Rop, p, currRing); // into CurrRing?
1531          res->rtyp = POLY_CMD;
1532          return FALSE;
1533        }
1534      }
1535      else
1536      {
1537        WerrorS("`system(\"oppose\",<ring>,<poly>)` expected");
1538        return TRUE;
1539      }
1540    }
1541    else
1542  #endif
1543  /*==================== walk stuff =================*/
1544  /*==================== walkNextWeight =================*/
1545  #ifdef HAVE_WALK
1546  #ifdef OWNW
1547    if (strcmp(sys_cmd, "walkNextWeight") == 0)
1548    {
1549      const short t[]={3,INTVEC_CMD,INTVEC_CMD,IDEAL_CMD};
1550      if (!iiCheckTypes(h,t,1)) return TRUE;
1551      if (((intvec*) h->Data())->length() != currRing->N ||
1552          ((intvec*) h->next->Data())->length() != currRing->N)
1553      {
1554        Werror("system(\"walkNextWeight\" ...) intvecs not of length %d\n",
1555               currRing->N);
1556        return TRUE;
1557      }
1558      res->data = (void*) walkNextWeight(((intvec*) h->Data()),
1559                                         ((intvec*) h->next->Data()),
1560                                         (ideal) h->next->next->Data());
1561      if (res->data == NULL || res->data == (void*) 1L)
1562      {
1563        res->rtyp = INT_CMD;
1564      }
1565      else
1566      {
1567        res->rtyp = INTVEC_CMD;
1568      }
1569      return FALSE;
1570    }
1571    else
1572  #endif
1573  #endif
1574  /*==================== walkNextWeight =================*/
1575  #ifdef HAVE_WALK
1576  #ifdef OWNW
1577    if (strcmp(sys_cmd, "walkInitials") == 0)
1578    {
1579      if (h == NULL || h->Typ() != IDEAL_CMD)
1580      {
1581        WerrorS("system(\"walkInitials\", ideal) expected");
1582        return TRUE;
1583      }
1584      res->data = (void*) walkInitials((ideal) h->Data());
1585      res->rtyp = IDEAL_CMD;
1586      return FALSE;
1587    }
1588    else
1589  #endif
1590  #endif
1591  /*==================== walkAddIntVec =================*/
1592  #ifdef HAVE_WALK
1593  #ifdef WAIV
1594    if (strcmp(sys_cmd, "walkAddIntVec") == 0)
1595    {
1596      const short t[]={2,INTVEC_CMD,INTVEC_CMD};
1597      if (!iiCheckTypes(h,t,1)) return TRUE;
1598      intvec* arg1 = (intvec*) h->Data();
1599      intvec* arg2 = (intvec*) h->next->Data();
1600      res->data = (intvec*) walkAddIntVec(arg1, arg2);
1601      res->rtyp = INTVEC_CMD;
1602      return FALSE;
1603    }
1604    else
1605  #endif
1606  #endif
1607  /*==================== MwalkNextWeight =================*/
1608  #ifdef HAVE_WALK
1609  #ifdef MwaklNextWeight
1610    if (strcmp(sys_cmd, "MwalkNextWeight") == 0)
1611    {
1612      const short t[]={3,INTVEC_CMD,INTVEC_CMD,IDEAL_CMD};
1613      if (!iiCheckTypes(h,t,1)) return TRUE;
1614      if (((intvec*) h->Data())->length() != currRing->N ||
1615        ((intvec*) h->next->Data())->length() != currRing->N)
1616      {
1617        Werror("system(\"MwalkNextWeight\" ...) intvecs not of length %d\n",
1618               currRing->N);
1619        return TRUE;
1620      }
1621      intvec* arg1 = (intvec*) h->Data();
1622      intvec* arg2 = (intvec*) h->next->Data();
1623      ideal arg3   =   (ideal) h->next->next->Data();
1624      intvec* result = (intvec*) MwalkNextWeight(arg1, arg2, arg3);
1625      res->rtyp = INTVEC_CMD;
1626      res->data =  result;
1627      return FALSE;
1628    }
1629    else
1630  #endif //MWalkNextWeight
1631  #endif
1632  /*==================== Mivdp =================*/
1633  #ifdef HAVE_WALK
1634    if(strcmp(sys_cmd, "Mivdp") == 0)
1635    {
1636      if (h == NULL || h->Typ() != INT_CMD)
1637      {
1638        WerrorS("system(\"Mivdp\", int) expected");
1639        return TRUE;
1640      }
1641      if ((int) ((long)(h->Data())) != currRing->N)
1642      {
1643        Werror("system(\"Mivdp\" ...) intvecs not of length %d\n",
1644               currRing->N);
1645        return TRUE;
1646      }
1647      int arg1 = (int) ((long)(h->Data()));
1648      intvec* result = (intvec*) Mivdp(arg1);
1649      res->rtyp = INTVEC_CMD;
1650      res->data =  result;
1651      return FALSE;
1652    }
1653    else
1654  #endif
1655  /*==================== Mivlp =================*/
1656  #ifdef HAVE_WALK
1657    if(strcmp(sys_cmd, "Mivlp") == 0)
1658    {
1659      if (h == NULL || h->Typ() != INT_CMD)
1660      {
1661        WerrorS("system(\"Mivlp\", int) expected");
1662        return TRUE;
1663      }
1664      if ((int) ((long)(h->Data())) != currRing->N)
1665      {
1666        Werror("system(\"Mivlp\" ...) intvecs not of length %d\n",
1667               currRing->N);
1668        return TRUE;
1669      }
1670      int arg1 = (int) ((long)(h->Data()));
1671      intvec* result = (intvec*) Mivlp(arg1);
1672      res->rtyp = INTVEC_CMD;
1673      res->data =  result;
1674      return FALSE;
1675    }
1676    else
1677  #endif
1678  /*==================== MpDiv =================*/
1679  #ifdef HAVE_WALK
1680  #ifdef MpDiv
1681    if(strcmp(sys_cmd, "MpDiv") == 0)
1682    {
1683      const short t[]={2,POLY_CMD,POLY_CMD};
1684      if (!iiCheckTypes(h,t,1)) return TRUE;
1685      poly arg1 = (poly) h->Data();
1686      poly arg2 = (poly) h->next->Data();
1687      poly result = MpDiv(arg1, arg2);
1688      res->rtyp = POLY_CMD;
1689      res->data = result;
1690      return FALSE;
1691    }
1692    else
1693  #endif
1694  #endif
1695  /*==================== MpMult =================*/
1696  #ifdef HAVE_WALK
1697  #ifdef MpMult
1698    if(strcmp(sys_cmd, "MpMult") == 0)
1699    {
1700      const short t[]={2,POLY_CMD,POLY_CMD};
1701      if (!iiCheckTypes(h,t,1)) return TRUE;
1702      poly arg1 = (poly) h->Data();
1703      poly arg2 = (poly) h->next->Data();
1704      poly result = MpMult(arg1, arg2);
1705      res->rtyp = POLY_CMD;
1706      res->data = result;
1707      return FALSE;
1708    }
1709    else
1710  #endif
1711  #endif
1712  /*==================== MivSame =================*/
1713  #ifdef HAVE_WALK
1714    if (strcmp(sys_cmd, "MivSame") == 0)
1715    {
1716      const short t[]={2,INTVEC_CMD,INTVEC_CMD};
1717      if (!iiCheckTypes(h,t,1)) return TRUE;
1718      /*
1719      if (((intvec*) h->Data())->length() != currRing->N ||
1720      ((intvec*) h->next->Data())->length() != currRing->N)
1721      {
1722        Werror("system(\"MivSame\" ...) intvecs not of length %d\n",
1723               currRing->N);
1724        return TRUE;
1725      }
1726      */
1727      intvec* arg1 = (intvec*) h->Data();
1728      intvec* arg2 = (intvec*) h->next->Data();
1729      /*
1730      poly result = (poly) MivSame(arg1, arg2);
1731      res->rtyp = POLY_CMD;
1732      res->data =  (poly) result;
1733      */
1734      res->rtyp = INT_CMD;
1735      res->data = (void*)(long) MivSame(arg1, arg2);
1736      return FALSE;
1737    }
1738    else
1739  #endif
1740  /*==================== M3ivSame =================*/
1741  #ifdef HAVE_WALK
1742    if (strcmp(sys_cmd, "M3ivSame") == 0)
1743    {
1744      const short t[]={3,INTVEC_CMD,INTVEC_CMD,INTVEC_CMD};
1745      if (!iiCheckTypes(h,t,1)) return TRUE;
1746      /*
1747      if (((intvec*) h->Data())->length() != currRing->N ||
1748        ((intvec*) h->next->Data())->length() != currRing->N ||
1749        ((intvec*) h->next->next->Data())->length() != currRing->N )
1750      {
1751        Werror("system(\"M3ivSame\" ...) intvecs not of length %d\n",
1752              currRing->N);
1753        return TRUE;
1754      }
1755      */
1756      intvec* arg1 = (intvec*) h->Data();
1757      intvec* arg2 = (intvec*) h->next->Data();
1758      intvec* arg3 = (intvec*) h->next->next->Data();
1759      /*
1760      poly result = (poly) M3ivSame(arg1, arg2, arg3);
1761      res->rtyp = POLY_CMD;
1762      res->data =  (poly) result;
1763      */
1764      res->rtyp = INT_CMD;
1765      res->data = (void*)(long) M3ivSame(arg1, arg2, arg3);
1766      return FALSE;
1767    }
1768    else
1769  #endif
1770  /*==================== MwalkInitialForm =================*/
1771  #ifdef HAVE_WALK
1772    if(strcmp(sys_cmd, "MwalkInitialForm") == 0)
1773    {
1774      const short t[]={2,IDEAL_CMD,INTVEC_CMD};
1775      if (!iiCheckTypes(h,t,1)) return TRUE;
1776      if(((intvec*) h->next->Data())->length() != currRing->N)
1777      {
1778        Werror("system \"MwalkInitialForm\"...) intvec not of length %d\n",
1779               currRing->N);
1780        return TRUE;
1781      }
1782      ideal id      = (ideal) h->Data();
1783      intvec* int_w = (intvec*) h->next->Data();
1784      ideal result  = (ideal) MwalkInitialForm(id, int_w);
1785      res->rtyp = IDEAL_CMD;
1786      res->data = result;
1787      return FALSE;
1788    }
1789    else
1790  #endif
1791  /*==================== MivMatrixOrder =================*/
1792  #ifdef HAVE_WALK
1793    /************** Perturbation walk **********/
1794    if(strcmp(sys_cmd, "MivMatrixOrder") == 0)
1795    {
1796      if(h==NULL || h->Typ() != INTVEC_CMD)
1797      {
1798        WerrorS("system(\"MivMatrixOrder\",intvec) expected");
1799        return TRUE;
1800      }
1801      intvec* arg1 = (intvec*) h->Data();
1802      intvec* result = MivMatrixOrder(arg1);
1803      res->rtyp = INTVEC_CMD;
1804      res->data =  result;
1805      return FALSE;
1806    }
1807    else
1808  #endif
1809  /*==================== MivMatrixOrderdp =================*/
1810  #ifdef HAVE_WALK
1811    if(strcmp(sys_cmd, "MivMatrixOrderdp") == 0)
1812    {
1813      if(h==NULL || h->Typ() != INT_CMD)
1814      {
1815        WerrorS("system(\"MivMatrixOrderdp\",intvec) expected");
1816        return TRUE;
1817      }
1818      int arg1 = (int) ((long)(h->Data()));
1819      intvec* result = (intvec*) MivMatrixOrderdp(arg1);
1820      res->rtyp = INTVEC_CMD;
1821      res->data =  result;
1822      return FALSE;
1823    }
1824    else
1825  #endif
1826  /*==================== MPertVectors =================*/
1827  #ifdef HAVE_WALK
1828    if(strcmp(sys_cmd, "MPertVectors") == 0)
1829    {
1830      const short t[]={3,IDEAL_CMD,INTVEC_CMD,INT_CMD};
1831      if (!iiCheckTypes(h,t,1)) return TRUE;
1832      ideal arg1 = (ideal) h->Data();
1833      intvec* arg2 = (intvec*) h->next->Data();
1834      int arg3 = (int) ((long)(h->next->next->Data()));
1835      intvec* result = (intvec*) MPertVectors(arg1, arg2, arg3);
1836      res->rtyp = INTVEC_CMD;
1837      res->data =  result;
1838      return FALSE;
1839    }
1840    else
1841  #endif
1842  /*==================== MPertVectorslp =================*/
1843  #ifdef HAVE_WALK
1844    if(strcmp(sys_cmd, "MPertVectorslp") == 0)
1845    {
1846      const short t[]={3,IDEAL_CMD,INTVEC_CMD,INT_CMD};
1847      if (!iiCheckTypes(h,t,1)) return TRUE;
1848      ideal arg1 = (ideal) h->Data();
1849      intvec* arg2 = (intvec*) h->next->Data();
1850      int arg3 = (int) ((long)(h->next->next->Data()));
1851      intvec* result = (intvec*) MPertVectorslp(arg1, arg2, arg3);
1852      res->rtyp = INTVEC_CMD;
1853      res->data =  result;
1854      return FALSE;
1855    }
1856    else
1857  #endif
1858    /************** fractal walk **********/
1859  #ifdef HAVE_WALK
1860    if(strcmp(sys_cmd, "Mfpertvector") == 0)
1861    {
1862      const short t[]={2,IDEAL_CMD,INTVEC_CMD};
1863      if (!iiCheckTypes(h,t,1)) return TRUE;
1864      ideal arg1 = (ideal) h->Data();
1865      intvec* arg2 = (intvec*) h->next->Data();
1866      intvec* result = Mfpertvector(arg1, arg2);
1867      res->rtyp = INTVEC_CMD;
1868      res->data =  result;
1869      return FALSE;
1870    }
1871    else
1872  #endif
1873  /*==================== MivUnit =================*/
1874  #ifdef HAVE_WALK
1875    if(strcmp(sys_cmd, "MivUnit") == 0)
1876    {
1877      const short t[]={1,INT_CMD};
1878      if (!iiCheckTypes(h,t,1)) return TRUE;
1879      int arg1 = (int) ((long)(h->Data()));
1880      intvec* result = (intvec*) MivUnit(arg1);
1881      res->rtyp = INTVEC_CMD;
1882      res->data =  result;
1883      return FALSE;
1884    }
1885    else
1886  #endif
1887  /*==================== MivWeightOrderlp =================*/
1888  #ifdef HAVE_WALK
1889    if(strcmp(sys_cmd, "MivWeightOrderlp") == 0)
1890    {
1891      const short t[]={1,INTVEC_CMD};
1892      if (!iiCheckTypes(h,t,1)) return TRUE;
1893      intvec* arg1 = (intvec*) h->Data();
1894      intvec* result = MivWeightOrderlp(arg1);
1895      res->rtyp = INTVEC_CMD;
1896      res->data =  result;
1897      return FALSE;
1898    }
1899    else
1900  #endif
1901  /*==================== MivWeightOrderdp =================*/
1902  #ifdef HAVE_WALK
1903    if(strcmp(sys_cmd, "MivWeightOrderdp") == 0)
1904    {
1905      if(h==NULL || h->Typ() != INTVEC_CMD)
1906      {
1907        WerrorS("system(\"MivWeightOrderdp\",intvec) expected");
1908        return TRUE;
1909      }
1910      intvec* arg1 = (intvec*) h->Data();
1911      //int arg2 = (int) h->next->Data();
1912      intvec* result = MivWeightOrderdp(arg1);
1913      res->rtyp = INTVEC_CMD;
1914      res->data =  result;
1915      return FALSE;
1916    }
1917    else
1918  #endif
1919  /*==================== MivMatrixOrderlp =================*/
1920  #ifdef HAVE_WALK
1921    if(strcmp(sys_cmd, "MivMatrixOrderlp") == 0)
1922    {
1923      if(h==NULL || h->Typ() != INT_CMD)
1924      {
1925        WerrorS("system(\"MivMatrixOrderlp\",int) expected");
1926        return TRUE;
1927      }
1928      int arg1 = (int) ((long)(h->Data()));
1929      intvec* result = (intvec*) MivMatrixOrderlp(arg1);
1930      res->rtyp = INTVEC_CMD;
1931      res->data =  result;
1932      return FALSE;
1933    }
1934    else
1935  #endif
1936  /*==================== MkInterRedNextWeight =================*/
1937  #ifdef HAVE_WALK
1938    if (strcmp(sys_cmd, "MkInterRedNextWeight") == 0)
1939    {
1940      const short t[]={3,INTVEC_CMD,INTVEC_CMD,IDEAL_CMD};
1941      if (!iiCheckTypes(h,t,1)) return TRUE;
1942      if (((intvec*) h->Data())->length() != currRing->N ||
1943        ((intvec*) h->next->Data())->length() != currRing->N)
1944      {
1945        Werror("system(\"MkInterRedNextWeight\" ...) intvecs not of length %d\n",
1946                 currRing->N);
1947        return TRUE;
1948      }
1949      intvec* arg1 = (intvec*) h->Data();
1950      intvec* arg2 = (intvec*) h->next->Data();
1951      ideal arg3   =   (ideal) h->next->next->Data();
1952      intvec* result = (intvec*) MkInterRedNextWeight(arg1, arg2, arg3);
1953      res->rtyp = INTVEC_CMD;
1954      res->data =  result;
1955      return FALSE;
1956    }
1957    else
1958  #endif
1959  /*==================== MPertNextWeight =================*/
1960  #ifdef HAVE_WALK
1961  #ifdef MPertNextWeight
1962    if (strcmp(sys_cmd, "MPertNextWeight") == 0)
1963    {
1964      const short t[]={3,INTVEC_CMD,IDEAL_CMD,INT_CMD};
1965      if (!iiCheckTypes(h,t,1)) return TRUE;
1966      if (((intvec*) h->Data())->length() != currRing->N)
1967      {
1968        Werror("system(\"MPertNextWeight\" ...) intvecs not of length %d\n",
1969                 currRing->N);
1970        return TRUE;
1971      }
1972      intvec* arg1 = (intvec*) h->Data();
1973      ideal arg2 = (ideal) h->next->Data();
1974      int arg3   =   (int) h->next->next->Data();
1975      intvec* result = (intvec*) MPertNextWeight(arg1, arg2, arg3);
1976      res->rtyp = INTVEC_CMD;
1977      res->data =  result;
1978      return FALSE;
1979    }
1980    else
1981  #endif //MPertNextWeight
1982  #endif
1983  /*==================== Mivperttarget =================*/
1984  #ifdef HAVE_WALK
1985  #ifdef Mivperttarget
1986    if (strcmp(sys_cmd, "Mivperttarget") == 0)
1987    {
1988      const short t[]={2,IDEAL_CMD,INT_CMD};
1989      if (!iiCheckTypes(h,t,1)) return TRUE;
1990      ideal arg1 = (ideal) h->Data();
1991      int arg2 = (int) h->next->Data();
1992      intvec* result = (intvec*) Mivperttarget(arg1, arg2);
1993      res->rtyp = INTVEC_CMD;
1994      res->data =  result;
1995      return FALSE;
1996    }
1997    else
1998  #endif //Mivperttarget
1999  #endif
2000  /*==================== Mwalk =================*/
2001  #ifdef HAVE_WALK
2002    if (strcmp(sys_cmd, "Mwalk") == 0)
2003    {
2004      const short t[]={6,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,RING_CMD,INT_CMD,INT_CMD};
2005      if (!iiCheckTypes(h,t,1)) return TRUE;
2006      if (((intvec*) h->next->Data())->length() != currRing->N &&
2007        ((intvec*) h->next->next->Data())->length() != currRing->N )
2008      {
2009        Werror("system(\"Mwalk\" ...) intvecs not of length %d\n",
2010           currRing->N);
2011        return TRUE;
2012      }
2013      ideal arg1 = (ideal) h->CopyD();
2014      intvec* arg2 = (intvec*) h->next->Data();
2015      intvec* arg3 = (intvec*) h->next->next->Data();
2016      ring arg4 = (ring) h->next->next->next->Data();
2017      int arg5 = (int) (long) h->next->next->next->next->Data();
2018      int arg6 = (int) (long) h->next->next->next->next->next->Data();
2019      ideal result = (ideal) Mwalk(arg1, arg2, arg3, arg4, arg5, arg6);
2020      res->rtyp = IDEAL_CMD;
2021      res->data =  result;
2022      return FALSE;
2023    }
2024    else
2025  #endif
2026  /*==================== Mpwalk =================*/
2027  #ifdef HAVE_WALK
2028  #ifdef MPWALK_ORIG
2029    if (strcmp(sys_cmd, "Mwalk") == 0)
2030    {
2031      const short t[]={4,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,RING_CMD};
2032      if (!iiCheckTypes(h,t,1)) return TRUE;
2033      if ((((intvec*) h->next->Data())->length() != currRing->N &&
2034          ((intvec*) h->next->next->Data())->length() != currRing->N ) &&
2035          (((intvec*) h->next->Data())->length() != (currRing->N)*(currRing->N) &&
2036          ((intvec*) h->next->next->Data())->length() != (currRing->N)*(currRing->N)))
2037      {
2038        Werror("system(\"Mwalk\" ...) intvecs not of length %d or %d\n",
2039               currRing->N,(currRing->N)*(currRing->N));
2040        return TRUE;
2041      }
2042      ideal arg1 = (ideal) h->Data();
2043      intvec* arg2 = (intvec*) h->next->Data();
2044      intvec* arg3   =  (intvec*) h->next->next->Data();
2045      ring arg4 = (ring) h->next->next->next->Data();
2046      ideal result = (ideal) Mwalk(arg1, arg2, arg3,arg4);
2047      res->rtyp = IDEAL_CMD;
2048      res->data =  result;
2049      return FALSE;
2050    }
2051    else
2052  #else
2053    if (strcmp(sys_cmd, "Mpwalk") == 0)
2054    {
2055      const short t[]={8,IDEAL_CMD,INT_CMD,INT_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD,INT_CMD};
2056      if (!iiCheckTypes(h,t,1)) return TRUE;
2057      if(((intvec*) h->next->next->next->Data())->length() != currRing->N &&
2058         ((intvec*) h->next->next->next->next->Data())->length()!=currRing->N)
2059      {
2060        Werror("system(\"Mpwalk\" ...) intvecs not of length %d\n",currRing->N);
2061        return TRUE;
2062      }
2063      ideal arg1 = (ideal) h->Data();
2064      int arg2 = (int) (long) h->next->Data();
2065      int arg3 = (int) (long) h->next->next->Data();
2066      intvec* arg4 = (intvec*) h->next->next->next->Data();
2067      intvec* arg5 = (intvec*) h->next->next->next->next->Data();
2068      int arg6 = (int) (long) h->next->next->next->next->next->Data();
2069      int arg7 = (int) (long) h->next->next->next->next->next->next->Data();
2070      int arg8 = (int) (long) h->next->next->next->next->next->next->next->Data();
2071      ideal result = (ideal) Mpwalk(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
2072      res->rtyp = IDEAL_CMD;
2073      res->data =  result;
2074      return FALSE;
2075    }
2076    else
2077    #endif
2078  #endif
2079  /*==================== Mrwalk =================*/
2080  #ifdef HAVE_WALK
2081    if (strcmp(sys_cmd, "Mrwalk") == 0)
2082    {
2083      const short t[]={7,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD,INT_CMD,INT_CMD};
2084      if (!iiCheckTypes(h,t,1)) return TRUE;
2085      if(((intvec*) h->next->Data())->length() != currRing->N &&
2086         ((intvec*) h->next->Data())->length() != (currRing->N)*(currRing->N) &&
2087         ((intvec*) h->next->next->Data())->length() != currRing->N &&
2088         ((intvec*) h->next->next->Data())->length() != (currRing->N)*(currRing->N) )
2089      {
2090        Werror("system(\"Mrwalk\" ...) intvecs not of length %d or %d\n",
2091               currRing->N,(currRing->N)*(currRing->N));
2092        return TRUE;
2093      }
2094      ideal arg1 = (ideal) h->Data();
2095      intvec* arg2 = (intvec*) h->next->Data();
2096      intvec* arg3 =  (intvec*) h->next->next->Data();
2097      int arg4 = (int)(long) h->next->next->next->Data();
2098      int arg5 = (int)(long) h->next->next->next->next->Data();
2099      int arg6 = (int)(long) h->next->next->next->next->next->Data();
2100      int arg7 = (int)(long) h->next->next->next->next->next->next->Data();
2101      ideal result = (ideal) Mrwalk(arg1, arg2, arg3, arg4, arg5, arg6, arg7);
2102      res->rtyp = IDEAL_CMD;
2103      res->data =  result;
2104      return FALSE;
2105    }
2106    else
2107  #endif
2108  /*==================== MAltwalk1 =================*/
2109  #ifdef HAVE_WALK
2110    if (strcmp(sys_cmd, "MAltwalk1") == 0)
2111    {
2112      const short t[]={5,IDEAL_CMD,INT_CMD,INT_CMD,INTVEC_CMD,INTVEC_CMD};
2113      if (!iiCheckTypes(h,t,1)) return TRUE;
2114      if (((intvec*) h->next->next->next->Data())->length() != currRing->N &&
2115        ((intvec*) h->next->next->next->next->Data())->length()!=currRing->N)
2116      {
2117        Werror("system(\"MAltwalk1\" ...) intvecs not of length %d\n",
2118                 currRing->N);
2119        return TRUE;
2120      }
2121      ideal arg1 = (ideal) h->Data();
2122      int arg2 = (int) ((long)(h->next->Data()));
2123      int arg3 = (int) ((long)(h->next->next->Data()));
2124      intvec* arg4 = (intvec*) h->next->next->next->Data();
2125      intvec* arg5   =  (intvec*) h->next->next->next->next->Data();
2126      ideal result = (ideal) MAltwalk1(arg1, arg2, arg3, arg4, arg5);
2127      res->rtyp = IDEAL_CMD;
2128      res->data =  result;
2129      return FALSE;
2130    }
2131    else
2132  #endif
2133  /*==================== MAltwalk1 =================*/
2134  #ifdef HAVE_WALK
2135  #ifdef MFWALK_ALT
2136    if (strcmp(sys_cmd, "Mfwalk_alt") == 0)
2137    {
2138      const short t[]={4,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD};
2139      if (!iiCheckTypes(h,t,1)) return TRUE;
2140      if (((intvec*) h->next->Data())->length() != currRing->N &&
2141        ((intvec*) h->next->next->Data())->length() != currRing->N )
2142      {
2143        Werror("system(\"Mfwalk\" ...) intvecs not of length %d\n",
2144              currRing->N);
2145        return TRUE;
2146      }
2147      ideal arg1 = (ideal) h->Data();
2148      intvec* arg2 = (intvec*) h->next->Data();
2149      intvec* arg3   =  (intvec*) h->next->next->Data();
2150      int arg4 = (int) h->next->next->next->Data();
2151      ideal result = (ideal) Mfwalk_alt(arg1, arg2, arg3, arg4);
2152      res->rtyp = IDEAL_CMD;
2153      res->data =  result;
2154      return FALSE;
2155    }
2156    else
2157  #endif
2158  #endif
2159  /*==================== Mfwalk =================*/
2160  #ifdef HAVE_WALK
2161    if (strcmp(sys_cmd, "Mfwalk") == 0)
2162    {
2163      const short t[]={5,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD};
2164      if (!iiCheckTypes(h,t,1)) return TRUE;
2165      if (((intvec*) h->next->Data())->length() != currRing->N &&
2166        ((intvec*) h->next->next->Data())->length() != currRing->N )
2167      {
2168        Werror("system(\"Mfwalk\" ...) intvecs not of length %d\n",
2169                 currRing->N);
2170        return TRUE;
2171      }
2172      ideal arg1 = (ideal) h->Data();
2173      intvec* arg2 = (intvec*) h->next->Data();
2174      intvec* arg3 = (intvec*) h->next->next->Data();
2175      int arg4 = (int)(long) h->next->next->next->Data();
2176      int arg5 = (int)(long) h->next->next->next->next->Data();
2177      ideal result = (ideal) Mfwalk(arg1, arg2, arg3, arg4, arg5);
2178      res->rtyp = IDEAL_CMD;
2179      res->data =  result;
2180      return FALSE;
2181    }
2182    else
2183  #endif
2184  /*==================== Mfrwalk =================*/
2185  #ifdef HAVE_WALK
2186    if (strcmp(sys_cmd, "Mfrwalk") == 0)
2187    {
2188      const short t[]={6,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD,INT_CMD};
2189      if (!iiCheckTypes(h,t,1)) return TRUE;
2190/*
2191      if (((intvec*) h->next->Data())->length() != currRing->N &&
2192          ((intvec*) h->next->next->Data())->length() != currRing->N)
2193      {
2194        Werror("system(\"Mfrwalk\" ...) intvecs not of length %d\n",currRing->N);
2195        return TRUE;
2196      }
2197*/
2198      if((((intvec*) h->next->Data())->length() != currRing->N &&
2199         ((intvec*) h->next->next->Data())->length() != currRing->N ) &&
2200         (((intvec*) h->next->Data())->length() != (currRing->N)*(currRing->N) &&
2201         ((intvec*) h->next->next->Data())->length() != (currRing->N)*(currRing->N) ))
2202      {
2203        Werror("system(\"Mfrwalk\" ...) intvecs not of length %d or %d\n",
2204               currRing->N,(currRing->N)*(currRing->N));
2205        return TRUE;
2206      }
2207
2208      ideal arg1 = (ideal) h->Data();
2209      intvec* arg2 = (intvec*) h->next->Data();
2210      intvec* arg3 = (intvec*) h->next->next->Data();
2211      int arg4 = (int)(long) h->next->next->next->Data();
2212      int arg5 = (int)(long) h->next->next->next->next->Data();
2213      int arg6 = (int)(long) h->next->next->next->next->next->Data();
2214      ideal result = (ideal) Mfrwalk(arg1, arg2, arg3, arg4, arg5, arg6);
2215      res->rtyp = IDEAL_CMD;
2216      res->data =  result;
2217      return FALSE;
2218    }
2219    else
2220  /*==================== Mprwalk =================*/
2221    if (strcmp(sys_cmd, "Mprwalk") == 0)
2222    {
2223      const short t[]={9,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD,INT_CMD,INT_CMD,INT_CMD,INT_CMD};
2224      if (!iiCheckTypes(h,t,1)) return TRUE;
2225      if((((intvec*) h->next->Data())->length() != currRing->N &&
2226         ((intvec*) h->next->next->Data())->length() != currRing->N ) &&
2227         (((intvec*) h->next->Data())->length() != (currRing->N)*(currRing->N) &&
2228         ((intvec*) h->next->next->Data())->length() != (currRing->N)*(currRing->N) ))
2229      {
2230        Werror("system(\"Mrwalk\" ...) intvecs not of length %d or %d\n",
2231               currRing->N,(currRing->N)*(currRing->N));
2232        return TRUE;
2233      }
2234      ideal arg1 = (ideal) h->Data();
2235      intvec* arg2 = (intvec*) h->next->Data();
2236      intvec* arg3 =  (intvec*) h->next->next->Data();
2237      int arg4 = (int)(long) h->next->next->next->Data();
2238      int arg5 = (int)(long) h->next->next->next->next->Data();
2239      int arg6 = (int)(long) h->next->next->next->next->next->Data();
2240      int arg7 = (int)(long) h->next->next->next->next->next->next->Data();
2241      int arg8 = (int)(long) h->next->next->next->next->next->next->next->Data();
2242      int arg9 = (int)(long) h->next->next->next->next->next->next->next->next->Data();
2243      ideal result = (ideal) Mprwalk(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9);
2244      res->rtyp = IDEAL_CMD;
2245      res->data =  result;
2246      return FALSE;
2247    }
2248    else
2249  #endif
2250  /*==================== TranMImprovwalk =================*/
2251  #ifdef HAVE_WALK
2252  #ifdef TRAN_Orig
2253    if (strcmp(sys_cmd, "TranMImprovwalk") == 0)
2254    {
2255      const short t[]={3,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD};
2256      if (!iiCheckTypes(h,t,1)) return TRUE;
2257      if (((intvec*) h->next->Data())->length() != currRing->N &&
2258        ((intvec*) h->next->next->Data())->length() != currRing->N )
2259      {
2260        Werror("system(\"TranMImprovwalk\" ...) intvecs not of length %d\n",
2261              currRing->N);
2262        return TRUE;
2263      }
2264      ideal arg1 = (ideal) h->Data();
2265      intvec* arg2 = (intvec*) h->next->Data();
2266      intvec* arg3   =  (intvec*) h->next->next->Data();
2267      ideal result = (ideal) TranMImprovwalk(arg1, arg2, arg3);
2268      res->rtyp = IDEAL_CMD;
2269      res->data =  result;
2270      return FALSE;
2271    }
2272    else
2273  #endif
2274  #endif
2275  /*==================== MAltwalk2 =================*/
2276  #ifdef HAVE_WALK
2277    if (strcmp(sys_cmd, "MAltwalk2") == 0)
2278    {
2279      const short t[]={3,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD};
2280      if (!iiCheckTypes(h,t,1)) return TRUE;
2281      if (((intvec*) h->next->Data())->length() != currRing->N &&
2282        ((intvec*) h->next->next->Data())->length() != currRing->N )
2283      {
2284        Werror("system(\"MAltwalk2\" ...) intvecs not of length %d\n",
2285                 currRing->N);
2286        return TRUE;
2287      }
2288      ideal arg1 = (ideal) h->Data();
2289      intvec* arg2 = (intvec*) h->next->Data();
2290      intvec* arg3   =  (intvec*) h->next->next->Data();
2291      ideal result = (ideal) MAltwalk2(arg1, arg2, arg3);
2292      res->rtyp = IDEAL_CMD;
2293      res->data =  result;
2294      return FALSE;
2295    }
2296    else
2297  #endif
2298  /*==================== MAltwalk2 =================*/
2299  #ifdef HAVE_WALK
2300    if (strcmp(sys_cmd, "TranMImprovwalk") == 0)
2301    {
2302      const short t[]={4,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD};
2303      if (!iiCheckTypes(h,t,1)) return TRUE;
2304      if (((intvec*) h->next->Data())->length() != currRing->N &&
2305        ((intvec*) h->next->next->Data())->length() != currRing->N )
2306      {
2307        Werror("system(\"TranMImprovwalk\" ...) intvecs not of length %d\n",
2308                 currRing->N);
2309        return TRUE;
2310      }
2311      ideal arg1 = (ideal) h->Data();
2312      intvec* arg2 = (intvec*) h->next->Data();
2313      intvec* arg3   =  (intvec*) h->next->next->Data();
2314      int arg4   =  (int) ((long)(h->next->next->next->Data()));
2315      ideal result = (ideal) TranMImprovwalk(arg1, arg2, arg3, arg4);
2316      res->rtyp = IDEAL_CMD;
2317      res->data =  result;
2318      return FALSE;
2319    }
2320    else
2321  #endif
2322  /*==================== TranMrImprovwalk =================*/
2323  #if 0
2324  #ifdef HAVE_WALK
2325    if (strcmp(sys_cmd, "TranMrImprovwalk") == 0)
2326    {
2327      if (h == NULL || h->Typ() != IDEAL_CMD ||
2328        h->next == NULL || h->next->Typ() != INTVEC_CMD ||
2329        h->next->next == NULL || h->next->next->Typ() != INTVEC_CMD ||
2330        h->next->next->next == NULL || h->next->next->next->Typ() != INT_CMD ||
2331        h->next->next->next == NULL || h->next->next->next->next->Typ() != INT_CMD ||
2332        h->next->next->next == NULL || h->next->next->next->next->next->Typ() != INT_CMD)
2333      {
2334        WerrorS("system(\"TranMrImprovwalk\", ideal, intvec, intvec) expected");
2335        return TRUE;
2336      }
2337      if (((intvec*) h->next->Data())->length() != currRing->N &&
2338        ((intvec*) h->next->next->Data())->length() != currRing->N )
2339      {
2340        Werror("system(\"TranMrImprovwalk\" ...) intvecs not of length %d\n", currRing->N);
2341        return TRUE;
2342      }
2343      ideal arg1 = (ideal) h->Data();
2344      intvec* arg2 = (intvec*) h->next->Data();
2345      intvec* arg3 = (intvec*) h->next->next->Data();
2346      int arg4 = (int)(long) h->next->next->next->Data();
2347      int arg5 = (int)(long) h->next->next->next->next->Data();
2348      int arg6 = (int)(long) h->next->next->next->next->next->Data();
2349      ideal result = (ideal) TranMrImprovwalk(arg1, arg2, arg3, arg4, arg5, arg6);
2350      res->rtyp = IDEAL_CMD;
2351      res->data =  result;
2352      return FALSE;
2353    }
2354    else
2355  #endif
2356  #endif
2357  /*================= Extended system call ========================*/
2358    {
2359       #ifndef MAKE_DISTRIBUTION
2360       return(jjEXTENDED_SYSTEM(res, args));
2361       #else
2362       Werror( "system(\"%s\",...) %s", sys_cmd, feNotImplemented );
2363       #endif
2364    }
2365  } /* typ==string */
2366  return TRUE;
2367}
2368
2369
2370#ifdef HAVE_EXTENDED_SYSTEM
2371  // You can put your own system calls here
2372#  include "kernel/fglm/fglm.h"
2373#  ifdef HAVE_NEWTON
2374#    include "hc_newton.h"
2375#  endif
2376
2377static BOOLEAN jjEXTENDED_SYSTEM(leftv res, leftv h)
2378{
2379    if(h->Typ() == STRING_CMD)
2380    {
2381      char *sys_cmd=(char *)(h->Data());
2382      h=h->next;
2383  /*==================== test syz strat =================*/
2384      if (strcmp(sys_cmd, "syz") == 0)
2385      {
2386         if ((h!=NULL) && (h->Typ()==STRING_CMD))
2387         {
2388           const char *s=(const char *)h->Data();
2389           if (strcmp(s,"posInT_EcartFDegpLength")==0)
2390             test_PosInT=posInT_EcartFDegpLength;
2391           else if (strcmp(s,"posInT_FDegpLength")==0)
2392             test_PosInT=posInT_FDegpLength;
2393           else if (strcmp(s,"posInT_pLength")==0)
2394             test_PosInT=posInT_pLength;
2395           else if (strcmp(s,"posInT0")==0)
2396             test_PosInT=posInT0;
2397           else if (strcmp(s,"posInT1")==0)
2398             test_PosInT=posInT1;
2399           else if (strcmp(s,"posInT2")==0)
2400             test_PosInT=posInT2;
2401           else if (strcmp(s,"posInT11")==0)
2402             test_PosInT=posInT11;
2403           else if (strcmp(s,"posInT110")==0)
2404             test_PosInT=posInT110;
2405           else if (strcmp(s,"posInT13")==0)
2406             test_PosInT=posInT13;
2407           else if (strcmp(s,"posInT15")==0)
2408             test_PosInT=posInT15;
2409           else if (strcmp(s,"posInT17")==0)
2410             test_PosInT=posInT17;
2411           else if (strcmp(s,"posInT17_c")==0)
2412             test_PosInT=posInT17_c;
2413           else if (strcmp(s,"posInT19")==0)
2414             test_PosInT=posInT19;
2415           else PrintS("valid posInT:0,1,2,11,110,13,15,17,17_c,19,_EcartFDegpLength,_FDegpLength,_pLength,_EcartpLength\n");
2416         }
2417         else
2418         {
2419           test_PosInT=NULL;
2420           test_PosInL=NULL;
2421         }
2422         si_opt_2|=Sy_bit(23);
2423         return FALSE;
2424      }
2425      else
2426  /*==================== locNF ======================================*/
2427      if(strcmp(sys_cmd,"locNF")==0)
2428      {
2429        const short t[]={4,VECTOR_CMD,MODUL_CMD,INT_CMD,INTVEC_CMD};
2430        if (iiCheckTypes(h,t,1))
2431        {
2432          poly f=(poly)h->Data();
2433          h=h->next;
2434          ideal m=(ideal)h->Data();
2435          assumeStdFlag(h);
2436          h=h->next;
2437          int n=(int)((long)h->Data());
2438          h=h->next;
2439          intvec *v=(intvec *)h->Data();
2440
2441          /* == now the work starts == */
2442
2443          int * iv=iv2array(v, currRing);
2444          poly r=0;
2445          poly hp=ppJetW(f,n,iv);
2446          int s=MATCOLS(m);
2447          int j=0;
2448          matrix T=mp_InitI(s,1,0, currRing);
2449
2450          while (hp != NULL)
2451          {
2452            if (pDivisibleBy(m->m[j],hp))
2453            {
2454              if (MATELEM(T,j+1,1)==0)
2455              {
2456                MATELEM(T,j+1,1)=pDivideM(pHead(hp),pHead(m->m[j]));
2457              }
2458              else
2459              {
2460                pAdd(MATELEM(T,j+1,1),pDivideM(pHead(hp),pHead(m->m[j])));
2461              }
2462              hp=ppJetW(ksOldSpolyRed(m->m[j],hp,0),n,iv);
2463              j=0;
2464            }
2465            else
2466            {
2467              if (j==s-1)
2468              {
2469                r=pAdd(r,pHead(hp));
2470                hp=pLmDeleteAndNext(hp); /* hp=pSub(hp,pHead(hp));*/
2471                j=0;
2472              }
2473              else
2474              {
2475                j++;
2476              }
2477            }
2478          }
2479
2480          matrix Temp=mp_Transp((matrix) id_Vec2Ideal(r, currRing), currRing);
2481          matrix R=mpNew(MATCOLS((matrix) id_Vec2Ideal(f, currRing)),1);
2482          for (int k=1;k<=MATROWS(Temp);k++)
2483          {
2484            MATELEM(R,k,1)=MATELEM(Temp,k,1);
2485          }
2486
2487          lists L=(lists)omAllocBin(slists_bin);
2488          L->Init(2);
2489          L->m[0].rtyp=MATRIX_CMD;   L->m[0].data=(void *)R;
2490          L->m[1].rtyp=MATRIX_CMD;   L->m[1].data=(void *)T;
2491          res->data=L;
2492          res->rtyp=LIST_CMD;
2493          // iv aufraeumen
2494          omFree(iv);
2495          return FALSE;
2496        }
2497        else
2498          return TRUE;
2499      }
2500      else
2501  /*==================== poly debug ==================================*/
2502        if(strcmp(sys_cmd,"p")==0)
2503        {
2504#  ifdef RDEBUG
2505          p_DebugPrint((poly)h->Data(), currRing);
2506#  else
2507          WarnS("Sorry: not available for release build!");
2508#  endif
2509          return FALSE;
2510        }
2511        else
2512  /*==================== setsyzcomp ==================================*/
2513      if(strcmp(sys_cmd,"setsyzcomp")==0)
2514      {
2515        if ((h!=NULL) && (h->Typ()==INT_CMD))
2516        {
2517          int k = (int)(long)h->Data();
2518          if ( currRing->order[0] == ringorder_s )
2519          {
2520            rSetSyzComp(k, currRing);
2521          }
2522        }
2523      }
2524  /*==================== ring debug ==================================*/
2525        if(strcmp(sys_cmd,"r")==0)
2526        {
2527#  ifdef RDEBUG
2528          rDebugPrint((ring)h->Data());
2529#  else
2530          WarnS("Sorry: not available for release build!");
2531#  endif
2532          return FALSE;
2533        }
2534        else
2535  /*==================== changeRing ========================*/
2536        /* The following code changes the names of the variables in the
2537           current ring to "x1", "x2", ..., "xN", where N is the number
2538           of variables in the current ring.
2539           The purpose of this rewriting is to eliminate indexed variables,
2540           as they may cause problems when generating scripts for Magma,
2541           Maple, or Macaulay2. */
2542        if(strcmp(sys_cmd,"changeRing")==0)
2543        {
2544          int varN = currRing->N;
2545          char h[10];
2546          for (int i = 1; i <= varN; i++)
2547          {
2548            omFree(currRing->names[i - 1]);
2549            sprintf(h, "x%d", i);
2550            currRing->names[i - 1] = omStrDup(h);
2551          }
2552          rComplete(currRing);
2553          res->rtyp = INT_CMD;
2554          res->data = (void*)0L;
2555          return FALSE;
2556        }
2557        else
2558  /*==================== mtrack ==================================*/
2559      if(strcmp(sys_cmd,"mtrack")==0)
2560      {
2561  #ifdef OM_TRACK
2562        om_Opts.MarkAsStatic = 1;
2563        FILE *fd = NULL;
2564        int max = 5;
2565        while (h != NULL)
2566        {
2567          omMarkAsStaticAddr(h);
2568          if (fd == NULL && h->Typ()==STRING_CMD)
2569          {
2570            char *fn=(char*) h->Data();
2571            fd = fopen(fn, "w");
2572            if (fd == NULL)
2573              Warn("Can not open %s for writing og mtrack. Using stdout",fn);
2574          }
2575          else if (h->Typ() == INT_CMD)
2576          {
2577            max = (int)(long)h->Data();
2578          }
2579          h = h->Next();
2580        }
2581        omPrintUsedTrackAddrs((fd == NULL ? stdout : fd), max);
2582        if (fd != NULL) fclose(fd);
2583        om_Opts.MarkAsStatic = 0;
2584        return FALSE;
2585  #else
2586        WerrorS("system(\"mtrack\",..) is not implemented in this version");
2587        return TRUE;
2588  #endif
2589      }
2590      else
2591  /*==================== backtrace ==================================*/
2592  #ifndef OM_NDEBUG
2593      if(strcmp(sys_cmd,"backtrace")==0)
2594      {
2595        omPrintCurrentBackTrace(stdout);
2596        return FALSE;
2597      }
2598      else
2599  #endif
2600
2601#if !defined(OM_NDEBUG)
2602  /*==================== omMemoryTest ==================================*/
2603      if (strcmp(sys_cmd,"omMemoryTest")==0)
2604      {
2605
2606#ifdef OM_STATS_H
2607        PrintS("\n[om_Info]: \n");
2608        omUpdateInfo();
2609#define OM_PRINT(name) Print(" %-22s : %10ld \n", #name, om_Info . name)
2610        OM_PRINT(MaxBytesSystem);
2611        OM_PRINT(CurrentBytesSystem);
2612        OM_PRINT(MaxBytesSbrk);
2613        OM_PRINT(CurrentBytesSbrk);
2614        OM_PRINT(MaxBytesMmap);
2615        OM_PRINT(CurrentBytesMmap);
2616        OM_PRINT(UsedBytes);
2617        OM_PRINT(AvailBytes);
2618        OM_PRINT(UsedBytesMalloc);
2619        OM_PRINT(AvailBytesMalloc);
2620        OM_PRINT(MaxBytesFromMalloc);
2621        OM_PRINT(CurrentBytesFromMalloc);
2622        OM_PRINT(MaxBytesFromValloc);
2623        OM_PRINT(CurrentBytesFromValloc);
2624        OM_PRINT(UsedBytesFromValloc);
2625        OM_PRINT(AvailBytesFromValloc);
2626        OM_PRINT(MaxPages);
2627        OM_PRINT(UsedPages);
2628        OM_PRINT(AvailPages);
2629        OM_PRINT(MaxRegionsAlloc);
2630        OM_PRINT(CurrentRegionsAlloc);
2631#undef OM_PRINT
2632#endif
2633
2634#ifdef OM_OPTS_H
2635        PrintS("\n[om_Opts]: \n");
2636#define OM_PRINT(format, name) Print(" %-22s : %10" format"\n", #name, om_Opts . name)
2637        OM_PRINT("d", MinTrack);
2638        OM_PRINT("d", MinCheck);
2639        OM_PRINT("d", MaxTrack);
2640        OM_PRINT("d", MaxCheck);
2641        OM_PRINT("d", Keep);
2642        OM_PRINT("d", HowToReportErrors);
2643        OM_PRINT("d", MarkAsStatic);
2644        OM_PRINT("u", PagesPerRegion);
2645        OM_PRINT("p", OutOfMemoryFunc);
2646        OM_PRINT("p", MemoryLowFunc);
2647        OM_PRINT("p", ErrorHook);
2648#undef OM_PRINT
2649#endif
2650
2651#ifdef OM_ERROR_H
2652        Print("\n\n[om_ErrorStatus]        : '%s' (%s)\n",
2653                omError2String(om_ErrorStatus),
2654                omError2Serror(om_ErrorStatus));
2655        Print("[om_InternalErrorStatus]: '%s' (%s)\n",
2656                omError2String(om_InternalErrorStatus),
2657                omError2Serror(om_InternalErrorStatus));
2658
2659#endif
2660
2661//        omTestMemory(1);
2662//        omtTestErrors();
2663        return FALSE;
2664      }
2665      else
2666#endif
2667  /*==================== pDivStat =============================*/
2668  #if defined(PDEBUG) || defined(PDIV_DEBUG)
2669      if(strcmp(sys_cmd,"pDivStat")==0)
2670      {
2671        extern void pPrintDivisbleByStat();
2672        pPrintDivisbleByStat();
2673        return FALSE;
2674      }
2675      else
2676  #endif
2677  /*==================== red =============================*/
2678  #if 0
2679      if(strcmp(sys_cmd,"red")==0)
2680      {
2681        if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2682        {
2683          res->rtyp=IDEAL_CMD;
2684          res->data=(void *)kStdred((ideal)h->Data(),NULL,testHomog,NULL);
2685          setFlag(res,FLAG_STD);
2686          return FALSE;
2687        }
2688        else
2689          WerrorS("ideal expected");
2690      }
2691      else
2692  #endif
2693  /*==================== fastcomb =============================*/
2694      if(strcmp(sys_cmd,"fastcomb")==0)
2695      {
2696        if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2697        {
2698          if (h->next!=NULL)
2699          {
2700            if (h->next->Typ()!=POLY_CMD)
2701            {
2702              WarnS("Wrong types for poly= comb(ideal,poly)");
2703            }
2704          }
2705          res->rtyp=POLY_CMD;
2706          res->data=(void *) fglmLinearCombination(
2707                             (ideal)h->Data(),(poly)h->next->Data());
2708          return FALSE;
2709        }
2710        else
2711          WerrorS("ideal expected");
2712      }
2713      else
2714  /*==================== comb =============================*/
2715      if(strcmp(sys_cmd,"comb")==0)
2716      {
2717        if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2718        {
2719          if (h->next!=NULL)
2720          {
2721            if (h->next->Typ()!=POLY_CMD)
2722            {
2723                WarnS("Wrong types for poly= comb(ideal,poly)");
2724            }
2725          }
2726          res->rtyp=POLY_CMD;
2727          res->data=(void *)fglmNewLinearCombination(
2728                              (ideal)h->Data(),(poly)h->next->Data());
2729          return FALSE;
2730        }
2731        else
2732          WerrorS("ideal expected");
2733      }
2734      else
2735  #if 0 /* debug only */
2736  /*==================== listall ===================================*/
2737      if(strcmp(sys_cmd,"listall")==0)
2738      {
2739        void listall(int showproc);
2740        int showproc=0;
2741        if ((h!=NULL) && (h->Typ()==INT_CMD)) showproc=(int)((long)h->Data());
2742        listall(showproc);
2743        return FALSE;
2744      }
2745      else
2746  #endif
2747  #if 0 /* debug only */
2748  /*==================== proclist =================================*/
2749      if(strcmp(sys_cmd,"proclist")==0)
2750      {
2751        void piShowProcList();
2752        piShowProcList();
2753        return FALSE;
2754      }
2755      else
2756  #endif
2757  /* ==================== newton ================================*/
2758  #ifdef HAVE_NEWTON
2759      if(strcmp(sys_cmd,"newton")==0)
2760      {
2761        if ((h->Typ()!=POLY_CMD)
2762        || (h->next->Typ()!=INT_CMD)
2763        || (h->next->next->Typ()!=INT_CMD))
2764        {
2765          WerrorS("system(\"newton\",<poly>,<int>,<int>) expected");
2766          return TRUE;
2767        }
2768        poly  p=(poly)(h->Data());
2769        int l=pLength(p);
2770        short *points=(short *)omAlloc(currRing->N*l*sizeof(short));
2771        int i,j,k;
2772        k=0;
2773        poly pp=p;
2774        for (i=0;pp!=NULL;i++)
2775        {
2776          for(j=1;j<=currRing->N;j++)
2777          {
2778            points[k]=pGetExp(pp,j);
2779            k++;
2780          }
2781          pIter(pp);
2782        }
2783        hc_ERG r=hc_KOENIG(currRing->N,      // dimension
2784                  l,      // number of points
2785                  (short*) points,   // points: x_1, y_1,z_1, x_2,y_2,z2,...
2786                  currRing->OrdSgn==-1,
2787                  (int) (h->next->Data()),      // 1: Milnor, 0: Newton
2788                  (int) (h->next->next->Data()) // debug
2789                 );
2790        //----<>---Output-----------------------
2791
2792
2793  //  PrintS("Bin jetzt in extra.cc bei der Auswertung.\n"); // **********
2794
2795
2796        lists L=(lists)omAllocBin(slists_bin);
2797        L->Init(6);
2798        L->m[0].rtyp=STRING_CMD;               // newtonnumber;
2799        L->m[0].data=(void *)omStrDup(r.nZahl);
2800        L->m[1].rtyp=INT_CMD;
2801        L->m[1].data=(void *)(long)r.achse;          // flag for unoccupied axes
2802        L->m[2].rtyp=INT_CMD;
2803        L->m[2].data=(void *)(long)r.deg;            // #degenerations
2804        if ( r.deg != 0)              // only if degenerations exist
2805        {
2806          L->m[3].rtyp=INT_CMD;
2807          L->m[3].data=(void *)(long)r.anz_punkte;     // #points
2808          //---<>--number of points------
2809          int anz = r.anz_punkte;    // number of points
2810          int dim = (currRing->N);     // dimension
2811          intvec* v = new intvec( anz*dim );
2812          for (i=0; i<anz*dim; i++)    // copy points
2813            (*v)[i] = r.pu[i];
2814          L->m[4].rtyp=INTVEC_CMD;
2815          L->m[4].data=(void *)v;
2816          //---<>--degenerations---------
2817          int deg = r.deg;    // number of points
2818          intvec* w = new intvec( r.speicher );  // necessary memory
2819          i=0;               // start copying
2820          do
2821          {
2822            (*w)[i] = r.deg_tab[i];
2823            i++;
2824          }
2825          while (r.deg_tab[i-1] != -2);   // mark for end of list
2826          L->m[5].rtyp=INTVEC_CMD;
2827          L->m[5].data=(void *)w;
2828        }
2829        else
2830        {
2831          L->m[3].rtyp=INT_CMD; L->m[3].data=(char *)0;
2832          L->m[4].rtyp=DEF_CMD;
2833          L->m[5].rtyp=DEF_CMD;
2834        }
2835
2836        res->data=(void *)L;
2837        res->rtyp=LIST_CMD;
2838        // free all pointer in r:
2839        delete[] r.nZahl;
2840        delete[] r.pu;
2841        delete[] r.deg_tab;      // Ist das ein Problem??
2842
2843        omFreeSize((ADDRESS)points,currRing->N*l*sizeof(short));
2844        return FALSE;
2845      }
2846      else
2847  #endif
2848  /*==== connection to Sebastian Jambor's code ======*/
2849  /* This code connects Sebastian Jambor's code for
2850     computing the minimal polynomial of an (n x n) matrix
2851     with entries in F_p to SINGULAR. Two conversion methods
2852     are needed; see further up in this file:
2853        (1) conversion of a matrix with long entries to
2854            a SINGULAR matrix with number entries, where
2855            the numbers are coefficients in currRing;
2856        (2) conversion of an array of longs (encoding the
2857            coefficients of the minimal polynomial) to a
2858            SINGULAR poly living in currRing. */
2859      if (strcmp(sys_cmd, "minpoly") == 0)
2860      {
2861        if ((h == NULL) || (h->Typ() != MATRIX_CMD) || h->next != NULL)
2862        {
2863          Werror("expected exactly one argument: %s",
2864                 "a square matrix with number entries");
2865          return TRUE;
2866        }
2867        else
2868        {
2869          matrix m = (matrix)h->Data();
2870          int n = m->rows();
2871          unsigned long p = (unsigned long)n_GetChar(currRing->cf);
2872          if (n != m->cols())
2873          {
2874            WerrorS("expected exactly one argument: "
2875                   "a square matrix with number entries");
2876            return TRUE;
2877          }
2878          unsigned long** ml = singularMatrixToLongMatrix(m);
2879          unsigned long* polyCoeffs = computeMinimalPolynomial(ml, n, p);
2880          poly theMinPoly = longCoeffsToSingularPoly(polyCoeffs, n);
2881          res->rtyp = POLY_CMD;
2882          res->data = (void *)theMinPoly;
2883          for (int i = 0; i < n; i++) delete[] ml[i];
2884          delete[] ml;
2885          delete[] polyCoeffs;
2886          return FALSE;
2887        }
2888      }
2889      else
2890  /*==================== sdb_flags =================*/
2891  #ifdef HAVE_SDB
2892      if (strcmp(sys_cmd, "sdb_flags") == 0)
2893      {
2894        if ((h!=NULL) && (h->Typ()==INT_CMD))
2895        {
2896          sdb_flags=(int)((long)h->Data());
2897        }
2898        else
2899        {
2900          WerrorS("system(\"sdb_flags\",`int`) expected");
2901          return TRUE;
2902        }
2903        return FALSE;
2904      }
2905      else
2906  #endif
2907  /*==================== sdb_edit =================*/
2908  #ifdef HAVE_SDB
2909      if (strcmp(sys_cmd, "sdb_edit") == 0)
2910      {
2911        if ((h!=NULL) && (h->Typ()==PROC_CMD))
2912        {
2913          procinfov p=(procinfov)h->Data();
2914          sdb_edit(p);
2915        }
2916        else
2917        {
2918          WerrorS("system(\"sdb_edit\",`proc`) expected");
2919          return TRUE;
2920        }
2921        return FALSE;
2922      }
2923      else
2924  #endif
2925  /*==================== GF =================*/
2926  #if 0 // for testing only
2927      if (strcmp(sys_cmd, "GF") == 0)
2928      {
2929        if ((h!=NULL) && (h->Typ()==POLY_CMD))
2930        {
2931          int c=rChar(currRing);
2932          setCharacteristic( c,nfMinPoly[0], currRing->parameter[0][0] );
2933          CanonicalForm F( convSingGFFactoryGF( (poly)h->Data(), currRing ) );
2934          res->rtyp=POLY_CMD;
2935          res->data=convFactoryGFSingGF( F, currRing );
2936          return FALSE;
2937        }
2938        else { WerrorS("wrong typ"); return TRUE;}
2939      }
2940      else
2941  #endif
2942  /*==================== SVD =================*/
2943  #ifdef HAVE_SVD
2944       if (strcmp(sys_cmd, "svd") == 0)
2945       {
2946            extern lists testsvd(matrix M);
2947              res->rtyp=LIST_CMD;
2948            res->data=(char*)(testsvd((matrix)h->Data()));
2949            return FALSE;
2950       }
2951       else
2952  #endif
2953  /*==================== redNF_ring =================*/
2954  #ifdef HAVE_RINGS
2955      if (strcmp(sys_cmd, "redNF_ring")==0)
2956      {
2957        ring r = currRing;
2958        poly f = (poly) h->Data();
2959        h = h->next;
2960        ideal G = (ideal) h->Data();
2961        res->rtyp=POLY_CMD;
2962        res->data=(poly) ringRedNF(f, G, r);
2963        return(FALSE);
2964      }
2965      else
2966  #endif
2967  /*==================== Roune Hilb  =================*/
2968       if (strcmp(sys_cmd, "hilbroune") == 0)
2969       {
2970         if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
2971         {
2972           slicehilb((ideal)h->Data());
2973         }
2974         else return TRUE;
2975         return FALSE;
2976       }
2977      else
2978  /*==================== F5 Implementation =================*/
2979  #ifdef HAVE_F5
2980      if (strcmp(sys_cmd, "f5")==0)
2981      {
2982        if (h->Typ()!=IDEAL_CMD)
2983        {
2984          WerrorS("ideal expected");
2985          return TRUE;
2986        }
2987
2988        ring r = currRing;
2989        ideal G = (ideal) h->Data();
2990        h = h->next;
2991        int opt;
2992        if(h != NULL) {
2993          opt = (int) (long) h->Data();
2994        }
2995        else {
2996          opt = 2;
2997        }
2998        h = h->next;
2999        int plus;
3000        if(h != NULL) {
3001          plus = (int) (long) h->Data();
3002        }
3003        else {
3004          plus = 0;
3005        }
3006        h = h->next;
3007        int termination;
3008        if(h != NULL) {
3009          termination = (int) (long) h->Data();
3010        }
3011        else {
3012          termination = 0;
3013        }
3014        res->rtyp=IDEAL_CMD;
3015        res->data=(ideal) F5main(G,r,opt,plus,termination);
3016        return FALSE;
3017      }
3018      else
3019  #endif
3020  /*==================== Testing groebner basis =================*/
3021  #ifdef HAVE_RINGS
3022      if (strcmp(sys_cmd, "NF_ring")==0)
3023      {
3024        ring r = currRing;
3025        poly f = (poly) h->Data();
3026        h = h->next;
3027        ideal G = (ideal) h->Data();
3028        res->rtyp=POLY_CMD;
3029        res->data=(poly) ringNF(f, G, r);
3030        return(FALSE);
3031      }
3032      else
3033      if (strcmp(sys_cmd, "spoly")==0)
3034      {
3035        poly f = pCopy((poly) h->Data());
3036        h = h->next;
3037        poly g = pCopy((poly) h->Data());
3038
3039        res->rtyp=POLY_CMD;
3040        res->data=(poly) plain_spoly(f,g);
3041        return(FALSE);
3042      }
3043      else
3044      if (strcmp(sys_cmd, "testGB")==0)
3045      {
3046        ideal I = (ideal) h->Data();
3047        h = h->next;
3048        ideal GI = (ideal) h->Data();
3049        res->rtyp = INT_CMD;
3050        res->data = (void *)(long) testGB(I, GI);
3051        return(FALSE);
3052      }
3053      else
3054  #endif
3055    /*==================== sca:AltVar ==================================*/
3056  #ifdef HAVE_PLURAL
3057      if ( (strcmp(sys_cmd, "AltVarStart") == 0) || (strcmp(sys_cmd, "AltVarEnd") == 0) )
3058      {
3059        ring r = currRing;
3060
3061        if((h!=NULL) && (h->Typ()==RING_CMD)) r = (ring)h->Data(); else
3062        {
3063          WerrorS("`system(\"AltVarStart/End\"[,<ring>])` expected");
3064          return TRUE;
3065        }
3066
3067        res->rtyp=INT_CMD;
3068
3069        if (rIsSCA(r))
3070        {
3071          if(strcmp(sys_cmd, "AltVarStart") == 0)
3072            res->data = (void*)(long)scaFirstAltVar(r);
3073          else
3074            res->data = (void*)(long)scaLastAltVar(r);
3075          return FALSE;
3076        }
3077
3078        WerrorS("`system(\"AltVarStart/End\",<ring>) requires a SCA ring");
3079        return TRUE;
3080      }
3081      else
3082  #endif
3083  /*==================== RatNF, noncomm rational coeffs =================*/
3084  #ifdef HAVE_RATGRING
3085      if (strcmp(sys_cmd, "intratNF") == 0)
3086      {
3087        poly p;
3088        poly *q;
3089        ideal I;
3090        int is, k, id;
3091        if ((h!=NULL) && (h->Typ()==POLY_CMD))
3092        {
3093          p=(poly)h->CopyD();
3094          h=h->next;
3095          //        PrintS("poly is done\n");
3096        }
3097        else return TRUE;
3098        if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
3099        {
3100          I=(ideal)h->CopyD();
3101          q = I->m;
3102          h=h->next;
3103          //        PrintS("ideal is done\n");
3104        }
3105        else return TRUE;
3106        if ((h!=NULL) && (h->Typ()==INT_CMD))
3107        {
3108          is=(int)((long)(h->Data()));
3109          //        res->rtyp=INT_CMD;
3110          //        PrintS("int is done\n");
3111          //        res->rtyp=IDEAL_CMD;
3112          if (rIsPluralRing(currRing))
3113          {
3114            id = IDELEMS(I);
3115                   int *pl=(int*)omAlloc0(IDELEMS(I)*sizeof(int));
3116            for(k=0; k < id; k++)
3117            {
3118              pl[k] = pLength(I->m[k]);
3119            }
3120            PrintS("starting redRat\n");
3121            //res->data = (char *)
3122            redRat(&p, q, pl, (int)IDELEMS(I),is,currRing);
3123            res->data=p;
3124            res->rtyp=POLY_CMD;
3125            //        res->data = ncGCD(p,q,currRing);
3126          }
3127          else
3128          {
3129            res->rtyp=POLY_CMD;
3130            res->data=p;
3131          }
3132        }
3133        else return TRUE;
3134        return FALSE;
3135      }
3136      else
3137  /*==================== RatNF, noncomm rational coeffs =================*/
3138      if (strcmp(sys_cmd, "ratNF") == 0)
3139      {
3140        poly p,q;
3141        int is, htype;
3142        if ((h!=NULL) && ( (h->Typ()==POLY_CMD) || (h->Typ()==VECTOR_CMD) ) )
3143        {
3144          p=(poly)h->CopyD();
3145          h=h->next;
3146          htype = h->Typ();
3147        }
3148        else return TRUE;
3149        if ((h!=NULL) && ( (h->Typ()==POLY_CMD) || (h->Typ()==VECTOR_CMD) ) )
3150        {
3151          q=(poly)h->CopyD();
3152          h=h->next;
3153        }
3154        else return TRUE;
3155        if ((h!=NULL) && (h->Typ()==INT_CMD))
3156        {
3157          is=(int)((long)(h->Data()));
3158          res->rtyp=htype;
3159          //        res->rtyp=IDEAL_CMD;
3160          if (rIsPluralRing(currRing))
3161          {
3162            res->data = nc_rat_ReduceSpolyNew(q,p,is, currRing);
3163            //        res->data = ncGCD(p,q,currRing);
3164          }
3165          else res->data=p;
3166        }
3167        else return TRUE;
3168        return FALSE;
3169      }
3170      else
3171        /*==================== RatSpoly, noncomm rational coeffs =================*/
3172      if (strcmp(sys_cmd, "ratSpoly") == 0)
3173      {
3174        poly p,q;
3175        int is;
3176        if ((h!=NULL) && (h->Typ()==POLY_CMD))
3177        {
3178          p=(poly)h->CopyD();
3179          h=h->next;
3180        }
3181        else return TRUE;
3182        if ((h!=NULL) && (h->Typ()==POLY_CMD))
3183        {
3184          q=(poly)h->CopyD();
3185          h=h->next;
3186        }
3187        else return TRUE;
3188        if ((h!=NULL) && (h->Typ()==INT_CMD))
3189        {
3190          is=(int)((long)(h->Data()));
3191          res->rtyp=POLY_CMD;
3192          //        res->rtyp=IDEAL_CMD;
3193          if (rIsPluralRing(currRing))
3194          {
3195            res->data = nc_rat_CreateSpoly(p,q,is,currRing);
3196            //        res->data = ncGCD(p,q,currRing);
3197          }
3198          else res->data=p;
3199        }
3200        else return TRUE;
3201        return FALSE;
3202      }
3203      else
3204  #endif // HAVE_RATGRING
3205  /*==================== Rat def =================*/
3206      if (strcmp(sys_cmd, "ratVar") == 0)
3207      {
3208        int start,end;
3209        if ((h!=NULL) && (h->Typ()==POLY_CMD))
3210        {
3211          start=pIsPurePower((poly)h->Data());
3212          h=h->next;
3213        }
3214        else return TRUE;
3215        if ((h!=NULL) && (h->Typ()==POLY_CMD))
3216        {
3217          end=pIsPurePower((poly)h->Data());
3218          h=h->next;
3219        }
3220        else return TRUE;
3221        currRing->real_var_start=start;
3222        currRing->real_var_end=end;
3223        return (start==0)||(end==0)||(start>end);
3224      }
3225      else
3226  /*==================== t-rep-GB ==================================*/
3227      if (strcmp(sys_cmd, "unifastmult")==0)
3228      {
3229        poly f = (poly)h->Data();
3230        h=h->next;
3231        poly g=(poly)h->Data();
3232        res->rtyp=POLY_CMD;
3233        res->data=unifastmult(f,g,currRing);
3234        return(FALSE);
3235      }
3236      else
3237      if (strcmp(sys_cmd, "multifastmult")==0)
3238      {
3239        poly f = (poly)h->Data();
3240        h=h->next;
3241        poly g=(poly)h->Data();
3242        res->rtyp=POLY_CMD;
3243        res->data=multifastmult(f,g,currRing);
3244        return(FALSE);
3245      }
3246      else
3247      if (strcmp(sys_cmd, "mults")==0)
3248      {
3249        res->rtyp=INT_CMD ;
3250        res->data=(void*)(long) Mults();
3251        return(FALSE);
3252      }
3253      else
3254      if (strcmp(sys_cmd, "fastpower")==0)
3255      {
3256        ring r = currRing;
3257        poly f = (poly)h->Data();
3258        h=h->next;
3259        int n=(int)((long)h->Data());
3260        res->rtyp=POLY_CMD ;
3261        res->data=(void*) pFastPower(f,n,r);
3262        return(FALSE);
3263      }
3264      else
3265      if (strcmp(sys_cmd, "normalpower")==0)
3266      {
3267        poly f = (poly)h->Data();
3268        h=h->next;
3269        int n=(int)((long)h->Data());
3270        res->rtyp=POLY_CMD ;
3271        res->data=(void*) pPower(pCopy(f),n);
3272        return(FALSE);
3273      }
3274      else
3275      if (strcmp(sys_cmd, "MCpower")==0)
3276      {
3277        ring r = currRing;
3278        poly f = (poly)h->Data();
3279        h=h->next;
3280        int n=(int)((long)h->Data());
3281        res->rtyp=POLY_CMD ;
3282        res->data=(void*) pFastPowerMC(f,n,r);
3283        return(FALSE);
3284      }
3285      else
3286      if (strcmp(sys_cmd, "bit_subst")==0)
3287      {
3288        ring r = currRing;
3289        poly outer = (poly)h->Data();
3290        h=h->next;
3291        poly inner=(poly)h->Data();
3292        res->rtyp=POLY_CMD ;
3293        res->data=(void*) uni_subst_bits(outer, inner,r);
3294        return(FALSE);
3295      }
3296      else
3297  /*==================== gcd-varianten =================*/
3298      if (strcmp(sys_cmd, "gcd") == 0)
3299      {
3300        if (h==NULL)
3301        {
3302        #if 0
3303          Print("FLINT_P:%d (use Flints gcd for polynomials in char p)\n",isOn(SW_USE_FL_GCD_P));
3304          Print("FLINT_0:%d (use Flints gcd for polynomials in char 0)\n",isOn(SW_USE_FL_GCD_0));
3305        #endif
3306          Print("EZGCD:%d (use EZGCD for gcd of polynomials in char 0)\n",isOn(SW_USE_EZGCD));
3307          Print("EZGCD_P:%d (use EZGCD_P for gcd of polynomials in char p)\n",isOn(SW_USE_EZGCD_P));
3308          Print("CRGCD:%d (use chinese Remainder for gcd of polynomials in char 0)\n",isOn(SW_USE_CHINREM_GCD));
3309          #ifndef __CYGWIN__
3310          Print("homog:%d (use homog. test for factorization of polynomials)\n",singular_homog_flag);
3311          #endif
3312          return FALSE;
3313        }
3314        else
3315        if ((h!=NULL) && (h->Typ()==STRING_CMD)
3316        && (h->next!=NULL) && (h->next->Typ()==INT_CMD))
3317        {
3318          int d=(int)(long)h->next->Data();
3319          char *s=(char *)h->Data();
3320        #if 0
3321          if (strcmp(s,"FLINT_P")==0) { if (d) On(SW_USE_FL_GCD_P); else Off(SW_USE_FL_GCD_P); } else
3322          if (strcmp(s,"FLINT_0")==0) { if (d) On(SW_USE_FL_GCD_0); else Off(SW_USE_FL_GCD_0); } else
3323        #endif
3324          if (strcmp(s,"EZGCD")==0) { if (d) On(SW_USE_EZGCD); else Off(SW_USE_EZGCD); } else
3325          if (strcmp(s,"EZGCD_P")==0) { if (d) On(SW_USE_EZGCD_P); else Off(SW_USE_EZGCD_P); } else
3326          if (strcmp(s,"CRGCD")==0) { if (d) On(SW_USE_CHINREM_GCD); else Off(SW_USE_CHINREM_GCD); } else
3327          #ifndef __CYGWIN__
3328          if (strcmp(s,"homog")==0) { if (d) singular_homog_flag=1; else singular_homog_flag=0; } else
3329          #endif
3330          return TRUE;
3331          return FALSE;
3332        }
3333        else return TRUE;
3334      }
3335      else
3336  /*==================== subring =================*/
3337      if (strcmp(sys_cmd, "subring") == 0)
3338      {
3339        if (h!=NULL)
3340        {
3341          extern ring rSubring(ring r,leftv v); /* ipshell.cc*/
3342          res->data=(char *)rSubring(currRing,h);
3343          res->rtyp=RING_CMD;
3344          return res->data==NULL;
3345        }
3346        else return TRUE;
3347      }
3348      else
3349  /*==================== HNF =================*/
3350  #ifdef HAVE_NTL
3351      if (strcmp(sys_cmd, "HNF") == 0)
3352      {
3353        if (h!=NULL)
3354        {
3355          res->rtyp=h->Typ();
3356          if (h->Typ()==MATRIX_CMD)
3357          {
3358            res->data=(char *)singntl_HNF((matrix)h->Data(), currRing);
3359            return FALSE;
3360          }
3361          else if (h->Typ()==INTMAT_CMD)
3362          {
3363            res->data=(char *)singntl_HNF((intvec*)h->Data());
3364            return FALSE;
3365          }
3366          else if (h->Typ()==INTMAT_CMD)
3367          {
3368            res->data=(char *)singntl_HNF((intvec*)h->Data());
3369            return FALSE;
3370          }
3371          else
3372          {
3373            WerrorS("expected `system(\"HNF\",<matrix|intmat|bigintmat>)`");
3374            return TRUE;
3375          }
3376        }
3377        else return TRUE;
3378      }
3379      else
3380  /*================= probIrredTest ======================*/
3381      if (strcmp (sys_cmd, "probIrredTest") == 0)
3382      {
3383        if (h!=NULL && (h->Typ()== POLY_CMD) && ((h->next != NULL) && h->next->Typ() == STRING_CMD))
3384        {
3385          CanonicalForm F= convSingPFactoryP((poly)(h->Data()), currRing);
3386          char *s=(char *)h->next->Data();
3387          double error= atof (s);
3388          int irred= probIrredTest (F, error);
3389          res->rtyp= INT_CMD;
3390          res->data= (void*)(long)irred;
3391          return FALSE;
3392        }
3393        else return TRUE;
3394      }
3395      else
3396  #endif
3397  /*==================== mpz_t loader ======================*/
3398    if(strcmp(sys_cmd, "GNUmpLoad")==0)
3399    {
3400      if ((h != NULL) && (h->Typ() == STRING_CMD))
3401      {
3402        char* filename = (char*)h->Data();
3403        FILE* f = fopen(filename, "r");
3404        if (f == NULL)
3405        {
3406          WerrorS( "invalid file name (in paths use '/')");
3407          return FALSE;
3408        }
3409        mpz_t m; mpz_init(m);
3410        mpz_inp_str(m, f, 10);
3411        fclose(f);
3412        number n = n_InitMPZ(m, coeffs_BIGINT);
3413        res->rtyp = BIGINT_CMD;
3414        res->data = (void*)n;
3415        return FALSE;
3416      }
3417      else
3418      {
3419        WerrorS( "expected valid file name as a string");
3420        return TRUE;
3421      }
3422    }
3423    else
3424  /*==================== intvec matching ======================*/
3425    /* Given two non-empty intvecs, the call
3426            'system("intvecMatchingSegments", ivec, jvec);'
3427         computes all occurences of jvec in ivec, i.e., it returns
3428         a list of int indices k such that ivec[k..size(jvec)+k-1] = jvec.
3429         If no such k exists (e.g. when ivec is shorter than jvec), an
3430         intvec with the single entry 0 is being returned. */
3431    if(strcmp(sys_cmd, "intvecMatchingSegments")==0)
3432    {
3433      if ((h       != NULL) && (h->Typ()       == INTVEC_CMD) &&
3434          (h->next != NULL) && (h->next->Typ() == INTVEC_CMD) &&
3435          (h->next->next == NULL))
3436      {
3437        intvec* ivec = (intvec*)h->Data();
3438        intvec* jvec = (intvec*)h->next->Data();
3439        intvec* r = new intvec(1); (*r)[0] = 0;
3440        int validEntries = 0;
3441        for (int k = 0; k <= ivec->rows() - jvec->rows(); k++)
3442        {
3443          if (memcmp(&(*ivec)[k], &(*jvec)[0],
3444                       sizeof(int) * jvec->rows()) == 0)
3445          {
3446            if (validEntries == 0)
3447              (*r)[0] = k + 1;
3448            else
3449            {
3450              r->resize(validEntries + 1);
3451              (*r)[validEntries] = k + 1;
3452            }
3453            validEntries++;
3454          }
3455        }
3456        res->rtyp = INTVEC_CMD;
3457        res->data = (void*)r;
3458        return FALSE;
3459      }
3460      else
3461      {
3462        WerrorS("expected two non-empty intvecs as arguments");
3463        return TRUE;
3464      }
3465    }
3466    else
3467  /* ================== intvecOverlap ======================= */
3468    /* Given two non-empty intvecs, the call
3469            'system("intvecOverlap", ivec, jvec);'
3470         computes the longest intvec kvec such that ivec ends with kvec
3471         and jvec starts with kvec. The length of this overlap is being
3472         returned. If there is no overlap at all, then 0 is being returned. */
3473    if(strcmp(sys_cmd, "intvecOverlap")==0)
3474    {
3475      if ((h       != NULL) && (h->Typ()       == INTVEC_CMD) &&
3476            (h->next != NULL) && (h->next->Typ() == INTVEC_CMD) &&
3477            (h->next->next == NULL))
3478      {
3479        intvec* ivec = (intvec*)h->Data();
3480        intvec* jvec = (intvec*)h->next->Data();
3481        int ir = ivec->rows(); int jr = jvec->rows();
3482        int r = jr; if (ir < jr) r = ir;   /* r = min{ir, jr} */
3483        while ((r >= 1) && (memcmp(&(*ivec)[ir - r], &(*jvec)[0],
3484                                     sizeof(int) * r) != 0))
3485          r--;
3486        res->rtyp = INT_CMD;
3487        res->data = (void*)(long)r;
3488        return FALSE;
3489      }
3490      else
3491      {
3492        WerrorS("expected two non-empty intvecs as arguments");
3493        return TRUE;
3494      }
3495    }
3496    else
3497  /*==================== Hensel's lemma ======================*/
3498    if(strcmp(sys_cmd, "henselfactors")==0)
3499    {
3500      if ((h != NULL) && (h->Typ() == INT_CMD) &&
3501        (h->next != NULL) && (h->next->Typ() == INT_CMD) &&
3502        (h->next->next != NULL) && (h->next->next->Typ() == POLY_CMD) &&
3503        (h->next->next->next != NULL) &&
3504        (h->next->next->next->Typ() == POLY_CMD) &&
3505        (h->next->next->next->next != NULL) &&
3506        (h->next->next->next->next->Typ() == POLY_CMD) &&
3507        (h->next->next->next->next->next != NULL) &&
3508        (h->next->next->next->next->next->Typ() == INT_CMD) &&
3509        (h->next->next->next->next->next->next == NULL))
3510      {
3511        int xIndex = (int)(long)h->Data();
3512        int yIndex = (int)(long)h->next->Data();
3513        poly hh    = (poly)h->next->next->Data();
3514        poly f0    = (poly)h->next->next->next->Data();
3515        poly g0    = (poly)h->next->next->next->next->Data();
3516        int d      = (int)(long)h->next->next->next->next->next->Data();
3517        poly f; poly g;
3518        henselFactors(xIndex, yIndex, hh, f0, g0, d, f, g);
3519        lists L = (lists)omAllocBin(slists_bin);
3520        L->Init(2);
3521        L->m[0].rtyp = POLY_CMD; L->m[0].data=(void*)f;
3522        L->m[1].rtyp = POLY_CMD; L->m[1].data=(void*)g;
3523        res->rtyp = LIST_CMD;
3524        res->data = (char *)L;
3525        return FALSE;
3526      }
3527      else
3528      {
3529        WerrorS( "expected argument list (int, int, poly, poly, poly, int)");
3530        return TRUE;
3531      }
3532    }
3533    else
3534  /*==================== Approx_Step  =================*/
3535  #ifdef HAVE_PLURAL
3536    if (strcmp(sys_cmd, "astep") == 0)
3537    {
3538      ideal I;
3539      if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
3540      {
3541        I=(ideal)h->CopyD();
3542        res->rtyp=IDEAL_CMD;
3543        if (rIsPluralRing(currRing)) res->data=Approx_Step(I);
3544        else res->data=I;
3545        setFlag(res,FLAG_STD);
3546      }
3547      else return TRUE;
3548      return FALSE;
3549    }
3550    else
3551  #endif
3552  /*==================== PrintMat  =================*/
3553  #ifdef HAVE_PLURAL
3554    if (strcmp(sys_cmd, "PrintMat") == 0)
3555    {
3556      int a;
3557      int b;
3558      ring r;
3559      int metric;
3560      if (h!=NULL)
3561      {
3562        if (h->Typ()==INT_CMD)
3563        {
3564          a=(int)((long)(h->Data()));
3565          h=h->next;
3566        }
3567        else if (h->Typ()==INT_CMD)
3568        {
3569          b=(int)((long)(h->Data()));
3570          h=h->next;
3571        }
3572        else if (h->Typ()==RING_CMD)
3573        {
3574          r=(ring)h->Data();
3575          h=h->next;
3576        }
3577        else
3578          return TRUE;
3579      }
3580      else
3581        return TRUE;
3582      if ((h!=NULL) && (h->Typ()==INT_CMD))
3583      {
3584        metric=(int)((long)(h->Data()));
3585      }
3586      res->rtyp=MATRIX_CMD;
3587      if (rIsPluralRing(r)) res->data=nc_PrintMat(a,b,r,metric);
3588      else res->data=NULL;
3589      return FALSE;
3590    }
3591    else
3592  #endif
3593/* ============ NCUseExtensions ======================== */
3594  #ifdef HAVE_PLURAL
3595    if(strcmp(sys_cmd,"NCUseExtensions")==0)
3596    {
3597      if ((h!=NULL) && (h->Typ()==INT_CMD))
3598        res->data=(void *)(long)setNCExtensions( (int)((long)(h->Data())) );
3599      else
3600        res->data=(void *)(long)getNCExtensions();
3601      res->rtyp=INT_CMD;
3602      return FALSE;
3603    }
3604    else
3605  #endif
3606/* ============ NCGetType ======================== */
3607  #ifdef HAVE_PLURAL
3608    if(strcmp(sys_cmd,"NCGetType")==0)
3609    {
3610      res->rtyp=INT_CMD;
3611      if( rIsPluralRing(currRing) )
3612        res->data=(void *)(long)ncRingType(currRing);
3613      else
3614        res->data=(void *)(-1L);
3615      return FALSE;
3616    }
3617    else
3618  #endif
3619/* ============ ForceSCA ======================== */
3620  #ifdef HAVE_PLURAL
3621    if(strcmp(sys_cmd,"ForceSCA")==0)
3622    {
3623      if( !rIsPluralRing(currRing) )
3624        return TRUE;
3625      int b, e;
3626      if ((h!=NULL) && (h->Typ()==INT_CMD))
3627      {
3628        b = (int)((long)(h->Data()));
3629        h=h->next;
3630      }
3631      else return TRUE;
3632      if ((h!=NULL) && (h->Typ()==INT_CMD))
3633      {
3634        e = (int)((long)(h->Data()));
3635      }
3636      else return TRUE;
3637      if( !sca_Force(currRing, b, e) )
3638        return TRUE;
3639      return FALSE;
3640    }
3641    else
3642  #endif
3643/* ============ ForceNewNCMultiplication ======================== */
3644  #ifdef HAVE_PLURAL
3645    if(strcmp(sys_cmd,"ForceNewNCMultiplication")==0)
3646    {
3647      if( !rIsPluralRing(currRing) )
3648        return TRUE;
3649      if( !ncInitSpecialPairMultiplication(currRing) ) // No Plural!
3650        return TRUE;
3651      return FALSE;
3652    }
3653    else
3654  #endif
3655/* ============ ForceNewOldNCMultiplication ======================== */
3656  #ifdef HAVE_PLURAL
3657    if(strcmp(sys_cmd,"ForceNewOldNCMultiplication")==0)
3658    {
3659      if( !rIsPluralRing(currRing) )
3660        return TRUE;
3661      if( !ncInitSpecialPowersMultiplication(currRing) ) // Enable Formula for Plural (depends on swiches)!
3662        return TRUE;
3663      return FALSE;
3664    }
3665    else
3666  #endif
3667/*==================== test64 =================*/
3668  #if 0
3669    if(strcmp(sys_cmd,"test64")==0)
3670    {
3671      long l=8;int i;
3672      for(i=1;i<62;i++)
3673      {
3674        l=l<<1;
3675        number n=n_Init(l,coeffs_BIGINT);
3676        Print("%ld= ",l);n_Print(n,coeffs_BIGINT);
3677        CanonicalForm nn=n_convSingNFactoryN(n,TRUE,coeffs_BIGINT);
3678        n_Delete(&n,coeffs_BIGINT);
3679        n=n_convFactoryNSingN(nn,coeffs_BIGINT);
3680        PrintS(" F:");
3681        n_Print(n,coeffs_BIGINT);
3682        PrintLn();
3683        n_Delete(&n,coeffs_BIGINT);
3684      }
3685      Print("SIZEOF_LONG=%d\n",SIZEOF_LONG);
3686      return FALSE;
3687    }
3688    else
3689   #endif
3690/*==================== n_SwitchChinRem =================*/
3691    if(strcmp(sys_cmd,"cache_chinrem")==0)
3692    {
3693      EXTERN_VAR int n_SwitchChinRem;
3694      Print("caching inverse in chines remainder:%d\n",n_SwitchChinRem);
3695      if ((h!=NULL)&&(h->Typ()==INT_CMD))
3696        n_SwitchChinRem=(int)(long)h->Data();
3697      return FALSE;
3698    }
3699    else
3700/*==================== LU for bigintmat =================*/
3701#ifdef SINGULAR_4_2
3702    if(strcmp(sys_cmd,"LU")==0)
3703    {
3704      if ((h!=NULL) && (h->Typ()==CMATRIX_CMD))
3705      {
3706        // get the argument:
3707        bigintmat *b=(bigintmat *)h->Data();
3708        // just for tests: simply transpose
3709        bigintmat *bb=b->transpose();
3710        // return the result:
3711        res->rtyp=CMATRIX_CMD;
3712        res->data=(char*)bb;
3713        return FALSE;
3714      }
3715      else
3716      {
3717        WerrorS("system(\"LU\",<cmatrix>) expected");
3718        return TRUE;
3719      }
3720    }
3721    else
3722#endif
3723/*==================== sort =================*/
3724    if(strcmp(sys_cmd,"sort")==0)
3725    {
3726      extern BOOLEAN jjSORTLIST(leftv,leftv);
3727      if (h->Typ()==LIST_CMD)
3728        return jjSORTLIST(res,h);
3729      else
3730        return TRUE;
3731    }
3732    else
3733/*==================== uniq =================*/
3734    if(strcmp(sys_cmd,"uniq")==0)
3735    {
3736      extern BOOLEAN jjUNIQLIST(leftv, leftv);
3737      if (h->Typ()==LIST_CMD)
3738        return jjUNIQLIST(res,h);
3739      else
3740        return TRUE;
3741    }
3742    else
3743/*==================== GF(p,n) ==================================*/
3744    if(strcmp(sys_cmd,"GF")==0)
3745    {
3746      const short t[]={3,INT_CMD,INT_CMD,STRING_CMD};
3747      if (iiCheckTypes(h,t,1))
3748      {
3749        int p=(int)(long)h->Data();
3750        int n=(int)(long)h->next->Data();
3751        char *v=(char*)h->next->next->CopyD();
3752        GFInfo param;
3753        param.GFChar = p;
3754        param.GFDegree = n;
3755        param.GFPar_name = v;
3756        coeffs cf= nInitChar(n_GF, &param);
3757        res->rtyp=CRING_CMD;
3758        res->data=cf;
3759        return FALSE;
3760      }
3761      else
3762        return TRUE;
3763    }
3764    else
3765/*==================== power* ==================================*/
3766    #if 0
3767    if(strcmp(sys_cmd,"power1")==0)
3768    {
3769      res->rtyp=POLY_CMD;
3770      poly f=(poly)h->CopyD();
3771      poly g=pPower(f,2000);
3772      res->data=(void *)g;
3773      return FALSE;
3774    }
3775    else
3776    if(strcmp(sys_cmd,"power2")==0)
3777    {
3778      res->rtyp=POLY_CMD;
3779      poly f=(poly)h->Data();
3780      poly g=pOne();
3781      for(int i=0;i<2000;i++)
3782        g=pMult(g,pCopy(f));
3783      res->data=(void *)g;
3784      return FALSE;
3785    }
3786    if(strcmp(sys_cmd,"power3")==0)
3787    {
3788      res->rtyp=POLY_CMD;
3789      poly f=(poly)h->Data();
3790      poly p2=pMult(pCopy(f),pCopy(f));
3791      poly p4=pMult(pCopy(p2),pCopy(p2));
3792      poly p8=pMult(pCopy(p4),pCopy(p4));
3793      poly p16=pMult(pCopy(p8),pCopy(p8));
3794      poly p32=pMult(pCopy(p16),pCopy(p16));
3795      poly p64=pMult(pCopy(p32),pCopy(p32));
3796      poly p128=pMult(pCopy(p64),pCopy(p64));
3797      poly p256=pMult(pCopy(p128),pCopy(p128));
3798      poly p512=pMult(pCopy(p256),pCopy(p256));
3799      poly p1024=pMult(pCopy(p512),pCopy(p512));
3800      poly p1536=pMult(p1024,p512);
3801      poly p1792=pMult(p1536,p256);
3802      poly p1920=pMult(p1792,p128);
3803      poly p1984=pMult(p1920,p64);
3804      poly p2000=pMult(p1984,p16);
3805      res->data=(void *)p2000;
3806      pDelete(&p2);
3807      pDelete(&p4);
3808      pDelete(&p8);
3809      //pDelete(&p16);
3810      pDelete(&p32);
3811      //pDelete(&p64);
3812      //pDelete(&p128);
3813      //pDelete(&p256);
3814      //pDelete(&p512);
3815      //pDelete(&p1024);
3816      //pDelete(&p1536);
3817      //pDelete(&p1792);
3818      //pDelete(&p1920);
3819      //pDelete(&p1984);
3820      return FALSE;
3821    }
3822    else
3823    #endif
3824/* ccluster --------------------------------------------------------------*/
3825#ifdef HAVE_CCLUSTER
3826    if(strcmp(sys_cmd,"ccluster")==0)
3827    {
3828      if ((currRing!=NULL)
3829      && (rField_is_Q(currRing) || rField_is_R(currRing) || rField_is_long_R(currRing)))
3830      {
3831        const short t[]={5,POLY_CMD,NUMBER_CMD,NUMBER_CMD,NUMBER_CMD,NUMBER_CMD};
3832        const short t2[]={6,POLY_CMD,POLY_CMD,NUMBER_CMD,NUMBER_CMD,NUMBER_CMD,NUMBER_CMD};
3833
3834//         printf("test t : %d\n", h->Typ()==POLY_CMD);
3835//         printf("test t : %d\n", h->next->Typ()==POLY_CMD);
3836        int pol_with_complex_coeffs=0;
3837        if (h->next->Typ()==POLY_CMD)
3838            pol_with_complex_coeffs=1;
3839
3840        if ( (pol_with_complex_coeffs==0 && iiCheckTypes(h,t,1))
3841       ||(pol_with_complex_coeffs==1 && iiCheckTypes(h,t2,1)) )
3842        {
3843          // convert first arg. to fmpq_poly_t
3844          fmpq_poly_t fre, fim;
3845          convSingPFlintP(fre,(poly)h->Data(),currRing); h=h->next;
3846          if (pol_with_complex_coeffs==1)
3847          { // convert second arg. to fmpq_poly_t
3848            convSingPFlintP(fim,(poly)h->Data(),currRing); h=h->next;
3849          }
3850          // convert box-center(re,im), box-size, epsilon
3851          fmpq_t center_re,center_im,boxsize,eps;
3852          convSingNFlintN(center_re,(number)h->Data(),currRing->cf); h=h->next;
3853          convSingNFlintN(center_im,(number)h->Data(),currRing->cf); h=h->next;
3854          convSingNFlintN(boxsize,(number)h->Data(),currRing->cf); h=h->next;
3855          convSingNFlintN(eps,(number)h->Data(),currRing->cf); h=h->next;
3856          // alloc arrays
3857          int n=fmpq_poly_length(fre);
3858          fmpq_t* re_part=(fmpq_t*)omAlloc(n*sizeof(fmpq_t));
3859          fmpq_t* im_part=(fmpq_t*)omAlloc(n*sizeof(fmpq_t));
3860          int *mult      =(int*)   omAlloc(n*sizeof(int));
3861          for(int i=0; i<n;i++)
3862          { fmpq_init(re_part[i]); fmpq_init(im_part[i]); }
3863          // call cccluster, adjust n
3864          int verbosity =0; //nothing is printed
3865          int strategy = 23; //default strategy
3866          int nn=0;
3867          long nb_threads = (long) feOptValue(FE_OPT_CPUS);
3868          strategy = strategy+(nb_threads<<6);
3869//       printf("nb threads: %ld\n", nb_threads);
3870//       printf("strategy: %ld\n", strategy);
3871          if (pol_with_complex_coeffs==0)
3872            nn=ccluster_interface_poly_real(re_part,im_part,mult,fre,center_re,center_im,boxsize,eps,strategy,verbosity);
3873          else
3874            nn=ccluster_interface_poly_real_imag(re_part,im_part,mult,fre,fim,center_re,center_im,boxsize,eps,strategy,verbosity);
3875          // convert to list
3876          lists l=(lists)omAlloc0Bin(slists_bin);
3877          l->Init(nn);
3878          for(int i=0; i<nn;i++)
3879          {
3880            lists ll=(lists)omAlloc0Bin(slists_bin);
3881            l->m[i].rtyp=LIST_CMD;
3882            l->m[i].data=ll;
3883            ll->Init(3);
3884            ll->m[0].rtyp=NUMBER_CMD;
3885            ll->m[1].rtyp=NUMBER_CMD;
3886            ll->m[2].rtyp=INT_CMD;
3887            ll->m[0].data=convFlintNSingN(re_part[i],currRing->cf);
3888            ll->m[1].data=convFlintNSingN(im_part[i],currRing->cf);
3889            ll->m[2].data=(void *)(long)mult[i];
3890          }
3891          //clear re, im, mults, fre, fim
3892          for(int i=n-1;i>=0;i--) { fmpq_clear(re_part[i]); fmpq_clear(im_part[i]); }
3893          omFree(re_part);
3894          omFree(im_part);
3895          omFree(mult);
3896          fmpq_clear(center_re); fmpq_clear(center_im); fmpq_clear(boxsize); fmpq_clear(eps);
3897          fmpq_poly_clear(fre);
3898          if (pol_with_complex_coeffs==1) fmpq_poly_clear(fim);
3899          // result
3900          res->rtyp=LIST_CMD;
3901          res->data=l;
3902          return FALSE;
3903        }
3904      }
3905      return TRUE;
3906    }
3907    else
3908#endif
3909/* ====== maEvalAt ============================*/
3910    if(strcmp(sys_cmd,"evaluate")==0)
3911    {
3912      extern number maEvalAt(const poly p,const number* pt, const ring r);
3913      if (h->Typ()!=POLY_CMD)
3914      {
3915        WerrorS("expected system(\"evaluate\",<poly>,..)");
3916        return TRUE;
3917      }
3918      poly p=(poly)h->Data();
3919      number *pt=(number*)omAlloc(sizeof(number)*currRing->N);
3920      for(int i=0;i<currRing->N;i++)
3921      {
3922        h=h->next;
3923        if ((h==NULL)||(h->Typ()!=NUMBER_CMD))
3924        {
3925          WerrorS("system(\"evaluate\",<poly>,<number>..) - expect number");
3926          return TRUE;
3927        }
3928        pt[i]=(number)h->Data();
3929      }
3930      res->data=maEvalAt(p,pt,currRing);
3931      res->rtyp=NUMBER_CMD;
3932      return FALSE;
3933    }
3934    else
3935/* ====== DivRem ============================*/
3936    if(strcmp(sys_cmd,"DivRem")==0)
3937    {
3938      const short t1[]={2,POLY_CMD,POLY_CMD};
3939      if (iiCheckTypes(h,t1,1))
3940      {
3941        poly p=(poly)h->CopyD();
3942        poly q=(poly)h->next->CopyD();
3943        poly rest;
3944        res->data=p_DivRem(p,q,rest,currRing);
3945        res->rtyp=POLY_CMD;
3946        Print("rest:");pWrite(rest);
3947        return FALSE;
3948      }
3949      else
3950      {
3951        WerrorS("expected system(\"DivRem\",<poly>,<poly>)");
3952        return TRUE;
3953      }
3954    }
3955    else
3956/*==================== Error =================*/
3957      Werror( "(extended) system(\"%s\",...) %s", sys_cmd, feNotImplemented );
3958  }
3959  return TRUE;
3960}
3961
3962#endif // HAVE_EXTENDED_SYSTEM
3963
3964
Note: See TracBrowser for help on using the repository browser.