Index: Singular/ChangeLog
===================================================================
--- Singular/ChangeLog	(revision f4404c2811a260acd825c9312b087b2c2704ae91)
+++ Singular/ChangeLog	(revision 2ba9a69a24ccbc29ecc0e7d5cbb295b889219b25)
@@ -1,2 +1,13 @@
+Fri Jan 16 15:30:07 MET 1998 Kai Krueger <krueger@mathematik.uni-kl.de>
+	* extra.cc,febase.cc,febase.inc,grammar.y,iparith.cc
+	* ipassign.cc,ipid.cc,ipid.h,iplib.cc,ipshell.h,misc.cc
+	* mpsr_Put.cc,mpsr_Put.h,silink.cc,structs.h,subexpr.cc,subexpr.h
+	* tesths.cc 
+	  Implementation of new proc-scheme done.
+	
+Fri Jan 16 14:51:07 MET 1998 Kai Krueger <krueger@mathematik.uni-kl.de>
+	* Makefile.in,tests/mpcheck,teste/comparecheck:
+	  fixed use of correct Singular during checks
+
 Fri Jan 16 09:23:07 MET 1998
         * changes for TEST_MAC_ORDER, part 1 (hannes)
Index: Singular/extra.cc
===================================================================
--- Singular/extra.cc	(revision f4404c2811a260acd825c9312b087b2c2704ae91)
+++ Singular/extra.cc	(revision 2ba9a69a24ccbc29ecc0e7d5cbb295b889219b25)
@@ -2,5 +2,5 @@
 *  Computer Algebra System SINGULAR      *
 *****************************************/
-/* $Id: extra.cc,v 1.26 1998-01-12 17:32:46 Singular Exp $ */
+/* $Id: extra.cc,v 1.27 1998-01-16 14:29:47 krueger Exp $ */
 /*
 * ABSTRACT: general interface to internals of Singular ("system" command)
@@ -81,5 +81,5 @@
       {
         res->rtyp=STRING_CMD;
-        res->data=mstrdup(iiGetLibName(IDSTRING(hh)));
+        res->data=mstrdup(iiGetLibName(IDPROC(hh)));
         if (res->data==NULL) res->data=mstrdup("");
         return FALSE;
@@ -87,4 +87,14 @@
       else
         Warn("`%s` not found",(char*)h->next->Data());
+    }
+    else
+/*==================== proclist =================================*/
+    if(strcmp((char*)(h->Data()),"proclist")==0)
+    {
+      int piShowProcList();
+      res->rtyp=STRING_CMD;
+      res->data=(void *)mstrdup("");
+      piShowProcList();
+      return FALSE;
     }
     else
Index: Singular/grammar.y
===================================================================
--- Singular/grammar.y	(revision f4404c2811a260acd825c9312b087b2c2704ae91)
+++ Singular/grammar.y	(revision 2ba9a69a24ccbc29ecc0e7d5cbb295b889219b25)
@@ -2,5 +2,5 @@
 *  Computer Algebra System SINGULAR     *
 ****************************************/
-/* $Id: grammar.y,v 1.19 1997-09-12 08:27:08 Singular Exp $ */
+/* $Id: grammar.y,v 1.20 1998-01-16 14:29:49 krueger Exp $ */
 /*
 * ABSTRACT: SINGULAR shell grammatik
@@ -42,4 +42,7 @@
 #include "lists.h"
 
+
+procinfo *iiInitSingularProcinfo(procinfo *pi, char *libname,
+                                 char *procname, int line, long pos);
 
 extern int   yylineno;
@@ -1395,12 +1398,14 @@
         PROC_CMD extendedid BLOCKTOK
           {
+	    procinfov pi;
             idhdl h = enterid($2,myynest,PROC_CMD,&idroot,FALSE);
             if (h==NULL) {FreeL((ADDRESS)$3); YYERROR;}
-            IDSTRING(h) = (char *)AllocL(strlen($3)+31);
-            sprintf(IDSTRING(h),"parameter list #;\n%s;return();\n\n",$3);
+	    iiInitSingularProcinfo(IDPROC(h),"", $2, 0, 0);
+	    IDPROC(h)->data.s.body = (char *)AllocL(strlen($3)+31);;
+	    sprintf(IDPROC(h)->data.s.body,"parameter list #;\n%s;return();\n\n",$3);
             FreeL((ADDRESS)$3);
           }
         | PROC_DEF STRINGTOK BLOCKTOK
-          {
+          { 
             idhdl h = enterid($1,myynest,PROC_CMD,&idroot,FALSE);
             if (h==NULL)
@@ -1411,10 +1416,12 @@
             }
             char *args=iiProcArgs($2,FALSE);
-            FreeL((ADDRESS)$2);
-            IDSTRING(h) = (char *)AllocL(strlen($3)+strlen(args)+14);
-            sprintf(IDSTRING(h),"%s\n%s;RETURN();\n\n",args,$3);
+            procinfov pi;
+	    FreeL((ADDRESS)$2);
+	    iiInitSingularProcinfo(IDPROC(h),"", $1, 0, 0);
+	    IDPROC(h)->data.s.body = (char *)AllocL(strlen($3)+strlen(args)+14);;
+	    sprintf(IDPROC(h)->data.s.body,"%s\n%s;RETURN();\n\n",args,$3);
             FreeL((ADDRESS)args);
             FreeL((ADDRESS)$3);
-            //Print(">>%s<<\n",IDSTRING(h));
+            //Print(">>%s<<\n",IDPROC(h)->data.s.body);
           }
         ;
Index: Singular/iparith.cc
===================================================================
--- Singular/iparith.cc	(revision f4404c2811a260acd825c9312b087b2c2704ae91)
+++ Singular/iparith.cc	(revision 2ba9a69a24ccbc29ecc0e7d5cbb295b889219b25)
@@ -2689,5 +2689,8 @@
 static BOOLEAN jjSTRING_PROC(leftv res, leftv v)
 {
-  res->data=mstrdup(IDSTRING((idhdl)v->data));
+  procinfov pi = IDPROC((idhdl)v->data);
+  if(pi->language == LANG_SINGULAR)
+    res->data=mstrdup(pi->data.s.body);
+  else res->data=mstrdup("");
   return FALSE;
 }
Index: Singular/ipassign.cc
===================================================================
--- Singular/ipassign.cc	(revision f4404c2811a260acd825c9312b087b2c2704ae91)
+++ Singular/ipassign.cc	(revision 2ba9a69a24ccbc29ecc0e7d5cbb295b889219b25)
@@ -2,5 +2,5 @@
 *  Computer Algebra System SINGULAR     *
 ****************************************/
