/*
    		 Crown Copyright (c) 1996

    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.
*/
/*
			    VERSION INFORMATION
			    ===================

--------------------------------------------------------------------------
$Header: /u/g/release/CVSROOT/Source/src/installers/680x0/common/xdb_output.c,v 1.1.1.1 1998/01/17 15:55:50 release Exp $
--------------------------------------------------------------------------
$Log: xdb_output.c,v $
 * Revision 1.1.1.1  1998/01/17  15:55:50  release
 * First version to be checked into rolling release.
 *
Revision 1.1.1.1  1997/10/13 12:43:02  ma
First version.

Revision 1.1.1.1  1997/03/14 07:50:23  ma
Imported from DRA

 * Revision 1.1.1.1  1996/09/20  10:57:01  john
 *
 * Revision 1.2  1996/07/05  14:35:40  john
 * Fix to diagnostics
 *
 * Revision 1.1  95/03/08  16:46:25  ra
 * Added missing files.
 *
 * Revision 1.3  94/02/21  16:09:13  16:09:13  ra (Robert Andrews)
 * Put in a number of explicit casts.
 *
 * Revision 1.2  93/04/19  13:39:31  13:39:31  ra (Robert Andrews)
 * crt_fname and crt_line_num are no longer static.
 *
 * Revision 1.1  93/02/22  17:17:25  17:17:25  ra (Robert Andrews)
 * Initial revision
 *
--------------------------------------------------------------------------
*/


#include "config.h"
#include "common_types.h"
#include "assembler.h"
#include "codex.h"
#include "exp.h"
#include "expmacs.h"
#include "instrs.h"
#include "mach.h"
#include "mach_ins.h"
#include "mach_op.h"
#include "output.h"
#include "tags.h"
#include "utility.h"
#include "xdb_types.h"
#include "xdb_output.h"
#include "stab_types.h"
extern int diag_override ;


/*
    WORK OUT WHETHER TO DO A DYNAMIC TEST FOR DIAGNOSTIC FORMAT
*/

#if ( default_diag == DIAG_UNKNOWN )
#define dynamic_test
extern double atof PROTO_S ( ( CONST char * ) ) ;
#include <sys/utsname.h>
#else
#undef dynamic_test
#endif


/*
    WHICH DIAGNOSTIC FORMAT SHOULD BE USED?
*/

bool diag_format = default_diag ;


/*
    ARRAY OF DIAGNOSTIC DIRECTIVES

    This array gives information on all the available diagnostic directives,
    included those which are unused.
*/

diag_directive dd [] = {
    { m_dd_array, 2, 2 },
    { m_dd_begin, 1, 1 },
    { m_dd_const, 0, 0 },	/* unknown */
    { m_dd_dvar, 2, 2 },
    { m_dd_end, 1, 1 },
    { m_dd_entry, 0, 0 },	/* unknown */
    { m_dd_enum, 1, 1 },
    { m_dd_field, 2, 2 },
    { m_dd_file, 0, 0 },	/* unknown */
    { m_dd_fparam, 2, 2 },
    { m_dd_function, 3, 3 },
    { m_dd_functype, 2, 2 },
    { m_dd_import, 0, 0 },	/* unknown */
    { m_dd_label, 0, 0 },	/* unknown */
    { m_dd_memenum, 2, 2 },
    { m_dd_module, 1, 2 },
    { m_dd_pointer, 1, 1 },
    { m_dd_set, 0, 0 },		/* unknown */
    { m_dd_srcfile, 1, 1 },
    { m_dd_struct, 2, 2 },
    { m_dd_subrange, 2, 2 },
    { m_dd_svar, 2, 2 },
    { m_dd_tagdef, 1, 1 },
    { m_dd_typedef, 1, 1 },
    { m_dd_union, 1, 1 },
    { m_dd_variant, 0, 0 }	/* unknown */
} ;


/*
    DIAGNOSTICS FILES

    There are three sections of diagnostic information in the new
    diagnostics mode (the vt, lntt and gntt sections).  One temporary
    file is used for each.  In the old diagnosics mode there is
    only one section (the dntt section), and only one file, diagfp2,
    is used.
*/

