source: git/Singular/iplib.cc @ 5317c2

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