iplib.cc File Reference

#include "kernel/mod2.h"
#include "Singular/tok.h"
#include "misc/options.h"
#include "Singular/ipid.h"
#include "polys/monomials/ring.h"
#include "Singular/subexpr.h"
#include "Singular/ipshell.h"
#include "Singular/fevoices.h"
#include "Singular/lists.h"
#include <ctype.h>
#include "libparse.h"
#include "Singular/mod_lib.h"
#include <map>
#include <string>
#include <pthread.h>

Go to the source code of this file.

Macros
#define	SINGULAR_PATH_LENGTH   512
#define	SI_MAX_NEST   500
#define	MODULE_SUFFIX   so
#define	MODULE_SUFFIX_STRING   EXPANDED_STRINGIFY(MODULE_SUFFIX)
#define	SI_GET_BUILTIN_MOD_INIT0(name)   int SI_MOD_INIT0(name)(SModulFunctions*);
#define	SI_GET_BUILTIN_MOD_INIT(name)   if (strcmp(libname, #name ".so") == 0){ return SI_MOD_INIT0(name); }

Functions
BOOLEAN	load_modules (const char *newlib, char *fullname, BOOLEAN autoexport)
int	iiArithAddCmd (const char *szName, short nAlias, short nTokval, short nToktype, short nPos)
void	yylprestart (FILE *input_file)
int	current_pos (int i=0)
void	print_init ()
static char	mytolower (char c)
BOOLEAN	iiGetLibStatus (const char *lib)
char *	iiProcName (char *buf, char &ct, char *&e)
char *	iiProcArgs (char *e, BOOLEAN withParenth)
char *	iiGetLibProcBuffer (procinfo *pi, int part)
BOOLEAN	iiAllStart (procinfov pi, const char *p, feBufferTypes t, int l)
BOOLEAN	iiPStart (idhdl pn, leftv v)
static void	iiShowLevRings ()
static void	iiCheckNest ()
BOOLEAN	iiMake_proc (idhdl pn, package pack, leftv args)
static void	iiCallLibProcBegin ()
static void	iiCallLibProcEnd (idhdl save_ringhdl, ring save_ring)
void *	iiCallLibProc1 (const char *n, void *arg, int arg_type, BOOLEAN &err)
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)
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...
BOOLEAN	iiEStart (char *example, procinfo *pi)
	SI_FOREACH_BUILTIN (SI_GET_BUILTIN_MOD_INIT0) }
int	flint_mod_init (SModulFunctions *psModulFunctions)
SModulFunc_t	iiGetBuiltinModInit (const char *libname)
BOOLEAN	iiTryLoadLib (leftv v, const char *id)
BOOLEAN	iiLocateLib (const char *lib, char *where)
BOOLEAN	iiLibCmd (const char *newlib, BOOLEAN autoexport, BOOLEAN tellerror, BOOLEAN force)
static void	iiCleanProcs (idhdl &root)
static void	iiRunInit (package p)
BOOLEAN	iiLoadLIB (FILE *fp, const char *libnamebuf, const char *newlib, idhdl pl, BOOLEAN autoexport, BOOLEAN tellerror)
procinfo *	iiInitSingularProcinfo (procinfov pi, const char *libname, const char *procname, int, long pos, BOOLEAN pstatic)
int	iiAddCproc (const char *libname, const char *procname, BOOLEAN pstatic, BOOLEAN(*func)(leftv res, leftv v))
int	iiAddCprocTop (const char *libname, const char *procname, BOOLEAN pstatic, BOOLEAN(*func)(leftv res, leftv v))
bool	registered_dyn_module (char *fullname)
void	register_dyn_module (char *fullname, void *handle)
void	close_all_dyn_modules ()
BOOLEAN	load_modules_aux (const char *newlib, char *fullname, BOOLEAN autoexport)
BOOLEAN	load_builtin (const char *newlib, BOOLEAN autoexport, SModulFunc_t init)
void	module_help_main (const char *newlib, const char *help)
void	module_help_proc (const char *newlib, const char *p, const char *help)
void *	binary_module_function (const char *newlib, const char *funcname)
static char	mytoupper (char c)
char *	iiConvName (const char *libname)

Variables
EXTERN_VAR int	yylp_errno
EXTERN_VAR int	yylplineno
const char *	yylp_errlist []
VAR libstackv	library_stack
VAR ring *	iiLocalRing
INST_VAR sleftv	iiRETURNEXPR
VAR int	iiRETURNEXPR_len =0
THREAD_VAR std::map< std::string, void * > *	dyn_modules