static FILE *diagfp1 ;
static FILE *diagfp2 ;
static FILE *diagfp3 ;


/*
    INITIALIZE DIAGNOSTICS FILES

    The temporary files are opened, and the headings of the various
    sections are printed.
*/

void init_diag
    PROTO_Z ()
{
    double vs = ( diag_format == DIAG_XDB_NEW ? 7.40 : 7.05 ) ;

#ifdef dynamic_test
    struct utsname u ;
    char *os = "HP-UX" ;
    uname ( &u ) ;
    os = u.sysname ;
    vs = atof ( u.release ) ;
    if ( strcmp ( os, "HP-UX" ) == 0 ) {
	diag_format = ( vs >= 7.40 ? DIAG_XDB_NEW : DIAG_XDB_OLD ) ;
    } else {
	diag_format = DIAG_UNKNOWN ;
   }
#endif

    if ( diag_override != DIAG_UNKNOWN ) {
	diag_format = diag_override ;
	vs = ( diag_format == DIAG_XDB_NEW ? 7.40 : 7.05 ) ;
    }
    switch ( diag_format ) {

	case DIAG_STAB : {
	    /* Temporary files not used */
	    break ;
	}

	case DIAG_UNKNOWN : {
	    warning ( "Unknown diagnostics format" ) ;
	    diag_format = DIAG_XDB_NEW ;
	    /* Fall through */
	}

	case DIAG_XDB_NEW : {
	    diagfp1 = tmpfile () ;
	    diagfp2 = tmpfile () ;
	    diagfp3 = tmpfile () ;
	    if ( diagfp1 == null || diagfp2 == null || diagfp3 == null ) {
		error ( "Can't open temporary diagnostics file" ) ;
		exit ( EXIT_FAILURE ) ;
	    }
	    fprintf ( diagfp1, "%s\n", instr_names [ m_as_data ] ) ;
	    fprintf ( diagfp1, "%s\n", instr_names [ m_dd_vt ] ) ;
	    fprintf ( diagfp2, "%s\n", instr_names [ m_dd_lntt ] ) ;
	    fprintf ( diagfp3, "%s\n", instr_names [ m_dd_gntt ] ) ;
	    break ;
	}

	case DIAG_XDB_OLD : {
	    diagfp2 = tmpfile () ;
	    if ( diagfp2 == null ) {
		error ( "Can't open temporary diagnostics file" ) ;
		exit ( EXIT_FAILURE ) ;
	    }
	    fprintf ( diagfp2, "%s\n", instr_names [ m_as_data ] ) ;
	    fprintf ( diagfp2, "%s\n", instr_names [ m_dd_start ] ) ;
	    break ;
	}
    }
    return ;
}


/*
    COPY A FILE

    The the file is copied to the main output file, fpout.
*/

static void copy_diag_file
    PROTO_N ( ( file ) )
    PROTO_T ( FILE *file )
{
    int c ;
    rewind ( file ) ;
    while ( c = getc ( file ), c != EOF ) putc ( c, fpout ) ;
    fclose ( file ) ;
    return ;
}


/*
    VT AREA NEWLINE FLAG

    This flag is true if a newline has just been output in the vt area.
*/

static int vt_newline = 1 ;


/*
    COPY DIAGNOSTICS FILES

    All the diagnostic files are copied to the main output file.
*/

void copy_diag
    PROTO_Z ()
{
    if ( diag_format == DIAG_XDB_NEW ) {
	if ( vt_newline ) {
	    fprintf ( diagfp1, "%s0\n", instr_names [ m_dd_vtbytes ] ) ;
	} else {
	    fprintf ( diagfp1, ",0\n" ) ;
	}
	copy_diag_file ( diagfp1 ) ;
	copy_diag_file ( diagfp2 ) ;
	copy_diag_file ( diagfp3 ) ;
    } else if ( diag_format == DIAG_XDB_OLD ) {
	copy_diag_file ( diagfp2 ) ;
    }
    return ;
}


