source: git/Singular/extra.cc @ bf27e44

fieker-DuValspielwiese
Last change on this file since bf27e44 was 335380, checked in by Viktor Levandovskyy <levandov@…>, 23 years ago
plural corrections git-svn-id: file:///usr/local/Singular/svn/trunk@5264 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 33.1 KB
Line 
1/*****************************************
2*  Computer Algebra System SINGULAR      *
3*****************************************/
4/* $Id: extra.cc,v 1.162 2001-02-22 19:12:57 levandov 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#ifdef ix86_Win /* only for the DLLTest */
75#include "WinDllTest.h"
76#ifdef HAVE_DL
77#include "mod_raw.h"
78#endif
79#endif
80
81// Define to enable many more system commands
82#ifndef MAKE_DISTRIBUTION
83#define HAVE_EXTENDED_SYSTEM
84#endif
85
86#ifdef HAVE_FACTORY
87#define SI_DONT_HAVE_GLOBAL_VARS
88#include "clapsing.h"
89#include "clapconv.h"
90#include "kstdfac.h"
91#endif
92
93#include "silink.h"
94#include "walk.h"
95
96/*
97 *   New function/system-calls that will be included as dynamic module
98 * should be inserted here.
99 * - without HAVE_DYNAMIC_LOADING: these functions comes as system("....");
100 * - with    HAVE_DYNAMIC_LOADING: these functions are loaded as module.
101 */
102#ifndef HAVE_DYNAMIC_LOADING
103#ifdef HAVE_PCV
104#include "pcv.h"
105#endif
106#endif /* not HAVE_DYNAMIC_LOADING */
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/*==================== pcv ==================================*/
505#ifndef HAVE_DYNAMIC_LOADING
506#ifdef HAVE_PCV
507    if(strcmp(sys_cmd,"pcvLAddL")==0)
508    {
509      return pcvLAddL(res,h);
510    }
511    else
512    if(strcmp(sys_cmd,"pcvPMulL")==0)
513    {
514      return pcvPMulL(res,h);
515    }
516    else
517    if(strcmp(sys_cmd,"pcvMinDeg")==0)
518    {
519      return pcvMinDeg(res,h);
520    }
521    else
522    if(strcmp(sys_cmd,"pcvP2CV")==0)
523    {
524      return pcvP2CV(res,h);
525    }
526    else
527    if(strcmp(sys_cmd,"pcvCV2P")==0)
528    {
529      return pcvCV2P(res,h);
530    }
531    else
532    if(strcmp(sys_cmd,"pcvDim")==0)
533    {
534      return pcvDim(res,h);
535    }
536    else
537    if(strcmp(sys_cmd,"pcvBasis")==0)
538    {
539      return pcvBasis(res,h);
540    }
541    else
542#endif
543#endif /* HAVE_DYNAMIC_LOADING */
544/*==================== contributors =============================*/
545   if(strcmp(sys_cmd,"contributors") == 0)
546   {
547     res->rtyp=STRING_CMD;
548     res->data=(void *)omStrDup(
549       "Olaf Bachmann, Hubert Grassmann, Kai Krueger, Wolfgang Neumann, Thomas Nuessler, Wilfred Pohl, Jens Schmidt, Thomas Siebert, Ruediger Stobbe, Moritz Wenk, Tim Wichmann");
550     return FALSE;
551   }
552   else
553/*==================== spectrum =============================*/
554   #ifdef HAVE_SPECTRUM
555   if(strcmp(sys_cmd,"spectrum") == 0)
556   {
557     if (h->Typ()!=POLY_CMD)
558     {
559       WerrorS("poly expected");
560       return TRUE;
561     }
562     if (h->next==NULL)
563       return spectrumProc(res,h);
564     if (h->next->Typ()!=INT_CMD)
565     {
566       WerrorS("poly,int expected");
567       return TRUE;
568     }
569     if(((int)h->next->Data())==1)
570       return spectrumfProc(res,h);
571     return spectrumProc(res,h);
572   }
573   else
574/*==================== semic =============================*/
575   if(strcmp(sys_cmd,"semic") == 0)
576   {
577     if ((h->next!=NULL)
578     && (h->Typ()==LIST_CMD)
579     && (h->next->Typ()==LIST_CMD))
580     {
581       if (h->next->next==NULL)
582         return semicProc(res,h,h->next);
583       else if (h->next->next->Typ()==INT_CMD)
584         return semicProc3(res,h,h->next,h->next->next);
585     }
586     return TRUE;
587   }
588   else
589/*==================== spadd =============================*/
590   if(strcmp(sys_cmd,"spadd") == 0)
591   {
592     if ((h->next!=NULL)
593     && (h->Typ()==LIST_CMD)
594     && (h->next->Typ()==LIST_CMD))
595     {
596       if (h->next->next==NULL)
597         return spaddProc(res,h,h->next);
598     }
599     return TRUE;
600   }
601   else
602/*==================== spmul =============================*/
603   if(strcmp(sys_cmd,"spmul") == 0)
604   {
605     if ((h->next!=NULL)
606     && (h->Typ()==LIST_CMD)
607     && (h->next->Typ()==INT_CMD))
608     {
609       if (h->next->next==NULL)
610         return spmulProc(res,h,h->next);
611     }
612     return TRUE;
613   }
614   else
615   #endif
616/*================= Extended system call ========================*/
617   {
618     #ifndef MAKE_DISTRIBUTION
619     return(jjEXTENDED_SYSTEM(res, args));
620     #else
621     Werror( "system(\"%s\",...) %s", sys_cmd, feNotImplemented );
622     #endif
623   }
624  } /* typ==string */
625  return TRUE;
626}
627
628
629
630#ifdef HAVE_EXTENDED_SYSTEM
631// You can put your own system calls here
632#include "fglmcomb.cc"
633#include "fglm.h"
634#ifdef HAVE_NEWTON
635#include <hc_newton.h>
636#endif
637#include "mpsr.h"
638
639#include "mod_raw.h"
640   
641static BOOLEAN jjEXTENDED_SYSTEM(leftv res, leftv h)
642{
643  if(h->Typ() == STRING_CMD)
644  {
645    char *sys_cmd=(char *)(h->Data());
646    h=h->next;
647/*==================== interred ==================================*/
648    #if 0
649    if(strcmp(sys_cmd,"interred")==0)
650    {
651      res->data=(char *)kIR((ideal)h->Data(),currQuotient);
652      res->rtyp=h->Typ();
653      return ((h->Typ()!=IDEAL_CMD) && (h->Typ()!=MODUL_CMD));
654    }
655    else
656    #endif
657#ifdef RDEBUG
658/*==================== poly debug ==================================*/
659    if(strcmp(sys_cmd,"p")==0)
660    {
661      pDebugPrint((poly)h->Data());
662      return FALSE;
663    }
664    else
665/*==================== ring debug ==================================*/
666    if(strcmp(sys_cmd,"r")==0)
667    {
668      rDebugPrint((ring)h->Data());
669      return FALSE;
670    }
671    else
672#endif
673/*==================== mtrack ==================================*/
674    if(strcmp(sys_cmd,"mtrack")==0)
675    {
676#ifdef OM_TRACK
677      om_Opts.MarkAsStatic = 1;
678      FILE *fd = NULL;
679      int max = 5;
680      while (h != NULL)
681      {
682        omMarkAsStaticAddr(h);
683        if (fd == NULL && h->Typ()==STRING_CMD)
684        {
685          fd = fopen((char*) h->Data(), "w");
686          if (fd == NULL)
687            Warn("Can not open %s for writing og mtrack. Using stdout");
688        }
689        if (h->Typ() == INT_CMD)
690        {
691          max = (int) h->Data();
692        }
693        h = h->Next();
694      }
695      omPrintUsedTrackAddrs((fd == NULL ? stdout : fd), max);
696      if (fd != NULL) fclose(fd);
697      om_Opts.MarkAsStatic = 0;
698      return FALSE;
699#else
700     WerrorS("mtrack not supported without OM_TRACK");
701     return TRUE;
702#endif
703    }
704/*==================== mtrack_all ==================================*/
705    if(strcmp(sys_cmd,"mtrack_all")==0)
706    {
707#ifdef OM_TRACK
708      om_Opts.MarkAsStatic = 1;
709      FILE *fd = NULL;
710      if ((h!=NULL) &&(h->Typ()==STRING_CMD))
711      {
712        fd = fopen((char*) h->Data(), "w");
713        if (fd == NULL)
714          Warn("Can not open %s for writing og mtrack. Using stdout");
715        omMarkAsStaticAddr(h);
716      }
717      // OB: TBC print to fd
718      omPrintUsedAddrs((fd == NULL ? stdout : fd), 5);
719      if (fd != NULL) fclose(fd);
720      om_Opts.MarkAsStatic = 0;
721      return FALSE;
722#else
723     WerrorS("mtrack not supported without OM_TRACK");
724     return TRUE;
725#endif
726    }
727    else
728/*==================== backtrace ==================================*/
729    if(strcmp(sys_cmd,"backtrace")==0)
730    {
731#ifndef OM_NDEBUG
732      omPrintCurrentBackTrace(stdout);
733      return FALSE;
734#else
735     WerrorS("btrack not supported without OM_TRACK");
736     return TRUE;
737#endif
738    }
739    else
740/*==================== naIdeal ==================================*/
741    if(strcmp(sys_cmd,"naIdeal")==0)
742    {
743      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
744      {
745        naSetIdeal((ideal)h->Data());
746        return FALSE;
747      }
748      else
749         WerrorS("ideal expected");
750    }
751    else
752/*==================== isSqrFree =============================*/
753#ifdef HAVE_FACTORY
754    if(strcmp(sys_cmd,"isSqrFree")==0)
755    {
756      if ((h!=NULL) &&(h->Typ()==POLY_CMD))
757      {
758        res->rtyp=INT_CMD;
759        res->data=(void *)singclap_isSqrFree((poly)h->Data());
760        return FALSE;
761      }
762      else
763        WerrorS("poly expected");
764    }
765    else
766#endif
767/*==================== pDivStat =============================*/
768#if defined(PDEBUG) || defined(PDIV_DEBUG)
769    if(strcmp(sys_cmd,"pDivStat")==0)
770    {
771      extern void pPrintDivisbleByStat();
772      pPrintDivisbleByStat();
773      return FALSE;
774    }
775    else
776#endif
777/*==================== alarm ==================================*/
778#ifndef __MWERKS__
779#ifndef MSDOS
780#ifndef atarist
781#ifdef unix
782    if(strcmp(sys_cmd,"alarm")==0)
783    {
784      if ((h!=NULL) &&(h->Typ()==INT_CMD))
785      {
786        // standard variant -> SIGALARM (standard: abort)
787        //alarm((unsigned)h->next->Data());
788        // process time (user +system): SIGVTALARM
789        struct itimerval t,o;
790        memset(&t,0,sizeof(t));
791        t.it_value.tv_sec     =(unsigned)h->Data();
792        setitimer(ITIMER_VIRTUAL,&t,&o);
793        return FALSE;
794      }
795      else
796        WerrorS("int expected");
797    }
798    else
799#endif
800#endif
801#endif
802#endif
803/*==================== red =============================*/
804#if 0
805    if(strcmp(sys_cmd,"red")==0)
806    {
807      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
808      {
809        res->rtyp=IDEAL_CMD;
810        res->data=(void *)kStdred((ideal)h->Data(),NULL,testHomog,NULL);
811        setFlag(res,FLAG_STD);
812        return FALSE;
813      }
814      else
815        WerrorS("ideal expected");
816    }
817    else
818#endif
819/*==================== algfetch =====================*/
820    if (strcmp(sys_cmd,"algfetch")==0)
821    {
822      int k;
823      idhdl w;
824      ideal i0, i1;
825      ring r0=(ring)h->Data();
826      leftv v = h->next;
827      w = r0->idroot->get(v->Name(),myynest);
828      if (w!=NULL)
829      {
830        if (IDTYP(w)==IDEAL_CMD)
831        {
832          i0 = IDIDEAL(w);
833          i1 = idInit(IDELEMS(i0),i0->rank);
834          for (k=0; k<IDELEMS(i1); k++)
835          {
836            i1->m[k] = maAlgpolyFetch(r0, i0->m[k]);
837          }
838          res->rtyp = IDEAL_CMD;
839          res->data = (void*)i1;
840          return FALSE;
841        }
842        else if (IDTYP(w)==POLY_CMD)
843        {
844          res->rtyp = POLY_CMD;
845          res->data = (void*)maAlgpolyFetch(r0,IDPOLY(w));
846          return FALSE;
847        }
848        else
849          WerrorS("`system(\"algfetch\",<ideal>/<poly>)` expected");
850      }
851      else
852        Werror("`%s` not found in `%s`",v->Name(),h->Name());
853    }
854    else
855/*==================== algmap =======================*/
856    if (strcmp(sys_cmd,"algmap")==0)
857    {
858      int k;
859      idhdl w;
860      ideal i0, i1, i, j;
861      ring r0=(ring)h->Data();
862      leftv v = h->next;
863      w = r0->idroot->get(v->Name(),myynest);
864      i0 = IDIDEAL(w);
865      v = v->next;
866      i = (ideal)v->Data();
867      v = v->next;
868      j = (ideal)v->Data();
869      i1 = idInit(IDELEMS(i0),i0->rank);
870      for (k=0; k<IDELEMS(i1); k++)
871      {
872        i1->m[k] = maAlgpolyMap(r0, i0->m[k], i, j);
873      }
874      res->rtyp = IDEAL_CMD;
875      res->data = (void*)i1;
876      return FALSE;
877    }
878    else
879#ifdef HAVE_FACTORY
880/*==================== fastcomb =============================*/
881    if(strcmp(sys_cmd,"fastcomb")==0)
882    {
883      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
884      {
885        int i=0;
886        if (h->next!=NULL)
887        {
888          if (h->next->Typ()!=POLY_CMD)
889          {
890            Warn("Wrong types for poly= comb(ideal,poly)");
891          }
892        }
893        res->rtyp=POLY_CMD;
894        res->data=(void *) fglmLinearCombination(
895                           (ideal)h->Data(),(poly)h->next->Data());
896        return FALSE;
897      }
898      else
899        WerrorS("ideal expected");
900    }
901    else
902/*==================== comb =============================*/
903    if(strcmp(sys_cmd,"comb")==0)
904    {
905      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
906      {
907        int i=0;
908        if (h->next!=NULL)
909        {
910          if (h->next->Typ()!=POLY_CMD)
911          {
912              Warn("Wrong types for poly= comb(ideal,poly)");
913          }
914        }
915        res->rtyp=POLY_CMD;
916        res->data=(void *)fglmNewLinearCombination(
917                            (ideal)h->Data(),(poly)h->next->Data());
918        return FALSE;
919      }
920      else
921        WerrorS("ideal expected");
922    }
923    else
924#endif
925#ifdef FACTORY_GCD_TEST
926/*=======================gcd Testerei ================================*/
927    if ( ! strcmp( sys_cmd, "setgcd" ) ) {
928        if ( (h != NULL) && (h->Typ() == INT_CMD) ) {
929            CFPrimitiveGcdUtil::setAlgorithm( (int)h->Data() );
930            return FALSE;
931        } else
932            WerrorS("int expected");
933    }
934    else
935#endif
936
937#ifdef FACTORY_GCD_TIMING
938    if ( ! strcmp( sys_cmd, "gcdtime" ) ) {
939        TIMING_PRINT( contentTimer, "time used for content: " );
940        TIMING_PRINT( algContentTimer, "time used for algContent: " );
941        TIMING_PRINT( algLcmTimer, "time used for algLcm: " );
942        TIMING_RESET( contentTimer );
943        TIMING_RESET( algContentTimer );
944        TIMING_RESET( algLcmTimer );
945        return FALSE;
946    }
947    else
948#endif
949
950#ifdef FACTORY_GCD_STAT
951    if ( ! strcmp( sys_cmd, "gcdstat" ) ) {
952        printGcdTotal();
953        printContTotal();
954        resetGcdTotal();
955        resetContTotal();
956        return FALSE;
957    }
958    else
959#endif
960/*==================== lib ==================================*/
961    if(strcmp(sys_cmd,"LIB")==0)
962    {
963#ifdef HAVE_NAMESPACES
964      idhdl hh=namespaceroot->get((char*)h->Data(),0);
965#else /* HAVE_NAMESPACES */
966      idhdl hh=idroot->get((char*)h->Data(),0);
967#endif /* HAVE_NAMESPACES */
968      if ((hh!=NULL)&&(IDTYP(hh)==PROC_CMD))
969      {
970        res->rtyp=STRING_CMD;
971        char *r=iiGetLibName(IDPROC(hh));
972        if (r==NULL) r="";
973        res->data=omStrDup(r);
974        return FALSE;
975      }
976      else
977        Warn("`%s` not found",(char*)h->Data());
978    }
979    else
980#ifdef HAVE_NAMESPACES
981/*==================== nspush ===================================*/
982    if(strcmp(sys_cmd,"nspush")==0)
983    {
984      if (h->Typ()==PACKAGE_CMD)
985      {
986        idhdl hh=(idhdl)h->data;
987        namespaceroot = namespaceroot->push(IDPACKAGE(hh), IDID(hh));
988        return FALSE;
989      }
990      else
991        Warn("argument 2 is not a package");
992    }
993    else
994/*==================== nspop ====================================*/
995    if(strcmp(sys_cmd,"nspop")==0)
996    {
997      namespaceroot->pop();
998      return FALSE;
999    }
1000    else
1001#endif /* HAVE_NAMESPACES */
1002/*==================== nsstack ===================================*/
1003    if(strcmp(sys_cmd,"nsstack")==0)
1004    {
1005      namehdl nshdl = namespaceroot;
1006      for( ; nshdl->isroot != TRUE; nshdl = nshdl->next) {
1007        Print("NSstack: %s:%d, nesting=%d\n", nshdl->name, nshdl->lev, nshdl->myynest);
1008      }
1009      Print("NSstack: %s:%d, nesting=%d\n", nshdl->name, nshdl->lev, nshdl->myynest);
1010      return FALSE;
1011    }
1012    else
1013/*==================== proclist =================================*/
1014    if(strcmp(sys_cmd,"proclist")==0)
1015    {
1016      piShowProcList();
1017      return FALSE;
1018    }
1019    else
1020/* ==================== newton ================================*/
1021#ifdef HAVE_NEWTON
1022    if(strcmp(sys_cmd,"newton")==0)
1023    {
1024      if ((h->Typ()!=POLY_CMD)
1025      || (h->next->Typ()!=INT_CMD)
1026      || (h->next->next->Typ()!=INT_CMD))
1027      {
1028        WerrorS("system(\"newton\",<poly>,<int>,<int>) expected");
1029        return TRUE;
1030      }
1031      poly  p=(poly)(h->Data());
1032      int l=pLength(p);
1033      short *points=(short *)omAlloc(currRing->N*l*sizeof(short));
1034      int i,j,k;
1035      k=0;
1036      poly pp=p;
1037      for (i=0;pp!=NULL;i++)
1038      {
1039        for(j=1;j<=currRing->N;j++)
1040        {
1041          points[k]=pGetExp(pp,j);
1042          k++;
1043        }
1044        pIter(pp);
1045      }
1046      hc_ERG r=hc_KOENIG(currRing->N,      // dimension
1047                l,      // number of points
1048                (short*) points,   // points: x_1, y_1,z_1, x_2,y_2,z2,...
1049                currRing->OrdSgn==-1,
1050                (int) (h->next->Data()),      // 1: Milnor, 0: Newton
1051                (int) (h->next->next->Data()) // debug
1052               );
1053      //----<>---Output-----------------------
1054
1055
1056//  PrintS("Bin jetzt in extra.cc bei der Auswertung.\n"); // **********
1057
1058
1059      lists L=(lists)omAllocBin(slists_bin);
1060      L->Init(6);
1061      L->m[0].rtyp=STRING_CMD;               // newtonnumber;
1062      L->m[0].data=(void *)omStrDup(r.nZahl);
1063      L->m[1].rtyp=INT_CMD;
1064      L->m[1].data=(void *)r.achse;          // flag for unoccupied axes
1065      L->m[2].rtyp=INT_CMD;
1066      L->m[2].data=(void *)r.deg;            // #degenerations
1067      if ( r.deg != 0)              // only if degenerations exist
1068      {
1069        L->m[3].rtyp=INT_CMD;
1070        L->m[3].data=(void *)r.anz_punkte;     // #points
1071        //---<>--number of points------
1072        int anz = r.anz_punkte;    // number of points
1073        int dim = (currRing->N);     // dimension
1074        intvec* v = new intvec( anz*dim );
1075        for (i=0; i<anz*dim; i++)    // copy points
1076          (*v)[i] = r.pu[i];
1077        L->m[4].rtyp=INTVEC_CMD;
1078        L->m[4].data=(void *)v;
1079        //---<>--degenerations---------
1080        int deg = r.deg;    // number of points
1081        intvec* w = new intvec( r.speicher );  // necessary memeory
1082        i=0;               // start copying
1083        do
1084        {
1085          (*w)[i] = r.deg_tab[i];
1086          i++;
1087        }
1088        while (r.deg_tab[i-1] != -2);   // mark for end of list
1089        L->m[5].rtyp=INTVEC_CMD;
1090        L->m[5].data=(void *)w;
1091      }
1092      else
1093      {
1094        L->m[3].rtyp=INT_CMD; L->m[3].data=(char *)0;
1095        L->m[4].rtyp=DEF_CMD;
1096        L->m[5].rtyp=DEF_CMD;
1097      }
1098
1099      res->data=(void *)L;
1100      res->rtyp=LIST_CMD;
1101      // free all pointer in r:
1102      delete[] r.nZahl;
1103      delete[] r.pu;
1104      delete[] r.deg_tab;      // Ist das ein Problem??
1105
1106      omFreeSize((ADDRESS)points,currRing->N*l*sizeof(short));
1107      return FALSE;
1108    }
1109    else
1110#endif
1111/*==================== sdb_flags =================*/
1112    if (strcmp(sys_cmd, "sdb_flags") == 0)
1113    {
1114      if ((h!=NULL) && (h->Typ()==INT_CMD))
1115      {
1116        sdb_flags=(int)h->Data();
1117      }
1118      else
1119      {
1120        WerrorS("system(\"sdb_flags\",`int`) expected");
1121        return TRUE;
1122      }
1123      return FALSE;
1124    }
1125    else
1126/*==================== sdb_edit =================*/
1127    if (strcmp(sys_cmd, "sdb_edit") == 0)
1128    {
1129      if ((h!=NULL) && (h->Typ()==PROC_CMD))
1130      {
1131        procinfov p=(procinfov)h->Data();
1132        sdb_edit(p);
1133      }
1134      else
1135      {
1136        WerrorS("system(\"sdb_edit\",`proc`) expected");
1137        return TRUE;
1138      }
1139      return FALSE;
1140    }
1141    else
1142/*==================== GF =================*/
1143#if 0
1144    if (strcmp(sys_cmd, "GF") == 0)
1145    {
1146      int c=rChar(currRing);
1147      setCharacteristic( c, 2);
1148      CanonicalForm F( convSingGFClapGF( (poly)h->Data() ) );
1149      res->rtyp=POLY_CMD;
1150      res->data=convClapGFSingGF( F );
1151      return FALSE;
1152    }
1153    else
1154#endif
1155/*==================== stdX =================*/
1156    if (strcmp(sys_cmd, "std") == 0)
1157    {
1158      ideal i1;
1159      int i2;
1160      if ((h!=NULL) && (h->Typ()==MODUL_CMD))
1161      {
1162        i1=(ideal)h->CopyD();
1163        h=h->next;
1164      }
1165      else return TRUE;
1166      if ((h!=NULL) && (h->Typ()==INT_CMD))
1167      {
1168        i2=(int)h->Data();
1169      }
1170      else return TRUE;
1171      res->rtyp=MODUL_CMD;
1172      res->data=idXXX(i1,i2);
1173      return FALSE;
1174    }
1175    else
1176#ifdef HAVE_PLURAL
1177/*==================== PLURAL =================*/
1178    if (strcmp(sys_cmd, "PLURAL") == 0)
1179    {
1180      matrix C;
1181      matrix D;
1182
1183      if ((h!=NULL) && (h->Typ()==MATRIX_CMD))
1184      {
1185        C=(matrix)h->CopyD();
1186        h=h->next;
1187      }
1188      else return TRUE;
1189      if ((h!=NULL) && (h->Typ()==MATRIX_CMD))
1190      {
1191        D=(matrix)h->CopyD();
1192      }
1193      else return TRUE;
1194      if (currRing->nc==NULL)
1195      {
1196        currRing->nc=(nc_struct *)omAlloc0(sizeof(nc_struct));
1197        currRing->nc->MT=(matrix *)omAlloc0(pVariables*(pVariables-1)/2*sizeof(matrix));
1198        currRing->nc->MTsize=(int *)omAlloc0(pVariables*(pVariables-1)/2*sizeof(int));
1199      }
1200      else
1201      {
1202        WarnS("redefining algebra structure");
1203      }
1204      currRing->nc->type=nc_general;
1205      currRing->nc->C=C;
1206      currRing->nc->D=D;
1207      {
1208        int i,j;
1209        poly p;
1210        short DefMTsize=7;
1211        int nv=pVariables;
1212        for(i=1;i<nv;i++)
1213        {
1214          for(j=i+1;j<=nv;j++)
1215          { 
1216            currRing->nc->MTsize[UPMATELEM(i,j,curring->N)]=DefMTsize; /* default sizes */
1217            currRing->nc->MT[UPMATELEM(i,j,curring->N)]=mpNew(DefMTsize,DefMTsize);
1218            p=pOne();
1219            pSetCoeff(p,nCopy(pGetCoeff(MATELEM(currRing->nc->C,i,j))));
1220            pSetExp(p,i,1);
1221            pSetExp(p,j,1);
1222            pSetm(p);
1223            p=pAdd(p,pCopy(MATELEM(currRing->nc->D,i,j)));
1224            MATELEM(currRing->nc->MT[UPMATELEM(i,j,curring->N)],1,1)=p;
1225            /* set MT[i,j,1,1] to c_i_j*x_i*x_j + D_i_j */
1226          }
1227        }
1228      }
1229      // set p_Procs:
1230//      currRing->p_Procs->pp_Mult_mm =nc_pp_Mult_mm;
1231//      currRing->p_Procs->p_Mult_mm =nc_p_Mult_mm;
1232//      currRing->p_Procs->p_Minus_mm_Mult_qq =nc_p_Minus_mm_Mult_qq;
1233
1234      return FALSE;
1235    }
1236    else
1237#endif
1238#ifdef HAVE_WALK
1239/*==================== walk stuff =================*/
1240    if (strcmp(sys_cmd, "walkNextWeight") == 0)
1241    {
1242      if (h == NULL || h->Typ() != INTVEC_CMD ||
1243          h->next == NULL || h->next->Typ() != INTVEC_CMD ||
1244          h->next->next == NULL || h->next->next->Typ() != IDEAL_CMD)
1245      {
1246        Werror("system(\"walkNextWeight\", intvec, intvec, ideal) expected");
1247        return TRUE;
1248      }
1249
1250      if (((intvec*) h->Data())->length() != currRing->N ||
1251          ((intvec*) h->next->Data())->length() != currRing->N)
1252      {
1253        Werror("system(\"walkNextWeight\" ...) intvecs not of length %d\n",
1254               currRing->N);
1255        return TRUE;
1256      }
1257      res->data = (void*) walkNextWeight(((intvec*) h->Data()),
1258                                         ((intvec*) h->next->Data()),
1259                                         (ideal) h->next->next->Data());
1260      if (res->data == (void*) 0 || res->data == (void*) 1)
1261      {
1262        res->rtyp = INT_CMD;
1263      }
1264      else
1265      {
1266        res->rtyp = INTVEC_CMD;
1267      }
1268      return FALSE;
1269    }
1270    else if (strcmp(sys_cmd, "walkInitials") == 0)
1271    {
1272      if (h == NULL || h->Typ() != IDEAL_CMD)
1273      {
1274        WerrorS("system(\"walkInitials\", ideal) expected");
1275        return TRUE;
1276      }
1277
1278      res->data = (void*) walkInitials((ideal) h->Data());
1279      res->rtyp = IDEAL_CMD;
1280      return FALSE;
1281    }
1282    else
1283#endif
1284#ifdef ix86_Win
1285#ifdef HAVE_DL
1286/*==================== DLL =================*/
1287/* testing the DLL functionality under Win32 */
1288      if (strcmp(sys_cmd, "DLL") == 0)
1289        {
1290          typedef void  (*Void_Func)();
1291          typedef int  (*Int_Func)(int);
1292          void *hh=dynl_open("WinDllTest.dll");
1293          if ((h!=NULL) && (h->Typ()==INT_CMD))
1294            {
1295              int (*f)(int);
1296              if (hh!=NULL)
1297                {
1298                  int (*f)(int);
1299                  f=(Int_Func)dynl_sym(hh,"PlusDll");
1300                  int i=10;
1301                  if (f!=NULL) printf("%d\n",f(i));
1302                  else PrintS("cannot find PlusDll\n");
1303                }
1304            }
1305          else
1306            {   
1307              void (*f)();
1308              f= (Void_Func)dynl_sym(hh,"TestDll");
1309              if (f!=NULL) f();
1310              else PrintS("cannot find TestDll\n");
1311            }
1312          return FALSE;
1313        }
1314      else
1315#endif
1316#endif
1317/*==================== Error =================*/
1318      Werror( "system(\"%s\",...) %s", sys_cmd, feNotImplemented );
1319  }
1320  return TRUE;
1321}
1322#endif // HAVE_EXTENDED_SYSTEM
Note: See TracBrowser for help on using the repository browser.