Subversion Repositories tendra.SVN

/*

 * Copyright (c) 2002-2005 The TenDRA Project <http://www.tendra.org/>.

 * All rights reserved.

 *

 * Redistribution and use in source and binary forms, with or without

 * modification, are permitted provided that the following conditions are met:

 *

 * 1. Redistributions of source code must retain the above copyright notice,

 *    this list of conditions and the following disclaimer.

 * 2. Redistributions in binary form must reproduce the above copyright notice,

 *    this list of conditions and the following disclaimer in the documentation

 *    and/or other materials provided with the distribution.

 * 3. Neither the name of The TenDRA Project nor the names of its contributors

 *    may be used to endorse or promote products derived from this software

 *    without specific, prior written permission.

 *

 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS

 * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,

 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR

 * PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR

 * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,

 * EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,

 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;

 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,

 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR

 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF

 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

 *

 * $Id$

 */

/*

    		 Crown Copyright (c) 1997

    This TenDRA(r) Computer Program is subject to Copyright

    owned by the United Kingdom Secretary of State for Defence

    acting through the Defence Evaluation and Research Agency

    (DERA).  It is made available to Recipients with a

    royalty-free licence for its use, reproduction, transfer

    to other parties and amendment for any purpose not excluding

    product development provided that any such use et cetera

    shall be deemed to be acceptance of the following conditions:-

        (1) Its Recipients shall ensure that this Notice is

        reproduced upon any copies or amended versions of it;

        (2) Any amended version of it shall be clearly marked to

        show both the nature of and the organisation responsible

        for the relevant amendment or amendments;

        (3) Its onward transfer from a recipient to another

        party shall be deemed to be that party's acceptance of

        these conditions;

        (4) DERA gives no warranty or assurance as to its

        quality or suitability for any purpose and DERA accepts

        no liability whatsoever in relation to any use to which

        it may be put.

*/

/**********************************************************************

$Author: release $

$Date: 1998/02/04 10:43:38 $

$Revision: 1.2 $

$Log: dwarf_out.c,v $

 * Revision 1.2  1998/02/04  10:43:38  release

 * Changes during testing.

 *

 * Revision 1.1.1.1  1998/01/17  15:55:47  release

 * First version to be checked into rolling release.

 *

 * Revision 1.5  1997/03/24  12:44:29  pwe

 * outn int->long

 *

 * Revision 1.4  1997/02/19  12:53:47  pwe

 * NEWDIAGS for debugging optimised code

 *

 * Revision 1.3  1995/09/28  12:39:48  pwe

 * dwarf.h via import, and type changes for tcc checks

 *

 * Revision 1.2  1995/09/13  14:25:38  pwe

 * tidy for gcc

 *

 * Revision 1.1.1.1  1995/08/14  14:30:23  pwe

 * transferred from DJCH

 *

**********************************************************************/

/* extra fns for writing DWARF info */

/* LOG 6/9/93 changes for sparc/ICL port of SVR4.2 djch

   */

/* LOG 7/9/93 this will only compile with -Ycommon, assuming 32 bit int

   makes life a lot easier djch. several changes of long to int to

   get weak prototypes to work */

/* LOG 25/11/93 removed redundant labbufe djch */

#include "config.h"

#include "common_types.h"

#include "installtypes.h"

#include "machine.h"

/* machine dependant */

#include "out.h"

#include "diagglob.h"

#include "diagtypes.h"

#include "basicread.h"

/* machine dependant */

#include "expmacs.h"

#include "shapemacs.h"

#include "xalloc.h"

#include "dwarf_types.h"

#include "dwarf_loc.h"

#include "dwarf_mc.h"

#include "dwarf_out.h"

#include "cross_config.h"

#ifdef NEWDIAGS

#include "tags.h"

#endif

#ifndef CROSS_INCLUDE

#include <dwarf.h>

#else

#include CROSS_INCLUDE/dwarf.h>

