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

moveblock.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"
static int currblo;
typedef enum {left,right} side;

void destroynode(int p, side s)
{
  if (p==-1) return;
  if (s==left)
    tree[p].x=GNIL;
  else
    tree[p].y=GNIL;
}
/*
n: node
p: parent (-1 for first node) ps: left/right
r: root of seq rs:left/right
*/
void movecode(int n, int p, int ps, int *r, int *rs, int ret)
{
  if (debug) fprintf(stderr,"movecode:%d %d %d\n",n,p,*r);
  if (ret==-1)
    ret=GNIL;
  if (p!=*r)/*we are not at the root of seq*/
  {
    if ( tree[*r].f==Fseq )
    {
      /*the interesting case*/
      if (*rs==left)
      {
        int seq=newseq(n,tree[*r].x);
        tree[*r].x=seq;
        *rs=right;*r=seq;
      }
      else
      {
        int seq=newseq(tree[*r].x,n);
        tree[*r].x=seq;
      }
    }
    else /*we are at the start of a func, block or args entry*/
    {
      if (*rs==left)
      {
        int seq=newseq(n,tree[*r].x);
        tree[*r].x=seq;
        *r=seq;*rs=right;
      }
      else
      {
        int seq=newseq(n,tree[*r].y);
        tree[*r].y=seq;
        *r=seq;*rs=right;
      }
    }
    if (ps==left)
      tree[p].x=ret;
    else
      tree[p].y=ret;
  }
}
void moveblock(int n, int p, int ps, int *r, int *rs)
{
  int x,y;
  int z;
  int s;
  gpfunc *gp;
  int nf;
  if (n<0)
    return;
  x=tree[n].x;
  y=tree[n].y;
  switch(tree[n].f)
  {
  case Fseq:
    s=left;z=n;
    moveblock(x,n,left,&z,&s);
    s=right;z=n;
    moveblock(y,n,right,&z,&s);
    break;
  case Frefarg:
  case Ftag:
    moveblock(x,n,left,r,rs);
    break;
  case Fconst:
  case Fsmall:
  case Fgnil:
  case Fentry:
    break;
  case Fentryfunc:
    /*If it is a func with "seq" arg we must change the root...
      Yes it's a real pain.
      Note: normally 'E' code does not contain Fseq after parsing,
      but may after this stage, e.g. if it calls "vector".
    */
    nf=findfunction(entryname(n));
    gp=lfunc+nf;
    if (nf>=0 && gp->spec>0)
      tree[n].m|=funcmode(*gp)&(1<<Msemicomma);
    if (nf>=0 && gp->spec>0 && gp->proto.code && y!=-1)
    {
      int stack[STACKSZ];
      int i;
      int nb=listtostackparent(y,Flistarg,stack,STACKSZ,gp->gpname,n);
      const char *code=gp->proto.code;
      if (code[0]==0)
        die(-1,"incorrect pseudoprototype for %s: %s\n",gp->gpname,code);
      if (nb==0)
      {
        if (code[0]=='*' || code[0]=='I' || code[0]=='E')
        {
          z=n; s=right;
          moveblock(y,z,right,&z,&s);
        }
        else
          moveblock(y,n,right,r,rs);
      }
      else
      {
        if (code[0]=='*' || code[0]=='I' || code[0]=='E')
        {
          z=stack[0];s=left;
          moveblock(tree[z].x,z,left,&z,&s);
        }
        else
          moveblock(tree[stack[0]].x,stack[0],left,r,rs);
      }
      for(i=0;i<nb;i++)
      {
        if (code[0]!='*' && code[i+1]==0)
          die(-1,"incorrect pseudoprototype for %s: %s\n",gp->gpname,code);
        if (code[0]=='*' || code[i+1]=='I' || code[i+1]=='E')
        {
          z=stack[i];s=right;
          moveblock(tree[z].y,z,right,&z,&s);
        }
        else
          moveblock(tree[stack[i]].y,stack[i],right,r,rs);
      }
    }
    else
      moveblock(y,n,right,r,rs);
    break;
  case Fdeffunc:
    z=n;s=right;
    moveblock(y,n,right,&z,&s);
    break;
  case Fblock:
    z=n;s=right;
    movecode(n,p,ps,r,rs,newleaf(block[x].ret));
    moveblock(y,n,right,&z,&s);
    break;
  default:
    if (tree[n].f>=FneedENTRY || tree[n].f<0)
      die(n,"Incorrect node %s in moveblock",funcname(tree[n].f));
    moveblock(x,n,left,r,rs);
    moveblock(y,n,right,r,rs);
  }
}
int blockisempty(int n)
{
  int i;
  context *fc=block+tree[n].x;
  for(i=0;i<fc->s.n;i++)
  {
    ctxvar *v=fc->c+i;
    if (!(v->flag&(1<<Cconst)) || v->val==-1)
      return 0;
  }
  return 1;
}
/*
n: node
p: parent (-1 for first node)
d: 0 right child, 1 left child
*/
void cleanvar(int n)
{
  int x,y;
  int i;
  int v,savc,savblo;
  context *bl;
  if (n<0)
    return;
  x=tree[n].x;
  y=tree[n].y;
  switch(tree[n].f)
  {
  case Faffect:
    cleanvar(x);
    cleanvar(y);
    x=tree[n].x;
    y=tree[n].y;
    if (tree[x].f==Fentry)
    {
      v=getvarerr(x);
      if (ctxstack[v].flag&(1<<Cconst))
      {
        int simple=0;
        if (ctxstack[v].val!=-1)
          die(n,"Internal error: constant variable affected two times");
        if (tree[y].f==Fsmall)
          simple=1;
        else if (tree[y].f==Fentry)
        {
          int w=getvarerr(y);
          int i;
          context *bl=block+currblo;
          simple=1;
          if (!(ctxstack[w].flag&((1<<Cconst)|(1<<Cimmutable))) )
          {
            for(i=0;i<bl->v.n;i++)
            {
              affnode *an=bl->var+i;
              if (an->idx==w && an->f!=AFaccess)
                simple=0;
            }
          }
        }
        if (simple)
        {
          ctxstack[v].val=y;
          tree[n]=tree[GNIL];
        }
      }
    }
    break;
  case Frefarg:
  case Ftag:
    cleanvar(x);
    break;
  case Fconst:
  case Fsmall:
  case Fgnil:
    break;
  case Fentry:
    v=getvarerr(n);
    if ( (ctxstack[v].flag&(1<<Cconst)) && ctxstack[v].val!=-1)
    {
      tree[n]=tree[ctxstack[v].val];
      tree[n].comment=-1;
    }
    break;
  case Fentryfunc:
    cleanvar(y);
    break;
  case Fdeffunc:
    cleanvar(y);
    tree[y].m&=~(1<<Mbrace);
    break;
  case Fblock:
    savc=s_ctx.n;
    savblo=currblo;
    currblo=tree[n].x;
    pushctx(block+currblo);
    bl=block+tree[n].x;
    for (i=0;i<bl->s.n;i++)
    {
      ctxvar *c=bl->c+i;
      if (c->initval!=-1)
        cleanvar(c->initval);
    }
    cleanvar(y);
    copyctx(savc,block+tree[n].x);
    if (blockisempty(n))
      tree[n].m|=(1<<Mbrace);
    s_ctx.n=savc;
    currblo=savblo;
    break;
  default:
    if (tree[n].f>=FneedENTRY || tree[n].f<0)
      die(n,"Incorrect node %s in cleanvar",funcname(tree[n].f));
    cleanvar(x);
    cleanvar(y);
  }
}

