ipid.cc File Reference

#include "kernel/mod2.h"
#include "misc/options.h"
#include "misc/intvec.h"
#include "coeffs/numbers.h"
#include "coeffs/bigintmat.h"
#include "polys/matpol.h"
#include "polys/monomials/ring.h"
#include "kernel/polys.h"
#include "kernel/ideals.h"
#include "kernel/GBEngine/syz.h"
#include "Singular/tok.h"
#include "Singular/ipshell.h"
#include "Singular/fevoices.h"
#include "Singular/lists.h"
#include "Singular/attrib.h"
#include "Singular/links/silink.h"
#include "Singular/ipid.h"
#include "Singular/blackbox.h"
#include "Singular/number2.h"
#include "polys/mod_raw.h"

Go to the source code of this file.

Functions
void	paCleanUp (package pack)
void *	idrecDataInit (int t)
idhdl	enterid (const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
void	killid (const char *id, idhdl *ih)
void	killhdl (idhdl h, package proot)
void	killhdl2 (idhdl h, idhdl *ih, ring r)
idhdl	ggetid (const char *n)
void	ipListFlag (idhdl h)
lists	ipNameList (idhdl root)
lists	ipNameListLev (idhdl root, int lev)
static int	ipSwapId (idhdl tomove, idhdl &root1, idhdl &root2)
void	ipMoveId (idhdl tomove)
const char *	piProcinfo (procinfov pi, const char *request)
BOOLEAN	piKill (procinfov pi)
idhdl	packFindHdl (package r)
BOOLEAN	iiAlias (leftv p)

Variables
VAR omBin	sip_command_bin = omGetSpecBin(sizeof(sip_command))
VAR omBin	sip_package_bin = omGetSpecBin(sizeof(sip_package))
VAR omBin	idrec_bin = omGetSpecBin(sizeof(idrec))
VAR proclevel *	procstack =NULL
VAR idhdl	currPackHdl = NULL
VAR idhdl	basePackHdl = NULL
VAR package	currPack = NULL
VAR package	basePack = NULL
VAR idhdl	currRingHdl = NULL

Function Documentation

enterid()

idhdl enterid	(	const char *	s,
		int	lev,
		int	t,
		idhdl *	root,
		BOOLEAN	init,
		BOOLEAN	search )

Definition at line 256 of file ipid.cc.

{
  if (s==NULL) return NULL;
  if (root==NULL) return NULL;
  idhdl h;
  s=omStrDup(s);
  // idhdl *save_root=root;
  if (t==PACKAGE_CMD)
  {
    if (root!=&(basePack->idroot))
    {
      root=&(basePack->idroot);
    }
  }
  // is it already defined in root ?
  if ((h=(*root)->get_level(s,lev))!=NULL)
  {
    if ((IDTYP(h) == t)||(t==DEF_CMD))
    {
      if (IDTYP(h)==PACKAGE_CMD)
      {
        if (strcmp(s,"Top")==0)
        {
          goto errlabel;
        }
        else return h;
      }
      else
      {
        if (BVERBOSE(V_REDEFINE))
        {
          const char *f=VoiceName();
          if (strcmp(f,"STDIN")==0)
            Warn("redefining %s (%s)",s,my_yylinebuf);
          else
            Warn("redefining %s (%s) %s:%d",s,my_yylinebuf,f, yylineno);
        }
        if (s==IDID(h)) IDID(h)=NULL;
        if((t!=PROC_CMD)||(IDPROC(h)->language!=LANG_C))
        {
          killhdl2(h,root,currRing);
        }
      }
    }
    else
      goto errlabel;
  }
  // is it already defined in currRing->idroot ?
  else if (search && (currRing!=NULL)&&((*root) != currRing->idroot))
  {
    if ((h=currRing->idroot->get_level(s,lev))!=NULL)
    {
      if ((IDTYP(h) == t)||(t==DEF_CMD))
      {
        if (BVERBOSE(V_REDEFINE))
        {
          const char *f=VoiceName();
          if (strcmp(f,"STDIN")==0)
            Warn("redefining %s (%s)",s,my_yylinebuf);
          else
            Warn("redefining %s (%s) %s:%d",s,my_yylinebuf,f, yylineno);
        }
        if (s==IDID(h)) IDID(h)=NULL;
        //  proc is not ring-dep, no need to check for type "proc":
        killhdl2(h,&currRing->idroot,currRing);
      }
      else
        goto errlabel;
    }
  }
  // is it already defined in idroot ?
  else if (search && (*root != IDROOT))
  {
    if ((h=IDROOT->get_level(s,lev))!=NULL)
    {
      if ((IDTYP(h) == t)||(t==DEF_CMD))
      {
        if (BVERBOSE(V_REDEFINE))
        {
          const char *f=VoiceName();
          if (strcmp(f,"STDIN")==0)
            Warn("redefining %s (%s)",s,my_yylinebuf);
          else
            Warn("redefining %s (%s) %s:%d",s,my_yylinebuf,f, yylineno);
        }
        if (s==IDID(h)) IDID(h)=NULL;
        if((t!=PROC_CMD)||(IDPROC(h)->language!=LANG_C))
        {
          killhdl2(h,&IDROOT,NULL);
        }
      }
      else
        goto errlabel;
    }
  }
  *root = (*root)->set(s, lev, t, init);
#ifndef SING_NDEBUG
  checkall();
#endif
  return *root;
 
  errlabel:
    //Werror("identifier `%s` in use(lev h=%d,typ=%d,t=%d, curr=%d)",s,IDLEV(h),IDTYP(h),t,lev);
    Werror("identifier `%s` in use",s);
    //listall();
    omFreeBinAddr((ADDRESS)s);
    return NULL;
}

ggetid()

idhdl ggetid

(

const char *

n

)

Definition at line 558 of file ipid.cc.

{
  if (currRing!=NULL)
  {
    idhdl h2 = currRing->idroot->get(n,myynest);
    if ((h2!=NULL)&&(IDLEV(h2)==myynest)) return h2;
    idhdl h = IDROOT->get(n,myynest);
    if (h!=NULL) return h;
    if (h2!=NULL) return h2;
  }
  else
  {
    idhdl h = IDROOT->get(n,myynest);
    if (h!=NULL) return h;
  }
  if (basePack!=currPack)
    return basePack->idroot->get(n,myynest);
  return NULL;
}

idrecDataInit()

void * idrecDataInit

(

int

t

)

Definition at line 116 of file ipid.cc.

{
  switch (t)
  {
    //the type with init routines:
#ifdef SINGULAR_4_2
    case CNUMBER_CMD:
      return (void*)n2Init(0,NULL);
    case CPOLY_CMD:
      return (void*)p2Init(0,NULL);
    case CMATRIX_CMD:
#endif
    case BIGINTMAT_CMD:
      return (void *)new bigintmat();
    case BIGINTVEC_CMD:
      return (void *)new bigintmat(1,0,coeffs_BIGINT);
    case BUCKET_CMD:
      if (currRing!=NULL)
      return (void*)sBucketCreate(currRing);
      else
      {
        WerrorS("need basering for polyBucket");
        return NULL;
      }
    case INTVEC_CMD:
    case INTMAT_CMD:
      return (void *)new intvec();
    case NUMBER_CMD:
    {
      if (currRing!=NULL) return (void *) nInit(0);
      else                return NULL;
    }
    case BIGINT_CMD:
      return (void *) n_Init(0, coeffs_BIGINT);
    case IDEAL_CMD:
    case MODUL_CMD:
    case MATRIX_CMD:
    case SMATRIX_CMD:
      return (void*) idInit(1,1);
    case MAP_CMD:
    {
      map m = (map)idInit(1,1);
      m->preimage = omStrDup(IDID(currRingHdl));
      return (void *)m;
    }
    case STRING_CMD:
      return (void *)omAlloc0(1);
    case LIST_CMD:
    {
      lists l=(lists)omAllocBin(slists_bin);
      l->Init();
      return (void*)l;
    }
    //the types with the standard init: set the struct to zero
    case LINK_CMD:
      return (void*) omAlloc0Bin(sip_link_bin);
    case PACKAGE_CMD:
    {
      package pa=(package)omAlloc0Bin(sip_package_bin);
      pa->language=LANG_NONE;
      pa->loaded = FALSE;
      return (void*)pa;
    }
    case PROC_CMD:
    {
      procinfov pi=(procinfov)omAlloc0Bin(procinfo_bin);
      pi->ref=1;
      pi->language=LANG_NONE;
      return (void*)pi;
    }
    case RESOLUTION_CMD:
      return  (void *)omAlloc0(sizeof(ssyStrategy));
    //other types: without alloc. (int,script,poly,def,package,..)
    case INT_CMD:
    case DEF_CMD:
    case POLY_CMD:
    case VECTOR_CMD:
    case RING_CMD:
    case CRING_CMD:
    case QRING_CMD:
      return NULL;
    default:
      {
        if (t>MAX_TOK)
        {
#ifdef BLACKBOX_DEVEL
          Print("bb-type %d\n",t);
#endif
          blackbox *bb=getBlackboxStuff(t);
          if (bb!=NULL)
             return (void *)bb->blackbox_Init(bb);
        }
        else
          Werror("unknown type in idrecDataInit:%d",t);
        break;
      }
  }
  return (void *)0L;
}

iiAlias()

BOOLEAN iiAlias

(

leftv

p

)

Definition at line 818 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:
         {
           int t=p->Typ();
           if (t<MAX_TOK)
           {
             Werror("unknown type %d(%s)",t,Tok2Cmdname(t));
             return TRUE;
           }
           /*else: blackbox type, not yet set*/
           break;
         }
  }
  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;
}