Macro Definition Documentation

MODULE_SUFFIX

#define MODULE_SUFFIX   so

Definition at line 39 of file iplib.cc.

MODULE_SUFFIX_STRING

#define MODULE_SUFFIX_STRING   EXPANDED_STRINGIFY(MODULE_SUFFIX)

Definition at line 42 of file iplib.cc.

SI_GET_BUILTIN_MOD_INIT

#define SI_GET_BUILTIN_MOD_INIT

(

name

)

if (strcmp(libname, #name ".so") == 0){ return SI_MOD_INIT0(name); }

SI_GET_BUILTIN_MOD_INIT0

#define SI_GET_BUILTIN_MOD_INIT0

(

name

)

int SI_MOD_INIT0(name)(SModulFunctions*);

Definition at line 799 of file iplib.cc.

SI_MAX_NEST

#define SI_MAX_NEST   500

Definition at line 27 of file iplib.cc.

SINGULAR_PATH_LENGTH

#define SINGULAR_PATH_LENGTH   512

Definition at line 21 of file iplib.cc.

Function Documentation

binary_module_function()

void * binary_module_function	(	const char *	newlib,
		const char *	funcname
	)

Definition at line 1386 of file iplib.cc.

{
  void* result = NULL;
 
  const char* bin_dir = feGetResource('b');
  if (!bin_dir)  { return NULL; }
 
  char path_name[MAXPATHLEN];
  sprintf(path_name, "%s%s%s.%s", bin_dir, DIR_SEPP, newlib, MODULE_SUFFIX_STRING);
 
  void* openlib = dynl_open(path_name);
  if(!openlib)
  {
    Werror("dynl_open of %s failed:%s", path_name, dynl_error());
    return NULL;
  }
  result = dynl_sym(openlib, funcname);
  if (!result) Werror("%s: %s\n", funcname, dynl_error());
 
  return result;
}

close_all_dyn_modules()

void close_all_dyn_modules

(

)

Definition at line 1171 of file iplib.cc.

                             {
  for (std::map<std::string, void *>::iterator it = dyn_modules->begin();
       it != dyn_modules->end();
       it++)
  {
    dynl_close(it->second);
  }
  delete dyn_modules;
  dyn_modules = NULL;
}

current_pos()

int current_pos

(

int

i = 0

)

Definition at line 3346 of file libparse.cc.

{
  return(i+offset+(int)(yytext-yylp_buffer_start));
}

flint_mod_init()

int flint_mod_init

(

SModulFunctions *

psModulFunctions

)

Definition at line 1281 of file misc_ip.cc.

{
    package save=currPack;
    currPack=basePack;
    n_FlintQ=nRegister(n_unknown,flintQ_InitChar);
    if (n_FlintQ!=n_unknown)
    {
      iiAddCproc("kernel","flintQp",FALSE,ii_FlintQ_init);
      nRegisterCfByName(flintQInitCfByName,n_FlintQ);
    }
#if __FLINT_RELEASE >= 20503
    iiAddCproc("kernel","flintQ",FALSE,ii_FlintQrat_init);
    nRegisterCfByName(flintQInitCfByName,n_FlintQ);
#endif
    n_FlintZn=nRegister(n_unknown,flintZn_InitChar);
    if (n_FlintZn!=n_unknown)
    {
      iiAddCproc("kernel","flintZn",FALSE,ii_FlintZn_init);
      nRegisterCfByName(flintZnInitCfByName,n_FlintZn);
    }
    currPack=save;
    return MAX_TOK;
}

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

iiAddCprocTop()

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

Definition at line 1138 of file iplib.cc.

{
  int r=iiAddCproc(libname,procname,pstatic,func);
  package s=currPack;
  currPack=basePack;
  if (r) r=iiAddCproc(libname,procname,pstatic,func);
  currPack=s;
  return r;
}

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

iiArithAddCmd()

int iiArithAddCmd	(	const char *	szName,
		short	nAlias,
		short	nTokval,
		short	nToktype,
		short	nPos
	)

Definition at line 9868 of file iparith.cc.

{
  //printf("AddCmd(%s, %d, %d, %d, %d)\n", szName, nAlias,
  //       nTokval, nToktype, nPos);
  if(nPos>=0)
  {
    // no checks: we rely on a correct generated code in iparith.inc
    assume((unsigned)nPos < sArithBase.nCmdAllocated);
    assume(szName!=NULL);
    sArithBase.sCmds[nPos].name    = omStrDup(szName);
    sArithBase.sCmds[nPos].alias   = nAlias;
    sArithBase.sCmds[nPos].tokval  = nTokval;
    sArithBase.sCmds[nPos].toktype = nToktype;
    sArithBase.nCmdUsed++;
    //if(nTokval>0) sArithBase.nLastIdentifier++;
  }
  else
  {
    if(szName==NULL) return -1;
    int nIndex = iiArithFindCmd(szName);
    if(nIndex>=0)
    {
      Print("'%s' already exists at %d\n", szName, nIndex);
      return -1;
    }
 
    if(sArithBase.nCmdUsed>=sArithBase.nCmdAllocated)
    {
      /* needs to create new slots */
      unsigned long nSize = (sArithBase.nCmdAllocated+1)*sizeof(cmdnames);
      sArithBase.sCmds = (cmdnames *)omRealloc(sArithBase.sCmds, nSize);
      if(sArithBase.sCmds==NULL) return -1;
      sArithBase.nCmdAllocated++;
    }
    /* still free slots available */
    sArithBase.sCmds[sArithBase.nCmdUsed].name    = omStrDup(szName);
    sArithBase.sCmds[sArithBase.nCmdUsed].alias   = nAlias;
    sArithBase.sCmds[sArithBase.nCmdUsed].tokval  = nTokval;
    sArithBase.sCmds[sArithBase.nCmdUsed].toktype = nToktype;
    sArithBase.nCmdUsed++;
 
    qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
          (&_gentable_sort_cmds));
    for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
        sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
    {
      if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
    }
    //Print("L=%d\n", sArithBase.nLastIdentifier);
  }
  return 0;
}

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

iiCallLibProcBegin()

static void iiCallLibProcBegin ( )

static

Definition at line 589 of file iplib.cc.

{
  idhdl tmp_ring=NULL;
  if (currRing!=NULL)
  {
    if ((currRingHdl!=NULL) && (IDRING(currRingHdl)!=currRing))
    {
      // clean up things depending on currRingHdl:
      sLastPrinted.CleanUp(IDRING(currRingHdl));
      sLastPrinted.Init();
    }
    // need to define a ring-hdl for currRingHdl
    tmp_ring=enterid(" tmpRing",myynest,RING_CMD,&IDROOT,FALSE);
    IDRING(tmp_ring)=rIncRefCnt(currRing);
    rSetHdl(tmp_ring);
  }
}

iiCallLibProcEnd()

static void iiCallLibProcEnd ( idhdl  save_ringhdl, ring  save_ring  )

static

Definition at line 606 of file iplib.cc.

{
  if ((currRing!=NULL)
  &&(currRing!=save_ring))
  {
    rDecRefCnt(currRing);
    idhdl hh=IDROOT;
    idhdl prev=NULL;
    while((hh!=currRingHdl) && (hh!=NULL)) { prev=hh; hh=hh->next; }
    if (hh!=NULL)
    {
      if (prev==NULL) IDROOT=hh->next;
      else prev->next=hh->next;
      omFree((ADDRESS)IDID(hh));
      omFreeBin((ADDRESS)hh, idrec_bin);
    }
  }
  currRingHdl=save_ringhdl;
  currRing=save_ring;
}

iiCheckNest()

static void iiCheckNest ( )

static

Definition at line 493 of file iplib.cc.

{
  if (myynest >= iiRETURNEXPR_len-1)
  {
    iiLocalRing=(ring *)omreallocSize(iiLocalRing,
                                   iiRETURNEXPR_len*sizeof(ring),
                                   (iiRETURNEXPR_len+16)*sizeof(ring));
    memset(&(iiLocalRing[iiRETURNEXPR_len]),0,16*sizeof(ring));
    iiRETURNEXPR_len+=16;
  }
}

iiCleanProcs()

static void iiCleanProcs ( idhdl &  root )

static

Definition at line 928 of file iplib.cc.

{
  idhdl prev=NULL;
  loop
  {
    if (root==NULL) return;
    if (IDTYP(root)==PROC_CMD)
    {
      procinfo *pi=(procinfo*)IDDATA(root);
      if ((pi->language == LANG_SINGULAR)
      && (pi->data.s.body_start == 0L))
      {
        // procinfo data incorrect:
        // - no proc body can start at the beginning of the file
        killhdl(root);
        if (prev==NULL)
          root=IDROOT;
        else
        {
          root=prev;
          prev=NULL;
        }
        continue;
      }
    }
    prev=root;
    root=IDNEXT(root);
  }
}

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

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

iiGetBuiltinModInit()

SModulFunc_t iiGetBuiltinModInit

(

const char *

libname

)

Definition at line 807 of file iplib.cc.

{
#ifdef HAVE_FLINT
  if (strcmp(libname,"flint.so")==0) return SI_MOD_INIT0(flint);
#endif
#  define SI_GET_BUILTIN_MOD_INIT(name) if (strcmp(libname, #name ".so") == 0){ return SI_MOD_INIT0(name); }
          SI_FOREACH_BUILTIN(SI_GET_BUILTIN_MOD_INIT)
#  undef  SI_GET_BUILTIN_MOD_INIT
 
  return NULL;
}

iiGetLibProcBuffer()

char * iiGetLibProcBuffer	(	procinfo *	pi,
		int	part
	)

Definition at line 197 of file iplib.cc.

{
  char buf[SINGULAR_PATH_LENGTH], *s = NULL, *p;
  long procbuflen;
 
  FILE * fp = feFopen( pi->libname, "rb", NULL, TRUE );
  if (fp==NULL)
  {
    return NULL;
  }
 
  fseek(fp, pi->data.s.proc_start, SEEK_SET);
  if(part==0)
  { // load help string
    int i, offset=0;
    long head = pi->data.s.def_end - pi->data.s.proc_start;
    procbuflen = pi->data.s.help_end - pi->data.s.help_start;
    if (procbuflen<5)
    {
      fclose(fp);
      return NULL; // help part does not exist
    }
    //Print("Help=%ld-%ld=%d\n", pi->data.s.body_start,
    //    pi->data.s.proc_start, procbuflen);
    s = (char *)omAlloc(procbuflen+head+3);
    myfread(s, head, 1, fp);
    s[head] = '\n';
    fseek(fp, pi->data.s.help_start, SEEK_SET);
    myfread(s+head+1, procbuflen, 1, fp);
    fclose(fp);
    s[procbuflen+head+1] = '\n';
    s[procbuflen+head+2] = '\0';
    offset=0;
    for(i=0;i<=procbuflen+head+2; i++)
    {
      if(s[i]=='\\' &&
         (s[i+1]=='"' || s[i+1]=='{' || s[i+1]=='}' || s[i+1]=='\\'))
      {
        i++;
        offset++;
      }
      if(offset>0) s[i-offset] = s[i];
    }
    return(s);
  }
  else if(part==1)
  { // load proc part - must exist
    procbuflen = pi->data.s.def_end - pi->data.s.proc_start;
    char *ss=(char *)omAlloc(procbuflen+2);
    //fgets(buf, sizeof(buf), fp);
    myfread( ss, procbuflen, 1, fp);
    char ct;
    char *e;
    s=iiProcName(ss,ct,e);
    char *argstr=NULL;
    *e=ct;
    argstr=iiProcArgs(e,TRUE);
 
    assume(pi->data.s.body_end > pi->data.s.body_start);
 
    procbuflen = pi->data.s.body_end - pi->data.s.body_start;
    pi->data.s.body = (char *)omAlloc( strlen(argstr)+procbuflen+15+
                                      strlen(pi->libname) );
    //Print("Body=%ld-%ld=%d\n", pi->data.s.body_end,
    //    pi->data.s.body_start, procbuflen);
    assume(pi->data.s.body != NULL);
    fseek(fp, pi->data.s.body_start, SEEK_SET);
    strcpy(pi->data.s.body,argstr);
    myfread( pi->data.s.body+strlen(argstr), procbuflen, 1, fp);
    fclose( fp );
    procbuflen+=strlen(argstr);
    omFree(argstr);
    omFree(ss);
    pi->data.s.body[procbuflen] = '\0';
    strcat( pi->data.s.body+procbuflen, "\n;return();\n\n" );
    strcat( pi->data.s.body+procbuflen+13,pi->libname);
    s=(char *)strchr(pi->data.s.body,'{');
    if (s!=NULL) *s=' ';
    return NULL;
  }
  else if(part==2)
  { // example
    if ( pi->data.s.example_lineno == 0)
      return NULL; // example part does not exist
    // load example
    fseek(fp, pi->data.s.example_start, SEEK_SET);
    /*char *dummy=*/ (void) fgets(buf, sizeof(buf), fp); // skip line with "example"
    procbuflen = pi->data.s.proc_end - pi->data.s.example_start - strlen(buf);
    //Print("Example=%ld-%ld=%d\n", pi->data.s.proc_end,
    //  pi->data.s.example_start, procbuflen);
    s = (char *)omAlloc(procbuflen+14);
    myfread(s, procbuflen, 1, fp);
    s[procbuflen] = '\0';
    strcat(s+procbuflen-3, "\n;return();\n\n" );
    p=(char *)strchr(s,'{');
    if (p!=NULL) *p=' ';
    return(s);
  }
  return NULL;
}

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

iiInitSingularProcinfo()

procinfo * iiInitSingularProcinfo	(	procinfov	pi,
		const char *	libname,
		const char *	procname,
		int	,
		long	pos,
		BOOLEAN	pstatic
	)

Definition at line 1049 of file iplib.cc.

{
  memset(pi,0,sizeof(*pi));
  pi->libname = omStrDup(libname);
  pi->procname = omStrDup(procname);
  pi->language = LANG_SINGULAR;
  pi->ref = 1;
  pi->is_static = pstatic;
  pi->data.s.proc_start = pos;
  return(pi);
}

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	args
	)

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

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	v
	)

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

