source: git/Singular/extra.cc @ 9e9288

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