source: git/Singular/iplib.cc @ 5480da

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