-/* $Id: ipassign.cc,v 1.19 1997-11-13 10:52:44 Singular Exp $ */
+/* $Id: ipassign.cc,v 1.20 1998-01-16 14:29:52 krueger Exp $ */
 
 /*
@@ -330,4 +330,23 @@
   return FALSE;
 }
+static BOOLEAN jiA_PROC(leftv res, leftv a, Subexpr e)
+{
+  extern procinfo *iiInitSingularProcinfo(procinfo *pi, char *libname,
+				   char *procname, int line, long pos);
+  extern void piCleanUp(procinfov pi);
+
+  if(res->data!=NULL) piCleanUp((procinfo *)res->data);
+  if(a->rtyp==STRING_CMD) {
+    res->data = (void *)Alloc(sizeof(procinfo));
+    memset(res->data,0,sizeof(*(res->data)));
+    ((procinfo *)(res->data))->language=LANG_NONE;
+    iiInitSingularProcinfo((procinfo *)res->data,"",res->name,0,0);
+    ((procinfo *)res->data)->data.s.body=(void *)a->CopyD(STRING_CMD);
+  }
+  else
+    res->data=(void *)a->CopyD(PROC_CMD);
+  jiAssignAttr(res,a);
+  return FALSE;
+}
 static BOOLEAN jiA_INTVEC(leftv res, leftv a, Subexpr e)
 {
@@ -478,6 +497,6 @@
 ,{jiA_RING,     QRING_CMD,      QRING_CMD }
 ,{jiA_STRING,   STRING_CMD,     STRING_CMD }
-,{jiA_STRING,   PROC_CMD,       STRING_CMD }
-,{jiA_STRING,   PROC_CMD,       PROC_CMD }
+,{jiA_PROC,     PROC_CMD,       STRING_CMD }
+,{jiA_PROC,     PROC_CMD,       PROC_CMD }
 ,{jiA_POLY,     VECTOR_CMD,     VECTOR_CMD }
 ,{jiA_INTVEC,   INTVEC_CMD,     INTVEC_CMD }
Index: Singular/ipid.cc
===================================================================
--- Singular/ipid.cc	(revision f4404c2811a260acd825c9312b087b2c2704ae91)
+++ Singular/ipid.cc	(revision 2ba9a69a24ccbc29ecc0e7d5cbb295b889219b25)
@@ -2,5 +2,5 @@
 *  Computer Algebra System SINGULAR     *
 ****************************************/
-/* $Id: ipid.cc,v 1.8 1997-12-18 14:26:35 Singular Exp $ */
+/* $Id: ipid.cc,v 1.9 1998-01-16 14:29:52 krueger Exp $ */
 
 /*
@@ -95,7 +95,4 @@
         IDMAP(h)->preimage = mstrdup(IDID(currRingHdl));
         break;
-      case PROC_CMD:
-        IDSTRING(h) = mstrdup("parameter list #;\nreturn();\n\n");
-        break;
       case STRING_CMD:
         IDSTRING(h) = mstrdup("");
@@ -125,4 +122,9 @@
       IDSTRING(h) = (char *)Alloc0(len);
     }
+  }
+  if(t == PROC_CMD) {
+    IDPROC(h) = (procinfo *)Alloc(sizeof(procinfo));
+    memset(IDPROC(h),0,sizeof(*IDPROC(h)));
+    IDPROC(h)->language=LANG_NONE;
   }
   return  h;
@@ -323,11 +325,14 @@
     idDelete(&iid);
   }
-  // string / proc / binary ------------------------------------------------
-  else if ((IDTYP(h) == STRING_CMD)
-           ||(IDTYP(h) == PROC_CMD)
-      )
+  // string -------------------------------------------------------------
+  else if (IDTYP(h) == STRING_CMD)
   {
     FreeL((ADDRESS)IDSTRING(h));
     //IDSTRING(h)=NULL;
+  }
+  // proc ---------------------------------------------------------------
+  else if (IDTYP(h) == PROC_CMD)
+  {
+    piKill(IDPROC(h));
   }
   // number -------------------------------------------------------------
@@ -474,2 +479,47 @@
   }
 }
+
+char * piProcinfo(procinfov pi, char *request)
+{
+  if(pi == NULL) return "empty proc";
+  else if (strcmp(request, "libname")  == 0) return pi->libname;
+  else if (strcmp(request, "procname") == 0) return pi->procname;
+  else if (strcmp(request, "type")     == 0) {
+    switch (pi->language) {
+      case LANG_SINGULAR: return "singular"; break;
+      case LANG_C:        return "object";   break;
+      case LANG_NONE:     return "none";     break;
+      default:            return "unknow language";
+    }
+  } else if (strcmp(request, "ref")      == 0) {
+    char p[8];
+    sprintf(p, "%d\0", pi->ref);
+    return mstrdup(p);
+  }
+
+}
+
+void piCleanUp(procinfov pi)
+{
+  (pi->ref)--;
+  if (pi->ref <= 0)
+  {
+    FreeL((ADDRESS)pi->libname);
+    FreeL((ADDRESS)pi->procname);
+    if( pi->language == LANG_SINGULAR) { 
+      FreeL((ADDRESS)pi->data.s.body);
+    }
+    if( pi->language == LANG_C) {
+    }
+    memset((void *) pi, 0, sizeof(procinfo));
+    pi->language=LANG_NONE;
+  }
+}
+
+void piKill(procinfov pi)
+{
+  piCleanUp(pi);
+  if (pi->ref <= 0)
+    Free((ADDRESS)pi, sizeof(procinfo));
+}
+
Index: Singular/ipid.h
===================================================================
--- Singular/ipid.h	(revision f4404c2811a260acd825c9312b087b2c2704ae91)
+++ Singular/ipid.h	(revision 2ba9a69a24ccbc29ecc0e7d5cbb295b889219b25)
@@ -4,5 +4,5 @@
 *  Computer Algebra System SINGULAR     *
 ****************************************/
