Subversion Repositories tendra.SVN

Rev

Rev 2 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
2 7u83 1 
/*
2 
    		 Crown Copyright (c) 1997
3 
 
4 
    This TenDRA(r) Computer Program is subject to Copyright
5 
    owned by the United Kingdom Secretary of State for Defence
6 
    acting through the Defence Evaluation and Research Agency
7 
    (DERA).  It is made available to Recipients with a
8 
    royalty-free licence for its use, reproduction, transfer
9 
    to other parties and amendment for any purpose not excluding
10 
    product development provided that any such use et cetera
11 
    shall be deemed to be acceptance of the following conditions:-
12 
 
13 
        (1) Its Recipients shall ensure that this Notice is
14 
        reproduced upon any copies or amended versions of it;
15 
 
16 
        (2) Any amended version of it shall be clearly marked to
17 
        show both the nature of and the organisation responsible
18 
        for the relevant amendment or amendments;
19 
 
20 
        (3) Its onward transfer from a recipient to another
21 
        party shall be deemed to be that party's acceptance of
22 
        these conditions;
23 
 
24 
        (4) DERA gives no warranty or assurance as to its
25 
        quality or suitability for any purpose and DERA accepts
26 
        no liability whatsoever in relation to any use to which
27 
        it may be put.
28 
*/
29 
 
30 
 
31 
/**********************************************************************
32 
$Author: release $
33 
$Date: 1998/02/04 10:43:38 $
34 
$Revision: 1.2 $
35 
$Log: dwarf_type.c,v $
36 
 * Revision 1.2  1998/02/04  10:43:38  release
37 
 * Changes during testing.
38 
 *
39 
 * Revision 1.1.1.1  1998/01/17  15:55:48  release
40 
 * First version to be checked into rolling release.
41 
 *
42 
 * Revision 1.7  1996/07/05  09:03:58  pwe
43 
 * correction for enums
44 
 *
45 
 * Revision 1.6  1996/03/13  13:50:37  pwe
46 
 * diags for long long
47 
 *
48 
 * Revision 1.5  1995/11/28  13:40:31  pwe
49 
 * int more likely than long for 32 bit
50 
 *
51 
 * Revision 1.4  1995/09/28  12:40:00  pwe
52 
 * dwarf.h via import, and type changes for tcc checks
53 
 *
54 
 * Revision 1.3  1995/09/13  16:13:18  pwe
55 
 * tidy for gcc
56 
 *
57 
 * Revision 1.2  1995/09/13  14:25:41  pwe
58 
 * tidy for gcc
59 
 *
60 
 * Revision 1.1.1.1  1995/08/14  14:30:25  pwe
61 
 * transferred from DJCH
62 
 *
63 
**********************************************************************/
64 
 
65 
/* LOG 3/6/93 added extra message to is_fund_dwarf when using
66 
   non-diag libraries djch */
67 
/* LOG 7/9/93 changes for SPARC SVR4.2 to abstract asm directives djch */
68 
/* LOG 25/11/93 renamed SET to DOT_SET to free SET for pwc's use djch */
69 
 
70 
#include "config.h"
71 
#include "common_types.h"
72 
#include "installtypes.h"
73 
#include "machine.h"
74 
#include "out.h"
75 
#include "shapemacs.h"
76 
#include "expmacs.h"
77 
#include "basicread.h"
78 
#include "xalloc.h"
79 
 
80 
#include "dwarf_types.h"
81 
#include "dwarf_out.h"
82 
#include "dwarf_queue.h"
83 
#include "dwarf_loc.h"
84 
#include "dwarf_type.h"
85 
#include "cross_config.h"
86 
 
87 
#ifndef CROSS_INCLUDE
88 
#include <dwarf.h>
89 
#else
90 
#include CROSS_INCLUDE/dwarf.h>
91 
#endif
92 
 
93 
#define NOT_YET(x) fprintf(stderr,"%s not yet implemented\n",x)
94 
 
95 
#define BEEN_PUT_OUT(x) ((x)->been_outed != NULL)
96 
 
97 
#define gcc_FT_long_long		0x8008
98 
#define gcc_FT_unsigned_long_long	0x8208
99 
 
100 
static int is_fund_dwarf
101 
    PROTO_N ( (t) )
102 
    PROTO_T ( diag_type t )