iiRunInit()

static void iiRunInit ( package  p )

static

Definition at line 957 of file iplib.cc.

{
  idhdl h=p->idroot->get("mod_init",0);
  if (h==NULL) return;
  if (IDTYP(h)==PROC_CMD)
  {
    int save=yylineno;
    myynest++;
    // procinfo *pi=(procinfo*)IDDATA(h);
    //PrintS("mod_init found\n");
    iiMake_proc(h,p,NULL);
    myynest--;
    yylineno=save;
  }
}

iiShowLevRings()

static void iiShowLevRings ( )

static

Definition at line 478 of file iplib.cc.

{
  int i;
  for (i=0;i<=myynest;i++)
  {
    Print("lev %d:",i);
    if (iiLocalRing[i]==NULL) PrintS("NULL");
    else                      Print("%lx",(long)iiLocalRing[i]);
    PrintLn();
  }
  if (currRing==NULL) PrintS("curr:NULL\n");
  else                Print ("curr:%lx\n",(long)currRing);
}

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

load_builtin()

BOOLEAN load_builtin	(	const char *	newlib,
		BOOLEAN	autoexport,
		SModulFunc_t	init
	)

Definition at line 1294 of file iplib.cc.

{
  int iiAddCproc(const char *libname, const char *procname, BOOLEAN pstatic,
                 BOOLEAN(*func)(leftv res, leftv v));
/*
  typedef int (*fktn_t)(int(*iiAddCproc)(const char *libname, const char *procname,
                               BOOLEAN pstatic,
                               BOOLEAN(*func)(leftv res, leftv v)));
*/
  // SModulFunc_t fktn;
  idhdl pl;
  char *plib = iiConvName(newlib);
  // BOOLEAN RET=TRUE;
  // int token;
 
  pl = basePack->idroot->get(plib,0); // search PACKAGE only in Top
  if ((pl!=NULL)
  &&(IDTYP(pl)==PACKAGE_CMD))
  {
    if(IDPACKAGE(pl)->language==LANG_C)
    {
      if (BVERBOSE(V_LOAD_LIB)) Warn( "(builtin) %s already loaded", newlib);
      omFreeBinAddr(plib);
      return FALSE;
    }
  }
  else
  {
    pl = enterid( plib,0, PACKAGE_CMD, &IDROOT, TRUE );
    IDPACKAGE(pl)->libname=omStrDup(newlib);
  }
  omFreeBinAddr(plib);
  IDPACKAGE(pl)->language = LANG_C;
 
  IDPACKAGE(pl)->handle=(void *)NULL;
  SModulFunctions sModulFunctions;
 
  package s=currPack;
  currPack=IDPACKAGE(pl);
  if( init!= NULL)
  {
    sModulFunctions.iiArithAddCmd = iiArithAddCmd;
    if (autoexport) sModulFunctions.iiAddCproc = iiAddCprocTop;
    else            sModulFunctions.iiAddCproc = iiAddCproc;
    (*init)(&sModulFunctions);
  }
  if (BVERBOSE(V_LOAD_LIB)) Print( "// ** loaded (builtin) %s \n", newlib);
  currPack->loaded=1;
  currPack=s;
 
  return FALSE;
}

