Bill Allombert on Sat, 18 Aug 2007 23:15:58 +0200


[Date Prev] [Date Next] [Thread Prev] [Thread Next] [Date Index] [Thread Index]

[patch] lexically-scoped variables update


Dear PARI-dev,

This patch is a preliminary implementation of lexically-scoped
variables in GP, updated.

The patch is a bit cleaner and apply to today CVS.

Known limitations:
1) local variables defined through the prototype code V are still dynamically
scoped (for now).
2) The memory model was preserved so we essentially get the same set of
bugs as with GP 2.3.
3) This is slightly slower than it should be.
4) This breaks some usage of trap() for debugging:

? f(z)=1/z
? trap
? f(0)
  *** _/_: division by zero
  ***   Break loop (type 'break' or Control-d to go back to GP)
break> z
z
instead of 0.

Limitation 4) is hard to fix.

Cheers,
Bill.
Index: src/headers/paristio.h
===================================================================
RCS file: /home/cvs/pari/src/headers/paristio.h,v
retrieving revision 1.40
diff -u -r1.40 paristio.h
--- src/headers/paristio.h	1 Aug 2007 22:00:12 -0000	1.40
+++ src/headers/paristio.h	18 Aug 2007 15:19:09 -0000
@@ -37,7 +37,6 @@
   char *help;
   void *pvalue;
   long arity;
-  GEN  lvars;
   struct entree *next;
 } entree;
 
Index: src/language/anal.c
===================================================================
RCS file: /home/cvs/pari/src/language/anal.c,v
retrieving revision 1.281
diff -u -r1.281 anal.c
--- src/language/anal.c	7 Aug 2007 14:55:16 -0000	1.281
+++ src/language/anal.c	18 Aug 2007 15:19:09 -0000
@@ -306,7 +306,6 @@
   ep->help    = NULL;
   ep->pvalue  = NULL;
   ep->arity   = 0;
-  ep->lvars   = NULL;
   ep->next    = *table;
   return *table = ep;
 }
Index: src/language/compile.c
===================================================================
RCS file: /home/cvs/pari/src/language/compile.c,v
retrieving revision 1.18
diff -u -r1.18 compile.c
--- src/language/compile.c	15 Aug 2007 16:41:46 -0000	1.18
+++ src/language/compile.c	18 Aug 2007 15:19:12 -0000
@@ -26,12 +26,20 @@
  **                                                                       **
  ***************************************************************************/
 
+typedef enum {Lglobal, Llocal, Lmy} Ltype;
+
+struct vars_s
+{
+  Ltype type; /*Only Llocal and Lmy are allowed */
+  entree *ep;
+};
+
 static THREAD gp2c_stack s_opcode, s_operand, s_data, s_lvar;
 static THREAD char *opcode;
 static THREAD long *operand;
 static THREAD GEN *data;
 static THREAD long offset=-1;
-static THREAD long *localvars;
+static THREAD struct vars_s *localvars;
 
 void
 pari_init_compiler(void)
@@ -94,6 +102,7 @@
     gunclone(data[i+pos->data-1]);
   }
   s_data.n=pos->data;
+  s_lvar.n=pos->localvars;
   offset=pos->offset;
   return cl;
 }
@@ -116,13 +125,14 @@
 }
 
 static void
-var_push(long x)
+var_push(entree *ep, Ltype type)
 {
   long n=stack_new(&s_lvar);
-  localvars[n] = x;
+  localvars[n].ep   = ep;
+  localvars[n].type = type;
 } 
 
-enum FLflag {FLnocopy=1};
+enum FLflag {FLnocopy=1, FLreturn=2};
 
 static void compilenode(long n, int mode, long flag);
 
@@ -259,6 +269,21 @@
   return ep;
 }
 
+static long
+getmvar(entree *ep)
+{
+  long i;
+  long vn=0;
+  for(i=s_lvar.n-1;i>=0;i--)
+  {
+    if(localvars[i].type==Lmy)
+      vn--;
+    if(localvars[i].ep==ep)
+      return localvars[i].type==Lmy?vn:0;
+  }
+  return 0;
+}
+
 static entree *
 getfunc(long n)
 {
@@ -273,6 +298,14 @@
   return !strncmp(tree[x].str, s, tree[x].len);
 }
 
