Rev 5 | Blame | Compare with Previous | Last modification | View Log | RSS feed
/*
* 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();
}
void
out_dwarf_diag_tags(void)
{
/* maybe put out unused ones later */
return;
}
dwarf_global *
new_dwarf_global(diag_descriptor *d)
{
dwarf_global *new = (dwarf_global *)xcalloc(1, sizeof(dwarf_global));
new->desc = d;
return new;
}