/*
  n: node
  p: parent (-1 for first node)
  d: side
 */
void cleancode(int n, int p, int d)
{
  int x,fx;
  int y,fy;
  if (n<0)
    return;
  x=tree[n].x;
  y=tree[n].y;
  switch(tree[n].f)
  {
  case Fseq:
    cleancode(x,n,left);
    cleancode(y,n,right);
    x=tree[n].x;fx=tree[detag(x)].f;
    y=tree[n].y;fy=tree[detag(y)].f;
    if ( p>=0 && ( fx==Fgnil || fy==Fgnil))
    {
      if (fx==Fgnil && fy==Fgnil)
        destroynode(p,d);
      else
      {
        if (d==left)
          tree[p].x=(fx==Fgnil)?y:x;
        else
          tree[p].y=(fx==Fgnil)?y:x;
      }
    }
    else
      tree[n].m|=(1<<Msemicomma);
    break;
  case Faffect:
    cleancode(x,n,left);
    cleancode(y,n,right);
    x=tree[n].x;
    y=tree[n].y;
    if (is_subtype(tree[x].t,Gvoid))
    {
      tree[n]=tree[y];
      tree[n].comment=-1;
      if (tree[n].f==Fentry || tree[n].f==Fgnil)
        destroynode(p,d);
    }
    break;
  case Frefarg:
  case Ftag:
    cleancode(x,n,left);
    break;
  case Fconst:
  case Fsmall:
  case Fgnil:
    break;
  case Fentry:
  case Fentryfunc:
    cleancode(y,n,right);
    break;
  case Fdeffunc:
  case Fblock:
    tree[n].m|=(1<<Msemicomma);
    cleancode(y,n,right);
    y=tree[n].y;
    if (tree[y].f==Fgnil)
      destroynode(p,d);
    break;
  default:
    if (tree[n].f>=FneedENTRY || tree[n].f<0)
      die(n,"Incorrect node %s in cleancode",funcname(tree[n].f));
    cleancode(x,n,left);
    cleancode(y,n,right);
  }
}

