source: git/Singular/extra.cc @ 3542f7

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