Subversion Repositories tendra.SVN

Rev

Rev 5 | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
2 7u83 1 
/*
6 7u83 2 
 * Copyright (c) 2002-2005 The TenDRA Project <http://www.tendra.org/>.
3 
 * All rights reserved.
4 
 *
5 
 * Redistribution and use in source and binary forms, with or without
6 
 * modification, are permitted provided that the following conditions are met:
7 
 *
8 
 * 1. Redistributions of source code must retain the above copyright notice,
9 
 *    this list of conditions and the following disclaimer.
10 
 * 2. Redistributions in binary form must reproduce the above copyright notice,
11 
 *    this list of conditions and the following disclaimer in the documentation
12 
 *    and/or other materials provided with the distribution.
13 
 * 3. Neither the name of The TenDRA Project nor the names of its contributors
14 
 *    may be used to endorse or promote products derived from this software
15 
 *    without specific, prior written permission.
16 
 *
17 
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
18 
 * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
19 
 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
20 
 * PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
21 
 * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
22 
 * EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
23 
 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
24 
 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
25 
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
26 
 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
27 
 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
28 
 *
29 
 * $Id$
30 
 */
31 
/*
2 7u83 32 
    		 Crown Copyright (c) 1997
33 
 
34 
    This TenDRA(r) Computer Program is subject to Copyright
35 
    owned by the United Kingdom Secretary of State for Defence
36 
    acting through the Defence Evaluation and Research Agency
37 
    (DERA).  It is made available to Recipients with a
38 
    royalty-free licence for its use, reproduction, transfer
39 
    to other parties and amendment for any purpose not excluding
40 
    product development provided that any such use et cetera
41 
    shall be deemed to be acceptance of the following conditions:-
42 
 
43 
        (1) Its Recipients shall ensure that this Notice is
44 
        reproduced upon any copies or amended versions of it;
45 
 
46 
        (2) Any amended version of it shall be clearly marked to
47 
        show both the nature of and the organisation responsible
48 
        for the relevant amendment or amendments;
49 
 
50 
        (3) Its onward transfer from a recipient to another
51 
        party shall be deemed to be that party's acceptance of
52 
        these conditions;
53 
 
54 
        (4) DERA gives no warranty or assurance as to its
55 
        quality or suitability for any purpose and DERA accepts
56 
        no liability whatsoever in relation to any use to which
57 
        it may be put.
58 
*/
59 
 
60 
 
61 
/**********************************************************************
62 
$Author: release $
63 
$Date: 1998/02/04 10:43:38 $
64 
$Revision: 1.2 $
65 
$Log: dwarf_out.c,v $
66 
 * Revision 1.2  1998/02/04  10:43:38  release
67 
 * Changes during testing.
68 
 *
69 
 * Revision 1.1.1.1  1998/01/17  15:55:47  release
70 
 * First version to be checked into rolling release.
71 
 *
72 
 * Revision 1.5  1997/03/24  12:44:29  pwe
73 
 * outn int->long
74 
 *
75 
 * Revision 1.4  1997/02/19  12:53:47  pwe
76 
 * NEWDIAGS for debugging optimised code
77 
 *
78 
 * Revision 1.3  1995/09/28  12:39:48  pwe
79 
 * dwarf.h via import, and type changes for tcc checks
80 
 *
81 
 * Revision 1.2  1995/09/13  14:25:38  pwe
82 
 * tidy for gcc
83 
 *
84 
 * Revision 1.1.1.1  1995/08/14  14:30:23  pwe
85 
 * transferred from DJCH
86 
 *
87 
**********************************************************************/
88 
 
89 
/* extra fns for writing DWARF info */
90 
/* LOG 6/9/93 changes for sparc/ICL port of SVR4.2 djch
91 
   */
92 
/* LOG 7/9/93 this will only compile with -Ycommon, assuming 32 bit int
93 
   makes life a lot easier djch. several changes of long to int to
94 
   get weak prototypes to work */
95 
/* LOG 25/11/93 removed redundant labbufe djch */
96 
 
97 
#include "config.h"
98 
#include "common_types.h"
99 
#include "installtypes.h"
100 
#include "machine.h"
101 
 
102 
/* machine dependant */
103 
#include "out.h"
104 
 
105 
#include "diagglob.h"
106 
#include "diagtypes.h"
107 
#include "basicread.h"
108 
 