load_modules()

BOOLEAN load_modules	(	const char *	newlib,
		char *	fullname,
		BOOLEAN	autoexport
	)

Definition at line 1284 of file iplib.cc.

{
  GLOBAL_VAR static pthread_mutex_t mutex = PTHREAD_MUTEX_INITIALIZER;
  pthread_mutex_lock(&mutex);
  BOOLEAN r = load_modules_aux(newlib, fullname, autoexport);
  pthread_mutex_unlock(&mutex);
  return r;
}

load_modules_aux()

BOOLEAN load_modules_aux	(	const char *	newlib,
		char *	fullname,
		BOOLEAN	autoexport
	)

Definition at line 1181 of file iplib.cc.

{
/*
  typedef int (*fktn_t)(int(*iiAddCproc)(const char *libname, const char *procname,
                               BOOLEAN pstatic,
                               BOOLEAN(*func)(leftv res, leftv v)));
*/
  SModulFunc_t fktn;
  idhdl pl;
  char *plib = iiConvName(newlib);
  BOOLEAN RET=TRUE;
  int token;
  int l=si_max((int)strlen(fullname),(int)strlen(newlib))+3;
  char *FullName=(char*)omAlloc0(l);
 
  if( *fullname != '/' &&  *fullname != '.' )
    sprintf(FullName, "./%s", newlib);
  else strncpy(FullName, fullname,l);
 
 
  if(IsCmd(plib, token))
  {
    Werror("'%s' is resered identifier\n", plib);
    goto load_modules_end;
  }
  pl = basePack->idroot->get(plib,0); /* packages only in top level
                                        (see enterid) */
  if ((pl!=NULL)
  &&(IDTYP(pl)==PACKAGE_CMD))
  {
    if(IDPACKAGE(pl)->language==LANG_C)
    {
      if (BVERBOSE(V_LOAD_LIB)) Warn( "%s already loaded as package", newlib);
      omFreeBinAddr(plib);
      return FALSE;
    }
    else if(IDPACKAGE(pl)->language==LANG_MIX)
    {
      if (BVERBOSE(V_LOAD_LIB)) Warn( "%s contain binary parts, cannot load", newlib);
      omFreeBinAddr(plib);
      return FALSE;
    }
  }
  else
  {
    pl = enterid( plib,0, PACKAGE_CMD, &IDROOT, TRUE );
    omFreeBinAddr(plib); /* enterid copied plib*/
    IDPACKAGE(pl)->libname=omStrDup(newlib);
  }
  IDPACKAGE(pl)->language = LANG_C;
  if (dynl_check_opened(FullName))
  {
    if (BVERBOSE(V_LOAD_LIB)) Warn( "%s already loaded as C library", fullname);
    omFreeSize(FullName,l);
    return FALSE;
  }
  if((IDPACKAGE(pl)->handle=dynl_open(FullName))==(void *)NULL)
  {
    Werror("dynl_open failed:%s", dynl_error());
    Werror("%s not found", newlib);
    killhdl2(pl,&(basePack->idroot),NULL); // remove package
    goto load_modules_end;
  }
  else
  {
    SModulFunctions sModulFunctions;
 
    package s=currPack;
    currPack=IDPACKAGE(pl);
    fktn = (SModulFunc_t)dynl_sym(IDPACKAGE(pl)->handle, "mod_init");
    if( fktn!= NULL)
    {
      sModulFunctions.iiArithAddCmd = iiArithAddCmd;
      if (autoexport) sModulFunctions.iiAddCproc = iiAddCprocTop;
      else            sModulFunctions.iiAddCproc = iiAddCproc;
      int ver=(*fktn)(&sModulFunctions);
      if (ver==MAX_TOK)
      {
        if (BVERBOSE(V_LOAD_LIB)) Print( "// ** loaded %s\n", fullname);
      }
      else
      {
        Warn("loaded %s for a different version of Singular(expected MAX_TOK: %d, got %d)",fullname,MAX_TOK,ver);
      }
      currPack->loaded=1;
      currPack=s; /* reset currPack to previous */
      register_dyn_module(fullname, IDPACKAGE(pl)->handle);
      RET=FALSE;
    }
    else
    {
      Werror("mod_init not found:: %s\nThis is probably not a dynamic module for Singular!\n", dynl_error());
      errorreported=0;
      if(IDPACKAGE(pl)->idroot==NULL)
        killhdl2(pl,&(basePack->idroot),NULL); // remove package
    }
  }
 
  load_modules_end:
  omFreeSize(FullName,l);
  return RET;
}

