source: git/Singular/iplib.cc @ 954cf2

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