Macros | Functions
extra.cc File Reference
#include <kernel/mod2.h>
#include <misc/auxiliary.h>
#include <misc/sirandom.h>
#include <factory/factory.h>
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <ctype.h>
#include <signal.h>
#include <time.h>
#include <sys/time.h>
#include <unistd.h>
#include <misc/options.h>
#include <coeffs/coeffs.h>
#include <coeffs/mpr_complex.h>
#include "coeffs/AE.h"
#include "coeffs/AEp.h"
#include "coeffs/AEQ.h"
#include <resources/feResource.h>
#include <polys/monomials/ring.h>
#include <kernel/polys.h>
#include <polys/monomials/maps.h>
#include <polys/matpol.h>
#include <polys/prCopy.h>
#include <polys/weight.h>
#include <coeffs/bigintmat.h>
#include <kernel/fast_mult.h>
#include <kernel/digitech.h>
#include <kernel/combinatorics/stairc.h>
#include <kernel/ideals.h>
#include <kernel/GBEngine/kstd1.h>
#include <kernel/GBEngine/syz.h>
#include <kernel/GBEngine/kutil.h>
#include <kernel/GBEngine/shiftgb.h>
#include <kernel/linear_algebra/linearAlgebra.h>
#include <kernel/combinatorics/hutil.h>
#include <kernel/GBEngine/tgb.h>
#include <kernel/linear_algebra/minpoly.h>
#include <numeric/mpr_base.h>
#include "tok.h"
#include "ipid.h"
#include "lists.h"
#include "cntrlc.h"
#include "ipshell.h"
#include "sdb.h"
#include "feOpt.h"
#include "fehelp.h"
#include "distrib.h"
#include "misc_ip.h"
#include "attrib.h"
#include "links/silink.h"
#include "walk.h"
#include <Singular/newstruct.h>
#include <Singular/blackbox.h>
#include <Singular/pyobject_setup.h>
#include <kernel/GBEngine/ringgb.h>
#include <kernel/GBEngine/f5gb.h>
#include <kernel/spectrum/spectrum.h>
#include <polys/nc/nc.h>
#include <polys/nc/ncSAMult.h>
#include <polys/nc/sca.h>
#include <kernel/GBEngine/nc.h>
#include "ipconv.h"
#include <kernel/GBEngine/ratgring.h>
#include <polys/flintconv.h>
#include <polys/clapconv.h>
#include <kernel/GBEngine/kstdfac.h>
#include <polys/clapsing.h>
#include "eigenval_ip.h"
#include "gms.h"
#include "Singular/links/simpleipc.h"
#include "pcv.h"
#include <kernel/fglm/fglmcomb.cc>
#include <kernel/fglm/fglm.h>
#include <hc_newton.h>
#include <polys/mod_raw.h>

Go to the source code of this file.

Macros

#define HAVE_WALK   1
 
#define TEST_FOR(A)   if(strcmp(s,A)==0) res->data=(void *)1; else
 
#define HAVE_SHEAFCOH_TRICKS   1
 

Functions

unsigned long ** singularMatrixToLongMatrix (matrix singularMatrix)
 
poly longCoeffsToSingularPoly (unsigned long *polyCoeffs, const int degree)
 
BOOLEAN jjSYSTEM (leftv res, leftv args)
 
static BOOLEAN jjEXTENDED_SYSTEM (leftv res, leftv h)
 

Macro Definition Documentation

#define HAVE_SHEAFCOH_TRICKS   1
#define HAVE_WALK   1

Definition at line 11 of file extra.cc.

#define TEST_FOR (   A)    if(strcmp(s,A)==0) res->data=(void *)1; else

Function Documentation

static BOOLEAN jjEXTENDED_SYSTEM ( leftv  res,
leftv  h 
)
static

Definition at line 2264 of file extra.cc.