module_help_main()

void module_help_main	(	const char *	newlib,
		const char *	help
	)

Definition at line 1347 of file iplib.cc.

{
  char *plib = iiConvName(newlib);
  idhdl pl = basePack->idroot->get(plib,0);
  if ((pl==NULL)||(IDTYP(pl)!=PACKAGE_CMD))
    Werror(">>%s<< is not a package (trying to add package help)",plib);
  else
  {
    package s=currPack;
    currPack=IDPACKAGE(pl);
    idhdl h=enterid("info",0,STRING_CMD,&IDROOT,FALSE);
    IDSTRING(h)=omStrDup(help);
    currPack=s;
  }
}

module_help_proc()

void module_help_proc	(	const char *	newlib,
		const char *	p,
		const char *	help
	)

Definition at line 1362 of file iplib.cc.

{
  char *plib = iiConvName(newlib);
  idhdl pl = basePack->idroot->get(plib,0);
  if ((pl==NULL)||(IDTYP(pl)!=PACKAGE_CMD))
    Werror(">>%s<< is not a package(trying to add help for %s)",plib,p);
  else
  {
    package s=currPack;
    currPack=IDPACKAGE(pl);
    char buff[SINGULAR_PATH_LENGTH];
    buff[SINGULAR_PATH_LENGTH-1]='\0';
    strncpy(buff,p,SINGULAR_PATH_LENGTH-1);
    strncat(buff,"_help",SINGULAR_PATH_LENGTH-1-strlen(p));
    idhdl h=enterid(buff,0,STRING_CMD,&IDROOT,FALSE);
    IDSTRING(h)=omStrDup(help);
    currPack=s;
  }
}

