/* Simplify intrinsic functions at compile-time.
- Copyright (C) 2000, 2001, 2002, 2003, 2004 Free Software Foundation,
- Inc.
+ Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software
+ Foundation, Inc.
Contributed by Andy Vaught & Katherine Holcomb
This file is part of GCC.
You should have received a copy of the GNU General Public License
along with GCC; see the file COPYING. If not, write to the Free
-Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA. */
+Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
+02110-1301, USA. */
#include "config.h"
#include "system.h"
#include "flags.h"
-
-#include <string.h>
-
#include "gfortran.h"
#include "arith.h"
#include "intrinsic.h"
return range_check (result, "ACOS");
}
+gfc_expr *
+gfc_simplify_acosh (gfc_expr * x)
+{
+ gfc_expr *result;
+
+ if (x->expr_type != EXPR_CONSTANT)
+ return NULL;
+
+ if (mpfr_cmp_si (x->value.real, 1) < 0)
+ {
+ gfc_error ("Argument of ACOSH at %L must not be less than 1",
+ &x->where);
+ return &gfc_bad_expr;
+ }
+
+ result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
+
+ mpfr_acosh (result->value.real, x->value.real, GFC_RND_MODE);
+
+ return range_check (result, "ACOSH");
+}
gfc_expr *
gfc_simplify_adjustl (gfc_expr * e)
gfc_expr *
gfc_simplify_aimag (gfc_expr * e)
{
+
gfc_expr *result;
if (e->expr_type != EXPR_CONSTANT)
gfc_expr *
gfc_simplify_anint (gfc_expr * e, gfc_expr * k)
{
- gfc_expr *rtrunc, *result;
- int kind, cmp;
- mpfr_t half;
+ gfc_expr *result;
+ int kind;
kind = get_kind (BT_REAL, k, "ANINT", e->ts.kind);
if (kind == -1)
result = gfc_constant_result (e->ts.type, kind, &e->where);
- rtrunc = gfc_copy_expr (e);
+ mpfr_round (result->value.real, e->value.real);
+
+ return range_check (result, "ANINT");
+}
- cmp = mpfr_cmp_ui (e->value.real, 0);
- gfc_set_model_kind (kind);
- mpfr_init (half);
- mpfr_set_str (half, "0.5", 10, GFC_RND_MODE);
+gfc_expr *
+gfc_simplify_and (gfc_expr * x, gfc_expr * y)
+{
+ gfc_expr *result;
+ int kind;
- if (cmp > 0)
+ if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT)
+ return NULL;
+
+ kind = x->ts.kind > y->ts.kind ? x->ts.kind : y->ts.kind;
+ if (x->ts.type == BT_INTEGER)
{
- mpfr_add (rtrunc->value.real, e->value.real, half, GFC_RND_MODE);
- mpfr_trunc (result->value.real, rtrunc->value.real);
+ result = gfc_constant_result (BT_INTEGER, kind, &x->where);
+ mpz_and (result->value.integer, x->value.integer, y->value.integer);
}
- else if (cmp < 0)
+ else /* BT_LOGICAL */
{
- mpfr_sub (rtrunc->value.real, e->value.real, half, GFC_RND_MODE);
- mpfr_trunc (result->value.real, rtrunc->value.real);
+ result = gfc_constant_result (BT_LOGICAL, kind, &x->where);
+ result->value.logical = x->value.logical && y->value.logical;
}
- else
- mpfr_set_ui (result->value.real, 0, GFC_RND_MODE);
-
- gfc_free_expr (rtrunc);
- mpfr_clear (half);
- return range_check (result, "ANINT");
+ return range_check (result, "AND");
}
gfc_expr *
gfc_simplify_dnint (gfc_expr * e)
{
- gfc_expr *rtrunc, *result;
- int cmp;
- mpfr_t half;
+ gfc_expr *result;
if (e->expr_type != EXPR_CONSTANT)
return NULL;
- result =
- gfc_constant_result (BT_REAL, gfc_default_double_kind, &e->where);
-
- rtrunc = gfc_copy_expr (e);
-
- cmp = mpfr_cmp_ui (e->value.real, 0);
-
- gfc_set_model_kind (gfc_default_double_kind);
- mpfr_init (half);
- mpfr_set_str (half, "0.5", 10, GFC_RND_MODE);
-
- if (cmp > 0)
- {
- mpfr_add (rtrunc->value.real, e->value.real, half, GFC_RND_MODE);
- mpfr_trunc (result->value.real, rtrunc->value.real);
- }
- else if (cmp < 0)
- {
- mpfr_sub (rtrunc->value.real, e->value.real, half, GFC_RND_MODE);
- mpfr_trunc (result->value.real, rtrunc->value.real);
- }
- else
- mpfr_set_ui (result->value.real, 0, GFC_RND_MODE);
+ result = gfc_constant_result (BT_REAL, gfc_default_double_kind, &e->where);
- gfc_free_expr (rtrunc);
- mpfr_clear (half);
+ mpfr_round (result->value.real, e->value.real);
return range_check (result, "DNINT");
}
gfc_expr *
-gfc_simplify_atan (gfc_expr * x)
+gfc_simplify_asinh (gfc_expr * x)
{
gfc_expr *result;
result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
+ mpfr_asinh(result->value.real, x->value.real, GFC_RND_MODE);
+
+ return range_check (result, "ASINH");
+}
+
+
+gfc_expr *
+gfc_simplify_atan (gfc_expr * x)
+{
+ gfc_expr *result;
+
+ if (x->expr_type != EXPR_CONSTANT)
+ return NULL;
+
+ result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
+
mpfr_atan(result->value.real, x->value.real, GFC_RND_MODE);
return range_check (result, "ATAN");
+}
+
+
+gfc_expr *
+gfc_simplify_atanh (gfc_expr * x)
+{
+ gfc_expr *result;
+
+ if (x->expr_type != EXPR_CONSTANT)
+ return NULL;
+
+ if (mpfr_cmp_si (x->value.real, 1) >= 0 ||
+ mpfr_cmp_si (x->value.real, -1) <= 0)
+ {
+ gfc_error ("Argument of ATANH at %L must be inside the range -1 to 1",
+ &x->where);
+ return &gfc_bad_expr;
+ }
+
+ result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
+
+ mpfr_atanh(result->value.real, x->value.real, GFC_RND_MODE);
+ return range_check (result, "ATANH");
}
arctangent2 (y->value.real, x->value.real, result->value.real);
return range_check (result, "ATAN2");
-
}
gfc_expr *ceil, *result;
int kind;
- kind = get_kind (BT_REAL, k, "CEILING", gfc_default_real_kind);
+ kind = get_kind (BT_INTEGER, k, "CEILING", gfc_default_integer_kind);
if (kind == -1)
return &gfc_bad_expr;
if (e->expr_type != EXPR_CONSTANT)
return NULL;
- if (gfc_extract_int (e, &c) != NULL || c < 0 || c > 255)
+ if (gfc_extract_int (e, &c) != NULL || c < 0 || c > UCHAR_MAX)
{
gfc_error ("Bad character in CHAR function at %L", &e->where);
return &gfc_bad_expr;
gfc_expr *
+gfc_simplify_complex (gfc_expr * x, gfc_expr * y)
+{
+ int kind;
+
+ if (x->expr_type != EXPR_CONSTANT
+ || (y != NULL && y->expr_type != EXPR_CONSTANT))
+ return NULL;
+
+ if (x->ts.type == BT_INTEGER)
+ {
+ if (y->ts.type == BT_INTEGER)
+ kind = gfc_default_real_kind;
+ else
+ kind = y->ts.kind;
+ }
+ else
+ {
+ if (y->ts.type == BT_REAL)
+ kind = (x->ts.kind > y->ts.kind) ? x->ts.kind : y->ts.kind;
+ else
+ kind = x->ts.kind;
+ }
+
+ return simplify_cmplx ("COMPLEX", x, y, kind);
+}
+
+
+gfc_expr *
gfc_simplify_conjg (gfc_expr * e)
{
gfc_expr *result;
gfc_simplify_dim (gfc_expr * x, gfc_expr * y)
{
gfc_expr *result;
+ int kind;
if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT)
return NULL;
- result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
+ kind = x->ts.kind > y->ts.kind ? x->ts.kind : y->ts.kind;
+ result = gfc_constant_result (x->ts.type, kind, &x->where);
switch (x->ts.type)
{
gfc_expr *
gfc_simplify_exponent (gfc_expr * x)
{
+ int i;
mpfr_t tmp;
gfc_expr *result;
gfc_mpfr_to_mpz (result->value.integer, tmp);
+ /* The model number for tiny(x) is b**(emin - 1) where b is the base and emin
+ is the smallest exponent value. So, we need to add 1 if x is tiny(x). */
+ i = gfc_validate_kind (x->ts.type, x->ts.kind, false);
+ if (mpfr_cmp (x->value.real, gfc_real_kinds[i].tiny) == 0)
+ mpz_add_ui (result->value.integer,result->value.integer, 1);
+
mpfr_clear (tmp);
return range_check (result, "EXPONENT");
mpfr_t floor;
int kind;
- kind = get_kind (BT_REAL, k, "FLOOR", gfc_default_real_kind);
+ kind = get_kind (BT_INTEGER, k, "FLOOR", gfc_default_integer_kind);
if (kind == -1)
gfc_internal_error ("gfc_simplify_floor(): Bad kind");
result = gfc_copy_expr (x);
mpz_setbit (result->value.integer, pos);
+
+ twos_complement (result->value.integer, gfc_integer_kinds[k].bit_size);
+
return range_check (result, "IBSET");
}
return &gfc_bad_expr;
}
- index = (int) e->value.character.string[0];
+ index = (unsigned char) e->value.character.string[0];
- if (index < CHAR_MIN || index > CHAR_MAX)
+ if (index < 0 || index > UCHAR_MAX)
{
gfc_error ("Argument of ICHAR at %L out of range of this processor",
&e->where);
gfc_expr *rpart, *rtrunc, *result;
int kind;
- kind = get_kind (BT_REAL, k, "INT", gfc_default_real_kind);
+ kind = get_kind (BT_INTEGER, k, "INT", gfc_default_integer_kind);
if (kind == -1)
return &gfc_bad_expr;
static gfc_expr *
-gfc_simplify_bound (gfc_expr * array, gfc_expr * dim, int upper)
+simplify_bound (gfc_expr * array, gfc_expr * dim, int upper)
{
gfc_ref *ref;
gfc_array_spec *as;
- int i;
+ gfc_expr *e;
+ int d;
if (array->expr_type != EXPR_VARIABLE)
return NULL;
if (dim == NULL)
+ /* TODO: Simplify constant multi-dimensional bounds. */
return NULL;
if (dim->expr_type != EXPR_CONSTANT)
/* Follow any component references. */
as = array->symtree->n.sym->as;
- ref = array->ref;
- while (ref->next != NULL)
+ for (ref = array->ref; ref; ref = ref->next)
{
- if (ref->type == REF_COMPONENT)
- as = ref->u.c.sym->as;
- ref = ref->next;
+ switch (ref->type)
+ {
+ case REF_ARRAY:
+ switch (ref->u.ar.type)
+ {
+ case AR_ELEMENT:
+ as = NULL;
+ continue;
+
+ case AR_FULL:
+ /* We're done because 'as' has already been set in the
+ previous iteration. */
+ goto done;
+
+ case AR_SECTION:
+ case AR_UNKNOWN:
+ return NULL;
+ }
+
+ gcc_unreachable ();
+
+ case REF_COMPONENT:
+ as = ref->u.c.component->as;
+ continue;
+
+ case REF_SUBSTRING:
+ continue;
+ }
}
- if (ref->type != REF_ARRAY || ref->u.ar.type != AR_FULL)
+ gcc_unreachable ();
+
+ done:
+ if (as->type == AS_DEFERRED || as->type == AS_ASSUMED_SHAPE)
return NULL;
-
- i = mpz_get_si (dim->value.integer);
- if (upper)
- return gfc_copy_expr (as->upper[i-1]);
- else
- return gfc_copy_expr (as->lower[i-1]);
+
+ d = mpz_get_si (dim->value.integer);
+
+ if (d < 1 || d > as->rank
+ || (d == as->rank && as->type == AS_ASSUMED_SIZE && upper))
+ {
+ gfc_error ("DIM argument at %L is out of bounds", &dim->where);
+ return &gfc_bad_expr;
+ }
+
+ e = upper ? as->upper[d-1] : as->lower[d-1];
+
+ if (e->expr_type != EXPR_CONSTANT)
+ return NULL;
+
+ return gfc_copy_expr (e);
}
gfc_expr *
gfc_simplify_lbound (gfc_expr * array, gfc_expr * dim)
{
- return gfc_simplify_bound (array, dim, 0);
+ return simplify_bound (array, dim, 0);
}
{
gfc_expr *result;
mpfr_t quot, iquot, term;
+ int kind;
if (a->expr_type != EXPR_CONSTANT || p->expr_type != EXPR_CONSTANT)
return NULL;
- result = gfc_constant_result (a->ts.type, a->ts.kind, &a->where);
+ kind = a->ts.kind > p->ts.kind ? a->ts.kind : p->ts.kind;
+ result = gfc_constant_result (a->ts.type, kind, &a->where);
switch (a->ts.type)
{
return &gfc_bad_expr;
}
- gfc_set_model_kind (a->ts.kind);
+ gfc_set_model_kind (kind);
mpfr_init (quot);
mpfr_init (iquot);
mpfr_init (term);
{
gfc_expr *result;
mpfr_t quot, iquot, term;
+ int kind;
if (a->expr_type != EXPR_CONSTANT || p->expr_type != EXPR_CONSTANT)
return NULL;
- result = gfc_constant_result (a->ts.type, a->ts.kind, &a->where);
+ kind = a->ts.kind > p->ts.kind ? a->ts.kind : p->ts.kind;
+ result = gfc_constant_result (a->ts.type, kind, &a->where);
switch (a->ts.type)
{
return &gfc_bad_expr;
}
- gfc_set_model_kind (a->ts.kind);
+ gfc_set_model_kind (kind);
mpfr_init (quot);
mpfr_init (iquot);
mpfr_init (term);
mpfr_div (quot, a->value.real, p->value.real, GFC_RND_MODE);
mpfr_floor (iquot, quot);
mpfr_mul (term, iquot, p->value.real, GFC_RND_MODE);
+ mpfr_sub (result->value.real, a->value.real, term, GFC_RND_MODE);
mpfr_clear (quot);
mpfr_clear (iquot);
mpfr_clear (term);
-
- mpfr_sub (result->value.real, a->value.real, term, GFC_RND_MODE);
break;
default:
gfc_simplify_nearest (gfc_expr * x, gfc_expr * s)
{
gfc_expr *result;
- float rval;
- double val, eps;
- int p, i, k, match_float;
-
- /* FIXME: This implementation is dopey and probably not quite right,
- but it's a start. */
+ mpfr_t tmp;
+ int direction, sgn;
- if (x->expr_type != EXPR_CONSTANT)
+ if (x->expr_type != EXPR_CONSTANT || s->expr_type != EXPR_CONSTANT)
return NULL;
- k = gfc_validate_kind (x->ts.type, x->ts.kind, false);
-
- result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where);
+ gfc_set_model_kind (x->ts.kind);
+ result = gfc_copy_expr (x);
- val = mpfr_get_d (x->value.real, GFC_RND_MODE);
- p = gfc_real_kinds[k].digits;
+ direction = mpfr_sgn (s->value.real);
- eps = 1.;
- for (i = 1; i < p; ++i)
+ if (direction == 0)
{
- eps = eps / 2.;
+ gfc_error ("Second argument of NEAREST at %L may not be zero",
+ &s->where);
+ gfc_free (result);
+ return &gfc_bad_expr;
}
- /* TODO we should make sure that 'float' matches kind 4 */
- match_float = gfc_real_kinds[k].kind == 4;
- if (mpfr_cmp_ui (s->value.real, 0) > 0)
+ /* TODO: Use mpfr_nextabove and mpfr_nextbelow once we move to a
+ newer version of mpfr. */
+
+ sgn = mpfr_sgn (x->value.real);
+
+ if (sgn == 0)
{
- if (match_float)
- {
- rval = (float) val;
- rval = rval + eps;
- mpfr_set_d (result->value.real, rval, GFC_RND_MODE);
- }
+ int k = gfc_validate_kind (BT_REAL, x->ts.kind, 0);
+
+ if (direction > 0)
+ mpfr_add (result->value.real,
+ x->value.real, gfc_real_kinds[k].subnormal, GFC_RND_MODE);
else
- {
- val = val + eps;
- mpfr_set_d (result->value.real, val, GFC_RND_MODE);
- }
+ mpfr_sub (result->value.real,
+ x->value.real, gfc_real_kinds[k].subnormal, GFC_RND_MODE);
}
- else if (mpfr_cmp_ui (s->value.real, 0) < 0)
+ else
{
- if (match_float)
+ if (sgn < 0)
{
- rval = (float) val;
- rval = rval - eps;
- mpfr_set_d (result->value.real, rval, GFC_RND_MODE);
+ direction = -direction;
+ mpfr_neg (result->value.real, result->value.real, GFC_RND_MODE);
}
+
+ if (direction > 0)
+ mpfr_add_one_ulp (result->value.real, GFC_RND_MODE);
else
{
- val = val - eps;
- mpfr_set_d (result->value.real, val, GFC_RND_MODE);
+ /* In this case the exponent can shrink, which makes us skip
+ over one number because we subtract one ulp with the
+ larger exponent. Thus we need to compensate for this. */
+ mpfr_init_set (tmp, result->value.real, GFC_RND_MODE);
+
+ mpfr_sub_one_ulp (result->value.real, GFC_RND_MODE);
+ mpfr_add_one_ulp (result->value.real, GFC_RND_MODE);
+
+ /* If we're back to where we started, the spacing is one
+ ulp, and we get the correct result by subtracting. */
+ if (mpfr_cmp (tmp, result->value.real) == 0)
+ mpfr_sub_one_ulp (result->value.real, GFC_RND_MODE);
+
+ mpfr_clear (tmp);
}
- }
- else
- {
- gfc_error ("Invalid second argument of NEAREST at %L", &s->where);
- gfc_free (result);
- return &gfc_bad_expr;
+
+ if (sgn < 0)
+ mpfr_neg (result->value.real, result->value.real, GFC_RND_MODE);
}
return range_check (result, "NEAREST");
static gfc_expr *
simplify_nint (const char *name, gfc_expr * e, gfc_expr * k)
{
- gfc_expr *rtrunc, *itrunc, *result;
- int kind, cmp;
- mpfr_t half;
+ gfc_expr *itrunc, *result;
+ int kind;
kind = get_kind (BT_INTEGER, k, name, gfc_default_integer_kind);
if (kind == -1)
result = gfc_constant_result (BT_INTEGER, kind, &e->where);
- rtrunc = gfc_copy_expr (e);
itrunc = gfc_copy_expr (e);
- cmp = mpfr_cmp_ui (e->value.real, 0);
-
- gfc_set_model (e->value.real);
- mpfr_init (half);
- mpfr_set_str (half, "0.5", 10, GFC_RND_MODE);
-
- if (cmp > 0)
- {
- mpfr_add (rtrunc->value.real, e->value.real, half, GFC_RND_MODE);
- mpfr_trunc (itrunc->value.real, rtrunc->value.real);
- }
- else if (cmp < 0)
- {
- mpfr_sub (rtrunc->value.real, e->value.real, half, GFC_RND_MODE);
- mpfr_trunc (itrunc->value.real, rtrunc->value.real);
- }
- else
- mpfr_set_ui (itrunc->value.real, 0, GFC_RND_MODE);
+ mpfr_round(itrunc->value.real, e->value.real);
gfc_mpfr_to_mpz (result->value.integer, itrunc->value.real);
gfc_free_expr (itrunc);
- gfc_free_expr (rtrunc);
- mpfr_clear (half);
return range_check (result, name);
}
mpz_and (result->value.integer, result->value.integer,
gfc_integer_kinds[i].max_int);
+ twos_complement (result->value.integer, gfc_integer_kinds[i].bit_size);
+
return range_check (result, "NOT");
}
gfc_expr *
+gfc_simplify_or (gfc_expr * x, gfc_expr * y)
+{
+ gfc_expr *result;
+ int kind;
+
+ if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT)
+ return NULL;
+
+ kind = x->ts.kind > y->ts.kind ? x->ts.kind : y->ts.kind;
+ if (x->ts.type == BT_INTEGER)
+ {
+ result = gfc_constant_result (BT_INTEGER, kind, &x->where);
+ mpz_ior (result->value.integer, x->value.integer, y->value.integer);
+ }
+ else /* BT_LOGICAL */
+ {
+ result = gfc_constant_result (BT_LOGICAL, kind, &x->where);
+ result->value.logical = x->value.logical || y->value.logical;
+ }
+
+ return range_check (result, "OR");
+}
+
+
+gfc_expr *
gfc_simplify_precision (gfc_expr * e)
{
gfc_expr *result;
return range_check (result, "REAL");
}
+
+gfc_expr *
+gfc_simplify_realpart (gfc_expr * e)
+{
+ gfc_expr *result;
+
+ if (e->expr_type != EXPR_CONSTANT)
+ return NULL;
+
+ result = gfc_constant_result (BT_REAL, e->ts.kind, &e->where);
+ mpfr_set (result->value.real, e->value.complex.r, GFC_RND_MODE);
+
+ return range_check (result, "REALPART");
+}
+
gfc_expr *
gfc_simplify_repeat (gfc_expr * e, gfc_expr * n)
{
for (i = 0; i < rank; i++)
mpz_init_set_ui (e->shape[i], shape[i]);
- e->ts = head->expr->ts;
+ e->ts = source->ts;
e->rank = rank;
return e;
gfc_expr *
gfc_simplify_ubound (gfc_expr * array, gfc_expr * dim)
{
- return gfc_simplify_bound (array, dim, 1);
+ return simplify_bound (array, dim, 1);
}
return result;
}
+
+gfc_expr *
+gfc_simplify_xor (gfc_expr * x, gfc_expr * y)
+{
+ gfc_expr *result;
+ int kind;
+
+ if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT)
+ return NULL;
+
+ kind = x->ts.kind > y->ts.kind ? x->ts.kind : y->ts.kind;
+ if (x->ts.type == BT_INTEGER)
+ {
+ result = gfc_constant_result (BT_INTEGER, kind, &x->where);
+ mpz_xor (result->value.integer, x->value.integer, y->value.integer);
+ }
+ else /* BT_LOGICAL */
+ {
+ result = gfc_constant_result (BT_LOGICAL, kind, &x->where);
+ result->value.logical = (x->value.logical && ! y->value.logical)
+ || (! x->value.logical && y->value.logical);
+ }
+
+ return range_check (result, "XOR");
+}
+
+
+
/****************** Constant simplification *****************/
/* Master function to convert one constant to another. While this is
case BT_COMPLEX:
f = gfc_int2complex;
break;
+ case BT_LOGICAL:
+ f = gfc_int2log;
+ break;
default:
goto oops;
}
break;
case BT_LOGICAL:
- if (type != BT_LOGICAL)
- goto oops;
- f = gfc_log2log;
+ switch (type)
+ {
+ case BT_INTEGER:
+ f = gfc_log2int;
+ break;
+ case BT_LOGICAL:
+ f = gfc_log2log;
+ break;
+ default:
+ goto oops;
+ }
+ break;
+
+ case BT_HOLLERITH:
+ switch (type)
+ {
+ case BT_INTEGER:
+ f = gfc_hollerith2int;
+ break;
+
+ case BT_REAL:
+ f = gfc_hollerith2real;
+ break;
+
+ case BT_COMPLEX:
+ f = gfc_hollerith2complex;
+ break;
+
+ case BT_CHARACTER:
+ f = gfc_hollerith2character;
+ break;
+
+ case BT_LOGICAL:
+ f = gfc_hollerith2logical;
+ break;
+
+ default:
+ goto oops;
+ }
break;
default: