gdb/opencl-lang.c

   1 /* OpenCL language support for GDB, the GNU debugger.
   2    Copyright (C) 2010-2019 Free Software Foundation, Inc.
   3
   4    Contributed by Ken Werner <ken.werner@de.ibm.com>.
   5
   6    This file is part of GDB.
   7
   8    This program is free software; you can redistribute it and/or modify
   9    it under the terms of the GNU General Public License as published by
  10    the Free Software Foundation; either version 3 of the License, or
  11    (at your option) any later version.
  12
  13    This program is distributed in the hope that it will be useful,
  14    but WITHOUT ANY WARRANTY; without even the implied warranty of
  15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16    GNU General Public License for more details.
  17
  18    You should have received a copy of the GNU General Public License
  19    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
  20
  21 #include "defs.h"
  22 #include "gdbtypes.h"
  23 #include "symtab.h"
  24 #include "expression.h"
  25 #include "parser-defs.h"
  26 #include "language.h"
  27 #include "varobj.h"
  28 #include "c-lang.h"
  29
  30 /* This macro generates enum values from a given type.  */
  31
  32 #define OCL_P_TYPE(TYPE)\
  33   opencl_primitive_type_##TYPE,\
  34   opencl_primitive_type_##TYPE##2,\
  35   opencl_primitive_type_##TYPE##3,\
  36   opencl_primitive_type_##TYPE##4,\
  37   opencl_primitive_type_##TYPE##8,\
  38   opencl_primitive_type_##TYPE##16
  39
  40 enum opencl_primitive_types {
  41   OCL_P_TYPE (char),
  42   OCL_P_TYPE (uchar),
  43   OCL_P_TYPE (short),
  44   OCL_P_TYPE (ushort),
  45   OCL_P_TYPE (int),
  46   OCL_P_TYPE (uint),
  47   OCL_P_TYPE (long),
  48   OCL_P_TYPE (ulong),
  49   OCL_P_TYPE (half),
  50   OCL_P_TYPE (float),
  51   OCL_P_TYPE (double),
  52   opencl_primitive_type_bool,
  53   opencl_primitive_type_unsigned_char,
  54   opencl_primitive_type_unsigned_short,
  55   opencl_primitive_type_unsigned_int,
  56   opencl_primitive_type_unsigned_long,
  57   opencl_primitive_type_size_t,
  58   opencl_primitive_type_ptrdiff_t,
  59   opencl_primitive_type_intptr_t,
  60   opencl_primitive_type_uintptr_t,
  61   opencl_primitive_type_void,
  62   nr_opencl_primitive_types
  63 };
  64
  65 static struct gdbarch_data *opencl_type_data;
  66
  67 static struct type **
  68 builtin_opencl_type (struct gdbarch *gdbarch)
  69 {
  70   return (struct type **) gdbarch_data (gdbarch, opencl_type_data);
  71 }
  72
  73 /* Returns the corresponding OpenCL vector type from the given type code,
  74    the length of the element type, the unsigned flag and the amount of
  75    elements (N).  */
  76
  77 static struct type *
  78 lookup_opencl_vector_type (struct gdbarch *gdbarch, enum type_code code,
  79                            unsigned int el_length, unsigned int flag_unsigned,
  80                            int n)
  81 {
  82   int i;
  83   unsigned int length;
  84   struct type *type = NULL;
  85   struct type **types = builtin_opencl_type (gdbarch);
  86
  87   /* Check if n describes a valid OpenCL vector size (2, 3, 4, 8, 16).  */
  88   if (n != 2 && n != 3 && n != 4 && n != 8 && n != 16)
  89     error (_("Invalid OpenCL vector size: %d"), n);
  90
  91   /* Triple vectors have the size of a quad vector.  */
  92   length = (n == 3) ?  el_length * 4 : el_length * n;
  93
  94   for (i = 0; i < nr_opencl_primitive_types; i++)
  95     {
  96       LONGEST lowb, highb;
  97
  98       if (TYPE_CODE (types[i]) == TYPE_CODE_ARRAY && TYPE_VECTOR (types[i])
  99           && get_array_bounds (types[i], &lowb, &highb)
 100           && TYPE_CODE (TYPE_TARGET_TYPE (types[i])) == code
 101           && TYPE_UNSIGNED (TYPE_TARGET_TYPE (types[i])) == flag_unsigned
 102           && TYPE_LENGTH (TYPE_TARGET_TYPE (types[i])) == el_length
 103           && TYPE_LENGTH (types[i]) == length
 104           && highb - lowb + 1 == n)
 105         {
 106           type = types[i];
 107           break;
 108         }
 109     }
 110
 111   return type;
 112 }
 113
 114 /* Returns nonzero if the array ARR contains duplicates within
 115      the first N elements.  */
 116
 117 static int
 118 array_has_dups (int *arr, int n)
 119 {
 120   int i, j;
 121
 122   for (i = 0; i < n; i++)
 123     {
 124       for (j = i + 1; j < n; j++)
 125         {
 126           if (arr[i] == arr[j])
 127             return 1;
 128         }
 129     }
 130
 131   return 0;
 132 }
 133
 134 /* The OpenCL component access syntax allows to create lvalues referring to
 135    selected elements of an original OpenCL vector in arbitrary order.  This
 136    structure holds the information to describe such lvalues.  */
 137
 138 struct lval_closure
 139 {
 140   /* Reference count.  */
 141   int refc;
 142   /* The number of indices.  */
 143   int n;
 144   /* The element indices themselves.  */
 145   int *indices;
 146   /* A pointer to the original value.  */
 147   struct value *val;
 148 };
 149
 150 /* Allocates an instance of struct lval_closure.  */
 151
 152 static struct lval_closure *
 153 allocate_lval_closure (int *indices, int n, struct value *val)
 154 {
 155   struct lval_closure *c = XCNEW (struct lval_closure);
 156
 157   c->refc = 1;
 158   c->n = n;
 159   c->indices = XCNEWVEC (int, n);
 160   memcpy (c->indices, indices, n * sizeof (int));
 161   value_incref (val); /* Increment the reference counter of the value.  */
 162   c->val = val;
 163
 164   return c;
 165 }
 166
 167 static void
 168 lval_func_read (struct value *v)
 169 {
 170   struct lval_closure *c = (struct lval_closure *) value_computed_closure (v);
 171   struct type *type = check_typedef (value_type (v));
 172   struct type *eltype = TYPE_TARGET_TYPE (check_typedef (value_type (c->val)));
 173   LONGEST offset = value_offset (v);
 174   LONGEST elsize = TYPE_LENGTH (eltype);
 175   int n, i, j = 0;
 176   LONGEST lowb = 0;
 177   LONGEST highb = 0;
 178
 179   if (TYPE_CODE (type) == TYPE_CODE_ARRAY
 180       && !get_array_bounds (type, &lowb, &highb))
 181     error (_("Could not determine the vector bounds"));
 182
 183   /* Assume elsize aligned offset.  */
 184   gdb_assert (offset % elsize == 0);
 185   offset /= elsize;
 186   n = offset + highb - lowb + 1;
 187   gdb_assert (n <= c->n);
 188
 189   for (i = offset; i < n; i++)
 190     memcpy (value_contents_raw (v) + j++ * elsize,
 191             value_contents (c->val) + c->indices[i] * elsize,
 192             elsize);
 193 }
 194
 195 static void
 196 lval_func_write (struct value *v, struct value *fromval)
 197 {
 198   struct value *mark = value_mark ();
 199   struct lval_closure *c = (struct lval_closure *) value_computed_closure (v);
 200   struct type *type = check_typedef (value_type (v));
 201   struct type *eltype = TYPE_TARGET_TYPE (check_typedef (value_type (c->val)));
 202   LONGEST offset = value_offset (v);
 203   LONGEST elsize = TYPE_LENGTH (eltype);
 204   int n, i, j = 0;
 205   LONGEST lowb = 0;
 206   LONGEST highb = 0;
 207
 208   if (TYPE_CODE (type) == TYPE_CODE_ARRAY
 209       && !get_array_bounds (type, &lowb, &highb))
 210     error (_("Could not determine the vector bounds"));
 211
 212   /* Assume elsize aligned offset.  */
 213   gdb_assert (offset % elsize == 0);
 214   offset /= elsize;
 215   n = offset + highb - lowb + 1;
 216
 217   /* Since accesses to the fourth component of a triple vector is undefined we
 218      just skip writes to the fourth element.  Imagine something like this:
 219        int3 i3 = (int3)(0, 1, 2);
 220        i3.hi.hi = 5;
 221      In this case n would be 4 (offset=12/4 + 1) while c->n would be 3.  */
 222   if (n > c->n)
 223     n = c->n;
 224
 225   for (i = offset; i < n; i++)
 226     {
 227       struct value *from_elm_val = allocate_value (eltype);
 228       struct value *to_elm_val = value_subscript (c->val, c->indices[i]);
 229
 230       memcpy (value_contents_writeable (from_elm_val),
 231               value_contents (fromval) + j++ * elsize,
 232               elsize);
 233       value_assign (to_elm_val, from_elm_val);
 234     }
 235
 236   value_free_to_mark (mark);
 237 }
 238
 239 /* Return nonzero if bits in V from OFFSET and LENGTH represent a
 240    synthetic pointer.  */
 241
 242 static int
 243 lval_func_check_synthetic_pointer (const struct value *v,
 244                                    LONGEST offset, int length)
 245 {
 246   struct lval_closure *c = (struct lval_closure *) value_computed_closure (v);
 247   /* Size of the target type in bits.  */
 248   int elsize =
 249       TYPE_LENGTH (TYPE_TARGET_TYPE (check_typedef (value_type (c->val)))) * 8;
 250   int startrest = offset % elsize;
 251   int start = offset / elsize;
 252   int endrest = (offset + length) % elsize;
 253   int end = (offset + length) / elsize;
 254   int i;
 255
 256   if (endrest)
 257     end++;
 258
 259   if (end > c->n)
 260     return 0;
 261
 262   for (i = start; i < end; i++)
 263     {
 264       int comp_offset = (i == start) ? startrest : 0;
 265       int comp_length = (i == end) ? endrest : elsize;
 266
 267       if (!value_bits_synthetic_pointer (c->val,
 268                                          c->indices[i] * elsize + comp_offset,
 269                                          comp_length))
 270         return 0;
 271     }
 272
 273   return 1;
 274 }
 275
 276 static void *
 277 lval_func_copy_closure (const struct value *v)
 278 {
 279   struct lval_closure *c = (struct lval_closure *) value_computed_closure (v);
 280
 281   ++c->refc;
 282
 283   return c;
 284 }
 285
 286 static void
 287 lval_func_free_closure (struct value *v)
 288 {
 289   struct lval_closure *c = (struct lval_closure *) value_computed_closure (v);
 290
 291   --c->refc;
 292
 293   if (c->refc == 0)
 294     {
 295       value_decref (c->val); /* Decrement the reference counter of the value.  */
 296       xfree (c->indices);
 297       xfree (c);
 298     }
 299 }
 300
 301 static const struct lval_funcs opencl_value_funcs =
 302   {
 303     lval_func_read,
 304     lval_func_write,
 305     NULL,       /* indirect */
 306     NULL,       /* coerce_ref */
 307     lval_func_check_synthetic_pointer,
 308     lval_func_copy_closure,
 309     lval_func_free_closure
 310   };
 311
 312 /* Creates a sub-vector from VAL.  The elements are selected by the indices of
 313    an array with the length of N.  Supported values for NOSIDE are
 314    EVAL_NORMAL and EVAL_AVOID_SIDE_EFFECTS.  */
 315
 316 static struct value *
 317 create_value (struct gdbarch *gdbarch, struct value *val, enum noside noside,
 318               int *indices, int n)
 319 {
 320   struct type *type = check_typedef (value_type (val));
 321   struct type *elm_type = TYPE_TARGET_TYPE (type);
 322   struct value *ret;
 323
 324   /* Check if a single component of a vector is requested which means
 325      the resulting type is a (primitive) scalar type.  */
 326   if (n == 1)
 327     {
 328       if (noside == EVAL_AVOID_SIDE_EFFECTS)
 329         ret = value_zero (elm_type, not_lval);
 330       else
 331         ret = value_subscript (val, indices[0]);
 332     }
 333   else
 334     {
 335       /* Multiple components of the vector are requested which means the
 336          resulting type is a vector as well.  */
 337       struct type *dst_type =
 338         lookup_opencl_vector_type (gdbarch, TYPE_CODE (elm_type),
 339                                    TYPE_LENGTH (elm_type),
 340                                    TYPE_UNSIGNED (elm_type), n);
 341
 342       if (dst_type == NULL)
 343         dst_type = init_vector_type (elm_type, n);
 344
 345       make_cv_type (TYPE_CONST (type), TYPE_VOLATILE (type), dst_type, NULL);
 346
 347       if (noside == EVAL_AVOID_SIDE_EFFECTS)
 348         ret = allocate_value (dst_type);
 349       else
 350         {
 351           /* Check whether to create a lvalue or not.  */
 352           if (VALUE_LVAL (val) != not_lval && !array_has_dups (indices, n))
 353             {
 354               struct lval_closure *c = allocate_lval_closure (indices, n, val);
 355               ret = allocate_computed_value (dst_type, &opencl_value_funcs, c);
 356             }
 357           else
 358             {
 359               int i;
 360
 361               ret = allocate_value (dst_type);
 362
 363               /* Copy src val contents into the destination value.  */
 364               for (i = 0; i < n; i++)
 365                 memcpy (value_contents_writeable (ret)
 366                         + (i * TYPE_LENGTH (elm_type)),
 367                         value_contents (val)
 368                         + (indices[i] * TYPE_LENGTH (elm_type)),
 369                         TYPE_LENGTH (elm_type));
 370             }
 371         }
 372     }
 373   return ret;
 374 }
 375
 376 /* OpenCL vector component access.  */
 377
 378 static struct value *
 379 opencl_component_ref (struct expression *exp, struct value *val, char *comps,
 380                       enum noside noside)
 381 {
 382   LONGEST lowb, highb;
 383   int src_len;
 384   struct value *v;
 385   int indices[16], i;
 386   int dst_len;
 387
 388   if (!get_array_bounds (check_typedef (value_type (val)), &lowb, &highb))
 389     error (_("Could not determine the vector bounds"));
 390
 391   src_len = highb - lowb + 1;
 392
 393   /* Throw an error if the amount of array elements does not fit a
 394      valid OpenCL vector size (2, 3, 4, 8, 16).  */
 395   if (src_len != 2 && src_len != 3 && src_len != 4 && src_len != 8
 396       && src_len != 16)
 397     error (_("Invalid OpenCL vector size"));
 398
 399   if (strcmp (comps, "lo") == 0 )
 400     {
 401       dst_len = (src_len == 3) ? 2 : src_len / 2;
 402
 403       for (i = 0; i < dst_len; i++)
 404         indices[i] = i;
 405     }
 406   else if (strcmp (comps, "hi") == 0)
 407     {
 408       dst_len = (src_len == 3) ? 2 : src_len / 2;
 409
 410       for (i = 0; i < dst_len; i++)
 411         indices[i] = dst_len + i;
 412     }
 413   else if (strcmp (comps, "even") == 0)
 414     {
 415       dst_len = (src_len == 3) ? 2 : src_len / 2;
 416
 417       for (i = 0; i < dst_len; i++)
 418         indices[i] = i*2;
 419     }
 420   else if (strcmp (comps, "odd") == 0)
 421     {
 422       dst_len = (src_len == 3) ? 2 : src_len / 2;
 423
 424       for (i = 0; i < dst_len; i++)
 425         indices[i] = i*2+1;
 426     }
 427   else if (strncasecmp (comps, "s", 1) == 0)
 428     {
 429 #define HEXCHAR_TO_INT(C) ((C >= '0' && C <= '9') ? \
 430                            C-'0' : ((C >= 'A' && C <= 'F') ? \
 431                            C-'A'+10 : ((C >= 'a' && C <= 'f') ? \
 432                            C-'a'+10 : -1)))
 433
 434       dst_len = strlen (comps);
 435       /* Skip the s/S-prefix.  */
 436       dst_len--;
 437
 438       for (i = 0; i < dst_len; i++)
 439         {
 440           indices[i] = HEXCHAR_TO_INT(comps[i+1]);
 441           /* Check if the requested component is invalid or exceeds
 442              the vector.  */
 443           if (indices[i] < 0 || indices[i] >= src_len)
 444             error (_("Invalid OpenCL vector component accessor %s"), comps);
 445         }
 446     }
 447   else
 448     {
 449       dst_len = strlen (comps);
 450
 451       for (i = 0; i < dst_len; i++)
 452         {
 453           /* x, y, z, w */
 454           switch (comps[i])
 455           {
 456           case 'x':
 457             indices[i] = 0;
 458             break;
 459           case 'y':
 460             indices[i] = 1;
 461             break;
 462           case 'z':
 463             if (src_len < 3)
 464               error (_("Invalid OpenCL vector component accessor %s"), comps);
 465             indices[i] = 2;
 466             break;
 467           case 'w':
 468             if (src_len < 4)
 469               error (_("Invalid OpenCL vector component accessor %s"), comps);
 470             indices[i] = 3;
 471             break;
 472           default:
 473             error (_("Invalid OpenCL vector component accessor %s"), comps);
 474             break;
 475           }
 476         }
 477     }
 478
 479   /* Throw an error if the amount of requested components does not
 480      result in a valid length (1, 2, 3, 4, 8, 16).  */
 481   if (dst_len != 1 && dst_len != 2 && dst_len != 3 && dst_len != 4
 482       && dst_len != 8 && dst_len != 16)
 483     error (_("Invalid OpenCL vector component accessor %s"), comps);
 484
 485   v = create_value (exp->gdbarch, val, noside, indices, dst_len);
 486
 487   return v;
 488 }
 489
 490 /* Perform the unary logical not (!) operation.  */
 491
 492 static struct value *
 493 opencl_logical_not (struct expression *exp, struct value *arg)
 494 {
 495   struct type *type = check_typedef (value_type (arg));
 496   struct type *rettype;
 497   struct value *ret;
 498
 499   if (TYPE_CODE (type) == TYPE_CODE_ARRAY && TYPE_VECTOR (type))
 500     {
 501       struct type *eltype = check_typedef (TYPE_TARGET_TYPE (type));
 502       LONGEST lowb, highb;
 503       int i;
 504
 505       if (!get_array_bounds (type, &lowb, &highb))
 506         error (_("Could not determine the vector bounds"));
 507
 508       /* Determine the resulting type of the operation and allocate the
 509          value.  */
 510       rettype = lookup_opencl_vector_type (exp->gdbarch, TYPE_CODE_INT,
 511                                            TYPE_LENGTH (eltype), 0,
 512                                            highb - lowb + 1);
 513       ret = allocate_value (rettype);
 514
 515       for (i = 0; i < highb - lowb + 1; i++)
 516         {
 517           /* For vector types, the unary operator shall return a 0 if the
 518           value of its operand compares unequal to 0, and -1 (i.e. all bits
 519           set) if the value of its operand compares equal to 0.  */
 520           int tmp = value_logical_not (value_subscript (arg, i)) ? -1 : 0;
 521           memset (value_contents_writeable (ret) + i * TYPE_LENGTH (eltype),
 522                   tmp, TYPE_LENGTH (eltype));
 523         }
 524     }
 525   else
 526     {
 527       rettype = language_bool_type (exp->language_defn, exp->gdbarch);
 528       ret = value_from_longest (rettype, value_logical_not (arg));
 529     }
 530
 531   return ret;
 532 }
 533
 534 /* Perform a relational operation on two scalar operands.  */
 535
 536 static int
 537 scalar_relop (struct value *val1, struct value *val2, enum exp_opcode op)
 538 {
 539   int ret;
 540
 541   switch (op)
 542     {
 543     case BINOP_EQUAL:
 544       ret = value_equal (val1, val2);
 545       break;
 546     case BINOP_NOTEQUAL:
 547       ret = !value_equal (val1, val2);
 548       break;
 549     case BINOP_LESS:
 550       ret = value_less (val1, val2);
 551       break;
 552     case BINOP_GTR:
 553       ret = value_less (val2, val1);
 554       break;
 555     case BINOP_GEQ:
 556       ret = value_less (val2, val1) || value_equal (val1, val2);
 557       break;
 558     case BINOP_LEQ:
 559       ret = value_less (val1, val2) || value_equal (val1, val2);
 560       break;
 561     case BINOP_LOGICAL_AND:
 562       ret = !value_logical_not (val1) && !value_logical_not (val2);
 563       break;
 564     case BINOP_LOGICAL_OR:
 565       ret = !value_logical_not (val1) || !value_logical_not (val2);
 566       break;
 567     default:
 568       error (_("Attempt to perform an unsupported operation"));
 569       break;
 570     }
 571   return ret;
 572 }
 573
 574 /* Perform a relational operation on two vector operands.  */
 575
 576 static struct value *
 577 vector_relop (struct expression *exp, struct value *val1, struct value *val2,
 578               enum exp_opcode op)
 579 {
 580   struct value *ret;
 581   struct type *type1, *type2, *eltype1, *eltype2, *rettype;
 582   int t1_is_vec, t2_is_vec, i;
 583   LONGEST lowb1, lowb2, highb1, highb2;
 584
 585   type1 = check_typedef (value_type (val1));
 586   type2 = check_typedef (value_type (val2));
 587
 588   t1_is_vec = (TYPE_CODE (type1) == TYPE_CODE_ARRAY && TYPE_VECTOR (type1));
 589   t2_is_vec = (TYPE_CODE (type2) == TYPE_CODE_ARRAY && TYPE_VECTOR (type2));
 590
 591   if (!t1_is_vec || !t2_is_vec)
 592     error (_("Vector operations are not supported on scalar types"));
 593
 594   eltype1 = check_typedef (TYPE_TARGET_TYPE (type1));
 595   eltype2 = check_typedef (TYPE_TARGET_TYPE (type2));
 596
 597   if (!get_array_bounds (type1,&lowb1, &highb1)
 598       || !get_array_bounds (type2, &lowb2, &highb2))
 599     error (_("Could not determine the vector bounds"));
 600
 601   /* Check whether the vector types are compatible.  */
 602   if (TYPE_CODE (eltype1) != TYPE_CODE (eltype2)
 603       || TYPE_LENGTH (eltype1) != TYPE_LENGTH (eltype2)
 604       || TYPE_UNSIGNED (eltype1) != TYPE_UNSIGNED (eltype2)
 605       || lowb1 != lowb2 || highb1 != highb2)
 606     error (_("Cannot perform operation on vectors with different types"));
 607
 608   /* Determine the resulting type of the operation and allocate the value.  */
 609   rettype = lookup_opencl_vector_type (exp->gdbarch, TYPE_CODE_INT,
 610                                        TYPE_LENGTH (eltype1), 0,
 611                                        highb1 - lowb1 + 1);
 612   ret = allocate_value (rettype);
 613
 614   for (i = 0; i < highb1 - lowb1 + 1; i++)
 615     {
 616       /* For vector types, the relational, equality and logical operators shall
 617          return 0 if the specified relation is false and -1 (i.e. all bits set)
 618          if the specified relation is true.  */
 619       int tmp = scalar_relop (value_subscript (val1, i),
 620                               value_subscript (val2, i), op) ? -1 : 0;
 621       memset (value_contents_writeable (ret) + i * TYPE_LENGTH (eltype1),
 622               tmp, TYPE_LENGTH (eltype1));
 623      }
 624
 625   return ret;
 626 }
 627
 628 /* Perform a cast of ARG into TYPE.  There's sadly a lot of duplication in
 629    here from valops.c:value_cast, opencl is different only in the
 630    behaviour of scalar to vector casting.  As far as possibly we're going
 631    to try and delegate back to the standard value_cast function. */
 632
 633 static struct value *
 634 opencl_value_cast (struct type *type, struct value *arg)
 635 {
 636   if (type != value_type (arg))
 637     {
 638       /* Casting scalar to vector is a special case for OpenCL, scalar
 639          is cast to element type of vector then replicated into each
 640          element of the vector.  First though, we need to work out if
 641          this is a scalar to vector cast; code lifted from
 642          valops.c:value_cast.  */
 643       enum type_code code1, code2;
 644       struct type *to_type;
 645       int scalar;
 646
 647       to_type = check_typedef (type);
 648
 649       code1 = TYPE_CODE (to_type);
 650       code2 = TYPE_CODE (check_typedef (value_type (arg)));
 651
 652       if (code2 == TYPE_CODE_REF)
 653         code2 = TYPE_CODE (check_typedef (value_type (coerce_ref (arg))));
 654
 655       scalar = (code2 == TYPE_CODE_INT || code2 == TYPE_CODE_BOOL
 656                 || code2 == TYPE_CODE_CHAR || code2 == TYPE_CODE_FLT
 657                 || code2 == TYPE_CODE_DECFLOAT || code2 == TYPE_CODE_ENUM
 658                 || code2 == TYPE_CODE_RANGE);
 659
 660       if (code1 == TYPE_CODE_ARRAY && TYPE_VECTOR (to_type) && scalar)
 661         {
 662           struct type *eltype;
 663
 664           /* Cast to the element type of the vector here as
 665              value_vector_widen will error if the scalar value is
 666              truncated by the cast.  To avoid the error, cast (and
 667              possibly truncate) here.  */
 668           eltype = check_typedef (TYPE_TARGET_TYPE (to_type));
 669           arg = value_cast (eltype, arg);
 670
 671           return value_vector_widen (arg, type);
 672         }
 673       else
 674         /* Standard cast handler.  */
 675         arg = value_cast (type, arg);
 676     }
 677   return arg;
 678 }
 679
 680 /* Perform a relational operation on two operands.  */
 681
 682 static struct value *
 683 opencl_relop (struct expression *exp, struct value *arg1, struct value *arg2,
 684               enum exp_opcode op)
 685 {
 686   struct value *val;
 687   struct type *type1 = check_typedef (value_type (arg1));
 688   struct type *type2 = check_typedef (value_type (arg2));
 689   int t1_is_vec = (TYPE_CODE (type1) == TYPE_CODE_ARRAY
 690                    && TYPE_VECTOR (type1));
 691   int t2_is_vec = (TYPE_CODE (type2) == TYPE_CODE_ARRAY
 692                    && TYPE_VECTOR (type2));
 693
 694   if (!t1_is_vec && !t2_is_vec)
 695     {
 696       int tmp = scalar_relop (arg1, arg2, op);
 697       struct type *type =
 698         language_bool_type (exp->language_defn, exp->gdbarch);
 699
 700       val = value_from_longest (type, tmp);
 701     }
 702   else if (t1_is_vec && t2_is_vec)
 703     {
 704       val = vector_relop (exp, arg1, arg2, op);
 705     }
 706   else
 707     {
 708       /* Widen the scalar operand to a vector.  */
 709       struct value **v = t1_is_vec ? &arg2 : &arg1;
 710       struct type *t = t1_is_vec ? type2 : type1;
 711
 712       if (TYPE_CODE (t) != TYPE_CODE_FLT && !is_integral_type (t))
 713         error (_("Argument to operation not a number or boolean."));
 714
 715       *v = opencl_value_cast (t1_is_vec ? type1 : type2, *v);
 716       val = vector_relop (exp, arg1, arg2, op);
 717     }
 718
 719   return val;
 720 }
 721
 722 /* Expression evaluator for the OpenCL.  Most operations are delegated to
 723    evaluate_subexp_standard; see that function for a description of the
 724    arguments.  */
 725
 726 static struct value *
 727 evaluate_subexp_opencl (struct type *expect_type, struct expression *exp,
 728                    int *pos, enum noside noside)
 729 {
 730   enum exp_opcode op = exp->elts[*pos].opcode;
 731   struct value *arg1 = NULL;
 732   struct value *arg2 = NULL;
 733   struct type *type1, *type2;
 734
 735   switch (op)
 736     {
 737     /* Handle assignment and cast operators to support OpenCL-style
 738        scalar-to-vector widening.  */
 739     case BINOP_ASSIGN:
 740       (*pos)++;
 741       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 742       type1 = value_type (arg1);
 743       arg2 = evaluate_subexp (type1, exp, pos, noside);
 744
 745       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
 746         return arg1;
 747
 748       if (deprecated_value_modifiable (arg1)
 749           && VALUE_LVAL (arg1) != lval_internalvar)
 750         arg2 = opencl_value_cast (type1, arg2);
 751
 752       return value_assign (arg1, arg2);
 753
 754     case UNOP_CAST:
 755       type1 = exp->elts[*pos + 1].type;
 756       (*pos) += 2;
 757       arg1 = evaluate_subexp (type1, exp, pos, noside);
 758
 759       if (noside == EVAL_SKIP)
 760         return value_from_longest (builtin_type (exp->gdbarch)->
 761                                    builtin_int, 1);
 762
 763       return opencl_value_cast (type1, arg1);
 764
 765     case UNOP_CAST_TYPE:
 766       (*pos)++;
 767       arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
 768       type1 = value_type (arg1);
 769       arg1 = evaluate_subexp (type1, exp, pos, noside);
 770
 771       if (noside == EVAL_SKIP)
 772         return value_from_longest (builtin_type (exp->gdbarch)->
 773                                    builtin_int, 1);
 774
 775       return opencl_value_cast (type1, arg1);
 776
 777     /* Handle binary relational and equality operators that are either not
 778        or differently defined for GNU vectors.  */
 779     case BINOP_EQUAL:
 780     case BINOP_NOTEQUAL:
 781     case BINOP_LESS:
 782     case BINOP_GTR:
 783     case BINOP_GEQ:
 784     case BINOP_LEQ:
 785       (*pos)++;
 786       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 787       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
 788
 789       if (noside == EVAL_SKIP)
 790         return value_from_longest (builtin_type (exp->gdbarch)->
 791                                    builtin_int, 1);
 792
 793       return opencl_relop (exp, arg1, arg2, op);
 794
 795     /* Handle the logical unary operator not(!).  */
 796     case UNOP_LOGICAL_NOT:
 797       (*pos)++;
 798       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 799
 800       if (noside == EVAL_SKIP)
 801         return value_from_longest (builtin_type (exp->gdbarch)->
 802                                    builtin_int, 1);
 803
 804       return opencl_logical_not (exp, arg1);
 805
 806     /* Handle the logical operator and(&&) and or(||).  */
 807     case BINOP_LOGICAL_AND:
 808     case BINOP_LOGICAL_OR:
 809       (*pos)++;
 810       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 811
 812       if (noside == EVAL_SKIP)
 813         {
 814           evaluate_subexp (NULL_TYPE, exp, pos, noside);
 815
 816           return value_from_longest (builtin_type (exp->gdbarch)->
 817                                      builtin_int, 1);
 818         }
 819       else
 820         {
 821           /* For scalar operations we need to avoid evaluating operands
 822              unecessarily.  However, for vector operations we always need to
 823              evaluate both operands.  Unfortunately we only know which of the
 824              two cases apply after we know the type of the second operand.
 825              Therefore we evaluate it once using EVAL_AVOID_SIDE_EFFECTS.  */
 826           int oldpos = *pos;
 827
 828           arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
 829                                   EVAL_AVOID_SIDE_EFFECTS);
 830           *pos = oldpos;
 831           type1 = check_typedef (value_type (arg1));
 832           type2 = check_typedef (value_type (arg2));
 833
 834           if ((TYPE_CODE (type1) == TYPE_CODE_ARRAY && TYPE_VECTOR (type1))
 835               || (TYPE_CODE (type2) == TYPE_CODE_ARRAY && TYPE_VECTOR (type2)))
 836             {
 837               arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 838
 839               return opencl_relop (exp, arg1, arg2, op);
 840             }
 841           else
 842             {
 843               /* For scalar built-in types, only evaluate the right
 844                  hand operand if the left hand operand compares
 845                  unequal(&&)/equal(||) to 0.  */
 846               int res;
 847               int tmp = value_logical_not (arg1);
 848
 849               if (op == BINOP_LOGICAL_OR)
 850                 tmp = !tmp;
 851
 852               arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
 853                                       tmp ? EVAL_SKIP : noside);
 854               type1 = language_bool_type (exp->language_defn, exp->gdbarch);
 855
 856               if (op == BINOP_LOGICAL_AND)
 857                 res = !tmp && !value_logical_not (arg2);
 858               else /* BINOP_LOGICAL_OR */
 859                 res = tmp || !value_logical_not (arg2);
 860
 861               return value_from_longest (type1, res);
 862             }
 863         }
 864
 865     /* Handle the ternary selection operator.  */
 866     case TERNOP_COND:
 867       (*pos)++;
 868       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 869       type1 = check_typedef (value_type (arg1));
 870       if (TYPE_CODE (type1) == TYPE_CODE_ARRAY && TYPE_VECTOR (type1))
 871         {
 872           struct value *arg3, *tmp, *ret;
 873           struct type *eltype2, *type3, *eltype3;
 874           int t2_is_vec, t3_is_vec, i;
 875           LONGEST lowb1, lowb2, lowb3, highb1, highb2, highb3;
 876
 877           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 878           arg3 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 879           type2 = check_typedef (value_type (arg2));
 880           type3 = check_typedef (value_type (arg3));
 881           t2_is_vec
 882             = TYPE_CODE (type2) == TYPE_CODE_ARRAY && TYPE_VECTOR (type2);
 883           t3_is_vec
 884             = TYPE_CODE (type3) == TYPE_CODE_ARRAY && TYPE_VECTOR (type3);
 885
 886           /* Widen the scalar operand to a vector if necessary.  */
 887           if (t2_is_vec || !t3_is_vec)
 888             {
 889               arg3 = opencl_value_cast (type2, arg3);
 890               type3 = value_type (arg3);
 891             }
 892           else if (!t2_is_vec || t3_is_vec)
 893             {
 894               arg2 = opencl_value_cast (type3, arg2);
 895               type2 = value_type (arg2);
 896             }
 897           else if (!t2_is_vec || !t3_is_vec)
 898             {
 899               /* Throw an error if arg2 or arg3 aren't vectors.  */
 900               error (_("\
 901 Cannot perform conditional operation on incompatible types"));
 902             }
 903
 904           eltype2 = check_typedef (TYPE_TARGET_TYPE (type2));
 905           eltype3 = check_typedef (TYPE_TARGET_TYPE (type3));
 906
 907           if (!get_array_bounds (type1, &lowb1, &highb1)
 908               || !get_array_bounds (type2, &lowb2, &highb2)
 909               || !get_array_bounds (type3, &lowb3, &highb3))
 910             error (_("Could not determine the vector bounds"));
 911
 912           /* Throw an error if the types of arg2 or arg3 are incompatible.  */
 913           if (TYPE_CODE (eltype2) != TYPE_CODE (eltype3)
 914               || TYPE_LENGTH (eltype2) != TYPE_LENGTH (eltype3)
 915               || TYPE_UNSIGNED (eltype2) != TYPE_UNSIGNED (eltype3)
 916               || lowb2 != lowb3 || highb2 != highb3)
 917             error (_("\
 918 Cannot perform operation on vectors with different types"));
 919
 920           /* Throw an error if the sizes of arg1 and arg2/arg3 differ.  */
 921           if (lowb1 != lowb2 || lowb1 != lowb3
 922               || highb1 != highb2 || highb1 != highb3)
 923             error (_("\
 924 Cannot perform conditional operation on vectors with different sizes"));
 925
 926           ret = allocate_value (type2);
 927
 928           for (i = 0; i < highb1 - lowb1 + 1; i++)
 929             {
 930               tmp = value_logical_not (value_subscript (arg1, i)) ?
 931                     value_subscript (arg3, i) : value_subscript (arg2, i);
 932               memcpy (value_contents_writeable (ret) +
 933                       i * TYPE_LENGTH (eltype2), value_contents_all (tmp),
 934                       TYPE_LENGTH (eltype2));
 935             }
 936
 937           return ret;
 938         }
 939       else
 940         {
 941           if (value_logical_not (arg1))
 942             {
 943               /* Skip the second operand.  */
 944               evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
 945
 946               return evaluate_subexp (NULL_TYPE, exp, pos, noside);
 947             }
 948           else
 949             {
 950               /* Skip the third operand.  */
 951               arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 952               evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
 953
 954               return arg2;
 955             }
 956         }
 957
 958     /* Handle STRUCTOP_STRUCT to allow component access on OpenCL vectors.  */
 959     case STRUCTOP_STRUCT:
 960       {
 961         int pc = (*pos)++;
 962         int tem = longest_to_int (exp->elts[pc + 1].longconst);
 963
 964         (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
 965         arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 966         type1 = check_typedef (value_type (arg1));
 967
 968         if (noside == EVAL_SKIP)
 969           {
 970             return value_from_longest (builtin_type (exp->gdbarch)->
 971                                        builtin_int, 1);
 972           }
 973         else if (TYPE_CODE (type1) == TYPE_CODE_ARRAY && TYPE_VECTOR (type1))
 974           {
 975             return opencl_component_ref (exp, arg1, &exp->elts[pc + 2].string,
 976                                          noside);
 977           }
 978         else
 979           {
 980             struct value *v = value_struct_elt (&arg1, NULL,
 981                                                 &exp->elts[pc + 2].string, NULL,
 982                                                 "structure");
 983
 984             if (noside == EVAL_AVOID_SIDE_EFFECTS)
 985               v = value_zero (value_type (v), VALUE_LVAL (v));
 986             return v;
 987           }
 988       }
 989     default:
 990       break;
 991     }
 992
 993   return evaluate_subexp_c (expect_type, exp, pos, noside);
 994 }
 995
 996 /* Print OpenCL types.  */
 997
 998 static void
 999 opencl_print_type (struct type *type, const char *varstring,
1000                    struct ui_file *stream, int show, int level,
1001                    const struct type_print_options *flags)
1002 {
1003   /* We nearly always defer to C type printing, except that vector
1004      types are considered primitive in OpenCL, and should always
1005      be printed using their TYPE_NAME.  */
1006   if (show > 0)
1007     {
1008       type = check_typedef (type);
1009       if (TYPE_CODE (type) == TYPE_CODE_ARRAY && TYPE_VECTOR (type)
1010           && TYPE_NAME (type) != NULL)
1011         show = 0;
1012     }
1013
1014   c_print_type (type, varstring, stream, show, level, flags);
1015 }
1016
1017 static void
1018 opencl_language_arch_info (struct gdbarch *gdbarch,
1019                            struct language_arch_info *lai)
1020 {
1021   struct type **types = builtin_opencl_type (gdbarch);
1022
1023   /* Copy primitive types vector from gdbarch.  */
1024   lai->primitive_type_vector = types;
1025
1026   /* Type of elements of strings.  */
1027   lai->string_char_type = types [opencl_primitive_type_char];
1028
1029   /* Specifies the return type of logical and relational operations.  */
1030   lai->bool_type_symbol = "int";
1031   lai->bool_type_default = types [opencl_primitive_type_int];
1032 }
1033
1034 const struct exp_descriptor exp_descriptor_opencl =
1035 {
1036   print_subexp_standard,
1037   operator_length_standard,
1038   operator_check_standard,
1039   op_name_standard,
1040   dump_subexp_body_standard,
1041   evaluate_subexp_opencl
1042 };
1043
1044 extern const struct language_defn opencl_language_defn =
1045 {
1046   "opencl",                     /* Language name */
1047   "OpenCL C",
1048   language_opencl,
1049   range_check_off,
1050   case_sensitive_on,
1051   array_row_major,
1052   macro_expansion_c,
1053   NULL,
1054   &exp_descriptor_opencl,
1055   c_parse,
1056   null_post_parser,
1057   c_printchar,                  /* Print a character constant */
1058   c_printstr,                   /* Function to print string constant */
1059   c_emit_char,                  /* Print a single char */
1060   opencl_print_type,            /* Print a type using appropriate syntax */
1061   c_print_typedef,              /* Print a typedef using appropriate syntax */
1062   c_val_print,                  /* Print a value using appropriate syntax */
1063   c_value_print,                /* Print a top-level value */
1064   default_read_var_value,       /* la_read_var_value */
1065   NULL,                         /* Language specific skip_trampoline */
1066   NULL,                         /* name_of_this */
1067   false,                        /* la_store_sym_names_in_linkage_form_p */
1068   basic_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */
1069   basic_lookup_transparent_type,/* lookup_transparent_type */
1070   NULL,                         /* Language specific symbol demangler */
1071   NULL,
1072   NULL,                         /* Language specific
1073                                    class_name_from_physname */
1074   c_op_print_tab,               /* expression operators for printing */
1075   1,                            /* c-style arrays */
1076   0,                            /* String lower bound */
1077   default_word_break_characters,
1078   default_collect_symbol_completion_matches,
1079   opencl_language_arch_info,
1080   default_print_array_index,
1081   default_pass_by_reference,
1082   c_get_string,
1083   c_watch_location_expression,
1084   NULL,                         /* la_get_symbol_name_matcher */
1085   iterate_over_symbols,
1086   default_search_name_hash,
1087   &default_varobj_ops,
1088   NULL,
1089   NULL,
1090   LANG_MAGIC
1091 };
1092
1093 static void *
1094 build_opencl_types (struct gdbarch *gdbarch)
1095 {
1096   struct type **types
1097     = GDBARCH_OBSTACK_CALLOC (gdbarch, nr_opencl_primitive_types + 1,
1098                               struct type *);
1099
1100 /* Helper macro to create strings.  */
1101 #define OCL_STRING(S) #S
1102 /* This macro allocates and assigns the type struct pointers
1103    for the vector types.  */
1104 #define BUILD_OCL_VTYPES(TYPE)\
1105   types[opencl_primitive_type_##TYPE##2] \
1106     = init_vector_type (types[opencl_primitive_type_##TYPE], 2); \
1107   TYPE_NAME (types[opencl_primitive_type_##TYPE##2]) = OCL_STRING(TYPE ## 2); \
1108   types[opencl_primitive_type_##TYPE##3] \
1109     = init_vector_type (types[opencl_primitive_type_##TYPE], 3); \
1110   TYPE_NAME (types[opencl_primitive_type_##TYPE##3]) = OCL_STRING(TYPE ## 3); \
1111   TYPE_LENGTH (types[opencl_primitive_type_##TYPE##3]) \
1112     = 4 * TYPE_LENGTH (types[opencl_primitive_type_##TYPE]); \
1113   types[opencl_primitive_type_##TYPE##4] \
1114     = init_vector_type (types[opencl_primitive_type_##TYPE], 4); \
1115   TYPE_NAME (types[opencl_primitive_type_##TYPE##4]) = OCL_STRING(TYPE ## 4); \
1116   types[opencl_primitive_type_##TYPE##8] \
1117     = init_vector_type (types[opencl_primitive_type_##TYPE], 8); \
1118   TYPE_NAME (types[opencl_primitive_type_##TYPE##8]) = OCL_STRING(TYPE ## 8); \
1119   types[opencl_primitive_type_##TYPE##16] \
1120     = init_vector_type (types[opencl_primitive_type_##TYPE], 16); \
1121   TYPE_NAME (types[opencl_primitive_type_##TYPE##16]) = OCL_STRING(TYPE ## 16)
1122
1123   types[opencl_primitive_type_char]
1124     = arch_integer_type (gdbarch, 8, 0, "char");
1125   BUILD_OCL_VTYPES (char);
1126   types[opencl_primitive_type_uchar]
1127     = arch_integer_type (gdbarch, 8, 1, "uchar");
1128   BUILD_OCL_VTYPES (uchar);
1129   types[opencl_primitive_type_short]
1130     = arch_integer_type (gdbarch, 16, 0, "short");
1131   BUILD_OCL_VTYPES (short);
1132   types[opencl_primitive_type_ushort]
1133     = arch_integer_type (gdbarch, 16, 1, "ushort");
1134   BUILD_OCL_VTYPES (ushort);
1135   types[opencl_primitive_type_int]
1136     = arch_integer_type (gdbarch, 32, 0, "int");
1137   BUILD_OCL_VTYPES (int);
1138   types[opencl_primitive_type_uint]
1139     = arch_integer_type (gdbarch, 32, 1, "uint");
1140   BUILD_OCL_VTYPES (uint);
1141   types[opencl_primitive_type_long]
1142     = arch_integer_type (gdbarch, 64, 0, "long");
1143   BUILD_OCL_VTYPES (long);
1144   types[opencl_primitive_type_ulong]
1145     = arch_integer_type (gdbarch, 64, 1, "ulong");
1146   BUILD_OCL_VTYPES (ulong);
1147   types[opencl_primitive_type_half]
1148     = arch_float_type (gdbarch, 16, "half", floatformats_ieee_half);
1149   BUILD_OCL_VTYPES (half);
1150   types[opencl_primitive_type_float]
1151     = arch_float_type (gdbarch, 32, "float", floatformats_ieee_single);
1152   BUILD_OCL_VTYPES (float);
1153   types[opencl_primitive_type_double]
1154     = arch_float_type (gdbarch, 64, "double", floatformats_ieee_double);
1155   BUILD_OCL_VTYPES (double);
1156   types[opencl_primitive_type_bool]
1157     = arch_boolean_type (gdbarch, 8, 1, "bool");
1158   types[opencl_primitive_type_unsigned_char]
1159     = arch_integer_type (gdbarch, 8, 1, "unsigned char");
1160   types[opencl_primitive_type_unsigned_short]
1161     = arch_integer_type (gdbarch, 16, 1, "unsigned short");
1162   types[opencl_primitive_type_unsigned_int]
1163     = arch_integer_type (gdbarch, 32, 1, "unsigned int");
1164   types[opencl_primitive_type_unsigned_long]
1165     = arch_integer_type (gdbarch, 64, 1, "unsigned long");
1166   types[opencl_primitive_type_size_t]
1167     = arch_integer_type (gdbarch, gdbarch_ptr_bit (gdbarch), 1, "size_t");
1168   types[opencl_primitive_type_ptrdiff_t]
1169     = arch_integer_type (gdbarch, gdbarch_ptr_bit (gdbarch), 0, "ptrdiff_t");
1170   types[opencl_primitive_type_intptr_t]
1171     = arch_integer_type (gdbarch, gdbarch_ptr_bit (gdbarch), 0, "intptr_t");
1172   types[opencl_primitive_type_uintptr_t]
1173     = arch_integer_type (gdbarch, gdbarch_ptr_bit (gdbarch), 1, "uintptr_t");
1174   types[opencl_primitive_type_void]
1175     = arch_type (gdbarch, TYPE_CODE_VOID, TARGET_CHAR_BIT, "void");
1176
1177   return types;
1178 }
1179
1180 void
1181 _initialize_opencl_language (void)
1182 {
1183   opencl_type_data = gdbarch_data_register_post_init (build_opencl_types);
1184 }