"Fossies" - the Fresh Open Source Software Archive

Member "singular-4.2.1/Singular/iplib.cc" (9 Jun 2021, 39988 Bytes) of package /linux/misc/singular-4.2.1.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) C and C++ source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "iplib.cc" see the Fossies "Dox" file reference documentation and the latest Fossies "Diffs" side-by-side code changes report: 4.2.0p3_vs_4.2.1.

    1 /****************************************
    2 *  Computer Algebra System SINGULAR     *
    3 ****************************************/
    4 /*
    5 * ABSTRACT: interpreter: LIB and help
    6 */
    7 
    8 #include "kernel/mod2.h"
    9 
   10 #include "Singular/tok.h"
   11 #include "misc/options.h"
   12 #include "Singular/ipid.h"
   13 #include "polys/monomials/ring.h"
   14 #include "Singular/subexpr.h"
   15 #include "Singular/ipid.h"
   16 #include "Singular/ipshell.h"
   17 #include "Singular/fevoices.h"
   18 #include "Singular/lists.h"
   19 
   20 #include <ctype.h>
   21 
   22 #if SIZEOF_LONG == 8
   23 #define SI_MAX_NEST 500
   24 #elif defined(__CYGWIN__)
   25 #define SI_MAX_NEST 480
   26 #else
   27 #define SI_MAX_NEST 1000
   28 #endif
   29 
   30 #if defined(ix86Mac_darwin) || defined(x86_64Mac_darwin) || defined(ppcMac_darwin)
   31 #  define MODULE_SUFFIX bundle
   32 #elif defined(__CYGWIN__)
   33 #  define MODULE_SUFFIX dll
   34 #else
   35 #  define MODULE_SUFFIX so
   36 #endif
   37 
   38 #define MODULE_SUFFIX_STRING EXPANDED_STRINGIFY(MODULE_SUFFIX)
   39 
   40 
   41 #ifdef HAVE_DYNAMIC_LOADING
   42 BOOLEAN load_modules(const char *newlib, char *fullname, BOOLEAN autoexport);
   43 #endif
   44 
   45 #ifdef HAVE_LIBPARSER
   46 #  include "libparse.h"
   47 #else /* HAVE_LIBPARSER */
   48 procinfo *iiInitSingularProcinfo(procinfov pi, const char *libname,
   49               const char *procname, int line, long pos, BOOLEAN pstatic=FALSE);
   50 #endif /* HAVE_LIBPARSER */
   51 
   52 extern int iiArithAddCmd(const char *szName, short nAlias, short nTokval,
   53                          short nToktype, short nPos);
   54 
   55 #include "Singular/mod_lib.h"
   56 
   57 #ifdef HAVE_LIBPARSER
   58 void yylprestart (FILE *input_file );
   59 int current_pos(int i=0);
   60 EXTERN_VAR int yylp_errno;
   61 EXTERN_VAR int yylplineno;
   62 extern const char *yylp_errlist[];
   63 void print_init();
   64 VAR libstackv library_stack;
   65 #endif
   66 
   67 //int IsCmd(char *n, int tok);
   68 char mytolower(char c);
   69 
   70 /*2
   71 * return TRUE if the libray libname is already loaded
   72 */
   73 BOOLEAN iiGetLibStatus(const char *lib)
   74 {
   75   idhdl hl;
   76 
   77   char *plib = iiConvName(lib);
   78   hl = basePack->idroot->get(plib,0);
   79   omFree(plib);
   80   if((hl==NULL) ||(IDTYP(hl)!=PACKAGE_CMD))
   81   {
   82     return FALSE;
   83   }
   84   if ((IDPACKAGE(hl)->language!=LANG_C)&&(IDPACKAGE(hl)->libname!=NULL))
   85     return (strcmp(lib,IDPACKAGE(hl)->libname)==0);
   86   return FALSE;
   87 }
   88 
   89 /*2
   90 * given a line 'proc[ ]+{name}[ \t]*'
   91 * return a pointer to name and set the end of '\0'
   92 * changes the input!
   93 * returns: e: pointer to 'end of name'
   94 *          ct: changed char at the end of s
   95 */
   96 char* iiProcName(char *buf, char & ct, char* &e)
   97 {
   98   char *s=buf+5;
   99   while (*s==' ') s++;
  100   e=s+1;
  101   while ((*e>' ') && (*e!='(')) e++;
  102   ct=*e;
  103   *e='\0';
  104   return s;
  105 }
  106 
  107 /*2
  108 * given a line with args, return the argstr
  109 */
  110 char * iiProcArgs(char *e,BOOLEAN withParenth)
  111 {
  112   while ((*e==' ') || (*e=='\t') || (*e=='(')) e++;
  113   if (*e<' ')
  114   {
  115     if (withParenth)
  116     {
  117       // no argument list, allow list #
  118       return omStrDup("parameter list #;");
  119     }
  120     else
  121     {
  122       // empty list
  123       return omStrDup("");
  124     }
  125   }
  126   BOOLEAN in_args;
  127   BOOLEAN args_found;
  128   char *s;
  129   char *argstr=(char *)omAlloc(127); // see ../omalloc/omTables.inc
  130   int argstrlen=127;
  131   *argstr='\0';
  132   int par=0;
  133   do
  134   {
  135     args_found=FALSE;
  136     s=e; // set s to the starting point of the arg
  137          // and search for the end
  138     // skip leading spaces:
  139     loop
  140     {
  141       if ((*s==' ')||(*s=='\t'))
  142         s++;
  143       else if ((*s=='\n')&&(*(s+1)==' '))
  144         s+=2;
  145       else // start of new arg or \0 or )
  146         break;
  147     }
  148     e=s;
  149     while ((*e!=',')
  150     &&((par!=0) || (*e!=')'))
  151     &&(*e!='\0'))
  152     {
  153       if (*e=='(') par++;
  154       else if (*e==')') par--;
  155       args_found=args_found || (*e>' ');
  156       e++;
  157     }
  158     in_args=(*e==',');
  159     if (args_found)
  160     {
  161       *e='\0';
  162       // check for space:
  163       if ((int)strlen(argstr)+12 /* parameter + ;*/ +(int)strlen(s)>= argstrlen)
  164       {
  165         argstrlen*=2;
  166         char *a=(char *)omAlloc( argstrlen);
  167         strcpy(a,argstr);
  168         omFree((ADDRESS)argstr);
  169         argstr=a;
  170       }
  171       // copy the result to argstr
  172       if(strncmp(s,"alias ",6)!=0)
  173       {
  174         strcat(argstr,"parameter ");
  175       }
  176       strcat(argstr,s);
  177       strcat(argstr,"; ");
  178       e++; // e was pointing to ','
  179     }
  180   } while (in_args);
  181   return argstr;
  182 }
  183 
  184 /*2
  185 * locate `procname` in lib `libname` and find the part `part`:
  186 *  part=0: help, between, but excluding the line "proc ..." and "{...":
  187 *    => return
  188 *  part=1: body, between "{ ..." and "}", including the 1. line, w/o "{"
  189 *    => set pi->data.s.body, return NULL
  190 *  part=2: example, between, but excluding the line "exapmle {..." and "}":
  191 *    => return
  192 */
  193 char* iiGetLibProcBuffer(procinfo *pi, int part )
  194 {
  195   char buf[256], *s = NULL, *p;
  196   long procbuflen;
  197 
  198   FILE * fp = feFopen( pi->libname, "rb", NULL, TRUE );
  199   if (fp==NULL)
  200   {
  201     return NULL;
  202   }
  203 
  204   fseek(fp, pi->data.s.proc_start, SEEK_SET);
  205   if(part==0)
  206   { // load help string
  207     int i, offset=0;
  208     long head = pi->data.s.def_end - pi->data.s.proc_start;
  209     procbuflen = pi->data.s.help_end - pi->data.s.help_start;
  210     if (procbuflen<5)
  211     {
  212       fclose(fp);
  213       return NULL; // help part does not exist
  214     }
  215     //Print("Help=%ld-%ld=%d\n", pi->data.s.body_start,
  216     //    pi->data.s.proc_start, procbuflen);
  217     s = (char *)omAlloc(procbuflen+head+3);
  218     myfread(s, head, 1, fp);
  219     s[head] = '\n';
  220     fseek(fp, pi->data.s.help_start, SEEK_SET);
  221     myfread(s+head+1, procbuflen, 1, fp);
  222     fclose(fp);
  223     s[procbuflen+head+1] = '\n';
  224     s[procbuflen+head+2] = '\0';
  225     offset=0;
  226     for(i=0;i<=procbuflen+head+2; i++)
  227     {
  228       if(s[i]=='\\' &&
  229          (s[i+1]=='"' || s[i+1]=='{' || s[i+1]=='}' || s[i+1]=='\\'))
  230       {
  231         i++;
  232         offset++;
  233       }
  234       if(offset>0) s[i-offset] = s[i];
  235     }
  236     return(s);
  237   }
  238   else if(part==1)
  239   { // load proc part - must exist
  240     procbuflen = pi->data.s.def_end - pi->data.s.proc_start;
  241     char *ss=(char *)omAlloc(procbuflen+2);
  242     //fgets(buf, sizeof(buf), fp);
  243     myfread( ss, procbuflen, 1, fp);
  244     char ct;
  245     char *e;
  246     s=iiProcName(ss,ct,e);
  247     char *argstr=NULL;
  248     *e=ct;
  249     argstr=iiProcArgs(e,TRUE);
  250 
  251     assume(pi->data.s.body_end > pi->data.s.body_start);
  252 
  253     procbuflen = pi->data.s.body_end - pi->data.s.body_start;
  254     pi->data.s.body = (char *)omAlloc( strlen(argstr)+procbuflen+15+
  255                                       strlen(pi->libname) );
  256     //Print("Body=%ld-%ld=%d\n", pi->data.s.body_end,
  257     //    pi->data.s.body_start, procbuflen);
  258     assume(pi->data.s.body != NULL);
  259     fseek(fp, pi->data.s.body_start, SEEK_SET);
  260     strcpy(pi->data.s.body,argstr);
  261     myfread( pi->data.s.body+strlen(argstr), procbuflen, 1, fp);
  262     fclose( fp );
  263     procbuflen+=strlen(argstr);
  264     omFree(argstr);
  265     omFree(ss);
  266     pi->data.s.body[procbuflen] = '\0';
  267     strcat( pi->data.s.body+procbuflen, "\n;return();\n\n" );
  268     strcat( pi->data.s.body+procbuflen+13,pi->libname);
  269     s=(char *)strchr(pi->data.s.body,'{');
  270     if (s!=NULL) *s=' ';
  271     return NULL;
  272   }
  273   else if(part==2)
  274   { // example
  275     if ( pi->data.s.example_lineno == 0)
  276       return NULL; // example part does not exist
  277     // load example
  278     fseek(fp, pi->data.s.example_start, SEEK_SET);
  279     /*char *dummy=*/ (void) fgets(buf, sizeof(buf), fp); // skip line with "example"
  280     procbuflen = pi->data.s.proc_end - pi->data.s.example_start - strlen(buf);
  281     //Print("Example=%ld-%ld=%d\n", pi->data.s.proc_end,
  282     //  pi->data.s.example_start, procbuflen);
  283     s = (char *)omAlloc(procbuflen+14);
  284     myfread(s, procbuflen, 1, fp);
  285     s[procbuflen] = '\0';
  286     strcat(s+procbuflen-3, "\n;return();\n\n" );
  287     p=(char *)strchr(s,'{');
  288     if (p!=NULL) *p=' ';
  289     return(s);
  290   }
  291   return NULL;
  292 }
  293 
  294 BOOLEAN iiAllStart(procinfov pi, const char *p, feBufferTypes t, int l)
  295 {
  296   int save_trace=traceit;
  297   int restore_traceit=0;
  298   if (traceit_stop
  299   && (traceit & TRACE_SHOW_LINE))
  300   {
  301     traceit &=(~TRACE_SHOW_LINE);
  302     traceit_stop=0;
  303     restore_traceit=1;
  304   }
  305   // see below:
  306   BITSET save1=si_opt_1;
  307   BITSET save2=si_opt_2;
  308   newBuffer( omStrDup(p /*pi->data.s.body*/), t /*BT_proc*/,
  309                pi, l );
  310   BOOLEAN err=yyparse();
  311 
  312   if (sLastPrinted.rtyp!=0)
  313   {
  314     sLastPrinted.CleanUp();
  315   }
  316 
  317   if (restore_traceit) traceit=save_trace;
  318 
  319   // the access to optionStruct and verboseStruct do not work
  320   // on x86_64-Linux for pic-code
  321   if ((TEST_V_ALLWARN) &&
  322   (t==BT_proc) &&
  323   ((save1!=si_opt_1)||(save2!=si_opt_2)) &&
  324   (pi->libname!=NULL) && (pi->libname[0]!='\0'))
  325   {
  326     if ((pi->libname!=NULL) && (pi->libname[0]!='\0'))
  327       Warn("option changed in proc %s from %s",pi->procname,pi->libname);
  328     else
  329       Warn("option changed in proc %s",pi->procname);
  330     int i;
  331     for (i=0; optionStruct[i].setval!=0; i++)
  332     {
  333       if ((optionStruct[i].setval & si_opt_1)
  334       && (!(optionStruct[i].setval & save1)))
  335       {
  336           Print(" +%s",optionStruct[i].name);
  337       }
  338       if (!(optionStruct[i].setval & si_opt_1)
  339       && ((optionStruct[i].setval & save1)))
  340       {
  341           Print(" -%s",optionStruct[i].name);
  342       }
  343     }
  344     for (i=0; verboseStruct[i].setval!=0; i++)
  345     {
  346       if ((verboseStruct[i].setval & si_opt_2)
  347       && (!(verboseStruct[i].setval & save2)))
  348       {
  349           Print(" +%s",verboseStruct[i].name);
  350       }
  351       if (!(verboseStruct[i].setval & si_opt_2)
  352       && ((verboseStruct[i].setval & save2)))
  353       {
  354           Print(" -%s",verboseStruct[i].name);
  355       }
  356     }
  357     PrintLn();
  358   }
  359   return err;
  360 }
  361 /*2
  362 * start a proc
  363 * parameters are built as exprlist
  364 * TODO:interrupt
  365 * return FALSE on success, TRUE if an error occurs
  366 */
  367 BOOLEAN iiPStart(idhdl pn, leftv v)
  368 {
  369   procinfov pi=NULL;
  370   int old_echo=si_echo;
  371   BOOLEAN err=FALSE;
  372   char save_flags=0;
  373 
  374   /* init febase ======================================== */
  375   /* we do not enter this case if filename != NULL !! */
  376   if (pn!=NULL)
  377   {
  378     pi = IDPROC(pn);
  379     if(pi!=NULL)
  380     {
  381       save_flags=pi->trace_flag;
  382       if( pi->data.s.body==NULL )
  383       {
  384         iiGetLibProcBuffer(pi);
  385         if (pi->data.s.body==NULL) return TRUE;
  386       }
  387 //      omUpdateInfo();
  388 //      int m=om_Info.UsedBytes;
  389 //      Print("proc %s, mem=%d\n",IDID(pn),m);
  390     }
  391   }
  392   else return TRUE;
  393   /* generate argument list ======================================*/
  394   //iiCurrArgs should be NULL here, as the assignment for the parameters
  395   // of the prevouis call are already done befor calling another routine
  396   if (v!=NULL)
  397   {
  398     iiCurrArgs=(leftv)omAllocBin(sleftv_bin);
  399     memcpy(iiCurrArgs,v,sizeof(sleftv)); // keeps track of v->next etc.
  400     v->Init();
  401   }
  402   else
  403   {
  404     iiCurrArgs=NULL;
  405   }
  406   /* start interpreter ======================================*/
  407   myynest++;
  408   if (myynest > SI_MAX_NEST)
  409   {
  410     WerrorS("nesting too deep");
  411     err=TRUE;
  412   }
  413   else
  414   {
  415     iiCurrProc=pn;
  416     err=iiAllStart(pi,pi->data.s.body,BT_proc,pi->data.s.body_lineno-(v!=NULL));
  417     iiCurrProc=NULL;
  418 
  419     if (iiLocalRing[myynest-1] != currRing)
  420     {
  421       if (iiRETURNEXPR.RingDependend())
  422       {
  423         //idhdl hn;
  424         const char *n;
  425         const char *o;
  426         idhdl nh=NULL, oh=NULL;
  427         if (iiLocalRing[myynest-1]!=NULL)
  428           oh=rFindHdl(iiLocalRing[myynest-1],NULL);
  429         if (oh!=NULL)          o=oh->id;
  430         else                   o="none";
  431         if (currRing!=NULL)
  432           nh=rFindHdl(currRing,NULL);
  433         if (nh!=NULL)          n=nh->id;
  434         else                   n="none";
  435         Werror("ring change during procedure call %s: %s -> %s (level %d)",pi->procname,o,n,myynest);
  436         iiRETURNEXPR.CleanUp();
  437         err=TRUE;
  438       }
  439       currRing=iiLocalRing[myynest-1];
  440     }
  441     if ((currRing==NULL)
  442     && (currRingHdl!=NULL))
  443       currRing=IDRING(currRingHdl);
  444     else
  445     if ((currRing!=NULL) &&
  446       ((currRingHdl==NULL)||(IDRING(currRingHdl)!=currRing)
  447        ||(IDLEV(currRingHdl)>=myynest-1)))
  448     {
  449       rSetHdl(rFindHdl(currRing,NULL));
  450       iiLocalRing[myynest-1]=NULL;
  451     }
  452     //Print("kill locals for %s (level %d)\n",IDID(pn),myynest);
  453     killlocals(myynest);
  454 #ifndef SING_NDEBUG
  455     checkall();
  456 #endif
  457     //Print("end kill locals for %s (%d)\n",IDID(pn),myynest);
  458   }
  459   myynest--;
  460   si_echo=old_echo;
  461   if (pi!=NULL)
  462     pi->trace_flag=save_flags;
  463 //  omUpdateInfo();
  464 //  int m=om_Info.UsedBytes;
  465 //  Print("exit %s, mem=%d\n",IDID(pn),m);
  466   return err;
  467 }
  468 
  469 VAR ring    *iiLocalRing;
  470 INST_VAR sleftv  iiRETURNEXPR;
  471 VAR int     iiRETURNEXPR_len=0;
  472 
  473 #ifdef RDEBUG
  474 static void iiShowLevRings()
  475 {
  476   int i;
  477   for (i=0;i<=myynest;i++)
  478   {
  479     Print("lev %d:",i);
  480     if (iiLocalRing[i]==NULL) PrintS("NULL");
  481     else                      Print("%lx",(long)iiLocalRing[i]);
  482     PrintLn();
  483   }
  484   if (currRing==NULL) PrintS("curr:NULL\n");
  485   else                Print ("curr:%lx\n",(long)currRing);
  486 }
  487 #endif /* RDEBUG */
  488 
  489 static void iiCheckNest()
  490 {
  491   if (myynest >= iiRETURNEXPR_len-1)
  492   {
  493     iiLocalRing=(ring *)omreallocSize(iiLocalRing,
  494                                    iiRETURNEXPR_len*sizeof(ring),
  495                                    (iiRETURNEXPR_len+16)*sizeof(ring));
  496     memset(&(iiLocalRing[iiRETURNEXPR_len]),0,16*sizeof(ring));
  497     iiRETURNEXPR_len+=16;
  498   }
  499 }
  500 BOOLEAN iiMake_proc(idhdl pn, package pack, leftv args)
  501 {
  502   int err;
  503   procinfov pi = IDPROC(pn);
  504   if(pi->is_static && myynest==0)
  505   {
  506     Werror("'%s::%s()' is a local procedure and cannot be accessed by an user.",
  507            pi->libname, pi->procname);
  508     return TRUE;
  509   }
  510   iiCheckNest();
  511   iiLocalRing[myynest]=currRing;
  512   //Print("currRing(%d):%s(%x) in %s\n",myynest,IDID(currRingHdl),currRing,IDID(pn));
  513   iiRETURNEXPR.Init();
  514   procstack->push(pi->procname);
  515   if ((traceit&TRACE_SHOW_PROC)
  516   || (pi->trace_flag&TRACE_SHOW_PROC))
  517   {
  518     if (traceit&TRACE_SHOW_LINENO) PrintLn();
  519     Print("entering%-*.*s %s (level %d)\n",myynest*2,myynest*2," ",IDID(pn),myynest);
  520   }
  521 #ifdef RDEBUG
  522   if (traceit&TRACE_SHOW_RINGS) iiShowLevRings();
  523 #endif
  524   switch (pi->language)
  525   {
  526     default:
  527     case LANG_NONE:
  528                  WerrorS("undefined proc");
  529                  err=TRUE;
  530                  break;
  531 
  532     case LANG_SINGULAR:
  533                  if ((pi->pack!=NULL)&&(currPack!=pi->pack))
  534                  {
  535                    currPack=pi->pack;
  536                    iiCheckPack(currPack);
  537                    currPackHdl=packFindHdl(currPack);
  538                    //Print("set pack=%s\n",IDID(currPackHdl));
  539                  }
  540                  else if ((pack!=NULL)&&(currPack!=pack))
  541                  {
  542                    currPack=pack;
  543                    iiCheckPack(currPack);
  544                    currPackHdl=packFindHdl(currPack);
  545                    //Print("set pack=%s\n",IDID(currPackHdl));
  546                  }
  547                  err=iiPStart(pn,args);
  548                  break;
  549     case LANG_C:
  550                  leftv res = (leftv)omAlloc0Bin(sleftv_bin);
  551                  err = (pi->data.o.function)(res, args);
  552                  memcpy(&iiRETURNEXPR,res,sizeof(iiRETURNEXPR));
  553                  omFreeBin((ADDRESS)res,  sleftv_bin);
  554                  break;
  555   }
  556   if ((traceit&TRACE_SHOW_PROC)
  557   || (pi->trace_flag&TRACE_SHOW_PROC))
  558   {
  559     if (traceit&TRACE_SHOW_LINENO) PrintLn();
  560     Print("leaving %-*.*s %s (level %d)\n",myynest*2,myynest*2," ",IDID(pn),myynest);
  561   }
  562   //const char *n="NULL";
  563   //if (currRingHdl!=NULL) n=IDID(currRingHdl);
  564   //Print("currRing(%d):%s(%x) after %s\n",myynest,n,currRing,IDID(pn));
  565 #ifdef RDEBUG
  566   if (traceit&TRACE_SHOW_RINGS) iiShowLevRings();
  567 #endif
  568   if (err)
  569   {
  570     iiRETURNEXPR.CleanUp();
  571     //iiRETURNEXPR.Init(); //done by CleanUp
  572   }
  573   if (iiCurrArgs!=NULL)
  574   {
  575     if (!err) Warn("too many arguments for %s",IDID(pn));
  576     iiCurrArgs->CleanUp();
  577     omFreeBin((ADDRESS)iiCurrArgs, sleftv_bin);
  578     iiCurrArgs=NULL;
  579   }
  580   procstack->pop();
  581   if (err)
  582     return TRUE;
  583   return FALSE;
  584 }
  585 static void iiCallLibProcBegin()
  586 {
  587   idhdl tmp_ring=NULL;
  588   if (currRing!=NULL)
  589   {
  590     if ((currRingHdl!=NULL) && (IDRING(currRingHdl)!=currRing))
  591     {
  592       // clean up things depending on currRingHdl:
  593       sLastPrinted.CleanUp(IDRING(currRingHdl));
  594       sLastPrinted.Init();
  595     }
  596     // need to define a ring-hdl for currRingHdl
  597     tmp_ring=enterid(" tmpRing",myynest,RING_CMD,&IDROOT,FALSE);
  598     IDRING(tmp_ring)=rIncRefCnt(currRing);
  599     rSetHdl(tmp_ring);
  600   }
  601 }
  602 static void iiCallLibProcEnd(idhdl save_ringhdl, ring save_ring)
  603 {
  604   if ((currRing!=NULL)
  605   &&(currRing!=save_ring))
  606   {
  607     rDecRefCnt(currRing);
  608     idhdl hh=IDROOT;
  609     idhdl prev=NULL;
  610     while((hh!=currRingHdl) && (hh!=NULL)) { prev=hh; hh=hh->next; }
  611     if (hh!=NULL)
  612     {
  613       if (prev==NULL) IDROOT=hh->next;
  614       else prev->next=hh->next;
  615       omFree((ADDRESS)IDID(hh));
  616       omFreeBin((ADDRESS)hh, idrec_bin);
  617     }
  618   }
  619   currRingHdl=save_ringhdl;
  620   currRing=save_ring;
  621 }
  622 
  623 void* iiCallLibProc1(const char*n, void *arg, int arg_type, BOOLEAN &err)
  624 {
  625   idhdl h=ggetid(n);
  626   if ((h==NULL)
  627   || (IDTYP(h)!=PROC_CMD))
  628   {
  629     err=2;
  630     return NULL;
  631   }
  632   // ring handling
  633   idhdl save_ringhdl=currRingHdl;
  634   ring save_ring=currRing;
  635   iiCallLibProcBegin();
  636   // argument:
  637   sleftv tmp;
  638   tmp.Init();
  639   tmp.data=arg;
  640   tmp.rtyp=arg_type;
  641   // call proc
  642   err=iiMake_proc(h,currPack,&tmp);
  643   // clean up ring
  644   iiCallLibProcEnd(save_ringhdl,save_ring);
  645   // return
  646   if (err==FALSE)
  647   {
  648     void*r=iiRETURNEXPR.data;
  649     iiRETURNEXPR.data=NULL;
  650     iiRETURNEXPR.CleanUp();
  651     return r;
  652   }
  653   return NULL;
  654 }
  655 
  656 // return NULL on failure
  657 ideal ii_CallProcId2Id(const char *lib,const char *proc, ideal arg, const ring R)
  658 {
  659   char *plib = iiConvName(lib);
  660   idhdl h=ggetid(plib);
  661   omFree(plib);
  662   if (h==NULL)
  663   {
  664     BOOLEAN bo=iiLibCmd(lib,TRUE,TRUE,FALSE);
  665     if (bo) return NULL;
  666   }
  667   ring oldR=currRing;
  668   rChangeCurrRing(R);
  669   BOOLEAN err;
  670   ideal I=(ideal)iiCallLibProc1(proc,idCopy(arg),IDEAL_CMD,err);
  671   rChangeCurrRing(oldR);
  672   if (err) return NULL;
  673   return I;
  674 }
  675 
  676 int ii_CallProcId2Int(const char *lib,const char *proc, ideal arg, const ring R)
  677 {
  678   char *plib = iiConvName(lib);
  679   idhdl h=ggetid(plib);
  680   omFree(plib);
  681   if (h==NULL)
  682   {
  683     BOOLEAN bo=iiLibCmd(lib,TRUE,TRUE,FALSE);
  684     if (bo) return 0;
  685   }
  686   BOOLEAN err;
  687   ring oldR=currRing;
  688   rChangeCurrRing(R);
  689   int I=(int)(long)iiCallLibProc1(proc,idCopy(arg),IDEAL_CMD,err);
  690   rChangeCurrRing(oldR);
  691   if (err) return 0;
  692   return I;
  693 }
  694 
  695 /// args: NULL terminated array of arguments
  696 /// arg_types: 0 terminated array of corresponding types
  697 leftv ii_CallLibProcM(const char*n, void **args, int* arg_types, const ring R, BOOLEAN &err)
  698 {
  699   idhdl h=ggetid(n);
  700   if ((h==NULL)
  701   || (IDTYP(h)!=PROC_CMD))
  702   {
  703     err=2;
  704     return NULL;
  705   }
  706   // ring handling
  707   idhdl save_ringhdl=currRingHdl;
  708   ring save_ring=currRing;
  709   rChangeCurrRing(R);
  710   iiCallLibProcBegin();
  711   // argument:
  712   if (arg_types[0]!=0)
  713   {
  714     sleftv tmp;
  715     leftv tt=&tmp;
  716     int i=1;
  717     tmp.Init();
  718     tmp.data=args[0];
  719     tmp.rtyp=arg_types[0];
  720     while(arg_types[i]!=0)
  721     {
  722       tt->next=(leftv)omAlloc0Bin(sleftv_bin);
  723       tt=tt->next;
  724       tt->rtyp=arg_types[i];
  725       tt->data=args[i];
  726       i++;
  727     }
  728     // call proc
  729     err=iiMake_proc(h,currPack,&tmp);
  730   }
  731   else
  732   // call proc
  733     err=iiMake_proc(h,currPack,NULL);
  734   // clean up ring
  735   iiCallLibProcEnd(save_ringhdl,save_ring);
  736   // return
  737   if (err==FALSE)
  738   {
  739     leftv h=(leftv)omAllocBin(sleftv_bin);
  740     memcpy(h,&iiRETURNEXPR,sizeof(sleftv));
  741     iiRETURNEXPR.Init();
  742     return h;
  743   }
  744   return NULL;
  745 }
  746 /*2
  747 * start an example (as a proc),
  748 * destroys the string 'example'
  749 */
  750 BOOLEAN iiEStart(char* example, procinfo *pi)
  751 {
  752   BOOLEAN err;
  753   int old_echo=si_echo;
  754 
  755   iiCheckNest();
  756   procstack->push(example);
  757   iiLocalRing[myynest]=currRing;
  758   if (traceit&TRACE_SHOW_PROC)
  759   {
  760     if (traceit&TRACE_SHOW_LINENO) printf("\n");
  761     printf("entering example (level %d)\n",myynest);
  762   }
  763   myynest++;
  764 
  765   err=iiAllStart(pi,example,BT_example,(pi != NULL ? pi->data.s.example_lineno: 0));
  766 
  767   killlocals(myynest);
  768   myynest--;
  769   si_echo=old_echo;
  770   if (traceit&TRACE_SHOW_PROC)
  771   {
  772     if (traceit&TRACE_SHOW_LINENO) printf("\n");
  773     printf("leaving  -example- (level %d)\n",myynest);
  774   }
  775   if (iiLocalRing[myynest] != currRing)
  776   {
  777     if (iiLocalRing[myynest]!=NULL)
  778     {
  779       rSetHdl(rFindHdl(iiLocalRing[myynest],NULL));
  780       iiLocalRing[myynest]=NULL;
  781     }
  782     else
  783     {
  784       currRingHdl=NULL;
  785       currRing=NULL;
  786     }
  787   }
  788   procstack->pop();
  789   return err;
  790 }
  791 
  792 
  793 extern "C"
  794 {
  795 #  define SI_GET_BUILTIN_MOD_INIT0(name) int SI_MOD_INIT0(name)(SModulFunctions*);
  796           SI_FOREACH_BUILTIN(SI_GET_BUILTIN_MOD_INIT0)
  797 #  undef  SI_GET_BUILTIN_MOD_INIT0
  798 };
  799 
  800 extern "C" int flint_mod_init(SModulFunctions* psModulFunctions);
  801 
  802 SModulFunc_t
  803 iiGetBuiltinModInit(const char* libname)
  804 {
  805 #ifdef HAVE_FLINT
  806   if (strcmp(libname,"flint.so")==0) return SI_MOD_INIT0(flint);
  807 #endif
  808 #  define SI_GET_BUILTIN_MOD_INIT(name) if (strcmp(libname, #name ".so") == 0){ return SI_MOD_INIT0(name); }
  809           SI_FOREACH_BUILTIN(SI_GET_BUILTIN_MOD_INIT)
  810 #  undef  SI_GET_BUILTIN_MOD_INIT
  811 
  812   return NULL;
  813 }
  814 
  815 
  816 
  817 
  818 /*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
  819 BOOLEAN iiTryLoadLib(leftv v, const char *id)
  820 {
  821   BOOLEAN LoadResult = TRUE;
  822   char libnamebuf[1024];
  823   char *libname = (char *)omAlloc(strlen(id)+5);
  824   const char *suffix[] = { "", ".lib", ".so", ".sl", NULL };
  825   int i = 0;
  826   // FILE *fp;
  827   // package pack;
  828   // idhdl packhdl;
  829   lib_types LT;
  830   for(i=0; suffix[i] != NULL; i++)
  831   {
  832     sprintf(libname, "%s%s", id, suffix[i]);
  833     *libname = mytolower(*libname);
  834     if((LT = type_of_LIB(libname, libnamebuf)) > LT_NOTFOUND)
  835     {
  836       #ifdef HAVE_DYNAMIC_LOADING
  837       char libnamebuf[1024];
  838       #endif
  839 
  840       if (LT==LT_SINGULAR)
  841         LoadResult = iiLibCmd(libname, FALSE, FALSE,TRUE);
  842       #ifdef HAVE_DYNAMIC_LOADING
  843       else if ((LT==LT_ELF) || (LT==LT_HPUX))
  844         LoadResult = load_modules(libname,libnamebuf,FALSE);
  845       #endif
  846       else if (LT==LT_BUILTIN)
  847       {
  848         LoadResult=load_builtin(libname,FALSE, iiGetBuiltinModInit(libname));
  849       }
  850       if(!LoadResult )
  851       {
  852         v->name = iiConvName(libname);
  853         break;
  854       }
  855     }
  856   }
  857   omFree(libname);
  858   return LoadResult;
  859 }
  860 
  861 /*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
  862 /* check, if library lib has already been loaded
  863    if yes, writes filename of lib into where and returns TRUE,
  864       no, returns FALSE
  865 */
  866 BOOLEAN iiLocateLib(const char* lib, char* where)
  867 {
  868   char *plib = iiConvName(lib);
  869   idhdl pl = basePack->idroot->get(plib,0);
  870   if( (pl!=NULL) && (IDTYP(pl)==PACKAGE_CMD) &&
  871     (IDPACKAGE(pl)->language == LANG_SINGULAR))
  872   {
  873     strncpy(where,IDPACKAGE(pl)->libname,127);
  874     return TRUE;
  875   }
  876   else
  877     return FALSE;;
  878 }
  879 
  880 BOOLEAN iiLibCmd( const char *newlib, BOOLEAN autoexport, BOOLEAN tellerror, BOOLEAN force )
  881 {
  882   if (strcmp(newlib,"Singular")==0) return FALSE;
  883   char libnamebuf[1024];
  884   idhdl pl;
  885   char *plib = iiConvName(newlib);
  886   FILE * fp = feFopen( newlib, "r", libnamebuf, tellerror );
  887   // int lines = 1;
  888   BOOLEAN LoadResult = TRUE;
  889 
  890   if (fp==NULL)
  891   {
  892     return TRUE;
  893   }
  894   pl = basePack->idroot->get(plib,0);
  895   if (pl==NULL)
  896   {
  897     pl = enterid( plib,0, PACKAGE_CMD,
  898                   &(basePack->idroot), TRUE );
  899     IDPACKAGE(pl)->language = LANG_SINGULAR;
  900     IDPACKAGE(pl)->libname=omStrDup(newlib);
  901   }
  902   else
  903   {
  904     if(IDTYP(pl)!=PACKAGE_CMD)
  905     {
  906       omFree(plib);
  907       WarnS("not of type package.");
  908       fclose(fp);
  909       return TRUE;
  910     }
  911     if (!force)
  912     {
  913       omFree(plib);
  914       return FALSE;
  915     }
  916   }
  917   LoadResult = iiLoadLIB(fp, libnamebuf, newlib, pl, autoexport, tellerror);
  918 
  919   if(!LoadResult) IDPACKAGE(pl)->loaded = TRUE;
  920   omFree((ADDRESS)plib);
  921   return LoadResult;
  922 }
  923 /*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
  924 static void iiCleanProcs(idhdl &root)
  925 {
  926   idhdl prev=NULL;
  927   loop
  928   {
  929     if (root==NULL) return;
  930     if (IDTYP(root)==PROC_CMD)
  931     {
  932       procinfo *pi=(procinfo*)IDDATA(root);
  933       if ((pi->language == LANG_SINGULAR)
  934       && (pi->data.s.body_start == 0L))
  935       {
  936         // procinfo data incorrect:
  937         // - no proc body can start at the beginning of the file
  938         killhdl(root);
  939         if (prev==NULL)
  940           root=IDROOT;
  941         else
  942         {
  943           root=prev;
  944           prev=NULL;
  945         }
  946         continue;
  947       }
  948     }
  949     prev=root;
  950     root=IDNEXT(root);
  951   }
  952 }
  953 static void iiRunInit(package p)
  954 {
  955   idhdl h=p->idroot->get("mod_init",0);
  956   if (h==NULL) return;
  957   if (IDTYP(h)==PROC_CMD)
  958   {
  959     int save=yylineno;
  960     myynest++;
  961     // procinfo *pi=(procinfo*)IDDATA(h);
  962     //PrintS("mod_init found\n");
  963     iiMake_proc(h,p,NULL);
  964     myynest--;
  965     yylineno=save;
  966   }
  967 }
  968 /*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
  969 BOOLEAN iiLoadLIB(FILE *fp, const char *libnamebuf, const char*newlib,
  970              idhdl pl, BOOLEAN autoexport, BOOLEAN tellerror)
  971 {
  972   EXTERN_VAR FILE *yylpin;
  973   libstackv ls_start = library_stack;
  974   lib_style_types lib_style;
  975 
  976   yylpin = fp;
  977   #if YYLPDEBUG > 1
  978   print_init();
  979   #endif
  980   EXTERN_VAR int lpverbose;
  981   if (BVERBOSE(V_DEBUG_LIB)) lpverbose=1;
  982   else lpverbose=0;
  983   // yylplex sets also text_buffer
  984   if (text_buffer!=NULL) *text_buffer='\0';
  985   yylplex(newlib, libnamebuf, &lib_style, pl, autoexport);
  986   if(yylp_errno)
  987   {
  988     Werror("Library %s: ERROR occurred: in line %d, %d.", newlib, yylplineno,
  989          current_pos(0));
  990     if(yylp_errno==YYLP_BAD_CHAR)
  991     {
  992       Werror(yylp_errlist[yylp_errno], *text_buffer, yylplineno);
  993       omFree((ADDRESS)text_buffer);
  994       text_buffer=NULL;
  995     }
  996     else
  997       Werror(yylp_errlist[yylp_errno], yylplineno);
  998     WerrorS("Cannot load library,... aborting.");
  999     reinit_yylp();
 1000     fclose( yylpin );
 1001     iiCleanProcs(IDROOT);
 1002     return TRUE;
 1003   }
 1004   if (BVERBOSE(V_LOAD_LIB))
 1005     Print( "// ** loaded %s %s\n", libnamebuf, text_buffer);
 1006   if( (lib_style == OLD_LIBSTYLE) && (BVERBOSE(V_LOAD_LIB)))
 1007   {
 1008     Warn( "library %s has old format. This format is still accepted,", newlib);
 1009     WarnS( "but for functionality you may wish to change to the new");
 1010     WarnS( "format. Please refer to the manual for further information.");
 1011   }
 1012   reinit_yylp();
 1013   fclose( yylpin );
 1014   fp = NULL;
 1015   iiRunInit(IDPACKAGE(pl));
 1016 
 1017   {
 1018     libstackv ls;
 1019     for(ls = library_stack; (ls != NULL) && (ls != ls_start); )
 1020     {
 1021       if(ls->to_be_done)
 1022       {
 1023         ls->to_be_done=FALSE;
 1024         iiLibCmd(ls->get(),autoexport,tellerror,FALSE);
 1025         ls = ls->pop(newlib);
 1026       }
 1027     }
 1028 #if 0
 1029     PrintS("--------------------\n");
 1030     for(ls = library_stack; ls != NULL; ls = ls->next)
 1031     {
 1032       Print("%s: LIB-stack:(%d), %s %s\n", newlib, ls->cnt, ls->get(),
 1033         ls->to_be_done ? "not loaded" : "loaded");
 1034     }
 1035     PrintS("--------------------\n");
 1036 #endif
 1037   }
 1038 
 1039   if(fp != NULL) fclose(fp);
 1040   return FALSE;
 1041 }
 1042 
 1043 
 1044 /*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
 1045 procinfo *iiInitSingularProcinfo(procinfov pi, const char *libname,
 1046               const char *procname, int, long pos, BOOLEAN pstatic)
 1047 {
 1048   memset(pi,0,sizeof(*pi));
 1049   pi->libname = omStrDup(libname);
 1050   pi->procname = omStrDup(procname);
 1051   pi->language = LANG_SINGULAR;
 1052   pi->ref = 1;
 1053   pi->is_static = pstatic;
 1054   pi->data.s.proc_start = pos;
 1055   return(pi);
 1056 }
 1057 
 1058 /*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
 1059 int iiAddCproc(const char *libname, const char *procname, BOOLEAN pstatic,
 1060                BOOLEAN(*func)(leftv res, leftv v))
 1061 {
 1062   procinfov pi;
 1063   idhdl h;
 1064 
 1065   #ifndef SING_NDEBUG
 1066   int dummy;
 1067   if (IsCmd(procname,dummy))
 1068   {
 1069     Werror(">>%s< is a reserved name",procname);
 1070     return 0;
 1071   }
 1072   #endif
 1073 
 1074   h=IDROOT->get(procname,0);
 1075   if ((h!=NULL)
 1076   && (IDTYP(h)==PROC_CMD))
 1077   {
 1078     pi = IDPROC(h);
 1079     #if 0
 1080     if ((pi->language == LANG_SINGULAR)
 1081     &&(BVERBOSE(V_REDEFINE)))
 1082       Warn("extend `%s`",procname);
 1083     #endif
 1084   }
 1085   else
 1086   {
 1087     h = enterid(procname,0, PROC_CMD, &IDROOT, TRUE);
 1088   }
 1089   if ( h!= NULL )
 1090   {
 1091     pi = IDPROC(h);
 1092     if((pi->language == LANG_SINGULAR)
 1093     ||(pi->language == LANG_NONE))
 1094     {
 1095       omfree(pi->libname);
 1096       pi->libname = omStrDup(libname);
 1097       omfree(pi->procname);
 1098       pi->procname = omStrDup(procname);
 1099       pi->language = LANG_C;
 1100       pi->ref = 1;
 1101       pi->is_static = pstatic;
 1102       pi->data.o.function = func;
 1103     }
 1104     else if(pi->language == LANG_C)
 1105     {
 1106       if(pi->data.o.function == func)
 1107       {
 1108         pi->ref++;
 1109       }
 1110       else
 1111       {
 1112         omfree(pi->libname);
 1113         pi->libname = omStrDup(libname);
 1114         omfree(pi->procname);
 1115         pi->procname = omStrDup(procname);
 1116         pi->language = LANG_C;
 1117         pi->ref = 1;
 1118         pi->is_static = pstatic;
 1119         pi->data.o.function = func;
 1120       }
 1121     }
 1122     else
 1123       Warn("internal error: unknown procedure type %d",pi->language);
 1124     if (currPack->language==LANG_SINGULAR) currPack->language=LANG_MIX;
 1125     return(1);
 1126   }
 1127   else
 1128   {
 1129     WarnS("iiAddCproc: failed.");
 1130   }
 1131   return(0);
 1132 }
 1133 
 1134 int iiAddCprocTop(const char *libname, const char *procname, BOOLEAN pstatic,
 1135                BOOLEAN(*func)(leftv res, leftv v))
 1136 {
 1137   int r=iiAddCproc(libname,procname,pstatic,func);
 1138   package s=currPack;
 1139   currPack=basePack;
 1140   if (r) r=iiAddCproc(libname,procname,pstatic,func);
 1141   currPack=s;
 1142   return r;
 1143 }
 1144 
 1145 /*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
 1146 #ifdef HAVE_DYNAMIC_LOADING
 1147 #include <map>
 1148 #include <string>
 1149 #include <pthread.h>
 1150 
 1151 THREAD_VAR std::map<std::string, void *> *dyn_modules;
 1152 
 1153 bool registered_dyn_module(char *fullname) {
 1154   if (dyn_modules == NULL)
 1155     return false;
 1156   std::string fname = fullname;
 1157   return dyn_modules->count(fname) != 0;
 1158 }
 1159 
 1160 void register_dyn_module(char *fullname, void * handle) {
 1161   std::string fname = fullname;
 1162   if (dyn_modules == NULL)
 1163     dyn_modules = new std::map<std::string, void *>();
 1164   dyn_modules->insert(std::pair<std::string, void *>(fname, handle));
 1165 }
 1166 
 1167 void close_all_dyn_modules() {
 1168   for (std::map<std::string, void *>::iterator it = dyn_modules->begin();
 1169        it != dyn_modules->end();
 1170        it++)
 1171   {
 1172     dynl_close(it->second);
 1173   }
 1174   delete dyn_modules;
 1175   dyn_modules = NULL;
 1176 }
 1177 BOOLEAN load_modules_aux(const char *newlib, char *fullname, BOOLEAN autoexport)
 1178 {
 1179 /*
 1180   typedef int (*fktn_t)(int(*iiAddCproc)(const char *libname, const char *procname,
 1181                                BOOLEAN pstatic,
 1182                                BOOLEAN(*func)(leftv res, leftv v)));
 1183 */
 1184   SModulFunc_t fktn;
 1185   idhdl pl;
 1186   char *plib = iiConvName(newlib);
 1187   BOOLEAN RET=TRUE;
 1188   int token;
 1189   int l=si_max((int)strlen(fullname),(int)strlen(newlib))+3;
 1190   char *FullName=(char*)omAlloc0(l);
 1191 
 1192   if( *fullname != '/' &&  *fullname != '.' )
 1193     sprintf(FullName, "./%s", newlib);
 1194   else strncpy(FullName, fullname,l);
 1195 
 1196 
 1197   if(IsCmd(plib, token))
 1198   {
 1199     Werror("'%s' is resered identifier\n", plib);
 1200     goto load_modules_end;
 1201   }
 1202   pl = basePack->idroot->get(plib,0); /* packages only in top level
 1203                                         (see enterid) */
 1204   if ((pl!=NULL)
 1205   &&(IDTYP(pl)==PACKAGE_CMD))
 1206   {
 1207     if(IDPACKAGE(pl)->language==LANG_C)
 1208     {
 1209       if (BVERBOSE(V_LOAD_LIB)) Warn( "%s already loaded as package", newlib);
 1210       omFree(plib);
 1211       return FALSE;
 1212     }
 1213     else if(IDPACKAGE(pl)->language==LANG_MIX)
 1214     {
 1215       if (BVERBOSE(V_LOAD_LIB)) Warn( "%s contain binary parts, cannot load", newlib);
 1216       omFree(plib);
 1217       return FALSE;
 1218     }
 1219   }
 1220   else
 1221   {
 1222     pl = enterid( plib,0, PACKAGE_CMD, &IDROOT, TRUE );
 1223     omFree(plib); /* enterid copied plib*/
 1224     IDPACKAGE(pl)->libname=omStrDup(newlib);
 1225   }
 1226   IDPACKAGE(pl)->language = LANG_C;
 1227   if (dynl_check_opened(FullName))
 1228   {
 1229     if (BVERBOSE(V_LOAD_LIB)) Warn( "%s already loaded as C library", fullname);
 1230     omFreeSize(FullName,l);
 1231     return FALSE;
 1232   }
 1233   if((IDPACKAGE(pl)->handle=dynl_open(FullName))==(void *)NULL)
 1234   {
 1235     Werror("dynl_open failed:%s", dynl_error());
 1236     Werror("%s not found", newlib);
 1237     killhdl2(pl,&(basePack->idroot),NULL); // remove package
 1238     goto load_modules_end;
 1239   }
 1240   else
 1241   {
 1242     SModulFunctions sModulFunctions;
 1243 
 1244     package s=currPack;
 1245     currPack=IDPACKAGE(pl);
 1246     fktn = (SModulFunc_t)dynl_sym(IDPACKAGE(pl)->handle, "mod_init");
 1247     if( fktn!= NULL)
 1248     {
 1249       sModulFunctions.iiArithAddCmd = iiArithAddCmd;
 1250       if (autoexport) sModulFunctions.iiAddCproc = iiAddCprocTop;
 1251       else            sModulFunctions.iiAddCproc = iiAddCproc;
 1252       int ver=(*fktn)(&sModulFunctions);
 1253       if (ver==MAX_TOK)
 1254       {
 1255         if (BVERBOSE(V_LOAD_LIB)) Print( "// ** loaded %s\n", fullname);
 1256       }
 1257       else
 1258       {
 1259         Warn("loaded %s for a different version of Singular(expected MAX_TOK: %d, got %d)",fullname,MAX_TOK,ver);
 1260       }
 1261       currPack->loaded=1;
 1262       currPack=s; /* reset currPack to previous */
 1263       register_dyn_module(fullname, IDPACKAGE(pl)->handle);
 1264       RET=FALSE;
 1265     }
 1266     else
 1267     {
 1268       Werror("mod_init not found:: %s\nThis is probably not a dynamic module for Singular!\n", dynl_error());
 1269       errorreported=0;
 1270       if(IDPACKAGE(pl)->idroot==NULL)
 1271         killhdl2(pl,&(basePack->idroot),NULL); // remove package
 1272     }
 1273   }
 1274 
 1275   load_modules_end:
 1276   omFreeSize(FullName,l);
 1277   return RET;
 1278 }
 1279 
 1280 BOOLEAN load_modules(const char *newlib, char *fullname, BOOLEAN autoexport)
 1281 {
 1282   GLOBAL_VAR static pthread_mutex_t mutex = PTHREAD_MUTEX_INITIALIZER;
 1283   pthread_mutex_lock(&mutex);
 1284   BOOLEAN r = load_modules_aux(newlib, fullname, autoexport);
 1285   pthread_mutex_unlock(&mutex);
 1286   return r;
 1287 }
 1288 #endif /* HAVE_DYNAMIC_LOADING */
 1289 /*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
 1290 BOOLEAN load_builtin(const char *newlib, BOOLEAN autoexport, SModulFunc_t init)
 1291 {
 1292   int iiAddCproc(const char *libname, const char *procname, BOOLEAN pstatic,
 1293                  BOOLEAN(*func)(leftv res, leftv v));
 1294 /*
 1295   typedef int (*fktn_t)(int(*iiAddCproc)(const char *libname, const char *procname,
 1296                                BOOLEAN pstatic,
 1297                                BOOLEAN(*func)(leftv res, leftv v)));
 1298 */
 1299   // SModulFunc_t fktn;
 1300   idhdl pl;
 1301   char *plib = iiConvName(newlib);
 1302   // BOOLEAN RET=TRUE;
 1303   // int token;
 1304 
 1305   pl = basePack->idroot->get(plib,0); // search PACKAGE only in Top
 1306   if ((pl!=NULL)
 1307   &&(IDTYP(pl)==PACKAGE_CMD))
 1308   {
 1309     if(IDPACKAGE(pl)->language==LANG_C)
 1310     {
 1311       if (BVERBOSE(V_LOAD_LIB)) Warn( "(builtin) %s already loaded", newlib);
 1312       omFree(plib);
 1313       return FALSE;
 1314     }
 1315   }
 1316   else
 1317   {
 1318     pl = enterid( plib,0, PACKAGE_CMD, &IDROOT, TRUE );
 1319     IDPACKAGE(pl)->libname=omStrDup(newlib);
 1320   }
 1321   omFree(plib);
 1322   IDPACKAGE(pl)->language = LANG_C;
 1323 
 1324   IDPACKAGE(pl)->handle=(void *)NULL;
 1325   SModulFunctions sModulFunctions;
 1326 
 1327   package s=currPack;
 1328   currPack=IDPACKAGE(pl);
 1329   if( init!= NULL)
 1330   {
 1331     sModulFunctions.iiArithAddCmd = iiArithAddCmd;
 1332     if (autoexport) sModulFunctions.iiAddCproc = iiAddCprocTop;
 1333     else            sModulFunctions.iiAddCproc = iiAddCproc;
 1334     (*init)(&sModulFunctions);
 1335   }
 1336   if (BVERBOSE(V_LOAD_LIB)) Print( "// ** loaded (builtin) %s \n", newlib);
 1337   currPack->loaded=1;
 1338   currPack=s;
 1339 
 1340   return FALSE;
 1341 }
 1342 /*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
 1343 void module_help_main(const char *newlib,const char *help)
 1344 {
 1345   char *plib = iiConvName(newlib);
 1346   idhdl pl = basePack->idroot->get(plib,0);
 1347   if ((pl==NULL)||(IDTYP(pl)!=PACKAGE_CMD))
 1348     Werror(">>%s<< is not a package (trying to add package help)",plib);
 1349   else
 1350   {
 1351     package s=currPack;
 1352     currPack=IDPACKAGE(pl);
 1353     idhdl h=enterid("info",0,STRING_CMD,&IDROOT,FALSE);
 1354     IDSTRING(h)=omStrDup(help);
 1355     currPack=s;
 1356   }
 1357 }
 1358 void module_help_proc(const char *newlib,const char *p, const char *help)
 1359 {
 1360   char *plib = iiConvName(newlib);
 1361   idhdl pl = basePack->idroot->get(plib,0);
 1362   if ((pl==NULL)||(IDTYP(pl)!=PACKAGE_CMD))
 1363     Werror(">>%s<< is not a package(trying to add help for %s)",plib,p);
 1364   else
 1365   {
 1366     package s=currPack;
 1367     currPack=IDPACKAGE(pl);
 1368     char buff[256];
 1369     buff[255]='\0';
 1370     strncpy(buff,p,255);
 1371     strncat(buff,"_help",255-strlen(p));
 1372     idhdl h=enterid(buff,0,STRING_CMD,&IDROOT,FALSE);
 1373     IDSTRING(h)=omStrDup(help);
 1374     currPack=s;
 1375   }
 1376 }
 1377 /*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
 1378 
 1379 #ifdef HAVE_DYNAMIC_LOADING
 1380 // loads a dynamic module from the binary path and returns a named function
 1381 // returns NULL, if something fails
 1382 void* binary_module_function(const char* newlib, const char* funcname)
 1383 {
 1384   void* result = NULL;
 1385 
 1386   const char* bin_dir = feGetResource('b');
 1387   if (!bin_dir)  { return NULL; }
 1388 
 1389   char path_name[MAXPATHLEN];
 1390   sprintf(path_name, "%s%s%s.%s", bin_dir, DIR_SEPP, newlib, MODULE_SUFFIX_STRING);
 1391 
 1392   void* openlib = dynl_open(path_name);
 1393   if(!openlib)
 1394   {
 1395     Werror("dynl_open of %s failed:%s", path_name, dynl_error());
 1396     return NULL;
 1397   }
 1398   result = dynl_sym(openlib, funcname);
 1399   if (!result) Werror("%s: %s\n", funcname, dynl_error());
 1400 
 1401   return result;
 1402 }
 1403 #endif
 1404 
 1405 /*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
 1406 char mytoupper(char c)
 1407 {
 1408   if(c>=97 && c<=(97+26)) c-=32;
 1409   return(c);
 1410 }
 1411 
 1412 char mytolower(char c)
 1413 {
 1414   if(c>=65 && c<=(65+26)) c+=32;
 1415   return(c);
 1416 }
 1417 
 1418 /*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
 1419 //#if defined(WINNT)
 1420 //#  define  FS_SEP '\\'
 1421 //#else
 1422 //#  define FS_SEP '/'
 1423 //#endif
 1424 
 1425 char *iiConvName(const char *libname)
 1426 {
 1427   char *tmpname = omStrDup(libname);
 1428   char *p = strrchr(tmpname, DIR_SEP);
 1429   char *r;
 1430   if(p==NULL) p = tmpname; else p++;
 1431   // p is now the start of the file name (without path)
 1432   r=p;
 1433   while(isalnum(*r)||(*r=='_')) r++;
 1434   // r point the the end of the main part of the filename
 1435   *r = '\0';
 1436   r = omStrDup(p);
 1437   *r = mytoupper(*r);
 1438   // printf("iiConvName: '%s' '%s' => '%s'\n", libname, tmpname, r);
 1439   omFree((ADDRESS)tmpname);
 1440 
 1441   return(r);
 1442 }
 1443 
 1444 /*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
 1445 #if 0 /* debug only */
 1446 void piShowProcList()
 1447 {
 1448   idhdl h;
 1449   procinfo *proc;
 1450   char *name;
 1451 
 1452   Print( "%-15s  %20s      %s,%s  %s,%s   %s,%s\n", "Library", "function",
 1453          "line", "start", "line", "body", "line", "example");
 1454   for(h = IDROOT; h != NULL; h = IDNEXT(h))
 1455   {
 1456     if(IDTYP(h) == PROC_CMD)
 1457     {
 1458       proc = IDPROC(h);
 1459       if(strcmp(proc->procname, IDID(h))!=0)
 1460       {
 1461         name = (char *)omAlloc(strlen(IDID(h))+strlen(proc->procname)+4);
 1462         sprintf(name, "%s -> %s", IDID(h), proc->procname);
 1463         Print( "%d %-15s  %20s ", proc->is_static ? 1 : 0, proc->libname, name);
 1464         omFree((ADDRESS)name);
 1465       }
 1466       else
 1467         Print( "%d %-15s  %20s ", proc->is_static ? 1 : 0, proc->libname,
 1468                proc->procname);
 1469       if(proc->language==LANG_SINGULAR)
 1470         Print("line %-5ld  %4d,%-5ld  %4d,%-5ld\n",
 1471               proc->data.s.proc_start,
 1472               proc->data.s.body_lineno, proc->data.s.body_start,
 1473               proc->data.s.example_lineno, proc->data.s.example_start);
 1474       else if(proc->language==LANG_C)
 1475         PrintS("type: object\n");
 1476     }
 1477   }
 1478 }
 1479 #endif
 1480 
 1481 /*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
 1482 //char *iiLineNo(char *procname, int lineno)
 1483 //{
 1484 //  char buf[256];
 1485 //  idhdl pn = ggetid(procname);
 1486 //  procinfo *pi = IDPROC(pn);
 1487 //
 1488 //  sprintf(buf, "%s %3d\0", procname, lineno);
 1489 //  //sprintf(buf, "%s::%s %3d\0", pi->libname, pi->procname,
 1490 //  //  lineno + pi->data.s.body_lineno);
 1491 //  return(buf);
 1492 //}
 1493 /*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
 1494 #ifdef HAVE_LIBPARSER
 1495 void libstack::push(const char */*p*/, char *libn)
 1496 {
 1497   libstackv lp;
 1498   if( !iiGetLibStatus(libn))
 1499   {
 1500     for(lp = this;lp!=NULL;lp=lp->next)
 1501     {
 1502       if(strcmp(lp->get(), libn)==0) break;
 1503     }
 1504     if(lp==NULL)
 1505     {
 1506       libstackv ls = (libstack *)omAlloc0Bin(libstack_bin);
 1507       ls->next = this;
 1508       ls->libname = omStrDup(libn);
 1509       ls->to_be_done = TRUE;
 1510       if(library_stack != NULL) ls->cnt = library_stack->cnt+1; else ls->cnt = 0;
 1511       library_stack = ls;
 1512     }
 1513   }
 1514 }
 1515 
 1516 libstackv libstack::pop(const char */*p*/)
 1517 {
 1518   libstackv ls = this;
 1519   //omFree((ADDRESS)ls->libname);
 1520   library_stack = ls->next;
 1521   omFreeBin((ADDRESS)ls,  libstack_bin);
 1522   return(library_stack);
 1523 }
 1524 
 1525 #endif /* HAVE_LIBPARSER */
 1526 /*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/