-/* $Id: ipid.h,v 1.7 1998-01-12 18:59:49 obachman Exp $ */
+/* $Id: ipid.h,v 1.8 1998-01-16 14:29:53 krueger Exp $ */
 /*
 * ABSTRACT: identfier handling
@@ -95,4 +95,5 @@
   si_link       li;
   package       pack;
+  procinfo *    pinf;
 };
 
@@ -130,4 +131,5 @@
 #define IDLINK(a)   ((a)->data.li)
 #define IDPACKAGE(a) ((a)->data.pack)
+#define IDPROC(a)   ((a)->data.pinf)
 
   idrec() { memset(this,0,sizeof(*this)); }
Index: Singular/iplib.cc
===================================================================
--- Singular/iplib.cc	(revision f4404c2811a260acd825c9312b087b2c2704ae91)
+++ Singular/iplib.cc	(revision 2ba9a69a24ccbc29ecc0e7d5cbb295b889219b25)
@@ -2,5 +2,5 @@
 *  Computer Algebra System SINGULAR     *
 ****************************************/
-/* $Id: iplib.cc,v 1.7 1997-07-09 15:54:01 Singular Exp $ */
+/* $Id: iplib.cc,v 1.8 1998-01-16 14:29:53 krueger Exp $ */
 /*
 * ABSTRACT: interpreter: LIB and help
@@ -22,27 +22,17 @@
 #include "lists.h"
 
+procinfo *iiInitSingularProcinfo(procinfo *pi, char *libname,
+                                 char *procname, int line, long pos);
+char *iiConvName(char *p);
+
 /*2
 * find the library of an proc:
-* first case: IDSTRING="LIB:xyz.lib"
-*  => return (string+4)
-* second case: IDSTRING=".....);\n"
-*  => return NULL; (no lib known)
-* else: IDSTRING="....\nxxx.lib"
-*  => return (xxx.lib)
+*  => return (pi->libname)
 */
-char * iiGetLibName(char *procstr)
+char * iiGetLibName(procinfov pi)
 {
   char *res=NULL;
 
-  if (strncmp(procstr,"LIB:",4)==0)
-  {
-    res=(procstr+4);
-  }
-  else
-  {
-    int l=strlen(procstr)-1; /* procstr[l] is the last character */
-    while((l>0) && (procstr[l]!='\n')) l--;
-    if (procstr[l]=='\n') res=(procstr+l+1);
-  }
+  res = pi->libname;
   return res;
 }
@@ -111,142 +101,79 @@
   return argstr;
 }
+
 /*2
 * locate `procname` in lib `libname` and find the part `part`:
 *  part=0: help, between, but excluding the line "proc ..." and "{...":
-*    => Print, return NULL
+*    => return
 *  part=1: body, between "{ ..." and "}", including the 1. line, w/o "{"
-*    => FreeL(libname), return
+*    => set pi->data.s.body, return NULL
 *  part=2: example, between, but excluding the line "exapmle {..." and "}":
 *    => return
 */
