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