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