source: git/Singular/iplib.cc @ 0348347

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