OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [gcc.target/] [alpha/] [pr39740.c] - Blame information for rev 378

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 312 jeremybenn 
/* { 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 
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.