109 
/* machine dependant */
110 
#include "expmacs.h"
111 
 
112 
#include "shapemacs.h"
113 
 
114 
#include "xalloc.h"
115 
#include "dwarf_types.h"
116 
#include "dwarf_loc.h"
117 
#include "dwarf_mc.h"
118 
#include "dwarf_out.h"
119 
#include "cross_config.h"
120 
#ifdef NEWDIAGS
121 
#include "tags.h"
122 
#endif
123 
 
124 
#ifndef CROSS_INCLUDE
125 
#include <dwarf.h>
126 
#else
127 
#include CROSS_INCLUDE/dwarf.h>
128 
#endif
129 
 
6 7u83 130 
#define WHOLE_LINE (0xffff)	/* this should be in dwarf.h */
131 
#define WHOLE_SECT (0)		/* this should be in dwarf.h */
2 7u83 132 
 
133 
#if issparc
134 
#define DWARF_NAME "D"
135 
#else
136 
#define DWARF_NAME "dwf"
137 
#endif
138 
 
139 
#if (is80x86)
6 7u83 140 
static char *nl80x86 = "\n";
2 7u83 141 
#define outnl()	outs(nl80x86)	/* avoid side effects of 80x86 outnl */
142 
#endif
143 
 
6 7u83 144 
void
145 
out_dwarf_lab(H_dwarf_lab *l)
2 7u83 146 
{
6 7u83 147 
	if (OUT_FLAG(*l) != 0) {
148 
		failer("attempt to re_output dwarf label");
149 
		exit(EXIT_FAILURE);
150 
	}
151 
	OUT_FLAG(*l) = (char)1;
152 
	outs(LAB2CHAR(*l));
153 
	outc(':');
154 
	outnl();
2 7u83 155 
}
156 
 
6 7u83 157 
 
158 
static void
159 
mk_dwarf_label(dwarf_label *p, CONST char *x)
2 7u83 160 
{
6 7u83 161 
	sprintf(LAB2CHAR(p->beg), "%s%s%s", local_prefix, DWARF_NAME, x);
162 
	OUT_FLAG(p->beg) = 0;
163 
	sprintf(LAB2CHAR(p->end), "%s%s%s.e", local_prefix, DWARF_NAME, x);
164 
	OUT_FLAG(p->end) = 0;
2 7u83 165 
}
166 
 
6 7u83 167 
 
168 
void
169 
next_dwarf_lab(dwarf_label *p)
2 7u83 170 
{
6 7u83 171 
	static unsigned long next_dwarf_lab_no = 0;
172 
	char num_buf[DWARF_LAB_LEN];
2 7u83 173 
 
6 7u83 174 
	sprintf(num_buf, "%ld", next_dwarf_lab_no++);
175 
	mk_dwarf_label(p, num_buf);
2 7u83 176 
}
177 
 
6 7u83 178 
 
179 
dwarf_type_label *
180 
next_dwarf_type_lab(void)
2 7u83 181 
{
6 7u83 182 
	dwarf_type_label *ptr =
183 
	    (dwarf_type_label *)xcalloc(1, sizeof(dwarf_type_label));
2 7u83 184 
 
6 7u83 185 
	static unsigned long next_dwarf_type_lab_no = 0;
2 7u83 186 
 
6 7u83 187 
	sprintf(LAB2CHAR(*ptr), "%s%sT%ld", local_prefix, DWARF_NAME,
188 
		next_dwarf_type_lab_no++);
189 
	return ptr;
2 7u83 190 
}
191 
 
6 7u83 192 
 
2 7u83 193 
#if (is80x86)
194 
#define GO_DWARF	outs("\t.section\t.debug");outnl()
195 
#define GO_LINE		outs("\t.section\t.line");outnl()
196 
#define LEAVE_DWARF	outs("\t.previous");outnl()
197 
#define LEAVE_LINE	LEAVE_DWARF
198 
#define BYTE4S		".4byte"
199 
#define BYTE2S		".2byte"
200 
#define BYTE		".byte"
201 
#define STRING		".string"
202 
#define TEXT_SEG 	".text"
203 
#define END_UNIT_ALIGN  ".align 4"
204 
#define SUB3_F		"[ %s - %s] - %s\t"
6 7u83 205 
 
2 7u83 206 
#else
6 7u83 207 
 
