lang.opt: New option -fdec-intrinsic-ints.

2016-08-03  Fritz Reese  <fritzoreese@gmail.com>

	gcc/fortran/
	* lang.opt: New option -fdec-intrinsic-ints.
	* options.c (set_dec_flags): Enable with -fdec.
	* gfortran.texi, invoke.texi, intrinsics.texi: Update documentation.
	* intrinsic.c (add_function, add_subroutine): New B/I/J/K intrinsic
	variants.

	gcc/testsuite/gfortran.dg/
	* dec_intrinsic_ints.f90: New testcase.

From-SVN: r239078

gcc/fortran/ChangeLog

+2016-08-03  Fritz Reese  <fritzoreese@gmail.com>
+
+	* lang.opt: New option -fdec-intrinsic-ints.
+	* options.c (set_dec_flags): Enable with -fdec.
+	* gfortran.texi, invoke.texi, intrinsics.texi: Update documentation.
+	* intrinsic.c (add_function, add_subroutine): New B/I/J/K intrinsic
+	variants.
+
 2016-07-30  Steven G. Kargl <kargl@gcc.gnu.org>
 
 	PR fortran/41922

gcc/fortran/gfortran.texi

@@ -1461,6 +1461,7 @@ without warning.
 * Read/Write after EOF marker::
 * STRUCTURE and RECORD::
 * UNION and MAP::
+* Type variants for integer intrinsics::
 @end menu
 
 @node Old-style kind specifications
@@ -2367,6 +2368,58 @@ a.h  ===             '.C'
 a.l  ===               '.D'
 @end example
 
+@node Type variants for integer intrinsics
+@subsection Type variants for integer intrinsics
+@cindex intrinsics, integer
+
+Similar to the D/C prefixes to real functions to specify the input/output
+types, GNU Fortran offers B/I/J/K prefixes to integer functions for
+compatibility with DEC programs. The types implied by each are:
+
+@example
+@code{B} - @code{INTEGER(kind=1)}
+@code{I} - @code{INTEGER(kind=2)}
+@code{J} - @code{INTEGER(kind=4)}
+@code{K} - @code{INTEGER(kind=8)}
+@end example
+
+GNU Fortran supports these with the flag @option{-fdec-intrinsic-ints}.
+Intrinsics for which prefixed versions are available and in what form are noted
+in @ref{Intrinsic Procedures}. The complete list of supported intrinsics is
+here:
+
+@multitable @columnfractions .2 .2 .2 .2 .2
+
+@headitem Intrinsic @tab B @tab I @tab J @tab K
+
+@item @code{@ref{ABS}}
+  @tab @code{BABS} @tab @code{IIABS} @tab @code{JIABS} @tab @code{KIABS}
+@item @code{@ref{BTEST}}
+  @tab @code{BBTEST} @tab @code{BITEST} @tab @code{BJTEST} @tab @code{BKTEST}
+@item @code{@ref{IAND}}
+  @tab @code{BIAND} @tab @code{IIAND} @tab @code{JIAND} @tab @code{KIAND}
+@item @code{@ref{IBCLR}}
+  @tab @code{BBCLR} @tab @code{IIBCLR} @tab @code{JIBCLR} @tab @code{KIBCLR}
+@item @code{@ref{IBITS}}
+  @tab @code{BBITS} @tab @code{IIBITS} @tab @code{JIBITS} @tab @code{KIBITS}
+@item @code{@ref{IBSET}}
+  @tab @code{BBSET} @tab @code{IIBSET} @tab @code{JIBSET} @tab @code{KIBSET}
+@item @code{@ref{IEOR}}
+  @tab @code{BIEOR} @tab @code{IIEOR} @tab @code{JIEOR} @tab @code{KIEOR}
+@item @code{@ref{IOR}}
+  @tab @code{BIOR} @tab @code{IIOR} @tab @code{JIOR} @tab @code{KIOR}
+@item @code{@ref{ISHFT}}
+  @tab @code{BSHFT} @tab @code{IISHFT} @tab @code{JISHFT} @tab @code{KISHFT}
+@item @code{@ref{ISHFTC}}
+  @tab @code{BSHFTC} @tab @code{IISHFTC} @tab @code{JISHFTC} @tab @code{KISHFTC}
+@item @code{@ref{MOD}}
+  @tab @code{BMOD} @tab @code{IMOD} @tab @code{JMOD} @tab @code{KMOD}
+@item @code{@ref{NOT}}
+  @tab @code{BNOT} @tab @code{INOT} @tab @code{JNOT} @tab @code{KNOT}
+@item @code{@ref{REAL}}
+  @tab @code{--} @tab @code{FLOATI} @tab @code{FLOATJ} @tab @code{FLOATK}
+@end multitable
+
 
 @node Extensions not implemented in GNU Fortran
 @section Extensions not implemented in GNU Fortran