2265 {
2266  if(h->Typ() == STRING_CMD)
2267  {
2268  char *sys_cmd=(char *)(h->Data());
2269  h=h->next;
2270  /*==================== test syz strat =================*/
2271  if (strcmp(sys_cmd, "syz") == 0)
2272  {
2273  int posInT_EcartFDegpLength(const TSet set,const int length,LObject &p);
2274  int posInT_FDegpLength(const TSet set,const int length,LObject &p);
2275  int posInT_pLength(const TSet set,const int length,LObject &p);
2276  int posInT0(const TSet set,const int length,LObject &p);
2277  int posInT1(const TSet set,const int length,LObject &p);
2278  int posInT2(const TSet set,const int length,LObject &p);
2279  int posInT11(const TSet set,const int length,LObject &p);
2280  int posInT110(const TSet set,const int length,LObject &p);
2281  int posInT13(const TSet set,const int length,LObject &p);
2282  int posInT15(const TSet set,const int length,LObject &p);
2283  int posInT17(const TSet set,const int length,LObject &p);
2284  int posInT17_c(const TSet set,const int length,LObject &p);
2285  int posInT19(const TSet set,const int length,LObject &p);
2286  if ((h!=NULL) && (h->Typ()==STRING_CMD))
2287  {
2288  const char *s=(const char *)h->Data();
2289  if (strcmp(s,"posInT_EcartFDegpLength")==0)
2291  else if (strcmp(s,"posInT_FDegpLength")==0)
2293  else if (strcmp(s,"posInT_pLength")==0)
2295  else if (strcmp(s,"posInT0")==0)
2297  else if (strcmp(s,"posInT1")==0)
2299  else if (strcmp(s,"posInT2")==0)
2301  else if (strcmp(s,"posInT11")==0)
2303  else if (strcmp(s,"posInT110")==0)
2305  else if (strcmp(s,"posInT13")==0)
2307  else if (strcmp(s,"posInT15")==0)
2309  else if (strcmp(s,"posInT17")==0)
2311  else if (strcmp(s,"posInT17_c")==0)
2313  else if (strcmp(s,"posInT19")==0)
2315  else Print("valid posInT:0,1,2,11,110,13,15,17,17_c,19,_EcartFDegpLength,_FDegpLength,_pLength,_EcartpLength\n");
2316  }
2317  else
2318  {
2319  test_PosInT=NULL;
2320  test_PosInL=NULL;
2321  }
2322  si_opt_2|=Sy_bit(23);
2323  return FALSE;
2324  }
2325  else
2326  /*==================== locNF ======================================*/
2327  if(strcmp(sys_cmd,"locNF")==0)
2328  {
2329  const short t[]={4,VECTOR_CMD,MODUL_CMD,INT_CMD,INTVEC_CMD};
2330  if (iiCheckTypes(h,t,1))
2331  {
2332  poly f=(poly)h->Data();
2333  h=h->next;
2334  ideal m=(ideal)h->Data();
2335  assumeStdFlag(h);
2336  h=h->next;
2337  int n=(int)((long)h->Data());
2338  h=h->next;
2339  intvec *v=(intvec *)h->Data();
2340 
2341  /* == now the work starts == */
2342 
2343  short * iv=iv2array(v, currRing);
2344  poly r=0;
2345  poly hp=ppJetW(f,n,iv);
2346  int s=MATCOLS(m);
2347  int j=0;
2348  matrix T=mp_InitI(s,1,0, currRing);
2349 
2350  while (hp != NULL)
2351  {
2352  if (pDivisibleBy(m->m[j],hp))
2353  {
2354  if (MATELEM(T,j+1,1)==0)
2355  {
2356  MATELEM(T,j+1,1)=pDivideM(pHead(hp),pHead(m->m[j]));
2357  }
2358  else
2359  {
2360  pAdd(MATELEM(T,j+1,1),pDivideM(pHead(hp),pHead(m->m[j])));
2361  }
2362  hp=ppJetW(ksOldSpolyRed(m->m[j],hp,0),n,iv);
2363  j=0;
2364  }
2365  else
2366  {
2367  if (j==s-1)
2368  {
2369  r=pAdd(r,pHead(hp));
2370  hp=pLmDeleteAndNext(hp); /* hp=pSub(hp,pHead(hp));*/
2371  j=0;
2372  }
2373  else
2374  {
2375  j++;
2376  }
2377  }
2378  }
2379 
2382  for (int k=1;k<=MATROWS(Temp);k++)
2383  {
2384  MATELEM(R,k,1)=MATELEM(Temp,k,1);
2385  }
2386 
2388  L->Init(2);
2389  L->m[0].rtyp=MATRIX_CMD; L->m[0].data=(void *)R;
2390  L->m[1].rtyp=MATRIX_CMD; L->m[1].data=(void *)T;
2391  res->data=L;
2392  res->rtyp=LIST_CMD;
2393  // iv aufraeumen
2394  omFree(iv);
2395  return FALSE;
2396  }
2397  else
2398  return TRUE;
2399  }
2400  else
2401  /*==================== poly debug ==================================*/
2402  if(strcmp(sys_cmd,"p")==0)
2403  {
2404 # ifdef RDEBUG
2405  p_DebugPrint((poly)h->Data(), currRing);
2406 # else
2407  Warn("Sorry: not available for release build!");
2408 # endif
2409  return FALSE;
2410  }
2411  else
2412  /*==================== setsyzcomp ==================================*/
2413  if(strcmp(sys_cmd,"setsyzcomp")==0)
2414  {
2415  if ((h!=NULL) && (h->Typ()==INT_CMD))
2416  {
2417  int k = (int)(long)h->Data();
2418  if ( currRing->order[0] == ringorder_s )
2419  {
2420  rSetSyzComp(k, currRing);
2421  }
2422  }
2423  }
2424  /*==================== ring debug ==================================*/
2425  if(strcmp(sys_cmd,"r")==0)
2426  {
2427 # ifdef RDEBUG
2428  rDebugPrint((ring)h->Data());
2429 # else
2430  Warn("Sorry: not available for release build!");
2431 # endif
2432  return FALSE;
2433  }
2434  else
2435  /*==================== changeRing ========================*/
2436  /* The following code changes the names of the variables in the
2437  current ring to "x1", "x2", ..., "xN", where N is the number
2438  of variables in the current ring.
2439  The purpose of this rewriting is to eliminate indexed variables,
2440  as they may cause problems when generating scripts for Magma,
2441  Maple, or Macaulay2. */
2442  if(strcmp(sys_cmd,"changeRing")==0)
2443  {
2444  int varN = currRing->N;
2445  char h[10];
2446  for (int i = 1; i <= varN; i++)
2447  {
2448  omFree(currRing->names[i - 1]);
2449  sprintf(h, "x%d", i);
2450  currRing->names[i - 1] = omStrDup(h);
2451  }
2453  res->rtyp = INT_CMD;
2454  res->data = (void*)0L;
2455  return FALSE;
2456  }
2457  else
2458  /*==================== mtrack ==================================*/
2459  if(strcmp(sys_cmd,"mtrack")==0)
2460  {
2461  #ifdef OM_TRACK
2462  om_Opts.MarkAsStatic = 1;
2463  FILE *fd = NULL;
2464  int max = 5;
2465  while (h != NULL)
2466  {
2467  omMarkAsStaticAddr(h);
2468  if (fd == NULL && h->Typ()==STRING_CMD)
2469  {
2470  fd = fopen((char*) h->Data(), "w");
2471  if (fd == NULL)
2472  Warn("Can not open %s for writing og mtrack. Using stdout"); // %s ???
2473  }
2474  if (h->Typ() == INT_CMD)
2475  {
2476  max = (int)(long)h->Data();
2477  }
2478  h = h->Next();
2479  }
2480  omPrintUsedTrackAddrs((fd == NULL ? stdout : fd), max);
2481  if (fd != NULL) fclose(fd);
2482  om_Opts.MarkAsStatic = 0;
2483  return FALSE;
2484  #endif
2485  }
2486  /*==================== mtrack_all ==================================*/
2487  if(strcmp(sys_cmd,"mtrack_all")==0)
2488  {
2489  #ifdef OM_TRACK
2490  om_Opts.MarkAsStatic = 1;
2491  FILE *fd = NULL;
2492  if ((h!=NULL) &&(h->Typ()==STRING_CMD))
2493  {
2494  fd = fopen((char*) h->Data(), "w");
2495  if (fd == NULL)
2496  Warn("Can not open %s for writing og mtrack. Using stdout");
2497  omMarkAsStaticAddr(h);
2498  }
2499  // OB: TBC print to fd
2500  omPrintUsedAddrs((fd == NULL ? stdout : fd), 5);
2501  if (fd != NULL) fclose(fd);
2502  om_Opts.MarkAsStatic = 0;
2503  return FALSE;
2504  #endif
2505  }
2506  else
2507  /*==================== backtrace ==================================*/
2508  #ifndef OM_NDEBUG
2509  if(strcmp(sys_cmd,"backtrace")==0)
2510  {
2511  omPrintCurrentBackTrace(stdout);
2512  return FALSE;
2513  }
2514  else
2515  #endif
2516 
2517 #if !defined(OM_NDEBUG)
2518  /*==================== omMemoryTest ==================================*/
2519  if (strcmp(sys_cmd,"omMemoryTest")==0)
2520  {
2521 
2522 #ifdef OM_STATS_H
2523  PrintS("\n[om_Info]: \n");
2524  omUpdateInfo();
2525 #define OM_PRINT(name) Print(" %-22s : %10ld \n", #name, om_Info . name)
2526  OM_PRINT(MaxBytesSystem);
2527  OM_PRINT(CurrentBytesSystem);
2528  OM_PRINT(MaxBytesSbrk);
2529  OM_PRINT(CurrentBytesSbrk);
2530  OM_PRINT(MaxBytesMmap);
2531  OM_PRINT(CurrentBytesMmap);
2532  OM_PRINT(UsedBytes);
2533  OM_PRINT(AvailBytes);
2534  OM_PRINT(UsedBytesMalloc);
2535  OM_PRINT(AvailBytesMalloc);
2536  OM_PRINT(MaxBytesFromMalloc);
2537  OM_PRINT(CurrentBytesFromMalloc);
2538  OM_PRINT(MaxBytesFromValloc);
2539  OM_PRINT(CurrentBytesFromValloc);
2540  OM_PRINT(UsedBytesFromValloc);
2541  OM_PRINT(AvailBytesFromValloc);
2542  OM_PRINT(MaxPages);
2543  OM_PRINT(UsedPages);
2544  OM_PRINT(AvailPages);
2545  OM_PRINT(MaxRegionsAlloc);
2546  OM_PRINT(CurrentRegionsAlloc);
2547 #undef OM_PRINT
2548 #endif
2549 
2550 #ifdef OM_OPTS_H
2551  PrintS("\n[om_Opts]: \n");
2552 #define OM_PRINT(format, name) Print(" %-22s : %10" format"\n", #name, om_Opts . name)
2553  OM_PRINT("d", MinTrack);
2554  OM_PRINT("d", MinCheck);
2555  OM_PRINT("d", MaxTrack);
2556  OM_PRINT("d", MaxCheck);
2557  OM_PRINT("d", Keep);
2558  OM_PRINT("d", HowToReportErrors);
2559  OM_PRINT("d", MarkAsStatic);
2560  OM_PRINT("u", PagesPerRegion);
2561  OM_PRINT("p", OutOfMemoryFunc);
2562  OM_PRINT("p", MemoryLowFunc);
2563  OM_PRINT("p", ErrorHook);
2564 #undef OM_PRINT
2565 #endif
2566 
2567 #ifdef OM_ERROR_H
2568  Print("\n\n[om_ErrorStatus] : '%s' (%s)\n",
2571  Print("[om_InternalErrorStatus]: '%s' (%s)\n",
2574 
2575 #endif
2576 
2577 // omTestMemory(1);
2578 // omtTestErrors();
2579  return FALSE;
2580  }
2581  else
2582 #endif
2583  /*==================== pDivStat =============================*/
2584  #if defined(PDEBUG) || defined(PDIV_DEBUG)
2585  if(strcmp(sys_cmd,"pDivStat")==0)
2586  {
2587  extern void pPrintDivisbleByStat();
2589  return FALSE;
2590  }
2591  else
2592  #endif
2593  /*==================== alarm ==================================*/
2594  #ifdef unix
2595  if(strcmp(sys_cmd,"alarm")==0)
2596  {
2597  if ((h!=NULL) &&(h->Typ()==INT_CMD))
2598  {
2599  // standard variant -> SIGALARM (standard: abort)
2600  //alarm((unsigned)h->next->Data());
2601  // process time (user +system): SIGVTALARM
2602  struct itimerval t,o;
2603  memset(&t,0,sizeof(t));
2604  t.it_value.tv_sec =(unsigned)((unsigned long)h->Data());
2605  setitimer(ITIMER_VIRTUAL,&t,&o);
2606  return FALSE;
2607  }
2608  else
2609  WerrorS("int expected");
2610  }
2611  else
2612  #endif
2613  /*==================== red =============================*/
2614  #if 0
2615  if(strcmp(sys_cmd,"red")==0)
2616  {
2617  if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2618  {
2619  res->rtyp=IDEAL_CMD;
2620  res->data=(void *)kStdred((ideal)h->Data(),NULL,testHomog,NULL);
2621  setFlag(res,FLAG_STD);
2622  return FALSE;
2623  }
2624  else
2625  WerrorS("ideal expected");
2626  }
2627  else
2628  #endif
2629  /*==================== fastcomb =============================*/
2630  if(strcmp(sys_cmd,"fastcomb")==0)
2631  {
2632  if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2633  {
2634  if (h->next!=NULL)
2635  {
2636  if (h->next->Typ()!=POLY_CMD)
2637  {
2638  Warn("Wrong types for poly= comb(ideal,poly)");
2639  }
2640  }
2641  res->rtyp=POLY_CMD;
2642  res->data=(void *) fglmLinearCombination(
2643  (ideal)h->Data(),(poly)h->next->Data());
2644  return FALSE;
2645  }
2646  else
2647  WerrorS("ideal expected");
2648  }
2649  else
2650  /*==================== comb =============================*/
2651  if(strcmp(sys_cmd,"comb")==0)
2652  {
2653  if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2654  {
2655  if (h->next!=NULL)
2656  {
2657  if (h->next->Typ()!=POLY_CMD)
2658  {
2659  Warn("Wrong types for poly= comb(ideal,poly)");
2660  }
2661  }
2662  res->rtyp=POLY_CMD;
2663  res->data=(void *)fglmNewLinearCombination(
2664  (ideal)h->Data(),(poly)h->next->Data());
2665  return FALSE;
2666  }
2667  else
2668  WerrorS("ideal expected");
2669  }
2670  else
2671  #if 0 /* debug only */
2672  /*==================== listall ===================================*/
2673  if(strcmp(sys_cmd,"listall")==0)
2674  {
2675  void listall(int showproc);
2676  int showproc=0;
2677  if ((h!=NULL) && (h->Typ()==INT_CMD)) showproc=(int)((long)h->Data());
2678  listall(showproc);
2679  return FALSE;
2680  }
2681  else
2682  #endif
2683  #if 0 /* debug only */
2684  /*==================== proclist =================================*/
2685  if(strcmp(sys_cmd,"proclist")==0)
2686  {
2687  void piShowProcList();
2688  piShowProcList();
2689  return FALSE;
2690  }
2691  else
2692  #endif
2693  /* ==================== newton ================================*/
2694  #ifdef HAVE_NEWTON
2695  if(strcmp(sys_cmd,"newton")==0)
2696  {
2697  if ((h->Typ()!=POLY_CMD)
2698  || (h->next->Typ()!=INT_CMD)
2699  || (h->next->next->Typ()!=INT_CMD))
2700  {
2701  WerrorS("system(\"newton\",<poly>,<int>,<int>) expected");
2702  return TRUE;
2703  }
2704  poly p=(poly)(h->Data());
2705  int l=pLength(p);
2706  short *points=(short *)omAlloc(currRing->N*l*sizeof(short));
2707  int i,j,k;
2708  k=0;
2709  poly pp=p;
2710  for (i=0;pp!=NULL;i++)
2711  {
2712  for(j=1;j<=currRing->N;j++)
2713  {
2714  points[k]=pGetExp(pp,j);
2715  k++;
2716  }
2717  pIter(pp);
2718  }
2719  hc_ERG r=hc_KOENIG(currRing->N, // dimension
2720  l, // number of points
2721  (short*) points, // points: x_1, y_1,z_1, x_2,y_2,z2,...
2722  currRing->OrdSgn==-1,
2723  (int) (h->next->Data()), // 1: Milnor, 0: Newton
2724  (int) (h->next->next->Data()) // debug
2725  );
2726  //----<>---Output-----------------------
2727 
2728 
2729  // PrintS("Bin jetzt in extra.cc bei der Auswertung.\n"); // **********
2730 
2731 
2733  L->Init(6);
2734  L->m[0].rtyp=STRING_CMD; // newtonnumber;
2735  L->m[0].data=(void *)omStrDup(r.nZahl);
2736  L->m[1].rtyp=INT_CMD;
2737  L->m[1].data=(void *)(long)r.achse; // flag for unoccupied axes
2738  L->m[2].rtyp=INT_CMD;
2739  L->m[2].data=(void *)(long)r.deg; // #degenerations
2740  if ( r.deg != 0) // only if degenerations exist
2741  {
2742  L->m[3].rtyp=INT_CMD;
2743  L->m[3].data=(void *)(long)r.anz_punkte; // #points
2744  //---<>--number of points------
2745  int anz = r.anz_punkte; // number of points
2746  int dim = (currRing->N); // dimension
2747  intvec* v = new intvec( anz*dim );
2748  for (i=0; i<anz*dim; i++) // copy points
2749  (*v)[i] = r.pu[i];
2750  L->m[4].rtyp=INTVEC_CMD;
2751  L->m[4].data=(void *)v;
2752  //---<>--degenerations---------
2753  int deg = r.deg; // number of points
2754  intvec* w = new intvec( r.speicher ); // necessary memory
2755  i=0; // start copying
2756  do
2757  {
2758  (*w)[i] = r.deg_tab[i];
2759  i++;
2760  }
2761  while (r.deg_tab[i-1] != -2); // mark for end of list
2762  L->m[5].rtyp=INTVEC_CMD;
2763  L->m[5].data=(void *)w;
2764  }
2765  else
2766  {
2767  L->m[3].rtyp=INT_CMD; L->m[3].data=(char *)0;
2768  L->m[4].rtyp=DEF_CMD;
2769  L->m[5].rtyp=DEF_CMD;
2770  }
2771 
2772  res->data=(void *)L;
2773  res->rtyp=LIST_CMD;
2774  // free all pointer in r:
2775  delete[] r.nZahl;
2776  delete[] r.pu;
2777  delete[] r.deg_tab; // Ist das ein Problem??
2778 
2779  omFreeSize((ADDRESS)points,currRing->N*l*sizeof(short));
2780  return FALSE;
2781  }
2782  else
2783  #endif
2784  /*==== connection to Sebastian Jambor's code ======*/
2785  /* This code connects Sebastian Jambor's code for
2786  computing the minimal polynomial of an (n x n) matrix
2787  with entries in F_p to SINGULAR. Two conversion methods
2788  are needed; see further up in this file:
2789  (1) conversion of a matrix with long entries to
2790  a SINGULAR matrix with number entries, where
2791  the numbers are coefficients in currRing;
2792  (2) conversion of an array of longs (encoding the
2793  coefficients of the minimal polynomial) to a
2794  SINGULAR poly living in currRing. */
2795  if (strcmp(sys_cmd, "minpoly") == 0)
2796  {
2797  if ((h == NULL) || (h->Typ() != MATRIX_CMD) || h->next != NULL)
2798  {
2799  Werror("expected exactly one argument: %s",
2800  "a square matrix with number entries");
2801  return TRUE;
2802  }
2803  else
2804  {
2805  matrix m = (matrix)h->Data();
2806  int n = m->rows();
2807  unsigned long p = (unsigned long)n_GetChar(currRing->cf);
2808  if (n != m->cols())
2809  {
2810  WerrorS("expected exactly one argument: "
2811  "a square matrix with number entries");
2812  return TRUE;
2813  }
2814  unsigned long** ml = singularMatrixToLongMatrix(m);
2815  unsigned long* polyCoeffs = computeMinimalPolynomial(ml, n, p);
2816  poly theMinPoly = longCoeffsToSingularPoly(polyCoeffs, n);
2817  res->rtyp = POLY_CMD;
2818  res->data = (void *)theMinPoly;
2819  for (int i = 0; i < n; i++) delete[] ml[i];
2820  delete[] ml;
2821  delete[] polyCoeffs;
2822  return FALSE;
2823  }
2824  }
2825  else
2826  /*==================== sdb_flags =================*/
2827  #ifdef HAVE_SDB
2828  if (strcmp(sys_cmd, "sdb_flags") == 0)
2829  {
2830  if ((h!=NULL) && (h->Typ()==INT_CMD))
2831  {
2832  sdb_flags=(int)((long)h->Data());
2833  }
2834  else
2835  {
2836  WerrorS("system(\"sdb_flags\",`int`) expected");
2837  return TRUE;
2838  }
2839  return FALSE;
2840  }
2841  else
2842  #endif
2843  /*==================== sdb_edit =================*/
2844  #ifdef HAVE_SDB
2845  if (strcmp(sys_cmd, "sdb_edit") == 0)
2846  {
2847  if ((h!=NULL) && (h->Typ()==PROC_CMD))
2848  {
2849  procinfov p=(procinfov)h->Data();
2850  sdb_edit(p);
2851  }
2852  else
2853  {
2854  WerrorS("system(\"sdb_edit\",`proc`) expected");
2855  return TRUE;
2856  }
2857  return FALSE;
2858  }
2859  else
2860  #endif
2861  /*==================== GF =================*/
2862  #if 0 // for testing only
2863  if (strcmp(sys_cmd, "GF") == 0)
2864  {
2865  if ((h!=NULL) && (h->Typ()==POLY_CMD))
2866  {
2867  int c=rChar(currRing);
2868  setCharacteristic( c,nfMinPoly[0], currRing->parameter[0][0] );
2869  CanonicalForm F( convSingGFFactoryGF( (poly)h->Data(), currRing ) );
2870  res->rtyp=POLY_CMD;
2871  res->data=convFactoryGFSingGF( F, currRing );
2872  return FALSE;
2873  }
2874  else { WerrorS("wrong typ"); return TRUE;}
2875  }
2876  else
2877  #endif
2878  /*==================== SVD =================*/
2879  #ifdef HAVE_SVD
2880  if (strcmp(sys_cmd, "svd") == 0)
2881  {
2882  extern lists testsvd(matrix M);
2883  res->rtyp=LIST_CMD;
2884  res->data=(char*)(testsvd((matrix)h->Data()));
2885  eturn FALSE;
2886  }
2887  else
2888  #endif
2889 
2890 
2891  /*==================== DLL =================*/
2892  #ifdef __CYGWIN__
2893  #ifdef HAVE_DL
2894  /* testing the DLL functionality under Win32 */
2895  if (strcmp(sys_cmd, "DLL") == 0)
2896  {
2897  typedef void (*Void_Func)();
2898  typedef int (*Int_Func)(int);
2899  void *hh=dynl_open("WinDllTest.dll");
2900  if ((h!=NULL) && (h->Typ()==INT_CMD))
2901  {
2902  int (*f)(int);
2903  if (hh!=NULL)
2904  {
2905  int (*f)(int);
2906  f=(Int_Func)dynl_sym(hh,"PlusDll");
2907  int i=10;
2908  if (f!=NULL) printf("%d\n",f(i));
2909  else PrintS("cannot find PlusDll\n");
2910  }
2911  }
2912  else
2913  {
2914  void (*f)();
2915  f= (Void_Func)dynl_sym(hh,"TestDll");
2916  if (f!=NULL) f();
2917  else PrintS("cannot find TestDll\n");
2918  }
2919  return FALSE;
2920  }
2921  else
2922  #endif
2923  #endif
2924  #ifdef HAVE_RING2TOM
2925  /*==================== ring-GB ==================================*/
2926  if (strcmp(sys_cmd, "findZeroPoly")==0)
2927  {
2928  ring r = currRing;
2929  poly f = (poly) h->Data();
2930  res->rtyp=POLY_CMD;
2931  res->data=(poly) kFindZeroPoly(f, r, r);
2932  return(FALSE);
2933  }
2934  else
2935  /*==================== Creating zero polynomials =================*/
2936  #ifdef HAVE_VANIDEAL
2937  if (strcmp(sys_cmd, "createG0")==0)
2938  {
2939  /* long exp[50];
2940  int N = 0;
2941  while (h != NULL)
2942  {
2943  N += 1;
2944  exp[N] = (long) h->Data();
2945  // if (exp[i] % 2 != 0) exp[i] -= 1;
2946  h = h->next;
2947  }
2948  for (int k = 1; N + k <= currRing->N; k++) exp[k] = 0;
2949 
2950  poly t_p;
2951  res->rtyp=POLY_CMD;
2952  res->data= (poly) kCreateZeroPoly(exp, -1, &t_p, currRing, currRing);
2953  return(FALSE); */
2954 
2955  res->rtyp = IDEAL_CMD;
2956  res->data = (ideal) createG0();
2957  return(FALSE);
2958  }
2959  else
2960  #endif
2961  /*==================== redNF_ring =================*/
2962  if (strcmp(sys_cmd, "redNF_ring")==0)
2963  {
2964  ring r = currRing;
2965  poly f = (poly) h->Data();
2966  h = h->next;
2967  ideal G = (ideal) h->Data();
2968  res->rtyp=POLY_CMD;
2969  res->data=(poly) ringRedNF(f, G, r);
2970  return(FALSE);
2971  }
2972  else
2973  #endif
2974  /*==================== Roune Hilb =================*/
2975  if (strcmp(sys_cmd, "hilbroune") == 0)
2976  {
2977  ideal I;
2978  if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
2979  {
2980  I=(ideal)h->CopyD();
2981  slicehilb(I);
2982  }
2983  else return TRUE;
2984  return FALSE;
2985  }
2986  else
2987  /*==================== F5 Implementation =================*/
2988  #ifdef HAVE_F5
2989  if (strcmp(sys_cmd, "f5")==0)
2990  {
2991  if (h->Typ()!=IDEAL_CMD)
2992  {
2993  WerrorS("ideal expected");
2994  return TRUE;
2995  }
2996 
2997  ring r = currRing;
2998  ideal G = (ideal) h->Data();
2999  h = h->next;
3000  int opt;
3001  if(h != NULL) {
3002  opt = (int) (long) h->Data();
3003  }
3004  else {
3005  opt = 2;
3006  }
3007  h = h->next;
3008  int plus;
3009  if(h != NULL) {
3010  plus = (int) (long) h->Data();
3011  }
3012  else {
3013  plus = 0;
3014  }
3015  h = h->next;
3016  int termination;
3017  if(h != NULL) {
3018  termination = (int) (long) h->Data();
3019  }
3020  else {
3021  termination = 0;
3022  }
3023  res->rtyp=IDEAL_CMD;
3024  res->data=(ideal) F5main(G,r,opt,plus,termination);
3025  return FALSE;
3026  }
3027  else
3028  #endif
3029  /*==================== Testing groebner basis =================*/
3030  #ifdef HAVE_RINGS
3031  if (strcmp(sys_cmd, "NF_ring")==0)
3032  {
3033  ring r = currRing;
3034  poly f = (poly) h->Data();
3035  h = h->next;
3036  ideal G = (ideal) h->Data();
3037  res->rtyp=POLY_CMD;
3038  res->data=(poly) ringNF(f, G, r);
3039  return(FALSE);
3040  }
3041  else
3042  if (strcmp(sys_cmd, "spoly")==0)
3043  {
3044  poly f = pCopy((poly) h->Data());
3045  h = h->next;
3046  poly g = pCopy((poly) h->Data());
3047 
3048  res->rtyp=POLY_CMD;
3049  res->data=(poly) plain_spoly(f,g);
3050  return(FALSE);
3051  }
3052  else
3053  if (strcmp(sys_cmd, "testGB")==0)
3054  {
3055  ideal I = (ideal) h->Data();
3056  h = h->next;
3057  ideal GI = (ideal) h->Data();
3058  res->rtyp = INT_CMD;
3059  res->data = (void *)(long) testGB(I, GI);
3060  return(FALSE);
3061  }
3062  else
3063  #endif
3064  /*==================== sca?AltVar ==================================*/
3065  #ifdef HAVE_PLURAL
3066  if ( (strcmp(sys_cmd, "AltVarStart") == 0) || (strcmp(sys_cmd, "AltVarEnd") == 0) )
3067  {
3068  ring r = currRing;
3069 
3070  if((h!=NULL) && (h->Typ()==RING_CMD)) r = (ring)h->Data(); else
3071  {
3072  WerrorS("`system(\"AltVarStart/End\"[,<ring>])` expected");
3073  return TRUE;
3074  }
3075 
3076  res->rtyp=INT_CMD;
3077 
3078  if (rIsSCA(r))
3079  {
3080  if(strcmp(sys_cmd, "AltVarStart") == 0)
3081  res->data = (void*)(long)scaFirstAltVar(r);
3082  else
3083  res->data = (void*)(long)scaLastAltVar(r);
3084  return FALSE;
3085  }
3086 
3087  WerrorS("`system(\"AltVarStart/End\",<ring>) requires a SCA ring");
3088  return TRUE;
3089  }
3090  else
3091  #endif
3092  /*==================== RatNF, noncomm rational coeffs =================*/
3093  #ifdef HAVE_RATGRING
3094  if (strcmp(sys_cmd, "intratNF") == 0)
3095  {
3096  poly p;
3097  poly *q;
3098  ideal I;
3099  int is, k, id;
3100  if ((h!=NULL) && (h->Typ()==POLY_CMD))
3101  {
3102  p=(poly)h->CopyD();
3103  h=h->next;
3104  // Print("poly is done\n");
3105  }
3106  else return TRUE;
3107  if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
3108  {
3109  I=(ideal)h->CopyD();
3110  q = I->m;
3111  h=h->next;
3112  // Print("ideal is done\n");
3113  }
3114  else return TRUE;
3115  if ((h!=NULL) && (h->Typ()==INT_CMD))
3116  {
3117  is=(int)((long)(h->Data()));
3118  // res->rtyp=INT_CMD;
3119  // Print("int is done\n");
3120  // res->rtyp=IDEAL_CMD;
3121  if (rIsPluralRing(currRing))
3122  {
3123  id = IDELEMS(I);
3124  int *pl=(int*)omAlloc0(IDELEMS(I)*sizeof(int));
3125  for(k=0; k < id; k++)
3126  {
3127  pl[k] = pLength(I->m[k]);
3128  }
3129  Print("starting redRat\n");
3130  //res->data = (char *)
3131  redRat(&p, q, pl, (int)IDELEMS(I),is,currRing);
3132  res->data=p;
3133  res->rtyp=POLY_CMD;
3134  // res->data = ncGCD(p,q,currRing);
3135  }
3136  else
3137  {
3138  res->rtyp=POLY_CMD;
3139  res->data=p;
3140  }
3141  }
3142  else return TRUE;
3143  return FALSE;
3144  }
3145  else
3146  /*==================== RatNF, noncomm rational coeffs =================*/
3147  if (strcmp(sys_cmd, "ratNF") == 0)
3148  {
3149  poly p,q;
3150  int is, htype;
3151  if ((h!=NULL) && ( (h->Typ()==POLY_CMD) || (h->Typ()==VECTOR_CMD) ) )
3152  {
3153  p=(poly)h->CopyD();
3154  h=h->next;
3155  htype = h->Typ();
3156  }
3157  else return TRUE;
3158  if ((h!=NULL) && ( (h->Typ()==POLY_CMD) || (h->Typ()==VECTOR_CMD) ) )
3159  {
3160  q=(poly)h->CopyD();
3161  h=h->next;
3162  }
3163  else return TRUE;
3164  if ((h!=NULL) && (h->Typ()==INT_CMD))
3165  {
3166  is=(int)((long)(h->Data()));
3167  res->rtyp=htype;
3168  // res->rtyp=IDEAL_CMD;
3169  if (rIsPluralRing(currRing))
3170  {
3171  res->data = nc_rat_ReduceSpolyNew(q,p,is, currRing);
3172  // res->data = ncGCD(p,q,currRing);
3173  }
3174  else res->data=p;
3175  }
3176  else return TRUE;
3177  return FALSE;
3178  }
3179  else
3180  /*==================== RatSpoly, noncomm rational coeffs =================*/
3181  if (strcmp(sys_cmd, "ratSpoly") == 0)
3182  {
3183  poly p,q;
3184  int is;
3185  if ((h!=NULL) && (h->Typ()==POLY_CMD))
3186  {
3187  p=(poly)h->CopyD();
3188  h=h->next;
3189  }
3190  else return TRUE;
3191  if ((h!=NULL) && (h->Typ()==POLY_CMD))
3192  {
3193  q=(poly)h->CopyD();
3194  h=h->next;
3195  }
3196  else return TRUE;
3197  if ((h!=NULL) && (h->Typ()==INT_CMD))
3198  {
3199  is=(int)((long)(h->Data()));
3200  res->rtyp=POLY_CMD;
3201  // res->rtyp=IDEAL_CMD;
3202  if (rIsPluralRing(currRing))
3203  {
3204  res->data = nc_rat_CreateSpoly(p,q,is,currRing);
3205  // res->data = ncGCD(p,q,currRing);
3206  }
3207  else res->data=p;
3208  }
3209  else return TRUE;
3210  return FALSE;
3211  }
3212  else
3213  #endif // HAVE_RATGRING
3214  /*==================== Rat def =================*/
3215  if (strcmp(sys_cmd, "ratVar") == 0)
3216  {
3217  int start,end;
3218  if ((h!=NULL) && (h->Typ()==POLY_CMD))
3219  {
3220  start=pIsPurePower((poly)h->Data());
3221  h=h->next;
3222  }
3223  else return TRUE;
3224  if ((h!=NULL) && (h->Typ()==POLY_CMD))
3225  {
3226  end=pIsPurePower((poly)h->Data());
3227  h=h->next;
3228  }
3229  else return TRUE;
3230  currRing->real_var_start=start;
3231  currRing->real_var_end=end;
3232  return (start==0)||(end==0)||(start>end);
3233  }
3234  else
3235  /*==================== t-rep-GB ==================================*/
3236  if (strcmp(sys_cmd, "unifastmult")==0)
3237  {
3238  poly f = (poly)h->Data();
3239  h=h->next;
3240  poly g=(poly)h->Data();
3241  res->rtyp=POLY_CMD;
3242  res->data=unifastmult(f,g,currRing);
3243  return(FALSE);
3244  }
3245  else
3246  if (strcmp(sys_cmd, "multifastmult")==0)
3247  {
3248  poly f = (poly)h->Data();
3249  h=h->next;
3250  poly g=(poly)h->Data();
3251  res->rtyp=POLY_CMD;
3252  res->data=multifastmult(f,g,currRing);
3253  return(FALSE);
3254  }
3255  else
3256  if (strcmp(sys_cmd, "mults")==0)
3257  {
3258  res->rtyp=INT_CMD ;
3259  res->data=(void*)(long) Mults();
3260  return(FALSE);
3261  }
3262  else
3263  if (strcmp(sys_cmd, "fastpower")==0)
3264  {
3265  ring r = currRing;
3266  poly f = (poly)h->Data();
3267  h=h->next;
3268  int n=(int)((long)h->Data());
3269  res->rtyp=POLY_CMD ;
3270  res->data=(void*) pFastPower(f,n,r);
3271  return(FALSE);
3272  }
3273  else
3274  if (strcmp(sys_cmd, "normalpower")==0)
3275  {
3276  poly f = (poly)h->Data();
3277  h=h->next;
3278  int n=(int)((long)h->Data());
3279  res->rtyp=POLY_CMD ;
3280  res->data=(void*) pPower(pCopy(f),n);
3281  return(FALSE);
3282  }
3283  else
3284  if (strcmp(sys_cmd, "MCpower")==0)
3285  {
3286  ring r = currRing;
3287  poly f = (poly)h->Data();
3288  h=h->next;
3289  int n=(int)((long)h->Data());
3290  res->rtyp=POLY_CMD ;
3291  res->data=(void*) pFastPowerMC(f,n,r);
3292  return(FALSE);
3293  }
3294  else
3295  if (strcmp(sys_cmd, "bit_subst")==0)
3296  {
3297  ring r = currRing;
3298  poly outer = (poly)h->Data();
3299  h=h->next;
3300  poly inner=(poly)h->Data();
3301  res->rtyp=POLY_CMD ;
3302  res->data=(void*) uni_subst_bits(outer, inner,r);
3303  return(FALSE);
3304  }
3305  else
3306  /*==================== gcd-varianten =================*/
3307  if (strcmp(sys_cmd, "gcd") == 0)
3308  {
3309  if (h==NULL)
3310  {
3311 #ifdef HAVE_PLURAL
3312  Print("EZGCD:%d (use EZGCD for gcd of polynomials in char 0)\n",isOn(SW_USE_EZGCD));
3313  Print("EZGCD_P:%d (use EZGCD_P for gcd of polynomials in char p)\n",isOn(SW_USE_EZGCD_P));
3314  Print("CRGCD:%d (use chinese Remainder for gcd of polynomials in char 0)\n",isOn(SW_USE_CHINREM_GCD));
3315  Print("QGCD:%d (use QGCD for gcd of polynomials in alg. ext.)\n",isOn(SW_USE_QGCD));
3316 #endif
3317  Print("homog:%d (use homog. test for factorization of polynomials)\n",singular_homog_flag);
3318  return FALSE;
3319  }
3320  else
3321  if ((h!=NULL) && (h->Typ()==STRING_CMD)
3322  && (h->next!=NULL) && (h->next->Typ()==INT_CMD))
3323  {
3324  int d=(int)(long)h->next->Data();
3325  char *s=(char *)h->Data();
3326 #ifdef HAVE_PLURAL
3327  if (strcmp(s,"EZGCD")==0) { if (d) On(SW_USE_EZGCD); else Off(SW_USE_EZGCD); } else
3328  if (strcmp(s,"EZGCD_P")==0) { if (d) On(SW_USE_EZGCD_P); else Off(SW_USE_EZGCD_P); } else
3329  if (strcmp(s,"CRGCD")==0) { if (d) On(SW_USE_CHINREM_GCD); else Off(SW_USE_CHINREM_GCD); } else
3330  if (strcmp(s,"QGCD")==0) { if (d) On(SW_USE_QGCD); else Off(SW_USE_QGCD); } else
3331 #endif
3332  if (strcmp(s,"homog")==0) { if (d) singular_homog_flag=1; else singular_homog_flag=0; } else
3333  return TRUE;
3334  return FALSE;
3335  }
3336  else return TRUE;
3337  }
3338  else
3339  /*==================== subring =================*/
3340  if (strcmp(sys_cmd, "subring") == 0)
3341  {
3342  if (h!=NULL)
3343  {
3344  extern ring rSubring(ring r,leftv v); /* ipshell.cc*/
3345  res->data=(char *)rSubring(currRing,h);
3346  res->rtyp=RING_CMD;
3347  return res->data==NULL;
3348  }
3349  else return TRUE;
3350  }
3351  else
3352  /*==================== HNF =================*/
3353  #ifdef HAVE_NTL
3354  if (strcmp(sys_cmd, "HNF") == 0)
3355  {
3356  if (h!=NULL)
3357  {
3358  res->rtyp=h->Typ();
3359  if (h->Typ()==MATRIX_CMD)
3360  {
3361  res->data=(char *)singntl_HNF((matrix)h->Data(), currRing);
3362  return FALSE;
3363  }
3364  else if (h->Typ()==INTMAT_CMD)
3365  {
3366  res->data=(char *)singntl_HNF((intvec*)h->Data());
3367  return FALSE;
3368  }
3369  else return TRUE;
3370  }
3371  else return TRUE;
3372  }
3373  else
3374  /*================= probIrredTest ======================*/
3375  if (strcmp (sys_cmd, "probIrredTest") == 0)
3376  {
3377  if (h!=NULL && (h->Typ()== POLY_CMD) && ((h->next != NULL) && h->next->Typ() == STRING_CMD))
3378  {
3379  CanonicalForm F= convSingPFactoryP((poly)(h->Data()), currRing);
3380  char *s=(char *)h->next->Data();
3381  double error= atof (s);
3382  int irred= probIrredTest (F, error);
3383  res->rtyp= INT_CMD;
3384  res->data= (void*)(long)irred;
3385  return FALSE;
3386  }
3387  else return TRUE;
3388  }
3389  else
3390  #endif
3391  #ifdef __CYGWIN__
3392  /*==================== Python Singular =================*/
3393  if (strcmp(sys_cmd, "python") == 0)
3394  {
3395  const char* c;
3396  if ((h!=NULL) && (h->Typ()==STRING_CMD))
3397  {
3398  c=(const char*)h->Data();
3399  if (!PyInitialized) {
3400  PyInitialized = 1;
3401  // Py_Initialize();
3402  // initPySingular();
3403  }
3404  // PyRun_SimpleString(c);
3405  return FALSE;
3406  }
3407  else return TRUE;
3408  }
3409  else
3410  /*==================== Python Singular =================
3411  if (strcmp(sys_cmd, "ipython") == 0)
3412  {
3413  const char* c;
3414  {
3415  if (!PyInitialized)
3416  {
3417  PyInitialized = 1;
3418  Py_Initialize();
3419  initPySingular();
3420  }
3421  PyRun_SimpleString(
3422  "try: \n\
3423  __IPYTHON__ \n\
3424  except NameError: \n\
3425  argv = [''] \n\
3426  banner = exit_msg = '' \n\
3427  else: \n\
3428  # Command-line options for IPython (a list like sys.argv) \n\
3429  argv = ['-pi1','In <\\#>:','-pi2',' .\\D.:','-po','Out<\\#>:'] \n\
3430  banner = '*** Nested interpreter ***' \n\
3431  exit_msg = '*** Back in main IPython ***' \n\
3432  \n\
3433  # First import the embeddable shell class \n\
3434  from IPython.Shell import IPShellEmbed \n\
3435  # Now create the IPython shell instance. Put ipshell() anywhere in your code \n\
3436  # where you want it to open. \n\
3437  ipshell = IPShellEmbed(argv,banner=banner,exit_msg=exit_msg) \n\
3438  ipshell()");
3439  return FALSE;
3440  }
3441  }
3442  else
3443  */
3444 
3445  #endif
3446  /*==================== mpz_t loader ======================*/
3447  if(strcmp(sys_cmd, "GNUmpLoad")==0)
3448  {
3449  if ((h != NULL) && (h->Typ() == STRING_CMD))
3450  {
3451  char* filename = (char*)h->Data();
3452  FILE* f = fopen(filename, "r");
3453  if (f == NULL)
3454  {
3455  WerrorS( "invalid file name (in paths use '/')");
3456  return FALSE;
3457  }
3458  mpz_t m; mpz_init(m);
3459  mpz_inp_str(m, f, 10);
3460  fclose(f);
3461  number n = n_InitMPZ(m, coeffs_BIGINT);
3462  res->rtyp = BIGINT_CMD;
3463  res->data = (void*)n;
3464  return FALSE;
3465  }
3466  else
3467  {
3468  WerrorS( "expected valid file name as a string");
3469  return TRUE;
3470  }
3471  }
3472  else
3473  /*==================== intvec matching ======================*/
3474  /* Given two non-empty intvecs, the call
3475  'system("intvecMatchingSegments", ivec, jvec);'
3476  computes all occurences of jvec in ivec, i.e., it returns
3477  a list of int indices k such that ivec[k..size(jvec)+k-1] = jvec.
3478  If no such k exists (e.g. when ivec is shorter than jvec), an
3479  intvec with the single entry 0 is being returned. */
3480  if(strcmp(sys_cmd, "intvecMatchingSegments")==0)
3481  {
3482  if ((h != NULL) && (h->Typ() == INTVEC_CMD) &&
3483  (h->next != NULL) && (h->next->Typ() == INTVEC_CMD) &&
3484  (h->next->next == NULL))
3485  {
3486  intvec* ivec = (intvec*)h->Data();
3487  intvec* jvec = (intvec*)h->next->Data();
3488  intvec* r = new intvec(1); (*r)[0] = 0;
3489  int validEntries = 0;
3490  for (int k = 0; k <= ivec->rows() - jvec->rows(); k++)
3491  {
3492  if (memcmp(&(*ivec)[k], &(*jvec)[0],
3493  sizeof(int) * jvec->rows()) == 0)
3494  {
3495  if (validEntries == 0)
3496  (*r)[0] = k + 1;
3497  else
3498  {
3499  r->resize(validEntries + 1);
3500  (*r)[validEntries] = k + 1;
3501  }
3502  validEntries++;
3503  }
3504  }
3505  res->rtyp = INTVEC_CMD;
3506  res->data = (void*)r;
3507  return FALSE;
3508  }
3509  else
3510  {
3511  WerrorS("expected two non-empty intvecs as arguments");
3512  return TRUE;
3513  }
3514  }
3515  else
3516  /* ================== intvecOverlap ======================= */
3517  /* Given two non-empty intvecs, the call
3518  'system("intvecOverlap", ivec, jvec);'
3519  computes the longest intvec kvec such that ivec ends with kvec
3520  and jvec starts with kvec. The length of this overlap is being
3521  returned. If there is no overlap at all, then 0 is being returned. */
3522  if(strcmp(sys_cmd, "intvecOverlap")==0)
3523  {
3524  if ((h != NULL) && (h->Typ() == INTVEC_CMD) &&
3525  (h->next != NULL) && (h->next->Typ() == INTVEC_CMD) &&
3526  (h->next->next == NULL))
3527  {
3528  intvec* ivec = (intvec*)h->Data();
3529  intvec* jvec = (intvec*)h->next->Data();
3530  int ir = ivec->rows(); int jr = jvec->rows();
3531  int r = jr; if (ir < jr) r = ir; /* r = min{ir, jr} */
3532  while ((r >= 1) && (memcmp(&(*ivec)[ir - r], &(*jvec)[0],
3533  sizeof(int) * r) != 0))
3534  r--;
3535  res->rtyp = INT_CMD;
3536  res->data = (void*)(long)r;
3537  return FALSE;
3538  }
3539  else
3540  {
3541  WerrorS("expected two non-empty intvecs as arguments");
3542  return TRUE;
3543  }
3544  }
3545  else
3546  /*==================== Hensel's lemma ======================*/
3547  if(strcmp(sys_cmd, "henselfactors")==0)
3548  {
3549  if ((h != NULL) && (h->Typ() == INT_CMD) &&
3550  (h->next != NULL) && (h->next->Typ() == INT_CMD) &&
3551  (h->next->next != NULL) && (h->next->next->Typ() == POLY_CMD) &&
3552  (h->next->next->next != NULL) &&
3553  (h->next->next->next->Typ() == POLY_CMD) &&
3554  (h->next->next->next->next != NULL) &&
3555  (h->next->next->next->next->Typ() == POLY_CMD) &&
3556  (h->next->next->next->next->next != NULL) &&
3557  (h->next->next->next->next->next->Typ() == INT_CMD) &&
3558  (h->next->next->next->next->next->next == NULL))
3559  {
3560  int xIndex = (int)(long)h->Data();
3561  int yIndex = (int)(long)h->next->Data();
3562  poly hh = (poly)h->next->next->Data();
3563  poly f0 = (poly)h->next->next->next->Data();
3564  poly g0 = (poly)h->next->next->next->next->Data();
3565  int d = (int)(long)h->next->next->next->next->next->Data();
3566  poly f; poly g;
3567  henselFactors(xIndex, yIndex, hh, f0, g0, d, f, g);
3569  L->Init(2);
3570  L->m[0].rtyp = POLY_CMD; L->m[0].data=(void*)f;
3571  L->m[1].rtyp = POLY_CMD; L->m[1].data=(void*)g;
3572  res->rtyp = LIST_CMD;
3573  res->data = (char *)L;
3574  return FALSE;
3575  }
3576  else
3577  {
3578  WerrorS( "expected argument list (int, int, poly, poly, poly, int)");
3579  return TRUE;
3580  }
3581  }
3582  else
3583  /*==================== neworder =============================*/
3584  if(strcmp(sys_cmd,"neworder")==0)
3585  {
3586  if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
3587  {
3588  res->rtyp=STRING_CMD;
3589  res->data=(void *)singclap_neworder((ideal)h->Data(), currRing);
3590  return FALSE;
3591  }
3592  else
3593  WerrorS("ideal expected");
3594  }
3595  else
3596  /*==================== Approx_Step =================*/
3597  #ifdef HAVE_PLURAL
3598  if (strcmp(sys_cmd, "astep") == 0)
3599  {
3600  ideal I;
3601  if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
3602  {
3603  I=(ideal)h->CopyD();
3604  res->rtyp=IDEAL_CMD;
3605  if (rIsPluralRing(currRing)) res->data=Approx_Step(I);
3606  else res->data=I;
3607  setFlag(res,FLAG_STD);
3608  }
3609  else return TRUE;
3610  return FALSE;
3611  }
3612  else
3613  #endif
3614  /*==================== PrintMat =================*/
3615  #ifdef HAVE_PLURAL
3616  if (strcmp(sys_cmd, "PrintMat") == 0)
3617  {
3618  int a;
3619  int b;
3620  ring r;
3621  int metric;
3622  if (h!=NULL)
3623  {
3624  if (h->Typ()==INT_CMD)
3625  {
3626  a=(int)((long)(h->Data()));
3627  h=h->next;
3628  }
3629  else if (h->Typ()==INT_CMD)
3630  {
3631  b=(int)((long)(h->Data()));
3632  h=h->next;
3633  }
3634  else if (h->Typ()==RING_CMD)
3635  {
3636  r=(ring)h->Data();
3637  h=h->next;
3638  }
3639  else
3640  return TRUE;
3641  }
3642  else
3643  return TRUE;
3644  if ((h!=NULL) && (h->Typ()==INT_CMD))
3645  {
3646  metric=(int)((long)(h->Data()));
3647  }
3648  res->rtyp=MATRIX_CMD;
3649  if (rIsPluralRing(r)) res->data=nc_PrintMat(a,b,r,metric);
3650  else res->data=NULL;
3651  return FALSE;
3652  }
3653  else
3654  #endif
3655 /* ============ NCUseExtensions ======================== */
3656  #ifdef HAVE_PLURAL
3657  if(strcmp(sys_cmd,"NCUseExtensions")==0)
3658  {
3659  if ((h!=NULL) && (h->Typ()==INT_CMD))
3660  res->data=(void *)(long)setNCExtensions( (int)((long)(h->Data())) );
3661  else
3662  res->data=(void *)(long)getNCExtensions();
3663  res->rtyp=INT_CMD;
3664  return FALSE;
3665  }
3666  else
3667  #endif
3668 /* ============ NCGetType ======================== */
3669  #ifdef HAVE_PLURAL
3670  if(strcmp(sys_cmd,"NCGetType")==0)
3671  {
3672  res->rtyp=INT_CMD;
3673  if( rIsPluralRing(currRing) )
3674  res->data=(void *)(long)ncRingType(currRing);
3675  else
3676  res->data=(void *)(-1L);
3677  return FALSE;
3678  }
3679  else
3680  #endif
3681 /* ============ ForceSCA ======================== */
3682  #ifdef HAVE_PLURAL
3683  if(strcmp(sys_cmd,"ForceSCA")==0)
3684  {
3685  if( !rIsPluralRing(currRing) )
3686  return TRUE;
3687  int b, e;
3688  if ((h!=NULL) && (h->Typ()==INT_CMD))
3689  {
3690  b = (int)((long)(h->Data()));
3691  h=h->next;
3692  }
3693  else return TRUE;
3694  if ((h!=NULL) && (h->Typ()==INT_CMD))
3695  {
3696  e = (int)((long)(h->Data()));
3697  }
3698  else return TRUE;
3699  if( !sca_Force(currRing, b, e) )
3700  return TRUE;
3701  return FALSE;
3702  }
3703  else
3704  #endif
3705 /* ============ ForceNewNCMultiplication ======================== */
3706  #ifdef HAVE_PLURAL
3707  if(strcmp(sys_cmd,"ForceNewNCMultiplication")==0)
3708  {
3709  if( !rIsPluralRing(currRing) )
3710  return TRUE;
3711  if( !ncInitSpecialPairMultiplication(currRing) ) // No Plural!
3712  return TRUE;
3713  return FALSE;
3714  }
3715  else
3716  #endif
3717 /* ============ ForceNewOldNCMultiplication ======================== */
3718  #ifdef HAVE_PLURAL
3719  if(strcmp(sys_cmd,"ForceNewOldNCMultiplication")==0)
3720  {
3721  if( !rIsPluralRing(currRing) )
3722  return TRUE;
3723  if( !ncInitSpecialPowersMultiplication(currRing) ) // Enable Formula for Plural (depends on swiches)!
3724  return TRUE;
3725  return FALSE;
3726  }
3727  else
3728  #endif
3729 /*==================== test64 =================*/
3730  #if 0
3731  if(strcmp(sys_cmd,"test64")==0)
3732  {
3733  long l=8;int i;
3734  for(i=1;i<62;i++)
3735  {
3736  l=l<<1;
3737  number n=n_Init(l,coeffs_BIGINT);
3738  Print("%ld= ",l);n_Print(n,coeffs_BIGINT);
3740  n_Delete(&n,coeffs_BIGINT);
3742  PrintS(" F:");
3744  PrintLn();
3745  n_Delete(&n,coeffs_BIGINT);
3746  }
3747  Print("SIZEOF_LONG=%d\n",SIZEOF_LONG);
3748  return FALSE;
3749  }
3750  else
3751  #endif
3752 /*==================== n_SwitchChinRem =================*/
3753  if(strcmp(sys_cmd,"cache_chinrem")==0)
3754  {
3755  extern int n_SwitchChinRem;
3756  Print("caching inverse in chines remainder:%d\n",n_SwitchChinRem);
3757  if ((h!=NULL)&&(h->Typ()==INT_CMD))
3758  n_SwitchChinRem=(int)(long)h->Data();
3759  return FALSE;
3760  }
3761  else
3762 /*==================== LU for bigintmat =================*/
3763 #ifdef SINGULAR_4_1
3764  if(strcmp(sys_cmd,"LU")==0)
3765  {
3766  if ((h!=NULL) && (h->Typ()==CMATRIX_CMD))
3767  {
3768  // get the argument:
3769  bigintmat *b=(bigintmat *)h->Data();
3770  // just for tests: simply transpose
3771  bigintmat *bb=b->transpose();
3772  // return the result:
3773  res->rtyp=CMATRIX_CMD;
3774  res->data=(char*)bb;
3775  return FALSE;
3776  }
3777  else
3778  {
3779  WerrorS("system(\"LU\",<cmatrix>) expected");
3780  return TRUE;
3781  }
3782  }
3783  else
3784 #endif
3785 /*==================== Error =================*/
3786  Werror( "(extended) system(\"%s\",...) %s", sys_cmd, feNotImplemented );
3787  }
3788  return TRUE;
3789 }
bigintmat * transpose()
Definition: bigintmat.cc:38
int & rows()
Definition: matpol.h:24
int status int fd
Definition: si_signals.h:59
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
int posInT_pLength(const TSet set, const int length, LObject &p)
Definition: kutil.cc:9869
#define pIsPurePower(p)
Definition: polys.h:219
const CanonicalForm int s
Definition: facAbsFact.cc:55
sleftv * m
Definition: lists.h:45
poly pFastPower(poly f, int n, ring r)
Definition: fast_mult.cc:342
void p_DebugPrint(poly p, const ring r)
Definition: ring.cc:4240
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
const char * omError2String(omError_t error)
Definition: omError.c:52
ring rSubring(ring org_ring, sleftv *rv)
Definition: ipshell.cc:5837
void resize(int new_length)
Definition: intvec.cc:125
const poly a
Definition: syzextra.cc:212
int sdb_flags
Definition: sdb.cc:32
void PrintLn()
Definition: reporter.cc:327
int posInT2(const TSet set, const int length, LObject &p)
Definition: kutil.cc:4341
#define Print
Definition: emacs.cc:83
Definition: tok.h:85
#define pAdd(p, q)
Definition: polys.h:174
void Off(int sw)
switches
class sLObject LObject
Definition: kutil.h:60
Definition: lists.h:22
TObject * TSet
Definition: kutil.h:61
void henselFactors(const int xIndex, const int yIndex, const poly h, const poly f0, const poly g0, const int d, poly &f, poly &g)
Computes a factorization of a polynomial h(x, y) in K[[x]][y] up to a certain degree in x...
#define FALSE
Definition: auxiliary.h:140
int posInT1(const TSet set, const int length, LObject &p)
Definition: kutil.cc:4313
Definition: tok.h:42
return P p
Definition: myNF.cc:203
short * iv2array(intvec *iv, const ring R)
Definition: weight.cc:208
Matrices of numbers.
Definition: bigintmat.h:51
number n_convFactoryNSingN(const CanonicalForm n, const coeffs r)
Definition: numbers.cc:560
f
Definition: cfModGcd.cc:4022
lists testsvd(matrix M)
Definition: calcSVD.cc:27
void sdb_edit(procinfo *pi)
Definition: sdb.cc:110
void slicehilb(ideal I)
Definition: hilb.cc:1095
int & getNCExtensions()
Definition: old.gring.cc:88
static const int SW_USE_EZGCD_P
set to 1 to use EZGCD over F_q
Definition: cf_defs.h:34
int setNCExtensions(int iMask)
Definition: old.gring.cc:93
int n_SwitchChinRem
Definition: longrat.cc:2753
static FORCE_INLINE number n_Init(long i, const coeffs r)
a number representing i in the given coeff field/ring r
Definition: coeffs.h:539
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
int rChar(ring r)
Definition: ring.cc:684
poly pFastPowerMC(poly f, int n, ring r)
Definition: fast_mult.cc:588
unsigned long ** singularMatrixToLongMatrix(matrix singularMatrix)
Definition: extra.cc:190
omError_t om_InternalErrorStatus
Definition: omError.c:12
poly nc_rat_ReduceSpolyNew(const poly p1, poly p2, int ishift, const ring r)
Definition: ratgring.cc:466
static FORCE_INLINE int n_GetChar(const coeffs r)
Return the characteristic of the coeff. domain.
Definition: coeffs.h:445
factory&#39;s main class
Definition: canonicalform.h:75
#define TRUE
Definition: auxiliary.h:144
void * ADDRESS
Definition: auxiliary.h:161
static coordinates * points
void * dynl_sym(void *handle, const char *symbol)
Definition: mod_raw.cc:171
g
Definition: cfModGcd.cc:4031
void WerrorS(const char *s)
Definition: feFopen.cc:24
int k
Definition: cfEzgcd.cc:93
int testGB(ideal I, ideal GI)
Definition: ringgb.cc:230
static TreeM * G
Definition: janet.cc:38
int posInT15(const TSet set, const int length, LObject &p)
Definition: kutil.cc:4618
coeffs coeffs_BIGINT
Definition: ipid.cc:54
int Typ()
Definition: subexpr.cc:969
#define omAlloc(size)
Definition: omAllocDecl.h:210
static bool rIsPluralRing(const ring r)
we must always have this test!
Definition: ring.h:361
#define Sy_bit(x)
Definition: options.h:30
void setCharacteristic(int c)
Definition: cf_char.cc:23
CanonicalForm n_convSingNFactoryN(number n, BOOLEAN setChar, const coeffs r)
Definition: numbers.cc:565
static int pLength(poly a)
Definition: p_polys.h:189
int posInT0(const TSet, const int length, LObject &)
Definition: kutil.cc:4302
poly pp
Definition: myNF.cc:296
void rDebugPrint(ring r)
Definition: ring.cc:4035
void * dynl_open(char *filename)
Definition: mod_raw.cc:157
omOpts_t om_Opts
Definition: omOpts.c:11
static poly fglmNewLinearCombination(ideal source, poly monset)
Definition: fglmcomb.cc:155
void * data
Definition: subexpr.h:89
#define pIter(p)
Definition: monomials.h:44
matrix mp_Transp(matrix a, const ring R)
Definition: matpol.cc:268
bool sca_Force(ring rGR, int b, int e)
Definition: sca.cc:1175
#define M
Definition: sirandom.c:24
unsigned long * computeMinimalPolynomial(unsigned long **matrix, unsigned n, unsigned long p)
Definition: minpoly.cc:430
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
#define pGetExp(p, i)
Exponent.
Definition: polys.h:41
int posInT11(const TSet set, const int length, LObject &p)
Definition: kutil.cc:4371
int posInT17_c(const TSet set, const int length, LObject &p)
Definition: kutil.cc:4740
const ring r
Definition: syzextra.cc:208
Definition: intvec.h:16
BOOLEAN rComplete(ring r, int force)
this needs to be called whenever a new ring is created: new fields in ring are created (like VarOffse...
Definition: ring.cc:3436
matrix nc_PrintMat(int a, int b, ring r, int metric)
returns matrix with the info on noncomm multiplication
Definition: old.gring.cc:2459
int j
Definition: myNF.cc:70
static int max(int a, int b)
Definition: fast_mult.cc:264
Definition: tok.h:58
poly uni_subst_bits(poly outer_uni, poly inner_multi, ring r)
Definition: digitech.cc:47
#define omFree(addr)
Definition: omAllocDecl.h:261
poly multifastmult(poly f, poly g, ring r)
Definition: fast_mult.cc:290
omError_t om_ErrorStatus
Definition: omError.c:11
int Mults()
Definition: fast_mult.cc:14
#define pDivideM(a, b)
Definition: polys.h:265
const ring R
Definition: DebugPrint.cc:36
const char feNotImplemented[]
Definition: reporter.cc:54
const char * omError2Serror(omError_t error)
Definition: omError.c:63
ip_smatrix * matrix
static FORCE_INLINE number n_InitMPZ(mpz_t n, const coeffs r)
conversion of a GMP integer to number
Definition: coeffs.h:543
#define setFlag(A, F)
Definition: ipid.h:112
int m
Definition: cfEzgcd.cc:119
bool isOn(int sw)
switches
poly nc_rat_CreateSpoly(poly pp1, poly pp2, int ishift, const ring r)
Definition: ratgring.cc:341
void On(int sw)
switches
int dim(ideal I, ring r)
BOOLEAN assumeStdFlag(leftv h)
Definition: subexpr.cc:1448
poly longCoeffsToSingularPoly(unsigned long *polyCoeffs, const int degree)
Definition: extra.cc:222
int i
Definition: cfEzgcd.cc:123
void PrintS(const char *s)
Definition: reporter.cc:294
int posInT17(const TSet set, const int length, LObject &p)
Definition: kutil.cc:4676
static const int SW_USE_CHINREM_GCD
set to 1 to use modular gcd over Z
Definition: cf_defs.h:38
Definition: tok.h:88
#define pHead(p)
returns newly allocated copy of Lm(p), coef is copied, next=NULL, p might be NULL ...
Definition: polys.h:67
#define IDELEMS(i)
Definition: simpleideals.h:24
matrix singntl_HNF(matrix m, const ring s)
Definition: clapsing.cc:1639
static short scaFirstAltVar(ring r)
Definition: sca.h:18
poly ringRedNF(poly f, ideal G, ring r)
Definition: ringgb.cc:121
int singular_homog_flag
Definition: cf_factor.cc:377
#define FLAG_STD
Definition: ipid.h:108
poly kFindZeroPoly(poly input_p, ring leadRing, ring tailRing)
Definition: kstd2.cc:295
leftv next
Definition: subexpr.h:87
void rSetSyzComp(int k, const ring r)
Definition: ring.cc:4991
ideal Approx_Step(ideal L)
Ann: ???
Definition: nc.cc:254
poly plain_spoly(poly f, poly g)
Definition: ringgb.cc:172
INLINE_THIS void Init(int l=0)
Definition: lists.h:66
matrix mpNew(int r, int c)
create a r x c zero-matrix
Definition: matpol.cc:48
int posInT_EcartFDegpLength(const TSet set, const int length, LObject &p)
Definition: kutil.cc:9778
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
int & cols()
Definition: matpol.h:25
matrix mp_InitI(int r, int c, int v, const ring R)
make it a v * unit matrix
Definition: matpol.cc:140
#define error(a)
Definition: mpr_numeric.cc:979
#define MATCOLS(i)
Definition: matpol.h:28
#define NULL
Definition: omList.c:10
CanonicalForm convSingPFactoryP(poly p, const ring r)
Definition: clapconv.cc:88
#define pDivisibleBy(a, b)
returns TRUE, if leading monom of a divides leading monom of b i.e., if there exists a expvector c > ...
Definition: polys.h:126
slists * lists
Definition: mpr_numeric.h:146
int rows() const
Definition: intvec.h:88
int probIrredTest(const CanonicalForm &F, double error)
given some error probIrredTest detects irreducibility or reducibility of F with confidence level 1-er...
Definition: facIrredTest.cc:63
BOOLEAN iiCheckTypes(leftv args, const short *type_list, int report)
check a list of arguemys against a given field of types return TRUE if the types match return FALSE (...
Definition: ipshell.cc:6434
int posInT110(const TSet set, const int length, LObject &p)
Definition: kutil.cc:4504
static const int SW_USE_QGCD
set to 1 to use Encarnacion GCD over Q(a)
Definition: cf_defs.h:40
void omUpdateInfo()
Definition: omStats.c:24
static const int SW_USE_EZGCD
set to 1 to use EZGCD over Z
Definition: cf_defs.h:32
const CanonicalForm & w
Definition: facAbsFact.cc:55
static short scaLastAltVar(ring r)
Definition: sca.h:25
int rtyp
Definition: subexpr.h:92
static bool rIsSCA(const ring r)
Definition: nc.h:206
void * Data()
Definition: subexpr.cc:1111
BOOLEAN ncInitSpecialPairMultiplication(ring r)
Definition: ncSAMult.cc:267
CFList int bool & irred
[in,out] Is A irreducible?
Definition: facFactorize.h:31
bool ncInitSpecialPowersMultiplication(ring r)
Definition: ncSAFormula.cc:51
Definition: tok.h:96
int(* test_PosInT)(const TSet T, const int tl, LObject &h)
Definition: kstd2.cc:98
#define omPrintCurrentBackTrace(fd)
Definition: omRet2Info.h:39
static nc_type & ncRingType(nc_struct *p)
Definition: nc.h:175
KINLINE poly ksOldSpolyRed(poly p1, poly p2, poly spNoether)
Definition: kInline.h:1082
int redRat(poly *h, poly *reducer, int *red_length, int rl, int ishift, ring r)
Definition: ratgring.cc:594
#define pLmDeleteAndNext(p)
like pLmDelete, returns pNext(p)
Definition: polys.h:78
omBin slists_bin
Definition: lists.cc:23
void pPrintDivisbleByStat()
Definition: pDebug.cc:412
void omPrintUsedTrackAddrs(FILE *fd, int max_frames)
Definition: omDebugCheck.c:568
#define pPower(p, q)
Definition: polys.h:175
void omMarkAsStaticAddr(void *addr)
void omPrintUsedAddrs(FILE *fd, int max_frames)
Definition: omDebugCheck.c:557
static FORCE_INLINE void n_Delete(number *p, const coeffs r)
delete &#39;p&#39;
Definition: coeffs.h:456
int posInT19(const TSet set, const int length, LObject &p)
Definition: kutil.cc:4805
int(* test_PosInL)(const LSet set, const int length, LObject *L, const kStrategy strat)
Definition: kstd2.cc:99
#define MATROWS(i)
Definition: matpol.h:27
ideal createG0()
Definition: kutil.cc:3683
ideal id_Vec2Ideal(poly vec, const ring R)
static jList * T
Definition: janet.cc:37
polyrec * poly
Definition: hilb.h:10
char * singclap_neworder(ideal I, const ring r)
Definition: clapsing.cc:1487
poly ringNF(poly f, ideal G, ring r)
Definition: ringgb.cc:203
int posInT_FDegpLength(const TSet set, const int length, LObject &p)
Definition: kutil.cc:9832
unsigned si_opt_2
Definition: options.c:6
s?
Definition: ring.h:678
const poly b
Definition: syzextra.cc:213
#define ppJetW(p, m, iv)
Definition: polys.h:340
void Werror(const char *fmt,...)
Definition: reporter.cc:199
#define omAlloc0(size)
Definition: omAllocDecl.h:211
int l
Definition: cfEzgcd.cc:94
int nfMinPoly[16]
Definition: ffields.cc:580
procinfo * procinfov
Definition: structs.h:63
int posInT13(const TSet set, const int length, LObject &p)
Definition: kutil.cc:4550
poly unifastmult(poly f, poly g, ring r)
Definition: fast_mult.cc:272
static poly fglmLinearCombination(ideal source, poly monset)
Definition: fglmcomb.cc:419
#define pCopy(p)
return a copy of the poly
Definition: polys.h:156
#define MATELEM(mat, i, j)
Definition: matpol.h:29
void n_Print(number &a, const coeffs r)
print a number (BEWARE of string buffers!) mostly for debugging
Definition: numbers.cc:549
#define Warn
Definition: emacs.cc:80
#define omStrDup(s)
Definition: omAllocDecl.h:263
ideal F5main(ideal id, ring r, int opt, int plus, int termination)
Definition: f5gb.cc:1880
BOOLEAN jjSYSTEM ( leftv  res,
leftv  args 
)

Definition at line 245 of file extra.cc.

246 {
247  if(args->Typ() == STRING_CMD)
248  {
249  const char *sys_cmd=(char *)(args->Data());
250  leftv h=args->next;
251 // ONLY documented system calls go here
252 // Undocumented system calls go down into jjEXTENDED_SYSTEM (#ifdef HAVE_EXTENDED_SYSTEM)
253 /*==================== nblocks ==================================*/
254  if (strcmp(sys_cmd, "nblocks") == 0)
255  {
256  ring r;
257  if (h == NULL)
258  {
259  if (currRingHdl != NULL)
260  {
261  r = IDRING(currRingHdl);
262  }
263  else
264  {
265  WerrorS("no ring active");
266  return TRUE;
267  }
268  }
269  else
270  {
271  if (h->Typ() != RING_CMD)
272  {
273  WerrorS("ring expected");
274  return TRUE;
275  }
276  r = (ring) h->Data();
277  }
278  res->rtyp = INT_CMD;
279  res->data = (void*) (long)(rBlocks(r) - 1);
280  return FALSE;
281  }
282 /*==================== version ==================================*/
283  if(strcmp(sys_cmd,"version")==0)
284  {
285  res->rtyp=INT_CMD;
286  res->data=(void *)SINGULAR_VERSION;
287  return FALSE;
288  }
289  else
290 /*==================== cpu ==================================*/
291  if(strcmp(sys_cmd,"cpu")==0)
292  {
293  long cpu=1; //feOptValue(FE_OPT_CPUS);
294  #ifdef _SC_NPROCESSORS_ONLN
295  cpu=sysconf(_SC_NPROCESSORS_ONLN);
296  #elif defined(_SC_NPROCESSORS_CONF)
297  cpu=sysconf(_SC_NPROCESSORS_CONF);
298  #endif
299  res->data=(void *)cpu;
300  res->rtyp=INT_CMD;
301  return FALSE;
302  }
303  else
304 
305 /*==================== sh ==================================*/
306  if(strcmp(sys_cmd,"sh")==0)
307  {
308  if (feOptValue(FE_OPT_NO_SHELL))
309  {
310  WerrorS("shell execution is disallowed in restricted mode");
311  return TRUE;
312  }
313  res->rtyp=INT_CMD;
314  if (h==NULL) res->data = (void *)(long) system("sh");
315  else if (h->Typ()==STRING_CMD)
316  res->data = (void*)(long) system((char*)(h->Data()));
317  else
318  WerrorS("string expected");
319  return FALSE;
320  }
321  else
322  #if 0
323  if(strcmp(sys_cmd,"power1")==0)
324  {
325  res->rtyp=POLY_CMD;
326  poly f=(poly)h->CopyD();
327  poly g=pPower(f,2000);
328  res->data=(void *)g;
329  return FALSE;
330  }
331  else
332  if(strcmp(sys_cmd,"power2")==0)
333  {
334  res->rtyp=POLY_CMD;
335  poly f=(poly)h->Data();
336  poly g=pOne();
337  for(int i=0;i<2000;i++)
338  g=pMult(g,pCopy(f));
339  res->data=(void *)g;
340  return FALSE;
341  }
342  if(strcmp(sys_cmd,"power3")==0)
343  {
344  res->rtyp=POLY_CMD;
345  poly f=(poly)h->Data();
346  poly p2=pMult(pCopy(f),pCopy(f));
347  poly p4=pMult(pCopy(p2),pCopy(p2));
348  poly p8=pMult(pCopy(p4),pCopy(p4));
349  poly p16=pMult(pCopy(p8),pCopy(p8));
350  poly p32=pMult(pCopy(p16),pCopy(p16));
351  poly p64=pMult(pCopy(p32),pCopy(p32));
352  poly p128=pMult(pCopy(p64),pCopy(p64));
353  poly p256=pMult(pCopy(p128),pCopy(p128));
354  poly p512=pMult(pCopy(p256),pCopy(p256));
355  poly p1024=pMult(pCopy(p512),pCopy(p512));
356  poly p1536=pMult(p1024,p512);
357  poly p1792=pMult(p1536,p256);
358  poly p1920=pMult(p1792,p128);
359  poly p1984=pMult(p1920,p64);
360  poly p2000=pMult(p1984,p16);
361  res->data=(void *)p2000;
362  pDelete(&p2);
363  pDelete(&p4);
364  pDelete(&p8);
365  //pDelete(&p16);
366  pDelete(&p32);
367  //pDelete(&p64);
368  //pDelete(&p128);
369  //pDelete(&p256);
370  //pDelete(&p512);
371  //pDelete(&p1024);
372  //pDelete(&p1536);
373  //pDelete(&p1792);
374  //pDelete(&p1920);
375  //pDelete(&p1984);
376  return FALSE;
377  }
378  else
379  #endif
380 /*==================== uname ==================================*/
381  if(strcmp(sys_cmd,"uname")==0)
382  {
383  res->rtyp=STRING_CMD;
384  res->data = omStrDup(S_UNAME);
385  return FALSE;
386  }
387  else
388 /*==================== with ==================================*/
389  if(strcmp(sys_cmd,"with")==0)
390  {
391  if (h==NULL)
392  {
393  res->rtyp=STRING_CMD;
394  res->data=(void *)versionString();
395  return FALSE;
396  }
397  else if (h->Typ()==STRING_CMD)
398  {
399  #define TEST_FOR(A) if(strcmp(s,A)==0) res->data=(void *)1; else
400  char *s=(char *)h->Data();
401  res->rtyp=INT_CMD;
402  #ifdef HAVE_DBM
403  TEST_FOR("DBM")
404  #endif
405  #ifdef HAVE_DLD
406  TEST_FOR("DLD")
407  #endif
408  //TEST_FOR("factory")
409  //TEST_FOR("libfac")
410  #ifdef HAVE_READLINE
411  TEST_FOR("readline")
412  #endif
413  #ifdef TEST_MAC_ORDER
414  TEST_FOR("MAC_ORDER")
415  #endif
416  // unconditional since 3-1-0-6
417  TEST_FOR("Namespaces")
418  #ifdef HAVE_DYNAMIC_LOADING
419  TEST_FOR("DynamicLoading")
420  #endif
421  #ifdef HAVE_EIGENVAL
422  TEST_FOR("eigenval")
423  #endif
424  #ifdef HAVE_GMS
425  TEST_FOR("gms")
426  #endif
427  #ifdef OM_NDEBUG
428  TEST_FOR("om_ndebug")
429  #endif
430  #ifdef SING_NDEBUG
431  TEST_FOR("ndebug")
432  #endif
433  {};
434  return FALSE;
435  #undef TEST_FOR
436  }
437  return TRUE;
438  }
439  else
440  /*==================== browsers ==================================*/
441  if (strcmp(sys_cmd,"browsers")==0)
442  {
443  res->rtyp = STRING_CMD;
444  StringSetS("");
446  res->data = StringEndS();
447  return FALSE;
448  }
449  else
450  /*==================== pid ==================================*/
451  if (strcmp(sys_cmd,"pid")==0)
452  {
453  res->rtyp=INT_CMD;
454  res->data=(void *)(long) getpid();
455  return FALSE;
456  }
457  else
458  /*==================== getenv ==================================*/
459  if (strcmp(sys_cmd,"getenv")==0)
460  {
461  if ((h!=NULL) && (h->Typ()==STRING_CMD))
462  {
463  res->rtyp=STRING_CMD;
464  const char *r=getenv((char *)h->Data());
465  if (r==NULL) r="";
466  res->data=(void *)omStrDup(r);
467  return FALSE;
468  }
469  else
470  {
471  WerrorS("string expected");
472  return TRUE;
473  }
474  }
475  else
476  /*==================== setenv ==================================*/
477  if (strcmp(sys_cmd,"setenv")==0)
478  {
479  #ifdef HAVE_SETENV
480  const short t[]={2,STRING_CMD,STRING_CMD};
481  if (iiCheckTypes(h,t,1))
482  {
483  res->rtyp=STRING_CMD;
484  setenv((char *)h->Data(), (char *)h->next->Data(), 1);
485  res->data=(void *)omStrDup((char *)h->next->Data());
487  return FALSE;
488  }
489  else
490  {
491  return TRUE;
492  }
493  #else
494  WerrorS("setenv not supported on this platform");
495  return TRUE;
496  #endif
497  }
498  else
499  /*==================== Singular ==================================*/
500  if (strcmp(sys_cmd, "Singular") == 0)
501  {
502  res->rtyp=STRING_CMD;
503  const char *r=feResource("Singular");
504  if (r == NULL) r="";
505  res->data = (void*) omStrDup( r );
506  return FALSE;
507  }
508  else
509  if (strcmp(sys_cmd, "SingularLib") == 0)
510  {
511  res->rtyp=STRING_CMD;
512  const char *r=feResource("SearchPath");
513  if (r == NULL) r="";
514  res->data = (void*) omStrDup( r );
515  return FALSE;
516  }
517  else
518  /*==================== options ==================================*/
519  if (strstr(sys_cmd, "--") == sys_cmd)
520  {
521  if (strcmp(sys_cmd, "--") == 0)
522  {
524  return FALSE;
525  }
526  feOptIndex opt = feGetOptIndex(&sys_cmd[2]);
527  if (opt == FE_OPT_UNDEF)
528  {
529  Werror("Unknown option %s", sys_cmd);
530  WerrorS("Use 'system(\"--\");' for listing of available options");
531  return TRUE;
532  }
533  // for Untyped Options (help version),
534  // setting it just triggers action
535  if (feOptSpec[opt].type == feOptUntyped)
536  {
537  feSetOptValue(opt,0);
538  return FALSE;
539  }
540  if (h == NULL)
541  {
542  if (feOptSpec[opt].type == feOptString)
543  {
544  res->rtyp = STRING_CMD;
545  const char *r=(const char*)feOptSpec[opt].value;
546  if (r == NULL) r="";
547  res->data = omStrDup(r);
548  }
549  else
550  {
551  res->rtyp = INT_CMD;
552  res->data = feOptSpec[opt].value;
553  }
554  return FALSE;
555  }
556  if (h->Typ() != STRING_CMD &&
557  h->Typ() != INT_CMD)
558  {
559  WerrorS("Need string or int argument to set option value");
560  return TRUE;
561  }
562  const char* errormsg;
563  if (h->Typ() == INT_CMD)
564  {
565  if (feOptSpec[opt].type == feOptString)
566  {
567  Werror("Need string argument to set value of option %s", sys_cmd);
568  return TRUE;
569  }
570  errormsg = feSetOptValue(opt, (int)((long) h->Data()));
571  if (errormsg != NULL)
572  Werror("Option '--%s=%d' %s", sys_cmd, (int) ((long)h->Data()), errormsg);
573  }
574  else
575  {
576  errormsg = feSetOptValue(opt, (char*) h->Data());
577  if (errormsg != NULL)
578  Werror("Option '--%s=%s' %s", sys_cmd, (char*) h->Data(), errormsg);
579  }
580  if (errormsg != NULL) return TRUE;
581  return FALSE;
582  }
583  else
584  /*==================== HC ==================================*/
585  if (strcmp(sys_cmd,"HC")==0)
586  {
587  res->rtyp=INT_CMD;
588  res->data=(void *)(long) HCord;
589  return FALSE;
590  }
591  else
592  /*==================== random ==================================*/
593  if(strcmp(sys_cmd,"random")==0)
594  {
595  const short t[]={1,INT_CMD};
596  if (h!=NULL)
597  {
598  if (iiCheckTypes(h,t,1))
599  {
600  siRandomStart=(int)((long)h->Data());
603  return FALSE;
604  }
605  else
606  {
607  return TRUE;
608  }
609  }
610  res->rtyp=INT_CMD;
611  res->data=(void*)(long) siSeed;
612  return FALSE;
613  }
614  else
615  /*==================== std_syz =================*/
616  if (strcmp(sys_cmd, "std_syz") == 0)
617  {
618  ideal i1;
619  int i2;
620  if ((h!=NULL) && (h->Typ()==MODUL_CMD))
621  {
622  i1=(ideal)h->CopyD();
623  h=h->next;
624  }
625  else return TRUE;
626  if ((h!=NULL) && (h->Typ()==INT_CMD))
627  {
628  i2=(int)((long)h->Data());
629  }
630  else return TRUE;
631  res->rtyp=MODUL_CMD;
632  res->data=idXXX(i1,i2);
633  return FALSE;
634  }
635  else
636  /*======================= demon_list =====================*/
637  if (strcmp(sys_cmd,"denom_list")==0)
638  {
639  res->rtyp=LIST_CMD;
640  extern lists get_denom_list();
641  res->data=(lists)get_denom_list();
642  return FALSE;
643  }
644  else
645  /*==================== complexNearZero ======================*/
646  if(strcmp(sys_cmd,"complexNearZero")==0)
647  {
648  const short t[]={2,NUMBER_CMD,INT_CMD};
649  if (iiCheckTypes(h,t,1))
650  {
651  if ( !rField_is_long_C(currRing) )
652  {
653  WerrorS( "unsupported ground field!");
654  return TRUE;
655  }
656  else
657  {
658  res->rtyp=INT_CMD;
659  res->data=(void*)complexNearZero((gmp_complex*)h->Data(),
660  (int)((long)(h->next->Data())));
661  return FALSE;
662  }
663  }
664  else
665  {
666  return TRUE;
667  }
668  }
669  else
670  /*==================== getPrecDigits ======================*/
671  if(strcmp(sys_cmd,"getPrecDigits")==0)
672  {
673  if ( (currRing==NULL)
675  {
676  WerrorS( "unsupported ground field!");
677  return TRUE;
678  }
679  res->rtyp=INT_CMD;
680  res->data=(void*)(long)gmp_output_digits;
681  //if (gmp_output_digits!=getGMPFloatDigits())
682  //{ Print("%d, %d\n",getGMPFloatDigits(),gmp_output_digits);}
683  return FALSE;
684  }
685  else
686  /*==================== lduDecomp ======================*/
687  if(strcmp(sys_cmd, "lduDecomp")==0)
688  {
689  const short t[]={1,MATRIX_CMD};
690  if (iiCheckTypes(h,t,1))
691  {
692  matrix aMat = (matrix)h->Data();
693  matrix pMat; matrix lMat; matrix dMat; matrix uMat;
694  poly l; poly u; poly prodLU;
695  lduDecomp(aMat, pMat, lMat, dMat, uMat, l, u, prodLU);
697  L->Init(7);
698  L->m[0].rtyp = MATRIX_CMD; L->m[0].data=(void*)pMat;
699  L->m[1].rtyp = MATRIX_CMD; L->m[1].data=(void*)lMat;
700  L->m[2].rtyp = MATRIX_CMD; L->m[2].data=(void*)dMat;
701  L->m[3].rtyp = MATRIX_CMD; L->m[3].data=(void*)uMat;
702  L->m[4].rtyp = POLY_CMD; L->m[4].data=(void*)l;
703  L->m[5].rtyp = POLY_CMD; L->m[5].data=(void*)u;
704  L->m[6].rtyp = POLY_CMD; L->m[6].data=(void*)prodLU;
705  res->rtyp = LIST_CMD;
706  res->data = (char *)L;
707  return FALSE;
708  }
709  else
710  {
711  return TRUE;
712  }
713  }
714  else
715  /*==================== lduSolve ======================*/
716  if(strcmp(sys_cmd, "lduSolve")==0)
717  {
718  /* for solving a linear equation system A * x = b, via the
719  given LDU-decomposition of the matrix A;
720  There is one valid parametrisation:
721  1) exactly eight arguments P, L, D, U, l, u, lTimesU, b;
722  P, L, D, and U realise the LDU-decomposition of A, that is,
723  P * A = L * D^(-1) * U, and P, L, D, and U satisfy the
724  properties decribed in method 'luSolveViaLDUDecomp' in
725  linearAlgebra.h; see there;
726  l, u, and lTimesU are as described in the same location;
727  b is the right-hand side vector of the linear equation system;
728  The method will return a list of either 1 entry or three entries:
729  1) [0] if there is no solution to the system;
730  2) [1, x, H] if there is at least one solution;
731  x is any solution of the given linear system,
732  H is the matrix with column vectors spanning the homogeneous
733  solution space.
734  The method produces an error if matrix and vector sizes do not
735  fit. */
736  const short t[]={7,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD,POLY_CMD,POLY_CMD,MATRIX_CMD};
737  if (!iiCheckTypes(h,t,1))
738  {
739  return TRUE;
740  }
742  {
743  WerrorS("field required");
744  return TRUE;
745  }
746  matrix pMat = (matrix)h->Data();
747  matrix lMat = (matrix)h->next->Data();
748  matrix dMat = (matrix)h->next->next->Data();
749  matrix uMat = (matrix)h->next->next->next->Data();
750  poly l = (poly) h->next->next->next->next->Data();
751  poly u = (poly) h->next->next->next->next->next->Data();
752  poly lTimesU = (poly) h->next->next->next->next->next->next->Data();
753  matrix bVec = (matrix)h->next->next->next->next->next->next->next->Data();
754  matrix xVec; int solvable; matrix homogSolSpace;
755  if (pMat->rows() != pMat->cols())
756  {
757  Werror("first matrix (%d x %d) is not quadratic",
758  pMat->rows(), pMat->cols());
759  return TRUE;
760  }
761  if (lMat->rows() != lMat->cols())
762  {
763  Werror("second matrix (%d x %d) is not quadratic",
764  lMat->rows(), lMat->cols());
765  return TRUE;
766  }
767  if (dMat->rows() != dMat->cols())
768  {
769  Werror("third matrix (%d x %d) is not quadratic",
770  dMat->rows(), dMat->cols());
771  return TRUE;
772  }
773  if (dMat->cols() != uMat->rows())
774  {
775  Werror("third matrix (%d x %d) and fourth matrix (%d x %d) %s",
776  dMat->rows(), dMat->cols(), uMat->rows(), uMat->cols(),
777  "do not t");
778  return TRUE;
779  }
780  if (uMat->rows() != bVec->rows())
781  {
782  Werror("fourth matrix (%d x %d) and vector (%d x 1) do not fit",
783  uMat->rows(), uMat->cols(), bVec->rows());
784  return TRUE;
785  }
786  solvable = luSolveViaLDUDecomp(pMat, lMat, dMat, uMat, l, u, lTimesU,
787  bVec, xVec, homogSolSpace);
788 
789  /* build the return structure; a list with either one or
790  three entries */
792  if (solvable)
793  {
794  ll->Init(3);
795  ll->m[0].rtyp=INT_CMD; ll->m[0].data=(void *)(long)solvable;
796  ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)xVec;
797  ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)homogSolSpace;
798  }
799  else
800  {
801  ll->Init(1);
802  ll->m[0].rtyp=INT_CMD; ll->m[0].data=(void *)(long)solvable;
803  }
804  res->rtyp = LIST_CMD;
805  res->data=(char*)ll;
806  return FALSE;
807  }
808  else
809  /*==== countedref: reference and shared ====*/
810  if (strcmp(sys_cmd, "shared") == 0)
811  {
812  #ifndef SI_COUNTEDREF_AUTOLOAD
813  void countedref_shared_load();
815  #endif
816  res->rtyp = NONE;
817  return FALSE;
818  }
819  else if (strcmp(sys_cmd, "reference") == 0)
820  {
821  #ifndef SI_COUNTEDREF_AUTOLOAD
824  #endif
825  res->rtyp = NONE;
826  return FALSE;
827  }
828  else
829 /*==================== semaphore =================*/
830 #ifdef HAVE_SIMPLEIPC
831  if (strcmp(sys_cmd,"semaphore")==0)
832  {
833  if((h!=NULL) && (h->Typ()==STRING_CMD) && (h->next!=NULL) && (h->next->Typ()==INT_CMD))
834  {
835  int v=1;
836  if ((h->next->next!=NULL)&& (h->next->next->Typ()==INT_CMD))
837  v=(int)(long)h->next->next->Data();
838  res->data=(char *)(long)simpleipc_cmd((char *)h->Data(),(int)(long)h->next->Data(),v);
839  res->rtyp=INT_CMD;
840  return FALSE;
841  }
842  else
843  {
844  WerrorS("Usage: system(\"semaphore\",<cmd>,int)");
845  return TRUE;
846  }
847  }
848  else
849 #endif
850 /*==================== reserved port =================*/
851  if (strcmp(sys_cmd,"reserve")==0)
852  {
853  int ssiReservePort(int clients);
854  const short t[]={1,INT_CMD};
855  if (iiCheckTypes(h,t,1))
856  {
857  res->rtyp=INT_CMD;
858  int p=ssiReservePort((int)(long)h->Data());
859  res->data=(void*)(long)p;
860  return (p==0);
861  }
862  return TRUE;
863  }
864  else
865 /*==================== reserved link =================*/
866  if (strcmp(sys_cmd,"reservedLink")==0)
867  {
868  extern si_link ssiCommandLink();
869  res->rtyp=LINK_CMD;
871  res->data=(void*)p;
872  return (p==NULL);
873  }
874  else
875 /*==================== install newstruct =================*/
876  if (strcmp(sys_cmd,"install")==0)
877  {
878  const short t[]={4,STRING_CMD,STRING_CMD,PROC_CMD,INT_CMD};
879  if (iiCheckTypes(h,t,1))
880  {
881  return newstruct_set_proc((char*)h->Data(),(char*)h->next->Data(),
882  (int)(long)h->next->next->next->Data(),
883  (procinfov)h->next->next->Data());
884  }
885  return TRUE;
886  }
887  else
888 /*==================== newstruct =================*/
889  if (strcmp(sys_cmd,"newstruct")==0)
890  {
891  const short t[]={1,STRING_CMD};
892  if (iiCheckTypes(h,t,1))
893  {
894  int id=0;
895  char *n=(char*)h->Data();
896  blackboxIsCmd(n,id);
897  if (id>0)
898  {
899  blackbox *bb=getBlackboxStuff(id);
900  if (BB_LIKE_LIST(bb))
901  {
902  newstruct_desc desc=(newstruct_desc)bb->data;
903  newstructShow(desc);
904  return FALSE;
905  }
906  else Werror("'%s' is not a newstruct",n);
907  }
908  else Werror("'%s' is not a blackbox object",n);
909  }
910  return TRUE;
911  }
912  else
913 /*==================== blackbox =================*/
914  if (strcmp(sys_cmd,"blackbox")==0)
915  {
917  return FALSE;
918  }
919  else
920  /*================= absBiFact ======================*/
921  #ifdef HAVE_NTL
922  if (strcmp(sys_cmd, "absFact") == 0)
923  {
924  const short t[]={1,POLY_CMD};
925  if (iiCheckTypes(h,t,1)
926  && (currRing!=NULL)
927  && (getCoeffType(currRing->cf)==n_transExt))
928  {
929  res->rtyp=LIST_CMD;
930  intvec *v=NULL;
931  ideal mipos= NULL;
932  int n= 0;
933  ideal f=singclap_absFactorize((poly)(h->Data()), mipos, &v, n, currRing);
934  if (f==NULL) return TRUE;
935  ivTest(v);
937  l->Init(4);
938  l->m[0].rtyp=IDEAL_CMD;
939  l->m[0].data=(void *)f;
940  l->m[1].rtyp=INTVEC_CMD;
941  l->m[1].data=(void *)v;
942  l->m[2].rtyp=IDEAL_CMD;
943  l->m[2].data=(void*) mipos;
944  l->m[3].rtyp=INT_CMD;
945  l->m[3].data=(void*) (long) n;
946  res->data=(void *)l;
947  return FALSE;
948  }
949  else return TRUE;
950  }
951  else
952  #endif
953  /* =================== LLL via NTL ==============================*/
954  #ifdef HAVE_NTL
955  if (strcmp(sys_cmd, "LLL") == 0)
956  {
957  if (h!=NULL)
958  {
959  res->rtyp=h->Typ();
960  if (h->Typ()==MATRIX_CMD)
961  {
962  res->data=(char *)singntl_LLL((matrix)h->Data(), currRing);
963  return FALSE;
964  }
965  else if (h->Typ()==INTMAT_CMD)
966  {
967  res->data=(char *)singntl_LLL((intvec*)h->Data());
968  return FALSE;
969  }
970  else return TRUE;
971  }
972  else return TRUE;
973  }
974  else
975  #endif
976  /* =================== LLL via Flint ==============================*/
977  #ifdef HAVE_FLINT
978  #ifdef FLINT_VER_2_4_5
979  if (strcmp(sys_cmd, "LLL_Flint") == 0)
980  {
981  if (h!=NULL)
982  {
983  if(h->next == NULL)
984  {
985  res->rtyp=h->Typ();
986  if (h->Typ()==BIGINTMAT_CMD)
987  {
988  res->data=(char *)singflint_LLL((bigintmat*)h->Data(), NULL);
989  return FALSE;
990  }
991  else if (h->Typ()==INTMAT_CMD)
992  {
993  res->data=(char *)singflint_LLL((intvec*)h->Data(), NULL);
994  return FALSE;
995  }
996  else return TRUE;
997  }
998  if(h->next->Typ()!= INT_CMD)
999  {
1000  WerrorS("matrix,int or bigint,int expected");
1001  return TRUE;
1002  }
1003  if(h->next->Typ()== INT_CMD)
1004  {
1005  if(((int)((long)(h->next->Data())) != 0) && (int)((long)(h->next->Data()) != 1))
1006  {
1007  WerrorS("int is different from 0, 1");
1008  return TRUE;
1009  }
1010  res->rtyp=h->Typ();
1011  if((long)(h->next->Data()) == 0)
1012  {
1013  if (h->Typ()==BIGINTMAT_CMD)
1014  {
1015  res->data=(char *)singflint_LLL((bigintmat*)h->Data(), NULL);
1016  return FALSE;
1017  }
1018  else if (h->Typ()==INTMAT_CMD)
1019  {
1020  res->data=(char *)singflint_LLL((intvec*)h->Data(), NULL);
1021  return FALSE;
1022  }
1023  else return TRUE;
1024  }
1025  // This will give also the transformation matrix U s.t. res = U * m
1026  if((long)(h->next->Data()) == 1)
1027  {
1028  if (h->Typ()==BIGINTMAT_CMD)
1029  {
1030  bigintmat* m = (bigintmat*)h->Data();
1031  bigintmat* T = new bigintmat(m->rows(),m->rows(),m->basecoeffs());
1032  for(int i = 1; i<=m->rows(); i++)
1033  {
1034  n_Delete(&(BIMATELEM(*T,i,i)),T->basecoeffs());
1035  BIMATELEM(*T,i,i)=n_Init(1, T->basecoeffs());
1036  }
1037  m = singflint_LLL(m,T);
1039  L->Init(2);
1040  L->m[0].rtyp = BIGINTMAT_CMD; L->m[0].data = (void*)m;
1041  L->m[1].rtyp = BIGINTMAT_CMD; L->m[1].data = (void*)T;
1042  res->data=L;
1043  res->rtyp=LIST_CMD;
1044  return FALSE;
1045  }
1046  else if (h->Typ()==INTMAT_CMD)
1047  {
1048  intvec* m = (intvec*)h->Data();
1049  intvec* T = new intvec(m->rows(),m->rows(),(int)0);
1050  for(int i = 1; i<=m->rows(); i++)
1051  IMATELEM(*T,i,i)=1;
1052  m = singflint_LLL(m,T);
1054  L->Init(2);
1055  L->m[0].rtyp = INTMAT_CMD; L->m[0].data = (void*)m;
1056  L->m[1].rtyp = INTMAT_CMD; L->m[1].data = (void*)T;
1057  res->data=L;
1058  res->rtyp=LIST_CMD;
1059  return FALSE;
1060  }
1061  else return TRUE;
1062  }
1063  }
1064 
1065  }
1066  else return TRUE;
1067  }
1068  else
1069  #endif
1070  #endif
1071  /*==================== shift-test for freeGB =================*/
1072  #ifdef HAVE_SHIFTBBA
1073  if (strcmp(sys_cmd, "stest") == 0)
1074  {
1075  const short t[]={4,POLY_CMD,INT_CMD,INT_CMD,INT_CMD};
1076  if (iiCheckTypes(h,t,1))
1077  {
1078  poly p=(poly)h->CopyD();
1079  h=h->next;
1080  int sh=(int)((long)(h->Data()));
1081  h=h->next;
1082  int uptodeg=(int)((long)(h->Data()));
1083  h=h->next;
1084  int lVblock=(int)((long)(h->Data()));
1085  res->data = pLPshift(p,sh,uptodeg,lVblock);
1086  res->rtyp = POLY_CMD;
1087  return FALSE;
1088  }
1089  else return TRUE;
1090  }
1091  else
1092  #endif
1093  /*==================== block-test for freeGB =================*/
1094  #ifdef HAVE_SHIFTBBA
1095  if (strcmp(sys_cmd, "btest") == 0)
1096  {
1097  const short t[]={2,POLY_CMD,INT_CMD};
1098  if (iiCheckTypes(h,t,1))
1099  {
1100  poly p=(poly)h->CopyD();
1101  h=h->next;
1102  int lV=(int)((long)(h->Data()));
1103  res->rtyp = INT_CMD;
1104  res->data = (void*)(long)pLastVblock(p, lV);
1105  return FALSE;
1106  }
1107  else return TRUE;
1108  }
1109  else
1110  #endif
1111  /*==================== shrink-test for freeGB =================*/
1112  #ifdef HAVE_SHIFTBBA
1113  if (strcmp(sys_cmd, "shrinktest") == 0)
1114  {
1115  const short t[]={2,POLY_CMD,INT_CMD};
1116  if (iiCheckTypes(h,t,1))
1117  {
1118  poly p=(poly)h->Data();
1119  h=h->next;
1120  int lV=(int)((long)(h->Data()));
1121  res->rtyp = POLY_CMD;
1122  // res->data = p_mShrink(p, lV, currRing);
1123  // kStrategy strat=new skStrategy;
1124  // strat->tailRing = currRing;
1125  res->data = p_Shrink(p, lV, currRing);
1126  return FALSE;
1127  }
1128  else return TRUE;
1129  }
1130  else
1131  #endif
1132  /*==================== pcv ==================================*/
1133  #ifdef HAVE_PCV
1134  if(strcmp(sys_cmd,"pcvLAddL")==0)
1135  {
1136  return pcvLAddL(res,h);
1137  }
1138  else
1139  if(strcmp(sys_cmd,"pcvPMulL")==0)
1140  {
1141  return pcvPMulL(res,h);
1142  }
1143  else
1144  if(strcmp(sys_cmd,"pcvMinDeg")==0)
1145  {
1146  return pcvMinDeg(res,h);
1147  }
1148  else
1149  if(strcmp(sys_cmd,"pcvP2CV")==0)
1150  {
1151  return pcvP2CV(res,h);
1152  }
1153  else
1154  if(strcmp(sys_cmd,"pcvCV2P")==0)
1155  {
1156  return pcvCV2P(res,h);
1157  }
1158  else
1159  if(strcmp(sys_cmd,"pcvDim")==0)
1160  {
1161  return pcvDim(res,h);
1162  }
1163  else
1164  if(strcmp(sys_cmd,"pcvBasis")==0)
1165  {
1166  return pcvBasis(res,h);
1167  }
1168  else
1169  #endif
1170  /*==================== hessenberg/eigenvalues ==================================*/
1171  #ifdef HAVE_EIGENVAL
1172  if(strcmp(sys_cmd,"hessenberg")==0)
1173  {
1174  return evHessenberg(res,h);
1175  }
1176  else
1177  #endif
1178  /*==================== eigenvalues ==================================*/
1179  #ifdef HAVE_EIGENVAL
1180  if(strcmp(sys_cmd,"eigenvals")==0)
1181  {
1182  return evEigenvals(res,h);
1183  }
1184  else
1185  #endif
1186  /*==================== rowelim ==================================*/
1187  #ifdef HAVE_EIGENVAL
1188  if(strcmp(sys_cmd,"rowelim")==0)
1189  {
1190  return evRowElim(res,h);
1191  }
1192  else
1193  #endif
1194  /*==================== rowcolswap ==================================*/
1195  #ifdef HAVE_EIGENVAL
1196  if(strcmp(sys_cmd,"rowcolswap")==0)
1197  {
1198  return evSwap(res,h);
1199  }
1200  else
1201  #endif
1202  /*==================== Gauss-Manin system ==================================*/
1203  #ifdef HAVE_GMS
1204  if(strcmp(sys_cmd,"gmsnf")==0)
1205  {
1206  return gmsNF(res,h);
1207  }
1208  else
1209  #endif
1210  /*==================== contributors =============================*/
1211  if(strcmp(sys_cmd,"contributors") == 0)
1212  {
1213  res->rtyp=STRING_CMD;
1214  res->data=(void *)omStrDup(
1215  "Olaf Bachmann, Michael Brickenstein, Hubert Grassmann, Kai Krueger, Victor Levandovskyy, Wolfgang Neumann, Thomas Nuessler, Wilfred Pohl, Jens Schmidt, Mathias Schulze, Thomas Siebert, Ruediger Stobbe, Moritz Wenk, Tim Wichmann");
1216  return FALSE;
1217  }
1218  else
1219  /*==================== spectrum =============================*/
1220  #ifdef HAVE_SPECTRUM
1221  if(strcmp(sys_cmd,"spectrum") == 0)
1222  {
1223  if ((h==NULL) || (h->Typ()!=POLY_CMD))
1224  {
1225  WerrorS("poly expected");
1226  return TRUE;
1227  }
1228  if (h->next==NULL)
1229  return spectrumProc(res,h);
1230  if (h->next->Typ()!=INT_CMD)
1231  {
1232  WerrorS("poly,int expected");
1233  return TRUE;
1234  }
1235  if(((long)h->next->Data())==1L)
1236  return spectrumfProc(res,h);
1237  return spectrumProc(res,h);
1238  }
1239  else
1240  /*==================== semic =============================*/
1241  if(strcmp(sys_cmd,"semic") == 0)
1242  {
1243  if ((h->next!=NULL)
1244  && (h->Typ()==LIST_CMD)
1245  && (h->next->Typ()==LIST_CMD))
1246  {
1247  if (h->next->next==NULL)
1248  return semicProc(res,h,h->next);
1249  else if (h->next->next->Typ()==INT_CMD)
1250  return semicProc3(res,h,h->next,h->next->next);
1251  }
1252  return TRUE;
1253  }
1254  else
1255  /*==================== spadd =============================*/
1256  if(strcmp(sys_cmd,"spadd") == 0)
1257  {
1258  const short t[]={2,LIST_CMD,LIST_CMD};
1259  if (iiCheckTypes(h,t,1))
1260  {
1261  return spaddProc(res,h,h->next);
1262  }
1263  return TRUE;
1264  }
1265  else
1266  /*==================== spmul =============================*/
1267  if(strcmp(sys_cmd,"spmul") == 0)
1268  {
1269  const short t[]={2,LIST_CMD,INT_CMD};
1270  if (iiCheckTypes(h,t,1))
1271  {
1272  return spmulProc(res,h,h->next);
1273  }
1274  return TRUE;
1275  }
1276  else
1277  #endif
1278 /*==================== tensorModuleMult ========================= */
1279  #define HAVE_SHEAFCOH_TRICKS 1
1280 
1281  #ifdef HAVE_SHEAFCOH_TRICKS
1282  if(strcmp(sys_cmd,"tensorModuleMult")==0)
1283  {
1284  const short t[]={2,INT_CMD,MODUL_CMD};
1285  // WarnS("tensorModuleMult!");
1286  if (iiCheckTypes(h,t,1))
1287  {
1288  int m = (int)( (long)h->Data() );
1289  ideal M = (ideal)h->next->Data();
1290  res->rtyp=MODUL_CMD;
1291  res->data=(void *)id_TensorModuleMult(m, M, currRing);
1292  return FALSE;
1293  }
1294  return TRUE;
1295  }
1296  else
1297  #endif
1298  /*==================== twostd =================*/
1299  #ifdef HAVE_PLURAL
1300  if (strcmp(sys_cmd, "twostd") == 0)
1301  {
1302  ideal I;
1303  if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
1304  {
1305  I=(ideal)h->CopyD();
1306  res->rtyp=IDEAL_CMD;
1307  if (rIsPluralRing(currRing)) res->data=twostd(I);
1308  else res->data=I;
1309  setFlag(res,FLAG_TWOSTD);
1310  setFlag(res,FLAG_STD);
1311  }
1312  else return TRUE;
1313  return FALSE;
1314  }
1315  else
1316  #endif
1317  /*==================== lie bracket =================*/
1318  #ifdef HAVE_PLURAL
1319  if (strcmp(sys_cmd, "bracket") == 0)
1320  {
1321  const short t[]={2,POLY_CMD,POLY_CMD};
1322  if (iiCheckTypes(h,t,1))
1323  {
1324  poly p=(poly)h->CopyD();
1325  h=h->next;
1326  poly q=(poly)h->Data();
1327  res->rtyp=POLY_CMD;
1329  return FALSE;
1330  }
1331  return TRUE;
1332  }
1333  else
1334  #endif
1335  /*==================== env ==================================*/
1336  #ifdef HAVE_PLURAL
1337  if (strcmp(sys_cmd, "env")==0)
1338  {
1339  if ((h!=NULL) && (h->Typ()==RING_CMD))
1340  {
1341  ring r = (ring)h->Data();
1342  res->data = rEnvelope(r);
1343  res->rtyp = RING_CMD;
1344  return FALSE;
1345  }
1346  else
1347  {
1348  WerrorS("`system(\"env\",<ring>)` expected");
1349  return TRUE;
1350  }
1351  }
1352  else
1353  #endif
1354 /* ============ opp ======================== */
1355  #ifdef HAVE_PLURAL
1356  if (strcmp(sys_cmd, "opp")==0)
1357  {
1358  if ((h!=NULL) && (h->Typ()==RING_CMD))
1359  {
1360  ring r=(ring)h->Data();
1361  res->data=rOpposite(r);
1362  res->rtyp=RING_CMD;
1363  return FALSE;
1364  }
1365  else
1366  {
1367  WerrorS("`system(\"opp\",<ring>)` expected");
1368  return TRUE;
1369  }
1370  }
1371  else
1372  #endif
1373  /*==================== oppose ==================================*/
1374  #ifdef HAVE_PLURAL
1375  if (strcmp(sys_cmd, "oppose")==0)
1376  {
1377  if ((h!=NULL) && (h->Typ()==RING_CMD)
1378  && (h->next!= NULL))
1379  {
1380  ring Rop = (ring)h->Data();
1381  h = h->next;
1382  idhdl w;
1383  if ((w=Rop->idroot->get(h->Name(),myynest))!=NULL)
1384  {
1385  poly p = (poly)IDDATA(w);
1386  res->data = pOppose(Rop, p, currRing); // into CurrRing?
1387  res->rtyp = POLY_CMD;
1388  return FALSE;
1389  }
1390  }
1391  else
1392  {
1393  WerrorS("`system(\"oppose\",<ring>,<poly>)` expected");
1394  return TRUE;
1395  }
1396  }
1397  else
1398  #endif
1399  /*==================== freeGB, twosided GB in free algebra =================*/
1400  #ifdef HAVE_PLURAL
1401  #ifdef HAVE_SHIFTBBA
1402  if (strcmp(sys_cmd, "freegb") == 0)
1403  {
1404  const short t[]={3,IDEAL_CMD,INT_CMD,INT_CMD};
1405  if (iiCheckTypes(h,t,1))
1406  {
1407  ideal I=(ideal)h->CopyD();
1408  h=h->next;
1409  int uptodeg=(int)((long)(h->Data()));
1410  h=h->next;
1411  int lVblock=(int)((long)(h->Data()));
1412  res->data = freegb(I,uptodeg,lVblock);
1413  if (res->data == NULL)
1414  {
1415  /* that is there were input errors */
1416  res->data = I;
1417  }
1418  res->rtyp = IDEAL_CMD;
1419  return FALSE;
1420  }
1421  else return TRUE;
1422  }
1423  else
1424  #endif /*SHIFTBBA*/
1425  #endif /*PLURAL*/
1426  /*==================== walk stuff =================*/
1427  /*==================== walkNextWeight =================*/
1428  #ifdef HAVE_WALK
1429  #ifdef OWNW
1430  if (strcmp(sys_cmd, "walkNextWeight") == 0)
1431  {
1432  const short t[]={3,INTVEC_CMD,INTVEC_CMD,IDEAL_CMD};
1433  if (!iiCheckTypes(h,t,1)) return TRUE;
1434  if (((intvec*) h->Data())->length() != currRing->N ||
1435  ((intvec*) h->next->Data())->length() != currRing->N)
1436  {
1437  Werror("system(\"walkNextWeight\" ...) intvecs not of length %d\n",
1438  currRing->N);
1439  return TRUE;
1440  }
1441  res->data = (void*) walkNextWeight(((intvec*) h->Data()),
1442  ((intvec*) h->next->Data()),
1443  (ideal) h->next->next->Data());
1444  if (res->data == NULL || res->data == (void*) 1L)
1445  {
1446  res->rtyp = INT_CMD;
1447  }
1448  else
1449  {
1450  res->rtyp = INTVEC_CMD;
1451  }
1452  return FALSE;
1453  }
1454  else
1455  #endif
1456  #endif
1457  /*==================== walkNextWeight =================*/
1458  #ifdef HAVE_WALK
1459  #ifdef OWNW
1460  if (strcmp(sys_cmd, "walkInitials") == 0)
1461  {
1462  if (h == NULL || h->Typ() != IDEAL_CMD)
1463  {
1464  WerrorS("system(\"walkInitials\", ideal) expected");
1465  return TRUE;
1466  }
1467  res->data = (void*) walkInitials((ideal) h->Data());
1468  res->rtyp = IDEAL_CMD;
1469  return FALSE;
1470  }
1471  else
1472  #endif
1473  #endif
1474  /*==================== walkAddIntVec =================*/
1475  #ifdef HAVE_WALK
1476  #ifdef WAIV
1477  if (strcmp(sys_cmd, "walkAddIntVec") == 0)
1478  {
1479  const short t[]={2,INTVEC_CMD,INTVEC_CMD};
1480  if (!iiCheckTypes(h,t,1)) return TRUE;
1481  intvec* arg1 = (intvec*) h->Data();
1482  intvec* arg2 = (intvec*) h->next->Data();
1483  res->data = (intvec*) walkAddIntVec(arg1, arg2);
1484  res->rtyp = INTVEC_CMD;
1485  return FALSE;
1486  }
1487  else
1488  #endif
1489  #endif
1490  /*==================== MwalkNextWeight =================*/
1491  #ifdef HAVE_WALK
1492  #ifdef MwaklNextWeight
1493  if (strcmp(sys_cmd, "MwalkNextWeight") == 0)
1494  {
1495  const short t[]={3,INTVEC_CMD,INTVEC_CMD,IDEAL_CMD};
1496  if (!iiCheckTypes(h,t,1)) return TRUE;
1497  if (((intvec*) h->Data())->length() != currRing->N ||
1498  ((intvec*) h->next->Data())->length() != currRing->N)
1499  {
1500  Werror("system(\"MwalkNextWeight\" ...) intvecs not of length %d\n",
1501  currRing->N);
1502  return TRUE;
1503  }
1504  intvec* arg1 = (intvec*) h->Data();
1505  intvec* arg2 = (intvec*) h->next->Data();
1506  ideal arg3 = (ideal) h->next->next->Data();
1507  intvec* result = (intvec*) MwalkNextWeight(arg1, arg2, arg3);
1508  res->rtyp = INTVEC_CMD;
1509  res->data = result;
1510  return FALSE;
1511  }
1512  else
1513  #endif //MWalkNextWeight
1514  #endif
1515  /*==================== Mivdp =================*/
1516  #ifdef HAVE_WALK
1517  if(strcmp(sys_cmd, "Mivdp") == 0)
1518  {
1519  if (h == NULL || h->Typ() != INT_CMD)
1520  {
1521  WerrorS("system(\"Mivdp\", int) expected");
1522  return TRUE;
1523  }
1524  if ((int) ((long)(h->Data())) != currRing->N)
1525  {
1526  Werror("system(\"Mivdp\" ...) intvecs not of length %d\n",
1527  currRing->N);
1528  return TRUE;
1529  }
1530  int arg1 = (int) ((long)(h->Data()));
1531  intvec* result = (intvec*) Mivdp(arg1);
1532  res->rtyp = INTVEC_CMD;
1533  res->data = result;
1534  return FALSE;
1535  }
1536  else
1537  #endif
1538  /*==================== Mivlp =================*/
1539  #ifdef HAVE_WALK
1540  if(strcmp(sys_cmd, "Mivlp") == 0)
1541  {
1542  if (h == NULL || h->Typ() != INT_CMD)
1543  {
1544  WerrorS("system(\"Mivlp\", int) expected");
1545  return TRUE;
1546  }
1547  if ((int) ((long)(h->Data())) != currRing->N)
1548  {
1549  Werror("system(\"Mivlp\" ...) intvecs not of length %d\n",
1550  currRing->N);
1551  return TRUE;
1552  }
1553  int arg1 = (int) ((long)(h->Data()));
1554  intvec* result = (intvec*) Mivlp(arg1);
1555  res->rtyp = INTVEC_CMD;
1556  res->data = result;
1557  return FALSE;
1558  }
1559  else
1560  #endif
1561  /*==================== MpDiv =================*/
1562  #ifdef HAVE_WALK
1563  #ifdef MpDiv
1564  if(strcmp(sys_cmd, "MpDiv") == 0)
1565  {
1566  const short t[]={2,POLY_CMD,POLY_CMD};
1567  if (!iiCheckTypes(h,t,1)) return TRUE;
1568  poly arg1 = (poly) h->Data();
1569  poly arg2 = (poly) h->next->Data();
1570  poly result = MpDiv(arg1, arg2);
1571  res->rtyp = POLY_CMD;
1572  res->data = result;
1573  return FALSE;
1574  }
1575  else
1576  #endif
1577  #endif
1578  /*==================== MpMult =================*/
1579  #ifdef HAVE_WALK
1580  #ifdef MpMult
1581  if(strcmp(sys_cmd, "MpMult") == 0)
1582  {
1583  const short t[]={2,POLY_CMD,POLY_CMD};
1584  if (!iiCheckTypes(h,t,1)) return TRUE;
1585  poly arg1 = (poly) h->Data();
1586  poly arg2 = (poly) h->next->Data();
1587  poly result = MpMult(arg1, arg2);
1588  res->rtyp = POLY_CMD;
1589  res->data = result;
1590  return FALSE;
1591  }
1592  else
1593  #endif
1594  #endif
1595  /*==================== MivSame =================*/
1596  #ifdef HAVE_WALK
1597  if (strcmp(sys_cmd, "MivSame") == 0)
1598  {
1599  const short t[]={2,INTVEC_CMD,INTVEC_CMD};
1600  if (!iiCheckTypes(h,t,1)) return TRUE;
1601  /*
1602  if (((intvec*) h->Data())->length() != currRing->N ||
1603  ((intvec*) h->next->Data())->length() != currRing->N)
1604  {
1605  Werror("system(\"MivSame\" ...) intvecs not of length %d\n",
1606  currRing->N);
1607  return TRUE;
1608  }
1609  */
1610  intvec* arg1 = (intvec*) h->Data();
1611  intvec* arg2 = (intvec*) h->next->Data();
1612  /*
1613  poly result = (poly) MivSame(arg1, arg2);
1614  res->rtyp = POLY_CMD;
1615  res->data = (poly) result;
1616  */
1617  res->rtyp = INT_CMD;
1618  res->data = (void*)(long) MivSame(arg1, arg2);
1619  return FALSE;
1620  }
1621  else
1622  #endif
1623  /*==================== M3ivSame =================*/
1624  #ifdef HAVE_WALK
1625  if (strcmp(sys_cmd, "M3ivSame") == 0)
1626  {
1627  const short t[]={3,INTVEC_CMD,INTVEC_CMD,INTVEC_CMD};
1628  if (!iiCheckTypes(h,t,1)) return TRUE;
1629  /*
1630  if (((intvec*) h->Data())->length() != currRing->N ||
1631  ((intvec*) h->next->Data())->length() != currRing->N ||
1632  ((intvec*) h->next->next->Data())->length() != currRing->N )
1633  {
1634  Werror("system(\"M3ivSame\" ...) intvecs not of length %d\n",
1635  currRing->N);
1636  return TRUE;
1637  }
1638  */
1639  intvec* arg1 = (intvec*) h->Data();
1640  intvec* arg2 = (intvec*) h->next->Data();
1641  intvec* arg3 = (intvec*) h->next->next->Data();
1642  /*
1643  poly result = (poly) M3ivSame(arg1, arg2, arg3);
1644  res->rtyp = POLY_CMD;
1645  res->data = (poly) result;
1646  */
1647  res->rtyp = INT_CMD;
1648  res->data = (void*)(long) M3ivSame(arg1, arg2, arg3);
1649  return FALSE;
1650  }
1651  else
1652  #endif
1653  /*==================== MwalkInitialForm =================*/
1654  #ifdef HAVE_WALK
1655  if(strcmp(sys_cmd, "MwalkInitialForm") == 0)
1656  {
1657  const short t[]={2,IDEAL_CMD,INTVEC_CMD};
1658  if (!iiCheckTypes(h,t,1)) return TRUE;
1659  if(((intvec*) h->next->Data())->length() != currRing->N)
1660  {
1661  Werror("system \"MwalkInitialForm\"...) intvec not of length %d\n",
1662  currRing->N);
1663  return TRUE;
1664  }
1665  ideal id = (ideal) h->Data();
1666  intvec* int_w = (intvec*) h->next->Data();
1667  ideal result = (ideal) MwalkInitialForm(id, int_w);
1668  res->rtyp = IDEAL_CMD;
1669  res->data = result;
1670  return FALSE;
1671  }
1672  else
1673  #endif
1674  /*==================== MivMatrixOrder =================*/
1675  #ifdef HAVE_WALK
1676  /************** Perturbation walk **********/
1677  if(strcmp(sys_cmd, "MivMatrixOrder") == 0)
1678  {
1679  if(h==NULL || h->Typ() != INTVEC_CMD)
1680  {
1681  WerrorS("system(\"MivMatrixOrder\",intvec) expected");
1682  return TRUE;
1683  }
1684  intvec* arg1 = (intvec*) h->Data();
1685  intvec* result = MivMatrixOrder(arg1);
1686  res->rtyp = INTVEC_CMD;
1687  res->data = result;
1688  return FALSE;
1689  }
1690  else
1691  #endif
1692  /*==================== MivMatrixOrderdp =================*/
1693  #ifdef HAVE_WALK
1694  if(strcmp(sys_cmd, "MivMatrixOrderdp") == 0)
1695  {
1696  if(h==NULL || h->Typ() != INT_CMD)
1697  {
1698  WerrorS("system(\"MivMatrixOrderdp\",intvec) expected");
1699  return TRUE;
1700  }
1701  int arg1 = (int) ((long)(h->Data()));
1702  intvec* result = (intvec*) MivMatrixOrderdp(arg1);
1703  res->rtyp = INTVEC_CMD;
1704  res->data = result;
1705  return FALSE;
1706  }
1707  else
1708  #endif
1709  /*==================== MPertVectors =================*/
1710  #ifdef HAVE_WALK
1711  if(strcmp(sys_cmd, "MPertVectors") == 0)
1712  {
1713  const short t[]={3,IDEAL_CMD,INTVEC_CMD,INT_CMD};
1714  if (!iiCheckTypes(h,t,1)) return TRUE;
1715  ideal arg1 = (ideal) h->Data();
1716  intvec* arg2 = (intvec*) h->next->Data();
1717  int arg3 = (int) ((long)(h->next->next->Data()));
1718  intvec* result = (intvec*) MPertVectors(arg1, arg2, arg3);
1719  res->rtyp = INTVEC_CMD;
1720  res->data = result;
1721  return FALSE;
1722  }
1723  else
1724  #endif
1725  /*==================== MPertVectorslp =================*/
1726  #ifdef HAVE_WALK
1727  if(strcmp(sys_cmd, "MPertVectorslp") == 0)
1728  {
1729  const short t[]={3,IDEAL_CMD,INTVEC_CMD,INT_CMD};
1730  if (!iiCheckTypes(h,t,1)) return TRUE;
1731  ideal arg1 = (ideal) h->Data();
1732  intvec* arg2 = (intvec*) h->next->Data();
1733  int arg3 = (int) ((long)(h->next->next->Data()));
1734  intvec* result = (intvec*) MPertVectorslp(arg1, arg2, arg3);
1735  res->rtyp = INTVEC_CMD;
1736  res->data = result;
1737  return FALSE;
1738  }
1739  else
1740  #endif
1741  /************** fractal walk **********/
1742  #ifdef HAVE_WALK
1743  if(strcmp(sys_cmd, "Mfpertvector") == 0)
1744  {
1745  const short t[]={2,IDEAL_CMD,INTVEC_CMD};
1746  if (!iiCheckTypes(h,t,1)) return TRUE;
1747  ideal arg1 = (ideal) h->Data();
1748  intvec* arg2 = (intvec*) h->next->Data();
1749  intvec* result = Mfpertvector(arg1, arg2);
1750  res->rtyp = INTVEC_CMD;
1751  res->data = result;
1752  return FALSE;
1753  }
1754  else
1755  #endif
1756  /*==================== MivUnit =================*/
1757  #ifdef HAVE_WALK
1758  if(strcmp(sys_cmd, "MivUnit") == 0)
1759  {
1760  const short t[]={1,INT_CMD};
1761  if (!iiCheckTypes(h,t,1)) return TRUE;
1762  int arg1 = (int) ((long)(h->Data()));
1763  intvec* result = (intvec*) MivUnit(arg1);
1764  res->rtyp = INTVEC_CMD;
1765  res->data = result;
1766  return FALSE;
1767  }
1768  else
1769  #endif
1770  /*==================== MivWeightOrderlp =================*/
1771  #ifdef HAVE_WALK
1772  if(strcmp(sys_cmd, "MivWeightOrderlp") == 0)
1773  {
1774  const short t[]={1,INTVEC_CMD};
1775  if (!iiCheckTypes(h,t,1)) return TRUE;
1776  intvec* arg1 = (intvec*) h->Data();
1777  intvec* result = MivWeightOrderlp(arg1);
1778  res->rtyp = INTVEC_CMD;
1779  res->data = result;
1780  return FALSE;
1781  }
1782  else
1783  #endif
1784  /*==================== MivWeightOrderdp =================*/
1785  #ifdef HAVE_WALK
1786  if(strcmp(sys_cmd, "MivWeightOrderdp") == 0)
1787  {
1788  if(h==NULL || h->Typ() != INTVEC_CMD)
1789  {
1790  WerrorS("system(\"MivWeightOrderdp\",intvec) expected");
1791  return TRUE;
1792  }
1793  intvec* arg1 = (intvec*) h->Data();
1794  //int arg2 = (int) h->next->Data();
1795  intvec* result = MivWeightOrderdp(arg1);
1796  res->rtyp = INTVEC_CMD;
1797  res->data = result;
1798  return FALSE;
1799  }
1800  else
1801  #endif
1802  /*==================== MivMatrixOrderlp =================*/
1803  #ifdef HAVE_WALK
1804  if(strcmp(sys_cmd, "MivMatrixOrderlp") == 0)
1805  {
1806  if(h==NULL || h->Typ() != INT_CMD)
1807  {
1808  WerrorS("system(\"MivMatrixOrderlp\",int) expected");
1809  return TRUE;
1810  }
1811  int arg1 = (int) ((long)(h->Data()));
1812  intvec* result = (intvec*) MivMatrixOrderlp(arg1);
1813  res->rtyp = INTVEC_CMD;
1814  res->data = result;
1815  return FALSE;
1816  }
1817  else
1818  #endif
1819  /*==================== MkInterRedNextWeight =================*/
1820  #ifdef HAVE_WALK
1821  if (strcmp(sys_cmd, "MkInterRedNextWeight") == 0)
1822  {
1823  const short t[]={3,INTVEC_CMD,INTVEC_CMD,IDEAL_CMD};
1824  if (!iiCheckTypes(h,t,1)) return TRUE;
1825  if (((intvec*) h->Data())->length() != currRing->N ||
1826  ((intvec*) h->next->Data())->length() != currRing->N)
1827  {
1828  Werror("system(\"MkInterRedNextWeight\" ...) intvecs not of length %d\n",
1829  currRing->N);
1830  return TRUE;
1831  }
1832  intvec* arg1 = (intvec*) h->Data();
1833  intvec* arg2 = (intvec*) h->next->Data();
1834  ideal arg3 = (ideal) h->next->next->Data();
1835  intvec* result = (intvec*) MkInterRedNextWeight(arg1, arg2, arg3);
1836  res->rtyp = INTVEC_CMD;
1837  res->data = result;
1838  return FALSE;
1839  }
1840  else
1841  #endif
1842  /*==================== MPertNextWeight =================*/
1843  #ifdef HAVE_WALK
1844  #ifdef MPertNextWeight
1845  if (strcmp(sys_cmd, "MPertNextWeight") == 0)
1846  {
1847  const short t[]={3,INTVEC_CMD,IDEAL_CMD,INT_CMD};
1848  if (!iiCheckTypes(h,t,1)) return TRUE;
1849  if (((intvec*) h->Data())->length() != currRing->N)
1850  {
1851  Werror("system(\"MPertNextWeight\" ...) intvecs not of length %d\n",
1852  currRing->N);
1853  return TRUE;
1854  }
1855  intvec* arg1 = (intvec*) h->Data();
1856  ideal arg2 = (ideal) h->next->Data();
1857  int arg3 = (int) h->next->next->Data();
1858  intvec* result = (intvec*) MPertNextWeight(arg1, arg2, arg3);
1859  res->rtyp = INTVEC_CMD;
1860  res->data = result;
1861  return FALSE;
1862  }
1863  else
1864  #endif //MPertNextWeight
1865  #endif
1866  /*==================== Mivperttarget =================*/
1867  #ifdef HAVE_WALK
1868  #ifdef Mivperttarget
1869  if (strcmp(sys_cmd, "Mivperttarget") == 0)
1870  {
1871  const short t[]={2,IDEAL_CMD,INT_CMD};
1872  if (!iiCheckTypes(h,t,1)) return TRUE;
1873  ideal arg1 = (ideal) h->Data();
1874  int arg2 = (int) h->next->Data();
1875  intvec* result = (intvec*) Mivperttarget(arg1, arg2);
1876  res->rtyp = INTVEC_CMD;
1877  res->data = result;
1878  return FALSE;
1879  }
1880  else
1881  #endif //Mivperttarget
1882  #endif
1883  /*==================== Mwalk =================*/
1884  #ifdef HAVE_WALK
1885  if (strcmp(sys_cmd, "Mwalk") == 0)
1886  {
1887  const short t[]={6,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,RING_CMD,INT_CMD,INT_CMD};
1888  if (!iiCheckTypes(h,t,1)) return TRUE;
1889  if (((intvec*) h->next->Data())->length() != currRing->N &&
1890  ((intvec*) h->next->next->Data())->length() != currRing->N )
1891  {
1892  Werror("system(\"Mwalk\" ...) intvecs not of length %d\n",
1893  currRing->N);
1894  return TRUE;
1895  }
1896  ideal arg1 = (ideal) h->CopyD();
1897  intvec* arg2 = (intvec*) h->next->Data();
1898  intvec* arg3 = (intvec*) h->next->next->Data();
1899  ring arg4 = (ring) h->next->next->next->Data();
1900  int arg5 = (int) (long) h->next->next->next->next->Data();
1901  int arg6 = (int) (long) h->next->next->next->next->next->Data();
1902  ideal result = (ideal) Mwalk(arg1, arg2, arg3, arg4, arg5, arg6);
1903  res->rtyp = IDEAL_CMD;
1904  res->data = result;
1905  return FALSE;
1906  }
1907  else
1908  #endif
1909  /*==================== Mpwalk =================*/
1910  #ifdef HAVE_WALK
1911  #ifdef MPWALK_ORIG
1912  if (strcmp(sys_cmd, "Mwalk") == 0)
1913  {
1914  const short t[]={4,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,RING_CMD};
1915  if (!iiCheckTypes(h,t,1)) return TRUE;
1916  if ((((intvec*) h->next->Data())->length() != currRing->N &&
1917  ((intvec*) h->next->next->Data())->length() != currRing->N ) &&
1918  (((intvec*) h->next->Data())->length() != (currRing->N)*(currRing->N) &&
1919  ((intvec*) h->next->next->Data())->length() != (currRing->N)*(currRing->N)))
1920  {
1921  Werror("system(\"Mwalk\" ...) intvecs not of length %d or %d\n",
1922  currRing->N,(currRing->N)*(currRing->N));
1923  return TRUE;
1924  }
1925  ideal arg1 = (ideal) h->Data();
1926  intvec* arg2 = (intvec*) h->next->Data();
1927  intvec* arg3 = (intvec*) h->next->next->Data();
1928  ring arg4 = (ring) h->next->next->next->Data();
1929  ideal result = (ideal) Mwalk(arg1, arg2, arg3,arg4);
1930  res->rtyp = IDEAL_CMD;
1931  res->data = result;
1932  return FALSE;
1933  }
1934  else
1935  #else
1936  if (strcmp(sys_cmd, "Mpwalk") == 0)
1937  {
1938  const short t[]={8,IDEAL_CMD,INT_CMD,INT_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD,INT_CMD};
1939  if (!iiCheckTypes(h,t,1)) return TRUE;
1940  if(((intvec*) h->next->next->next->Data())->length() != currRing->N &&
1941  ((intvec*) h->next->next->next->next->Data())->length()!=currRing->N)
1942  {
1943  Werror("system(\"Mpwalk\" ...) intvecs not of length %d\n",currRing->N);
1944  return TRUE;
1945  }
1946  ideal arg1 = (ideal) h->Data();
1947  int arg2 = (int) (long) h->next->Data();
1948  int arg3 = (int) (long) h->next->next->Data();
1949  intvec* arg4 = (intvec*) h->next->next->next->Data();
1950  intvec* arg5 = (intvec*) h->next->next->next->next->Data();
1951  int arg6 = (int) (long) h->next->next->next->next->next->Data();
1952  int arg7 = (int) (long) h->next->next->next->next->next->next->Data();
1953  int arg8 = (int) (long) h->next->next->next->next->next->next->next->Data();
1954  ideal result = (ideal) Mpwalk(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
1955  res->rtyp = IDEAL_CMD;
1956  res->data = result;
1957  return FALSE;
1958  }
1959  else
1960  #endif
1961  #endif
1962  /*==================== Mrwalk =================*/
1963  #ifdef HAVE_WALK
1964  if (strcmp(sys_cmd, "Mrwalk") == 0)
1965  {
1966  const short t[]={7,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD,INT_CMD,INT_CMD};
1967  if (!iiCheckTypes(h,t,1)) return TRUE;
1968  if(((intvec*) h->next->Data())->length() != currRing->N &&
1969  ((intvec*) h->next->Data())->length() != (currRing->N)*(currRing->N) &&
1970  ((intvec*) h->next->next->Data())->length() != currRing->N &&
1971  ((intvec*) h->next->next->Data())->length() != (currRing->N)*(currRing->N) )
1972  {
1973  Werror("system(\"Mrwalk\" ...) intvecs not of length %d or %d\n",
1974  currRing->N,(currRing->N)*(currRing->N));
1975  return TRUE;
1976  }
1977  ideal arg1 = (ideal) h->Data();
1978  intvec* arg2 = (intvec*) h->next->Data();
1979  intvec* arg3 = (intvec*) h->next->next->Data();
1980  int arg4 = (int)(long) h->next->next->next->Data();
1981  int arg5 = (int)(long) h->next->next->next->next->Data();
1982  int arg6 = (int)(long) h->next->next->next->next->next->Data();
1983  int arg7 = (int)(long) h->next->next->next->next->next->next->Data();
1984  ideal result = (ideal) Mrwalk(arg1, arg2, arg3, arg4, arg5, arg6, arg7);
1985  res->rtyp = IDEAL_CMD;
1986  res->data = result;
1987  return FALSE;
1988  }
1989  else
1990  #endif
1991  /*==================== MAltwalk1 =================*/
1992  #ifdef HAVE_WALK
1993  if (strcmp(sys_cmd, "MAltwalk1") == 0)
1994  {
1995  const short t[]={5,IDEAL_CMD,INT_CMD,INT_CMD,INTVEC_CMD,INTVEC_CMD};
1996  if (!iiCheckTypes(h,t,1)) return TRUE;
1997  if (((intvec*) h->next->next->next->Data())->length() != currRing->N &&
1998  ((intvec*) h->next->next->next->next->Data())->length()!=currRing->N)
1999  {
2000  Werror("system(\"MAltwalk1\" ...) intvecs not of length %d\n",
2001  currRing->N);
2002  return TRUE;
2003  }
2004  ideal arg1 = (ideal) h->Data();
2005  int arg2 = (int) ((long)(h->next->Data()));
2006  int arg3 = (int) ((long)(h->next->next->Data()));
2007  intvec* arg4 = (intvec*) h->next->next->next->Data();
2008  intvec* arg5 = (intvec*) h->next->next->next->next->Data();
2009  ideal result = (ideal) MAltwalk1(arg1, arg2, arg3, arg4, arg5);
2010  res->rtyp = IDEAL_CMD;
2011  res->data = result;
2012  return FALSE;
2013  }
2014  else
2015  #endif
2016  /*==================== MAltwalk1 =================*/
2017  #ifdef HAVE_WALK
2018  #ifdef MFWALK_ALT
2019  if (strcmp(sys_cmd, "Mfwalk_alt") == 0)
2020  {
2021  const short t[]={4,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD};
2022  if (!iiCheckTypes(h,t,1)) return TRUE;
2023  if (((intvec*) h->next->Data())->length() != currRing->N &&
2024  ((intvec*) h->next->next->Data())->length() != currRing->N )
2025  {
2026  Werror("system(\"Mfwalk\" ...) intvecs not of length %d\n",
2027  currRing->N);
2028  return TRUE;
2029  }
2030  ideal arg1 = (ideal) h->Data();
2031  intvec* arg2 = (intvec*) h->next->Data();
2032  intvec* arg3 = (intvec*) h->next->next->Data();
2033  int arg4 = (int) h->next->next->next->Data();
2034  ideal result = (ideal) Mfwalk_alt(arg1, arg2, arg3, arg4);
2035  res->rtyp = IDEAL_CMD;
2036  res->data = result;
2037  return FALSE;
2038  }
2039  else
2040  #endif
2041  #endif
2042  /*==================== Mfwalk =================*/
2043  #ifdef HAVE_WALK
2044  if (strcmp(sys_cmd, "Mfwalk") == 0)
2045  {
2046  const short t[]={5,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD};
2047  if (!iiCheckTypes(h,t,1)) return TRUE;
2048  if (((intvec*) h->next->Data())->length() != currRing->N &&
2049  ((intvec*) h->next->next->Data())->length() != currRing->N )
2050  {
2051  Werror("system(\"Mfwalk\" ...) intvecs not of length %d\n",
2052  currRing->N);
2053  return TRUE;
2054  }
2055  ideal arg1 = (ideal) h->Data();
2056  intvec* arg2 = (intvec*) h->next->Data();
2057  intvec* arg3 = (intvec*) h->next->next->Data();
2058  int arg4 = (int)(long) h->next->next->next->Data();
2059  int arg5 = (int)(long) h->next->next->next->next->Data();
2060  ideal result = (ideal) Mfwalk(arg1, arg2, arg3, arg4, arg5);
2061  res->rtyp = IDEAL_CMD;
2062  res->data = result;
2063  return FALSE;
2064  }
2065  else
2066  #endif
2067  /*==================== Mfrwalk =================*/
2068  #ifdef HAVE_WALK
2069  if (strcmp(sys_cmd, "Mfrwalk") == 0)
2070  {
2071  const short t[]={6,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD,INT_CMD};
2072  if (!iiCheckTypes(h,t,1)) return TRUE;
2073 /*
2074  if (((intvec*) h->next->Data())->length() != currRing->N &&
2075  ((intvec*) h->next->next->Data())->length() != currRing->N)
2076  {
2077  Werror("system(\"Mfrwalk\" ...) intvecs not of length %d\n",currRing->N);
2078  return TRUE;
2079  }
2080 */
2081  if((((intvec*) h->next->Data())->length() != currRing->N &&
2082  ((intvec*) h->next->next->Data())->length() != currRing->N ) &&
2083  (((intvec*) h->next->Data())->length() != (currRing->N)*(currRing->N) &&
2084  ((intvec*) h->next->next->Data())->length() != (currRing->N)*(currRing->N) ))
2085  {
2086  Werror("system(\"Mfrwalk\" ...) intvecs not of length %d or %d\n",
2087  currRing->N,(currRing->N)*(currRing->N));
2088  return TRUE;
2089  }
2090 
2091  ideal arg1 = (ideal) h->Data();
2092  intvec* arg2 = (intvec*) h->next->Data();
2093  intvec* arg3 = (intvec*) h->next->next->Data();
2094  int arg4 = (int)(long) h->next->next->next->Data();
2095  int arg5 = (int)(long) h->next->next->next->next->Data();
2096  int arg6 = (int)(long) h->next->next->next->next->next->Data();
2097  ideal result = (ideal) Mfrwalk(arg1, arg2, arg3, arg4, arg5, arg6);
2098  res->rtyp = IDEAL_CMD;
2099  res->data = result;
2100  return FALSE;
2101  }
2102  else
2103  /*==================== Mprwalk =================*/
2104  if (strcmp(sys_cmd, "Mprwalk") == 0)
2105  {
2106  const short t[]={9,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD,INT_CMD,INT_CMD,INT_CMD,INT_CMD};
2107  if (!iiCheckTypes(h,t,1)) return TRUE;
2108  if((((intvec*) h->next->Data())->length() != currRing->N &&
2109  ((intvec*) h->next->next->Data())->length() != currRing->N ) &&
2110  (((intvec*) h->next->Data())->length() != (currRing->N)*(currRing->N) &&
2111  ((intvec*) h->next->next->Data())->length() != (currRing->N)*(currRing->N) ))
2112  {
2113  Werror("system(\"Mrwalk\" ...) intvecs not of length %d or %d\n",
2114  currRing->N,(currRing->N)*(currRing->N));
2115  return TRUE;
2116  }
2117  ideal arg1 = (ideal) h->Data();
2118  intvec* arg2 = (intvec*) h->next->Data();
2119  intvec* arg3 = (intvec*) h->next->next->Data();
2120  int arg4 = (int)(long) h->next->next->next->Data();
2121  int arg5 = (int)(long) h->next->next->next->next->Data();
2122  int arg6 = (int)(long) h->next->next->next->next->next->Data();
2123  int arg7 = (int)(long) h->next->next->next->next->next->next->Data();
2124  int arg8 = (int)(long) h->next->next->next->next->next->next->next->Data();
2125  int arg9 = (int)(long) h->next->next->next->next->next->next->next->next->Data();
2126  ideal result = (ideal) Mprwalk(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9);
2127  res->rtyp = IDEAL_CMD;
2128  res->data = result;
2129  return FALSE;
2130  }
2131  else
2132  #endif
2133  /*==================== TranMImprovwalk =================*/
2134  #ifdef HAVE_WALK
2135  #ifdef TRAN_Orig
2136  if (strcmp(sys_cmd, "TranMImprovwalk") == 0)
2137  {
2138  const short t[]={3,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD};
2139  if (!iiCheckTypes(h,t,1)) return TRUE;
2140  if (((intvec*) h->next->Data())->length() != currRing->N &&
2141  ((intvec*) h->next->next->Data())->length() != currRing->N )
2142  {
2143  Werror("system(\"TranMImprovwalk\" ...) intvecs not of length %d\n",
2144  currRing->N);
2145  return TRUE;
2146  }
2147  ideal arg1 = (ideal) h->Data();
2148  intvec* arg2 = (intvec*) h->next->Data();
2149  intvec* arg3 = (intvec*) h->next->next->Data();
2150  ideal result = (ideal) TranMImprovwalk(arg1, arg2, arg3);
2151  res->rtyp = IDEAL_CMD;
2152  res->data = result;
2153  return FALSE;
2154  }
2155  else
2156  #endif
2157  #endif
2158  /*==================== MAltwalk2 =================*/
2159  #ifdef HAVE_WALK
2160  if (strcmp(sys_cmd, "MAltwalk2") == 0)
2161  {
2162  const short t[]={3,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD};
2163  if (!iiCheckTypes(h,t,1)) return TRUE;
2164  if (((intvec*) h->next->Data())->length() != currRing->N &&
2165  ((intvec*) h->next->next->Data())->length() != currRing->N )
2166  {
2167  Werror("system(\"MAltwalk2\" ...) intvecs not of length %d\n",
2168  currRing->N);
2169  return TRUE;
2170  }
2171  ideal arg1 = (ideal) h->Data();
2172  intvec* arg2 = (intvec*) h->next->Data();
2173  intvec* arg3 = (intvec*) h->next->next->Data();
2174  ideal result = (ideal) MAltwalk2(arg1, arg2, arg3);
2175  res->rtyp = IDEAL_CMD;
2176  res->data = result;
2177  return FALSE;
2178  }
2179  else
2180  #endif
2181  /*==================== MAltwalk2 =================*/
2182  #ifdef HAVE_WALK
2183  if (strcmp(sys_cmd, "TranMImprovwalk") == 0)
2184  {
2185  const short t[]={4,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD};
2186  if (!iiCheckTypes(h,t,1)) return TRUE;
2187  if (((intvec*) h->next->Data())->length() != currRing->N &&
2188  ((intvec*) h->next->next->Data())->length() != currRing->N )
2189  {
2190  Werror("system(\"TranMImprovwalk\" ...) intvecs not of length %d\n",
2191  currRing->N);
2192  return TRUE;
2193  }
2194  ideal arg1 = (ideal) h->Data();
2195  intvec* arg2 = (intvec*) h->next->Data();
2196  intvec* arg3 = (intvec*) h->next->next->Data();
2197  int arg4 = (int) ((long)(h->next->next->next->Data()));
2198  ideal result = (ideal) TranMImprovwalk(arg1, arg2, arg3, arg4);
2199  res->rtyp = IDEAL_CMD;
2200  res->data = result;
2201  return FALSE;
2202  }
2203  else
2204  #endif
2205  /*==================== TranMrImprovwalk =================*/
2206  #if 0
2207  #ifdef HAVE_WALK
2208  if (strcmp(sys_cmd, "TranMrImprovwalk") == 0)
2209  {
2210  if (h == NULL || h->Typ() != IDEAL_CMD ||
2211  h->next == NULL || h->next->Typ() != INTVEC_CMD ||
2212  h->next->next == NULL || h->next->next->Typ() != INTVEC_CMD ||
2213  h->next->next->next == NULL || h->next->next->next->Typ() != INT_CMD ||
2214  h->next->next->next == NULL || h->next->next->next->next->Typ() != INT_CMD ||
2215  h->next->next->next == NULL || h->next->next->next->next->next->Typ() != INT_CMD)
2216  {
2217  WerrorS("system(\"TranMrImprovwalk\", ideal, intvec, intvec) expected");
2218  return TRUE;
2219  }
2220  if (((intvec*) h->next->Data())->length() != currRing->N &&
2221  ((intvec*) h->next->next->Data())->length() != currRing->N )
2222  {
2223  Werror("system(\"TranMrImprovwalk\" ...) intvecs not of length %d\n", currRing->N);
2224  return TRUE;
2225  }
2226  ideal arg1 = (ideal) h->Data();
2227  intvec* arg2 = (intvec*) h->next->Data();
2228  intvec* arg3 = (intvec*) h->next->next->Data();
2229  int arg4 = (int)(long) h->next->next->next->Data();
2230  int arg5 = (int)(long) h->next->next->next->next->Data();
2231  int arg6 = (int)(long) h->next->next->next->next->next->Data();
2232  ideal result = (ideal) TranMrImprovwalk(arg1, arg2, arg3, arg4, arg5, arg6);
2233  res->rtyp = IDEAL_CMD;
2234  res->data = result;
2235  return FALSE;
2236  }
2237  else
2238  #endif
2239  #endif
2240  /*================= Extended system call ========================*/
2241  {
2242  #ifndef MAKE_DISTRIBUTION
2243  return(jjEXTENDED_SYSTEM(res, args));
2244  #else
2245  Werror( "system(\"%s\",...) %s", sys_cmd, feNotImplemented );
2246  #endif
2247  }
2248  } /* typ==string */
2249  return TRUE;
2250 }
feOptIndex
Definition: feOptGen.h:15
int & rows()
Definition: matpol.h:24
lists get_denom_list()
Definition: denom_list.cc:8
poly pOppose(ring Rop_src, poly p, const ring Rop_dst)
opposes a vector p from Rop to currRing (dst!)
Definition: old.gring.cc:3427
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
const CanonicalForm int s
Definition: facAbsFact.cc:55
ring rEnvelope(ring R)
Definition: ring.cc:5517
sleftv * m
Definition: lists.h:45
intvec * MivMatrixOrder(intvec *iv)
Definition: walk.cc:969
poly nc_p_Bracket_qq(poly p, const poly q, const ring r)
returns [p,q], destroys p
Definition: old.gring.cc:2308
void factoryseed(int s)
random seed initializer
Definition: cf_random.cc:176
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
int HCord
Definition: kutil.cc:227
matrix singntl_LLL(matrix m, const ring s)
Definition: clapsing.cc:1706
intvec * Mfpertvector(ideal G, intvec *ivtarget)
Definition: walk.cc:1518
Definition: tok.h:85
static void * feOptValue(feOptIndex opt)
Definition: feOpt.h:40
matrix evRowElim(matrix M, int i, int j, int k)
Definition: eigenval.cc:47
Definition: lists.h:22
ideal Mpwalk(ideal Go, int op_deg, int tp_deg, intvec *curr_weight, intvec *target_weight, int nP, int reduction, int printout)
Definition: walk.cc:5848
used for all transcendental extensions, i.e., the top-most extension in an extension tower is transce...
Definition: coeffs.h:38
char * versionString()
Definition: misc_ip.cc:784
#define FALSE
Definition: auxiliary.h:140
return P p
Definition: myNF.cc:203
intvec * MivWeightOrderlp(intvec *ivstart)
Definition: walk.cc:1442
BOOLEAN semicProc3(leftv res, leftv u, leftv v, leftv w)
Definition: ipshell.cc:4375
Matrices of numbers.
Definition: bigintmat.h:51
f
Definition: cfModGcd.cc:4022
#define SINGULAR_VERSION
Definition: mod2.h:94
static char * feResource(feResourceConfig config, int warn)
Definition: feResource.cc:252
lists pcvPMulL(poly p, lists l1)
Definition: pcv.cc:56
static FORCE_INLINE number n_Init(long i, const coeffs r)
a number representing i in the given coeff field/ring r
Definition: coeffs.h:539
ring rOpposite(ring src)
Definition: ring.cc:5189
#define BB_LIKE_LIST(B)
Definition: blackbox.h:54
int siRandomStart
Definition: cntrlc.cc:103
ideal id_TensorModuleMult(const int m, const ideal M, const ring rRing)
char * getenv()
BOOLEAN spectrumProc(leftv result, leftv first)
Definition: ipshell.cc:3997
#define TRUE
Definition: auxiliary.h:144
int MivSame(intvec *u, intvec *v)
Definition: walk.cc:899
intvec * MivWeightOrderdp(intvec *ivstart)
Definition: walk.cc:1462
BOOLEAN spmulProc(leftv result, leftv first, leftv second)
Definition: ipshell.cc:4334
void * value
Definition: fegetopt.h:93
const char * feSetOptValue(feOptIndex opt, char *optarg)
Definition: feOpt.cc:153
g
Definition: cfModGcd.cc:4031
void WerrorS(const char *s)
Definition: feFopen.cc:24
gmp_complex numbers based on
Definition: mpr_complex.h:178
char * StringEndS()
Definition: reporter.cc:151
bool complexNearZero(gmp_complex *c, int digits)
Definition: mpr_complex.cc:778
void lduDecomp(const matrix aMat, matrix &pMat, matrix &lMat, matrix &dMat, matrix &uMat, poly &l, poly &u, poly &lTimesU)
LU-decomposition of a given (m x n)-matrix with performing only those divisions that yield zero remai...
int Typ()
Definition: subexpr.cc:969
static bool rIsPluralRing(const ring r)
we must always have this test!
Definition: ring.h:361
const char * Name()
Definition: subexpr.h:121
matrix evSwap(matrix M, int i, int j)
Definition: eigenval.cc:25
Definition: idrec.h:34
#define ivTest(v)
Definition: intvec.h:165
idhdl get(const char *s, int lev)
Definition: ipid.cc:91
intvec * MPertVectorslp(ideal G, intvec *ivtarget, int pdeg)
Definition: walk.cc:1305
void * data
Definition: subexpr.h:89
void printBlackboxTypes()
list all defined type (for debugging)
Definition: blackbox.cc:210
void feStringAppendBrowsers(int warn)
Definition: fehelp.cc:352
ideal Mfwalk(ideal G, intvec *ivstart, intvec *ivtarget, int reduction, int printout)
Definition: walk.cc:7923
poly p_Shrink(poly p, int lV, const ring r)
Definition: shiftgb.cc:510
int myynest
Definition: febase.cc:46
#define M
Definition: sirandom.c:24
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
static int rBlocks(ring r)
Definition: ring.h:516
const ring r
Definition: syzextra.cc:208
ideal MAltwalk1(ideal Go, int op_deg, int tp_deg, intvec *curr_weight, intvec *target_weight)
Definition: walk.cc:9470
#define FLAG_TWOSTD
Definition: ipid.h:109
Definition: intvec.h:16
int pcvDim(int d0, int d1)
Definition: pcv.cc:361
void newstructShow(newstruct_desc d)
Definition: newstruct.cc:829
void StringSetS(const char *st)
Definition: reporter.cc:128
static BOOLEAN jjEXTENDED_SYSTEM(leftv res, leftv h)
Definition: extra.cc:2264
int M3ivSame(intvec *temp, intvec *u, intvec *v)
Definition: walk.cc:920
poly pLPshift(poly p, int sh, int uptodeg, int lV)
Definition: shiftgb.cc:155
const char feNotImplemented[]
Definition: reporter.cc:54
struct fe_option feOptSpec[]
intvec * MwalkNextWeight(intvec *curr_weight, intvec *target_weight, ideal G)
ideal Mwalk(ideal Go, intvec *orig_M, intvec *target_M, ring baseRing, int reduction, int printout)
Definition: walk.cc:5202
ip_smatrix * matrix
intvec * MPertNextWeight(intvec *iva, ideal G, int deg)
void system(sys)
idhdl currRingHdl
Definition: ipid.cc:65
#define setFlag(A, F)
Definition: ipid.h:112
int simpleipc_cmd(char *cmd, int id, int v)
Definition: semaphore.c:122
int m
Definition: cfEzgcd.cc:119
void fePrintOptValues()
Definition: feOpt.cc:321
poly pcvCV2P(poly cv, int d0, int d1)
Definition: pcv.cc:263
int i
Definition: cfEzgcd.cc:123
intvec * Mivperttarget(ideal G, int ndeg)
BOOLEAN spectrumfProc(leftv result, leftv first)
Definition: ipshell.cc:4048
lists pcvLAddL(lists l1, lists l2)
Definition: pcv.cc:31
#define pOne()
Definition: polys.h:286
int pcvBasis(lists b, int i, poly m, int d, int n)
Definition: pcv.cc:391
Definition: tok.h:88
intvec * MPertVectors(ideal G, intvec *ivtarget, int pdeg)
Definition: walk.cc:1094
ideal freegb(ideal I, int uptodeg, int lVblock)
Definition: kstd2.cc:3413
static FORCE_INLINE n_coeffType getCoeffType(const coeffs r)
Returns the type of coeffs domain.
Definition: coeffs.h:422
#define FLAG_STD
Definition: ipid.h:108
leftv next
Definition: subexpr.h:87
static BOOLEAN rField_is_long_C(const ring r)
Definition: ring.h:494
intvec * Mivdp(int nR)
Definition: walk.cc:1013
#define BIMATELEM(M, I, J)
Definition: bigintmat.h:136
INLINE_THIS void Init(int l=0)
Definition: lists.h:66
int pLastVblock(poly p, int lV)
Definition: shiftgb.cc:223
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
matrix evHessenberg(matrix M)
Definition: eigenval.cc:100
int rows() const
Definition: bigintmat.h:148
int & cols()
Definition: matpol.h:25
Definition: tok.h:95
lists evEigenvals(matrix M)
Definition: eigenval_ip.cc:118
static BOOLEAN rField_is_Ring(const ring r)
Definition: ring.h:437
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
BOOLEAN semicProc(leftv res, leftv u, leftv v)
Definition: ipshell.cc:4415
int siSeed
Definition: sirandom.c:29
bool luSolveViaLDUDecomp(const matrix pMat, const matrix lMat, const matrix dMat, const matrix uMat, const poly l, const poly u, const poly lTimesU, const matrix bVec, matrix &xVec, matrix &H)
Solves the linear system A * x = b, where A is an (m x n)-matrix which is given by its LDU-decomposit...
ideal TranMImprovwalk(ideal G, intvec *curr_weight, intvec *target_tmp, int nP)
Definition: walk.cc:8288
#define pMult(p, q)
Definition: polys.h:178
int rows() const
Definition: intvec.h:88
BOOLEAN iiCheckTypes(leftv args, const short *type_list, int report)
check a list of arguemys against a given field of types return TRUE if the types match return FALSE (...
Definition: ipshell.cc:6434
coeffs basecoeffs() const
Definition: bigintmat.h:149
static BOOLEAN rField_is_long_R(const ring r)
Definition: ring.h:491
#define IDRING(a)
Definition: ipid.h:126
int blackboxIsCmd(const char *n, int &tok)
used by scanner: returns ROOT_DECL for known types (and the type number in tok)
Definition: blackbox.cc:193
const CanonicalForm & w
Definition: facAbsFact.cc:55
#define pDelete(p_ptr)
Definition: polys.h:157
intvec * MivMatrixOrderdp(int nV)
Definition: walk.cc:1423
int rtyp
Definition: subexpr.h:92
#define TEST_FOR(A)
void * Data()
Definition: subexpr.cc:1111
ideal MAltwalk2(ideal Go, intvec *curr_weight, intvec *target_weight)
Definition: walk.cc:4235
ideal Mrwalk(ideal Go, intvec *orig_M, intvec *target_M, int weight_rad, int pert_deg, int reduction, int printout)
Definition: walk.cc:5503
poly pcvP2CV(poly p, int d0, int d1)
Definition: pcv.cc:246
Definition: tok.h:96
omBin slists_bin
Definition: lists.cc:23
BOOLEAN spaddProc(leftv result, leftv first, leftv second)
Definition: ipshell.cc:4292
intvec * MivUnit(int nV)
Definition: walk.cc:1502
ideal idXXX(ideal h1, int k)
Definition: ideals.cc:701
ideal singclap_absFactorize(poly f, ideal &mipos, intvec **exps, int &numFactors, const ring r)
Definition: clapsing.cc:1762
#define pPower(p, q)
Definition: polys.h:175
BOOLEAN newstruct_set_proc(const char *bbname, const char *func, int args, procinfov pr)
Definition: newstruct.cc:849
size_t gmp_output_digits
Definition: mpr_complex.cc:44
ideal Mprwalk(ideal Go, intvec *orig_M, intvec *target_M, int weight_rad, int op_deg, int tp_deg, int nP, int reduction, int printout)
Definition: walk.cc:6283
END_NAMESPACE const void * p2
Definition: syzextra.cc:202
static FORCE_INLINE void n_Delete(number *p, const coeffs r)
delete &#39;p&#39;
Definition: coeffs.h:456
lists gmsNF(ideal p, ideal g, matrix B, int D, int K)
Definition: gms.cc:22
feOptIndex feGetOptIndex(const char *name)
Definition: feOpt.cc:104
void countedref_reference_load()
Initialize blackbox types &#39;reference&#39; and &#39;shared&#39;, or both.
Definition: countedref.cc:700
static jList * T
Definition: janet.cc:37
polyrec * poly
Definition: hilb.h:10
#define IDDATA(a)
Definition: ipid.h:125
ideal MwalkInitialForm(ideal G, intvec *ivw)
Definition: walk.cc:767
ideal Mfrwalk(ideal G, intvec *ivstart, intvec *ivtarget, int weight_rad, int reduction, int printout)
Definition: walk.cc:8104
static Poly * h
Definition: janet.cc:978
#define IMATELEM(M, I, J)
Definition: intvec.h:77
#define NONE
Definition: tok.h:173
void feReInitResources()
Definition: feResource.cc:201
void Werror(const char *fmt,...)
Definition: reporter.cc:199
intvec * MivMatrixOrderlp(int nV)
Definition: walk.cc:1407
void * CopyD(int t)
Definition: subexpr.cc:676
int pcvMinDeg(poly p)
Definition: pcv.cc:108
void countedref_shared_load()
Definition: countedref.cc:724
return result
Definition: facAbsBiFact.cc:76
int l
Definition: cfEzgcd.cc:94
intvec * Mivlp(int nR)
Definition: walk.cc:1028
procinfo * procinfov
Definition: structs.h:63
#define pCopy(p)
return a copy of the poly
Definition: polys.h:156
blackbox * getBlackboxStuff(const int t)
return the structure to the type given by t
Definition: blackbox.cc:20
intvec * MkInterRedNextWeight(intvec *iva, intvec *ivb, ideal G)
Definition: walk.cc:2577
ideal twostd(ideal I)
Compute two-sided GB:
Definition: nc.cc:22
#define omStrDup(s)
Definition: omAllocDecl.h:263
poly longCoeffsToSingularPoly ( unsigned long *  polyCoeffs,
const int  degree 
)

Definition at line 222 of file extra.cc.

223 {
224  poly result = NULL;
225  for (int i = 0; i <= degree; i++)
226  {
227  if ((int)polyCoeffs[i] != 0)
228  {
229  poly term = p_ISet((int)polyCoeffs[i], currRing);
230  if (i > 0)
231  {
232  p_SetExp(term, 1, i, currRing);
233  p_Setm(term, currRing);
234  }
235  result = p_Add_q(result, term, currRing);
236  }
237  }
238  return result;
239 }
Definition: int_poly.h:36
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
int i
Definition: cfEzgcd.cc:123
static unsigned long p_SetExp(poly p, const unsigned long e, const unsigned long iBitmask, const int VarOffset)
set a single variable exponent : VarOffset encodes the position in p->exp
Definition: p_polys.h:484
#define NULL
Definition: omList.c:10
static void p_Setm(poly p, const ring r)
Definition: p_polys.h:436
int degree(const CanonicalForm &f)
polyrec * poly
Definition: hilb.h:10
static poly p_Add_q(poly p, poly q, const ring r)
Definition: p_polys.h:884
poly p_ISet(long i, const ring r)
returns the poly representing the integer i
Definition: p_polys.cc:1302
return result
Definition: facAbsBiFact.cc:76
unsigned long** singularMatrixToLongMatrix ( matrix  singularMatrix)

Definition at line 190 of file extra.cc.

191 {
192  int n = singularMatrix->rows();
193  assume(n == singularMatrix->cols());
194  unsigned long **longMatrix = 0;
195  longMatrix = new unsigned long *[n] ;
196  for (int i = 0 ; i < n; i++)
197  longMatrix[i] = new unsigned long [n];
198  number entry;
199  for (int r = 0; r < n; r++)
200  for (int c = 0; c < n; c++)
201  {
202  poly p=MATELEM(singularMatrix, r + 1, c + 1);
203  int entryAsInt;
204  if (p!=NULL)
205  {
206  entry = p_GetCoeff(p, currRing);
207  entryAsInt = n_Int(entry, currRing->cf);
208  if (entryAsInt < 0) entryAsInt += n_GetChar(currRing->cf);
209  }
210  else
211  entryAsInt=0;
212  longMatrix[r][c] = (unsigned long)entryAsInt;
213  }
214  return longMatrix;
215 }
int & rows()
Definition: matpol.h:24
return P p
Definition: myNF.cc:203
static FORCE_INLINE int n_GetChar(const coeffs r)
Return the characteristic of the coeff. domain.
Definition: coeffs.h:445
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
const ring r
Definition: syzextra.cc:208
static FORCE_INLINE long n_Int(number &n, const coeffs r)
conversion of n to an int; 0 if not possible in Z/pZ: the representing int lying in (-p/2 ...
Definition: coeffs.h:548
#define assume(x)
Definition: mod2.h:405
int i
Definition: cfEzgcd.cc:123
int & cols()
Definition: matpol.h:25
#define NULL
Definition: omList.c:10
#define p_GetCoeff(p, r)
Definition: monomials.h:57
polyrec * poly
Definition: hilb.h:10
#define MATELEM(mat, i, j)
Definition: matpol.h:29