ipshell.h File Reference

#include <stdio.h>
#include <kernel/ideals.h>
#include <Singular/lists.h>
#include <Singular/fevoices.h>

Go to the source code of this file.

Data Structures
struct	sValCmd1
struct	sValCmd2
struct	sValCmd3
struct	sValCmdM
struct	sValAssign_sys
struct	sValAssign

Typedefs
typedef BOOLEAN(*	proc1) (leftv, leftv)
typedef char *(*	Proc1) (char *)
typedef BOOLEAN(*	proc2) (leftv, leftv, leftv)
typedef BOOLEAN(*	proc3) (leftv, leftv, leftv, leftv)
typedef BOOLEAN(*	proci) (leftv, leftv, Subexpr)

Functions
BOOLEAN	spectrumProc (leftv, leftv)
BOOLEAN	spectrumfProc (leftv, leftv)
BOOLEAN	spaddProc (leftv, leftv, leftv)
BOOLEAN	spmulProc (leftv, leftv, leftv)
BOOLEAN	semicProc (leftv, leftv, leftv)
BOOLEAN	semicProc3 (leftv, leftv, leftv, leftv)
BOOLEAN	iiAssignCR (leftv, leftv)
BOOLEAN	iiARROW (leftv, char *, char *)
int	IsCmd (const char *n, int &tok)
BOOLEAN	iiPStart (idhdl pn, sleftv *sl)
BOOLEAN	iiEStart (char *example, procinfo *pi)
BOOLEAN	iiAllStart (procinfov pi, char *p, feBufferTypes t, int l)
void	type_cmd (leftv v)
void	test_cmd (int i)
void	list_cmd (int typ, const char *what, const char *prefix, BOOLEAN iterate, BOOLEAN fullname=FALSE)
void	killlocals (int v)
int	exprlist_length (leftv v)
const char *	Tok2Cmdname (int i)
const char *	iiTwoOps (int t)
int	iiOpsTwoChar (const char *s)
int	IsPrime (int i)
BOOLEAN	iiWRITE (leftv res, leftv exprlist)
BOOLEAN	iiExport (leftv v, int toLev)
BOOLEAN	iiExport (leftv v, int toLev, package pack)
BOOLEAN	iiInternalExport (leftv v, int toLev, package pack)
char *	iiGetLibName (procinfov v)
char *	iiGetLibProcBuffer (procinfov pi, int part=1)
char *	iiProcName (char *buf, char &ct, char *&e)
char *	iiProcArgs (char *e, BOOLEAN withParenth)
BOOLEAN	iiLibCmd (char *newlib, BOOLEAN autoexport, BOOLEAN tellerror, BOOLEAN force)
BOOLEAN	jjLOAD (const char *s, BOOLEAN autoexport=FALSE)
	load lib/module given in v More...
BOOLEAN	iiLocateLib (const char *lib, char *where)
leftv	iiMap (map theMap, const char *what)
void	iiMakeResolv (resolvente r, int length, int rlen, char *name, int typ0, intvec **weights=NULL)
BOOLEAN	jjMINRES (leftv res, leftv v)
BOOLEAN	jjBETTI (leftv res, leftv v)
BOOLEAN	jjBETTI2 (leftv res, leftv u, leftv v)
BOOLEAN	jjBETTI2_ID (leftv res, leftv u, leftv v)
BOOLEAN	jjIMPORTFROM (leftv res, leftv u, leftv v)
BOOLEAN	jjLIST_PL (leftv res, leftv v)
BOOLEAN	jjVARIABLES_P (leftv res, leftv u)
BOOLEAN	jjVARIABLES_ID (leftv res, leftv u)
int	iiRegularity (lists L)
leftv	singular_system (sleftv h)
BOOLEAN	jjSYSTEM (leftv res, leftv v)
void	iiDebug ()
BOOLEAN	iiCheckRing (int i)
poly	iiHighCorner (ideal i, int ak)
char *	iiConvName (const char *libname)
BOOLEAN	iiLoadLIB (FILE *fp, const char *libnamebuf, const char *newlib, idhdl pl, BOOLEAN autoexport, BOOLEAN tellerror)
lists	syConvRes (syStrategy syzstr, BOOLEAN toDel=FALSE, int add_row_shift=0)
syStrategy	syForceMin (lists li)
syStrategy	syConvList (lists li, BOOLEAN toDel)
BOOLEAN	syBetti1 (leftv res, leftv u)
BOOLEAN	syBetti2 (leftv res, leftv u, leftv w)
BOOLEAN	iiExprArith1 (leftv res, sleftv *a, int op)
BOOLEAN	iiExprArith2 (leftv res, sleftv *a, int op, sleftv *b, BOOLEAN proccall=FALSE)
BOOLEAN	iiExprArith3 (leftv res, int op, leftv a, leftv b, leftv c)
BOOLEAN	iiExprArithM (leftv res, sleftv *a, int op)
BOOLEAN	iiApply (leftv res, leftv a, int op, leftv proc)
BOOLEAN	iiAssign (leftv left, leftv right, BOOLEAN toplevel=TRUE)
BOOLEAN	iiParameter (leftv p)
BOOLEAN	iiAlias (leftv p)
int	iiTokType (int op)
int	iiDeclCommand (leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring=FALSE, BOOLEAN init_b=TRUE)
BOOLEAN	iiMake_proc (idhdl pn, package pack, sleftv *sl)
char *	showOption ()
BOOLEAN	setOption (leftv res, leftv v)
char *	versionString ()
void	singular_example (char *str)
BOOLEAN	iiTryLoadLib (leftv v, const char *id)
int	iiAddCproc (const char *libname, const char *procname, BOOLEAN pstatic, BOOLEAN(*func)(leftv res, leftv v))
void	iiCheckPack (package &p)
void	checkall ()
void	rSetHdl (idhdl h)
ring	rInit (sleftv *pn, sleftv *rv, sleftv *ord)
idhdl	rDefault (const char *s)
idhdl	rSimpleFindHdl (ring r, idhdl root, idhdl n=NULL)
idhdl	rFindHdl (ring r, idhdl n)
void	rKill (idhdl h)
void	rKill (ring r)
lists	scIndIndset (ideal S, BOOLEAN all, ideal Q)
BOOLEAN	mpKoszul (leftv res, leftv c, leftv b, leftv id)
BOOLEAN	mpJacobi (leftv res, leftv a)
BOOLEAN	jjRESULTANT (leftv res, leftv u, leftv v, leftv w)
BOOLEAN	kQHWeight (leftv res, leftv v)
BOOLEAN	kWeight (leftv res, leftv id)
BOOLEAN	loSimplex (leftv res, leftv args)
	Implementation of the Simplex Algorithm. More...
BOOLEAN	loNewtonP (leftv res, leftv arg1)
	compute Newton Polytopes of input polynomials More...
BOOLEAN	nuMPResMat (leftv res, leftv arg1, leftv arg2)
	returns module representing the multipolynomial resultant matrix Arguments 2: ideal i, int k k=0: use sparse resultant matrix of Gelfand, Kapranov and Zelevinsky k=1: use resultant matrix of Macaulay (k=0 is default) More...
BOOLEAN	nuLagSolve (leftv res, leftv arg1, leftv arg2, leftv arg3)
	find the (complex) roots an univariate polynomial Determines the roots of an univariate polynomial using Laguerres' root-solver. More...
BOOLEAN	nuVanderSys (leftv res, leftv arg1, leftv arg2, leftv arg3)
	COMPUTE: polynomial p with values given by v at points p1,..,pN derived from p; more precisely: consider p as point in K^n and v as N elements in K, let p1,..,pN be the points in K^n obtained by evaluating all monomials of degree 0,1,...,N at p in lexicographical order, then the procedure computes the polynomial f satisfying f(pi) = v[i] RETURN: polynomial f of degree d. More...
BOOLEAN	nuUResSolve (leftv res, leftv args)
	solve a multipolynomial system using the u-resultant Input ideal must be 0-dimensional and (currRing->N) == IDELEMS(ideal). More...
BOOLEAN	jjCHARSERIES (leftv res, leftv u)
void	paPrint (const char *n, package p)
BOOLEAN	iiTestAssume (leftv a, leftv b)
BOOLEAN	iiExprArith1Tab (leftv res, leftv a, int op, struct sValCmd1 *dA1, int at, struct sConvertTypes *dConvertTypes)
	apply an operation 'op' to an argument a return TRUE on failure More...
BOOLEAN	iiExprArith2Tab (leftv res, leftv a, int op, struct sValCmd2 *dA2, int at, struct sConvertTypes *dConvertTypes)
	apply an operation 'op' to arguments a and a->next return TRUE on failure More...
BOOLEAN	iiExprArith3Tab (leftv res, leftv a, int op, struct sValCmd3 *dA3, int at, struct sConvertTypes *dConvertTypes)
	apply an operation 'op' to arguments a, a->next and a->next->next return TRUE on failure More...
BOOLEAN	iiCheckTypes (leftv args, const short *type_list, int report=0)
	check a list of arguemys against a given field of types return TRUE if the types match return FALSE (and, if report) report an error via Werror otherwise More...
BOOLEAN	iiBranchTo (leftv r, leftv args)

Variables
leftv	iiCurrArgs
idhdl	iiCurrProc
int	iiOp
const char *	currid
int	iiRETURNEXPR_len
sleftv	iiRETURNEXPR
ring *	iiLocalRing
const char *	lastreserved
const char *	singular_date
int	myynest
int	printlevel
int	si_echo
BOOLEAN	yyInRingConstruction
struct sValCmd2	dArith2 []
struct sValCmd1	dArith1 []
struct sValCmd3	dArith3 []
struct sValCmdM	dArithM []

---

Data Structure Documentation

struct sValCmd1

Definition at line 66 of file gentable.cc.

Data Fields
short	arg
short	cmd
int	p
proc1	p
short	res
short	valid_for

struct sValCmd2

Definition at line 57 of file gentable.cc.

Data Fields
short	arg1
short	arg2
short	cmd
int	p
proc2	p
short	res
short	valid_for

struct sValCmd3

Definition at line 74 of file gentable.cc.

Data Fields
short	arg1
short	arg2
short	arg3
short	cmd
int	p
proc3	p
short	res
short	valid_for

struct sValCmdM

Definition at line 84 of file gentable.cc.

Data Fields
short	cmd
short	number_of_args
int	p
proc1	p
short	res
short	valid_for

struct sValAssign_sys

Definition at line 92 of file gentable.cc.

Data Fields
short	arg
int	p
proc1	p
short	res

struct sValAssign

Definition at line 99 of file gentable.cc.

Data Fields
short	arg
int	p
proci	p
short	res

Typedef Documentation

typedef BOOLEAN(* proc1) (leftv, leftv)

Definition at line 124 of file ipshell.h.

typedef char*(* Proc1) (char *)

Definition at line 127 of file ipshell.h.

typedef BOOLEAN(* proc2) (leftv, leftv, leftv)

Definition at line 137 of file ipshell.h.

typedef BOOLEAN(* proc3) (leftv, leftv, leftv, leftv)

Definition at line 148 of file ipshell.h.

typedef BOOLEAN(* proci) (leftv, leftv, Subexpr)

Definition at line 177 of file ipshell.h.

Function Documentation

void checkall

(

)

Definition at line 1016 of file misc_ip.cc.

{
      idhdl hh=basePack->idroot;
      while (hh!=NULL)
      {
        omCheckAddr(hh);
        omCheckAddr((ADDRESS)IDID(hh));
        if (RingDependend(IDTYP(hh)))
        {
          Print("%s typ %d in Top (should be in ring)\n",IDID(hh),IDTYP(hh));
        }
        hh=IDNEXT(hh);
      }
      hh=basePack->idroot;
      while (hh!=NULL)
      {
        if (IDTYP(hh)==PACKAGE_CMD)
        {
          idhdl h2=IDPACKAGE(hh)->idroot;
          if (IDPACKAGE(hh)!=basePack)
          {
            while (h2!=NULL)
            {
              omCheckAddr(h2);
              omCheckAddr((ADDRESS)IDID(h2));
              if (RingDependend(IDTYP(h2)))
              {
                Print("%s typ %d in %s (should be in ring)\n",IDID(h2),IDTYP(h2),IDID(hh));
              }
              h2=IDNEXT(h2);
            }
          }
        }
        hh=IDNEXT(hh);
      }
}

int exprlist_length

(

leftv

v

)

Definition at line 549 of file ipshell.cc.

{
  int rc = 0;
  while (v!=NULL)
  {
    switch (v->Typ())
    {
      case INT_CMD:
      case POLY_CMD:
      case VECTOR_CMD:
      case NUMBER_CMD:
        rc++;
        break;
      case INTVEC_CMD:
      case INTMAT_CMD:
        rc += ((intvec *)(v->Data()))->length();
        break;
      case MATRIX_CMD:
      case IDEAL_CMD:
      case MODUL_CMD:
        {
          matrix mm = (matrix)(v->Data());
          rc += mm->rows() * mm->cols();
        }
        break;
      case LIST_CMD:
        rc+=((lists)v->Data())->nr+1;
        break;
      default:
        rc++;
    }
    v = v->next;
  }
  return rc;
}

int iiAddCproc	(	const char *	libname,
		const char *	procname,
		BOOLEAN	pstatic,
		BOOLEAN(*)(leftv res, leftv v)	func
	)

Definition at line 991 of file iplib.cc.

{
  procinfov pi;
  idhdl h;

  #ifndef SING_NDEBUG
  int dummy;
  if (IsCmd(procname,dummy))
  {
    Werror(">>%s< is a reserved name",procname);
    return 0;
  }
  #endif

  h = enterid(procname,0, PROC_CMD, &IDROOT, TRUE);
  if ( h!= NULL )
  {
    pi = IDPROC(h);
    pi->libname = omStrDup(libname);
    pi->procname = omStrDup(procname);
    pi->language = LANG_C;
    pi->ref = 1;
    pi->is_static = pstatic;
    pi->data.o.function = func;
    return(1);
  }
  else
  {
    PrintS("iiAddCproc: failed.\n");
  }
  return(0);
}

BOOLEAN iiAlias

(

leftv

p

)

Definition at line 1320 of file ipshell.cc.

{
  if (iiCurrArgs==NULL)
  {
    Werror("not enough arguments for proc %s",VoiceName());
    p->CleanUp();
    return TRUE;
  }
  leftv h=iiCurrArgs;
  iiCurrArgs=h->next;
  h->next=NULL;
  if (h->rtyp!=IDHDL)
  {
    BOOLEAN res=iiAssign(p,h);
    h->CleanUp();
    omFreeBin((ADDRESS)h, sleftv_bin);
    return res;
  }
  if (h->Typ()!=p->Typ())
  {
    WerrorS("type mismatch");
    return TRUE;
  }
  idhdl pp=(idhdl)p->data;
  switch(pp->typ)
  {
#ifdef SINGULAR_4_1
      case CRING_CMD:
        nKillChar((coeffs)pp);
        break;
#endif
      case INT_CMD:
        break;
      case INTVEC_CMD:
      case INTMAT_CMD:
         delete IDINTVEC(pp);
         break;
      case NUMBER_CMD:
         nDelete(&IDNUMBER(pp));
         break;
      case BIGINT_CMD:
         n_Delete(&IDNUMBER(pp),coeffs_BIGINT);
         break;
      case MAP_CMD:
         {
           map im = IDMAP(pp);
           omFree((ADDRESS)im->preimage);
         }
         // continue as ideal:
      case IDEAL_CMD:
      case MODUL_CMD:
      case MATRIX_CMD:
          idDelete(&IDIDEAL(pp));
         break;
      case PROC_CMD:
      case RESOLUTION_CMD:
      case STRING_CMD:
         omFree((ADDRESS)IDSTRING(pp));
         break;
      case LIST_CMD:
         IDLIST(pp)->Clean();
         break;
      case LINK_CMD:
         omFreeBin(IDLINK(pp),sip_link_bin);
         break;
       // case ring: cannot happen
       default:
         Werror("unknown type %d",p->Typ());
         return TRUE;
  }
  pp->typ=ALIAS_CMD;
  IDDATA(pp)=(char*)h->data;
  h->CleanUp();
  omFreeBin((ADDRESS)h, sleftv_bin);
  return FALSE;
}

BOOLEAN iiAllStart	(	procinfov	pi,
		char *	p,
		feBufferTypes	t,
		int	l
	)

Definition at line 312 of file iplib.cc.

{
  // see below:
  BITSET save1=si_opt_1;
  BITSET save2=si_opt_2;
  newBuffer( omStrDup(p /*pi->data.s.body*/), t /*BT_proc*/,
               pi, l );
  BOOLEAN err=yyparse();
  if (sLastPrinted.rtyp!=0)
  {
    sLastPrinted.CleanUp();
  }
  // the access to optionStruct and verboseStruct do not work
  // on x86_64-Linux for pic-code
  if ((TEST_V_ALLWARN) &&
  (t==BT_proc) &&
  ((save1!=si_opt_1)||(save2!=si_opt_2)) &&
  (pi->libname!=NULL) && (pi->libname[0]!='\0'))
  {
    if ((pi->libname!=NULL) && (pi->libname[0]!='\0'))
      Warn("option changed in proc %s from %s",pi->procname,pi->libname);
    else
      Warn("option changed in proc %s",pi->procname);
    int i;
    for (i=0; optionStruct[i].setval!=0; i++)
    {
      if ((optionStruct[i].setval & si_opt_1)
      && (!(optionStruct[i].setval & save1)))
      {
          Print(" +%s",optionStruct[i].name);
      }
      if (!(optionStruct[i].setval & si_opt_1)
      && ((optionStruct[i].setval & save1)))
      {
          Print(" -%s",optionStruct[i].name);
      }
    }
    for (i=0; verboseStruct[i].setval!=0; i++)
    {
      if ((verboseStruct[i].setval & si_opt_2)
      && (!(verboseStruct[i].setval & save2)))
      {
          Print(" +%s",verboseStruct[i].name);
      }
      if (!(verboseStruct[i].setval & si_opt_2)
      && ((verboseStruct[i].setval & save2)))
      {
          Print(" -%s",verboseStruct[i].name);
      }
    }
    PrintLn();
  }
  return err;
}

BOOLEAN iiApply	(	leftv	res,
		leftv	a,
		int	op,
		leftv	proc
	)

Definition at line 6109 of file ipshell.cc.

{
  memset(res,0,sizeof(sleftv));
  res->rtyp=a->Typ();
  switch (res->rtyp /*a->Typ()*/)
  {
    case INTVEC_CMD:
    case INTMAT_CMD:
        return iiApplyINTVEC(res,a,op,proc);
    case BIGINTMAT_CMD:
        return iiApplyBIGINTMAT(res,a,op,proc);
    case IDEAL_CMD:
    case MODUL_CMD:
    case MATRIX_CMD:
        return iiApplyIDEAL(res,a,op,proc);
    case LIST_CMD:
        return iiApplyLIST(res,a,op,proc);
  }
  WerrorS("first argument to `apply` must allow an index");
  return TRUE;
}

BOOLEAN iiARROW	(	leftv	,
		char *	,
		char *
	)

Definition at line 6158 of file ipshell.cc.

{
  char *ss=(char*)omAlloc(strlen(a)+strlen(s)+30); /* max. 27 currently */
  // find end of s:
  int end_s=strlen(s);
  while ((end_s>0) && ((s[end_s]<=' ')||(s[end_s]==';'))) end_s--;
  s[end_s+1]='\0';
  char *name=(char *)omAlloc(strlen(a)+strlen(s)+30);
  sprintf(name,"%s->%s",a,s);
  // find start of last expression
  int start_s=end_s-1;
  while ((start_s>=0) && (s[start_s]!=';')) start_s--;
  if (start_s<0) // ';' not found
  {
    sprintf(ss,"parameter def %s;return(%s);\n",a,s);
  }
  else // s[start_s] is ';'
  {
    s[start_s]='\0';
    sprintf(ss,"parameter def %s;%s;return(%s);\n",a,s,s+start_s+1);
  }
  memset(r,0,sizeof(*r));
  // now produce procinfo for PROC_CMD:
  r->data = (void *)omAlloc0Bin(procinfo_bin);
  ((procinfo *)(r->data))->language=LANG_NONE;
  iiInitSingularProcinfo((procinfo *)r->data,"",name,0,0);
  ((procinfo *)r->data)->data.s.body=ss;
  omFree(name);
  r->rtyp=PROC_CMD;
  //r->rtyp=STRING_CMD;
  //r->data=ss;
  return FALSE;
}

BOOLEAN iiAssign	(	leftv	left,
		leftv	right,
		BOOLEAN	toplevel = TRUE
	)

Definition at line 1659 of file ipassign.cc.

{
  if (errorreported) return TRUE;
  int ll=l->listLength();
  int rl;
  int lt=l->Typ();
  int rt=NONE;
  BOOLEAN b;
  if (l->rtyp==ALIAS_CMD)
  {
    Werror("`%s` is read-only",l->Name());
  }

  if (l->rtyp==IDHDL)
  {
    atKillAll((idhdl)l->data);
    IDFLAG((idhdl)l->data)=0;
    l->attribute=NULL;
    toplevel=FALSE;
  }
  else if (l->attribute!=NULL)
    atKillAll((idhdl)l);
  l->flag=0;
  if (ll==1)
  {
    /* l[..] = ... */
    if(l->e!=NULL)
    {
      BOOLEAN like_lists=0;
      blackbox *bb=NULL;
      int bt;
      if (((bt=l->rtyp)>MAX_TOK)
      || ((l->rtyp==IDHDL) && ((bt=IDTYP((idhdl)l->data))>MAX_TOK)))
      {
        bb=getBlackboxStuff(bt);
        like_lists=BB_LIKE_LIST(bb); // bb like a list
      }
      else if (((l->rtyp==IDHDL) && (IDTYP((idhdl)l->data)==LIST_CMD))
        || (l->rtyp==LIST_CMD))
      {
        like_lists=2; // bb in a list
      }
      if(like_lists)
      {
        if (traceit&TRACE_ASSIGN) PrintS("assign list[..]=...or similar\n");
        if (like_lists==1)
        {
          // check blackbox/newtype type:
          if(bb->blackbox_CheckAssign(bb,l,r)) return TRUE;
        }
        b=jiAssign_list(l,r);
        if((!b) && (like_lists==2))
        {
          //Print("jjA_L_LIST: - 2 \n");
          if((l->rtyp==IDHDL) && (l->data!=NULL))
          {
            ipMoveId((idhdl)l->data);
            l->attribute=IDATTR((idhdl)l->data);
            l->flag=IDFLAG((idhdl)l->data);
          }
        }
        r->CleanUp();
        Subexpr h;
        while (l->e!=NULL)
        {
          h=l->e->next;
          omFreeBin((ADDRESS)l->e, sSubexpr_bin);
          l->e=h;
        }
        return b;
      }
    }
    if (lt>MAX_TOK)
    {
      blackbox *bb=getBlackboxStuff(lt);
#ifdef BLACKBOX_DEVEL
      Print("bb-assign: bb=%lx\n",bb);
#endif
      return (bb==NULL) || bb->blackbox_Assign(l,r);
    }
    // end of handling elems of list and similar
    rl=r->listLength();
    if (rl==1)
    {
      /* system variables = ... */
      if(((l->rtyp>=VECHO)&&(l->rtyp<=VPRINTLEVEL))
      ||((l->rtyp>=VALTVARS)&&(l->rtyp<=VMINPOLY)))
      {
        b=iiAssign_sys(l,r);
        r->CleanUp();
        //l->CleanUp();
        return b;
      }
      rt=r->Typ();
      /* a = ... */
      if ((lt!=MATRIX_CMD)
      &&(lt!=BIGINTMAT_CMD)
      &&(lt!=CMATRIX_CMD)
      &&(lt!=INTMAT_CMD)
      &&((lt==rt)||(lt!=LIST_CMD)))
      {
        b=jiAssign_1(l,r,toplevel);
        if (l->rtyp==IDHDL)
        {
          if ((lt==DEF_CMD)||(lt==LIST_CMD))
          {
            ipMoveId((idhdl)l->data);
          }
          l->attribute=IDATTR((idhdl)l->data);
          l->flag=IDFLAG((idhdl)l->data);
          l->CleanUp();
        }
        r->CleanUp();
        return b;
      }
      if (((lt!=LIST_CMD)
        &&((rt==MATRIX_CMD)
          ||(rt==BIGINTMAT_CMD)
          ||(rt==CMATRIX_CMD)
          ||(rt==INTMAT_CMD)
          ||(rt==INTVEC_CMD)
          ||(rt==MODUL_CMD)))
      ||((lt==LIST_CMD)
        &&(rt==RESOLUTION_CMD))
      )
      {
        b=jiAssign_1(l,r,toplevel);
        if((l->rtyp==IDHDL)&&(l->data!=NULL))
        {
          if ((lt==DEF_CMD) || (lt==LIST_CMD))
          {
            //Print("ipAssign - 3.0\n");
            ipMoveId((idhdl)l->data);
          }
          l->attribute=IDATTR((idhdl)l->data);
          l->flag=IDFLAG((idhdl)l->data);
        }
        r->CleanUp();
        Subexpr h;
        while (l->e!=NULL)
        {
          h=l->e->next;
          omFreeBin((ADDRESS)l->e, sSubexpr_bin);
          l->e=h;
        }
        return b;
      }
    }
    if (rt==NONE) rt=r->Typ();
  }
  else if (ll==(rl=r->listLength()))
  {
    b=jiAssign_rec(l,r);
    return b;
  }
  else
  {
    if (rt==NONE) rt=r->Typ();
    if (rt==INTVEC_CMD)
      return jiA_INTVEC_L(l,r);
    else if (rt==VECTOR_CMD)
      return jiA_VECTOR_L(l,r);
    else if ((rt==IDEAL_CMD)||(rt==MATRIX_CMD))
      return jiA_MATRIX_L(l,r);
    else if ((rt==STRING_CMD)&&(rl==1))
      return jiA_STRING_L(l,r);
    Werror("length of lists in assignment does not match (l:%d,r:%d)",
      ll,rl);
    return TRUE;
  }

  leftv hh=r;
  BOOLEAN nok=FALSE;
  BOOLEAN map_assign=FALSE;
  switch (lt)
  {
    case INTVEC_CMD:
      nok=jjA_L_INTVEC(l,r,new intvec(exprlist_length(r)));
      break;
    case INTMAT_CMD:
    {
      nok=jjA_L_INTVEC(l,r,new intvec(IDINTVEC((idhdl)l->data)));
      break;
    }
    case BIGINTMAT_CMD:
    {
      nok=jjA_L_BIGINTMAT(l, r, new bigintmat(IDBIMAT((idhdl)l->data)));
      break;
    }
    case MAP_CMD:
    {
      // first element in the list sl (r) must be a ring
      if (((rt == RING_CMD)||(rt == QRING_CMD))&&(r->e==NULL))
      {
        omFree((ADDRESS)IDMAP((idhdl)l->data)->preimage);
        IDMAP((idhdl)l->data)->preimage = omStrDup (r->Fullname());
        /* advance the expressionlist to get the next element after the ring */
        hh = r->next;
        //r=hh;
      }
      else
      {
        WerrorS("expected ring-name");
        nok=TRUE;
        break;
      }
      if (hh==NULL) /* map-assign: map f=r; */
      {
        WerrorS("expected image ideal");
        nok=TRUE;
        break;
      }
      if ((hh->next==NULL)&&(hh->Typ()==IDEAL_CMD))
        return jiAssign_1(l,hh,toplevel); /* map-assign: map f=r,i; */
      //no break, handle the rest like an ideal:
      map_assign=TRUE;
    }
    case MATRIX_CMD:
    case IDEAL_CMD:
    case MODUL_CMD:
    {
      sleftv t;
      matrix olm = (matrix)l->Data();
      int rk=olm->rank;
      char *pr=((map)olm)->preimage;
      BOOLEAN module_assign=(/*l->Typ()*/ lt==MODUL_CMD);
      matrix lm ;
      int  num;
      int j,k;
      int i=0;
      int mtyp=MATRIX_CMD; /*Type of left side object*/
      int etyp=POLY_CMD;   /*Type of elements of left side object*/

      if (lt /*l->Typ()*/==MATRIX_CMD)
      {
        num=olm->cols()*olm->rows();
        lm=mpNew(olm->rows(),olm->cols());
        int el;
        if ((traceit&TRACE_ASSIGN) && (num!=(el=exprlist_length(hh))))
        {
          Warn("expression list length(%d) does not match matrix size(%d)",el,num);
        }
      }
      else /* IDEAL_CMD or MODUL_CMD */
      {
        num=exprlist_length(hh);
        lm=(matrix)idInit(num,1);
        rk=1;
        if (module_assign)
        {
          mtyp=MODUL_CMD;
          etyp=VECTOR_CMD;
        }
      }

      int ht;
      loop
      {
        if (hh==NULL)
          break;
        else
        {
          matrix rm;
          ht=hh->Typ();
          if ((j=iiTestConvert(ht,etyp))!=0)
          {
            nok=iiConvert(ht,etyp,j,hh,&t);
            hh->next=t.next;
            if (nok) break;
            lm->m[i]=(poly)t.CopyD(etyp);
            pNormalize(lm->m[i]);
            if (module_assign) rk=si_max(rk,(int)pMaxComp(lm->m[i]));
            i++;
          }
          else
          if ((j=iiTestConvert(ht,mtyp))!=0)
          {
            nok=iiConvert(ht,mtyp,j,hh,&t);
            hh->next=t.next;
            if (nok) break;
            rm = (matrix)t.CopyD(mtyp);
            if (module_assign)
            {
              j = si_min(num,rm->cols());
              rk=si_max(rk,(int)rm->rank);
            }
            else
              j = si_min(num-i,rm->rows() * rm->cols());
            for(k=0;k<j;k++,i++)
            {
              lm->m[i]=rm->m[k];
              pNormalize(lm->m[i]);
              rm->m[k]=NULL;
            }
            idDelete((ideal *)&rm);
          }
          else
          {
            nok=TRUE;
            break;
          }
          t.next=NULL;t.CleanUp();
          if (i==num) break;
          hh=hh->next;
        }
      }
      if (nok)
        idDelete((ideal *)&lm);
      else
      {
        idDelete((ideal *)&olm);
        if (module_assign)   lm->rank=rk;
        else if (map_assign) ((map)lm)->preimage=pr;
        l=l->LData();
        if (l->rtyp==IDHDL)
          IDMATRIX((idhdl)l->data)=lm;
        else
          l->data=(char *)lm;
      }
      break;
    }
    case STRING_CMD:
      nok=jjA_L_STRING(l,r);
      break;
    //case DEF_CMD:
    case LIST_CMD:
      nok=jjA_L_LIST(l,r);
      break;
    case NONE:
    case 0:
      Werror("cannot assign to %s",l->Fullname());
      nok=TRUE;
      break;
    default:
      WerrorS("assign not impl.");
      nok=TRUE;
      break;
  } /* end switch: typ */
  if (nok && (!errorreported)) WerrorS("incompatible type in list assignment");
  r->CleanUp();
  return nok;
}