/*
    OUTPUT A DIAGNOSTICS STRING

    Diagnostic strings (eg. procedure and variable names) are dealt with
    differently in the two formats.  In the old format they are output
    direct, in the new they are added to the vt table and the offset
    from the start of the table is used.
*/

void diag_string
    PROTO_N ( ( file, s ) )
    PROTO_T ( FILE *file X char *s )
{
    if ( diag_format == DIAG_XDB_NEW ) {
	static int vtposn = 0 ;
	static int vtwidth = 0 ;
	if ( vt_newline ) {
	    fprintf ( diagfp1, "%s0", instr_names [ m_dd_vtbytes ] ) ;
	    vt_newline = 0 ;
	} else {
	    fprintf ( diagfp1, ",0" ) ;
	}
	vtposn++ ;
	vtwidth++ ;
	fprintf ( file, "%d", vtposn ) ;
	for ( ; *s ; s++ ) {
	    if ( vt_newline ) {
		fprintf ( diagfp1, "%s%d", instr_names [ m_dd_vtbytes ], *s ) ;
		vt_newline = 0 ;
	    } else {
		fprintf ( diagfp1, ",%d", *s ) ;
	    }
	    vtposn++ ;
	    vtwidth++ ;
	    if ( vtwidth > 12 ) {
		fprintf ( diagfp1, "\n" ) ;
		vt_newline = 1 ;
		vtwidth = 0 ;
	    }
	}
    } else {
	fprintf ( file, "\"%s\"", s ) ;
    }
    return ;
}


/*
    CURRENT FILE INDEX AND LINE NUMBER

    These variables record the current position in the source file.
*/

char *crt_fname = "" ;
long crt_line_num = -1 ;


/*
    NUMBER OF SLT INSTRUCTIONS

    A count of the number of slt instructions is maintained.
*/

static int slt_num = 0 ;


/*
    PRINT AN SLT SPECIAL INSTRUCTION

    An sltspecial instruction is output.  This goes straight into the
    main output file.
*/

static void slt_special
    PROTO_N ( ( t, p ) )
    PROTO_T ( int t X posn_t p )
{
    mach_op *op1, *op2, *op3 ;
    area ( ptext ) ;
    op1 = make_int_data ( t ) ;
    op2 = make_int_data ( crt_line_num ) ;
    op3 = make_hex_data ( p ) ;
    op1->of = op2 ;
    op2->of = op3 ;
    make_instr ( m_dd_special, op1, null, 0 ) ;
    area ( plast ) ;
    slt_num++ ;
    return ;
}


/*
    OUTPUT A SLT NORMAL INSTRUCTION

    An sltnormal instruction is output.  This goes straight into the
    main output file.
*/

static void slt_normal
    PROTO_Z ()
{
    mach_op *op ;
    area ( ptext ) ;
    op = make_int_data ( crt_line_num ) ;
    if ( diag_format == DIAG_STAB ) {
	mach_op *op1 = make_int_data ( 68 ) ;
	op1->of = make_int_data ( 0 ) ;
	op1->of->of = op ;
	make_instr ( m_stabd, op1, null, 0 ) ;
    } else {
	make_instr ( m_dd_normal, op, null, 0 ) ;
    }
    area ( plast ) ;
    slt_num++ ;
    return ;
}


/*
    OUTPUT A SLT EXIT INSTRUCTION

    An sltexit instruction is output (new format only).
*/

void slt_exit
    PROTO_Z ()
{
    mach_op *op ;
    area ( ptext ) ;
    op = make_int_data ( crt_line_num ) ;
    make_instr ( m_dd_exit, op, null, 0 ) ;
    area ( plast ) ;
    slt_num++ ;
    return ;
}


/*
    OUTPUT A DNT BEGIN INSTRUCTION
*/

void dnt_begin
    PROTO_Z ()
{
    if ( diag_format == DIAG_STAB ) {
	long lab = next_lab () ;
	make_label ( lab ) ;
	push_dscope ( ( posn_t ) lab, 0 ) ;
    } else {
	posn_t p = out_dd ( diagfp2, xdb_begin, 1 ) ;
	push_dscope ( p, 4 ) ;
	if ( diag_format == DIAG_XDB_NEW ) fprintf ( diagfp2, "0," ) ;
	fprintf ( diagfp2, "%d\n", slt_num ) ;
	slt_special ( 5, p ) ;
    }
    return ;
}


