Bill Allombert on Mon, 21 May 2007 22:35:47 +0200


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

[patch] lexically-scoped variables


Dear PARI-dev,

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

This patch cause the following changes:
1) The new keyword my() allow to declare lexically scoped variables.
2) Functions parameters are lexically scoped. (this is an
incompatibility with GP 2.3)
3) my() and local() can now happen anywhere in the code and the scope
of the variables is limited to the current closure.

Example explaining the difference between local() and my().

? f()=print(v)
? g(x)=local(v=x);f()
? h(x)=my(v=x);f()
? g(5)
5
? h(5)
v

Example of uses of my/local inside closures:
? for(i=1,5,my(z=i^2+1);print(z^2+1));z
5
26
101
290
677
%2 = z

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) The patch needs some clean up.

Cheers,
Bill.
Index: src/headers/paristio.h
===================================================================
RCS file: /home/cvs/pari/src/headers/paristio.h,v
retrieving revision 1.37
diff -u -r1.37 paristio.h
--- src/headers/paristio.h	28 Mar 2007 22:40:41 -0000	1.37
+++ src/headers/paristio.h	21 May 2007 19:37:25 -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.277
diff -u -r1.277 anal.c
--- src/language/anal.c	7 May 2007 17:16:06 -0000	1.277
+++ src/language/anal.c	21 May 2007 19:37:25 -0000
@@ -300,7 +300,6 @@
   ep->help    = NULL;
   ep->pvalue  = NULL;
   ep->arity   = 0;
-  ep->lvars   = NULL;
   ep->next    = *table;
   gel(ep1,0)  = 0;
   gel(ep1,1)  = 0;
Index: src/language/compile.c
===================================================================
RCS file: /home/cvs/pari/src/language/compile.c,v
retrieving revision 1.14
diff -u -r1.14 compile.c
--- src/language/compile.c	11 May 2007 16:25:32 -0000	1.14
+++ src/language/compile.c	21 May 2007 19:37:26 -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 Fflag {Fnocopy=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)
 {
@@ -347,7 +380,7 @@
   long yx=tree[y].x;
   long yy=tree[y].y;
   long f=tree[y].f;
-  compilenode(x,Ggen,Fnocopy);
+  compilenode(x,Ggen,FLnocopy);
   compilenode(yx,Gsmall,0);
   if (f==Fmatrix && yy==-1)
   {
@@ -385,7 +418,7 @@
   for (lnc=l-1; lnc>0 && tree[arg[lnc]].f==Fconst; lnc--);
   for (i=1;i<l;i++)
   {
-    compilenode(arg[i],Ggen,i>=lnc?Fnocopy:0);
+    compilenode(arg[i],Ggen,i>=lnc?FLnocopy:0);
     op_push(OCstackgen,i);
   }
   avma=ltop;
@@ -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(OCpushstoi,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;
@@ -551,7 +617,7 @@
     a = arg[1];
     if (tree[a].f!=Ffunction || tree[a].x!=OPpow)
     {
-      compilenode(a,Ggen,Fnocopy);
+      compilenode(a,Ggen,FLnocopy);
       op_push(OCpushlong,1);
     }
     else
@@ -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)
       {
@@ -606,7 +672,7 @@
         switch(c)
         {
         case 'G':
-          compilenode(arg[j],Ggen,j>=lnc?Fnocopy:0);
+          compilenode(arg[j],Ggen,j>=lnc?FLnocopy:0);
           j++;
           break;
         case 'M':
@@ -620,6 +686,7 @@
           {
             long a=arg[j++];
             entree *ep;
+            long vn;
             if (c=='&')
             {
               if (tree[a].f!=Frefarg)
@@ -628,7 +695,11 @@
               a=tree[a].x;
             }
             ep=getlvalue(a);
-            op_push(OCnewptr, (long) ep);
+            vn=getmvar(ep);
+            if (vn)
+              op_push(OCnewptrlex, vn);
+            else
+              op_push(OCnewptr, (long) ep);
             compilelvalue(a);
             op_push(OCpushptr, 0);
             nbpointers++;
@@ -640,18 +711,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':
@@ -664,12 +738,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++;
           }
@@ -684,7 +757,7 @@
             }
             else
             {
-              compilenode(a,Ggen,Fnocopy);
+              compilenode(a,Ggen,FLnocopy);
               op_push(OCtostr, 1);
             }
             break;
@@ -873,22 +946,31 @@
   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);
-    if (mode==Ggen && !(flag&Fnocopy))
+    if (mode==Ggen && !(flag&FLnocopy))
       op_push(OCcopy,0);
     break;
   case Faffect:
     if (tree[x].f==Fentry)
     {
       entree *ep=getvar(x);
-      compilenode(y,Ggen,Fnocopy);
-      op_push(OCstore,(long)ep);
+      long vn=getmvar(ep);
+      compilenode(y,Ggen,FLnocopy);
+      if (vn)
+        op_push(OCstorelex,vn);
+      else
+        op_push(OCstore,(long)ep);
       if (mode!=Gvoid)
       {
-        op_push(OCpushvalue,(long)ep);
+        if (vn)
+          op_push(OCpushlex,vn);
+        else
+          op_push(OCpushvalue,(long)ep);
+        if (flag&FLreturn)
+          op_push(OCcopyifclone,0);
         compilecast(n,Ggen,mode);
       }
     }
@@ -955,9 +1037,20 @@
   case Fentry:
     {
       entree *ep=getentry(n);
-      if (!EpSTATIC(do_alias(ep)))
+      long vn=getmvar(ep);
+      if (vn)
+      {
+        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(OCpushvalue,(long)ep);
+        if (flag&FLreturn)
+          op_push(OCcopyifclone,0);
         compilecast(n,Ggen,mode);
         break;
       }
@@ -974,8 +1067,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;
@@ -989,16 +1080,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:
           { 
@@ -1006,9 +1098,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: 
@@ -1016,25 +1108,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.19
diff -u -r1.19 eval.c
--- src/language/eval.c	15 May 2007 20:22:12 -0000	1.19
+++ src/language/eval.c	21 May 2007 19:37:26 -0000
@@ -156,7 +156,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;
@@ -194,6 +193,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
@@ -303,6 +316,7 @@
   matcomp c;
   GEN x;
   entree *ep;
+  long vn;
 } gp_pointer;
 
 
@@ -345,10 +359,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)
@@ -361,6 +416,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);
@@ -396,12 +453,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;
 }
 