BOOLEAN iiAssignCR	(	leftv	,
		leftv
	)

Definition at line 6192 of file ipshell.cc.

{
  int t=arg->Typ();
  char* ring_name=(char*)r->Name();
  ring_name=omStrDup(ring_name);
  if ((t==RING_CMD) ||(t==QRING_CMD))
  {
    sleftv tmp;
    memset(&tmp,0,sizeof(tmp));
    tmp.rtyp=IDHDL;
    tmp.data=(char*)rDefault(ring_name);
    if (tmp.data!=NULL)
    {
      BOOLEAN b=iiAssign(&tmp,arg);
      if (b) return TRUE;
      rSetHdl(ggetid(ring_name));
      omFree(ring_name);
      return FALSE;
    }
    else
      return TRUE;
  }
  else if (t==CRING_CMD)
  {
    sleftv tmp;
    sleftv n;
    memset(&n,0,sizeof(n));
    n.name=ring_name;
    if (iiDeclCommand(&tmp,&n,myynest,CRING_CMD,&IDROOT)) return TRUE;
    if (iiAssign(&tmp,arg)) return TRUE;
    //Print("create %s\n",r->Name());
    //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
    return FALSE;
  }
  return TRUE;// not handled -> error for now
}

BOOLEAN iiBranchTo	(	leftv	r,
		leftv	args
	)

Definition at line 1215 of file ipshell.cc.

{
  // <string1...stringN>,<proc>
  // known: args!=NULL, l>=1
  int l=args->listLength();
  int ll=0;
  if (iiCurrArgs!=NULL) ll=iiCurrArgs->listLength();
  if (ll!=(l-1)) return FALSE;
  leftv h=args;
  short *t=(short*)omAlloc(l*sizeof(short));
  t[0]=l-1;
  int b;
  int i;
  for(i=1;i<l;i++,h=h->next)
  {
    if (h->Typ()!=STRING_CMD)
    {
      omFree(t);
      Werror("arg %d is not a string",i);
      return TRUE;
    }
    int tt;
    b=IsCmd((char *)h->Data(),tt);
    if(b) t[i]=tt;
    else
    {
      omFree(t);
      Werror("arg %d is not a type name",i);
      return TRUE;
    }
  }
  if (h->Typ()!=PROC_CMD)
  {
    omFree(t);
    Werror("last arg (%d) is not a proc",i);
    return TRUE;
  }
  b=iiCheckTypes(iiCurrArgs,t,0);
  omFree(t);
  if (b && (h->rtyp==IDHDL) && (h->e==NULL))
  {
    BOOLEAN err;
    //Print("branchTo: %s\n",h->Name());
    iiCurrProc=(idhdl)h->data;
    procinfo * pi=IDPROC(iiCurrProc);
    if( pi->data.s.body==NULL )
    {
      iiGetLibProcBuffer(pi);
      if (pi->data.s.body==NULL) return TRUE;
    }
    if ((pi->pack!=NULL)&&(currPack!=pi->pack))
    {
      currPack=pi->pack;
      iiCheckPack(currPack);
      currPackHdl=packFindHdl(currPack);
      //Print("set pack=%s\n",IDID(currPackHdl));
    }
    err=iiAllStart(pi,pi->data.s.body,BT_proc,pi->data.s.body_lineno-(iiCurrArgs==NULL));
    exitBuffer(BT_proc);
    if (iiCurrArgs!=NULL)
    {
      if (!err) Warn("too many arguments for %s",IDID(iiCurrProc));
      iiCurrArgs->CleanUp();
      omFreeBin((ADDRESS)iiCurrArgs, sleftv_bin);
      iiCurrArgs=NULL;
    }
    return 2-err;
  }
  return FALSE;
}

void iiCheckPack

(

package &

p

)

Definition at line 1629 of file ipshell.cc.

{
  if (p==basePack) return;

  idhdl t=basePack->idroot;

  while ((t!=NULL) && (IDTYP(t)!=PACKAGE_CMD) && (IDPACKAGE(t)!=p)) t=t->next;

  if (t==NULL)
  {
    WarnS("package not found\n");
    p=basePack;
  }
  return;
}

BOOLEAN iiCheckRing

(

int

i

)

Definition at line 1585 of file ipshell.cc.

{
  if (currRing==NULL)
  {
    #ifdef SIQ
    if (siq<=0)
    {
    #endif
      if (RingDependend(i))
      {
        WerrorS("no ring active");
        return TRUE;
      }
    #ifdef SIQ
    }
    #endif
  }
  return FALSE;
}

BOOLEAN iiCheckTypes	(	leftv	args,
		const short *	type_list,
		int	report = 0
	)

check a list of arguemys against a given field of types return TRUE if the types match return FALSE (and, if report) report an error via Werror otherwise

Parameters

type_list	< [in] argument list (may be NULL) [in] field of types len, t1,t2,...
report	;in] report error?

Definition at line 6247 of file ipshell.cc.

{
  if (args==NULL)
  {
    if (type_list[0]==0) return TRUE;
    else
    {
      if (report) WerrorS("no arguments expected");
      return FALSE;
    }
  }
  int l=args->listLength();
  if (l!=(int)type_list[0])
  {
    if (report) iiReportTypes(0,l,type_list);
    return FALSE;
  }
  for(int i=1;i<=l;i++,args=args->next)
  {
    short t=type_list[i];
    if (t!=ANY_TYPE)
    {
      if (((t==IDHDL)&&(args->rtyp!=IDHDL))
      || (t!=args->Typ()))
      {
        if (report) iiReportTypes(i,args->Typ(),type_list);
        return FALSE;
      }
    }
  }
  return TRUE;
}

char* iiConvName

(

const char *

libname

)

Definition at line 1262 of file iplib.cc.

{
  char *tmpname = omStrDup(libname);
  char *p = strrchr(tmpname, DIR_SEP);
  char *r;
  if(p==NULL) p = tmpname;
  else p++;
  r = (char *)strchr(p, '.');
  if( r!= NULL) *r = '\0';
  r = omStrDup(p);
  *r = mytoupper(*r);
  // printf("iiConvName: '%s' '%s' => '%s'\n", libname, tmpname, r);
  omFree((ADDRESS)tmpname);

  return(r);
}

void iiDebug

(

)

Definition at line 1025 of file ipshell.cc.

{
  Print("\n-- break point in %s --\n",VoiceName());
  if (iiDebugMarker) VoiceBackTrack();
  char * s;
  iiDebugMarker=FALSE;
  s = (char *)omAlloc(BREAK_LINE_LENGTH+4);
  loop
  {
    memset(s,0,80);
    fe_fgets_stdin("",s,BREAK_LINE_LENGTH);
    if (s[BREAK_LINE_LENGTH-1]!='\0')
    {
      Print("line too long, max is %d chars\n",BREAK_LINE_LENGTH);
    }
    else
      break;
  }
  if (*s=='\n')
  {
    iiDebugMarker=TRUE;
  }
#if MDEBUG
  else if(strncmp(s,"cont;",5)==0)
  {
    iiDebugMarker=TRUE;
  }
#endif /* MDEBUG */
  else
  {
    strcat( s, "\n;~\n");
    newBuffer(s,BT_execute);
  }
}

int iiDeclCommand	(	leftv	sy,
		leftv	name,
		int	lev,
		int	t,
		idhdl *	root,
		BOOLEAN	isring = FALSE,
		BOOLEAN	init_b = TRUE
	)

Definition at line 1160 of file ipshell.cc.

{
  BOOLEAN res=FALSE;
  const char *id = name->name;

  memset(sy,0,sizeof(sleftv));
  if ((name->name==NULL)||(isdigit(name->name[0])))
  {
    WerrorS("object to declare is not a name");
    res=TRUE;
  }
  else
  {
    if (TEST_V_ALLWARN
    && (name->rtyp!=0)
    && (name->rtyp!=IDHDL)
    && (currRingHdl!=NULL) && (IDLEV(currRingHdl)==myynest))
    {
      Warn("`%s` is %s in %s:%d:%s",name->name,Tok2Cmdname(name->rtyp),
      currentVoice->filename,yylineno,my_yylinebuf);
    }
    {
      sy->data = (char *)enterid(id,lev,t,root,init_b);
    }
    if (sy->data!=NULL)
    {
      sy->rtyp=IDHDL;
      currid=sy->name=IDID((idhdl)sy->data);
      // name->name=NULL; /* used in enterid */
      //sy->e = NULL;
      if (name->next!=NULL)
      {
        sy->next=(leftv)omAllocBin(sleftv_bin);
        res=iiDeclCommand(sy->next,name->next,lev,t,root, isring);
      }
    }
    else res=TRUE;
  }
  name->CleanUp();
  return res;
}

BOOLEAN iiEStart	(	char *	example,
		procinfo *	pi
	)

Definition at line 655 of file iplib.cc.

{
  BOOLEAN err;
  int old_echo=si_echo;

  iiCheckNest();
  procstack->push(example);
#ifdef USE_IILOCALRING
  iiLocalRing[myynest]=currRing;
#endif
  if (traceit&TRACE_SHOW_PROC)
  {
    if (traceit&TRACE_SHOW_LINENO) printf("\n");
    printf("entering example (level %d)\n",myynest);
  }
  myynest++;

  err=iiAllStart(pi,example,BT_example,(pi != NULL ? pi->data.s.example_lineno: 0));

  killlocals(myynest);
  myynest--;
  si_echo=old_echo;
  if (traceit&TRACE_SHOW_PROC)
  {
    if (traceit&TRACE_SHOW_LINENO) printf("\n");
    printf("leaving  -example- (level %d)\n",myynest);
  }
#ifdef USE_IILOCALRING
  if (iiLocalRing[myynest] != currRing)
  {
    if (iiLocalRing[myynest]!=NULL)
    {
      rSetHdl(rFindHdl(iiLocalRing[myynest],NULL));
      iiLocalRing[myynest]=NULL;
    }
    else
    {
      currRingHdl=NULL;
      currRing=NULL;
    }
  }
#else /* USE_IILOCALRING */
#endif /* USE_IILOCALRING */
  if (NS_LRING != currRing)
  {
    if (NS_LRING!=NULL)
    {
      idhdl rh=procstack->cRingHdl;
      if ((rh==NULL)||(IDRING(rh)!=NS_LRING))
        rh=rFindHdl(NS_LRING,NULL);
      rSetHdl(rh);
    }
    else
    {
      currRingHdl=NULL;
      currRing=NULL;
    }
  }
//#endif /* USE_IILOCALRING */
  procstack->pop();
  return err;
}

BOOLEAN iiExport	(	leftv	v,
		int	toLev
	)

Definition at line 1505 of file ipshell.cc.

{
  BOOLEAN nok=FALSE;
  leftv r=v;
  while (v!=NULL)
  {
    if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL))
    {
      Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
      nok=TRUE;
    }
    else
    {
      if(iiInternalExport(v, toLev))
      {
        r->CleanUp();
        return TRUE;
      }
    }
    v=v->next;
  }
  r->CleanUp();
  return nok;
}

BOOLEAN iiExport	(	leftv	v,
		int	toLev,
		package	pack
	)

Definition at line 1531 of file ipshell.cc.

{
#ifdef SINGULAR_4_1
  if ((pack==basePack)&&(pack!=currPack))
  { Warn("'exportto' to Top is depreciated in >>%s<<",my_yylinebuf);}
#endif
  BOOLEAN nok=FALSE;
  leftv rv=v;
  while (v!=NULL)
  {
    if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL)
    )
    {
      Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
      nok=TRUE;
    }
    else
    {
      idhdl old=pack->idroot->get( v->name,toLev);
      if (old!=NULL)
      {
        if ((pack==currPack) && (old==(idhdl)v->data))
        {
          if (BVERBOSE(V_REDEFINE)) Warn("`%s` is already global",IDID(old));
          break;
        }
        else if (IDTYP(old)==v->Typ())
        {
          if (BVERBOSE(V_REDEFINE))
          {
            Warn("redefining %s",IDID(old));
          }
          v->name=omStrDup(v->name);
          killhdl2(old,&(pack->idroot),currRing);
        }
        else
        {
          rv->CleanUp();
          return TRUE;
        }
      }
      //Print("iiExport: pack=%s\n",IDID(root));
      if(iiInternalExport(v, toLev, pack))
      {
        rv->CleanUp();
        return TRUE;
      }
    }
    v=v->next;
  }
  rv->CleanUp();
  return nok;
}

BOOLEAN iiExprArith1	(	leftv	res,
		sleftv *	a,
		int	op
	)

BOOLEAN iiExprArith1Tab	(	leftv	res,
		leftv	a,
		int	op,
		struct sValCmd1 *	dA1,
		int	at,
		struct sConvertTypes *	dConvertTypes
	)

apply an operation 'op' to an argument a return TRUE on failure

Parameters

[out]	res	pre-allocated result
[in]	a	argument
[in]	op	operation
[in]	dA1	table of possible proc assumes dArith1[0].cmd==op
[in]	at	a->Typ()
[in]	dConvertTypes	table of type conversions

Definition at line 8161 of file iparith.cc.

{
  memset(res,0,sizeof(sleftv));
  BOOLEAN call_failed=FALSE;

  if (!errorreported)
  {
    BOOLEAN failed=FALSE;
    iiOp=op;
    int i = 0;
    while (dA1[i].cmd==op)
    {
      if (at==dA1[i].arg)
      {
        if (currRing!=NULL)
        {
          if (check_valid(dA1[i].valid_for,op)) break;
        }
        else
        {
          if (RingDependend(dA1[i].res))
          {
            WerrorS("no ring active");
            break;
          }
        }
        if (traceit&TRACE_CALL)
          Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(at));
        res->rtyp=dA1[i].res;
        if ((call_failed=dA1[i].p(res,a)))
        {
          break;// leave loop, goto error handling
        }
        if (a->Next()!=NULL)
        {
          res->next=(leftv)omAllocBin(sleftv_bin);
          failed=iiExprArith1(res->next,a->next,op);
        }
        a->CleanUp();
        return failed;
      }
      i++;
    }
    // implicite type conversion --------------------------------------------
    if (dA1[i].cmd!=op)
    {
      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
      i=0;
      //Print("fuer %c , typ: %s\n",op,Tok2Cmdname(at));
      while (dA1[i].cmd==op)
      {
        int ai;
        //Print("test %s\n",Tok2Cmdname(dA1[i].arg));
        if ((ai=iiTestConvert(at,dA1[i].arg,dConvertTypes))!=0)
        {
          if (currRing!=NULL)
          {
            if (check_valid(dA1[i].valid_for,op)) break;
          }
          else
          {
            if (RingDependend(dA1[i].res))
            {
              WerrorS("no ring active");
              break;
            }
          }
          if (traceit&TRACE_CALL)
            Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(dA1[i].arg));
          res->rtyp=dA1[i].res;
          failed= ((iiConvert(at,dA1[i].arg,ai,a,an,dConvertTypes))
          || (call_failed=dA1[i].p(res,an)));
          // everything done, clean up temp. variables
          if (failed)
          {
            // leave loop, goto error handling
            break;
          }
          else
          {
            if (an->Next() != NULL)
            {
              res->next = (leftv)omAllocBin(sleftv_bin);
              failed=iiExprArith1(res->next,an->next,op);
            }
            // everything ok, clean up and return
            an->CleanUp();
            omFreeBin((ADDRESS)an, sleftv_bin);
            a->CleanUp();
            return failed;
          }
        }
        i++;
      }
      an->CleanUp();
      omFreeBin((ADDRESS)an, sleftv_bin);
    }
    // error handling
    if (!errorreported)
    {
      if ((at==0) && (a->Fullname()!=sNoName))
      {
        Werror("`%s` is not defined",a->Fullname());
      }
      else
      {
        i=0;
        const char *s = iiTwoOps(op);
        Werror("%s(`%s`) failed"
                ,s,Tok2Cmdname(at));
        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
        {
          while (dA1[i].cmd==op)
          {
            if ((dA1[i].res!=0)
            && (dA1[i].p!=jjWRONG))
              Werror("expected %s(`%s`)"
                ,s,Tok2Cmdname(dA1[i].arg));
            i++;
          }
        }
      }
    }
    res->rtyp = UNKNOWN;
  }
  a->CleanUp();
  return TRUE;
}

BOOLEAN iiExprArith2	(	leftv	res,
		sleftv *	a,
		int	op,
		sleftv *	b,
		BOOLEAN	proccall = FALSE
	)

BOOLEAN iiExprArith2Tab	(	leftv	res,
		leftv	a,
		int	op,
		struct sValCmd2 *	dA2,
		int	at,
		struct sConvertTypes *	dConvertTypes
	)

apply an operation 'op' to arguments a and a->next return TRUE on failure

Parameters

[out]	res	pre-allocated result
[in]	a	2 arguments
[in]	op	operation
[in]	dA2	table of possible proc assumes dA2[0].cmd==op
[in]	at	a->Typ()
[in]	dConvertTypes	table of type conversions

Definition at line 8088 of file iparith.cc.

{
  leftv b=a->next;
  a->next=NULL;
  int bt=b->Typ();
  BOOLEAN bo=iiExprArith2TabIntern(res,a,op,b,TRUE,dA2,at,bt,dConvertTypes);
  a->next=b;
  a->CleanUp();
  return bo;
}

BOOLEAN iiExprArith3	(	leftv	res,
		int	op,
		leftv	a,
		leftv	b,
		leftv	c
	)

Definition at line 8491 of file iparith.cc.

{
  memset(res,0,sizeof(sleftv));

  if (!errorreported)
  {
#ifdef SIQ
    if (siq>0)
    {
      //Print("siq:%d\n",siq);
      command d=(command)omAlloc0Bin(sip_command_bin);
      memcpy(&d->arg1,a,sizeof(sleftv));
      //a->Init();
      memcpy(&d->arg2,b,sizeof(sleftv));
      //b->Init();
      memcpy(&d->arg3,c,sizeof(sleftv));
      //c->Init();
      d->op=op;
      d->argc=3;
      res->data=(char *)d;
      res->rtyp=COMMAND;
      return FALSE;
    }
#endif
    int at=a->Typ();
    // handling bb-objects ----------------------------------------------
    if (at>MAX_TOK)
    {
      blackbox *bb=getBlackboxStuff(at);
      if (bb!=NULL)
      {
        if(!bb->blackbox_Op3(op,res,a,b,c)) return FALSE;
        if (errorreported) return TRUE;
        // else: no op defined
      }
      else          return TRUE;
      if (errorreported) return TRUE;
    }
    int bt=b->Typ();
    int ct=c->Typ();

    iiOp=op;
    int i=0;
    while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
    return iiExprArith3TabIntern(res,op,a,b,c,dArith3+i,at,bt,ct,dConvertTypes);
  }
  a->CleanUp();
  b->CleanUp();
  c->CleanUp();
        //Print("op: %d,result typ:%d\n",op,res->rtyp);
  return TRUE;
}

BOOLEAN iiExprArith3Tab	(	leftv	res,
		leftv	a,
		int	op,
		struct sValCmd3 *	dA3,
		int	at,
		struct sConvertTypes *	dConvertTypes
	)

apply an operation 'op' to arguments a, a->next and a->next->next return TRUE on failure

Parameters

[out]	res	pre-allocated result
[in]	a	3 arguments
[in]	op	operation
[in]	dA3	table of possible proc assumes dA3[0].cmd==op
[in]	at	a->Typ()
[in]	dConvertTypes	table of type conversions

Definition at line 8543 of file iparith.cc.

{
  leftv b=a->next;
  a->next=NULL;
  int bt=b->Typ();
  leftv c=b->next;
  b->next=NULL;
  int ct=c->Typ();
  BOOLEAN bo=iiExprArith3TabIntern(res,op,a,b,c,dA3,at,bt,ct,dConvertTypes);
  b->next=c;
  a->next=b;
  a->CleanUp();
  return bo;
}

BOOLEAN iiExprArithM	(	leftv	res,
		sleftv *	a,
		int	op
	)

char* iiGetLibName

(

procinfov

v

)

Definition at line 101 of file iplib.cc.

{
  return pi->libname;
}

char* iiGetLibProcBuffer	(	procinfov	pi,
		int	part = 1
	)

poly iiHighCorner	(	ideal	i,
		int	ak
	)

Definition at line 1605 of file ipshell.cc.

{
  int i;
  if(!idIsZeroDim(I)) return NULL; // not zero-dim.
  poly po=NULL;
  if (rHasLocalOrMixedOrdering_currRing())
  {
    scComputeHC(I,currRing->qideal,ak,po);
    if (po!=NULL)
    {
      pGetCoeff(po)=nInit(1);
      for (i=rVar(currRing); i>0; i--)
      {
        if (pGetExp(po, i) > 0) pDecrExp(po,i);
      }
      pSetComp(po,ak);
      pSetm(po);
    }
  }
  else
    po=pOne();
  return po;
}

BOOLEAN iiInternalExport	(	leftv	v,
		int	toLev,
		package	pack
	)

Definition at line 1459 of file ipshell.cc.

{
  idhdl h=(idhdl)v->data;
  if(h==NULL)
  {
    Warn("'%s': no such identifier\n", v->name);
    return FALSE;
  }
  package frompack=v->req_packhdl;
  if (frompack==NULL) frompack=currPack;
  if ((RingDependend(IDTYP(h)))
  || ((IDTYP(h)==LIST_CMD)
     && (lRingDependend(IDLIST(h)))
     )
  )
  {
    //Print("// ==> Ringdependent set nesting to 0\n");
    return (iiInternalExport(v, toLev));
  }
  else
  {
    IDLEV(h)=toLev;
    v->req_packhdl=rootpack;
    if (h==frompack->idroot)
    {
      frompack->idroot=h->next;
    }
    else
    {
      idhdl hh=frompack->idroot;
      while ((hh!=NULL) && (hh->next!=h))
        hh=hh->next;
      if ((hh!=NULL) && (hh->next==h))
        hh->next=h->next;
      else
      {
        Werror("`%s` not found",v->Name());
        return TRUE;
      }
    }
    h->next=rootpack->idroot;
    rootpack->idroot=h;
  }
  return FALSE;
}

BOOLEAN iiLibCmd	(	char *	newlib,
		BOOLEAN	autoexport,
		BOOLEAN	tellerror,
		BOOLEAN	force
	)

Definition at line 801 of file iplib.cc.

{
  char libnamebuf[128];
  // procinfov pi;
  // idhdl h;
  idhdl pl;
  // idhdl hl;
  // long pos = 0L;
  char *plib = iiConvName(newlib);
  FILE * fp = feFopen( newlib, "r", libnamebuf, tellerror );
  // int lines = 1;
  BOOLEAN LoadResult = TRUE;

  if (fp==NULL)
  {
    return TRUE;
  }
  pl = basePack->idroot->get(plib,0);
  if (pl==NULL)
  {
    pl = enterid( plib,0, PACKAGE_CMD,
                  &(basePack->idroot), TRUE );
    IDPACKAGE(pl)->language = LANG_SINGULAR;
    IDPACKAGE(pl)->libname=omStrDup(newlib);
  }
  else
  {
    if(IDTYP(pl)!=PACKAGE_CMD)
    {
      WarnS("not of type package.");
      fclose(fp);
      return TRUE;
    }
    if (!force) return FALSE;
  }
  LoadResult = iiLoadLIB(fp, libnamebuf, newlib, pl, autoexport, tellerror);
  omFree((ADDRESS)newlib);

  if(!LoadResult) IDPACKAGE(pl)->loaded = TRUE;
  omFree((ADDRESS)plib);

 return LoadResult;
}

BOOLEAN iiLoadLIB	(	FILE *	fp,
		const char *	libnamebuf,
		const char *	newlib,
		idhdl	pl,
		BOOLEAN	autoexport,
		BOOLEAN	tellerror
	)

Definition at line 890 of file iplib.cc.

{
  extern FILE *yylpin;
  libstackv ls_start = library_stack;
  lib_style_types lib_style;

  yylpin = fp;
  #if YYLPDEBUG > 1
  print_init();
  #endif
  extern int lpverbose;
  if (BVERBOSE(V_DEBUG_LIB)) lpverbose=1;
  else lpverbose=0;
  // yylplex sets also text_buffer
  if (text_buffer!=NULL) *text_buffer='\0';
  yylplex(newlib, libnamebuf, &lib_style, pl, autoexport);
  if(yylp_errno)
  {
    Werror("Library %s: ERROR occured: in line %d, %d.", newlib, yylplineno,
         current_pos(0));
    if(yylp_errno==YYLP_BAD_CHAR)
    {
      Werror(yylp_errlist[yylp_errno], *text_buffer, yylplineno);
      omFree((ADDRESS)text_buffer);
      text_buffer=NULL;
    }
    else
      Werror(yylp_errlist[yylp_errno], yylplineno);
    Werror("Cannot load library,... aborting.");
    reinit_yylp();
    fclose( yylpin );
    iiCleanProcs(IDROOT);
    return TRUE;
  }
  if (BVERBOSE(V_LOAD_LIB))
    Print( "// ** loaded %s %s\n", libnamebuf, text_buffer);
  if( (lib_style == OLD_LIBSTYLE) && (BVERBOSE(V_LOAD_LIB)))
  {
    Warn( "library %s has old format. This format is still accepted,", newlib);
    Warn( "but for functionality you may wish to change to the new");
    Warn( "format. Please refer to the manual for further information.");
  }
  reinit_yylp();
  fclose( yylpin );
  fp = NULL;
  iiRunInit(IDPACKAGE(pl));

  {
    libstackv ls;
    for(ls = library_stack; (ls != NULL) && (ls != ls_start); )
    {
      if(ls->to_be_done)
      {
        ls->to_be_done=FALSE;
        iiLibCmd(ls->get(),autoexport,tellerror,FALSE);
        ls = ls->pop(newlib);
      }
    }
#if 0
    PrintS("--------------------\n");
    for(ls = library_stack; ls != NULL; ls = ls->next)
    {
      Print("%s: LIB-stack:(%d), %s %s\n", newlib, ls->cnt, ls->get(),
        ls->to_be_done ? "not loaded" : "loaded");
    }
    PrintS("--------------------\n");
#endif
  }

  if(fp != NULL) fclose(fp);
  return FALSE;
}

BOOLEAN iiLocateLib	(	const char *	lib,
		char *	where
	)

Definition at line 787 of file iplib.cc.

{
  char *plib = iiConvName(lib);
  idhdl pl = basePack->idroot->get(plib,0);
  if( (pl!=NULL) && (IDTYP(pl)==PACKAGE_CMD) &&
    (IDPACKAGE(pl)->language == LANG_SINGULAR))
  {
    strncpy(where,IDPACKAGE(pl)->libname,127);
    return TRUE;
  }
  else
    return FALSE;;
}

BOOLEAN iiMake_proc	(	idhdl	pn,
		package	pack,
		sleftv *	sl
	)

Definition at line 563 of file iplib.cc.

