Changeset 2ba9a6 in git


Ignore:
Timestamp:
Jan 16, 1998, 3:29:59 PM (26 years ago)
Author:
Kai Krüger <krueger@…>
Branches:
(u'spielwiese', 'fe61d9c35bf7c61f2b6cbf1b56e25e2f08d536cc')
Children:
f6590b9deabd44afb9756e810c1213f1e4aa4190
Parents:
f4404c2811a260acd825c9312b087b2c2704ae91
Message:
Implementation of new proc-scheme done.


git-svn-id: file:///usr/local/Singular/svn/trunk@1033 2c84dea3-7e68-4137-9b89-c4e89433aadc
Location:
Singular
Files:
17 edited

Legend:

Unmodified
Added
Removed

  • Singular/ChangeLog

    rf4404c r2ba9a6  
     1Fri Jan 16 15:30:07 MET 1998 Kai Krueger <krueger@mathematik.uni-kl.de>
     2        * extra.cc,febase.cc,febase.inc,grammar.y,iparith.cc
     3        * ipassign.cc,ipid.cc,ipid.h,iplib.cc,ipshell.h,misc.cc
     4        * mpsr_Put.cc,mpsr_Put.h,silink.cc,structs.h,subexpr.cc,subexpr.h
     5        * tesths.cc
     6          Implementation of new proc-scheme done.
     7       
     8Fri Jan 16 14:51:07 MET 1998 Kai Krueger <krueger@mathematik.uni-kl.de>
     9        * Makefile.in,tests/mpcheck,teste/comparecheck:
     10          fixed use of correct Singular during checks
     11
    112Fri Jan 16 09:23:07 MET 1998
    213        * changes for TEST_MAC_ORDER, part 1 (hannes)

  • Singular/extra.cc

    rf4404c r2ba9a6  
    22*  Computer Algebra System SINGULAR      *
    33*****************************************/
    4 /* $Id: extra.cc,v 1.26 1998-01-12 17:32:46 Singular Exp $ */
     4/* $Id: extra.cc,v 1.27 1998-01-16 14:29:47 krueger Exp $ */
    55/*
    66* ABSTRACT: general interface to internals of Singular ("system" command)
    … …  
    8181      {
    8282        res->rtyp=STRING_CMD;
    83         res->data=mstrdup(iiGetLibName(IDSTRING(hh)));
     83        res->data=mstrdup(iiGetLibName(IDPROC(hh)));
    8484        if (res->data==NULL) res->data=mstrdup("");
    8585        return FALSE;
    … …  
    8787      else
    8888        Warn("`%s` not found",(char*)h->next->Data());
     89    }
     90    else
     91/*==================== proclist =================================*/
     92    if(strcmp((char*)(h->Data()),"proclist")==0)
     93    {
     94      int piShowProcList();
     95      res->rtyp=STRING_CMD;
     96      res->data=(void *)mstrdup("");
     97      piShowProcList();
     98      return FALSE;
    8999    }
    90100    else

  • Singular/grammar.y

    rf4404c r2ba9a6  
    22*  Computer Algebra System SINGULAR     *
    33****************************************/
    4 /* $Id: grammar.y,v 1.19 1997-09-12 08:27:08 Singular Exp $ */
     4/* $Id: grammar.y,v 1.20 1998-01-16 14:29:49 krueger Exp $ */
    55/*
    66* ABSTRACT: SINGULAR shell grammatik
    … …  
    4242#include "lists.h"
    4343
     44
     45procinfo *iiInitSingularProcinfo(procinfo *pi, char *libname,
     46                                 char *procname, int line, long pos);
    4447
    4548extern int   yylineno;
    … …  
    13951398        PROC_CMD extendedid BLOCKTOK
    13961399          {
     1400            procinfov pi;
    13971401            idhdl h = enterid($2,myynest,PROC_CMD,&idroot,FALSE);
    13981402            if (h==NULL) {FreeL((ADDRESS)$3); YYERROR;}
    1399             IDSTRING(h) = (char *)AllocL(strlen($3)+31);
    1400             sprintf(IDSTRING(h),"parameter list #;\n%s;return();\n\n",$3);
     1403            iiInitSingularProcinfo(IDPROC(h),"", $2, 0, 0);
     1404            IDPROC(h)->data.s.body = (char *)AllocL(strlen($3)+31);;
     1405            sprintf(IDPROC(h)->data.s.body,"parameter list #;\n%s;return();\n\n",$3);
    14011406            FreeL((ADDRESS)$3);
    14021407          }
    14031408        | PROC_DEF STRINGTOK BLOCKTOK
    1404           {
     1409          { 
    14051410            idhdl h = enterid($1,myynest,PROC_CMD,&idroot,FALSE);
    14061411            if (h==NULL)
    … …  
    14111416            }
    14121417            char *args=iiProcArgs($2,FALSE);
    1413             FreeL((ADDRESS)$2);
    1414             IDSTRING(h) = (char *)AllocL(strlen($3)+strlen(args)+14);
    1415             sprintf(IDSTRING(h),"%s\n%s;RETURN();\n\n",args,$3);
     1418            procinfov pi;
     1419            FreeL((ADDRESS)$2);
     1420            iiInitSingularProcinfo(IDPROC(h),"", $1, 0, 0);
     1421            IDPROC(h)->data.s.body = (char *)AllocL(strlen($3)+strlen(args)+14);;
     1422            sprintf(IDPROC(h)->data.s.body,"%s\n%s;RETURN();\n\n",args,$3);
    14161423            FreeL((ADDRESS)args);
    14171424            FreeL((ADDRESS)$3);
    1418             //Print(">>%s<<\n",IDSTRING(h));
     1425            //Print(">>%s<<\n",IDPROC(h)->data.s.body);
    14191426          }
    14201427        ;

  • Singular/iparith.cc

    rf4404c r2ba9a6  
    26892689static BOOLEAN jjSTRING_PROC(leftv res, leftv v)
    26902690{
    2691   res->data=mstrdup(IDSTRING((idhdl)v->data));
     2691  procinfov pi = IDPROC((idhdl)v->data);
     2692  if(pi->language == LANG_SINGULAR)
     2693    res->data=mstrdup(pi->data.s.body);
     2694  else res->data=mstrdup("");
    26922695  return FALSE;
    26932696}

  • Singular/ipassign.cc

    rf4404c r2ba9a6  
    22*  Computer Algebra System SINGULAR     *
    33****************************************/
    4 /* $Id: ipassign.cc,v 1.19 1997-11-13 10:52:44 Singular Exp $ */
     4/* $Id: ipassign.cc,v 1.20 1998-01-16 14:29:52 krueger Exp $ */
    55
    66/*
    … …  
    330330  return FALSE;
    331331}
     332static BOOLEAN jiA_PROC(leftv res, leftv a, Subexpr e)
     333{
     334  extern procinfo *iiInitSingularProcinfo(procinfo *pi, char *libname,
     335                                   char *procname, int line, long pos);
     336  extern void piCleanUp(procinfov pi);
     337
     338  if(res->data!=NULL) piCleanUp((procinfo *)res->data);
     339  if(a->rtyp==STRING_CMD) {
     340    res->data = (void *)Alloc(sizeof(procinfo));
     341    memset(res->data,0,sizeof(*(res->data)));
     342    ((procinfo *)(res->data))->language=LANG_NONE;
     343    iiInitSingularProcinfo((procinfo *)res->data,"",res->name,0,0);
     344    ((procinfo *)res->data)->data.s.body=(void *)a->CopyD(STRING_CMD);
     345  }
     346  else
     347    res->data=(void *)a->CopyD(PROC_CMD);
     348  jiAssignAttr(res,a);
     349  return FALSE;
     350}
    332351static BOOLEAN jiA_INTVEC(leftv res, leftv a, Subexpr e)
    333352{
    … …  
    478497,{jiA_RING,     QRING_CMD,      QRING_CMD }
    479498,{jiA_STRING,   STRING_CMD,     STRING_CMD }
    480 ,{jiA_STRING,   PROC_CMD,       STRING_CMD }
    481 ,{jiA_STRING,   PROC_CMD,       PROC_CMD }
     499,{jiA_PROC,     PROC_CMD,       STRING_CMD }
     500,{jiA_PROC,     PROC_CMD,       PROC_CMD }
    482501,{jiA_POLY,     VECTOR_CMD,     VECTOR_CMD }
    483502,{jiA_INTVEC,   INTVEC_CMD,     INTVEC_CMD }

  • Singular/ipid.cc

    rf4404c r2ba9a6  
    22*  Computer Algebra System SINGULAR     *
    33****************************************/
    4 /* $Id: ipid.cc,v 1.8 1997-12-18 14:26:35 Singular Exp $ */
     4/* $Id: ipid.cc,v 1.9 1998-01-16 14:29:52 krueger Exp $ */
    55
    66/*
    … …  
    9595        IDMAP(h)->preimage = mstrdup(IDID(currRingHdl));
    9696        break;
    97       case PROC_CMD:
    98         IDSTRING(h) = mstrdup("parameter list #;\nreturn();\n\n");
    99         break;
    10097      case STRING_CMD:
    10198        IDSTRING(h) = mstrdup("");
    … …  
    125122      IDSTRING(h) = (char *)Alloc0(len);
    126123    }
     124  }
     125  if(t == PROC_CMD) {
     126    IDPROC(h) = (procinfo *)Alloc(sizeof(procinfo));
     127    memset(IDPROC(h),0,sizeof(*IDPROC(h)));
     128    IDPROC(h)->language=LANG_NONE;
    127129  }
    128130  return  h;
    … …  
    323325    idDelete(&iid);
    324326  }
    325   // string / proc / binary ------------------------------------------------
    326   else if ((IDTYP(h) == STRING_CMD)
    327            ||(IDTYP(h) == PROC_CMD)
    328       )
     327  // string -------------------------------------------------------------
     328  else if (IDTYP(h) == STRING_CMD)
    329329  {
    330330    FreeL((ADDRESS)IDSTRING(h));
    331331    //IDSTRING(h)=NULL;
     332  }
     333  // proc ---------------------------------------------------------------
     334  else if (IDTYP(h) == PROC_CMD)
     335  {
     336    piKill(IDPROC(h));
    332337  }
    333338  // number -------------------------------------------------------------
    … …  
    474479  }
    475480}
     481
     482char * piProcinfo(procinfov pi, char *request)
     483{
     484  if(pi == NULL) return "empty proc";
     485  else if (strcmp(request, "libname")  == 0) return pi->libname;
     486  else if (strcmp(request, "procname") == 0) return pi->procname;
     487  else if (strcmp(request, "type")     == 0) {
     488    switch (pi->language) {
     489      case LANG_SINGULAR: return "singular"; break;
     490      case LANG_C:        return "object";   break;
     491      case LANG_NONE:     return "none";     break;
     492      default:            return "unknow language";
     493    }
     494  } else if (strcmp(request, "ref")      == 0) {
     495    char p[8];
     496    sprintf(p, "%d\0", pi->ref);
     497    return mstrdup(p);
     498  }
     499
     500}
     501
     502void piCleanUp(procinfov pi)
     503{
     504  (pi->ref)--;
     505  if (pi->ref <= 0)
     506  {
     507    FreeL((ADDRESS)pi->libname);
     508    FreeL((ADDRESS)pi->procname);
     509    if( pi->language == LANG_SINGULAR) {
     510      FreeL((ADDRESS)pi->data.s.body);
     511    }
     512    if( pi->language == LANG_C) {
     513    }
     514    memset((void *) pi, 0, sizeof(procinfo));
     515    pi->language=LANG_NONE;
     516  }
     517}
     518
     519void piKill(procinfov pi)
     520{
     521  piCleanUp(pi);
     522  if (pi->ref <= 0)
     523    Free((ADDRESS)pi, sizeof(procinfo));
     524}
     525

  • Singular/ipid.h

    rf4404c r2ba9a6  
    44*  Computer Algebra System SINGULAR     *
    55****************************************/
    6 /* $Id: ipid.h,v 1.7 1998-01-12 18:59:49 obachman Exp $ */
     6/* $Id: ipid.h,v 1.8 1998-01-16 14:29:53 krueger Exp $ */
    77/*
    88* ABSTRACT: identfier handling
    … …  
    9595  si_link       li;
    9696  package       pack;
     97  procinfo *    pinf;
    9798};
    9899
    … …  
    130131#define IDLINK(a)   ((a)->data.li)
    131132#define IDPACKAGE(a) ((a)->data.pack)
     133#define IDPROC(a)   ((a)->data.pinf)
    132134
    133135  idrec() { memset(this,0,sizeof(*this)); }

  • Singular/iplib.cc

    rf4404c r2ba9a6  
    22*  Computer Algebra System SINGULAR     *
    33****************************************/
    4 /* $Id: iplib.cc,v 1.7 1997-07-09 15:54:01 Singular Exp $ */
     4/* $Id: iplib.cc,v 1.8 1998-01-16 14:29:53 krueger Exp $ */
    55/*
    66* ABSTRACT: interpreter: LIB and help
    … …  
    2222#include "lists.h"
    2323
     24procinfo *iiInitSingularProcinfo(procinfo *pi, char *libname,
     25                                 char *procname, int line, long pos);
     26char *iiConvName(char *p);
     27
    2428/*2
    2529* 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)
     30*  => return (pi->libname)
    3231*/
    33 char * iiGetLibName(char *procstr)
     32char * iiGetLibName(procinfov pi)
    3433{
    3534  char *res=NULL;
    3635
    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   }
     36  res = pi->libname;
    4737  return res;
    4838}
    … …  
    111101  return argstr;
    112102}
     103
    113104/*2
    114105* locate `procname` in lib `libname` and find the part `part`:
    115106*  part=0: help, between, but excluding the line "proc ..." and "{...":
    116 *    => Print, return NULL
     107*    => return
    117108*  part=1: body, between "{ ..." and "}", including the 1. line, w/o "{"
    118 *    => FreeL(libname), return
     109*    => set pi->data.s.body, return NULL
    119110*  part=2: example, between, but excluding the line "exapmle {..." and "}":
    120111*    => return
    121112*/
    122 char* 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 );
     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 );
    133119  if (fp==NULL)
    134120  {
    135     if (part==1) FreeL((ADDRESS)(libname-4));
    136121    return NULL;
    137122  }
    138123
    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));
     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  }
    251178  return NULL;
    252179}
    … …  
    302229    if (pn!=NULL)
    303230    {
    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) );
     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      }
    310242      fileVoice = voice;
    311243    }
    … …  
    393325{
    394326  int err;
     327  procinfov pi = IDPROC(pn);
    395328  iiCheckNest();
    396329  iiLocalRing[myynest]=currRing;
    … …  
    404337  if (traceit&TRACE_SHOW_RINGS) iiShowLevRings();
    405338#endif
    406   err=iiPStart(pn,NULL,sl);
     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
    407358  if (traceit&TRACE_SHOW_PROC)
    408359  {
    … …  
    504455  char libnamebuf[128];
    505456  idhdl h,hl;
     457  int lines = 1;
     458  long pos = 0L;
     459  procinfov pi;
    506460  FILE * fp = feFopen( newlib, "r", libnamebuf, tellerror );
    507461  if (fp==NULL)
    … …  
    589543  #define IN_HEADER 1
    590544  #define IN_BODY   2
    591   #define IN_LIB_HEADER 3
     545  #define IN_EXAMPLE      3
     546  #define IN_EXAMPLE_BODY 4
     547  #define IN_LIB_HEADER   5
    592548  int v=-1,otherLines=0,inBlock=IN_LIB_HEADER;
    593549  do /*while (fgets( buf, sizeof(buf), fp))*/
    594550  {
     551    int  offset;
    595552    if (buf[0]!='\n')
    596553    {
    … …  
    618575        {
    619576          char proc[256];
     577          char ct1, *e;
    620578          sscanf( buf, "proc %s", proc);
     579          offset = 2;
    621580          char *ct=strchr(proc,'(');
    622           if (ct!=NULL) *ct='\0';
     581          if (ct!=NULL) { *ct='\0'; offset=3; }
    623582          sprintf( buf, "LIB:%s", newlib);
    624           h = enterid( mstrdup(proc), myynest, PROC_CMD, &idroot, FALSE );
     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 );
    625592          if (h!=NULL)
    626593          {
    627             IDSTRING(h) = mstrdup( buf );
     594            iiInitSingularProcinfo(IDPROC(h),newlib,proc,lines,pos);
    628595            if (BVERBOSE(V_LOAD_PROC)) Warn( "     proc %s loaded", proc );
    629596          }
    … …  
    640607        else if (strncmp( buf, "example", 7) == 0)
    641608        {
    642           inBlock=IN_HEADER;
     609          IDPROC(h)->data.s.example_start = pos;
     610          IDPROC(h)->data.s.example_lineno = lines;
     611          inBlock=IN_EXAMPLE;
    643612        }
    644613        else if (strncmp( buf, "//", 2) != 0)
    … …  
    650619        }
    651620      }
    652       else if (inBlock==IN_HEADER)
     621      else if ((inBlock==IN_HEADER) || (inBlock==IN_EXAMPLE))
    653622      {
    654623        if (buf[0]=='{')
    655624        {
     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          }
    656630          inBlock=IN_BODY;
    657631        }
    658632      }
    659       else if (inBlock==IN_BODY)
     633      else if ((inBlock==IN_BODY) || (inBlock==IN_EXAMPLE_BODY))
    660634      {
    661635        if (buf[0]=='}')
    662         {
    663           inBlock=0;
    664         }
    665       }
    666     }
     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);
    667647  } while (fgets( buf, sizeof(buf), fp));
    668648  fclose( fp );
     649  //if (h!=NULL) IDPROC(h) = pi;
    669650  if (BVERBOSE(V_DEBUG_LIB))
    670651  {
    … …  
    680661}
    681662
     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 = 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 = 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}

  • Singular/ipshell.h

    rf4404c r2ba9a6  
    44*  Computer Algebra System SINGULAR     *
    55****************************************/
    6 /* $Id: ipshell.h,v 1.9 1997-07-11 14:27:55 Singular Exp $ */
     6/* $Id: ipshell.h,v 1.10 1998-01-16 14:29:54 krueger Exp $ */
    77/*
    88* ABSTRACT
    … …  
    4646BOOLEAN iiExport(leftv v, int toLev);
    4747BOOLEAN iiExport(leftv v, int toLev, idhdl &root);
    48 char *  iiGetLibName(char *procstr);
    49 char *  iiGetLibProcBuffer( char* libname, char* procname, int part=1 );
     48char *  iiGetLibName(procinfov v);
     49char *  iiGetLibProcBuffer( procinfov pi, int part=1 );
    5050char *  iiProcName(char *buf, char & ct, char* &e);
    5151char *  iiProcArgs(char *e,BOOLEAN withParenth);

  • Singular/misc.cc

    rf4404c r2ba9a6  
    331331  if ((h!=NULL) && (IDTYP(h)==PROC_CMD))
    332332  {
    333     char *lib=iiGetLibName(IDSTRING(h));
     333    char *lib=iiGetLibName(IDPROC(h));
    334334    Print("// proc %s ",s);
    335335    if((lib==NULL)||(*lib=='\0'))
    … …  
    340340    {
    341341      Print("from lib %s\n",lib);
    342       if (!example)
    343         iiGetLibProcBuffer(lib,s,0);
    344       else
    345       {
    346         s=iiGetLibProcBuffer(lib,s,2);
    347         if (s!=NULL)
    348         {
    349           if (strlen(s)>5) iiEStart(s); /*newBuffer(s,BT_execute);*/
    350           else FreeL((ADDRESS)s);
    351         }
     342      s=iiGetLibProcBuffer(IDPROC(h), example ? 2 : 0);
     343      if (!example) {
     344        PrintS(s);
     345        FreeL((ADDRESS)s);
     346      }
     347      else {
     348        if (s!=NULL) {
     349          if (strlen(s)>5) iiEStart(s); /*newBuffer(s,BT_execute);*/
     350          else FreeL((ADDRESS)s);
     351        }
    352352      }
    353353    }

  • Singular/mpsr_Put.cc

    rf4404c r2ba9a6  
    22*  Computer Algebra System SINGULAR     *
    33****************************************/
    4 /* $Id: mpsr_Put.cc,v 1.6 1997-04-10 13:08:37 obachman Exp $ */
     4/* $Id: mpsr_Put.cc,v 1.7 1998-01-16 14:29:55 krueger Exp $ */
    55
    66
    … …  
    217217}
    218218
    219 mpsr_Status_t mpsr_PutProc(MP_Link_pt link, char* pname, char *proc)
     219mpsr_Status_t mpsr_PutProc(MP_Link_pt link, char* pname, procinfov proc)
    220220{
    221221  MP_DictTag_t dict;
    222222  MP_Common_t  cop;
     223  char *iiGetLibProcBuffer(procinfov pi, int part=1);
    223224
    224225  failr(mpsr_tok2mp('=', &dict, &cop));
    … …  
    226227  // A Singular- procedure is sent as a cop with the string as arg
    227228  mp_failr(MP_PutCommonOperatorPacket(link,
    228                                       dict,
    229                                       cop,
    230                                       0,
    231                                       2));
     229                                        dict,
     230                                        cop,
     231                                        0,
     232                                        2));
    232233  mp_failr(MP_PutIdentifierPacket(link, MP_SingularDict, pname,1));
    233234  mp_failr(MP_PutAnnotationPacket(link,
    234                                   MP_SingularDict,
    235                                   MP_AnnotSingularProcDef,
    236                                   0));
    237   mp_return(MP_PutStringPacket(link, proc, 0));
     235                                  MP_SingularDict,
     236                                  MP_AnnotSingularProcDef,
     237                                  0));
     238  if( proc->language == LANG_SINGULAR) {
     239    if (proc->data.s.body == NULL)
     240      iiGetLibProcBuffer(proc);
     241    mp_return(MP_PutStringPacket(link, proc->data.s.body, 0));
     242  }
     243  else
     244    mp_return(MP_PutStringPacket(link, "", 0));
     245  mp_return(MP_Success);
    238246}
    239247

  • Singular/mpsr_Put.h

    rf4404c r2ba9a6  
    22*  Computer Algebra System SINGULAR     *
    33****************************************/
    4 /* $Id: mpsr_Put.h,v 1.5 1997-06-30 17:04:47 obachman Exp $ */
     4/* $Id: mpsr_Put.h,v 1.6 1998-01-16 14:29:56 krueger Exp $ */
    55/***************************************************************
    66 *
    … …  
    8080}
    8181extern mpsr_Status_t mpsr_PutRing(MP_Link_pt link, ring r);
    82 extern mpsr_Status_t mpsr_PutProc(MP_Link_pt link,  char *pname, char* proc);
     82extern mpsr_Status_t mpsr_PutProc(MP_Link_pt link, char *pname,procinfov proc);
    8383inline mpsr_Status_t mpsr_PutDef(MP_Link_pt link, char *name)
    8484{
    … …  
    154154{
    155155  typecheck(v, PROC_CMD);
    156   return mpsr_PutProc(link, v->name, (char *) v->Data());
     156  return mpsr_PutProc(link, v->name, (procinfov) v->Data());
    157157}
    158158inline mpsr_Status_t mpsr_PutDefLeftv(MP_Link_pt link, leftv v)

  • Singular/silink.cc

    rf4404c r2ba9a6  
    22*  Computer Algebra System SINGULAR     *
    33****************************************/
    4 /* $Id: silink.cc,v 1.12 1997-08-12 17:14:43 Singular Exp $ */
     4/* $Id: silink.cc,v 1.13 1998-01-16 14:29:56 krueger Exp $ */
    55
    66/*
    … …  
    639639    fprintf(fd, ")");
    640640  }
    641   else  if (type_id == PROC_CMD || type_id == STRING_CMD)
     641  else  if (type_id == STRING_CMD)
    642642  {
    643643    char *pstr = IDSTRING(h), c;
    … …  
    650650    }
    651651    fputc('"', fd);
     652  }
     653  else  if (type_id == PROC_CMD)
     654  {
     655    procinfov pi = IDPROC(h);
     656    if (pi->language == LANG_SINGULAR) {
     657      if( pi->data.s.body==NULL) iiGetLibProcBuffer(pi);
     658      char *pstr = pi->data.s.body, c;
     659      fputc('"', fd);
     660      while (*pstr != '\0') {
     661        if (*pstr == '"') fputc('\\', fd);
     662        fputc(*pstr, fd);
     663        pstr++;
     664      }
     665      fputc('"', fd);
     666    } else fputs("(null)", fd);
    652667  }
    653668  else

  • Singular/structs.h

    rf4404c r2ba9a6  
    44*  Computer Algebra System SINGULAR     *
    55****************************************/
    6 /* $Id: structs.h,v 1.6 1997-12-03 16:59:06 obachman Exp $ */
     6/* $Id: structs.h,v 1.7 1998-01-16 14:29:57 krueger Exp $ */
    77/*
    88* ABSTRACT
    … …  
    3434class skStrategy;
    3535class ssyStrategy;
     36class procinfo;
    3637
    3738struct  sip_sring;
    … …  
    8283typedef ssyStrategy *      syStrategy;
    8384typedef struct reca *      alg;
     85typedef procinfo *         procinfov;
    8486
    8587struct _scmdnames

  • Singular/subexpr.cc

    rf4404c r2ba9a6  
    9090#endif
    9191  {
    92     if (t/*Typ()*/!=PROC_CMD)
    93     {
    94       const char *n=Name();
    95       char *s;
    96       void *d=Data();
    97       if (errorreported)
    98         return;
    99       if ((store!=NULL)&&(store!=this))
    100         store->CleanUp();
    101 
    102       switch (t /*=Typ()*/)
     92    const char *n=Name();
     93    char *s;
     94    void *d=Data();
     95    if (errorreported)
     96      return;
     97    if ((store!=NULL)&&(store!=this))
     98      store->CleanUp();
     99   
     100    switch (t /*=Typ()*/)
    103101      {
    104102        case UNKNOWN:
    … …  
    140138          ::Print("%-*.*s%d",spaces,spaces," ",(int)d);
    141139          break;
     140       case PROC_CMD:
     141         {
     142           procinfov pi=(procinfov)d;
     143           ::Print("%-*.*s// libname  : %s\n",spaces,spaces," ",
     144                   piProcinfo(pi, "libname"));
     145           ::Print("%-*.*s// procname : %s\n",spaces,spaces," ",
     146                   piProcinfo(pi, "procname"));
     147           ::Print("%-*.*s// type     : %s",spaces,spaces," ",
     148                   piProcinfo(pi, "type"));
     149           //      ::Print("%-*.*s// ref      : %s",spaces,spaces," ",
     150           //   piProcinfo(pi, "ref"));
     151           break;
     152         }
    142153       case LINK_CMD:
    143154          {
    … …  
    188199#endif
    189200      } /* end switch: (Typ()) */
    190     }
    191201  }
    192202  if (next!=NULL)
    … …  
    262272        rKill((ring)data);
    263273        break;
     274      case PROC_CMD:
     275        piKill((procinfov)data);
     276        break;
    264277      case LINK_CMD:
    265278        slKill((si_link)data);
    … …  
    403416      #endif
    404417    case PROC_CMD:
    405       return  (void *)mstrdup((char *)d);
     418      return  (void *)piCopy((procinfov) d);
    406419    case POLY_CMD:
    407420    case VECTOR_CMD:
    … …  
    459472      break;
    460473    case STRING_CMD:
    461     //  data= (void *)mstrdup((char *)d);
    462     //  break;
     474      data= (void *)mstrdup((char *)d);
     475      break;
    463476    case PROC_CMD:
    464       data= (void *)mstrdup((char *)d);
     477      data= (void *)piCopy((procinfov) d);
    465478      break;
    466479    case POLY_CMD:

  • Singular/subexpr.h

    rf4404c r2ba9a6  
    44*  Computer Algebra System SINGULAR     *
    55****************************************/
    6 /* $Id: subexpr.h,v 1.3 1997-04-09 12:20:15 Singular Exp $ */
     6/* $Id: subexpr.h,v 1.4 1998-01-16 14:29:58 krueger Exp $ */
    77/*
    88* ABSTRACT: handling of leftv
    … …  
    8888BOOLEAN assumeStdFlag(leftv h);
    8989
     90class proc_singular
     91{
     92public:
     93  long   proc_start;       // position where proc is starting
     94  long   help_start;       // position where help is starting
     95  long   body_start;       // position where proc-body is starting
     96  long   body_end;         // position where proc-body is ending
     97  long   example_start;    // position where example is starting
     98  long   proc_end;         // position where proc is ending
     99  int    proc_lineno;
     100  int    body_lineno;
     101  int    example_lineno;
     102  char   *body;
     103};
     104
     105struct proc_object
     106{
     107//public:
     108  BOOLEAN (*function)(leftv res, leftv v);
     109};
     110
     111union uprocinfodata;
     112
     113union uprocinfodata
     114{
     115public:
     116  proc_singular  s;        // data of Singular-procedure
     117  struct proc_object    o; // pointer to binary-function
     118};
     119
     120typedef union uprocinfodata procinfodata;
     121
     122typedef enum { LANG_NONE, LANG_SINGULAR, LANG_C } language_defs;
     123
     124class procinfo
     125{
     126public:
     127  char          *libname;
     128  char          *procname;
     129  language_defs language;
     130  short         ref;
     131  procinfodata  data;
     132};
     133
     134inline procinfov piCopy(procinfov pi)
     135{
     136  pi->ref++;
     137  return pi;
     138}
     139void piKill(procinfov l);
     140char *piProcinfo(procinfov pi, char *request);
     141void piShowProcinfo(procinfov pi, char *txt);
    90142#endif

  • Singular/tesths.cc

    rf4404c r2ba9a6  
    22*  Computer Algebra System SINGULAR     *
    33****************************************/
    4 /* $Id: tesths.cc,v 1.28 1997-12-03 16:59:09 obachman Exp $ */
     4/* $Id: tesths.cc,v 1.29 1998-01-16 14:29:59 krueger Exp $ */
    55
    66/*
    … …  
    223223    //if ((h!=NULL) && (IDTYP(h)==PROC_CMD))
    224224    //{
    225     //  IDSTRING(h)=iiGetLibProcBuffer( IDSTRING(h), IDID(h));
     225    //  IDSTRING(h)=iiGetLibProcBuffer( IDPROC(h)));
    226226    //  newBuffer( mstrdup(IDSTRING(h)), BT_execute, IDID(h) );
    227227      //leftv r=iiMake_proc(h,NULL);
Note: See TracChangeset for help on using the changeset viewer.