103 
{
104 
  switch(t->key)
105 
  {
106 
   case DIAG_TYPE_ARRAY:
107 
   case DIAG_TYPE_PROC:
108 
   case DIAG_TYPE_STRUCT:
109 
   case DIAG_TYPE_ENUM:
110 
   case DIAG_TYPE_UNION:
111 
    return 0;
112 
 
113 
   case DIAG_TYPE_FLOAT:
114 
   case DIAG_TYPE_VARIETY:
115 
   case DIAG_TYPE_NULL:
116 
   case DIAG_TYPE_BITFIELD:
117 
    return 1;
118 
 
119 
   case DIAG_TYPE_LOC:
120 
    return is_fund_dwarf(t->data.loc.object);
121 
   case DIAG_TYPE_PTR:
122 
    return is_fund_dwarf(t->data.ptr.object);
123 
   case DIAG_TYPE_INITED:
124 
    failer("Initialized but undefined diag type in is_fund_dwarf - may be caused by using libraries without diagnostic information");
125 
   case DIAG_TYPE_UNINIT:
126 
   default:
127 
    failer("Illegal diag type in is_fund_dwarf");
128 
  }
129 
  exit (EXIT_FAILURE);
130 
}
131 
 
132 
static void out_plain_fund_attr
133 
    PROTO_N ( (t) )
134 
    PROTO_T ( diag_type t )
135 
{
136 
  switch(t->key)
137 
  {
138 
   case DIAG_TYPE_FLOAT:
139 
    switch(t->data.f_var)	/* magic numbers from install_fns.c */
140 
    {
141 
     case 0:
142 
      dwarf2c(FT_float);
143 
      break;
144 
     case 1:
145 
      dwarf2c(FT_dbl_prec_float);
146 
      break;
147 
     case 2:
148 
      dwarf2c(FT_ext_prec_float);
149 
      break;
150 
     default:
151 
      failer("unknown float type");
152 
      exit(EXIT_FAILURE);
153 
    }
154 
    break;
155 
   case DIAG_TYPE_VARIETY:
156 
    switch(name(t->data.var))
157 
    {
158 
     case scharhd:
159 
      dwarf2c(FT_signed_char);
160 
      break;
161 
     case ucharhd:
162 
      dwarf2c(FT_unsigned_char);
163 
      break;
164 
     case swordhd:
165 
      dwarf2c(FT_signed_short);
166 
      break;
167 
     case uwordhd:
168 
      dwarf2c(FT_unsigned_short);
169 
      break;
170 
     case slonghd:
171 
      dwarf2c(FT_signed_integer);
172 
      break;
173 
     case ulonghd:
174 
      dwarf2c(FT_unsigned_integer);
175 
      break;
176 
     case s64hd:
177 
      dwarf2c(gcc_FT_long_long);
178 
      break;
179 
     case u64hd:
180 
      dwarf2c(gcc_FT_unsigned_long_long);
181 
      break;
182 
     default:
183 
      failer("Unknown int type");
184 
      exit(EXIT_FAILURE);
185 
    }
186 
    break;
187 
   case DIAG_TYPE_BITFIELD:
188 
    out_plain_fund_attr(t->data.bitfield.result_type);
189 
    if (t->data.bitfield.result_type->key != DIAG_TYPE_VARIETY)
190 
      failer("non variety base type in bitfield");
191 
    out_dwarf_bytesize_attr(t->data.bitfield.result_type->data.var);
192 
    OUT_DWARF_ATTR(AT_bit_size);
193 
    dwarf4n((int)t->data.bitfield.no_of_bits.nat_val.small_nat);
194 
    break;
195 
   case DIAG_TYPE_NULL:
196 
    dwarf2c(FT_void);
197 
    break;
198 
   case DIAG_TYPE_PTR:
199 
    if (t->data.ptr.object->key != DIAG_TYPE_NULL)
200 
      failer("non void ptr in out_plain_fund_attr");
201 
    dwarf2c(FT_pointer);
202 
    break;
203 
   default:
204 
    failer("wrong type in out_plain_fund_attr");
205 
    exit(EXIT_FAILURE);
206 
  }
207 
}
208 
 
209 
static int is_qualified
210 
    PROTO_N ( (t) )
211 
    PROTO_T ( diag_type t )
