source: git/Singular/extra.cc @ 63be42

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