Implement first part of unsigned integers for Fortran.

gcc/fortran/ChangeLog:

	* arith.cc (gfc_reduce_unsigned): New function.
	(gfc_arith_error): Add ARITH_UNSIGNED_TRUNCATED and
	ARITH_UNSIGNED_NEGATIVE.
	(gfc_arith_init_1): Initialize unsigned types.
	(gfc_check_unsigned_range): New function.
	(gfc_range_check): Handle unsigned types.
	(gfc_arith_uminus): Likewise.
	(gfc_arith_plus): Likewise.
	(gfc_arith_minus): Likewise.
	(gfc_arith_times): Likewise.
	(gfc_arith_divide): Likewise.
	(gfc_compare_expr): Likewise.
	(eval_intrinsic): Likewise.
	(gfc_int2int): Also convert unsigned.
	(gfc_uint2uint): New function.
	(gfc_int2uint): New function.
	(gfc_uint2int): New function.
	(gfc_uint2real): New function.
	(gfc_uint2complex): New function.
	(gfc_real2uint): New function.
	(gfc_complex2uint): New function.
	(gfc_log2uint): New function.
	(gfc_uint2log): New function.
	* arith.h (gfc_int2uint, gfc_uint2uint, gfc_uint2int, gfc_uint2real):
	Add prototypes.
	(gfc_uint2complex, gfc_real2uint, gfc_complex2uint, gfc_log2uint):
	Likewise.
	(gfc_uint2log): Likewise.
	* check.cc (gfc_boz2uint): New function
	(type_check2): New function.
	(int_or_real_or_unsigned_check): New function.
	(less_than_bitsizekind): Adjust for unsingeds.
	(less_than_bitsize2): Likewise.
	(gfc_check_allocated): Likewise.
	(gfc_check_mod): Likewise.
	(gfc_check_bge_bgt_ble_blt): Likewise.
	(gfc_check_bitfcn): Likewise.
	(gfc_check_digits): Likewise.
	(gfc_check_dshift): Likewise.
	(gfc_check_huge): Likewise.
	(gfc_check_iu): New function.
	(gfc_check_iand_ieor_ior): Adjust for unsigneds.
	(gfc_check_ibits): Likewise.
	(gfc_check_uint): New function.
	(gfc_check_ishft): Adjust for unsigneds.
	(gfc_check_ishftc): Likewise.
	(gfc_check_min_max): Likewise.
	(gfc_check_merge_bits): Likewise.
	(gfc_check_selected_int_kind): Likewise.
	(gfc_check_shift): Likewise.
	(gfc_check_mvbits): Likewise.
	(gfc_invalid_unsigned_ops): Likewise.
	* decl.cc (gfc_match_decl_type_spec): Likewise.
	* dump-parse-tree.cc (show_expr): Likewise.
	* expr.cc (gfc_get_constant_expr): Likewise.
	(gfc_copy_expr): Likewise.
	(gfc_extract_int): Likewise.
	(numeric_type): Likewise.
	* gfortran.h (enum arith): Extend with ARITH_UNSIGNED_TRUNCATED
	and ARITH_UNSIGNED_NEGATIVE.
	(enum gfc_isym_id): Extend with GFC_ISYM_SU_KIND and GFC_ISYM_UINT.
	(gfc_check_unsigned_range): New prototype-
	(gfc_arith_error): Likewise.
	(gfc_reduce_unsigned): Likewise.
	(gfc_boz2uint): Likewise.
	(gfc_invalid_unsigned_ops): Likewise.
	(gfc_convert_mpz_to_unsigned): Likewise.
	* gfortran.texi: Add some rudimentary documentation.
	* intrinsic.cc (gfc_type_letter): Adjust for unsigneds.
	(add_functions): Add uint and adjust functions to be called.
	(add_conversions): Add unsigned conversions.
	(gfc_convert_type_warn): Adjust for unsigned.
	* intrinsic.h (gfc_check_iu, gfc_check_uint, gfc_check_mod, gfc_simplify_uint,
	gfc_simplify_selected_unsigned_kind, gfc_resolve_uint): New prototypes.
	* invoke.texi: Add -funsigned.
	* iresolve.cc (gfc_resolve_dshift): Handle unsigneds.
	(gfc_resolve_iand): Handle unsigneds.
	(gfc_resolve_ibclr): Handle unsigneds.
	(gfc_resolve_ibits): Handle unsigneds.
	(gfc_resolve_ibset): Handle unsigneds.
	(gfc_resolve_ieor): Handle unsigneds.
	(gfc_resolve_ior): Handle unsigneds.
	(gfc_resolve_uint): Handle unsigneds.
	(gfc_resolve_merge_bits): Handle unsigneds.
	(gfc_resolve_not): Handle unsigneds.
	* lang.opt: Add -funsigned.
	* libgfortran.h: Add BT_UNSIGNED.
	* match.cc (gfc_match_type_spec): Match UNSIGNED.
	* misc.cc (gfc_basic_typename): Add UNSIGNED.
	(gfc_typename): Likewise.
	* primary.cc (convert_unsigned): New function.
	(match_unsigned_constant): New function.
	(gfc_match_literal_constant): Handle unsigned.
	* resolve.cc (resolve_operator): Handle unsigned.
	(resolve_ordinary_assign): Likewise.
	* simplify.cc (convert_mpz_to_unsigned): Renamed to...
	(gfc_convert_mpz_to_unsigned): and adjusted.
	(gfc_simplify_bit_size): Adjusted for unsigned.
	(compare_bitwise): Likewise.
	(gfc_simplify_bge): Likewise.
	(gfc_simplify_bgt): Likewise.
	(gfc_simplify_ble): Likewise.
	(gfc_simplify_blt): Likewise.
	(simplify_cmplx): Likewise.
	(gfc_simplify_digits): Likewise.
	(simplify_dshift): Likewise.
	(gfc_simplify_huge): Likewise.
	(gfc_simplify_iand): Likewise.
	(gfc_simplify_ibclr): Likewise.
	(gfc_simplify_ibits): Likewise.
	(gfc_simplify_ibset): Likewise.
	(gfc_simplify_ieor): Likewise.
	(gfc_simplify_uint): Likewise.
	(gfc_simplify_ior): Likewise.
	(simplify_shift): Likewise.
	(gfc_simplify_ishftc): Likewise.
	(gfc_simplify_merge_bits): Likewise.
	(min_max_choose): Likewise.
	(gfc_simplify_mod): Likewise.
	(gfc_simplify_modulo): Likewise.
	(gfc_simplify_popcnt): Likewise.
	(gfc_simplify_range): Likewise.
	(gfc_simplify_selected_unsigned_kind): Likewise.
	(gfc_convert_constant): Likewise.
	* target-memory.cc (size_unsigned): New function.
	(gfc_element_size): Adjust for unsigned.
	* trans-const.h (gfc_conv_mpz_unsigned_to_tree): Add prototype.
	* trans-const.cc (gfc_conv_mpz_unsigned_to_tree): Handle unsigneds.
	(gfc_conv_constant_to_tree): Likewise.
	* trans-decl.cc (gfc_conv_cfi_to_gfc): Put in "not yet implemented".
	* trans-expr.cc (gfc_conv_gfc_desc_to_cfi_desc): Likewise.
	* trans-stmt.cc (gfc_trans_integer_select): Handle unsigned.
	(gfc_trans_select): Likewise.
	* trans-intrinsic.cc (gfc_conv_intrinsic_mod): Handle unsigned.
	(gfc_conv_intrinsic_shift): Likewise.
	(gfc_conv_intrinsic_function): Add GFC_ISYM_UINT.
	* trans-io.cc (enum iocall): Add IOCALL_X_UNSIGNED and IOCALL_X_UNSIGNED_WRITE.
	(gfc_build_io_library_fndecls): Add transfer_unsigned and transfer_unsigned_write.
	(transfer_expr): Handle unsigneds.
	* trans-types.cc (gfc_unsinged_kinds): New array.
	(gfc_unsigned_types): Likewise.
	(gfc_init_kinds): Handle them.
	(validate_unsigned): New function.
	(gfc_validate_kind): Use it.
	(gfc_build_unsigned_type): New function.
	(gfc_init_types): Use it.
	(gfc_get_unsigned_type): New function.
	(gfc_typenode_for_spec): Handle unsigned.
	* trans-types.h (gfc_get_unsigned_type): New prototype.