#endif

#define WHOLE_LINE (0xffff)	/* this should be in dwarf.h */

#define WHOLE_SECT (0)		/* this should be in dwarf.h */

#if issparc

#define DWARF_NAME "D"

#else

#define DWARF_NAME "dwf"

#endif

#if (is80x86)

static char *nl80x86 = "\n";

#define outnl()	outs(nl80x86)	/* avoid side effects of 80x86 outnl */

#endif

void

out_dwarf_lab(H_dwarf_lab *l)

{

	if (OUT_FLAG(*l) != 0) {

		failer("attempt to re_output dwarf label");

		exit(EXIT_FAILURE);

	}

	OUT_FLAG(*l) = (char)1;

	outs(LAB2CHAR(*l));

	outc(':');

	outnl();

}

static void

mk_dwarf_label(dwarf_label *p, CONST char *x)

{

	sprintf(LAB2CHAR(p->beg), "%s%s%s", local_prefix, DWARF_NAME, x);

	OUT_FLAG(p->beg) = 0;

	sprintf(LAB2CHAR(p->end), "%s%s%s.e", local_prefix, DWARF_NAME, x);

	OUT_FLAG(p->end) = 0;

}

void

next_dwarf_lab(dwarf_label *p)

{

	static unsigned long next_dwarf_lab_no = 0;

	char num_buf[DWARF_LAB_LEN];

	sprintf(num_buf, "%ld", next_dwarf_lab_no++);

	mk_dwarf_label(p, num_buf);

}

dwarf_type_label *

next_dwarf_type_lab(void)

{

	dwarf_type_label *ptr =

	    (dwarf_type_label *)xcalloc(1, sizeof(dwarf_type_label));

	static unsigned long next_dwarf_type_lab_no = 0;

	sprintf(LAB2CHAR(*ptr), "%s%sT%ld", local_prefix, DWARF_NAME,

		next_dwarf_type_lab_no++);

	return ptr;

}

#if (is80x86)

#define GO_DWARF	outs("\t.section\t.debug");outnl()

#define GO_LINE		outs("\t.section\t.line");outnl()

#define LEAVE_DWARF	outs("\t.previous");outnl()

#define LEAVE_LINE	LEAVE_DWARF

#define BYTE4S		".4byte"

#define BYTE2S		".2byte"

#define BYTE		".byte"

#define STRING		".string"

#define TEXT_SEG 	".text"

#define END_UNIT_ALIGN  ".align 4"

#define SUB3_F		"[ %s - %s] - %s\t"

#else

#if (issparc)

#define GO_DWARF	outs("\t.pushsection\t\".debug\"");outnl()

#define GO_LINE		outs("\t.pushsection\t\".line\"");outnl()

#define LEAVE_DWARF	outs("\t.popsection");outnl()

#define LEAVE_LINE	LEAVE_DWARF

#define BYTE4S		".uaword"

#define BYTE2S		".uahalf"

#define BYTE		".byte"

#define STRING		".asciz"

#define TEXT_SEG 	".section \".text\""

#define END_UNIT_ALIGN  ".align 4"

#define SUB3_F		"(%s - %s) - %s\t"

#else

error need elf section swapping code

#endif

#endif

#if FS_CONCAT_STRING

#define BYTE4_F		"\t"BYTE4S"\t%s"

#define BYTE2_CMT_F	"\t"BYTE2S COMMENT_2("\t%#x\t", "%s")

#define BYTE2_F		"\t"BYTE2S"\t%s"

#define BYTE_CMT_F	"\t"BYTE COMMENT_2("\t%#x\t", "%s")

#define STRING_M	"\t"STRING"\t"

#define STRING_F	STRING_M"\"%s\""

#define END_UNIT	"\t"END_UNIT_ALIGN

#else

#if (issparc)

/* KEEP these in step.......... */

#define BYTE4_F		"\t.uaword\t%s"

#define BYTE2_CMT_F	"\t.uahalf\t%#x\t!%s"

#define BYTE2_F		"\t.uahalf\t%s"

#define BYTE_CMT_F	"\t.byte\t%#x\t!%s"

#define STRING_M	"\t.asciz\t"

#define STRING_F	"\t.asciz\t\"%s\""

#define END_UNIT	"\t.align 4"

#else

#if (is80x86)

#define BYTE4_F		"\t.4byte\t%s"

#define BYTE2_CMT_F	"\t.2byte\t%#x\t!%s"

#define BYTE2_F		"\t.2byte\t%s"

#define BYTE_CMT_F	"\t.byte\t%#x\t!%s"

#define STRING_M	"\t.string\t"

#define STRING_F	"\t.string\t\"%s\""

#define END_UNIT	"\t.align 4"

#else

error not yet written

#endif

#endif

#endif

void

dwarf4(CONST char *t)

{

	char outbuf[100];

	sprintf(outbuf, BYTE4_F, t);

	outs(outbuf);

	outnl();

}

void

dwarf4n(int x)

{

	char outbuf[100];

	sprintf(outbuf, "%#x", x);

	dwarf4(outbuf);

}

void

out_dwarf_thing(int t, char *cmt)

{

	char outbuf[100];

	if (t > 0xffff) {

		failer("value too big for .2byte constant in out_dwarf_thing");

	}

	sprintf(outbuf, BYTE2_CMT_F, t, cmt);

	outs(outbuf);

	outnl();

}

void

out_dwarf_string(CONST char * CONST s)

{

	/* s = null term'ed in core and to be in asm file */

	char outbuf[100];

	sprintf(outbuf, STRING_F, s);

	outs(outbuf);

	outnl();

}

void

dwarf2(char *c)

{

	char outbuf[100];

	sprintf(outbuf, BYTE2_F, c);

	outs(outbuf);

	outnl();

}

void

out_dwarfone(int t, char *cmt)

{

	char outbuf[100];

	sprintf(outbuf, BYTE_CMT_F, t, cmt);

	outs(outbuf);

	outnl();

}

static dwarf_label 	dwarf_blk_stk[100];

static unsigned int 	dwarf_blk_stk_ptr=0;

void

enter_dwarf_blk(int four, int exclusive, dwarf_label *lb)

{

	/* switch to debug section, put out begin label and length expr */

	char exprbuf[100];

	dwarf_blk_stk[dwarf_blk_stk_ptr++] = *lb;

	/* the block stack is used for nested dwarf blocks, not for sibling

	 * structure */

	/* two byte block are already in debug */

	if (four) {

		GO_DWARF;

	}

	OUT_DWARF_BEG(lb);

	if (exclusive) {

		sprintf(exprbuf, COMMENT_2(SUB3_F, " excl. entry len"),

			lb->end, lb->beg, four ? "4" : "2");

	} else {

		sprintf(exprbuf, COMMENT_2("%s-%s\t", " entry len"), lb->end,

			lb->beg);

	}

	if (four) {

		dwarf4(exprbuf);

	} else {

		dwarf2(exprbuf);

	}

}

void

leave_dwarf_blk1(int leave)

{

	if (dwarf_blk_stk_ptr == 0) {

		failer("dwarf stack underflow");

	}

	{

		dwarf_label *lb = &dwarf_blk_stk[--dwarf_blk_stk_ptr];

		OUT_DWARF_END(lb);

		if (leave) {

			LEAVE_DWARF;

		}

	}

}

char *

current_label_name(void)

{

	return LAB2CHAR(dwarf_blk_stk[dwarf_blk_stk_ptr - 1].beg);

}

void

new_dwarf_blk2(void)

{

	dwarf_label lb;

	next_dwarf_lab(&lb);

	enter_dwarf_blk(0, 1, &lb);

}

void

new_dwarf_blk4(void)