{
  int err;
  procinfov pi = IDPROC(pn);
  if(pi->is_static && myynest==0)
  {
    Werror("'%s::%s()' is a local procedure and cannot be accessed by an user.",
           pi->libname, pi->procname);
    return TRUE;
  }
  iiCheckNest();
#ifdef USE_IILOCALRING
  iiLocalRing[myynest]=currRing;
  //Print("currRing(%d):%s(%x) in %s\n",myynest,IDID(currRingHdl),currRing,IDID(pn));
#endif
  iiRETURNEXPR.Init();
  procstack->push(pi->procname);
  if ((traceit&TRACE_SHOW_PROC)
  || (pi->trace_flag&TRACE_SHOW_PROC))
  {
    if (traceit&TRACE_SHOW_LINENO) PrintLn();
    Print("entering%-*.*s %s (level %d)\n",myynest*2,myynest*2," ",IDID(pn),myynest);
  }
#ifdef RDEBUG
  if (traceit&TRACE_SHOW_RINGS) iiShowLevRings();
#endif
  switch (pi->language)
  {
    default:
    case LANG_NONE:
                 WerrorS("undefined proc");
                 err=TRUE;
                 break;

    case LANG_SINGULAR:
                 if ((pi->pack!=NULL)&&(currPack!=pi->pack))
                 {
                   currPack=pi->pack;
                   iiCheckPack(currPack);
                   currPackHdl=packFindHdl(currPack);
                   //Print("set pack=%s\n",IDID(currPackHdl));
                 }
                 else if ((pack!=NULL)&&(currPack!=pack))
                 {
                   currPack=pack;
                   iiCheckPack(currPack);
                   currPackHdl=packFindHdl(currPack);
                   //Print("set pack=%s\n",IDID(currPackHdl));
                 }
                 err=iiPStart(pn,sl);
                 break;
    case LANG_C:
                 leftv res = (leftv)omAlloc0Bin(sleftv_bin);
                 err = (pi->data.o.function)(res, sl);
                 memcpy(&iiRETURNEXPR,res,sizeof(iiRETURNEXPR));
                 omFreeBin((ADDRESS)res,  sleftv_bin);
                 break;
  }
  if ((traceit&TRACE_SHOW_PROC)
  || (pi->trace_flag&TRACE_SHOW_PROC))
  {
    if (traceit&TRACE_SHOW_LINENO) PrintLn();
    Print("leaving %-*.*s %s (level %d)\n",myynest*2,myynest*2," ",IDID(pn),myynest);
  }
  //const char *n="NULL";
  //if (currRingHdl!=NULL) n=IDID(currRingHdl);
  //Print("currRing(%d):%s(%x) after %s\n",myynest,n,currRing,IDID(pn));
#ifdef RDEBUG
  if (traceit&TRACE_SHOW_RINGS) iiShowLevRings();
#endif
  if (err)
  {
    iiRETURNEXPR.CleanUp();
    //iiRETURNEXPR.Init(); //done by CleanUp
  }
  if (iiCurrArgs!=NULL)
  {
    if (!err) Warn("too many arguments for %s",IDID(pn));
    iiCurrArgs->CleanUp();
    omFreeBin((ADDRESS)iiCurrArgs, sleftv_bin);
    iiCurrArgs=NULL;
  }
  procstack->pop();
  if (err)
    return TRUE;
  return FALSE;
}

void iiMakeResolv	(	resolvente	r,
		int	length,
		int	rlen,
		char *	name,
		int	typ0,
		intvec **	weights = NULL
	)

Definition at line 816 of file ipshell.cc.

{
  lists L=liMakeResolv(r,length,rlen,typ0,weights);
  int i=0;
  idhdl h;
  char * s=(char *)omAlloc(strlen(name)+5);

  while (i<=L->nr)
  {
    sprintf(s,"%s(%d)",name,i+1);
    if (i==0)
      h=enterid(s,myynest,typ0,&(currRing->idroot), FALSE);
    else
      h=enterid(s,myynest,MODUL_CMD,&(currRing->idroot), FALSE);
    if (h!=NULL)
    {
      h->data.uideal=(ideal)L->m[i].data;
      h->attribute=L->m[i].attribute;
      if (BVERBOSE(V_DEF_RES))
        Print("//defining: %s as %d-th syzygy module\n",s,i+1);
    }
    else
    {
      idDelete((ideal *)&(L->m[i].data));
      Warn("cannot define %s",s);
    }
    //L->m[i].data=NULL;
    //L->m[i].rtyp=0;
    //L->m[i].attribute=NULL;
    i++;
  }
  omFreeSize((ADDRESS)L->m,(L->nr+1)*sizeof(sleftv));
  omFreeBin((ADDRESS)L, slists_bin);
  omFreeSize((ADDRESS)s,strlen(name)+5);
}

leftv iiMap	(	map	theMap,
		const char *	what
	)

Definition at line 670 of file ipshell.cc.

{
  idhdl w,r;
  leftv v;
  int i;
  nMapFunc nMap;

  r=IDROOT->get(theMap->preimage,myynest);
  if ((currPack!=basePack)
  &&((r==NULL) || ((r->typ != RING_CMD) && (r->typ != QRING_CMD))))
    r=basePack->idroot->get(theMap->preimage,myynest);
  if ((r==NULL) && (currRingHdl!=NULL)
  && (strcmp(theMap->preimage,IDID(currRingHdl))==0))
  {
    r=currRingHdl;
  }
  if ((r!=NULL) && ((r->typ == RING_CMD) || (r->typ== QRING_CMD)))
  {
    ring src_ring=IDRING(r);
    if ((nMap=n_SetMap(src_ring->cf, currRing->cf))==NULL)
    {
      Werror("can not map from ground field of %s to current ground field",
          theMap->preimage);
      return NULL;
    }
    if (IDELEMS(theMap)<src_ring->N)
    {
      theMap->m=(polyset)omReallocSize((ADDRESS)theMap->m,
                                 IDELEMS(theMap)*sizeof(poly),
                                 (src_ring->N)*sizeof(poly));
      for(i=IDELEMS(theMap);i<src_ring->N;i++)
        theMap->m[i]=NULL;
      IDELEMS(theMap)=src_ring->N;
    }
    if (what==NULL)
    {
      WerrorS("argument of a map must have a name");
    }
    else if ((w=src_ring->idroot->get(what,myynest))!=NULL)
    {
      char *save_r=NULL;
      v=(leftv)omAlloc0Bin(sleftv_bin);
      sleftv tmpW;
      memset(&tmpW,0,sizeof(sleftv));
      tmpW.rtyp=IDTYP(w);
      if (tmpW.rtyp==MAP_CMD)
      {
        tmpW.rtyp=IDEAL_CMD;
        save_r=IDMAP(w)->preimage;
        IDMAP(w)->preimage=0;
      }
      tmpW.data=IDDATA(w);
      // check overflow
      BOOLEAN overflow=FALSE;
      if ((tmpW.rtyp==IDEAL_CMD)
        || (tmpW.rtyp==MODUL_CMD)
        || (tmpW.rtyp==MAP_CMD))
      {
        ideal id=(ideal)tmpW.data;
        for(int j=IDELEMS(theMap)-1;j>=0 && !overflow;j--)
        {
          if (theMap->m[j]!=NULL)
          {
            long deg_monexp=pTotaldegree(theMap->m[j]);
            for(int i=IDELEMS(id)-1;i>=0;i--)
            {
              poly p=id->m[i];
              if ((p!=NULL) && (p_Totaldegree(p,src_ring)!=0) &&
              ((unsigned long)deg_monexp > (currRing->bitmask / (unsigned long)p_Totaldegree(p,src_ring)/2)))
              {
                overflow=TRUE;
                break;
              }
            }
          }
        }
      }
      else if (tmpW.rtyp==POLY_CMD)
      {
        for(int j=IDELEMS(theMap)-1;j>=0 && !overflow;j--)
        {
          if (theMap->m[j]!=NULL)
          {
            long deg_monexp=pTotaldegree(theMap->m[j]);
            poly p=(poly)tmpW.data;
            if ((p!=NULL) && (p_Totaldegree(p,src_ring)!=0) &&
            ((unsigned long)deg_monexp > (currRing->bitmask / (unsigned long)p_Totaldegree(p,src_ring)/2)))
            {
              overflow=TRUE;
              break;
            }
          }
        }
      }
      if (overflow)
        Warn("possible OVERFLOW in map, max exponent is %ld",currRing->bitmask/2);
#if 0
      if (((tmpW.rtyp==IDEAL_CMD)||(tmpW.rtyp==MODUL_CMD)) && idIs0(IDIDEAL(w)))
      {
        v->rtyp=tmpW.rtyp;
        v->data=idInit(IDELEMS(IDIDEAL(w)),IDIDEAL(w)->rank);
      }
      else
#endif
      {
#ifdef FAST_MAP
        if ((tmpW.rtyp==IDEAL_CMD) && (nMap == ndCopyMap)
#ifdef HAVE_PLURAL
        && (!rIsPluralRing(currRing))
#endif
        )
        {
          v->rtyp=IDEAL_CMD;
          v->data=fast_map(IDIDEAL(w), src_ring, (ideal)theMap, currRing);
        }
        else
#endif
        if (maApplyFetch(MAP_CMD,theMap,v,&tmpW,src_ring,NULL,NULL,0,nMap))
        {
          Werror("cannot map %s(%d)",Tok2Cmdname(w->typ),w->typ);
          omFreeBin((ADDRESS)v, sleftv_bin);
          if (save_r!=NULL) IDMAP(w)->preimage=save_r;
          return NULL;
        }
      }
      if (save_r!=NULL)
      {
        IDMAP(w)->preimage=save_r;
        IDMAP((idhdl)v)->preimage=omStrDup(save_r);
        v->rtyp=MAP_CMD;
      }
      return v;
    }
    else
    {
      Werror("%s undefined in %s",what,theMap->preimage);
    }
  }
  else
  {
    Werror("cannot find preimage %s",theMap->preimage);
  }
  return NULL;
}

int iiOpsTwoChar

(

const char *

s

)

Definition at line 123 of file ipshell.cc.

{
/* not handling: &&, ||, ** */
  if (s[1]=='\0') return s[0];
  else if (s[2]!='\0') return 0;
  switch(s[0])
  {
    case '.': if (s[1]=='.') return DOTDOT;
              else           return 0;
    case ':': if (s[1]==':') return COLONCOLON;
              else           return 0;
    case '-': if (s[1]=='-') return COLONCOLON;
              else           return 0;
    case '+': if (s[1]=='+') return PLUSPLUS;
              else           return 0;
    case '=': if (s[1]=='=') return EQUAL_EQUAL;
              else           return 0;
    case '<': if (s[1]=='=') return LE;
              else if (s[1]=='>') return NOTEQUAL;
              else           return 0;
    case '>': if (s[1]=='=') return GE;
              else           return 0;
    case '!': if (s[1]=='=') return NOTEQUAL;
              else           return 0;
  }
  return 0;
}

BOOLEAN iiParameter

(

leftv

p

)

Definition at line 1285 of file ipshell.cc.

{
  if (iiCurrArgs==NULL)
  {
    if (strcmp(p->name,"#")==0)
      return iiDefaultParameter(p);
    Werror("not enough arguments for proc %s",VoiceName());
    p->CleanUp();
    return TRUE;
  }
  leftv h=iiCurrArgs;
  leftv rest=h->next; /*iiCurrArgs is not NULL here*/
  BOOLEAN is_default_list=FALSE;
  if (strcmp(p->name,"#")==0)
  {
    is_default_list=TRUE;
    rest=NULL;
  }
  else
  {
    h->next=NULL;
  }
  BOOLEAN res=iiAssign(p,h);
  if (is_default_list)
  {
    iiCurrArgs=NULL;
  }
  else
  {
    iiCurrArgs=rest;
  }
  h->CleanUp();
  omFreeBin((ADDRESS)h, sleftv_bin);
  return res;
}

char* iiProcArgs	(	char *	e,
		BOOLEAN	withParenth
	)

Definition at line 127 of file iplib.cc.

{
  while ((*e==' ') || (*e=='\t') || (*e=='(')) e++;
  if (*e<' ')
  {
    if (withParenth)
    {
      // no argument list, allow list #
      return omStrDup("parameter list #;");
    }
    else
    {
      // empty list
      return omStrDup("");
    }
  }
  BOOLEAN in_args;
  BOOLEAN args_found;
  char *s;
  char *argstr=(char *)omAlloc(127); // see ../omalloc/omTables.inc
  int argstrlen=127;
  *argstr='\0';
  int par=0;
  do
  {
    args_found=FALSE;
    s=e; // set s to the starting point of the arg
         // and search for the end
    while(*s==' ') s++; e=s; // skip leading paces
    while ((*e!=',')
    &&((par!=0) || (*e!=')'))
    &&(*e!='\0'))
    {
      if (*e=='(') par++;
      else if (*e==')') par--;
      args_found=args_found || (*e>' ');
      e++;
    }
    in_args=(*e==',');
    if (args_found)
    {
      *e='\0';
      // check for space:
      if ((int)strlen(argstr)+12 /* parameter + ;*/ +(int)strlen(s)>= argstrlen)
      {
        argstrlen*=2;
        char *a=(char *)omAlloc( argstrlen);
        strcpy(a,argstr);
        omFree((ADDRESS)argstr);
        argstr=a;
      }
      // copy the result to argstr
      if(strncmp(s,"alias ",6)!=0)
      {
        strcat(argstr,"parameter ");
      }
      strcat(argstr,s);
      strcat(argstr,"; ");
      e++; // e was pointing to ','
    }
  } while (in_args);
  return argstr;
}

char* iiProcName	(	char *	buf,
		char &	ct,
		char *&	e
	)

Definition at line 113 of file iplib.cc.

{
  char *s=buf+5;
  while (*s==' ') s++;
  e=s+1;
  while ((*e>' ') && (*e!='(')) e++;
  ct=*e;
  *e='\0';
  return s;
}

BOOLEAN iiPStart	(	idhdl	pn,
		sleftv *	sl
	)

Definition at line 372 of file iplib.cc.

{
  procinfov pi=NULL;
  int old_echo=si_echo;
  BOOLEAN err=FALSE;
  char save_flags=0;

  /* init febase ======================================== */
  /* we do not enter this case if filename != NULL !! */
  if (pn!=NULL)
  {
    pi = IDPROC(pn);
    if(pi!=NULL)
    {
      save_flags=pi->trace_flag;
      if( pi->data.s.body==NULL )
      {
        iiGetLibProcBuffer(pi);
        if (pi->data.s.body==NULL) return TRUE;
      }
//      omUpdateInfo();
//      int m=om_Info.UsedBytes;
//      Print("proc %s, mem=%d\n",IDID(pn),m);
    }
  }
  else return TRUE;
  /* generate argument list ======================================*/
  if (v!=NULL)
  {
    iiCurrArgs=(leftv)omAllocBin(sleftv_bin);
    memcpy(iiCurrArgs,v,sizeof(sleftv));
    memset(v,0,sizeof(sleftv));
  }
  else
  {
    iiCurrArgs=NULL;
  }
  iiCurrProc=pn;
  /* start interpreter ======================================*/
  myynest++;
  if (myynest > SI_MAX_NEST)
  {
    WerrorS("nesting too deep");
    err=TRUE;
  }
  else
  {
    err=iiAllStart(pi,pi->data.s.body,BT_proc,pi->data.s.body_lineno-(v!=NULL));

#ifdef USE_IILOCALRING
#if 0
  if(procstack->cRing != iiLocalRing[myynest]) Print("iiMake_proc: 1 ring not saved procs:%x, iiLocal:%x\n",procstack->cRing, iiLocalRing[myynest]);
#endif
    if (iiLocalRing[myynest-1] != currRing)
    {
      if (iiRETURNEXPR.RingDependend())
      {
        //idhdl hn;
        const char *n;
        const char *o;
        idhdl nh=NULL, oh=NULL;
        if (iiLocalRing[myynest-1]!=NULL)
          oh=rFindHdl(iiLocalRing[myynest-1],NULL);
        if (oh!=NULL)          o=oh->id;
        else                   o="none";
        if (currRing!=NULL)
          nh=rFindHdl(currRing,NULL);
        if (nh!=NULL)          n=nh->id;
        else                   n="none";
        Werror("ring change during procedure call: %s -> %s (level %d)",o,n,myynest);
        iiRETURNEXPR.CleanUp();
        err=TRUE;
      }
      currRing=iiLocalRing[myynest-1];
    }
    if ((currRing==NULL)
    && (currRingHdl!=NULL))
      currRing=IDRING(currRingHdl);
    else
    if ((currRing!=NULL) &&
      ((currRingHdl==NULL)||(IDRING(currRingHdl)!=currRing)
       ||(IDLEV(currRingHdl)>=myynest-1)))
    {
      rSetHdl(rFindHdl(currRing,NULL));
      iiLocalRing[myynest-1]=NULL;
    }
#else /* USE_IILOCALRING */
    if (procstack->cRing != currRing)
    {
      //if (procstack->cRingHdl!=NULL)
      //Print("procstack:%s,",IDID(procstack->cRingHdl));
      //if (currRingHdl!=NULL)
      //Print(" curr:%s\n",IDID(currRingHdl));
      //Print("pr:%x, curr: %x\n",procstack->cRing,currRing);
      if (iiRETURNEXPR.RingDependend())
      {
        //idhdl hn;
        const char *n;
        const char *o;
        if (procstack->cRing!=NULL)
        {
          //PrintS("reset ring\n");
          procstack->cRingHdl=rFindHdl(procstack->cRing,NULL);
          o=IDID(procstack->cRingHdl);
          currRing=procstack->cRing;
          currRingHdl=procstack->cRingHdl;
        }
        else                            o="none";
        if (currRing!=NULL)             n=IDID(currRingHdl);
        else                            n="none";
        if (currRing==NULL)
        {
          Werror("ring change during procedure call: %s -> %s (level %d)",o,n,myynest);
          iiRETURNEXPR.CleanUp();
          err=TRUE;
        }
      }
      if (procstack->cRingHdl!=NULL)
      {
        rSetHdl(procstack->cRingHdl);
      }
      else
      { currRingHdl=NULL; currRing=NULL; }
    }
#endif /* USE_IILOCALRING */
    //Print("kill locals for %s (level %d)\n",IDID(pn),myynest);
    killlocals(myynest);
#ifndef SING_NDEBUG
    checkall();
#endif
    //Print("end kill locals for %s (%d)\n",IDID(pn),myynest);
  }
  myynest--;
  si_echo=old_echo;
  if (pi!=NULL)
    pi->trace_flag=save_flags;
//  omUpdateInfo();
//  int m=om_Info.UsedBytes;
//  Print("exit %s, mem=%d\n",IDID(pn),m);
  return err;
}

int iiRegularity

(

lists

L

)

Definition at line 997 of file ipshell.cc.

{
  int len,reg,typ0;

  resolvente r=liFindRes(L,&len,&typ0);

  if (r==NULL)
    return -2;
  intvec *weights=NULL;
  int add_row_shift=0;
  intvec *ww=(intvec *)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
  if (ww!=NULL)
  {
     weights=ivCopy(ww);
     add_row_shift = ww->min_in();
     (*weights) -= add_row_shift;
  }
  //Print("attr:%x\n",weights);

  intvec *dummy=syBetti(r,len,&reg,weights);
  if (weights!=NULL) delete weights;
  delete dummy;
  omFreeSize((ADDRESS)r,len*sizeof(ideal));
  return reg+1+add_row_shift;
}

BOOLEAN iiTestAssume	(	leftv	a,
		leftv	b
	)

Definition at line 6131 of file ipshell.cc.

{
  // assume a: level
  if ((a->Typ()==INT_CMD)&&((long)a->Data()>=0))
  {
    if ((TEST_V_ALLWARN) && (myynest==0)) WarnS("ASSUME at top level is of no use: see documentation");
    char       assume_yylinebuf[80];
    strncpy(assume_yylinebuf,my_yylinebuf,79);
    int lev=(long)a->Data();
    int startlev=0;
    idhdl h=ggetid("assumeLevel");
    if ((h!=NULL)&&(IDTYP(h)==INT_CMD)) startlev=(long)IDINT(h);
    if(lev <=startlev)
    {
      BOOLEAN bo=b->Eval();
      if (bo) { WerrorS("syntax error in ASSUME");return TRUE;}
      if (b->Typ()!=INT_CMD) { WerrorS("ASUMME(<level>,<int expr>)");return TRUE; }
      if (b->Data()==NULL) { Werror("ASSUME failed:%s",assume_yylinebuf);return TRUE;}
    }
  }
  b->CleanUp();
  a->CleanUp();
  return FALSE;
}

int iiTokType

(

int

op

)

Definition at line 253 of file iparith.cc.

{
  for (int i=0;i<sArithBase.nCmdUsed;i++)
  {
    if (sArithBase.sCmds[i].tokval==op)
      return sArithBase.sCmds[i].toktype;
  }
  return 0;
}

BOOLEAN iiTryLoadLib	(	leftv	v,
		const char *	id
	)

Definition at line 741 of file iplib.cc.

{
  BOOLEAN LoadResult = TRUE;
  char libnamebuf[128];
  char *libname = (char *)omAlloc(strlen(id)+5);
  const char *suffix[] = { "", ".lib", ".so", ".sl", NULL };
  int i = 0;
  // FILE *fp;
  // package pack;
  // idhdl packhdl;
  lib_types LT;
  for(i=0; suffix[i] != NULL; i++)
  {
    sprintf(libname, "%s%s", id, suffix[i]);
    *libname = mytolower(*libname);
    if((LT = type_of_LIB(libname, libnamebuf)) > LT_NOTFOUND)
    {
      char *s=omStrDup(libname);
      char libnamebuf[256];

      if (LT==LT_SINGULAR)
        LoadResult = iiLibCmd(s, FALSE, FALSE,TRUE);
      #ifdef HAVE_DYNAMIC_LOADING
      else if ((LT==LT_ELF) || (LT==LT_HPUX))
        LoadResult = load_modules(s,libnamebuf,FALSE);
      #endif
      else if (LT==LT_BUILTIN)
      {
        LoadResult=load_builtin(s,FALSE, iiGetBuiltinModInit(s));
      }
      if(!LoadResult )
      {
        v->name = iiConvName(libname);
        break;
      }
    }
  }
  omFree(libname);
  return LoadResult;
}

const char* iiTwoOps

(

int

t

)

Definition at line 250 of file gentable.cc.

{
  if (t<127)
  {
    static char ch[2];
    switch (t)
    {
      case '&':
        return "and";
      case '|':
        return "or";
      default:
        ch[0]=t;
        ch[1]='\0';
        return ch;
    }
  }
  switch (t)
  {
    case COLONCOLON:  return "::";
    case DOTDOT:      return "..";
    //case PLUSEQUAL:   return "+=";
    //case MINUSEQUAL:  return "-=";
    case MINUSMINUS:  return "--";
    case PLUSPLUS:    return "++";
    case EQUAL_EQUAL: return "==";
    case LE:          return "<=";
    case GE:          return ">=";
    case NOTEQUAL:    return "<>";
    default:          return Tok2Cmdname(t);
  }
}

BOOLEAN iiWRITE	(	leftv	res,
		leftv	exprlist
	)

Definition at line 643 of file ipshell.cc.

{
  sleftv vf;
  if (iiConvert(v->Typ(),LINK_CMD,iiTestConvert(v->Typ(),LINK_CMD),v,&vf))
  {
    WerrorS("link expected");
    return TRUE;
  }
  si_link l=(si_link)vf.Data();
  if (vf.next == NULL)
  {
    WerrorS("write: need at least two arguments");
    return TRUE;
  }

  BOOLEAN b=slWrite(l,vf.next); /* iiConvert preserves next */
  if (b)
  {
    const char *s;
    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
    else                            s=sNoName;
    Werror("cannot write to %s",s);
  }
  vf.CleanUp();
  return b;
}

int IsCmd	(	const char *	n,
		int &	tok
	)

Definition at line 8688 of file iparith.cc.

{
  int i;
  int an=1;
  int en=sArithBase.nLastIdentifier;

  loop
  //for(an=0; an<sArithBase.nCmdUsed; )
  {
    if(an>=en-1)
    {
      if (strcmp(n, sArithBase.sCmds[an].name) == 0)
      {
        i=an;
        break;
      }
      else if ((an!=en) && (strcmp(n, sArithBase.sCmds[en].name) == 0))
      {
        i=en;
        break;
      }
      else
      {
        // -- blackbox extensions:
        // return 0;
        return blackboxIsCmd(n,tok);
      }
    }
    i=(an+en)/2;
    if (*n < *(sArithBase.sCmds[i].name))
    {
      en=i-1;
    }
    else if (*n > *(sArithBase.sCmds[i].name))
    {
      an=i+1;
    }
    else
    {
      int v=strcmp(n,sArithBase.sCmds[i].name);
      if(v<0)
      {
        en=i-1;
      }
      else if(v>0)
      {
        an=i+1;
      }
      else /*v==0*/
      {
        break;
      }
    }
  }
  lastreserved=sArithBase.sCmds[i].name;
  tok=sArithBase.sCmds[i].tokval;
  if(sArithBase.sCmds[i].alias==2)
  {
    Warn("outdated identifier `%s` used - please change your code",
    sArithBase.sCmds[i].name);
    sArithBase.sCmds[i].alias=1;
  }
  #if 0
  if (currRingHdl==NULL)
  {
    #ifdef SIQ
    if (siq<=0)
    {
    #endif
      if ((tok>=BEGIN_RING) && (tok<=END_RING))
      {
        WerrorS("no ring active");
        return 0;
      }
    #ifdef SIQ
    }
    #endif
  }
  #endif
  if (!expected_parms)
  {
    switch (tok)
    {
      case IDEAL_CMD:
      case INT_CMD:
      case INTVEC_CMD:
      case MAP_CMD:
      case MATRIX_CMD:
      case MODUL_CMD:
      case POLY_CMD:
      case PROC_CMD:
      case RING_CMD:
      case STRING_CMD:
        cmdtok = tok;
        break;
    }
  }
  return sArithBase.sCmds[i].toktype;
}

int IsPrime

(

int

i

)

Definition at line 633 of file ipshell.cc.

{
  if      (p == 0)    return 0;
  else if (p == 1)    return 1/*1*/;
  else if ((p == 2)||(p==3))    return p;
  else if (p < 0)     return 2; //(iiIsPrime0((unsigned)(-p)));
  else if ((p & 1)==0) return iiIsPrime0((unsigned)(p-1));
  return iiIsPrime0((unsigned)(p));
}

BOOLEAN jjBETTI	(	leftv	res,
		leftv	v
	)

Definition at line 936 of file ipshell.cc.

{
  sleftv tmp;
  memset(&tmp,0,sizeof(tmp));
  tmp.rtyp=INT_CMD;
  tmp.data=(void *)1;
  if ((u->Typ()==IDEAL_CMD)
  || (u->Typ()==MODUL_CMD))
    return jjBETTI2_ID(res,u,&tmp);
  else
    return jjBETTI2(res,u,&tmp);
}

BOOLEAN jjBETTI2	(	leftv	res,
		leftv	u,
		leftv	v
	)

Definition at line 970 of file ipshell.cc.

{
  resolvente r;
  int len;
  int reg,typ0;
  lists l=(lists)u->Data();

  intvec *weights=NULL;
  int add_row_shift=0;
  intvec *ww=(intvec *)atGet(&(l->m[0]),"isHomog",INTVEC_CMD);
  if (ww!=NULL)
  {
     weights=ivCopy(ww);
     add_row_shift = ww->min_in();
     (*weights) -= add_row_shift;
  }
  //Print("attr:%x\n",weights);

  r=liFindRes(l,&len,&typ0);
  if (r==NULL) return TRUE;
  res->data=(char *)syBetti(r,len,&reg,weights,(int)(long)v->Data());
  omFreeSize((ADDRESS)r,(len)*sizeof(ideal));
  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
  if (weights!=NULL) delete weights;
  return FALSE;
}

BOOLEAN jjBETTI2_ID	(	leftv	res,
		leftv	u,
		leftv	v
	)

Definition at line 949 of file ipshell.cc.

{
  lists l=(lists) omAllocBin(slists_bin);
  l->Init(1);
  l->m[0].rtyp=u->Typ();
  l->m[0].data=u->Data();
  attr *a=u->Attribute();
  if (a!=NULL)
  l->m[0].attribute=*a;
  sleftv tmp2;
  memset(&tmp2,0,sizeof(tmp2));
  tmp2.rtyp=LIST_CMD;
  tmp2.data=(void *)l;
  BOOLEAN r=jjBETTI2(res,&tmp2,v);
  l->m[0].data=NULL;
  l->m[0].attribute=NULL;
  l->m[0].rtyp=DEF_CMD;
  l->Clean();
  return r;
}

BOOLEAN jjCHARSERIES	(	leftv	res,
		leftv	u
	)

Definition at line 3053 of file ipshell.cc.

{
  res->data=singclap_irrCharSeries((ideal)u->Data(), currRing);
  return (res->data==NULL);
}

BOOLEAN jjIMPORTFROM	(	leftv	res,
		leftv	u,
		leftv	v
	)

Definition at line 2067 of file ipassign.cc.

{
  //Print("importfrom %s::%s ->.\n",v->Name(),u->Name() );
  assume(u->Typ()==PACKAGE_CMD);
  char *vn=(char *)v->Name();
  idhdl h=((package)(u->Data()))->idroot->get(vn /*v->Name()*/, myynest);
  if (h!=NULL)
  {
    //check for existence
    if (((package)(u->Data()))==basePack)
    {
      WarnS("source and destination packages are identical");
      return FALSE;
    }
    idhdl t=basePack->idroot->get(vn /*v->Name()*/, myynest);
    if (t!=NULL)
    {
      Warn("redefining `%s`",vn);
      killhdl(t);
    }
    sleftv tmp_expr;
    if (iiDeclCommand(&tmp_expr,v,myynest,DEF_CMD,&IDROOT)) return TRUE;
    sleftv h_expr;
    memset(&h_expr,0,sizeof(h_expr));
    h_expr.rtyp=IDHDL;
    h_expr.data=h;
    h_expr.name=vn;
    return iiAssign(&tmp_expr,&h_expr);
  }
  else
  {
    Werror("`%s` not found in `%s`",v->Name(), u->Name());
    return TRUE;
  }
  return FALSE;
}