/*
  n: node
  p: parent (-1 for first node)
  ps: child side(left/right)
  *r: root
  *rs: root child side
 */
void gendeblock(int n, int p, int ps, int *r, int *rs)
{
  int x,y;
  int z;
  int s;
  gpfunc *gp;
  int nf;
  if (n<0)
    return;
  x=tree[n].x;
  y=tree[n].y;
  switch(tree[n].f)
  {
    case Fseq:
      s=left;z=n;
      gendeblock(x,n,left,&z,&s);
      s=right;z=n;
      gendeblock(y,n,right,&z,&s);
      break;
    case Frefarg:
    case Ftag:
      gendeblock(x,n,left,r,rs);
      break;
    case Fconst:
    case Fsmall:
    case Fgnil:
    case Fentry:
      break;
    case Fentryfunc:
   /*If it is a func with "seq" arg we must change the root...
      Yes it's a real pain.
      Note: normally 'E' code does not contain Fseq after parsing,
      but may after this stage, e.g. if it calls "vector".
    */
    nf=findfunction(entryname(n));
    gp=lfunc+nf;
    if (nf>=0 && gp->spec>0 && gp->proto.code && y!=-1)
    {
      int stack[STACKSZ];
      int i;
      int nb=listtostackparent(y,Flistarg,stack,STACKSZ,gp->gpname,n);
      const char *code=gp->proto.code;
      if (code[0]==0)
        die(-1,"incorrect pseudoprototype for %s: %s\n",gp->gpname,code);
      if (nb==0)
      {
        if (code[0]=='*' || code[0]=='I' || code[0]=='E')
        {
          z=n; s=right;
          gendeblock(y,z,right,&z,&s);
        }
        else
          gendeblock(y,n,right,r,rs);
      }
      else
      {
        if (code[0]=='*' || code[0]=='I' || code[0]=='E')
        {
          z=stack[0];s=left;
          gendeblock(tree[z].x,z,left,&z,&s);
        }
        else
          gendeblock(tree[stack[0]].x,stack[0],left,r,rs);
      }
      for(i=0;i<nb;i++)
      {
        if (code[0]!='*' && code[i+1]==0)
          die(-1,"incorrect pseudoprototype for %s: %s\n",gp->gpname,code);
        if (code[0]=='*' || code[i+1]=='I' || code[i+1]=='E')
        {
          z=stack[i];s=right;
          gendeblock(tree[z].y,z,right,&z,&s);
        }
        else
          gendeblock(tree[stack[i]].y,stack[i],right,r,rs);
      }
    }
    else
    {
      gendeblock(y,n,right,r,rs);
      if (ps==left)
        n=tree[p].x;
      else
        n=tree[p].y;
      if (is_subtype(tree[n].t,Gvoid))
      {
        /*C doesn't allow making anything from void, so we need to
          move the call here. GP cast void to zero if necessary*/
        movecode(n,p,ps,r,rs,-1);
      }
    }
    break;
  case Fdeffunc:
    z=n;s=right;
    gendeblock(y,n,right,&z,&s);
    break;
  case Fblock:
    z=n;s=right;
    gendeblock(y,n,right,&z,&s);
    break;
  default:
    if (tree[n].f>=FneedENTRY || tree[n].f<0)
      die(n,"Incorrect node %s in gendeblock",funcname(tree[n].f));
    gendeblock(x,n,left,r,rs);
    gendeblock(y,n,right,r,rs);
  }
}


Generated by  Doxygen 1.6.0   Back to index