source: git/Singular/iplib.cc @ 5c5638

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