source: git/Singular/extra.cc @ c599b4

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