My Project  debian-1:4.1.2-p1+ds-2
Macros | Functions
extra.cc File Reference
#include "kernel/mod2.h"
#include "misc/sirandom.h"
#include "resources/omFindExec.h"
#include "factory/factory.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/weight.h"
#include "polys/shiftop.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/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 "links/ssiLink.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/fglm.h"
#include "hc_newton.h"
#include "polys/mod_raw.h"
#include "kernel/GBEngine/shiftgb.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

◆ HAVE_SHEAFCOH_TRICKS

#define HAVE_SHEAFCOH_TRICKS   1

◆ HAVE_WALK

#define HAVE_WALK   1

Definition at line 10 of file extra.cc.

◆ TEST_FOR

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

Function Documentation

◆ jjEXTENDED_SYSTEM()

static BOOLEAN jjEXTENDED_SYSTEM ( leftv  res,
leftv  h 
)
static

Definition at line 2270 of file extra.cc.

2271 {
2272  if(h->Typ() == STRING_CMD)
2273  {
2274  char *sys_cmd=(char *)(h->Data());
2275  h=h->next;
2276  /*==================== test syz strat =================*/
2277  if (strcmp(sys_cmd, "syz") == 0)
2278  {
2279  if ((h!=NULL) && (h->Typ()==STRING_CMD))
2280  {
2281  const char *s=(const char *)h->Data();
2282  if (strcmp(s,"posInT_EcartFDegpLength")==0)
2284  else if (strcmp(s,"posInT_FDegpLength")==0)
2286  else if (strcmp(s,"posInT_pLength")==0)
2288  else if (strcmp(s,"posInT0")==0)
2290  else if (strcmp(s,"posInT1")==0)
2292  else if (strcmp(s,"posInT2")==0)
2294  else if (strcmp(s,"posInT11")==0)
2296  else if (strcmp(s,"posInT110")==0)
2298  else if (strcmp(s,"posInT13")==0)
2300  else if (strcmp(s,"posInT15")==0)
2302  else if (strcmp(s,"posInT17")==0)
2304  else if (strcmp(s,"posInT17_c")==0)
2306  else if (strcmp(s,"posInT19")==0)
2308  else PrintS("valid posInT:0,1,2,11,110,13,15,17,17_c,19,_EcartFDegpLength,_FDegpLength,_pLength,_EcartpLength\n");
2309  }
2310  else
2311  {
2312  test_PosInT=NULL;
2313  test_PosInL=NULL;
2314  }
2315  si_opt_2|=Sy_bit(23);
2316  return FALSE;
2317  }
2318  else
2319  /*==================== locNF ======================================*/
2320  if(strcmp(sys_cmd,"locNF")==0)
2321  {
2322  const short t[]={4,VECTOR_CMD,MODUL_CMD,INT_CMD,INTVEC_CMD};
2323  if (iiCheckTypes(h,t,1))
2324  {
2325  poly f=(poly)h->Data();
2326  h=h->next;
2327  ideal m=(ideal)h->Data();
2328  assumeStdFlag(h);
2329  h=h->next;
2330  int n=(int)((long)h->Data());
2331  h=h->next;
2332  intvec *v=(intvec *)h->Data();
2333 
2334  /* == now the work starts == */
2335 
2336  short * iv=iv2array(v, currRing);
2337  poly r=0;
2338  poly hp=ppJetW(f,n,iv);
2339  int s=MATCOLS(m);
2340  int j=0;
2341  matrix T=mp_InitI(s,1,0, currRing);
2342 
2343  while (hp != NULL)
2344  {
2345  if (pDivisibleBy(m->m[j],hp))
2346  {
2347  if (MATELEM(T,j+1,1)==0)
2348  {
2349  MATELEM(T,j+1,1)=pDivideM(pHead(hp),pHead(m->m[j]));
2350  }
2351  else
2352  {
2353  pAdd(MATELEM(T,j+1,1),pDivideM(pHead(hp),pHead(m->m[j])));
2354  }
2355  hp=ppJetW(ksOldSpolyRed(m->m[j],hp,0),n,iv);
2356  j=0;
2357  }
2358  else
2359  {
2360  if (j==s-1)
2361  {
2362  r=pAdd(r,pHead(hp));
2363  hp=pLmDeleteAndNext(hp); /* hp=pSub(hp,pHead(hp));*/
2364  j=0;
2365  }
2366  else
2367  {
2368  j++;
2369  }
2370  }
2371  }
2372 
2375  for (int k=1;k<=MATROWS(Temp);k++)
2376  {
2377  MATELEM(R,k,1)=MATELEM(Temp,k,1);
2378  }
2379 
2381  L->Init(2);
2382  L->m[0].rtyp=MATRIX_CMD; L->m[0].data=(void *)R;
2383  L->m[1].rtyp=MATRIX_CMD; L->m[1].data=(void *)T;
2384  res->data=L;
2385  res->rtyp=LIST_CMD;
2386  // iv aufraeumen
2387  omFree(iv);
2388  return FALSE;
2389  }
2390  else
2391  return TRUE;
2392  }
2393  else
2394  /*==================== poly debug ==================================*/
2395  if(strcmp(sys_cmd,"p")==0)
2396  {
2397 # ifdef RDEBUG
2398  p_DebugPrint((poly)h->Data(), currRing);
2399 # else
2400  WarnS("Sorry: not available for release build!");
2401 # endif
2402  return FALSE;
2403  }
2404  else
2405  /*==================== setsyzcomp ==================================*/
2406  if(strcmp(sys_cmd,"setsyzcomp")==0)
2407  {
2408  if ((h!=NULL) && (h->Typ()==INT_CMD))
2409  {
2410  int k = (int)(long)h->Data();
2411  if ( currRing->order[0] == ringorder_s )
2412  {
2414  }
2415  }
2416  }
2417  /*==================== ring debug ==================================*/
2418  if(strcmp(sys_cmd,"r")==0)
2419  {
2420 # ifdef RDEBUG
2421  rDebugPrint((ring)h->Data());
2422 # else
2423  WarnS("Sorry: not available for release build!");
2424 # endif
2425  return FALSE;
2426  }
2427  else
2428  /*==================== changeRing ========================*/
2429  /* The following code changes the names of the variables in the
2430  current ring to "x1", "x2", ..., "xN", where N is the number
2431  of variables in the current ring.
2432  The purpose of this rewriting is to eliminate indexed variables,
2433  as they may cause problems when generating scripts for Magma,
2434  Maple, or Macaulay2. */
2435  if(strcmp(sys_cmd,"changeRing")==0)
2436  {
2437  int varN = currRing->N;
2438  char h[10];
2439  for (int i = 1; i <= varN; i++)
2440  {
2441  omFree(currRing->names[i - 1]);
2442  sprintf(h, "x%d", i);
2443  currRing->names[i - 1] = omStrDup(h);
2444  }
2446  res->rtyp = INT_CMD;
2447  res->data = (void*)0L;
2448  return FALSE;
2449  }
2450  else
2451  /*==================== mtrack ==================================*/
2452  if(strcmp(sys_cmd,"mtrack")==0)
2453  {
2454  #ifdef OM_TRACK
2455  om_Opts.MarkAsStatic = 1;
2456  FILE *fd = NULL;
2457  int max = 5;
2458  while (h != NULL)
2459  {
2461  if (fd == NULL && h->Typ()==STRING_CMD)
2462  {
2463  char *fn=(char*) h->Data();
2464  fd = fopen(fn, "w");
2465  if (fd == NULL)
2466  Warn("Can not open %s for writing og mtrack. Using stdout",fn);
2467  }
2468  else if (h->Typ() == INT_CMD)
2469  {
2470  max = (int)(long)h->Data();
2471  }
2472  h = h->Next();
2473  }
2474  omPrintUsedTrackAddrs((fd == NULL ? stdout : fd), max);
2475  if (fd != NULL) fclose(fd);
2476  om_Opts.MarkAsStatic = 0;
2477  return FALSE;
2478  #else
2479  WerrorS("system(\"mtrack\",..) is not implemented in this version");
2480  return TRUE;
2481  #endif
2482  }
2483  else
2484  /*==================== backtrace ==================================*/
2485  #ifndef OM_NDEBUG
2486  if(strcmp(sys_cmd,"backtrace")==0)
2487  {
2488  omPrintCurrentBackTrace(stdout);
2489  return FALSE;
2490  }
2491  else
2492  #endif
2493 
2494 #if !defined(OM_NDEBUG)
2495  /*==================== omMemoryTest ==================================*/
2496  if (strcmp(sys_cmd,"omMemoryTest")==0)
2497  {
2498 
2499 #ifdef OM_STATS_H
2500  PrintS("\n[om_Info]: \n");
2501  omUpdateInfo();
2502 #define OM_PRINT(name) Print(" %-22s : %10ld \n", #name, om_Info . name)
2503  OM_PRINT(MaxBytesSystem);
2504  OM_PRINT(CurrentBytesSystem);
2505  OM_PRINT(MaxBytesSbrk);
2506  OM_PRINT(CurrentBytesSbrk);
2507  OM_PRINT(MaxBytesMmap);
2508  OM_PRINT(CurrentBytesMmap);
2509  OM_PRINT(UsedBytes);
2510  OM_PRINT(AvailBytes);
2511  OM_PRINT(UsedBytesMalloc);
2512  OM_PRINT(AvailBytesMalloc);
2513  OM_PRINT(MaxBytesFromMalloc);
2514  OM_PRINT(CurrentBytesFromMalloc);
2515  OM_PRINT(MaxBytesFromValloc);
2516  OM_PRINT(CurrentBytesFromValloc);
2517  OM_PRINT(UsedBytesFromValloc);
2518  OM_PRINT(AvailBytesFromValloc);
2519  OM_PRINT(MaxPages);
2520  OM_PRINT(UsedPages);
2521  OM_PRINT(AvailPages);
2522  OM_PRINT(MaxRegionsAlloc);
2523  OM_PRINT(CurrentRegionsAlloc);
2524 #undef OM_PRINT
2525 #endif
2526 
2527 #ifdef OM_OPTS_H
2528  PrintS("\n[om_Opts]: \n");
2529 #define OM_PRINT(format, name) Print(" %-22s : %10" format"\n", #name, om_Opts . name)
2530  OM_PRINT("d", MinTrack);
2531  OM_PRINT("d", MinCheck);
2532  OM_PRINT("d", MaxTrack);
2533  OM_PRINT("d", MaxCheck);
2534  OM_PRINT("d", Keep);
2535  OM_PRINT("d", HowToReportErrors);
2536  OM_PRINT("d", MarkAsStatic);
2537  OM_PRINT("u", PagesPerRegion);
2538  OM_PRINT("p", OutOfMemoryFunc);
2539  OM_PRINT("p", MemoryLowFunc);
2540  OM_PRINT("p", ErrorHook);
2541 #undef OM_PRINT
2542 #endif
2543 
2544 #ifdef OM_ERROR_H
2545  Print("\n\n[om_ErrorStatus] : '%s' (%s)\n",
2548  Print("[om_InternalErrorStatus]: '%s' (%s)\n",
2551 
2552 #endif
2553 
2554 // omTestMemory(1);
2555 // omtTestErrors();
2556  return FALSE;
2557  }
2558  else
2559 #endif
2560  /*==================== pDivStat =============================*/
2561  #if defined(PDEBUG) || defined(PDIV_DEBUG)
2562  if(strcmp(sys_cmd,"pDivStat")==0)
2563  {
2564  extern void pPrintDivisbleByStat();
2566  return FALSE;
2567  }
2568  else
2569  #endif
2570  /*==================== red =============================*/
2571  #if 0
2572  if(strcmp(sys_cmd,"red")==0)
2573  {
2574  if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2575  {
2576  res->rtyp=IDEAL_CMD;
2577  res->data=(void *)kStdred((ideal)h->Data(),NULL,testHomog,NULL);
2578  setFlag(res,FLAG_STD);
2579  return FALSE;
2580  }
2581  else
2582  WerrorS("ideal expected");
2583  }
2584  else
2585  #endif
2586  /*==================== fastcomb =============================*/
2587  if(strcmp(sys_cmd,"fastcomb")==0)
2588  {
2589  if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2590  {
2591  if (h->next!=NULL)
2592  {
2593  if (h->next->Typ()!=POLY_CMD)
2594  {
2595  WarnS("Wrong types for poly= comb(ideal,poly)");
2596  }
2597  }
2598  res->rtyp=POLY_CMD;
2599  res->data=(void *) fglmLinearCombination(
2600  (ideal)h->Data(),(poly)h->next->Data());
2601  return FALSE;
2602  }
2603  else
2604  WerrorS("ideal expected");
2605  }
2606  else
2607  /*==================== comb =============================*/
2608  if(strcmp(sys_cmd,"comb")==0)
2609  {
2610  if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
2611  {
2612  if (h->next!=NULL)
2613  {
2614  if (h->next->Typ()!=POLY_CMD)
2615  {
2616  WarnS("Wrong types for poly= comb(ideal,poly)");
2617  }
2618  }
2619  res->rtyp=POLY_CMD;
2620  res->data=(void *)fglmNewLinearCombination(
2621  (ideal)h->Data(),(poly)h->next->Data());
2622  return FALSE;
2623  }
2624  else
2625  WerrorS("ideal expected");
2626  }
2627  else
2628  #if 0 /* debug only */
2629  /*==================== listall ===================================*/
2630  if(strcmp(sys_cmd,"listall")==0)
2631  {
2632  void listall(int showproc);
2633  int showproc=0;
2634  if ((h!=NULL) && (h->Typ()==INT_CMD)) showproc=(int)((long)h->Data());
2635  listall(showproc);
2636  return FALSE;
2637  }
2638  else
2639  #endif
2640  #if 0 /* debug only */
2641  /*==================== proclist =================================*/
2642  if(strcmp(sys_cmd,"proclist")==0)
2643  {
2644  void piShowProcList();
2645  piShowProcList();
2646  return FALSE;
2647  }
2648  else
2649  #endif
2650  /* ==================== newton ================================*/
2651  #ifdef HAVE_NEWTON
2652  if(strcmp(sys_cmd,"newton")==0)
2653  {
2654  if ((h->Typ()!=POLY_CMD)
2655  || (h->next->Typ()!=INT_CMD)
2656  || (h->next->next->Typ()!=INT_CMD))
2657  {
2658  WerrorS("system(\"newton\",<poly>,<int>,<int>) expected");
2659  return TRUE;
2660  }
2661  poly p=(poly)(h->Data());
2662  int l=pLength(p);
2663  short *points=(short *)omAlloc(currRing->N*l*sizeof(short));
2664  int i,j,k;
2665  k=0;
2666  poly pp=p;
2667  for (i=0;pp!=NULL;i++)
2668  {
2669  for(j=1;j<=currRing->N;j++)
2670  {
2671  points[k]=pGetExp(pp,j);
2672  k++;
2673  }
2674  pIter(pp);
2675  }
2676  hc_ERG r=hc_KOENIG(currRing->N, // dimension
2677  l, // number of points
2678  (short*) points, // points: x_1, y_1,z_1, x_2,y_2,z2,...
2679  currRing->OrdSgn==-1,
2680  (int) (h->next->Data()), // 1: Milnor, 0: Newton
2681  (int) (h->next->next->Data()) // debug
2682  );
2683  //----<>---Output-----------------------
2684 
2685 
2686  // PrintS("Bin jetzt in extra.cc bei der Auswertung.\n"); // **********
2687 
2688 
2690  L->Init(6);
2691  L->m[0].rtyp=STRING_CMD; // newtonnumber;
2692  L->m[0].data=(void *)omStrDup(r.nZahl);
2693  L->m[1].rtyp=INT_CMD;
2694  L->m[1].data=(void *)(long)r.achse; // flag for unoccupied axes
2695  L->m[2].rtyp=INT_CMD;
2696  L->m[2].data=(void *)(long)r.deg; // #degenerations
2697  if ( r.deg != 0) // only if degenerations exist
2698  {
2699  L->m[3].rtyp=INT_CMD;
2700  L->m[3].data=(void *)(long)r.anz_punkte; // #points
2701  //---<>--number of points------
2702  int anz = r.anz_punkte; // number of points
2703  int dim = (currRing->N); // dimension
2704  intvec* v = new intvec( anz*dim );
2705  for (i=0; i<anz*dim; i++) // copy points
2706  (*v)[i] = r.pu[i];
2707  L->m[4].rtyp=INTVEC_CMD;
2708  L->m[4].data=(void *)v;
2709  //---<>--degenerations---------
2710  int deg = r.deg; // number of points
2711  intvec* w = new intvec( r.speicher ); // necessary memory
2712  i=0; // start copying
2713  do
2714  {
2715  (*w)[i] = r.deg_tab[i];
2716  i++;
2717  }
2718  while (r.deg_tab[i-1] != -2); // mark for end of list
2719  L->m[5].rtyp=INTVEC_CMD;
2720  L->m[5].data=(void *)w;
2721  }
2722  else
2723  {
2724  L->m[3].rtyp=INT_CMD; L->m[3].data=(char *)0;
2725  L->m[4].rtyp=DEF_CMD;
2726  L->m[5].rtyp=DEF_CMD;
2727  }
2728 
2729  res->data=(void *)L;
2730  res->rtyp=LIST_CMD;
2731  // free all pointer in r:
2732  delete[] r.nZahl;
2733  delete[] r.pu;
2734  delete[] r.deg_tab; // Ist das ein Problem??
2735 
2736  omFreeSize((ADDRESS)points,currRing->N*l*sizeof(short));
2737  return FALSE;
2738  }
2739  else
2740  #endif
2741  /*==== connection to Sebastian Jambor's code ======*/
2742  /* This code connects Sebastian Jambor's code for
2743  computing the minimal polynomial of an (n x n) matrix
2744  with entries in F_p to SINGULAR. Two conversion methods
2745  are needed; see further up in this file:
2746  (1) conversion of a matrix with long entries to
2747  a SINGULAR matrix with number entries, where
2748  the numbers are coefficients in currRing;
2749  (2) conversion of an array of longs (encoding the
2750  coefficients of the minimal polynomial) to a
2751  SINGULAR poly living in currRing. */
2752  if (strcmp(sys_cmd, "minpoly") == 0)
2753  {
2754  if ((h == NULL) || (h->Typ() != MATRIX_CMD) || h->next != NULL)
2755  {
2756  Werror("expected exactly one argument: %s",
2757  "a square matrix with number entries");
2758  return TRUE;
2759  }
2760  else
2761  {
2762  matrix m = (matrix)h->Data();
2763  int n = m->rows();
2764  unsigned long p = (unsigned long)n_GetChar(currRing->cf);
2765  if (n != m->cols())
2766  {
2767  WerrorS("expected exactly one argument: "
2768  "a square matrix with number entries");
2769  return TRUE;
2770  }
2771  unsigned long** ml = singularMatrixToLongMatrix(m);
2772  unsigned long* polyCoeffs = computeMinimalPolynomial(ml, n, p);
2773  poly theMinPoly = longCoeffsToSingularPoly(polyCoeffs, n);
2774  res->rtyp = POLY_CMD;
2775  res->data = (void *)theMinPoly;
2776  for (int i = 0; i < n; i++) delete[] ml[i];
2777  delete[] ml;
2778  delete[] polyCoeffs;
2779  return FALSE;
2780  }
2781  }
2782  else
2783  /*==================== sdb_flags =================*/
2784  #ifdef HAVE_SDB
2785  if (strcmp(sys_cmd, "sdb_flags") == 0)
2786  {
2787  if ((h!=NULL) && (h->Typ()==INT_CMD))
2788  {
2789  sdb_flags=(int)((long)h->Data());
2790  }
2791  else
2792  {
2793  WerrorS("system(\"sdb_flags\",`int`) expected");
2794  return TRUE;
2795  }
2796  return FALSE;
2797  }
2798  else
2799  #endif
2800  /*==================== sdb_edit =================*/
2801  #ifdef HAVE_SDB
2802  if (strcmp(sys_cmd, "sdb_edit") == 0)
2803  {
2804  if ((h!=NULL) && (h->Typ()==PROC_CMD))
2805  {
2806  procinfov p=(procinfov)h->Data();
2807  sdb_edit(p);
2808  }
2809  else
2810  {
2811  WerrorS("system(\"sdb_edit\",`proc`) expected");
2812  return TRUE;
2813  }
2814  return FALSE;
2815  }
2816  else
2817  #endif
2818  /*==================== GF =================*/
2819  #if 0 // for testing only
2820  if (strcmp(sys_cmd, "GF") == 0)
2821  {
2822  if ((h!=NULL) && (h->Typ()==POLY_CMD))
2823  {
2824  int c=rChar(currRing);
2825  setCharacteristic( c,nfMinPoly[0], currRing->parameter[0][0] );
2826  CanonicalForm F( convSingGFFactoryGF( (poly)h->Data(), currRing ) );
2827  res->rtyp=POLY_CMD;
2828  res->data=convFactoryGFSingGF( F, currRing );
2829  return FALSE;
2830  }
2831  else { WerrorS("wrong typ"); return TRUE;}
2832  }
2833  else
2834  #endif
2835  /*==================== SVD =================*/
2836  #ifdef HAVE_SVD
2837  if (strcmp(sys_cmd, "svd") == 0)
2838  {
2839  extern lists testsvd(matrix M);
2840  res->rtyp=LIST_CMD;
2841  res->data=(char*)(testsvd((matrix)h->Data()));
2842  return FALSE;
2843  }
2844  else
2845  #endif
2846 
2847 
2848  /*==================== DLL =================*/
2849  #ifdef __CYGWIN__
2850  #ifdef HAVE_DL
2851  /* testing the DLL functionality under Win32 */
2852  if (strcmp(sys_cmd, "DLL") == 0)
2853  {
2854  typedef void (*Void_Func)();
2855  typedef int (*Int_Func)(int);
2856  void *hh=dynl_open("WinDllTest.dll");
2857  if ((h!=NULL) && (h->Typ()==INT_CMD))
2858  {
2859  int (*f)(int);
2860  if (hh!=NULL)
2861  {
2862  int (*f)(int);
2863  f=(Int_Func)dynl_sym(hh,"PlusDll");
2864  int i=10;
2865  if (f!=NULL) printf("%d\n",f(i));
2866  else PrintS("cannot find PlusDll\n");
2867  }
2868  }
2869  else
2870  {
2871  void (*f)();
2872  f= (Void_Func)dynl_sym(hh,"TestDll");
2873  if (f!=NULL) f();
2874  else PrintS("cannot find TestDll\n");
2875  }
2876  return FALSE;
2877  }
2878  else
2879  #endif
2880  #endif
2881  #ifdef HAVE_RING2TOM
2882  /*==================== ring-GB ==================================*/
2883  if (strcmp(sys_cmd, "findZeroPoly")==0)
2884  {
2885  ring r = currRing;
2886  poly f = (poly) h->Data();
2887  res->rtyp=POLY_CMD;
2888  res->data=(poly) kFindZeroPoly(f, r, r);
2889  return(FALSE);
2890  }
2891  else
2892  /*==================== Creating zero polynomials =================*/
2893  #ifdef HAVE_VANIDEAL
2894  if (strcmp(sys_cmd, "createG0")==0)
2895  {
2896  /* long exp[50];
2897  int N = 0;
2898  while (h != NULL)
2899  {
2900  N += 1;
2901  exp[N] = (long) h->Data();
2902  // if (exp[i] % 2 != 0) exp[i] -= 1;
2903  h = h->next;
2904  }
2905  for (int k = 1; N + k <= currRing->N; k++) exp[k] = 0;
2906 
2907  poly t_p;
2908  res->rtyp=POLY_CMD;
2909  res->data= (poly) kCreateZeroPoly(exp, -1, &t_p, currRing, currRing);
2910  return(FALSE); */
2911 
2912  res->rtyp = IDEAL_CMD;
2913  res->data = (ideal) createG0();
2914  return(FALSE);
2915  }
2916  else
2917  #endif
2918  /*==================== redNF_ring =================*/
2919  if (strcmp(sys_cmd, "redNF_ring")==0)
2920  {
2921  ring r = currRing;
2922  poly f = (poly) h->Data();
2923  h = h->next;
2924  ideal G = (ideal) h->Data();
2925  res->rtyp=POLY_CMD;
2926  res->data=(poly) ringRedNF(f, G, r);
2927  return(FALSE);
2928  }
2929  else
2930  #endif
2931  /*==================== Roune Hilb =================*/
2932  if (strcmp(sys_cmd, "hilbroune") == 0)
2933  {
2934  if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
2935  {
2936  slicehilb((ideal)h->Data());
2937  }
2938  else return TRUE;
2939  return FALSE;
2940  }
2941  else
2942  /*==================== F5 Implementation =================*/
2943  #ifdef HAVE_F5
2944  if (strcmp(sys_cmd, "f5")==0)
2945  {
2946  if (h->Typ()!=IDEAL_CMD)
2947  {
2948  WerrorS("ideal expected");
2949  return TRUE;
2950  }
2951 
2952  ring r = currRing;
2953  ideal G = (ideal) h->Data();
2954  h = h->next;
2955  int opt;
2956  if(h != NULL) {
2957  opt = (int) (long) h->Data();
2958  }
2959  else {
2960  opt = 2;
2961  }
2962  h = h->next;
2963  int plus;
2964  if(h != NULL) {
2965  plus = (int) (long) h->Data();
2966  }
2967  else {
2968  plus = 0;
2969  }
2970  h = h->next;
2971  int termination;
2972  if(h != NULL) {
2973  termination = (int) (long) h->Data();
2974  }
2975  else {
2976  termination = 0;
2977  }
2978  res->rtyp=IDEAL_CMD;
2979  res->data=(ideal) F5main(G,r,opt,plus,termination);
2980  return FALSE;
2981  }
2982  else
2983  #endif
2984  /*==================== Testing groebner basis =================*/
2985  #ifdef HAVE_RINGS
2986  if (strcmp(sys_cmd, "NF_ring")==0)
2987  {
2988  ring r = currRing;
2989  poly f = (poly) h->Data();
2990  h = h->next;
2991  ideal G = (ideal) h->Data();
2992  res->rtyp=POLY_CMD;
2993  res->data=(poly) ringNF(f, G, r);
2994  return(FALSE);
2995  }
2996  else
2997  if (strcmp(sys_cmd, "spoly")==0)
2998  {
2999  poly f = pCopy((poly) h->Data());
3000  h = h->next;
3001  poly g = pCopy((poly) h->Data());
3002 
3003  res->rtyp=POLY_CMD;
3004  res->data=(poly) plain_spoly(f,g);
3005  return(FALSE);
3006  }
3007  else
3008  if (strcmp(sys_cmd, "testGB")==0)
3009  {
3010  ideal I = (ideal) h->Data();
3011  h = h->next;
3012  ideal GI = (ideal) h->Data();
3013  res->rtyp = INT_CMD;
3014  res->data = (void *)(long) testGB(I, GI);
3015  return(FALSE);
3016  }
3017  else
3018  #endif
3019  /*==================== sca:AltVar ==================================*/
3020  #ifdef HAVE_PLURAL
3021  if ( (strcmp(sys_cmd, "AltVarStart") == 0) || (strcmp(sys_cmd, "AltVarEnd") == 0) )
3022  {
3023  ring r = currRing;
3024 
3025  if((h!=NULL) && (h->Typ()==RING_CMD)) r = (ring)h->Data(); else
3026  {
3027  WerrorS("`system(\"AltVarStart/End\"[,<ring>])` expected");
3028  return TRUE;
3029  }
3030 
3031  res->rtyp=INT_CMD;
3032 
3033  if (rIsSCA(r))
3034  {
3035  if(strcmp(sys_cmd, "AltVarStart") == 0)
3036  res->data = (void*)(long)scaFirstAltVar(r);
3037  else
3038  res->data = (void*)(long)scaLastAltVar(r);
3039  return FALSE;
3040  }
3041 
3042  WerrorS("`system(\"AltVarStart/End\",<ring>) requires a SCA ring");
3043  return TRUE;
3044  }
3045  else
3046  #endif
3047  /*==================== RatNF, noncomm rational coeffs =================*/
3048  #ifdef HAVE_RATGRING
3049  if (strcmp(sys_cmd, "intratNF") == 0)
3050  {
3051  poly p;
3052  poly *q;
3053  ideal I;
3054  int is, k, id;
3055  if ((h!=NULL) && (h->Typ()==POLY_CMD))
3056  {
3057  p=(poly)h->CopyD();
3058  h=h->next;
3059  // PrintS("poly is done\n");
3060  }
3061  else return TRUE;
3062  if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
3063  {
3064  I=(ideal)h->CopyD();
3065  q = I->m;
3066  h=h->next;
3067  // PrintS("ideal is done\n");
3068  }
3069  else return TRUE;
3070  if ((h!=NULL) && (h->Typ()==INT_CMD))
3071  {
3072  is=(int)((long)(h->Data()));
3073  // res->rtyp=INT_CMD;
3074  // PrintS("int is done\n");
3075  // res->rtyp=IDEAL_CMD;
3076  if (rIsPluralRing(currRing))
3077  {
3078  id = IDELEMS(I);
3079  int *pl=(int*)omAlloc0(IDELEMS(I)*sizeof(int));
3080  for(k=0; k < id; k++)
3081  {
3082  pl[k] = pLength(I->m[k]);
3083  }
3084  PrintS("starting redRat\n");
3085  //res->data = (char *)
3086  redRat(&p, q, pl, (int)IDELEMS(I),is,currRing);
3087  res->data=p;
3088  res->rtyp=POLY_CMD;
3089  // res->data = ncGCD(p,q,currRing);
3090  }
3091  else
3092  {
3093  res->rtyp=POLY_CMD;
3094  res->data=p;
3095  }
3096  }
3097  else return TRUE;
3098  return FALSE;
3099  }
3100  else
3101  /*==================== RatNF, noncomm rational coeffs =================*/
3102  if (strcmp(sys_cmd, "ratNF") == 0)
3103  {
3104  poly p,q;
3105  int is, htype;
3106  if ((h!=NULL) && ( (h->Typ()==POLY_CMD) || (h->Typ()==VECTOR_CMD) ) )
3107  {
3108  p=(poly)h->CopyD();
3109  h=h->next;
3110  htype = h->Typ();
3111  }
3112  else return TRUE;
3113  if ((h!=NULL) && ( (h->Typ()==POLY_CMD) || (h->Typ()==VECTOR_CMD) ) )
3114  {
3115  q=(poly)h->CopyD();
3116  h=h->next;
3117  }
3118  else return TRUE;
3119  if ((h!=NULL) && (h->Typ()==INT_CMD))
3120  {
3121  is=(int)((long)(h->Data()));
3122  res->rtyp=htype;
3123  // res->rtyp=IDEAL_CMD;
3124  if (rIsPluralRing(currRing))
3125  {
3126  res->data = nc_rat_ReduceSpolyNew(q,p,is, currRing);
3127  // res->data = ncGCD(p,q,currRing);
3128  }
3129  else res->data=p;
3130  }
3131  else return TRUE;
3132  return FALSE;
3133  }
3134  else
3135  /*==================== RatSpoly, noncomm rational coeffs =================*/
3136  if (strcmp(sys_cmd, "ratSpoly") == 0)
3137  {
3138  poly p,q;
3139  int is;
3140  if ((h!=NULL) && (h->Typ()==POLY_CMD))
3141  {
3142  p=(poly)h->CopyD();
3143  h=h->next;
3144  }
3145  else return TRUE;
3146  if ((h!=NULL) && (h->Typ()==POLY_CMD))
3147  {
3148  q=(poly)h->CopyD();
3149  h=h->next;
3150  }
3151  else return TRUE;
3152  if ((h!=NULL) && (h->Typ()==INT_CMD))
3153  {
3154  is=(int)((long)(h->Data()));
3155  res->rtyp=POLY_CMD;
3156  // res->rtyp=IDEAL_CMD;
3157  if (rIsPluralRing(currRing))
3158  {
3159  res->data = nc_rat_CreateSpoly(p,q,is,currRing);
3160  // res->data = ncGCD(p,q,currRing);
3161  }
3162  else res->data=p;
3163  }
3164  else return TRUE;
3165  return FALSE;
3166  }
3167  else
3168  #endif // HAVE_RATGRING
3169  /*==================== Rat def =================*/
3170  if (strcmp(sys_cmd, "ratVar") == 0)
3171  {
3172  int start,end;
3173  if ((h!=NULL) && (h->Typ()==POLY_CMD))
3174  {
3175  start=pIsPurePower((poly)h->Data());
3176  h=h->next;
3177  }
3178  else return TRUE;
3179  if ((h!=NULL) && (h->Typ()==POLY_CMD))
3180  {
3181  end=pIsPurePower((poly)h->Data());
3182  h=h->next;
3183  }
3184  else return TRUE;
3185  currRing->real_var_start=start;
3186  currRing->real_var_end=end;
3187  return (start==0)||(end==0)||(start>end);
3188  }
3189  else
3190  /*==================== t-rep-GB ==================================*/
3191  if (strcmp(sys_cmd, "unifastmult")==0)
3192  {
3193  poly f = (poly)h->Data();
3194  h=h->next;
3195  poly g=(poly)h->Data();
3196  res->rtyp=POLY_CMD;
3197  res->data=unifastmult(f,g,currRing);
3198  return(FALSE);
3199  }
3200  else
3201  if (strcmp(sys_cmd, "multifastmult")==0)
3202  {
3203  poly f = (poly)h->Data();
3204  h=h->next;
3205  poly g=(poly)h->Data();
3206  res->rtyp=POLY_CMD;
3207  res->data=multifastmult(f,g,currRing);
3208  return(FALSE);
3209  }
3210  else
3211  if (strcmp(sys_cmd, "mults")==0)
3212  {
3213  res->rtyp=INT_CMD ;
3214  res->data=(void*)(long) Mults();
3215  return(FALSE);
3216  }
3217  else
3218  if (strcmp(sys_cmd, "fastpower")==0)
3219  {
3220  ring r = currRing;
3221  poly f = (poly)h->Data();
3222  h=h->next;
3223  int n=(int)((long)h->Data());
3224  res->rtyp=POLY_CMD ;
3225  res->data=(void*) pFastPower(f,n,r);
3226  return(FALSE);
3227  }
3228  else
3229  if (strcmp(sys_cmd, "normalpower")==0)
3230  {
3231  poly f = (poly)h->Data();
3232  h=h->next;
3233  int n=(int)((long)h->Data());
3234  res->rtyp=POLY_CMD ;
3235  res->data=(void*) pPower(pCopy(f),n);
3236  return(FALSE);
3237  }
3238  else
3239  if (strcmp(sys_cmd, "MCpower")==0)
3240  {
3241  ring r = currRing;
3242  poly f = (poly)h->Data();
3243  h=h->next;
3244  int n=(int)((long)h->Data());
3245  res->rtyp=POLY_CMD ;
3246  res->data=(void*) pFastPowerMC(f,n,r);
3247  return(FALSE);
3248  }
3249  else
3250  if (strcmp(sys_cmd, "bit_subst")==0)
3251  {
3252  ring r = currRing;
3253  poly outer = (poly)h->Data();
3254  h=h->next;
3255  poly inner=(poly)h->Data();
3256  res->rtyp=POLY_CMD ;
3257  res->data=(void*) uni_subst_bits(outer, inner,r);
3258  return(FALSE);
3259  }
3260  else
3261  /*==================== gcd-varianten =================*/
3262  if (strcmp(sys_cmd, "gcd") == 0)
3263  {
3264  if (h==NULL)
3265  {
3266  Print("EZGCD:%d (use EZGCD for gcd of polynomials in char 0)\n",isOn(SW_USE_EZGCD));
3267  Print("EZGCD_P:%d (use EZGCD_P for gcd of polynomials in char p)\n",isOn(SW_USE_EZGCD_P));
3268  Print("CRGCD:%d (use chinese Remainder for gcd of polynomials in char 0)\n",isOn(SW_USE_CHINREM_GCD));
3269  Print("QGCD:%d (use QGCD for gcd of polynomials in alg. ext.)\n",isOn(SW_USE_QGCD));
3270  Print("homog:%d (use homog. test for factorization of polynomials)\n",singular_homog_flag);
3271  return FALSE;
3272  }
3273  else
3274  if ((h!=NULL) && (h->Typ()==STRING_CMD)
3275  && (h->next!=NULL) && (h->next->Typ()==INT_CMD))
3276  {
3277  int d=(int)(long)h->next->Data();
3278  char *s=(char *)h->Data();
3279 #ifdef HAVE_PLURAL
3280  if (strcmp(s,"EZGCD")==0) { if (d) On(SW_USE_EZGCD); else Off(SW_USE_EZGCD); } else
3281  if (strcmp(s,"EZGCD_P")==0) { if (d) On(SW_USE_EZGCD_P); else Off(SW_USE_EZGCD_P); } else
3282  if (strcmp(s,"CRGCD")==0) { if (d) On(SW_USE_CHINREM_GCD); else Off(SW_USE_CHINREM_GCD); } else
3283  if (strcmp(s,"QGCD")==0) { if (d) On(SW_USE_QGCD); else Off(SW_USE_QGCD); } else
3284 #endif
3285  if (strcmp(s,"homog")==0) { if (d) singular_homog_flag=1; else singular_homog_flag=0; } else
3286  return TRUE;
3287  return FALSE;
3288  }
3289  else return TRUE;
3290  }
3291  else
3292  /*==================== subring =================*/
3293  if (strcmp(sys_cmd, "subring") == 0)
3294  {
3295  if (h!=NULL)
3296  {
3297  extern ring rSubring(ring r,leftv v); /* ipshell.cc*/
3298  res->data=(char *)rSubring(currRing,h);
3299  res->rtyp=RING_CMD;
3300  return res->data==NULL;
3301  }
3302  else return TRUE;
3303  }
3304  else
3305  /*==================== HNF =================*/
3306  #ifdef HAVE_NTL
3307  if (strcmp(sys_cmd, "HNF") == 0)
3308  {
3309  if (h!=NULL)
3310  {
3311  res->rtyp=h->Typ();
3312  if (h->Typ()==MATRIX_CMD)
3313  {
3314  res->data=(char *)singntl_HNF((matrix)h->Data(), currRing);
3315  return FALSE;
3316  }
3317  else if (h->Typ()==INTMAT_CMD)
3318  {
3319  res->data=(char *)singntl_HNF((intvec*)h->Data());
3320  return FALSE;
3321  }
3322  else if (h->Typ()==INTMAT_CMD)
3323  {
3324  res->data=(char *)singntl_HNF((intvec*)h->Data());
3325  return FALSE;
3326  }
3327  else
3328  {
3329  WerrorS("expected `system(\"HNF\",<matrix|intmat|bigintmat>)`");
3330  return TRUE;
3331  }
3332  }
3333  else return TRUE;
3334  }
3335  else
3336  /*================= probIrredTest ======================*/
3337  if (strcmp (sys_cmd, "probIrredTest") == 0)
3338  {
3339  if (h!=NULL && (h->Typ()== POLY_CMD) && ((h->next != NULL) && h->next->Typ() == STRING_CMD))
3340  {
3341  CanonicalForm F= convSingPFactoryP((poly)(h->Data()), currRing);
3342  char *s=(char *)h->next->Data();
3343  double error= atof (s);
3344  int irred= probIrredTest (F, error);
3345  res->rtyp= INT_CMD;
3346  res->data= (void*)(long)irred;
3347  return FALSE;
3348  }
3349  else return TRUE;
3350  }
3351  else
3352  #endif
3353  /*==================== mpz_t loader ======================*/
3354  if(strcmp(sys_cmd, "GNUmpLoad")==0)
3355  {
3356  if ((h != NULL) && (h->Typ() == STRING_CMD))
3357  {
3358  char* filename = (char*)h->Data();
3359  FILE* f = fopen(filename, "r");
3360  if (f == NULL)
3361  {
3362  WerrorS( "invalid file name (in paths use '/')");
3363  return FALSE;
3364  }
3365  mpz_t m; mpz_init(m);
3366  mpz_inp_str(m, f, 10);
3367  fclose(f);
3368  number n = n_InitMPZ(m, coeffs_BIGINT);
3369  res->rtyp = BIGINT_CMD;
3370  res->data = (void*)n;
3371  return FALSE;
3372  }
3373  else
3374  {
3375  WerrorS( "expected valid file name as a string");
3376  return TRUE;
3377  }
3378  }
3379  else
3380  /*==================== intvec matching ======================*/
3381  /* Given two non-empty intvecs, the call
3382  'system("intvecMatchingSegments", ivec, jvec);'
3383  computes all occurences of jvec in ivec, i.e., it returns
3384  a list of int indices k such that ivec[k..size(jvec)+k-1] = jvec.
3385  If no such k exists (e.g. when ivec is shorter than jvec), an
3386  intvec with the single entry 0 is being returned. */
3387  if(strcmp(sys_cmd, "intvecMatchingSegments")==0)
3388  {
3389  if ((h != NULL) && (h->Typ() == INTVEC_CMD) &&
3390  (h->next != NULL) && (h->next->Typ() == INTVEC_CMD) &&
3391  (h->next->next == NULL))
3392  {
3393  intvec* ivec = (intvec*)h->Data();
3394  intvec* jvec = (intvec*)h->next->Data();
3395  intvec* r = new intvec(1); (*r)[0] = 0;
3396  int validEntries = 0;
3397  for (int k = 0; k <= ivec->rows() - jvec->rows(); k++)
3398  {
3399  if (memcmp(&(*ivec)[k], &(*jvec)[0],
3400  sizeof(int) * jvec->rows()) == 0)
3401  {
3402  if (validEntries == 0)
3403  (*r)[0] = k + 1;
3404  else
3405  {
3406  r->resize(validEntries + 1);
3407  (*r)[validEntries] = k + 1;
3408  }
3409  validEntries++;
3410  }
3411  }
3412  res->rtyp = INTVEC_CMD;
3413  res->data = (void*)r;
3414  return FALSE;
3415  }
3416  else
3417  {
3418  WerrorS("expected two non-empty intvecs as arguments");
3419  return TRUE;
3420  }
3421  }
3422  else
3423  /* ================== intvecOverlap ======================= */
3424  /* Given two non-empty intvecs, the call
3425  'system("intvecOverlap", ivec, jvec);'
3426  computes the longest intvec kvec such that ivec ends with kvec
3427  and jvec starts with kvec. The length of this overlap is being
3428  returned. If there is no overlap at all, then 0 is being returned. */
3429  if(strcmp(sys_cmd, "intvecOverlap")==0)
3430  {
3431  if ((h != NULL) && (h->Typ() == INTVEC_CMD) &&
3432  (h->next != NULL) && (h->next->Typ() == INTVEC_CMD) &&
3433  (h->next->next == NULL))
3434  {
3435  intvec* ivec = (intvec*)h->Data();
3436  intvec* jvec = (intvec*)h->next->Data();
3437  int ir = ivec->rows(); int jr = jvec->rows();
3438  int r = jr; if (ir < jr) r = ir; /* r = min{ir, jr} */
3439  while ((r >= 1) && (memcmp(&(*ivec)[ir - r], &(*jvec)[0],
3440  sizeof(int) * r) != 0))
3441  r--;
3442  res->rtyp = INT_CMD;
3443  res->data = (void*)(long)r;
3444  return FALSE;
3445  }
3446  else
3447  {
3448  WerrorS("expected two non-empty intvecs as arguments");
3449  return TRUE;
3450  }
3451  }
3452  else
3453  /*==================== Hensel's lemma ======================*/
3454  if(strcmp(sys_cmd, "henselfactors")==0)
3455  {
3456  if ((h != NULL) && (h->Typ() == INT_CMD) &&
3457  (h->next != NULL) && (h->next->Typ() == INT_CMD) &&
3458  (h->next->next != NULL) && (h->next->next->Typ() == POLY_CMD) &&
3459  (h->next->next->next != NULL) &&
3460  (h->next->next->next->Typ() == POLY_CMD) &&
3461  (h->next->next->next->next != NULL) &&
3462  (h->next->next->next->next->Typ() == POLY_CMD) &&
3463  (h->next->next->next->next->next != NULL) &&
3464  (h->next->next->next->next->next->Typ() == INT_CMD) &&
3465  (h->next->next->next->next->next->next == NULL))
3466  {
3467  int xIndex = (int)(long)h->Data();
3468  int yIndex = (int)(long)h->next->Data();
3469  poly hh = (poly)h->next->next->Data();
3470  poly f0 = (poly)h->next->next->next->Data();
3471  poly g0 = (poly)h->next->next->next->next->Data();
3472  int d = (int)(long)h->next->next->next->next->next->Data();
3473  poly f; poly g;
3474  henselFactors(xIndex, yIndex, hh, f0, g0, d, f, g);
3476  L->Init(2);
3477  L->m[0].rtyp = POLY_CMD; L->m[0].data=(void*)f;
3478  L->m[1].rtyp = POLY_CMD; L->m[1].data=(void*)g;
3479  res->rtyp = LIST_CMD;
3480  res->data = (char *)L;
3481  return FALSE;
3482  }
3483  else
3484  {
3485  WerrorS( "expected argument list (int, int, poly, poly, poly, int)");
3486  return TRUE;
3487  }
3488  }
3489  else
3490  /*==================== Approx_Step =================*/
3491  #ifdef HAVE_PLURAL
3492  if (strcmp(sys_cmd, "astep") == 0)
3493  {
3494  ideal I;
3495  if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
3496  {
3497  I=(ideal)h->CopyD();
3498  res->rtyp=IDEAL_CMD;
3499  if (rIsPluralRing(currRing)) res->data=Approx_Step(I);
3500  else res->data=I;
3501  setFlag(res,FLAG_STD);
3502  }
3503  else return TRUE;
3504  return FALSE;
3505  }
3506  else
3507  #endif
3508  /*==================== PrintMat =================*/
3509  #ifdef HAVE_PLURAL
3510  if (strcmp(sys_cmd, "PrintMat") == 0)
3511  {
3512  int a;
3513  int b;
3514  ring r;
3515  int metric;
3516  if (h!=NULL)
3517  {
3518  if (h->Typ()==INT_CMD)
3519  {
3520  a=(int)((long)(h->Data()));
3521  h=h->next;
3522  }
3523  else if (h->Typ()==INT_CMD)
3524  {
3525  b=(int)((long)(h->Data()));
3526  h=h->next;
3527  }
3528  else if (h->Typ()==RING_CMD)
3529  {
3530  r=(ring)h->Data();
3531  h=h->next;
3532  }
3533  else
3534  return TRUE;
3535  }
3536  else
3537  return TRUE;
3538  if ((h!=NULL) && (h->Typ()==INT_CMD))
3539  {
3540  metric=(int)((long)(h->Data()));
3541  }
3542  res->rtyp=MATRIX_CMD;
3543  if (rIsPluralRing(r)) res->data=nc_PrintMat(a,b,r,metric);
3544  else res->data=NULL;
3545  return FALSE;
3546  }
3547  else
3548  #endif
3549 /* ============ NCUseExtensions ======================== */
3550  #ifdef HAVE_PLURAL
3551  if(strcmp(sys_cmd,"NCUseExtensions")==0)
3552  {
3553  if ((h!=NULL) && (h->Typ()==INT_CMD))
3554  res->data=(void *)(long)setNCExtensions( (int)((long)(h->Data())) );
3555  else
3556  res->data=(void *)(long)getNCExtensions();
3557  res->rtyp=INT_CMD;
3558  return FALSE;
3559  }
3560  else
3561  #endif
3562 /* ============ NCGetType ======================== */
3563  #ifdef HAVE_PLURAL
3564  if(strcmp(sys_cmd,"NCGetType")==0)
3565  {
3566  res->rtyp=INT_CMD;
3567  if( rIsPluralRing(currRing) )
3568  res->data=(void *)(long)ncRingType(currRing);
3569  else
3570  res->data=(void *)(-1L);
3571  return FALSE;
3572  }
3573  else
3574  #endif
3575 /* ============ ForceSCA ======================== */
3576  #ifdef HAVE_PLURAL
3577  if(strcmp(sys_cmd,"ForceSCA")==0)
3578  {
3579  if( !rIsPluralRing(currRing) )
3580  return TRUE;
3581  int b, e;
3582  if ((h!=NULL) && (h->Typ()==INT_CMD))
3583  {
3584  b = (int)((long)(h->Data()));
3585  h=h->next;
3586  }
3587  else return TRUE;
3588  if ((h!=NULL) && (h->Typ()==INT_CMD))
3589  {
3590  e = (int)((long)(h->Data()));
3591  }
3592  else return TRUE;
3593  if( !sca_Force(currRing, b, e) )
3594  return TRUE;
3595  return FALSE;
3596  }
3597  else
3598  #endif
3599 /* ============ ForceNewNCMultiplication ======================== */
3600  #ifdef HAVE_PLURAL
3601  if(strcmp(sys_cmd,"ForceNewNCMultiplication")==0)
3602  {
3603  if( !rIsPluralRing(currRing) )
3604  return TRUE;
3605  if( !ncInitSpecialPairMultiplication(currRing) ) // No Plural!
3606  return TRUE;
3607  return FALSE;
3608  }
3609  else
3610  #endif
3611 /* ============ ForceNewOldNCMultiplication ======================== */
3612  #ifdef HAVE_PLURAL
3613  if(strcmp(sys_cmd,"ForceNewOldNCMultiplication")==0)
3614  {
3615  if( !rIsPluralRing(currRing) )
3616  return TRUE;
3617  if( !ncInitSpecialPowersMultiplication(currRing) ) // Enable Formula for Plural (depends on swiches)!
3618  return TRUE;
3619  return FALSE;
3620  }
3621  else
3622  #endif
3623 /*==================== test64 =================*/
3624  #if 0
3625  if(strcmp(sys_cmd,"test64")==0)
3626  {
3627  long l=8;int i;
3628  for(i=1;i<62;i++)
3629  {
3630  l=l<<1;
3631  number n=n_Init(l,coeffs_BIGINT);
3632  Print("%ld= ",l);n_Print(n,coeffs_BIGINT);
3634  n_Delete(&n,coeffs_BIGINT);
3636  PrintS(" F:");
3638  PrintLn();
3639  n_Delete(&n,coeffs_BIGINT);
3640  }
3641  Print("SIZEOF_LONG=%d\n",SIZEOF_LONG);
3642  return FALSE;
3643  }
3644  else
3645  #endif
3646 /*==================== n_SwitchChinRem =================*/
3647  if(strcmp(sys_cmd,"cache_chinrem")==0)
3648  {
3650  Print("caching inverse in chines remainder:%d\n",n_SwitchChinRem);
3651  if ((h!=NULL)&&(h->Typ()==INT_CMD))
3652  n_SwitchChinRem=(int)(long)h->Data();
3653  return FALSE;
3654  }
3655  else
3656 /*==================== LU for bigintmat =================*/
3657 #ifdef SINGULAR_4_2
3658  if(strcmp(sys_cmd,"LU")==0)
3659  {
3660  if ((h!=NULL) && (h->Typ()==CMATRIX_CMD))
3661  {
3662  // get the argument:
3663  bigintmat *b=(bigintmat *)h->Data();
3664  // just for tests: simply transpose
3665  bigintmat *bb=b->transpose();
3666  // return the result:
3667  res->rtyp=CMATRIX_CMD;
3668  res->data=(char*)bb;
3669  return FALSE;
3670  }
3671  else
3672  {
3673  WerrorS("system(\"LU\",<cmatrix>) expected");
3674  return TRUE;
3675  }
3676  }
3677  else
3678 #endif
3679 /*==================== sort =================*/
3680  if(strcmp(sys_cmd,"sort")==0)
3681  {
3682  extern BOOLEAN jjSORTLIST(leftv,leftv);
3683  if (h->Typ()==LIST_CMD)
3684  return jjSORTLIST(res,h);
3685  else
3686  return TRUE;
3687  }
3688  else
3689 /*==================== uniq =================*/
3690  if(strcmp(sys_cmd,"uniq")==0)
3691  {
3692  extern BOOLEAN jjUNIQLIST(leftv, leftv);
3693  if (h->Typ()==LIST_CMD)
3694  return jjUNIQLIST(res,h);
3695  else
3696  return TRUE;
3697  }
3698  else
3699 /*==================== GF(p,n) ==================================*/
3700  if(strcmp(sys_cmd,"GF")==0)
3701  {
3702  const short t[]={3,INT_CMD,INT_CMD,STRING_CMD};
3703  if (iiCheckTypes(h,t,1))
3704  {
3705  int p=(int)(long)h->Data();
3706  int n=(int)(long)h->next->Data();
3707  char *v=(char*)h->next->next->CopyD();
3708  GFInfo param;
3709  param.GFChar = p;
3710  param.GFDegree = n;
3711  param.GFPar_name = v;
3712  coeffs cf= nInitChar(n_GF, &param);
3713  res->rtyp=CRING_CMD;
3714  res->data=cf;
3715  return FALSE;
3716  }
3717  else
3718  return TRUE;
3719  }
3720  else
3721 /*==================== power* ==================================*/
3722  #if 0
3723  if(strcmp(sys_cmd,"power1")==0)
3724  {
3725  res->rtyp=POLY_CMD;
3726  poly f=(poly)h->CopyD();
3727  poly g=pPower(f,2000);
3728  res->data=(void *)g;
3729  return FALSE;
3730  }
3731  else
3732  if(strcmp(sys_cmd,"power2")==0)
3733  {
3734  res->rtyp=POLY_CMD;
3735  poly f=(poly)h->Data();
3736  poly g=pOne();
3737  for(int i=0;i<2000;i++)
3738  g=pMult(g,pCopy(f));
3739  res->data=(void *)g;
3740  return FALSE;
3741  }
3742  if(strcmp(sys_cmd,"power3")==0)
3743  {
3744  res->rtyp=POLY_CMD;
3745  poly f=(poly)h->Data();
3746  poly p2=pMult(pCopy(f),pCopy(f));
3747  poly p4=pMult(pCopy(p2),pCopy(p2));
3748  poly p8=pMult(pCopy(p4),pCopy(p4));
3749  poly p16=pMult(pCopy(p8),pCopy(p8));
3750  poly p32=pMult(pCopy(p16),pCopy(p16));
3751  poly p64=pMult(pCopy(p32),pCopy(p32));
3752  poly p128=pMult(pCopy(p64),pCopy(p64));
3753  poly p256=pMult(pCopy(p128),pCopy(p128));
3754  poly p512=pMult(pCopy(p256),pCopy(p256));
3755  poly p1024=pMult(pCopy(p512),pCopy(p512));
3756  poly p1536=pMult(p1024,p512);
3757  poly p1792=pMult(p1536,p256);
3758  poly p1920=pMult(p1792,p128);
3759  poly p1984=pMult(p1920,p64);
3760  poly p2000=pMult(p1984,p16);
3761  res->data=(void *)p2000;
3762  pDelete(&p2);
3763  pDelete(&p4);
3764  pDelete(&p8);
3765  //pDelete(&p16);
3766  pDelete(&p32);
3767  //pDelete(&p64);
3768  //pDelete(&p128);
3769  //pDelete(&p256);
3770  //pDelete(&p512);
3771  //pDelete(&p1024);
3772  //pDelete(&p1536);
3773  //pDelete(&p1792);
3774  //pDelete(&p1920);
3775  //pDelete(&p1984);
3776  return FALSE;
3777  }
3778  else
3779  #endif
3780 /*==================== Error =================*/
3781  Werror( "(extended) system(\"%s\",...) %s", sys_cmd, feNotImplemented );
3782  }
3783  return TRUE;
3784 }

◆ jjSYSTEM()

BOOLEAN jjSYSTEM ( leftv  res,
leftv  args 
)

Definition at line 231 of file extra.cc.

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

◆ longCoeffsToSingularPoly()

poly longCoeffsToSingularPoly ( unsigned long *  polyCoeffs,
const int  degree 
)

Definition at line 208 of file extra.cc.

209 {
210  poly result = NULL;
211  for (int i = 0; i <= degree; i++)
212  {
213  if ((int)polyCoeffs[i] != 0)
214  {
215  poly term = p_ISet((int)polyCoeffs[i], currRing);
216  if (i > 0)
217  {
218  p_SetExp(term, 1, i, currRing);
219  p_Setm(term, currRing);
220  }
222  }
223  }
224  return result;
225 }

◆ singularMatrixToLongMatrix()

unsigned long** singularMatrixToLongMatrix ( matrix  singularMatrix)

Definition at line 176 of file extra.cc.

177 {
178  int n = singularMatrix->rows();
179  assume(n == singularMatrix->cols());
180  unsigned long **longMatrix = 0;
181  longMatrix = new unsigned long *[n] ;
182  for (int i = 0 ; i < n; i++)
183  longMatrix[i] = new unsigned long [n];
184  number entry;
185  for (int r = 0; r < n; r++)
186  for (int c = 0; c < n; c++)
187  {
188  poly p=MATELEM(singularMatrix, r + 1, c + 1);
189  int entryAsInt;
190  if (p!=NULL)
191  {
192  entry = p_GetCoeff(p, currRing);
193  entryAsInt = n_Int(entry, currRing->cf);
194  if (entryAsInt < 0) entryAsInt += n_GetChar(currRing->cf);
195  }
196  else
197  entryAsInt=0;
198  longMatrix[r][c] = (unsigned long)entryAsInt;
199  }
200  return longMatrix;
201 }
getCoeffType
static FORCE_INLINE n_coeffType getCoeffType(const coeffs r)
Returns the type of coeffs domain.
Definition: coeffs.h:420
dim
int dim(ideal I, ring r)
Definition: tropicalStrategy.cc:22
pDivisibleBy
#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:132
FALSE
#define FALSE
Definition: auxiliary.h:96
kFindZeroPoly
poly kFindZeroPoly(poly input_p, ring leadRing, ring tailRing)
Definition: kstd2.cc:454
ivTest
#define ivTest(v)
Definition: intvec.h:157
jjUNIQLIST
BOOLEAN jjUNIQLIST(leftv, leftv arg)
Definition: iparith.cc:9707
pLmDeleteAndNext
#define pLmDeleteAndNext(p)
like pLmDelete, returns pNext(p)
Definition: polys.h:76
error
void error(const char *fmt,...)
Definition: emacs.cc:54
matrix
ip_smatrix * matrix
Definition: matpol.h:42
ncInitSpecialPairMultiplication
BOOLEAN ncInitSpecialPairMultiplication(ring r)
Definition: ncSAMult.cc:264
sleftv::Data
void * Data()
Definition: subexpr.cc:1175
countedref_shared_load
void countedref_shared_load()
Definition: countedref.cc:724
rField_is_long_R
static BOOLEAN rField_is_long_R(const ring r)
Definition: ring.h:536
GFInfo::GFChar
int GFChar
Definition: coeffs.h:93
twostd
ideal twostd(ideal I)
Compute two-sided GB:
Definition: nc.cc:18
fePrintOptValues
void fePrintOptValues()
Definition: feOpt.cc:316
getenv
char * getenv()
feReInitResources
void feReInitResources()
Definition: feResource.cc:204
p_GetCoeff
#define p_GetCoeff(p, r)
Definition: monomials.h:47
gmp_output_digits
EXTERN_VAR size_t gmp_output_digits
Definition: mpr_base.h:114
TranMImprovwalk
ideal TranMImprovwalk(ideal G, intvec *curr_weight, intvec *target_tmp, int nP)
Definition: walk.cc:8326
multifastmult
poly multifastmult(poly f, poly g, ring r)
Definition: fast_mult.cc:290
ip_smatrix
Definition: matpol.h:13
isOn
bool isOn(int sw)
switches
Definition: canonicalform.cc:1912
Mwalk
ideal Mwalk(ideal Go, intvec *orig_M, intvec *target_M, ring baseRing, int reduction, int printout)
Definition: walk.cc:5239
FLAG_TWOSTD
#define FLAG_TWOSTD
Definition: ipid.h:104
j
int j
Definition: facHensel.cc:105
versionString
char * versionString()
Definition: misc_ip.cc:784
f
FILE * f
Definition: checklibs.c:9
posInT17_c
int posInT17_c(const TSet set, const int length, LObject &p)
Definition: kutil.cc:5837
spectrumfProc
BOOLEAN spectrumfProc(leftv result, leftv first)
Definition: ipshell.cc:4157
omFree
#define omFree(addr)
Definition: omAllocDecl.h:259
k
int k
Definition: cfEzgcd.cc:92
CRING_CMD
Definition: tok.h:55
gmsNF
lists gmsNF(ideal p, ideal g, matrix B, int D, int K)
Definition: gms.cc:21
rDebugPrint
void rDebugPrint(const ring r)
Definition: ring.cc:4044
NUMBER_CMD
Definition: grammar.cc:288
procinfov
procinfo * procinfov
Definition: structs.h:64
MATELEM
#define MATELEM(mat, i, j)
1-based access to matrix
Definition: matpol.h:29
bigintmat
Definition: bigintmat.h:49
fglmNewLinearCombination
poly fglmNewLinearCombination(ideal source, poly monset)
Definition: fglmcomb.cc:153
nc_rat_ReduceSpolyNew
poly nc_rat_ReduceSpolyNew(const poly p1, poly p2, int ishift, const ring r)
Definition: ratgring.cc:465
nc_p_Bracket_qq
poly nc_p_Bracket_qq(poly p, const poly q, const ring r)
returns [p,q], destroys p
Definition: old.gring.cc:2243
result
return result
Definition: facAbsBiFact.cc:76
n_GetChar
static FORCE_INLINE int n_GetChar(const coeffs r)
Return the characteristic of the coeff. domain.
Definition: coeffs.h:443
GFInfo
Creation data needed for finite fields.
Definition: coeffs.h:91
p_DebugPrint
void p_DebugPrint(poly p, const ring r)
Definition: ring.cc:4249
BIGINT_CMD
Definition: tok.h:37
LIST_CMD
Definition: tok.h:117
pGetExp
#define pGetExp(p, i)
Exponent.
Definition: polys.h:40
evRowElim
matrix evRowElim(matrix M, int i, int j, int k)
Definition: eigenval.cc:47
posInT_EcartFDegpLength
int posInT_EcartFDegpLength(const TSet set, const int length, LObject &p)
Definition: kutil.cc:11815
Mivdp
intvec * Mivdp(int nR)
Definition: walk.cc:983
ADDRESS
void * ADDRESS
Definition: auxiliary.h:135
posInT17
int posInT17(const TSet set, const int length, LObject &p)
Definition: kutil.cc:5730
omPrintUsedTrackAddrs
#define omPrintUsedTrackAddrs(F, max)
Definition: xalloc.h:308
MODUL_CMD
Definition: grammar.cc:287
MwalkNextWeight
intvec * MwalkNextWeight(intvec *curr_weight, intvec *target_weight, ideal G)
STRING_CMD
Definition: tok.h:183
feOptIndex
feOptIndex
Definition: feOptGen.h:14
h
STATIC_VAR Poly * h
Definition: janet.cc:971
redRat
int redRat(poly *h, poly *reducer, int *red_length, int rl, int ishift, ring r)
Definition: ratgring.cc:593
MPertVectorslp
intvec * MPertVectorslp(ideal G, intvec *ivtarget, int pdeg)
Definition: walk.cc:1271
ncRingType
static nc_type & ncRingType(nc_struct *p)
Definition: nc.h:159
M3ivSame
int M3ivSame(intvec *temp, intvec *u, intvec *v)
Definition: walk.cc:895
feGetOptIndex
feOptIndex feGetOptIndex(const char *name)
Definition: feOpt.cc:100
NONE
#define NONE
Definition: tok.h:219
irred
CFList int bool & irred
[in,out] Is A irreducible?
Definition: facFactorize.h:31
cf
CanonicalForm cf
Definition: cfModGcd.cc:4024
ppJetW
#define ppJetW(p, m, iv)
Definition: polys.h:353
omError2String
const char * omError2String(omError_t error)
Definition: omError.c:53
IDDATA
#define IDDATA(a)
Definition: ipid.h:120
feOptUntyped
Definition: fegetopt.h:77
pFastPowerMC
poly pFastPowerMC(poly f, int n, ring r)
Definition: fast_mult.cc:588
posInT110
int posInT110(const TSet set, const int length, LObject &p)
Definition: kutil.cc:5478
ip_smatrix::cols
int & cols()
Definition: matpol.h:24
iv2array
short * iv2array(intvec *iv, const ring R)
Definition: weight.cc:199
length
static BOOLEAN length(leftv result, leftv arg)
Definition: interval.cc:263
procinfo
Definition: subexpr.h:52
Mpwalk
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:5884
g
g
Definition: cfModGcd.cc:4031
MivUnit
intvec * MivUnit(int nV)
Definition: walk.cc:1464
omStrDup
#define omStrDup(s)
Definition: omAllocDecl.h:261
spmulProc
BOOLEAN spmulProc(leftv result, leftv first, leftv second)
Definition: ipshell.cc:4443
feSetOptValue
const char * feSetOptValue(feOptIndex opt, char *optarg)
Definition: feOpt.cc:150
n_Delete
static FORCE_INLINE void n_Delete(number *p, const coeffs r)
delete 'p'
Definition: coeffs.h:454
DEF_CMD
Definition: tok.h:57
n_GF
\GF{p^n < 2^16}
Definition: coeffs.h:32
nInitChar
coeffs nInitChar(n_coeffType t, void *parameter)
one-time initialisations for new coeffs in case of an error return NULL
Definition: numbers.cc:349
omAllocBin
#define omAllocBin(bin)
Definition: omAllocDecl.h:203
feStringAppendBrowsers
void feStringAppendBrowsers(int warn)
Definition: fehelp.cc:336
jjSORTLIST
BOOLEAN jjSORTLIST(leftv, leftv arg)
Definition: iparith.cc:9698
BIGINTMAT_CMD
Definition: grammar.cc:278
semicProc3
BOOLEAN semicProc3(leftv res, leftv u, leftv v, leftv w)
Definition: ipshell.cc:4484
sdb_edit
void sdb_edit(procinfo *pi)
Definition: sdb.cc:108
pDelete
#define pDelete(p_ptr)
Definition: polys.h:175
getNCExtensions
int & getNCExtensions()
Definition: old.gring.cc:82
testHomog
Definition: structs.h:42
StringEndS
char * StringEndS()
Definition: reporter.cc:150
pcvBasis
int pcvBasis(lists b, int i, poly m, int d, int n)
Definition: pcv.cc:429
printBlackboxTypes
void printBlackboxTypes()
list all defined type (for debugging)
Definition: blackbox.cc:218
setNCExtensions
int setNCExtensions(int iMask)
Definition: old.gring.cc:87
posInT_FDegpLength
int posInT_FDegpLength(const TSet set, const int length, LObject &p)
Definition: kutil.cc:11869
kNFBound
poly kNFBound(ideal F, ideal Q, poly p, int bound, int syzComp, int lazyReduce)
Definition: kstd1.cc:2878
sleftv
Class used for (list of) interpreter objects.
Definition: subexpr.h:81
pMult
#define pMult(p, q)
Definition: polys.h:195
testGB
int testGB(ideal I, ideal GI)
Definition: ringgb.cc:225
siRandomStart
VAR int siRandomStart
Definition: cntrlc.cc:96
w
const CanonicalForm & w
Definition: facAbsFact.cc:55
pcvMinDeg
int pcvMinDeg(poly p)
Definition: pcv.cc:134
RING_CMD
Definition: grammar.cc:281
b
CanonicalForm b
Definition: cfModGcd.cc:4044
pFastPower
poly pFastPower(poly f, int n, ring r)
Definition: fast_mult.cc:342
n_InitMPZ
static FORCE_INLINE number n_InitMPZ(mpz_t n, const coeffs r)
conversion of a GMP integer to number
Definition: coeffs.h:541
points
STATIC_VAR coordinates * points
Definition: interpolation.cc:96
evSwap
matrix evSwap(matrix M, int i, int j)
Definition: eigenval.cc:25
omPrintCurrentBackTrace
#define omPrintCurrentBackTrace(fd)
Definition: omRet2Info.h:38
pOppose
poly pOppose(ring Rop_src, poly p, const ring Rop_dst)
opposes a vector p from Rop to currRing (dst!)
Definition: old.gring.cc:3368
MATRIX_CMD
Definition: grammar.cc:286
testsvd
lists testsvd(matrix M)
Definition: calcSVD.cc:26
longCoeffsToSingularPoly
poly longCoeffsToSingularPoly(unsigned long *polyCoeffs, const int degree)
Definition: extra.cc:208
CanonicalForm
factory's main class
Definition: canonicalform.h:77
posInT19
int posInT19(const TSet set, const int length, LObject &p)
Definition: kutil.cc:5964
factoryseed
void factoryseed(int s)
random seed initializer
Definition: cf_random.cc:176
term
Definition: int_poly.h:33
p_SetExp
static unsigned long p_SetExp(poly p, const unsigned long e, const unsigned long iBitmask, const int VarOffset)
set a single variable exponent @Note: VarOffset encodes the position in p->exp
Definition: p_polys.h:475
test_PosInL
VAR int(* test_PosInL)(const LSet set, const int length, LObject *L, const kStrategy strat)
Definition: kstd2.cc:81
rIsPluralRing
static BOOLEAN rIsPluralRing(const ring r)
we must always have this test!
Definition: ring.h:396
pLength
static unsigned pLength(poly a)
Definition: p_polys.h:182
HilbertSeries_OrbitData
void HilbertSeries_OrbitData(ideal S, int lV, bool IG_CASE, bool mgrad, bool odp, int trunDegHs)
Definition: hilb.cc:1967
SW_USE_EZGCD
static const int SW_USE_EZGCD
set to 1 to use EZGCD over Z
Definition: cf_defs.h:33
sca_Force
bool sca_Force(ring rGR, int b, int e)
Definition: sca.cc:1159
get_denom_list
lists get_denom_list()
Definition: denom_list.cc:8
MAltwalk2
ideal MAltwalk2(ideal Go, intvec *curr_weight, intvec *target_weight)
Definition: walk.cc:4221
om_InternalErrorStatus
omError_t om_InternalErrorStatus
Definition: omError.c:13
omError2Serror
const char * omError2Serror(omError_t error)
Definition: omError.c:64
TRUE
#define TRUE
Definition: auxiliary.h:100
i
int i
Definition: cfEzgcd.cc:125
rChar
int rChar(ring r)
Definition: ring.cc:712
ip_smatrix::rows
int & rows()
Definition: matpol.h:23
res
CanonicalForm res
Definition: facAbsFact.cc:64
INT_CMD
Definition: tok.h:95
countedref_reference_load
void countedref_reference_load()
Initialize blackbox types 'reference' and 'shared', or both.
Definition: countedref.cc:700
Mprwalk
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:6324
Sy_bit
#define Sy_bit(x)
Definition: options.h:30
M
#define M
Definition: sirandom.c:25
n_convFactoryNSingN
number n_convFactoryNSingN(const CanonicalForm n, const coeffs r)
Definition: numbers.cc:621
posInT2
int posInT2(const TSet set, const int length, LObject &p)
Definition: kutil.cc:5295
PrintS
void PrintS(const char *s)
Definition: reporter.cc:283
pcvPMulL
lists pcvPMulL(poly p, lists l1)
Definition: pcv.cc:75
luSolveViaLDUDecomp
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...
Definition: linearAlgebra.cc:1461
omFreeSize
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:258
BOOLEAN
int BOOLEAN
Definition: auxiliary.h:87
Mivperttarget
intvec * Mivperttarget(ideal G, int ndeg)
lduDecomp
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...
Definition: linearAlgebra.cc:1343
n_SwitchChinRem
VAR int n_SwitchChinRem
Definition: longrat.cc:2933
PROC_CMD
Definition: grammar.cc:280
MivSame
int MivSame(intvec *u, intvec *v)
Definition: walk.cc:875
siSeed
VAR int siSeed
Definition: sirandom.c:30
createG0
ideal createG0()
Definition: kutil.cc:4455
om_ErrorStatus
omError_t om_ErrorStatus
Definition: omError.c:12
posInT_pLength
int posInT_pLength(const TSet set, const int length, LObject &p)
Definition: kutil.cc:11906
mp_Transp
matrix mp_Transp(matrix a, const ring R)
Definition: matpol.cc:253
Mfwalk
ideal Mfwalk(ideal G, intvec *ivstart, intvec *ivtarget, int reduction, int printout)
Definition: walk.cc:7963
scaFirstAltVar
static short scaFirstAltVar(ring r)
Definition: sca.h:18
rField_is_Ring
static BOOLEAN rField_is_Ring(const ring r)
Definition: ring.h:478
henselFactors
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,...
Definition: linearAlgebra.cc:1219
omUpdateInfo
#define omUpdateInfo()
Definition: xalloc.h:268
rOpposite
ring rOpposite(ring src)
Definition: ring.cc:5189
IDEAL_CMD
Definition: grammar.cc:284
RightColonOperation
ideal RightColonOperation(ideal S, poly w, int lV)
Definition: hilb.cc:2307
pcvCV2P
poly pcvCV2P(poly cv, int d0, int d1)
Definition: pcv.cc:296
semicProc
BOOLEAN semicProc(leftv res, leftv u, leftv v)
Definition: ipshell.cc:4524
G
STATIC_VAR TreeM * G
Definition: janet.cc:31
GFInfo::GFDegree
int GFDegree
Definition: coeffs.h:94
sm_Flatten
ideal sm_Flatten(ideal a, const ring R)
Definition: matpol.cc:1924
setCharacteristic
void setCharacteristic(int c)
Definition: cf_char.cc:23
max
static int max(int a, int b)
Definition: fast_mult.cc:264
coeffs
pOne
#define pOne()
Definition: polys.h:299
MivMatrixOrderdp
intvec * MivMatrixOrderdp(int nV)
Definition: walk.cc:1387
intvec
Definition: intvec.h:18
blackboxIsCmd
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:201
sleftv::data
void * data
Definition: subexpr.h:87
Mults
int Mults()
Definition: fast_mult.cc:14
pIter
#define pIter(p)
Definition: monomials.h:34
intvec::resize
void resize(int new_length)
Definition: intvec.cc:105
omAlloc
#define omAlloc(size)
Definition: omAllocDecl.h:208
spaddProc
BOOLEAN spaddProc(leftv result, leftv first, leftv second)
Definition: ipshell.cc:4401
singntl_HNF
matrix singntl_HNF(matrix m, const ring s)
Definition: clapsing.cc:1698
F5main
ideal F5main(ideal id, ring r, int opt, int plus, int termination)
Definition: f5gb.cc:1889
SW_USE_CHINREM_GCD
static const int SW_USE_CHINREM_GCD
set to 1 to use modular gcd over Z
Definition: cf_defs.h:39
T
STATIC_VAR jList * T
Definition: janet.cc:30
n_Init
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:537
GFInfo::GFPar_name
const char * GFPar_name
Definition: coeffs.h:95
SINGULAR_VERSION
#define SINGULAR_VERSION
Definition: mod2.h:85
singular_homog_flag
EXTERN_VAR int singular_homog_flag
Definition: cf_algorithm.h:64
VECTOR_CMD
Definition: grammar.cc:292
pp
CanonicalForm pp(const CanonicalForm &)
CanonicalForm pp ( const CanonicalForm & f )
Definition: cf_gcd.cc:248
singularMatrixToLongMatrix
unsigned long ** singularMatrixToLongMatrix(matrix singularMatrix)
Definition: extra.cc:176
slists::m
sleftv * m
Definition: lists.h:45
MivMatrixOrder
intvec * MivMatrixOrder(intvec *iv)
Definition: walk.cc:941
pPower
#define pPower(p, q)
Definition: polys.h:192
rBlocks
static int rBlocks(ring r)
Definition: ring.h:562
uni_subst_bits
poly uni_subst_bits(poly outer_uni, poly inner_multi, ring r)
Definition: digitech.cc:47
omFindExec
char * omFindExec(const char *name, char *exec)
Definition: omFindExec.c:251
MivWeightOrderdp
intvec * MivWeightOrderdp(intvec *ivstart)
Definition: walk.cc:1424
mpNew
matrix mpNew(int r, int c)
create a r x c zero-matrix
Definition: matpol.cc:36
n_convSingNFactoryN
CanonicalForm n_convSingNFactoryN(number n, BOOLEAN setChar, const coeffs r)
Definition: numbers.cc:626
ksOldSpolyRed
KINLINE poly ksOldSpolyRed(poly p1, poly p2, poly spNoether)
Definition: kInline.h:1114
pAdd
#define pAdd(p, q)
Definition: polys.h:191
pDivideM
#define pDivideM(a, b)
Definition: polys.h:278
MwalkInitialForm
ideal MwalkInitialForm(ideal G, intvec *ivw)
Definition: walk.cc:749
posInT13
int posInT13(const TSet set, const int length, LObject &p)
Definition: kutil.cc:5567
n_transExt
used for all transcendental extensions, i.e., the top-most extension in an extension tower is transce...
Definition: coeffs.h:38
IDRING
#define IDRING(a)
Definition: ipid.h:121
n_Print
void n_Print(number &a, const coeffs r)
print a number (BEWARE of string buffers!) mostly for debugging
Definition: numbers.cc:610
Off
void Off(int sw)
switches
Definition: canonicalform.cc:1905
MPertVectors
intvec * MPertVectors(ideal G, intvec *ivtarget, int pdeg)
Definition: walk.cc:1061
plain_spoly
poly plain_spoly(poly f, poly g)
Definition: ringgb.cc:167
sdb_flags
VAR int sdb_flags
Definition: sdb.cc:30
convSingPFactoryP
CanonicalForm convSingPFactoryP(poly p, const ring r)
Definition: clapconv.cc:84
mp_InitI
matrix mp_InitI(int r, int c, int v, const ring R)
make it a v * unit matrix
Definition: matpol.cc:128
nc_rat_CreateSpoly
poly nc_rat_CreateSpoly(poly pp1, poly pp2, int ishift, const ring r)
Definition: ratgring.cc:340
slists
Definition: lists.h:22
INTVEC_CMD
Definition: tok.h:100
ringRedNF
poly ringRedNF(poly f, ideal G, ring r)
Definition: ringgb.cc:116
MAltwalk1
ideal MAltwalk1(ideal Go, int op_deg, int tp_deg, intvec *curr_weight, intvec *target_weight)
Definition: walk.cc:9599
MivMatrixOrderlp
intvec * MivMatrixOrderlp(int nV)
Definition: walk.cc:1372
INTMAT_CMD
Definition: grammar.cc:279
dynl_open
void * dynl_open(char *filename)
Definition: mod_raw.cc:143
nfMinPoly
STATIC_VAR int nfMinPoly[16]
Definition: ffields.cc:548
IMATELEM
#define IMATELEM(M, I, J)
Definition: intvec.h:85
idrec
Definition: idrec.h:33
feResource
static char * feResource(feResourceConfig config, int warn)
Definition: feResource.cc:254
Mivlp
intvec * Mivlp(int nR)
Definition: walk.cc:997
rEnvelope
ring rEnvelope(ring R)
Definition: ring.cc:5519
p_Add_q
static poly p_Add_q(poly p, poly q, const ring r)
Definition: p_polys.h:880
jjEXTENDED_SYSTEM
static BOOLEAN jjEXTENDED_SYSTEM(leftv res, leftv h)
Definition: extra.cc:2270
newstruct_set_proc
BOOLEAN newstruct_set_proc(const char *bbname, const char *func, int args, procinfov pr)
Definition: newstruct.cc:863
complexNearZero
bool complexNearZero(gmp_complex *c, int digits)
Definition: mpr_complex.cc:764
system
void system(sys)
MkInterRedNextWeight
intvec * MkInterRedNextWeight(intvec *iva, intvec *ivb, ideal G)
Definition: walk.cc:2530
ncInitSpecialPowersMultiplication
bool ncInitSpecialPowersMultiplication(ring r)
Definition: ncSAFormula.cc:48
pcvDim
int pcvDim(int d0, int d1)
Definition: pcv.cc:399
probIrredTest
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
StringSetS
void StringSetS(const char *st)
Definition: reporter.cc:127
spectrumProc
BOOLEAN spectrumProc(leftv result, leftv first)
Definition: ipshell.cc:4106
pPrintDivisbleByStat
void pPrintDivisbleByStat()
Definition: pDebug.cc:404
Approx_Step
ideal Approx_Step(ideal L)
Ann: ???
Definition: nc.cc:250
SW_USE_EZGCD_P
static const int SW_USE_EZGCD_P
set to 1 to use EZGCD over F_q
Definition: cf_defs.h:35
bound
static CanonicalForm bound(const CFMatrix &M)
Definition: cf_linsys.cc:460
computeMinimalPolynomial
unsigned long * computeMinimalPolynomial(unsigned long **matrix, unsigned n, unsigned long p)
Definition: minpoly.cc:428
Print
#define Print
Definition: emacs.cc:79
id_Vec2Ideal
ideal id_Vec2Ideal(poly vec, const ring R)
Definition: simpleideals.cc:1207
omMarkAsStaticAddr
void omMarkAsStaticAddr(void *addr)
pcvP2CV
poly pcvP2CV(poly p, int d0, int d1)
Definition: pcv.cc:279
slists_bin
VAR omBin slists_bin
Definition: lists.cc:22
om_Opts
omOpts_t om_Opts
Definition: omOpts.c:12
rSetSyzComp
void rSetSyzComp(int k, const ring r)
Definition: ring.cc:5005
test_PosInT
VAR int(* test_PosInT)(const TSet T, const int tl, LObject &h)
Definition: kstd2.cc:80
Werror
void Werror(const char *fmt,...)
Definition: reporter.cc:188
idXXX
ideal idXXX(ideal h1, int k)
Definition: ideals.cc:876
scaLastAltVar
static short scaLastAltVar(ring r)
Definition: sca.h:25
pIsPurePower
#define pIsPurePower(p)
Definition: polys.h:234
FE_OPT_UNDEF
Definition: feOptGen.h:14
myynest
VAR int myynest
Definition: febase.cc:40
assumeStdFlag
BOOLEAN assumeStdFlag(leftv h)
Definition: subexpr.cc:1551
dynl_sym
void * dynl_sym(void *handle, const char *symbol)
Definition: mod_raw.cc:160
WerrorS
void WerrorS(const char *s)
Definition: feFopen.cc:24
ringorder_s
s?
Definition: ring.h:75
sleftv::Typ
int Typ()
Definition: subexpr.cc:1032
m
int m
Definition: cfEzgcd.cc:121
singntl_LLL
matrix singntl_LLL(matrix m, const ring s)
Definition: clapsing.cc:1796
MATCOLS
#define MATCOLS(i)
Definition: matpol.h:27
TEST_FOR
#define TEST_FOR(A)
WarnS
#define WarnS
Definition: emacs.cc:77
sleftv::rtyp
int rtyp
Definition: subexpr.h:90
assume
#define assume(x)
Definition: mod2.h:384
NULL
#define NULL
Definition: omList.c:11
coeffs_BIGINT
VAR coeffs coeffs_BIGINT
Definition: ipid.cc:49
lists
slists * lists
Definition: mpr_numeric.h:145
posInT1
int posInT1(const TSet set, const int length, LObject &p)
Definition: kutil.cc:5267
MPertNextWeight
intvec * MPertNextWeight(intvec *iva, ideal G, int deg)
simpleipc_cmd
int simpleipc_cmd(char *cmd, int id, int v)
Definition: semaphore.c:167
BIMATELEM
#define BIMATELEM(M, I, J)
Definition: bigintmat.h:132
MAXPATHLEN
#define MAXPATHLEN
Definition: omRet2Info.c:21
fe_option::value
void * value
Definition: fegetopt.h:93
pcvLAddL
lists pcvLAddL(lists l1, lists l2)
Definition: pcv.cc:30
evEigenvals
lists evEigenvals(matrix M)
Definition: eigenval_ip.cc:118
l
int l
Definition: cfEzgcd.cc:93
Mrwalk
ideal Mrwalk(ideal Go, intvec *orig_M, intvec *target_M, int weight_rad, int pert_deg, int reduction, int printout)
Definition: walk.cc:5540
feNotImplemented
const char feNotImplemented[]
Definition: reporter.cc:53
feOptSpec
EXTERN_VAR struct fe_option feOptSpec[]
Definition: feOpt.h:16
n_Int
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:546
R
#define R
Definition: sirandom.c:27
intvec::rows
int rows() const
Definition: intvec.h:96
evHessenberg
matrix evHessenberg(matrix M)
Definition: eigenval.cc:100
HCord
VAR int HCord
Definition: kutil.cc:235
currRingHdl
VAR idhdl currRingHdl
Definition: ipid.cc:58
p_Setm
static void p_Setm(poly p, const ring r)
Definition: p_polys.h:223
Warn
#define Warn
Definition: emacs.cc:76
v
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
nc_PrintMat
matrix nc_PrintMat(int a, int b, ring r, int metric)
returns matrix with the info on noncomm multiplication
Definition: old.gring.cc:2394
slists::Init
INLINE_THIS void Init(int l=0)
p
int p
Definition: cfModGcd.cc:4019
setFlag
#define setFlag(A, F)
Definition: ipid.h:107
MivWeightOrderlp
intvec * MivWeightOrderlp(intvec *ivstart)
Definition: walk.cc:1405
currRing
VAR ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
s
const CanonicalForm int s
Definition: facAbsFact.cc:55
iiCheckTypes
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:6550
Mfpertvector
intvec * Mfpertvector(ideal G, intvec *ivtarget)
Definition: walk.cc:1479
POLY_CMD
Definition: grammar.cc:289
feOptValue
static void * feOptValue(feOptIndex opt)
Definition: feOpt.h:39
pCopy
#define pCopy(p)
return a copy of the poly
Definition: polys.h:174
ringNF
poly ringNF(poly f, ideal G, ring r)
Definition: ringgb.cc:198
IDELEMS
#define IDELEMS(i)
Definition: simpleideals.h:23
SW_USE_QGCD
static const int SW_USE_QGCD
set to 1 to use Encarnacion GCD over Q(a)
Definition: cf_defs.h:41
posInT15
int posInT15(const TSet set, const int length, LObject &p)
Definition: kutil.cc:5635
p_ISet
poly p_ISet(long i, const ring r)
returns the poly representing the integer i
Definition: p_polys.cc:1284
posInT0
int posInT0(const TSet, const int length, LObject &)
Definition: kutil.cc:5256
FLAG_STD
#define FLAG_STD
Definition: ipid.h:103
pHead
#define pHead(p)
returns newly allocated copy of Lm(p), coef is copied, next=NULL, p might be NULL
Definition: polys.h:65
fglmLinearCombination
poly fglmLinearCombination(ideal source, poly monset)
Definition: fglmcomb.cc:415
Mfrwalk
ideal Mfrwalk(ideal G, intvec *ivstart, intvec *ivtarget, int weight_rad, int reduction, int printout)
Definition: walk.cc:8143
fd
int status int fd
Definition: si_signals.h:58
PrintLn
void PrintLn()
Definition: reporter.cc:309
rIsSCA
static bool rIsSCA(const ring r)
Definition: nc.h:190
rField_is_long_C
static BOOLEAN rField_is_long_C(const ring r)
Definition: ring.h:539
MATROWS
#define MATROWS(i)
Definition: matpol.h:26
getBlackboxStuff
blackbox * getBlackboxStuff(const int t)
return the structure to the type given by t
Definition: blackbox.cc:16
LINK_CMD
Definition: tok.h:116
CMATRIX_CMD
Definition: tok.h:45
degree
int degree(const CanonicalForm &f)
Definition: canonicalform.h:309
omAlloc0
#define omAlloc0(size)
Definition: omAllocDecl.h:209
newstructShow
void newstructShow(newstruct_desc d)
Definition: newstruct.cc:843
singclap_absFactorize
ideal singclap_absFactorize(poly f, ideal &mipos, intvec **exps, int &numFactors, const ring r)
Definition: clapsing.cc:1852
On
void On(int sw)
switches
Definition: canonicalform.cc:1898
posInT11
int posInT11(const TSet set, const int length, LObject &p)
Definition: kutil.cc:5325
unifastmult
poly unifastmult(poly f, poly g, ring r)
Definition: fast_mult.cc:272
rSubring
ring rSubring(ring org_ring, sleftv *rv)
Definition: ipshell.cc:5961
si_opt_2
VAR unsigned si_opt_2
Definition: options.c:6
sleftv::next
leftv next
Definition: subexpr.h:85
slicehilb
void slicehilb(ideal I)
Definition: hilb.cc:1130
EXTERN_VAR
#define EXTERN_VAR
Definition: globaldefs.h:6
gmp_complex
gmp_complex numbers based on
Definition: mpr_complex.h:177
BB_LIKE_LIST
#define BB_LIKE_LIST(B)
Definition: blackbox.h:53
singclap_neworder
char * singclap_neworder(ideal I, const ring r)
Definition: clapsing.cc:1545
SMATRIX_CMD
Definition: grammar.cc:291
sm_UnFlatten
ideal sm_UnFlatten(ideal a, int col, const ring R)
Definition: matpol.cc:1944
feOptString
Definition: fegetopt.h:77
id_TensorModuleMult
ideal id_TensorModuleMult(const int m, const ideal M, const ring rRing)
Definition: simpleideals.cc:1789
rComplete
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:3397