{

	dwarf_label lb;

	next_dwarf_lab(&lb);

	enter_dwarf_blk(1, 1, &lb);

}

static dwarf_label text_range;

static dwarf_label line_range;

void

out_diagnose_prelude(void)

{

	char exprbuf[100];

	mk_dwarf_label(&text_range, "text");

	mk_dwarf_label(&line_range, "line");

	outs(TEXT_SEG);

	outnl();

	OUT_DWARF_BEG(&text_range);

	GO_DWARF;

	LEAVE_DWARF;

	GO_LINE;

	LEAVE_LINE;

	GO_LINE;

	OUT_DWARF_BEG(&line_range);

	sprintf(exprbuf, "%s-%s", line_range.end, line_range.beg);

	dwarf4(exprbuf);

	dwarf4(text_range.beg);

	LEAVE_LINE;

	enter_dwarf_comp_unit();

}

void

out_diagnose_postlude(void)

{

	char exprbuf[100];

	leave_dwarf_comp_unit();

	outs(TEXT_SEG);

	outnl();

	OUT_DWARF_END(&text_range);

	GO_LINE;

	dwarf4n(WHOLE_SECT);	/* line 0 means whole section */

	dwarf2c(WHOLE_LINE);

	sprintf(exprbuf, "%s-%s", text_range.end, text_range.beg);

	dwarf4(exprbuf);

	OUT_DWARF_END(&line_range);

	LEAVE_LINE;

}

static filename main_filename;

void

out_dwarf_sourcemark(CONST sourcemark * CONST x)

{

	dwarf_label lb;

	if (x->file != main_filename) {

		/*    fprintf(stderr, "Sourcemark for file %s cannot be used\n",

		      TDFSTRING2CHAR(x->file->file));*/

		return;

	}

	next_dwarf_lab(&lb);

	OUT_DWARF_BEG(&lb);		/* note this label is in TEXT space */

	GO_LINE;

	dwarf4n((int)x->line_no.nat_val.small_nat);

	if ((x->char_off.nat_val.small_nat) == 0) {

		out_dwarf_thing(WHOLE_LINE, "no source pos");

	} else {

		out_dwarf_thing((int)x->char_off.nat_val.small_nat,

				"source pos");

	}

	{

		char expr_buf[100];

		sprintf(expr_buf, "%s - %s", LAB2CHAR(lb.beg),

			LAB2CHAR(text_range.beg));

		dwarf4(expr_buf);

	}

	LEAVE_LINE;

}

static dwarf_label 	dwarf_sib_stk[100];

static int	 	dwarf_sib_stk_ptr= -1;

/* static dwarf_label	underflow_lab = {"underflow", "undeflow.e"};*/

#define SIB_TOS	       (dwarf_sib_stk[dwarf_sib_stk_ptr])

#define SIB_PUSH	(dwarf_sib_stk[++dwarf_sib_stk_ptr])

#define SIB_POP		(--dwarf_sib_stk_ptr)

/* ((dwarf_sib_stk_ptr) == 0 ? failer("sib stack underflow"), underflow_lab */

void

start_sib_chain1(int d_tag, char *tag_name)

{

	/* generate new label

	   enter blk for new label

	   gen sib label

	   push sib label

	   gen sib chain */

	dwarf_label chain_head;

	next_dwarf_lab(&chain_head);

	enter_dwarf_entry(&chain_head);

	next_dwarf_lab(&SIB_PUSH);

	OUT_DWARF_TAG_NAMED(d_tag, tag_name);

	outs(COMMENT_2("\t", " new sibling chain level "));

	outn((long)dwarf_sib_stk_ptr);

	outnl();

	OUT_DWARF_ATTR(AT_sibling);

	dwarf4(SIB_TOS.beg);

}

void

make_next_new_chain(void)

{

	/* simulate entering next level */

	next_dwarf_lab(&SIB_PUSH);

}

