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 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, leftv sl)
BOOLEAN	iiEStart (char *example, procinfo *pi)
BOOLEAN	iiAllStart (procinfov pi, const 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)
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)
static char *	iiGetLibName (const procinfov pi)
	find the library of an proc More...
char *	iiGetLibProcBuffer (procinfov pi, int part=1)
char *	iiProcName (char *buf, char &ct, char *&e)
char *	iiProcArgs (char *e, BOOLEAN withParenth)
BOOLEAN	iiLibCmd (const char *newlib, BOOLEAN autoexport, BOOLEAN tellerror, BOOLEAN force)
BOOLEAN	jjLOAD (const char *s, BOOLEAN autoexport=FALSE)
	load lib/module given in v More...
BOOLEAN	jjLOAD_TRY (const char *s)
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	iiGetLibStatus (const char *lib)
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	syConvList (lists li)
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)
coeffs	jjSetMinpoly (coeffs cf, number a)
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, leftv sl)
void *	iiCallLibProc1 (const char *n, void *arg, int arg_type, BOOLEAN &err)
leftv	ii_CallLibProcM (const char *n, void **args, int *arg_types, const ring R, BOOLEAN &err)
	args: NULL terminated array of arguments arg_types: 0 terminated array of corresponding types More...
ideal	ii_CallProcId2Id (const char *lib, const char *proc, ideal arg, const ring R)
int	ii_CallProcId2Int (const char *lib, const char *proc, ideal arg, const ring R)
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	rSetHdl (idhdl h)
ring	rInit (leftv pn, leftv rv, leftv ord)
idhdl	rDefault (const char *s)
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, const struct sValCmd1 *dA1, int at, const struct sConvertTypes *dConvertTypes)
	apply an operation 'op' to an argument a return TRUE on failure More...
BOOLEAN	iiExprArith2Tab (leftv res, leftv a, int op, const struct sValCmd2 *dA2, int at, const 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, const struct sValCmd3 *dA3, int at, const 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)
lists	rDecompose (const ring r)
lists	rDecompose_list_cf (const ring r)
BOOLEAN	rDecompose_CF (leftv res, const coeffs C)
ring	rCompose (const lists L, const BOOLEAN check_comp=TRUE, const long bitmask=0x7fff, const int isLetterplace=FALSE)
void	iiSetReturn (const leftv h)

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

---

Data Structure Documentation

sValCmd1

struct sValCmd1

Definition at line 78 of file gentable.cc.

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

sValCmd2

struct sValCmd2

Definition at line 69 of file gentable.cc.

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

sValCmd3

struct sValCmd3

Definition at line 86 of file gentable.cc.

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

sValCmdM

struct sValCmdM

Definition at line 96 of file gentable.cc.

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

sValAssign_sys

struct sValAssign_sys

Definition at line 104 of file gentable.cc.

Data Fields
short	arg
int	p
proc1	p
short	res

sValAssign

struct sValAssign

Definition at line 111 of file gentable.cc.

Data Fields
short	arg
int	p
proci	p
short	res

Typedef Documentation

proc1

typedef BOOLEAN(* proc1) (leftv, leftv)

Definition at line 122 of file ipshell.h.

proc2

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

Definition at line 134 of file ipshell.h.

proc3

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

Definition at line 145 of file ipshell.h.

proci

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

Definition at line 175 of file ipshell.h.

Function Documentation

exprlist_length()

int exprlist_length

(

leftv

v

)

Definition at line 552 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;
}

ii_CallLibProcM()

leftv ii_CallLibProcM	(	const char *	n,
		void **	args,
		int *	arg_types,
		const ring	R,
		BOOLEAN &	err
	)

args: NULL terminated array of arguments arg_types: 0 terminated array of corresponding types

Definition at line 701 of file iplib.cc.

{
  idhdl h=ggetid(n);
  if ((h==NULL)
  || (IDTYP(h)!=PROC_CMD))
  {
    err=2;
    return NULL;
  }
  // ring handling
  idhdl save_ringhdl=currRingHdl;
  ring save_ring=currRing;
  rChangeCurrRing(R);
  iiCallLibProcBegin();
  // argument:
  if (arg_types[0]!=0)
  {
    sleftv tmp;
    leftv tt=&tmp;
    int i=1;
    tmp.Init();
    tmp.data=args[0];
    tmp.rtyp=arg_types[0];
    while(arg_types[i]!=0)
    {
      tt->next=(leftv)omAlloc0Bin(sleftv_bin);
      tt=tt->next;
      tt->rtyp=arg_types[i];
      tt->data=args[i];
      i++;
    }
    // call proc
    err=iiMake_proc(h,currPack,&tmp);
  }
  else
  // call proc
    err=iiMake_proc(h,currPack,NULL);
  // clean up ring
  iiCallLibProcEnd(save_ringhdl,save_ring);
  // return
  if (err==FALSE)
  {
    leftv h=(leftv)omAllocBin(sleftv_bin);
    memcpy(h,&iiRETURNEXPR,sizeof(sleftv));
    iiRETURNEXPR.Init();
    return h;
  }
  return NULL;
}

ii_CallProcId2Id()

ideal ii_CallProcId2Id	(	const char *	lib,
		const char *	proc,
		ideal	arg,
		const ring	R
	)

Definition at line 661 of file iplib.cc.

{
  char *plib = iiConvName(lib);
  idhdl h=ggetid(plib);
  omFreeBinAddr(plib);
  if (h==NULL)
  {
    BOOLEAN bo=iiLibCmd(lib,TRUE,TRUE,FALSE);
    if (bo) return NULL;
  }
  ring oldR=currRing;
  rChangeCurrRing(R);
  BOOLEAN err;
  ideal I=(ideal)iiCallLibProc1(proc,idCopy(arg),IDEAL_CMD,err);
  rChangeCurrRing(oldR);
  if (err) return NULL;
  return I;
}

ii_CallProcId2Int()

int ii_CallProcId2Int	(	const char *	lib,
		const char *	proc,
		ideal	arg,
		const ring	R
	)

Definition at line 680 of file iplib.cc.

{
  char *plib = iiConvName(lib);
  idhdl h=ggetid(plib);
  omFreeBinAddr(plib);
  if (h==NULL)
  {
    BOOLEAN bo=iiLibCmd(lib,TRUE,TRUE,FALSE);
    if (bo) return 0;
  }
  BOOLEAN err;
  ring oldR=currRing;
  rChangeCurrRing(R);
  int I=(int)(long)iiCallLibProc1(proc,idCopy(arg),IDEAL_CMD,err);
  rChangeCurrRing(oldR);
  if (err) return 0;
  return I;
}

iiAddCproc()

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

Definition at line 1063 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=IDROOT->get(procname,0);
  if ((h!=NULL)
  && (IDTYP(h)==PROC_CMD))
  {
    pi = IDPROC(h);
    #if 0
    if ((pi->language == LANG_SINGULAR)
    &&(BVERBOSE(V_REDEFINE)))
      Warn("extend `%s`",procname);
    #endif
  }
  else
  {
    h = enterid(procname,0, PROC_CMD, &IDROOT, TRUE);
  }
  if ( h!= NULL )
  {
    pi = IDPROC(h);
    if((pi->language == LANG_SINGULAR)
    ||(pi->language == LANG_NONE))
    {
      omfree(pi->libname);
      pi->libname = omStrDup(libname);
      omfree(pi->procname);
      pi->procname = omStrDup(procname);
      pi->language = LANG_C;
      pi->ref = 1;
      pi->is_static = pstatic;
      pi->data.o.function = func;
    }
    else if(pi->language == LANG_C)
    {
      if(pi->data.o.function == func)
      {
        pi->ref++;
      }
      else
      {
        omfree(pi->libname);
        pi->libname = omStrDup(libname);
        omfree(pi->procname);
        pi->procname = omStrDup(procname);
        pi->language = LANG_C;
        pi->ref = 1;
        pi->is_static = pstatic;
        pi->data.o.function = func;
      }
    }
    else
      Warn("internal error: unknown procedure type %d",pi->language);
    if (currPack->language==LANG_SINGULAR) currPack->language=LANG_MIX;
    return(1);
  }
  else
  {
    WarnS("iiAddCproc: failed.");
  }
  return(0);
}

iiAlias()

BOOLEAN iiAlias

(

leftv

p

)

Definition at line 844 of file ipid.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()) &&(p->Typ()!=DEF_CMD))
  {
    WerrorS("type mismatch");
    return TRUE;
  }
  idhdl pp=(idhdl)p->data;
  switch(pp->typ)
  {
      case CRING_CMD:
        nKillChar((coeffs)pp);
        break;
      case DEF_CMD:
      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);
           omFreeBinAddr((ADDRESS)im->preimage);
           im->preimage=NULL;// and continue
         }
         // 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;
  int eff_typ=h->Typ();
  if ((RingDependend(eff_typ))
  || ((eff_typ==LIST_CMD) && (lRingDependend((lists)h->Data()))))
  {
    ipSwapId(pp,IDROOT,currRing->idroot);
  }
  h->CleanUp();
  omFreeBin((ADDRESS)h, sleftv_bin);
  return FALSE;
}

iiAllStart()

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

Definition at line 298 of file iplib.cc.

{
  int save_trace=traceit;
  int restore_traceit=0;
  if (traceit_stop
  && (traceit & TRACE_SHOW_LINE))
  {
    traceit &=(~TRACE_SHOW_LINE);
    traceit_stop=0;
    restore_traceit=1;
  }
  // 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();
  }
 
  if (restore_traceit) traceit=save_trace;
 
  // 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;
}

iiApply()

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

Definition at line 6431 of file ipshell.cc.

{
  res->Init();
  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;
}

iiARROW()

BOOLEAN iiARROW	(	leftv	r,
		char *	a,
		char *	s
	)

Definition at line 6480 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);
  }
  r->Init();
  // 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;
}

iiAssign()

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

Definition at line 1963 of file ipassign.cc.

{
  if (errorreported) return TRUE;
  int ll=l->listLength();
  int rl;
  int lt=l->Typ();
  int rt=NONE;
  int is_qring=FALSE;
  BOOLEAN b=FALSE;
  if (l->rtyp==ALIAS_CMD)
  {
    Werror("`%s` is read-only",l->Name());
  }
 
  if (l->rtyp==IDHDL)
  {
    atKillAll((idhdl)l->data);
    is_qring=hasFlag((idhdl)l->data,FLAG_QRING_DEF);
    IDFLAG((idhdl)l->data)=0;
    l->attribute=NULL;
    toplevel=FALSE;
  }
  else if (l->attribute!=NULL)
    atKillAll((idhdl)l);
  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,rt,toplevel,is_qring);
        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,rt,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 map_assign=FALSE;
  switch (lt)
  {
    case INTVEC_CMD:
      b=jjA_L_INTVEC(l,r,new intvec(exprlist_length(r)));
      break;
    case INTMAT_CMD:
    {
      b=jjA_L_INTVEC(l,r,new intvec(IDINTVEC((idhdl)l->data)));
      break;
    }
    case BIGINTMAT_CMD:
    {
      b=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)&&(r->e==NULL))
      {
        omFreeBinAddr((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;
      }
      else
      {
        WerrorS("expected ring-name");
        b=TRUE;
        break;
      }
      if (hh==NULL) /* map-assign: map f=r; */
      {
        WerrorS("expected image ideal");
        b=TRUE;
        break;
      }
      if ((hh->next==NULL)&&(hh->Typ()==IDEAL_CMD))
      {
        b=jiAssign_1(l,hh,IDEAL_CMD,toplevel); /* map-assign: map f=r,i; */
        omFreeBin(hh,sleftv_bin);
        return b;
      }
      //no break, handle the rest like an ideal:
      map_assign=TRUE; // and continue
    }
    case MATRIX_CMD:
    case IDEAL_CMD:
    case MODUL_CMD:
    {
      sleftv t;
      matrix olm = (matrix)l->Data();
      long rk;
      char *pr=((map)olm)->preimage;
      BOOLEAN module_assign=(/*l->Typ()*/ lt==MODUL_CMD);
      matrix lm ;
      long  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)
      {
        rk=olm->rows();
        num=olm->cols()*rk /*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);
        if (module_assign)
        {
          rk=0;
          mtyp=MODUL_CMD;
          etyp=VECTOR_CMD;
        }
        else
          rk=1;
      }
 
      int ht;
      loop
      {
        if (hh==NULL)
          break;
        else
        {
          matrix rm;
          ht=hh->Typ();
          if ((j=iiTestConvert(ht,etyp))!=0)
          {
            b=iiConvert(ht,etyp,j,hh,&t);
            hh->next=t.next;
            if (b)
            { Werror("can not convert %s(%s) -> %s",Tok2Cmdname(ht),hh->Name(),Tok2Cmdname(etyp));
               break;
            }
            lm->m[i]=(poly)t.CopyD(etyp);
            pNormalize(lm->m[i]);
            if (module_assign) rk=si_max(rk,pMaxComp(lm->m[i]));
            i++;
          }
          else
          if ((j=iiTestConvert(ht,mtyp))!=0)
          {
            b=iiConvert(ht,mtyp,j,hh,&t);
            hh->next=t.next;
            if (b)
            { Werror("can not convert %s(%s) -> %s",Tok2Cmdname(ht),hh->Name(),Tok2Cmdname(mtyp));
               break;
            }
            rm = (matrix)t.CopyD(mtyp);
            if (module_assign)
            {
              j = si_min((int)num,rm->cols());
              rk=si_max(rk,rm->rank);
            }
            else
              j = si_min(num-i,(long)rm->rows() * (long)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
          {
            b=TRUE;
            Werror("can not convert %s(%s) -> %s",Tok2Cmdname(ht),hh->Name(),Tok2Cmdname(mtyp));
            break;
          }
          t.next=NULL;t.CleanUp();
          if (i==num) break;
          hh=hh->next;
        }
      }
      if (b)
        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:
      b=jjA_L_STRING(l,r);
      break;
    //case DEF_CMD:
    case LIST_CMD:
      b=jjA_L_LIST(l,r);
      break;
    case NONE:
    case 0:
      Werror("cannot assign to %s",l->Fullname());
      b=TRUE;
      break;
    default:
      WerrorS("assign not impl.");
      b=TRUE;
      break;
  } /* end switch: typ */
  if (b && (!errorreported)) WerrorS("incompatible type in list assignment");
  r->CleanUp();
  return b;
}

iiAssignCR()

BOOLEAN iiAssignCR	(	leftv	r,
		leftv	arg
	)

Definition at line 6514 of file ipshell.cc.

{
  char* ring_name=omStrDup((char*)r->Name());
  int t=arg->Typ();
  if (t==RING_CMD)
  {
    sleftv tmp;
    tmp.Init();
    tmp.rtyp=IDHDL;
    idhdl h=rDefault(ring_name);
    tmp.data=(char*)h;
    if (h!=NULL)
    {
      tmp.name=h->id;
      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;
    n.Init();
    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;
  }
  //Print("create %s\n",r->Name());
  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
  return TRUE;// not handled -> error for now
}

iiBranchTo()

BOOLEAN iiBranchTo	(	leftv	r,
		leftv	args
	)

Definition at line 1273 of file ipshell.cc.

{
  // must be inside a proc, as we simultae an proc_end at the end
  if (myynest==0)
  {
    WerrorS("branchTo can only occur in a proc");
    return TRUE;
  }
  // <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;
  // set up the table for type test:
  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)
    {
      omFreeBinAddr(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
    {
      omFreeBinAddr(t);
      Werror("arg %d is not a type name",i);
      return TRUE;
    }
  }
  if (h->Typ()!=PROC_CMD)
  {
    omFreeBinAddr(t);
    Werror("last(%d.) arg.(%s) is not a proc(but %s(%d)), nesting=%d",
           i,h->name,Tok2Cmdname(h->Typ()),h->Typ(),myynest);
    return TRUE;
  }
  b=iiCheckTypes(iiCurrArgs,t,0);
  omFreeBinAddr(t);
  if (b && (h->rtyp==IDHDL) && (h->e==NULL))
  {
    // get the proc:
    iiCurrProc=(idhdl)h->data;
    idhdl currProc=iiCurrProc; /*iiCurrProc may be changed after yyparse*/
    procinfo * pi=IDPROC(currProc);
    // already loaded ?
    if( pi->data.s.body==NULL )
    {
      iiGetLibProcBuffer(pi);
      if (pi->data.s.body==NULL) return TRUE;
    }
    // set currPackHdl/currPack
    if ((pi->pack!=NULL)&&(currPack!=pi->pack))
    {
      currPack=pi->pack;
      iiCheckPack(currPack);
      currPackHdl=packFindHdl(currPack);
      //Print("set pack=%s\n",IDID(currPackHdl));
    }
    // see iiAllStart:
    BITSET save1=si_opt_1;
    BITSET save2=si_opt_2;
    newBuffer( omStrDup(pi->data.s.body), BT_proc,
               pi, pi->data.s.body_lineno-(iiCurrArgs==NULL) );
    BOOLEAN err=yyparse();
    iiCurrProc=NULL;
    si_opt_1=save1;
    si_opt_2=save2;
    // now save the return-expr.
    sLastPrinted.CleanUp(currRing);
    memcpy(&sLastPrinted,&iiRETURNEXPR,sizeof(sleftv));
    iiRETURNEXPR.Init();
    // warning about args.:
    if (iiCurrArgs!=NULL)
    {
      if (err==0) Warn("too many arguments for %s",IDID(currProc));
      iiCurrArgs->CleanUp();
      omFreeBin((ADDRESS)iiCurrArgs, sleftv_bin);
      iiCurrArgs=NULL;
    }
    // similate proc_end:
    // - leave input
    void myychangebuffer();
    myychangebuffer();
    // - set the current buffer to its end (this is a pointer in a buffer,
    //   not a file ptr) "branchTo" is only valid in proc)
    currentVoice->fptr=strlen(currentVoice->buffer);
    // - kill local vars
    killlocals(myynest);
    // - return
    newBuffer(omStrDup("\n;return(_);\n"),BT_execute);
    return (err!=0);
  }
  return FALSE;
}

iiCallLibProc1()

void * iiCallLibProc1	(	const char *	n,
		void *	arg,
		int	arg_type,
		BOOLEAN &	err
	)

Definition at line 627 of file iplib.cc.

{
  idhdl h=ggetid(n);
  if ((h==NULL)
  || (IDTYP(h)!=PROC_CMD))
  {
    err=2;
    return NULL;
  }
  // ring handling
  idhdl save_ringhdl=currRingHdl;
  ring save_ring=currRing;
  iiCallLibProcBegin();
  // argument:
  sleftv tmp;
  tmp.Init();
  tmp.data=arg;
  tmp.rtyp=arg_type;
  // call proc
  err=iiMake_proc(h,currPack,&tmp);
  // clean up ring
  iiCallLibProcEnd(save_ringhdl,save_ring);
  // return
  if (err==FALSE)
  {
    void*r=iiRETURNEXPR.data;
    iiRETURNEXPR.data=NULL;
    iiRETURNEXPR.CleanUp();
    return r;
  }
  return NULL;
}

iiCheckPack()

void iiCheckPack

(

package &

p

)

Definition at line 1630 of file ipshell.cc.

{
  if (p!=basePack)
  {
    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;
    }
  }
}

iiCheckRing()

BOOLEAN iiCheckRing

(

int

i

)

Definition at line 1586 of file ipshell.cc.

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

iiCheckTypes()

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 6572 of file ipshell.cc.

{
  int l=0;
  if (args==NULL)
  {
    if (type_list[0]==0) return TRUE;
  }
  else 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;
}

iiConvName()

char * iiConvName

(

const char *

libname

)

Definition at line 1429 of file iplib.cc.

{
  char *tmpname = omStrDup(libname);
  char *p = strrchr(tmpname, DIR_SEP);
  char *r;
  if(p==NULL) p = tmpname; else p++;
  // p is now the start of the file name (without path)
  r=p;
  while(isalnum(*r)||(*r=='_')) r++;
  // r point the the end of the main part of the filename
  *r = '\0';
  r = omStrDup(p);
  *r = mytoupper(*r);
  // printf("iiConvName: '%s' '%s' => '%s'\n", libname, tmpname, r);
  omFree((ADDRESS)tmpname);
 
  return(r);
}

iiDebug()

void iiDebug

(

)

Definition at line 1065 of file ipshell.cc.

{
#ifdef HAVE_SDB
  sdb_flags=1;
#endif
  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,BREAK_LINE_LENGTH+4);
    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);
  }
}

iiDeclCommand()

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

Definition at line 1198 of file ipshell.cc.

{
  BOOLEAN res=FALSE;
  BOOLEAN is_qring=FALSE;
  const char *id = name->name;
 
  sy->Init();
  if ((name->name==NULL)||(isdigit(name->name[0])))
  {
    WerrorS("object to declare is not a name");
    res=TRUE;
  }
  else
  {
    if (root==NULL) return TRUE;
    if (*root!=IDROOT)
    {
      if ((currRing==NULL) || (*root!=currRing->idroot))
      {
        Werror("can not define `%s` in other package",name->name);
        return TRUE;
      }
    }
    if (t==QRING_CMD)
    {
      t=RING_CMD; // qring is always RING_CMD
      is_qring=TRUE;
    }
 
    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);
      if (is_qring)
      {
        IDFLAG((idhdl)sy->data)=sy->flag=Sy_bit(FLAG_QRING_DEF);
      }
      // 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;
}

iiEStart()

BOOLEAN iiEStart	(	char *	example,
		procinfo *	pi
	)

Definition at line 754 of file iplib.cc.

{
  BOOLEAN err;
  int old_echo=si_echo;
 
  iiCheckNest();
  procstack->push(example);
  iiLocalRing[myynest]=currRing;
  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);
  }
  if (iiLocalRing[myynest] != currRing)
  {
    if (iiLocalRing[myynest]!=NULL)
    {
      rSetHdl(rFindHdl(iiLocalRing[myynest],NULL));
      iiLocalRing[myynest]=NULL;
    }
    else
    {
      currRingHdl=NULL;
      currRing=NULL;
    }
  }
  procstack->pop();
  return err;
}

iiExport() [1/2]

BOOLEAN iiExport	(	leftv	v,
		int	toLev
	)

Definition at line 1511 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))
        nok=TRUE;
    }
    v=v->next;
  }
  r->CleanUp();
  return nok;
}

iiExport() [2/2]

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

Definition at line 1534 of file ipshell.cc.

{
//  if ((pack==basePack)&&(pack!=currPack))
//  { Warn("'exportto' to Top is depreciated in >>%s<<",my_yylinebuf);}
  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 (%s)",IDID(old),my_yylinebuf);
          }
          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;
}

iiExprArith1()

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

iiExprArith1Tab()

BOOLEAN iiExprArith1Tab	(	leftv	res,
		leftv	a,
		int	op,
		const struct sValCmd1 *	dA1,
		int	at,
		const 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 8983 of file iparith.cc.

{
  res->Init();
  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 (5)");
            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 ((dA1[i].valid_for & NO_CONVERSION)==0)
        {
          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 (6)");
                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);
              return failed;
            }
          }
        }
        i++;
      }
      an->CleanUp();
      omFreeBin((ADDRESS)an, sleftv_bin);
    }
    // error handling
    if (!errorreported)
    {
      if ((at==0) && (a->Fullname()!=sNoName_fe))
      {
        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;
}

iiExprArith2()

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

iiExprArith2Tab()

BOOLEAN iiExprArith2Tab	(	leftv	res,
		leftv	a,
		int	op,
		const struct sValCmd2 *	dA2,
		int	at,
		const 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 8910 of file iparith.cc.

{
  res->Init();
  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(); // to clean up the chain, content already done in iiExprArith2TabIntern
  return bo;
}

iiExprArith3()

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

Definition at line 9323 of file iparith.cc.

{
  res->Init();
 
  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;
        // otherwise, try defaul (attrib,..)
      }
      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;
}

iiExprArith3Tab()

BOOLEAN iiExprArith3Tab	(	leftv	res,
		leftv	a,
		int	op,
		const struct sValCmd3 *	dA3,
		int	at,
		const 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 9375 of file iparith.cc.

{
  res->Init();
  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(); // to cleanup the chain, content already done
  return bo;
}

iiExprArithM()

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

iiGetLibName()

static char * iiGetLibName ( const procinfov  pi )

inlinestatic

find the library of an proc

Definition at line 66 of file ipshell.h.

{ return pi->libname; }

iiGetLibProcBuffer()

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

iiGetLibStatus()

BOOLEAN iiGetLibStatus

(

const char *

lib

)

Definition at line 77 of file iplib.cc.

{
  idhdl hl;
 
  char *plib = iiConvName(lib);
  hl = basePack->idroot->get(plib,0);
  omFreeBinAddr(plib);
  if((hl==NULL) ||(IDTYP(hl)!=PACKAGE_CMD))
  {
    return FALSE;
  }
  if ((IDPACKAGE(hl)->language!=LANG_C)&&(IDPACKAGE(hl)->libname!=NULL))
    return (strcmp(lib,IDPACKAGE(hl)->libname)==0);
  return FALSE;
}

iiHighCorner()

poly iiHighCorner	(	ideal	i,
		int	ak
	)

Definition at line 1606 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;
}

iiInternalExport()

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

Definition at line 1465 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;
}

iiLibCmd()

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

Definition at line 884 of file iplib.cc.

{
  if (strcmp(newlib,"Singular")==0) return FALSE;
  char libnamebuf[1024];
  idhdl pl;
  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)
    {
      omFreeBinAddr(plib);
      WarnS("not of type package.");
      fclose(fp);
      return TRUE;
    }
    if (!force)
    {
      omFreeBinAddr(plib);
      return FALSE;
    }
  }
  LoadResult = iiLoadLIB(fp, libnamebuf, newlib, pl, autoexport, tellerror);
 
  if(!LoadResult) IDPACKAGE(pl)->loaded = TRUE;
  omFree((ADDRESS)plib);
  return LoadResult;
}

iiLoadLIB()

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

Definition at line 973 of file iplib.cc.

{
  EXTERN_VAR FILE *yylpin;
  libstackv ls_start = library_stack;
  lib_style_types lib_style;
 
  yylpin = fp;
  #if YYLPDEBUG > 1
  print_init();
  #endif
  EXTERN_VAR 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 occurred: 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);
    WerrorS("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);
    WarnS( "but for functionality you may wish to change to the new");
    WarnS( "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;
}

iiLocateLib()

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

Definition at line 870 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;;
}

iiMake_proc()

BOOLEAN iiMake_proc	(	idhdl	pn,
		package	pack,
		leftv	sl
	)

Definition at line 504 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();
  iiLocalRing[myynest]=currRing;
  //Print("currRing(%d):%s(%x) in %s\n",myynest,IDID(currRingHdl),currRing,IDID(pn));
  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,args);
                 break;
    case LANG_C:
                 leftv res = (leftv)omAlloc0Bin(sleftv_bin);
                 err = (pi->data.o.function)(res, args);
                 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;
}

iiMakeResolv()

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

Definition at line 847 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);
}

iiMap()

leftv iiMap	(	map	theMap,
		const char *	what
	)

Definition at line 615 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=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))
  {
    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));
#ifdef HAVE_SHIFTBBA
      if (rIsLPRing(src_ring))
      {
        // src_ring [x,y,z,...]
        // curr_ring [a,b,c,...]
        //
        // map=[a,b,c,d] -> [a,b,c,...]
        // map=[a,b] -> [a,b,0,...]
 
        short src_lV = src_ring->isLPring;
        short src_ncGenCount = src_ring->LPncGenCount;
        short src_nVars = src_lV - src_ncGenCount;
        int src_nblocks = src_ring->N / src_lV;
 
        short dest_nVars = currRing->isLPring - currRing->LPncGenCount;
        short dest_ncGenCount = currRing->LPncGenCount;
 
        // add missing NULL generators
        for(i=IDELEMS(theMap); i < src_lV - src_ncGenCount; i++)
        {
          theMap->m[i]=NULL;
        }
 
        // remove superfluous generators
        for(i = src_nVars; i < IDELEMS(theMap); i++)
        {
          if (theMap->m[i] != NULL)
          {
            p_Delete(&(theMap->m[i]), currRing);
            theMap->m[i] = NULL;
          }
        }
 
        // add ncgen mappings
        for(i = src_nVars; i < src_lV; i++)
        {
          short ncGenIndex = i - src_nVars;
          if (ncGenIndex < dest_ncGenCount)
          {
            poly p = p_One(currRing);
            p_SetExp(p, dest_nVars + ncGenIndex + 1, 1, currRing);
            p_Setm(p, currRing);
            theMap->m[i] = p;
          }
          else
          {
            theMap->m[i] = NULL;
          }
        }
 
        // copy the first block to all other blocks
        for(i = 1; i < src_nblocks; i++)
        {
          for(int j = 0; j < src_lV; j++)
          {
            theMap->m[(i * src_lV) + j] = p_Copy(theMap->m[j], currRing);
          }
        }
      }
      else
      {
#endif
      for(i=IDELEMS(theMap);i<src_ring->N;i++)
        theMap->m[i]=NULL;
#ifdef HAVE_SHIFTBBA
      }
#endif
      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;
      tmpW.Init();
      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;
        long *degs=(long*)omAlloc(IDELEMS(id)*sizeof(long));
        for(int i=IDELEMS(id)-1;i>=0;i--)
        {
          poly p=id->m[i];
          if (p!=NULL) degs[i]=p_Totaldegree(p,src_ring);
          else         degs[i]=0;
        }
        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) && (degs[i]!=0) &&
              ((unsigned long)deg_monexp > (currRing->bitmask / ((unsigned long)degs[i])/2)))
              {
                overflow=TRUE;
                break;
              }
            }
          }
        }
        omFreeSize(degs,IDELEMS(id)*sizeof(long));
      }
      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;
            long deg=0;
            if ((p!=NULL) && ((deg=p_Totaldegree(p,src_ring))!=0) &&
            ((unsigned long)deg_monexp > (currRing->bitmask / ((unsigned long)deg)/2)))
            {
              overflow=TRUE;
              break;
            }
          }
        }
      }
      if (overflow)
#ifdef HAVE_SHIFTBBA
        // in Letterplace rings the exponent is always 0 or 1! ignore this warning.
        if (!rIsLPRing(currRing))
        {
#endif
        Warn("possible OVERFLOW in map, max exponent is %ld",currRing->bitmask/2);
#ifdef HAVE_SHIFTBBA
        }
#endif
#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
      {
        if ((tmpW.rtyp==IDEAL_CMD)
        ||(tmpW.rtyp==MODUL_CMD)
        ||(tmpW.rtyp==MATRIX_CMD)
        ||(tmpW.rtyp==MAP_CMD))
        {
          v->rtyp=tmpW.rtyp;
          char *tmp = theMap->preimage;
          theMap->preimage=(char*)1L;
          // map gets 1 as its rank (as an ideal)
          v->data=maMapIdeal(IDIDEAL(w), src_ring, (ideal)theMap, currRing,nMap);
          theMap->preimage=tmp; // map gets its preimage back
        }
        if (v->data==NULL) /*i.e. not IDEAL_CMD/MODUL_CMD/MATRIX_CMD/MAP */
        {
          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;
}

iiOpsTwoChar()

int iiOpsTwoChar

(

const char *

s

)

Definition at line 121 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 MINUSMINUS;
              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;
}

iiParameter()

BOOLEAN iiParameter

(

leftv

p

)

Definition at line 1376 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;
}

iiProcArgs()

char * iiProcArgs	(	char *	e,
		BOOLEAN	withParenth
	)

Definition at line 114 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
    // skip leading spaces:
    loop
    {
      if ((*s==' ')||(*s=='\t'))
        s++;
      else if ((*s=='\n')&&(*(s+1)==' '))
        s+=2;
      else // start of new arg or \0 or )
        break;
    }
    e=s;
    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;
}

iiProcName()

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

Definition at line 100 of file iplib.cc.

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

iiPStart()

BOOLEAN iiPStart	(	idhdl	pn,
		leftv	sl
	)

Definition at line 371 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 ======================================*/
  //iiCurrArgs should be NULL here, as the assignment for the parameters
  // of the prevouis call are already done befor calling another routine
  if (v!=NULL)
  {
    iiCurrArgs=(leftv)omAllocBin(sleftv_bin);
    memcpy(iiCurrArgs,v,sizeof(sleftv)); // keeps track of v->next etc.
    v->Init();
  }
  else
  {
    iiCurrArgs=NULL;
  }
  /* start interpreter ======================================*/
  myynest++;
  if (myynest > SI_MAX_NEST)
  {
    WerrorS("nesting too deep");
    err=TRUE;
  }
  else
  {
    iiCurrProc=pn;
    err=iiAllStart(pi,pi->data.s.body,BT_proc,pi->data.s.body_lineno-(v!=NULL));
    iiCurrProc=NULL;
 
    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 -> %s (level %d)",pi->procname,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;
    }
    //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;
}

iiRegularity()

int iiRegularity

(

lists

L

)

Definition at line 1037 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;
}

iiSetReturn()

void iiSetReturn

(

const leftv

h

)

Definition at line 6601 of file ipshell.cc.

{
  if ((source->next==NULL)&&(source->e==NULL))
  {
    if ((source->rtyp!=IDHDL)&&(source->rtyp!=ALIAS_CMD))
    {
      memcpy(&iiRETURNEXPR,source,sizeof(sleftv));
      source->Init();
      return;
    }
    if (source->rtyp==IDHDL)
    {
      if ((IDLEV((idhdl)source->data)==myynest)
      &&(IDTYP((idhdl)source->data)!=RING_CMD))
      {
        iiRETURNEXPR.Init();
        iiRETURNEXPR.rtyp=IDTYP((idhdl)source->data);
        iiRETURNEXPR.data=IDDATA((idhdl)source->data);
        iiRETURNEXPR.flag=IDFLAG((idhdl)source->data);
        iiRETURNEXPR.attribute=IDATTR((idhdl)source->data);
        IDATTR((idhdl)source->data)=NULL;
        IDDATA((idhdl)source->data)=NULL;
        source->name=NULL;
        source->attribute=NULL;
        return;
      }
    }
  }
  iiRETURNEXPR.Copy(source);
}

iiTestAssume()

BOOLEAN iiTestAssume	(	leftv	a,
		leftv	b
	)

Definition at line 6453 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;
}

iiTokType()

int iiTokType

(

int

op

)

Definition at line 233 of file iparith.cc.

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

iiTryLoadLib()

BOOLEAN iiTryLoadLib	(	leftv	v,
		const char *	id
	)

Definition at line 823 of file iplib.cc.

{
  BOOLEAN LoadResult = TRUE;
  char libnamebuf[1024];
  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)
    {
      #ifdef HAVE_DYNAMIC_LOADING
      char libnamebuf[1024];
      #endif
 
      if (LT==LT_SINGULAR)
        LoadResult = iiLibCmd(libname, FALSE, FALSE,TRUE);
      #ifdef HAVE_DYNAMIC_LOADING
      else if ((LT==LT_ELF) || (LT==LT_HPUX))
        LoadResult = load_modules(libname,libnamebuf,FALSE);
      #endif
      else if (LT==LT_BUILTIN)
      {
        LoadResult=load_builtin(libname,FALSE, iiGetBuiltinModInit(libname));
      }
      if(!LoadResult )
      {
        v->name = iiConvName(libname);
        break;
      }
    }
  }
  omFree(libname);
  return LoadResult;
}

iiTwoOps()

const char * iiTwoOps

(

int

t

)

Definition at line 261 of file gentable.cc.

{
  if (t<127)
  {
    STATIC_VAR 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);
  }
}

iiWRITE()

BOOLEAN iiWRITE	(	leftv	res,
		leftv	exprlist
	)

Definition at line 588 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_fe;
    Werror("cannot write to %s",s);
  }
  vf.CleanUp();
  return b;
}

IsCmd()

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

Definition at line 9523 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;
}

jjBETTI()

BOOLEAN jjBETTI	(	leftv	res,
		leftv	v
	)

Definition at line 967 of file ipshell.cc.

{
  sleftv tmp;
  tmp.Init();
  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);
}

jjBETTI2()

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

Definition at line 1001 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=NULL;
  if (l->nr>=0) 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;
  intvec* res_im=syBetti(r,len,&reg,weights,(int)(long)v->Data());
  res->data=(void*)res_im;
  omFreeSize((ADDRESS)r,(len)*sizeof(ideal));
  //Print("rowShift: %d ",add_row_shift);
  for(int i=1;i<=res_im->rows();i++)
  {
    if (IMATELEM(*res_im,1,i)==0) { add_row_shift--; }
    else break;
  }
  //Print(" %d\n",add_row_shift);
  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
  if (weights!=NULL) delete weights;
  return FALSE;
}

jjBETTI2_ID()

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

Definition at line 980 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;
  tmp2.Init();
  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;
}

jjCHARSERIES()

BOOLEAN jjCHARSERIES	(	leftv	res,
		leftv	u
	)

Definition at line 3347 of file ipshell.cc.

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

jjIMPORTFROM()

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

Definition at line 2369 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)
    {
      if (BVERBOSE(V_REDEFINE)) Warn("redefining %s (%s)",vn,my_yylinebuf);
      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;
}

jjLIST_PL()

BOOLEAN jjLIST_PL	(	leftv	res,
		leftv	v
	)

Definition at line 7998 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)
      {
        L->m[i].rtyp=rt;
        L->m[i].data=rIncRefCnt(((ring)h->Data()));
      }
      else
        L->m[i].Copy(h);
    }
  }
  res->data=(char *)L;
  return FALSE;
}

jjLOAD()

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

load lib/module given in v

Definition at line 5512 of file iparith.cc.

{
  char libnamebuf[1024];
  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_level(plib,0);
        if (pl==NULL)
        {
          pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
          IDPACKAGE(pl)->language = LANG_SINGULAR;
          IDPACKAGE(pl)->libname=omStrDup(s);
        }
        else if (IDTYP(pl)!=PACKAGE_CMD)
        {
          Werror("can not create package `%s`",plib);
          omFreeBinAddr(plib);
          return TRUE;
        }
        else /* package */
        {
          package pa=IDPACKAGE(pl);
          if ((pa->language==LANG_C)
          || (pa->language==LANG_MIX))
          {
            Werror("can not create package `%s` - binaries  exists",plib);
            omFreeBinAddr(plib);
            return TRUE;
          }
        }
        omFreeBinAddr(plib);
        package savepack=currPack;
        currPack=IDPACKAGE(pl);
        IDPACKAGE(pl)->loaded=TRUE;
        char libnamebuf[1024];
        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;
}

jjLOAD_TRY()

BOOLEAN jjLOAD_TRY

(

const char *

s

)

Definition at line 5588 of file iparith.cc.

{
  if (!iiGetLibStatus(s))
  {
    void (*WerrorS_save)(const char *s) = WerrorS_callback;
    WerrorS_callback=WerrorS_dummy;
    WerrorS_dummy_cnt=0;
    BOOLEAN bo=jjLOAD(s,TRUE);
    if (TEST_OPT_PROT && (bo || (WerrorS_dummy_cnt>0)))
      Print("loading of >%s< failed\n",s);
    WerrorS_callback=WerrorS_save;
    errorreported=0;
  }
  return FALSE;
}

jjMINRES()

BOOLEAN jjMINRES	(	leftv	res,
		leftv	v
	)

Definition at line 946 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;
}

jjRESULTANT()

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

Definition at line 3340 of file ipshell.cc.

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

jjSetMinpoly()

coeffs jjSetMinpoly	(	coeffs	cf,
		number	a
	)

Definition at line 175 of file ipassign.cc.

{
  if ( !nCoeff_is_transExt(cf) )
  {
    if(!nCoeff_is_algExt(cf) )
    {
      WerrorS("cannot set minpoly for these coeffients");
      return NULL;
    }
  }
  if (rVar(cf->extRing)!=1)
  {
    WerrorS("only univariate minpoly allowed");
    return NULL;
  }
 
  number p = n_Copy(a,cf);
  n_Normalize(p, cf);
 
  if (n_IsZero(p, cf))
  {
    n_Delete(&p, cf);
    return cf;
  }
 
  AlgExtInfo A;
 
  A.r = rCopy(cf->extRing); // Copy  ground field!
  // if minpoly was already set:
  if( cf->extRing->qideal != NULL ) id_Delete(&(A.r->qideal),A.r);
  ideal q = idInit(1,1);
  if ((p==NULL) ||(NUM((fraction)p)==NULL))
  {
    WerrorS("Could not construct the alg. extension: minpoly==0");
    // cleanup A: TODO
    rDelete( A.r );
    return NULL;
  }
  if (DEN((fraction)(p)) != NULL) // minpoly must be a fraction with poly numerator...!!
  {
    poly n=DEN((fraction)(p));
    if(!p_IsConstant(n,cf->extRing))
    {
      WarnS("denominator must be constant - ignoring it");
    }
    p_Delete(&n,cf->extRing);
    DEN((fraction)(p))=NULL;
  }
 
  q->m[0] = NUM((fraction)p);
  A.r->qideal = q;
 
  EXTERN_VAR omBin fractionObjectBin;
  NUM((fractionObject *)p) = NULL; // not necessary, but still...
  omFreeBin((ADDRESS)p, fractionObjectBin);
 
  coeffs new_cf = nInitChar(n_algExt, &A);
  if (new_cf==NULL)
  {
    WerrorS("Could not construct the alg. extension: illegal minpoly?");
    // cleanup A: TODO
    rDelete( A.r );
    return NULL;
  }
  return new_cf;
}

jjSYSTEM()

BOOLEAN jjSYSTEM	(	leftv	res,
		leftv	v
	)

Definition at line 232 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
/*==================== alarm ==================================*/
      if(strcmp(sys_cmd,"alarm")==0)
      {
        if ((h!=NULL) &&(h->Typ()==INT_CMD))
        {
          // standard variant -> SIGALARM (standard: abort)
          //alarm((unsigned)h->next->Data());
          // process time (user +system): SIGVTALARM
          struct itimerval t,o;
          memset(&t,0,sizeof(t));
          t.it_value.tv_sec     =(unsigned)((unsigned long)h->Data());
          setitimer(ITIMER_VIRTUAL,&t,&o);
          return FALSE;
        }
        else
          WerrorS("int expected");
      }
      else
/*==================== content ==================================*/
    if(strcmp(sys_cmd,"content")==0)
    {
      if ((h!=NULL) && ((h->Typ()==POLY_CMD)||(h->Typ()==VECTOR_CMD)))
      {
        int t=h->Typ();
        poly p=(poly)h->CopyD();
        if (p!=NULL)
        {
           if (!nCoeff_is_Ring(currRing->cf)) p_Cleardenom(p,currRing);
          p_Content(p,currRing);
        }
        res->data=(void *)p;
        res->rtyp=t;
        return FALSE;
      }
      return TRUE;
    }
    else
/*==================== cpu ==================================*/
    if(strcmp(sys_cmd,"cpu")==0)
    {
      #if 0
      long cpu=1;
      #ifdef _SC_NPROCESSORS_ONLN
      cpu=sysconf(_SC_NPROCESSORS_ONLN);
      #elif defined(_SC_NPROCESSORS_CONF)
      cpu=sysconf(_SC_NPROCESSORS_CONF);
      #endif
      res->data=(void *)cpu;
      #else
      res->data=(void *)feOptValue(FE_OPT_CPUS);
      #endif
      res->rtyp=INT_CMD;
      return FALSE;
    }
    else
/*==================== executable ==================================*/
    if(strcmp(sys_cmd,"executable")==0)
    {
      if ((h!=NULL) && (h->Typ()==STRING_CMD))
      {
        char tbuf[MAXPATHLEN];
        char *s=omFindExec((char*)h->Data(),tbuf);
        if(s==NULL) s=(char*)"";
        res->data=(void *)omStrDup(s);
        res->rtyp=STRING_CMD;
        return FALSE;
      }
      return TRUE;
    }
    else
  /*==================== flatten =============================*/
    if(strcmp(sys_cmd,"flatten")==0)
    {
      if ((h!=NULL) &&(h->Typ()==SMATRIX_CMD))
      {
        res->data=(char*)sm_Flatten((ideal)h->Data(),currRing);
        res->rtyp=SMATRIX_CMD;
        return FALSE;
      }
      else
        WerrorS("smatrix expected");
    }
    else
  /*==================== unflatten =============================*/
    if(strcmp(sys_cmd,"unflatten")==0)
    {
      const short t1[]={2,SMATRIX_CMD,INT_CMD};
      if (iiCheckTypes(h,t1,1))
      {
        res->data=(char*)sm_UnFlatten((ideal)h->Data(),(int)(long)h->next->Data(),currRing);
        res->rtyp=SMATRIX_CMD;
        return res->data==NULL;
      }
      else return TRUE;
    }
    else
  /*==================== neworder =============================*/
    if(strcmp(sys_cmd,"neworder")==0)
    {
      if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
      {
        res->rtyp=STRING_CMD;
        res->data=(void *)singclap_neworder((ideal)h->Data(), currRing);
        return FALSE;
      }
      else
        WerrorS("ideal expected");
    }
    else
/*===== nc_hilb ===============================================*/
   // Hilbert series of non-commutative monomial algebras
    if(strcmp(sys_cmd,"nc_hilb") == 0)
    {
      ideal i; int lV;
      bool ig = FALSE;
      bool mgrad = FALSE;
      bool autop = FALSE;
      int trunDegHs=0;
      if((h != NULL)&&(h->Typ() == IDEAL_CMD))
        i = (ideal)h->Data();
      else
      {
        WerrorS("nc_Hilb:ideal expected");
        return TRUE;
      }
      h = h->next;
      if((h != NULL)&&(h->Typ() == INT_CMD))
        lV = (int)(long)h->Data();
      else
      {
        WerrorS("nc_Hilb:int expected");
        return TRUE;
      }
      h = h->next;
      while(h != NULL)
      {
        if((int)(long)h->Data() == 1)
          ig = TRUE;
        else if((int)(long)h->Data() == 2)
          mgrad = TRUE;
        else if(h->Typ()==STRING_CMD)
           autop = TRUE;
        else if(h->Typ() == INT_CMD)
          trunDegHs = (int)(long)h->Data();
        h = h->next;
      }
      if(h != NULL)
      {
        WerrorS("nc_Hilb:int 1,2, total degree for the truncation, and a string                  for printing the details are expected");
        return TRUE;
      }
 
      HilbertSeries_OrbitData(i, lV, ig, mgrad, autop, trunDegHs);
      return(FALSE);
    }
    else
/* ====== verify ============================*/
    if(strcmp(sys_cmd,"verifyGB")==0)
    {
      if (rIsNCRing(currRing))
      {
        WerrorS("system(\"verifyGB\",<ideal>,..) expects a commutative ring");
        return TRUE;
      }
      if (h->Typ()!=IDEAL_CMD)
      {
        WerrorS("expected system(\"verifyGB\",<ideal>,..)");
        return TRUE;
      }
      ideal F=(ideal)h->Data();
      if (h->next==NULL)
      {
        #ifdef HAVE_VSPACE
        int cpus = (long) feOptValue(FE_OPT_CPUS);
        if (cpus>1)
          res->data=(char*)(long) kVerify2(F,currRing->qideal);
        else
        #endif
          res->data=(char*)(long) kVerify1(F,currRing->qideal);
      }
      else return TRUE;
      res->rtyp=INT_CMD;
      return FALSE;
    }
    else
/*===== rcolon ===============================================*/
  if(strcmp(sys_cmd,"rcolon") == 0)
  {
    const short t1[]={3,IDEAL_CMD,POLY_CMD,INT_CMD};
    if (iiCheckTypes(h,t1,1))
    {
      ideal i = (ideal)h->Data();
      h = h->next;
      poly w=(poly)h->Data();
      h = h->next;
      int lV = (int)(long)h->Data();
      res->rtyp = IDEAL_CMD;
      res->data = RightColonOperation(i, w, lV);
      return(FALSE);
    }
    else
      return TRUE;
  }
  else
 
/*==================== sh ==================================*/
    if(strcmp(sys_cmd,"sh")==0)
    {
      if (FE_OPT_NO_SHELL_FLAG)
      {
        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
/*========reduce procedure like the global one but with jet bounds=======*/
    if(strcmp(sys_cmd,"reduce_bound")==0)
    {
      poly p;
      ideal pid=NULL;
      const short t1[]={3,POLY_CMD,IDEAL_CMD,INT_CMD};
      const short t2[]={3,IDEAL_CMD,IDEAL_CMD,INT_CMD};
      const short t3[]={3,VECTOR_CMD,MODUL_CMD,INT_CMD};
      const short t4[]={3,MODUL_CMD,MODUL_CMD,INT_CMD};
      if ((iiCheckTypes(h,t1,0))||((iiCheckTypes(h,t3,0))))
      {
        p = (poly)h->CopyD();
      }
      else if  ((iiCheckTypes(h,t2,0))||(iiCheckTypes(h,t4,1)))
      {
        pid = (ideal)h->CopyD();
      }
      else return TRUE;
      //int htype;
      res->rtyp= h->Typ(); /*htype*/
      ideal q = (ideal)h->next->CopyD();
      int bound = (int)(long)h->next->next->Data();
      if (pid==NULL) /*(htype == POLY_CMD || htype == VECTOR_CMD)*/
        res->data = (char *)kNFBound(q,currRing->qideal,p,bound);
      else /*(htype == IDEAL_CMD || htype == MODUL_CMD)*/
        res->data = (char *)kNFBound(q,currRing->qideal,pid,bound);
      return FALSE;
    }
    else
/*==================== 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
    if (strcmp(sys_cmd, "SingularBin") == 0)
    {
      res->rtyp=STRING_CMD;
      const char *r=feResource('r');
      if (r == NULL) r="/usr/local";
      int l=strlen(r);
      /* where to find Singular's programs: */
      #define SINGULAR_PROCS_DIR "/libexec/singular/MOD"
      int ll=si_max((int)strlen(SINGULAR_PROCS_DIR),(int)strlen(LIBEXEC_DIR));
      char *s=(char*)omAlloc(l+ll+2);
      if ((strstr(r,".libs/..")==NULL)   /*not installed Singular (libtool)*/
      &&(strstr(r,"Singular/..")==NULL)) /*not installed Singular (static)*/
      {
        strcpy(s,r);
        strcat(s,SINGULAR_PROCS_DIR);
        if (access(s,X_OK)==0)
        {
          strcat(s,"/");
        }
        else
        {
          /*second try: LIBEXEC_DIR*/
          strcpy(s,LIBEXEC_DIR);
          if (access(s,X_OK)==0)
          {
            strcat(s,"/");
          }
          else
          {
            s[0]='\0';
          }
        }
      }
      else
      {
        const char *r=feResource('b');
        if (r == NULL)
        {
          s[0]='\0';
        }
        else
        {
          strcpy(s,r);
          strcat(s,"/");
        }
      }
      res->data = (void*)s;
      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)
    {
      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 ======================*/
    #if defined(HAVE_FLINT) || defined(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
  #if __FLINT_RELEASE >= 20500
    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
/* ====== rref ============================*/
  #if defined(HAVE_FLINT) || defined(HAVE_NTL)
  if(strcmp(sys_cmd,"rref")==0)
  {
    const short t1[]={1,MATRIX_CMD};
    const short t2[]={1,SMATRIX_CMD};
    if (iiCheckTypes(h,t1,0))
    {
      matrix M=(matrix)h->Data();
      #if defined(HAVE_FLINT)
      res->data=(void*)singflint_rref(M,currRing);
      #elif defined(HAVE_NTL)
      res->data=(void*)singntl_rref(M,currRing);
      #endif
      res->rtyp=MATRIX_CMD;
      return FALSE;
    }
    else if (iiCheckTypes(h,t2,1))
    {
      ideal M=(ideal)h->Data();
      #if defined(HAVE_FLINT)
      res->data=(void*)singflint_rref(M,currRing);
      #elif defined(HAVE_NTL)
      res->data=(void*)singntl_rref(M,currRing);
      #endif
      res->rtyp=SMATRIX_CMD;
      return FALSE;
    }
    else
    {
      WerrorS("expected system(\"rref\",<matrix>/<smatrix>)");
      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
  /*==================== 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[]={6,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,RING_CMD,INT_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(\"Mwalk\" ...) intvecs not of length %d\n",
           currRing->N);
        return TRUE;
      }
      ideal arg1 = (ideal) h->CopyD();
      intvec* arg2 = (intvec*) h->next->Data();
      intvec* arg3 = (intvec*) h->next->next->Data();
      ring arg4 = (ring) 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) Mwalk(arg1, arg2, arg3, arg4, arg5, arg6);
      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[]={8,IDEAL_CMD,INT_CMD,INT_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_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();
      int arg7 = (int) (long) h->next->next->next->next->next->next->Data();
      int arg8 = (int) (long) h->next->next->next->next->next->next->next->Data();
      ideal result = (ideal) Mpwalk(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
      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[]={7,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD,INT_CMD,INT_CMD};
      if (!iiCheckTypes(h,t,1)) return TRUE;
      if(((intvec*) h->next->Data())->length() != currRing->N &&
         ((intvec*) h->next->Data())->length() != (currRing->N)*(currRing->N) &&
         ((intvec*) h->next->next->Data())->length() != 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();
      int arg6 = (int)(long) h->next->next->next->next->next->Data();
      int arg7 = (int)(long) h->next->next->next->next->next->next->Data();
      ideal result = (ideal) Mrwalk(arg1, arg2, arg3, arg4, arg5, arg6, arg7);
      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[]={5,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_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)(long) h->next->next->next->Data();
      int arg5 = (int)(long) h->next->next->next->next->Data();
      ideal result = (ideal) Mfwalk(arg1, arg2, arg3, arg4, arg5);
      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,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(\"Mfrwalk\" ...) intvecs not of length %d\n",currRing->N);
        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(\"Mfrwalk\" ...) 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();
      int arg6 = (int)(long) h->next->next->next->next->next->Data();
      ideal result = (ideal) Mfrwalk(arg1, arg2, arg3, arg4, arg5, arg6);
      res->rtyp = IDEAL_CMD;
      res->data =  result;
      return FALSE;
    }
    else
  /*==================== Mprwalk =================*/
    if (strcmp(sys_cmd, "Mprwalk") == 0)
    {
      const short t[]={9,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD,INT_CMD,INT_CMD,INT_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 ) &&
         (((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();
      int arg6 = (int)(long) h->next->next->next->next->next->Data();
      int arg7 = (int)(long) h->next->next->next->next->next->next->Data();
      int arg8 = (int)(long) h->next->next->next->next->next->next->next->Data();
      int arg9 = (int)(long) h->next->next->next->next->next->next->next->next->Data();
      ideal result = (ideal) Mprwalk(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9);
      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;
}

jjVARIABLES_ID()

BOOLEAN jjVARIABLES_ID	(	leftv	res,
		leftv	u
	)

Definition at line 6318 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;
}

jjVARIABLES_P()

BOOLEAN jjVARIABLES_P	(	leftv	res,
		leftv	u
	)

Definition at line 6310 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;
}

killlocals()

void killlocals

(

int

v

)

Definition at line 386 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)
    {
      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();
}

kQHWeight()

BOOLEAN kQHWeight	(	leftv	res,
		leftv	v
	)

Definition at line 3323 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;
}

kWeight()

BOOLEAN kWeight	(	leftv	res,
		leftv	id
	)

Definition at line 3301 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;
}

list_cmd()

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

Definition at line 425 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)==PACKAGE_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))
    || ((IDTYP(h)==CRING_CMD) && (typ==RING_CMD))
    )
    {
      list1(prefix,h,start==currRingHdl, fullname);
      if ((IDTYP(h)==RING_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;
}

loNewtonP()

BOOLEAN loNewtonP	(	leftv	res,
		leftv	arg1
	)

compute Newton Polytopes of input polynomials

Definition at line 4563 of file ipshell.cc.

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

loSimplex()

BOOLEAN loSimplex	(	leftv	res,
		leftv	args
	)

Implementation of the Simplex Algorithm.

For args, see class simplex.

Definition at line 4569 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;
}

mpJacobi()

BOOLEAN mpJacobi	(	leftv	res,
		leftv	a
	)

Definition at line 3069 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;
}

mpKoszul()

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

Definition at line 3091 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);
  }
  omFreeSize(choise,d*sizeof(int));
  if (id==NULL) idDelete(&temp);
 
  res->data=(char *)result;
  return FALSE;
}

nuLagSolve()

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 4678 of file ipshell.cc.