BOOLEAN jjLIST_PL	(	leftv	res,
		leftv	v
	)

Definition at line 7369 of file iparith.cc.

{
  int sl=0;
  if (v!=NULL) sl = v->listLength();
  lists L;
  if((sl==1)&&(v->Typ()==RESOLUTION_CMD))
  {
    int add_row_shift = 0;
    intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
    if (weights!=NULL)  add_row_shift=weights->min_in();
    L=syConvRes((syStrategy)v->Data(),FALSE,add_row_shift);
  }
  else
  {
    L=(lists)omAllocBin(slists_bin);
    leftv h=NULL;
    int i;
    int rt;

    L->Init(sl);
    for (i=0;i<sl;i++)
    {
      if (h!=NULL)
      { /* e.g. not in the first step:
         * h is the pointer to the old sleftv,
         * v is the pointer to the next sleftv
         * (in this moment) */
         h->next=v;
      }
      h=v;
      v=v->next;
      h->next=NULL;
      rt=h->Typ();
      if (rt==0)
      {
        L->Clean();
        Werror("`%s` is undefined",h->Fullname());
        return TRUE;
      }
      if ((rt==RING_CMD)||(rt==QRING_CMD))
      {
        L->m[i].rtyp=rt;  L->m[i].data=h->Data();
        ((ring)L->m[i].data)->ref++;
      }
      else
        L->m[i].Copy(h);
    }
  }
  res->data=(char *)L;
  return FALSE;
}

BOOLEAN jjLOAD	(	const char *	s,
		BOOLEAN	autoexport = FALSE
	)

load lib/module given in v

Definition at line 5266 of file iparith.cc.

{
  char libnamebuf[256];
  lib_types LT = type_of_LIB(s, libnamebuf);

#ifdef HAVE_DYNAMIC_LOADING
  extern BOOLEAN load_modules(const char *newlib, char *fullpath, BOOLEAN autoexport);
#endif /* HAVE_DYNAMIC_LOADING */
  switch(LT)
  {
      default:
      case LT_NONE:
        Werror("%s: unknown type", s);
        break;
      case LT_NOTFOUND:
        Werror("cannot open %s", s);
        break;

      case LT_SINGULAR:
      {
        char *plib = iiConvName(s);
        idhdl pl = IDROOT->get(plib,0);
        if (pl==NULL)
        {
          pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
          IDPACKAGE(pl)->language = LANG_SINGULAR;
          IDPACKAGE(pl)->libname=omStrDup(plib);
        }
        else if (IDTYP(pl)!=PACKAGE_CMD)
        {
          Werror("can not create package `%s`",plib);
          omFree(plib);
          return TRUE;
        }
        package savepack=currPack;
        currPack=IDPACKAGE(pl);
        IDPACKAGE(pl)->loaded=TRUE;
        char libnamebuf[256];
        FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
        BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
        currPack=savepack;
        IDPACKAGE(pl)->loaded=(!bo);
        return bo;
      }
      case LT_BUILTIN:
        SModulFunc_t iiGetBuiltinModInit(const char*);
        return load_builtin(s,autoexport, iiGetBuiltinModInit(s));
      case LT_MACH_O:
      case LT_ELF:
      case LT_HPUX:
#ifdef HAVE_DYNAMIC_LOADING
        return load_modules(s, libnamebuf, autoexport);
#else /* HAVE_DYNAMIC_LOADING */
        WerrorS("Dynamic modules are not supported by this version of Singular");
        break;
#endif /* HAVE_DYNAMIC_LOADING */
  }
  return TRUE;
}

BOOLEAN jjMINRES	(	leftv	res,
		leftv	v
	)

Definition at line 915 of file ipshell.cc.

{
  int len=0;
  int typ0;
  lists L=(lists)v->Data();
  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
  int add_row_shift = 0;
  if (weights==NULL)
    weights=(intvec*)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
  if (weights!=NULL)  add_row_shift=weights->min_in();
  resolvente rr=liFindRes(L,&len,&typ0);
  if (rr==NULL) return TRUE;
  resolvente r=iiCopyRes(rr,len);

  syMinimizeResolvente(r,len,0);
  omFreeSize((ADDRESS)rr,len*sizeof(ideal));
  len++;
  res->data=(char *)liMakeResolv(r,len,-1,typ0,NULL,add_row_shift);
  return FALSE;
}

BOOLEAN jjRESULTANT	(	leftv	res,
		leftv	u,
		leftv	v,
		leftv	w
	)

Definition at line 3046 of file ipshell.cc.

{
  res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
                  (poly)w->CopyD(), currRing);
  return errorreported;
}

BOOLEAN jjSYSTEM	(	leftv	res,
		leftv	v
	)

Definition at line 245 of file extra.cc.

{
  if(args->Typ() == STRING_CMD)
  {
    const char *sys_cmd=(char *)(args->Data());
    leftv h=args->next;
// ONLY documented system calls go here
// Undocumented system calls go down into jjEXTENDED_SYSTEM (#ifdef HAVE_EXTENDED_SYSTEM)
/*==================== nblocks ==================================*/
    if (strcmp(sys_cmd, "nblocks") == 0)
    {
      ring r;
      if (h == NULL)
      {
        if (currRingHdl != NULL)
        {
          r = IDRING(currRingHdl);
        }
        else
        {
          WerrorS("no ring active");
          return TRUE;
        }
      }
      else
      {
        if (h->Typ() != RING_CMD)
        {
          WerrorS("ring expected");
          return TRUE;
        }
        r = (ring) h->Data();
      }
      res->rtyp = INT_CMD;
      res->data = (void*) (long)(rBlocks(r) - 1);
      return FALSE;
    }
/*==================== version ==================================*/
    if(strcmp(sys_cmd,"version")==0)
    {
      res->rtyp=INT_CMD;
      res->data=(void *)SINGULAR_VERSION;
      return FALSE;
    }
    else
/*==================== cpu ==================================*/
    if(strcmp(sys_cmd,"cpu")==0)
    {
      long cpu=1; //feOptValue(FE_OPT_CPUS);
      #ifdef _SC_NPROCESSORS_ONLN
      cpu=sysconf(_SC_NPROCESSORS_ONLN);
      #elif defined(_SC_NPROCESSORS_CONF)
      cpu=sysconf(_SC_NPROCESSORS_CONF);
      #endif
      res->data=(void *)cpu;
      res->rtyp=INT_CMD;
      return FALSE;
    }
    else

/*==================== sh ==================================*/
    if(strcmp(sys_cmd,"sh")==0)
    {
      if (feOptValue(FE_OPT_NO_SHELL))
      {
        WerrorS("shell execution is disallowed in restricted mode");
        return TRUE;
      }
      res->rtyp=INT_CMD;
      if (h==NULL) res->data = (void *)(long) system("sh");
      else if (h->Typ()==STRING_CMD)
        res->data = (void*)(long) system((char*)(h->Data()));
      else
        WerrorS("string expected");
      return FALSE;
    }
    else
    #if 0
    if(strcmp(sys_cmd,"power1")==0)
    {
      res->rtyp=POLY_CMD;
      poly f=(poly)h->CopyD();
      poly g=pPower(f,2000);
      res->data=(void *)g;
      return FALSE;
    }
    else
    if(strcmp(sys_cmd,"power2")==0)
    {
      res->rtyp=POLY_CMD;
      poly f=(poly)h->Data();
      poly g=pOne();
      for(int i=0;i<2000;i++)
        g=pMult(g,pCopy(f));
      res->data=(void *)g;
      return FALSE;
    }
    if(strcmp(sys_cmd,"power3")==0)
    {
      res->rtyp=POLY_CMD;
      poly f=(poly)h->Data();
      poly p2=pMult(pCopy(f),pCopy(f));
      poly p4=pMult(pCopy(p2),pCopy(p2));
      poly p8=pMult(pCopy(p4),pCopy(p4));
      poly p16=pMult(pCopy(p8),pCopy(p8));
      poly p32=pMult(pCopy(p16),pCopy(p16));
      poly p64=pMult(pCopy(p32),pCopy(p32));
      poly p128=pMult(pCopy(p64),pCopy(p64));
      poly p256=pMult(pCopy(p128),pCopy(p128));
      poly p512=pMult(pCopy(p256),pCopy(p256));
      poly p1024=pMult(pCopy(p512),pCopy(p512));
      poly p1536=pMult(p1024,p512);
      poly p1792=pMult(p1536,p256);
      poly p1920=pMult(p1792,p128);
      poly p1984=pMult(p1920,p64);
      poly p2000=pMult(p1984,p16);
      res->data=(void *)p2000;
      pDelete(&p2);
      pDelete(&p4);
      pDelete(&p8);
      //pDelete(&p16);
      pDelete(&p32);
      //pDelete(&p64);
      //pDelete(&p128);
      //pDelete(&p256);
      //pDelete(&p512);
      //pDelete(&p1024);
      //pDelete(&p1536);
      //pDelete(&p1792);
      //pDelete(&p1920);
      //pDelete(&p1984);
      return FALSE;
    }
    else
    #endif
/*==================== uname ==================================*/
    if(strcmp(sys_cmd,"uname")==0)
    {
      res->rtyp=STRING_CMD;
      res->data = omStrDup(S_UNAME);
      return FALSE;
    }
    else
/*==================== with ==================================*/
    if(strcmp(sys_cmd,"with")==0)
    {
      if (h==NULL)
      {
        res->rtyp=STRING_CMD;
        res->data=(void *)versionString();
        return FALSE;
      }
      else if (h->Typ()==STRING_CMD)
      {
        #define TEST_FOR(A) if(strcmp(s,A)==0) res->data=(void *)1; else
        char *s=(char *)h->Data();
        res->rtyp=INT_CMD;
        #ifdef HAVE_DBM
          TEST_FOR("DBM")
        #endif
        #ifdef HAVE_DLD
          TEST_FOR("DLD")
        #endif
          //TEST_FOR("factory")
          //TEST_FOR("libfac")
        #ifdef HAVE_READLINE
          TEST_FOR("readline")
        #endif
        #ifdef TEST_MAC_ORDER
          TEST_FOR("MAC_ORDER")
        #endif
        // unconditional since 3-1-0-6
          TEST_FOR("Namespaces")
        #ifdef HAVE_DYNAMIC_LOADING
          TEST_FOR("DynamicLoading")
        #endif
        #ifdef HAVE_EIGENVAL
          TEST_FOR("eigenval")
        #endif
        #ifdef HAVE_GMS
          TEST_FOR("gms")
        #endif
        #ifdef OM_NDEBUG
          TEST_FOR("om_ndebug")
        #endif
        #ifdef SING_NDEBUG
          TEST_FOR("ndebug")
        #endif
          {};
          return FALSE;
        #undef TEST_FOR
      }
      return TRUE;
    }
    else
  /*==================== browsers ==================================*/
    if (strcmp(sys_cmd,"browsers")==0)
    {
      res->rtyp = STRING_CMD;
      StringSetS("");
      feStringAppendBrowsers(0);
      res->data = StringEndS();
      return FALSE;
    }
    else
  /*==================== pid ==================================*/
    if (strcmp(sys_cmd,"pid")==0)
    {
      res->rtyp=INT_CMD;
      res->data=(void *)(long) getpid();
      return FALSE;
    }
    else
  /*==================== getenv ==================================*/
    if (strcmp(sys_cmd,"getenv")==0)
    {
      if ((h!=NULL) && (h->Typ()==STRING_CMD))
      {
        res->rtyp=STRING_CMD;
        const char *r=getenv((char *)h->Data());
        if (r==NULL) r="";
        res->data=(void *)omStrDup(r);
        return FALSE;
      }
      else
      {
        WerrorS("string expected");
        return TRUE;
      }
    }
    else
  /*==================== setenv ==================================*/
    if (strcmp(sys_cmd,"setenv")==0)
    {
  #ifdef HAVE_SETENV
      const short t[]={2,STRING_CMD,STRING_CMD};
      if (iiCheckTypes(h,t,1))
      {
        res->rtyp=STRING_CMD;
        setenv((char *)h->Data(), (char *)h->next->Data(), 1);
        res->data=(void *)omStrDup((char *)h->next->Data());
        feReInitResources();
        return FALSE;
      }
      else
      {
        return TRUE;
      }
  #else
      WerrorS("setenv not supported on this platform");
      return TRUE;
  #endif
    }
    else
  /*==================== Singular ==================================*/
    if (strcmp(sys_cmd, "Singular") == 0)
    {
      res->rtyp=STRING_CMD;
      const char *r=feResource("Singular");
      if (r == NULL) r="";
      res->data = (void*) omStrDup( r );
      return FALSE;
    }
    else
    if (strcmp(sys_cmd, "SingularLib") == 0)
    {
      res->rtyp=STRING_CMD;
      const char *r=feResource("SearchPath");
      if (r == NULL) r="";
      res->data = (void*) omStrDup( r );
      return FALSE;
    }
    else
  /*==================== options ==================================*/
    if (strstr(sys_cmd, "--") == sys_cmd)
    {
      if (strcmp(sys_cmd, "--") == 0)
      {
        fePrintOptValues();
        return FALSE;
      }
      feOptIndex opt = feGetOptIndex(&sys_cmd[2]);
      if (opt == FE_OPT_UNDEF)
      {
        Werror("Unknown option %s", sys_cmd);
        WerrorS("Use 'system(\"--\");' for listing of available options");
        return TRUE;
      }
      // for Untyped Options (help version),
      // setting it just triggers action
      if (feOptSpec[opt].type == feOptUntyped)
      {
        feSetOptValue(opt,0);
        return FALSE;
      }
      if (h == NULL)
      {
        if (feOptSpec[opt].type == feOptString)
        {
          res->rtyp = STRING_CMD;
          const char *r=(const char*)feOptSpec[opt].value;
          if (r == NULL) r="";
          res->data = omStrDup(r);
        }
        else
        {
          res->rtyp = INT_CMD;
          res->data = feOptSpec[opt].value;
        }
        return FALSE;
      }
      if (h->Typ() != STRING_CMD &&
          h->Typ() != INT_CMD)
      {
        WerrorS("Need string or int argument to set option value");
        return TRUE;
      }
      const char* errormsg;
      if (h->Typ() == INT_CMD)
      {
        if (feOptSpec[opt].type == feOptString)
        {
          Werror("Need string argument to set value of option %s", sys_cmd);
          return TRUE;
        }
        errormsg = feSetOptValue(opt, (int)((long) h->Data()));
        if (errormsg != NULL)
          Werror("Option '--%s=%d' %s", sys_cmd, (int) ((long)h->Data()), errormsg);
      }
      else
      {
        errormsg = feSetOptValue(opt, (char*) h->Data());
        if (errormsg != NULL)
          Werror("Option '--%s=%s' %s", sys_cmd, (char*) h->Data(), errormsg);
      }
      if (errormsg != NULL) return TRUE;
      return FALSE;
    }
    else
  /*==================== HC ==================================*/
    if (strcmp(sys_cmd,"HC")==0)
    {
      res->rtyp=INT_CMD;
      res->data=(void *)(long) HCord;
      return FALSE;
    }
    else
  /*==================== random ==================================*/
    if(strcmp(sys_cmd,"random")==0)
    {
      const short t[]={1,INT_CMD};
      if (h!=NULL)
      {
        if (iiCheckTypes(h,t,1))
        {
          siRandomStart=(int)((long)h->Data());
          siSeed=siRandomStart;
          factoryseed(siRandomStart);
          return FALSE;
        }
        else
        {
          return TRUE;
        }
      }
      res->rtyp=INT_CMD;
      res->data=(void*)(long) siSeed;
      return FALSE;
    }
    else
    /*======================= demon_list =====================*/
    if (strcmp(sys_cmd,"denom_list")==0)
    {
      res->rtyp=LIST_CMD;
      extern lists get_denom_list();
      res->data=(lists)get_denom_list();
      return FALSE;
    }
    else
    /*==================== complexNearZero ======================*/
    if(strcmp(sys_cmd,"complexNearZero")==0)
    {
      const short t[]={2,NUMBER_CMD,INT_CMD};
      if (iiCheckTypes(h,t,1))
      {
        if ( !rField_is_long_C(currRing) )
        {
          WerrorS( "unsupported ground field!");
          return TRUE;
        }
        else
        {
          res->rtyp=INT_CMD;
          res->data=(void*)complexNearZero((gmp_complex*)h->Data(),
                             (int)((long)(h->next->Data())));
          return FALSE;
        }
      }
      else
      {
        return TRUE;
      }
    }
    else
  /*==================== getPrecDigits ======================*/
    if(strcmp(sys_cmd,"getPrecDigits")==0)
    {
      if ( (currRing==NULL)
      ||  (!rField_is_long_C(currRing) && !rField_is_long_R(currRing)))
      {
        WerrorS( "unsupported ground field!");
        return TRUE;
      }
      res->rtyp=INT_CMD;
      res->data=(void*)(long)gmp_output_digits;
      //if (gmp_output_digits!=getGMPFloatDigits())
      //{ Print("%d, %d\n",getGMPFloatDigits(),gmp_output_digits);}
      return FALSE;
    }
    else
  /*==================== lduDecomp ======================*/
    if(strcmp(sys_cmd, "lduDecomp")==0)
    {
      const short t[]={1,MATRIX_CMD};
      if (iiCheckTypes(h,t,1))
      {
        matrix aMat = (matrix)h->Data();
        matrix pMat; matrix lMat; matrix dMat; matrix uMat;
        poly l; poly u; poly prodLU;
        lduDecomp(aMat, pMat, lMat, dMat, uMat, l, u, prodLU);
        lists L = (lists)omAllocBin(slists_bin);
        L->Init(7);
        L->m[0].rtyp = MATRIX_CMD; L->m[0].data=(void*)pMat;
        L->m[1].rtyp = MATRIX_CMD; L->m[1].data=(void*)lMat;
        L->m[2].rtyp = MATRIX_CMD; L->m[2].data=(void*)dMat;
        L->m[3].rtyp = MATRIX_CMD; L->m[3].data=(void*)uMat;
        L->m[4].rtyp = POLY_CMD; L->m[4].data=(void*)l;
        L->m[5].rtyp = POLY_CMD; L->m[5].data=(void*)u;
        L->m[6].rtyp = POLY_CMD; L->m[6].data=(void*)prodLU;
        res->rtyp = LIST_CMD;
        res->data = (char *)L;
        return FALSE;
      }
      else
      {
        return TRUE;
      }
    }
    else
  /*==================== lduSolve ======================*/
    if(strcmp(sys_cmd, "lduSolve")==0)
    {
      /* for solving a linear equation system A * x = b, via the
           given LDU-decomposition of the matrix A;
           There is one valid parametrisation:
           1) exactly eight arguments P, L, D, U, l, u, lTimesU, b;
              P, L, D, and U realise the LDU-decomposition of A, that is,
              P * A = L * D^(-1) * U, and P, L, D, and U satisfy the
              properties decribed in method 'luSolveViaLDUDecomp' in
              linearAlgebra.h; see there;
              l, u, and lTimesU are as described in the same location;
              b is the right-hand side vector of the linear equation system;
           The method will return a list of either 1 entry or three entries:
           1) [0] if there is no solution to the system;
           2) [1, x, H] if there is at least one solution;
              x is any solution of the given linear system,
              H is the matrix with column vectors spanning the homogeneous
              solution space.
           The method produces an error if matrix and vector sizes do not
           fit. */
      const short t[]={7,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD,POLY_CMD,POLY_CMD,MATRIX_CMD};
      if (!iiCheckTypes(h,t,1))
      {
        return TRUE;
      }
      if (rField_is_Ring(currRing))
      {
        WerrorS("field required");
        return TRUE;
      }
      matrix pMat  = (matrix)h->Data();
      matrix lMat  = (matrix)h->next->Data();
      matrix dMat  = (matrix)h->next->next->Data();
      matrix uMat  = (matrix)h->next->next->next->Data();
      poly l       = (poly)  h->next->next->next->next->Data();
      poly u       = (poly)  h->next->next->next->next->next->Data();
      poly lTimesU = (poly)  h->next->next->next->next->next->next->Data();
      matrix bVec  = (matrix)h->next->next->next->next->next->next->next->Data();
      matrix xVec; int solvable; matrix homogSolSpace;
      if (pMat->rows() != pMat->cols())
      {
        Werror("first matrix (%d x %d) is not quadratic",
                 pMat->rows(), pMat->cols());
        return TRUE;
      }
      if (lMat->rows() != lMat->cols())
      {
        Werror("second matrix (%d x %d) is not quadratic",
                 lMat->rows(), lMat->cols());
        return TRUE;
      }
      if (dMat->rows() != dMat->cols())
      {
        Werror("third matrix (%d x %d) is not quadratic",
                 dMat->rows(), dMat->cols());
        return TRUE;
      }
      if (dMat->cols() != uMat->rows())
      {
        Werror("third matrix (%d x %d) and fourth matrix (%d x %d) %s",
                 dMat->rows(), dMat->cols(), uMat->rows(), uMat->cols(),
                 "do not t");
        return TRUE;
      }
      if (uMat->rows() != bVec->rows())
      {
        Werror("fourth matrix (%d x %d) and vector (%d x 1) do not fit",
                 uMat->rows(), uMat->cols(), bVec->rows());
        return TRUE;
      }
      solvable = luSolveViaLDUDecomp(pMat, lMat, dMat, uMat, l, u, lTimesU,
                                       bVec, xVec, homogSolSpace);

      /* build the return structure; a list with either one or
           three entries */
      lists ll = (lists)omAllocBin(slists_bin);
      if (solvable)
      {
        ll->Init(3);
        ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)solvable;
        ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)xVec;
        ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)homogSolSpace;
      }
      else
      {
        ll->Init(1);
        ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)solvable;
      }
      res->rtyp = LIST_CMD;
      res->data=(char*)ll;
      return FALSE;
    }
    else
  /*==== countedref: reference and shared ====*/
    if (strcmp(sys_cmd, "shared") == 0)
    {
      #ifndef SI_COUNTEDREF_AUTOLOAD
      void countedref_shared_load();
      countedref_shared_load();
      #endif
      res->rtyp = NONE;
      return FALSE;
    }
    else if (strcmp(sys_cmd, "reference") == 0)
    {
      #ifndef SI_COUNTEDREF_AUTOLOAD
      void countedref_reference_load();
      countedref_reference_load();
      #endif
      res->rtyp = NONE;
      return FALSE;
    }
    else
/*==================== semaphore =================*/
#ifdef HAVE_SIMPLEIPC
    if (strcmp(sys_cmd,"semaphore")==0)
    {
      if((h!=NULL) && (h->Typ()==STRING_CMD) && (h->next!=NULL) && (h->next->Typ()==INT_CMD))
      {
        int v=1;
        if ((h->next->next!=NULL)&& (h->next->next->Typ()==INT_CMD))
          v=(int)(long)h->next->next->Data();
        res->data=(char *)(long)simpleipc_cmd((char *)h->Data(),(int)(long)h->next->Data(),v);
        res->rtyp=INT_CMD;
        return FALSE;
      }
      else
      {
        WerrorS("Usage: system(\"semaphore\",<cmd>,int)");
        return TRUE;
      }
    }
    else
#endif
/*==================== reserved port =================*/
    if (strcmp(sys_cmd,"reserve")==0)
    {
      int ssiReservePort(int clients);
      const short t[]={1,INT_CMD};
      if (iiCheckTypes(h,t,1))
      {
        res->rtyp=INT_CMD;
        int p=ssiReservePort((int)(long)h->Data());
        res->data=(void*)(long)p;
        return (p==0);
      }
      return TRUE;
    }
    else
/*==================== reserved link =================*/
    if (strcmp(sys_cmd,"reservedLink")==0)
    {
      extern si_link ssiCommandLink();
      res->rtyp=LINK_CMD;
      si_link p=ssiCommandLink();
      res->data=(void*)p;
      return (p==NULL);
    }
    else
/*==================== install newstruct =================*/
    if (strcmp(sys_cmd,"install")==0)
    {
      const short t[]={4,STRING_CMD,STRING_CMD,PROC_CMD,INT_CMD};
      if (iiCheckTypes(h,t,1))
      {
        return newstruct_set_proc((char*)h->Data(),(char*)h->next->Data(),
                                (int)(long)h->next->next->next->Data(),
                                (procinfov)h->next->next->Data());
      }
      return TRUE;
    }
    else
/*==================== newstruct =================*/
    if (strcmp(sys_cmd,"newstruct")==0)
    {
      const short t[]={1,STRING_CMD};
      if (iiCheckTypes(h,t,1))
      {
        int id=0;
        char *n=(char*)h->Data();
        blackboxIsCmd(n,id);
        if (id>0)
        {
          blackbox *bb=getBlackboxStuff(id);
          if (BB_LIKE_LIST(bb))
          {
            newstruct_desc desc=(newstruct_desc)bb->data;
            newstructShow(desc);
            return FALSE;
          }
          else Werror("'%s' is not a newstruct",n);
        }
        else Werror("'%s' is not a blackbox object",n);
      }
      return TRUE;
    }
    else