libgfortran/ChangeLog:

	* gfortran.map: Add _gfortran_transfer_unsgned and
	_gfortran_transfer-signed.
	* io/io.h (set_unsigned): New prototype.
	(us_max): New prototype.
	(read_decimal_unsigned): New prototype.
	(write_iu): New prototype.
	* io/list_read.c (convert_unsigned): New function.
	(read_integer): Also handle unsigneds.
	(list_formatted_read_scalar): Handle unsigneds.
	(nml_read_obj): Likewise.
	* io/read.c (set_unsigned): New function.
	(us_max): New function.
	(read_utf8): Whitespace fixes.
	(read_default_char1): Whitespace fixes.
	(read_a_char4): Whitespace fixes.
	(next_char): Whiltespace fixes.
	(read_decimal_unsigned): New function.
	(read_f): Whitespace fixes.
	(read_x): Whitespace fixes.
	* io/transfer.c (transfer_unsigned): New function.
	(transfer_unsigned_write): New function.
	(require_one_of_two_types): New function.
	(formatted_transfer_scalar_read): Use it.
	(formatted_transfer_scalar_write): Also use it.
	* io/write.c (write_decimal_unsigned): New function.
	(write_iu): New function.
	(write_unsigned): New function.
	(list_formatted_write_scalar): Adjust for unsigneds.
	* libgfortran.h (GFC_UINTEGER_1_HUGE): Define.
	(GFC_UINTEGER_2_HUGE): Define.
	(GFC_UINTEGER_4_HUGE): Define.
	(GFC_UINTEGER_8_HUGE): Define.
	(GFC_UINTEGER_16_HUGE): Define.
	(HAVE_GFC_UINTEGER_1): Undefine (done by mk-kind-h.sh)
	(HAVE_GFC_UINTEGER_4): Likewise.
	* mk-kinds-h.sh: Add GFC_UINTEGER_*_HUGE.

