source: git/Singular/extra.cc @ 6b32990

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