source: git/Singular/extra.cc @ 5d32fd

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