gcc/testsuite/ChangeLog:

	* gfortran.dg/unsigned_1.f90: New test.
	* gfortran.dg/unsigned_10.f90: New test.
	* gfortran.dg/unsigned_11.f90: New test.
	* gfortran.dg/unsigned_12.f90: New test.
	* gfortran.dg/unsigned_13.f90: New test.
	* gfortran.dg/unsigned_14.f90: New test.
	* gfortran.dg/unsigned_15.f90: New test.
	* gfortran.dg/unsigned_16.f90: New test.
	* gfortran.dg/unsigned_17.f90: New test.
	* gfortran.dg/unsigned_18.f90: New test.
	* gfortran.dg/unsigned_19.f90: New test.
	* gfortran.dg/unsigned_2.f90: New test.
	* gfortran.dg/unsigned_20.f90: New test.
	* gfortran.dg/unsigned_21.f90: New test.
	* gfortran.dg/unsigned_22.f90: New test.
	* gfortran.dg/unsigned_23.f90: New test.
	* gfortran.dg/unsigned_24.f: New test.
	* gfortran.dg/unsigned_3.f90: New test.
	* gfortran.dg/unsigned_4.f90: New test.
	* gfortran.dg/unsigned_5.f90: New test.
	* gfortran.dg/unsigned_6.f90: New test.
	* gfortran.dg/unsigned_7.f90: New test.
	* gfortran.dg/unsigned_8.f90: New test.
	* gfortran.dg/unsigned_9.f90: New test.

1 files changed, 213 insertions, 23 deletions

diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c
index 7a9e341..aa866bf 100644
--- a/libgfortran/io/read.c
+++ b/libgfortran/io/read.c
@@ -54,7 +54,7 @@ set_integer (void *dest, GFC_INTEGER_LARGEST value, int length)
       }
       break;
 #endif
-/* length=10 comes about for kind=10 real/complex BOZ, cf. PR41711. */
+/* length=10 comes about for kind=10 real/complex BOZ, see PR41711. */
     case 10:
     case 16:
       {
@@ -92,6 +92,62 @@ set_integer (void *dest, GFC_INTEGER_LARGEST value, int length)
     }
 }
 
+/* set_integer()-- All of the integer assignments come here to
+   actually place the value into memory.  */
+
+void
+set_unsigned (void *dest, GFC_UINTEGER_LARGEST value, int length)
+{
+  NOTE ("set_integer: %lld %p", (long long int) value, dest);
+  switch (length)
+    {
+#ifdef HAVE_GFC_UINTEGER_16
+#ifdef HAVE_GFC_REAL_17
+    case 17:
+      {
+	GFC_UINTEGER_16 tmp = value;
+	memcpy (dest, (void *) &tmp, 16);
+      }
+      break;
+#endif
+/* length=10 comes about for kind=10 real/complex BOZ, cf. PR41711.  */
+    case 10:
+    case 16:
+      {
+	GFC_UINTEGER_16 tmp = value;
+	memcpy (dest, (void *) &tmp, length);
+      }
+      break;
+#endif
+    case 8:
+      {
+	GFC_UINTEGER_8 tmp = value;
+	memcpy (dest, (void *) &tmp, length);
+      }
+      break;
+    case 4:
+      {
+	GFC_UINTEGER_4 tmp = value;
+	memcpy (dest, (void *) &tmp, length);
+      }
+      break;
+    case 2:
+      {
+	GFC_UINTEGER_2 tmp = value;
+	memcpy (dest, (void *) &tmp, length);
+      }
+      break;
+    case 1:
+      {
+	GFC_UINTEGER_1 tmp = value;
+	memcpy (dest, (void *) &tmp, length);
+      }
+      break;
+    default:
+      internal_error (NULL, "Bad integer kind");
+    }
+}
+
 
 /* Max signed value of size give by length argument.  */
 
@@ -132,6 +188,28 @@ si_max (int length)
     }
 }
 
+GFC_UINTEGER_LARGEST
+us_max (int length)
+{
+  switch (length)
+    {
+#ifdef HAVE_GFC_UINTEGER_16
+    case 17:
+    case 16:
+      return GFC_UINTEGER_16_HUGE;
+#endif
+    case 8:
+      return GFC_UINTEGER_8_HUGE;
+    case 4:
+      return GFC_UINTEGER_4_HUGE;
+    case 2:
+      return GFC_UINTEGER_2_HUGE;
+    case 1:
+      return GFC_UINTEGER_1_HUGE;
+    default:
+      internal_error (NULL, "Bad unsigned kind");
+    }
+}
 
 /* convert_real()-- Convert a character representation of a floating
    point number to the machine number.  Returns nonzero if there is an
@@ -392,7 +470,7 @@ read_utf8 (st_parameter_dt *dtp, size_t *nbytes)
     if ((c & ~masks[nb-1]) == patns[nb-1])
       goto found;
   goto invalid;
-	
+
  found:
   c = (c & masks[nb-1]);
   nread = nb - 1;
@@ -423,7 +501,7 @@ read_utf8 (st_parameter_dt *dtp, size_t *nbytes)
     goto invalid;
 
   return c;
-      
+
  invalid:
   generate_error (&dtp->common, LIBERROR_READ_VALUE, "Invalid UTF-8 encoding");
   return (gfc_char4_t) '?';
@@ -466,7 +544,7 @@ read_default_char1 (st_parameter_dt *dtp, char *p, size_t len, size_t width)
   size_t m;
 
   s = read_block_form (dtp, &width);
-  
+
   if (s == NULL)
     return;
   if (width > len)
@@ -610,7 +688,7 @@ read_a_char4 (st_parameter_dt *dtp, const fnode *f, char *p, size_t length)
     read_utf8_char4 (dtp, p, length, w);
   else
     read_default_char4 (dtp, p, length, w);
-  
+
   dtp->u.p.sf_read_comma =
     dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA ? 0 : 1;
 }
@@ -651,7 +729,7 @@ next_char (st_parameter_dt *dtp, char **p, size_t *w)
   if (c != ' ')
     return c;
   if (dtp->u.p.blank_status != BLANK_UNSPECIFIED)
-    return ' ';  /* return a blank to signal a null */ 
+    return ' ';  /* return a blank to signal a null */
 
   /* At this point, the rest of the field has to be trailing blanks */
 