2 7u83 208 
#if (issparc)
209 
#define GO_DWARF	outs("\t.pushsection\t\".debug\"");outnl()
210 
#define GO_LINE		outs("\t.pushsection\t\".line\"");outnl()
211 
#define LEAVE_DWARF	outs("\t.popsection");outnl()
212 
#define LEAVE_LINE	LEAVE_DWARF
213 
#define BYTE4S		".uaword"
214 
#define BYTE2S		".uahalf"
215 
#define BYTE		".byte"
216 
#define STRING		".asciz"
217 
#define TEXT_SEG 	".section \".text\""
218 
#define END_UNIT_ALIGN  ".align 4"
219 
#define SUB3_F		"(%s - %s) - %s\t"
220 
 
221 
#else
222 
error need elf section swapping code
223 
#endif
224 
#endif
225 
 
226 
#if FS_CONCAT_STRING
227 
 
6 7u83 228 
#define BYTE4_F		"\t"BYTE4S"\t%s"
229 
#define BYTE2_CMT_F	"\t"BYTE2S COMMENT_2("\t%#x\t", "%s")
230 
#define BYTE2_F		"\t"BYTE2S"\t%s"
231 
#define BYTE_CMT_F	"\t"BYTE COMMENT_2("\t%#x\t", "%s")
232 
#define STRING_M	"\t"STRING"\t"
233 
#define STRING_F	STRING_M"\"%s\""
234 
#define END_UNIT	"\t"END_UNIT_ALIGN
2 7u83 235 
 
236 
#else
6 7u83 237 
 
2 7u83 238 
#if (issparc)
239 
/* KEEP these in step.......... */
6 7u83 240 
#define BYTE4_F		"\t.uaword\t%s"
241 
#define BYTE2_CMT_F	"\t.uahalf\t%#x\t!%s"
242 
#define BYTE2_F		"\t.uahalf\t%s"
243 
#define BYTE_CMT_F	"\t.byte\t%#x\t!%s"
244 
#define STRING_M	"\t.asciz\t"
245 
#define STRING_F	"\t.asciz\t\"%s\""
246 
#define END_UNIT	"\t.align 4"
247 
 
2 7u83 248 
#else
6 7u83 249 
 
2 7u83 250 
#if (is80x86)
6 7u83 251 
#define BYTE4_F		"\t.4byte\t%s"
252 
#define BYTE2_CMT_F	"\t.2byte\t%#x\t!%s"
253 
#define BYTE2_F		"\t.2byte\t%s"
254 
#define BYTE_CMT_F	"\t.byte\t%#x\t!%s"
255 
#define STRING_M	"\t.string\t"
256 
#define STRING_F	"\t.string\t\"%s\""
257 
#define END_UNIT	"\t.align 4"
2 7u83 258 
#else
259 
error not yet written
260 
#endif
261 
#endif
262 
#endif
263 
 
6 7u83 264 
 
265 
void
266 
dwarf4(CONST char *t)
2 7u83 267 
{
6 7u83 268 
	char outbuf[100];
2 7u83 269 
 
6 7u83 270 
	sprintf(outbuf, BYTE4_F, t);
2 7u83 271 
 
6 7u83 272 
	outs(outbuf);
273 
	outnl();
2 7u83 274 
}
275 
 
6 7u83 276 
 
277 
void
278 
dwarf4n(int x)
2 7u83 279 
{
6 7u83 280 
	char outbuf[100];
2 7u83 281 
 
6 7u83 282 
	sprintf(outbuf, "%#x", x);
283 
	dwarf4(outbuf);
2 7u83 284 
}
285 
 
6 7u83 286 
 
287 
void
288 
out_dwarf_thing(int t, char *cmt)
2 7u83 289 
{
6 7u83 290 
	char outbuf[100];
2 7u83 291 
 
6 7u83 292 
	if (t > 0xffff) {
293 
		failer("value too big for .2byte constant in out_dwarf_thing");
294 
	}
2 7u83 295 
 
6 7u83 296 
	sprintf(outbuf, BYTE2_CMT_F, t, cmt);
297 
	outs(outbuf);
298 
	outnl();
2 7u83 299 
}
300 
 
6 7u83 301 
 
302 
void
303 
out_dwarf_string(CONST char * CONST s)
2 7u83 304 
{
6 7u83 305 
	/* s = null term'ed in core and to be in asm file */
306 
	char outbuf[100];
2 7u83 307 
 
6 7u83 308 
	sprintf(outbuf, STRING_F, s);
309 
	outs(outbuf);
310 
	outnl();
2 7u83 311 
}
312 
 
