Include string.h in common-defs.h
[external/binutils.git] / 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 all bits in V within OFFSET and LENGTH are valid.  */
242
243 static int
244 lval_func_check_validity (const struct value *v, int 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_valid (c->val, c->indices[i] * elsize + comp_offset,
268                              comp_length))
269         return 0;
270     }
271
272   return 1;
273 }
274
275 /* Return nonzero if any bit in V is valid.  */
276
277 static int
278 lval_func_check_any_valid (const struct value *v)
279 {
280   struct lval_closure *c = (struct lval_closure *) value_computed_closure (v);
281   /* Size of the target type in bits.  */
282   int elsize =
283       TYPE_LENGTH (TYPE_TARGET_TYPE (check_typedef (value_type (c->val)))) * 8;
284   int i;
285
286   for (i = 0; i < c->n; i++)
287     if (value_bits_valid (c->val, c->indices[i] * elsize, elsize))
288       return 1;
289
290   return 0;
291 }
292
293 /* Return nonzero if bits in V from OFFSET and LENGTH represent a
294    synthetic pointer.  */
295
296 static int
297 lval_func_check_synthetic_pointer (const struct value *v,
298                                    int offset, int length)
299 {
300   struct lval_closure *c = (struct lval_closure *) value_computed_closure (v);
301   /* Size of the target type in bits.  */
302   int elsize =
303       TYPE_LENGTH (TYPE_TARGET_TYPE (check_typedef (value_type (c->val)))) * 8;
304   int startrest = offset % elsize;
305   int start = offset / elsize;
306   int endrest = (offset + length) % elsize;
307   int end = (offset + length) / elsize;
308   int i;
309
310   if (endrest)
311     end++;
312
313   if (end > c->n)
314     return 0;
315
316   for (i = start; i < end; i++)
317     {
318       int comp_offset = (i == start) ? startrest : 0;
319       int comp_length = (i == end) ? endrest : elsize;
320
321       if (!value_bits_synthetic_pointer (c->val,
322                                          c->indices[i] * elsize + comp_offset,
323                                          comp_length))
324         return 0;
325     }
326
327   return 1;
328 }
329
330 static void *
331 lval_func_copy_closure (const struct value *v)
332 {
333   struct lval_closure *c = (struct lval_closure *) value_computed_closure (v);
334
335   ++c->refc;
336
337   return c;
338 }
339
340 static void
341 lval_func_free_closure (struct value *v)
342 {
343   struct lval_closure *c = (struct lval_closure *) value_computed_closure (v);
344
345   --c->refc;
346
347   if (c->refc == 0)
348     {
349       value_free (c->val); /* Decrement the reference counter of the value.  */
350       xfree (c->indices);
351       xfree (c);
352     }
353 }
354
355 static const struct lval_funcs opencl_value_funcs =
356   {
357     lval_func_read,
358     lval_func_write,
359     lval_func_check_validity,
360     lval_func_check_any_valid,
361     NULL,       /* indirect */
362     NULL,       /* coerce_ref */
363     lval_func_check_synthetic_pointer,
364     lval_func_copy_closure,
365     lval_func_free_closure
366   };
367
368 /* Creates a sub-vector from VAL.  The elements are selected by the indices of
369    an array with the length of N.  Supported values for NOSIDE are
370    EVAL_NORMAL and EVAL_AVOID_SIDE_EFFECTS.  */
371
372 static struct value *
373 create_value (struct gdbarch *gdbarch, struct value *val, enum noside noside,
374               int *indices, int n)
375 {
376   struct type *type = check_typedef (value_type (val));
377   struct type *elm_type = TYPE_TARGET_TYPE (type);
378   struct value *ret;
379
380   /* Check if a single component of a vector is requested which means
381      the resulting type is a (primitive) scalar type.  */
382   if (n == 1)
383     {
384       if (noside == EVAL_AVOID_SIDE_EFFECTS)
385         ret = value_zero (elm_type, not_lval);
386       else
387         ret = value_subscript (val, indices[0]);
388     }
389   else
390     {
391       /* Multiple components of the vector are requested which means the
392          resulting type is a vector as well.  */
393       struct type *dst_type =
394         lookup_opencl_vector_type (gdbarch, TYPE_CODE (elm_type),
395                                    TYPE_LENGTH (elm_type),
396                                    TYPE_UNSIGNED (elm_type), n);
397
398       if (dst_type == NULL)
399         dst_type = init_vector_type (elm_type, n);
400
401       make_cv_type (TYPE_CONST (type), TYPE_VOLATILE (type), dst_type, NULL);
402
403       if (noside == EVAL_AVOID_SIDE_EFFECTS)
404         ret = allocate_value (dst_type);
405       else
406         {
407           /* Check whether to create a lvalue or not.  */
408           if (VALUE_LVAL (val) != not_lval && !array_has_dups (indices, n))
409             {
410               struct lval_closure *c = allocate_lval_closure (indices, n, val);
411               ret = allocate_computed_value (dst_type, &opencl_value_funcs, c);
412             }
413           else
414             {
415               int i;
416
417               ret = allocate_value (dst_type);
418
419               /* Copy src val contents into the destination value.  */
420               for (i = 0; i < n; i++)
421                 memcpy (value_contents_writeable (ret)
422                         + (i * TYPE_LENGTH (elm_type)),
423                         value_contents (val)
424                         + (indices[i] * TYPE_LENGTH (elm_type)),
425                         TYPE_LENGTH (elm_type));
426             }
427         }
428     }
429   return ret;
430 }
431
432 /* OpenCL vector component access.  */
433
434 static struct value *
435 opencl_component_ref (struct expression *exp, struct value *val, char *comps,
436                       enum noside noside)
437 {
438   LONGEST lowb, highb;
439   int src_len;
440   struct value *v;
441   int indices[16], i;
442   int dst_len;
443
444   if (!get_array_bounds (check_typedef (value_type (val)), &lowb, &highb))
445     error (_("Could not determine the vector bounds"));
446
447   src_len = highb - lowb + 1;
448
449   /* Throw an error if the amount of array elements does not fit a
450      valid OpenCL vector size (2, 3, 4, 8, 16).  */
451   if (src_len != 2 && src_len != 3 && src_len != 4 && src_len != 8
452       && src_len != 16)
453     error (_("Invalid OpenCL vector size"));
454
455   if (strcmp (comps, "lo") == 0 )
456     {
457       dst_len = (src_len == 3) ? 2 : src_len / 2;
458
459       for (i = 0; i < dst_len; i++)
460         indices[i] = i;
461     }
462   else if (strcmp (comps, "hi") == 0)
463     {
464       dst_len = (src_len == 3) ? 2 : src_len / 2;
465
466       for (i = 0; i < dst_len; i++)
467         indices[i] = dst_len + i;
468     }
469   else if (strcmp (comps, "even") == 0)
470     {
471       dst_len = (src_len == 3) ? 2 : src_len / 2;
472
473       for (i = 0; i < dst_len; i++)
474         indices[i] = i*2;
475     }
476   else if (strcmp (comps, "odd") == 0)
477     {
478       dst_len = (src_len == 3) ? 2 : src_len / 2;
479
480       for (i = 0; i < dst_len; i++)
481         indices[i] = i*2+1;
482     }
483   else if (strncasecmp (comps, "s", 1) == 0)
484     {
485 #define HEXCHAR_TO_INT(C) ((C >= '0' && C <= '9') ? \
486                            C-'0' : ((C >= 'A' && C <= 'F') ? \
487                            C-'A'+10 : ((C >= 'a' && C <= 'f') ? \
488                            C-'a'+10 : -1)))
489
490       dst_len = strlen (comps);
491       /* Skip the s/S-prefix.  */
492       dst_len--;
493
494       for (i = 0; i < dst_len; i++)
495         {
496           indices[i] = HEXCHAR_TO_INT(comps[i+1]);
497           /* Check if the requested component is invalid or exceeds
498              the vector.  */
499           if (indices[i] < 0 || indices[i] >= src_len)
500             error (_("Invalid OpenCL vector component accessor %s"), comps);
501         }
502     }
503   else
504     {
505       dst_len = strlen (comps);
506
507       for (i = 0; i < dst_len; i++)
508         {
509           /* x, y, z, w */
510           switch (comps[i])
511           {
512           case 'x':
513             indices[i] = 0;
514             break;
515           case 'y':
516             indices[i] = 1;
517             break;
518           case 'z':
519             if (src_len < 3)
520               error (_("Invalid OpenCL vector component accessor %s"), comps);
521             indices[i] = 2;
522             break;
523           case 'w':
524             if (src_len < 4)
525               error (_("Invalid OpenCL vector component accessor %s"), comps);
526             indices[i] = 3;
527             break;
528           default:
529             error (_("Invalid OpenCL vector component accessor %s"), comps);
530             break;
531           }
532         }
533     }
534
535   /* Throw an error if the amount of requested components does not
536      result in a valid length (1, 2, 3, 4, 8, 16).  */
537   if (dst_len != 1 && dst_len != 2 && dst_len != 3 && dst_len != 4
538       && dst_len != 8 && dst_len != 16)
539     error (_("Invalid OpenCL vector component accessor %s"), comps);
540
541   v = create_value (exp->gdbarch, val, noside, indices, dst_len);
542
543   return v;
544 }
545
546 /* Perform the unary logical not (!) operation.  */
547
548 static struct value *
549 opencl_logical_not (struct expression *exp, struct value *arg)
550 {
551   struct type *type = check_typedef (value_type (arg));
552   struct type *rettype;
553   struct value *ret;
554
555   if (TYPE_CODE (type) == TYPE_CODE_ARRAY && TYPE_VECTOR (type))
556     {
557       struct type *eltype = check_typedef (TYPE_TARGET_TYPE (type));
558       LONGEST lowb, highb;
559       int i;
560
561       if (!get_array_bounds (type, &lowb, &highb))
562         error (_("Could not determine the vector bounds"));
563
564       /* Determine the resulting type of the operation and allocate the
565          value.  */
566       rettype = lookup_opencl_vector_type (exp->gdbarch, TYPE_CODE_INT,
567                                            TYPE_LENGTH (eltype), 0,
568                                            highb - lowb + 1);
569       ret = allocate_value (rettype);
570
571       for (i = 0; i < highb - lowb + 1; i++)
572         {
573           /* For vector types, the unary operator shall return a 0 if the
574           value of its operand compares unequal to 0, and -1 (i.e. all bits
575           set) if the value of its operand compares equal to 0.  */
576           int tmp = value_logical_not (value_subscript (arg, i)) ? -1 : 0;
577           memset (value_contents_writeable (ret) + i * TYPE_LENGTH (eltype),
578                   tmp, TYPE_LENGTH (eltype));
579         }
580     }
581   else
582     {
583       rettype = language_bool_type (exp->language_defn, exp->gdbarch);
584       ret = value_from_longest (rettype, value_logical_not (arg));
585     }
586
587   return ret;
588 }
589
590 /* Perform a relational operation on two scalar operands.  */
591
592 static int
593 scalar_relop (struct value *val1, struct value *val2, enum exp_opcode op)
594 {
595   int ret;
596
597   switch (op)
598     {
599     case BINOP_EQUAL:
600       ret = value_equal (val1, val2);
601       break;
602     case BINOP_NOTEQUAL:
603       ret = !value_equal (val1, val2);
604       break;
605     case BINOP_LESS:
606       ret = value_less (val1, val2);
607       break;
608     case BINOP_GTR:
609       ret = value_less (val2, val1);
610       break;
611     case BINOP_GEQ:
612       ret = value_less (val2, val1) || value_equal (val1, val2);
613       break;
614     case BINOP_LEQ:
615       ret = value_less (val1, val2) || value_equal (val1, val2);
616       break;
617     case BINOP_LOGICAL_AND:
618       ret = !value_logical_not (val1) && !value_logical_not (val2);
619       break;
620     case BINOP_LOGICAL_OR:
621       ret = !value_logical_not (val1) || !value_logical_not (val2);
622       break;
623     default:
624       error (_("Attempt to perform an unsupported operation"));
625       break;
626     }
627   return ret;
628 }
629
630 /* Perform a relational operation on two vector operands.  */
631
632 static struct value *
633 vector_relop (struct expression *exp, struct value *val1, struct value *val2,
634               enum exp_opcode op)
635 {
636   struct value *ret;
637   struct type *type1, *type2, *eltype1, *eltype2, *rettype;
638   int t1_is_vec, t2_is_vec, i;
639   LONGEST lowb1, lowb2, highb1, highb2;
640
641   type1 = check_typedef (value_type (val1));
642   type2 = check_typedef (value_type (val2));
643
644   t1_is_vec = (TYPE_CODE (type1) == TYPE_CODE_ARRAY && TYPE_VECTOR (type1));
645   t2_is_vec = (TYPE_CODE (type2) == TYPE_CODE_ARRAY && TYPE_VECTOR (type2));
646
647   if (!t1_is_vec || !t2_is_vec)
648     error (_("Vector operations are not supported on scalar types"));
649
650   eltype1 = check_typedef (TYPE_TARGET_TYPE (type1));
651   eltype2 = check_typedef (TYPE_TARGET_TYPE (type2));
652
653   if (!get_array_bounds (type1,&lowb1, &highb1)
654       || !get_array_bounds (type2, &lowb2, &highb2))
655     error (_("Could not determine the vector bounds"));
656
657   /* Check whether the vector types are compatible.  */
658   if (TYPE_CODE (eltype1) != TYPE_CODE (eltype2)
659       || TYPE_LENGTH (eltype1) != TYPE_LENGTH (eltype2)
660       || TYPE_UNSIGNED (eltype1) != TYPE_UNSIGNED (eltype2)
661       || lowb1 != lowb2 || highb1 != highb2)
662     error (_("Cannot perform operation on vectors with different types"));
663
664   /* Determine the resulting type of the operation and allocate the value.  */
665   rettype = lookup_opencl_vector_type (exp->gdbarch, TYPE_CODE_INT,
666                                        TYPE_LENGTH (eltype1), 0,
667                                        highb1 - lowb1 + 1);
668   ret = allocate_value (rettype);
669
670   for (i = 0; i < highb1 - lowb1 + 1; i++)
671     {
672       /* For vector types, the relational, equality and logical operators shall
673          return 0 if the specified relation is false and -1 (i.e. all bits set)
674          if the specified relation is true.  */
675       int tmp = scalar_relop (value_subscript (val1, i),
676                               value_subscript (val2, i), op) ? -1 : 0;
677       memset (value_contents_writeable (ret) + i * TYPE_LENGTH (eltype1),
678               tmp, TYPE_LENGTH (eltype1));
679      }
680
681   return ret;
682 }
683
684 /* Perform a cast of ARG into TYPE.  There's sadly a lot of duplication in
685    here from valops.c:value_cast, opencl is different only in the
686    behaviour of scalar to vector casting.  As far as possibly we're going
687    to try and delegate back to the standard value_cast function. */
688
689 static struct value *
690 opencl_value_cast (struct type *type, struct value *arg)
691 {
692   if (type != value_type (arg))
693     {
694       /* Casting scalar to vector is a special case for OpenCL, scalar
695          is cast to element type of vector then replicated into each
696          element of the vector.  First though, we need to work out if
697          this is a scalar to vector cast; code lifted from
698          valops.c:value_cast.  */
699       enum type_code code1, code2;
700       struct type *to_type;
701       int scalar;
702
703       to_type = check_typedef (type);
704
705       code1 = TYPE_CODE (to_type);
706       code2 = TYPE_CODE (check_typedef (value_type (arg)));
707
708       if (code2 == TYPE_CODE_REF)
709         code2 = TYPE_CODE (check_typedef (value_type (coerce_ref (arg))));
710
711       scalar = (code2 == TYPE_CODE_INT || code2 == TYPE_CODE_BOOL
712                 || code2 == TYPE_CODE_CHAR || code2 == TYPE_CODE_FLT
713                 || code2 == TYPE_CODE_DECFLOAT || code2 == TYPE_CODE_ENUM
714                 || code2 == TYPE_CODE_RANGE);
715
716       if (code1 == TYPE_CODE_ARRAY && TYPE_VECTOR (to_type) && scalar)
717         {
718           struct type *eltype;
719
720           /* Cast to the element type of the vector here as
721              value_vector_widen will error if the scalar value is
722              truncated by the cast.  To avoid the error, cast (and
723              possibly truncate) here.  */
724           eltype = check_typedef (TYPE_TARGET_TYPE (to_type));
725           arg = value_cast (eltype, arg);
726
727           return value_vector_widen (arg, type);
728         }
729       else
730         /* Standard cast handler.  */
731         arg = value_cast (type, arg);
732     }
733   return arg;
734 }
735
736 /* Perform a relational operation on two operands.  */
737
738 static struct value *
739 opencl_relop (struct expression *exp, struct value *arg1, struct value *arg2,
740               enum exp_opcode op)
741 {
742   struct value *val;
743   struct type *type1 = check_typedef (value_type (arg1));
744   struct type *type2 = check_typedef (value_type (arg2));
745   int t1_is_vec = (TYPE_CODE (type1) == TYPE_CODE_ARRAY
746                    && TYPE_VECTOR (type1));
747   int t2_is_vec = (TYPE_CODE (type2) == TYPE_CODE_ARRAY
748                    && TYPE_VECTOR (type2));
749
750   if (!t1_is_vec && !t2_is_vec)
751     {
752       int tmp = scalar_relop (arg1, arg2, op);
753       struct type *type =
754         language_bool_type (exp->language_defn, exp->gdbarch);
755
756       val = value_from_longest (type, tmp);
757     }
758   else if (t1_is_vec && t2_is_vec)
759     {
760       val = vector_relop (exp, arg1, arg2, op);
761     }
762   else
763     {
764       /* Widen the scalar operand to a vector.  */
765       struct value **v = t1_is_vec ? &arg2 : &arg1;
766       struct type *t = t1_is_vec ? type2 : type1;
767
768       if (TYPE_CODE (t) != TYPE_CODE_FLT && !is_integral_type (t))
769         error (_("Argument to operation not a number or boolean."));
770
771       *v = opencl_value_cast (t1_is_vec ? type1 : type2, *v);
772       val = vector_relop (exp, arg1, arg2, op);
773     }
774
775   return val;
776 }
777
778 /* Expression evaluator for the OpenCL.  Most operations are delegated to
779    evaluate_subexp_standard; see that function for a description of the
780    arguments.  */
781
782 static struct value *
783 evaluate_subexp_opencl (struct type *expect_type, struct expression *exp,
784                    int *pos, enum noside noside)
785 {
786   enum exp_opcode op = exp->elts[*pos].opcode;
787   struct value *arg1 = NULL;
788   struct value *arg2 = NULL;
789   struct type *type1, *type2;
790
791   switch (op)
792     {
793     /* Handle assignment and cast operators to support OpenCL-style
794        scalar-to-vector widening.  */
795     case BINOP_ASSIGN:
796       (*pos)++;
797       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
798       type1 = value_type (arg1);
799       arg2 = evaluate_subexp (type1, exp, pos, noside);
800
801       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
802         return arg1;
803
804       if (deprecated_value_modifiable (arg1)
805           && VALUE_LVAL (arg1) != lval_internalvar)
806         arg2 = opencl_value_cast (type1, arg2);
807
808       return value_assign (arg1, arg2);
809
810     case UNOP_CAST:
811       type1 = exp->elts[*pos + 1].type;
812       (*pos) += 2;
813       arg1 = evaluate_subexp (type1, exp, pos, noside);
814
815       if (noside == EVAL_SKIP)
816         return value_from_longest (builtin_type (exp->gdbarch)->
817                                    builtin_int, 1);
818
819       return opencl_value_cast (type1, arg1);
820
821     case UNOP_CAST_TYPE:
822       (*pos)++;
823       arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
824       type1 = value_type (arg1);
825       arg1 = evaluate_subexp (type1, exp, pos, noside);
826
827       if (noside == EVAL_SKIP)
828         return value_from_longest (builtin_type (exp->gdbarch)->
829                                    builtin_int, 1);
830
831       return opencl_value_cast (type1, arg1);
832
833     /* Handle binary relational and equality operators that are either not
834        or differently defined for GNU vectors.  */
835     case BINOP_EQUAL:
836     case BINOP_NOTEQUAL:
837     case BINOP_LESS:
838     case BINOP_GTR:
839     case BINOP_GEQ:
840     case BINOP_LEQ:
841       (*pos)++;
842       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
843       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
844
845       if (noside == EVAL_SKIP)
846         return value_from_longest (builtin_type (exp->gdbarch)->
847                                    builtin_int, 1);
848
849       return opencl_relop (exp, arg1, arg2, op);
850
851     /* Handle the logical unary operator not(!).  */
852     case UNOP_LOGICAL_NOT:
853       (*pos)++;
854       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
855
856       if (noside == EVAL_SKIP)
857         return value_from_longest (builtin_type (exp->gdbarch)->
858                                    builtin_int, 1);
859
860       return opencl_logical_not (exp, arg1);
861
862     /* Handle the logical operator and(&&) and or(||).  */
863     case BINOP_LOGICAL_AND:
864     case BINOP_LOGICAL_OR:
865       (*pos)++;
866       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
867
868       if (noside == EVAL_SKIP)
869         {
870           evaluate_subexp (NULL_TYPE, exp, pos, noside);
871
872           return value_from_longest (builtin_type (exp->gdbarch)->
873                                      builtin_int, 1);
874         }
875       else
876         {
877           /* For scalar operations we need to avoid evaluating operands
878              unecessarily.  However, for vector operations we always need to
879              evaluate both operands.  Unfortunately we only know which of the
880              two cases apply after we know the type of the second operand.
881              Therefore we evaluate it once using EVAL_AVOID_SIDE_EFFECTS.  */
882           int oldpos = *pos;
883
884           arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
885                                   EVAL_AVOID_SIDE_EFFECTS);
886           *pos = oldpos;
887           type1 = check_typedef (value_type (arg1));
888           type2 = check_typedef (value_type (arg2));
889
890           if ((TYPE_CODE (type1) == TYPE_CODE_ARRAY && TYPE_VECTOR (type1))
891               || (TYPE_CODE (type2) == TYPE_CODE_ARRAY && TYPE_VECTOR (type2)))
892             {
893               arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
894
895               return opencl_relop (exp, arg1, arg2, op);
896             }
897           else
898             {
899               /* For scalar built-in types, only evaluate the right
900                  hand operand if the left hand operand compares
901                  unequal(&&)/equal(||) to 0.  */
902               int res;
903               int tmp = value_logical_not (arg1);
904
905               if (op == BINOP_LOGICAL_OR)
906                 tmp = !tmp;
907
908               arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
909                                       tmp ? EVAL_SKIP : noside);
910               type1 = language_bool_type (exp->language_defn, exp->gdbarch);
911
912               if (op == BINOP_LOGICAL_AND)
913                 res = !tmp && !value_logical_not (arg2);
914               else /* BINOP_LOGICAL_OR */
915                 res = tmp || !value_logical_not (arg2);
916
917               return value_from_longest (type1, res);
918             }
919         }
920
921     /* Handle the ternary selection operator.  */
922     case TERNOP_COND:
923       (*pos)++;
924       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
925       type1 = check_typedef (value_type (arg1));
926       if (TYPE_CODE (type1) == TYPE_CODE_ARRAY && TYPE_VECTOR (type1))
927         {
928           struct value *arg3, *tmp, *ret;
929           struct type *eltype2, *type3, *eltype3;
930           int t2_is_vec, t3_is_vec, i;
931           LONGEST lowb1, lowb2, lowb3, highb1, highb2, highb3;
932
933           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
934           arg3 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
935           type2 = check_typedef (value_type (arg2));
936           type3 = check_typedef (value_type (arg3));
937           t2_is_vec
938             = TYPE_CODE (type2) == TYPE_CODE_ARRAY && TYPE_VECTOR (type2);
939           t3_is_vec
940             = TYPE_CODE (type3) == TYPE_CODE_ARRAY && TYPE_VECTOR (type3);
941
942           /* Widen the scalar operand to a vector if necessary.  */
943           if (t2_is_vec || !t3_is_vec)
944             {
945               arg3 = opencl_value_cast (type2, arg3);
946               type3 = value_type (arg3);
947             }
948           else if (!t2_is_vec || t3_is_vec)
949             {
950               arg2 = opencl_value_cast (type3, arg2);
951               type2 = value_type (arg2);
952             }
953           else if (!t2_is_vec || !t3_is_vec)
954             {
955               /* Throw an error if arg2 or arg3 aren't vectors.  */
956               error (_("\
957 Cannot perform conditional operation on incompatible types"));
958             }
959
960           eltype2 = check_typedef (TYPE_TARGET_TYPE (type2));
961           eltype3 = check_typedef (TYPE_TARGET_TYPE (type3));
962
963           if (!get_array_bounds (type1, &lowb1, &highb1)
964               || !get_array_bounds (type2, &lowb2, &highb2)
965               || !get_array_bounds (type3, &lowb3, &highb3))
966             error (_("Could not determine the vector bounds"));
967
968           /* Throw an error if the types of arg2 or arg3 are incompatible.  */
969           if (TYPE_CODE (eltype2) != TYPE_CODE (eltype3)
970               || TYPE_LENGTH (eltype2) != TYPE_LENGTH (eltype3)
971               || TYPE_UNSIGNED (eltype2) != TYPE_UNSIGNED (eltype3)
972               || lowb2 != lowb3 || highb2 != highb3)
973             error (_("\
974 Cannot perform operation on vectors with different types"));
975
976           /* Throw an error if the sizes of arg1 and arg2/arg3 differ.  */
977           if (lowb1 != lowb2 || lowb1 != lowb3
978               || highb1 != highb2 || highb1 != highb3)
979             error (_("\
980 Cannot perform conditional operation on vectors with different sizes"));
981
982           ret = allocate_value (type2);
983
984           for (i = 0; i < highb1 - lowb1 + 1; i++)
985             {
986               tmp = value_logical_not (value_subscript (arg1, i)) ?
987                     value_subscript (arg3, i) : value_subscript (arg2, i);
988               memcpy (value_contents_writeable (ret) +
989                       i * TYPE_LENGTH (eltype2), value_contents_all (tmp),
990                       TYPE_LENGTH (eltype2));
991             }
992
993           return ret;
994         }
995       else
996         {
997           if (value_logical_not (arg1))
998             {
999               /* Skip the second operand.  */
1000               evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1001
1002               return evaluate_subexp (NULL_TYPE, exp, pos, noside);
1003             }
1004           else
1005             {
1006               /* Skip the third operand.  */
1007               arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1008               evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1009
1010               return arg2;
1011             }
1012         }
1013
1014     /* Handle STRUCTOP_STRUCT to allow component access on OpenCL vectors.  */
1015     case STRUCTOP_STRUCT:
1016       {
1017         int pc = (*pos)++;
1018         int tem = longest_to_int (exp->elts[pc + 1].longconst);
1019
1020         (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1021         arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1022         type1 = check_typedef (value_type (arg1));
1023
1024         if (noside == EVAL_SKIP)
1025           {
1026             return value_from_longest (builtin_type (exp->gdbarch)->
1027                                        builtin_int, 1);
1028           }
1029         else if (TYPE_CODE (type1) == TYPE_CODE_ARRAY && TYPE_VECTOR (type1))
1030           {
1031             return opencl_component_ref (exp, arg1, &exp->elts[pc + 2].string,
1032                                          noside);
1033           }
1034         else
1035           {
1036             struct value *v = value_struct_elt (&arg1, NULL,
1037                                                 &exp->elts[pc + 2].string, NULL,
1038                                                 "structure");
1039
1040             if (noside == EVAL_AVOID_SIDE_EFFECTS)
1041               v = value_zero (value_type (v), not_lval);
1042             return v;
1043           }
1044       }
1045     default:
1046       break;
1047     }
1048
1049   return evaluate_subexp_c (expect_type, exp, pos, noside);
1050 }
1051
1052 /* Print OpenCL types.  */
1053
1054 static void
1055 opencl_print_type (struct type *type, const char *varstring,
1056                    struct ui_file *stream, int show, int level,
1057                    const struct type_print_options *flags)
1058 {
1059   /* We nearly always defer to C type printing, except that vector
1060      types are considered primitive in OpenCL, and should always
1061      be printed using their TYPE_NAME.  */
1062   if (show > 0)
1063     {
1064       CHECK_TYPEDEF (type);
1065       if (TYPE_CODE (type) == TYPE_CODE_ARRAY && TYPE_VECTOR (type)
1066           && TYPE_NAME (type) != NULL)
1067         show = 0;
1068     }
1069
1070   c_print_type (type, varstring, stream, show, level, flags); 
1071 }
1072
1073 static void
1074 opencl_language_arch_info (struct gdbarch *gdbarch,
1075                            struct language_arch_info *lai)
1076 {
1077   struct type **types = builtin_opencl_type (gdbarch);
1078
1079   /* Copy primitive types vector from gdbarch.  */
1080   lai->primitive_type_vector = types;
1081
1082   /* Type of elements of strings.  */
1083   lai->string_char_type = types [opencl_primitive_type_char];
1084
1085   /* Specifies the return type of logical and relational operations.  */
1086   lai->bool_type_symbol = "int";
1087   lai->bool_type_default = types [opencl_primitive_type_int];
1088 }
1089
1090 const struct exp_descriptor exp_descriptor_opencl =
1091 {
1092   print_subexp_standard,
1093   operator_length_standard,
1094   operator_check_standard,
1095   op_name_standard,
1096   dump_subexp_body_standard,
1097   evaluate_subexp_opencl
1098 };
1099
1100 const struct language_defn opencl_language_defn =
1101 {
1102   "opencl",                     /* Language name */
1103   "OpenCL C",
1104   language_opencl,
1105   range_check_off,
1106   case_sensitive_on,
1107   array_row_major,
1108   macro_expansion_c,
1109   &exp_descriptor_opencl,
1110   c_parse,
1111   c_error,
1112   null_post_parser,
1113   c_printchar,                  /* Print a character constant */
1114   c_printstr,                   /* Function to print string constant */
1115   c_emit_char,                  /* Print a single char */
1116   opencl_print_type,            /* Print a type using appropriate syntax */
1117   c_print_typedef,              /* Print a typedef using appropriate syntax */
1118   c_val_print,                  /* Print a value using appropriate syntax */
1119   c_value_print,                /* Print a top-level value */
1120   default_read_var_value,       /* la_read_var_value */
1121   NULL,                         /* Language specific skip_trampoline */
1122   NULL,                         /* name_of_this */
1123   basic_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */
1124   basic_lookup_transparent_type,/* lookup_transparent_type */
1125   NULL,                         /* Language specific symbol demangler */
1126   NULL,                         /* Language specific
1127                                    class_name_from_physname */
1128   c_op_print_tab,               /* expression operators for printing */
1129   1,                            /* c-style arrays */
1130   0,                            /* String lower bound */
1131   default_word_break_characters,
1132   default_make_symbol_completion_list,
1133   opencl_language_arch_info,
1134   default_print_array_index,
1135   default_pass_by_reference,
1136   c_get_string,
1137   NULL,                         /* la_get_symbol_name_cmp */
1138   iterate_over_symbols,
1139   &default_varobj_ops,
1140   LANG_MAGIC
1141 };
1142
1143 static void *
1144 build_opencl_types (struct gdbarch *gdbarch)
1145 {
1146   struct type **types
1147     = GDBARCH_OBSTACK_CALLOC (gdbarch, nr_opencl_primitive_types + 1,
1148                               struct type *);
1149
1150 /* Helper macro to create strings.  */
1151 #define OCL_STRING(S) #S
1152 /* This macro allocates and assigns the type struct pointers
1153    for the vector types.  */
1154 #define BUILD_OCL_VTYPES(TYPE)\
1155   types[opencl_primitive_type_##TYPE##2] \
1156     = init_vector_type (types[opencl_primitive_type_##TYPE], 2); \
1157   TYPE_NAME (types[opencl_primitive_type_##TYPE##2]) = OCL_STRING(TYPE ## 2); \
1158   types[opencl_primitive_type_##TYPE##3] \
1159     = init_vector_type (types[opencl_primitive_type_##TYPE], 3); \
1160   TYPE_NAME (types[opencl_primitive_type_##TYPE##3]) = OCL_STRING(TYPE ## 3); \
1161   TYPE_LENGTH (types[opencl_primitive_type_##TYPE##3]) \
1162     = 4 * TYPE_LENGTH (types[opencl_primitive_type_##TYPE]); \
1163   types[opencl_primitive_type_##TYPE##4] \
1164     = init_vector_type (types[opencl_primitive_type_##TYPE], 4); \
1165   TYPE_NAME (types[opencl_primitive_type_##TYPE##4]) = OCL_STRING(TYPE ## 4); \
1166   types[opencl_primitive_type_##TYPE##8] \
1167     = init_vector_type (types[opencl_primitive_type_##TYPE], 8); \
1168   TYPE_NAME (types[opencl_primitive_type_##TYPE##8]) = OCL_STRING(TYPE ## 8); \
1169   types[opencl_primitive_type_##TYPE##16] \
1170     = init_vector_type (types[opencl_primitive_type_##TYPE], 16); \
1171   TYPE_NAME (types[opencl_primitive_type_##TYPE##16]) = OCL_STRING(TYPE ## 16)
1172
1173   types[opencl_primitive_type_char]
1174     = arch_integer_type (gdbarch, 8, 0, "char");
1175   BUILD_OCL_VTYPES (char);
1176   types[opencl_primitive_type_uchar]
1177     = arch_integer_type (gdbarch, 8, 1, "uchar");
1178   BUILD_OCL_VTYPES (uchar);
1179   types[opencl_primitive_type_short]
1180     = arch_integer_type (gdbarch, 16, 0, "short");
1181   BUILD_OCL_VTYPES (short);
1182   types[opencl_primitive_type_ushort]
1183     = arch_integer_type (gdbarch, 16, 1, "ushort");
1184   BUILD_OCL_VTYPES (ushort);
1185   types[opencl_primitive_type_int]
1186     = arch_integer_type (gdbarch, 32, 0, "int");
1187   BUILD_OCL_VTYPES (int);
1188   types[opencl_primitive_type_uint]
1189     = arch_integer_type (gdbarch, 32, 1, "uint");
1190   BUILD_OCL_VTYPES (uint);
1191   types[opencl_primitive_type_long]
1192     = arch_integer_type (gdbarch, 64, 0, "long");
1193   BUILD_OCL_VTYPES (long);
1194   types[opencl_primitive_type_ulong]
1195     = arch_integer_type (gdbarch, 64, 1, "ulong");
1196   BUILD_OCL_VTYPES (ulong);
1197   types[opencl_primitive_type_half]
1198     = arch_float_type (gdbarch, 16, "half", floatformats_ieee_half);
1199   BUILD_OCL_VTYPES (half);
1200   types[opencl_primitive_type_float]
1201     = arch_float_type (gdbarch, 32, "float", floatformats_ieee_single);
1202   BUILD_OCL_VTYPES (float);
1203   types[opencl_primitive_type_double]
1204     = arch_float_type (gdbarch, 64, "double", floatformats_ieee_double);
1205   BUILD_OCL_VTYPES (double);
1206   types[opencl_primitive_type_bool]
1207     = arch_boolean_type (gdbarch, 8, 1, "bool");
1208   types[opencl_primitive_type_unsigned_char]
1209     = arch_integer_type (gdbarch, 8, 1, "unsigned char");
1210   types[opencl_primitive_type_unsigned_short]
1211     = arch_integer_type (gdbarch, 16, 1, "unsigned short");
1212   types[opencl_primitive_type_unsigned_int]
1213     = arch_integer_type (gdbarch, 32, 1, "unsigned int");
1214   types[opencl_primitive_type_unsigned_long]
1215     = arch_integer_type (gdbarch, 64, 1, "unsigned long");
1216   types[opencl_primitive_type_size_t]
1217     = arch_integer_type (gdbarch, gdbarch_ptr_bit (gdbarch), 1, "size_t");
1218   types[opencl_primitive_type_ptrdiff_t]
1219     = arch_integer_type (gdbarch, gdbarch_ptr_bit (gdbarch), 0, "ptrdiff_t");
1220   types[opencl_primitive_type_intptr_t]
1221     = arch_integer_type (gdbarch, gdbarch_ptr_bit (gdbarch), 0, "intptr_t");
1222   types[opencl_primitive_type_uintptr_t]
1223     = arch_integer_type (gdbarch, gdbarch_ptr_bit (gdbarch), 1, "uintptr_t");
1224   types[opencl_primitive_type_void]
1225     = arch_type (gdbarch, TYPE_CODE_VOID, 1, "void");
1226
1227   return types;
1228 }
1229
1230 /* Provide a prototype to silence -Wmissing-prototypes.  */
1231 extern initialize_file_ftype _initialize_opencl_language;
1232
1233 void
1234 _initialize_opencl_language (void)
1235 {
1236   opencl_type_data = gdbarch_data_register_post_init (build_opencl_types);
1237   add_language (&opencl_language_defn);
1238 }