source: git/Singular/iplib.cc @ 634dab0

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