6 7u83 313 
 
314 
void
315 
dwarf2(char *c)
2 7u83 316 
{
6 7u83 317 
	char outbuf[100];
2 7u83 318 
 
6 7u83 319 
	sprintf(outbuf, BYTE2_F, c);
320 
	outs(outbuf);
321 
	outnl();
2 7u83 322 
}
323 
 
6 7u83 324 
 
325 
void
326 
out_dwarfone(int t, char *cmt)
2 7u83 327 
{
6 7u83 328 
	char outbuf[100];
2 7u83 329 
 
6 7u83 330 
	sprintf(outbuf, BYTE_CMT_F, t, cmt);
331 
	outs(outbuf);
332 
	outnl();
2 7u83 333 
}
334 
 
6 7u83 335 
 
2 7u83 336 
static dwarf_label 	dwarf_blk_stk[100];
337 
static unsigned int 	dwarf_blk_stk_ptr=0;
338 
 
6 7u83 339 
void
340 
enter_dwarf_blk(int four, int exclusive, dwarf_label *lb)
2 7u83 341 
{
6 7u83 342 
	/* switch to debug section, put out begin label and length expr */
343 
	char exprbuf[100];
2 7u83 344 
 
6 7u83 345 
	dwarf_blk_stk[dwarf_blk_stk_ptr++] = *lb;
346 
	/* the block stack is used for nested dwarf blocks, not for sibling
347 
	 * structure */
2 7u83 348 
 
6 7u83 349 
	/* two byte block are already in debug */
350 
	if (four) {
351 
		GO_DWARF;
352 
	}
2 7u83 353 
 
6 7u83 354 
	OUT_DWARF_BEG(lb);
355 
	if (exclusive) {
356 
		sprintf(exprbuf, COMMENT_2(SUB3_F, " excl. entry len"),
357 
			lb->end, lb->beg, four ? "4" : "2");
358 
	} else {
359 
		sprintf(exprbuf, COMMENT_2("%s-%s\t", " entry len"), lb->end,
360 
			lb->beg);
361 
	}
362 
	if (four) {
363 
		dwarf4(exprbuf);
364 
	} else {
365 
		dwarf2(exprbuf);
366 
	}
2 7u83 367 
}
368 
 
6 7u83 369 
 
370 
void
371 
leave_dwarf_blk1(int leave)
2 7u83 372 
{
6 7u83 373 
	if (dwarf_blk_stk_ptr == 0) {
374 
		failer("dwarf stack underflow");
375 
	}
376 
	{
377 
		dwarf_label *lb = &dwarf_blk_stk[--dwarf_blk_stk_ptr];
2 7u83 378 
 
6 7u83 379 
		OUT_DWARF_END(lb);
380 
		if (leave) {
381 
			LEAVE_DWARF;
382 
		}
383 
	}
2 7u83 384 
}
385 
 
6 7u83 386 
 
387 
char *
388 
current_label_name(void)
2 7u83 389 
{
6 7u83 390 
	return LAB2CHAR(dwarf_blk_stk[dwarf_blk_stk_ptr - 1].beg);
2 7u83 391 
}
392 
 
393 
 
6 7u83 394 
void
395 
new_dwarf_blk2(void)
2 7u83 396 
{
6 7u83 397 
	dwarf_label lb;
398 
	next_dwarf_lab(&lb);
2 7u83 399 
 
6 7u83 400 
	enter_dwarf_blk(0, 1, &lb);
2 7u83 401 
}
402 
 
6 7u83 403 
 
404 
void
405 
new_dwarf_blk4(void)
2 7u83 406 
{
6 7u83 407 
	dwarf_label lb;
408 
	next_dwarf_lab(&lb);
2 7u83 409 
 
6 7u83 410 
	enter_dwarf_blk(1, 1, &lb);
2 7u83 411 
}
412 
 
6 7u83 413 
 
2 7u83 414 
static dwarf_label text_range;
415 
static dwarf_label line_range;
416 
 
