source: git/Singular/extra.cc @ d5b766

spielwiese
Last change on this file since d5b766 was d5b766, checked in by Mathias Schulze <mschulze@…>, 23 years ago
*mschulze: added include units.h git-svn-id: file:///usr/local/Singular/svn/trunk@5163 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 32.3 KB
Line 
1/*****************************************
2*  Computer Algebra System SINGULAR      *
3*****************************************/
4/* $Id: extra.cc,v 1.154 2001-02-01 13:23:12 mschulze Exp $ */
5/*
6* ABSTRACT: general interface to internals of Singular ("system" command)
7*/
8
9#include <stdlib.h>
10#if defined(__alpha)
11extern "C"
12{
13  int setenv(const char *name, const char *value, int overwrite);
14}
15#endif
16
17#include <stdio.h>
18#include <string.h>
19#include <ctype.h>
20#include <signal.h>
21#include "mod2.h"
22
23#ifndef __MWERKS__
24#ifdef TIME_WITH_SYS_TIME
25# include <time.h>
26# ifdef HAVE_SYS_TIME_H
27#   include <sys/time.h>
28# endif
29#else
30# ifdef HAVE_SYS_TIME_H
31#   include <sys/time.h>
32# else
33#   include <time.h>
34# endif
35#endif
36#ifdef HAVE_SYS_TIMES_H
37#include <sys/times.h>
38#endif
39
40#endif
41#include <unistd.h>
42
43#include "tok.h"
44#include "ipid.h"
45#include "polys.h"
46#include "kutil.h"
47#include "cntrlc.h"
48#include "stairc.h"
49#include "ipshell.h"
50#include "algmap.h"
51#include "modulop.h"
52#include "febase.h"
53#include "matpol.h"
54#include "longalg.h"
55#include "ideals.h"
56#include "kstd1.h"
57#include "syz.h"
58#include "sdb.h"
59#include "feOpt.h"
60#include "distrib.h"
61#include "prCopy.h"
62#include "mpr_complex.h"
63
64#include "walk.h"
65
66#ifdef HAVE_SPECTRUM
67#include "spectrum.h"
68#endif
69
70#ifdef HAVE_PLURAL
71#include "gring.h"
72#endif
73
74// Define to enable many more system commands
75#ifndef MAKE_DISTRIBUTION
76#define HAVE_EXTENDED_SYSTEM
77#endif
78
79#ifdef HAVE_FACTORY
80#define SI_DONT_HAVE_GLOBAL_VARS
81#include "clapsing.h"
82#include "clapconv.h"
83#include "kstdfac.h"
84#endif
85
86#include "silink.h"
87#include "walk.h"
88
89#include "rednf.h"
90
91/*
92 *   New function/system-calls that will be included as dynamic module
93 * should be inserted here.
94 * - without HAVE_DYNAMIC_LOADING: these functions comes as system("....");
95 * - with    HAVE_DYNAMIC_LOADING: these functions are loaded as module.
96 */
97#ifndef HAVE_DYNAMIC_LOADING
98#ifdef HAVE_PCV
99#include "pcv.h"
100#endif
101#endif /* not HAVE_DYNAMIC_LOADING */
102
103// procedures to compute with units
104#ifdef HAVE_UNITS
105#include "units.h"
106#endif
107
108// see clapsing.cc for a description of the `FACTORY_*' options
109
110#ifdef FACTORY_GCD_STAT
111#include "gcd_stat.h"
112#endif
113
114#ifdef FACTORY_GCD_TIMING
115#define TIMING
116#include "timing.h"
117TIMING_DEFINE_PRINTPROTO( contentTimer );
118TIMING_DEFINE_PRINTPROTO( algContentTimer );
119TIMING_DEFINE_PRINTPROTO( algLcmTimer );
120#endif
121
122void piShowProcList();
123#ifndef MAKE_DISTRIBUTION
124static BOOLEAN jjEXTENDED_SYSTEM(leftv res, leftv h);
125#endif
126
127
128//void emStart();
129/*2
130*  the "system" command
131*/
132BOOLEAN jjSYSTEM(leftv res, leftv args)
133{
134  if(args->Typ() == STRING_CMD)
135  {
136    const char *sys_cmd=(char *)(args->Data());
137    leftv h=args->next;
138// ONLY documented system calls go here
139// Undocumented system calls go down into #ifdef HAVE_EXTENDED_SYSTEM
140/*==================== nblocks ==================================*/
141    if (strcmp(sys_cmd, "nblocks") == 0)
142    {
143      ring r;
144      if (h == NULL)
145      {
146        if (currRingHdl != NULL)
147        {
148          r = IDRING(currRingHdl);
149        }
150        else
151        {
152          WerrorS("no ring active");
153          return TRUE;
154        }
155      }
156      else
157      {
158        if (h->Typ() != RING_CMD)
159        {
160          WerrorS("ring expected");
161          return TRUE;
162        }
163        r = (ring) h->Data();
164      }
165      res->rtyp = INT_CMD;
166      res->data = (void*) (rBlocks(r) - 1);
167      return FALSE;
168    }
169/*==================== version ==================================*/
170    if(strcmp(sys_cmd,"version")==0)
171    {
172      res->rtyp=INT_CMD;
173      res->data=(void *)SINGULAR_VERSION;
174      return FALSE;
175    }
176    else
177/*==================== gen ==================================*/
178    if(strcmp(sys_cmd,"gen")==0)
179    {
180      res->rtyp=INT_CMD;
181      res->data=(void *)npGen;
182      return FALSE;
183    }
184    else
185/*==================== sh ==================================*/
186    if(strcmp(sys_cmd,"sh")==0)
187    {
188      res->rtyp=INT_CMD;
189      #ifndef __MWERKS__
190      if (h==NULL) res->data = (void *)system("sh");
191      else if (h->Typ()==STRING_CMD)
192        res->data = (void*) system((char*)(h->Data()));
193      else
194        WerrorS("string expected");
195      #else
196      res->data=(void *)0;
197      #endif
198      return FALSE;
199    }
200    else
201/*==================== uname ==================================*/
202    if(strcmp(sys_cmd,"uname")==0)
203    {
204      res->rtyp=STRING_CMD;
205      res->data = omStrDup(S_UNAME);
206      return FALSE;
207    }
208    else
209/*==================== with ==================================*/
210    if(strcmp(sys_cmd,"with")==0)
211    {
212      if (h==NULL)
213      {
214        res->rtyp=STRING_CMD;
215        res->data=(void *)omStrDup(versionString());
216        return FALSE;
217      }
218      else if (h->Typ()==STRING_CMD)
219      {
220        #define TEST_FOR(A) if(strcmp(s,A)==0) res->data=(void *)1; else
221        char *s=(char *)h->Data();
222        res->rtyp=INT_CMD;
223        #ifdef HAVE_DBM
224          TEST_FOR("DBM")
225        #endif
226        #ifdef HAVE_DLD
227          TEST_FOR("DLD")
228        #endif
229        #ifdef HAVE_FACTORY
230          TEST_FOR("factory")
231        #endif
232        #ifdef HAVE_LIBFAC_P
233          TEST_FOR("libfac")
234        #endif
235        #ifdef HAVE_MPSR
236          TEST_FOR("MP")
237        #endif
238        #ifdef HAVE_READLINE
239          TEST_FOR("readline")
240        #endif
241        #ifdef HAVE_TCL
242          TEST_FOR("tcl")
243        #endif
244        #ifdef TEST_MAC_ORDER
245          TEST_FOR("MAC_ORDER");
246        #endif
247        #ifdef HAVE_NAMESPACES
248          TEST_FOR("Namespaces");
249        #endif
250        #ifdef HAVE_DYNAMIC_LOADING
251          TEST_FOR("DynamicLoading");
252        #endif
253          ;
254        return FALSE;
255        #undef TEST_FOR
256      }
257      return TRUE;
258    }
259    else
260/*==================== browsers ==================================*/
261    if (strcmp(sys_cmd,"browsers")==0)
262    {
263      res->rtyp = STRING_CMD;
264      char* b = StringSetS("");
265      feStringAppendBrowsers(0);
266      res->data = omStrDup(b);
267      return FALSE;
268    }
269    else
270/*==================== pid ==================================*/
271    if (strcmp(sys_cmd,"pid")==0)
272    {
273      res->rtyp=INT_CMD;
274    #ifndef MSDOS
275    #ifndef __MWERKS__
276      res->data=(void *)getpid();
277    #else
278      res->data=(void *)1;
279    #endif
280    #else
281      res->data=(void *)1;
282    #endif
283      return FALSE;
284    }
285    else
286/*==================== getenv ==================================*/
287    if (strcmp(sys_cmd,"getenv")==0)
288    {
289      if ((h!=NULL) && (h->Typ()==STRING_CMD))
290      {
291        res->rtyp=STRING_CMD;
292        char *r=getenv((char *)h->Data());
293        if (r==NULL) r="";
294        res->data=(void *)omStrDup(r);
295        return FALSE;
296      }
297      else
298      {
299        WerrorS("string expected");
300        return TRUE;
301      }
302    }
303    else
304/*==================== setenv ==================================*/
305    if (strcmp(sys_cmd,"setenv")==0)
306    {
307#ifdef HAVE_SETENV
308      if (h!=NULL && h->Typ()==STRING_CMD && h->Data() != NULL &&
309          h->next != NULL && h->next->Typ() == STRING_CMD
310          && h->next->Data() != NULL)
311      {
312        res->rtyp=STRING_CMD;
313        setenv((char *)h->Data(), (char *)h->next->Data(), 1);
314        res->data=(void *)omStrDup((char *)h->next->Data());
315        feReInitResources();
316        return FALSE;
317      }
318      else
319      {
320        WerrorS("two strings expected");
321        return TRUE;
322      }
323#else
324      WerrorS("setenv not supported on this platform");
325      return TRUE;
326#endif
327    }
328    else
329/*==================== Singular ==================================*/
330    if (strcmp(sys_cmd, "Singular") == 0)
331    {
332      res->rtyp=STRING_CMD;
333      char *r=feResource("Singular");
334      if (r != NULL)
335        res->data = (void*) omStrDup( r );
336      else
337        res->data = (void*) omStrDup("");
338      return FALSE;
339    }
340    else
341/*==================== options ==================================*/
342    if (strstr(sys_cmd, "--") == sys_cmd)
343    {
344      if (strcmp(sys_cmd, "--") == 0)
345      {
346        fePrintOptValues();
347        return FALSE;
348      }
349
350      feOptIndex opt = feGetOptIndex(&sys_cmd[2]);
351      if (opt == FE_OPT_UNDEF)
352      {
353        Werror("Unknown option %s", sys_cmd);
354        Werror("Use 'system(\"--\");' for listing of available options");
355        return TRUE;
356      }
357
358      // for Untyped Options (help version),
359      // setting it just triggers action
360      if (feOptSpec[opt].type == feOptUntyped)
361      {
362        feSetOptValue(opt,0);
363        return FALSE;
364      }
365
366      if (h == NULL)
367      {
368        if (feOptSpec[opt].type == feOptString)
369        {
370          res->rtyp = STRING_CMD;
371          if (feOptSpec[opt].value != NULL)
372            res->data = omStrDup((char*) feOptSpec[opt].value);
373          else
374            res->data = omStrDup("");
375        }
376        else
377        {
378          res->rtyp = INT_CMD;
379          res->data = feOptSpec[opt].value;
380        }
381        return FALSE;
382      }
383
384      if (h->Typ() != STRING_CMD &&
385          h->Typ() != INT_CMD)
386      {
387        Werror("Need string or int argument to set option value");
388        return TRUE;
389      }
390      char* errormsg;
391      if (h->Typ() == INT_CMD)
392      {
393        if (feOptSpec[opt].type == feOptString)
394        {
395          Werror("Need string argument to set value of option %s", sys_cmd);
396          return TRUE;
397        }
398        errormsg = feSetOptValue(opt, (int) h->Data());
399        if (errormsg != NULL)
400          Werror("Option '--%s=%d' %s", sys_cmd, (int) h->Data(), errormsg);
401      }
402      else
403      {
404        errormsg = feSetOptValue(opt, (char*) h->Data());
405        if (errormsg != NULL)
406          Werror("Option '--%s=%s' %s", sys_cmd, (char*) h->Data(), errormsg);
407      }
408      if (errormsg != NULL) return TRUE;
409      return FALSE;
410    }
411    else
412/*==================== HC ==================================*/
413    if (strcmp(sys_cmd,"HC")==0)
414    {
415      res->rtyp=INT_CMD;
416      res->data=(void *)HCord;
417      return FALSE;
418    }
419    else
420/*==================== random ==================================*/
421    if(strcmp(sys_cmd,"random")==0)
422    {
423      if ((h!=NULL) &&(h->Typ()==INT_CMD))
424      {
425        siRandomStart=(int)h->Data();
426#ifdef buildin_rand
427        siSeed=siRandomStart;
428#else
429        srand((unsigned int)siRandomStart);
430#endif
431#ifdef HAVE_FACTORY
432        factoryseed(siRandomStart);
433#endif
434        return FALSE;
435      }
436      else if (h != NULL)
437      {
438        WerrorS("int expected");
439        return TRUE;
440      }
441      res->rtyp=INT_CMD;
442      res->data=(void*) siRandomStart;
443      return FALSE;
444    }
445/*==================== complexNearZero ======================*/
446    if(strcmp(sys_cmd,"complexNearZero")==0)
447    {
448      if (h->Typ()==NUMBER_CMD )
449      {
450        if ( h->next!=NULL && h->next->Typ()==INT_CMD )
451        {
452          if ( !rField_is_long_C() )
453            {
454              Werror( "unsupported ground field!");
455              return TRUE;
456            }
457          else
458            {
459              res->rtyp=INT_CMD;
460              res->data=(void*)complexNearZero((gmp_complex*)h->Data(),(int)h->next->Data());
461              return FALSE;
462            }
463        }
464        else
465        {
466          Werror( "expected <int> as third parameter!");
467          return TRUE;
468        }
469      }
470      else
471      {
472        Werror( "expected <number> as second parameter!");
473        return TRUE;
474      }
475    }
476/*==================== getPrecDigits ======================*/
477    if(strcmp(sys_cmd,"getPrecDigits")==0)
478    {
479      if ( !rField_is_long_C() && !rField_is_long_R() )
480      {
481        Werror( "unsupported ground field!");
482        return TRUE;
483      }
484      res->rtyp=INT_CMD;
485      res->data=(void*)getGMPFloatDigits();
486      return FALSE;
487    }
488/*==================== neworder =============================*/
489// should go below
490#ifdef HAVE_LIBFAC_P
491    if(strcmp(sys_cmd,"neworder")==0)
492    {
493      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
494      {
495        res->rtyp=STRING_CMD;
496        res->data=(void *)singclap_neworder((ideal)h->Data());
497        return FALSE;
498      }
499      else
500        WerrorS("ideal expected");
501    }
502    else
503#endif
504/*==================== rednf ==================================*/
505    if(strcmp(sys_cmd,"invunit")==0)
506    {
507      return invunit(res,h);
508    }
509    else
510    if(strcmp(sys_cmd,"expand")==0)
511    {
512      return expand(res,h);
513    }
514    else
515    if(strcmp(sys_cmd,"rednf")==0)
516    {
517      return rednf(res,h);
518    }
519    else
520/*==================== pcv ==================================*/
521#ifndef HAVE_DYNAMIC_LOADING
522#ifdef HAVE_PCV
523    if(strcmp(sys_cmd,"pcvLAddL")==0)
524    {
525      return pcvLAddL(res,h);
526    }
527    else
528    if(strcmp(sys_cmd,"pcvPMulL")==0)
529    {
530      return pcvPMulL(res,h);
531    }
532    else
533    if(strcmp(sys_cmd,"pcvMinDeg")==0)
534    {
535      return pcvMinDeg(res,h);
536    }
537    else
538    if(strcmp(sys_cmd,"pcvP2CV")==0)
539    {
540      return pcvP2CV(res,h);
541    }
542    else
543    if(strcmp(sys_cmd,"pcvCV2P")==0)
544    {
545      return pcvCV2P(res,h);
546    }
547    else
548    if(strcmp(sys_cmd,"pcvDim")==0)
549    {
550      return pcvDim(res,h);
551    }
552    else
553    if(strcmp(sys_cmd,"pcvBasis")==0)
554    {
555      return pcvBasis(res,h);
556    }
557    else
558#endif
559#endif /* HAVE_DYNAMIC_LOADING */
560/*==================== contributors =============================*/
561   if(strcmp(sys_cmd,"contributors") == 0)
562   {
563     res->rtyp=STRING_CMD;
564     res->data=(void *)omStrDup(
565       "Olaf Bachmann, Hubert Grassmann, Kai Krueger, Wolfgang Neumann, Thomas Nuessler, Wilfred Pohl, Jens Schmidt, Thomas Siebert, Ruediger Stobbe, Moritz Wenk, Tim Wichmann");
566     return FALSE;
567   }
568   else
569/*==================== spectrum =============================*/
570   #ifdef HAVE_SPECTRUM
571   if(strcmp(sys_cmd,"spectrum") == 0)
572   {
573     if (h->Typ()!=POLY_CMD)
574     {
575       WerrorS("poly expected");
576       return TRUE;
577     }
578     if (h->next==NULL)
579       return spectrumProc(res,h);
580     if (h->next->Typ()!=INT_CMD)
581     {
582       WerrorS("poly,int expected");
583       return TRUE;
584     }
585     if(((int)h->next->Data())==1)
586       return spectrumfProc(res,h);
587     return spectrumProc(res,h);
588   }
589   else
590/*==================== semic =============================*/
591   if(strcmp(sys_cmd,"semic") == 0)
592   {
593     if ((h->next!=NULL)
594     && (h->Typ()==LIST_CMD)
595     && (h->next->Typ()==LIST_CMD))
596     {
597       if (h->next->next==NULL)
598         return semicProc(res,h,h->next);
599       else if (h->next->next->Typ()==INT_CMD)
600         return semicProc3(res,h,h->next,h->next->next);
601     }
602     return TRUE;
603   }
604   else
605/*==================== spadd =============================*/
606   if(strcmp(sys_cmd,"spadd") == 0)
607   {
608     if ((h->next!=NULL)
609     && (h->Typ()==LIST_CMD)
610     && (h->next->Typ()==LIST_CMD))
611     {
612       if (h->next->next==NULL)
613         return spaddProc(res,h,h->next);
614     }
615     return TRUE;
616   }
617   else
618/*==================== spmul =============================*/
619   if(strcmp(sys_cmd,"spmul") == 0)
620   {
621     if ((h->next!=NULL)
622     && (h->Typ()==LIST_CMD)
623     && (h->next->Typ()==INT_CMD))
624     {
625       if (h->next->next==NULL)
626         return spmulProc(res,h,h->next);
627     }
628     return TRUE;
629   }
630   else
631   #endif
632/*================= Extended system call ========================*/
633   {
634     #ifndef MAKE_DISTRIBUTION
635     return(jjEXTENDED_SYSTEM(res, args));
636     #else
637     Werror( "system(\"%s\",...) %s", sys_cmd, feNotImplemented );
638     #endif
639   }
640  } /* typ==string */
641  return TRUE;
642}
643
644
645
646#ifdef HAVE_EXTENDED_SYSTEM
647// You can put your own system calls here
648#include "fglmcomb.cc"
649#include "fglm.h"
650#ifdef HAVE_NEWTON
651#include <hc_newton.h>
652#endif
653#include "mpsr.h"
654
655#include "mod_raw.h"
656   
657static BOOLEAN jjEXTENDED_SYSTEM(leftv res, leftv h)
658{
659  if(h->Typ() == STRING_CMD)
660  {
661    char *sys_cmd=(char *)(h->Data());
662    h=h->next;
663#ifdef RDEBUG
664/*==================== poly debug ==================================*/
665    if(strcmp(sys_cmd,"p")==0)
666    {
667      pDebugPrint((poly)h->Data());
668      return FALSE;
669    }
670    else
671/*==================== ring debug ==================================*/
672    if(strcmp(sys_cmd,"r")==0)
673    {
674      rDebugPrint((ring)h->Data());
675      return FALSE;
676    }
677    else
678#endif
679/*==================== mtrack ==================================*/
680    if(strcmp(sys_cmd,"mtrack")==0)
681    {
682#ifdef OM_TRACK
683      om_Opts.MarkAsStatic = 1;
684      FILE *fd = NULL;
685      int max = 5;
686      while (h != NULL)
687      {
688        omMarkAsStaticAddr(h);
689        if (fd == NULL && h->Typ()==STRING_CMD)
690        {
691          fd = fopen((char*) h->Data(), "w");
692          if (fd == NULL)
693            Warn("Can not open %s for writing og mtrack. Using stdout");
694        }
695        if (h->Typ() == INT_CMD)
696        {
697          max = (int) h->Data();
698        }
699        h = h->Next();
700      }
701      omPrintUsedTrackAddrs((fd == NULL ? stdout : fd), max);
702      if (fd != NULL) fclose(fd);
703      om_Opts.MarkAsStatic = 0;
704      return FALSE;
705#else
706     WerrorS("mtrack not supported without OM_TRACK");
707     return TRUE;
708#endif
709    }
710/*==================== mtrack_all ==================================*/
711    if(strcmp(sys_cmd,"mtrack_all")==0)
712    {
713#ifdef OM_TRACK
714      om_Opts.MarkAsStatic = 1;
715      FILE *fd = NULL;
716      if ((h!=NULL) &&(h->Typ()==STRING_CMD))
717      {
718        fd = fopen((char*) h->Data(), "w");
719        if (fd == NULL)
720          Warn("Can not open %s for writing og mtrack. Using stdout");
721        omMarkAsStaticAddr(h);
722      }
723      // OB: TBC print to fd
724      omPrintUsedAddrs((fd == NULL ? stdout : fd), 5);
725      if (fd != NULL) fclose(fd);
726      om_Opts.MarkAsStatic = 0;
727      return FALSE;
728#else
729     WerrorS("mtrack not supported without OM_TRACK");
730     return TRUE;
731#endif
732    }
733    else
734/*==================== backtrace ==================================*/
735    if(strcmp(sys_cmd,"backtrace")==0)
736    {
737#ifndef OM_NDEBUG
738      omPrintCurrentBackTrace(stdout);
739      return FALSE;
740#else
741     WerrorS("btrack not supported without OM_TRACK");
742     return TRUE;
743#endif
744    }
745    else
746/*==================== naIdeal ==================================*/
747    if(strcmp(sys_cmd,"naIdeal")==0)
748    {
749      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
750      {
751        naSetIdeal((ideal)h->Data());
752        return FALSE;
753      }
754      else
755         WerrorS("ideal expected");
756    }
757    else
758/*==================== isSqrFree =============================*/
759#ifdef HAVE_FACTORY
760    if(strcmp(sys_cmd,"isSqrFree")==0)
761    {
762      if ((h!=NULL) &&(h->Typ()==POLY_CMD))
763      {
764        res->rtyp=INT_CMD;
765        res->data=(void *)singclap_isSqrFree((poly)h->Data());
766        return FALSE;
767      }
768      else
769        WerrorS("poly expected");
770    }
771    else
772#endif
773/*==================== pDivStat =============================*/
774#if defined(PDEBUG) || defined(PDIV_DEBUG)
775    if(strcmp(sys_cmd,"pDivStat")==0)
776    {
777      extern void pPrintDivisbleByStat();
778      pPrintDivisbleByStat();
779      return FALSE;
780    }
781    else
782#endif
783/*==================== alarm ==================================*/
784#ifndef __MWERKS__
785#ifndef MSDOS
786#ifndef atarist
787#ifdef unix
788    if(strcmp(sys_cmd,"alarm")==0)
789    {
790      if ((h!=NULL) &&(h->Typ()==INT_CMD))
791      {
792        // standard variant -> SIGALARM (standard: abort)
793        //alarm((unsigned)h->next->Data());
794        // process time (user +system): SIGVTALARM
795        struct itimerval t,o;
796        memset(&t,0,sizeof(t));
797        t.it_value.tv_sec     =(unsigned)h->Data();
798        setitimer(ITIMER_VIRTUAL,&t,&o);
799        return FALSE;
800      }
801      else
802        WerrorS("int expected");
803    }
804    else
805#endif
806#endif
807#endif
808#endif
809/*==================== red =============================*/
810#if 0
811    if(strcmp(sys_cmd,"red")==0)
812    {
813      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
814      {
815        res->rtyp=IDEAL_CMD;
816        res->data=(void *)kStdred((ideal)h->Data(),NULL,testHomog,NULL);
817        setFlag(res,FLAG_STD);
818        return FALSE;
819      }
820      else
821        WerrorS("ideal expected");
822    }
823    else
824#endif
825/*==================== algfetch =====================*/
826    if (strcmp(sys_cmd,"algfetch")==0)
827    {
828      int k;
829      idhdl w;
830      ideal i0, i1;
831      ring r0=(ring)h->Data();
832      leftv v = h->next;
833      w = r0->idroot->get(v->Name(),myynest);
834      if (w!=NULL)
835      {
836        if (IDTYP(w)==IDEAL_CMD)
837        {
838          i0 = IDIDEAL(w);
839          i1 = idInit(IDELEMS(i0),i0->rank);
840          for (k=0; k<IDELEMS(i1); k++)
841          {
842            i1->m[k] = maAlgpolyFetch(r0, i0->m[k]);
843          }
844          res->rtyp = IDEAL_CMD;
845          res->data = (void*)i1;
846          return FALSE;
847        }
848        else if (IDTYP(w)==POLY_CMD)
849        {
850          res->rtyp = POLY_CMD;
851          res->data = (void*)maAlgpolyFetch(r0,IDPOLY(w));
852          return FALSE;
853        }
854        else
855          WerrorS("`system(\"algfetch\",<ideal>/<poly>)` expected");
856      }
857      else
858        Werror("`%s` not found in `%s`",v->Name(),h->Name());
859    }
860    else
861/*==================== algmap =======================*/
862    if (strcmp(sys_cmd,"algmap")==0)
863    {
864      int k;
865      idhdl w;
866      ideal i0, i1, i, j;
867      ring r0=(ring)h->Data();
868      leftv v = h->next;
869      w = r0->idroot->get(v->Name(),myynest);
870      i0 = IDIDEAL(w);
871      v = v->next;
872      i = (ideal)v->Data();
873      v = v->next;
874      j = (ideal)v->Data();
875      i1 = idInit(IDELEMS(i0),i0->rank);
876      for (k=0; k<IDELEMS(i1); k++)
877      {
878        i1->m[k] = maAlgpolyMap(r0, i0->m[k], i, j);
879      }
880      res->rtyp = IDEAL_CMD;
881      res->data = (void*)i1;
882      return FALSE;
883    }
884    else
885#ifdef HAVE_FACTORY
886/*==================== fastcomb =============================*/
887    if(strcmp(sys_cmd,"fastcomb")==0)
888    {
889      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
890      {
891        int i=0;
892        if (h->next!=NULL)
893        {
894          if (h->next->Typ()!=POLY_CMD)
895          {
896            Warn("Wrong types for poly= comb(ideal,poly)");
897          }
898        }
899        res->rtyp=POLY_CMD;
900        res->data=(void *) fglmLinearCombination(
901                           (ideal)h->Data(),(poly)h->next->Data());
902        return FALSE;
903      }
904      else
905        WerrorS("ideal expected");
906    }
907    else
908/*==================== comb =============================*/
909    if(strcmp(sys_cmd,"comb")==0)
910    {
911      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
912      {
913        int i=0;
914        if (h->next!=NULL)
915        {
916          if (h->next->Typ()!=POLY_CMD)
917          {
918              Warn("Wrong types for poly= comb(ideal,poly)");
919          }
920        }
921        res->rtyp=POLY_CMD;
922        res->data=(void *)fglmNewLinearCombination(
923                            (ideal)h->Data(),(poly)h->next->Data());
924        return FALSE;
925      }
926      else
927        WerrorS("ideal expected");
928    }
929    else
930#endif
931#ifdef FACTORY_GCD_TEST
932/*=======================gcd Testerei ================================*/
933    if ( ! strcmp( sys_cmd, "setgcd" ) ) {
934        if ( (h != NULL) && (h->Typ() == INT_CMD) ) {
935            CFPrimitiveGcdUtil::setAlgorithm( (int)h->Data() );
936            return FALSE;
937        } else
938            WerrorS("int expected");
939    }
940    else
941#endif
942
943#ifdef FACTORY_GCD_TIMING
944    if ( ! strcmp( sys_cmd, "gcdtime" ) ) {
945        TIMING_PRINT( contentTimer, "time used for content: " );
946        TIMING_PRINT( algContentTimer, "time used for algContent: " );
947        TIMING_PRINT( algLcmTimer, "time used for algLcm: " );
948        TIMING_RESET( contentTimer );
949        TIMING_RESET( algContentTimer );
950        TIMING_RESET( algLcmTimer );
951        return FALSE;
952    }
953    else
954#endif
955
956#ifdef FACTORY_GCD_STAT
957    if ( ! strcmp( sys_cmd, "gcdstat" ) ) {
958        printGcdTotal();
959        printContTotal();
960        resetGcdTotal();
961        resetContTotal();
962        return FALSE;
963    }
964    else
965#endif
966/*==================== lib ==================================*/
967    if(strcmp(sys_cmd,"LIB")==0)
968    {
969#ifdef HAVE_NAMESPACES
970      idhdl hh=namespaceroot->get((char*)h->Data(),0);
971#else /* HAVE_NAMESPACES */
972      idhdl hh=idroot->get((char*)h->Data(),0);
973#endif /* HAVE_NAMESPACES */
974      if ((hh!=NULL)&&(IDTYP(hh)==PROC_CMD))
975      {
976        res->rtyp=STRING_CMD;
977        char *r=iiGetLibName(IDPROC(hh));
978        if (r==NULL) r="";
979        res->data=omStrDup(r);
980        return FALSE;
981      }
982      else
983        Warn("`%s` not found",(char*)h->Data());
984    }
985    else
986#ifdef HAVE_NAMESPACES
987/*==================== nspush ===================================*/
988    if(strcmp(sys_cmd,"nspush")==0)
989    {
990      if (h->Typ()==PACKAGE_CMD)
991      {
992        idhdl hh=(idhdl)h->data;
993        namespaceroot = namespaceroot->push(IDPACKAGE(hh), IDID(hh));
994        return FALSE;
995      }
996      else
997        Warn("argument 2 is not a package");
998    }
999    else
1000/*==================== nspop ====================================*/
1001    if(strcmp(sys_cmd,"nspop")==0)
1002    {
1003      namespaceroot->pop();
1004      return FALSE;
1005    }
1006    else
1007#endif /* HAVE_NAMESPACES */
1008/*==================== nsstack ===================================*/
1009    if(strcmp(sys_cmd,"nsstack")==0)
1010    {
1011      namehdl nshdl = namespaceroot;
1012      for( ; nshdl->isroot != TRUE; nshdl = nshdl->next) {
1013        Print("NSstack: %s:%d, nesting=%d\n", nshdl->name, nshdl->lev, nshdl->myynest);
1014      }
1015      Print("NSstack: %s:%d, nesting=%d\n", nshdl->name, nshdl->lev, nshdl->myynest);
1016      return FALSE;
1017    }
1018    else
1019/*==================== proclist =================================*/
1020    if(strcmp(sys_cmd,"proclist")==0)
1021    {
1022      piShowProcList();
1023      return FALSE;
1024    }
1025    else
1026/* ==================== newton ================================*/
1027#ifdef HAVE_NEWTON
1028    if(strcmp(sys_cmd,"newton")==0)
1029    {
1030      if ((h->Typ()!=POLY_CMD)
1031      || (h->next->Typ()!=INT_CMD)
1032      || (h->next->next->Typ()!=INT_CMD))
1033      {
1034        WerrorS("system(\"newton\",<poly>,<int>,<int>) expected");
1035        return TRUE;
1036      }
1037      poly  p=(poly)(h->Data());
1038      int l=pLength(p);
1039      short *points=(short *)omAlloc(currRing->N*l*sizeof(short));
1040      int i,j,k;
1041      k=0;
1042      poly pp=p;
1043      for (i=0;pp!=NULL;i++)
1044      {
1045        for(j=1;j<=currRing->N;j++)
1046        {
1047          points[k]=pGetExp(pp,j);
1048          k++;
1049        }
1050        pIter(pp);
1051      }
1052      hc_ERG r=hc_KOENIG(currRing->N,      // dimension
1053                l,      // number of points
1054                (short*) points,   // points: x_1, y_1,z_1, x_2,y_2,z2,...
1055                currRing->OrdSgn==-1,
1056                (int) (h->next->Data()),      // 1: Milnor, 0: Newton
1057                (int) (h->next->next->Data()) // debug
1058               );
1059      //----<>---Output-----------------------
1060
1061
1062//  PrintS("Bin jetzt in extra.cc bei der Auswertung.\n"); // **********
1063
1064
1065      lists L=(lists)omAllocBin(slists_bin);
1066      L->Init(6);
1067      L->m[0].rtyp=STRING_CMD;               // newtonnumber;
1068      L->m[0].data=(void *)omStrDup(r.nZahl);
1069      L->m[1].rtyp=INT_CMD;
1070      L->m[1].data=(void *)r.achse;          // flag for unoccupied axes
1071      L->m[2].rtyp=INT_CMD;
1072      L->m[2].data=(void *)r.deg;            // #degenerations
1073      if ( r.deg != 0)              // only if degenerations exist
1074      {
1075        L->m[3].rtyp=INT_CMD;
1076        L->m[3].data=(void *)r.anz_punkte;     // #points
1077        //---<>--number of points------
1078        int anz = r.anz_punkte;    // number of points
1079        int dim = (currRing->N);     // dimension
1080        intvec* v = new intvec( anz*dim );
1081        for (i=0; i<anz*dim; i++)    // copy points
1082          (*v)[i] = r.pu[i];
1083        L->m[4].rtyp=INTVEC_CMD;
1084        L->m[4].data=(void *)v;
1085        //---<>--degenerations---------
1086        int deg = r.deg;    // number of points
1087        intvec* w = new intvec( r.speicher );  // necessary memeory
1088        i=0;               // start copying
1089        do
1090        {
1091          (*w)[i] = r.deg_tab[i];
1092          i++;
1093        }
1094        while (r.deg_tab[i-1] != -2);   // mark for end of list
1095        L->m[5].rtyp=INTVEC_CMD;
1096        L->m[5].data=(void *)w;
1097      }
1098      else
1099      {
1100        L->m[3].rtyp=INT_CMD; L->m[3].data=(char *)0;
1101        L->m[4].rtyp=DEF_CMD;
1102        L->m[5].rtyp=DEF_CMD;
1103      }
1104
1105      res->data=(void *)L;
1106      res->rtyp=LIST_CMD;
1107      // free all pointer in r:
1108      delete[] r.nZahl;
1109      delete[] r.pu;
1110      delete[] r.deg_tab;      // Ist das ein Problem??
1111
1112      omFreeSize((ADDRESS)points,currRing->N*l*sizeof(short));
1113      return FALSE;
1114    }
1115    else
1116#endif
1117/*==================== sdb_flags =================*/
1118    if (strcmp(sys_cmd, "sdb_flags") == 0)
1119    {
1120      if ((h!=NULL) && (h->Typ()==INT_CMD))
1121      {
1122        sdb_flags=(int)h->Data();
1123      }
1124      else
1125      {
1126        WerrorS("system(\"sdb_flags\",`int`) expected");
1127        return TRUE;
1128      }
1129      return FALSE;
1130    }
1131    else
1132/*==================== sdb_edit =================*/
1133    if (strcmp(sys_cmd, "sdb_edit") == 0)
1134    {
1135      if ((h!=NULL) && (h->Typ()==PROC_CMD))
1136      {
1137        procinfov p=(procinfov)h->Data();
1138        sdb_edit(p);
1139      }
1140      else
1141      {
1142        WerrorS("system(\"sdb_edit\",`proc`) expected");
1143        return TRUE;
1144      }
1145      return FALSE;
1146    }
1147    else
1148/*==================== GF =================*/
1149#if 0
1150    if (strcmp(sys_cmd, "GF") == 0)
1151    {
1152      int c=rChar(currRing);
1153      setCharacteristic( c, 2);
1154      CanonicalForm F( convSingGFClapGF( (poly)h->Data() ) );
1155      res->rtyp=POLY_CMD;
1156      res->data=convClapGFSingGF( F );
1157      return FALSE;
1158    }
1159    else
1160#endif
1161/*==================== stdX =================*/
1162    if (strcmp(sys_cmd, "std") == 0)
1163    {
1164      ideal i1;
1165      int i2;
1166      if ((h!=NULL) && (h->Typ()==MODUL_CMD))
1167      {
1168        i1=(ideal)h->CopyD();
1169        h=h->next;
1170      }
1171      else return TRUE;
1172      if ((h!=NULL) && (h->Typ()==INT_CMD))
1173      {
1174        i2=(int)h->Data();
1175      }
1176      else return TRUE;
1177      res->rtyp=MODUL_CMD;
1178      res->data=idXXX(i1,i2);
1179      return FALSE;
1180    }
1181    else
1182#ifdef HAVE_PLURAL
1183/*==================== PLURAL =================*/
1184    if (strcmp(sys_cmd, "PLURAL") == 0)
1185    {
1186      matrix C;
1187      matrix D;
1188
1189      if ((h!=NULL) && (h->Typ()==MATRIX_CMD))
1190      {
1191        C=(matrix)h->CopyD();
1192        h=h->next;
1193      }
1194      else return TRUE;
1195      if ((h!=NULL) && (h->Typ()==MATRIX_CMD))
1196      {
1197        D=(matrix)h->CopyD();
1198      }
1199      else return TRUE;
1200      if (currRing->nc==NULL)
1201      {
1202        currRing->nc=(nc_struct *)omAlloc0(sizeof(nc_struct));
1203        currRing->nc->MT=(matrix *)omAlloc0(pVariables*(pVariables-1)/2*sizeof(matrix));
1204        currRing->nc->MTsize=(int *)omAlloc0(pVariables*(pVariables-1)/2*sizeof(int));
1205      }
1206      else
1207      {
1208        WarnS("redefining algebra structure");
1209      }
1210      currRing->nc->type=nc_general;
1211      currRing->nc->C=C;
1212      currRing->nc->D=D;
1213      {
1214        int i,j;
1215        poly p;
1216        short DefMTsize=7;
1217        int nv=pVariables;
1218        for(i=1;i<nv;i++)
1219        {
1220          for(j=i+1;j<=nv;j++)
1221          { 
1222            currRing->nc->MTsize[UPMATELEM(i,j)]=DefMTsize; /* default sizes */
1223            currRing->nc->MT[UPMATELEM(i,j)]=mpNew(DefMTsize,DefMTsize);
1224            p=pOne();
1225            pSetCoeff(p,nCopy(pGetCoeff(MATELEM(currRing->nc->C,i,j))));
1226            pSetExp(p,i,1);
1227            pSetExp(p,j,1);
1228            pSetm(p);
1229            p=pAdd(p,pCopy(MATELEM(currRing->nc->D,i,j)));
1230            MATELEM(currRing->nc->MT[UPMATELEM(i,j)],1,1)=p;
1231            /* set MT[i,j,1,1] to c_i_j*x_i*x_j + D_i_j */
1232          }
1233        }
1234      }
1235      // set p_Procs:
1236//      currRing->p_Procs->pp_Mult_mm =nc_pp_Mult_mm;
1237//      currRing->p_Procs->p_Mult_mm =nc_p_Mult_mm;
1238//      currRing->p_Procs->p_Minus_mm_Mult_qq =nc_p_Minus_mm_Mult_qq;
1239
1240      return FALSE;
1241    }
1242    else
1243#endif
1244#ifdef HAVE_WALK
1245/*==================== walk stuff =================*/
1246    if (strcmp(sys_cmd, "walkNextWeight") == 0)
1247    {
1248      if (h == NULL || h->Typ() != INTVEC_CMD ||
1249          h->next == NULL || h->next->Typ() != INTVEC_CMD ||
1250          h->next->next == NULL || h->next->next->Typ() != IDEAL_CMD)
1251      {
1252        Werror("system(\"walkNextWeight\", intvec, intvec, ideal) expected");
1253        return TRUE;
1254      }
1255
1256      if (((intvec*) h->Data())->length() != currRing->N ||
1257          ((intvec*) h->next->Data())->length() != currRing->N)
1258      {
1259        Werror("system(\"walkNextWeight\" ...) intvecs not of length %d\n",
1260               currRing->N);
1261        return TRUE;
1262      }
1263      res->data = (void*) walkNextWeight(((intvec*) h->Data()),
1264                                         ((intvec*) h->next->Data()),
1265                                         (ideal) h->next->next->Data());
1266      if (res->data == (void*) 0 || res->data == (void*) 1)
1267      {
1268        res->rtyp = INT_CMD;
1269      }
1270      else
1271      {
1272        res->rtyp = INTVEC_CMD;
1273      }
1274      return FALSE;
1275    }
1276    else if (strcmp(sys_cmd, "walkInitials") == 0)
1277    {
1278      if (h == NULL || h->Typ() != IDEAL_CMD)
1279      {
1280        WerrorS("system(\"walkInitials\", ideal) expected");
1281        return TRUE;
1282      }
1283
1284      res->data = (void*) walkInitials((ideal) h->Data());
1285      res->rtyp = IDEAL_CMD;
1286      return FALSE;
1287    }
1288    else
1289#endif
1290
1291/*==================== Error =================*/
1292      Werror( "system(\"%s\",...) %s", sys_cmd, feNotImplemented );
1293  }
1294  return TRUE;
1295}
1296#endif // HAVE_EXTENDED_SYSTEM
Note: See TracBrowser for help on using the repository browser.