source: git/Singular/extra.cc @ 0aad7c

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