re PR libfortran/17631 (libfortran: intrinsic subroutine MVBITS not implemented)
PR fortran/17631 fortran/ * intrinsic.c (add_sym_5): Remove. (add_subroutines): Add resolution function for MVBITS. * intrinsic.h (gfc_resolve_mvbits): Declare resolution function for MVBITS * iresolve.c (gfc_resolve_mvbits): New function. (gfc_resolve_random_number): Remove empty line at end of function. libgfortran/ * Makefile.am (gfor_helper_src): Add intrinsics/mvbits.h. * intrinsics/mvbits.h: New file. testsuite/ * gfortran.fortran-torture/execute/intrinsic_mvbits.f90: New test. From-SVN: r88527
This commit is contained in:
Tobias Schlüter
Tobias Schlüter
parent
58c5b409e8
commit
ee569894e7
9 changed files with 68 additions and 49 deletions
|
|
@ -4,6 +4,14 @@
|
|||
* iresolve.c (gfc_resolve_pack): Choose function depending if mask
|
||||
is scalar.
|
||||
|
||||
PR fortran/17631
|
||||
* intrinsic.c (add_sym_5): Remove.
|
||||
(add_subroutines): Add resolution function for MVBITS.
|
||||
* intrinsic.h (gfc_resolve_mvbits): Declare resolution function for
|
||||
MVBITS
|
||||
* iresolve.c (gfc_resolve_mvbits): New function.
|
||||
(gfc_resolve_random_number): Remove empty line at end of function.
|
||||
|
||||
2004-10-04 Erik Schnetter <schnetter@aei.mpg.de>
|
||||
|
||||
* scanner.c (preprocessor_line): Accept preprocessor lines without
|
||||
|
|
|
|||
|
|
@ -600,35 +600,6 @@ static void add_sym_4s (const char *name, int elemental, int actual_ok,
|
|||
}
|
||||
|
||||
|
||||
static void add_sym_5 (const char *name, int elemental, int actual_ok, bt type,
|
||||
int kind,
|
||||
try (*check)(gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *),
|
||||
gfc_expr *(*simplify)(gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *),
|
||||
void (*resolve)(gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *),
|
||||
const char* a1, bt type1, int kind1, int optional1,
|
||||
const char* a2, bt type2, int kind2, int optional2,
|
||||
const char* a3, bt type3, int kind3, int optional3,
|
||||
const char* a4, bt type4, int kind4, int optional4,
|
||||
const char* a5, bt type5, int kind5, int optional5
|
||||
) {
|
||||
gfc_check_f cf;
|
||||
gfc_simplify_f sf;
|
||||
gfc_resolve_f rf;
|
||||
|
||||
cf.f5 = check;
|
||||
sf.f5 = simplify;
|
||||
rf.f5 = resolve;
|
||||
|
||||
add_sym (name, elemental, actual_ok, type, kind, cf, sf, rf,
|
||||
a1, type1, kind1, optional1,
|
||||
a2, type2, kind2, optional2,
|
||||
a3, type3, kind3, optional3,
|
||||
a4, type4, kind4, optional4,
|
||||
a5, type5, kind5, optional5,
|
||||
(void*)0);
|
||||
}
|
||||
|
||||
|
||||
static void add_sym_5s
|
||||
(
|
||||
const char *name, int elemental, int actual_ok, bt type, int kind,
|
||||
|
|
@ -1960,12 +1931,11 @@ add_subroutines (void)
|
|||
trim_name, BT_LOGICAL, dl, 1);
|
||||
|
||||
|
||||
/* This needs changing to add_sym_5s if it gets a resolution function. */
|
||||
add_sym_5 ("mvbits", 1, 1, BT_UNKNOWN, 0,
|
||||
gfc_check_mvbits, gfc_simplify_mvbits, NULL,
|
||||
f, BT_INTEGER, di, 0, fp, BT_INTEGER, di, 0,
|
||||
ln, BT_INTEGER, di, 0, t, BT_INTEGER, di, 0,
|
||||
tp, BT_INTEGER, di, 0);
|
||||
add_sym_5s ("mvbits", 1, 1, BT_UNKNOWN, 0,
|
||||
gfc_check_mvbits, gfc_simplify_mvbits, gfc_resolve_mvbits,
|
||||
f, BT_INTEGER, di, 0, fp, BT_INTEGER, di, 0,
|
||||
ln, BT_INTEGER, di, 0, t, BT_INTEGER, di, 0,
|
||||
tp, BT_INTEGER, di, 0);
|
||||
|
||||
add_sym_1s ("random_number", 0, 1, BT_UNKNOWN, 0,
|
||||
gfc_check_random_number, NULL, gfc_resolve_random_number,
|
||||
|
|
|
|||
|
|
@ -323,6 +323,7 @@ void gfc_resolve_verify (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
|
|||
|
||||
/* Intrinsic subroutine resolution. */
|
||||
void gfc_resolve_cpu_time (gfc_code *);
|
||||
void gfc_resolve_mvbits (gfc_code *);
|
||||
void gfc_resolve_system_clock(gfc_code *);
|
||||
void gfc_resolve_random_number (gfc_code *);
|
||||
void gfc_resolve_getarg (gfc_code *);
|
||||
|
|
|
|||
|
|
@ -1461,6 +1461,19 @@ gfc_resolve_cpu_time (gfc_code * c ATTRIBUTE_UNUSED)
|
|||
}
|
||||
|
||||
|
||||
void
|
||||
gfc_resolve_mvbits (gfc_code * c)
|
||||
{
|
||||
const char *name;
|
||||
int kind;
|
||||
|
||||
kind = c->ext.actual->expr->ts.kind;
|
||||
name = gfc_get_string (PREFIX("mvbits_i%d"), kind);
|
||||
|
||||
c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
|
||||
}
|
||||
|
||||
|
||||
void
|
||||
gfc_resolve_random_number (gfc_code * c ATTRIBUTE_UNUSED)
|
||||
{
|
||||
|
|
@ -1474,7 +1487,6 @@ gfc_resolve_random_number (gfc_code * c ATTRIBUTE_UNUSED)
|
|||
name = gfc_get_string (PREFIX("arandom_r%d"), kind);
|
||||
|
||||
c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -3,6 +3,9 @@
|
|||
PR fortran/17283
|
||||
* gfortran.fortran-torture/execute/intrinsic_pack.f90: Add more tests.
|
||||
|
||||
PR fortran/17631
|
||||
* gfortran.fortran-torture/execute/intrinsic_mvbits.f90: New test.
|
||||
|
||||
2004-10-04 Chao-ying Fu <fu@mips.com>
|
||||
|
||||
* gcc.dg/vect/pr16105.c: Enable for mipsisa64*-*-*.
|
||||
|
|
|
|||
|
|
@ -0,0 +1,10 @@
|
|||
! Test the MVBITS intrinsic subroutine
|
||||
INTEGER*4 :: from, to, result
|
||||
|
||||
DATA from / z'0003FFFC' /
|
||||
DATA to / z'77760000' /
|
||||
DATA result / z'7777FFFE' /
|
||||
|
||||
CALL mvbits(from, 2, 16, to, 1)
|
||||
if (to /= result) CALL abort()
|
||||
end
|
||||
|
|
@ -7,6 +7,11 @@
|
|||
* runtime/memory.c (internal_malloc, internal_malloc64): Allow
|
||||
allocating zero memory.
|
||||
|
||||
PR fortran/17631
|
||||
* Makefile.am (gfor_helper_src): Add intrinsics/mvbits.h.
|
||||
* Makefile.in: Regenerate.
|
||||
* intrinsics/mvbits.h: New file.
|
||||
|
||||
2004-10-04 Paul Brook <paul@codesourcery.com>
|
||||
Bud Davis <bdavis9659@comcast.net>
|
||||
|
||||
|
|
|
|||
|
|
@ -52,6 +52,7 @@ intrinsics/etime.c \
|
|||
intrinsics/getcwd.c \
|
||||
intrinsics/getXid.c \
|
||||
intrinsics/ishftc.c \
|
||||
intrinsics/mvbits.c \
|
||||
intrinsics/pack_generic.c \
|
||||
intrinsics/size.c \
|
||||
intrinsics/spread_generic.c \
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
# Makefile.in generated by automake 1.8.5 from Makefile.am.
|
||||
# Makefile.in generated by automake 1.8.3 from Makefile.am.
|
||||
# @configure_input@
|
||||
|
||||
# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
|
||||
|
|
@ -121,11 +121,12 @@ am__objects_32 = backspace.lo close.lo endfile.lo format.lo inquire.lo \
|
|||
am__objects_33 = associated.lo abort.lo args.lo bessel.lo \
|
||||
c99_functions.lo cpu_time.lo cshift0.lo date_and_time.lo \
|
||||
env.lo erf.lo eoshift0.lo eoshift2.lo etime.lo getcwd.lo \
|
||||
getXid.lo ishftc.lo pack_generic.lo size.lo spread_generic.lo \
|
||||
string_intrinsics.lo rand.lo random.lo reshape_generic.lo \
|
||||
reshape_packed.lo selected_int_kind.lo selected_real_kind.lo \
|
||||
system_clock.lo transpose_generic.lo unpack_generic.lo \
|
||||
in_pack_generic.lo in_unpack_generic.lo normalize.lo
|
||||
getXid.lo ishftc.lo mvbits.lo pack_generic.lo size.lo \
|
||||
spread_generic.lo string_intrinsics.lo rand.lo random.lo \
|
||||
reshape_generic.lo reshape_packed.lo selected_int_kind.lo \
|
||||
selected_real_kind.lo system_clock.lo transpose_generic.lo \
|
||||
unpack_generic.lo in_pack_generic.lo in_unpack_generic.lo \
|
||||
normalize.lo
|
||||
am__objects_34 =
|
||||
am__objects_35 = _abs_c4.lo _abs_c8.lo _abs_i4.lo _abs_i8.lo \
|
||||
_abs_r4.lo _abs_r8.lo _exp_r4.lo _exp_r8.lo _exp_c4.lo \
|
||||
|
|
@ -324,6 +325,7 @@ intrinsics/etime.c \
|
|||
intrinsics/getcwd.c \
|
||||
intrinsics/getXid.c \
|
||||
intrinsics/ishftc.c \
|
||||
intrinsics/mvbits.c \
|
||||
intrinsics/pack_generic.c \
|
||||
intrinsics/size.c \
|
||||
intrinsics/spread_generic.c \
|
||||
|
|
@ -740,7 +742,7 @@ clean-toolexeclibLTLIBRARIES:
|
|||
-test -z "$(toolexeclib_LTLIBRARIES)" || rm -f $(toolexeclib_LTLIBRARIES)
|
||||
@list='$(toolexeclib_LTLIBRARIES)'; for p in $$list; do \
|
||||
dir="`echo $$p | sed -e 's|/[^/]*$$||'`"; \
|
||||
test "$$dir" != "$$p" || dir=.; \
|
||||
test "$$dir" = "$$p" && dir=.; \
|
||||
echo "rm -f \"$${dir}/so_locations\""; \
|
||||
rm -f "$${dir}/so_locations"; \
|
||||
done
|
||||
|
|
@ -2114,6 +2116,15 @@ ishftc.obj: intrinsics/ishftc.c
|
|||
ishftc.lo: intrinsics/ishftc.c
|
||||
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o ishftc.lo `test -f 'intrinsics/ishftc.c' || echo '$(srcdir)/'`intrinsics/ishftc.c
|
||||
|
||||
mvbits.o: intrinsics/mvbits.c
|
||||
$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o mvbits.o `test -f 'intrinsics/mvbits.c' || echo '$(srcdir)/'`intrinsics/mvbits.c
|
||||
|
||||
mvbits.obj: intrinsics/mvbits.c
|
||||
$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o mvbits.obj `if test -f 'intrinsics/mvbits.c'; then $(CYGPATH_W) 'intrinsics/mvbits.c'; else $(CYGPATH_W) '$(srcdir)/intrinsics/mvbits.c'; fi`
|
||||
|
||||
mvbits.lo: intrinsics/mvbits.c
|
||||
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o mvbits.lo `test -f 'intrinsics/mvbits.c' || echo '$(srcdir)/'`intrinsics/mvbits.c
|
||||
|
||||
pack_generic.o: intrinsics/pack_generic.c
|
||||
$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pack_generic.o `test -f 'intrinsics/pack_generic.c' || echo '$(srcdir)/'`intrinsics/pack_generic.c
|
||||
|
||||
|
|
@ -2932,11 +2943,9 @@ TAGS: $(HEADERS) $(SOURCES) config.h.in $(TAGS_DEPENDENCIES) \
|
|||
done | \
|
||||
$(AWK) ' { files[$$0] = 1; } \
|
||||
END { for (i in files) print i; }'`; \
|
||||
if test -z "$(ETAGS_ARGS)$$tags$$unique"; then :; else \
|
||||
test -n "$$unique" || unique=$$empty_fix; \
|
||||
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
|
||||
$$tags $$unique; \
|
||||
fi
|
||||
test -z "$(ETAGS_ARGS)$$tags$$unique" \
|
||||
|| $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
|
||||
$$tags $$unique
|
||||
ctags: CTAGS
|
||||
CTAGS: $(HEADERS) $(SOURCES) config.h.in $(TAGS_DEPENDENCIES) \
|
||||
$(TAGS_FILES) $(LISP)
|
||||
|
|
@ -3032,7 +3041,7 @@ distcheck: dist
|
|||
*.tar.Z*) \
|
||||
uncompress -c $(distdir).tar.Z | $(AMTAR) xf - ;;\
|
||||
*.shar.gz*) \
|
||||
GZIP=$(GZIP_ENV) gunzip -c $(distdir).shar.gz | unshar ;;\
|
||||
GZIP=$(GZIP_ENV) gunzip -c $(distdir).tar.gz | unshar ;;\
|
||||
*.zip*) \
|
||||
unzip $(distdir).zip ;;\
|
||||
esac
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue