source: git/Singular/extra.cc @ ad4bc9

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