mytolower()

static char mytolower ( char  c )

static

Definition at line 1416 of file iplib.cc.

{
  if(c>=65 && c<=(65+26)) c+=32;
  return(c);
}

mytoupper()

static char mytoupper ( char  c )

static

Definition at line 1410 of file iplib.cc.

{
  if(c>=97 && c<=(97+26)) c-=32;
  return(c);
}

print_init()

void print_init

(

)

Definition at line 3482 of file libparse.cc.

{
   printf("Init=%d\n", yy_init);
}

register_dyn_module()

void register_dyn_module	(	char *	fullname,
		void *	handle
	)

Definition at line 1164 of file iplib.cc.

                                                        {
  std::string fname = fullname;
  if (dyn_modules == NULL)
    dyn_modules = new std::map<std::string, void *>();
  dyn_modules->insert(std::pair<std::string, void *>(fname, handle));
}

registered_dyn_module()

bool registered_dyn_module

(

char *

fullname

)

Definition at line 1157 of file iplib.cc.

                                           {
  if (dyn_modules == NULL)
    return false;
  std::string fname = fullname;
  return dyn_modules->count(fname) != 0;
}

SI_FOREACH_BUILTIN()

SI_FOREACH_BUILTIN

(

SI_GET_BUILTIN_MOD_INIT0

)

yylprestart()

void yylprestart

(

FILE *

input_file

)

Variable Documentation

dyn_modules

THREAD_VAR std::map<std::string, void *>* dyn_modules

Definition at line 1155 of file iplib.cc.

iiLocalRing

VAR ring* iiLocalRing

Definition at line 473 of file iplib.cc.

iiRETURNEXPR

INST_VAR sleftv iiRETURNEXPR

Definition at line 474 of file iplib.cc.

iiRETURNEXPR_len

VAR int iiRETURNEXPR_len =0

Definition at line 475 of file iplib.cc.

library_stack

VAR libstackv library_stack

Definition at line 68 of file iplib.cc.

yylp_errlist

const char* yylp_errlist[]

extern

Definition at line 1114 of file libparse.cc.

yylp_errno

EXTERN_VAR int yylp_errno

Definition at line 64 of file iplib.cc.

yylplineno

EXTERN_VAR int yylplineno

Definition at line 65 of file iplib.cc.