+INLINE int
+is_node_zero(long n)
+{
+  while (tree[n].f==Ftag)
+    n=tree[n].x;
+  return (tree[n].f==Fsmall && tree[n].x==0);
+}
+
 static GEN 
 listtogen(long n, long f)
 {
@@ -474,8 +507,9 @@
   PPproto mod;
   GEN arg=listtogen(y,Flistarg);
   long nbpointers=0;
-  long nb=lg(arg)-1, lnc;
+  long nb=lg(arg)-1, lnc, lev=0;
   entree *ep = getfunc(n);
+  entree *ev[8];
   if (EpVALENCE(ep)==EpVAR || EpVALENCE(ep)==EpGVAR)
     pari_err(talker2,"not a function in function call",
         tree[n].str, get_origin());
@@ -497,23 +531,55 @@
   }
   if (is_func_named(x,"if") && mode==Gvoid)
     ep=is_entry("_void_if");
+  if (is_func_named(x,"my"))
+  {
+    if (tree[n].f==Fderfunc)
+      pari_err(talker2,"can't derive this",tree[n].str,get_origin());
+    if (nb)
+    {
+      op_push(OCnewframe,nb);
+      for(i=1;i<=nb;i++)
+        var_push(NULL,Lmy);
+    }
+    for (i=1;i<=nb;i++)
+    {
+      long a=arg[i];
+      if (tree[a].f==Faffect)
+      {
+        if (!is_node_zero(tree[a].y))
+        {
+          compilenode(tree[a].y,Ggen,0);
+          op_push(OCstorelex,-nb+i-1);
+        }
+        a=tree[a].x;
+      }
+      localvars[s_lvar.n-nb+i-1].ep=getvar(a);
+    }
+    compilecast(n,Gvoid,mode);
+    avma=ltop;
+    return;
+  }
   if (is_func_named(x,"local"))
   {
     if (tree[n].f==Fderfunc)
       pari_err(talker2,"can't derive this",tree[n].str,get_origin());
     for (i=1;i<=nb;i++)
     {
-      long en, a=arg[i];
+      entree *en;
+      long a=arg[i];
+      op_code op=OClocalvar0;
       if (tree[a].f==Faffect)
       {
-        compilenode(tree[a].y,Ggen,0);
+        if (!is_node_zero(tree[a].y))
+        {
+          compilenode(tree[a].y,Ggen,0);
+          op=OClocalvar;
+        }
         a=tree[a].x;
       }
-      else
-        op_push(OCpushlong,(long)gen_0);
-      en=(long)getvar(a);
-      op_push(OCgetarg,en);
-      var_push(en);
+      en=getvar(a);
+      op_push(op,(long)en);
+      var_push(en,Llocal);
     }
     compilecast(n,Gvoid,mode);
     avma=ltop;
@@ -592,7 +658,7 @@
     while((mod=parseproto(&p,&c))!=PPend)
     {
       if (j<=nb && tree[arg[j]].f!=Fnoarg 
-                && (mod==PPdefault || mod==PPdefaultmulti))
+          && (mod==PPdefault || mod==PPdefaultmulti))
         mod=PPstd;
       switch(mod)
       {
@@ -618,7 +684,7 @@
           break;
         case '&': case '*': 
           {
-            long a=arg[j++];
+            long vn, a=arg[j++];
             entree *ep;
             if (c=='&')
             {
@@ -628,11 +694,20 @@
               a=tree[a].x;
             }
             ep=getlvalue(a);
+            vn=getmvar(ep);
             if (tree[a].f==Fentry)
-              op_push(OCsimpleptr, (long) ep);
+            {
+              if (vn)
+                op_push(OCsimpleptrlex, vn);
+              else
+                op_push(OCsimpleptrdyn, (long) ep);
+            }
             else
             {
-              op_push(OCnewptr, (long) ep);
+              if (vn)
+                op_push(OCnewptrlex, vn);
+              else
+                op_push(OCnewptrdyn, (long) ep);
               compilelvalue(a);
               op_push(OCpushptr, 0);
             }
@@ -645,18 +720,21 @@
             struct codepos pos;
             long a=arg[j++];
             int type=c=='I'?Gvoid:Ggen;
+            long flag=c=='I'?0:FLreturn;
             getcodepos(&pos);
+            for(i=0;i<lev;i++)
+              var_push(ev[i],Llocal);
             if (tree[a].f==Fnoarg)
               compilecast(a,Gvoid,type);
             else
-              compilenode(a,type,0);
+              compilenode(a,type,flag);
             op_push(OCpushgen, data_push(getclosure(&pos)));
             break;
           }
         case 'V':
           {
-            entree *ep = getvar(arg[j++]);
-            op_push(OCpushlong, (long)ep);
+            ev[lev++] = getvar(arg[j++]);
+            op_push(OCpushlong, (long)ev[lev-1]);
             break;
           }
         case 'S':
@@ -669,12 +747,11 @@
           {
             long x=tree[arg[j]].x;
             long y=tree[arg[j]].y;
-            entree *ep;
             if (tree[arg[j]].f!=Faffect)
               pari_err(talker2,"expected character: '=' instead of",
                   tree[n].str+tree[n].len, get_origin());
-            ep = getvar(x);
-            op_push(OCpushlong, (long)ep);
+            ev[lev++] = getvar(x);
+            op_push(OCpushlong, (long)ev[lev-1]);
             compilenode(y,Ggen,0);
             i++; j++;
           }
@@ -878,7 +955,7 @@
   case Fseq:
     if (tree[x].f!=Fnoarg)
       compilenode(x,Gvoid,0);
-    compilenode(y,mode,0);
+    compilenode(y,mode,flag&FLreturn);
     return;
   case Ffacteurmat:
     compilefacteurmat(n,mode);
@@ -889,11 +966,20 @@
     if (tree[x].f==Fentry)
     {
       entree *ep=getvar(x);
+      long vn=getmvar(ep);
       compilenode(y,Ggen,FLnocopy);
-      op_push(OCstore,(long)ep);
+      if (vn)
+        op_push(OCstorelex,vn);
+      else
+        op_push(OCstoredyn,(long)ep);
       if (mode!=Gvoid)
       {
-        op_push(OCpushvalue,(long)ep);
+        if (vn)
+          op_push(OCpushlex,vn);
+        else
+          op_push(OCpushdyn,(long)ep);
+        if (flag&FLreturn)
+          op_push(OCcopyifclone,0);
         compilecast(n,Ggen,mode);
       }
     }
@@ -972,9 +1058,20 @@
   case Fentry:
     {
       entree *ep=getentry(n);
-      if (!EpSTATIC(do_alias(ep)))
+      long vn=getmvar(ep);
+      if (vn)
       {
-        op_push(OCpushvalue,(long)ep);
+        op_push(OCpushlex,(long)vn);
+        if (flag&FLreturn)
+          op_push(OCcopyifclone,0);
+        compilecast(n,Ggen,mode);
+        break;
+      }
+      else if (!EpSTATIC(do_alias(ep)))
+      {
+        op_push(OCpushdyn,(long)ep);
+        if (flag&FLreturn)
+          op_push(OCcopyifclone,0);
         compilecast(n,Ggen,mode);
         break;
       }
@@ -991,8 +1088,6 @@
       GEN arg2=listtogen(tree[x].y,Flistarg);
       entree *ep=getfunc(x);
       long loc=y;
-      long nbvar;
-      GEN lvar;
       long arity=lg(arg2)-1;
       if (loc>=0)
         while (tree[loc].f==Fseq) loc=tree[loc].x;
@@ -1006,16 +1101,17 @@
               tree[n].str,get_origin());
       }
       getcodepos(&pos);
+      if (arity) op_push(OCnewframe,arity);
       for (i=1;i<=arity;i++)
       {
         long a = arg2[lg(arg2)-i];
-        long en;
+        entree *en;
         switch (tree[a].f)
         {
         case Fentry: case Ftag:
-          en=(long)getvar(a);
-          op_push(OCgetarg,en);
-          var_push(en);
+          en=getvar(a);
+          var_push(en,Lmy);
+          op_push(OCgetarg,-arity+i-1);
           break;
         case Faffect:
           { 
@@ -1023,9 +1119,9 @@
             getcodepos(&lpos);
             compilenode(tree[a].y,Ggen,0);
             op_push(OCpushgen, data_push(getclosure(&lpos)));
-            en=(long)getvar(tree[a].x);
-            op_push(OCdefaultarg,en);
-            var_push(en);
+            en=getvar(tree[a].x);
+            var_push(en,Lmy);
+            op_push(OCdefaultarg,-arity+i-1);
             break;
           }
         default: 
@@ -1033,25 +1129,11 @@
               tree[a].str,get_origin());
         }
       }