212 
{
213 
  switch(t->key)
214 
  {
215 
   case DIAG_TYPE_LOC:		/* yes if const/volatile */
216 
    if (t->data.loc.qualifier.is_const || t->data.loc.qualifier.is_volatile)
217 
      return 1;
218 
    return is_qualified(t->data.loc.object);
219 
   case DIAG_TYPE_PTR:		/* definit-ish yes */
220 
				/* EXCEPT that pointer to void is
221 
				   DWARF'ed as FT_pointer */
222 
    if (t->data.ptr.qualifier.is_const || t->data.ptr.qualifier.is_volatile)
223 
      return 1;
224 
    if (t->data.ptr.object->key != DIAG_TYPE_NULL)
225 
      return 1;
226 
				/* I dont think that void can be qualified
227 
				 thus we won't recurse to the void*/
228 
   default:
229 
    return 0;
230 
  }
231 
}
232 
 
233 
static void out_quals
234 
    PROTO_N ( (t) )
235 
    PROTO_T ( diag_tq t )
236 
{
237 
  if (t.is_const)
238 
    dwarf1(MOD_const);
239 
  if (t.is_volatile)
240 
    dwarf1(MOD_volatile);
241 
}
242 
 
243 
static diag_type dequalify
244 
    PROTO_N ( (t) )
245 
    PROTO_T ( diag_type t )
246 
{
247 
    /* get to base and output mods */
248 
/* QUALIFERS */
249 
  switch (t->key)
250 
  {
251 
   case DIAG_TYPE_LOC:
252 
    out_quals(t->data.loc.qualifier);
253 
    return (dequalify(t->data.loc.object));
254 
   case DIAG_TYPE_PTR:
255 
    if (t->data.ptr.object->key == DIAG_TYPE_NULL)
256 
      return t;			/* NOT a plain diag_type, fudge for void * */
257 
    dwarf1(MOD_pointer_to);
258 
    out_quals(t->data.ptr.qualifier);
259 
				/* qualifiers to the thing being pointed to */
260 
    return (dequalify(t->data.ptr.object));
261 
   default:
262 
    return t;
263 
  }
264 
}
265 
 
266 
diag_type base_type
267 
    PROTO_N ( (t) )
268 
    PROTO_T ( diag_type t )
269 
{
270 
  switch (t->key)
271 
  {
272 
   case DIAG_TYPE_LOC:
273 
    return (base_type(t->data.loc.object));
274 
   case DIAG_TYPE_PTR:
275 
    return (base_type(t->data.ptr.object));
276 
   default:
277 
    return t;
278 
  }
279 
}
280 
 
281 
static void out_fund_attr
282 
    PROTO_N ( (t) )
283 
    PROTO_T ( diag_type t )
284 
{
285 
  if (is_qualified(t))
286 
  {
287 
    OUT_DWARF_ATTR(AT_mod_fund_type);
288 
    new_dwarf_blk2();
289 
    out_plain_fund_attr(dequalify(t));
290 
    leave_dwarf_blk2();
291 
  }
292 
  else
293 
  {
294 
    OUT_DWARF_ATTR(AT_fund_type);
295 
    out_plain_fund_attr((t->key == DIAG_TYPE_LOC) ? t->data.loc.object : t);
296 
  }
297 
}
298 
 
299 
static void out_plain_user_attr
300 
    PROTO_N ( (t) )
301 
    PROTO_T ( diag_type t )
302 
{
303 
  /*  this NEVER writes out the actual TAG_xxxx block, but instead
304 
   outputs the FORM_REF 4 byte offset of the actual block */
305 
  if (!BEEN_PUT_OUT(t))
306 
  {
307 
    failer("out_plain_user_attr without an asm label");
308 
    exit(EXIT_FAILURE);
309 
  }
310 
  dwarf4(&((*t->been_outed)[0]));
311 
}
312 
 
313 
static void out_user_attr
314 
    PROTO_N ( (t) )
315 
    PROTO_T ( diag_type t )
316 
{
317 
  if (is_qualified(t))
318 
  {
319 
    OUT_DWARF_ATTR(AT_mod_u_d_type);
320 
    new_dwarf_blk2();
321 
    out_plain_user_attr(dequalify(t));
322 
    leave_dwarf_blk2();
323 
  }
324 
  else
325 
  {
326 
    OUT_DWARF_ATTR(AT_user_def_type);
327 
    out_plain_user_attr((t->key == DIAG_TYPE_LOC) ? t->data.loc.object : t);
328 
  }
329 
}
330 
 
331 
static void queue_up_type_out
332 
    PROTO_N ( (t) )
333 
    PROTO_T ( diag_type t )
334 
{
335 
  if (BEEN_PUT_OUT(t))
336 
  {
337 
    failer("Whhops, queueing twice");
338 
    return;
339 
  }
340 
  t->been_outed = next_dwarf_type_lab();
341 
  add_type_q(t);
342 
}
343 
 