/*
    OUTPUT A DNT END INSTRUCTION
*/

int dnt_end
    PROTO_Z ()
{
    dscope *d = pop_dscope () ;
    if ( d == null ) return ( 0 ) ;
    if ( diag_format == DIAG_STAB ) {
	long lab1 = ( long ) d->posn ;
	long lab2 = next_lab () ;
	make_label ( lab2 ) ;
	make_stabn ( 192, lab1 ) ;
	make_stabn ( 224, lab2 ) ;
    } else {
	posn_t p = out_dd ( diagfp2, xdb_end, 1 ) ;
	if ( diag_format == DIAG_XDB_NEW ) {
	    fprintf ( diagfp2, "%d,0,", d->dscope_type ) ;
	}
	fprintf ( diagfp2, "%d,0x%x\n", slt_num,
		  ( unsigned int ) d->posn ) ;
	slt_special ( 6, p ) ;
    }
    return ( 1 ) ;
}


/*
    FLAG FOR MODULE NAME
*/

static bool have_module = 0 ;


/*
    DIAGNOSTICS FOR FILE NAME

    This routine output the necessary instructions to indicate a change
    of source file.
*/

void diag_source_file
    PROTO_N ( ( nm, ln ) )
    PROTO_T ( char *nm X long ln )
{
    if ( diag_format == DIAG_STAB ) {
	int n = strlen ( nm ) + 3 ;
	char *qnm = alloc_nof ( char, n ) ;
	mach_op *op = make_extern_data ( "Ltext", 0 ) ;
	sprintf ( qnm, "\"%s\"", nm ) ;
	make_stabs ( qnm, ( have_module ? 132 : 100 ), L0, op ) ;
	if ( !have_module ) {
	    make_external_label ( "Ltext" ) ;
	    init_stab_types () ;
	    have_module = 1 ;
	}
	crt_fname = nm ;
	crt_line_num = ln ;
    } else {
	posn_t x = out_dd ( diagfp2, xdb_srcfile, 1 ) ;
	fprintf ( diagfp2, "1," ) ;
	diag_string ( diagfp2, nm ) ;
	fprintf ( diagfp2, ",%d\n", slt_num ) ;
	crt_fname = nm ;
	crt_line_num = ln ;
	make_instr ( m_dd_align, null, null, 0 ) ;
	slt_special ( 1, x ) ;
	if ( !have_module ) {
	    x = out_dd ( diagfp2, xdb_module, 1 ) ;
	    if ( diag_format == DIAG_XDB_NEW ) {
		fprintf ( diagfp2, "0,0" ) ;
	    } else {
		diag_string ( diagfp2, nm ) ;
	    }
	    fprintf ( diagfp2, ",%d\n", slt_num ) ;
	    push_dscope ( x, 1 ) ;
	    slt_special ( 2, x ) ;
	    have_module = 1 ;
	}
    }
    return ;
}


/*
    DIAGNOSTICS FOR LINE NUMBER

    This routine outputs an instruction indicating the position within
    the source file.
*/

void diag_source
    PROTO_N ( ( nm, ln, d ) )
    PROTO_T ( char *nm X long ln X int d )
{
    if ( have_module && d == 0 ) return ;
    if ( !eq ( nm, crt_fname ) ) diag_source_file ( nm, ln ) ;
    crt_line_num = ln ;
    if ( d ) slt_normal () ;
    return ;
}


/*
    CURRENT DIAGNOSTICS PROCEDURE LABEL
*/

long crt_diag_proc_lab ;


/*
    DIAGNOSTICS FOR A PROCEDURE
*/

