Logo Search packages:      
Sourcecode: gp2c version File versions  Download package

varlist.c

/*
Copyright (C) 2002-2005  The PARI group.

This file is part of the GP2C package.

PARI/GP is free software; you can redistribute it and/or modify it under the
terms of the GNU General Public License as published by the Free Software
Foundation. It is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY WHATSOEVER.

Check the License for details. You should have received a copy of it, along
with the package; see the file 'COPYING'. If not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */

#include "config.h"
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include "header.h"

void varlistaff(int sava, int savc, stack *v)
{
  affnode **an=(affnode **) stack_base(v);
  int i;
  v->n=0;
  for (i=sava;i<s_aff.n;i++)
    if (affstack[i].idx<savc)
    {
      int n=stack_new(v);
      (*an)[n]=affstack[i];
    }
}

void varlistvar(int idx)
{
  ctxvar *v=ctxstack+idx;
  if (v->flag&(1<<Carg))
    return;
  if (v->initval>=0)
  {
    varlist(v->initval);
    newaff(AFaffect,idx);
  }
}

void varlistfunc(int n,int fc)
{
  gpfunc *gp=lfunc+fc;
  gpproto pro=gp->proto;
  const char *proto=pro.code;
  int i=0;
  char const *p=proto,*q=proto;
  char c;
  PPproto mod;
  int arg[STACKSZ];
  int nb=genlistargs(n,arg,0,STACKSZ);
  gpdescarg *rule=gp->dsc?descfindrules(nb,arg,gp):NULL;
  if (rule)
  {
    for (i=0; i<nb && i<rule->nargs; i++)
    {
      switch(rule->args[i].t)
      {
      case AAlvalue:
      case AAreftype:
        {
          int v, a=detag(arg[i]);
          if (tree[a].f==Frefarg)
            a=tree[a].x;
          v=getvarerr(getlvaluerr(a));
          newaff(AFrefarg,v);
          if (tree[a].f!=Fentry)
            newaff(AFaffectcompo,v);
          break;
        }
       default:
         break;
      }
    }
    return;
  }
  if (!proto) return;
  while((mod=parseproto(&p,&c)))
  {
    if (mod==PPsep) continue;
    switch(mod)
    {
    case PPdefault:
      if (i>=nb || arg[i]==GNOARG)
      {
        i++;
        break;
      }
    case PPstd: /* Fall through */
      switch(c)
      {
      case '&':
      case 'W':
        {
          int v, a=detag(arg[i]);
          if (tree[a].f==Frefarg)
            a=tree[a].x;
          v=getvarerr(getlvaluerr(a));
          newaff(AFrefarg,v);
          if (c=='W' || tree[a].f!=Fentry)
            newaff(AFaffectcompo,v);
          break;
        }
      }
      i++;
      break;
    case PPdefaultmulti:
      i++;
      break;
    case PPmultiarg:
      i=nb;
      break;
    default:
      die(n,"internal error: PPproto %d in varlistfunc",mod);
    }
    q=p;
  }
  if(i<nb) die(n,"Too many arguments in function call");
}

void varlist(int n)
{
  int i,x,y,nv;
  int v,savc,sava,savb;
  context *bl;
  if (n<0)
    return;
  x=tree[n].x;
  y=tree[n].y;
  switch(tree[n].f)
  {
  case Faffect:
    /*    if (tree[x].f!=Fentry)
          varlist(x);*/
    varlist(y);
    v=getvarerr(getlvaluerr(x));
    if (isfunc(y,"clone"))
      newaff(AFclone,v);
    else
    {
      if (tree[detag(x)].f==Fentry)
        newaff(AFaffect,v);
      else
        newaff(AFaffectcompo,v);
    }
    break;
  case Ftag:
    varlist(x);
    break;
  case Fconst:
  case Fsmall:
  case Fgnil:
    break;
  case Frefarg:
    break;
  case Fentry:
    v=getvarerr(n);
    newaff(AFaccess,v);
    break;
  case Fentryfunc:
    {
      int fc=findfunction(entryname(n));
      gpfunc *gp;
      varlist(y);
      if (fc<0) break;
      gp = lfunc+fc;
      if (gp->spec==GPuser)
      {
        userfunc *uf=gp->user;
        int base=lfunc[currfunc].user->savb;/*currfunc!=fc*/
        int i;
        char *c;
        c=calloc(base,sizeof(*c));
        for(i=0;i<uf->v.n;i++)
        {
          affnode *an=uf->var+i;
          if (an->idx<base && ctxstack[an->idx].flag&(1<<Cglobal)
              && an->f!=AFaccess && an->f!=AFhide && c[an->idx]==0)
          {
            c[an->idx]=1;
            newaff(AFaffect,an->idx);
          }
        }
        free(c);
      }
      else
       varlistfunc(n,fc);
    }
    break;
  case Fdeffunc:
    {
      int funcid=tree[n].x;
      const char *name=entryname(funcid);
      int savcf=currfunc;
      userfunc *uf;
      /*get func number and context*/
      currfunc=findfunction(name);
      uf=lfunc[currfunc].user;
      savc=s_ctx.n;
      uf->savb=savc;
      sava=s_aff.n;
      varlist(y);
      nv=uf->v.n;
      varlistaff(sava,savc,&uf->v);
      if (nv!=uf->v.n)
        lastpass=1;
      currfunc=savcf;
    }
    break;
  case Fblock:
    savc=s_ctx.n;
    sava=s_aff.n;
    bl=block+tree[n].x;
    for (i=0;i<bl->s.n;i++)
    {
      ctxvar *v=bl->c+i;
      int nv=getvarbyname(varstr(*v));
      if (nv!=-1)
        newaff(AFhide,nv);
    }
    pushctx(bl);
    savb=s_ctx.n;
    for(i=0;i<bl->s.n;i++)
      varlistvar(savc+i);
    varlist(y);
    nv=bl->v.n;
    varlistaff(sava,savb,&bl->v);
    if (nv!=bl->v.n)
      lastpass=1;
    bl->savb=savb;
    copyctx(savc,bl);
    s_ctx.n=savc;
    break;
  default:
    if (tree[n].f>=FneedENTRY || tree[n].f<0)
      die(n,"Incorrect node %s in varlist",funcname(tree[n].f));
    varlist(x);
    varlist(y);
  }
}

Generated by  Doxygen 1.6.0   Back to index