source: git/Singular/iplib.cc @ c3b42b

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