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

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