-      if (y>=0 && tree[y].f!=Fnoarg) compilenode(y,Ggen,0);
-      else compilecast(n,Gvoid,Ggen);
-      nbvar=s_lvar.n-pos.localvars;
-      s_lvar.n=pos.localvars;
-      lvar=cgetg(nbvar+1,t_VECSMALL);
-      for(i=1;i<=nbvar;i++)
-        lvar[i]=localvars[pos.localvars+i-1];
-      if (nbvar > 1)
-      { /* check for duplicates */
-        GEN x = vecsmall_copy(lvar);
-        long k;
-        vecsmall_sort(x);
-        for (k=x[1],i=2; i<lg(x); k=x[i],i++)
-          if (x[i] == k)
-            pari_err(talker,"user function %s: variable %s declared twice",
-                ep->name, ((entree*)x[i])->name);
-      }
+      if (y>=0 && tree[y].f!=Fnoarg)
+        compilenode(y,Ggen,FLreturn);
+      else
+        compilecast(n,Gvoid,Ggen);
       op_push(OCpushgen, data_push(getclosure(&pos)));
-      op_push(OCpushgen, data_push(lvar));
       op_push(OCpushgen, data_push(
             strntoGENstr(tree[n].str,tree[n].len)));
       op_push(OCpushlong, arity);