{
  poly gls;
  gls= (poly)(arg1->Data());
  int howclean= (int)(long)arg3->Data();
 
  if ( gls == NULL || pIsConstant( gls ) )
  {
    WerrorS("Input polynomial is constant!");
    return TRUE;
  }
 
  if (rField_is_Zp(currRing))
  {
    int* r=Zp_roots(gls, currRing);
    lists rlist;
    rlist= (lists)omAlloc( sizeof(slists) );
    rlist->Init( r[0] );
    for(int i=r[0];i>0;i--)
    {
      rlist->m[i-1].data=n_Init(r[i],currRing->cf);
      rlist->m[i-1].rtyp=NUMBER_CMD;
    }
    omFree(r);
    res->data=rlist;
    res->rtyp= LIST_CMD;
    return FALSE;
  }
  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 );
  }
 
  int ldummy;
  int deg= currRing->pLDeg( gls, &ldummy, currRing );
  int i,vpos=0;
  poly piter;
  lists elist;
 
  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 && 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;
 
  lists rlist;
  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->data= (void*)rlist;
 
  return FALSE;
}

nuMPResMat()

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 4655 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;
}

nuUResSolve()

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 4922 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;
  if (smv!=NULL) nDelete( &smv );
 
  res->data= (void *)listofroots;
 
  //emptylist->Clean();
  //  omFreeSize( (ADDRESS) emptylist, sizeof(slists) );
 
  return FALSE;
}

nuVanderSys()

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 4821 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;
}

paPrint()

void paPrint	(	const char *	n,
		package	p
	)

Definition at line 6333 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_MAX:      PrintS("M"); break;
    case LANG_NONE:     PrintS("N"); break;
    default:            PrintS("U");
  }
  if(p->libname!=NULL)
  Print(",%s", p->libname);
  PrintS(")");
}

rCompose()

ring rCompose	(	const lists	L,
		const BOOLEAN	check_comp = TRUE,
		const long	bitmask = 0x7fff,
		const int	isLetterplace = FALSE
	)

Definition at line 2783 of file ipshell.cc.

{
  if ((L->nr!=3)
#ifdef HAVE_PLURAL
  &&(L->nr!=5)
#endif
  )
    return NULL;
  int is_gf_char=0;
  // 0: char/ cf - ring
  // 1: list (var)
  // 2: list (ord)
  // 3: qideal
  // possibly:
  // 4: C
  // 5: D
 
  ring R = (ring) omAlloc0Bin(sip_sring_bin);
 
  // ------------------------------------------------------------------
  // 0: char:
  if (L->m[0].Typ()==CRING_CMD)
  {
    R->cf=(coeffs)L->m[0].Data();
    R->cf->ref++;
  }
  else if (L->m[0].Typ()==INT_CMD)
  {
    int ch = (int)(long)L->m[0].Data();
    assume( ch >= 0 );
 
    if (ch == 0) // Q?
      R->cf = nInitChar(n_Q, NULL);
    else
    {
      int l = IsPrime(ch); // Zp?
      if( l != ch )
      {
        Warn("%d is invalid characteristic of ground field. %d is used.", ch, l);
        ch = l;
      }
      #ifndef TEST_ZN_AS_ZP
      R->cf = nInitChar(n_Zp, (void*)(long)ch);
      #else
      mpz_t modBase;
      mpz_init_set_ui(modBase,(long) ch);
      ZnmInfo info;
      info.base= modBase;
      info.exp= 1;
      R->cf=nInitChar(n_Zn,(void*) &info); //exponent is missing
      R->cf->is_field=1;
      R->cf->is_domain=1;
      R->cf->has_simple_Inverse=1;
      #endif
    }
  }
  else if (L->m[0].Typ()==LIST_CMD) // something complicated...
  {
    lists LL=(lists)L->m[0].Data();
 
#ifdef HAVE_RINGS
    if (LL->m[0].Typ() == STRING_CMD) // 1st comes a string?
    {
      rComposeRing(LL, R); // Ring!?
    }
    else
#endif
    if (LL->nr < 3)
      rComposeC(LL,R); // R, long_R, long_C
    else
    {
      if (LL->m[0].Typ()==INT_CMD)
      {
        int ch = (int)(long)LL->m[0].Data();
        while ((ch!=fftable[is_gf_char]) && (fftable[is_gf_char])) is_gf_char++;
        if (fftable[is_gf_char]==0) is_gf_char=-1;
 
        if(is_gf_char!= -1)
        {
          GFInfo param;
 
          param.GFChar = ch;
          param.GFDegree = 1;
          param.GFPar_name = (const char*)(((lists)(LL->m[1].Data()))->m[0].Data());
 
          // nfInitChar should be able to handle the case when ch is in fftables!
          R->cf = nInitChar(n_GF, (void*)&param);
        }
      }
 
      if( R->cf == NULL )
      {
        ring extRing = rCompose((lists)L->m[0].Data(),FALSE,0x7fff);
 
        if (extRing==NULL)
        {
          WerrorS("could not create the specified coefficient field");
          goto rCompose_err;
        }
 
        if( extRing->qideal != NULL ) // Algebraic extension
        {
          AlgExtInfo extParam;
 
          extParam.r = extRing;
 
          R->cf = nInitChar(n_algExt, (void*)&extParam);
        }
        else // Transcendental extension
        {
          TransExtInfo extParam;
          extParam.r = extRing;
 
          R->cf = nInitChar(n_transExt, &extParam);
        }
      }
    }
  }
  else
  {
    WerrorS("coefficient field must be described by `int` or `list`");
    goto rCompose_err;
  }
 
  if( R->cf == NULL )
  {
    WerrorS("could not create coefficient field described by the input!");
    goto rCompose_err;
  }
 
  // ------------------------- VARS ---------------------------
  if (rComposeVar(L,R)) goto rCompose_err;
  // ------------------------ ORDER ------------------------------
  if (rComposeOrder(L,check_comp,R)) goto rCompose_err;
 
  // ------------------------ ??????? --------------------
 
  if (!isLetterplace) rRenameVars(R);
  #ifdef HAVE_SHIFTBBA
  else
  {
    R->isLPring=isLetterplace;
    R->ShortOut=FALSE;
    R->CanShortOut=FALSE;
  }
  #endif
  if ((bitmask!=0)&&(R->wanted_maxExp==0)) R->wanted_maxExp=bitmask;
  rComplete(R);
 
  // ------------------------ Q-IDEAL ------------------------
 
  if (L->m[3].Typ()==IDEAL_CMD)
  {
    ideal q=(ideal)L->m[3].Data();
    if (q->m[0]!=NULL)
    {
      if (R->cf != currRing->cf) //->cf->ch!=currRing->cf->ch)
      {
      #if 0
            WerrorS("coefficient fields must be equal if q-ideal !=0");
            goto rCompose_err;
      #else
        ring orig_ring=currRing;
        rChangeCurrRing(R);
        int *perm=NULL;
        int *par_perm=NULL;
        int par_perm_size=0;
        nMapFunc nMap;
 
        if ((nMap=nSetMap(orig_ring->cf))==NULL)
        {
          if (rEqual(orig_ring,currRing))
          {
            nMap=n_SetMap(currRing->cf, currRing->cf);
          }
          else
          // Allow imap/fetch to be make an exception only for:
          if ( (rField_is_Q_a(orig_ring) &&  // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
            (rField_is_Q(currRing) || rField_is_Q_a(currRing) ||
             rField_is_Zp(currRing) || rField_is_Zp_a(currRing) ||
             rField_is_Zn(currRing)))
           ||
           (rField_is_Zp_a(orig_ring) &&  // Zp(a..) -> Zp(a..) || Zp
            (rField_is_Zp(currRing, rInternalChar(orig_ring)) ||
             rField_is_Zp_a(currRing, rInternalChar(orig_ring)))) )
          {
            par_perm_size=rPar(orig_ring);
 
//            if ((orig_ring->minpoly != NULL) || (orig_ring->qideal != NULL))
//              naSetChar(rInternalChar(orig_ring),orig_ring);
//            else ntSetChar(rInternalChar(orig_ring),orig_ring);
 
            nSetChar(currRing->cf);
          }
          else
          {
            WerrorS("coefficient fields must be equal if q-ideal !=0");
            goto rCompose_err;
          }
        }
        perm=(int *)omAlloc0((orig_ring->N+1)*sizeof(int));
        if (par_perm_size!=0)
          par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
        int i;
        #if 0
        // use imap:
        maFindPerm(orig_ring->names,orig_ring->N,orig_ring->parameter,orig_ring->P,
          currRing->names,currRing->N,currRing->parameter, currRing->P,
          perm,par_perm, currRing->ch);
        #else
        // use fetch
        if ((rPar(orig_ring)>0) && (rPar(currRing)==0))
        {
          for(i=si_min(rPar(orig_ring),rVar(currRing))-1;i>=0;i--) par_perm[i]=i+1;
        }
        else if (par_perm_size!=0)
          for(i=si_min(rPar(orig_ring),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
        for(i=si_min(orig_ring->N,rVar(currRing));i>0;i--) perm[i]=i;
        #endif
        ideal dest_id=idInit(IDELEMS(q),1);
        for(i=IDELEMS(q)-1; i>=0; i--)
        {
          dest_id->m[i]=p_PermPoly(q->m[i],perm,orig_ring, currRing,nMap,
                                  par_perm,par_perm_size);
          //  PrintS("map:");pWrite(dest_id->m[i]);PrintLn();
          pTest(dest_id->m[i]);
        }
        R->qideal=dest_id;
        if (perm!=NULL)
          omFreeSize((ADDRESS)perm,(orig_ring->N+1)*sizeof(int));
        if (par_perm!=NULL)
          omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
        rChangeCurrRing(orig_ring);
      #endif
      }
      else
        R->qideal=idrCopyR(q,currRing,R);
    }
  }
  else
  {
    WerrorS("q-ideal must be given as `ideal`");
    goto rCompose_err;
  }
 
 
  // ---------------------------------------------------------------
  #ifdef HAVE_PLURAL
  if (L->nr==5)
  {
    if (nc_CallPlural((matrix)L->m[4].Data(),
                      (matrix)L->m[5].Data(),
                      NULL,NULL,
                      R,
                      true, // !!!
                      true, false,
                      currRing, FALSE)) goto rCompose_err;
    // takes care about non-comm. quotient! i.e. calls "nc_SetupQuotient" due to last true
  }
  #endif
  return R;
 
rCompose_err:
  if (R->N>0)
  {
    int i;
    if (R->names!=NULL)
    {
      i=R->N-1;
      while (i>=0) { omfree(R->names[i]); i--; }
      omFree(R->names);
    }
  }
  omfree(R->order);
  omfree(R->block0);
  omfree(R->block1);
  omfree(R->wvhdl);
  omFree(R);
  return NULL;
}

rDecompose()

lists rDecompose

(

const ring

r

)

Definition at line 2161 of file ipshell.cc.

{
  assume( r != NULL );
  const coeffs C = r->cf;
  assume( C != NULL );
 
  // sanity check: require currRing==r for rings with polynomial data
  if ( (r!=currRing) && (
           (nCoeff_is_algExt(C) && (C != currRing->cf))
        || (r->qideal != NULL)
#ifdef HAVE_PLURAL
        || (rIsPluralRing(r))
#endif
                        )
     )
  {
    WerrorS("ring with polynomial data must be the base ring or compatible");
    return NULL;
  }
  // 0: char/ cf - ring
  // 1: list (var)
  // 2: list (ord)
  // 3: qideal
  // possibly:
  // 4: C
  // 5: D
  lists L=(lists)omAlloc0Bin(slists_bin);
  if (rIsPluralRing(r))
    L->Init(6);
  else
    L->Init(4);
  // ----------------------------------------
  // 0: char/ cf - ring
  if (rField_is_numeric(r))
  {
    rDecomposeC(&(L->m[0]),r);
  }
  else if (rField_is_Ring(r))
  {
    rDecomposeRing(&(L->m[0]),r);
  }
  else if ( r->cf->extRing!=NULL )// nCoeff_is_algExt(r->cf))
  {
    rDecomposeCF(&(L->m[0]), r->cf->extRing, r);
  }
  else if(rField_is_GF(r))
  {
    lists Lc=(lists)omAlloc0Bin(slists_bin);
    Lc->Init(4);
    // char:
    Lc->m[0].rtyp=INT_CMD;
    Lc->m[0].data=(void*)(long)r->cf->m_nfCharQ;
    // var:
    lists Lv=(lists)omAlloc0Bin(slists_bin);
    Lv->Init(1);
    Lv->m[0].rtyp=STRING_CMD;
    Lv->m[0].data=(void *)omStrDup(*rParameter(r));
    Lc->m[1].rtyp=LIST_CMD;
    Lc->m[1].data=(void*)Lv;
    // ord:
    lists Lo=(lists)omAlloc0Bin(slists_bin);
    Lo->Init(1);
    lists Loo=(lists)omAlloc0Bin(slists_bin);
    Loo->Init(2);
    Loo->m[0].rtyp=STRING_CMD;
    Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
 
    intvec *iv=new intvec(1); (*iv)[0]=1;
    Loo->m[1].rtyp=INTVEC_CMD;
    Loo->m[1].data=(void *)iv;
 
    Lo->m[0].rtyp=LIST_CMD;
    Lo->m[0].data=(void*)Loo;
 
    Lc->m[2].rtyp=LIST_CMD;
    Lc->m[2].data=(void*)Lo;
    // q-ideal:
    Lc->m[3].rtyp=IDEAL_CMD;
    Lc->m[3].data=(void *)idInit(1,1);
    // ----------------------
    L->m[0].rtyp=LIST_CMD;
    L->m[0].data=(void*)Lc;
  }
  else if (rField_is_Zp(r) || rField_is_Q(r))
  {
    L->m[0].rtyp=INT_CMD;
    L->m[0].data=(void *)(long)r->cf->ch;
  }
  else
  {
    L->m[0].rtyp=CRING_CMD;
    L->m[0].data=(void *)r->cf;
    r->cf->ref++;
  }
  // ----------------------------------------
  rDecompose_23456(r,L);
  return L;
}

rDecompose_CF()

BOOLEAN rDecompose_CF	(	leftv	res,
		const coeffs	C
	)

Definition at line 1949 of file ipshell.cc.

{
  assume( C != NULL );
 
  // sanity check: require currRing==r for rings with polynomial data
  if ( nCoeff_is_algExt(C) && (C != currRing->cf))
  {
    WerrorS("ring with polynomial data must be the base ring or compatible");
    return TRUE;
  }
  if (nCoeff_is_numeric(C))
  {
    rDecomposeC_41(res,C);
  }
#ifdef HAVE_RINGS
  else if (nCoeff_is_Ring(C))
  {
    rDecomposeRing_41(res,C);
  }
#endif
  else if ( C->extRing!=NULL )// nCoeff_is_algExt(r->cf))
  {
    rDecomposeCF(res, C->extRing, currRing);
  }
  else if(nCoeff_is_GF(C))
  {
    lists Lc=(lists)omAlloc0Bin(slists_bin);
    Lc->Init(4);
    // char:
    Lc->m[0].rtyp=INT_CMD;
    Lc->m[0].data=(void*)(long)C->m_nfCharQ;
    // var:
    lists Lv=(lists)omAlloc0Bin(slists_bin);
    Lv->Init(1);
    Lv->m[0].rtyp=STRING_CMD;
    Lv->m[0].data=(void *)omStrDup(*n_ParameterNames(C));
    Lc->m[1].rtyp=LIST_CMD;
    Lc->m[1].data=(void*)Lv;
    // ord:
    lists Lo=(lists)omAlloc0Bin(slists_bin);
    Lo->Init(1);
    lists Loo=(lists)omAlloc0Bin(slists_bin);
    Loo->Init(2);
    Loo->m[0].rtyp=STRING_CMD;
    Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
 
    intvec *iv=new intvec(1); (*iv)[0]=1;
    Loo->m[1].rtyp=INTVEC_CMD;
    Loo->m[1].data=(void *)iv;
 
    Lo->m[0].rtyp=LIST_CMD;
    Lo->m[0].data=(void*)Loo;
 
    Lc->m[2].rtyp=LIST_CMD;
    Lc->m[2].data=(void*)Lo;
    // q-ideal:
    Lc->m[3].rtyp=IDEAL_CMD;
    Lc->m[3].data=(void *)idInit(1,1);
    // ----------------------
    res->rtyp=LIST_CMD;
    res->data=(void*)Lc;
  }
  else
  {
    res->rtyp=INT_CMD;
    res->data=(void *)(long)C->ch;
  }
  // ----------------------------------------
  return FALSE;
}

rDecompose_list_cf()

lists rDecompose_list_cf

(

const ring

r

)

Definition at line 2122 of file ipshell.cc.

{
  assume( r != NULL );
  const coeffs C = r->cf;
  assume( C != NULL );
 
  // sanity check: require currRing==r for rings with polynomial data
  if ( (r!=currRing) && (
        (r->qideal != NULL)
#ifdef HAVE_PLURAL
        || (rIsPluralRing(r))
#endif
                        )
     )
  {
    WerrorS("ring with polynomial data must be the base ring or compatible");
    return NULL;
  }
  // 0: char/ cf - ring
  // 1: list (var)
  // 2: list (ord)
  // 3: qideal
  // possibly:
  // 4: C
  // 5: D
  lists L=(lists)omAlloc0Bin(slists_bin);
  if (rIsPluralRing(r))
    L->Init(6);
  else
    L->Init(4);
  // ----------------------------------------
  // 0: char/ cf - ring
  L->m[0].rtyp=CRING_CMD;
  L->m[0].data=(char*)r->cf; r->cf->ref++;
  // ----------------------------------------
  rDecompose_23456(r,L);
  return L;
}

rDefault()

idhdl rDefault

(

const char *

s

)

Definition at line 1644 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();
  }
 
  ring r = IDRING(tmp) = (ring) omAlloc0Bin(sip_sring_bin);
 
  #ifndef TEST_ZN_AS_ZP
  r->cf = nInitChar(n_Zp, (void*)32003); //   r->cf->ch = 32003;
  #else
  mpz_t modBase;
  mpz_init_set_ui(modBase, (long)32003);
  ZnmInfo info;
  info.base= modBase;
  info.exp= 1;
  r->cf=nInitChar(n_Zn,(void*) &info);
  r->cf->is_field=1;
  r->cf->is_domain=1;
  r->cf->has_simple_Inverse=1;
  #endif
  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 = (rRingOrder_t *) omAlloc(3 * sizeof(rRingOrder_t *));
  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]  = (rRingOrder_t)0;
 
  /* complete ring intializations */
  rComplete(r);
  rSetHdl(tmp);
  return currRingHdl;
}

rFindHdl()

idhdl rFindHdl	(	ring	r,
		idhdl	n
	)

Definition at line 1701 of file ipshell.cc.

{
  if  ((r==NULL)||(r->VarOffset==NULL))
    return NULL;
  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;
}

rInit()

ring rInit	(	leftv	pn,
		leftv	rv,
		leftv	ord
	)

Definition at line 5625 of file ipshell.cc.

{
  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)
  {
    cf=(coeffs)pn->CopyD();
    leftv pnn=pn;
    if(P>1) /*parameter*/
    {
      pnn = pnn->next;
      const int pars = pnn->listLength();
      assume( pars > 0 );
      char ** names = (char**)omAlloc0(pars * sizeof(char_ptr));
 
      if (rSleftvList2StringArray(pnn, names))
      {
        WerrorS("parameter expected");
        goto rInitError;
      }
 
      TransExtInfo extParam;
 
      extParam.r = rDefault( cf, 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);
    }
    assume( cf != NULL );
  }
  else if (pn->Typ()==INT_CMD)
  {
    int ch = (int)(long)pn->Data();
    leftv pnn=pn;
 
    /* parameter? -------------------------------------------------------*/
    pnn = pnn->next;
 
    if (pnn == 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;
        }
        #ifndef TEST_ZN_AS_ZP
        cf = nInitChar(n_Zp, (void*)(long)ch);
        #else
        mpz_t modBase;
        mpz_init_set_ui(modBase, (long)ch);
        ZnmInfo info;
        info.base= modBase;
        info.exp= 1;
        cf=nInitChar(n_Zn,(void*) &info);
        cf->is_field=1;
        cf->is_domain=1;
        cf->has_simple_Inverse=1;
        #endif
      }
      else
        cf = nInitChar(n_Q, (void*)(long)ch);
    }
    else
    {
      const int pars = pnn->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 = pnn->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(pnn, 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) ->Error: Invalid ground field specification
  }
  else if ((pn->name != NULL)
  && ((strcmp(pn->name,"real")==0) || (strcmp(pn->name,"complex")==0)))
  {
    leftv pnn=pn->next;
    BOOLEAN complex_flag=(strcmp(pn->name,"complex")==0);
    if ((pnn!=NULL) && (pnn->Typ()==INT_CMD))
    {
      float_len=(int)(long)pnn->Data();
      float_len2=float_len;
      pnn=pnn->next;
      if ((pnn!=NULL) && (pnn->Typ()==INT_CMD))
      {
        float_len2=(int)(long)pnn->Data();
        pnn=pnn->next;
      }
    }
 
    if (!complex_flag)
      complex_flag= (pnn!=NULL) && (pnn->name!=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 ((pnn == NULL) || (pnn->name == NULL))
           param.par_name=(const char*)"i"; //default to i
         else
           param.par_name = (const char*)pnn->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!?
    mpz_t modBase;
    unsigned int modExponent = 1;
    mpz_init_set_si(modBase, 0);
    if (pn->next!=NULL)
    {
      leftv pnn=pn;
      if (pnn->next->Typ()==INT_CMD)
      {
        pnn=pnn->next;
        mpz_set_ui(modBase, (long) pnn->Data());
        if ((pnn->next!=NULL) && (pnn->next->Typ()==INT_CMD))
        {
          pnn=pnn->next;
          modExponent = (long) pnn->Data();
        }
        while ((pnn->next!=NULL) && (pnn->next->Typ()==INT_CMD))
        {
          pnn=pnn->next;
          mpz_mul_ui(modBase, modBase, (int)(long) pnn->Data());
        }
      }
      else if (pnn->next->Typ()==BIGINT_CMD)
      {
        number p=(number)pnn->next->CopyD();
        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_sgn1(modBase) < 0))
    {
      WerrorS("Wrong ground ring specification (module is 1)");
      goto rInitError;
    }
    if (modExponent < 1)
    {
      WerrorS("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);
      }
      else
      {
        if (mpz_sgn1(modBase)==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_sgn1(modBase)==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 );
    mpz_clear(modBase);
  }
#endif
  // ring NEW = OLD, (), (); where OLD is a polynomial ring...
  else if ((pn->Typ()==RING_CMD) && (P == 1))
  {
    ring r=(ring)pn->Data();
    if (r->qideal==NULL)
    {
      TransExtInfo extParam;
      extParam.r = r;
      extParam.r->ref++;
      cf = nInitChar(n_transExt, &extParam); // R(a)
    }
    else if (IDELEMS(r->qideal)==1)
    {
      AlgExtInfo extParam;
      extParam.r=r;
      extParam.r->ref++;
      cf = nInitChar(n_algExt, &extParam);   // R[a]/<minideal>
    }
    else
    {
      WerrorS("algebraic extension ring must have one minpoly");
      goto rInitError;
    }
  }
  else
  {
    WerrorS("Wrong or unknown ground field specification");
#if 0
// debug stuff for unknown cf descriptions:
    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;
  }
 
  /*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)
  {
    WerrorS("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
  pn->CleanUp();
  rv->CleanUp();
  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);
  pn->CleanUp();
  rv->CleanUp();
  ord->CleanUp();
  return NULL;
}

rKill() [1/2]

void rKill

(

idhdl

h

)

Definition at line 6226 of file ipshell.cc.

{
  ring r = IDRING(h);
  int ref=0;
  if (r!=NULL)
  {
    // avoid, that sLastPrinted is the last reference to the base ring:
    // clean up before killing the last "named" refrence:
    if ((sLastPrinted.rtyp==RING_CMD)
    && (sLastPrinted.data==(void*)r))
    {
      sLastPrinted.CleanUp(r);
    }
    ref=r->ref;
    if ((ref<=0)&&(r==currRing))
    {
      // cleanup DENOMINATOR_LIST
      if (DENOMINATOR_LIST!=NULL)
      {
        denominator_list dd=DENOMINATOR_LIST;
        if (TEST_V_ALLWARN)
          Warn("deleting denom_list for ring change from %s",IDID(h));
        do
        {
          n_Delete(&(dd->n),currRing->cf);
          dd=dd->next;
          omFreeBinAddr(DENOMINATOR_LIST);
          DENOMINATOR_LIST=dd;
        } while(DENOMINATOR_LIST!=NULL);
      }
    }
    rKill(r);
  }
  if (h==currRingHdl)
  {
    if (ref<=0) { currRing=NULL; currRingHdl=NULL;}
    else
    {
      currRingHdl=rFindHdl(r,currRingHdl);
    }
  }
}

rKill() [2/2]

void rKill

(

ring

r

)

Definition at line 6180 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
    int j;
    for (j=0;j<myynest;j++)
    {
      if (iiLocalRing[j]==r)
      {
        if (j==0) WarnS("killing the basering for level 0");
        iiLocalRing[j]=NULL;
      }
    }
// 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;
  }
  rDecRefCnt(r);
}

rSetHdl()

void rSetHdl

(

idhdl

h

)

Definition at line 5126 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);
  }
  else return;
 
  // clean up history
  if (currRing!=NULL)
  {
    if(sLastPrinted.RingDependend())
    {
      sLastPrinted.CleanUp();
    }
 
    if (rg!=currRing)/*&&(currRing!=NULL)*/
    {
      if (rg->cf!=currRing->cf)
      {
        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;
            omFreeBinAddr(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;
}

scIndIndset()

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

Definition at line 1103 of file ipshell.cc.

{
  int i;
  indset save;
  lists res=(lists)omAlloc0Bin(slists_bin);
 
  hexist = hInit(S, Q, &hNexist);
  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;
  }
  save = ISet = (indset)omAlloc0Bin(indlist_bin);
  hMu = 0;
  hwork = (scfmon)omAlloc(hNexist * sizeof(scmon));
  hvar = (varset)omAlloc((rVar(currRing) + 1) * sizeof(int));
  hpure = (scmon)omAlloc0((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;
    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;
}

semicProc()

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

Definition at line 4551 of file ipshell.cc.

{
  sleftv tmp;
  tmp.Init();
  tmp.rtyp=INT_CMD;
  /* tmp.data = (void *)0;  -- done by Init */
 
  return  semicProc3(res,u,v,&tmp);
}

semicProc3()

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

Definition at line 4511 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);
}

setOption()

BOOLEAN setOption	(	leftv	res,
		leftv	v
	)

Definition at line 568 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()
        && !rField_is_Ring(currRing)
        ) {
          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
          WarnS("cannot set option");
#if 0
        if (TEST_OPT_INTSTRATEGY && (currRing!=NULL)
        && rField_has_simple_inverse()
        && !rField_is_Ring(currRing)
        ) {
          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
          WarnS("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_VAR 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_VAR 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;
    omFreeBinAddr((ADDRESS)n);
    v=v->next;
  } while (v!=NULL);
 
   // set global variable to show memory usage
  if (BVERBOSE(V_SHOW_MEM)) om_sing_opt_show_mem = 1;
  else om_sing_opt_show_mem = 0;
 
  return FALSE;
}

showOption()

char * showOption

(

)

Definition at line 709 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();
}

singular_example()

void singular_example

(

char *

str

)

Definition at line 430 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_level(s,0);
  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);
    }
  }
}

