source: git/Singular/extra.cc @ 06babc

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