-char* iiGetLibProcBuffer( char* libname, char* procname, int part )
-{
-  /* =========== open lib ==============*/
-  char buf[256];
-  if (part==1)
-  {
-    // libname comes as LIB:name
-    libname += 4;
-    //libname[strlen(libname)-1] = '\0';
-  }
-  FILE * fp = feFopen( libname, "rb", NULL, TRUE );
+char* iiGetLibProcBuffer(procinfo *pi, int part )
+{
+  char buf[256], *s = NULL, *p;
+  long procbuflen;
+
+  FILE * fp = feFopen( pi->libname, "rb", NULL, TRUE );
   if (fp==NULL)
   {
-    if (part==1) FreeL((ADDRESS)(libname-4));
     return NULL;
   }
 
-  /* =========== search lib =========== */
-  while (fgets( buf, sizeof(buf), fp))
-  {
-    /* search for lines "proc ..." */
-    if (strncmp( buf, "proc ", 5) == 0)
-    {
-      char ct;
-      char *e;
-      char *s=iiProcName(buf,ct,e);
-      char *argstr=NULL;
-      if (strcmp( s, procname ) == 0)
-      {
-        if (part==1)
-        {
-          // =========== processing of argument list =============
-          *e=ct;
-          argstr=iiProcArgs(e,TRUE);
-        }
-        int procbuflen;
-        // =========== search beginning of proc body ============
-        long startpos = ftell( fp );
-        loop
-        {
-          if(!fgets( buf, sizeof(buf), fp)) return NULL; // search "{"
-          //if (strchr(buf,'{')!=NULL)
-          if (buf[0]=='{')
-          {
-             if (part==0) return NULL;
-             procbuflen=strlen(buf);
-             break;
-          }
-          if (part==0) PrintS(buf);
-          startpos = ftell( fp );
-        }
-
-        // =========== search end of proc body ============
-        // read till "}", to calculate length of procbuffer
-        while (fgets( buf, sizeof(buf), fp))
-        {
-          if (buf[0] == '}') break;
-          procbuflen += strlen(buf);
-        }
-        // =========== search example part ============
-        if (part==2)
-        {
-          procbuflen = 0;
-          loop
-          {
-            /* EOF ? */
-            if (!fgets( buf, sizeof(buf), fp))
-              return NULL;
-            /* found ? */
-            if (strncmp( buf, "example", 7) == 0)
-              break;
-            /* next proc ? */
-            if (strncmp( buf, "proc ", 5) == 0)
-              return NULL;
-          }
-          startpos = ftell( fp );
-          while (fgets( buf, sizeof(buf), fp))
-          {
-            if (buf[0] == '}') break;
-            procbuflen += strlen(buf);
-          }
-          //Print("start:%d, len:%d\n",startpos,procbuflen);
-        }
-
-        // =========== read the part ===========
-        char* procbuf;
-        if (part==1) procbuf = (char *)AllocL( strlen(argstr)+procbuflen+14+strlen(libname) );
-        else         procbuf = (char *)AllocL( procbuflen+14+strlen(libname) );
-        if (procbuf==NULL)
-        {
-          Werror( "unable to allocate proc buffer `%s`", procname );
-          if (part==1) FreeL((ADDRESS)(libname-4));
-          return NULL;
-        }
-        fseek( fp, startpos, SEEK_SET );
-        if (part==1)
-        {
-          strcpy(procbuf,argstr);
-          fread( procbuf+strlen(argstr), procbuflen, 1, fp);
-          procbuflen+=strlen(argstr);
-          FreeL(argstr);
-        }
-        else
-        {
-          fread( procbuf, procbuflen, 1, fp);
-        }
-        fclose( fp );
-        procbuf[procbuflen] = '\0';
-
-        // =========== modify text ===========
-        //if ((part==1)||(part==2))
-        {
-          //strcpy( procbuf+procbuflen, "\n;RETURN();\n" );
-          strcat( procbuf+procbuflen-3, "\n;RETURN();\n\n" );
-          if (part==1)
-          {
-            strcat( procbuf+procbuflen+10,libname);
-            FreeL((ADDRESS)(libname-4));
-          }
-        }
-        s=strchr(procbuf,'{');
-        if (s!=NULL) *s=' ';
-        //Print("end iiGetLibProcBuffer, changed pos: %d, s=%x\n",procbuf-s,s);
-        return procbuf;
-      }
-    }
-  }
-  Werror( "`%s` not found in LIB `%s`", procname, libname );
-  if (part==1) FreeL((ADDRESS)(libname-4));
+  fseek(fp, pi->data.s.proc_start, SEEK_SET);
+  if(part==0) { // load help string
+    procbuflen = pi->data.s.body_start - pi->data.s.proc_start;
+    //Print("Help=%ld-%ld=%d\n", pi->data.s.body_start,
+    //    pi->data.s.proc_start, procbuflen);
+    s = (char *)AllocL(procbuflen);
+    fread(s, procbuflen, 1, fp);
+    s[procbuflen] = '\0';
+    return(s);
+  }
+  if(part==1) { // load proc part
+    fgets(buf, sizeof(buf), fp);
+    char ct;
+    char *e;
+    s=iiProcName(buf,ct,e);
+    char *argstr=NULL;
+    *e=ct;
+    argstr=iiProcArgs(e,TRUE);
+    procbuflen = pi->data.s.body_end - pi->data.s.body_start;
+    pi->data.s.body = (char *)AllocL( strlen(argstr)+procbuflen+15+
+				      strlen(pi->libname) );
+    //Print("Body=%ld-%ld=%d\n", pi->data.s.body_end,
+    //    pi->data.s.body_start, procbuflen);
+    if (pi->data.s.body==NULL) {
+      Werror( "unable to allocate proc buffer `%s`", pi->procname );
+      return NULL;
+    }
+    fseek(fp, pi->data.s.body_start, SEEK_SET);
+    strcpy(pi->data.s.body,argstr);
+    fread( pi->data.s.body+strlen(argstr), procbuflen, 1, fp);
+    procbuflen+=strlen(argstr);
+    FreeL(argstr);
+    fclose( fp );
+    pi->data.s.body[procbuflen] = '\0';
+    strcat( pi->data.s.body+procbuflen, "\n;\nRETURN();\n\n" );
+    strcat( pi->data.s.body+procbuflen+13,pi->libname);
+    s=strchr(pi->data.s.body,'{');
+    if (s!=NULL) *s=' ';
+    return NULL;
+  }
+  if(part==2) { // load example
+    fseek(fp, pi->data.s.example_start, SEEK_SET);
+    fgets(buf, sizeof(buf), fp);
+    procbuflen = pi->data.s.proc_end - pi->data.s.example_start - strlen(buf);
+    //Print("Example=%ld-%ld=%d\n", pi->data.s.proc_end,
+    //  pi->data.s.example_start, procbuflen);
+    s = (char *)AllocL(procbuflen+14);
+    fread(s, procbuflen, 1, fp);
+    s[procbuflen] = '\0';
+    strcat(s+procbuflen-3, "\n;RETURN();\n\n" );
+    p=strchr(s,'{');
+    if (p!=NULL) *s=' ';
+    return(s);
+  }
   return NULL;
 }
@@ -302,10 +229,15 @@
     if (pn!=NULL)
     {
-      if (strncmp( IDSTRING(pn), "LIB:", 4 ) == 0)
-      {
-        IDSTRING(pn) = iiGetLibProcBuffer( IDSTRING(pn), IDID(pn) );
-        if (IDSTRING(pn)==NULL) return TRUE;
-      }
-      newBuffer( mstrdup(IDSTRING(pn)), BT_proc, IDID(pn) );
+      procinfov pi;
+      pi = IDPROC(pn);
+      if(pi!=NULL) {
+        if( pi->data.s.body==NULL ) {
+	  iiGetLibProcBuffer(IDPROC(pn));
+	  if (IDPROC(pn)->data.s.body==NULL) return TRUE;
+	}
+	newBuffer( mstrdup(IDPROC(pn)->data.s.body), BT_proc, IDID(pn) );
+      } else { // for security only
+        newBuffer( mstrdup(IDSTRING(pn)), BT_proc, IDID(pn) );
+      }
       fileVoice = voice;
     }
@@ -393,4 +325,5 @@
 {
   int err;
+  procinfov pi = IDPROC(pn);
   iiCheckNest();
   iiLocalRing[myynest]=currRing;
@@ -404,5 +337,23 @@
   if (traceit&TRACE_SHOW_RINGS) iiShowLevRings();
 #endif
-  err=iiPStart(pn,NULL,sl);
+#if 1
+  if(pi->language == LANG_SINGULAR) err=iiPStart(pn,NULL,sl);
+  if(pi->language == LANG_C) {
+    leftv res = (leftv)Alloc0(sizeof(sleftv));
+    err = (pi->data.o.function)(res, sl);
+    iiRETURNEXPR[myynest+1].Copy(res);
+    Free((ADDRESS)res, sizeof(sleftv));
+  }
+#else
+  switch (pi->language) {
+    case LANG_SINGULAR: err=iiPStart(pn,NULL,sl); break;
+    case LANG_C: leftv res = (leftv)Alloc0(sizeof(sleftv));
+      err = (pi->data.o.function)(res, sl);
+      iiRETURNEXPR[myynest+1].Copy(res);
+      Free((ADDRESS)res, sizeof(sleftv));
+      break;
+    default: err=TRUE;
+  }
+#endif
   if (traceit&TRACE_SHOW_PROC)
   {
@@ -504,4 +455,7 @@
   char libnamebuf[128];
   idhdl h,hl;
+  int lines = 1;
+  long pos = 0L;
+  procinfov pi;
   FILE * fp = feFopen( newlib, "r", libnamebuf, tellerror );
   if (fp==NULL)
@@ -589,8 +543,11 @@
   #define IN_HEADER 1
   #define IN_BODY   2
-  #define IN_LIB_HEADER 3
+  #define IN_EXAMPLE      3
+  #define IN_EXAMPLE_BODY 4
+  #define IN_LIB_HEADER   5
   int v=-1,otherLines=0,inBlock=IN_LIB_HEADER;
   do /*while (fgets( buf, sizeof(buf), fp))*/
   {
+    int  offset;
     if (buf[0]!='\n')
     {
@@ -618,12 +575,22 @@
         {
           char proc[256];
+          char ct1, *e;
           sscanf( buf, "proc %s", proc);
+	  offset = 2;
           char *ct=strchr(proc,'(');
-          if (ct!=NULL) *ct='\0';
+          if (ct!=NULL) { *ct='\0'; offset=3; }
           sprintf( buf, "LIB:%s", newlib);
-          h = enterid( mstrdup(proc), myynest, PROC_CMD, &idroot, FALSE );
+#if 0
+          if(strcmp(proc, "_init")==0) {
+            char *p =  iiConvName(newlib);
+            Print("Init found:%s;\n", p);
+            h = enterid( mstrdup(p), myynest, PROC_CMD, &idroot, FALSE );
+            FreeL((ADDRESS)p);
+          } else
+#endif
+            h = enterid( mstrdup(proc), myynest, PROC_CMD, &idroot, FALSE );
           if (h!=NULL)
           {
-            IDSTRING(h) = mstrdup( buf );
+            iiInitSingularProcinfo(IDPROC(h),newlib,proc,lines,pos);
             if (BVERBOSE(V_LOAD_PROC)) Warn( "     proc %s loaded", proc );
           }
@@ -640,5 +607,7 @@
         else if (strncmp( buf, "example", 7) == 0)
         {
-          inBlock=IN_HEADER;
+          IDPROC(h)->data.s.example_start = pos;
+          IDPROC(h)->data.s.example_lineno = lines;
+          inBlock=IN_EXAMPLE;
         }
         else if (strncmp( buf, "//", 2) != 0)
@@ -650,21 +619,33 @@
         }
       }
-      else if (inBlock==IN_HEADER)
+      else if ((inBlock==IN_HEADER) || (inBlock==IN_EXAMPLE))
       {
         if (buf[0]=='{')
         {
+          if(inBlock==IN_HEADER) {
+            IDPROC(h)->data.s.body_start = pos;
+            IDPROC(h)->data.s.body_lineno = lines-offset;
+	    // Print("%s: %d-%d\n", pi->procname, lines, offset);
+          }
           inBlock=IN_BODY;
         }
       }
-      else if (inBlock==IN_BODY)
+      else if ((inBlock==IN_BODY) || (inBlock==IN_EXAMPLE_BODY))
       {
         if (buf[0]=='}')
-        {
-          inBlock=0;
-        }
-      }
-    }
+	  {
+            if(IDPROC(h)->data.s.example_start==0)
+	      IDPROC(h)->data.s.example_start=pos;
+            if(IDPROC(h)->data.s.body_end==0) IDPROC(h)->data.s.body_end=pos;
+            IDPROC(h)->data.s.proc_end = pos;
+	    inBlock=0;
+	  }
+      }
+    }
+    lines++;
+    pos = ftell(fp);
   } while (fgets( buf, sizeof(buf), fp));
   fclose( fp );
