source: git/Singular/extra.cc @ 7b8818

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