source: git/Singular/extra.cc @ 09d74fe

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