source: git/Singular/iplib.cc @ 7fd611

spielwiese
Last change on this file since 7fd611 was 7fd611, checked in by Kai Krüger <krueger@…>, 25 years ago
pretty-printing of help git-svn-id: file:///usr/local/Singular/svn/trunk@1810 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 22.6 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: iplib.cc,v 1.26 1998-05-18 09:32: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#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+2);
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    Werror(yylp_errlist[yylp_errno], yylplineno);
531    Werror("Cannot load library,... aborting.");
532    reinit_yylp();
533    fclose( yylpin );
534    FreeL((ADDRESS)newlib);
535    return TRUE;
536  }
537  if (BVERBOSE(V_LOAD_LIB)) Print( "// ** loaded %s %s", libnamebuf,
538                                   text_buffer);
539  if( (lib_style == OLD_LIBSTYLE) && (BVERBOSE(V_LOAD_LIB)))
540    Warn( "library %s has an old format. Please fix it for the next time",
541          newlib);
542  else {
543    if (BVERBOSE(V_LOAD_LIB)) Print("\n");
544  }
545  reinit_yylp();
546  fclose( yylpin );
547  {
548    libstackv ls;
549    for(ls = library_stack; (ls != NULL) && (ls != ls_start); ) {
550      if(ls->to_be_done) {
551        //Print("// Processing id %d LIB:%s\n", ls->cnt, ls->get());
552        ls->to_be_done=FALSE;
553        iiLibCmd(ls->get());
554        ls = ls->pop(newlib);
555        //Print("Done\n");
556      }
557    }
558#if 0
559    Print("--------------------\n");
560    for(ls = library_stack; ls != NULL; ls = ls->next) {
561      Print("%s: LIB-stack:(%d), %s %s\n", newlib, ls->cnt, ls->get(),
562        ls->to_be_done ? "not loaded" : "loaded");
563    }
564    Print("--------------------\n");
565#endif
566  }
567#else /* HAVE_LIBPARSER */
568  // processing head section
569  if (fgets( buf, sizeof(buf), fp))
570  {
571    if (BVERBOSE(V_LOAD_LIB))
572    {
573      if (strncmp( buf, "// $Id", 5) == 0)
574      {
575        char ver[10];
576        char date[16];
577        ver[0]='?'; ver[1]='.'; ver[2]='?'; ver[3]='\0';
578        date[0]='?'; date[1]='\0';
579        sscanf(buf,"// %*s %*s %10s %16s",ver,date);
580        strcat(libnamebuf,"(");
581        strcat(libnamebuf,ver);
582        strcat(libnamebuf,",");
583        strcat(libnamebuf,date);
584        strcat(libnamebuf,")");
585      }
586      else
587      {
588        strcat(libnamebuf,"(**unknown version**)");
589      }
590      Warn( "loading %s", libnamebuf );
591    }
592  }
593
594  #define IN_HEADER 1
595  #define IN_BODY   2
596  #define IN_EXAMPLE      3
597  #define IN_EXAMPLE_BODY 4
598  #define IN_LIB_HEADER   5
599  int v=-1,otherLines=0,inBlock=IN_LIB_HEADER;
600  do /*while (fgets( buf, sizeof(buf), fp))*/
601  {
602    int  offset;
603    if (buf[0]!='\n')
604    {
605      if ((inBlock==0)||(inBlock==IN_LIB_HEADER))
606      {
607        if (strncmp( buf, "LIB ", 4) == 0)
608        {
609          char *s=buf+5;
610          char *f=strchr(s,'"');
611          if (f!=NULL)
612            *f='\0';
613          else
614            return TRUE;
615          // if (BVERBOSE(V_LOAD_LIB)) Print("// requires %s",s);
616          f=strstr(IDSTRING(hl),s);
617          if (f == NULL)
618          {
619            // if (BVERBOSE(V_LOAD_LIB)) PrintLn();
620            iiLibCmd(mstrdup(s));
621            // if (BVERBOSE(V_LOAD_LIB)) Print( "// loading %s\n", newlib);
622          }
623          //else if (BVERBOSE(V_LOAD_LIB)) PrintS(" -> already loaded\n");
624        }
625        else if (strncmp( buf, "proc ", 5) == 0)
626        {
627          char proc[256];
628          char ct1, *e;
629          sscanf( buf, "proc %s", proc);
630          offset = 2;
631          char *ct=strchr(proc,'(');
632          if (ct!=NULL) { *ct='\0'; offset=3; }
633          sprintf( buf, "LIB:%s", newlib);
634#if 0
635          if(strcmp(proc, "_init")==0)
636          {
637            char *p =  iiConvName(newlib);
638            Print("Init found:%s;\n", p);
639            h = enterid( mstrdup(p), myynest, PROC_CMD, &idroot, FALSE );
640            FreeL((ADDRESS)p);
641          } else
642#endif
643            h = enterid( mstrdup(proc), myynest, PROC_CMD, &idroot, FALSE );
644          if (h!=NULL)
645          {
646            iiInitSingularProcinfo(IDPROC(h),newlib,proc,lines,pos);
647            if (BVERBOSE(V_LOAD_PROC)) Warn( "     proc %s loaded", proc );
648          }
649          inBlock=IN_HEADER;
650        }
651        else if (strncmp( buf, "// ver:", 7) == 0)
652        {
653          v=0;
654          sscanf( buf+7, "%d", &v);
655          if(v!=(SINGULAR_VERSION/100))
656            Warn("version mismatch - library `%s` requires:%d.%d",
657                  newlib,v/1000,(v%1000)/100);
658        }
659        else if (strncmp( buf, "example", 7) == 0)
660        {
661          IDPROC(h)->data.s.example_start = pos;
662          IDPROC(h)->data.s.example_lineno = lines;
663          inBlock=IN_EXAMPLE;
664        }
665        else if (strncmp( buf, "//", 2) != 0)
666        {
667          if (inBlock==0)
668          {
669            otherLines++;
670          }
671        }
672      }
673      else if ((inBlock==IN_HEADER) || (inBlock==IN_EXAMPLE))
674      {
675        if (buf[0]=='{')
676        {
677          if(inBlock==IN_HEADER)
678          {
679            IDPROC(h)->data.s.body_start = pos;
680            IDPROC(h)->data.s.body_lineno = lines-offset;
681            // Print("%s: %d-%d\n", pi->procname, lines, offset);
682          }
683          inBlock=IN_BODY;
684        }
685      }
686      else if ((inBlock==IN_BODY) || (inBlock==IN_EXAMPLE_BODY))
687      {
688        if (buf[0]=='}')
689        {
690          if(IDPROC(h)->data.s.example_start==0)
691            IDPROC(h)->data.s.example_start=pos;
692          if(IDPROC(h)->data.s.body_end==0) IDPROC(h)->data.s.body_end=pos;
693          IDPROC(h)->data.s.proc_end = pos;
694          inBlock=0;
695        }
696      }
697    }
698    lines++;
699    pos = ftell(fp);
700  } while (fgets( buf, sizeof(buf), fp));
701  fclose( fp );
702
703  //if (h!=NULL) IDPROC(h) = pi;
704  if (BVERBOSE(V_DEBUG_LIB))
705  {
706    if (inBlock!=0)
707      Warn("LIB `%s` ends within block",newlib);
708    if (otherLines!=0)
709      Warn("%d lines not recognised in LIB `%s`",otherLines,newlib);
710    if(v==-1)
711      Warn("LIB `%s` has no version flag",newlib);
712  }
713#endif /* HAVE_LIBPARSER */
714  FreeL((ADDRESS)newlib);
715  return FALSE;
716}
717
718/*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
719procinfo *iiInitSingularProcinfo(procinfov pi, char *libname, char *procname,
720                                 int line, long pos, BOOLEAN pstatic)
721{
722  pi->libname = mstrdup(libname);
723
724  if( strcmp(procname,"_init")==0)
725  {
726    char *p = iiConvName(libname);
727    pi->procname = mstrdup(p);
728    FreeL((ADDRESS)p);
729  } else pi->procname = mstrdup(procname);
730  pi->language = LANG_SINGULAR;
731  pi->ref = 1;
732  pi->is_static = pstatic;
733  pi->data.s.proc_start = pos;
734  pi->data.s.help_start = 0L;
735  pi->data.s.help_end   = 0L;
736  pi->data.s.body_start = 0L;
737  pi->data.s.body_end   = 0L;
738  pi->data.s.example_start = 0L;
739  pi->data.s.proc_lineno = line;
740  pi->data.s.body_lineno = 0;
741  pi->data.s.example_lineno = 0;
742  pi->data.s.body = NULL;
743  return(pi);
744}
745
746#ifdef HAVE_DYNAMIC_LOADING
747/*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
748int iiAddCproc(char *libname, char *procname, BOOLEAN pstatic,
749               BOOLEAN(*func)(leftv res, leftv v))
750{
751  procinfov pi;
752  idhdl h;
753
754  h = enterid(mstrdup(procname),0, PROC_CMD, &idroot, FALSE);
755  if ( h!= NULL ) {
756    Print("register binary proc: %s::%s\n", libname, procname);
757    pi = IDPROC(h);
758    pi->libname = mstrdup(libname);
759    pi->procname = mstrdup(procname);
760    pi->language = LANG_C;
761    pi->ref = 1;
762    pi->is_static = pstatic;
763    pi->data.o.function = func;
764    return(1);
765  } else {
766    Print("iiAddCproc: failed.\n");
767  }
768  return(0);
769}
770#endif /* HAVE_DYNAMIC_LOADING */
771
772/*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
773char *iiConvName(char *libname)
774{
775  int l=strlen(libname)+7;
776  char *p = (char *)AllocL(l);
777  char *r;
778
779  memset(p,0,l);
780  sprintf(p, "%s_init", libname);
781  for(r=p; *r!='\0'; r++)
782  {
783    if(*r=='.') *r='_';
784    if(*r==':') *r='_';
785  }
786  return(p);
787}
788
789/*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
790void piShowProcList()
791{
792  idhdl h;
793  procinfo *proc;
794  char *name;
795
796  Print( "%-15s  %20s      %s,%s  %s,%s   %s,%s\n", "Library", "function",
797         "line", "start", "line", "body", "line", "example");
798  for(h = idroot; h != NULL; h = IDNEXT(h))
799  {
800    if(IDTYP(h) == PROC_CMD)
801    {
802      proc = IDPROC(h);
803      if(strcmp(proc->procname, IDID(h))!=0)
804      {
805        name = (char *)AllocL(strlen(IDID(h))+strlen(proc->procname)+4);
806        sprintf(name, "%s -> %s", IDID(h), proc->procname);
807        Print( "%-15s  %20s ", proc->libname, name);
808        FreeL(name);
809      }
810      else
811        Print( "%-15s  %20s ", proc->libname, proc->procname);
812      if(proc->language==LANG_SINGULAR)
813        Print("line %4d,%-5ld  %4d,%-5ld  %4d,%-5ld\n",
814              proc->data.s.proc_lineno, proc->data.s.proc_start,
815              proc->data.s.body_lineno, proc->data.s.body_start,
816              proc->data.s.example_lineno, proc->data.s.example_start);
817      else if(proc->language==LANG_C)
818        Print("type: object\n");
819
820    }
821  }
822}
823
824/*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
825//char *iiLineNo(char *procname, int lineno)
826//{
827//  char buf[256];
828//  idhdl pn = ggetid(procname);
829//  procinfo *pi = IDPROC(pn);
830//
831//  sprintf(buf, "%s %3d\0", procname, lineno);
832//  //sprintf(buf, "%s::%s %3d\0", pi->libname, pi->procname,
833//  //  lineno + pi->data.s.body_lineno);
834//  return(buf);
835//}
836/*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
837#ifdef HAVE_LIBPARSER
838void libstack::push(char *p, char *libname)
839{
840  idhdl hl = idroot->get("LIB",0);
841  libstackv lp;
842  char *f = NULL;
843  if(hl!=NULL) f = strstr(IDSTRING(hl),libname);
844  if( (hl==NULL) || (f == NULL)) {
845    for(lp = this;lp!=NULL;lp=lp->next) {
846      if(strcmp(lp->get(), libname)==0) break;
847    }
848    if(lp==NULL) {
849      libstackv ls = (libstack *)Alloc0(sizeof(libstack));
850      ls->next = this;
851      ls->libname = mstrdup(libname);
852      ls->to_be_done = TRUE;
853      if(this != NULL) ls->cnt = this->cnt+1; else ls->cnt = 0;
854      library_stack = ls;
855    }
856  }
857}
858
859libstackv libstack::pop(char *p)
860{
861  libstackv ls = this;
862  //FreeL(ls->libname);
863  library_stack = ls->next;
864  Free((ADDRESS)ls, sizeof(libstack));
865  return(library_stack);
866}
867
868#endif /* HAVE_LIBPARSER */
869/*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
Note: See TracBrowser for help on using the repository browser.