6 7u83 417 
void
418 
out_diagnose_prelude(void)
2 7u83 419 
{
6 7u83 420 
	char exprbuf[100];
2 7u83 421 
 
6 7u83 422 
	mk_dwarf_label(&text_range, "text");
423 
	mk_dwarf_label(&line_range, "line");
2 7u83 424 
 
6 7u83 425 
	outs(TEXT_SEG);
426 
	outnl();
427 
	OUT_DWARF_BEG(&text_range);
428 
	GO_DWARF;
429 
	LEAVE_DWARF;
430 
	GO_LINE;
431 
	LEAVE_LINE;
2 7u83 432 
 
6 7u83 433 
	GO_LINE;
434 
	OUT_DWARF_BEG(&line_range);
435 
	sprintf(exprbuf, "%s-%s", line_range.end, line_range.beg);
436 
	dwarf4(exprbuf);
437 
	dwarf4(text_range.beg);
438 
	LEAVE_LINE;
439 
	enter_dwarf_comp_unit();
2 7u83 440 
 
441 
}
442 
 
6 7u83 443 
 
444 
void
445 
out_diagnose_postlude(void)
2 7u83 446 
{
6 7u83 447 
	char exprbuf[100];
2 7u83 448 
 
6 7u83 449 
	leave_dwarf_comp_unit();
2 7u83 450 
 
6 7u83 451 
	outs(TEXT_SEG);
452 
	outnl();
453 
	OUT_DWARF_END(&text_range);
454 
	GO_LINE;
455 
	dwarf4n(WHOLE_SECT);	/* line 0 means whole section */
456 
	dwarf2c(WHOLE_LINE);
457 
	sprintf(exprbuf, "%s-%s", text_range.end, text_range.beg);
458 
	dwarf4(exprbuf);
459 
	OUT_DWARF_END(&line_range);
460 
	LEAVE_LINE;
2 7u83 461 
}
462 
 
6 7u83 463 
 
2 7u83 464 
static filename main_filename;
465 
 
6 7u83 466 
void
467 
out_dwarf_sourcemark(CONST sourcemark * CONST x)
2 7u83 468 
{
6 7u83 469 
	dwarf_label lb;
2 7u83 470 
 
6 7u83 471 
	if (x->file != main_filename) {
472 
		/*    fprintf(stderr, "Sourcemark for file %s cannot be used\n",
473 
		      TDFSTRING2CHAR(x->file->file));*/
474 
		return;
475 
	}
2 7u83 476 
 
6 7u83 477 
	next_dwarf_lab(&lb);
478 
	OUT_DWARF_BEG(&lb);		/* note this label is in TEXT space */
2 7u83 479 
 
6 7u83 480 
	GO_LINE;
481 
	dwarf4n((int)x->line_no.nat_val.small_nat);
482 
	if ((x->char_off.nat_val.small_nat) == 0) {
483 
		out_dwarf_thing(WHOLE_LINE, "no source pos");
484 
	} else {
485 
		out_dwarf_thing((int)x->char_off.nat_val.small_nat,
486 
				"source pos");
487 
	}
488 
	{
489 
		char expr_buf[100];
2 7u83 490 
 
6 7u83 491 
		sprintf(expr_buf, "%s - %s", LAB2CHAR(lb.beg),
492 
			LAB2CHAR(text_range.beg));
493 
		dwarf4(expr_buf);
494 
	}
495 
	LEAVE_LINE;
2 7u83 496 
}
497 
 
6 7u83 498 
 
2 7u83 499 
static dwarf_label 	dwarf_sib_stk[100];
500 
static int	 	dwarf_sib_stk_ptr= -1;
6 7u83 501 
/* static dwarf_label	underflow_lab = {"underflow", "undeflow.e"};*/
2 7u83 502 
 
6 7u83 503 
#define SIB_TOS	       (dwarf_sib_stk[dwarf_sib_stk_ptr])
2 7u83 504 
#define SIB_PUSH	(dwarf_sib_stk[++dwarf_sib_stk_ptr])
505 
#define SIB_POP		(--dwarf_sib_stk_ptr)
506 
 
6 7u83 507 
/* ((dwarf_sib_stk_ptr) == 0 ? failer("sib stack underflow"), underflow_lab */
2 7u83 508 
 