void diag_proc_main
    PROTO_N ( ( dt, e, id, is_glob, val ) )
    PROTO_T ( diag_type dt X exp e X char *id X int is_glob X char *val )
{
    exp a ;
    posn_t t ;
    long fp ;
    table_posn *p ;
    diag_type dtl ;

    /* Analyse result sort */
    if ( dt->key != DIAG_TYPE_PROC ) {
	error ( "Illegal procedure type" ) ;
	return ;
    }
    dtl = dt->data.proc.result_type ;

    if ( diag_format == DIAG_STAB ) {
	mach_op *op = make_extern_data ( val, 0 ) ;
	char *st = analyse_stab_type ( dtl, id, ( is_glob ? "F" : "f" ) ) ;
	make_stabs ( st, 36, crt_line_num, op ) ;
	dnt_begin () ;
    } else {
	p = analyse_diag_type ( diagfp2, dtl, 1 ) ;

	/* Create diagnostics procedure label */
	crt_diag_proc_lab = next_lab () ;

	/* Output function diagnostic directive */
	t = out_dd ( diagfp2, xdb_function, 1 ) ;
	fprintf ( diagfp2, "%d,1,", is_glob ) ;
	if ( diag_format == DIAG_XDB_NEW ) fprintf ( diagfp2, "0,0,0,0,0," ) ;
	diag_string ( diagfp2, id ) ;
	if ( strcmp ( id, "main" ) == 0 ) {
	    fputc ( ',', diagfp2 ) ;
	    diag_string ( diagfp2, "_MAIN_" ) ;
	    fputc ( ',', diagfp2 ) ;
	} else {
	    fprintf ( diagfp2, ",0," ) ;
	}
	fp = ftell ( diagfp2 ) ;
	fprintf ( diagfp2, "%s,%d,%s,", NULL_POSN_STR, slt_num, val ) ;
	out_posn ( diagfp2, p, 1 ) ;
	if ( diag_format == DIAG_XDB_NEW ) fprintf ( diagfp2, "%s,", val ) ;
	fprintf ( diagfp2, "L%ld\n", crt_diag_proc_lab ) ;

	/* Start new diagnostic scope */
	push_dscope ( t, 2 ) ;
	slt_special ( 3, t ) ;
    }

    /* Step over actual procedure arguments */
    a = son ( e ) ;
    while ( name ( a ) == ident_tag /* && isparam ( a ) */ ) {
	a = bro ( son ( a ) ) ;
    }

    /* Read procedure argument definitions */
    while ( name ( a ) == diagnose_tag ) {
	diag_info *di = dno ( a ) ;
	if ( di->key == DIAG_INFO_ID ) {
	    exp ps = di->data.id_scope.access ;
	    if ( isparam ( son ( ps ) ) ) {
		diag_type pdt = di->data.id_scope.typ ;
		char *pnm = di->data.id_scope.nme.ints.chars ;
		long off = 8 + ( no ( ps ) + no ( son ( ps ) ) ) / 8 ;
		if ( diag_format == DIAG_STAB ) {
		    mach_op *op = make_int_data ( off ) ;
		    char *st = analyse_stab_type ( pdt, pnm, "p" ) ;
		    make_stabs ( st, 160, L0, op ) ;
		} else {
		    p = analyse_diag_type ( diagfp2, pdt, 1 ) ;
		    t = out_dd ( diagfp2, xdb_fparam, 1 ) ;
		    fill_gap ( diagfp2, fp, t ) ;
		    if ( diag_format == DIAG_XDB_NEW ) {
			fprintf ( diagfp2, "0,0,0,0,0," ) ;
		    } else {
			fprintf ( diagfp2, "0,0," ) ;
		    }
		    if ( *pnm ) {
			diag_string ( diagfp2, pnm ) ;
		    } else {
			diag_string ( diagfp2, "__unknown" ) ;
		    }
		    fprintf ( diagfp2, ",%ld,", off ) ;
		    out_posn ( diagfp2, p, 1 ) ;
		    fp = ftell ( diagfp2 ) ;
		    if ( diag_format == DIAG_XDB_NEW ) {
			fprintf ( diagfp2, "%s,0\n", NULL_POSN_STR ) ;
		    } else {
			fprintf ( diagfp2, "%s\n", NULL_POSN_STR ) ;
		    }
		}
	    }
	}
	a = son ( a ) ;
    }
    return ;
}


/*
    DIAGNOSTICS FOR A GLOBAL IDENTIFIER
*/

