gcc/testsuite/gcc.target/alpha/pr39740.c

   1 /* { dg-do compile } */
   2 /* { dg-options "-O3 -std=c99 -mexplicit-relocs" } */
   3
   4 typedef int R_len_t;
   5 typedef unsigned int SEXPTYPE;
   6 struct sxpinfo_struct
   7 {
   8   SEXPTYPE type:5;
   9 };
  10
  11 struct vecsxp_struct
  12 {
  13   R_len_t length;
  14   R_len_t truelength;
  15 };
  16
  17 struct listsxp_struct
  18 {
  19   struct SEXPREC *carval;
  20   struct SEXPREC *cdrval;
  21   struct SEXPREC *tagval;
  22 };
  23
  24 typedef struct SEXPREC
  25 {
  26   struct sxpinfo_struct sxpinfo;
  27   union
  28   {
  29     struct listsxp_struct listsxp;
  30   } u;
  31 } SEXPREC, *SEXP;
  32
  33 typedef struct VECTOR_SEXPREC
  34 {
  35   struct vecsxp_struct vecsxp;
  36 } VECTOR_SEXPREC, *VECSEXP;
  37
  38 typedef union
  39 {
  40   VECTOR_SEXPREC s;
  41   double align;
  42 } SEXPREC_ALIGN;
  43
  44 extern SEXP R_NilValue;
  45 extern SEXP R_MissingArg;
  46
  47 int Rf_envlength (SEXP rho);
  48 SEXP Rf_protect (SEXP);
  49 const char *Rf_translateChar (SEXP);
  50
  51 inline R_len_t
  52 Rf_length (SEXP s)
  53 {
  54   int i;
  55   switch (((s)->sxpinfo.type))
  56     {
  57     case 0:
  58       return 0;
  59     case 24:
  60       return (((VECSEXP) (s))->vecsxp.length);
  61     case 6:
  62     case 17:
  63       i = 0;
  64       while (s != ((void *) 0) && s != R_NilValue)
  65         {
  66           i++;
  67           s = ((s)->u.listsxp.cdrval);
  68         }
  69       return i;
  70     case 4:
  71       return Rf_envlength (s);
  72     default:
  73       return 1;
  74     }
  75 }
  76
  77 inline SEXP
  78 Rf_lang3 (SEXP s, SEXP t, SEXP u)
  79 {
  80   return s;
  81 }
  82
  83 typedef SEXP (*CCODE) (SEXP, SEXP, SEXP, SEXP);
  84
  85 static SEXP PlusSymbol;
  86 static SEXP MinusSymbol;
  87 static SEXP DivideSymbol;
  88
  89 int isZero (SEXP s);
  90 SEXP PP (SEXP s);
  91 SEXP AddParens (SEXP expr);
  92 SEXP Rf_install ();
  93
  94 static int
  95 isUminus (SEXP s)
  96 {
  97   if (((s)->sxpinfo.type) == 6 && ((s)->u.listsxp.carval) == MinusSymbol)
  98     {
  99       switch (Rf_length (s))
 100         {
 101         case 2:
 102           return 1;
 103         case 3:
 104           if (((((((s)->u.listsxp.cdrval))->u.listsxp.cdrval))->u.listsxp.
 105                carval) == R_MissingArg)
 106             return 1;
 107           else
 108             return 0;
 109         }
 110     }
 111   else
 112     return 0;
 113 }
 114
 115 static SEXP
 116 simplify (SEXP fun, SEXP arg1, SEXP arg2)
 117 {
 118   SEXP ans;
 119   if (fun == PlusSymbol)
 120     {
 121       if (isZero (arg1))
 122         ans = arg2;
 123       else if (isUminus (arg1))
 124         ans =
 125           simplify (MinusSymbol, arg2,
 126                     ((((arg1)->u.listsxp.cdrval))->u.listsxp.carval));
 127       else if (isUminus (arg2))
 128         ans =
 129           simplify (MinusSymbol, arg1,
 130                     ((((arg2)->u.listsxp.cdrval))->u.listsxp.carval));
 131     }
 132   else if (fun == DivideSymbol)
 133     {
 134       ans = Rf_lang3 (DivideSymbol, arg1, arg2);
 135     }
 136
 137   return ans;
 138 }
 139
 140
 141 static SEXP
 142 D (SEXP expr, SEXP var)
 143 {
 144   return simplify (PlusSymbol,
 145                    PP (D
 146                        (((((expr)->u.listsxp.cdrval))->u.listsxp.carval),
 147                         var)),
 148                    PP (D
 149                        (((((((expr)->u.listsxp.cdrval))->u.listsxp.cdrval))->
 150                          u.listsxp.carval), var)));
 151 }
 152
 153 SEXP
 154 do_D (SEXP call, SEXP op, SEXP args, SEXP env)
 155 {
 156   SEXP expr, var;
 157   var = Rf_install ();
 158   expr = ((args)->u.listsxp.carval);
 159   Rf_protect (expr = D (expr, var));
 160   expr = AddParens (expr);
 161   return expr;
 162 }