ipListFlag()

void ipListFlag

(

idhdl

h

)

Definition at line 596 of file ipid.cc.

{
  if (hasFlag(h,FLAG_STD)) PrintS(" (SB)");
#ifdef HAVE_PLURAL
  if (hasFlag(h,FLAG_TWOSTD)) PrintS(" (2SB)");
#endif
}

ipMoveId()

void ipMoveId

(

idhdl

tomove

)

Definition at line 681 of file ipid.cc.

{
  if ((currRing!=NULL)&&(tomove!=NULL))
  {
    if (RingDependend(IDTYP(tomove))
    || ((IDTYP(tomove)==LIST_CMD) && (lRingDependend(IDLIST(tomove)))))
    {
      /*move 'tomove' to ring id's*/
      if (ipSwapId(tomove,IDROOT,currRing->idroot))
      ipSwapId(tomove,basePack->idroot,currRing->idroot);
    }
    else
    {
      /*move 'tomove' to global id's*/
      ipSwapId(tomove,currRing->idroot,IDROOT);
    }
  }
}

ipNameList()

lists ipNameList

(

idhdl

root

)

Definition at line 604 of file ipid.cc.

{
  idhdl h=root;
  /* compute the length */
  int l=0;
  while (h!=NULL) { l++; h=IDNEXT(h); }
  /* allocate list */
  lists L=(lists)omAllocBin(slists_bin);
  L->Init(l);
  /* copy names */
  h=root;
  l=0;
  while (h!=NULL)
  {
    /* list is initialized with 0 => no need to clear anything */
    L->m[l].rtyp=STRING_CMD;
    L->m[l].data=omStrDup(IDID(h));
    l++;
    h=IDNEXT(h);
  }
  return L;
}