@@ -461,7 +513,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];
@@ -510,12 +562,16 @@
           goto calluser; /*Maybe it is a function*/
         }
         break;
+    case OCpushlex:
+        gel(st,sp++)=var[s_var.n+operand].value;
+        break;
     case OCnewptr:
         {
           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)
           {
@@ -528,9 +584,21 @@
             break;
           default:
             pari_err(varer1,"variable name expected",NULL,NULL);
+            exit(0);
           }
           break;
         }
+    case OCnewptrlex:
+        {
+          gp_pointer *g;
+          if (rp==s_ptrs.n-1)
+            stack_new(&s_ptrs);
+          g = &ptrs[rp++];
+          g->vn=operand;
+          g->ep=(entree *)0x1L;
+          g->x = (GEN) var[s_var.n+operand].value;
+          break;
+        }
     case OCpushptr:
         {
           gp_pointer *g = &ptrs[rp-1];
@@ -541,7 +609,13 @@
         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;
@@ -560,6 +634,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--;
@@ -594,6 +671,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);
@@ -760,25 +841,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)
@@ -887,7 +981,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;
@@ -916,15 +1010,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;
@@ -949,7 +1048,6 @@
           gpfree(ep->code);
           /*FIXME: the function might be in use...
             gunclone(ep->value);
-          gunclone(ep->lvars);
           */
           break;
         case EpNEW:
@@ -958,21 +1056,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
@@ -1066,10 +1171,19 @@
       ep=(entree*)operand;
       pariprintf("pushvalue\t%s\n",ep->name);
       break;
+    case OCpushlex:
+      pariprintf("pushlex\t\t%ld\n",operand);
+      break;
+    case OCstorelex:
+      pariprintf("storelex\t%ld\n",operand);
+      break;
     case OCnewptr:
       ep=(entree*)operand;
       pariprintf("newptr\t\t%s\n",ep->name);
       break;
+    case OCnewptrlex:
+      pariprintf("newptrlex\t%ld\n",operand);
+      break;
     case OCpushptr:
       pariprintf("pushptr\n");
       break;
@@ -1104,6 +1218,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;
@@ -1129,12 +1246,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;
@@ -1185,6 +1308,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.4
diff -u -r1.4 opcode.h
--- src/language/opcode.h	5 Apr 2007 15:54:24 -0000	1.4
+++ src/language/opcode.h	21 May 2007 19:37:27 -0000
@@ -19,7 +19,7 @@
 typedef enum {OCpushlong='A',OCpushgen,OCpushreal,OCpushstoi,
               OCpushvalue,OCpushvar,
               OCpop,
-              OCstoi,OCitos,OCtostr,OCvarn,OCcopy,
+              OCstoi,OCitos,OCtostr,OCvarn,OCcopy,OCcopyifclone,
               OCprecreal,OCprecdl,
               OCvec,OCmat,OCcol,
               OCstackgen,OCstore,
@@ -28,7 +28,8 @@
               OCcompo1ptr,OCcompo2ptr,OCcompoCptr,OCcompoLptr,
               OCcalllong,OCcallgen,OCcallgen2,OCcallint,OCcallvoid,OCcalluser,
               OCderivgen,OCderivuser,
-              OCdeffunc,OCgetarg,OCdefaultarg,
-              OCglobalvar} op_code;
+              OCdeffunc,
+              OCpushlex,OCstorelex,OCnewframe,OCnewptrlex,
+              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	21 May 2007 19:37:27 -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	21 May 2007 19:37:27 -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
--- /dev/null	2007-05-15 00:28:02.128070500 +0200
+++ src/functions/programming/my	2007-05-12 14:00:42.000000000 +0200
@@ -0,0 +1,3 @@
+Function: my
+Section: programming/specific
+Help: my(x,...,z): declare x,...,z as lexically-scoped local variables