source: git/Singular/iplib.cc @ 18dd47

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