ipNameListLev()

lists ipNameListLev	(	idhdl	root,
		int	lev )

Definition at line 627 of file ipid.cc.

{
  idhdl h=root;
  /* compute the length */
  int l=0;
  while (h!=NULL) { if (IDLEV(h)==lev) l++; h=IDNEXT(h); }
  /* allocate list */
  lists L=(lists)omAllocBin(slists_bin);
  L->Init(l);
  /* copy names */
  h=root;
  l=0;
  while (h!=NULL)
  {
    if (IDLEV(h)==lev)
    {
      /* list is initialized with 0 => no need to clear anything */
      L->m[l].rtyp=STRING_CMD;
      L->m[l].data=omStrDup(IDID(h));
      l++;
    }
    h=IDNEXT(h);
  }
  return L;
}

ipSwapId()

int ipSwapId ( idhdl tomove, idhdl & root1, idhdl & root2 )

static

Definition at line 656 of file ipid.cc.

{
  idhdl h;
  /* search 'tomove' in root2 : if found -> do nothing */
  h=root2;
  while ((h!=NULL) && (h!=tomove)) h=IDNEXT(h);
  if (h!=NULL) return FALSE; /*okay */
  /* search predecessor of h in root1, remove 'tomove' */
  h=root1;
  if (tomove==h)
  {
    root1=IDNEXT(h);
  }
  else
  {
    while ((h!=NULL) && (IDNEXT(h)!=tomove)) h=IDNEXT(h);
    if (h==NULL) return TRUE; /* not in the list root1 -> do nothing */
    IDNEXT(h)=IDNEXT(tomove);
  }
  /* add to root2 list */
  IDNEXT(tomove)=root2;
  root2=tomove;
  return FALSE;
}

killhdl()

void killhdl	(	idhdl	h,
		package	proot )

Definition at line 391 of file ipid.cc.

{
  int t=IDTYP(h);
  if (((BEGIN_RING<t) && (t<END_RING))
  || ((t==LIST_CMD) && (lRingDependend((lists)IDDATA(h)))))
    killhdl2(h,&currRing->idroot,currRing);
  else
  {
    if(t==PACKAGE_CMD)
    {
      killhdl2(h,&(basePack->idroot),NULL);
    }
    else
    {
      idhdl s=proot->idroot;
      while ((s!=h) && (s!=NULL)) s=s->next;
      if (s!=NULL)
        killhdl2(h,&(proot->idroot),NULL);
      else if (basePack!=proot)
      {
        idhdl s=basePack->idroot;
        while ((s!=h) && (s!=NULL)) s=s->next;
        if (s!=NULL)
          killhdl2(h,&(basePack->idroot),currRing);
        else
          killhdl2(h,&(currRing->idroot),currRing);
       }
    }
  }
}

killhdl2()

void killhdl2	(	idhdl	h,
		idhdl *	ih,
		ring	r )

Definition at line 422 of file ipid.cc.

{
  //printf("kill %s, id %x, typ %d lev: %d\n",IDID(h),(int)IDID(h),IDTYP(h),IDLEV(h));
  idhdl hh;
 
  if (TEST_V_ALLWARN
  && (IDLEV(h)!=myynest)
  &&(IDLEV(h)==0))
  {
    if (((*ih)==basePack->idroot)
    || ((currRing!=NULL)&&((*ih)==currRing->idroot)))
      Warn("kill global `%s` at line >>%s<<\n",IDID(h),my_yylinebuf);
  }
  if ((IDTYP(h)!=PROC_CMD) && (h->attribute!=NULL))
  {
    if ((IDTYP(h)==RING_CMD)&&(IDRING(h)!=r))
       h->attribute->killAll(IDRING(h));
    else
       h->attribute->killAll(r);
    h->attribute=NULL;
  }
  if (IDTYP(h) == PACKAGE_CMD)
  {
    if ((((IDPACKAGE(h)->language==LANG_C) ||(IDPACKAGE(h)->language==LANG_MIX))
      &&(IDPACKAGE(h)->idroot!=NULL))
    || (strcmp(IDID(h),"Top")==0))
    {
      Warn("cannot kill `%s`",IDID(h));
      return;
    }
    // any objects defined for this package ?
    if ((IDPACKAGE(h)->ref<=0)  &&  (IDPACKAGE(h)->idroot!=NULL))
    {
      if (currPack==IDPACKAGE(h))
      {
        currPack=basePack;
        currPackHdl=NULL;
      }
      idhdl * hd = &IDRING(h)->idroot;
      idhdl  hdh = IDNEXT(*hd);
      idhdl  temp;
      while (hdh!=NULL)
      {
        temp = IDNEXT(hdh);
        killhdl2(hdh,&(IDPACKAGE(h)->idroot),NULL);
        hdh = temp;
      }
      killhdl2(*hd,hd,NULL);
      if (IDPACKAGE(h)->libname!=NULL) omFreeBinAddr((ADDRESS)(IDPACKAGE(h)->libname));
    }
    paKill(IDPACKAGE(h));
    if (currPackHdl==h) currPackHdl=packFindHdl(currPack);
    iiCheckPack(currPack);
  }
  else if (IDTYP(h)==RING_CMD)
    rKill(h);
  else if (IDDATA(h)!=NULL)
    s_internalDelete(IDTYP(h),IDDATA(h),r);
  IDDATA(h)=NULL;
  //  general  -------------------------------------------------------------
  // now dechain it and delete idrec
  if (IDID(h)!=NULL) // OB: ?????
    omFreeBinAddr((ADDRESS)IDID(h));
  IDID(h)=NULL;
  IDDATA(h)=NULL;
  if (h == (*ih))
  {
    // h is at the beginning of the list
    *ih = IDNEXT(h) /* ==*ih */;
  }
  else if (ih!=NULL)
  {
    // h is somethere in the list:
    hh = *ih;
    loop
    {
      if (hh==NULL)
      {
        PrintS(">>?<< not found for kill\n");
        return;
      }
      idhdl hhh = IDNEXT(hh);
      if (hhh == h)
      {
        IDNEXT(hh) = IDNEXT(hhh);
        break;
      }
      hh = hhh;
    }
  }
  omFreeBin((ADDRESS)h, idrec_bin);
}

killid()

void killid	(	const char *	id,
		idhdl *	ih )

Definition at line 364 of file ipid.cc.

