source: git/Singular/extra.cc @ 206aed

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