void

cont_sib_chain1(int d_tag, char *tag_name)

{

	/* enter blk for TOS

	   gen sib label

	   setq TOS sib label

	   gen sib chain */

	enter_dwarf_entry(&SIB_TOS);

	next_dwarf_lab(&SIB_TOS);

	outs(COMMENT_2("\t", " sibling chain level "));

	outn((long)dwarf_sib_stk_ptr);

	outnl();

	OUT_DWARF_TAG_NAMED(d_tag, tag_name);

	OUT_DWARF_ATTR(AT_sibling);

	dwarf4(SIB_TOS.beg);

}

void

end_sib_chain(void)

{

	/* enter blk for TOS

	   gen dummy blk

	   pop stack

	   leave blk */

	enter_dwarf_entry(&SIB_TOS);

	outs(COMMENT_2("\t", " end sibling chain level "));

	outn((long)dwarf_sib_stk_ptr);

	outnl();

	leave_dwarf_blk();

	SIB_POP;

}

static void

end_toplevel_chain(void)

{

	/* just put out the label */

	GO_DWARF;

	OUT_DWARF_BEG(&SIB_TOS);

	outs(COMMENT_2("\t", " end toplevel chain"));

	outnl();

	LEAVE_DWARF;

	SIB_POP;

}

/* HACK to get a filename */

static long name_space;

static char *first_filename = (char *)0;

void

dwarf_inspect_filename(filename f)

{

	if (first_filename) {

		return;

	}

	{

		char *str = TDFSTRING2CHAR(f->file);

		char *lastdot = strrchr(str, '.');

		if (!lastdot) {

			/* no dot in name */

			return;

		}

		if (lastdot[1] != 'h') {

			first_filename = (char *)xcalloc(1, strlen(str) + 1);

			/* +1 for null ending */

			strcpy(first_filename, str);

			/* note this to validate sourcemarks */

			main_filename = f;

			fflush(fpout);

			{

				long old_tell = ftell(fpout);

				fseek(fpout, name_space, SEEK_SET);

				outc('"'); outs(str); outc('"');

				fseek(fpout, old_tell, SEEK_SET);

			}

		}

	}

}

extern char *crt_filename;

static void

maybe_fix_filename(void)

{

	char name_buf[100];

	char *last_dot;

	/* seen a .c already */

	if (first_filename) {

		return;

	}

	if (crt_filename == NULL) {

		name_buf[0] = '\0';

	} else {

		strcpy(name_buf, crt_filename);

	}

	if (strlen(name_buf) > 0) {

		last_dot = strrchr(name_buf, '.');

		if (last_dot) {

			last_dot[1] = 'c';

		} else {

			strcpy(name_buf, "UNKNOWN_SUFFIX.c");

		}

	} else {

		strcpy(name_buf, "UNKNOWN_FILE.c");

	}

	fflush(fpout);

	{

		long old_tell = ftell(fpout);

		fseek(fpout, name_space, SEEK_SET);

		outc('"'); outs(name_buf); outc('"');

		fseek(fpout, old_tell, SEEK_SET);

	}

}

void

enter_dwarf_comp_unit(void)

{

	start_sib_chain(TAG_compile_unit);

	OUT_DWARF_ATTR(AT_name);

	outs(STRING_M);

	fflush(fpout);

	name_space = ftell(fpout);

	outs("                                                                    ");

	outs("                                                                    ");

	outnl();

	OUT_DWARF_ATTR(AT_language);

	dwarf4n((int)LANG_C89);

	OUT_DWARF_ATTR(AT_low_pc);

	dwarf4(LAB2CHAR(text_range.beg));

	OUT_DWARF_ATTR(AT_high_pc);

	dwarf4(LAB2CHAR(text_range.end));

	OUT_DWARF_ATTR(AT_stmt_list);

	dwarf4(LAB2CHAR(line_range.beg));

	leave_dwarf_blk();

	make_next_new_chain();

}