@@ -730,19 +808,19 @@ read_decimal (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
       c = next_char (dtp, &p, &w);
       if (c == '\0')
 	break;
-	
+
       if (c == ' ')
         {
 	  if (dtp->u.p.blank_status == BLANK_NULL)
 	    {
 	      /* Skip spaces.  */
 	      for ( ; w > 0; p++, w--)
-		if (*p != ' ') break; 
+		if (*p != ' ') break;
 	      continue;
 	    }
 	  if (dtp->u.p.blank_status == BLANK_ZERO) c = '0';
         }
-        
+
       if (c < '0' || c > '9')
 	goto bad;
 
@@ -778,6 +856,119 @@ read_decimal (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
 
 }
 
+/* read_decimal_unsigned() - almost the same as above.  Checks for sign
+   and overflow are performed with -pedantic.  */
+
+void
+read_decimal_unsigned (st_parameter_dt *dtp, const fnode *f, char *dest,
+		       int length)
+{
+  GFC_UINTEGER_LARGEST value, old_value;
+  size_t w;
+  int negative;
+  char c, *p;
+
+  w = f->u.w;
+
+  /* This is a legacy extension, and the frontend will only allow such cases
+   * through when -fdec-format-defaults is passed.
+   */
+  if (w == (size_t) DEFAULT_WIDTH)
+    w = default_width_for_integer (length);
+
+  p = read_block_form (dtp, &w);
+
+  if (p == NULL)
+    return;
+
+  p = eat_leading_spaces (&w, p);
+  if (w == 0)
+    {
+      set_unsigned (dest, (GFC_UINTEGER_LARGEST) 0, length);
+      return;
+    }
+
+  negative = 0;
+
+  switch (*p)
+    {
+    case '-':
+      if (compile_options.pedantic)
+	goto no_sign;
+
+      negative = 1;
+
+      /* Fall through.  */
+
+    case '+':
+      p++;
+      if (--w == 0)
+	goto bad;
+      /* Fall through.  */
+
+    default:
+      break;
+    }
+
+  /* At this point we have a digit-string.  */
+  value = 0;
+
+  for (;;)
+    {
+      c = next_char (dtp, &p, &w);
+      if (c == '\0')
+	break;
+
+      if (c == ' ')
+	{
+	  if (dtp->u.p.blank_status == BLANK_NULL)
+	    {
+	      /* Skip spaces.  */
+	      for ( ; w > 0; p++, w--)
+		if (*p != ' ') break;
+	      continue;
+	    }
+	  if (dtp->u.p.blank_status == BLANK_ZERO) c = '0';
+	}
+
+      if (c < '0' || c > '9')
+	goto bad;
+
+      c -= '0';
+      old_value = value;
+      value = 10 * value + c;
+      if (compile_options.pedantic && value < old_value)
+	goto overflow;
+    }
+
+  if (negative)
+    value = -value;
+
+  if (compile_options.pedantic && value > us_max (length))
+    goto overflow;
+
+  set_unsigned (dest, value, length);
+  return;
+
+ bad:
+  generate_error (&dtp->common, LIBERROR_READ_VALUE,
+		  "Bad value during unsigned integer read");
+  next_record (dtp, 1);
+  return;
+
+ no_sign:
+  generate_error (&dtp->common, LIBERROR_READ_VALUE,
+		  "Negative sign for unsigned integer read");
+  next_record (dtp, 1);
+  return;
+
+ overflow:
+  generate_error (&dtp->common, LIBERROR_READ_OVERFLOW,
+		  "Value overflowed during unsigned integer read");
+  next_record (dtp, 1);
+
+}
+
 
 /* read_radix()-- This function reads values for non-decimal radixes.
    The difference here is that we treat the values here as unsigned
@@ -992,7 +1183,7 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
   if (w == 0)
     goto zero;
 
-  /* Check for Infinity or NaN.  */    
+  /* Check for Infinity or NaN.  */
   if (unlikely ((w >= 3 && (*p == 'i' || *p == 'I' || *p == 'n' || *p == 'N'))))
     {
       int seen_paren = 0;
@@ -1034,9 +1225,9 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
 	  ++p;
 	  ++out;
 	}
-	 
+
       *out = '\0';
-      
+
       if (seen_paren != 0 && seen_paren != 2)
 	goto bad_float;
 
@@ -1133,7 +1324,7 @@ found_digit:
       ++p;
       --w;
     }
