Subversion Repositories openrisc

/* { dg-do compile } */
/* { dg-options "-O3 -std=c99 -mexplicit-relocs" } */
 
typedef int R_len_t;
typedef unsigned int SEXPTYPE;
struct sxpinfo_struct
{
  SEXPTYPE type:5;
};
 
struct vecsxp_struct
{
  R_len_t length;
  R_len_t truelength;
};
 
struct listsxp_struct
{
  struct SEXPREC *carval;
  struct SEXPREC *cdrval;
  struct SEXPREC *tagval;
};
 
typedef struct SEXPREC
{
  struct sxpinfo_struct sxpinfo;
  union
  {
    struct listsxp_struct listsxp;
  } u;
} SEXPREC, *SEXP;
 
typedef struct VECTOR_SEXPREC
{
  struct vecsxp_struct vecsxp;
} VECTOR_SEXPREC, *VECSEXP;
 
typedef union
{
  VECTOR_SEXPREC s;
  double align;
} SEXPREC_ALIGN;
 
extern SEXP R_NilValue;
extern SEXP R_MissingArg;
 
int Rf_envlength (SEXP rho);
SEXP Rf_protect (SEXP);
const char *Rf_translateChar (SEXP);
 
inline R_len_t
Rf_length (SEXP s)
{
  int i;
  switch (((s)->sxpinfo.type))
    {
    case 0:
      return 0;
    case 24:
      return (((VECSEXP) (s))->vecsxp.length);
    case 6:
    case 17:
      i = 0;
      while (s != ((void *) 0) && s != R_NilValue)
	{
	  i++;
	  s = ((s)->u.listsxp.cdrval);
	}
      return i;
    case 4:
      return Rf_envlength (s);
    default:
      return 1;
    }
}
 
inline SEXP
Rf_lang3 (SEXP s, SEXP t, SEXP u)
{
  return s;
}
 
typedef SEXP (*CCODE) (SEXP, SEXP, SEXP, SEXP);
 
static SEXP PlusSymbol;
static SEXP MinusSymbol;
static SEXP DivideSymbol;
 
int isZero (SEXP s);
SEXP PP (SEXP s);
SEXP AddParens (SEXP expr);
SEXP Rf_install ();
 
static int
isUminus (SEXP s)
{
  if (((s)->sxpinfo.type) == 6 && ((s)->u.listsxp.carval) == MinusSymbol)
    {
      switch (Rf_length (s))
	{
	case 2:
	  return 1;
	case 3:
	  if (((((((s)->u.listsxp.cdrval))->u.listsxp.cdrval))->u.listsxp.
	       carval) == R_MissingArg)
	    return 1;
	  else
	    return 0;
	}
    }
  else
    return 0;
}
 
static SEXP
simplify (SEXP fun, SEXP arg1, SEXP arg2)
{
  SEXP ans;
  if (fun == PlusSymbol)
    {
      if (isZero (arg1))
	ans = arg2;
      else if (isUminus (arg1))
	ans =
	  simplify (MinusSymbol, arg2,
		    ((((arg1)->u.listsxp.cdrval))->u.listsxp.carval));
      else if (isUminus (arg2))
	ans =
	  simplify (MinusSymbol, arg1,
		    ((((arg2)->u.listsxp.cdrval))->u.listsxp.carval));
    }
  else if (fun == DivideSymbol)
    {
      ans = Rf_lang3 (DivideSymbol, arg1, arg2);
    }
 
  return ans;
}
 
 
static SEXP
D (SEXP expr, SEXP var)
{
  return simplify (PlusSymbol,
		   PP (D
		       (((((expr)->u.listsxp.cdrval))->u.listsxp.carval),
			var)),
		   PP (D
		       (((((((expr)->u.listsxp.cdrval))->u.listsxp.cdrval))->
			 u.listsxp.carval), var)));
}
 
SEXP
do_D (SEXP call, SEXP op, SEXP args, SEXP env)
{
  SEXP expr, var;
  var = Rf_install ();
  expr = ((args)->u.listsxp.carval);
  Rf_protect (expr = D (expr, var));
  expr = AddParens (expr);
  return expr;
}