source: git/Singular/iplib.cc @ 1a90ed

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