6 7u83 509 
void
510 
start_sib_chain1(int d_tag, char *tag_name)
2 7u83 511 
{
6 7u83 512 
	/* generate new label
513 
	   enter blk for new label
514 
	   gen sib label
515 
	   push sib label
516 
	   gen sib chain */
517 
	dwarf_label chain_head;
518 
	next_dwarf_lab(&chain_head);
2 7u83 519 
 
6 7u83 520 
	enter_dwarf_entry(&chain_head);
521 
	next_dwarf_lab(&SIB_PUSH);
2 7u83 522 
 
6 7u83 523 
	OUT_DWARF_TAG_NAMED(d_tag, tag_name);
524 
	outs(COMMENT_2("\t", " new sibling chain level "));
525 
	outn((long)dwarf_sib_stk_ptr);
526 
	outnl();
527 
	OUT_DWARF_ATTR(AT_sibling);
528 
	dwarf4(SIB_TOS.beg);
2 7u83 529 
}
530 
 
6 7u83 531 
 
532 
void
533 
make_next_new_chain(void)
2 7u83 534 
{
6 7u83 535 
	/* simulate entering next level */
536 
	next_dwarf_lab(&SIB_PUSH);
2 7u83 537 
}
538 
 
6 7u83 539 
 
540 
void
541 
cont_sib_chain1(int d_tag, char *tag_name)
2 7u83 542 
{
6 7u83 543 
	/* enter blk for TOS
544 
	   gen sib label
545 
	   setq TOS sib label
546 
	   gen sib chain */
547 
	enter_dwarf_entry(&SIB_TOS);
548 
	next_dwarf_lab(&SIB_TOS);
549 
	outs(COMMENT_2("\t", " sibling chain level "));
550 
	outn((long)dwarf_sib_stk_ptr);
551 
	outnl();
2 7u83 552 
 
6 7u83 553 
	OUT_DWARF_TAG_NAMED(d_tag, tag_name);
554 
	OUT_DWARF_ATTR(AT_sibling);
555 
	dwarf4(SIB_TOS.beg);
2 7u83 556 
}
557 
 
6 7u83 558 
 
559 
void
560 
end_sib_chain(void)
2 7u83 561 
{
6 7u83 562 
	/* enter blk for TOS
563 
	   gen dummy blk
564 
	   pop stack
565 
	   leave blk */
566 
	enter_dwarf_entry(&SIB_TOS);
567 
	outs(COMMENT_2("\t", " end sibling chain level "));
568 
	outn((long)dwarf_sib_stk_ptr);
569 
	outnl();
570 
	leave_dwarf_blk();
571 
	SIB_POP;
2 7u83 572 
}
573 
 
6 7u83 574 
 
575 
static void
576 
end_toplevel_chain(void)
2 7u83 577 
{
6 7u83 578 
	/* just put out the label */
579 
	GO_DWARF;
580 
	OUT_DWARF_BEG(&SIB_TOS);
581 
	outs(COMMENT_2("\t", " end toplevel chain"));
582 
	outnl();
583 
	LEAVE_DWARF;
584 
	SIB_POP;
2 7u83 585 
}
586 
 
6 7u83 587 
/* HACK to get a filename */
2 7u83 588 
static long name_space;
589 
 
6 7u83 590 
static char *first_filename = (char *)0;
2 7u83 591 
 
6 7u83 592 
void
593 
dwarf_inspect_filename(filename f)
2 7u83 594 
{
6 7u83 595 
	if (first_filename) {
596 
		return;
597 
	}
598 
	{
599 
		char *str = TDFSTRING2CHAR(f->file);
600 
		char *lastdot = strrchr(str, '.');
2 7u83 601 
 
6 7u83 602 
		if (!lastdot) {
603 
			/* no dot in name */
604 
			return;
605 
		}
2 7u83 606 
 
6 7u83 607 
		if (lastdot[1] != 'h') {
608 
			first_filename = (char *)xcalloc(1, strlen(str) + 1);
609 
			/* +1 for null ending */
610 
			strcpy(first_filename, str);
2 7u83 611 
 
6 7u83 612 
			/* note this to validate sourcemarks */
613 
			main_filename = f;
2 7u83 614 
 
6 7u83 615 
			fflush(fpout);
616 
			{
617 
				long old_tell = ftell(fpout);
2 7u83 618 
 
6 7u83 619 
				fseek(fpout, name_space, SEEK_SET);
620 
				outc('"'); outs(str); outc('"');
621 
				fseek(fpout, old_tell, SEEK_SET);
622 
			}
623 
		}
624 
	}
2 7u83 625 
}
626 
 
6 7u83 627 
 
2 7u83 628 
extern char *crt_filename;
629 
 
6 7u83 630 
static void
631 
maybe_fix_filename(void)
2 7u83 632 
{
6 7u83 633 
	char name_buf[100];
634 
	char *last_dot;
2 7u83 635 
 
6 7u83 636 
	/* seen a .c already */
637 
	if (first_filename) {
638 
		return;
639 
	}
2 7u83 640 
 
6 7u83 641 
	if (crt_filename == NULL) {
642 
		name_buf[0] = '\0';
643 
	} else {
644 
		strcpy(name_buf, crt_filename);
645 
	}
2 7u83 646 
 
6 7u83 647 
	if (strlen(name_buf) > 0) {
648 
		last_dot = strrchr(name_buf, '.');
2 7u83 649 
 
6 7u83 650 
		if (last_dot) {
651 
			last_dot[1] = 'c';
652 
		} else {
653 
			strcpy(name_buf, "UNKNOWN_SUFFIX.c");
654 
		}
655 
	} else {
656 
		strcpy(name_buf, "UNKNOWN_FILE.c");
657 
	}
2 7u83 658 
 
6 7u83 659 
	fflush(fpout);
660 
	{
661 
		long old_tell = ftell(fpout);
2 7u83 662 
 
6 7u83 663 
		fseek(fpout, name_space, SEEK_SET);
664 
		outc('"'); outs(name_buf); outc('"');
665 
		fseek(fpout, old_tell, SEEK_SET);
666 
	}
2 7u83 667 
}
668 
 
6 7u83 669 
 
670 
void
671 
enter_dwarf_comp_unit(void)
2 7u83 672 
{
6 7u83 673 
	start_sib_chain(TAG_compile_unit);
674 
	OUT_DWARF_ATTR(AT_name);
675 
	outs(STRING_M);
676 
	fflush(fpout);
677 
	name_space = ftell(fpout);
678 
	outs("                                                                    ");
679 
	outs("                                                                    ");
680 
	outnl();
681 
	OUT_DWARF_ATTR(AT_language);
682 
	dwarf4n((int)LANG_C89);
683 
	OUT_DWARF_ATTR(AT_low_pc);
684 
	dwarf4(LAB2CHAR(text_range.beg));
685 
	OUT_DWARF_ATTR(AT_high_pc);
686 
	dwarf4(LAB2CHAR(text_range.end));
687 
	OUT_DWARF_ATTR(AT_stmt_list);
688 
	dwarf4(LAB2CHAR(line_range.beg));
689 
	leave_dwarf_blk();
2 7u83 690 
 
6 7u83 691 
	make_next_new_chain();
2 7u83 692 
}
693 
 
694 
 
695 
#include "dwarf_type.h"
696 
#include "dwarf_queue.h"
697 
 
6 7u83 698 
void
699 
leave_dwarf_comp_unit(void)
2 7u83 700 
{
6 7u83 701 
	dump_type_q();
702 
	/* end sib chain below comp unit */
703 
	end_sib_chain();
2 7u83 704 
 
6 7u83 705 
	{
706 
		dwarf_label lb;
707 
		next_dwarf_lab(&lb);
2 7u83 708 
 
6 7u83 709 
		enter_dwarf_blk(1, 0, &lb);
710 
		outs(END_UNIT);
711 
		outnl();
712 
		leave_dwarf_blk();
713 
	}
2 7u83 714 
 
6 7u83 715 
	/* sib of comp unit */
716 
	end_toplevel_chain();
717 
	maybe_fix_filename();
2 7u83 718 
}
719 
 
6 7u83 720 
 
721 
void
722 
out_dwarf_name_attr(CONST char * CONST s)
2 7u83 723 
{
6 7u83 724 
	if (*s == 0) {
725 
		outs(COMMENT_2("\t", " no source name"));
726 
		outnl();
727 
		return;
728 
	}
729 
	OUT_DWARF_ATTR(AT_name);
730 
	out_dwarf_string(s);
2 7u83 731 
}
732 
 
6 7u83 733 
 
734 
void
735 
out_dwarf_bytesize_attr(shape t)
2 7u83 736 
{
6 7u83 737 
	OUT_DWARF_ATTR(AT_byte_size);
738 
	dwarf4n((int)(shape_size(t) / 8));
2 7u83 739 
}
740 
 
741 
 
