source: git/Singular/iplib.cc @ ca7a56

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