/*==================== blackbox =================*/
    if (strcmp(sys_cmd,"blackbox")==0)
    {
      printBlackboxTypes();
      return FALSE;
    }
    else
  /*================= absBiFact ======================*/
    #ifdef HAVE_NTL
    if (strcmp(sys_cmd, "absFact") == 0)
    {
      const short t[]={1,POLY_CMD};
      if (iiCheckTypes(h,t,1)
      && (currRing!=NULL)
      && (getCoeffType(currRing->cf)==n_transExt))
      {
        res->rtyp=LIST_CMD;
        intvec *v=NULL;
        ideal mipos= NULL;
        int n= 0;
        ideal f=singclap_absFactorize((poly)(h->Data()), mipos, &v, n, currRing);
        if (f==NULL) return TRUE;
        ivTest(v);
        lists l=(lists)omAllocBin(slists_bin);
        l->Init(4);
        l->m[0].rtyp=IDEAL_CMD;
        l->m[0].data=(void *)f;
        l->m[1].rtyp=INTVEC_CMD;
        l->m[1].data=(void *)v;
        l->m[2].rtyp=IDEAL_CMD;
        l->m[2].data=(void*) mipos;
        l->m[3].rtyp=INT_CMD;
        l->m[3].data=(void*) (long) n;
        res->data=(void *)l;
        return FALSE;
      }
      else return TRUE;
    }
    else
    #endif
  /* =================== LLL via NTL ==============================*/
  #ifdef HAVE_NTL
    if (strcmp(sys_cmd, "LLL") == 0)
    {
      if (h!=NULL)
      {
        res->rtyp=h->Typ();
        if (h->Typ()==MATRIX_CMD)
        {
          res->data=(char *)singntl_LLL((matrix)h->Data(), currRing);
          return FALSE;
        }
        else if (h->Typ()==INTMAT_CMD)
        {
          res->data=(char *)singntl_LLL((intvec*)h->Data());
          return FALSE;
        }
        else return TRUE;
      }
      else return TRUE;
    }
    else
  #endif
  /* =================== LLL via Flint ==============================*/
  #ifdef HAVE_FLINT
  #ifdef FLINT_VER_2_4_5
    if (strcmp(sys_cmd, "LLL_Flint") == 0)
    {
      if (h!=NULL)
      {
        if(h->next == NULL)
        {
            res->rtyp=h->Typ();
            if (h->Typ()==BIGINTMAT_CMD)
            {
              res->data=(char *)singflint_LLL((bigintmat*)h->Data(), NULL);
              return FALSE;
            }
            else if (h->Typ()==INTMAT_CMD)
            {
              res->data=(char *)singflint_LLL((intvec*)h->Data(), NULL);
              return FALSE;
            }
            else return TRUE;
        }
        if(h->next->Typ()!= INT_CMD)
        {
            WerrorS("matrix,int or bigint,int expected");
            return TRUE;
        }
        if(h->next->Typ()== INT_CMD)
        {
            if(((int)((long)(h->next->Data())) != 0) && (int)((long)(h->next->Data()) != 1))
            {
                WerrorS("int is different from 0, 1");
                return TRUE;
            }
            res->rtyp=h->Typ();
            if((long)(h->next->Data()) == 0)
            {
                if (h->Typ()==BIGINTMAT_CMD)
                {
                  res->data=(char *)singflint_LLL((bigintmat*)h->Data(), NULL);
                  return FALSE;
                }
                else if (h->Typ()==INTMAT_CMD)
                {
                  res->data=(char *)singflint_LLL((intvec*)h->Data(), NULL);
                  return FALSE;
                }
                else return TRUE;
            }
            // This will give also the transformation matrix U s.t. res = U * m
            if((long)(h->next->Data()) == 1)
            {
                if (h->Typ()==BIGINTMAT_CMD)
                {
                  bigintmat* m = (bigintmat*)h->Data();
                  bigintmat* T = new bigintmat(m->rows(),m->rows(),m->basecoeffs());
                  for(int i = 1; i<=m->rows(); i++)
                  {
                    n_Delete(&(BIMATELEM(*T,i,i)),T->basecoeffs());
                    BIMATELEM(*T,i,i)=n_Init(1, T->basecoeffs());
                  }
                  m = singflint_LLL(m,T);
                  lists L = (lists)omAllocBin(slists_bin);
                  L->Init(2);
                  L->m[0].rtyp = BIGINTMAT_CMD;  L->m[0].data = (void*)m;
                  L->m[1].rtyp = BIGINTMAT_CMD;  L->m[1].data = (void*)T;
                  res->data=L;
                  res->rtyp=LIST_CMD;
                  return FALSE;
                }
                else if (h->Typ()==INTMAT_CMD)
                {
                  intvec* m = (intvec*)h->Data();
                  intvec* T = new intvec(m->rows(),m->rows(),(int)0);
                  for(int i = 1; i<=m->rows(); i++)
                    IMATELEM(*T,i,i)=1;
                  m = singflint_LLL(m,T);
                  lists L = (lists)omAllocBin(slists_bin);
                  L->Init(2);
                  L->m[0].rtyp = INTMAT_CMD;  L->m[0].data = (void*)m;
                  L->m[1].rtyp = INTMAT_CMD;  L->m[1].data = (void*)T;
                  res->data=L;
                  res->rtyp=LIST_CMD;
                  return FALSE;
                }
                else return TRUE;
            }
        }

      }
      else return TRUE;
    }
    else
  #endif
  #endif
  /*==================== shift-test for freeGB  =================*/
  #ifdef HAVE_SHIFTBBA
    if (strcmp(sys_cmd, "stest") == 0)
    {
      const short t[]={4,POLY_CMD,INT_CMD,INT_CMD,INT_CMD};
      if (iiCheckTypes(h,t,1))
      {
        poly p=(poly)h->CopyD();
        h=h->next;
        int sh=(int)((long)(h->Data()));
        h=h->next;
        int uptodeg=(int)((long)(h->Data()));
        h=h->next;
        int lVblock=(int)((long)(h->Data()));
        res->data = pLPshift(p,sh,uptodeg,lVblock);
        res->rtyp = POLY_CMD;
        return FALSE;
      }
      else return TRUE;
    }
    else
  #endif
  /*==================== block-test for freeGB  =================*/
  #ifdef HAVE_SHIFTBBA
    if (strcmp(sys_cmd, "btest") == 0)
    {
      const short t[]={2,POLY_CMD,INT_CMD};
      if (iiCheckTypes(h,t,1))
      {
        poly p=(poly)h->CopyD();
        h=h->next;
        int lV=(int)((long)(h->Data()));
        res->rtyp = INT_CMD;
        res->data = (void*)(long)pLastVblock(p, lV);
        return FALSE;
      }
      else return TRUE;
    }
    else
  #endif
  /*==================== shrink-test for freeGB  =================*/
  #ifdef HAVE_SHIFTBBA
    if (strcmp(sys_cmd, "shrinktest") == 0)
    {
      const short t[]={2,POLY_CMD,INT_CMD};
      if (iiCheckTypes(h,t,1))
      {
        poly p=(poly)h->CopyD();
        h=h->next;
        int lV=(int)((long)(h->Data()));
        res->rtyp = POLY_CMD;
        //        res->data = p_mShrink(p, lV, currRing);
        //        kStrategy strat=new skStrategy;
        //        strat->tailRing = currRing;
        res->data = p_Shrink(p, lV, currRing);
        return FALSE;
      }
      else return TRUE;
    }
    else
  #endif
  /*==================== pcv ==================================*/
  #ifdef HAVE_PCV
    if(strcmp(sys_cmd,"pcvLAddL")==0)
    {
      return pcvLAddL(res,h);
    }
    else
    if(strcmp(sys_cmd,"pcvPMulL")==0)
    {
      return pcvPMulL(res,h);
    }
    else
    if(strcmp(sys_cmd,"pcvMinDeg")==0)
    {
      return pcvMinDeg(res,h);
    }
    else
    if(strcmp(sys_cmd,"pcvP2CV")==0)
    {
      return pcvP2CV(res,h);
    }
    else
    if(strcmp(sys_cmd,"pcvCV2P")==0)
    {
      return pcvCV2P(res,h);
    }
    else
    if(strcmp(sys_cmd,"pcvDim")==0)
    {
      return pcvDim(res,h);
    }
    else
    if(strcmp(sys_cmd,"pcvBasis")==0)
    {
      return pcvBasis(res,h);
    }
    else
  #endif
  /*==================== hessenberg/eigenvalues ==================================*/
  #ifdef HAVE_EIGENVAL
    if(strcmp(sys_cmd,"hessenberg")==0)
    {
      return evHessenberg(res,h);
    }
    else
  #endif
  /*==================== eigenvalues ==================================*/
  #ifdef HAVE_EIGENVAL
    if(strcmp(sys_cmd,"eigenvals")==0)
    {
      return evEigenvals(res,h);
    }
    else
  #endif
  /*==================== rowelim ==================================*/
  #ifdef HAVE_EIGENVAL
    if(strcmp(sys_cmd,"rowelim")==0)
    {
      return evRowElim(res,h);
    }
    else
  #endif
  /*==================== rowcolswap ==================================*/
  #ifdef HAVE_EIGENVAL
    if(strcmp(sys_cmd,"rowcolswap")==0)
    {
      return evSwap(res,h);
    }
    else
  #endif
  /*==================== Gauss-Manin system ==================================*/
  #ifdef HAVE_GMS
    if(strcmp(sys_cmd,"gmsnf")==0)
    {
      return gmsNF(res,h);
    }
    else
  #endif
  /*==================== contributors =============================*/
    if(strcmp(sys_cmd,"contributors") == 0)
    {
      res->rtyp=STRING_CMD;
      res->data=(void *)omStrDup(
         "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");
      return FALSE;
    }
    else
  /*==================== spectrum =============================*/
    #ifdef HAVE_SPECTRUM
    if(strcmp(sys_cmd,"spectrum") == 0)
    {
      if ((h==NULL) || (h->Typ()!=POLY_CMD))
      {
        WerrorS("poly expected");
        return TRUE;
      }
      if (h->next==NULL)
        return spectrumProc(res,h);
      if (h->next->Typ()!=INT_CMD)
      {
        WerrorS("poly,int expected");
        return TRUE;
      }
      if(((long)h->next->Data())==1L)
         return spectrumfProc(res,h);
      return spectrumProc(res,h);
    }
    else
  /*==================== semic =============================*/
    if(strcmp(sys_cmd,"semic") == 0)
    {
      if ((h->next!=NULL)
      && (h->Typ()==LIST_CMD)
      && (h->next->Typ()==LIST_CMD))
      {
        if (h->next->next==NULL)
          return semicProc(res,h,h->next);
        else if (h->next->next->Typ()==INT_CMD)
          return semicProc3(res,h,h->next,h->next->next);
      }
      return TRUE;
    }
    else
  /*==================== spadd =============================*/
    if(strcmp(sys_cmd,"spadd") == 0)
    {
      const short t[]={2,LIST_CMD,LIST_CMD};
      if (iiCheckTypes(h,t,1))
      {
        return spaddProc(res,h,h->next);
      }
      return TRUE;
    }
    else
  /*==================== spmul =============================*/
    if(strcmp(sys_cmd,"spmul") == 0)
    {
      const short t[]={2,LIST_CMD,INT_CMD};
      if (iiCheckTypes(h,t,1))
      {
        return spmulProc(res,h,h->next);
      }
      return TRUE;
    }
    else
  #endif
/*==================== tensorModuleMult ========================= */
  #define HAVE_SHEAFCOH_TRICKS 1

  #ifdef HAVE_SHEAFCOH_TRICKS
    if(strcmp(sys_cmd,"tensorModuleMult")==0)
    {
      const short t[]={2,INT_CMD,MODUL_CMD};
  //      WarnS("tensorModuleMult!");
      if (iiCheckTypes(h,t,1))
      {
        int m = (int)( (long)h->Data() );
        ideal M = (ideal)h->next->Data();
        res->rtyp=MODUL_CMD;
        res->data=(void *)id_TensorModuleMult(m, M, currRing);
        return FALSE;
      }
      return TRUE;
    }
    else
  #endif
  /*==================== twostd  =================*/
  #ifdef HAVE_PLURAL
    if (strcmp(sys_cmd, "twostd") == 0)
    {
      ideal I;
      if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
      {
        I=(ideal)h->CopyD();
        res->rtyp=IDEAL_CMD;
        if (rIsPluralRing(currRing)) res->data=twostd(I);
        else res->data=I;
        setFlag(res,FLAG_TWOSTD);
        setFlag(res,FLAG_STD);
      }
      else return TRUE;
      return FALSE;
    }
    else
  #endif
  /*==================== lie bracket =================*/
  #ifdef HAVE_PLURAL
    if (strcmp(sys_cmd, "bracket") == 0)
    {
      const short t[]={2,POLY_CMD,POLY_CMD};
      if (iiCheckTypes(h,t,1))
      {
        poly p=(poly)h->CopyD();
        h=h->next;
        poly q=(poly)h->Data();
        res->rtyp=POLY_CMD;
        if (rIsPluralRing(currRing))  res->data=nc_p_Bracket_qq(p,q, currRing);
        return FALSE;
      }
      return TRUE;
    }
    else
  #endif
  /*==================== env ==================================*/
  #ifdef HAVE_PLURAL
    if (strcmp(sys_cmd, "env")==0)
    {
      if ((h!=NULL) && (h->Typ()==RING_CMD))
      {
        ring r = (ring)h->Data();
        res->data = rEnvelope(r);
        res->rtyp = RING_CMD;
        return FALSE;
      }
      else
      {
        WerrorS("`system(\"env\",<ring>)` expected");
        return TRUE;
      }
    }
    else
  #endif
/* ============ opp ======================== */
  #ifdef HAVE_PLURAL
    if (strcmp(sys_cmd, "opp")==0)
    {
      if ((h!=NULL) && (h->Typ()==RING_CMD))
      {
        ring r=(ring)h->Data();
        res->data=rOpposite(r);
        res->rtyp=RING_CMD;
        return FALSE;
      }
      else
      {
        WerrorS("`system(\"opp\",<ring>)` expected");
        return TRUE;
      }
    }
    else
  #endif
  /*==================== oppose ==================================*/
  #ifdef HAVE_PLURAL
    if (strcmp(sys_cmd, "oppose")==0)
    {
      if ((h!=NULL) && (h->Typ()==RING_CMD)
      && (h->next!= NULL))
      {
        ring Rop = (ring)h->Data();
        h   = h->next;
        idhdl w;
        if ((w=Rop->idroot->get(h->Name(),myynest))!=NULL)
        {
          poly p = (poly)IDDATA(w);
          res->data = pOppose(Rop, p, currRing); // into CurrRing?
          res->rtyp = POLY_CMD;
          return FALSE;
        }
      }
      else
      {
        WerrorS("`system(\"oppose\",<ring>,<poly>)` expected");
        return TRUE;
      }
    }
    else
  #endif
  /*==================== freeGB, twosided GB in free algebra =================*/
  #ifdef HAVE_PLURAL
  #ifdef HAVE_SHIFTBBA
    if (strcmp(sys_cmd, "freegb") == 0)
    {
      const short t[]={3,IDEAL_CMD,INT_CMD,INT_CMD};
      if (iiCheckTypes(h,t,1))
      {
        ideal I=(ideal)h->CopyD();
        h=h->next;
        int uptodeg=(int)((long)(h->Data()));
        h=h->next;
        int lVblock=(int)((long)(h->Data()));
        res->data = freegb(I,uptodeg,lVblock);
        if (res->data == NULL)
        {
          /* that is there were input errors */
          res->data = I;
        }
        res->rtyp = IDEAL_CMD;
        return FALSE;
      }
      else return TRUE;
    }
    else
  #endif /*SHIFTBBA*/
  #endif /*PLURAL*/
  /*==================== walk stuff =================*/
  /*==================== walkNextWeight =================*/
  #ifdef HAVE_WALK
  #ifdef OWNW
    if (strcmp(sys_cmd, "walkNextWeight") == 0)
    {
      const short t[]={3,INTVEC_CMD,INTVEC_CMD,IDEAL_CMD};
      if (!iiCheckTypes(h,t,1)) return TRUE;
      if (((intvec*) h->Data())->length() != currRing->N ||
          ((intvec*) h->next->Data())->length() != currRing->N)
      {
        Werror("system(\"walkNextWeight\" ...) intvecs not of length %d\n",
               currRing->N);
        return TRUE;
      }
      res->data = (void*) walkNextWeight(((intvec*) h->Data()),
                                         ((intvec*) h->next->Data()),
                                         (ideal) h->next->next->Data());
      if (res->data == NULL || res->data == (void*) 1L)
      {
        res->rtyp = INT_CMD;
      }
      else
      {
        res->rtyp = INTVEC_CMD;
      }
      return FALSE;
    }
    else
  #endif
  #endif
  /*==================== walkNextWeight =================*/
  #ifdef HAVE_WALK
  #ifdef OWNW
    if (strcmp(sys_cmd, "walkInitials") == 0)
    {
      if (h == NULL || h->Typ() != IDEAL_CMD)
      {
        WerrorS("system(\"walkInitials\", ideal) expected");
        return TRUE;
      }
      res->data = (void*) walkInitials((ideal) h->Data());
      res->rtyp = IDEAL_CMD;
      return FALSE;
    }
    else
  #endif
  #endif
  /*==================== walkAddIntVec =================*/
  #ifdef HAVE_WALK
  #ifdef WAIV
    if (strcmp(sys_cmd, "walkAddIntVec") == 0)
    {
      const short t[]={2,INTVEC_CMD,INTVEC_CMD};
      if (!iiCheckTypes(h,t,1)) return TRUE;
      intvec* arg1 = (intvec*) h->Data();
      intvec* arg2 = (intvec*) h->next->Data();
      res->data = (intvec*) walkAddIntVec(arg1, arg2);
      res->rtyp = INTVEC_CMD;
      return FALSE;
    }
    else
  #endif
  #endif
  /*==================== MwalkNextWeight =================*/
  #ifdef HAVE_WALK
  #ifdef MwaklNextWeight
    if (strcmp(sys_cmd, "MwalkNextWeight") == 0)
    {
      const short t[]={3,INTVEC_CMD,INTVEC_CMD,IDEAL_CMD};
      if (!iiCheckTypes(h,t,1)) return TRUE;
      if (((intvec*) h->Data())->length() != currRing->N ||
        ((intvec*) h->next->Data())->length() != currRing->N)
      {
        Werror("system(\"MwalkNextWeight\" ...) intvecs not of length %d\n",
               currRing->N);
        return TRUE;
      }
      intvec* arg1 = (intvec*) h->Data();
      intvec* arg2 = (intvec*) h->next->Data();
      ideal arg3   =   (ideal) h->next->next->Data();
      intvec* result = (intvec*) MwalkNextWeight(arg1, arg2, arg3);
      res->rtyp = INTVEC_CMD;
      res->data =  result;
      return FALSE;
    }
    else
  #endif //MWalkNextWeight
  #endif
  /*==================== Mivdp =================*/
  #ifdef HAVE_WALK
    if(strcmp(sys_cmd, "Mivdp") == 0)
    {
      if (h == NULL || h->Typ() != INT_CMD)
      {
        WerrorS("system(\"Mivdp\", int) expected");
        return TRUE;
      }
      if ((int) ((long)(h->Data())) != currRing->N)
      {
        Werror("system(\"Mivdp\" ...) intvecs not of length %d\n",
               currRing->N);
        return TRUE;
      }
      int arg1 = (int) ((long)(h->Data()));
      intvec* result = (intvec*) Mivdp(arg1);
      res->rtyp = INTVEC_CMD;
      res->data =  result;
      return FALSE;
    }
    else
  #endif
  /*==================== Mivlp =================*/
  #ifdef HAVE_WALK
    if(strcmp(sys_cmd, "Mivlp") == 0)
    {
      if (h == NULL || h->Typ() != INT_CMD)
      {
        WerrorS("system(\"Mivlp\", int) expected");
        return TRUE;
      }
      if ((int) ((long)(h->Data())) != currRing->N)
      {
        Werror("system(\"Mivlp\" ...) intvecs not of length %d\n",
               currRing->N);
        return TRUE;
      }
      int arg1 = (int) ((long)(h->Data()));
      intvec* result = (intvec*) Mivlp(arg1);
      res->rtyp = INTVEC_CMD;
      res->data =  result;
      return FALSE;
    }
    else
  #endif
  /*==================== MpDiv =================*/
  #ifdef HAVE_WALK
  #ifdef MpDiv
    if(strcmp(sys_cmd, "MpDiv") == 0)
    {
      const short t[]={2,POLY_CMD,POLY_CMD};
      if (!iiCheckTypes(h,t,1)) return TRUE;
      poly arg1 = (poly) h->Data();
      poly arg2 = (poly) h->next->Data();
      poly result = MpDiv(arg1, arg2);
      res->rtyp = POLY_CMD;
      res->data = result;
      return FALSE;
    }
    else
  #endif
  #endif
  /*==================== MpMult =================*/
  #ifdef HAVE_WALK
  #ifdef MpMult
    if(strcmp(sys_cmd, "MpMult") == 0)
    {
      const short t[]={2,POLY_CMD,POLY_CMD};
      if (!iiCheckTypes(h,t,1)) return TRUE;
      poly arg1 = (poly) h->Data();
      poly arg2 = (poly) h->next->Data();
      poly result = MpMult(arg1, arg2);
      res->rtyp = POLY_CMD;
      res->data = result;
      return FALSE;
    }
    else
  #endif
  #endif
  /*==================== MivSame =================*/
  #ifdef HAVE_WALK
    if (strcmp(sys_cmd, "MivSame") == 0)
    {
      const short t[]={2,INTVEC_CMD,INTVEC_CMD};
      if (!iiCheckTypes(h,t,1)) return TRUE;
      /*
      if (((intvec*) h->Data())->length() != currRing->N ||
      ((intvec*) h->next->Data())->length() != currRing->N)
      {
        Werror("system(\"MivSame\" ...) intvecs not of length %d\n",
               currRing->N);
        return TRUE;
      }
      */
      intvec* arg1 = (intvec*) h->Data();
      intvec* arg2 = (intvec*) h->next->Data();
      /*
      poly result = (poly) MivSame(arg1, arg2);
      res->rtyp = POLY_CMD;
      res->data =  (poly) result;
      */
      res->rtyp = INT_CMD;
      res->data = (void*)(long) MivSame(arg1, arg2);
      return FALSE;
    }
    else
  #endif
  /*==================== M3ivSame =================*/
  #ifdef HAVE_WALK
    if (strcmp(sys_cmd, "M3ivSame") == 0)
    {
      const short t[]={3,INTVEC_CMD,INTVEC_CMD,INTVEC_CMD};
      if (!iiCheckTypes(h,t,1)) return TRUE;
      /*
      if (((intvec*) h->Data())->length() != currRing->N ||
        ((intvec*) h->next->Data())->length() != currRing->N ||
        ((intvec*) h->next->next->Data())->length() != currRing->N )
      {
        Werror("system(\"M3ivSame\" ...) intvecs not of length %d\n",
              currRing->N);
        return TRUE;
      }
      */
      intvec* arg1 = (intvec*) h->Data();
      intvec* arg2 = (intvec*) h->next->Data();
      intvec* arg3 = (intvec*) h->next->next->Data();
      /*
      poly result = (poly) M3ivSame(arg1, arg2, arg3);
      res->rtyp = POLY_CMD;
      res->data =  (poly) result;
      */
      res->rtyp = INT_CMD;
      res->data = (void*)(long) M3ivSame(arg1, arg2, arg3);
      return FALSE;
    }
    else
  #endif
  /*==================== MwalkInitialForm =================*/
  #ifdef HAVE_WALK
    if(strcmp(sys_cmd, "MwalkInitialForm") == 0)
    {
      const short t[]={2,IDEAL_CMD,INTVEC_CMD};
      if (!iiCheckTypes(h,t,1)) return TRUE;
      if(((intvec*) h->next->Data())->length() != currRing->N)
      {
        Werror("system \"MwalkInitialForm\"...) intvec not of length %d\n",
               currRing->N);
        return TRUE;
      }
      ideal id      = (ideal) h->Data();
      intvec* int_w = (intvec*) h->next->Data();
      ideal result  = (ideal) MwalkInitialForm(id, int_w);
      res->rtyp = IDEAL_CMD;
      res->data = result;
      return FALSE;
    }
    else
  #endif
  /*==================== MivMatrixOrder =================*/
  #ifdef HAVE_WALK
    /************** Perturbation walk **********/
    if(strcmp(sys_cmd, "MivMatrixOrder") == 0)
    {
      if(h==NULL || h->Typ() != INTVEC_CMD)
      {
        WerrorS("system(\"MivMatrixOrder\",intvec) expected");
        return TRUE;
      }
      intvec* arg1 = (intvec*) h->Data();
      intvec* result = MivMatrixOrder(arg1);
      res->rtyp = INTVEC_CMD;
      res->data =  result;
      return FALSE;
    }
    else
  #endif
  /*==================== MivMatrixOrderdp =================*/
  #ifdef HAVE_WALK
    if(strcmp(sys_cmd, "MivMatrixOrderdp") == 0)
    {
      if(h==NULL || h->Typ() != INT_CMD)
      {
        WerrorS("system(\"MivMatrixOrderdp\",intvec) expected");
        return TRUE;
      }
      int arg1 = (int) ((long)(h->Data()));
      intvec* result = (intvec*) MivMatrixOrderdp(arg1);
      res->rtyp = INTVEC_CMD;
      res->data =  result;
      return FALSE;
    }
    else
  #endif
  /*==================== MPertVectors =================*/
  #ifdef HAVE_WALK
    if(strcmp(sys_cmd, "MPertVectors") == 0)
    {
      const short t[]={3,IDEAL_CMD,INTVEC_CMD,INT_CMD};
      if (!iiCheckTypes(h,t,1)) return TRUE;
      ideal arg1 = (ideal) h->Data();
      intvec* arg2 = (intvec*) h->next->Data();
      int arg3 = (int) ((long)(h->next->next->Data()));
      intvec* result = (intvec*) MPertVectors(arg1, arg2, arg3);
      res->rtyp = INTVEC_CMD;
      res->data =  result;
      return FALSE;
    }
    else
  #endif
  /*==================== MPertVectorslp =================*/
  #ifdef HAVE_WALK
    if(strcmp(sys_cmd, "MPertVectorslp") == 0)
    {
      const short t[]={3,IDEAL_CMD,INTVEC_CMD,INT_CMD};
      if (!iiCheckTypes(h,t,1)) return TRUE;
      ideal arg1 = (ideal) h->Data();
      intvec* arg2 = (intvec*) h->next->Data();
      int arg3 = (int) ((long)(h->next->next->Data()));
      intvec* result = (intvec*) MPertVectorslp(arg1, arg2, arg3);
      res->rtyp = INTVEC_CMD;
      res->data =  result;
      return FALSE;
    }
    else
  #endif
    /************** fractal walk **********/
  #ifdef HAVE_WALK
    if(strcmp(sys_cmd, "Mfpertvector") == 0)
    {
      const short t[]={2,IDEAL_CMD,INTVEC_CMD};
      if (!iiCheckTypes(h,t,1)) return TRUE;
      ideal arg1 = (ideal) h->Data();
      intvec* arg2 = (intvec*) h->next->Data();
      intvec* result = Mfpertvector(arg1, arg2);
      res->rtyp = INTVEC_CMD;
      res->data =  result;
      return FALSE;
    }
    else
  #endif
  /*==================== MivUnit =================*/
  #ifdef HAVE_WALK
    if(strcmp(sys_cmd, "MivUnit") == 0)
    {
      const short t[]={1,INT_CMD};
      if (!iiCheckTypes(h,t,1)) return TRUE;
      int arg1 = (int) ((long)(h->Data()));
      intvec* result = (intvec*) MivUnit(arg1);
      res->rtyp = INTVEC_CMD;
      res->data =  result;
      return FALSE;
    }
    else
  #endif
  /*==================== MivWeightOrderlp =================*/
  #ifdef HAVE_WALK
    if(strcmp(sys_cmd, "MivWeightOrderlp") == 0)
    {
      const short t[]={1,INTVEC_CMD};
      if (!iiCheckTypes(h,t,1)) return TRUE;
      intvec* arg1 = (intvec*) h->Data();
      intvec* result = MivWeightOrderlp(arg1);
      res->rtyp = INTVEC_CMD;
      res->data =  result;
      return FALSE;
    }
    else
  #endif
  /*==================== MivWeightOrderdp =================*/
  #ifdef HAVE_WALK
    if(strcmp(sys_cmd, "MivWeightOrderdp") == 0)
    {
      if(h==NULL || h->Typ() != INTVEC_CMD)
      {
        WerrorS("system(\"MivWeightOrderdp\",intvec) expected");
        return TRUE;
      }
      intvec* arg1 = (intvec*) h->Data();
      //int arg2 = (int) h->next->Data();
      intvec* result = MivWeightOrderdp(arg1);
      res->rtyp = INTVEC_CMD;
      res->data =  result;
      return FALSE;
    }
    else
  #endif
  /*==================== MivMatrixOrderlp =================*/
  #ifdef HAVE_WALK
    if(strcmp(sys_cmd, "MivMatrixOrderlp") == 0)
    {
      if(h==NULL || h->Typ() != INT_CMD)
      {
        WerrorS("system(\"MivMatrixOrderlp\",int) expected");
        return TRUE;
      }
      int arg1 = (int) ((long)(h->Data()));
      intvec* result = (intvec*) MivMatrixOrderlp(arg1);
      res->rtyp = INTVEC_CMD;
      res->data =  result;
      return FALSE;
    }
    else
  #endif
  /*==================== MkInterRedNextWeight =================*/
  #ifdef HAVE_WALK
    if (strcmp(sys_cmd, "MkInterRedNextWeight") == 0)
    {
      const short t[]={3,INTVEC_CMD,INTVEC_CMD,IDEAL_CMD};
      if (!iiCheckTypes(h,t,1)) return TRUE;
      if (((intvec*) h->Data())->length() != currRing->N ||
        ((intvec*) h->next->Data())->length() != currRing->N)
      {
        Werror("system(\"MkInterRedNextWeight\" ...) intvecs not of length %d\n",
                 currRing->N);
        return TRUE;
      }
      intvec* arg1 = (intvec*) h->Data();
      intvec* arg2 = (intvec*) h->next->Data();
      ideal arg3   =   (ideal) h->next->next->Data();
      intvec* result = (intvec*) MkInterRedNextWeight(arg1, arg2, arg3);
      res->rtyp = INTVEC_CMD;
      res->data =  result;
      return FALSE;
    }
    else
  #endif
  /*==================== MPertNextWeight =================*/
  #ifdef HAVE_WALK
  #ifdef MPertNextWeight
    if (strcmp(sys_cmd, "MPertNextWeight") == 0)
    {
      const short t[]={3,INTVEC_CMD,IDEAL_CMD,INT_CMD};
      if (!iiCheckTypes(h,t,1)) return TRUE;
      if (((intvec*) h->Data())->length() != currRing->N)
      {
        Werror("system(\"MPertNextWeight\" ...) intvecs not of length %d\n",
                 currRing->N);
        return TRUE;
      }
      intvec* arg1 = (intvec*) h->Data();
      ideal arg2 = (ideal) h->next->Data();
      int arg3   =   (int) h->next->next->Data();
      intvec* result = (intvec*) MPertNextWeight(arg1, arg2, arg3);
      res->rtyp = INTVEC_CMD;
      res->data =  result;
      return FALSE;
    }
    else
  #endif //MPertNextWeight
  #endif
  /*==================== Mivperttarget =================*/
  #ifdef HAVE_WALK
  #ifdef Mivperttarget
    if (strcmp(sys_cmd, "Mivperttarget") == 0)
    {
      const short t[]={2,IDEAL_CMD,INT_CMD};
      if (!iiCheckTypes(h,t,1)) return TRUE;
      ideal arg1 = (ideal) h->Data();
      int arg2 = (int) h->next->Data();
      intvec* result = (intvec*) Mivperttarget(arg1, arg2);
      res->rtyp = INTVEC_CMD;
      res->data =  result;
      return FALSE;
    }
    else
  #endif //Mivperttarget
  #endif
  /*==================== Mwalk =================*/
  #ifdef HAVE_WALK
    if (strcmp(sys_cmd, "Mwalk") == 0)
    {
      const short t[]={4,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,RING_CMD};
      if (!iiCheckTypes(h,t,1)) return TRUE;
      if (((intvec*) h->next->Data())->length() != currRing->N &&
        ((intvec*) h->next->next->Data())->length() != currRing->N )
      {
        Werror("system(\"Mwalk\" ...) intvecs not of length %d\n",
           currRing->N);
        return TRUE;
      }
      ideal arg1 = (ideal) h->Data();
      intvec* arg2 = (intvec*) h->next->Data();
      intvec* arg3   =  (intvec*) h->next->next->Data();
      ring arg4   =  (ring) h->next->next->next->Data();
      ideal result = (ideal) Mwalk(arg1, arg2, arg3,arg4);
      res->rtyp = IDEAL_CMD;
      res->data =  result;
      return FALSE;
    }
    else
  #endif
  /*==================== Mpwalk =================*/
  #ifdef HAVE_WALK
  #ifdef MPWALK_ORIG
    if (strcmp(sys_cmd, "Mwalk") == 0)
    {
      const short t[]={4,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,RING_CMD};
      if (!iiCheckTypes(h,t,1)) return TRUE;
      if ((((intvec*) h->next->Data())->length() != currRing->N &&
          ((intvec*) h->next->next->Data())->length() != currRing->N ) &&
          (((intvec*) h->next->Data())->length() != (currRing->N)*(currRing->N) &&
          ((intvec*) h->next->next->Data())->length() != (currRing->N)*(currRing->N)))
      {
        Werror("system(\"Mwalk\" ...) intvecs not of length %d or %d\n",
               currRing->N,(currRing->N)*(currRing->N));
        return TRUE;
      }
      ideal arg1 = (ideal) h->Data();
      intvec* arg2 = (intvec*) h->next->Data();
      intvec* arg3   =  (intvec*) h->next->next->Data();
      ring arg4 = (ring) h->next->next->next->Data();
      ideal result = (ideal) Mwalk(arg1, arg2, arg3,arg4);
      res->rtyp = IDEAL_CMD;
      res->data =  result;
      return FALSE;
    }
    else
  #else
    if (strcmp(sys_cmd, "Mpwalk") == 0)
    {
      const short t[]={6,IDEAL_CMD,INT_CMD,INT_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD};
      if (!iiCheckTypes(h,t,1)) return TRUE;
      if(((intvec*) h->next->next->next->Data())->length() != currRing->N &&
         ((intvec*) h->next->next->next->next->Data())->length()!=currRing->N)
      {
        Werror("system(\"Mpwalk\" ...) intvecs not of length %d\n",currRing->N);
        return TRUE;
      }
      ideal arg1 = (ideal) h->Data();
      int arg2 = (int) (long) h->next->Data();
      int arg3 = (int) (long) h->next->next->Data();
      intvec* arg4 = (intvec*) h->next->next->next->Data();
      intvec* arg5 = (intvec*) h->next->next->next->next->Data();
      int arg6 = (int) (long) h->next->next->next->next->next->Data();
      ideal result = (ideal) Mpwalk(arg1, arg2, arg3, arg4, arg5,arg6);
      res->rtyp = IDEAL_CMD;
      res->data =  result;
      return FALSE;
    }
    else
    #endif
  #endif
  /*==================== Mrwalk =================*/
  #ifdef HAVE_WALK
    if (strcmp(sys_cmd, "Mrwalk") == 0)
    {
      const short t[]={6,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD,RING_CMD};
      if (!iiCheckTypes(h,t,1)) return TRUE;
      if((((intvec*) h->next->Data())->length() != currRing->N &&
         ((intvec*) h->next->next->Data())->length() != currRing->N ) &&
         (((intvec*) h->next->Data())->length() != (currRing->N)*(currRing->N) &&
         ((intvec*) h->next->next->Data())->length() != (currRing->N)*(currRing->N) ))
      {
        Werror("system(\"Mrwalk\" ...) intvecs not of length %d or %d\n",
               currRing->N,(currRing->N)*(currRing->N));
        return TRUE;
      }
      ideal arg1 = (ideal) h->Data();
      intvec* arg2 = (intvec*) h->next->Data();
      intvec* arg3 =  (intvec*) h->next->next->Data();
      int arg4 = (int)(long) h->next->next->next->Data();
      int arg5 = (int)(long) h->next->next->next->next->Data();
      ring arg6 = (ring) h->next->next->next->next->next->Data();
      ideal result = (ideal) Mrwalk(arg1, arg2, arg3, arg4, arg5, arg6);
      res->rtyp = IDEAL_CMD;
      res->data =  result;
      return FALSE;
    }
    else
  #endif
  /*==================== MAltwalk1 =================*/
  #ifdef HAVE_WALK
    if (strcmp(sys_cmd, "MAltwalk1") == 0)
    {
      const short t[]={5,IDEAL_CMD,INT_CMD,INT_CMD,INTVEC_CMD,INTVEC_CMD};
      if (!iiCheckTypes(h,t,1)) return TRUE;
      if (((intvec*) h->next->next->next->Data())->length() != currRing->N &&
        ((intvec*) h->next->next->next->next->Data())->length()!=currRing->N)
      {
        Werror("system(\"MAltwalk1\" ...) intvecs not of length %d\n",
                 currRing->N);
        return TRUE;
      }
      ideal arg1 = (ideal) h->Data();
      int arg2 = (int) ((long)(h->next->Data()));
      int arg3 = (int) ((long)(h->next->next->Data()));
      intvec* arg4 = (intvec*) h->next->next->next->Data();
      intvec* arg5   =  (intvec*) h->next->next->next->next->Data();
      ideal result = (ideal) MAltwalk1(arg1, arg2, arg3, arg4, arg5);
      res->rtyp = IDEAL_CMD;
      res->data =  result;
      return FALSE;
    }
    else
  #endif
  /*==================== MAltwalk1 =================*/
  #ifdef HAVE_WALK
  #ifdef MFWALK_ALT
    if (strcmp(sys_cmd, "Mfwalk_alt") == 0)
    {
      const short t[]={4,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD};
      if (!iiCheckTypes(h,t,1)) return TRUE;
      if (((intvec*) h->next->Data())->length() != currRing->N &&
        ((intvec*) h->next->next->Data())->length() != currRing->N )
      {
        Werror("system(\"Mfwalk\" ...) intvecs not of length %d\n",
              currRing->N);
        return TRUE;
      }
      ideal arg1 = (ideal) h->Data();
      intvec* arg2 = (intvec*) h->next->Data();
      intvec* arg3   =  (intvec*) h->next->next->Data();
      int arg4 = (int) h->next->next->next->Data();
      ideal result = (ideal) Mfwalk_alt(arg1, arg2, arg3, arg4);
      res->rtyp = IDEAL_CMD;
      res->data =  result;
      return FALSE;
    }
    else
  #endif
  #endif
  /*==================== Mfwalk =================*/
  #ifdef HAVE_WALK
    if (strcmp(sys_cmd, "Mfwalk") == 0)
    {
      const short t[]={3,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD};
      if (!iiCheckTypes(h,t,1)) return TRUE;
      if (((intvec*) h->next->Data())->length() != currRing->N &&
        ((intvec*) h->next->next->Data())->length() != currRing->N )
      {
        Werror("system(\"Mfwalk\" ...) intvecs not of length %d\n",
                 currRing->N);
        return TRUE;
      }
      ideal arg1 = (ideal) h->Data();
      intvec* arg2 = (intvec*) h->next->Data();
      intvec* arg3   =  (intvec*) h->next->next->Data();
      ideal result = (ideal) Mfwalk(arg1, arg2, arg3);
      res->rtyp = IDEAL_CMD;
      res->data =  result;
      return FALSE;
    }
    else
  #endif
  /*==================== Mfrwalk =================*/
  #ifdef HAVE_WALK
    if (strcmp(sys_cmd, "Mfrwalk") == 0)
    {
      const short t[]={6,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD,RING_CMD};
      if (!iiCheckTypes(h,t,1)) return TRUE;
      if (((intvec*) h->next->Data())->length() != currRing->N &&
          ((intvec*) h->next->next->Data())->length() != currRing->N)
      {
        Werror("system(\"Mfrwalk\" ...) intvecs not of length %d\n",currRing->N);
        return TRUE;
      }
      ideal arg1 = (ideal) h->Data();
      intvec* arg2 = (intvec*) h->next->Data();
      intvec* arg3 = (intvec*) h->next->next->Data();
      int arg4 = (int)(long) h->next->next->next->Data();
      ideal result = (ideal) Mfrwalk(arg1, arg2, arg3, arg4);
      res->rtyp = IDEAL_CMD;
      res->data =  result;
      return FALSE;
    }
    else
  /*==================== Mprwalk =================*/
    if (strcmp(sys_cmd, "Mprwalk") == 0)
    {
      const short t[]={7,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD,INT_CMD,RING_CMD};
      if (!iiCheckTypes(h,t,1)) return TRUE;
      if (((intvec*) h->next->Data())->length() != currRing->N &&
          ((intvec*) h->next->next->Data())->length() != currRing->N )
      {
        Werror("system(\"Mrwalk\" ...) intvecs not of length %d\n",
               currRing->N);
        return TRUE;
      }
      ideal arg1 = (ideal) h->Data();
      intvec* arg2 = (intvec*) h->next->Data();
      intvec* arg3 =  (intvec*) h->next->next->Data();
      int arg4 = (int)(long) h->next->next->next->Data();
      int arg5 = (int)(long) h->next->next->next->next->Data();
      int arg6 = (int)(long) h->next->next->next->next->next->Data();
      ring arg7 = (ring) h->next->next->next->next->next->next->Data();
      ideal result = (ideal) Mprwalk(arg1, arg2, arg3, arg4, arg5, arg6, arg7);
      res->rtyp = IDEAL_CMD;
      res->data =  result;
      return FALSE;
    }
    else
  #endif
  /*==================== TranMImprovwalk =================*/
  #ifdef HAVE_WALK
  #ifdef TRAN_Orig
    if (strcmp(sys_cmd, "TranMImprovwalk") == 0)
    {
      const short t[]={3,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD};
      if (!iiCheckTypes(h,t,1)) return TRUE;
      if (((intvec*) h->next->Data())->length() != currRing->N &&
        ((intvec*) h->next->next->Data())->length() != currRing->N )
      {
        Werror("system(\"TranMImprovwalk\" ...) intvecs not of length %d\n",
              currRing->N);
        return TRUE;
      }
      ideal arg1 = (ideal) h->Data();
      intvec* arg2 = (intvec*) h->next->Data();
      intvec* arg3   =  (intvec*) h->next->next->Data();
      ideal result = (ideal) TranMImprovwalk(arg1, arg2, arg3);
      res->rtyp = IDEAL_CMD;
      res->data =  result;
      return FALSE;
    }
    else
  #endif
  #endif
  /*==================== MAltwalk2 =================*/
  #ifdef HAVE_WALK
    if (strcmp(sys_cmd, "MAltwalk2") == 0)
    {
      const short t[]={3,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD};
      if (!iiCheckTypes(h,t,1)) return TRUE;
      if (((intvec*) h->next->Data())->length() != currRing->N &&
        ((intvec*) h->next->next->Data())->length() != currRing->N )
      {
        Werror("system(\"MAltwalk2\" ...) intvecs not of length %d\n",
                 currRing->N);
        return TRUE;
      }
      ideal arg1 = (ideal) h->Data();
      intvec* arg2 = (intvec*) h->next->Data();
      intvec* arg3   =  (intvec*) h->next->next->Data();
      ideal result = (ideal) MAltwalk2(arg1, arg2, arg3);
      res->rtyp = IDEAL_CMD;
      res->data =  result;
      return FALSE;
    }
    else
  #endif
  /*==================== MAltwalk2 =================*/
  #ifdef HAVE_WALK
    if (strcmp(sys_cmd, "TranMImprovwalk") == 0)
    {
      const short t[]={4,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD};
      if (!iiCheckTypes(h,t,1)) return TRUE;
      if (((intvec*) h->next->Data())->length() != currRing->N &&
        ((intvec*) h->next->next->Data())->length() != currRing->N )
      {
        Werror("system(\"TranMImprovwalk\" ...) intvecs not of length %d\n",
                 currRing->N);
        return TRUE;
      }
      ideal arg1 = (ideal) h->Data();
      intvec* arg2 = (intvec*) h->next->Data();
      intvec* arg3   =  (intvec*) h->next->next->Data();
      int arg4   =  (int) ((long)(h->next->next->next->Data()));
      ideal result = (ideal) TranMImprovwalk(arg1, arg2, arg3, arg4);
      res->rtyp = IDEAL_CMD;
      res->data =  result;
      return FALSE;
    }
    else
  #endif
  /*==================== TranMrImprovwalk =================*/
  #if 0
  #ifdef HAVE_WALK
    if (strcmp(sys_cmd, "TranMrImprovwalk") == 0)
    {
      if (h == NULL || h->Typ() != IDEAL_CMD ||
        h->next == NULL || h->next->Typ() != INTVEC_CMD ||
        h->next->next == NULL || h->next->next->Typ() != INTVEC_CMD ||
        h->next->next->next == NULL || h->next->next->next->Typ() != INT_CMD ||
        h->next->next->next == NULL || h->next->next->next->next->Typ() != INT_CMD ||
        h->next->next->next == NULL || h->next->next->next->next->next->Typ() != INT_CMD)
      {
        WerrorS("system(\"TranMrImprovwalk\", ideal, intvec, intvec) expected");
        return TRUE;
      }
      if (((intvec*) h->next->Data())->length() != currRing->N &&
        ((intvec*) h->next->next->Data())->length() != currRing->N )
      {
        Werror("system(\"TranMrImprovwalk\" ...) intvecs not of length %d\n", currRing->N);
        return TRUE;
      }
      ideal arg1 = (ideal) h->Data();
      intvec* arg2 = (intvec*) h->next->Data();
      intvec* arg3 = (intvec*) h->next->next->Data();
      int arg4 = (int)(long) h->next->next->next->Data();
      int arg5 = (int)(long) h->next->next->next->next->Data();
      int arg6 = (int)(long) h->next->next->next->next->next->Data();
      ideal result = (ideal) TranMrImprovwalk(arg1, arg2, arg3, arg4, arg5, arg6);
      res->rtyp = IDEAL_CMD;
      res->data =  result;
      return FALSE;
    }
    else
  #endif
  #endif
  /*================= Extended system call ========================*/
    {
       #ifndef MAKE_DISTRIBUTION
       return(jjEXTENDED_SYSTEM(res, args));
       #else
       Werror( "system(\"%s\",...) %s", sys_cmd, feNotImplemented );
       #endif
    }
  } /* typ==string */
  return TRUE;
}

