Implement real literal extension for Ada

Sometimes it is convenient to be able to specify the exact bits of a
floating-point literal.  For example, you may want to set a
floating-point register to a denormalized value, or to a particular
NaN.

In C, you can do this by combining the "{}" cast with an array
literal, like:

    (gdb) p {double}{0x576488BDD2AE9FFE}
    $1 = 9.8765449999999996e+112

This patch adds a somewhat similar idea to Ada.  It extends the lexer
to allow "l" and "f" suffixes in a based literal.  The "f" indicates a
floating-point literal, and the "l"s control the size of the
floating-point type.

Note that this differs from Ada's based real literals.  I believe
those can also be used to control the bits of a floating-point value,
but they are a bit more cumbersome to use (simplest is binary but
that's also very lengthy).  Also, these aren't implemented in GDB.

I chose not to allow this extension to work with based integer
literals with exponents.  That didn't seem very useful.

gdb/ada-lex.l

@@ -122,7 +122,11 @@ static int paren_depth;
 				      e_ptr + 1);
 		 }
 
-{NUM10}"#"{HEXDIG}({HEXDIG}|_)*"#" {
+	/* The "llf" is a gdb extension to allow a floating-point
+	   constant to be written in some other base.  The
+	   floating-point number is formed by reinterpreting the
+	   bytes, allowing direct control over the bits.  */
+{NUM10}(l{0,2}f)?"#"{HEXDIG}({HEXDIG}|_)*"#" {
 		   canonicalizeNumeral (numbuf, yytext);
 		   return processInt (pstate, numbuf, strchr (numbuf, '#') + 1,
 				      NULL);
@@ -347,18 +351,36 @@ static int
 processInt (struct parser_state *par_state, const char *base0,
 	    const char *num0, const char *exp0)
 {
-  ULONGEST result;
   long exp;
   int base;
-  const char *trailer;
+  /* For the based literal with an "f" prefix, we'll return a
+     floating-point number.  This counts the the number of "l"s seen,
+     to decide the width of the floating-point number to return.  -1
+     means no "f".  */
+  int floating_point_l_count = -1;
 
   if (base0 == NULL)
     base = 10;
   else
     {
-      base = strtol (base0, (char **) NULL, 10);
+      char *end_of_base;
+      base = strtol (base0, &end_of_base, 10);
       if (base < 2 || base > 16)
 	error (_("Invalid base: %d."), base);
+      while (*end_of_base == 'l')
+	{
+	  ++floating_point_l_count;
+	  ++end_of_base;
+	}
+      /* This assertion is ensured by the pattern.  */
+      gdb_assert (floating_point_l_count == -1 || *end_of_base == 'f');
+      if (*end_of_base == 'f')
+	{
+	  ++end_of_base;
+	  ++floating_point_l_count;
+	}
+      /* This assertion is ensured by the pattern.  */
+      gdb_assert (*end_of_base == '#');
     }
 
   if (exp0 == NULL)
@@ -366,26 +388,62 @@ processInt (struct parser_state *par_state, const char *base0,
   else
     exp = strtol(exp0, (char **) NULL, 10);
 
-  errno = 0;
-  result = strtoulst (num0, &trailer, base);
-  if (errno == ERANGE)
-    error (_("Integer literal out of range"));
-  if (isxdigit(*trailer))
-    error (_("Invalid digit `%c' in based literal"), *trailer);
+  gdb_mpz result;
+  while (isxdigit (*num0))
+    {
+      int dig = fromhex (*num0);
+      if (dig >= base)
+	error (_("Invalid digit `%c' in based literal"), *num0);
+      mpz_mul_ui (result.val, result.val, base);
+      mpz_add_ui (result.val, result.val, dig);
+      ++num0;
+    }
 
   while (exp > 0)
     {
-      if (result > (ULONG_MAX / base))
-	error (_("Integer literal out of range"));
-      result *= base;
+      mpz_mul_ui (result.val, result.val, base);
       exp -= 1;
     }
 
-  if ((result >> (gdbarch_int_bit (par_state->gdbarch ())-1)) == 0)
+  if (floating_point_l_count > -1)
+    {
+      struct type *fp_type;
+      if (floating_point_l_count == 0)
+	fp_type = language_lookup_primitive_type (par_state->language (),
+						  par_state->gdbarch (),
+						  "float");
+      else if (floating_point_l_count == 1)
+	fp_type = language_lookup_primitive_type (par_state->language (),
+						  par_state->gdbarch (),
+						  "long_float");
+      else
+	{
+	  /* This assertion is ensured by the pattern.  */
+	  gdb_assert (floating_point_l_count == 2);
+	  fp_type = language_lookup_primitive_type (par_state->language (),
+						    par_state->gdbarch (),
+						    "long_long_float");
+	}
+
+      yylval.typed_val_float.type = fp_type;
+      result.write (gdb::make_array_view (yylval.typed_val_float.val,
+					  TYPE_LENGTH (fp_type)),
+		    type_byte_order (fp_type),
+		    true);
+
+      return FLOAT;
+    }
+
+  gdb_mpz maxval (ULONGEST_MAX / base);
+  if (mpz_cmp (result.val, maxval.val) > 0)
+    error (_("Integer literal out of range"));
+
+  LONGEST value = result.as_integer<LONGEST> ();
+  if ((value >> (gdbarch_int_bit (par_state->gdbarch ())-1)) == 0)
     yylval.typed_val.type = type_int (par_state);
-  else if ((result >> (gdbarch_long_bit (par_state->gdbarch ())-1)) == 0)
+  else if ((value >> (gdbarch_long_bit (par_state->gdbarch ())-1)) == 0)
     yylval.typed_val.type = type_long (par_state);
-  else if (((result >> (gdbarch_long_bit (par_state->gdbarch ())-1)) >> 1) == 0)
+  else if (((value >> (gdbarch_long_bit (par_state->gdbarch ())-1)) >> 1) == 0)
     {
       /* We have a number representable as an unsigned integer quantity.
          For consistency with the C treatment, we will treat it as an
@@ -396,18 +454,18 @@ processInt (struct parser_state *par_state, const char *base0,
        */
       yylval.typed_val.type
 	= builtin_type (par_state->gdbarch ())->builtin_unsigned_long;
-      if (result & LONGEST_SIGN)
+      if (value & LONGEST_SIGN)
 	yylval.typed_val.val =
-	  (LONGEST) (result & ~LONGEST_SIGN)
+	  (LONGEST) (value & ~LONGEST_SIGN)
 	  - (LONGEST_SIGN>>1) - (LONGEST_SIGN>>1);
       else
-	yylval.typed_val.val = (LONGEST) result;
+	yylval.typed_val.val = (LONGEST) value;
       return INT;
     }
   else
     yylval.typed_val.type = type_long_long (par_state);
 
-  yylval.typed_val.val = (LONGEST) result;
+  yylval.typed_val.val = value;
   return INT;
 }