344 
void out_dwarf_type_attr
345 
    PROTO_N ( (t) )
346 
    PROTO_T ( diag_type t )
347 
{
348 
				/* output a dwarf type as an attribute
349 
				 if done once already then just the attr,
350 
				 else queue the type, then the attr */
351 
  if (is_fund_dwarf(t))
352 
  {
353 
    out_fund_attr(t);
354 
    return;
355 
  }
356 
  {
357 
    diag_type b = base_type(t);
358 
    if (!BEEN_PUT_OUT(b))
359 
      queue_up_type_out(b);		/* this will assign the label value */
360 
 
361 
    out_user_attr(t);
362 
    return;
363 
  }
364 
}
365 
 
366 
void out_dwarf_user_type
367 
    PROTO_N ( (t) )
368 
    PROTO_T ( diag_type t )
369 
{
370 
  if (!BEEN_PUT_OUT(t))		/* if so then no external refs */
371 
  {
372 
    t->been_outed = next_dwarf_type_lab();
373 
  }
374 
  switch(t->key)
375 
  {
376 
   case DIAG_TYPE_ARRAY:
377 
    cont_sib_chain(TAG_array_type);
378 
 
379 
    OUT_DWARF_ATTR(AT_stride_size);
380 
    out_dwarf_const_by8(t->data.array.stride);
381 
/*    out_dwarf_name_attr(t->data.array.name); */
382 
    {
383 
      OUT_DWARF_ATTR(AT_subscr_data);
384 
      new_dwarf_blk2();
385 
      dwarf1((int)FMT_FT_C_C);
386 
      OUT_DWARF_TAG(FT_signed_integer);
387 
      out_dwarf_const4(t->data.array.lower_b);
388 
      out_dwarf_const4(t->data.array.upper_b); /* FOR C this is one too big */
389 
      dwarf1((int)FMT_ET);
390 
      out_dwarf_type_attr(t->data.array.element_type);
391 
      leave_dwarf_blk2();
392 
    }
393 
    break;
394 
   case DIAG_TYPE_ENUM:
395 
    cont_sib_chain(TAG_enumeration_type);
396 
    out_dwarf_name_attr(TDFSTRING2CHAR(t->data.t_enum.nme));
397 
    if (t->data.t_enum.base_type->key != DIAG_TYPE_VARIETY)
398 
      failer("non integral enum type");
399 
    out_dwarf_bytesize_attr(t->data.t_enum.base_type->data.var);
400 
    OUT_DWARF_ATTR(AT_element_list);
401 
    new_dwarf_blk4();
402 
    {
403 
      int i;
404 
      enum_values * a = t->data.t_enum.values->array;
405 
 
406 
      for (i=0; i<t->data.t_enum.values->lastused; i++)
407 
      {
408 
	out_dwarf_const4(a[i]->val);
409 
	out_dwarf_string(TDFSTRING2CHAR(a[i]->nme));
410 
      }
411 
    }
412 
    leave_dwarf_blk4();
413 
    break;
414 
   case DIAG_TYPE_PROC:
415 
    cont_sib_chain(TAG_subroutine_type);
416 
    out_dwarf_type_attr(t->data.proc.result_type);
417 
    break;
418 
   case DIAG_TYPE_STRUCT:
419 
    cont_sib_chain(TAG_structure_type);
420 
    out_dwarf_name_attr(TDFSTRING2CHAR(t->data.t_struct.nme));
421 
    out_dwarf_bytesize_attr(t->data.t_struct.tdf_shape);
422 
    break;
423 
   case DIAG_TYPE_UNION:
424 
    cont_sib_chain(TAG_union_type);
425 
    out_dwarf_name_attr(TDFSTRING2CHAR(t->data.t_union.nme));
426 
    out_dwarf_bytesize_attr(t->data.t_union.tdf_shape);
427 
    break;
428 
   default:
429 
    failer("Illegal diag type in out_dwarf_user_type");
430 
  }
431 
				/* now we must set the dwarf type label
432 
				 to be the dwarf label of this block */
433 
  {
434 
    char expr_buf[100];
435 
#if (is80x86)
436 
#define DOT_SET 	".set"
437 
#else
438 
#if (issparc)
439 
#else
440 
error need the .set directive
441 
#endif
442 
#endif
443 
 
444 
#if FS_CONCAT_STRING
445 
#if (is80x86)
446 
#define SET_F "\t"DOT_SET"\t%s , %s"
447 
#else
448 
#if (issparc)
449 
#define SET_F "\t%s = %s"
450 
#else
451 
error need set format str
452 
#endif
453 
#endif
454 
#else
455 
#if (issparc)
456 
/* KEEP this in step..... */
457 
#define SET_F "\t%s = %s"
458 
#else
459 
#if (is80x86)
460 
#define SET_F "\t.set\t %s , %s"
461 
#else
462 
error write this
463 
#endif
464 
#endif
465 
#endif
466 
 
467 
#ifdef mips
468 
    sprintf(expr_buf,SET_F,(char *)t->been_outed,
469 
#else
470 
    sprintf(expr_buf,SET_F,(char *)&((t->been_outed)[0]),
471 
#endif
472 
	    current_label_name());
473 
    outs(expr_buf);
474 
    outnl();
475 
  }
476 
  leave_dwarf_blk();
477 
 
478 
  switch(t->key)
479 
  {
480 
   case DIAG_TYPE_PROC:
481 
    {
482 
      int i;
483 
      diag_type_list pars = t->data.proc.params;
484 
 
485 
      make_next_new_chain();
486 
      for (i=0; i< pars->lastused; i++)
487 
      {
488 
	cont_sib_chain(TAG_formal_parameter);
489 
	out_dwarf_type_attr(pars->array[i]);
490 
	leave_dwarf_blk();
491 
      }
492 
      if (t->data.proc.opt_args)
493 
      {
494 
	cont_sib_chain(TAG_unspecified_parameters);
495 
	leave_dwarf_blk();
496 
      }
497 
      end_sib_chain();
498 
    }
499 
    break;
500 
   case DIAG_TYPE_STRUCT:
501 
    {
502 
      diag_field_list f = t->data.t_struct.fields;
503 
      int i;
504 
 
505 
      make_next_new_chain();
506 
      for ( i = f->lastused-1 ;i>=0; i--)
507 
      {
508 
	diag_field m = f->array[i];
509 
 
510 
	cont_sib_chain(TAG_member);
511 
	out_dwarf_name_attr(TDFSTRING2CHAR(m->field_name));
512 
	out_dwarf_type_attr(m->field_type);
513 
	if (m->field_type->key == DIAG_TYPE_BITFIELD)
514 
	{
515 
				/* dwarf describes bitfields wrt an anonymous
516 
				 object, whose size is that of the base type */
517 
	  int base_type_in_bits =
518 
	    shape_size(m->field_type->data.bitfield.result_type->data.var);
519 
	  int bit_size =
520 
	    m->field_type->data.bitfield.no_of_bits.nat_val.small_nat;
521 
	  int bit_offset_from_base =
522 
	    (int)no(m->where);
523 
	  int bit_offset_in_anon_obj =
524 
	    bit_offset_from_base % base_type_in_bits;
525 
	  int bit_offset_to_anon_obj =
526 
	    bit_offset_from_base - bit_offset_in_anon_obj;
527 
 
528 
	  OUT_DWARF_ATTR(AT_bit_offset);
529 
	  out_dwarf_thing((int)
530 
#if (little_end)
531 
			  ((base_type_in_bits - /* count from other end  */
532 
			   bit_offset_in_anon_obj) - bit_size)
533 
#else
534 
			  bit_offset_in_anon_obj
535 
#endif
536 
			  ," bits");
537 
	  out_dwarf_bit_member_loc_attr(bit_offset_to_anon_obj);
538 
	}
539 
	else
540 
	  out_dwarf_member_loc_attr(m->where);
541 
	leave_dwarf_blk();
542 
      }
543 
      end_sib_chain();
544 
    }
545 
    break;
546 
   case DIAG_TYPE_UNION:
547 
    {
548 
      diag_field_list f = t->data.t_union.fields;
549 
      int i;
550 
 
551 
      make_next_new_chain();
552 
      for ( i = f->lastused-1 ;i>=0; i--)
553 
      {
554 
	diag_field m = f->array[i];
555 
 
556 
	cont_sib_chain(TAG_member);
557 
	out_dwarf_name_attr(TDFSTRING2CHAR(m->field_name));
558 
	out_dwarf_type_attr(m->field_type);
559 
	out_dwarf_member_loc_attr(m->where);
560 
	leave_dwarf_blk();
561 
      }
562 
      end_sib_chain();
563 
    }
564 
    break;
565 
   default:
566 
    break;
567 
  }
568 
}
569 
 
570 
 
571