+  //if (h!=NULL) IDPROC(h) = pi;
   if (BVERBOSE(V_DEBUG_LIB))
   {
@@ -680,2 +661,82 @@
 }
 
+procinfo *iiInitSingularProcinfo(procinfov pi, char *libname,
+                                 char *procname, int line, long pos)
+{
+  pi->libname = mstrdup(libname);
+
+  if( strcmp(procname,"_init")==0) { 
+    char *p = iiConvName(libname);
+    pi->procname = mstrdup(p);
+    FreeL((ADDRESS)p);
+  } else pi->procname = mstrdup(procname);
+  pi->language = LANG_SINGULAR;
+  pi->ref = 1;
+  pi->data.s.proc_start = pos;
+  pi->data.s.help_start = 0L;
+  pi->data.s.body_start = 0L;
+  pi->data.s.body_end   = 0L;
+  pi->data.s.example_start = 0L;
+  pi->data.s.proc_lineno = line;
+  pi->data.s.body_lineno = 0;
+  pi->data.s.example_lineno = 0;
+  pi->data.s.body = NULL;
+  return(pi);
+}
+
+/*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
+char *iiConvName(char *libname)
+{
+  char *p = AllocL(strlen(libname)+7);
+  char *q = mstrdup(libname);
+  char *r = q;
+  for(; *r!='\0'; r++) {
+    if(*r=='.') *r='_';
+    if(*r==':') *r='_';
+  }
+  sprintf(p, "%s_init\0", q);
+  FreeL((ADDRESS)q);
+  return(p);
+}
+
+/*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
+int piShowProcList()
+{
+  idhdl h;
+  procinfo *proc;
+  char *name;
+
+  Print( "%-15s  %20s      %s,%s  %s,%s   %s,%s\n", "Library", "function",
+	 "line", "start", "line", "body", "line", "example");
+  for(h = idroot; h != NULL; h = IDNEXT(h)) {
+    if(IDTYP(h) == PROC_CMD) {
+      proc = IDPROC(h);
+      if(strcmp(proc->procname, IDID(h))!=0) {
+	name = AllocL(strlen(IDID(h))+strlen(proc->procname)+4);
+	sprintf(name, "%s -> %s", IDID(h), proc->procname);
+	Print( "%-15s  %20s ", proc->libname, name);
+	FreeL(name);
+      } else Print( "%-15s  %20s ", proc->libname, proc->procname);
+      if(proc->language==LANG_SINGULAR) 
+        Print("line %4d,%-5ld  %4d,%-5ld  %4d,%-5ld\n", 
+              proc->data.s.proc_lineno, proc->data.s.proc_start,
+              proc->data.s.body_lineno, proc->data.s.body_start,
+              proc->data.s.example_lineno, proc->data.s.example_start);
+      else if(proc->language==LANG_C) Print("type: object\n");
+
+    }
+  }
+}
+
+/*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*/
+char *iiLineNo(char *procname, int lineno)
+{
+  char buf[256];
+  idhdl pn = ggetid(procname);
+  procinfo *pi = IDPROC(pn);
+  
+  sprintf(buf, "%s %3d\0", procname, lineno);
+  //sprintf(buf, "%s::%s %3d\0", pi->libname, pi->procname,
+  //  lineno + pi->data.s.body_lineno);
+  return(buf);
+}
Index: Singular/ipshell.h
===================================================================
--- Singular/ipshell.h	(revision f4404c2811a260acd825c9312b087b2c2704ae91)
+++ Singular/ipshell.h	(revision 2ba9a69a24ccbc29ecc0e7d5cbb295b889219b25)
@@ -4,5 +4,5 @@
 *  Computer Algebra System SINGULAR     *
 ****************************************/
