source: git/Singular/iplib.cc @ 8c242f

spielwiese
Last change on this file since 8c242f was 8c242f, checked in by Hans Schönemann <hannes@…>, 14 years ago
avoid double free for example returns (trac 204) git-svn-id: file:///usr/local/Singular/svn/trunk@12560 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 29.5 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id$ */
5/*
6* ABSTRACT: interpreter: LIB and help
7*/
8
9//#include <stdlib.h>
10#include <stdio.h>
11#include <string.h>
12#include <ctype.h>
13#include <sys/stat.h>
14
15#include "mod2.h"
16#include "static.h"
17#include "tok.h"
18#include "options.h"
19#include "ipid.h"
20#include "omalloc.h"
21#include "febase.h"
22#include "ring.h"
23#include "subexpr.h"
24#include "ipshell.h"
25#include "lists.h"
26
27#if SIZEOF_LONG == 8
28#define SI_MAX_NEST 500
29#else
30#define SI_MAX_NEST 1000
31#endif
32
33#ifdef HAVE_DYNAMIC_LOADING
34BOOLEAN load_modules(char *newlib, char *fullname, BOOLEAN autoexport);
35#endif
36
37#ifdef HAVE_LIBPARSER
38#  include "libparse.h"
39#else /* HAVE_LIBPARSER */
40procinfo *iiInitSingularProcinfo(procinfov pi, const char *libname,
41              const char *procname, int line, long pos, BOOLEAN pstatic=FALSE);
42#endif /* HAVE_LIBPARSER */
43#define NS_LRING (procstack->cRing)
44
45extern int iiArithAddCmd(const char *szName, short nAlias, short nTokval,
46                         short nToktype, short nPos);
47
48#include "mod_raw.h"
49
50#ifdef HAVE_LIBPARSER
51void yylprestart (FILE *input_file );
52int current_pos(int i=0);
53extern int yylp_errno;
54extern int yylplineno;
55extern char *yylp_errlist[];
56void print_init();
57libstackv library_stack;
58#endif
59
60//int IsCmd(char *n, int tok);
61char mytolower(char c);
62
63/*2
64* return TRUE if the libray libname is already loaded
65*/
66BOOLEAN iiGetLibStatus(char *lib)
67{
68  idhdl hl;
69
70  char *plib = iiConvName(lib);
71  hl = basePack->idroot->get(plib,0);
72  if((hl==NULL) ||(IDTYP(hl)!=PACKAGE_CMD))
73  {
74    omFree(plib);
75    return FALSE;
76  }
77  omFree(plib);
78  return (strcmp(lib,IDPACKAGE(hl)->libname)==0);
79}
80
81/*2
82* find the library of an proc:
83*  => return (pi->libname)
84*/
85char * iiGetLibName(procinfov pi)
86{
87  return pi->libname;
88}
89
90/*2
91* given a line 'proc[ ]+{name}[ \t]*'
92* return a pointer to name and set the end of '\0'
93* changes the input!
94* returns: e: pointer to 'end of name'
95*          ct: changed char at the end of s
96*/
97char* iiProcName(char *buf, char & ct, char* &e)
98{
99  char *s=buf+5;
100  while (*s==' ') s++;
101  e=s+1;
102  while ((*e>' ') && (*e!='(')) e++;
103  ct=*e;
104  *e='\0';
105  return s;
106}
107
108/*2
109* given a line with args, return the argstr
110*/
111char * iiProcArgs(char *e,BOOLEAN withParenth)
112{
113  while ((*e==' ') || (*e=='\t') || (*e=='(')) e++;
114  if (*e<' ')
115  {
116    if (withParenth)
117    {
118      // no argument list, allow list #
119      return omStrDup("parameter list #;");
120    }
121    else
122    {
123      // empty list
124      return omStrDup("");
125    }
126  }
127  BOOLEAN in_args;
128  BOOLEAN args_found;
129  char *s;
130  char *argstr=(char *)omAlloc(127); // see ../omalloc/omTables.inc
131  int argstrlen=127;
132  *argstr='\0';
133  int par=0;
134  do
135  {
136    args_found=FALSE;
137    s=e; // set s to the starting point of the arg
138         // and search for the end
139    while ((*e!=',')
140    &&((par!=0) || (*e!=')'))
141    &&(*e!='\0'))
142    {
143      if (*e=='(') par++;
144      else if (*e==')') par--;
145      args_found=args_found || (*e>' ');
146      e++;
147    }
148    in_args=(*e==',');
149    if (args_found)
150    {
151      *e='\0';
152      // check for space:
153      if ((int)strlen(argstr)+12 /* parameter + ;*/ +(int)strlen(s)>= argstrlen)
154      {
155        argstrlen*=2;
156        char *a=(char *)omAlloc( argstrlen);
157        strcpy(a,argstr);
158        omFree((ADDRESS)argstr);
159        argstr=a;
160      }
161      // copy the result to argstr
162      strcat(argstr,"parameter ");
163      strcat(argstr,s);
164      strcat(argstr,"; ");
165      e++; // e was pointing to ','
166    }
167  } while (in_args);
168  return argstr;
169}
170
171/*2
172* locate `procname` in lib `libname` and find the part `part`:
173*  part=0: help, between, but excluding the line "proc ..." and "{...":
174*    => return
175*  part=1: body, between "{ ..." and "}", including the 1. line, w/o "{"
176*    => set pi->data.s.body, return NULL
177*  part=2: example, between, but excluding the line "exapmle {..." and "}":
178*    => return
179*/
180char* iiGetLibProcBuffer(procinfo *pi, int part )
181{
182  char buf[256], *s = NULL, *p;
183  long procbuflen;
184
185  FILE * fp = feFopen( pi->libname, "rb", NULL, TRUE );
186  if (fp==NULL)
187  {
188    return NULL;
189  }
190
191  fseek(fp, pi->data.s.proc_start, SEEK_SET);
192  if(part==0)
193  { // load help string
194    int i, offset=0;
195    long head = pi->data.s.def_end - pi->data.s.proc_start;
196    procbuflen = pi->data.s.help_end - pi->data.s.help_start;
197    if (procbuflen<5)
198    {
199      fclose(fp);
200      return NULL; // help part does not exist
201    }
202    //Print("Help=%ld-%ld=%d\n", pi->data.s.body_start,
203    //    pi->data.s.proc_start, procbuflen);
204    s = (char *)omAlloc(procbuflen+head+3);
205    myfread(s, head, 1, fp);
206    s[head] = '\n';
207    fseek(fp, pi->data.s.help_start, SEEK_SET);
208    myfread(s+head+1, procbuflen, 1, fp);
209    fclose(fp);
210    s[procbuflen+head+1] = '\n';
211    s[procbuflen+head+2] = '\0';
212    offset=0;
213    for(i=0;i<=procbuflen+head+2; i++)
214    {
215      if(s[i]=='\\' &&
216         (s[i+1]=='"' || s[i+1]=='{' || s[i+1]=='}' || s[i+1]=='\\'))
217      {
218        i++;
219        offset++;
220      }
221      if(offset>0) s[i-offset] = s[i];
222    }
223    return(s);
224  }
225  else if(part==1)
226  { // load proc part - must exist
227    procbuflen = pi->data.s.def_end - pi->data.s.proc_start;
228    char *ss=(char *)omAlloc(procbuflen+2);
229    //fgets(buf, sizeof(buf), fp);
230    myfread( ss, procbuflen, 1, fp);
231    char ct;
232    char *e;
233    s=iiProcName(ss,ct,e);
234    char *argstr=NULL;
235    *e=ct;
236    argstr=iiProcArgs(e,TRUE);
237
238    assume(pi->data.s.body_end > pi->data.s.body_start);
239
240    procbuflen = pi->data.s.body_end - pi->data.s.body_start;
241    pi->data.s.body = (char *)omAlloc( strlen(argstr)+procbuflen+15+
242                                      strlen(pi->libname) );
243    //Print("Body=%ld-%ld=%d\n", pi->data.s.body_end,
244    //    pi->data.s.body_start, procbuflen);
245    assume(pi->data.s.body != NULL);
246    fseek(fp, pi->data.s.body_start, SEEK_SET);
247    strcpy(pi->data.s.body,argstr);
248    myfread( pi->data.s.body+strlen(argstr), procbuflen, 1, fp);
249    fclose( fp );
250    procbuflen+=strlen(argstr);
251    omFree(argstr);
252    omFree(ss);
253    pi->data.s.body[procbuflen] = '\0';
254    strcat( pi->data.s.body+procbuflen, "\n;return();\n\n" );
255    strcat( pi->data.s.body+procbuflen+13,pi->libname);
256    s=(char *)strchr(pi->data.s.body,'{');
257    if (s!=NULL) *s=' ';
258    return NULL;
259  }
260  else if(part==2)
261  { // example
262    if ( pi->data.s.example_lineno == 0)
263      return NULL; // example part does not exist
264    // load example
265    fseek(fp, pi->data.s.example_start, SEEK_SET);
266    char *dummy=fgets(buf, sizeof(buf), fp); // skip line with "example"
267    procbuflen = pi->data.s.proc_end - pi->data.s.example_start - strlen(buf);
268    //Print("Example=%ld-%ld=%d\n", pi->data.s.proc_end,
269    //  pi->data.s.example_start, procbuflen);
270    s = (char *)omAlloc(procbuflen+14);
271    myfread(s, procbuflen, 1, fp);
272    s[procbuflen] = '\0';
273    strcat(s+procbuflen-3, "\n;return();\n\n" );
274    p=(char *)strchr(s,'{');
275    if (p!=NULL) *p=' ';
276    return(s);
277  }
278  return NULL;
279}
280
281/*2
282* start a proc
283* parameters are built as exprlist
284* TODO:interrupt
285* return FALSE on success, TRUE if an error occurs
286*/
287BOOLEAN iiPStart(idhdl pn, sleftv  * v)
288{
289  BOOLEAN err=FALSE;
290  int old_echo=si_echo;
291  char save_flags=0;
292  procinfov pi=NULL;
293
294  /* init febase ======================================== */
295  /* we do not enter this case if filename != NULL !! */
296  if (pn!=NULL)
297  {
298    pi = IDPROC(pn);
299    if(pi!=NULL)
300    {
301      save_flags=pi->trace_flag;
302      if( pi->data.s.body==NULL )
303      {
304        iiGetLibProcBuffer(pi);
305        if (pi->data.s.body==NULL) return TRUE;
306      }
307//      omUpdateInfo();
308//      int m=om_Info.UsedBytes;
309//      Print("proc %s, mem=%d\n",IDID(pn),m);
310      newBuffer( omStrDup(pi->data.s.body), BT_proc,
311                 pi, pi->data.s.body_lineno-(v!=NULL) );
312    }
313  }
314  /* generate argument list ======================================*/
315  if (v!=NULL)
316  {
317    iiCurrArgs=(leftv)omAllocBin(sleftv_bin);
318    memcpy(iiCurrArgs,v,sizeof(sleftv));
319    memset(v,0,sizeof(sleftv));
320  }
321  else
322  {
323    iiCurrArgs=NULL;
324  }
325  iiCurrProc=pn;
326  /* start interpreter ======================================*/
327  myynest++;
328  if (myynest > SI_MAX_NEST)
329  {
330    WerrorS("nesting too deep");
331    err=TRUE;
332  }
333  else
334  {
335    err=yyparse();
336#ifndef NDEBUG
337    checkall();
338#endif
339    if (sLastPrinted.rtyp!=0)
340    {
341      sLastPrinted.CleanUp();
342    }
343    //Print("kill locals for %s (level %d)\n",IDID(pn),myynest);
344    killlocals(myynest);
345#ifndef NDEBUG
346    checkall();
347#endif
348    //Print("end kill locals for %s (%d)\n",IDID(pn),myynest);
349  }
350  myynest--;
351  si_echo=old_echo;
352  if (pi!=NULL)
353    pi->trace_flag=save_flags;
354//  omUpdateInfo();
355//  int m=om_Info.UsedBytes;
356//  Print("exit %s, mem=%d\n",IDID(pn),m);
357  return err;
358}
359
360#ifdef USE_IILOCALRING
361ring    *iiLocalRing;
362#endif
363sleftv  *iiRETURNEXPR;
364int     iiRETURNEXPR_len=0;
365
366#ifdef RDEBUG
367static void iiShowLevRings()
368{
369  int i;
370#ifdef USE_IILOCALRING
371  for (i=0;i<=myynest;i++)
372  {
373    Print("lev %d:",i);
374    if (iiLocalRing[i]==NULL) PrintS("NULL");
375    else                      Print("%lx",(long)iiLocalRing[i]);
376    PrintLn();
377  }
378#endif
379#if  0
380  i=myynest;
381  proclevel *p=procstack;
382  while (p!=NULL)
383  {
384    Print("lev %d:",i);
385    if (p->cRingHdl==NULL) PrintS("NULL");
386    else                   Print("%s",IDID(p->cRingHdl));
387    PrintLn();
388    p=p->next;
389  }
390#endif
391  if (currRing==NULL) PrintS("curr:NULL\n");
392  else                Print ("curr:%lx\n",(long)currRing);
393}
394#endif /* RDEBUG */
395
396static void iiCheckNest()
397{
398  if (myynest >= iiRETURNEXPR_len-1)
399  {
400    iiRETURNEXPR=(sleftv *)omreallocSize(iiRETURNEXPR,
401                                   iiRETURNEXPR_len*sizeof(sleftv),
402                                   (iiRETURNEXPR_len+16)*sizeof(sleftv));
403    omMarkAsStaticAddr(iiRETURNEXPR);
404    memset(&(iiRETURNEXPR[iiRETURNEXPR_len]),0,16*sizeof(sleftv));
405#ifdef USE_IILOCALRING
406    iiLocalRing=(ring *)omreallocSize(iiLocalRing,
407                                   iiRETURNEXPR_len*sizeof(ring),
408                                   (iiRETURNEXPR_len+16)*sizeof(ring));
409    memset(&(iiLocalRing[iiRETURNEXPR_len]),0,16*sizeof(ring));
410#endif
411    iiRETURNEXPR_len+=16;
412  }
413}
414sleftv * iiMake_proc(idhdl pn, package pack, sleftv* sl)
415{
416  int err;
417  procinfov pi = IDPROC(pn);
418  if(pi->is_static && myynest==0)
419  {
420    Werror("'%s::%s()' is a local procedure and cannot be accessed by an user.",
421           pi->libname, pi->procname);
422    return NULL;
423  }
424  iiCheckNest();
425#ifdef USE_IILOCALRING
426  iiLocalRing[myynest]=currRing;
427  //Print("currRing(%d):%s(%x) in %s\n",myynest,IDID(currRingHdl),currRing,IDID(pn));
428#endif
429  iiRETURNEXPR[myynest+1].Init();
430  procstack->push(pi->procname);
431  if ((traceit&TRACE_SHOW_PROC)
432  || (pi->trace_flag&TRACE_SHOW_PROC))
433  {
434    if (traceit&TRACE_SHOW_LINENO) PrintLn();
435    Print("entering%-*.*s %s (level %d)\n",myynest*2,myynest*2," ",IDID(pn),myynest);
436  }
437#ifdef RDEBUG
438  if (traceit&TRACE_SHOW_RINGS) iiShowLevRings();
439#endif
440  switch (pi->language)
441  {
442    default:
443    case LANG_NONE:
444                 WerrorS("undefined proc");
445                 err=TRUE;
446                 break;
447
448    case LANG_SINGULAR:
449                 if ((pi->pack!=NULL)&&(currPack!=pi->pack))
450                 {
451                   currPack=pi->pack;
452                   iiCheckPack(currPack);
453                   currPackHdl=packFindHdl(currPack);
454                   //Print("set pack=%s\n",IDID(currPackHdl));
455                 }
456                 else if ((pack!=NULL)&&(currPack!=pack))
457                 {
458                   currPack=pack;
459                   iiCheckPack(currPack);
460                   currPackHdl=packFindHdl(currPack);
461                   //Print("set pack=%s\n",IDID(currPackHdl));
462                 }
463                 err=iiPStart(pn,sl);
464                 break;
465    case LANG_C:
466                 leftv res = (leftv)omAlloc0Bin(sleftv_bin);
467                 err = (pi->data.o.function)(res, sl);
468                 iiRETURNEXPR[myynest+1].Copy(res);
469                 omFreeBin((ADDRESS)res,  sleftv_bin);
470                 break;
471  }
472  if ((traceit&TRACE_SHOW_PROC)
473  || (pi->trace_flag&TRACE_SHOW_PROC))
474  {
475    if (traceit&TRACE_SHOW_LINENO) PrintLn();
476    Print("leaving %-*.*s %s (level %d)\n",myynest*2,myynest*2," ",IDID(pn),myynest);
477  }
478  //char *n="NULL";
479  //if (currRingHdl!=NULL) n=IDID(currRingHdl);
480  //Print("currRing(%d):%s(%x) after %s\n",myynest,n,currRing,IDID(pn));
481#ifdef RDEBUG
482  if (traceit&TRACE_SHOW_RINGS) iiShowLevRings();
483#endif
484  if (err)
485  {
486    iiRETURNEXPR[myynest+1].CleanUp();
487    //iiRETURNEXPR[myynest+1].Init(); //done by CleanUp
488  }
489#ifdef USE_IILOCALRING
490#if 0
491  if(procstack->cRing != iiLocalRing[myynest]) Print("iiMake_proc: 1 ring not saved procs:%x, iiLocal:%x\n",procstack->cRing, iiLocalRing[myynest]);
492#endif
493  if (iiLocalRing[myynest] != currRing)
494  {
495    if (currRing!=NULL)
496    { 
497      if (((iiRETURNEXPR[myynest+1].Typ()>BEGIN_RING)
498        && (iiRETURNEXPR[myynest+1].Typ()<END_RING))
499      || ((iiRETURNEXPR[myynest+1].Typ()==LIST_CMD)
500        && (lRingDependend((lists)iiRETURNEXPR[myynest+1].Data()))))
501      {
502        //idhdl hn;
503        const char *n;
504        const char *o;
505        idhdl nh=NULL, oh=NULL;
506        if (iiLocalRing[myynest]!=NULL)
507          oh=rFindHdl(iiLocalRing[myynest],NULL, NULL);
508        if (oh!=NULL)          o=oh->id;
509        else                   o="none";
510        if (currRing!=NULL)
511          nh=rFindHdl(currRing,NULL, NULL);
512        if (nh!=NULL)          n=nh->id;
513        else                   n="none";
514        Werror("ring change during procedure call: %s -> %s (level %d)",o,n,myynest);
515        iiRETURNEXPR[myynest+1].CleanUp();
516        err=TRUE;
517      }
518    }
519    currRing=iiLocalRing[myynest];
520  }
521  if ((currRing==NULL)
522  && (currRingHdl!=NULL))
523    currRing=IDRING(currRingHdl);
524  else
525  if ((currRing!=NULL) &&
526    ((currRingHdl==NULL)||(IDRING(currRingHdl)!=currRing)
527     ||(IDLEV(currRingHdl)>=myynest)))
528  {
529    rSetHdl(rFindHdl(currRing,NULL, NULL));
530    iiLocalRing[myynest]=NULL;
531  }
532#else /* USE_IILOCALRING */
533  if (procstack->cRing != currRing)
534  {
535    //if (procstack->cRingHdl!=NULL)
536    //Print("procstack:%s,",IDID(procstack->cRingHdl));
537    //if (currRingHdl!=NULL)
538    //Print(" curr:%s\n",IDID(currRingHdl));
539    //Print("pr:%x, curr: %x\n",procstack->cRing,currRing);
540    if (((iiRETURNEXPR[myynest+1].Typ()>BEGIN_RING)
541      && (iiRETURNEXPR[myynest+1].Typ()<END_RING))
542    || ((iiRETURNEXPR[myynest+1].Typ()==LIST_CMD)
543      && (lRingDependend((lists)iiRETURNEXPR[myynest+1].Data()))))
544    {
545      //idhdl hn;
546      char *n;
547      char *o;
548      if (procstack->cRing!=NULL)
549      {
550        //PrintS("reset ring\n");
551        procstack->cRingHdl=rFindHdl(procstack->cRing,NULL, NULL);
552        if (procstack->cRingHdl==NULL)
553          procstack->cRingHdl=
554           rFindHdl(procstack->cRing,NULL,procstack->currPack->idroot);
555        if (procstack->cRingHdl==NULL)
556          procstack->cRingHdl=
557           rFindHdl(procstack->cRing,NULL,basePack->idroot);
558        o=IDID(procstack->cRingHdl);
559        currRing=procstack->cRing;
560        currRingHdl=procstack->cRingHdl;
561      }
562      else                            o="none";
563      if (currRing!=NULL)             n=IDID(currRingHdl);
564      else                            n="none";
565      if (currRing==NULL)
566      {
567        Werror("ring change during procedure call: %s -> %s",o,n);
568        iiRETURNEXPR[myynest+1].CleanUp();
569        err=TRUE;
570      }
571    }
572    if (procstack->cRingHdl!=NULL)
573    {
574      rSetHdl(procstack->cRingHdl);
575    }
576    else
577    { currRingHdl=NULL; currRing=NULL; }
578  }
579#endif /* USE_IILOCALRING */
580  if (iiCurrArgs!=NULL)
581  {
582    if (!err) Warn("too many arguments for %s",IDID(pn));
583    iiCurrArgs->CleanUp();
584    omFreeBin((ADDRESS)iiCurrArgs, sleftv_bin);
585    iiCurrArgs=NULL;
586  }
587  procstack->pop();
588  if (err)
589    return NULL;
590  return &iiRETURNEXPR[myynest+1];
591}
592
593/*2
594* start an example (as a proc),
595* destroys the string 'example'
596*/
597BOOLEAN iiEStart(char* example, procinfo *pi)
598{
599  BOOLEAN err;
600  int old_echo=si_echo;
601
602  newBuffer( example, BT_example, pi,
603             (pi != NULL ? pi->data.s.example_lineno: 0));
604
605  iiCheckNest();
606  procstack->push(example);
607#ifdef USE_IILOCALRING
608  iiLocalRing[myynest]=currRing;
609#endif
610  if (traceit&TRACE_SHOW_PROC)
611  {
612    if (traceit&TRACE_SHOW_LINENO) printf("\n");
613    printf("entering example (level %d)\n",myynest);
614  }
615  myynest++;
616  iiRETURNEXPR[myynest].Init();
617  err=yyparse();
618  if (sLastPrinted.rtyp!=0)
619  {
620    sLastPrinted.CleanUp();
621    //memset(&sLastPrinted,0,sizeof(sleftv)); //done by CleanUp
622  }
623  killlocals(myynest);
624  myynest--;
625  si_echo=old_echo;
626  if (traceit&TRACE_SHOW_PROC)
627  {
628    if (traceit&TRACE_SHOW_LINENO) printf("\n");
629    printf("leaving  -example- (level %d)\n",myynest);
630  }
631#ifdef USE_IILOCALRING
632  if (iiLocalRing[myynest] != currRing)
633  {
634    if (iiLocalRing[myynest]!=NULL)
635    {
636      rSetHdl(rFindHdl(iiLocalRing[myynest],NULL, NULL));
637      iiLocalRing[myynest]=NULL;
638    }
639    else
640    {
641      currRingHdl=NULL;
642      currRing=NULL;
643    }
644  }
645#else /* USE_IILOCALRING */
646#endif /* USE_IILOCALRING */
647  if (NS_LRING != currRing)
648  {
649    if (NS_LRING!=NULL)
650    {
651      idhdl rh=procstack->cRingHdl;
652      if ((rh==NULL)||(IDRING(rh)!=NS_LRING))
653        rh=rFindHdl(NS_LRING,NULL, NULL);
654      rSetHdl(rh);
655    }
656    else
657    {
658      currRingHdl=NULL;
659      currRing=NULL;
660    }
661  }
662//#endif /* USE_IILOCALRING */
663  procstack->pop();
664  return err;
665}
666
667/*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
668BOOLEAN iiTryLoadLib(leftv v, const char *id)
669{
670  BOOLEAN LoadResult = TRUE;
671  char libnamebuf[128];
672  char *libname = (char *)omAlloc(strlen(id)+5);
673  const char *suffix[] = { "", ".lib", ".so", ".sl", NULL };
674  int i = 0;
675  FILE *fp;
676  package pack;
677  idhdl packhdl;
678  lib_types LT;
679
680  for(i=0; suffix[i] != NULL; i++)
681  {
682    sprintf(libname, "%s%s", id, suffix[i]);
683    *libname = mytolower(*libname);
684    if((LT = type_of_LIB(libname, libnamebuf)) > LT_NOTFOUND)
685    {
686      char *s=omStrDup(libname);
687      char libnamebuf[256];
688
689      if (LT==LT_SINGULAR)
690        LoadResult = iiLibCmd(s, FALSE, FALSE,TRUE);
691      #ifdef HAVE_DYNAMIC_LOADING
692      else if ((LT==LT_ELF) || (LT==LT_HPUX))
693        LoadResult = load_modules(s,libnamebuf,FALSE);
694      #endif
695      if(!LoadResult )
696      {
697        v->name = iiConvName(libname);
698        break;
699      }
700    }
701  }
702  omFree(libname);
703  return LoadResult;
704}
705
706/*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
707/* check, if library lib has already been loaded
708   if yes, writes filename of lib into where and returns TRUE,
709      no, returns FALSE
710*/
711BOOLEAN iiLocateLib(const char* lib, char* where)
712{
713  idhdl hl;
714
715  char *p;
716
717  hl = IDROOT->get("LIB", 0);
718  if (hl == NULL || (p=strstr(IDSTRING(hl), lib)) == NULL) return FALSE;
719  if ((p!=IDSTRING(hl)) && (*(p-1)!=',')) return FALSE;
720
721  if (strstr(IDSTRING(hl), ",") == NULL)
722  {
723    strcpy(where, IDSTRING(hl));
724  }
725  else
726  {
727    char* tmp = omStrDup(IDSTRING(hl));
728    char* tok = strtok(tmp, ",");
729    do
730    {
731      if (strstr(tok, lib) != NULL) break;
732      tok = strtok(NULL, ",");
733    }
734    while (tok != NULL);
735    assume(tok != NULL);
736    strcpy(where, tok);
737    omFree(tmp);
738  }
739  return TRUE;
740}
741
742BOOLEAN iiLibCmd( char *newlib, BOOLEAN autoexport, BOOLEAN tellerror, BOOLEAN force )
743{
744  char buf[256];
745  char libnamebuf[128];
746  idhdl h;
747  BOOLEAN LoadResult = TRUE;
748  idhdl pl;
749  idhdl hl;
750  int lines = 1;
751  long pos = 0L;
752  procinfov pi;
753  char *plib = iiConvName(newlib);
754  FILE * fp = feFopen( newlib, "r", libnamebuf, tellerror );
755  if (fp==NULL)
756  {
757    return TRUE;
758  }
759#ifdef HAVE_TCL
760  if (tclmode)
761  {
762    PrintTCLS('L',newlib);
763  }
764#endif
765  pl = basePack->idroot->get(plib,0);
766  if (pl==NULL)
767  {
768    pl = enterid( plib,0, PACKAGE_CMD,
769                  &(basePack->idroot), TRUE );
770    IDPACKAGE(pl)->language = LANG_SINGULAR;
771    IDPACKAGE(pl)->libname=omStrDup(newlib);
772  }
773  else
774  {
775    if(IDTYP(pl)!=PACKAGE_CMD)
776    {
777      WarnS("not of type package.");
778      fclose(fp);
779      return TRUE;
780    }
781    if (!force) return FALSE;
782  }
783  LoadResult = iiLoadLIB(fp, libnamebuf, newlib, pl, autoexport, tellerror);
784  omFree((ADDRESS)newlib);
785
786  if(!LoadResult) IDPACKAGE(pl)->loaded = TRUE;
787  omFree((ADDRESS)plib);
788
789 return LoadResult;
790}
791/*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
792static void iiCleanProcs(idhdl &root)
793{
794  idhdl prev=NULL;
795  loop
796  {
797    if (root==NULL) return;
798    if (IDTYP(root)==PROC_CMD)
799    {
800      procinfo *pi=(procinfo*)IDDATA(root);
801      if ((pi->language == LANG_SINGULAR)
802      && (pi->data.s.body_start == 0L))
803      {
804        // procinfo data incorrect:
805        // - no proc body can start at the beginning of the file
806        killhdl(root);
807        if (prev==NULL)
808          root=IDROOT;
809        else
810        {
811          root=prev;
812          prev=NULL;
813        }
814        continue;
815      }
816    }
817    prev=root;
818    root=IDNEXT(root);
819  }
820}
821/*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
822BOOLEAN iiLoadLIB(FILE *fp, char *libnamebuf, char*newlib,
823             idhdl pl, BOOLEAN autoexport, BOOLEAN tellerror)
824{
825  char buf[256];
826  extern FILE *yylpin;
827  libstackv ls_start = library_stack;
828  lib_style_types lib_style;
829
830  yylpin = fp;
831  #if YYLPDEBUG > 1
832  print_init();
833  #endif
834  extern int lpverbose;
835  if (BVERBOSE(V_DEBUG_LIB)) lpverbose=1;
836  else lpverbose=0;
837  yylplex(newlib, libnamebuf, &lib_style, pl, autoexport);
838  if(yylp_errno)
839  {
840    Werror("Library %s: ERROR occured: in line %d, %d.", newlib, yylplineno,
841         current_pos(0));
842    if(yylp_errno==YYLP_BAD_CHAR)
843    {
844      Werror(yylp_errlist[yylp_errno], *text_buffer, yylplineno);
845      omFree((ADDRESS)text_buffer);
846      text_buffer=NULL;
847    }
848    else
849      Werror(yylp_errlist[yylp_errno], yylplineno);
850    Werror("Cannot load library,... aborting.");
851    reinit_yylp();
852    fclose( yylpin );
853    iiCleanProcs(IDROOT);
854    return TRUE;
855  }
856  if (BVERBOSE(V_LOAD_LIB))
857    Print( "// ** loaded %s %s\n", libnamebuf, text_buffer);
858  if( (lib_style == OLD_LIBSTYLE) && (BVERBOSE(V_LOAD_LIB)))
859  {
860    Warn( "library %s has old format. This format is still accepted,", newlib);
861    Warn( "but for functionality you may wish to change to the new");
862    Warn( "format. Please refer to the manual for further information.");
863  }
864  reinit_yylp();
865  fclose( yylpin );
866  fp = NULL;
867
868  {
869    libstackv ls;
870    for(ls = library_stack; (ls != NULL) && (ls != ls_start); )
871    {
872      if(ls->to_be_done)
873      {
874        ls->to_be_done=FALSE;
875        iiLibCmd(ls->get(),autoexport,tellerror,FALSE);
876        ls = ls->pop(newlib);
877      }
878    }
879#if 0
880    PrintS("--------------------\n");
881    for(ls = library_stack; ls != NULL; ls = ls->next)
882    {
883      Print("%s: LIB-stack:(%d), %s %s\n", newlib, ls->cnt, ls->get(),
884        ls->to_be_done ? "not loaded" : "loaded");
885    }
886    PrintS("--------------------\n");
887#endif
888  }
889
890  if(fp != NULL) fclose(fp);
891  return FALSE;
892}
893
894
895/*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
896procinfo *iiInitSingularProcinfo(procinfov pi, const char *libname,
897              const char *procname, int line, long pos, BOOLEAN pstatic)
898{
899  pi->libname = omStrDup(libname);
900
901  if( strcmp(procname,"_init")==0)
902  {
903    pi->procname = iiConvName(libname);
904  }
905  else
906    pi->procname = omStrDup(procname);
907  pi->language = LANG_SINGULAR;
908  pi->ref = 1;
909  pi->pack = NULL;
910  pi->is_static = pstatic;
911  pi->data.s.proc_start = pos;
912  pi->data.s.def_end    = 0L;
913  pi->data.s.help_start = 0L;
914  pi->data.s.help_end   = 0L;
915  pi->data.s.body_start = 0L;
916  pi->data.s.body_end   = 0L;
917  pi->data.s.example_start = 0L;
918  pi->data.s.proc_lineno = line;
919  pi->data.s.body_lineno = 0;
920  pi->data.s.example_lineno = 0;
921  pi->data.s.body = NULL;
922  pi->data.s.help_chksum = 0;
923  return(pi);
924}
925
926#ifdef HAVE_DYNAMIC_LOADING
927/*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
928int iiAddCproc(char *libname, char *procname, BOOLEAN pstatic,
929               BOOLEAN(*func)(leftv res, leftv v))
930{
931  procinfov pi;
932  idhdl h;
933
934  h = enterid(procname,0, PROC_CMD, &IDROOT, TRUE);
935  if ( h!= NULL )
936  {
937    pi = IDPROC(h);
938    pi->libname = omStrDup(libname);
939    pi->procname = omStrDup(procname);
940    pi->language = LANG_C;
941    pi->ref = 1;
942    pi->is_static = pstatic;
943    pi->data.o.function = func;
944    return(1);
945  }
946  else
947  {
948    PrintS("iiAddCproc: failed.\n");
949  }
950  return(0);
951}
952
953int iiAddCprocTop(char *libname, char *procname, BOOLEAN pstatic,
954               BOOLEAN(*func)(leftv res, leftv v))
955{
956  int r=iiAddCproc(libname,procname,pstatic,func);
957  package s=currPack;
958  currPack=basePack;
959  if (r) r=iiAddCproc(libname,procname,pstatic,func);
960  currPack=s;
961  return r;
962}
963
964/*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
965BOOLEAN load_modules(char *newlib, char *fullname, BOOLEAN autoexport)
966{
967#ifdef HAVE_STATIC
968  WerrorS("mod_init: static version can not load modules");
969  return TRUE;
970#else
971  int iiAddCproc(char *libname, char *procname, BOOLEAN pstatic,
972                 BOOLEAN(*func)(leftv res, leftv v));
973  typedef int (*fktn_t)(int(*iiAddCproc)(char *libname, char *procname,
974                               BOOLEAN pstatic,
975                               BOOLEAN(*func)(leftv res, leftv v)));
976  typedef int (*fktn2_t)(SModulFunctions*);
977  fktn2_t fktn;
978  idhdl pl;
979  char *plib = iiConvName(newlib);
980  BOOLEAN RET=TRUE;
981  int token;
982  char FullName[256];
983
984  memset(FullName,0,256);
985
986  if( *fullname != '/' &&  *fullname != '.' )
987    sprintf(FullName, "./%s", newlib);
988  else strncpy(FullName, fullname,255);
989
990
991  if(IsCmd(plib, token))
992  {
993    Werror("'%s' is resered identifier\n", plib);
994    goto load_modules_end;
995  }
996  pl = IDROOT->get(plib,0);
997  if (pl==NULL)
998  {
999    pl = enterid( plib,0, PACKAGE_CMD, &IDROOT,
1000                  TRUE );
1001    IDPACKAGE(pl)->language = LANG_C;
1002    IDPACKAGE(pl)->libname=omStrDup(newlib);
1003  }
1004  else
1005  {
1006    if(IDTYP(pl)!=PACKAGE_CMD)
1007    {
1008      Warn("not of type package.");
1009      goto load_modules_end;
1010    }
1011  }
1012  if((IDPACKAGE(pl)->handle=dynl_open(FullName))==(void *)NULL)
1013  {
1014    Werror("dynl_open failed:%s", dynl_error());
1015    Werror("%s not found", newlib);
1016    goto load_modules_end;
1017  }
1018  else
1019  {
1020    SModulFunctions sModulFunctions;
1021   
1022    package s=currPack;
1023    currPack=IDPACKAGE(pl);
1024    fktn = (fktn2_t)dynl_sym(IDPACKAGE(pl)->handle, "mod_init");
1025    if( fktn!= NULL)
1026    {
1027      sModulFunctions.iiArithAddCmd = iiArithAddCmd;
1028      if (autoexport) sModulFunctions.iiAddCproc = iiAddCprocTop;
1029      else            sModulFunctions.iiAddCproc = iiAddCproc;
1030      (*fktn)(&sModulFunctions);
1031    }
1032    else Werror("mod_init: %s\n", dynl_error());
1033    if (BVERBOSE(V_LOAD_LIB)) Print( "// ** loaded %s \n", fullname);
1034    currPack->loaded=1;
1035    currPack=s;
1036  }
1037  RET=FALSE;
1038
1039  load_modules_end:
1040  return RET;
1041#endif /*STATIC */ 
1042}
1043#endif /* HAVE_DYNAMIC_LOADING */
1044
1045/*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
1046char mytoupper(char c)
1047{
1048  if(c>=97 && c<=(97+26)) c-=32;
1049  return(c);
1050}
1051
1052char mytolower(char c)
1053{
1054  if(c>=65 && c<=(65+26)) c+=32;
1055  return(c);
1056}
1057
1058/*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
1059//#if defined(WINNT)
1060//#  define  FS_SEP '\\'
1061//#else
1062//#  define FS_SEP '/'
1063//#endif
1064
1065char *iiConvName(const char *libname)
1066{
1067  char *tmpname = omStrDup(libname);
1068  char *p = strrchr(tmpname, DIR_SEP);
1069  char *r;
1070  if(p==NULL) p = tmpname;
1071  else p++;
1072  r = (char *)strchr(p, '.');
1073  if( r!= NULL) *r = '\0';
1074  r = omStrDup(p);
1075  *r = mytoupper(*r);
1076  // printf("iiConvName: '%s' '%s' => '%s'\n", libname, tmpname, r);
1077  omFree((ADDRESS)tmpname);
1078
1079  return(r);
1080}
1081
1082/*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
1083void piShowProcList()
1084{
1085  idhdl h;
1086  procinfo *proc;
1087  char *name;
1088
1089  Print( "%-15s  %20s      %s,%s  %s,%s   %s,%s\n", "Library", "function",
1090         "line", "start", "line", "body", "line", "example");
1091  for(h = IDROOT; h != NULL; h = IDNEXT(h))
1092  {
1093    if(IDTYP(h) == PROC_CMD)
1094    {
1095      proc = IDPROC(h);
1096      if(strcmp(proc->procname, IDID(h))!=0)
1097      {
1098        name = (char *)omAlloc(strlen(IDID(h))+strlen(proc->procname)+4);
1099        sprintf(name, "%s -> %s", IDID(h), proc->procname);
1100        Print( "%d %-15s  %20s ", proc->is_static ? 1 : 0, proc->libname, name);
1101        omFree((ADDRESS)name);
1102      }
1103      else
1104        Print( "%d %-15s  %20s ", proc->is_static ? 1 : 0, proc->libname,
1105               proc->procname);
1106      if(proc->language==LANG_SINGULAR)
1107        Print("line %4d,%-5ld  %4d,%-5ld  %4d,%-5ld\n",
1108              proc->data.s.proc_lineno, proc->data.s.proc_start,
1109              proc->data.s.body_lineno, proc->data.s.body_start,
1110              proc->data.s.example_lineno, proc->data.s.example_start);
1111      else if(proc->language==LANG_C)
1112        Print("type: object\n");
1113    }
1114  }
1115}
1116
1117/*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
1118//char *iiLineNo(char *procname, int lineno)
1119//{
1120//  char buf[256];
1121//  idhdl pn = ggetid(procname);
1122//  procinfo *pi = IDPROC(pn);
1123//
1124//  sprintf(buf, "%s %3d\0", procname, lineno);
1125//  //sprintf(buf, "%s::%s %3d\0", pi->libname, pi->procname,
1126//  //  lineno + pi->data.s.body_lineno);
1127//  return(buf);
1128//}
1129/*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
1130#ifdef HAVE_LIBPARSER
1131void libstack::push(char *p, char *libname)
1132{
1133  libstackv lp;
1134  if( !iiGetLibStatus(libname))
1135  {
1136    for(lp = this;lp!=NULL;lp=lp->next)
1137    {
1138      if(strcmp(lp->get(), libname)==0) break;
1139    }
1140    if(lp==NULL)
1141    {
1142      libstackv ls = (libstack *)omAlloc0Bin(libstack_bin);
1143      ls->next = this;
1144      ls->libname = omStrDup(libname);
1145      ls->to_be_done = TRUE;
1146      if(this != NULL) ls->cnt = this->cnt+1; else ls->cnt = 0;
1147      library_stack = ls;
1148    }
1149  }
1150}
1151
1152libstackv libstack::pop(char *p)
1153{
1154  libstackv ls = this;
1155  //omFree((ADDRESS)ls->libname);
1156  library_stack = ls->next;
1157  omFreeBin((ADDRESS)ls,  libstack_bin);
1158  return(library_stack);
1159}
1160
1161#endif /* HAVE_LIBPARSER */
1162/*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
Note: See TracBrowser for help on using the repository browser.