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

gp2c.c

/*
Copyright (C) 2000-2010  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. */

#define TYPE
#include "config.h"
#include <stdlib.h>
#include <stdio.h>
#include <unistd.h>
#include <string.h>
#include <errno.h>
#include "header.h"

FILE *yyin;
int yyparse (void);
void  yyrestart(FILE *new_file);
void patchfunclist(void);
void inittype(void);
void initoperators(void);
int linecount;
int yydebug;
static int optgen=0,opttree=0,opttype=0,optinfo=0;
int optstrict=0;
int optcleanvar=0;/*used in genbrace to suppress {} optimization*/
int indentlevel=2;
int do_warning=1;
char *optprefix,*optsuffix;
void printlistfunc(FILE *fout);
void outputtype(FILE *fout);
void cleancode(int n, int p);
void cleanvar(int n);
void initdesc(const char *s);
void maketreeGRL(FILE *fout,int n);
void dump(FILE *fout)
{
  int i,j;
  for(i=0;i<s_func.n;i++)
    if (lfunc[i].spec==GPuser)
    {
      gpfunc *gp=lfunc+i;
      context *fc=block+gp->user->bl;
      fprintf(fout,"Function:\n %s(",gp->proto.cname);
      for(j=0;j<fc->s.n;j++)
      {
        if (fc->c[j].flag&(1<<Carg))
          fprintf(fout,"%s%s %s",j?", ":"",
              GPname(vartype(fc->c[j])),varstr(fc->c[j]));
      }
      fprintf(fout,")\n");
      if (strcmp(gp->gpname,gp->proto.cname))
        fprintf(fout,"GP name: %s\n",gp->gpname);
      fprintf(fout,"code: %s\n",gp->proto.code);
      fprintf(fout,"return type: %s\n",GPname(functype(*gp)));
      fprintf(fout,"mode=%d \t  spec=%d\n",funcmode(*gp),gp->spec);
      for(   ;j<fc->s.n;j++)
      {
        ctxvar *c=fc->c+j;
        if (!((c->flag&(1<<Carg)) || ((c->flag&(1<<Cconst)) && c->val==-1)))
          fprintf(fout,"%s %s\n",GPname(vartype(*c)),varstr(*c));
      }
      fprintf(fout,"\n");
    }
}
extern int indent;
void
init_compiler(void)
{
  int n;
  stack_init(&s_node,sizeof(*tree),(void *)&tree);
  stack_init(&s_value,sizeof(*value),(void *)&value);
  stack_init(&s_func,sizeof(*lfunc),(void *)&lfunc);
  stack_init(&s_ctx,sizeof(*ctxstack),(void *)&ctxstack);
  stack_init(&s_aff,sizeof(*affstack),(void *)&affstack);
  stack_init(&s_bloc,sizeof(*block),(void *)&block);
  stack_init(&s_comment,sizeof(*com),(void *)&com);
  stack_init(&s_errors,sizeof(*errors),(void *)&errors);
  stack_init(&s_Ctype,sizeof(*Ctype),(void *)&Ctype);
  stack_init(&s_GPtype,sizeof(*GPtype),(void *)&GPtype);
  stack_init(&s_Mmode,sizeof(*Mmode),(void *)&Mmode);
  stack_init(&s_label,sizeof(*label),(void *)&label);
   /*Node 0 should be a (Gvoid)Fgnil*/
  n=newnode(Fgnil,-1,-1); tree[n].t=Gvoid;
   /*Node 1 should be a (Gnotype)Fgnil*/
  n=newnode(Fgnil,-1,-1); tree[n].t=Gnotype;
}

void
init_stdfunc(void)
{
  FC_badtype=findfuncdesc("_badtype");
  FC_formatcode=findfuncdesc("_formatcode");
  FC_tovec=findfuncdesc("_tovec");
  FC_cast=findfuncdesc("_cast");
  FC_proto_ret=findfuncdesc("_proto_ret");
  FC_proto_code=findfuncdesc("_proto_code");
  FC_decl_base=findfuncdesc("_decl_base");
  FC_decl_ext=findfuncdesc("_decl_ext");
  FC_default_check=findfuncdesc("_default_check");
  FC_default_marker=findfuncdesc("_default_marker");
  FC_gerepileupto=findfuncdesc("_gerepileupto");
  FC_const_smallreal=findfuncdesc("_const_smallreal");
  FC_const_expr=findfuncdesc("_const_expr");
  FC_copy=findfuncdesc("copy");
  FC_avma=findfuncdesc("_avma");
  Gpari_sp=findfunctype("_avma");
  Gbptr=findfunctype("_diffptr");
  FC_low_stack_lim=findfuncdesc("_low_stack_lim");
  /* GP 2.1 has no gerepileall but is supported*/
  FC_gerepileall=findfuncdescopt("_gerepileall");
  Ggptr = (FC_gerepileall<0)?strtotype("gptr"):Gnotype;
  FC_forprime_next=findfuncdescopt("_forprime_next");
  FC_matrixrow=findfuncdescopt("_[_,]");
  FC_const_real=findfuncdescopt("_const_real");
  FC_proto_max_args=findfuncdescopt("_proto_max_args");
  max_args = FC_proto_max_args<0 ? 8 :
             lfunc[FC_proto_max_args].dsc->a[0].args[0].misc;
}

void
init_typedef(void)
{
  gpdesc *def=lfunc[findfuncdesc("_typedef")].dsc;
  int r;
  ctype=(int*)calloc(s_GPtype.n,sizeof(*ctype));
  for (r=0; r<def->nb; r++)
  {
    gpdescarg *rule=def->a+r;
    int t=rule->args[0].type;
    ctype[t]=strtoctype(rule->cname);
  }
  Vgen=strtoctype("GEN");
}

void
compile(FILE *fin, FILE *fout, char *nom)
{
  char *descfile;
  int startnode;
  int status;
  int i;
  init_compiler();
  linecount=1;
  nameparse=nom;
  namelib=calloc(strlen(nameparse)+6,sizeof(*nameparse));
  sprintf(namelib,"%s%s.so",nameparse[0]=='/'?"":"./",nameparse);
  yyin=fin;
  currfunc=-1;
  initoperators();
  if (!(descfile=getenv("GP2C_FUNC_DSC")))
    descfile=FUNCDSC_PATH;
  for(i=0;GPneeded[i];i++) newtype(GPneeded[i]);
  for(i=0; Mneeded[i];i++) newmode( Mneeded[i]);
  initdesc(descfile);
  inittype();
  patchfunclist();
  if(opttype) {outputtype(fout);exit(0);}
  init_stdfunc();
  init_typedef();
  startnode=s_node.n-1;
  status=yyparse();
  for(i=0;i<s_errors.n;i++)
  {
    error_string *s=errors+i;
    fprintf(stderr,"%s:%ld: %s\n",nameparse,s->lineno,s->txt);
  }
  if(status)
  {
    fprintf(stderr,"Errors found: aborting...\n");
    exit(1);
  }
  if (s_errors.n)
  {
    fprintf(stderr,"%d error%s found: aborting...\n",s_errors.n,s_errors.n==1?"":"s");
    exit(1);
  }
  if (startnode==s_node.n-1)
    startnode=GNIL;
  else
    startnode=s_node.n-1;
  if (optgen)
  {
    printnode(fout,startnode);
    printf("\n");
    return;
  }
  if (yydebug) fprintf(stderr,"End of parsing\n");

  if (tree[startnode].f!=Fseq && tree[startnode].f!=Fdeffunc)
    startnode=addseqright(startnode,GNIL);
  gentoplevel(startnode,-1);
  startnode=addinitfunc(startnode);
  if (debug)
    printnode(stderr,startnode);
  genblock(startnode,-1);
  if (opttree==1)
  {
    maketree(stderr,startnode);
    fprintf(stderr,";\n");
  }
  if (debug)
    printnode(stderr,startnode);
  lastpass=0;
  gentype(startnode);
  do_warning=0;
  while (lastpass)
  {
    lastpass=0;
    gentype(startnode);
  }
  do_warning=1;
  if (debug>=2)
  {
    fprintf(stderr,"\n--------------END GENTYPE------------\n");
    printnode(stderr,startnode);
  }
  gendeblock(startnode,-1,0,NULL,NULL);
  moveblock(startnode,-1,0,NULL,NULL);
  if (debug)
  {
    fprintf(stderr,"\n--------------END MOVEBLOCK------------\n");
    printnode(stderr,startnode);
  }
  do
  {
    lastpass=0;
    varlist(startnode);
  } while(lastpass);
  if (!optcleanvar)
    cleanvar(startnode);
  pilelist(startnode);
  if (autogc)
    pileclean(startnode);
  if (optinfo) dump(stderr);
  if (!optcleanvar)
    cleanvar(startnode);
  cleancode(startnode,-1);
  if (tree[startnode].f==Fseq && tree[startnode].y==GNIL)
    startnode=tree[startnode].x;
  switch(opttree)
  {
  case 1:
    maketree(stderr,startnode);
    break;
  case 2:
    maketreeGRL(stderr,startnode);
    break;
  }
  if (debug)
  {
    fprintf(stderr,"\n--------------END CLEANCODE------------\n");
    printnode(stderr,startnode);
  }
  indent=0;
  genheader(fout);
  gencode(fout,startnode);
}
void version(void)
{
  printf("GP to C compiler version %s \n   targeted at PARI/GP %s\n",VERSION,PARI_VERSION);
  printf("Copyright 2000-2010 The PARI Group\n");
  printf("GP2C is free software, covered by the GNU General Public License, and \n\
you are welcome to change it and/or distribute copies of it under \n\
certain conditions.  There is absolutely no warranty for GP2C.\n");
}
void usage(FILE *fout, char *s)
{
  fprintf(fout,"%s [-ghfltvydSWTGV] [-o <file>] [-i N] [-p <prefix>] [file.gp] \n\
GP to C translator. \n\
\n\
user option: \n\
 -o <file> :  Place output in file <file>. \n\
 -g : Generate automatic garbage collection code. \n\
 -iN: Set indentation level to N spaces (default 2). \n\
 -W : Output information about global variables. \n\
 -p <prefix>: Prefix user-defined symbol by <prefix> to avoid conflict. \n\
 -s <suffix>: Add suffix <suffix> to GP install names of functions. \n\
 -S : Assume strict declarations for functions. \n\
query options: \n\
 -h : This help. \n\
 -f : Dump information about functions to stderr. \n\
 -l : Output the list of functions known to the compiler. \n\
 -t : Output the table of types known to the compiler. \n\
 -v : Output version information and exit. \n\
debugging options: \n\
 -d : Increase debugging level. \n\
 -y : Switch parser to debug mode. \n\
 -T : Output syntactic tree in treetool format. \n\
 -TT: Output syntactic tree in VCG/GRL format. \n\
 -G : Generate GP code in place of C code. Don't smile. \n\
 -V : Do not clean up variables. \n\
 \n\
file.gp: file to be processed, default to stdin. \n\
The generated C code is output to stdout unless the -o option is used \n\
 \n\
You can automated the process of compiling with \n\
the script gp2c-run. \n\
",s);
}
int main(int argc, char **argv)
{
  int c;
  FILE *fin;
  FILE *fout=stdout;
  autogc=0;
  warn=0;
  optprefix=NULL;
  optsuffix=NULL;
  while((c=getopt(argc,argv,"gi:hflo:p:s:StvydTGVW"))!=-1)
  {
    switch(c)
    {
    case 'g':
      autogc=1-autogc;
      break;
    case 'i':
      indentlevel=atoi(optarg);
      break;
    case 'h':
      usage(stdout,argv[0]);
      exit(0);
      break;
    case 'f':
      optinfo=1-optinfo;
      break;
    case 'l':
      {
        char *descfile;
        init_compiler();
        if (!(descfile=getenv("GP2C_FUNC_DSC")))
          descfile=FUNCDSC_PATH;
        initdesc(descfile);
        patchfunclist();
        printlistfunc(fout);
        exit(0);
      }
    case 'o':
      fout=fopen(optarg,"w");
      break;
    case 'p':
      optprefix=strdup(optarg);
      break;
    case 's':
      optsuffix=strdup(optarg);
      break;
    case 'S':
      optstrict=1-optstrict;
      break;
    case 't':
      opttype=1-opttype;
      break;
    case 'v':
      version();
      exit(0);
    case 'd':
      debug++;
      debug_stack=debug>1;
      break;
    case 'y':
      yydebug++;
      break;
    case 'T':
      opttree++;
      break;
    case 'G':
      optgen=1-optgen;
      break;
    case 'V':
      optcleanvar=1-optcleanvar;
      break;
    case 'W':
      warn=1-warn;
      break;
    case '?':
      usage(stderr,argv[0]);
      exit(1);
      break;
    }
  }
  if (argc-optind>1)
  {
    usage(stderr,argv[0]);
    exit(1);
  }
  if (argc==optind)
    compile(stdin,fout,"stdin");
  else
  {
    char *nom=argv[optind];
    char *nomf=nom;
    if ((fin=fopen(nomf,"r"))==NULL)
    {
      perror(argv[0]);
      exit(errno);
    }
    compile(fin,fout,nom);
    fclose(fin);
  }
  if (fout!=stdout) fclose(fout);
  return 0;
}

Generated by  Doxygen 1.6.0   Back to index