gcc/fortran/intrinsic.c

@@ -1255,6 +1255,14 @@ add_functions (void)
 	     gfc_check_abs, gfc_simplify_abs, gfc_resolve_abs,
 	     a, BT_REAL, dr, REQUIRED);
 
+  if (flag_dec_intrinsic_ints)
+    {
+      make_alias ("babs", GFC_STD_GNU);
+      make_alias ("iiabs", GFC_STD_GNU);
+      make_alias ("jiabs", GFC_STD_GNU);
+      make_alias ("kiabs", GFC_STD_GNU);
+    }
+
   add_sym_1 ("iabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
 	     NULL, gfc_simplify_abs, gfc_resolve_abs,
 	     a, BT_INTEGER, di, REQUIRED);
@@ -1557,6 +1565,14 @@ add_functions (void)
 	     gfc_check_bitfcn, gfc_simplify_btest, gfc_resolve_btest,
 	     i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
 
+  if (flag_dec_intrinsic_ints)
+    {
+      make_alias ("bbtest", GFC_STD_GNU);
+      make_alias ("bitest", GFC_STD_GNU);
+      make_alias ("bjtest", GFC_STD_GNU);
+      make_alias ("bktest", GFC_STD_GNU);
+    }
+
   make_generic ("btest", GFC_ISYM_BTEST, GFC_STD_F95);
 
   add_sym_2 ("ceiling", GFC_ISYM_CEILING, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
@@ -1950,6 +1966,14 @@ add_functions (void)
 	     gfc_check_iand, gfc_simplify_iand, gfc_resolve_iand,
 	     i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
 
+  if (flag_dec_intrinsic_ints)
+    {
+      make_alias ("biand", GFC_STD_GNU);
+      make_alias ("iiand", GFC_STD_GNU);
+      make_alias ("jiand", GFC_STD_GNU);
+      make_alias ("kiand", GFC_STD_GNU);
+    }
+
   make_generic ("iand", GFC_ISYM_IAND, GFC_STD_F95);
 
   add_sym_2 ("and", GFC_ISYM_AND, CLASS_IMPURE, ACTUAL_NO, BT_LOGICAL,
@@ -1981,6 +2005,14 @@ add_functions (void)
 	     gfc_check_bitfcn, gfc_simplify_ibclr, gfc_resolve_ibclr,
 	     i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
 
+  if (flag_dec_intrinsic_ints)
+    {
+      make_alias ("bbclr", GFC_STD_GNU);
+      make_alias ("iibclr", GFC_STD_GNU);
+      make_alias ("jibclr", GFC_STD_GNU);
+      make_alias ("kibclr", GFC_STD_GNU);
+    }
+
   make_generic ("ibclr", GFC_ISYM_IBCLR, GFC_STD_F95);
 
   add_sym_3 ("ibits", GFC_ISYM_IBITS, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
@@ -1988,12 +2020,28 @@ add_functions (void)
 	     i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED,
 	     ln, BT_INTEGER, di, REQUIRED);
 
+  if (flag_dec_intrinsic_ints)
+    {
+      make_alias ("bbits", GFC_STD_GNU);
+      make_alias ("iibits", GFC_STD_GNU);
+      make_alias ("jibits", GFC_STD_GNU);
+      make_alias ("kibits", GFC_STD_GNU);
+    }
+
   make_generic ("ibits", GFC_ISYM_IBITS, GFC_STD_F95);
 
   add_sym_2 ("ibset", GFC_ISYM_IBSET, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
 	     gfc_check_bitfcn, gfc_simplify_ibset, gfc_resolve_ibset,
 	     i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
 
+  if (flag_dec_intrinsic_ints)
+    {
+      make_alias ("bbset", GFC_STD_GNU);
+      make_alias ("iibset", GFC_STD_GNU);
+      make_alias ("jibset", GFC_STD_GNU);
+      make_alias ("kibset", GFC_STD_GNU);
+    }
+
   make_generic ("ibset", GFC_ISYM_IBSET, GFC_STD_F95);
 
   add_sym_2 ("ichar", GFC_ISYM_ICHAR, CLASS_ELEMENTAL, ACTUAL_NO,
@@ -2007,6 +2055,14 @@ add_functions (void)
 	     gfc_check_ieor, gfc_simplify_ieor, gfc_resolve_ieor,
 	     i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
 
+  if (flag_dec_intrinsic_ints)
+    {
+      make_alias ("bieor", GFC_STD_GNU);
+      make_alias ("iieor", GFC_STD_GNU);
+      make_alias ("jieor", GFC_STD_GNU);
+      make_alias ("kieor", GFC_STD_GNU);
+    }
+
   make_generic ("ieor", GFC_ISYM_IEOR, GFC_STD_F95);
 
   add_sym_2 ("xor", GFC_ISYM_XOR, CLASS_IMPURE, ACTUAL_NO, BT_LOGICAL,
@@ -2072,6 +2128,14 @@ add_functions (void)
 	     gfc_check_ior, gfc_simplify_ior, gfc_resolve_ior,
 	     i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
 
+  if (flag_dec_intrinsic_ints)
+    {
+      make_alias ("bior", GFC_STD_GNU);
+      make_alias ("iior", GFC_STD_GNU);
+      make_alias ("jior", GFC_STD_GNU);
+      make_alias ("kior", GFC_STD_GNU);
+    }
+
   make_generic ("ior", GFC_ISYM_IOR, GFC_STD_F95);
 
   add_sym_2 ("or", GFC_ISYM_OR, CLASS_IMPURE, ACTUAL_NO, BT_LOGICAL,
@@ -2139,6 +2203,14 @@ add_functions (void)
 	     gfc_check_ishft, gfc_simplify_ishft, gfc_resolve_ishft,
 	     i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
 
+  if (flag_dec_intrinsic_ints)
+    {
+      make_alias ("bshft", GFC_STD_GNU);
+      make_alias ("iishft", GFC_STD_GNU);
+      make_alias ("jishft", GFC_STD_GNU);
+      make_alias ("kishft", GFC_STD_GNU);
+    }
+
   make_generic ("ishft", GFC_ISYM_ISHFT, GFC_STD_F95);
 
   add_sym_3 ("ishftc", GFC_ISYM_ISHFTC, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
@@ -2146,6 +2218,14 @@ add_functions (void)
 	     i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED,
 	     sz, BT_INTEGER, di, OPTIONAL);
 
+  if (flag_dec_intrinsic_ints)
+    {
+      make_alias ("bshftc", GFC_STD_GNU);
+      make_alias ("iishftc", GFC_STD_GNU);
+      make_alias ("jishftc", GFC_STD_GNU);
+      make_alias ("kishftc", GFC_STD_GNU);
+    }
+
   make_generic ("ishftc", GFC_ISYM_ISHFTC, GFC_STD_F95);
 
   add_sym_2 ("kill", GFC_ISYM_KILL, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
@@ -2456,6 +2536,14 @@ add_functions (void)
 	     gfc_check_a_p, gfc_simplify_mod, gfc_resolve_mod,
 	     a, BT_INTEGER, di, REQUIRED, p, BT_INTEGER, di, REQUIRED);
 
+  if (flag_dec_intrinsic_ints)
+    {
+      make_alias ("bmod", GFC_STD_GNU);
+      make_alias ("imod", GFC_STD_GNU);
+      make_alias ("jmod", GFC_STD_GNU);
+      make_alias ("kmod", GFC_STD_GNU);
+    }
+
   add_sym_2 ("amod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
 	     NULL, gfc_simplify_mod, gfc_resolve_mod,
 	     a, BT_REAL, dr, REQUIRED, p, BT_REAL, dr, REQUIRED);
@@ -2498,6 +2586,14 @@ add_functions (void)
 	     gfc_check_i, gfc_simplify_not, gfc_resolve_not,
 	     i, BT_INTEGER, di, REQUIRED);
 
+  if (flag_dec_intrinsic_ints)
+    {
+      make_alias ("bnot", GFC_STD_GNU);
+      make_alias ("inot", GFC_STD_GNU);
+      make_alias ("jnot", GFC_STD_GNU);
+      make_alias ("knot", GFC_STD_GNU);
+    }
+
   make_generic ("not", GFC_ISYM_NOT, GFC_STD_F95);
 
   add_sym_2 ("norm2", GFC_ISYM_NORM2, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr,
@@ -2608,6 +2704,13 @@ add_functions (void)
 	     gfc_check_float, gfc_simplify_float, NULL,
 	     a, BT_INTEGER, di, REQUIRED);
 
+  if (flag_dec_intrinsic_ints)
+    {
+      make_alias ("floati", GFC_STD_GNU);
+      make_alias ("floatj", GFC_STD_GNU);
+      make_alias ("floatk", GFC_STD_GNU);
+    }
+
   add_sym_1 ("dfloat", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
 	     gfc_check_float, gfc_simplify_dble, gfc_resolve_dble,
 	     a, BT_REAL, dr, REQUIRED);
@@ -3306,6 +3409,14 @@ add_subroutines (void)
 	      t, BT_INTEGER, di, REQUIRED, INTENT_INOUT,
 	      tp, BT_INTEGER, di, REQUIRED, INTENT_IN);
 
+  if (flag_dec_intrinsic_ints)
+    {
+      make_alias ("bmvbits", GFC_STD_GNU);
+      make_alias ("imvbits", GFC_STD_GNU);
+      make_alias ("jmvbits", GFC_STD_GNU);
+      make_alias ("kmvbits", GFC_STD_GNU);
+    }
+
   add_sym_1s ("random_number", GFC_ISYM_RANDOM_NUMBER, CLASS_IMPURE,
 	      BT_UNKNOWN, 0, GFC_STD_F95,
 	      gfc_check_random_number, NULL, gfc_resolve_random_number,

gcc/fortran/invoke.texi

@@ -116,7 +116,8 @@ by type.  Explanations are in the following sections.
 @xref{Fortran Dialect Options,,Options controlling Fortran dialect}.
 @gccoptlist{-fall-intrinsics -fbackslash -fcray-pointer -fd-lines-as-code @gol
 -fd-lines-as-comments @gol
--fdec -fdec-structure -fdefault-double-8 -fdefault-integer-8 @gol
+-fdec -fdec-structure -fdec-intrinsic-ints @gol
+-fdefault-double-8 -fdefault-integer-8 @gol
 -fdefault-real-8 -fdollar-ok -ffixed-line-length-@var{n} @gol
 -ffixed-line-length-none -ffree-form -ffree-line-length-@var{n} @gol
 -ffree-line-length-none -fimplicit-none -finteger-4-integer-8 @gol
@@ -239,6 +240,7 @@ full documentation.
 
 Other flags enabled by this switch are:
 @option{-fdollar-ok} @option{-fcray-pointer} @option{-fdec-structure}
+@option{-fdec-intrinsic-ints}
 
 @item -fdec-structure
 @opindex @code{fdec-structure}
@@ -247,6 +249,11 @@ Enable DEC @code{STRUCTURE} and @code{RECORD} as well as @code{UNION},
 provided for compatibility only; Fortran 90 derived types should be used
 instead where possible.
 
+@item -fdec-intrinsic-ints
+@opindex @code{fdec-intrinsic-ints}
+Enable B/I/J/K kind variants of existing integer functions (e.g. BIAND, IIAND,
+JIAND, etc...). For a complete list of intrinsics see the full documentation.
+
 @item -fdollar-ok
 @opindex @code{fdollar-ok}
 @cindex @code{$}

gcc/fortran/lang.opt

@@ -424,6 +424,10 @@ fdec
 Fortran
 Enable all DEC language extensions.
 
+fdec-intrinsic-ints
+Fortran Var(flag_dec_intrinsic_ints)
+Enable kind-specific variants of integer intrinsic functions.
+
 fdec-structure
 Fortran
 Enable support for DEC STRUCTURE/RECORD.

gcc/fortran/options.c

@@ -53,6 +53,7 @@ static void
 set_dec_flags (int value)
 {
     gfc_option.flag_dec_structure  = value;
+    flag_dec_intrinsic_ints = value;
 }
 
 

gcc/testsuite/ChangeLog

+2016-08-03  Fritz Reese  <fritzoreese@gmail.com>
+
+	* gfortran.dg/dec_intrinsic_ints.f90: New testcase.
+
 2016-08-03  Richard Biener  <rguenther@suse.de>
 
 	* c-c++-common/ubsan/pr71403-1.c: Use dg-additional-options

gcc/testsuite/gfortran.dg/dec_intrinsic_ints.f90

+! { dg-do compile }
+! { dg-options "-fdec-intrinsic-ints" }
+!
+! Test B/I/J/K integer intrinsics.
+!
+program main
+
+implicit none
+
+integer*1 :: ab = 9_1, bb = 3_1, cb
+integer*2 :: ai = 9_2, bi = 3_2, ci
+integer*4 :: aj = 9_4, bj = 3_4, cj
+integer*8 :: ak = 9_8, bk = 3_8, ck
+integer   :: a  = 9  , b  = 3  , c
+
+integer*1 :: ib = 9_1, bpos = 3_1
+integer*2 :: ii = 9_2, ipos = 3_2
+integer*4 :: ij = 9_4, jpos = 3_4
+integer*8 :: ik = 9_8, kpos = 3_8
+integer   :: i  = 9  ,  pos = 3
+
+integer*1 :: ba,     bc, bd
+integer*2 :: ia,     ic, id
+integer*4 :: ja, jb, jc, jd
+integer*8 :: ka, kb, kc, kd
+
+logical*1 :: lb
+logical*2 :: li
+logical*4 :: lj
+logical*8 :: lk
+logical   :: l
+
+real :: r
+
+lb = bbtest(ib, bpos)
+li = bitest(ii, ipos)
+lj = bjtest(ij, jpos)
+lk = bktest(ik, kpos)
+l  =  btest(i ,  pos)
+
+lb = bbtest(9_1, 3_1)
+li = bitest(9_2, 3_2)
+lj = bjtest(9_4, 3_4)
+lk = bktest(9_8, 3_8)
+l  =  btest(9  , 3  )
+
+r = floati(ai)
+r = floatj(aj)
+r = floatk(ak)
+r = float (a )
+
+r = floati(9_2)
+r = floatj(9_4)
+r = floatk(9_8)
+r = float (9  )
+
+bb =  babs(ab)
+bi = iiabs(ai)
+bj = jiabs(aj)
+bk = kiabs(ak)
+b  =  iabs(a )
+
+bb =  babs(9_1)
+bi = iiabs(9_2)
+bj = jiabs(9_4)
+bk = kiabs(9_8)
+b  =  iabs(9  )
+
+cb = biand(ab, bb)
+ci = iiand(ai, bi)
+cj = jiand(aj, bj)
+ck = kiand(ak, bk)
+c  =  iand(a , b )
+
+cb = biand(9_1, 3_1)
+ci = iiand(9_2, 3_2)
+cj = jiand(9_4, 3_4)
+ck = kiand(9_8, 3_8)
+c  =  iand(9  , 3  )
+
+cb =  bbclr(ib, bpos)
+ci = iibclr(ii, ipos)
+cj = jibclr(ij, jpos)
+ck = kibclr(ik, kpos)
+c  =  ibclr(i ,  pos)
+
+cb =  bbclr(9_1, 3_1)
+ci = iibclr(9_2, 3_2)
+cj = jibclr(9_4, 3_4)
+ck = kibclr(9_8, 3_8)
+c  =  ibclr(i ,  pos)
+
+cb =  bbset(ib, bpos)
+ci = iibset(ii, ipos)
+cj = jibset(ij, jpos)
+ck = kibset(ik, kpos)
+c  =  ibset(i ,  pos)
+
+cb =  bbset(9_1, 3_1)
+ci = iibset(9_2, 3_2)
+cj = jibset(9_4, 3_4)
+ck = kibset(9_8, 3_8)
+c  =  ibset(i ,  pos)
+
+cb = bieor(ab, bb)
+ci = iieor(ai, bi)
+cj = jieor(aj, bj)
+ck = kieor(ak, bk)
+c  =  ieor(a , b )
+
+cb = bieor(9_1, 3_1)
+ci = iieor(9_2, 3_2)
+cj = jieor(9_4, 3_4)
+ck = kieor(9_8, 3_8)
+c  =  ieor(9  , 3  )
+
+cb = bior(ab, bb)
+ci = iior(ai, bi)
+cj = jior(aj, bj)
+ck = kior(ak, bk)
+c  =  ior(a , b )
+
+cb = bior(9_1, 3_1)
+ci = iior(9_2, 3_2)
+cj = jior(9_4, 3_4)
+ck = kior(9_8, 3_8)
+c  =  ior(9  , 3  )
+
+cb = bmod(ab, bb)
+ci = imod(ai, bi)
+cj = jmod(aj, bj)
+ck = kmod(ak, bk)
+c  =  mod(a , b )
+
+cb = bmod(9_1, 3_1)
+ci = imod(9_2, 3_2)
+cj = jmod(9_4, 3_4)
+ck = kmod(9_8, 3_8)
+c  =  mod(9  , 3  )
+
+ba = bbits(121, 10, 5)
+call bmvbits(121_1, 2, 3, ba, 1)
+bc = bshftc(ba, 3, 6)
+bd = bshft(bc, -3)
+ba = bnot(bd)
+
+ia = iibits(357, 10, 5)
+call imvbits(357_2, 8, 3, ia, 1)
+ic = iishftc(ia, 3, 6)
+id = iishft(ic, -3)
+ia = inot(id)
+
+ja = jibits(357, 10, 5)
+call jmvbits(357_4, 8, 3, ja, 1)
+jc = jishftc(ja, 3, 6)
+jd = jishft(jc, -3)
+ja = jnot(jd)
+
+ka = kibits(357_8, 10_8, 5_8)
+call kmvbits(357_8, 8_8, 3_8, ka, 1_8)
+kc = kishftc(ka, 3_8, 6_8)
+kd = kishft(kc, -3_8)
+ka = knot(kd)
+
+end program