{
  if (id!=NULL)
  {
    idhdl h = (*ih)->get(id,myynest);
 
    // id not found in global list, is it defined in current ring ?
    if (h==NULL)
    {
      if ((currRing!=NULL) && (*ih != (currRing->idroot)))
      {
        h = currRing->idroot->get(id,myynest);
        if (h!=NULL)
        {
          killhdl2(h,&(currRing->idroot),currRing);
          return;
        }
      }
      Werror("`%s` is not defined",id);
      return;
    }
    killhdl2(h,ih,currRing);
  }
  else
    WerrorS("kill what ?");
}

packFindHdl()

idhdl packFindHdl

(

package

r

)

Definition at line 805 of file ipid.cc.

{
  idhdl h=basePack->idroot;
  while (h!=NULL)
  {
    if ((IDTYP(h)==PACKAGE_CMD)
        && (IDPACKAGE(h)==r))
      return h;
    h=IDNEXT(h);
  }
  return NULL;
}

paCleanUp()

void paCleanUp

(

package

pack

)

Definition at line 759 of file ipid.cc.

{
  (pack->ref)--;
  if (pack->ref < 0)
  {
    if( pack->language == LANG_C)
    {
      Print("//dlclose(%s)\n",pack->libname);
#ifdef HAVE_DYNAMIC_LOADING
      dynl_close (pack->handle);
#endif /* HAVE_DYNAMIC_LOADING */
    }
    omFreeBinAddr((ADDRESS)pack->libname);
    memset((void *) pack, 0, sizeof(sip_package));
    pack->language=LANG_NONE;
  }
}

piKill()

BOOLEAN piKill

(

procinfov

pi

)

Definition at line 724 of file ipid.cc.

{
  (pi->ref)--;
  if (pi->ref == 0)
  {
    if (pi->language==LANG_SINGULAR)
    {
      Voice *p=currentVoice;
      while (p!=NULL)
      {
        if (p->pi==pi && pi->ref <= 1)
        {
          Warn("`%s` in use, can not be killed",pi->procname);
          return TRUE;
        }
        p=p->next;
      }
      if (pi->data.s.body != NULL) // OB: ????
        omFree((ADDRESS)pi->data.s.body);
      if (pi->libname != NULL) // OB: ????
        omFreeBinAddr((ADDRESS)pi->libname);
      if (pi->procname != NULL) // OB: ????
        omFreeBinAddr((ADDRESS)pi->procname);
 
    }
    if( pi->language == LANG_C)
    {
    }
    memset((void *) pi, 0, sizeof(procinfo));
    //pi->language=LANG_NONE;
    omFreeBin((ADDRESS)pi,  procinfo_bin);
  }
  return FALSE;
}

piProcinfo()

const char * piProcinfo	(	procinfov	pi,
		const char *	request )

Definition at line 700 of file ipid.cc.

{
  if((pi == NULL)||(pi->language==LANG_NONE)) return "empty proc";
  else if (strcmp(request, "libname")  == 0) return pi->libname;
  else if (strcmp(request, "procname") == 0) return pi->procname;
  else if (strcmp(request, "type")     == 0)
  {
    switch (pi->language)
    {
      case LANG_SINGULAR: return "singular"; break;
      case LANG_C:        return "object";   break;
      case LANG_NONE:     return "none";     break;
      default:            return "unknown language";
    }
  }
  else if (strcmp(request, "ref")      == 0)
  {
    char p[8];
    snprintf(p,8, "%d", pi->ref);
    return omStrDup(p);  // MEMORY-LEAK
  }
  return "??";
}

Variable Documentation

basePack

VAR package basePack = NULL

Definition at line 56 of file ipid.cc.

basePackHdl

VAR idhdl basePackHdl = NULL

Definition at line 54 of file ipid.cc.

currPack

VAR package currPack = NULL

Definition at line 55 of file ipid.cc.

currPackHdl

VAR idhdl currPackHdl = NULL

Definition at line 53 of file ipid.cc.

currRingHdl

VAR idhdl currRingHdl = NULL

Definition at line 57 of file ipid.cc.

idrec_bin

VAR omBin idrec_bin = omGetSpecBin(sizeof(idrec))

Definition at line 48 of file ipid.cc.

procstack

VAR proclevel* procstack =NULL

Definition at line 50 of file ipid.cc.

sip_command_bin

VAR omBin sip_command_bin = omGetSpecBin(sizeof(sip_command))

Definition at line 45 of file ipid.cc.

sip_package_bin

VAR omBin sip_package_bin = omGetSpecBin(sizeof(sip_package))

Definition at line 46 of file ipid.cc.