source: git/Singular/iplib.cc @ 6be769

spielwiese
Last change on this file since 6be769 was 6be769, checked in by Kai Krüger <krueger@…>, 26 years ago
Changes for help-section of procedures git-svn-id: file:///usr/local/Singular/svn/trunk@1672 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 22.3 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: iplib.cc,v 1.24 1998-05-09 14:34:29 krueger 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
14#include "mod2.h"
15#include "tok.h"
16#include "ipid.h"
17#include "mmemory.h"
18#include "febase.h"
19#include "ring.h"
20#include "subexpr.h"
21#include "ipshell.h"
22#include "lists.h"
23#ifdef HAVE_LIBPARSER
24#  include "libparse.h"
25#else /* HAVE_LIBPARSER */
26   procinfo *iiInitSingularProcinfo(procinfov pi, char *libname,
27                                    char *procname, int line, long pos,
28                                    BOOLEAN pstatic = FALSE);
29#endif /* HAVE_LIBPARSER */
30
31char *iiConvName(char *p);
32#ifdef HAVE_LIBPARSER
33void yylprestart (FILE *input_file );
34int current_pos(int i=0);
35extern int yylp_errno;
36extern int yylplineno;
37extern char *yylp_errlist[];
38void print_init();
39libstackv library_stack;
40#endif
41
42/*2
43* find the library of an proc:
44*  => return (pi->libname)
45*/
46char * iiGetLibName(procinfov pi)
47{
48  char *res=NULL;
49
50  res = pi->libname;
51  return res;
52}
53/*2
54* given a line 'proc[ ]+{name}[ \t]*'
55* return a pointer to name and set the end of '\0'
56* changes the input!
57* returns: e: pointer to 'end of name'
58*          ct: changed char at the end of s
59*/
60char* iiProcName(char *buf, char & ct, char* &e)
61{
62  char *s=buf+5;
63  while (*s==' ') s++;
64  e=s+1;
65  while ((*e>' ') && (*e!='(')) e++;
66  ct=*e;
67  *e='\0';
68  return s;
69}
70
71/*2
72* given a line with args, return the argstr
73*/
74char * iiProcArgs(char *e,BOOLEAN withParenth)
75{
76  while ((*e==' ') || (*e=='\t') || (*e=='(')) e++;
77  if (*e<' ')
78  {
79    if (withParenth)
80    {
81      // no argument list, allow list #
82      return mstrdup("parameter list #;");
83    }
84    else
85    {
86      // empty list
87      return mstrdup("");
88    }
89  }
90  BOOLEAN in_args;
91  BOOLEAN args_found;
92  char *s;
93  char *argstr=(char *)AllocL(200);
94  *argstr='\0';
95  do
96  {
97    args_found=FALSE;
98    s=e; // set s to the starting point of the arg
99         // and search for the end
100    while ((*e!=',')&&(*e!=')')&&(*e!='\0'))
101    {
102      args_found=args_found || (*e>' ');
103      e++;
104    }
105    in_args=(*e==',');
106    if (args_found)
107    {
108      *e='\0';
109      // copy the result to argstr
110      strcat(argstr,"parameter ");
111      strcat(argstr,s);
112      strcat(argstr,"; ");
113      e++; // e was pointing to ','
114    }
115  } while (in_args);
116  return argstr;
117}
118
119/*2
120* locate `procname` in lib `libname` and find the part `part`:
121*  part=0: help, between, but excluding the line "proc ..." and "{...":
122*    => return
123*  part=1: body, between "{ ..." and "}", including the 1. line, w/o "{"
124*    => set pi->data.s.body, return NULL
125*  part=2: example, between, but excluding the line "exapmle {..." and "}":
126*    => return
127*/
128char* iiGetLibProcBuffer(procinfo *pi, int part )
129{
130  char buf[256], *s = NULL, *p;
131  long procbuflen;
132
133  FILE * fp = feFopen( pi->libname, "rb", NULL, TRUE );
134  if (fp==NULL)
135  {
136    return NULL;
137  }
138
139  fseek(fp, pi->data.s.proc_start, SEEK_SET);
140  if(part==0)
141  { // load help string
142    long head = pi->data.s.def_end - pi->data.s.proc_start;
143    procbuflen = pi->data.s.help_end - pi->data.s.help_start;
144    //Print("Help=%ld-%ld=%d\n", pi->data.s.body_start,
145    //    pi->data.s.proc_start, procbuflen);
146    s = (char *)AllocL(procbuflen+head+2);
147    myfread(s, head, 1, fp);
148    s[head] = '\n';
149    fseek(fp, pi->data.s.help_start, SEEK_SET);
150    myfread(s+head+1, procbuflen, 1, fp);
151    s[procbuflen+head+1] = '\n';
152    s[procbuflen+head+2] = '\0';
153    return(s);
154  }
155  if(part==1)
156  { // load proc part
157    procbuflen = pi->data.s.def_end - pi->data.s.proc_start;
158    //fgets(buf, sizeof(buf), fp);
159    myfread( buf, procbuflen, 1, fp);
160    char ct;
161    char *e;
162    s=iiProcName(buf,ct,e);
163    char *argstr=NULL;
164    *e=ct;
165    argstr=iiProcArgs(e,TRUE);
166    procbuflen = pi->data.s.body_end - pi->data.s.body_start;
167    pi->data.s.body = (char *)AllocL( strlen(argstr)+procbuflen+15+
168                                      strlen(pi->libname) );
169    //Print("Body=%ld-%ld=%d\n", pi->data.s.body_end,
170    //    pi->data.s.body_start, procbuflen);
171    if (pi->data.s.body==NULL)
172    {
173      Werror( "unable to allocate proc buffer `%s`", pi->procname );
174      return NULL;
175    }
176    fseek(fp, pi->data.s.body_start, SEEK_SET);
177    strcpy(pi->data.s.body,argstr);
178    myfread( pi->data.s.body+strlen(argstr), procbuflen, 1, fp);
179    procbuflen+=strlen(argstr);
180    FreeL(argstr);
181    fclose( fp );
182    pi->data.s.body[procbuflen] = '\0';
183    strcat( pi->data.s.body+procbuflen, "\n;return();\n\n" );
184    strcat( pi->data.s.body+procbuflen+13,pi->libname);
185    s=strchr(pi->data.s.body,'{');
186    if (s!=NULL) *s=' ';
187    return NULL;
188  }
189  if(part==2)
190  { // load example
191    fseek(fp, pi->data.s.example_start, SEEK_SET);
192    fgets(buf, sizeof(buf), fp);
193    procbuflen = pi->data.s.proc_end - pi->data.s.example_start - strlen(buf);
194    //Print("Example=%ld-%ld=%d\n", pi->data.s.proc_end,
195    //  pi->data.s.example_start, procbuflen);
196    s = (char *)AllocL(procbuflen+14);
197    myfread(s, procbuflen, 1, fp);
198    s[procbuflen] = '\0';
199    strcat(s+procbuflen-3, "\n;return();\n\n" );
200    p=strchr(s,'{');
201    if (p!=NULL) *p=' ';
202    return(s);
203  }
204  return NULL;
205}
206
207/*2
208* start a proc
209* parameters are built as exprlist
210* TODO:interrupt
211* return FALSE on success, TRUE if an error occurs
212*/
213BOOLEAN iiPStart(idhdl pn, sleftv  * v)
214{
215  char * str;
216  BOOLEAN err=FALSE;
217  int old_echo=si_echo;
218
219  /* init febase ======================================== */
220  /* we do not enter this case if filename != NULL !! */
221  if (pn!=NULL)
222  {
223    procinfov pi;
224    pi = IDPROC(pn);
225    if(pi!=NULL)
226    {
227      if( pi->data.s.body==NULL )
228      {
229        iiGetLibProcBuffer(IDPROC(pn));
230        if (IDPROC(pn)->data.s.body==NULL) return TRUE;
231      }
232      newBuffer( mstrdup(IDPROC(pn)->data.s.body), BT_proc,
233                 pi, IDPROC(pn)->data.s.body_lineno );
234    }
235    //else
236    //{ // for security only
237    //  newBuffer( mstrdup(IDSTRING(pn)), BT_proc, IDID(pn) );
238    //}
239  }
240  /* generate argument list ======================================*/
241  if (v!=NULL)
242  {
243    iiCurrArgs=(leftv)Alloc(sizeof(sleftv));
244    memcpy(iiCurrArgs,v,sizeof(sleftv));
245    memset(v,0,sizeof(sleftv));
246  }
247  else
248  {
249    iiCurrArgs=NULL;
250  }
251  /* start interpreter ======================================*/
252  myynest++;
253  //Print("%-*.*s PStart <<%s>>, level:%d\n",2*myynest,2*myynest," ",IDID(pn),myynest);
254  err=yyparse();
255  killlocals(myynest);
256  myynest--;
257  si_echo=old_echo;
258  //Print("%-*.*s PEnd  <<%s>>, level:%d\n",2*myynest,2*myynest," ",IDID(pn),myynest);
259
260  return err;
261}
262
263ring    *iiLocalRing
264#ifdef TEST
265                    =NULL
266#endif
267                   ;
268sleftv  *iiRETURNEXPR
269#ifdef TEST
270                    =NULL
271#endif
272                   ;
273int     iiRETURNEXPR_len=0;
274
275#ifdef RDEBUG
276static void iiShowLevRings()
277{
278  int i;
279  for (i=1;i<=myynest;i++)
280  {
281    Print("lev %d:",i);
282    if (iiLocalRing[i]==NULL) PrintS("NULL");
283    else                      Print("%d",iiLocalRing[i]);
284    Print("\n");
285  }
286  if (currRing==NULL) PrintS("curr:NULL\n");
287  else                Print ("curr:%d\n",currRing->no);
288}
289#endif
290
291static void iiCheckNest()
292{
293  if (myynest >= iiRETURNEXPR_len-1)
294  {
295    iiRETURNEXPR=(sleftv *)ReAlloc(iiRETURNEXPR,
296                                   iiRETURNEXPR_len*sizeof(sleftv),
297                                   (iiRETURNEXPR_len+16)*sizeof(sleftv));
298    iiLocalRing=(ring *)ReAlloc(iiLocalRing,
299                                   iiRETURNEXPR_len*sizeof(ring),
300                                   (iiRETURNEXPR_len+16)*sizeof(ring));
301    iiRETURNEXPR_len+=16;
302  }
303}
304sleftv * iiMake_proc(idhdl pn, sleftv* sl)
305{
306  int err;
307  procinfov pi = IDPROC(pn);
308  if(pi->is_static && myynest==0) {
309    Werror("'%s::%s()' is a local procedure and cannot be accessed by an user.",
310           pi->libname, pi->procname);
311    return NULL;
312  }
313  iiCheckNest();
314  iiLocalRing[myynest]=currRing;
315  iiRETURNEXPR[myynest+1].Init();
316  if (traceit&TRACE_SHOW_PROC)
317  {
318    if (traceit&TRACE_SHOW_LINENO) PrintLn();
319    Print("entering%-*.*s %s (level %d)\n",myynest*2,myynest*2," ",IDID(pn),myynest);
320  }
321#ifdef RDEBUG
322  if (traceit&TRACE_SHOW_RINGS) iiShowLevRings();
323#endif
324#if 1
325  if(pi->language == LANG_SINGULAR) err=iiPStart(pn,sl);
326  if(pi->language == LANG_C)
327  {
328    leftv res = (leftv)Alloc0(sizeof(sleftv));
329    res->rtyp=NONE;
330    err = (pi->data.o.function)(res, sl);
331    iiRETURNEXPR[myynest+1].Copy(res);
332    Free((ADDRESS)res, sizeof(sleftv));
333  }
334#else
335  switch (pi->language)
336  {
337    case LANG_SINGULAR: err=iiPStart(pn,sl); break;
338    case LANG_C: leftv res = (leftv)Alloc0(sizeof(sleftv));
339      err = (pi->data.o.function)(res, sl);
340      iiRETURNEXPR[myynest+1].Copy(res);
341      Free((ADDRESS)res, sizeof(sleftv));
342      break;
343    default: err=TRUE;
344  }
345#endif
346  if (traceit&TRACE_SHOW_PROC)
347  {
348    if (traceit&TRACE_SHOW_LINENO) PrintLn();
349    Print("leaving %-*.*s %s (level %d)\n",myynest*2,myynest*2," ",IDID(pn),myynest);
350  }
351#ifdef RDEBUG
352  if (traceit&TRACE_SHOW_RINGS) iiShowLevRings();
353#endif
354  if (err)
355  {
356    iiRETURNEXPR[myynest+1].CleanUp();
357    iiRETURNEXPR[myynest+1].Init();
358  }
359  if (iiLocalRing[myynest] != currRing)
360  {
361    if (((iiRETURNEXPR[myynest+1].Typ()>BEGIN_RING)
362      && (iiRETURNEXPR[myynest+1].Typ()<END_RING))
363    || ((iiRETURNEXPR[myynest+1].Typ()==LIST_CMD)
364      && (lRingDependend((lists)iiRETURNEXPR[myynest+1].Data()))))
365    {
366      //idhdl hn;
367      char *n;
368      char *o;
369      if (iiLocalRing[myynest]!=NULL) o=rFindHdl(iiLocalRing[myynest],NULL)->id;
370      else                            o="none";
371      if (currRing!=NULL)             n=rFindHdl(currRing,NULL)->id;
372      else                            n="none";
373      Werror("ring change during procedure call: %s -> %s",o,n);
374      iiRETURNEXPR[myynest+1].CleanUp();
375      err=TRUE;
376    }
377    if (iiLocalRing[myynest]!=NULL)
378    {
379      rSetHdl(rFindHdl(iiLocalRing[myynest],NULL),TRUE);
380      iiLocalRing[myynest]=NULL;
381    }
382    else
383    { currRingHdl=NULL; currRing=NULL; }
384  }
385  if (iiCurrArgs!=NULL)
386  {
387    Warn("too many arguments for %s",IDID(pn));
388    iiCurrArgs->CleanUp();
389    Free((ADDRESS)iiCurrArgs,sizeof(sleftv));
390    iiCurrArgs=NULL;
391  }
392  if (err) return NULL;
393  return &iiRETURNEXPR[myynest+1];
394}
395
396/*2
397* start an example (as a proc),
398* destroys the string 'example'
399*/
400BOOLEAN iiEStart(char* example, procinfo *pi)
401{
402  BOOLEAN err;
403  int old_echo=si_echo;
404
405  newBuffer( example, BT_example, pi, pi->data.s.example_lineno );
406  iiCheckNest();
407  iiLocalRing[myynest]=currRing;
408  if (traceit&TRACE_SHOW_PROC)
409  {
410    if (traceit&TRACE_SHOW_LINENO) printf("\n");
411    printf("entering example (level %d)\n",myynest);
412  }
413  myynest++;
414  err=yyparse();
415  killlocals(myynest);
416  myynest--;
417  si_echo=old_echo;
418  if (traceit&TRACE_SHOW_PROC)
419  {
420    if (traceit&TRACE_SHOW_LINENO) printf("\n");
421    printf("leaving  -example- (level %d)\n",myynest);
422  }
423  if (iiLocalRing[myynest] != currRing)
424  {
425    if (iiLocalRing[myynest]!=NULL)
426    {
427      rSetHdl(rFindHdl(iiLocalRing[myynest],NULL),TRUE);
428      iiLocalRing[myynest]=NULL;
429    }
430    else
431    {
432      currRingHdl=NULL;
433      currRing=NULL;
434    }
435  }
436  return err;
437}
438
439/*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
440BOOLEAN iiLibCmd( char *newlib, BOOLEAN tellerror )
441{
442  char buf[256];
443  char libnamebuf[128];
444  idhdl h,hl;
445  int lines = 1;
446  long pos = 0L;
447  procinfov pi;
448  FILE * fp = feFopen( newlib, "r", libnamebuf, tellerror );
449  if (fp==NULL)
450  {
451    return TRUE;
452  }
453  hl = idroot->get("LIB",0);
454  if (hl==NULL)
455  {
456    hl = enterid( mstrdup("LIB"),0, STRING_CMD, &idroot, FALSE );
457    IDSTRING(hl) = mstrdup(newlib);
458  }
459  else
460  {
461#ifdef TEST
462    if (IDSTRING(hl) != NULL)
463#endif
464    {
465      char *s = (char *)AllocL( strlen(newlib) + strlen(IDSTRING(hl)) + 2 );
466      strcpy(s,IDSTRING(hl));
467      BOOLEAN f=FALSE;
468      if(strchr(s,',')==NULL)
469      {
470        if (strcmp(s,newlib)==0)
471          f=TRUE;
472      }
473      else
474      {
475        char *p=strtok(s,",");
476        do
477        {
478          if(strcmp(p,newlib)==0)
479          {
480            f=TRUE;
481            break;
482          }
483          p=strtok(NULL,",");
484        } while (p!=NULL);
485      }
486      if (f)
487        FreeL(s);
488      else
489      {
490        sprintf( s, "%s,%s", IDSTRING(hl), newlib);
491        FreeL((ADDRESS)IDSTRING(hl));
492        IDSTRING(hl) = s;
493      }
494    }
495#ifdef TEST
496    else
497    {
498      PrintS("## empty LIB string\n");
499      IDSTRING(hl) = mstrdup(newlib);
500    }
501#endif
502  }
503
504#ifdef HAVE_LIBPARSER
505  extern FILE *yylpin;
506  libstackv ls_start = library_stack;
507  lib_style_types lib_style;
508
509  yylpin = fp;
510# if YYLPDEBUG > 1
511  print_init();
512#  endif
513//  if (BVERBOSE(V_LOAD_LIB)) Print( "// ** loading %s...", libnamebuf);
514  extern int lpverbose;
515  if (BVERBOSE(V_DEBUG_LIB)) lpverbose=1; else lpverbose=0;
516  yylplex(newlib, libnamebuf, &lib_style);
517  if(yylp_errno) {
518    Werror("Library %s: ERROR occured: in line %d, %d.", newlib, yylplineno,
519         current_pos(0));
520    Werror(yylp_errlist[yylp_errno], yylplineno);
521    Werror("Cannot load library,... aborting.");
522    reinit_yylp();
523    fclose( yylpin );
524    FreeL((ADDRESS)newlib);
525    return TRUE;
526  }
527  if (BVERBOSE(V_LOAD_LIB)) Print( "// ** loaded %s %s", libnamebuf,
528                                   text_buffer);
529  if( (lib_style == OLD_LIBSTYLE) && (BVERBOSE(V_LOAD_LIB)))
530    Warn( "library %s has an old format. Please fix it for the next time",
531          newlib);
532  else {
533    if (BVERBOSE(V_LOAD_LIB)) Print("\n");
534  }
535  reinit_yylp();
536  fclose( yylpin );
537  {
538    libstackv ls;
539    for(ls = library_stack; (ls != NULL) && (ls != ls_start); ) {
540      if(ls->to_be_done) {
541        //Print("// Processing id %d LIB:%s\n", ls->cnt, ls->get());
542        ls->to_be_done=FALSE;
543        iiLibCmd(ls->get());
544        ls = ls->pop(newlib);
545        //Print("Done\n");
546      }
547    }
548#if 0
549    Print("--------------------\n");
550    for(ls = library_stack; ls != NULL; ls = ls->next) {
551      Print("%s: LIB-stack:(%d), %s %s\n", newlib, ls->cnt, ls->get(),
552        ls->to_be_done ? "not loaded" : "loaded");
553    }
554    Print("--------------------\n");
555#endif
556  }
557#else /* HAVE_LIBPARSER */
558  // processing head section
559  if (fgets( buf, sizeof(buf), fp))
560  {
561    if (BVERBOSE(V_LOAD_LIB))
562    {
563      if (strncmp( buf, "// $Id", 5) == 0)
564      {
565        char ver[10];
566        char date[16];
567        ver[0]='?'; ver[1]='.'; ver[2]='?'; ver[3]='\0';
568        date[0]='?'; date[1]='\0';
569        sscanf(buf,"// %*s %*s %10s %16s",ver,date);
570        strcat(libnamebuf,"(");
571        strcat(libnamebuf,ver);
572        strcat(libnamebuf,",");
573        strcat(libnamebuf,date);
574        strcat(libnamebuf,")");
575      }
576      else
577      {
578        strcat(libnamebuf,"(**unknown version**)");
579      }
580      Warn( "loading %s", libnamebuf );
581    }
582  }
583
584  #define IN_HEADER 1
585  #define IN_BODY   2
586  #define IN_EXAMPLE      3
587  #define IN_EXAMPLE_BODY 4
588  #define IN_LIB_HEADER   5
589  int v=-1,otherLines=0,inBlock=IN_LIB_HEADER;
590  do /*while (fgets( buf, sizeof(buf), fp))*/
591  {
592    int  offset;
593    if (buf[0]!='\n')
594    {
595      if ((inBlock==0)||(inBlock==IN_LIB_HEADER))
596      {
597        if (strncmp( buf, "LIB ", 4) == 0)
598        {
599          char *s=buf+5;
600          char *f=strchr(s,'"');
601          if (f!=NULL)
602            *f='\0';
603          else
604            return TRUE;
605          // if (BVERBOSE(V_LOAD_LIB)) Print("// requires %s",s);
606          f=strstr(IDSTRING(hl),s);
607          if (f == NULL)
608          {
609            // if (BVERBOSE(V_LOAD_LIB)) PrintLn();
610            iiLibCmd(mstrdup(s));
611            // if (BVERBOSE(V_LOAD_LIB)) Print( "// loading %s\n", newlib);
612          }
613          //else if (BVERBOSE(V_LOAD_LIB)) PrintS(" -> already loaded\n");
614        }
615        else if (strncmp( buf, "proc ", 5) == 0)
616        {
617          char proc[256];
618          char ct1, *e;
619          sscanf( buf, "proc %s", proc);
620          offset = 2;
621          char *ct=strchr(proc,'(');
622          if (ct!=NULL) { *ct='\0'; offset=3; }
623          sprintf( buf, "LIB:%s", newlib);
624#if 0
625          if(strcmp(proc, "_init")==0)
626          {
627            char *p =  iiConvName(newlib);
628            Print("Init found:%s;\n", p);
629            h = enterid( mstrdup(p), myynest, PROC_CMD, &idroot, FALSE );
630            FreeL((ADDRESS)p);
631          } else
632#endif
633            h = enterid( mstrdup(proc), myynest, PROC_CMD, &idroot, FALSE );
634          if (h!=NULL)
635          {
636            iiInitSingularProcinfo(IDPROC(h),newlib,proc,lines,pos);
637            if (BVERBOSE(V_LOAD_PROC)) Warn( "     proc %s loaded", proc );
638          }
639          inBlock=IN_HEADER;
640        }
641        else if (strncmp( buf, "// ver:", 7) == 0)
642        {
643          v=0;
644          sscanf( buf+7, "%d", &v);
645          if(v!=(SINGULAR_VERSION/100))
646            Warn("version mismatch - library `%s` requires:%d.%d",
647                  newlib,v/1000,(v%1000)/100);
648        }
649        else if (strncmp( buf, "example", 7) == 0)
650        {
651          IDPROC(h)->data.s.example_start = pos;
652          IDPROC(h)->data.s.example_lineno = lines;
653          inBlock=IN_EXAMPLE;
654        }
655        else if (strncmp( buf, "//", 2) != 0)
656        {
657          if (inBlock==0)
658          {
659            otherLines++;
660          }
661        }
662      }
663      else if ((inBlock==IN_HEADER) || (inBlock==IN_EXAMPLE))
664      {
665        if (buf[0]=='{')
666        {
667          if(inBlock==IN_HEADER)
668          {
669            IDPROC(h)->data.s.body_start = pos;
670            IDPROC(h)->data.s.body_lineno = lines-offset;
671            // Print("%s: %d-%d\n", pi->procname, lines, offset);
672          }
673          inBlock=IN_BODY;
674        }
675      }
676      else if ((inBlock==IN_BODY) || (inBlock==IN_EXAMPLE_BODY))
677      {
678        if (buf[0]=='}')
679        {
680          if(IDPROC(h)->data.s.example_start==0)
681            IDPROC(h)->data.s.example_start=pos;
682          if(IDPROC(h)->data.s.body_end==0) IDPROC(h)->data.s.body_end=pos;
683          IDPROC(h)->data.s.proc_end = pos;
684          inBlock=0;
685        }
686      }
687    }
688    lines++;
689    pos = ftell(fp);
690  } while (fgets( buf, sizeof(buf), fp));
691  fclose( fp );
692
693  //if (h!=NULL) IDPROC(h) = pi;
694  if (BVERBOSE(V_DEBUG_LIB))
695  {
696    if (inBlock!=0)
697      Warn("LIB `%s` ends within block",newlib);
698    if (otherLines!=0)
699      Warn("%d lines not recognised in LIB `%s`",otherLines,newlib);
700    if(v==-1)
701      Warn("LIB `%s` has no version flag",newlib);
702  }
703#endif /* HAVE_LIBPARSER */
704  FreeL((ADDRESS)newlib);
705  return FALSE;
706}
707
708/*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
709procinfo *iiInitSingularProcinfo(procinfov pi, char *libname, char *procname,
710                                 int line, long pos, BOOLEAN pstatic)
711{
712  pi->libname = mstrdup(libname);
713
714  if( strcmp(procname,"_init")==0)
715  {
716    char *p = iiConvName(libname);
717    pi->procname = mstrdup(p);
718    FreeL((ADDRESS)p);
719  } else pi->procname = mstrdup(procname);
720  pi->language = LANG_SINGULAR;
721  pi->ref = 1;
722  pi->is_static = pstatic;
723  pi->data.s.proc_start = pos;
724  pi->data.s.help_start = 0L;
725  pi->data.s.help_end   = 0L;
726  pi->data.s.body_start = 0L;
727  pi->data.s.body_end   = 0L;
728  pi->data.s.example_start = 0L;
729  pi->data.s.proc_lineno = line;
730  pi->data.s.body_lineno = 0;
731  pi->data.s.example_lineno = 0;
732  pi->data.s.body = NULL;
733  return(pi);
734}
735
736#ifdef HAVE_DYNAMIC_LOADING
737/*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
738int iiAddCproc(char *libname, char *procname, BOOLEAN pstatic,
739               BOOLEAN(*func)(leftv res, leftv v))
740{
741  procinfov pi;
742  idhdl h;
743
744  h = enterid(mstrdup(procname),0, PROC_CMD, &idroot, FALSE);
745  if ( h!= NULL ) {
746    Print("register binary proc: %s::%s\n", libname, procname);
747    pi = IDPROC(h);
748    pi->libname = mstrdup(libname);
749    pi->procname = mstrdup(procname);
750    pi->language = LANG_C;
751    pi->ref = 1;
752    pi->is_static = pstatic;
753    pi->data.o.function = func;
754    return(1);
755  } else {
756    Print("iiAddCproc: failed.\n");
757  }
758  return(0);
759}
760#endif /* HAVE_DYNAMIC_LOADING */
761
762/*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
763char *iiConvName(char *libname)
764{
765  char *p = (char *)AllocL(strlen(libname)+7);
766  char *q = mstrdup(libname);
767  char *r = q;
768  for(; *r!='\0'; r++)
769  {
770    if(*r=='.') *r='_';
771    if(*r==':') *r='_';
772  }
773  sprintf(p, "%s_init\0", q);
774  FreeL((ADDRESS)q);
775  return(p);
776}
777
778/*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
779void piShowProcList()
780{
781  idhdl h;
782  procinfo *proc;
783  char *name;
784
785  Print( "%-15s  %20s      %s,%s  %s,%s   %s,%s\n", "Library", "function",
786         "line", "start", "line", "body", "line", "example");
787  for(h = idroot; h != NULL; h = IDNEXT(h))
788  {
789    if(IDTYP(h) == PROC_CMD)
790    {
791      proc = IDPROC(h);
792      if(strcmp(proc->procname, IDID(h))!=0)
793      {
794        name = (char *)AllocL(strlen(IDID(h))+strlen(proc->procname)+4);
795        sprintf(name, "%s -> %s", IDID(h), proc->procname);
796        Print( "%-15s  %20s ", proc->libname, name);
797        FreeL(name);
798      }
799      else
800        Print( "%-15s  %20s ", proc->libname, proc->procname);
801      if(proc->language==LANG_SINGULAR)
802        Print("line %4d,%-5ld  %4d,%-5ld  %4d,%-5ld\n",
803              proc->data.s.proc_lineno, proc->data.s.proc_start,
804              proc->data.s.body_lineno, proc->data.s.body_start,
805              proc->data.s.example_lineno, proc->data.s.example_start);
806      else if(proc->language==LANG_C)
807        Print("type: object\n");
808
809    }
810  }
811}
812
813/*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
814//char *iiLineNo(char *procname, int lineno)
815//{
816//  char buf[256];
817//  idhdl pn = ggetid(procname);
818//  procinfo *pi = IDPROC(pn);
819//
820//  sprintf(buf, "%s %3d\0", procname, lineno);
821//  //sprintf(buf, "%s::%s %3d\0", pi->libname, pi->procname,
822//  //  lineno + pi->data.s.body_lineno);
823//  return(buf);
824//}
825/*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
826#ifdef HAVE_LIBPARSER
827void libstack::push(char *p, char *libname)
828{
829  idhdl hl = idroot->get("LIB",0);
830  libstackv lp;
831  char *f = NULL;
832  if(hl!=NULL) f = strstr(IDSTRING(hl),libname);
833  if( (hl==NULL) || (f == NULL)) {
834    for(lp = this;lp!=NULL;lp=lp->next) {
835      if(strcmp(lp->get(), libname)==0) break;
836    }
837    if(lp==NULL) {
838      libstackv ls = (libstack *)Alloc0(sizeof(libstack));
839      ls->next = this;
840      ls->libname = mstrdup(libname);
841      ls->to_be_done = TRUE;
842      if(this != NULL) ls->cnt = this->cnt+1; else ls->cnt = 0;
843      library_stack = ls;
844    }
845  }
846}
847
848libstackv libstack::pop(char *p)
849{
850  libstackv ls = this;
851  //FreeL(ls->libname);
852  library_stack = ls->next;
853  Free((ADDRESS)ls, sizeof(libstack));
854  return(library_stack);
855}
856
857#endif /* HAVE_LIBPARSER */
858/*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
Note: See TracBrowser for help on using the repository browser.