Index: src/language/eval.c
===================================================================
RCS file: /home/cvs/pari/src/language/eval.c,v
retrieving revision 1.24
diff -u -r1.24 eval.c
--- src/language/eval.c	15 Aug 2007 16:41:46 -0000	1.24
+++ src/language/eval.c	18 Aug 2007 15:19:15 -0000
@@ -158,7 +158,6 @@
   switch(EpVALENCE(ep))
   {
     case EpUSER:
-      gunclone(ep->lvars); ep->lvars=NULL;
       while (ep->pvalue!=INITIAL) pop_val(ep);
       gunclone((GEN)ep->value); ep->value=NULL;
       break;
@@ -196,6 +195,20 @@
   new_val_cell(ep, x, typ(x) >= t_VEC ? COPY_VAL: PUSH_VAL);
 }
 
+INLINE void
+zerovalue (entree *ep)
+{
+  var_cell *v = (var_cell*) gpmalloc(sizeof(var_cell));
+  v->value  = (GEN)ep->value;
+  v->prev   = (var_cell*) ep->pvalue;
+  v->flag   = PUSH_VAL;
+  v->valence= ep->valence;
+  ep->value = gen_0;
+  ep->pvalue= (char*)v;
+  ep->valence=EpVAR;
+}
+
+
 /* as above IF ep->value was PUSHed, or was created after block number 'loc'
    return 0 if not deleted, 1 otherwise [for recover()] */
 int
@@ -305,6 +318,7 @@
   matcomp c;
   GEN x;
   entree *ep;
+  long vn;
 } gp_pointer;
 
 
@@ -349,10 +363,51 @@
  **                                                                       **
  ***************************************************************************/
 
-static THREAD long *st;
+struct var_lex
+{
+  long flag;
+  GEN value;
+};
+
 static THREAD long sp, rp;
+static THREAD long *st;
 static THREAD gp_pointer *ptrs;