BOOLEAN jjVARIABLES_ID	(	leftv	res,
		leftv	u
	)

Definition at line 6004 of file ipshell.cc.

{
  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
  ideal I=(ideal)u->Data();
  int i;
  int n=0;
  for(i=I->nrows*I->ncols-1;i>=0;i--)
  {
    int n0=pGetVariables(I->m[i],e);
    if (n0>n) n=n0;
  }
  jjINT_S_TO_ID(n,e,res);
  return FALSE;
}

BOOLEAN jjVARIABLES_P	(	leftv	res,
		leftv	u
	)

Definition at line 5996 of file ipshell.cc.

{
  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
  int n=pGetVariables((poly)u->Data(),e);
  jjINT_S_TO_ID(n,e,res);
  return FALSE;
}

void killlocals

(

int

v

)

Definition at line 382 of file ipshell.cc.

{
  BOOLEAN changed=FALSE;
  idhdl sh=currRingHdl;
  ring cr=currRing;
  if (sh!=NULL) changed=((IDLEV(sh)<v) || (IDRING(sh)->ref>0));
  //if (changed) Print("currRing=%s(%x), lev=%d,ref=%d\n",IDID(sh),IDRING(sh),IDLEV(sh),IDRING(sh)->ref);

  killlocals_rec(&(basePack->idroot),v,currRing);

  if (iiRETURNEXPR_len > myynest)
  {
    int t=iiRETURNEXPR.Typ();
    if ((/*iiRETURNEXPR.Typ()*/ t==RING_CMD)
    || (/*iiRETURNEXPR.Typ()*/ t==QRING_CMD))
    {
      leftv h=&iiRETURNEXPR;
      if (((ring)h->data)->idroot!=NULL)
        killlocals0(v,&(((ring)h->data)->idroot),(ring)h->data);
    }
    else if (/*iiRETURNEXPR.Typ()*/ t==LIST_CMD)
    {
      leftv h=&iiRETURNEXPR;
      changed |=killlocals_list(v,(lists)h->data);
    }
  }
  if (changed)
  {
    currRingHdl=rFindHdl(cr,NULL);
    if (currRingHdl==NULL)
      currRing=NULL;
    else if(cr!=currRing)
      rChangeCurrRing(cr);
  }

  if (myynest<=1) iiNoKeepRing=TRUE;
  //Print("end killlocals  >= %d\n",v);
  //listall();
}

BOOLEAN kQHWeight	(	leftv	res,
		leftv	v
	)

Definition at line 3029 of file ipshell.cc.

{
  res->data=(char *)id_QHomWeight((ideal)v->Data(), currRing);
  if (res->data==NULL)
    res->data=(char *)new intvec(rVar(currRing));
  return FALSE;
}

BOOLEAN kWeight	(	leftv	res,
		leftv	id
	)

Definition at line 3007 of file ipshell.cc.

{
  ideal F=(ideal)id->Data();
  intvec * iv = new intvec(rVar(currRing));
  polyset s;
  int  sl, n, i;
  int  *x;

  res->data=(char *)iv;
  s = F->m;
  sl = IDELEMS(F) - 1;
  n = rVar(currRing);
  double wNsqr = (double)2.0 / (double)n;
  wFunctional = wFunctionalBuch;
  x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
  wCall(s, sl, x, wNsqr, currRing);
  for (i = n; i!=0; i--)
    (*iv)[i-1] = x[i + n + 1];
  omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
  return FALSE;
}

void list_cmd	(	int	typ,
		const char *	what,
		const char *	prefix,
		BOOLEAN	iterate,
		BOOLEAN	fullname = FALSE
	)

Definition at line 422 of file ipshell.cc.

{
  package savePack=currPack;
  idhdl h,start;
  BOOLEAN all = typ<0;
  BOOLEAN really_all=FALSE;

  if ( typ==0 )
  {
    if (strcmp(what,"all")==0)
    {
      if (currPack!=basePack)
        list_cmd(-1,NULL,prefix,iterate,fullname); // list current package
      really_all=TRUE;
      h=basePack->idroot;
    }
    else
    {
      h = ggetid(what);
      if (h!=NULL)
      {
        if (iterate) list1(prefix,h,TRUE,fullname);
        if (IDTYP(h)==ALIAS_CMD) PrintS("A");
        if ((IDTYP(h)==RING_CMD)
            || (IDTYP(h)==QRING_CMD)
            //|| (IDTYP(h)==PACKE_CMD)
        )
        {
          h=IDRING(h)->idroot;
        }
        else if(IDTYP(h)==PACKAGE_CMD)
        {
          currPack=IDPACKAGE(h);
          //Print("list_cmd:package\n");
          all=TRUE;typ=PROC_CMD;fullname=TRUE;really_all=TRUE;
          h=IDPACKAGE(h)->idroot;
        }
        else
        {
          currPack=savePack;
          return;
        }
      }
      else
      {
        Werror("%s is undefined",what);
        currPack=savePack;
        return;
      }
    }
    all=TRUE;
  }
  else if (RingDependend(typ))
  {
    h = currRing->idroot;
  }
  else
    h = IDROOT;
  start=h;
  while (h!=NULL)
  {
    if ((all
      && (IDTYP(h)!=PROC_CMD)
      &&(IDTYP(h)!=PACKAGE_CMD)
      && (IDTYP(h)!=CRING_CMD))
    || (typ == IDTYP(h))
    || ((typ==RING_CMD) &&(IDTYP(h)==CRING_CMD))
    || ((IDTYP(h)==QRING_CMD) && (typ==RING_CMD)))
    {
      list1(prefix,h,start==currRingHdl, fullname);
      if (((IDTYP(h)==RING_CMD)||(IDTYP(h)==QRING_CMD))
        && (really_all || (all && (h==currRingHdl)))
        && ((IDLEV(h)==0)||(IDLEV(h)==myynest)))
      {
        list_cmd(0,IDID(h),"//      ",FALSE);
      }
      if (IDTYP(h)==PACKAGE_CMD && really_all)
      {
        package save_p=currPack;
        currPack=IDPACKAGE(h);
        list_cmd(0,IDID(h),"//      ",FALSE);
        currPack=save_p;
      }
    }
    h = IDNEXT(h);
  }
  currPack=savePack;
}

BOOLEAN loNewtonP	(	leftv	res,
		leftv	arg1
	)

compute Newton Polytopes of input polynomials

Definition at line 4269 of file ipshell.cc.

{
  res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
  return FALSE;
}

BOOLEAN loSimplex	(	leftv	res,
		leftv	args
	)

Implementation of the Simplex Algorithm.

For args, see class simplex.

Definition at line 4275 of file ipshell.cc.

{
  if ( !(rField_is_long_R(currRing)) )
  {
    WerrorS("Ground field not implemented!");
    return TRUE;
  }

  simplex * LP;
  matrix m;

  leftv v= args;
  if ( v->Typ() != MATRIX_CMD ) // 1: matrix
    return TRUE;
  else
    m= (matrix)(v->CopyD());

  LP = new simplex(MATROWS(m),MATCOLS(m));
  LP->mapFromMatrix(m);

  v= v->next;
  if ( v->Typ() != INT_CMD )    // 2: m = number of constraints
    return TRUE;
  else
    LP->m= (int)(long)(v->Data());

  v= v->next;
  if ( v->Typ() != INT_CMD )    // 3: n = number of variables
    return TRUE;
  else
    LP->n= (int)(long)(v->Data());

  v= v->next;
  if ( v->Typ() != INT_CMD )    // 4: m1 = number of <= constraints
    return TRUE;
  else
    LP->m1= (int)(long)(v->Data());

  v= v->next;
  if ( v->Typ() != INT_CMD )    // 5: m2 = number of >= constraints
    return TRUE;
  else
    LP->m2= (int)(long)(v->Data());

  v= v->next;
  if ( v->Typ() != INT_CMD )    // 6: m3 = number of == constraints
    return TRUE;
  else
    LP->m3= (int)(long)(v->Data());

#ifdef mprDEBUG_PROT
  Print("m (constraints) %d\n",LP->m);
  Print("n (columns) %d\n",LP->n);
  Print("m1 (<=) %d\n",LP->m1);
  Print("m2 (>=) %d\n",LP->m2);
  Print("m3 (==) %d\n",LP->m3);
#endif

  LP->compute();

  lists lres= (lists)omAlloc( sizeof(slists) );
  lres->Init( 6 );

  lres->m[0].rtyp= MATRIX_CMD; // output matrix
  lres->m[0].data=(void*)LP->mapToMatrix(m);

  lres->m[1].rtyp= INT_CMD;   // found a solution?
  lres->m[1].data=(void*)(long)LP->icase;

  lres->m[2].rtyp= INTVEC_CMD;
  lres->m[2].data=(void*)LP->posvToIV();

  lres->m[3].rtyp= INTVEC_CMD;
  lres->m[3].data=(void*)LP->zrovToIV();

  lres->m[4].rtyp= INT_CMD;
  lres->m[4].data=(void*)(long)LP->m;

  lres->m[5].rtyp= INT_CMD;
  lres->m[5].data=(void*)(long)LP->n;

  res->data= (void*)lres;

  return FALSE;
}

BOOLEAN mpJacobi	(	leftv	res,
		leftv	a
	)

Definition at line 2773 of file ipshell.cc.

{
  int     i,j;
  matrix result;
  ideal id=(ideal)a->Data();

  result =mpNew(IDELEMS(id),rVar(currRing));
  for (i=1; i<=IDELEMS(id); i++)
  {
    for (j=1; j<=rVar(currRing); j++)
    {
      MATELEM(result,i,j) = pDiff(id->m[i-1],j);
    }
  }
  res->data=(char *)result;
  return FALSE;
}

BOOLEAN mpKoszul	(	leftv	res,
		leftv	c,
		leftv	b,
		leftv	id
	)

Definition at line 2795 of file ipshell.cc.

{
  int n=(int)(long)b->Data();
  int d=(int)(long)c->Data();
  int     k,l,sign,row,col;
  matrix  result;
  ideal temp;
  BOOLEAN bo;
  poly    p;

  if ((d>n) || (d<1) || (n<1))
  {
    res->data=(char *)mpNew(1,1);
    return FALSE;
  }
  int *choise = (int*)omAlloc(d*sizeof(int));
  if (id==NULL)
    temp=idMaxIdeal(1);
  else
    temp=(ideal)id->Data();

  k = binom(n,d);
  l = k*d;
  l /= n-d+1;
  result =mpNew(l,k);
  col = 1;
  idInitChoise(d,1,n,&bo,choise);
  while (!bo)
  {
    sign = 1;
    for (l=1;l<=d;l++)
    {
      if (choise[l-1]<=IDELEMS(temp))
      {
        p = pCopy(temp->m[choise[l-1]-1]);
        if (sign == -1) p = pNeg(p);
        sign *= -1;
        row = idGetNumberOfChoise(l-1,d,1,n,choise);
        MATELEM(result,row,col) = p;
      }
    }
    col++;
    idGetNextChoise(d,n,&bo,choise);
  }
  if (id==NULL) idDelete(&temp);

  res->data=(char *)result;
  return FALSE;
}

BOOLEAN nuLagSolve	(	leftv	res,
		leftv	arg1,
		leftv	arg2,
		leftv	arg3
	)

find the (complex) roots an univariate polynomial Determines the roots of an univariate polynomial using Laguerres' root-solver.

Good for polynomials with low and middle degree (<40). Arguments 3: poly arg1 , int arg2 , int arg3 arg2>0: defines precision of fractional part if ground field is Q arg3: number of iterations for approximation of roots (default=2) Returns a list of all (complex) roots of the polynomial arg1

Definition at line 4384 of file ipshell.cc.

{

  poly gls;
  gls= (poly)(arg1->Data());
  int howclean= (int)(long)arg3->Data();

  if ( !(rField_is_R(currRing) ||
         rField_is_Q(currRing) ||
         rField_is_long_R(currRing) ||
         rField_is_long_C(currRing)) )
  {
    WerrorS("Ground field not implemented!");
    return TRUE;
  }

  if ( !(rField_is_R(currRing) || rField_is_long_R(currRing) || \
                          rField_is_long_C(currRing)) )
  {
    unsigned long int ii = (unsigned long int)arg2->Data();
    setGMPFloatDigits( ii, ii );
  }

  if ( gls == NULL || pIsConstant( gls ) )
  {
    WerrorS("Input polynomial is constant!");
    return TRUE;
  }

  int ldummy;
  int deg= currRing->pLDeg( gls, &ldummy, currRing );
  //  int deg= pDeg( gls );
  //  int len= pLength( gls );
  int i,vpos=0;
  poly piter;
  lists elist;
  lists rlist;

  elist= (lists)omAlloc( sizeof(slists) );
  elist->Init( 0 );

  if ( rVar(currRing) > 1 )
  {
    piter= gls;
    for ( i= 1; i <= rVar(currRing); i++ )
      if ( pGetExp( piter, i ) )
      {
        vpos= i;
        break;
      }
    while ( piter )
    {
      for ( i= 1; i <= rVar(currRing); i++ )
        if ( (vpos != i) && (pGetExp( piter, i ) != 0) )
        {
          WerrorS("The input polynomial must be univariate!");
          return TRUE;
        }
      pIter( piter );
    }
  }

  rootContainer * roots= new rootContainer();
  number * pcoeffs= (number *)omAlloc( (deg+1) * sizeof( number ) );
  piter= gls;
  for ( i= deg; i >= 0; i-- )
  {
    //if ( piter ) Print("deg %d, pDeg(piter) %d\n",i,pTotaldegree(piter));
    if ( piter && pTotaldegree(piter) == i )
    {
      pcoeffs[i]= nCopy( pGetCoeff( piter ) );
      //nPrint( pcoeffs[i] );PrintS("  ");
      pIter( piter );
    }
    else
    {
      pcoeffs[i]= nInit(0);
    }
  }

#ifdef mprDEBUG_PROT
  for (i=deg; i >= 0; i--)
  {
    nPrint( pcoeffs[i] );PrintS("  ");
  }
  PrintLn();
#endif

  roots->fillContainer( pcoeffs, NULL, 1, deg, rootContainer::onepoly, 1 );
  roots->solver( howclean );

  int elem= roots->getAnzRoots();
  char *dummy;
  int j;

  rlist= (lists)omAlloc( sizeof(slists) );
  rlist->Init( elem );

  if (rField_is_long_C(currRing))
  {
    for ( j= 0; j < elem; j++ )
    {
      rlist->m[j].rtyp=NUMBER_CMD;
      rlist->m[j].data=(void *)nCopy((number)(roots->getRoot(j)));
      //rlist->m[j].data=(void *)(number)(roots->getRoot(j));
    }
  }
  else
  {
    for ( j= 0; j < elem; j++ )
    {
      dummy = complexToStr( (*roots)[j], gmp_output_digits, currRing->cf );
      rlist->m[j].rtyp=STRING_CMD;
      rlist->m[j].data=(void *)dummy;
    }
  }

  elist->Clean();
  //omFreeSize( (ADDRESS) elist, sizeof(slists) );

  // this is (via fillContainer) the same data as in root
  //for ( i= deg; i >= 0; i-- ) nDelete( &pcoeffs[i] );
  //omFreeSize( (ADDRESS) pcoeffs, (deg+1) * sizeof( number ) );

  delete roots;

  res->rtyp= LIST_CMD;
  res->data= (void*)rlist;

  return FALSE;
}

BOOLEAN nuMPResMat	(	leftv	res,
		leftv	arg1,
		leftv	arg2
	)

returns module representing the multipolynomial resultant matrix Arguments 2: ideal i, int k k=0: use sparse resultant matrix of Gelfand, Kapranov and Zelevinsky k=1: use resultant matrix of Macaulay (k=0 is default)

