source: git/Singular/extra.cc @ dea3d2

jengelh-datetimespielwiese
Last change on this file since dea3d2 was dea3d2, checked in by Martin Lee <martinlee84@…>, 10 years ago
add: rudimentary Bertone/Cheze/Galligo absolute factorization Conflicts: factory/GNUmakefile.in
  • Property mode set to 100644
File size: 112.7 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, "Mrwalk") == 0)
2024      { // Random Walk
2025        if (h == NULL || h->Typ() != IDEAL_CMD ||
2026            h->next == NULL || h->next->Typ() != INTVEC_CMD ||
2027            h->next->next == NULL || h->next->next->Typ() != INTVEC_CMD ||
2028            h->next->next->next == NULL || h->next->next->next->Typ() != INT_CMD ||
2029            h->next->next->next->next == NULL || h->next->next->next->next->Typ() != INT_CMD)
2030        {
2031          Werror("system(\"Mrwalk\", ideal, intvec, intvec, int, int) expected");
2032          return TRUE;
2033        }
2034
2035        if (((intvec*) h->next->Data())->length() != currRing->N &&
2036            ((intvec*) h->next->next->Data())->length() != currRing->N )
2037        {
2038          Werror("system(\"Mrwalk\" ...) intvecs not of length %d\n",
2039                 currRing->N);
2040          return TRUE;
2041        }
2042        ideal arg1 = (ideal) h->Data();
2043        intvec* arg2 = (intvec*) h->next->Data();
2044        intvec* arg3 =  (intvec*) h->next->next->Data();
2045        int arg4 = (int)(long) h->next->next->next->Data();
2046        int arg5 = (int)(long) h->next->next->next->next->Data();
2047
2048
2049        ideal result = (ideal) Mrwalk(arg1, arg2, arg3, arg4, arg5);
2050
2051        res->rtyp = IDEAL_CMD;
2052        res->data =  result;
2053
2054        return FALSE;
2055      }
2056      else
2057      if (strcmp(sys_cmd, "MAltwalk1") == 0)
2058      {
2059        if (h == NULL || h->Typ() != IDEAL_CMD ||
2060            h->next == NULL || h->next->Typ() != INT_CMD ||
2061            h->next->next == NULL || h->next->next->Typ() != INT_CMD ||
2062            h->next->next->next == NULL ||
2063              h->next->next->next->Typ() != INTVEC_CMD ||
2064            h->next->next->next->next == NULL ||
2065              h->next->next->next->next->Typ() != INTVEC_CMD)
2066        {
2067          Werror("system(\"MAltwalk1\", ideal, int, int, intvec, intvec) expected");
2068          return TRUE;
2069        }
2070
2071        if (((intvec*) h->next->next->next->Data())->length() != currRing->N &&
2072            ((intvec*) h->next->next->next->next->Data())->length()!=currRing->N)
2073        {
2074          Werror("system(\"MAltwalk1\" ...) intvecs not of length %d\n",
2075                 currRing->N);
2076          return TRUE;
2077        }
2078        ideal arg1 = (ideal) h->Data();
2079        int arg2 = (int) ((long)(h->next->Data()));
2080        int arg3 = (int) ((long)(h->next->next->Data()));
2081        intvec* arg4 = (intvec*) h->next->next->next->Data();
2082        intvec* arg5   =  (intvec*) h->next->next->next->next->Data();
2083
2084
2085        ideal result = (ideal) MAltwalk1(arg1, arg2, arg3, arg4, arg5);
2086
2087        res->rtyp = IDEAL_CMD;
2088        res->data =  result;
2089
2090        return FALSE;
2091      }
2092  #ifdef MFWALK_ALT
2093      else
2094      if (strcmp(sys_cmd, "Mfwalk_alt") == 0)
2095      {
2096        if (h == NULL || h->Typ() != IDEAL_CMD ||
2097            h->next == NULL || h->next->Typ() != INTVEC_CMD ||
2098            h->next->next == NULL || h->next->next->Typ() != INTVEC_CMD ||
2099            h->next->next->next == NULL || h->next->next->next->Typ() !=INT_CMD)
2100        {
2101          Werror("system(\"Mfwalk\", ideal, intvec, intvec,int) expected");
2102          return TRUE;
2103        }
2104
2105        if (((intvec*) h->next->Data())->length() != currRing->N &&
2106            ((intvec*) h->next->next->Data())->length() != currRing->N )
2107        {
2108          Werror("system(\"Mfwalk\" ...) intvecs not of length %d\n",
2109                 currRing->N);
2110          return TRUE;
2111        }
2112        ideal arg1 = (ideal) h->Data();
2113        intvec* arg2 = (intvec*) h->next->Data();
2114        intvec* arg3   =  (intvec*) h->next->next->Data();
2115        int arg4 = (int) h->next->next->next->Data();
2116
2117        ideal result = (ideal) Mfwalk_alt(arg1, arg2, arg3, arg4);
2118
2119        res->rtyp = IDEAL_CMD;
2120        res->data =  result;
2121
2122        return FALSE;
2123      }
2124  #endif
2125      else
2126      if (strcmp(sys_cmd, "Mfwalk") == 0)
2127      {
2128        if (h == NULL || h->Typ() != IDEAL_CMD ||
2129            h->next == NULL || h->next->Typ() != INTVEC_CMD ||
2130            h->next->next == NULL || h->next->next->Typ() != INTVEC_CMD)
2131        {
2132          Werror("system(\"Mfwalk\", ideal, intvec, intvec) expected");
2133          return TRUE;
2134        }
2135
2136        if (((intvec*) h->next->Data())->length() != currRing->N &&
2137            ((intvec*) h->next->next->Data())->length() != currRing->N )
2138        {
2139          Werror("system(\"Mfwalk\" ...) intvecs not of length %d\n",
2140                 currRing->N);
2141          return TRUE;
2142        }
2143        ideal arg1 = (ideal) h->Data();
2144        intvec* arg2 = (intvec*) h->next->Data();
2145        intvec* arg3   =  (intvec*) h->next->next->Data();
2146
2147        ideal result = (ideal) Mfwalk(arg1, arg2, arg3);
2148
2149        res->rtyp = IDEAL_CMD;
2150        res->data =  result;
2151
2152        return FALSE;
2153      }
2154      else
2155      if (strcmp(sys_cmd, "Mfrwalk") == 0)
2156      {
2157        if (h == NULL || h->Typ() != IDEAL_CMD ||
2158            h->next == NULL || h->next->Typ() != INTVEC_CMD ||
2159            h->next->next == NULL || h->next->next->Typ() != INTVEC_CMD ||
2160            h->next->next->next == NULL || h->next->next->next->Typ() != INT_CMD)
2161        {
2162          Werror("system(\"Mfrwalk\", ideal, intvec, intvec, int) expected");
2163          return TRUE;
2164        }
2165
2166        if (((intvec*) h->next->Data())->length() != currRing->N &&
2167            ((intvec*) h->next->next->Data())->length() != currRing->N )
2168        {
2169          Werror("system(\"Mfrwalk\" ...) intvecs not of length %d\n",
2170                 currRing->N);
2171          return TRUE;
2172        }
2173        ideal arg1 = (ideal) h->Data();
2174        intvec* arg2 = (intvec*) h->next->Data();
2175        intvec* arg3 = (intvec*) h->next->next->Data();
2176        int arg4 = (int)(long) h->next->next->next->Data();
2177       
2178        ideal result = (ideal) Mfrwalk(arg1, arg2, arg3, arg4);
2179
2180        res->rtyp = IDEAL_CMD;
2181        res->data =  result;
2182
2183        return FALSE;
2184      } 
2185      else
2186
2187  #ifdef TRAN_Orig
2188      if (strcmp(sys_cmd, "TranMImprovwalk") == 0)
2189      {
2190        if (h == NULL || h->Typ() != IDEAL_CMD ||
2191            h->next == NULL || h->next->Typ() != INTVEC_CMD ||
2192            h->next->next == NULL || h->next->next->Typ() != INTVEC_CMD)
2193        {
2194          Werror("system(\"TranMImprovwalk\", ideal, intvec, intvec) expected");
2195          return TRUE;
2196        }
2197
2198        if (((intvec*) h->next->Data())->length() != currRing->N &&
2199            ((intvec*) h->next->next->Data())->length() != currRing->N )
2200        {
2201          Werror("system(\"TranMImprovwalk\" ...) intvecs not of length %d\n",
2202                 currRing->N);
2203          return TRUE;
2204        }
2205        ideal arg1 = (ideal) h->Data();
2206        intvec* arg2 = (intvec*) h->next->Data();
2207        intvec* arg3   =  (intvec*) h->next->next->Data();
2208
2209
2210        ideal result = (ideal) TranMImprovwalk(arg1, arg2, arg3);
2211
2212        res->rtyp = IDEAL_CMD;
2213        res->data =  result;
2214
2215        return FALSE;
2216      }
2217      else
2218  #endif
2219      if (strcmp(sys_cmd, "MAltwalk2") == 0)
2220        {
2221        if (h == NULL || h->Typ() != IDEAL_CMD ||
2222            h->next == NULL || h->next->Typ() != INTVEC_CMD ||
2223            h->next->next == NULL || h->next->next->Typ() != INTVEC_CMD)
2224        {
2225          Werror("system(\"MAltwalk2\", ideal, intvec, intvec) expected");
2226          return TRUE;
2227        }
2228
2229        if (((intvec*) h->next->Data())->length() != currRing->N &&
2230            ((intvec*) h->next->next->Data())->length() != currRing->N )
2231        {
2232          Werror("system(\"MAltwalk2\" ...) intvecs not of length %d\n",
2233                 currRing->N);
2234          return TRUE;
2235        }
2236        ideal arg1 = (ideal) h->Data();
2237        intvec* arg2 = (intvec*) h->next->Data();
2238        intvec* arg3   =  (intvec*) h->next->next->Data();
2239
2240
2241        ideal result = (ideal) MAltwalk2(arg1, arg2, arg3);
2242
2243        res->rtyp = IDEAL_CMD;
2244        res->data =  result;
2245
2246        return FALSE;
2247      }
2248      else
2249      if (strcmp(sys_cmd, "TranMImprovwalk") == 0)
2250      {
2251        if (h == NULL || h->Typ() != IDEAL_CMD ||
2252            h->next == NULL || h->next->Typ() != INTVEC_CMD ||
2253            h->next->next == NULL || h->next->next->Typ() != INTVEC_CMD||
2254            h->next->next->next == NULL || h->next->next->next->Typ() != INT_CMD)
2255        {
2256          Werror("system(\"TranMImprovwalk\", ideal, intvec, intvec, int) expected");
2257          return TRUE;
2258        }
2259
2260        if (((intvec*) h->next->Data())->length() != currRing->N &&
2261            ((intvec*) h->next->next->Data())->length() != currRing->N )
2262        {
2263          Werror("system(\"TranMImprovwalk\" ...) intvecs not of length %d\n",
2264                 currRing->N);
2265          return TRUE;
2266        }
2267        ideal arg1 = (ideal) h->Data();
2268        intvec* arg2 = (intvec*) h->next->Data();
2269        intvec* arg3   =  (intvec*) h->next->next->Data();
2270        int arg4   =  (int) ((long)(h->next->next->next->Data()));
2271
2272        ideal result = (ideal) TranMImprovwalk(arg1, arg2, arg3, arg4);
2273
2274        res->rtyp = IDEAL_CMD;
2275        res->data =  result;
2276
2277        return FALSE;
2278      }
2279      else
2280      if (strcmp(sys_cmd, "TranMrImprovwalk") == 0)
2281      {
2282        if (h == NULL || h->Typ() != IDEAL_CMD ||
2283            h->next == NULL || h->next->Typ() != INTVEC_CMD ||
2284            h->next->next == NULL || h->next->next->Typ() != INTVEC_CMD ||
2285            h->next->next->next == NULL || h->next->next->next->Typ() != INT_CMD ||
2286            h->next->next->next == NULL || h->next->next->next->next->Typ() != INT_CMD ||
2287            h->next->next->next == NULL || h->next->next->next->next->next->Typ() != INT_CMD)
2288        {
2289          Werror("system(\"TranMrImprovwalk\", ideal, intvec, intvec) expected");
2290          return TRUE;
2291        }
2292
2293        if (((intvec*) h->next->Data())->length() != currRing->N &&
2294            ((intvec*) h->next->next->Data())->length() != currRing->N )
2295        {
2296          Werror("system(\"TranMrImprovwalk\" ...) intvecs not of length %d\n", currRing->N);
2297          return TRUE;
2298        }
2299        ideal arg1 = (ideal) h->Data();
2300        intvec* arg2 = (intvec*) h->next->Data();
2301        intvec* arg3 = (intvec*) h->next->next->Data();
2302        int arg4 = (int)(long) h->next->next->next->Data();
2303        int arg5 = (int)(long) h->next->next->next->next->Data();
2304        int arg6 = (int)(long) h->next->next->next->next->next->Data();
2305
2306        ideal result = (ideal) TranMrImprovwalk(arg1, arg2, arg3, arg4, arg5, arg6);
2307
2308        res->rtyp = IDEAL_CMD;
2309        res->data =  result;
2310
2311        return FALSE;
2312      }
2313      else
2314
2315  #endif
2316  /*================= Extended system call ========================*/
2317     {
2318       #ifndef MAKE_DISTRIBUTION
2319       return(jjEXTENDED_SYSTEM(res, args));
2320       #else
2321       Werror( "system(\"%s\",...) %s", sys_cmd, feNotImplemented );
2322       #endif
2323     }
2324    } /* typ==string */
2325    return TRUE;
2326  }
2327
2328
2329#ifdef HAVE_EXTENDED_SYSTEM
2330  // You can put your own system calls here
2331#  include <kernel/fglmcomb.cc>
2332#  include <kernel/fglm.h>
2333#  ifdef HAVE_NEWTON
2334#    include <hc_newton.h>
2335#  endif
2336#  include <polys/mod_raw.h>
2337#  include <polys/monomials/ring.h>
2338#  include <kernel/shiftgb.h>
2339
2340static BOOLEAN jjEXTENDED_SYSTEM(leftv res, leftv h)
2341{
2342    if(h->Typ() == STRING_CMD)
2343    {
2344      char *sys_cmd=(char *)(h->Data());
2345      h=h->next;
2346  /*==================== test syz strat =================*/
2347      if (strcmp(sys_cmd, "syz") == 0)
2348      {
2349         int posInT_EcartFDegpLength(const TSet set,const int length,LObject &p);
2350         int posInT_FDegpLength(const TSet set,const int length,LObject &p);
2351         int posInT_pLength(const TSet set,const int length,LObject &p);
2352         int posInT0(const TSet set,const int length,LObject &p);
2353         int posInT1(const TSet set,const int length,LObject &p);
2354         int posInT2(const TSet set,const int length,LObject &p);
2355         int posInT11(const TSet set,const int length,LObject &p);
2356         int posInT110(const TSet set,const int length,LObject &p);
2357         int posInT13(const TSet set,const int length,LObject &p);
2358         int posInT15(const TSet set,const int length,LObject &p);
2359         int posInT17(const TSet set,const int length,LObject &p);
2360         int posInT17_c(const TSet set,const int length,LObject &p);
2361         int posInT19(const TSet set,const int length,LObject &p);
2362         if ((h!=NULL) && (h->Typ()==STRING_CMD))
2363         {
2364           const char *s=(const char *)h->Data();
2365           if (strcmp(s,"posInT_EcartFDegpLength")==0)
2366             test_PosInT=posInT_EcartFDegpLength;
2367           else if (strcmp(s,"posInT_FDegpLength")==0)
2368             test_PosInT=posInT_FDegpLength;
2369           else if (strcmp(s,"posInT_pLength")==0)
2370             test_PosInT=posInT_pLength;
2371           else if (strcmp(s,"posInT0")==0)
2372             test_PosInT=posInT0;
2373           else if (strcmp(s,"posInT1")==0)
2374             test_PosInT=posInT1;
2375           else if (strcmp(s,"posInT2")==0)
2376             test_PosInT=posInT2;
2377           else if (strcmp(s,"posInT11")==0)
2378             test_PosInT=posInT11;
2379           else if (strcmp(s,"posInT110")==0)
2380             test_PosInT=posInT110;
2381           else if (strcmp(s,"posInT13")==0)
2382             test_PosInT=posInT13;
2383           else if (strcmp(s,"posInT15")==0)
2384             test_PosInT=posInT15;
2385           else if (strcmp(s,"posInT17")==0)
2386             test_PosInT=posInT17;
2387           else if (strcmp(s,"posInT17_c")==0)
2388             test_PosInT=posInT17_c;
2389           else if (strcmp(s,"posInT19")==0)
2390             test_PosInT=posInT19;
2391           else Print("valid posInT:0,1,2,11,110,13,15,17,17_c,19,_EcartFDegpLength,_FDegpLength,_pLength,_EcartpLength\n");
2392         }
2393         else
2394         {
2395           test_PosInT=NULL;
2396           test_PosInL=NULL;
2397         }
2398         si_opt_2|=Sy_bit(23);
2399         return FALSE;
2400      }
2401      else
2402  /*==================== locNF ======================================*/
2403      if(strcmp(sys_cmd,"locNF")==0)
2404      {
2405        if (h != NULL && h->Typ() == VECTOR_CMD)
2406        {
2407          poly f=(poly)h->Data();
2408          h=h->next;
2409          if (h != NULL && h->Typ() == MODUL_CMD)
2410          {
2411            ideal m=(ideal)h->Data();
2412            assumeStdFlag(h);
2413            h=h->next;
2414            if (h != NULL && h->Typ() == INT_CMD)
2415            {
2416              int n=(int)((long)h->Data());
2417              h=h->next;
2418              if (h != NULL && h->Typ() == INTVEC_CMD)
2419              {
2420                intvec *v=(intvec *)h->Data();
2421
2422                /* == now the work starts == */
2423
2424                short * iv=iv2array(v, currRing);
2425                poly r=0;
2426                poly hp=ppJetW(f,n,iv);
2427                int s=MATCOLS(m);
2428                int j=0;
2429                matrix T=mp_InitI(s,1,0, currRing);
2430
2431                while (hp != NULL)
2432                {
2433                  if (pDivisibleBy(m->m[j],hp))
2434                    {
2435                      if (MATELEM(T,j+1,1)==0)
2436                      {
2437                        MATELEM(T,j+1,1)=pDivideM(pHead(hp),pHead(m->m[j]));
2438                      }
2439                      else
2440                      {
2441                        pAdd(MATELEM(T,j+1,1),pDivideM(pHead(hp),pHead(m->m[j])));
2442                      }
2443                      hp=ppJetW(ksOldSpolyRed(m->m[j],hp,0),n,iv);
2444                      j=0;
2445                    }
2446                  else
2447                  {
2448                    if (j==s-1)
2449                    {
2450                      r=pAdd(r,pHead(hp));
2451                      hp=pLmDeleteAndNext(hp); /* hp=pSub(hp,pHead(hp));*/
2452                      j=0;
2453                    }
2454                    else
2455                    {
2456                      j++;
2457                    }
2458                  }
2459                }
2460
2461                matrix Temp=mp_Transp((matrix) id_Vec2Ideal(r, currRing), currRing);
2462                matrix R=mpNew(MATCOLS((matrix) id_Vec2Ideal(f, currRing)),1);
2463                for (int k=1;k<=MATROWS(Temp);k++)
2464                {
2465                  MATELEM(R,k,1)=MATELEM(Temp,k,1);
2466                }
2467
2468                lists L=(lists)omAllocBin(slists_bin);
2469                L->Init(2);
2470                L->m[0].rtyp=MATRIX_CMD;   L->m[0].data=(void *)R;
2471                L->m[1].rtyp=MATRIX_CMD;   L->m[1].data=(void *)T;
2472                res->data=L;
2473                res->rtyp=LIST_CMD;
2474                // iv aufraeumen
2475                omFree(iv);
2476              }
2477              else
2478              {
2479                Warn ("4th argument: must be an intvec!");
2480              }
2481            }
2482            else
2483            {
2484              Warn("3rd argument must be an int!!");
2485            }
2486          }
2487          else
2488          {
2489            Warn("2nd argument must be a module!");
2490          }
2491        }
2492        else
2493        {
2494          Warn("1st argument must be a vector!");
2495        }
2496        return FALSE;
2497      }
2498      else
2499  /*==================== poly debug ==================================*/
2500        if(strcmp(sys_cmd,"p")==0)
2501        {
2502#  ifdef RDEBUG
2503          p_DebugPrint((poly)h->Data(), currRing);
2504#  else
2505          Warn("Sorry: not available for release build!");
2506#  endif
2507          return FALSE;
2508        }
2509        else
2510  /*==================== ring debug ==================================*/
2511        if(strcmp(sys_cmd,"r")==0)
2512        {
2513#  ifdef RDEBUG
2514          rDebugPrint((ring)h->Data());
2515#  else
2516          Warn("Sorry: not available for release build!");
2517#  endif
2518          return FALSE;
2519        }
2520        else
2521  /*==================== changeRing ========================*/
2522        /* The following code changes the names of the variables in the
2523           current ring to "x1", "x2", ..., "xN", where N is the number
2524           of variables in the current ring.
2525           The purpose of this rewriting is to eliminate indexed variables,
2526           as they may cause problems when generating scripts for Magma,
2527           Maple, or Macaulay2. */
2528        if(strcmp(sys_cmd,"changeRing")==0)
2529        {
2530          int varN = currRing->N;
2531          char h[10];
2532          for (int i = 1; i <= varN; i++)
2533          {
2534            omFree(currRing->names[i - 1]);
2535            sprintf(h, "x%d", i);
2536            currRing->names[i - 1] = omStrDup(h);
2537          }
2538          rComplete(currRing);
2539          res->rtyp = INT_CMD;
2540          res->data = 0;
2541          return FALSE;
2542        }
2543        else
2544  /*==================== mtrack ==================================*/
2545      if(strcmp(sys_cmd,"mtrack")==0)
2546      {
2547  #ifdef OM_TRACK
2548        om_Opts.MarkAsStatic = 1;
2549        FILE *fd = NULL;
2550        int max = 5;
2551        while (h != NULL)
2552        {
2553          omMarkAsStaticAddr(h);
2554          if (fd == NULL && h->Typ()==STRING_CMD)
2555          {
2556            fd = fopen((char*) h->Data(), "w");
2557            if (fd == NULL)
2558              Warn("Can not open %s for writing og mtrack. Using stdout"); // %s  ???
2559          }
2560          if (h->Typ() == INT_CMD)
2561          {
2562            max = (int)(long)h->Data();
2563          }
2564          h = h->Next();
2565        }
2566        omPrintUsedTrackAddrs((fd == NULL ? stdout : fd), max);
2567        if (fd != NULL) fclose(fd);
2568        om_Opts.MarkAsStatic = 0;
2569        return FALSE;
2570  #endif
2571      }
2572  /*==================== mtrack_all ==================================*/
2573      if(strcmp(sys_cmd,"mtrack_all")==0)
2574      {
2575  #ifdef OM_TRACK
2576        om_Opts.MarkAsStatic = 1;
2577        FILE *fd = NULL;
2578        if ((h!=NULL) &&(h->Typ()==STRING_CMD))
2579        {
2580          fd = fopen((char*) h->Data(), "w");
2581          if (fd == NULL)
2582            Warn("Can not open %s for writing og mtrack. Using stdout");
2583          omMarkAsStaticAddr(h);
2584        }
2585        // OB: TBC print to fd
2586        omPrintUsedAddrs((fd == NULL ? stdout : fd), 5);
2587        if (fd != NULL) fclose(fd);
2588        om_Opts.MarkAsStatic = 0;
2589        return FALSE;
2590  #endif
2591      }
2592      else
2593  /*==================== backtrace ==================================*/
2594  #ifndef OM_NDEBUG
2595      if(strcmp(sys_cmd,"backtrace")==0)
2596      {
2597        omPrintCurrentBackTrace(stdout);
2598        return FALSE;
2599      }
2600      else
2601  #endif
2602
2603#if !defined(OM_NDEBUG)
2604  /*==================== omMemoryTest ==================================*/
2605      if (strcmp(sys_cmd,"omMemoryTest")==0)
2606      {
2607
2608#ifdef OM_STATS_H
2609        PrintS("\n[om_Info]: \n");
2610        omUpdateInfo();
2611#define OM_PRINT(name) Print(" %-22s : %10ld \n", #name, om_Info . name)
2612        OM_PRINT(MaxBytesSystem);
2613        OM_PRINT(CurrentBytesSystem);
2614        OM_PRINT(MaxBytesSbrk);
2615        OM_PRINT(CurrentBytesSbrk);
2616        OM_PRINT(MaxBytesMmap);
2617        OM_PRINT(CurrentBytesMmap);
2618        OM_PRINT(UsedBytes);
2619        OM_PRINT(AvailBytes);
2620        OM_PRINT(UsedBytesMalloc);
2621        OM_PRINT(AvailBytesMalloc);
2622        OM_PRINT(MaxBytesFromMalloc);
2623        OM_PRINT(CurrentBytesFromMalloc);
2624        OM_PRINT(MaxBytesFromValloc);
2625        OM_PRINT(CurrentBytesFromValloc);
2626        OM_PRINT(UsedBytesFromValloc);
2627        OM_PRINT(AvailBytesFromValloc);
2628        OM_PRINT(MaxPages);
2629        OM_PRINT(UsedPages);
2630        OM_PRINT(AvailPages);
2631        OM_PRINT(MaxRegionsAlloc);
2632        OM_PRINT(CurrentRegionsAlloc);
2633#undef OM_PRINT
2634#endif
2635
2636#ifdef OM_OPTS_H
2637        PrintS("\n[om_Opts]: \n");
2638#define OM_PRINT(format, name) Print(" %-22s : %10" format"\n", #name, om_Opts . name)
2639        OM_PRINT("d", MinTrack);
2640        OM_PRINT("d", MinCheck);
2641        OM_PRINT("d", MaxTrack);
2642        OM_PRINT("d", MaxCheck);
2643        OM_PRINT("d", Keep);
2644        OM_PRINT("d", HowToReportErrors);
2645        OM_PRINT("d", MarkAsStatic);
2646        OM_PRINT("u", PagesPerRegion);
2647        OM_PRINT("p", OutOfMemoryFunc);
2648        OM_PRINT("p", MemoryLowFunc);
2649        OM_PRINT("p", ErrorHook);
2650#undef OM_PRINT
2651#endif
2652
2653#ifdef OM_ERROR_H
2654        Print("\n\n[om_ErrorStatus]        : '%s' (%s)\n",
2655                omError2String(om_ErrorStatus),
2656                omError2Serror(om_ErrorStatus));
2657        Print("[om_InternalErrorStatus]: '%s' (%s)\n",
2658                omError2String(om_InternalErrorStatus),
2659                omError2Serror(om_InternalErrorStatus));
2660
2661#endif
2662
2663//        omTestMemory(1);
2664//        omtTestErrors();
2665        return FALSE;
2666      }
2667      else
2668#endif
2669  /*==================== naIdeal ==================================*/
2670//       // This seems to be obsolette with the new Frank's alg.ext field...
2671//       if(strcmp(sys_cmd,"naIdeal")==0)
2672//       {
2673//         if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2674//         {
2675//           naSetIdeal((ideal)h->Data());
2676//           return FALSE;
2677//         }
2678//         else
2679//            WerrorS("ideal expected");
2680//       }
2681//       else
2682  /*==================== isSqrFree =============================*/
2683  #ifdef HAVE_FACTORY
2684      if(strcmp(sys_cmd,"isSqrFree")==0)
2685      {
2686        if ((h!=NULL) &&(h->Typ()==POLY_CMD))
2687        {
2688          res->rtyp=INT_CMD;
2689          res->data=(void *)(long) singclap_isSqrFree((poly)h->Data(), currRing);
2690          return FALSE;
2691        }
2692        else
2693          WerrorS("poly expected");
2694      }
2695      else
2696  #endif
2697  /*==================== pDivStat =============================*/
2698  #if defined(PDEBUG) || defined(PDIV_DEBUG)
2699      if(strcmp(sys_cmd,"pDivStat")==0)
2700      {
2701        extern void pPrintDivisbleByStat();
2702        pPrintDivisbleByStat();
2703        return FALSE;
2704      }
2705      else
2706  #endif
2707  /*==================== alarm ==================================*/
2708  #ifdef unix
2709      if(strcmp(sys_cmd,"alarm")==0)
2710      {
2711        if ((h!=NULL) &&(h->Typ()==INT_CMD))
2712        {
2713          // standard variant -> SIGALARM (standard: abort)
2714          //alarm((unsigned)h->next->Data());
2715          // process time (user +system): SIGVTALARM
2716          struct itimerval t,o;
2717          memset(&t,0,sizeof(t));
2718          t.it_value.tv_sec     =(unsigned)((unsigned long)h->Data());
2719          setitimer(ITIMER_VIRTUAL,&t,&o);
2720          return FALSE;
2721        }
2722        else
2723          WerrorS("int expected");
2724      }
2725      else
2726  #endif
2727  /*==================== red =============================*/
2728  #if 0
2729      if(strcmp(sys_cmd,"red")==0)
2730      {
2731        if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2732        {
2733          res->rtyp=IDEAL_CMD;
2734          res->data=(void *)kStdred((ideal)h->Data(),NULL,testHomog,NULL);
2735          setFlag(res,FLAG_STD);
2736          return FALSE;
2737        }
2738        else
2739          WerrorS("ideal expected");
2740      }
2741      else
2742  #endif
2743  #ifdef HAVE_FACTORY
2744  /*==================== fastcomb =============================*/
2745      if(strcmp(sys_cmd,"fastcomb")==0)
2746      {
2747        if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2748        {
2749          if (h->next!=NULL)
2750          {
2751            if (h->next->Typ()!=POLY_CMD)
2752            {
2753              Warn("Wrong types for poly= comb(ideal,poly)");
2754            }
2755          }
2756          res->rtyp=POLY_CMD;
2757          res->data=(void *) fglmLinearCombination(
2758                             (ideal)h->Data(),(poly)h->next->Data());
2759          return FALSE;
2760        }
2761        else
2762          WerrorS("ideal expected");
2763      }
2764      else
2765  /*==================== comb =============================*/
2766      if(strcmp(sys_cmd,"comb")==0)
2767      {
2768        if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2769        {
2770          if (h->next!=NULL)
2771          {
2772            if (h->next->Typ()!=POLY_CMD)
2773            {
2774                Warn("Wrong types for poly= comb(ideal,poly)");
2775            }
2776          }
2777          res->rtyp=POLY_CMD;
2778          res->data=(void *)fglmNewLinearCombination(
2779                              (ideal)h->Data(),(poly)h->next->Data());
2780          return FALSE;
2781        }
2782        else
2783          WerrorS("ideal expected");
2784      }
2785      else
2786  #endif
2787  #if 0 /* debug only */
2788  /*==================== listall ===================================*/
2789      if(strcmp(sys_cmd,"listall")==0)
2790      {
2791        void listall(int showproc);
2792        int showproc=0;
2793        if ((h!=NULL) && (h->Typ()==INT_CMD)) showproc=(int)((long)h->Data());
2794        listall(showproc);
2795        return FALSE;
2796      }
2797      else
2798  #endif
2799  #if 0 /* debug only */
2800  /*==================== proclist =================================*/
2801      if(strcmp(sys_cmd,"proclist")==0)
2802      {
2803        void piShowProcList();
2804        piShowProcList();
2805        return FALSE;
2806      }
2807      else
2808  #endif
2809  /* ==================== newton ================================*/
2810  #ifdef HAVE_NEWTON
2811      if(strcmp(sys_cmd,"newton")==0)
2812      {
2813        if ((h->Typ()!=POLY_CMD)
2814        || (h->next->Typ()!=INT_CMD)
2815        || (h->next->next->Typ()!=INT_CMD))
2816        {
2817          WerrorS("system(\"newton\",<poly>,<int>,<int>) expected");
2818          return TRUE;
2819        }
2820        poly  p=(poly)(h->Data());
2821        int l=pLength(p);
2822        short *points=(short *)omAlloc(currRing->N*l*sizeof(short));
2823        int i,j,k;
2824        k=0;
2825        poly pp=p;
2826        for (i=0;pp!=NULL;i++)
2827        {
2828          for(j=1;j<=currRing->N;j++)
2829          {
2830            points[k]=pGetExp(pp,j);
2831            k++;
2832          }
2833          pIter(pp);
2834        }
2835        hc_ERG r=hc_KOENIG(currRing->N,      // dimension
2836                  l,      // number of points
2837                  (short*) points,   // points: x_1, y_1,z_1, x_2,y_2,z2,...
2838                  currRing->OrdSgn==-1,
2839                  (int) (h->next->Data()),      // 1: Milnor, 0: Newton
2840                  (int) (h->next->next->Data()) // debug
2841                 );
2842        //----<>---Output-----------------------
2843
2844
2845  //  PrintS("Bin jetzt in extra.cc bei der Auswertung.\n"); // **********
2846
2847
2848        lists L=(lists)omAllocBin(slists_bin);
2849        L->Init(6);
2850        L->m[0].rtyp=STRING_CMD;               // newtonnumber;
2851        L->m[0].data=(void *)omStrDup(r.nZahl);
2852        L->m[1].rtyp=INT_CMD;
2853        L->m[1].data=(void *)r.achse;          // flag for unoccupied axes
2854        L->m[2].rtyp=INT_CMD;
2855        L->m[2].data=(void *)r.deg;            // #degenerations
2856        if ( r.deg != 0)              // only if degenerations exist
2857        {
2858          L->m[3].rtyp=INT_CMD;
2859          L->m[3].data=(void *)r.anz_punkte;     // #points
2860          //---<>--number of points------
2861          int anz = r.anz_punkte;    // number of points
2862          int dim = (currRing->N);     // dimension
2863          intvec* v = new intvec( anz*dim );
2864          for (i=0; i<anz*dim; i++)    // copy points
2865            (*v)[i] = r.pu[i];
2866          L->m[4].rtyp=INTVEC_CMD;
2867          L->m[4].data=(void *)v;
2868          //---<>--degenerations---------
2869          int deg = r.deg;    // number of points
2870          intvec* w = new intvec( r.speicher );  // necessary memeory
2871          i=0;               // start copying
2872          do
2873          {
2874            (*w)[i] = r.deg_tab[i];
2875            i++;
2876          }
2877          while (r.deg_tab[i-1] != -2);   // mark for end of list
2878          L->m[5].rtyp=INTVEC_CMD;
2879          L->m[5].data=(void *)w;
2880        }
2881        else
2882        {
2883          L->m[3].rtyp=INT_CMD; L->m[3].data=(char *)0;
2884          L->m[4].rtyp=DEF_CMD;
2885          L->m[5].rtyp=DEF_CMD;
2886        }
2887
2888        res->data=(void *)L;
2889        res->rtyp=LIST_CMD;
2890        // free all pointer in r:
2891        delete[] r.nZahl;
2892        delete[] r.pu;
2893        delete[] r.deg_tab;      // Ist das ein Problem??
2894
2895        omFreeSize((ADDRESS)points,currRing->N*l*sizeof(short));
2896        return FALSE;
2897      }
2898      else
2899  #endif
2900  /*==== connection to Sebastian Jambor's code ======*/
2901  /* This code connects Sebastian Jambor's code for
2902     computing the minimal polynomial of an (n x n) matrix
2903     with entries in F_p to SINGULAR. Two conversion methods
2904     are needed; see further up in this file:
2905        (1) conversion of a matrix with long entries to
2906            a SINGULAR matrix with number entries, where
2907            the numbers are coefficients in currRing;
2908        (2) conversion of an array of longs (encoding the
2909            coefficients of the minimal polynomial) to a
2910            SINGULAR poly living in currRing. */
2911      if (strcmp(sys_cmd, "minpoly") == 0)
2912      {
2913        if ((h == NULL) || (h->Typ() != MATRIX_CMD) || h->next != NULL)
2914        {
2915          Werror("expected exactly one argument: %s",
2916                 "a square matrix with number entries");
2917          return TRUE;
2918        }
2919        else
2920        {
2921          matrix m = (matrix)h->Data();
2922          int n = m->rows();
2923          unsigned long p = (unsigned long)n_GetChar(currRing->cf);
2924          if (n != m->cols())
2925          {
2926            Werror("expected exactly one argument: %s",
2927                   "a square matrix with number entries");
2928            return TRUE;
2929          }
2930          unsigned long** ml = singularMatrixToLongMatrix(m);
2931          unsigned long* polyCoeffs = computeMinimalPolynomial(ml, n, p);
2932          poly theMinPoly = longCoeffsToSingularPoly(polyCoeffs, n);
2933          res->rtyp = POLY_CMD;
2934          res->data = (void *)theMinPoly;
2935          for (int i = 0; i < n; i++) delete[] ml[i];
2936          delete[] ml;
2937          delete[] polyCoeffs;
2938          return FALSE;
2939        }
2940      }
2941      else
2942  /*==================== sdb_flags =================*/
2943  #ifdef HAVE_SDB
2944      if (strcmp(sys_cmd, "sdb_flags") == 0)
2945      {
2946        if ((h!=NULL) && (h->Typ()==INT_CMD))
2947        {
2948          sdb_flags=(int)((long)h->Data());
2949        }
2950        else
2951        {
2952          WerrorS("system(\"sdb_flags\",`int`) expected");
2953          return TRUE;
2954        }
2955        return FALSE;
2956      }
2957      else
2958  #endif
2959  /*==================== sdb_edit =================*/
2960  #ifdef HAVE_SDB
2961      if (strcmp(sys_cmd, "sdb_edit") == 0)
2962      {
2963        if ((h!=NULL) && (h->Typ()==PROC_CMD))
2964        {
2965          procinfov p=(procinfov)h->Data();
2966          sdb_edit(p);
2967        }
2968        else
2969        {
2970          WerrorS("system(\"sdb_edit\",`proc`) expected");
2971          return TRUE;
2972        }
2973        return FALSE;
2974      }
2975      else
2976  #endif
2977  /*==================== GF =================*/
2978  #if 0 // for testing only
2979      if (strcmp(sys_cmd, "GF") == 0)
2980      {
2981        if ((h!=NULL) && (h->Typ()==POLY_CMD))
2982        {
2983          int c=rChar(currRing);
2984          setCharacteristic( c,nfMinPoly[0], currRing->parameter[0][0] );
2985          CanonicalForm F( convSingGFFactoryGF( (poly)h->Data(), currRing ) );
2986          res->rtyp=POLY_CMD;
2987          res->data=convFactoryGFSingGF( F, currRing );
2988          return FALSE;
2989        }
2990        else { Werror("wrong typ"); return TRUE;}
2991      }
2992      else
2993  #endif
2994  /*==================== stdX =================*/
2995      if (strcmp(sys_cmd, "std") == 0)
2996      {
2997        ideal i1;
2998        int i2;
2999        if ((h!=NULL) && (h->Typ()==MODUL_CMD))
3000        {
3001          i1=(ideal)h->CopyD();
3002          h=h->next;
3003        }
3004        else return TRUE;
3005        if ((h!=NULL) && (h->Typ()==INT_CMD))
3006        {
3007          i2=(int)((long)h->Data());
3008        }
3009        else return TRUE;
3010        res->rtyp=MODUL_CMD;
3011        res->data=idXXX(i1,i2);
3012        return FALSE;
3013      }
3014      else
3015  /*==================== SVD =================*/
3016  #ifdef HAVE_SVD
3017       if (strcmp(sys_cmd, "svd") == 0)
3018       {
3019            extern lists testsvd(matrix M);
3020              res->rtyp=LIST_CMD;
3021            res->data=(char*)(testsvd((matrix)h->Data()));
3022            return FALSE;
3023       }
3024       else
3025  #endif
3026
3027  /*==== countedref: reference and shared ====*/
3028       if (strcmp(sys_cmd, "shared") == 0)
3029       {
3030       #ifndef SI_COUNTEDREF_AUTOLOAD
3031         void countedref_shared_load();
3032         countedref_shared_load();
3033       #endif
3034         res->rtyp = NONE;
3035         return FALSE;
3036       }
3037       else if (strcmp(sys_cmd, "reference") == 0)
3038       {
3039       #ifndef SI_COUNTEDREF_AUTOLOAD
3040         void countedref_reference_load();
3041         countedref_reference_load();
3042       #endif
3043         res->rtyp = NONE;
3044         return FALSE;
3045       }
3046       else
3047
3048  /*==================== DLL =================*/
3049  #ifdef ix86_Win
3050  #ifdef HAVE_DL
3051  /* testing the DLL functionality under Win32 */
3052        if (strcmp(sys_cmd, "DLL") == 0)
3053        {
3054          typedef void  (*Void_Func)();
3055          typedef int  (*Int_Func)(int);
3056          void *hh=dynl_open("WinDllTest.dll");
3057          if ((h!=NULL) && (h->Typ()==INT_CMD))
3058          {
3059            int (*f)(int);
3060            if (hh!=NULL)
3061            {
3062              int (*f)(int);
3063              f=(Int_Func)dynl_sym(hh,"PlusDll");
3064              int i=10;
3065              if (f!=NULL) printf("%d\n",f(i));
3066              else PrintS("cannot find PlusDll\n");
3067            }
3068          }
3069          else
3070          {
3071            void (*f)();
3072            f= (Void_Func)dynl_sym(hh,"TestDll");
3073            if (f!=NULL) f();
3074            else PrintS("cannot find TestDll\n");
3075          }
3076          return FALSE;
3077        }
3078        else
3079  #endif
3080  #endif
3081  /*==================== eigenvalues ==================================*/
3082  #ifdef HAVE_EIGENVAL
3083      if(strcmp(sys_cmd,"eigenvals")==0)
3084      {
3085        return evEigenvals(res,h);
3086      }
3087      else
3088  #endif
3089  /*==================== Gauss-Manin system ==================================*/
3090  #ifdef HAVE_GMS
3091      if(strcmp(sys_cmd,"gmsnf")==0)
3092      {
3093        return gmsNF(res,h);
3094      }
3095      else
3096  #endif
3097  /*==================== facstd_debug ==================================*/
3098  #if !defined(NDEBUG)
3099      if(strcmp(sys_cmd,"facstd")==0)
3100      {
3101        extern int strat_nr;
3102        extern int strat_fac_debug;
3103        strat_fac_debug=(int)(long)h->Data();
3104        strat_nr=0;
3105        return FALSE;
3106      }
3107      else
3108  #endif
3109  #ifdef HAVE_RING2TOM
3110  /*==================== ring-GB ==================================*/
3111      if (strcmp(sys_cmd, "findZeroPoly")==0)
3112      {
3113        ring r = currRing;
3114        poly f = (poly) h->Data();
3115        res->rtyp=POLY_CMD;
3116        res->data=(poly) kFindZeroPoly(f, r, r);
3117        return(FALSE);
3118      }
3119      else
3120  /*==================== Creating zero polynomials =================*/
3121  #ifdef HAVE_VANIDEAL
3122      if (strcmp(sys_cmd, "createG0")==0)
3123      {
3124        /* long exp[50];
3125        int N = 0;
3126        while (h != NULL)
3127        {
3128          N += 1;
3129          exp[N] = (long) h->Data();
3130          // if (exp[i] % 2 != 0) exp[i] -= 1;
3131          h = h->next;
3132        }
3133        for (int k = 1; N + k <= currRing->N; k++) exp[k] = 0;
3134
3135        poly t_p;
3136        res->rtyp=POLY_CMD;
3137        res->data= (poly) kCreateZeroPoly(exp, -1, &t_p, currRing, currRing);
3138        return(FALSE); */
3139
3140        res->rtyp = IDEAL_CMD;
3141        res->data = (ideal) createG0();
3142        return(FALSE);
3143      }
3144      else
3145  #endif
3146  /*==================== redNF_ring =================*/
3147      if (strcmp(sys_cmd, "redNF_ring")==0)
3148      {
3149        ring r = currRing;
3150        poly f = (poly) h->Data();
3151        h = h->next;
3152        ideal G = (ideal) h->Data();
3153        res->rtyp=POLY_CMD;
3154        res->data=(poly) ringRedNF(f, G, r);
3155        return(FALSE);
3156      }
3157      else
3158  #endif
3159  /*==================== minor =================*/
3160      if (strcmp(sys_cmd, "minor")==0)
3161      {
3162        matrix a = (matrix) h->Data();
3163        h = h->next;
3164        int ar = (int)(long) h->Data();
3165        h = h->next;
3166        int which = (int)(long) h->Data();
3167        h = h->next;
3168        ideal R = NULL;
3169        if (h != NULL)
3170        {
3171          R = (ideal) h->Data();
3172        }
3173        res->data=(poly) idMinor(a, ar, (unsigned long) which, R);
3174        if (res->data == (poly) 1)
3175        {
3176          res->rtyp=INT_CMD;
3177          res->data = 0;
3178        }
3179        else
3180        {
3181          res->rtyp=POLY_CMD;
3182        }
3183        return(FALSE);
3184      }
3185      else
3186  /*==================== F5 Implementation =================*/
3187  #ifdef HAVE_F5
3188      if (strcmp(sys_cmd, "f5")==0)
3189      {
3190        if (h->Typ()!=IDEAL_CMD)
3191        {
3192          WerrorS("ideal expected");
3193          return TRUE;
3194        }
3195
3196        ring r = currRing;
3197        ideal G = (ideal) h->Data();
3198        h = h->next;
3199        int opt;
3200        if(h != NULL) {
3201          opt = (int) (long) h->Data();
3202        }
3203        else {
3204          opt = 2;
3205        }
3206        h = h->next;
3207        int plus;
3208        if(h != NULL) {
3209          plus = (int) (long) h->Data();
3210        }
3211        else {
3212          plus = 0;
3213        }
3214        h = h->next;
3215        int termination;
3216        if(h != NULL) {
3217          termination = (int) (long) h->Data();
3218        }
3219        else {
3220          termination = 0;
3221        }
3222        res->rtyp=IDEAL_CMD;
3223        res->data=(ideal) F5main(G,r,opt,plus,termination);
3224        return FALSE;
3225      }
3226      else
3227  #endif
3228  /*==================== Testing groebner basis =================*/
3229  #ifdef HAVE_RINGS
3230      if (strcmp(sys_cmd, "NF_ring")==0)
3231      {
3232        ring r = currRing;
3233        poly f = (poly) h->Data();
3234        h = h->next;
3235        ideal G = (ideal) h->Data();
3236        res->rtyp=POLY_CMD;
3237        res->data=(poly) ringNF(f, G, r);
3238        return(FALSE);
3239      }
3240      else
3241      if (strcmp(sys_cmd, "spoly")==0)
3242      {
3243        poly f = pCopy((poly) h->Data());
3244        h = h->next;
3245        poly g = pCopy((poly) h->Data());
3246
3247        res->rtyp=POLY_CMD;
3248        res->data=(poly) plain_spoly(f,g);
3249        return(FALSE);
3250      }
3251      else
3252      if (strcmp(sys_cmd, "testGB")==0)
3253      {
3254        ideal I = (ideal) h->Data();
3255        h = h->next;
3256        ideal GI = (ideal) h->Data();
3257        res->rtyp = INT_CMD;
3258        res->data = (void *) testGB(I, GI);
3259        return(FALSE);
3260      }
3261      else
3262  #endif
3263  /*==================== sca?AltVar ==================================*/
3264  #ifdef HAVE_PLURAL
3265      if ( (strcmp(sys_cmd, "AltVarStart") == 0) || (strcmp(sys_cmd, "AltVarEnd") == 0) )
3266      {
3267        ring r = currRing;
3268
3269        if((h!=NULL) && (h->Typ()==RING_CMD)) r = (ring)h->Data(); else
3270        {
3271          WerrorS("`system(\"AltVarStart/End\"[,<ring>])` expected");
3272          return TRUE;
3273        }
3274
3275        res->rtyp=INT_CMD;
3276
3277        if (rIsSCA(r))
3278        {
3279          if(strcmp(sys_cmd, "AltVarStart") == 0)
3280            res->data = (void*)(long)scaFirstAltVar(r);
3281          else
3282            res->data = (void*)(long)scaLastAltVar(r);
3283          return FALSE;
3284        }
3285
3286        WerrorS("`system(\"AltVarStart/End\",<ring>) requires a SCA ring");
3287        return TRUE;
3288      }
3289      else
3290  #endif
3291  /*==================== RatNF, noncomm rational coeffs =================*/
3292  #ifdef HAVE_PLURAL
3293  #ifdef HAVE_RATGRING
3294      if (strcmp(sys_cmd, "intratNF") == 0)
3295      {
3296        poly p;
3297        poly *q;
3298        ideal I;
3299        int is, k, id;
3300        if ((h!=NULL) && (h->Typ()==POLY_CMD))
3301        {
3302          p=(poly)h->CopyD();
3303          h=h->next;
3304          //        Print("poly is done\n");
3305        }
3306        else return TRUE;
3307        if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
3308        {
3309          I=(ideal)h->CopyD();
3310          q = I->m;
3311          h=h->next;
3312          //        Print("ideal is done\n");
3313        }
3314        else return TRUE;
3315        if ((h!=NULL) && (h->Typ()==INT_CMD))
3316        {
3317          is=(int)((long)(h->Data()));
3318          //        res->rtyp=INT_CMD;
3319          //        Print("int is done\n");
3320          //        res->rtyp=IDEAL_CMD;
3321          if (rIsPluralRing(currRing))
3322          {
3323            id = IDELEMS(I);
3324                   int *pl=(int*)omAlloc0(IDELEMS(I)*sizeof(int));
3325            for(k=0; k < id; k++)
3326            {
3327              pl[k] = pLength(I->m[k]);
3328            }
3329            Print("starting redRat\n");
3330            //res->data = (char *)
3331            redRat(&p, q, pl, (int)IDELEMS(I),is,currRing);
3332            res->data=p;
3333            res->rtyp=POLY_CMD;
3334            //        res->data = ncGCD(p,q,currRing);
3335          }
3336          else
3337          {
3338            res->rtyp=POLY_CMD;
3339            res->data=p;
3340          }
3341        }
3342        else return TRUE;
3343        return FALSE;
3344      }
3345      else
3346  /*==================== RatNF, noncomm rational coeffs =================*/
3347      if (strcmp(sys_cmd, "ratNF") == 0)
3348      {
3349        poly p,q;
3350        int is, htype;
3351        if ((h!=NULL) && ( (h->Typ()==POLY_CMD) || (h->Typ()==VECTOR_CMD) ) )
3352        {
3353          p=(poly)h->CopyD();
3354          h=h->next;
3355          htype = h->Typ();
3356        }
3357        else return TRUE;
3358        if ((h!=NULL) && ( (h->Typ()==POLY_CMD) || (h->Typ()==VECTOR_CMD) ) )
3359        {
3360          q=(poly)h->CopyD();
3361          h=h->next;
3362        }
3363        else return TRUE;
3364        if ((h!=NULL) && (h->Typ()==INT_CMD))
3365        {
3366          is=(int)((long)(h->Data()));
3367          res->rtyp=htype;
3368          //        res->rtyp=IDEAL_CMD;
3369          if (rIsPluralRing(currRing))
3370          {
3371            res->data = nc_rat_ReduceSpolyNew(q,p,is, currRing);
3372            //        res->data = ncGCD(p,q,currRing);
3373          }
3374          else res->data=p;
3375        }
3376        else return TRUE;
3377        return FALSE;
3378      }
3379      else
3380  /*==================== RatSpoly, noncomm rational coeffs =================*/
3381      if (strcmp(sys_cmd, "ratSpoly") == 0)
3382      {
3383        poly p,q;
3384        int is;
3385        if ((h!=NULL) && (h->Typ()==POLY_CMD))
3386        {
3387          p=(poly)h->CopyD();
3388          h=h->next;
3389        }
3390        else return TRUE;
3391        if ((h!=NULL) && (h->Typ()==POLY_CMD))
3392        {
3393          q=(poly)h->CopyD();
3394          h=h->next;
3395        }
3396        else return TRUE;
3397        if ((h!=NULL) && (h->Typ()==INT_CMD))
3398        {
3399          is=(int)((long)(h->Data()));
3400          res->rtyp=POLY_CMD;
3401          //        res->rtyp=IDEAL_CMD;
3402          if (rIsPluralRing(currRing))
3403          {
3404            res->data = nc_rat_CreateSpoly(p,q,is,currRing);
3405            //        res->data = ncGCD(p,q,currRing);
3406          }
3407          else res->data=p;
3408        }
3409        else return TRUE;
3410        return FALSE;
3411      }
3412      else
3413  #endif // HAVE_RATGRING
3414  /*==================== Rat def =================*/
3415      if (strcmp(sys_cmd, "ratVar") == 0)
3416      {
3417        int start,end;
3418        if ((h!=NULL) && (h->Typ()==POLY_CMD))
3419        {
3420          start=pIsPurePower((poly)h->Data());
3421          h=h->next;
3422        }
3423        else return TRUE;
3424        if ((h!=NULL) && (h->Typ()==POLY_CMD))
3425        {
3426          end=pIsPurePower((poly)h->Data());
3427          h=h->next;
3428        }
3429        else return TRUE;
3430        currRing->real_var_start=start;
3431        currRing->real_var_end=end;
3432        return (start==0)||(end==0)||(start>end);
3433      }
3434      else
3435  /*==================== shift-test for freeGB  =================*/
3436  #ifdef HAVE_SHIFTBBA
3437      if (strcmp(sys_cmd, "stest") == 0)
3438      {
3439        poly p;
3440        int sh,uptodeg, lVblock;
3441        if ((h!=NULL) && (h->Typ()==POLY_CMD))
3442        {
3443          p=(poly)h->CopyD();
3444          h=h->next;
3445        }
3446        else return TRUE;
3447        if ((h!=NULL) && (h->Typ()==INT_CMD))
3448        {
3449          sh=(int)((long)(h->Data()));
3450          h=h->next;
3451        }
3452        else return TRUE;
3453
3454        if ((h!=NULL) && (h->Typ()==INT_CMD))
3455        {
3456          uptodeg=(int)((long)(h->Data()));
3457          h=h->next;
3458        }
3459        else return TRUE;
3460        if ((h!=NULL) && (h->Typ()==INT_CMD))
3461        {
3462          lVblock=(int)((long)(h->Data()));
3463          res->data = pLPshift(p,sh,uptodeg,lVblock);
3464          res->rtyp = POLY_CMD;
3465        }
3466        else return TRUE;
3467        return FALSE;
3468      }
3469      else
3470  #endif
3471  /*==================== block-test for freeGB  =================*/
3472  #ifdef HAVE_SHIFTBBA
3473      if (strcmp(sys_cmd, "btest") == 0)
3474      {
3475        poly p;
3476        int lV;
3477        if ((h!=NULL) && (h->Typ()==POLY_CMD))
3478        {
3479          p=(poly)h->CopyD();
3480          h=h->next;
3481        }
3482        else return TRUE;
3483        if ((h!=NULL) && (h->Typ()==INT_CMD))
3484        {
3485          lV=(int)((long)(h->Data()));
3486          res->rtyp = INT_CMD;
3487          res->data = (void*)pLastVblock(p, lV);
3488        }
3489        else return TRUE;
3490        return FALSE;
3491      }
3492      else
3493  /*==================== shrink-test for freeGB  =================*/
3494      if (strcmp(sys_cmd, "shrinktest") == 0)
3495      {
3496        poly p;
3497        int lV;
3498        if ((h!=NULL) && (h->Typ()==POLY_CMD))
3499        {
3500          p=(poly)h->CopyD();
3501          h=h->next;
3502        }
3503        else return TRUE;
3504        if ((h!=NULL) && (h->Typ()==INT_CMD))
3505        {
3506          lV=(int)((long)(h->Data()));
3507          res->rtyp = POLY_CMD;
3508          //        res->data = p_mShrink(p, lV, currRing);
3509          //        kStrategy strat=new skStrategy;
3510          //        strat->tailRing = currRing;
3511          res->data = p_Shrink(p, lV, currRing);
3512        }
3513        else return TRUE;
3514        return FALSE;
3515      }
3516      else
3517  #endif
3518  #endif
3519  /*==================== t-rep-GB ==================================*/
3520      if (strcmp(sys_cmd, "unifastmult")==0)
3521      {
3522        poly f = (poly)h->Data();
3523        h=h->next;
3524        poly g=(poly)h->Data();
3525        res->rtyp=POLY_CMD;
3526        res->data=unifastmult(f,g,currRing);
3527        return(FALSE);
3528      }
3529      else
3530      if (strcmp(sys_cmd, "multifastmult")==0)
3531      {
3532        poly f = (poly)h->Data();
3533        h=h->next;
3534        poly g=(poly)h->Data();
3535        res->rtyp=POLY_CMD;
3536        res->data=multifastmult(f,g,currRing);
3537        return(FALSE);
3538      }
3539      else
3540      if (strcmp(sys_cmd, "mults")==0)
3541      {
3542        res->rtyp=INT_CMD ;
3543        res->data=(void*)(long) Mults();
3544        return(FALSE);
3545      }
3546      else
3547      if (strcmp(sys_cmd, "fastpower")==0)
3548      {
3549        ring r = currRing;
3550        poly f = (poly)h->Data();
3551        h=h->next;
3552        int n=(int)((long)h->Data());
3553        res->rtyp=POLY_CMD ;
3554        res->data=(void*) pFastPower(f,n,r);
3555        return(FALSE);
3556      }
3557      else
3558      if (strcmp(sys_cmd, "normalpower")==0)
3559      {
3560        poly f = (poly)h->Data();
3561        h=h->next;
3562        int n=(int)((long)h->Data());
3563        res->rtyp=POLY_CMD ;
3564        res->data=(void*) pPower(pCopy(f),n);
3565        return(FALSE);
3566      }
3567      else
3568      if (strcmp(sys_cmd, "MCpower")==0)
3569      {
3570        ring r = currRing;
3571        poly f = (poly)h->Data();
3572        h=h->next;
3573        int n=(int)((long)h->Data());
3574        res->rtyp=POLY_CMD ;
3575        res->data=(void*) pFastPowerMC(f,n,r);
3576        return(FALSE);
3577      }
3578      else
3579      if (strcmp(sys_cmd, "bit_subst")==0)
3580      {
3581        ring r = currRing;
3582        poly outer = (poly)h->Data();
3583        h=h->next;
3584        poly inner=(poly)h->Data();
3585        res->rtyp=POLY_CMD ;
3586        res->data=(void*) uni_subst_bits(outer, inner,r);
3587        return(FALSE);
3588      }
3589      else
3590  /*==================== gcd-varianten =================*/
3591  #ifdef HAVE_FACTORY
3592      if (strcmp(sys_cmd, "gcd") == 0)
3593      {
3594        if (h==NULL)
3595        {
3596#ifdef HAVE_PLURAL
3597          Print("NTL_0:%d (use NTL for gcd of polynomials in char 0)\n",isOn(SW_USE_NTL_GCD_0));
3598          Print("NTL_p:%d (use NTL for gcd of polynomials in char p)\n",isOn(SW_USE_NTL_GCD_P));
3599          Print("EZGCD:%d (use EZGCD for gcd of polynomials in char 0)\n",isOn(SW_USE_EZGCD));
3600          Print("EZGCD_P:%d (use EZGCD_P for gcd of polynomials in char p)\n",isOn(SW_USE_EZGCD_P));
3601          Print("CRGCD:%d (use chinese Remainder for gcd of polynomials in char 0)\n",isOn(SW_USE_CHINREM_GCD));
3602          Print("QGCD:%d (use QGCD for gcd of polynomials in alg. ext.)\n",isOn(SW_USE_QGCD));
3603#endif
3604          Print("homog:%d (use homog. test for factorization of polynomials)\n",singular_homog_flag);
3605          return FALSE;
3606        }
3607        else
3608        if ((h!=NULL) && (h->Typ()==STRING_CMD)
3609        && (h->next!=NULL) && (h->next->Typ()==INT_CMD))
3610        {
3611          int d=(int)(long)h->next->Data();
3612          char *s=(char *)h->Data();
3613#ifdef HAVE_PLURAL
3614          if (strcmp(s,"NTL_0")==0) { if (d) On(SW_USE_NTL_GCD_0); else Off(SW_USE_NTL_GCD_0); } else
3615          if (strcmp(s,"NTL_p")==0) { if (d) On(SW_USE_NTL_GCD_P); else Off(SW_USE_NTL_GCD_P); } else
3616          if (strcmp(s,"EZGCD")==0) { if (d) On(SW_USE_EZGCD); else Off(SW_USE_EZGCD); } else
3617          if (strcmp(s,"EZGCD_P")==0) { if (d) On(SW_USE_EZGCD_P); else Off(SW_USE_EZGCD_P); } else
3618          if (strcmp(s,"CRGCD")==0) { if (d) On(SW_USE_CHINREM_GCD); else Off(SW_USE_CHINREM_GCD); } else
3619          if (strcmp(s,"QGCD")==0) { if (d) On(SW_USE_QGCD); else Off(SW_USE_QGCD); } else
3620#endif
3621          if (strcmp(s,"homog")==0) { if (d) singular_homog_flag=1; else singular_homog_flag=0; } else
3622          return TRUE;
3623          return FALSE;
3624        }
3625        else return TRUE;
3626      }
3627      else
3628  #endif
3629  /*==================== subring =================*/
3630      if (strcmp(sys_cmd, "subring") == 0)
3631      {
3632        if (h!=NULL)
3633        {
3634          extern ring rSubring(ring r,leftv v); /* ipshell.cc*/
3635          res->data=(char *)rSubring(currRing,h);
3636          res->rtyp=RING_CMD;
3637          return res->data==NULL;
3638        }
3639        else return TRUE;
3640      }
3641      else
3642  /*==================== HNF =================*/
3643  #ifdef HAVE_FACTORY
3644  #ifdef HAVE_NTL
3645      if (strcmp(sys_cmd, "HNF") == 0)
3646      {
3647        if (h!=NULL)
3648        {
3649          res->rtyp=h->Typ();
3650          if (h->Typ()==MATRIX_CMD)
3651          {
3652            res->data=(char *)singntl_HNF((matrix)h->Data(), currRing);
3653            return FALSE;
3654          }
3655          else if (h->Typ()==INTMAT_CMD)
3656          {
3657            res->data=(char *)singntl_HNF((intvec*)h->Data(), currRing);
3658            return FALSE;
3659          }
3660          else return TRUE;
3661        }
3662        else return TRUE;
3663      }
3664      else
3665      if (strcmp(sys_cmd, "LLL") == 0)
3666      {
3667        if (h!=NULL)
3668        {
3669          res->rtyp=h->Typ();
3670          if (h->Typ()==MATRIX_CMD)
3671          {
3672            res->data=(char *)singntl_LLL((matrix)h->Data(), currRing);
3673            return FALSE;
3674          }
3675          else if (h->Typ()==INTMAT_CMD)
3676          {
3677            res->data=(char *)singntl_LLL((intvec*)h->Data(), currRing);
3678            return FALSE;
3679          }
3680          else return TRUE;
3681        }
3682        else return TRUE;
3683      }
3684      else
3685      #endif
3686  /*================= probIrredTest ======================*/
3687      if (strcmp (sys_cmd, "probIrredTest") == 0)
3688      {
3689        if (h!=NULL && (h->Typ()== POLY_CMD) && ((h->next != NULL) && h->next->Typ() == STRING_CMD))
3690        {
3691          CanonicalForm F= convSingPFactoryP((poly)(h->Data()), currRing);
3692          char *s=(char *)h->next->Data();
3693          double error= atof (s);
3694          int irred= probIrredTest (F, error);
3695          res->rtyp= INT_CMD;
3696          res->data= (void*)irred;
3697          return FALSE;
3698        }
3699        else return TRUE;
3700      }
3701      else
3702  #ifdef HAVE_FLINT
3703  /*================= absolute factorization ======================*/
3704      if (strcmp (sys_cmd, "absFact") == 0)
3705      {
3706        if (h!=NULL && (h->Typ()== POLY_CMD))
3707        {
3708          CanonicalForm F= convSingPFactoryP((poly)(h->Data()));
3709          CFList factors= absFactorize (F);
3710          res->rtyp= INT_CMD;
3711          res->data= (void*) 1;
3712          return FALSE;
3713        }
3714        else return TRUE;
3715      }
3716      else
3717  #endif
3718  #endif
3719  #ifdef ix86_Win
3720  /*==================== Python Singular =================*/
3721      if (strcmp(sys_cmd, "python") == 0)
3722      {
3723        const char* c;
3724        if ((h!=NULL) && (h->Typ()==STRING_CMD))
3725        {
3726          c=(const char*)h->Data();
3727          if (!PyInitialized) {
3728            PyInitialized = 1;
3729  //          Py_Initialize();
3730  //          initPySingular();
3731          }
3732  //      PyRun_SimpleString(c);
3733          return FALSE;
3734        }
3735        else return TRUE;
3736      }
3737      else
3738  /*==================== Python Singular =================
3739      if (strcmp(sys_cmd, "ipython") == 0)
3740      {
3741        const char* c;
3742        {
3743          if (!PyInitialized)
3744          {
3745            PyInitialized = 1;
3746            Py_Initialize();
3747            initPySingular();
3748          }
3749    PyRun_SimpleString(
3750  "try:                                                                                       \n\
3751      __IPYTHON__                                                                             \n\
3752  except NameError:                                                                           \n\
3753      argv = ['']                                                                             \n\
3754      banner = exit_msg = ''                                                                  \n\
3755  else:                                                                                       \n\
3756      # Command-line options for IPython (a list like sys.argv)                               \n\
3757      argv = ['-pi1','In <\\#>:','-pi2','   .\\D.:','-po','Out<\\#>:']                        \n\
3758      banner = '*** Nested interpreter ***'                                                   \n\
3759      exit_msg = '*** Back in main IPython ***'                                               \n\
3760                            \n\
3761  # First import the embeddable shell class                                                   \n\
3762  from IPython.Shell import IPShellEmbed                                                      \n\
3763  # Now create the IPython shell instance. Put ipshell() anywhere in your code                \n\
3764  # where you want it to open.                                                                \n\
3765  ipshell = IPShellEmbed(argv,banner=banner,exit_msg=exit_msg)                                \n\
3766  ipshell()");
3767          return FALSE;
3768        }
3769      }
3770      else
3771                */
3772
3773  #endif
3774/*======================= demon_list =====================*/
3775  if (strcmp(sys_cmd,"denom_list")==0)
3776  {
3777    res->rtyp=LIST_CMD;
3778    extern lists get_denom_list();
3779    res->data=(lists)get_denom_list();
3780    return FALSE;
3781  }
3782  else
3783/*==================== install newstruct =================*/
3784  if (strcmp(sys_cmd,"install")==0)
3785  {
3786    if ((h!=NULL) && (h->Typ()==STRING_CMD)
3787    && (h->next!=NULL) && (h->next->Typ()==STRING_CMD)
3788    && (h->next->next!=NULL) && (h->next->next->Typ()==PROC_CMD)
3789    && (h->next->next->next!=NULL) && (h->next->next->next->Typ()==INT_CMD))
3790    {
3791      return newstruct_set_proc((char*)h->Data(),(char*)h->next->Data(),
3792                                (int)(long)h->next->next->next->Data(),
3793                                (procinfov)h->next->next->Data());
3794    }
3795    return TRUE;
3796  }
3797  else
3798/*==================== Error =================*/
3799      Werror( "(extended) system(\"%s\",...) %s", sys_cmd, feNotImplemented );
3800  }
3801  return TRUE;
3802}
3803
3804#endif // HAVE_EXTENDED_SYSTEM
3805
3806
Note: See TracBrowser for help on using the repository browser.