-static THREAD gp2c_stack s_st,s_ptrs;
+static THREAD entree **lvars;
+static THREAD struct var_lex *var;
+static THREAD gp2c_stack s_st, s_ptrs, s_var, s_lvars;
+
+static void
+changelex(long vn, GEN x)
+{
+  struct var_lex *v=var+s_var.n+vn;
+  x = gclone(x); /* beware: killbloc may destroy old x */
+  if (v->flag == COPY_VAL) killbloc(v->value); else v->flag = COPY_VAL;
+  v->value = x;
+}
+
+INLINE void
+zerolex(long vn)
+{
+  struct var_lex *v=var+s_var.n+vn;
+  v->flag  = PUSH_VAL;
+  v->value = gen_0;
+}
+
+INLINE void
+copylex(long vn, GEN x)
+{
+  struct var_lex *v=var+s_var.n+vn;
+  v->flag  = typ(x) >= t_VEC ? COPY_VAL: PUSH_VAL;
+  v->value = (v->flag == COPY_VAL)? gclone(x):
+                                  (isclone(x))? gcopy(x): x;
+}
+
+INLINE void
+freelex(long vn)
+{
+  struct var_lex *v=var+s_var.n+vn;
+  if (v->flag == COPY_VAL) killbloc(v->value);
+}
 
 void
 pari_init_evaluator(void)
@@ -365,6 +420,8 @@
   stack_init(&s_ptrs,sizeof(*ptrs),(void**)&ptrs);
   stack_alloc(&s_ptrs,16);
   s_ptrs.n=s_ptrs.alloc;
+  stack_init(&s_var,sizeof(*var),(void**)&var);
+  stack_init(&s_lvars,sizeof(*lvars),(void**)&lvars);
 }
 
 static void closure_eval(GEN C);
@@ -400,12 +457,7 @@
     reset_break();
   }
   else
-  {
     z = gerepileupto(ltop, gel(st,--sp));
-    if (isclone(z)) z = gcopy(z);
-  }
-  for(j=1;j<lg(ep->lvars);j++)
-    pop_val((entree*)ep->lvars[j]);
   return z;
 }
 
@@ -465,7 +517,7 @@
   GEN data=gel(C,3);
   long saved_sp=sp;
   long saved_rp=rp;