Definition at line 4361 of file ipshell.cc.

{
  ideal gls = (ideal)(arg1->Data());
  int imtype= (int)(long)arg2->Data();

  uResultant::resMatType mtype= determineMType( imtype );

  // check input ideal ( = polynomial system )
  if ( mprIdealCheck( gls, arg1->Name(), mtype, true ) != mprOk )
  {
    return TRUE;
  }

  uResultant *resMat= new uResultant( gls, mtype, false );
  if (resMat!=NULL)
  {
    res->rtyp = MODUL_CMD;
    res->data= (void*)resMat->accessResMat()->getMatrix();
    if (!errorreported) delete resMat;
  }
  return errorreported;
}

BOOLEAN nuUResSolve	(	leftv	res,
		leftv	args
	)

solve a multipolynomial system using the u-resultant Input ideal must be 0-dimensional and (currRing->N) == IDELEMS(ideal).

Resultant method can be MPR_DENSE, which uses Macaulay Resultant (good for dense homogeneous polynoms) or MPR_SPARSE, which uses Sparse Resultant (Gelfand, Kapranov, Zelevinsky). Arguments 4: ideal i, int k, int l, int m k=0: use sparse resultant matrix of Gelfand, Kapranov and Zelevinsky k=1: use resultant matrix of Macaulay (k=0 is default) l>0: defines precision of fractional part if ground field is Q m=0,1,2: number of iterations for approximation of roots (default=2) Returns a list containing the roots of the system.

Definition at line 4617 of file ipshell.cc.

{
  leftv v= args;

  ideal gls;
  int imtype;
  int howclean;

  // get ideal
  if ( v->Typ() != IDEAL_CMD )
    return TRUE;
  else gls= (ideal)(v->Data());
  v= v->next;

  // get resultant matrix type to use (0,1)
  if ( v->Typ() != INT_CMD )
    return TRUE;
  else imtype= (int)(long)v->Data();
  v= v->next;

  if (imtype==0)
  {
    ideal test_id=idInit(1,1);
    int j;
    for(j=IDELEMS(gls)-1;j>=0;j--)
    {
      if (gls->m[j]!=NULL)
      {
        test_id->m[0]=gls->m[j];
        intvec *dummy_w=id_QHomWeight(test_id, currRing);
        if (dummy_w!=NULL)
        {
          WerrorS("Newton polytope not of expected dimension");
          delete dummy_w;
          return TRUE;
        }
      }
    }
  }

  // get and set precision in digits ( > 0 )
  if ( v->Typ() != INT_CMD )
    return TRUE;
  else if ( !(rField_is_R(currRing) || rField_is_long_R(currRing) || \
                          rField_is_long_C(currRing)) )
  {
    unsigned long int ii=(unsigned long int)v->Data();
    setGMPFloatDigits( ii, ii );
  }
  v= v->next;

  // get interpolation steps (0,1,2)
  if ( v->Typ() != INT_CMD )
    return TRUE;
  else howclean= (int)(long)v->Data();

  uResultant::resMatType mtype= determineMType( imtype );
  int i,count;
  lists listofroots= NULL;
  number smv= NULL;
  BOOLEAN interpolate_det= (mtype==uResultant::denseResMat)?TRUE:FALSE;

  //emptylist= (lists)omAlloc( sizeof(slists) );
  //emptylist->Init( 0 );

  //res->rtyp = LIST_CMD;
  //res->data= (void *)emptylist;

  // check input ideal ( = polynomial system )
  if ( mprIdealCheck( gls, args->Name(), mtype ) != mprOk )
  {
    return TRUE;
  }

  uResultant * ures;
  rootContainer ** iproots;
  rootContainer ** muiproots;
  rootArranger * arranger;

  // main task 1: setup of resultant matrix
  ures= new uResultant( gls, mtype );
  if ( ures->accessResMat()->initState() != resMatrixBase::ready )
  {
    WerrorS("Error occurred during matrix setup!");
    return TRUE;
  }

  // if dense resultant, check if minor nonsingular
  if ( mtype == uResultant::denseResMat )
  {
    smv= ures->accessResMat()->getSubDet();
#ifdef mprDEBUG_PROT
    PrintS("// Determinant of submatrix: ");nPrint(smv);PrintLn();
#endif
    if ( nIsZero(smv) )
    {
      WerrorS("Unsuitable input ideal: Minor of resultant matrix is singular!");
      return TRUE;
    }
  }

  // main task 2: Interpolate specialized resultant polynomials
  if ( interpolate_det )
    iproots= ures->interpolateDenseSP( false, smv );
  else
    iproots= ures->specializeInU( false, smv );

  // main task 3: Interpolate specialized resultant polynomials
  if ( interpolate_det )
    muiproots= ures->interpolateDenseSP( true, smv );
  else
    muiproots= ures->specializeInU( true, smv );

#ifdef mprDEBUG_PROT
  int c= iproots[0]->getAnzElems();
  for (i=0; i < c; i++) pWrite(iproots[i]->getPoly());
  c= muiproots[0]->getAnzElems();
  for (i=0; i < c; i++) pWrite(muiproots[i]->getPoly());
#endif

  // main task 4: Compute roots of specialized polys and match them up
  arranger= new rootArranger( iproots, muiproots, howclean );
  arranger->solve_all();

  // get list of roots
  if ( arranger->success() )
  {
    arranger->arrange();
    listofroots= listOfRoots(arranger, gmp_output_digits );
  }
  else
  {
    WerrorS("Solver was unable to find any roots!");
    return TRUE;
  }

  // free everything
  count= iproots[0]->getAnzElems();
  for (i=0; i < count; i++) delete iproots[i];
  omFreeSize( (ADDRESS) iproots, count * sizeof(rootContainer*) );
  count= muiproots[0]->getAnzElems();
  for (i=0; i < count; i++) delete muiproots[i];
  omFreeSize( (ADDRESS) muiproots, count * sizeof(rootContainer*) );

  delete ures;
  delete arranger;
  nDelete( &smv );

  res->data= (void *)listofroots;

  //emptylist->Clean();
  //  omFreeSize( (ADDRESS) emptylist, sizeof(slists) );

  return FALSE;
}

BOOLEAN nuVanderSys	(	leftv	res,
		leftv	arg1,
		leftv	arg2,
		leftv	arg3
	)

COMPUTE: polynomial p with values given by v at points p1,..,pN derived from p; more precisely: consider p as point in K^n and v as N elements in K, let p1,..,pN be the points in K^n obtained by evaluating all monomials of degree 0,1,...,N at p in lexicographical order, then the procedure computes the polynomial f satisfying f(pi) = v[i] RETURN: polynomial f of degree d.

Definition at line 4516 of file ipshell.cc.

{
  int i;
  ideal p,w;
  p= (ideal)arg1->Data();
  w= (ideal)arg2->Data();

  // w[0] = f(p^0)
  // w[1] = f(p^1)
  // ...
  // p can be a vector of numbers (multivariate polynom)
  //   or one number (univariate polynom)
  // tdg = deg(f)

  int n= IDELEMS( p );
  int m= IDELEMS( w );
  int tdg= (int)(long)arg3->Data();

  res->data= (void*)NULL;

  // check the input
  if ( tdg < 1 )
  {
    WerrorS("Last input parameter must be > 0!");
    return TRUE;
  }
  if ( n != rVar(currRing) )
  {
    Werror("Size of first input ideal must be equal to %d!",rVar(currRing));
    return TRUE;
  }
  if ( m != (int)pow((double)tdg+1,(double)n) )
  {
    Werror("Size of second input ideal must be equal to %d!",
      (int)pow((double)tdg+1,(double)n));
    return TRUE;
  }
  if ( !(rField_is_Q(currRing) /* ||
         rField_is_R() || rField_is_long_R() ||
         rField_is_long_C()*/ ) )
         {
    WerrorS("Ground field not implemented!");
    return TRUE;
  }

  number tmp;
  number *pevpoint= (number *)omAlloc( n * sizeof( number ) );
  for ( i= 0; i < n; i++ )
  {
    pevpoint[i]=nInit(0);
    if (  (p->m)[i] )
    {
      tmp = pGetCoeff( (p->m)[i] );
      if ( nIsZero(tmp) || nIsOne(tmp) || nIsMOne(tmp) )
      {
        omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
        WerrorS("Elements of first input ideal must not be equal to -1, 0, 1!");
        return TRUE;
      }
    } else tmp= NULL;
    if ( !nIsZero(tmp) )
    {
      if ( !pIsConstant((p->m)[i]))
      {
        omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
        WerrorS("Elements of first input ideal must be numbers!");
        return TRUE;
      }
      pevpoint[i]= nCopy( tmp );
    }
  }

  number *wresults= (number *)omAlloc( m * sizeof( number ) );
  for ( i= 0; i < m; i++ )
  {
    wresults[i]= nInit(0);
    if ( (w->m)[i] && !nIsZero(pGetCoeff((w->m)[i])) )
    {
      if ( !pIsConstant((w->m)[i]))
      {
        omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
        omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
        WerrorS("Elements of second input ideal must be numbers!");
        return TRUE;
      }
      wresults[i]= nCopy(pGetCoeff((w->m)[i]));
    }
  }

  vandermonde vm( m, n, tdg, pevpoint, FALSE );
  number *ncpoly= vm.interpolateDense( wresults );
  // do not free ncpoly[]!!
  poly rpoly= vm.numvec2poly( ncpoly );

  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );

  res->data= (void*)rpoly;
  return FALSE;
}

void paPrint	(	const char *	n,
		package	p
	)

Definition at line 6019 of file ipshell.cc.

{
  Print(" %s (",n);
  switch (p->language)
  {
    case LANG_SINGULAR: PrintS("S"); break;
    case LANG_C:        PrintS("C"); break;
    case LANG_TOP:      PrintS("T"); break;
    case LANG_NONE:     PrintS("N"); break;
    default:            PrintS("U");
  }
  if(p->libname!=NULL)
  Print(",%s", p->libname);
  PrintS(")");
}

idhdl rDefault

(

const char *

s

)

Definition at line 1645 of file ipshell.cc.

{
  idhdl tmp=NULL;

  if (s!=NULL) tmp = enterid(s, myynest, RING_CMD, &IDROOT);
  if (tmp==NULL) return NULL;

// if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
  if (sLastPrinted.RingDependend())
  {
    sLastPrinted.CleanUp();
    memset(&sLastPrinted,0,sizeof(sleftv));
  }

  ring r = IDRING(tmp);

  r->cf = nInitChar(n_Zp, (void*)32003); //   r->cf->ch = 32003;
  r->N      = 3;
  /*r->P     = 0; Alloc0 in idhdl::set, ipid.cc*/
  /*names*/
  r->names = (char **) omAlloc0(3 * sizeof(char_ptr));
  r->names[0]  = omStrDup("x");
  r->names[1]  = omStrDup("y");
  r->names[2]  = omStrDup("z");
  /*weights: entries for 3 blocks: NULL*/
  r->wvhdl = (int **)omAlloc0(3 * sizeof(int_ptr));
  /*order: dp,C,0*/
  r->order = (int *) omAlloc(3 * sizeof(int *));
  r->block0 = (int *)omAlloc0(3 * sizeof(int *));
  r->block1 = (int *)omAlloc0(3 * sizeof(int *));
  /* ringorder dp for the first block: var 1..3 */
  r->order[0]  = ringorder_dp;
  r->block0[0] = 1;
  r->block1[0] = 3;
  /* ringorder C for the second block: no vars */
  r->order[1]  = ringorder_C;
  /* the last block: everything is 0 */
  r->order[2]  = 0;

  /* complete ring intializations */
  rComplete(r);
  rSetHdl(tmp);
  return currRingHdl;
}

idhdl rFindHdl	(	ring	r,
		idhdl	n
	)

Definition at line 1690 of file ipshell.cc.

{
  idhdl h=rSimpleFindHdl(r,IDROOT,n);
  if (h!=NULL)  return h;
  if (IDROOT!=basePack->idroot) h=rSimpleFindHdl(r,basePack->idroot,n);
  if (h!=NULL)  return h;
  proclevel *p=procstack;
  while(p!=NULL)
  {
    if ((p->cPack!=basePack)
    && (p->cPack!=currPack))
      h=rSimpleFindHdl(r,p->cPack->idroot,n);
    if (h!=NULL)  return h;
    p=p->next;
  }
  idhdl tmp=basePack->idroot;
  while (tmp!=NULL)
  {
    if (IDTYP(tmp)==PACKAGE_CMD)
      h=rSimpleFindHdl(r,IDPACKAGE(tmp)->idroot,n);
    if (h!=NULL)  return h;
    tmp=IDNEXT(tmp);
  }
  return NULL;
}

ring rInit	(	sleftv *	pn,
		sleftv *	rv,
		sleftv *	ord
	)

Definition at line 5304 of file ipshell.cc.

{
#ifdef HAVE_RINGS
  //unsigned int ringtype = 0;
  mpz_ptr modBase = NULL;
  unsigned int modExponent = 1;
#endif
  int float_len=0;
  int float_len2=0;
  ring R = NULL;
  //BOOLEAN ffChar=FALSE;

  /* ch -------------------------------------------------------*/
  // get ch of ground field

  // allocated ring
  R = (ring) omAlloc0Bin(sip_sring_bin);

  coeffs cf = NULL;

  assume( pn != NULL );
  const int P = pn->listLength();

  if ((pn->Typ()==CRING_CMD)&&(P==1))
  {
    cf=(coeffs)pn->CopyD();
    assume( cf != NULL );
  }
  else if (pn->Typ()==INT_CMD)
  {
    int ch = (int)(long)pn->Data();

    /* parameter? -------------------------------------------------------*/
    pn = pn->next;

    if (pn == NULL) // no params!?
    {
      if (ch!=0)
      {
        int ch2=IsPrime(ch);
        if ((ch<2)||(ch!=ch2))
        {
          Warn("%d is invalid as characteristic of the ground field. 32003 is used.", ch);
          ch=32003;
        }
        cf = nInitChar(n_Zp, (void*)(long)ch);
      }
      else
        cf = nInitChar(n_Q, (void*)(long)ch);
    }
    else
    {
      const int pars = pn->listLength();

      assume( pars > 0 );

      // predefined finite field: (p^k, a)
      if ((ch!=0) && (ch!=IsPrime(ch)) && (pars == 1))
      {
        GFInfo param;

        param.GFChar = ch;
        param.GFDegree = 1;
        param.GFPar_name = pn->name;

        cf = nInitChar(n_GF, &param);
      }
      else // (0/p, a, b, ..., z)
      {
        if ((ch!=0) && (ch!=IsPrime(ch)))
        {
          WerrorS("too many parameters");
          goto rInitError;
        }

        char ** names = (char**)omAlloc0(pars * sizeof(char_ptr));

        if (rSleftvList2StringArray(pn, names))
        {
          WerrorS("parameter expected");
          goto rInitError;
        }

        TransExtInfo extParam;

        extParam.r = rDefault( ch, pars, names); // Q/Zp [ p_1, ... p_pars ]
        for(int i=pars-1; i>=0;i--)
        {
          omFree(names[i]);
        }
        omFree(names);

        cf = nInitChar(n_transExt, &extParam);
      }
    }

//    if (cf==NULL) goto rInitError;
    assume( cf != NULL );
  }
  else if ((pn->name != NULL)
  && ((strcmp(pn->name,"real")==0) || (strcmp(pn->name,"complex")==0)))
  {
    BOOLEAN complex_flag=(strcmp(pn->name,"complex")==0);
    if ((pn->next!=NULL) && (pn->next->Typ()==INT_CMD))
    {
      float_len=(int)(long)pn->next->Data();
      float_len2=float_len;
      pn=pn->next;
      if ((pn->next!=NULL) && (pn->next->Typ()==INT_CMD))
      {
        float_len2=(int)(long)pn->next->Data();
        pn=pn->next;
      }
    }

    if (!complex_flag)
      complex_flag= pn->next != NULL;
    if( !complex_flag && (float_len2 <= (short)SHORT_REAL_LENGTH))
       cf=nInitChar(n_R, NULL);
    else // longR or longC?
    {
       LongComplexInfo param;

       param.float_len = si_min (float_len, 32767);
       param.float_len2 = si_min (float_len2, 32767);

       // set the parameter name
       if (complex_flag)
       {
         if (param.float_len < SHORT_REAL_LENGTH)
         {
           param.float_len= SHORT_REAL_LENGTH;
           param.float_len2= SHORT_REAL_LENGTH;
         }
         if (pn->next == NULL)
           param.par_name=(const char*)"i"; //default to i
         else
           param.par_name = (const char*)pn->next->name;
       }

       cf = nInitChar(complex_flag ? n_long_C: n_long_R, (void*)&param);
    }
    assume( cf != NULL );
  }
#ifdef HAVE_RINGS
  else if ((pn->name != NULL) && (strcmp(pn->name, "integer") == 0))
  {
    // TODO: change to use coeffs_BIGINT!?
    modBase = (mpz_ptr) omAlloc(sizeof(mpz_t));
    mpz_init_set_si(modBase, 0);
    if (pn->next!=NULL)
    {
      if (pn->next->Typ()==INT_CMD)
      {
        mpz_set_ui(modBase, (int)(long) pn->next->Data());
        pn=pn->next;
        if ((pn->next!=NULL) && (pn->next->Typ()==INT_CMD))
        {
          modExponent = (long) pn->next->Data();
          pn=pn->next;
        }
        while ((pn->next!=NULL) && (pn->next->Typ()==INT_CMD))
        {
          mpz_mul_ui(modBase, modBase, (int)(long) pn->next->Data());
          pn=pn->next;
        }
      }
      else if (pn->next->Typ()==BIGINT_CMD)
      {
        number p=(number)pn->next->CopyD(); // FIXME: why CopyD() here if nlGMP should not overtake p!?
        nlGMP(p,(number)modBase,coeffs_BIGINT); // TODO? // extern void   nlGMP(number &i, number n, const coeffs r); // FIXME: n_MPZ( modBase, p, coeffs_BIGINT); ?
        n_Delete(&p,coeffs_BIGINT);
      }
    }
    else
      cf=nInitChar(n_Z,NULL);

    if ((mpz_cmp_ui(modBase, 1) == 0) && (mpz_cmp_ui(modBase, 0) < 0))
    {
      Werror("Wrong ground ring specification (module is 1)");
      goto rInitError;
    }
    if (modExponent < 1)
    {
      Werror("Wrong ground ring specification (exponent smaller than 1");
      goto rInitError;
    }
    // module is 0 ---> integers ringtype = 4;
    // we have an exponent
    if (modExponent > 1 && cf == NULL)
    {
      if ((mpz_cmp_ui(modBase, 2) == 0) && (modExponent <= 8*sizeof(unsigned long)))
      {
        /* this branch should be active for modExponent = 2..32 resp. 2..64,
           depending on the size of a long on the respective platform */
        //ringtype = 1;       // Use Z/2^ch
        cf=nInitChar(n_Z2m,(void*)(long)modExponent);
        mpz_clear(modBase);
        omFreeSize (modBase, sizeof (mpz_t));
      }
      else
      {
        if (mpz_cmp_ui(modBase,0)==0)
        {
          WerrorS("modulus must not be 0 or parameter not allowed");
          goto rInitError;
        }
        //ringtype = 3;
        ZnmInfo info;
        info.base= modBase;
        info.exp= modExponent;
        cf=nInitChar(n_Znm,(void*) &info); //exponent is missing
      }
    }
    // just a module m > 1
    else if (cf == NULL)
    {
      if (mpz_cmp_ui(modBase,0)==0)
      {
        WerrorS("modulus must not be 0 or parameter not allowed");
        goto rInitError;
      }
      //ringtype = 2;
      ZnmInfo info;
      info.base= modBase;
      info.exp= modExponent;
      cf=nInitChar(n_Zn,(void*) &info);
    }
    assume( cf != NULL );
  }
#endif
  // ring NEW = OLD, (), (); where OLD is a polynomial ring...
  else if ((pn->Typ()==RING_CMD) && (P == 1))
  {
    TransExtInfo extParam;
    extParam.r = (ring)pn->Data();
    cf = nInitChar(n_transExt, &extParam);
  }
  else if ((pn->Typ()==QRING_CMD) && (P == 1)) // same for qrings - which should be fields!?
  {
    AlgExtInfo extParam;
    extParam.r = (ring)pn->Data();

    cf = nInitChar(n_algExt, &extParam);   // Q[a]/<minideal>
  }
  else
  {
    Werror("Wrong or unknown ground field specification");
#ifndef SING_NDEBUG
    sleftv* p = pn;
    while (p != NULL)
    {
      Print( "pn[%p]: type: %d [%s]: %p, name: %s", (void*)p, p->Typ(), Tok2Cmdname(p->Typ()), p->Data(), (p->name == NULL? "NULL" : p->name) );
      PrintLn();
      p = p->next;
    }
#endif
    goto rInitError;
  }
//  pn=pn->next;

  /*every entry in the new ring is initialized to 0*/

  /* characteristic -----------------------------------------------*/
  /* input: 0 ch=0 : Q     parameter=NULL    ffChar=FALSE   float_len
   *         0    1 : Q(a,...)        *names         FALSE
   *         0   -1 : R               NULL           FALSE  0
   *         0   -1 : R               NULL           FALSE  prec. >6
   *         0   -1 : C               *names         FALSE  prec. 0..?
   *         p    p : Fp              NULL           FALSE
   *         p   -p : Fp(a)           *names         FALSE
   *         q    q : GF(q=p^n)       *names         TRUE
  */
  if (cf==NULL)
  {
    Werror("Invalid ground field specification");
    goto rInitError;
//    const int ch=32003;
//    cf=nInitChar(n_Zp, (void*)(long)ch);
  }

  assume( R != NULL );

  R->cf = cf;

  /* names and number of variables-------------------------------------*/
  {
    int l=rv->listLength();

    if (l>MAX_SHORT)
    {
      Werror("too many ring variables(%d), max is %d",l,MAX_SHORT);
       goto rInitError;
    }
    R->N = l; /*rv->listLength();*/
  }
  R->names   = (char **)omAlloc0(R->N * sizeof(char_ptr));
  if (rSleftvList2StringArray(rv, R->names))
  {
    WerrorS("name of ring variable expected");
    goto rInitError;
  }

  /* check names and parameters for conflicts ------------------------- */
  rRenameVars(R); // conflicting variables will be renamed
  /* ordering -------------------------------------------------------------*/
  if (rSleftvOrdering2Ordering(ord, R))
    goto rInitError;

  // Complete the initialization
  if (rComplete(R,1))
    goto rInitError;

/*#ifdef HAVE_RINGS
// currently, coefficients which are ring elements require a global ordering:
  if (rField_is_Ring(R) && (R->OrdSgn==-1))
  {
    WerrorS("global ordering required for these coefficients");
    goto rInitError;
  }
#endif*/

  rTest(R);

  // try to enter the ring into the name list
  // need to clean up sleftv here, before this ring can be set to
  // new currRing or currRing can be killed beacuse new ring has
  // same name
  if (pn != NULL) pn->CleanUp();
  if (rv != NULL) rv->CleanUp();
  if (ord != NULL) ord->CleanUp();
  //if ((tmp = enterid(s, myynest, RING_CMD, &IDROOT))==NULL)
  //  goto rInitError;

  //memcpy(IDRING(tmp),R,sizeof(*R));
  // set current ring
  //omFreeBin(R,  ip_sring_bin);
  //return tmp;
  return R;

  // error case:
  rInitError:
  if  ((R != NULL)&&(R->cf!=NULL)) rDelete(R);
  if (pn != NULL) pn->CleanUp();
  if (rv != NULL) rv->CleanUp();
  if (ord != NULL) ord->CleanUp();
  return NULL;
}

void rKill

(

idhdl

h

)

Definition at line 5884 of file ipshell.cc.

{
  ring r = IDRING(h);
  int ref=0;
  if (r!=NULL)
  {
    ref=r->ref;
    rKill(r);
  }
  if (h==currRingHdl)
  {
    if (ref<=0) { currRing=NULL; currRingHdl=NULL;}
    else
    {
      currRingHdl=rFindHdl(r,currRingHdl);
    }
  }
}

void rKill

(

ring

r

)

Definition at line 5815 of file ipshell.cc.

{
  if ((r->ref<=0)&&(r->order!=NULL))
  {
#ifdef RDEBUG
    if (traceit &TRACE_SHOW_RINGS) Print("kill ring %lx\n",(long)r);
#endif
    if (r->qideal!=NULL)
    {
      id_Delete(&r->qideal, r);
      r->qideal = NULL;
    }
    int j;
#ifdef USE_IILOCALRING
    for (j=0;j<myynest;j++)
    {
      if (iiLocalRing[j]==r)
      {
        if (j+1==myynest) Warn("killing the basering for level %d",j);
        iiLocalRing[j]=NULL;
      }
    }
#else /* USE_IILOCALRING */
//#endif /* USE_IILOCALRING */
    {
      proclevel * nshdl = procstack;
      int lev=myynest-1;

      for(; nshdl != NULL; nshdl = nshdl->next)
      {
        if (nshdl->cRing==r)
        {
          Warn("killing the basering for level %d",lev);
          nshdl->cRing=NULL;
          nshdl->cRingHdl=NULL;
        }
      }
    }
#endif /* USE_IILOCALRING */
// any variables depending on r ?
    while (r->idroot!=NULL)
    {
      r->idroot->lev=myynest; // avoid warning about kill global objects
      killhdl2(r->idroot,&(r->idroot),r);
    }
    if (r==currRing)
    {
      // all dependend stuff is done, clean global vars:
      if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
      if (sLastPrinted.RingDependend())
      {
        sLastPrinted.CleanUp();
      }
      //if ((myynest>0) && (iiRETURNEXPR.RingDependend()))
      //{
      //  WerrorS("return value depends on local ring variable (export missing ?)");
      //  iiRETURNEXPR.CleanUp();
      //}
      currRing=NULL;
      currRingHdl=NULL;
    }

    /* nKillChar(r); will be called from inside of rDelete */
    rDelete(r);
    return;
  }
  r->ref--;
}

void rSetHdl

(

idhdl

h

)

Definition at line 4821 of file ipshell.cc.

{
  ring rg = NULL;
  if (h!=NULL)
  {
//   Print(" new ring:%s (l:%d)\n",IDID(h),IDLEV(h));
    rg = IDRING(h);
    if (rg==NULL) return; //id <>NULL, ring==NULL
    omCheckAddrSize((ADDRESS)h,sizeof(idrec));
    if (IDID(h))  // OB: ????
      omCheckAddr((ADDRESS)IDID(h));
    rTest(rg);
  }

  // clean up history
  if (sLastPrinted.RingDependend())
  {
    sLastPrinted.CleanUp();
    memset(&sLastPrinted,0,sizeof(sleftv));
  }

  if ((rg!=currRing)&&(currRing!=NULL))
  {
    denominator_list dd=DENOMINATOR_LIST;
    if (DENOMINATOR_LIST!=NULL)
    {
      if (TEST_V_ALLWARN)
        Warn("deleting denom_list for ring change to %s",IDID(h));
      do
      {
        n_Delete(&(dd->n),currRing->cf);
        dd=dd->next;
        omFree(DENOMINATOR_LIST);
        DENOMINATOR_LIST=dd;
      } while(DENOMINATOR_LIST!=NULL);
    }
  }

  // test for valid "currRing":
  if ((rg!=NULL) && (rg->idroot==NULL))
  {
    ring old=rg;
    rg=rAssure_HasComp(rg);
    if (old!=rg)
    {
      rKill(old);
      IDRING(h)=rg;
    }
  }
   /*------------ change the global ring -----------------------*/
  rChangeCurrRing(rg);
  currRingHdl = h;
}

idhdl rSimpleFindHdl	(	ring	r,
		idhdl	root,
		idhdl	n = NULL
	)

Definition at line 5903 of file ipshell.cc.

{
  //idhdl next_best=NULL;
  idhdl h=root;
  while (h!=NULL)
  {
    if (((IDTYP(h)==RING_CMD)||(IDTYP(h)==QRING_CMD))
    && (h!=n)
    && (IDRING(h)==r)
    )
    {
   //   if (IDLEV(h)==myynest)
   //     return h;
   //   if ((IDLEV(h)==0) || (next_best==NULL))
   //     next_best=h;
   //   else if (IDLEV(next_best)<IDLEV(h))
   //     next_best=h;
      return h;
    }
    h=IDNEXT(h);
  }
  //return next_best;
  return NULL;
}

lists scIndIndset	(	ideal	S,
		BOOLEAN	all,
		ideal	Q
	)

Definition at line 1060 of file ipshell.cc.

