gdb/opencl-lang.c

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