6 7u83 742 
static void
743 
dwarf_out_descriptor(diag_descriptor *x)
2 7u83 744 
{
6 7u83 745 
	switch (x->key) {
746 
	case DIAG_ID_KEY: {
747 
		exp acc = x->data.id.access;
748 
		exp t = son(acc);
2 7u83 749 
#ifdef NEWDIAGS
6 7u83 750 
		if (name(acc) != hold_tag) {
751 
			failer("access should be in hold");
752 
			break;
753 
		}
754 
		acc = son(acc);
755 
		if (name(acc) == cont_tag && name(son(acc)) == name_tag &&
756 
		    isvar(son(son(acc)))) {
757 
			acc = son(acc);
758 
		}
759 
		if (name(acc) != name_tag) {
760 
			failer("not name_tag");
761 
			break;
762 
		}
763 
		t = son(acc);
2 7u83 764 
#endif
765 
 
6 7u83 766 
		if (!isvar(brog(t)->dec_u.dec_val.dec_exp) &&
767 
		    (name(brog(t)->dec_u.dec_val.dec_shape) == prokhd)) {
768 
			/*	fprintf(stderr, "%s was a proc\n",
769 
			 *	TDFSTRING2CHAR(x->data.id.nme));*/
770 
			break;
771 
		} else {
772 
			if (isparam(t)) {
773 
				failer("out descriptor for parameter variable");
774 
			}
775 
			if (!brog(t) ->dec_u.dec_val.extnamed) {
776 
				cont_sib_chain(TAG_local_variable);
777 
			} else {
778 
				cont_sib_chain(TAG_global_variable);
779 
			}
2 7u83 780 
 
6 7u83 781 
			out_dwarf_name_attr(TDFSTRING2CHAR(x->data.id.nme));
782 
			out_dwarf_type_attr(x->data.id.new_type);
783 
			out_dwarf_loc_attr(acc, -1);
784 
			/* -1 for proc_no, since outside any proc */
785 
			leave_dwarf_blk();
786 
		}
787 
		break;
788 
	}
789 
	case DIAG_STRUCT_KEY:
790 
		fprintf(stderr, "Not yet doing desc key %d name %s\n", x->key,
791 
			TDFSTRING2CHAR(x->data.id.nme));
792 
		break;
793 
	case DIAG_TYPEDEF_KEY:
794 
		if ((base_type(x->data.typ.new_type))->key ==
795 
		    DIAG_TYPE_INITED) {
796 
			/*      fprintf(stderr, "No diagtype defn provided for %s... omitting typedef\n",
797 
				TDFSTRING2CHAR(x->data.typ.nme)); */
798 
			break;
799 
		}
800 
		cont_sib_chain(TAG_typedef);
801 
		out_dwarf_name_attr(TDFSTRING2CHAR(x->data.typ.nme));
802 
		out_dwarf_type_attr(x->data.typ.new_type);
803 
		leave_dwarf_blk();
804 
		break;
805 
	default:
806 
		failer("Unknown descriptor");
807 
	}
2 7u83 808 
}
809 
 
810 
 
6 7u83 811 
void
812 
out_dwarf_global_list(void)
2 7u83 813 
{
6 7u83 814 
	int i;
2 7u83 815 
 
6 7u83 816 
	/*  fprintf(stderr, "diagvartab len %d used %d\n", unit_diagvar_tab.len,
817 
	    unit_diagvar_tab.lastused); */
818 
	outs(COMMENT_2("\t", "\tdumping global list"));
819 
	outnl();
820 
	for (i = 0; i < unit_diagvar_tab.lastused; i++) {
821 
		dwarf_out_descriptor(& (unit_diagvar_tab.array[i]));
822 
	}
823 
	dump_type_q();
2 7u83 824 
}
825 
 
6 7u83 826 
 
827 
void
828 
out_dwarf_diag_tags(void)
2 7u83 829 
{
6 7u83 830 
	/* maybe put out unused ones later */
831 
	return;
2 7u83 832 
}
833 
 
834 
 
6 7u83 835 
dwarf_global *
836 
new_dwarf_global(diag_descriptor *d)
2 7u83 837 
{
6 7u83 838 
	dwarf_global *new = (dwarf_global *)xcalloc(1, sizeof(dwarf_global));
2 7u83 839 
 
6 7u83 840 
	new->desc = d;
2 7u83 841 
 
6 7u83 842 
	return new;
2 7u83 843 
}