-/* $Id: ipshell.h,v 1.9 1997-07-11 14:27:55 Singular Exp $ */
+/* $Id: ipshell.h,v 1.10 1998-01-16 14:29:54 krueger Exp $ */
 /*
 * ABSTRACT
@@ -46,6 +46,6 @@
 BOOLEAN iiExport(leftv v, int toLev);
 BOOLEAN iiExport(leftv v, int toLev, idhdl &root);
-char *  iiGetLibName(char *procstr);
-char *  iiGetLibProcBuffer( char* libname, char* procname, int part=1 );
+char *  iiGetLibName(procinfov v);
+char *  iiGetLibProcBuffer( procinfov pi, int part=1 );
 char *  iiProcName(char *buf, char & ct, char* &e);
 char *  iiProcArgs(char *e,BOOLEAN withParenth);
Index: Singular/misc.cc
===================================================================
--- Singular/misc.cc	(revision f4404c2811a260acd825c9312b087b2c2704ae91)
+++ Singular/misc.cc	(revision 2ba9a69a24ccbc29ecc0e7d5cbb295b889219b25)
@@ -331,5 +331,5 @@
   if ((h!=NULL) && (IDTYP(h)==PROC_CMD))
   {
-    char *lib=iiGetLibName(IDSTRING(h));
+    char *lib=iiGetLibName(IDPROC(h));
     Print("// proc %s ",s);
     if((lib==NULL)||(*lib=='\0'))
@@ -340,14 +340,14 @@
     {
       Print("from lib %s\n",lib);
-      if (!example)
-        iiGetLibProcBuffer(lib,s,0);
-      else
-      {
-        s=iiGetLibProcBuffer(lib,s,2);
-        if (s!=NULL)
-        {
-          if (strlen(s)>5) iiEStart(s); /*newBuffer(s,BT_execute);*/
-          else FreeL((ADDRESS)s);
-        }
+      s=iiGetLibProcBuffer(IDPROC(h), example ? 2 : 0);
+      if (!example) {
+	PrintS(s);
+	FreeL((ADDRESS)s);
+      }
+      else {
+	if (s!=NULL) {
+	  if (strlen(s)>5) iiEStart(s); /*newBuffer(s,BT_execute);*/
+	  else FreeL((ADDRESS)s);
+	}
       }
     }
Index: Singular/mpsr_Put.cc
===================================================================
--- Singular/mpsr_Put.cc	(revision f4404c2811a260acd825c9312b087b2c2704ae91)
+++ Singular/mpsr_Put.cc	(revision 2ba9a69a24ccbc29ecc0e7d5cbb295b889219b25)
@@ -2,5 +2,5 @@
 *  Computer Algebra System SINGULAR     *
 ****************************************/