void diag_globl_variable
    PROTO_N ( ( dt, id, is_glob, val, has_def ) )
    PROTO_T ( diag_type dt X char *id X int is_glob X char *val X int has_def )
{
    if ( diag_format == DIAG_STAB ) {
	if ( is_glob ) {
	    char *st = analyse_stab_type ( dt, id, "G" ) ;
	    make_stabs ( st, 32, crt_line_num, null ) ;
	} else {
	    mach_op *op = make_extern_data ( val, 0 ) ;
	    char *st = analyse_stab_type ( dt, id, "S" ) ;
	    make_stabs ( st, 38, crt_line_num, op ) ;
	}
    } else {
	int loc ;
	FILE *file ;
	table_posn *x ;
	if ( diag_format == DIAG_XDB_NEW ) {
	    loc = ( is_glob ? 0 : 1 ) ;
	    file = ( is_glob ? diagfp3 : diagfp2 ) ;
	} else {
	    loc = 1 ;
	    file = diagfp2 ;
	}
	x = analyse_diag_type ( file, dt, loc ) ;
	( void ) out_dd ( file, xdb_svar, loc ) ;
	if ( diag_format == DIAG_XDB_NEW ) {
	    fprintf ( file, "%d,0,0,0,0,", is_glob ) ;
	} else {
	    fprintf ( file, "%d,0,", is_glob ) ;
	}
	diag_string ( file, id ) ;
	if ( has_def ) {
	    fprintf ( file, ",%s,", val ) ;
	} else {
	    fprintf ( file, ",-1," ) ;
	}
	out_posn ( file, x, 1 ) ;
	fprintf ( file, "0,0\n" ) ;
    }
    return ;
}


/*
    DIAGNOSTICS FOR A LOCAL IDENTIFIER
*/

void diag_local_variable
    PROTO_N ( ( dt, id, fp ) )
    PROTO_T ( diag_type dt X char *id X long fp )
{
    if ( diag_format == DIAG_STAB ) {
	mach_op *op = make_int_data ( -fp ) ;
	char *st = analyse_stab_type ( dt, id, "l" ) ;
	make_stabs ( st, 128, crt_line_num, op ) ;
    } else {
	table_posn *x = analyse_diag_type ( diagfp2, dt, 1 ) ;
	( void ) out_dd ( diagfp2, xdb_dvar, 1 ) ;
	if ( diag_format == DIAG_XDB_NEW ) {
	    fprintf ( diagfp2, "0,0,0,0," ) ;
	} else {
	    fprintf ( diagfp2, "0,0,0," ) ;
	}
	diag_string ( diagfp2, id ) ;
	fprintf ( diagfp2, ",%ld,", -fp ) ;
	if ( diag_format == DIAG_XDB_NEW ) {
	    out_posn ( diagfp2, x, 1 ) ;
	    fprintf ( diagfp2, "0\n" ) ;
	} else {
	    out_posn ( diagfp2, x, 0 ) ;
	}
    }
    return ;
}


/*
    DIAGNOSTICS FOR A TYPE DEFINITION
*/

void diag_type_defn
    PROTO_N ( ( nm, dt ) )
    PROTO_T ( char *nm X diag_type dt )
{
    switch ( dt->key ) {

	case DIAG_TYPE_UNINIT :
	case DIAG_TYPE_INITED : {
	    /* Ignore unused types */
	    break ;
	}

	default : {
	    if ( diag_format == DIAG_STAB ) {
		char *st = analyse_stab_type ( dt, nm, "t" ) ;
		make_stabs ( st, 128, L1, null ) ;
	    } else {
		int loc = ( diag_format == DIAG_XDB_NEW ? 0 : 1 ) ;
		FILE *file = ( loc ? diagfp2 : diagfp3 ) ;
		table_posn *p = analyse_diag_type ( file, dt, loc ) ;
		( void ) out_dd ( file, xdb_typedef, loc ) ;
		fprintf ( file, "0," ) ;
		diag_string ( file, nm ) ;
		fprintf ( file, "," ) ;
		out_posn ( file, p, 0 ) ;
	    }
	    break ;
	}
    }
    return ;
}