-  long pc, j;
+  long pc, j, nbmvar=0, nblvar=0;
   for(pc=1;pc<lg(oper);pc++)
   {
     op_code opcode=(op_code) code[pc];
@@ -497,7 +549,7 @@
         pari_var_create(ep);
         gel(st,sp++)=(GEN)initial_value(ep);
         break;
-    case OCpushvalue:
+    case OCpushdyn:
         ep=(entree*)operand;
         switch(ep->valence)
         {
@@ -511,12 +563,16 @@
           goto calluser; /*Maybe it is a function*/
         }
         break;
-    case OCsimpleptr:
+    case OCpushlex:
+        gel(st,sp++)=var[s_var.n+operand].value;
+        break;
+    case OCsimpleptrdyn:
         {
           gp_pointer *g;
           if (rp==s_ptrs.n-1) 
             stack_new(&s_ptrs);
           g = &ptrs[rp++];
+          g->vn=0;
           g->ep = (entree*) operand;
           switch (g->ep->valence)
           {
@@ -531,13 +587,25 @@
           gel(st,sp++) = (GEN)&(g->x);
           break;
         }
-    case OCnewptr:
+    case OCsimpleptrlex:
         {
           gp_pointer *g;
           if (rp==s_ptrs.n-1)
             stack_new(&s_ptrs);
           g = &ptrs[rp++];
-          matcomp *C=&g->c;
+          g->vn=operand;
+          g->ep=(entree *)0x1L;
+          g->x = (GEN) var[s_var.n+operand].value;
+          gel(st,sp++) = (GEN)&(g->x);
+          break;
+        }
+    case OCnewptrdyn:
+        {
+          gp_pointer *g;
+          matcomp *C;
+          if (rp==s_ptrs.n-1)
+            stack_new(&s_ptrs);
+          g = &ptrs[rp++];
           ep = (entree*) operand;
           switch (ep->valence)
           {
@@ -551,7 +619,25 @@
             pari_err(varer1,"variable name expected",NULL,NULL);
           }
           g->x = (GEN) ep->value;
+          g->vn=0;
+          g->ep=NULL;
+          C=&g->c;
+          C->full_col = C->full_row = 0;
+          C->parent   = (GEN)    g->x;
+          C->ptcell   = (GEN *) &g->x;
+          break;
+        }
+    case OCnewptrlex:
+        {
+          gp_pointer *g;
+          matcomp *C;
+          if (rp==s_ptrs.n-1)
+            stack_new(&s_ptrs);
+          g = &ptrs[rp++];
+          g->x = (GEN) var[s_var.n+operand].value;
+          g->vn=0;
           g->ep=NULL;
+          C=&g->c;
           C->full_col = C->full_row = 0;
           C->parent   = (GEN)    g->x;
           C->ptcell   = (GEN *) &g->x;
@@ -567,11 +653,17 @@
         for(j=0;j<operand;j++)
         {
           gp_pointer *g = &ptrs[--rp];
-          if (g->ep) changevalue(g->ep, g->x);
+          if (g->ep)
+          {
+            if (g->vn)
+              changelex(g->vn,g->x);
+            else
+              changevalue(g->ep, g->x);
+          }
           else change_compo(&(g->c), g->x);
         }
         break;
-    case OCstore:
+    case OCstoredyn:
         ep=(entree *)operand;
         switch (ep->valence)
         {
@@ -584,6 +676,9 @@
           pari_err(varer1,"variable name expected",NULL,NULL);
         }
         break;
+    case OCstorelex:
+        changelex(operand,gel(st,--sp));
+        break;
     case OCstackgen:
         gmael(st,sp-2,operand)=copyupto(gel(st,sp-1),gel(st,sp-2));
         sp--;
@@ -618,6 +713,10 @@
     case OCcopy:
         gel(st,sp-1) = gcopy(gel(st,sp-1));
         break;
+    case OCcopyifclone:
+        if (isclone(gel(st,sp-1)))
+          gel(st,sp-1) = gcopy(gel(st,sp-1));
+        break;
     case OCcompo1:
         {
           GEN  p=gel(st,sp-2);
@@ -767,25 +866,38 @@
           break;
         }
     case OCgetarg:
-        ep=(entree *)operand;
         if (gel(st,sp-1))
-          copyvalue(ep,gel(st,sp-1));
+          copylex(operand,gel(st,sp-1));
         else
-          copyvalue(ep,gen_0);
+          zerolex(operand);
         sp--;
         break;
     case OCdefaultarg:
         ep=(entree *)operand;
         if (gel(st,sp-2))
-          copyvalue(ep,gel(st,sp-2));
+          copylex(operand,gel(st,sp-2));
         else
         {
           GEN z = closure_evalgen(gel(st,sp-1));
           if (!z) pari_err(talker,"break not allowed in function parameter");
-          copyvalue(ep,z);
+          copylex(operand,z);
         }
         sp-=2;
         break;
+    case OClocalvar:
+        ep=(entree *)operand;
+        j=stack_new(&s_lvars);
+        lvars[j]=ep;
+        nblvar++;
+        copyvalue(ep,gel(st,--sp));
+        break;
+    case OClocalvar0:
+        ep=(entree *)operand;
+        j=stack_new(&s_lvars);
+        lvars[j]=ep;
+        nblvar++;
+        zerovalue(ep);
+        break;
     case OCglobalvar:
         ep=(entree *)operand;
         if (ep->valence==EpNEW) pari_var_create(ep);
@@ -890,7 +1002,7 @@
           pari_sp ltop;
           long n=st[--sp];
           entree *ep = (entree*) operand;
-          GEN z, lvars=ep->lvars;
+          GEN z;
           if (ep->valence!=EpUSER)
           {
             int w;
@@ -919,15 +1031,20 @@
             reset_break();
           }
           else
-          {
             z = gerepileupto(ltop, gel(st,--sp));
-            if (isclone(z)) z = gcopy(z);
-          }
-          for(j=1;j<lg(lvars);j++)
-            pop_val((entree*)lvars[j]);
           gel(st, sp++) = z;
           break;
         }
+    case OCnewframe:
+        stack_alloc(&s_var,operand);
+        s_var.n+=operand;
+        nbmvar+=operand;
+        for(j=1;j<=operand;j++)
+        {
+          var[s_var.n-j].flag=PUSH_VAL;
+          var[s_var.n-j].value=gen_0;
+        }
+        break;
     case OCvec:
         gel(st,sp++)=cgetg(operand,t_VEC);
         break;
@@ -952,7 +1069,6 @@
           gpfree(ep->code);
           /*FIXME: the function might be in use...
             gunclone(ep->value);
-          gunclone(ep->lvars);
           */
           break;
         case EpNEW:
@@ -961,21 +1077,28 @@
         default:
           pari_err(talker,"function name expected");
         }
-        ep->value = (void *) gclone(gel(st,sp-4));
-        ep->lvars = gclone(gel(st,sp-3));
+        ep->value = (void *) gclone(gel(st,sp-3));
         ep->code  = pari_strdup(GSTR(gel(st,sp-2)));
         ep->arity = st[sp-1];
-        sp-=4;
+        sp-=3;
         break;
     case OCpop:
         sp-=operand;
         break;
     }
   }