-/* $Id: mpsr_Put.cc,v 1.6 1997-04-10 13:08:37 obachman Exp $ */
+/* $Id: mpsr_Put.cc,v 1.7 1998-01-16 14:29:55 krueger Exp $ */
 
 
@@ -217,8 +217,9 @@
 }
 
-mpsr_Status_t mpsr_PutProc(MP_Link_pt link, char* pname, char *proc)
+mpsr_Status_t mpsr_PutProc(MP_Link_pt link, char* pname, procinfov proc)
 {
   MP_DictTag_t dict;
   MP_Common_t  cop;
+  char *iiGetLibProcBuffer(procinfov pi, int part=1);
 
   failr(mpsr_tok2mp('=', &dict, &cop));
@@ -226,14 +227,21 @@
   // A Singular- procedure is sent as a cop with the string as arg
   mp_failr(MP_PutCommonOperatorPacket(link,
-                                      dict,
-                                      cop,
-                                      0,
-                                      2));
+					dict,
+					cop,
+					0,
+					2));
   mp_failr(MP_PutIdentifierPacket(link, MP_SingularDict, pname,1));
   mp_failr(MP_PutAnnotationPacket(link,
-                                  MP_SingularDict,
-                                  MP_AnnotSingularProcDef,
-                                  0));
-  mp_return(MP_PutStringPacket(link, proc, 0));
+				  MP_SingularDict,
+				  MP_AnnotSingularProcDef,
+				  0));
+  if( proc->language == LANG_SINGULAR) {
+    if (proc->data.s.body == NULL)
+      iiGetLibProcBuffer(proc);
+    mp_return(MP_PutStringPacket(link, proc->data.s.body, 0));
+  }
+  else
+    mp_return(MP_PutStringPacket(link, "", 0));
+  mp_return(MP_Success);
 }
 
Index: Singular/mpsr_Put.h
===================================================================
--- Singular/mpsr_Put.h	(revision f4404c2811a260acd825c9312b087b2c2704ae91)
+++ Singular/mpsr_Put.h	(revision 2ba9a69a24ccbc29ecc0e7d5cbb295b889219b25)
@@ -2,5 +2,5 @@
 *  Computer Algebra System SINGULAR     *
 ****************************************/
-/* $Id: mpsr_Put.h,v 1.5 1997-06-30 17:04:47 obachman Exp $ */
+/* $Id: mpsr_Put.h,v 1.6 1998-01-16 14:29:56 krueger Exp $ */
 /***************************************************************
  *
@@ -80,5 +80,5 @@
 }
 extern mpsr_Status_t mpsr_PutRing(MP_Link_pt link, ring r);
-extern mpsr_Status_t mpsr_PutProc(MP_Link_pt link,  char *pname, char* proc);
+extern mpsr_Status_t mpsr_PutProc(MP_Link_pt link, char *pname,procinfov proc);
 inline mpsr_Status_t mpsr_PutDef(MP_Link_pt link, char *name)
 {
@@ -154,5 +154,5 @@
 {
   typecheck(v, PROC_CMD);
-  return mpsr_PutProc(link, v->name, (char *) v->Data());
+  return mpsr_PutProc(link, v->name, (procinfov) v->Data());
 }
 inline mpsr_Status_t mpsr_PutDefLeftv(MP_Link_pt link, leftv v)
Index: Singular/silink.cc
===================================================================
--- Singular/silink.cc	(revision f4404c2811a260acd825c9312b087b2c2704ae91)
+++ Singular/silink.cc	(revision 2ba9a69a24ccbc29ecc0e7d5cbb295b889219b25)
@@ -2,5 +2,5 @@
 *  Computer Algebra System SINGULAR     *
 ****************************************/
-/* $Id: silink.cc,v 1.12 1997-08-12 17:14:43 Singular Exp $ */
+/* $Id: silink.cc,v 1.13 1998-01-16 14:29:56 krueger Exp $ */
 
 /*
@@ -639,5 +639,5 @@
     fprintf(fd, ")");
   }
-  else  if (type_id == PROC_CMD || type_id == STRING_CMD)
+  else  if (type_id == STRING_CMD)
   {
     char *pstr = IDSTRING(h), c;
@@ -650,4 +650,19 @@
     }
     fputc('"', fd);
+  }
+  else  if (type_id == PROC_CMD)
+  { 
+    procinfov pi = IDPROC(h);
+    if (pi->language == LANG_SINGULAR) {
+      if( pi->data.s.body==NULL) iiGetLibProcBuffer(pi);
+      char *pstr = pi->data.s.body, c;
+      fputc('"', fd);
+      while (*pstr != '\0') {
+	if (*pstr == '"') fputc('\\', fd);
+	fputc(*pstr, fd);
+	pstr++;
+      }
+      fputc('"', fd);
+    } else fputs("(null)", fd);
   }
   else
Index: Singular/structs.h
===================================================================
--- Singular/structs.h	(revision f4404c2811a260acd825c9312b087b2c2704ae91)
+++ Singular/structs.h	(revision 2ba9a69a24ccbc29ecc0e7d5cbb295b889219b25)
@@ -4,5 +4,5 @@
 *  Computer Algebra System SINGULAR     *
 ****************************************/
