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