Automatic date update in version.in
[external/binutils.git] / 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 }