source: git/Singular/extra.cc @ 666c90

spielwiese
Last change on this file since 666c90 was 24beed, checked in by Michael Brickenstein <bricken@…>, 19 years ago
*bricken: MCpower git-svn-id: file:///usr/local/Singular/svn/trunk@7805 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 47.4 KB
Line 
1/*****************************************
2*  Computer Algebra System SINGULAR      *
3*****************************************/
4/* $Id: extra.cc,v 1.220 2005-04-01 08:15:55 bricken Exp $ */
5/*
6* ABSTRACT: general interface to internals of Singular ("system" command)
7*/
8
9#include <stdlib.h>
10#include <stdio.h>
11#include <string.h>
12#include <ctype.h>
13#include <signal.h>
14#include "mod2.h"
15
16#ifndef __MWERKS__
17#ifdef TIME_WITH_SYS_TIME
18# include <time.h>
19# ifdef HAVE_SYS_TIME_H
20#   include <sys/time.h>
21# endif
22#else
23# ifdef HAVE_SYS_TIME_H
24#   include <sys/time.h>
25# else
26#   include <time.h>
27# endif
28#endif
29#ifdef HAVE_SYS_TIMES_H
30#include <sys/times.h>
31#endif
32
33#endif
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
57#include "walk.h"
58#include "weight.h"
59#include "fast_mult.h"
60#include "digitech.h"
61#ifdef HAVE_SPECTRUM
62#include "spectrum.h"
63#endif
64
65#ifdef HAVE_PLURAL
66#include "ring.h"
67#include "gring.h"
68#include "ipconv.h"
69#endif
70
71#ifdef ix86_Win /* only for the DLLTest */
72/* #include "WinDllTest.h" */
73#ifdef HAVE_DL
74#include "mod_raw.h"
75#endif
76#endif
77
78// for tests of t-rep-GB
79#include "tgb.h"
80
81// Define to enable many more system commands
82#undef MAKE_DISTRIBUTION
83#ifndef MAKE_DISTRIBUTION
84#define HAVE_EXTENDED_SYSTEM 1
85#endif
86
87#ifdef HAVE_FACTORY
88#define SI_DONT_HAVE_GLOBAL_VARS
89#include "clapsing.h"
90#include "clapconv.h"
91#include "kstdfac.h"
92#endif
93
94#include "silink.h"
95#include "walk.h"
96
97#include "fast_maps.h"
98
99#ifdef HAVE_EIGENVAL
100#include "eigenval_ip.h"
101#endif
102
103#ifdef HAVE_GMS
104#include "gms.h"
105#endif
106
107/*
108 *   New function/system-calls that will be included as dynamic module
109 * should be inserted here.
110 * - without HAVE_DYNAMIC_LOADING: these functions comes as system("....");
111 * - with    HAVE_DYNAMIC_LOADING: these functions are loaded as module.
112 */
113//#ifndef HAVE_DYNAMIC_LOADING
114
115#ifdef HAVE_PCV
116#include "pcv.h"
117#endif
118
119//#endif /* not HAVE_DYNAMIC_LOADING */
120
121// see clapsing.cc for a description of the `FACTORY_*' options
122
123#ifdef FACTORY_GCD_STAT
124#include "gcd_stat.h"
125#endif
126
127#ifdef FACTORY_GCD_TIMING
128#define TIMING
129#include "timing.h"
130TIMING_DEFINE_PRINTPROTO( contentTimer );
131TIMING_DEFINE_PRINTPROTO( algContentTimer );
132TIMING_DEFINE_PRINTPROTO( algLcmTimer );
133#endif
134
135void piShowProcList();
136#ifndef MAKE_DISTRIBUTION
137static BOOLEAN jjEXTENDED_SYSTEM(leftv res, leftv h);
138#endif
139
140extern BOOLEAN jjJanetBasis(leftv res, leftv v);
141
142
143//void emStart();
144/*2
145*  the "system" command
146*/
147BOOLEAN jjSYSTEM(leftv res, leftv args)
148{
149  if(args->Typ() == STRING_CMD)
150  {
151    const char *sys_cmd=(char *)(args->Data());
152    leftv h=args->next;
153// ONLY documented system calls go here
154// Undocumented system calls go down into #ifdef HAVE_EXTENDED_SYSTEM
155/*==================== nblocks ==================================*/
156    if (strcmp(sys_cmd, "nblocks") == 0)
157    {
158      ring r;
159      if (h == NULL)
160      {
161        if (currRingHdl != NULL)
162        {
163          r = IDRING(currRingHdl);
164        }
165        else
166        {
167          WerrorS("no ring active");
168          return TRUE;
169        }
170      }
171      else
172      {
173        if (h->Typ() != RING_CMD)
174        {
175          WerrorS("ring expected");
176          return TRUE;
177        }
178        r = (ring) h->Data();
179      }
180      res->rtyp = INT_CMD;
181      res->data = (void*) (rBlocks(r) - 1);
182      return FALSE;
183    }
184/*==================== version ==================================*/
185    if(strcmp(sys_cmd,"version")==0)
186    {
187      res->rtyp=INT_CMD;
188      res->data=(void *)SINGULAR_VERSION;
189      return FALSE;
190    }
191    else
192/*==================== gen ==================================*/
193    if(strcmp(sys_cmd,"gen")==0)
194    {
195      res->rtyp=INT_CMD;
196      res->data=(void *)npGen;
197      return FALSE;
198    }
199    else
200/*==================== sh ==================================*/
201    if(strcmp(sys_cmd,"sh")==0)
202    {
203      res->rtyp=INT_CMD;
204      #ifndef __MWERKS__
205      if (h==NULL) res->data = (void *)system("sh");
206      else if (h->Typ()==STRING_CMD)
207        res->data = (void*) system((char*)(h->Data()));
208      else
209        WerrorS("string expected");
210      #else
211      res->data=(void *)0;
212      #endif
213      return FALSE;
214    }
215    else
216/*==================== uname ==================================*/
217    if(strcmp(sys_cmd,"uname")==0)
218    {
219      res->rtyp=STRING_CMD;
220      res->data = omStrDup(S_UNAME);
221      return FALSE;
222    }
223    else
224/*==================== with ==================================*/
225    if(strcmp(sys_cmd,"with")==0)
226    {
227      if (h==NULL)
228      {
229        res->rtyp=STRING_CMD;
230        res->data=(void *)omStrDup(versionString());
231        return FALSE;
232      }
233      else if (h->Typ()==STRING_CMD)
234      {
235        #define TEST_FOR(A) if(strcmp(s,A)==0) res->data=(void *)1; else
236        char *s=(char *)h->Data();
237        res->rtyp=INT_CMD;
238        #ifdef HAVE_DBM
239          TEST_FOR("DBM")
240        #endif
241        #ifdef HAVE_DLD
242          TEST_FOR("DLD")
243        #endif
244        #ifdef HAVE_FACTORY
245          TEST_FOR("factory")
246        #endif
247        #ifdef HAVE_LIBFAC_P
248          TEST_FOR("libfac")
249        #endif
250        #ifdef HAVE_MPSR
251          TEST_FOR("MP")
252        #endif
253        #ifdef HAVE_READLINE
254          TEST_FOR("readline")
255        #endif
256        #ifdef HAVE_TCL
257          TEST_FOR("tcl")
258        #endif
259        #ifdef TEST_MAC_ORDER
260          TEST_FOR("MAC_ORDER");
261        #endif
262        #ifdef HAVE_NS
263          TEST_FOR("Namespaces");
264        #endif
265        #ifdef HAVE_DYNAMIC_LOADING
266          TEST_FOR("DynamicLoading");
267        #endif
268        #ifdef HAVE_EIGENVAL
269          TEST_FOR("eigenval");
270        #endif
271        #ifdef HAVE_GMS
272          TEST_FOR("gms");
273        #endif
274          ;
275        return FALSE;
276        #undef TEST_FOR
277      }
278      return TRUE;
279    }
280    else
281/*==================== browsers ==================================*/
282    if (strcmp(sys_cmd,"browsers")==0)
283    {
284      res->rtyp = STRING_CMD;
285      char* b = StringSetS("");
286      feStringAppendBrowsers(0);
287      res->data = omStrDup(b);
288      return FALSE;
289    }
290    else
291/*==================== pid ==================================*/
292    if (strcmp(sys_cmd,"pid")==0)
293    {
294      res->rtyp=INT_CMD;
295    #ifndef MSDOS
296    #ifndef __MWERKS__
297      res->data=(void *)getpid();
298    #else
299      res->data=(void *)1;
300    #endif
301    #else
302      res->data=(void *)1;
303    #endif
304      return FALSE;
305    }
306    else
307/*==================== getenv ==================================*/
308    if (strcmp(sys_cmd,"getenv")==0)
309    {
310      if ((h!=NULL) && (h->Typ()==STRING_CMD))
311      {
312        res->rtyp=STRING_CMD;
313        char *r=getenv((char *)h->Data());
314        if (r==NULL) r="";
315        res->data=(void *)omStrDup(r);
316        return FALSE;
317      }
318      else
319      {
320        WerrorS("string expected");
321        return TRUE;
322      }
323    }
324    else
325/*==================== setenv ==================================*/
326    if (strcmp(sys_cmd,"setenv")==0)
327    {
328#ifdef HAVE_SETENV
329      if (h!=NULL && h->Typ()==STRING_CMD && h->Data() != NULL &&
330          h->next != NULL && h->next->Typ() == STRING_CMD
331          && h->next->Data() != NULL)
332      {
333        res->rtyp=STRING_CMD;
334        setenv((char *)h->Data(), (char *)h->next->Data(), 1);
335        res->data=(void *)omStrDup((char *)h->next->Data());
336        feReInitResources();
337        return FALSE;
338      }
339      else
340      {
341        WerrorS("two strings expected");
342        return TRUE;
343      }
344#else
345      WerrorS("setenv not supported on this platform");
346      return TRUE;
347#endif
348    }
349    else
350/*==================== Singular ==================================*/
351    if (strcmp(sys_cmd, "Singular") == 0)
352    {
353      res->rtyp=STRING_CMD;
354      char *r=feResource("Singular");
355      if (r != NULL)
356        res->data = (void*) omStrDup( r );
357      else
358        res->data = (void*) omStrDup("");
359      return FALSE;
360    }
361    else
362/*==================== options ==================================*/
363    if (strstr(sys_cmd, "--") == sys_cmd)
364    {
365      if (strcmp(sys_cmd, "--") == 0)
366      {
367        fePrintOptValues();
368        return FALSE;
369      }
370
371      feOptIndex opt = feGetOptIndex(&sys_cmd[2]);
372      if (opt == FE_OPT_UNDEF)
373      {
374        Werror("Unknown option %s", sys_cmd);
375        Werror("Use 'system(\"--\");' for listing of available options");
376        return TRUE;
377      }
378
379      // for Untyped Options (help version),
380      // setting it just triggers action
381      if (feOptSpec[opt].type == feOptUntyped)
382      {
383        feSetOptValue(opt,0);
384        return FALSE;
385      }
386
387      if (h == NULL)
388      {
389        if (feOptSpec[opt].type == feOptString)
390        {
391          res->rtyp = STRING_CMD;
392          if (feOptSpec[opt].value != NULL)
393            res->data = omStrDup((char*) feOptSpec[opt].value);
394          else
395            res->data = omStrDup("");
396        }
397        else
398        {
399          res->rtyp = INT_CMD;
400          res->data = feOptSpec[opt].value;
401        }
402        return FALSE;
403      }
404
405      if (h->Typ() != STRING_CMD &&
406          h->Typ() != INT_CMD)
407      {
408        Werror("Need string or int argument to set option value");
409        return TRUE;
410      }
411      char* errormsg;
412      if (h->Typ() == INT_CMD)
413      {
414        if (feOptSpec[opt].type == feOptString)
415        {
416          Werror("Need string argument to set value of option %s", sys_cmd);
417          return TRUE;
418        }
419        errormsg = feSetOptValue(opt, (int) h->Data());
420        if (errormsg != NULL)
421          Werror("Option '--%s=%d' %s", sys_cmd, (int) h->Data(), errormsg);
422      }
423      else
424      {
425        errormsg = feSetOptValue(opt, (char*) h->Data());
426        if (errormsg != NULL)
427          Werror("Option '--%s=%s' %s", sys_cmd, (char*) h->Data(), errormsg);
428      }
429      if (errormsg != NULL) return TRUE;
430      return FALSE;
431    }
432    else
433/*==================== HC ==================================*/
434    if (strcmp(sys_cmd,"HC")==0)
435    {
436      res->rtyp=INT_CMD;
437      res->data=(void *)HCord;
438      return FALSE;
439    }
440    else
441/*==================== random ==================================*/
442    if(strcmp(sys_cmd,"random")==0)
443    {
444      if ((h!=NULL) &&(h->Typ()==INT_CMD))
445      {
446        siRandomStart=(int)h->Data();
447#ifdef buildin_rand
448        siSeed=siRandomStart;
449#else
450        srand((unsigned int)siRandomStart);
451#endif
452#ifdef HAVE_FACTORY
453        factoryseed(siRandomStart);
454#endif
455        return FALSE;
456      }
457      else if (h != NULL)
458      {
459        WerrorS("int expected");
460        return TRUE;
461      }
462      res->rtyp=INT_CMD;
463      res->data=(void*) siRandomStart;
464      return FALSE;
465    }
466/*==================== complexNearZero ======================*/
467    if(strcmp(sys_cmd,"complexNearZero")==0)
468    {
469      if (h->Typ()==NUMBER_CMD )
470      {
471        if ( h->next!=NULL && h->next->Typ()==INT_CMD )
472        {
473          if ( !rField_is_long_C() )
474            {
475              Werror( "unsupported ground field!");
476              return TRUE;
477            }
478          else
479            {
480              res->rtyp=INT_CMD;
481              res->data=(void*)complexNearZero((gmp_complex*)h->Data(),(int)h->next->Data());
482              return FALSE;
483            }
484        }
485        else
486        {
487          Werror( "expected <int> as third parameter!");
488          return TRUE;
489        }
490      }
491      else
492      {
493        Werror( "expected <number> as second parameter!");
494        return TRUE;
495      }
496    }
497/*==================== getPrecDigits ======================*/
498    if(strcmp(sys_cmd,"getPrecDigits")==0)
499    {
500      if ( !rField_is_long_C() && !rField_is_long_R() )
501      {
502        Werror( "unsupported ground field!");
503        return TRUE;
504      }
505      res->rtyp=INT_CMD;
506      res->data=(void*)getGMPFloatDigits();
507      return FALSE;
508    }
509/*==================== neworder =============================*/
510// should go below
511#ifdef HAVE_LIBFAC_P
512    if(strcmp(sys_cmd,"neworder")==0)
513    {
514      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
515      {
516        res->rtyp=STRING_CMD;
517        res->data=(void *)singclap_neworder((ideal)h->Data());
518        return FALSE;
519      }
520      else
521        WerrorS("ideal expected");
522    }
523    else
524#endif
525//#ifndef HAVE_DYNAMIC_LOADING
526/*==================== pcv ==================================*/
527#ifdef HAVE_PCV
528    if(strcmp(sys_cmd,"pcvLAddL")==0)
529    {
530      return pcvLAddL(res,h);
531    }
532    else
533    if(strcmp(sys_cmd,"pcvPMulL")==0)
534    {
535      return pcvPMulL(res,h);
536    }
537    else
538    if(strcmp(sys_cmd,"pcvMinDeg")==0)
539    {
540      return pcvMinDeg(res,h);
541    }
542    else
543    if(strcmp(sys_cmd,"pcvP2CV")==0)
544    {
545      return pcvP2CV(res,h);
546    }
547    else
548    if(strcmp(sys_cmd,"pcvCV2P")==0)
549    {
550      return pcvCV2P(res,h);
551    }
552    else
553    if(strcmp(sys_cmd,"pcvDim")==0)
554    {
555      return pcvDim(res,h);
556    }
557    else
558    if(strcmp(sys_cmd,"pcvBasis")==0)
559    {
560      return pcvBasis(res,h);
561    }
562    else
563#endif
564/*==================== eigenvalues ==================================*/
565#ifdef HAVE_EIGENVAL
566    if(strcmp(sys_cmd,"hessenberg")==0)
567    {
568      return evHessenberg(res,h);
569    }
570    else
571    if(strcmp(sys_cmd,"eigenvals")==0)
572    {
573      return evEigenvals(res,h);
574    }
575    else
576#endif
577/*==================== Gauss-Manin system ==================================*/
578#ifdef HAVE_GMS
579    if(strcmp(sys_cmd,"gmsnf")==0)
580    {
581      return gmsNF(res,h);
582    }
583    else
584#endif
585//#endif /* HAVE_DYNAMIC_LOADING */
586/*==================== contributors =============================*/
587   if(strcmp(sys_cmd,"contributors") == 0)
588   {
589     res->rtyp=STRING_CMD;
590     res->data=(void *)omStrDup(
591       "Olaf Bachmann, Hubert Grassmann, Kai Krueger, Wolfgang Neumann, Thomas Nuessler, Wilfred Pohl, Jens Schmidt, Mathias Schulze, Thomas Siebert, Ruediger Stobbe, Moritz Wenk, Tim Wichmann");
592     return FALSE;
593   }
594   else
595/*==================== spectrum =============================*/
596   #ifdef HAVE_SPECTRUM
597   if(strcmp(sys_cmd,"spectrum") == 0)
598   {
599     if (h->Typ()!=POLY_CMD)
600     {
601       WerrorS("poly expected");
602       return TRUE;
603     }
604     if (h->next==NULL)
605       return spectrumProc(res,h);
606     if (h->next->Typ()!=INT_CMD)
607     {
608       WerrorS("poly,int expected");
609       return TRUE;
610     }
611     if(((int)h->next->Data())==1)
612       return spectrumfProc(res,h);
613     return spectrumProc(res,h);
614   }
615   else
616/*==================== semic =============================*/
617   if(strcmp(sys_cmd,"semic") == 0)
618   {
619     if ((h->next!=NULL)
620     && (h->Typ()==LIST_CMD)
621     && (h->next->Typ()==LIST_CMD))
622     {
623       if (h->next->next==NULL)
624         return semicProc(res,h,h->next);
625       else if (h->next->next->Typ()==INT_CMD)
626         return semicProc3(res,h,h->next,h->next->next);
627     }
628     return TRUE;
629   }
630   else
631/*==================== spadd =============================*/
632   if(strcmp(sys_cmd,"spadd") == 0)
633   {
634     if ((h->next!=NULL)
635     && (h->Typ()==LIST_CMD)
636     && (h->next->Typ()==LIST_CMD))
637     {
638       if (h->next->next==NULL)
639         return spaddProc(res,h,h->next);
640     }
641     return TRUE;
642   }
643   else
644/*==================== spmul =============================*/
645   if(strcmp(sys_cmd,"spmul") == 0)
646   {
647     if ((h->next!=NULL)
648     && (h->Typ()==LIST_CMD)
649     && (h->next->Typ()==INT_CMD))
650     {
651       if (h->next->next==NULL)
652         return spmulProc(res,h,h->next);
653     }
654     return TRUE;
655   }
656   else
657   #endif
658#ifdef HAVE_PLURAL
659/*==================== Approx_Step  =================*/
660      if (strcmp(sys_cmd, "astep") == 0)
661      {
662        ideal I;
663        if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
664        {
665          I=(ideal)h->CopyD();
666          res->rtyp=IDEAL_CMD;
667          if (rIsPluralRing(currRing)) res->data=Approx_Step(I);
668          else res->data=I;
669          setFlag(res,FLAG_STD);
670        }
671        else return TRUE;
672        return FALSE;
673      }
674/*==================== PrintMat  =================*/
675      if (strcmp(sys_cmd, "PrintMat") == 0)
676      {
677        int a;
678        int b;
679        ring r;
680        int metric;
681        if ((h!=NULL) && (h->Typ()==INT_CMD))
682        {
683          a=(int)h->CopyD();
684          h=h->next;
685        }
686        else return TRUE;
687        if ((h!=NULL) && (h->Typ()==INT_CMD))
688        {
689          b=(int)h->CopyD();
690          h=h->next;
691        }
692        else return TRUE;
693        if ((h!=NULL) && (h->Typ()==RING_CMD))
694        {
695          r=(ring)h->Data();
696          h=h->next;
697        }
698        else return TRUE;
699        if ((h!=NULL) && (h->Typ()==INT_CMD))
700        {
701          metric=(int)h->CopyD();
702        }
703        res->rtyp=MATRIX_CMD;
704        if (rIsPluralRing(r)) res->data=nc_PrintMat(a,b,r,metric);
705        else res->data=NULL;
706        return FALSE;
707      }
708/*==================== twostd  =================*/
709      if (strcmp(sys_cmd, "twostd") == 0)
710      {
711        ideal I;
712        if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
713        {
714          I=(ideal)h->CopyD();
715          res->rtyp=IDEAL_CMD;
716          if (rIsPluralRing(currRing)) res->data=twostd(I);
717          else res->data=I;
718          setFlag(res,FLAG_TWOSTD);
719          setFlag(res,FLAG_STD);
720        }
721        else return TRUE;
722        return FALSE;
723      }
724/*==================== lie bracket =================*/
725    if (strcmp(sys_cmd, "bracket") == 0)
726    {
727      poly p;
728      poly q;
729      if ((h!=NULL) && (h->Typ()==POLY_CMD))
730      {
731        p=(poly)h->CopyD();
732        h=h->next;
733      }
734      else return TRUE;
735      if ((h!=NULL) && (h->Typ()==POLY_CMD))
736      {
737        q=(poly)h->Data();
738      }
739      else return TRUE;
740      res->rtyp=POLY_CMD;
741      if (rIsPluralRing(currRing))  res->data=nc_p_Bracket_qq(p,q);
742      else res->data=NULL;
743      return FALSE;
744    }
745/*==================== PLURAL =================*/
746    if (strcmp(sys_cmd, "PLURAL") == 0)
747    {
748      matrix C;
749      matrix D;
750      number nN;
751      poly pN;
752      int i,j;
753      sleftv tmp_v;
754      memset(&tmp_v,0,sizeof(tmp_v));
755
756      if (currRing->nc==NULL)
757      {
758        currRing->nc=(nc_struct *)omAlloc0(sizeof(nc_struct));
759        currRing->nc->ref=1;
760        currRing->nc->basering=currRing;
761      }
762      else
763      {
764        WarnS("redefining algebra structure");
765        if (currRing->nc->ref>1) // in use by somebody else
766          currRing->nc->ref--;
767        else
768          ncKill(currRing); /* kill the previous nc data */
769        currRing->nc=(nc_struct *)omAlloc0(sizeof(nc_struct));
770        currRing->nc->ref=1;
771        currRing->nc->basering=currRing;
772      }
773      currRing->nc->type=nc_general;
774      /* C is either a poly (coeff - an int or a number) or a  matrix */
775      if (h==NULL) return TRUE;
776      leftv hh=h->next;
777      h->next=NULL;
778      switch(h->Typ())
779      {
780        case MATRIX_CMD: { C=(matrix)h->CopyD(); break; }
781
782        case INT_CMD: case NUMBER_CMD:
783        {
784          i=iiTestConvert(h->Typ(), POLY_CMD);
785          if (i==0)
786          {
787            Werror("cannot convert to poly");
788            return TRUE;
789          }
790          iiConvert(h->Typ(), POLY_CMD, i, h, &tmp_v);
791          pN=(poly)tmp_v.Data();
792          break;
793        }
794
795        case POLY_CMD:  {pN=(poly)h->Data(); break;}
796
797        default: return TRUE;
798      }
799      if (h->Typ()==MATRIX_CMD)
800      {
801        currRing->nc->type=nc_undef; /* to analyze later ! */
802        //      currRing->nc->IsSkewConstant=NULL;
803      }
804      else
805      {
806        nN=pGetCoeff(pN); // pN is not NULL anyway
807        if (nIsZero(nN)) 
808        {
809          Werror("zero coefficients are not allowed");
810          return TRUE;
811        }
812        if (nIsOne(nN)) currRing->nc->type=nc_lie; 
813        else currRing->nc->type=nc_skew;
814        currRing->nc->IsSkewConstant=1;
815        /* create matrix C */
816        C=mpNew(currRing->N,currRing->N);
817        for(i=1;i<currRing->N;i++)
818        {
819          for(j=i+1;j<=currRing->N;j++)
820          {
821            MATELEM(C,i,j) = nc_p_CopyPut(pN,currRing);
822            //  MATELEM(C,i,j)=pCopy(pN);
823          }
824        }
825      }
826      pN=NULL;
827      h=hh;
828      /* D is either a poly or a matrix */
829      if (h==NULL) { pN=NULL;}  /* D is zero matrix */
830      else
831      {
832        switch(h->Typ())
833        {
834          case MATRIX_CMD: { D=(matrix)h->CopyD(); break;}
835
836          case INT_CMD: case NUMBER_CMD:
837          {
838            i=iiTestConvert(h->Typ(), POLY_CMD);
839            if (i==0)
840            {
841              Werror("cannot convert to poly");
842              return TRUE;
843            }
844            iiConvert(h->Typ(), POLY_CMD, i, h, &tmp_v);
845            pN=(poly)tmp_v.Data();
846            break;
847          }
848
849          case POLY_CMD:  { pN=(poly)h->Data();break;}
850
851          default: return TRUE;
852        }
853      } /* end else h==NULL */
854      if (pN==NULL)
855      {
856        if (currRing->nc->type==nc_lie) 
857        {
858          currRing->nc->type=nc_skew; /* even commutative! */
859        }
860      }
861      else 
862      { 
863        if (currRing->nc->type==nc_skew) currRing->nc->type=nc_general; 
864      } /* end pN==NULL */
865      if (h==NULL)
866      {
867         WerrorS("expected `system(\"PLURAL\",<matrix>,<matrix>)`");
868         idDelete((ideal *)&(currRing->nc->C));
869         omFreeSize((ADDRESS)currRing->nc,sizeof(nc_struct));
870         currRing->nc=NULL;
871         return TRUE;
872      }
873      if (h->Typ()!=MATRIX_CMD)
874      {
875        D=mpNew(currRing->N,currRing->N);
876        /* create matrix D */
877        for(i=1;i<currRing->N;i++)
878        {
879          for(j=i+1;j<=currRing->N;j++)
880          {
881            MATELEM(D,i,j) = nc_p_CopyPut(pN,currRing);
882            //            MATELEM(D,i,j)=pCopy(pN);
883          }
884        }
885      }
886      else currRing->nc->type=nc_undef;
887      tmp_v.CleanUp();
888      pN=NULL;
889      /* Now we proceed with C and D */
890      matrix COM;
891      currRing->nc->MT=(matrix *)omAlloc0(currRing->N*(currRing->N-1)/2*sizeof(matrix));
892      currRing->nc->MTsize=(int *)omAlloc0(currRing->N*(currRing->N-1)/2*sizeof(int));
893      currRing->nc->C=C;
894      currRing->nc->D=D;
895      COM=mpCopy(currRing->nc->C);
896      poly p;
897      short DefMTsize=7;
898      int tmpIsSkewConstant=1;
899      int IsNonComm=0;
900      pN=nc_p_CopyGet(MATELEM(currRing->nc->C,1,2),currRing);
901      //      pN=MATELEM(currRing->nc->C,1,2);
902
903      for(i=1;i<currRing->N;i++)
904      {
905        for(j=i+1;j<=currRing->N;j++)
906        {
907          if (MATELEM(currRing->nc->C,i,j)==NULL)
908          {
909            Werror("Incorrect input : matrix of coefficients contains zeros in the upper triangle!");
910            return TRUE;
911          }
912          if (!nEqual(pGetCoeff(pN),pGetCoeff(MATELEM(currRing->nc->C,i,j)))) tmpIsSkewConstant=0;
913          if (MATELEM(currRing->nc->D,i,j)==NULL) /* quasicommutative case */
914          {
915            currRing->nc->MTsize[UPMATELEM(i,j,currRing->N)]=1;
916            /* 1x1 mult.matrix */
917            currRing->nc->MT[UPMATELEM(i,j,currRing->N)]=mpNew(1,1);
918          }
919          else /* pure noncommutative case*/
920          {
921            IsNonComm=1;
922            MATELEM(COM,i,j)=NULL;
923            currRing->nc->MTsize[UPMATELEM(i,j,currRing->N)]=DefMTsize; /* default sizes */
924            currRing->nc->MT[UPMATELEM(i,j,currRing->N)]=mpNew(DefMTsize,DefMTsize);
925          }
926          p=pOne();
927          pSetCoeff(p,nCopy(pGetCoeff(MATELEM(currRing->nc->C,i,j))));
928          pSetExp(p,i,1);
929          pSetExp(p,j,1);
930          pSetm(p);
931          //          p=pAdd(p,pCopy(MATELEM(currRing->nc->D,i,j)));
932          p=pAdd(p,nc_p_CopyGet(MATELEM(currRing->nc->D,i,j),currRing));
933          //          MATELEM(currRing->nc->MT[UPMATELEM(i,j,currRing->N)],1,1)=p;
934          MATELEM(currRing->nc->MT[UPMATELEM(i,j,currRing->N)],1,1)=nc_p_CopyPut(p,currRing);
935          pDelete(&p);
936          p=NULL;
937        }
938        /* set MT[i,j,1,1] to c_i_j*x_i*x_j + D_i_j */
939      }
940      if (currRing->nc->type==nc_undef)
941      {
942        if (IsNonComm==1)
943        {
944          assume(pN!=NULL);
945          if ((tmpIsSkewConstant==1) && (nIsOne(pGetCoeff(pN)))) currRing->nc->type=nc_lie;
946          else currRing->nc->type=nc_general;
947        }
948        if (IsNonComm==0) 
949        {
950          currRing->nc->type=nc_skew; /* could be also commutative */
951          currRing->nc->IsSkewConstant=tmpIsSkewConstant;
952        }
953      }
954      currRing->nc->COM=COM;
955      return FALSE;
956    }
957    else
958/*==================== opp ==================================*/
959    if (strcmp(sys_cmd, "opp")==0)
960    {
961      if ((h!=NULL) && (h->Typ()==RING_CMD))
962      {
963        ring r=(ring)h->Data();
964        res->data=rOpposite(r);
965        res->rtyp=RING_CMD;
966        return FALSE;
967      }
968      else
969      {
970        WerrorS("`system(\"opp\",<ring>)` expected");
971        return TRUE;
972      }
973    }
974    else
975/*==================== env ==================================*/
976    if (strcmp(sys_cmd, "env")==0)
977    {
978      if ((h!=NULL) && (h->Typ()==RING_CMD))
979      {
980        ring r = (ring)h->Data();
981        res->data = rEnvelope(r);
982        res->rtyp = RING_CMD;
983        return FALSE;
984      }
985      else
986      {
987        WerrorS("`system(\"env\",<ring>)` expected");
988        return TRUE;
989      }
990    }
991    else
992/*==================== oppose ==================================*/
993    if (strcmp(sys_cmd, "oppose")==0)
994    {
995      ring Rop;
996      if ((h!=NULL) && (h->Typ()==RING_CMD))
997      {
998        Rop = (ring)h->Data();
999        h   = h->next;
1000      }
1001      if ((h!=NULL)) 
1002      {
1003        idhdl w;
1004        if ((w=Rop->idroot->get(h->Name(),myynest))!=NULL)
1005        {
1006          poly p = (poly)IDDATA(w);
1007          res->data = pOppose(Rop,p);
1008          res->rtyp = POLY_CMD;
1009          return FALSE;
1010        }
1011       }
1012      else
1013      {
1014        WerrorS("`system(\"oppose\",<ring>,<poly>)` expected");
1015        return TRUE;
1016      }
1017    }
1018    else
1019#endif
1020/*================= Extended system call ========================*/
1021   {
1022     #ifndef MAKE_DISTRIBUTION
1023     return(jjEXTENDED_SYSTEM(res, args));
1024     #else
1025     Werror( "system(\"%s\",...) %s", sys_cmd, feNotImplemented );
1026     #endif
1027   }
1028  } /* typ==string */
1029  return TRUE;
1030}
1031
1032
1033#ifdef HAVE_EXTENDED_SYSTEM
1034// You can put your own system calls here
1035#include "fglmcomb.cc"
1036#include "fglm.h"
1037#ifdef HAVE_NEWTON
1038#include <hc_newton.h>
1039#endif
1040#include "mpsr.h"
1041#include "mod_raw.h"
1042
1043static BOOLEAN jjEXTENDED_SYSTEM(leftv res, leftv h)
1044{
1045  if(h->Typ() == STRING_CMD)
1046  {
1047    char *sys_cmd=(char *)(h->Data());
1048    h=h->next;
1049/*==================== locNF ======================================*/
1050    if(strcmp(sys_cmd,"locNF")==0)
1051    {
1052      if (h != NULL && h->Typ() == VECTOR_CMD)
1053      {
1054        poly f=(poly)h->Data();
1055        h=h->next;
1056        if (h != NULL && h->Typ() == MODUL_CMD)
1057        {
1058          ideal m=(ideal)h->Data();
1059          assumeStdFlag(h);
1060          h=h->next;
1061          if (h != NULL && h->Typ() == INT_CMD)
1062          {
1063            int n=(int)h->Data();
1064            h=h->next;
1065            if (h != NULL && h->Typ() == INTVEC_CMD)
1066            {
1067              intvec *v=(intvec *)h->Data();
1068
1069              /* == now the work starts == */
1070
1071              short * iv=iv2array(v);
1072              poly r=0;
1073              poly hp=ppJetW(f,n,iv);
1074              int s=MATCOLS(m);
1075              int j=0;
1076              matrix T=mpInitI(s,1,0);
1077
1078              while (hp != NULL)
1079              {
1080                if (pDivisibleBy(m->m[j],hp))
1081                  {
1082                    if (MATELEM(T,j+1,1)==0)
1083                    {
1084                      MATELEM(T,j+1,1)=pDivideM(pHead(hp),pHead(m->m[j]));
1085                    }
1086                    else
1087                    {
1088                      pAdd(MATELEM(T,j+1,1),pDivideM(pHead(hp),pHead(m->m[j])));
1089                    }
1090                    hp=ppJetW(ksOldSpolyRed(m->m[j],hp,0),n,iv);
1091                    j=0;
1092                  }
1093                else
1094                {
1095                  if (j==s-1)
1096                  {
1097                    r=pAdd(r,pHead(hp));
1098                    hp=pLmDeleteAndNext(hp); /* hp=pSub(hp,pHead(hp));*/
1099                    j=0;
1100                  }
1101                  else
1102                  {
1103                    j++;
1104                  }
1105                }
1106              }
1107
1108              matrix Temp=mpTransp((matrix) idVec2Ideal(r));
1109              matrix R=mpNew(MATCOLS((matrix) idVec2Ideal(f)),1);
1110              for (int k=1;k<=MATROWS(Temp);k++)
1111              {
1112                MATELEM(R,k,1)=MATELEM(Temp,k,1);
1113              }
1114
1115              lists L=(lists)omAllocBin(slists_bin);
1116              L->Init(2);
1117              L->m[0].rtyp=MATRIX_CMD;   L->m[0].data=(void *)R;
1118              L->m[1].rtyp=MATRIX_CMD;   L->m[1].data=(void *)T;
1119              res->data=L;
1120              res->rtyp=LIST_CMD;
1121              // iv aufraeumen
1122              omFree(iv);
1123            }
1124            else
1125            {
1126              Warn ("4th argument: must be an intvec!");
1127            }
1128          }
1129          else
1130          {
1131            Warn("3rd argument must be an int!!");
1132          }
1133        }
1134        else
1135        {
1136          Warn("2nd argument must be a module!");
1137        }
1138      }
1139      else
1140      {
1141        Warn("1st argument must be a vector!");
1142      }
1143      return FALSE;
1144    }
1145    else
1146/*==================== interred ==================================*/
1147    #if 0
1148    if(strcmp(sys_cmd,"interred")==0)
1149    {
1150      res->data=(char *)kIR((ideal)h->Data(),currQuotient);
1151      res->rtyp=h->Typ();
1152      return ((h->Typ()!=IDEAL_CMD) && (h->Typ()!=MODUL_CMD));
1153    }
1154    else
1155    #endif
1156#ifdef RDEBUG
1157/*==================== poly debug ==================================*/
1158    if(strcmp(sys_cmd,"p")==0)
1159    {
1160      pDebugPrint((poly)h->Data());
1161      return FALSE;
1162    }
1163    else
1164/*==================== ring debug ==================================*/
1165    if(strcmp(sys_cmd,"r")==0)
1166    {
1167      rDebugPrint((ring)h->Data());
1168      return FALSE;
1169    }
1170    else
1171#endif
1172/*==================== mtrack ==================================*/
1173    if(strcmp(sys_cmd,"mtrack")==0)
1174    {
1175#ifdef OM_TRACK
1176      om_Opts.MarkAsStatic = 1;
1177      FILE *fd = NULL;
1178      int max = 5;
1179      while (h != NULL)
1180      {
1181        omMarkAsStaticAddr(h);
1182        if (fd == NULL && h->Typ()==STRING_CMD)
1183        {
1184          fd = fopen((char*) h->Data(), "w");
1185          if (fd == NULL)
1186            Warn("Can not open %s for writing og mtrack. Using stdout");
1187        }
1188        if (h->Typ() == INT_CMD)
1189        {
1190          max = (int) h->Data();
1191        }
1192        h = h->Next();
1193      }
1194      omPrintUsedTrackAddrs((fd == NULL ? stdout : fd), max);
1195      if (fd != NULL) fclose(fd);
1196      om_Opts.MarkAsStatic = 0;
1197      return FALSE;
1198#else
1199     WerrorS("mtrack not supported without OM_TRACK");
1200     return TRUE;
1201#endif
1202    }
1203/*==================== mtrack_all ==================================*/
1204    if(strcmp(sys_cmd,"mtrack_all")==0)
1205    {
1206#ifdef OM_TRACK
1207      om_Opts.MarkAsStatic = 1;
1208      FILE *fd = NULL;
1209      if ((h!=NULL) &&(h->Typ()==STRING_CMD))
1210      {
1211        fd = fopen((char*) h->Data(), "w");
1212        if (fd == NULL)
1213          Warn("Can not open %s for writing og mtrack. Using stdout");
1214        omMarkAsStaticAddr(h);
1215      }
1216      // OB: TBC print to fd
1217      omPrintUsedAddrs((fd == NULL ? stdout : fd), 5);
1218      if (fd != NULL) fclose(fd);
1219      om_Opts.MarkAsStatic = 0;
1220      return FALSE;
1221#else
1222     WerrorS("mtrack not supported without OM_TRACK");
1223     return TRUE;
1224#endif
1225    }
1226    else
1227/*==================== backtrace ==================================*/
1228    if(strcmp(sys_cmd,"backtrace")==0)
1229    {
1230#ifndef OM_NDEBUG
1231      omPrintCurrentBackTrace(stdout);
1232      return FALSE;
1233#else
1234     WerrorS("btrack not supported without OM_TRACK");
1235     return TRUE;
1236#endif
1237    }
1238    else
1239/*==================== naIdeal ==================================*/
1240    if(strcmp(sys_cmd,"naIdeal")==0)
1241    {
1242      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
1243      {
1244        naSetIdeal((ideal)h->Data());
1245        return FALSE;
1246      }
1247      else
1248         WerrorS("ideal expected");
1249    }
1250    else
1251/*==================== isSqrFree =============================*/
1252#ifdef HAVE_FACTORY
1253    if(strcmp(sys_cmd,"isSqrFree")==0)
1254    {
1255      if ((h!=NULL) &&(h->Typ()==POLY_CMD))
1256      {
1257        res->rtyp=INT_CMD;
1258        res->data=(void *)singclap_isSqrFree((poly)h->Data());
1259        return FALSE;
1260      }
1261      else
1262        WerrorS("poly expected");
1263    }
1264    else
1265#endif
1266/*==================== pDivStat =============================*/
1267#if defined(PDEBUG) || defined(PDIV_DEBUG)
1268    if(strcmp(sys_cmd,"pDivStat")==0)
1269    {
1270      extern void pPrintDivisbleByStat();
1271      pPrintDivisbleByStat();
1272      return FALSE;
1273    }
1274    else
1275#endif
1276/*==================== alarm ==================================*/
1277#ifndef __MWERKS__
1278#ifndef MSDOS
1279#ifndef atarist
1280#ifdef unix
1281    if(strcmp(sys_cmd,"alarm")==0)
1282    {
1283      if ((h!=NULL) &&(h->Typ()==INT_CMD))
1284      {
1285        // standard variant -> SIGALARM (standard: abort)
1286        //alarm((unsigned)h->next->Data());
1287        // process time (user +system): SIGVTALARM
1288        struct itimerval t,o;
1289        memset(&t,0,sizeof(t));
1290        t.it_value.tv_sec     =(unsigned)h->Data();
1291        setitimer(ITIMER_VIRTUAL,&t,&o);
1292        return FALSE;
1293      }
1294      else
1295        WerrorS("int expected");
1296    }
1297    else
1298#endif
1299#endif
1300#endif
1301#endif
1302/*==================== red =============================*/
1303#if 0
1304    if(strcmp(sys_cmd,"red")==0)
1305    {
1306      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
1307      {
1308        res->rtyp=IDEAL_CMD;
1309        res->data=(void *)kStdred((ideal)h->Data(),NULL,testHomog,NULL);
1310        setFlag(res,FLAG_STD);
1311        return FALSE;
1312      }
1313      else
1314        WerrorS("ideal expected");
1315    }
1316    else
1317#endif
1318#ifdef HAVE_FACTORY
1319/*==================== fastcomb =============================*/
1320    if(strcmp(sys_cmd,"fastcomb")==0)
1321    {
1322      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
1323      {
1324        int i=0;
1325        if (h->next!=NULL)
1326        {
1327          if (h->next->Typ()!=POLY_CMD)
1328          {
1329            Warn("Wrong types for poly= comb(ideal,poly)");
1330          }
1331        }
1332        res->rtyp=POLY_CMD;
1333        res->data=(void *) fglmLinearCombination(
1334                           (ideal)h->Data(),(poly)h->next->Data());
1335        return FALSE;
1336      }
1337      else
1338        WerrorS("ideal expected");
1339    }
1340    else
1341/*==================== comb =============================*/
1342    if(strcmp(sys_cmd,"comb")==0)
1343    {
1344      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
1345      {
1346        int i=0;
1347        if (h->next!=NULL)
1348        {
1349          if (h->next->Typ()!=POLY_CMD)
1350          {
1351              Warn("Wrong types for poly= comb(ideal,poly)");
1352          }
1353        }
1354        res->rtyp=POLY_CMD;
1355        res->data=(void *)fglmNewLinearCombination(
1356                            (ideal)h->Data(),(poly)h->next->Data());
1357        return FALSE;
1358      }
1359      else
1360        WerrorS("ideal expected");
1361    }
1362    else
1363#endif
1364#ifdef FACTORY_GCD_TEST
1365/*=======================gcd Testerei ================================*/
1366    if ( ! strcmp( sys_cmd, "setgcd" ) ) {
1367        if ( (h != NULL) && (h->Typ() == INT_CMD) ) {
1368            CFPrimitiveGcdUtil::setAlgorithm( (int)h->Data() );
1369            return FALSE;
1370        } else
1371            WerrorS("int expected");
1372    }
1373    else
1374#endif
1375
1376#ifdef FACTORY_GCD_TIMING
1377    if ( ! strcmp( sys_cmd, "gcdtime" ) ) {
1378        TIMING_PRINT( contentTimer, "time used for content: " );
1379        TIMING_PRINT( algContentTimer, "time used for algContent: " );
1380        TIMING_PRINT( algLcmTimer, "time used for algLcm: " );
1381        TIMING_RESET( contentTimer );
1382        TIMING_RESET( algContentTimer );
1383        TIMING_RESET( algLcmTimer );
1384        return FALSE;
1385    }
1386    else
1387#endif
1388
1389#ifdef FACTORY_GCD_STAT
1390    if ( ! strcmp( sys_cmd, "gcdstat" ) ) {
1391        printGcdTotal();
1392        printContTotal();
1393        resetGcdTotal();
1394        resetContTotal();
1395        return FALSE;
1396    }
1397    else
1398#endif
1399#if !defined(HAVE_NS)
1400/*==================== lib ==================================*/
1401    if(strcmp(sys_cmd,"LIB")==0)
1402    {
1403      idhdl hh=idroot->get((char*)h->Data(),0);
1404      if ((hh!=NULL)&&(IDTYP(hh)==PROC_CMD))
1405      {
1406        res->rtyp=STRING_CMD;
1407        char *r=iiGetLibName(IDPROC(hh));
1408        if (r==NULL) r="";
1409        res->data=omStrDup(r);
1410        return FALSE;
1411      }
1412      else
1413        Warn("`%s` not found",(char*)h->Data());
1414    }
1415    else
1416#endif
1417/*==================== listall ===================================*/
1418    if(strcmp(sys_cmd,"listall")==0)
1419    {
1420      int showproc=0;
1421      if ((h!=NULL) && (h->Typ()==INT_CMD)) showproc=(int)h->Data();
1422#ifdef HAVE_NS
1423      listall(showproc);
1424#else
1425      idhdl hh=IDROOT;
1426      while (hh!=NULL)
1427      {
1428        if (IDDATA(hh)==(void *)currRing) PrintS("(R)");
1429        else PrintS("   ");
1430        Print("::%s, typ %s level %d\n",
1431               IDID(hh),Tok2Cmdname(IDTYP(hh)),IDLEV(hh));
1432        hh=IDNEXT(hh);
1433      }
1434      hh=IDROOT;
1435      while (hh!=NULL)
1436      {
1437        if ((IDTYP(hh)==RING_CMD)
1438        || (IDTYP(hh)==QRING_CMD)
1439        || (IDTYP(hh)==PACKAGE_CMD))
1440        {
1441          idhdl h2=IDRING(hh)->idroot;
1442          while (h2!=NULL)
1443          {
1444            if (IDDATA(h2)==(void *)currRing) PrintS("(R)");
1445            else PrintS("   ");
1446            Print("%s::%s, typ %s level %d\n",
1447            IDID(hh),IDID(h2),Tok2Cmdname(IDTYP(h2)),IDLEV(h2));
1448            h2=IDNEXT(h2);
1449          }
1450        }
1451        hh=IDNEXT(hh);
1452      }
1453#endif /* HAVE_NS */
1454      return FALSE;
1455    }
1456    else
1457/*==================== proclist =================================*/
1458    if(strcmp(sys_cmd,"proclist")==0)
1459    {
1460      piShowProcList();
1461      return FALSE;
1462    }
1463    else
1464/* ==================== newton ================================*/
1465#ifdef HAVE_NEWTON
1466    if(strcmp(sys_cmd,"newton")==0)
1467    {
1468      if ((h->Typ()!=POLY_CMD)
1469      || (h->next->Typ()!=INT_CMD)
1470      || (h->next->next->Typ()!=INT_CMD))
1471      {
1472        WerrorS("system(\"newton\",<poly>,<int>,<int>) expected");
1473        return TRUE;
1474      }
1475      poly  p=(poly)(h->Data());
1476      int l=pLength(p);
1477      short *points=(short *)omAlloc(currRing->N*l*sizeof(short));
1478      int i,j,k;
1479      k=0;
1480      poly pp=p;
1481      for (i=0;pp!=NULL;i++)
1482      {
1483        for(j=1;j<=currRing->N;j++)
1484        {
1485          points[k]=pGetExp(pp,j);
1486          k++;
1487        }
1488        pIter(pp);
1489      }
1490      hc_ERG r=hc_KOENIG(currRing->N,      // dimension
1491                l,      // number of points
1492                (short*) points,   // points: x_1, y_1,z_1, x_2,y_2,z2,...
1493                currRing->OrdSgn==-1,
1494                (int) (h->next->Data()),      // 1: Milnor, 0: Newton
1495                (int) (h->next->next->Data()) // debug
1496               );
1497      //----<>---Output-----------------------
1498
1499
1500//  PrintS("Bin jetzt in extra.cc bei der Auswertung.\n"); // **********
1501
1502
1503      lists L=(lists)omAllocBin(slists_bin);
1504      L->Init(6);
1505      L->m[0].rtyp=STRING_CMD;               // newtonnumber;
1506      L->m[0].data=(void *)omStrDup(r.nZahl);
1507      L->m[1].rtyp=INT_CMD;
1508      L->m[1].data=(void *)r.achse;          // flag for unoccupied axes
1509      L->m[2].rtyp=INT_CMD;
1510      L->m[2].data=(void *)r.deg;            // #degenerations
1511      if ( r.deg != 0)              // only if degenerations exist
1512      {
1513        L->m[3].rtyp=INT_CMD;
1514        L->m[3].data=(void *)r.anz_punkte;     // #points
1515        //---<>--number of points------
1516        int anz = r.anz_punkte;    // number of points
1517        int dim = (currRing->N);     // dimension
1518        intvec* v = new intvec( anz*dim );
1519        for (i=0; i<anz*dim; i++)    // copy points
1520          (*v)[i] = r.pu[i];
1521        L->m[4].rtyp=INTVEC_CMD;
1522        L->m[4].data=(void *)v;
1523        //---<>--degenerations---------
1524        int deg = r.deg;    // number of points
1525        intvec* w = new intvec( r.speicher );  // necessary memeory
1526        i=0;               // start copying
1527        do
1528        {
1529          (*w)[i] = r.deg_tab[i];
1530          i++;
1531        }
1532        while (r.deg_tab[i-1] != -2);   // mark for end of list
1533        L->m[5].rtyp=INTVEC_CMD;
1534        L->m[5].data=(void *)w;
1535      }
1536      else
1537      {
1538        L->m[3].rtyp=INT_CMD; L->m[3].data=(char *)0;
1539        L->m[4].rtyp=DEF_CMD;
1540        L->m[5].rtyp=DEF_CMD;
1541      }
1542
1543      res->data=(void *)L;
1544      res->rtyp=LIST_CMD;
1545      // free all pointer in r:
1546      delete[] r.nZahl;
1547      delete[] r.pu;
1548      delete[] r.deg_tab;      // Ist das ein Problem??
1549
1550      omFreeSize((ADDRESS)points,currRing->N*l*sizeof(short));
1551      return FALSE;
1552    }
1553    else
1554#endif
1555/*==================== sdb_flags =================*/
1556#ifdef HAVE_SDB
1557    if (strcmp(sys_cmd, "sdb_flags") == 0)
1558    {
1559      if ((h!=NULL) && (h->Typ()==INT_CMD))
1560      {
1561        sdb_flags=(int)h->Data();
1562      }
1563      else
1564      {
1565        WerrorS("system(\"sdb_flags\",`int`) expected");
1566        return TRUE;
1567      }
1568      return FALSE;
1569    }
1570    else
1571/*==================== sdb_edit =================*/
1572    if (strcmp(sys_cmd, "sdb_edit") == 0)
1573    {
1574      if ((h!=NULL) && (h->Typ()==PROC_CMD))
1575      {
1576        procinfov p=(procinfov)h->Data();
1577        sdb_edit(p);
1578      }
1579      else
1580      {
1581        WerrorS("system(\"sdb_edit\",`proc`) expected");
1582        return TRUE;
1583      }
1584      return FALSE;
1585    }
1586    else
1587#endif
1588/*==================== GF =================*/
1589#if 0
1590    if (strcmp(sys_cmd, "GF") == 0)
1591    {
1592      int c=rChar(currRing);
1593      setCharacteristic( c, 2);
1594      CanonicalForm F( convSingGFClapGF( (poly)h->Data() ) );
1595      res->rtyp=POLY_CMD;
1596      res->data=convClapGFSingGF( F );
1597      return FALSE;
1598    }
1599    else
1600#endif
1601/*==================== stdX =================*/
1602    if (strcmp(sys_cmd, "std") == 0)
1603    {
1604      ideal i1;
1605      int i2;
1606      if ((h!=NULL) && (h->Typ()==MODUL_CMD))
1607      {
1608        i1=(ideal)h->CopyD();
1609        h=h->next;
1610      }
1611      else return TRUE;
1612      if ((h!=NULL) && (h->Typ()==INT_CMD))
1613      {
1614        i2=(int)h->Data();
1615      }
1616      else return TRUE;
1617      res->rtyp=MODUL_CMD;
1618      res->data=idXXX(i1,i2);
1619      return FALSE;
1620    }
1621    else
1622#ifdef HAVE_WALK
1623/*==================== walk stuff =================*/
1624    if (strcmp(sys_cmd, "walkNextWeight") == 0)
1625    {
1626      if (h == NULL || h->Typ() != INTVEC_CMD ||
1627          h->next == NULL || h->next->Typ() != INTVEC_CMD ||
1628          h->next->next == NULL || h->next->next->Typ() != IDEAL_CMD)
1629      {
1630        Werror("system(\"walkNextWeight\", intvec, intvec, ideal) expected");
1631        return TRUE;
1632      }
1633
1634      if (((intvec*) h->Data())->length() != currRing->N ||
1635          ((intvec*) h->next->Data())->length() != currRing->N)
1636      {
1637        Werror("system(\"walkNextWeight\" ...) intvecs not of length %d\n",
1638               currRing->N);
1639        return TRUE;
1640      }
1641      res->data = (void*) walkNextWeight(((intvec*) h->Data()),
1642                                         ((intvec*) h->next->Data()),
1643                                         (ideal) h->next->next->Data());
1644      if (res->data == (void*) 0 || res->data == (void*) 1)
1645      {
1646        res->rtyp = INT_CMD;
1647      }
1648      else
1649      {
1650        res->rtyp = INTVEC_CMD;
1651      }
1652      return FALSE;
1653    }
1654    else if (strcmp(sys_cmd, "walkInitials") == 0)
1655    {
1656      if (h == NULL || h->Typ() != IDEAL_CMD)
1657      {
1658        WerrorS("system(\"walkInitials\", ideal) expected");
1659        return TRUE;
1660      }
1661
1662      res->data = (void*) walkInitials((ideal) h->Data());
1663      res->rtyp = IDEAL_CMD;
1664      return FALSE;
1665    }
1666    else
1667#endif
1668#ifdef ix86_Win
1669#ifdef HAVE_DL
1670/*==================== DLL =================*/
1671/* testing the DLL functionality under Win32 */
1672      if (strcmp(sys_cmd, "DLL") == 0)
1673      {
1674        typedef void  (*Void_Func)();
1675        typedef int  (*Int_Func)(int);
1676        void *hh=dynl_open("WinDllTest.dll");
1677        if ((h!=NULL) && (h->Typ()==INT_CMD))
1678        {
1679          int (*f)(int);
1680          if (hh!=NULL)
1681          {
1682            int (*f)(int);
1683            f=(Int_Func)dynl_sym(hh,"PlusDll");
1684            int i=10;
1685            if (f!=NULL) printf("%d\n",f(i));
1686            else PrintS("cannot find PlusDll\n");
1687          }
1688        }
1689        else
1690        {
1691          void (*f)();
1692          f= (Void_Func)dynl_sym(hh,"TestDll");
1693          if (f!=NULL) f();
1694          else PrintS("cannot find TestDll\n");
1695        }
1696        return FALSE;
1697      }
1698      else
1699#endif
1700#endif
1701/*==================== eigenvalues ==================================*/
1702#ifdef HAVE_EIGENVAL
1703    if(strcmp(sys_cmd,"eigenvals")==0)
1704    {
1705      return evEigenvals(res,h);
1706    }
1707    else
1708#endif
1709/*==================== Gauss-Manin system ==================================*/
1710#ifdef HAVE_GMS
1711    if(strcmp(sys_cmd,"gmsnf")==0)
1712    {
1713      return gmsNF(res,h);
1714    }
1715    else
1716#endif
1717/*==================== t-rep-GB ==================================*/
1718    if (strcmp(sys_cmd, "trepgb")==0)
1719    {
1720      ring r = currRing;
1721      ideal i = (ideal)h->Data();
1722      h=h->next;
1723      if(h)
1724      {
1725       
1726        BOOLEAN b=(BOOLEAN) h->Data();
1727        res->data=t_rep_gb(r,i,b);
1728      }
1729      else
1730        res->data=t_rep_gb(r,i);
1731      res->rtyp=IDEAL_CMD;
1732      setFlag(res,FLAG_STD);
1733      return(FALSE);
1734    }
1735    else
1736      if (strcmp(sys_cmd, "unifastmult")==0)
1737    {
1738      ring r = currRing;
1739      poly f = (poly)h->Data();
1740      h=h->next;
1741      poly g=(poly)h->Data();
1742      res->rtyp=POLY_CMD;
1743      res->data=unifastmult(f,g,currRing);
1744      return(FALSE);
1745    }
1746    else
1747      if (strcmp(sys_cmd, "multifastmult")==0)
1748    {
1749      ring r = currRing;
1750      poly f = (poly)h->Data();
1751      h=h->next;
1752      poly g=(poly)h->Data();
1753      res->rtyp=POLY_CMD;
1754      res->data=multifastmult(f,g,currRing);
1755      return(FALSE);
1756    }
1757      else
1758
1759      if (strcmp(sys_cmd, "mults")==0)
1760    {
1761
1762      res->rtyp=INT_CMD ;
1763      res->data=(void*) Mults();
1764      return(FALSE);
1765    }
1766      else
1767        if (strcmp(sys_cmd, "fastpower")==0)
1768    {
1769      ring r = currRing;
1770      poly f = (poly)h->Data();
1771      h=h->next;
1772      int n=(int)h->Data();
1773      res->rtyp=POLY_CMD ;
1774      res->data=(void*) pFastPower(f,n,r);
1775      return(FALSE);
1776    }
1777        else
1778                if (strcmp(sys_cmd, "normalpower")==0)
1779    {
1780      ring r = currRing;
1781      poly f = (poly)h->Data();
1782      h=h->next;
1783      int n=(int)h->Data();
1784      res->rtyp=POLY_CMD ;
1785      res->data=(void*) pPower(pCopy(f),n);
1786      return(FALSE);
1787    }
1788    else
1789     
1790                if (strcmp(sys_cmd, "MCpower")==0)
1791    {
1792      ring r = currRing;
1793      poly f = (poly)h->Data();
1794      h=h->next;
1795      int n=(int)h->Data();
1796      res->rtyp=POLY_CMD ;
1797      res->data=(void*) pFastPowerMC(f,n,r);
1798      return(FALSE);
1799    }
1800    else
1801     
1802                if (strcmp(sys_cmd, "bit_subst")==0)
1803    {
1804      ring r = currRing;
1805      poly outer = (poly)h->Data();
1806      h=h->next;
1807      poly inner=(poly)h->Data();
1808      res->rtyp=POLY_CMD ;
1809      res->data=(void*) uni_subst_bits(outer, inner,r);
1810      return(FALSE);
1811    }
1812/*==================== Error =================*/
1813      Werror( "system(\"%s\",...) %s", sys_cmd, feNotImplemented );
1814  }
1815  return TRUE;
1816}
1817#endif // HAVE_EXTENDED_SYSTEM
Note: See TracBrowser for help on using the repository browser.