-  
+
   /* No exponent has been seen, so we use the current scale factor.  */
   exponent = - dtp->u.p.scale_factor;
   goto done;
@@ -1171,7 +1362,7 @@ exponent:
 	  ++p;
 	  --w;
 	}
-	
+
       /* Only allow trailing blanks.  */
       while (w > 0)
 	{
@@ -1180,7 +1371,7 @@ exponent:
 	  ++p;
 	  --w;
 	}
-    }    
+    }
   else  /* BZ or BN status is enabled.  */
     {
       while (w > 0)
@@ -1220,7 +1411,7 @@ done:
      significand.  */
   else if (!seen_int_digit && !seen_dec_digit)
     {
-      notify_std (&dtp->common, GFC_STD_LEGACY, 
+      notify_std (&dtp->common, GFC_STD_LEGACY,
 		  "REAL input of style 'E+NN'");
       *(out++) = '0';
     }
@@ -1313,20 +1504,20 @@ read_x (st_parameter_dt *dtp, size_t n)
   if ((dtp->u.p.current_unit->pad_status == PAD_NO || is_internal_unit (dtp))
       && dtp->u.p.current_unit->bytes_left < (gfc_offset) n)
     n = dtp->u.p.current_unit->bytes_left;
-    
+
   if (n == 0)
     return;
-    
+
   if (dtp->u.p.current_unit->flags.encoding == ENCODING_UTF8)
     {
       gfc_char4_t c;
       size_t nbytes, j;
-    
+
       /* Proceed with decoding one character at a time.  */
       for (j = 0; j < n; j++)
 	{
 	  c = read_utf8 (dtp, &nbytes);
-    
+
 	  /* Check for a short read and if so, break out.  */
 	  if (nbytes == 0 || c == (gfc_char4_t)0)
 	    break;
@@ -1363,7 +1554,7 @@ read_x (st_parameter_dt *dtp, size_t n)
 	     the rest of the I/O statement.  Set the corresponding flag.  */
 	  if (dtp->u.p.advance_status == ADVANCE_NO || dtp->u.p.seen_dollar)
 	    dtp->u.p.eor_condition = 1;
-	    
+
 	  /* If we encounter a CR, it might be a CRLF.  */
 	  if (q == '\r') /* Probably a CRLF */
 	    {
@@ -1377,7 +1568,7 @@ read_x (st_parameter_dt *dtp, size_t n)
 	  goto done;
 	}
       n++;
-    } 
+    }
 
  done:
   if (((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) ||
@@ -1386,4 +1577,3 @@ read_x (st_parameter_dt *dtp, size_t n)
   dtp->u.p.current_unit->bytes_left -= n;
   dtp->u.p.current_unit->strm_pos += (gfc_offset) n;
 }
-