-  return;
-endeval:
-  sp = saved_sp;
-  rp = saved_rp;
+  if (0)
+  {
+  endeval:
+    sp = saved_sp;
+    rp = saved_rp;
+  }
+  for(j=1;j<=nbmvar;j++)
+    freelex(-j);
+  s_var.n-=nbmvar;
+  for(j=1;j<=nblvar;j++)
+    pop_val(lvars[s_lvars.n-j]);
+  s_lvars.n-=nblvar;
 }
 
 GEN
@@ -1065,17 +1188,34 @@
       ep=(entree*)operand;
       pariprintf("pushvar\t%s\n",ep->name);
       break;
-    case OCpushvalue:
+    case OCpushdyn:
+      ep=(entree*)operand;
+      pariprintf("pushdyn\t\t%s\n",ep->name);
+      break;
+    case OCpushlex:
+      pariprintf("pushlex\t\t%ld\n",operand);
+      break;
+    case OCstoredyn:
+      ep=(entree *)operand;
+      pariprintf("storedyn\t%s\n",ep->name);
+      break;
+    case OCstorelex:
+      pariprintf("storelex\t%ld\n",operand);
+      break;
+    case OCsimpleptrdyn:
       ep=(entree*)operand;
-      pariprintf("pushvalue\t%s\n",ep->name);
+      pariprintf("simpleptrdyn\t%s\n",ep->name);
       break;
-    case OCsimpleptr:
+    case OCsimpleptrlex:
       ep=(entree*)operand;
-      pariprintf("simpleptr\t%s\n",ep->name);
+      pariprintf("simpleptrlex\t%ld\n",operand);
       break;
-    case OCnewptr:
+    case OCnewptrdyn:
       ep=(entree*)operand;
-      pariprintf("newptr\t\t%s\n",ep->name);
+      pariprintf("newptrdyn\t%s\n",ep->name);
+      break;
+    case OCnewptrlex:
+      pariprintf("newptrlex\t%ld\n",operand);
       break;
     case OCpushptr:
       pariprintf("pushptr\n");
@@ -1086,10 +1226,6 @@
     case OCendptr:
       pariprintf("endptr\t\t%ld\n",operand);
       break;
-    case OCstore:
-      ep=(entree *)operand;
-      pariprintf("store\t\t%s\n",ep->name);
-      break;
     case OCprecreal:
       pariprintf("precreal\n");
       break;
@@ -1111,6 +1247,9 @@
     case OCcopy:
       pariprintf("copy\n");
       break;
+    case OCcopyifclone:
+      pariprintf("copyifclone\n");
+      break;
     case OCcompo1:
       pariprintf("compo1\t\t%s\n",disassemble_cast(operand));
       break;
@@ -1136,12 +1275,18 @@
       pariprintf("compoLptr\n");
       break;
     case OCgetarg:
-      ep=(entree*)operand;
-      pariprintf("getarg\t\t%s\n",ep->name);
+      pariprintf("getarg\t\t%ld\n",operand);
       break;
     case OCdefaultarg:
+      pariprintf("defaultarg\t%ld\n",operand);
+      break;
+    case OClocalvar:
       ep=(entree*)operand;
-      pariprintf("defaultarg\t%s\n",ep->name);
+      pariprintf("localvar\t%s\n",ep->name);
+      break;
+    case OClocalvar0:
+      ep=(entree*)operand;
+      pariprintf("localvar0\t%s\n",ep->name);
       break;
     case OCglobalvar:
       ep=(entree*)operand;
@@ -1192,6 +1337,9 @@
       ep=(entree*)operand;
       pariprintf("deffunc\t\t%s\n",ep->name);
       break;
+    case OCnewframe:
+      pariprintf("newframe\t%ld\n",operand);
+      break;
     case OCpop:
       pariprintf("pop\t\t%ld\n",operand);
       break;
Index: src/language/opcode.h
===================================================================
RCS file: /home/cvs/pari/src/language/opcode.h,v
retrieving revision 1.5
diff -u -r1.5 opcode.h
--- src/language/opcode.h	15 Aug 2007 16:41:46 -0000	1.5
+++ src/language/opcode.h	18 Aug 2007 15:19:15 -0000
@@ -16,19 +16,20 @@
 
 typedef enum {Gvoid, Gsmall, Gvec, Gvar, Ggen} Gtype;
 
-typedef enum {OCpushlong='A',OCpushgen,OCpushreal,OCpushstoi,
-              OCpushvalue,OCpushvar,
+typedef enum {OCpushlong='A',OCpushgen,OCpushreal,OCpushstoi,OCpushvar,
               OCpop,
-              OCstoi,OCitos,OCtostr,OCvarn,OCcopy,
+              OCstoi,OCitos,OCtostr,OCvarn,OCcopy,OCcopyifclone,
               OCprecreal,OCprecdl,
               OCvec,OCmat,OCcol,
-              OCstackgen,OCstore,
+              OCstackgen,
               OCcompo1,OCcompo2,OCcompoC,OCcompoL,
-              OCnewptr,OCpushptr,OCendptr,OCsimpleptr,
+              OCpushptr,OCendptr,
               OCcompo1ptr,OCcompo2ptr,OCcompoCptr,OCcompoLptr,
               OCcalllong,OCcallgen,OCcallgen2,OCcallint,OCcallvoid,OCcalluser,
               OCderivgen,OCderivuser,
-              OCdeffunc,OCgetarg,OCdefaultarg,
-              OCglobalvar} op_code;
+              OCdeffunc,OCnewframe,
+              OCpushdyn,OCstoredyn,OCnewptrdyn,OCsimpleptrdyn,
+              OCpushlex,OCstorelex,OCnewptrlex,OCsimpleptrlex,
+              OCgetarg,OCdefaultarg,OClocalvar,OClocalvar0,OCglobalvar} op_code;
 
 ENDEXTERN
Index: src/test/32/program
===================================================================
RCS file: /home/cvs/pari/src/test/32/program,v
retrieving revision 1.23
diff -u -r1.23 program
--- src/test/32/program	28 Mar 2007 22:40:42 -0000	1.23
+++ src/test/32/program	18 Aug 2007 15:19:15 -0000
@@ -134,7 +134,7 @@
 3
 ? kill(addii)
 ? getheap
-[24, 3169]
+[23, 3164]
 ? print("Total time spent: ",gettime);
-Total time spent: 560
+Total time spent: 36
 ? \q
Index: src/test/64/program
===================================================================
RCS file: /home/cvs/pari/src/test/64/program,v
retrieving revision 1.25
diff -u -r1.25 program
--- src/test/64/program	28 Mar 2007 22:40:42 -0000	1.25
+++ src/test/64/program	18 Aug 2007 15:19:15 -0000
@@ -131,7 +131,7 @@
 3
 ? kill(addii)
 ? getheap
-[24, 1683]
+[23, 1678]
 ? print("Total time spent: ",gettime);
-Total time spent: 16
+Total time spent: 8
 ? \q