singular_system()

leftv singular_system

(

sleftv

h

)

spaddProc()

BOOLEAN spaddProc	(	leftv	result,
		leftv	first,
		leftv	second
	)

Definition at line 4428 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);
}

spectrumfProc()

BOOLEAN spectrumfProc	(	leftv	result,
		leftv	first
	)

Definition at line 4184 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);
}

spectrumProc()

BOOLEAN spectrumProc	(	leftv	result,
		leftv	first
	)

Definition at line 4133 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);
}

spmulProc()

BOOLEAN spmulProc	(	leftv	result,
		leftv	first,
		leftv	second
	)

Definition at line 4470 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);
}

syBetti1()

BOOLEAN syBetti1	(	leftv	res,
		leftv	u
	)

Definition at line 3170 of file ipshell.cc.

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

syBetti2()

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

Definition at line 3147 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;
}

syConvList()

syStrategy syConvList

(

lists

li

)

Definition at line 3254 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;
  }
  return result;
}

syConvRes()

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

Definition at line 3182 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 (toDel)
    syKillComputation(syzstr);
  else
  {
    if( fullres != NULL && syzstr->fullres == NULL )
      syzstr->fullres = fullres;
 
    if( minres != NULL && syzstr->minres == NULL )
      syzstr->minres = minres;
  }
  return li;
}

test_cmd()

void test_cmd

(

int

i

)

Definition at line 514 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)
    {
      WarnS("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");
}

Tok2Cmdname()

const char * Tok2Cmdname

(

int

i

)

Definition at line 140 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";
  // 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
}

type_cmd()

void type_cmd

(

leftv

v

)

Definition at line 254 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: 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;
}

versionString()

char * versionString

(

)

Definition at line 770 of file misc_ip.cc.

{
  StringSetS("");
  StringAppend("Singular for %s version %s (%d, %d bit) %s",
               S_UNAME, VERSION, // SINGULAR_VERSION,
               SINGULAR_VERSION, sizeof(void*)*8,
#ifdef MAKE_DISTRIBUTION
               VERSION_DATE);
#else
               singular_date);
#endif
  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
              StringAppend("NTL(%s),",NTL_VERSION);
#endif
 
#ifdef HAVE_FLINT
              StringAppend("FLINT(%s),",FLINT_VERSION);
#endif
//              StringAppendS("factory(" FACTORYVERSION "),");
              StringAppendS("\n\t");
#ifndef HAVE_OMALLOC
              StringAppendS("xalloc,");
#else
              StringAppendS("omalloc,");
#endif
#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)
                StringAppend("dynamic readline%d),",RL_VERSION_MAJOR);
              #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)
              StringAppend("static readline(%d),",RL_VERSION_MAJOR);
  #else
    #ifdef HAVE_FEREAD
              StringAppendS("emulated readline,");
    #else
              StringAppendS("fgets,");
    #endif
  #endif
#endif
#ifdef HAVE_PLURAL
              StringAppendS("Plural,");
#endif
#ifdef HAVE_VSPACE
  #if defined(__GNUC__) && (__GNUC__<9) &&!defined(__clang__)
              StringAppendS("vspace(1),");
  #else
              StringAppendS("vspace(2),");
  #endif
#endif
#ifdef HAVE_DBM
              StringAppendS("DBM,\n\t");
#else
              StringAppendS("\n\t");
#endif
#ifdef HAVE_DYNAMIC_LOADING
              StringAppendS("dynamic modules,");
#endif
#ifdef HAVE_DYNANIC_PPROCS
              StringAppendS("dynamic p_Procs,");
#endif
#if YYDEBUG
              StringAppendS("YYDEBUG=1,");
#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
              StringAppendS("\n\t");
#ifdef __OPTIMIZE__
              StringAppendS("CC:OPTIMIZE,");
#endif
#ifdef __OPTIMIZE_SIZE__
              StringAppendS("CC:OPTIMIZE_SIZE,");
#endif
#ifdef __NO_INLINE__
              StringAppendS("CC:NO_INLINE,");
#endif
#ifdef HAVE_NTL
  #ifdef NTL_AVOID_BRANCHING
  #undef HAVE_GENERIC_ADD
  #endif
#endif
#ifdef HAVE_GENERIC_ADD
              StringAppendS("GenericAdd,");
#else
              StringAppendS("AvoidBranching,");
#endif
#ifdef HAVE_GENERIC_MULT
              StringAppendS("GenericMult,");
#else
              StringAppendS("TableMult,");
#endif
#ifdef HAVE_INVTABLE
              StringAppendS("invTable,");
#else
              StringAppendS("no invTable,");
#endif
              StringAppendS("\n\t");
#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 " " PTHREAD_CFLAGS,
              CXX,CXXFLAGS " " PTHREAD_CFLAGS,  DEFS,CPPFLAGS,  LDFLAGS,
              LIBS " " PTHREAD_LIBS);
              feStringAppendResources(0);
              feStringAppendBrowsers(0);
              StringAppendS("\n");
              return StringEndS();
}

Variable Documentation

currid

const char* currid

extern

Definition at line 171 of file grammar.cc.

dArith1

const struct sValCmd1 dArith1[]

extern

Definition at line 37 of file table.h.

dArith2

const struct sValCmd2 dArith2[]

extern

Definition at line 321 of file table.h.

dArith3

const struct sValCmd3 dArith3[]

extern

Definition at line 777 of file table.h.

dArithM

const struct sValCmdM dArithM[]

extern

Definition at line 909 of file table.h.

iiCurrArgs

EXTERN_VAR leftv iiCurrArgs

Definition at line 29 of file ipshell.h.

iiCurrProc

EXTERN_VAR idhdl iiCurrProc

Definition at line 30 of file ipshell.h.

iiLocalRing

EXTERN_VAR ring* iiLocalRing

Definition at line 35 of file ipshell.h.

iiOp

EXTERN_VAR int iiOp

Definition at line 31 of file ipshell.h.

iiRETURNEXPR

EXTERN_INST_VAR sleftv iiRETURNEXPR

Definition at line 34 of file ipshell.h.

iiRETURNEXPR_len

EXTERN_VAR int iiRETURNEXPR_len

Definition at line 33 of file ipshell.h.

lastreserved

const char* lastreserved

extern

Definition at line 82 of file ipshell.cc.

myynest

EXTERN_VAR int myynest

Definition at line 38 of file ipshell.h.

printlevel

EXTERN_VAR int printlevel

Definition at line 39 of file ipshell.h.

si_echo

EXTERN_VAR int si_echo

Definition at line 40 of file ipshell.h.

yyInRingConstruction

EXTERN_VAR BOOLEAN yyInRingConstruction

Definition at line 43 of file ipshell.h.