-/* $Id: structs.h,v 1.6 1997-12-03 16:59:06 obachman Exp $ */
+/* $Id: structs.h,v 1.7 1998-01-16 14:29:57 krueger Exp $ */
 /*
 * ABSTRACT
@@ -34,4 +34,5 @@
 class skStrategy;
 class ssyStrategy;
+class procinfo;
 
 struct  sip_sring;
@@ -82,4 +83,5 @@
 typedef ssyStrategy *      syStrategy;
 typedef struct reca *      alg;
+typedef procinfo *         procinfov;
 
 struct _scmdnames
Index: Singular/subexpr.cc
===================================================================
--- Singular/subexpr.cc	(revision f4404c2811a260acd825c9312b087b2c2704ae91)
+++ Singular/subexpr.cc	(revision 2ba9a69a24ccbc29ecc0e7d5cbb295b889219b25)
@@ -90,15 +90,13 @@
 #endif
   {
-    if (t/*Typ()*/!=PROC_CMD)
-    {
-      const char *n=Name();
-      char *s;
-      void *d=Data();
-      if (errorreported)
-        return;
-      if ((store!=NULL)&&(store!=this))
-        store->CleanUp();
-
-      switch (t /*=Typ()*/)
+    const char *n=Name();
+    char *s;
+    void *d=Data();
+    if (errorreported)
+      return;
+    if ((store!=NULL)&&(store!=this))
+      store->CleanUp();
+    
+    switch (t /*=Typ()*/)
       {
         case UNKNOWN:
@@ -140,4 +138,17 @@
           ::Print("%-*.*s%d",spaces,spaces," ",(int)d);
           break;
+       case PROC_CMD:
+         {
+           procinfov pi=(procinfov)d;
+	   ::Print("%-*.*s// libname  : %s\n",spaces,spaces," ",
+		   piProcinfo(pi, "libname"));
+	   ::Print("%-*.*s// procname : %s\n",spaces,spaces," ",
+		   piProcinfo(pi, "procname"));
+	   ::Print("%-*.*s// type     : %s",spaces,spaces," ",
+		   piProcinfo(pi, "type"));
+	   //	   ::Print("%-*.*s// ref      : %s",spaces,spaces," ",
+	   //   piProcinfo(pi, "ref"));
+	   break;
+         }
        case LINK_CMD:
           {
@@ -188,5 +199,4 @@
 #endif
       } /* end switch: (Typ()) */
-    }
   }
   if (next!=NULL)
@@ -262,4 +272,7 @@
         rKill((ring)data);
         break;
+      case PROC_CMD:
+	piKill((procinfov)data);
+	break;
       case LINK_CMD:
         slKill((si_link)data);
@@ -403,5 +416,5 @@
       #endif
     case PROC_CMD:
-      return  (void *)mstrdup((char *)d);
+      return  (void *)piCopy((procinfov) d);
     case POLY_CMD:
     case VECTOR_CMD:
@@ -459,8 +472,8 @@
       break;
     case STRING_CMD:
-    //  data= (void *)mstrdup((char *)d);
-    //  break;
+      data= (void *)mstrdup((char *)d);
+      break;
     case PROC_CMD:
-      data= (void *)mstrdup((char *)d);
+      data= (void *)piCopy((procinfov) d);
       break;
     case POLY_CMD:
Index: Singular/subexpr.h
===================================================================
--- Singular/subexpr.h	(revision f4404c2811a260acd825c9312b087b2c2704ae91)
+++ Singular/subexpr.h	(revision 2ba9a69a24ccbc29ecc0e7d5cbb295b889219b25)
@@ -4,5 +4,5 @@
 *  Computer Algebra System SINGULAR     *
 ****************************************/
-/* $Id: subexpr.h,v 1.3 1997-04-09 12:20:15 Singular Exp $ */
+/* $Id: subexpr.h,v 1.4 1998-01-16 14:29:58 krueger Exp $ */
 /*
 * ABSTRACT: handling of leftv
@@ -88,3 +88,55 @@
 BOOLEAN assumeStdFlag(leftv h);
 
+class proc_singular
+{
+public:
+  long   proc_start;       // position where proc is starting
+  long   help_start;       // position where help is starting
+  long   body_start;       // position where proc-body is starting
+  long   body_end;         // position where proc-body is ending
+  long   example_start;    // position where example is starting
+  long   proc_end;         // position where proc is ending
+  int    proc_lineno;
+  int    body_lineno;
+  int    example_lineno;
+  char   *body;
+};
+
+struct proc_object
+{
+//public:
+  BOOLEAN (*function)(leftv res, leftv v);
+};
+
+union uprocinfodata;
+
+union uprocinfodata
+{
+public:
+  proc_singular  s;        // data of Singular-procedure
+  struct proc_object    o; // pointer to binary-function
+};
+
+typedef union uprocinfodata procinfodata;
+
+typedef enum { LANG_NONE, LANG_SINGULAR, LANG_C } language_defs;
+
+class procinfo
+{
+public:
+  char          *libname;
+  char          *procname;
+  language_defs language;
+  short         ref;
+  procinfodata  data;
+};
+
+inline procinfov piCopy(procinfov pi)
+{
+  pi->ref++;
+  return pi;
+}
+void piKill(procinfov l);
+char *piProcinfo(procinfov pi, char *request);
+void piShowProcinfo(procinfov pi, char *txt);
 #endif
Index: Singular/tesths.cc
===================================================================
--- Singular/tesths.cc	(revision f4404c2811a260acd825c9312b087b2c2704ae91)
+++ Singular/tesths.cc	(revision 2ba9a69a24ccbc29ecc0e7d5cbb295b889219b25)
@@ -2,5 +2,5 @@
 *  Computer Algebra System SINGULAR     *
 ****************************************/
-/* $Id: tesths.cc,v 1.28 1997-12-03 16:59:09 obachman Exp $ */
+/* $Id: tesths.cc,v 1.29 1998-01-16 14:29:59 krueger Exp $ */
 
 /*
@@ -223,5 +223,5 @@
     //if ((h!=NULL) && (IDTYP(h)==PROC_CMD))
     //{
-    //  IDSTRING(h)=iiGetLibProcBuffer( IDSTRING(h), IDID(h));
+    //  IDSTRING(h)=iiGetLibProcBuffer( IDPROC(h)));
     //  newBuffer( mstrdup(IDSTRING(h)), BT_execute, IDID(h) );
       //leftv r=iiMake_proc(h,NULL);