{
  int i;
  indset save;
  lists res=(lists)omAlloc0Bin(slists_bin);

  hexist = hInit(S, Q, &hNexist, currRing);
  if (hNexist == 0)
  {
    intvec *iv=new intvec(rVar(currRing));
    for(i=0; i<rVar(currRing); i++) (*iv)[i]=1;
    res->Init(1);
    res->m[0].rtyp=INTVEC_CMD;
    res->m[0].data=(intvec*)iv;
    return res;
  }
  else if (hisModule!=0)
  {
    res->Init(0);
    return res;
  }
  save = ISet = (indset)omAlloc0Bin(indlist_bin);
  hMu = 0;
  hwork = (scfmon)omAlloc(hNexist * sizeof(scmon));
  hvar = (varset)omAlloc((rVar(currRing) + 1) * sizeof(int));
  hpure = (scmon)omAlloc((1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
  hrad = hexist;
  hNrad = hNexist;
  radmem = hCreate(rVar(currRing) - 1);
  hCo = rVar(currRing) + 1;
  hNvar = rVar(currRing);
  hRadical(hrad, &hNrad, hNvar);
  hSupp(hrad, hNrad, hvar, &hNvar);
  if (hNvar)
  {
    hCo = hNvar;
    memset(hpure, 0, (rVar(currRing) + 1) * sizeof(long));
    hPure(hrad, 0, &hNrad, hvar, hNvar, hpure, &hNpure);
    hLexR(hrad, hNrad, hvar, hNvar);
    hDimSolve(hpure, hNpure, hrad, hNrad, hvar, hNvar);
  }
  if (hCo && (hCo < rVar(currRing)))
  {
    hIndMult(hpure, hNpure, hrad, hNrad, hvar, hNvar);
  }
  if (hMu!=0)
  {
    ISet = save;
    hMu2 = 0;
    if (all && (hCo+1 < rVar(currRing)))
    {
      JSet = (indset)omAlloc0Bin(indlist_bin);
      hIndAllMult(hpure, hNpure, hrad, hNrad, hvar, hNvar);
      i=hMu+hMu2;
      res->Init(i);
      if (hMu2 == 0)
      {
        omFreeBin((ADDRESS)JSet, indlist_bin);
      }
    }
    else
    {
      res->Init(hMu);
    }
    for (i=0;i<hMu;i++)
    {
      res->m[i].data = (void *)save->set;
      res->m[i].rtyp = INTVEC_CMD;
      ISet = save;
      save = save->nx;
      omFreeBin((ADDRESS)ISet, indlist_bin);
    }
    omFreeBin((ADDRESS)save, indlist_bin);
    if (hMu2 != 0)
    {
      save = JSet;
      for (i=hMu;i<hMu+hMu2;i++)
      {
        res->m[i].data = (void *)save->set;
        res->m[i].rtyp = INTVEC_CMD;
        JSet = save;
        save = save->nx;
        omFreeBin((ADDRESS)JSet, indlist_bin);
      }
      omFreeBin((ADDRESS)save, indlist_bin);
    }
  }
  else
  {
    res->Init(0);
    omFreeBin((ADDRESS)ISet,  indlist_bin);
  }
  hKill(radmem, rVar(currRing) - 1);
  omFreeSize((ADDRESS)hpure, (1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
  omFreeSize((ADDRESS)hvar, (rVar(currRing) + 1) * sizeof(int));
  omFreeSize((ADDRESS)hwork, hNexist * sizeof(scmon));
  hDelete(hexist, hNexist);
  return res;
}

BOOLEAN semicProc	(	leftv	,
		leftv	,
		leftv
	)

Definition at line 4257 of file ipshell.cc.

{
  sleftv tmp;
  memset(&tmp,0,sizeof(tmp));
  tmp.rtyp=INT_CMD;
  /* tmp.data = (void *)0;  -- done by memset */

  return  semicProc3(res,u,v,&tmp);
}

BOOLEAN semicProc3	(	leftv	,
		leftv	,
		leftv	,
		leftv
	)

Definition at line 4217 of file ipshell.cc.

{
  semicState  state;
  BOOLEAN qh=(((int)(long)w->Data())==1);

  // -----------------
  //  check arguments
  // -----------------

  lists l1 = (lists)u->Data( );
  lists l2 = (lists)v->Data( );

  if( (state=list_is_spectrum( l1 ))!=semicOK )
  {
    WerrorS( "first argument is not a spectrum" );
    list_error( state );
  }
  else if( (state=list_is_spectrum( l2 ))!=semicOK )
  {
    WerrorS( "second argument is not a spectrum" );
    list_error( state );
  }
  else
  {
    spectrum s1= spectrumFromList( l1 );
    spectrum s2= spectrumFromList( l2 );

    res->rtyp = INT_CMD;
    if (qh)
      res->data = (void*)(long)(s1.mult_spectrumh( s2 ));
    else
      res->data = (void*)(long)(s1.mult_spectrum( s2 ));
  }

  // -----------------
  //  check status
  // -----------------

  return  (state!=semicOK);
}

BOOLEAN setOption	(	leftv	res,
		leftv	v
	)

Definition at line 578 of file misc_ip.cc.

{
  const char *n;
  do
  {
    if (v->Typ()==STRING_CMD)
    {
      n=(const char *)v->CopyD(STRING_CMD);
    }
    else
    {
      if (v->name==NULL)
        return TRUE;
      if (v->rtyp==0)
      {
        n=v->name;
        v->name=NULL;
      }
      else
      {
        n=omStrDup(v->name);
      }
    }

    int i;

    if(strcmp(n,"get")==0)
    {
      intvec *w=new intvec(2);
      (*w)[0]=si_opt_1;
      (*w)[1]=si_opt_2;
      res->rtyp=INTVEC_CMD;
      res->data=(void *)w;
      goto okay;
    }
    if(strcmp(n,"set")==0)
    {
      if((v->next!=NULL)
      &&(v->next->Typ()==INTVEC_CMD))
      {
        v=v->next;
        intvec *w=(intvec*)v->Data();
        si_opt_1=(*w)[0];
        si_opt_2=(*w)[1];
#if 0
        if (TEST_OPT_INTSTRATEGY && (currRing!=NULL)
        && rField_has_simple_inverse()
#ifdef HAVE_RINGS
        && !rField_is_Ring(currRing)
#endif
        ) {
          si_opt_1 &=~Sy_bit(OPT_INTSTRATEGY);
        }
#endif
        goto okay;
      }
    }
    if(strcmp(n,"none")==0)
    {
      si_opt_1=0;
      si_opt_2=0;
      goto okay;
    }
    for (i=0; (i==0) || (optionStruct[i-1].setval!=0); i++)
    {
      if (strcmp(n,optionStruct[i].name)==0)
      {
        if (optionStruct[i].setval & validOpts)
        {
          si_opt_1 |= optionStruct[i].setval;
          // optOldStd disables redthrough
          if (optionStruct[i].setval == Sy_bit(OPT_OLDSTD))
            si_opt_1 &= ~Sy_bit(OPT_REDTHROUGH);
        }
        else
          Warn("cannot set option");
#if 0
        if (TEST_OPT_INTSTRATEGY && (currRing!=NULL)
        && rField_has_simple_inverse()
#ifdef HAVE_RINGS
        && !rField_is_Ring(currRing)
#endif
        ) {
          test &=~Sy_bit(OPT_INTSTRATEGY);
        }
#endif
        goto okay;
      }
      else if ((strncmp(n,"no",2)==0)
      && (strcmp(n+2,optionStruct[i].name)==0))
      {
        if (optionStruct[i].setval & validOpts)
        {
          si_opt_1 &= optionStruct[i].resetval;
        }
        else
          Warn("cannot clear option");
        goto okay;
      }
    }
    for (i=0; (i==0) || (verboseStruct[i-1].setval!=0); i++)
    {
      if (strcmp(n,verboseStruct[i].name)==0)
      {
        si_opt_2 |= verboseStruct[i].setval;
        #ifdef YYDEBUG
        #if YYDEBUG
        /*debugging the bison grammar --> grammar.cc*/
        extern int    yydebug;
        if (BVERBOSE(V_YACC)) yydebug=1;
        else                  yydebug=0;
        #endif
        #endif
        goto okay;
      }
      else if ((strncmp(n,"no",2)==0)
      && (strcmp(n+2,verboseStruct[i].name)==0))
      {
        si_opt_2 &= verboseStruct[i].resetval;
        #ifdef YYDEBUG
        #if YYDEBUG
        /*debugging the bison grammar --> grammar.cc*/
        extern int    yydebug;
        if (BVERBOSE(V_YACC)) yydebug=1;
        else                  yydebug=0;
        #endif
        #endif
        goto okay;
      }
    }
    Werror("unknown option `%s`",n);
  okay:
    if (currRing != NULL)
      currRing->options = si_opt_1 & TEST_RINGDEP_OPTS;
    omFree((ADDRESS)n);
    v=v->next;
  } while (v!=NULL);

#ifdef OM_SINGULAR_CONFIG_H
   // set global variable to show memory usage
  extern int om_sing_opt_show_mem;
  if (BVERBOSE(V_SHOW_MEM)) om_sing_opt_show_mem = 1;
  else om_sing_opt_show_mem = 0;
#endif

  return FALSE;
}

char* showOption

(

)

Definition at line 726 of file misc_ip.cc.

{
  int i;
  BITSET tmp;

  StringSetS("//options:");
  if ((si_opt_1!=0)||(si_opt_2!=0))
  {
    tmp=si_opt_1;
    if(tmp)
    {
      for (i=0; optionStruct[i].setval!=0; i++)
      {
        if (optionStruct[i].setval & tmp)
        {
          StringAppend(" %s",optionStruct[i].name);
          tmp &=optionStruct[i].resetval;
        }
      }
      for (i=0; i<32; i++)
      {
        if (tmp & Sy_bit(i)) StringAppend(" %d",i);
      }
    }
    tmp=si_opt_2;
    if (tmp)
    {
      for (i=0; verboseStruct[i].setval!=0; i++)
      {
        if (verboseStruct[i].setval & tmp)
        {
          StringAppend(" %s",verboseStruct[i].name);
          tmp &=verboseStruct[i].resetval;
        }
      }
      for (i=1; i<32; i++)
      {
        if (tmp & Sy_bit(i)) StringAppend(" %d",i+32);
      }
    }
    return StringEndS();
  }
  StringAppendS(" none");
  return StringEndS();
}

void singular_example

(

char *

str

)

Definition at line 435 of file misc_ip.cc.

{
  assume(str!=NULL);
  char *s=str;
  while (*s==' ') s++;
  char *ss=s;
  while (*ss!='\0') ss++;
  while (*ss<=' ')
  {
    *ss='\0';
    ss--;
  }
  idhdl h=IDROOT->get(s,myynest);
  if ((h!=NULL) && (IDTYP(h)==PROC_CMD))
  {
    char *lib=iiGetLibName(IDPROC(h));
    if((lib!=NULL)&&(*lib!='\0'))
    {
      Print("// proc %s from lib %s\n",s,lib);
      s=iiGetLibProcBuffer(IDPROC(h), 2);
      if (s!=NULL)
      {
        if (strlen(s)>5)
        {
          iiEStart(s,IDPROC(h));
          omFree((ADDRESS)s);
          return;
        }
        else omFree((ADDRESS)s);
      }
    }
  }
  else
  {
    char sing_file[MAXPATHLEN];
    FILE *fd=NULL;
    char *res_m=feResource('m', 0);
    if (res_m!=NULL)
    {
      sprintf(sing_file, "%s/%s.sing", res_m, s);
      fd = feFopen(sing_file, "r");
    }
    if (fd != NULL)
    {

      int old_echo = si_echo;
      int length, got;
      char* s;

      fseek(fd, 0, SEEK_END);
      length = ftell(fd);
      fseek(fd, 0, SEEK_SET);
      s = (char*) omAlloc((length+20)*sizeof(char));
      got = fread(s, sizeof(char), length, fd);
      fclose(fd);
      if (got != length)
      {
        Werror("Error while reading file %s", sing_file);
      }
      else
      {
        s[length] = '\0';
        strcat(s, "\n;return();\n\n");
        si_echo = 2;
        iiEStart(s, NULL);
        si_echo = old_echo;
      }
      omFree(s);
    }
    else
    {
      Werror("no example for %s", str);
    }
  }
}

leftv singular_system

(

sleftv

h

)

BOOLEAN spaddProc	(	leftv	,
		leftv	,
		leftv
	)

Definition at line 4134 of file ipshell.cc.

{
    semicState  state;

    // -----------------
    //  check arguments
    // -----------------

    lists l1 = (lists)first->Data( );
    lists l2 = (lists)second->Data( );

    if( (state=list_is_spectrum( l1 )) != semicOK )
    {
        WerrorS( "first argument is not a spectrum:" );
        list_error( state );
    }
    else if( (state=list_is_spectrum( l2 )) != semicOK )
    {
        WerrorS( "second argument is not a spectrum:" );
        list_error( state );
    }
    else
    {
        spectrum s1= spectrumFromList ( l1 );
        spectrum s2= spectrumFromList ( l2 );
        spectrum sum( s1+s2 );

        result->rtyp = LIST_CMD;
        result->data = (char*)(getList(sum));
    }

    return  (state!=semicOK);
}

BOOLEAN spectrumfProc	(	leftv	,
		leftv
	)

Definition at line 3890 of file ipshell.cc.

{
  spectrumState state = spectrumOK;

  // -------------------
  //  check consistency
  // -------------------

  //  check for a local polynomial ring

  if( currRing->OrdSgn != -1 )
  // ?? HS: the test above is also true for k[x][[y]], k[[x]][y]
  // or should we use:
  //if( !ringIsLocal( ) )
  {
    WerrorS( "only works for local orderings" );
    state = spectrumWrongRing;
  }
  else if( currRing->qideal != NULL )
  {
    WerrorS( "does not work in quotient rings" );
    state = spectrumWrongRing;
  }
  else
  {
    lists   L    = (lists)NULL;
    int     flag = 2; // symmetric optimization

    state = spectrumCompute( (poly)first->Data( ),&L,flag );

    if( state==spectrumOK )
    {
      result->rtyp = LIST_CMD;
      result->data = (char*)L;
    }
    else
    {
      spectrumPrintError(state);
    }
  }

  return  (state!=spectrumOK);
}

BOOLEAN spectrumProc	(	leftv	,
		leftv
	)

Definition at line 3839 of file ipshell.cc.

{
  spectrumState state = spectrumOK;

  // -------------------
  //  check consistency
  // -------------------

  //  check for a local ring

  if( !ringIsLocal(currRing ) )
  {
    WerrorS( "only works for local orderings" );
    state = spectrumWrongRing;
  }

  //  no quotient rings are allowed

  else if( currRing->qideal != NULL )
  {
    WerrorS( "does not work in quotient rings" );
    state = spectrumWrongRing;
  }
  else
  {
    lists   L    = (lists)NULL;
    int     flag = 1; // weight corner optimization is safe

    state = spectrumCompute( (poly)first->Data( ),&L,flag );

    if( state==spectrumOK )
    {
      result->rtyp = LIST_CMD;
      result->data = (char*)L;
    }
    else
    {
      spectrumPrintError(state);
    }
  }

  return  (state!=spectrumOK);
}

BOOLEAN spmulProc	(	leftv	,
		leftv	,
		leftv
	)

Definition at line 4176 of file ipshell.cc.

{
    semicState  state;

    // -----------------
    //  check arguments
    // -----------------

    lists   l = (lists)first->Data( );
    int     k = (int)(long)second->Data( );

    if( (state=list_is_spectrum( l ))!=semicOK )
    {
        WerrorS( "first argument is not a spectrum" );
        list_error( state );
    }
    else if( k < 0 )
    {
        WerrorS( "second argument should be positive" );
        state = semicMulNegative;
    }
    else
    {
        spectrum s= spectrumFromList( l );
        spectrum product( k*s );

        result->rtyp = LIST_CMD;
        result->data = (char*)getList(product);
    }

    return  (state!=semicOK);
}

BOOLEAN syBetti1	(	leftv	res,
		leftv	u
	)

Definition at line 2873 of file ipshell.cc.

{
  sleftv tmp;
  memset(&tmp,0,sizeof(tmp));
  tmp.rtyp=INT_CMD;
  tmp.data=(void *)1;
  return syBetti2(res,u,&tmp);
}

BOOLEAN syBetti2	(	leftv	res,
		leftv	u,
		leftv	w
	)

Definition at line 2850 of file ipshell.cc.

{
  syStrategy syzstr=(syStrategy)u->Data();

  BOOLEAN minim=(int)(long)w->Data();
  int row_shift=0;
  int add_row_shift=0;
  intvec *weights=NULL;
  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
  if (ww!=NULL)
  {
     weights=ivCopy(ww);
     add_row_shift = ww->min_in();
     (*weights) -= add_row_shift;
  }

  res->data=(void *)syBettiOfComputation(syzstr,minim,&row_shift,weights);
  //row_shift += add_row_shift;
  //Print("row_shift=%d, add_row_shift=%d\n",row_shift,add_row_shift);
  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);

  return FALSE;
}

syStrategy syConvList	(	lists	li,
		BOOLEAN	toDel
	)

Definition at line 2961 of file ipshell.cc.

{
  int typ0;
  syStrategy result=(syStrategy)omAlloc0(sizeof(ssyStrategy));

  resolvente fr = liFindRes(li,&(result->length),&typ0,&(result->weights));
  if (fr != NULL)
  {

    result->fullres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
    for (int i=result->length-1;i>=0;i--)
    {
      if (fr[i]!=NULL)
        result->fullres[i] = idCopy(fr[i]);
    }
    result->list_length=result->length;
    omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
  }
  else
  {
    omFreeSize(result, sizeof(ssyStrategy));
    result = NULL;
  }
  if (toDel) li->Clean();
  return result;
}

lists syConvRes	(	syStrategy	syzstr,
		BOOLEAN	toDel = FALSE,
		int	add_row_shift = 0
	)

Definition at line 2885 of file ipshell.cc.

{
  resolvente fullres = syzstr->fullres;
  resolvente minres = syzstr->minres;

  const int length = syzstr->length;

  if ((fullres==NULL) && (minres==NULL))
  {
    if (syzstr->hilb_coeffs==NULL)
    { // La Scala
      fullres = syReorder(syzstr->res, length, syzstr);
    }
    else
    { // HRES
      minres = syReorder(syzstr->orderedRes, length, syzstr);
      syKillEmptyEntres(minres, length);
    }
  }

  resolvente tr;
  int typ0=IDEAL_CMD;

  if (minres!=NULL)
    tr = minres;
  else
    tr = fullres;

  resolvente trueres=NULL; intvec ** w=NULL;

  if (length>0)
  {
    trueres = (resolvente)omAlloc0((length)*sizeof(ideal));
    for (int i=(length)-1;i>=0;i--)
    {
      if (tr[i]!=NULL)
      {
        trueres[i] = idCopy(tr[i]);
      }
    }
    if ( id_RankFreeModule(trueres[0], currRing) > 0)
      typ0 = MODUL_CMD;
    if (syzstr->weights!=NULL)
    {
      w = (intvec**)omAlloc0(length*sizeof(intvec*));
      for (int i=length-1;i>=0;i--)
      {
        if (syzstr->weights[i]!=NULL) w[i] = ivCopy(syzstr->weights[i]);
      }
    }
  }

  lists li = liMakeResolv(trueres, length, syzstr->list_length,typ0,
                          w, add_row_shift);

  if (w != NULL) omFreeSize(w, length*sizeof(intvec*));

  if (toDel)
    syKillComputation(syzstr);
  else
  {
    if( fullres != NULL && syzstr->fullres == NULL )
      syzstr->fullres = fullres;

    if( minres != NULL && syzstr->minres == NULL )
      syzstr->minres = minres;
  }

  return li;


}

syStrategy syForceMin

(

lists

li

)

Definition at line 2991 of file ipshell.cc.

{
  int typ0;
  syStrategy result=(syStrategy)omAlloc0(sizeof(ssyStrategy));

  resolvente fr = liFindRes(li,&(result->length),&typ0);
  result->minres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
  for (int i=result->length-1;i>=0;i--)
  {
    if (fr[i]!=NULL)
      result->minres[i] = idCopy(fr[i]);
  }
  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
  return result;
}

void test_cmd

(

int

i

)

Definition at line 511 of file ipshell.cc.

{
  int ii;

  if (i<0)
  {
    ii= -i;
    if (ii < 32)
    {
      si_opt_1 &= ~Sy_bit(ii);
    }
    else if (ii < 64)
    {
      si_opt_2 &= ~Sy_bit(ii-32);
    }
    else
      WerrorS("out of bounds\n");
  }
  else if (i<32)
  {
    ii=i;
    if (Sy_bit(ii) & kOptions)
    {
      Warn("Gerhard, use the option command");
      si_opt_1 |= Sy_bit(ii);
    }
    else if (Sy_bit(ii) & validOpts)
      si_opt_1 |= Sy_bit(ii);
  }
  else if (i<64)
  {
    ii=i-32;
    si_opt_2 |= Sy_bit(ii);
  }
  else
    WerrorS("out of bounds\n");
}

const char* Tok2Cmdname

(

int

i

)

Definition at line 128 of file gentable.cc.

{
  if (tok < 0)
  {
    return cmds[0].name;
  }
  if (tok==COMMAND) return "command";
  if (tok==ANY_TYPE) return "any_type";
  if (tok==NONE) return "nothing";
  //if (tok==IFBREAK) return "if_break";
  //if (tok==VECTOR_FROM_POLYS) return "vector_from_polys";
  //if (tok==ORDER_VECTOR) return "ordering";
  //if (tok==REF_VAR) return "ref";
  //if (tok==OBJECT) return "object";
  //if (tok==PRINT_EXPR) return "print_expr";
  if (tok==IDHDL) return "identifier";
  if (tok==CRING_CMD) return "(c)ring";
  // we do not blackbox objects during table generation:
  //if (tok>MAX_TOK) return getBlackboxName(tok);
  int i = 0;
  while (cmds[i].tokval!=0)
  {
    if ((cmds[i].tokval == tok)&&(cmds[i].alias==0))
    {
      return cmds[i].name;
    }
    i++;
  }
  i=0;// try again for old/alias names:
  while (cmds[i].tokval!=0)
  {
    if (cmds[i].tokval == tok)
    {
      return cmds[i].name;
    }
    i++;
  }
  #if 0
  char *s=(char*)malloc(10);
  sprintf(s,"(%d)",tok);
  return s;
  #else
  return cmds[0].name;
  #endif
}

void type_cmd

(

leftv

v

)

Definition at line 248 of file ipshell.cc.

{
  BOOLEAN oldShortOut = FALSE;

  if (currRing != NULL)
  {
    oldShortOut = currRing->ShortOut;
    currRing->ShortOut = 1;
  }
  int t=v->Typ();
  Print("// %s %s ",v->Name(),Tok2Cmdname(t));
  switch (t)
  {
    case MAP_CMD:Print(" from %s\n",((map)(v->Data()))->preimage); break;
    case INTMAT_CMD: Print(" %d x %d\n",((intvec*)(v->Data()))->rows(),
                                      ((intvec*)(v->Data()))->cols()); break;
    case MATRIX_CMD:Print(" %u x %u\n" ,
       MATROWS((matrix)(v->Data())),
       MATCOLS((matrix)(v->Data())));break;
    case MODUL_CMD: Print(", rk %d\n", (int)(((ideal)(v->Data()))->rank));break;
    case LIST_CMD: Print(", size %d\n",((lists)(v->Data()))->nr+1); break;

    case PROC_CMD:
    case RING_CMD:
    case IDEAL_CMD:
    case QRING_CMD: PrintLn(); break;

    //case INT_CMD:
    //case STRING_CMD:
    //case INTVEC_CMD:
    //case POLY_CMD:
    //case VECTOR_CMD:
    //case PACKAGE_CMD:

    default:
      break;
  }
  v->Print();
  if (currRing != NULL)
    currRing->ShortOut = oldShortOut;
}

char* versionString

(

)

Definition at line 783 of file misc_ip.cc.

{
  StringSetS("");
  StringAppend("Singular for %s version %s (%d, %d bit) %s #%s",
               S_UNAME, VERSION, // SINGULAR_VERSION,
               SINGULAR_VERSION, SIZEOF_VOIDP*8, singular_date, GIT_VERSION);
  StringAppendS("\nwith\n\t");

#if defined(mpir_version)
              StringAppend("MPIR(%s)~GMP(%s),", mpir_version, gmp_version);
#elif defined(gmp_version)
              // #if defined (__GNU_MP_VERSION) && defined (__GNU_MP_VERSION_MINOR)
              //              StringAppend("GMP(%d.%d),",__GNU_MP_VERSION,__GNU_MP_VERSION_MINOR);
              StringAppend("GMP(%s),", gmp_version);
#endif
#ifdef HAVE_NTL
#include <NTL/version.h>
              StringAppend("NTL(%s),",NTL_VERSION);
#endif

#ifdef HAVE_FLINT
              StringAppend("FLINT(%s),",version);
#endif
              StringAppend("factory(%s),\n\t", factoryVersion);
#if defined(HAVE_DYN_RL)
              if (fe_fgets_stdin==fe_fgets_dummy)
                StringAppendS("no input,");
              else if (fe_fgets_stdin==fe_fgets)
                StringAppendS("fgets,");
              if (fe_fgets_stdin==fe_fgets_stdin_drl)
                StringAppendS("dynamic readline,");
              #ifdef HAVE_FEREAD
              else if (fe_fgets_stdin==fe_fgets_stdin_emu)
                StringAppendS("emulated readline,");
              #endif
              else
                StringAppendS("unknown fgets method,");
#else
  #if defined(HAVE_READLINE) && !defined(FEREAD)
              StringAppendS("static readline,");
  #else
    #ifdef HAVE_FEREAD
              StringAppendS("emulated readline,");
    #else
              StringAppendS("fgets,");
    #endif
  #endif
#endif
#ifdef HAVE_PLURAL
              StringAppendS("Plural,");
#endif
#ifdef HAVE_DBM
              StringAppendS("DBM,\n\t");
#else
              StringAppendS("\n\t");
#endif
#ifdef HAVE_DYNAMIC_LOADING
              StringAppendS("dynamic modules,");
#endif
              if (p_procs_dynamic) StringAppendS("dynamic p_Procs,");
#if YYDEBUG
              StringAppendS("YYDEBUG=1,");
#endif
#ifdef HAVE_ASSUME
             StringAppendS("ASSUME,");
#endif
#ifdef MDEBUG
              StringAppend("MDEBUG=%d,",MDEBUG);
#endif
#ifdef OM_CHECK
              StringAppend("OM_CHECK=%d,",OM_CHECK);
#endif
#ifdef OM_TRACK
              StringAppend("OM_TRACK=%d,",OM_TRACK);
#endif
#ifdef OM_NDEBUG
              StringAppendS("OM_NDEBUG,");
#endif
#ifdef SING_NDEBUG
              StringAppendS("SING_NDEBUG,");
#endif
#ifdef PDEBUG
              StringAppendS("PDEBUG,");
#endif
#ifdef KDEBUG
              StringAppendS("KDEBUG,");
#endif
#ifdef __OPTIMIZE__
              StringAppendS("CC:OPTIMIZE,");
#endif
#ifdef __OPTIMIZE_SIZE__
              StringAppendS("CC:OPTIMIZE_SIZE,");
#endif
#ifdef __NO_INLINE__
              StringAppendS("CC:NO_INLINE,");
#endif
#ifdef HAVE_EIGENVAL
              StringAppendS("eigenvalues,");
#endif
#ifdef HAVE_GMS
              StringAppendS("Gauss-Manin system,");
#endif
#ifdef HAVE_RATGRING
              StringAppendS("ratGB,");
#endif
              StringAppend("random=%d\n",siRandomStart);

#define SI_SHOW_BUILTIN_MODULE(name) StringAppend(" %s", #name);
              StringAppendS("built-in modules: {");
              SI_FOREACH_BUILTIN(SI_SHOW_BUILTIN_MODULE)
              StringAppendS("}\n");
#undef SI_SHOW_BUILTIN_MODULE

              StringAppend("AC_CONFIGURE_ARGS = %s,\n"
                           "CC = %s,FLAGS : %s,\n"
                           "CXX = %s,FLAGS : %s,\n"
                           "DEFS : %s,CPPFLAGS : %s,\n"
                           "LDFLAGS : %s,LIBS : %s "
#ifdef __GNUC__
              "(ver: " __VERSION__ ")"
#endif
              "\n",AC_CONFIGURE_ARGS, CC,CFLAGS, CXX,CXXFLAGS,  DEFS,CPPFLAGS,  LDFLAGS,LIBS);
              feStringAppendResources(0);
              feStringAppendBrowsers(0);
              StringAppendS("\n");
              return StringEndS();
}

Variable Documentation

const char* currid

Definition at line 172 of file grammar.cc.

struct sValCmd1 dArith1[]

Definition at line 19 of file table.h.

struct sValCmd2 dArith2[]

Definition at line 271 of file table.h.

struct sValCmd3 dArith3[]

Definition at line 656 of file table.h.

struct sValCmdM dArithM[]

Definition at line 763 of file table.h.

leftv iiCurrArgs

Definition at line 82 of file ipshell.cc.

idhdl iiCurrProc

Definition at line 83 of file ipshell.cc.

ring* iiLocalRing

Definition at line 515 of file iplib.cc.

int iiOp

Definition at line 238 of file iparith.cc.

sleftv iiRETURNEXPR

Definition at line 517 of file iplib.cc.

int iiRETURNEXPR_len

Definition at line 518 of file iplib.cc.

const char* lastreserved

Definition at line 84 of file ipshell.cc.

int myynest

Definition at line 46 of file febase.cc.

int printlevel

Definition at line 42 of file febase.cc.

int si_echo

Definition at line 41 of file febase.cc.

const char* singular_date

Definition at line 1160 of file misc_ip.cc.

BOOLEAN yyInRingConstruction

Definition at line 173 of file grammar.cc.