#include "dwarf_type.h"

#include "dwarf_queue.h"

void

leave_dwarf_comp_unit(void)

{

	dump_type_q();

	/* end sib chain below comp unit */

	end_sib_chain();

	{

		dwarf_label lb;

		next_dwarf_lab(&lb);

		enter_dwarf_blk(1, 0, &lb);

		outs(END_UNIT);

		outnl();

		leave_dwarf_blk();

	}

	/* sib of comp unit */

	end_toplevel_chain();

	maybe_fix_filename();

}

void

out_dwarf_name_attr(CONST char * CONST s)

{

	if (*s == 0) {

		outs(COMMENT_2("\t", " no source name"));

		outnl();

		return;

	}

	OUT_DWARF_ATTR(AT_name);

	out_dwarf_string(s);

}

void

out_dwarf_bytesize_attr(shape t)

{

	OUT_DWARF_ATTR(AT_byte_size);

	dwarf4n((int)(shape_size(t) / 8));

}

static void

dwarf_out_descriptor(diag_descriptor *x)

{

	switch (x->key) {

	case DIAG_ID_KEY: {

		exp acc = x->data.id.access;

		exp t = son(acc);

#ifdef NEWDIAGS

		if (name(acc) != hold_tag) {

			failer("access should be in hold");

			break;

		}

		acc = son(acc);

		if (name(acc) == cont_tag && name(son(acc)) == name_tag &&

		    isvar(son(son(acc)))) {

			acc = son(acc);

		}

		if (name(acc) != name_tag) {

			failer("not name_tag");

			break;

		}

		t = son(acc);

#endif

		if (!isvar(brog(t)->dec_u.dec_val.dec_exp) &&

		    (name(brog(t)->dec_u.dec_val.dec_shape) == prokhd)) {

			/*	fprintf(stderr, "%s was a proc\n",

			 *	TDFSTRING2CHAR(x->data.id.nme));*/

			break;

		} else {

			if (isparam(t)) {

				failer("out descriptor for parameter variable");

			}

			if (!brog(t) ->dec_u.dec_val.extnamed) {

				cont_sib_chain(TAG_local_variable);

			} else {

				cont_sib_chain(TAG_global_variable);

			}

			out_dwarf_name_attr(TDFSTRING2CHAR(x->data.id.nme));

			out_dwarf_type_attr(x->data.id.new_type);

			out_dwarf_loc_attr(acc, -1);

			/* -1 for proc_no, since outside any proc */

			leave_dwarf_blk();

		}

		break;

	}

	case DIAG_STRUCT_KEY:

		fprintf(stderr, "Not yet doing desc key %d name %s\n", x->key,

			TDFSTRING2CHAR(x->data.id.nme));

		break;

	case DIAG_TYPEDEF_KEY:

		if ((base_type(x->data.typ.new_type))->key ==

		    DIAG_TYPE_INITED) {

			/*      fprintf(stderr, "No diagtype defn provided for %s... omitting typedef\n",

				TDFSTRING2CHAR(x->data.typ.nme)); */

			break;

		}

		cont_sib_chain(TAG_typedef);

		out_dwarf_name_attr(TDFSTRING2CHAR(x->data.typ.nme));

		out_dwarf_type_attr(x->data.typ.new_type);

		leave_dwarf_blk();

		break;

	default:

		failer("Unknown descriptor");

	}

}

void

out_dwarf_global_list(void)

{

	int i;

	/*  fprintf(stderr, "diagvartab len %d used %d\n", unit_diagvar_tab.len,

	    unit_diagvar_tab.lastused); */

	outs(COMMENT_2("\t", "\tdumping global list"));

	outnl();

	for (i = 0; i < unit_diagvar_tab.lastused; i++) {

		dwarf_out_descriptor(& (unit_diagvar_tab.array[i]));

	}

	dump_type_q();

}