Subversion Repositories tendra.SVN

/*

    		 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.

*/

/*

			    VERSION INFORMATION

			    ===================

--------------------------------------------------------------------------

$Header: /u/g/release/CVSROOT/Source/src/installers/sparc/common/translat.c,v 1.2 1998/03/11 11:04:00 pwe Exp $

--------------------------------------------------------------------------

$Log: translat.c,v $

 * Revision 1.2  1998/03/11  11:04:00  pwe

 * DWARF optimisation info

 *

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

 * First version to be checked into rolling release.

 *

 * Revision 1.27  1997/12/04  19:54:30  pwe

 * ANDF-DE V1.9

 *

 * Revision 1.26  1997/10/10  18:33:10  pwe

 * prep ANDF-DE revision

 *

 * Revision 1.25  1997/08/23  13:54:43  pwe

 * initial ANDF-DE

 *

 * Revision 1.24  1997/04/17  12:00:03  pwe

 * dwarf2 support

 *

 * Revision 1.23  1997/04/04  15:23:15  pwe

 * tidy re old DWARF interface

 *

 * Revision 1.22  1997/03/26  13:04:55  pwe

 * general proc compatibility

 *

 * Revision 1.21  1997/03/24  17:09:40  pwe

 * reorganise solaris/sunos split

 *

 * Revision 1.20  1997/02/18  11:48:36  pwe

 * NEWDIAGS for debugging optimised code

 *

 * Revision 1.19  1996/09/18  12:04:04  pwe

 * fixed PIC_code

 *

 * Revision 1.18  1996/08/27  14:09:18  pwe

 * ensure all varargs are stored, and ptr is not64bit

 *

 * Revision 1.17  1996/08/15  15:34:57  pwe

 * mod for PWE ownership

 *

 * Revision 1.16  1995/12/15  11:14:57  john

 * Change for dynamic initialisations on SunOS

 *

 * Revision 1.15  1995/11/14  14:25:05  john

 * Fix to dynamic initialisations

 *

 * Revision 1.14  1995/11/07  09:53:53  john

 * Change to register allocation for general procs

 *

 * Revision 1.13  1995/10/25  17:13:50  john

 * Fixed error in init segment

 *

 * Revision 1.12  1995/10/06  10:22:09  john

 * Changed optimisation level for general procs (SunOS only).

 *

 * Revision 1.11  1995/10/04  09:01:22  john

 * Added dynamic initialisation on Solaris

 *

 * Revision 1.10  1995/09/22  13:07:48  john

 * Change for new exception handling

 *

 * Revision 1.9  1995/09/13  11:01:44  john

 * compilation fixes

 *

 * Revision 1.8  1995/08/04  15:47:14  john

 * Minor change

 *

 * Revision 1.7  1995/07/17  16:46:16  john

 * Fixed error on SunOS

 *

 * Revision 1.6  1995/07/14  16:34:26  john

 * Changes for new spec

 *

 * Revision 1.5  1995/06/30  08:29:50  john

 * Changed size of callee area

 *

 * Revision 1.4  1995/06/14  15:36:38  john

 * Added support for trap error treatment & stack limits.  Also, some

 * reformatting.

 *

 * Revision 1.3  1995/05/26  13:02:20  john

 * Change for new spec

 *

 * Revision 1.2  1995/04/20  08:07:08  john

 * Moved source stabs record before initial text section

 *

 * Revision 1.1.1.1  1995/03/13  10:19:00  john

 * Entered into CVS

 *

 * Revision 1.4  1994/07/07  16:11:33  djch

 * Jul94 tape

 *

 * Revision 1.3  1994/07/04  08:31:36  djch

 * changes for new versioning info.

 *

 * Revision 1.2  1994/05/03  15:12:43  djch

 * removed extract.h and the inner procs stuff, now done in the common section

 *

 * Revision 1.11  94/02/21  16:13:59  16:13:59  ra (Robert Andrews)

 * Correct unit weight in weightsv.

 * 

 * Revision 1.10  93/09/27  14:57:41  14:57:41  ra (Robert Andrews)

 * Added support for weak linking.  Added support for DWARF diagnostic

 * routines.

 * 

 * Revision 1.9  93/08/27  11:40:10  11:40:10  ra (Robert Andrews)

 * A couple of lint-like changes.

 * 

 * Revision 1.8  93/08/18  11:17:49  11:17:49  ra (Robert Andrews)

 * Removed stray spaces from outs command.

 * 

 * Revision 1.7  93/08/13  14:48:20  14:48:20  ra (Robert Andrews)

 * Removed a comment.

 * 

 * Revision 1.6  93/07/12  15:20:32  15:20:32  ra (Robert Andrews)

 * The exit_translator routine now outputs any special_routines which

 * have been used but are not defined in the system libraries.

 * 

 * Revision 1.5  93/07/05  18:29:07  18:29:07  ra (Robert Andrews)

 * Made distinction between the System V assembler and the System V ABI.

 * Added support for PIC by setting avoid_L7 if necessary.

 * 

 * Revision 1.4  93/06/29  14:49:03  14:49:03  ra (Robert Andrews)

 * Messed up version control header.  Revision 1.2 was the important one.

 * It involved a minor reorganisation and reformat.  The routines

 * init_translator and exit_translator were introduced.

 * 

 * Revision 1.1  93/06/24  14:59:37  14:59:37  ra (Robert Andrews)

 * Initial revision

 * 

--------------------------------------------------------------------------

*/

#define SPARCTRANS_CODE

/*

 * Translation is controlled by translate () in this module.

 * Code generation follows the following phases :

 *

 * 1. The TDF is read in, applying bottom-up optimisations.

 * 2. Top-down optimisations are performed.

 * 3. Register allocation is performed, and TDF idents introduced

 * so code generation can be performed with no register spills.

 * 4. Code is generated for each procedure, and global declarations processed.

 * 5. Currently assembler source is generated directly, and the

 * assembler optimiser ( as -O ) used for delay slot filling,

 * instruction scheduling and peep-hole optimisation.

 *

 * In a little more detail :

 *

 * 1 ) During the TDF reading process for tag declarations and tag

 * definitions, applications of tokens are expanded as they are

 * encountered, using the token definitions. Every token used must have

 * been previously defined in the bitstream.

 *

 * The reading of the tag definitions creates a data structure in memory

 * which directly represents the TDF. At present, all the tag definitions

 * are read into memory in this way before any further translation is

 * performed. This will shortly be changed, so that translation is

 * performed in smaller units. The translator is set up already so that

 * the change to translate in units of single global definitions ( or

 * groups of these ) can easily be made.

 *

 * During the creation of the data structure bottom-up optimisations

 * are performed. These are the optimisations which can be done when a

 * complete sub-tree of TDF is present, and are independent of the context

 * in which the sub-tree is used. They are defined in check.c and

 * check_id.c. These optimisation do such things as use the commutative

 * and associative laws for plus to collect together and evaluate

 * constants. More ambitious examples of these bottom-up optimisations

 * include all constant evaluation, elimination of inaccessible code, and

 * forward propagation of assignments of constants.

 *

 * 2 ) After reading in the TDF various optimisations are performed which

 * cannot be done until the whole context is present. For example,

 * constants cannot be extracted from a loop when we just have the loop

 * itself, because we cannot tell whether the variables used in it are

 * aliased.

 *

 * These optimisations are invoked by opt_all_exps which is defined in

 * indep.c. They include extraction of constants from loops, common

 * expression elimination on them and strength reduction for indexing.

 *

 * 3 ) Allocatable registers are partitioned into two sets, the s regs

 * which are preserved over calls, and the t regs which are not.

 *

 * The TDF is scanned introducing TDF idents so that expressions can be

 * evaluated within the available t regs with no spills. These new idents

 * may be later allocated to a s reg later, if the weighting algorithm

 * ( below ) considers this worth while. Otherwise they will be on the stack.

 *

 * Information is collected to help in global register allocation. During

 * a forward recursive scan of the TDF the number of accesses to each

 * variable is computed ( making assumptions about the frequency of

 * execution of loops ) . Then on the return scan of this recursion, for

 * each declaration, the number of registers which must be free for it to

 * be worthwhile to use a register is computed, and put into the TDF as

 * the "break" point. The procedures to do this are defined in weights.c.

 *

 * Suitable idents not alive over a procedure call are allocated to a t reg,

 * and others to s regs. At the same time stack space requirements are

 * calculated, so this is known before code for a procedure is generated.

 *

 * 4 ) Finally the code is generated without register spills. The code is

 * generated by make_code () in makecode.c, and make_XXX_code () in proc.c.

 *

 * Note that procedure inlining and loop unrolling optimisations are not

 * currently implemented. Library procedures such as memcpy () and

 * strcpy () are not treated specially. Integer multiply, divide and

 * remainder use the standard support procedures .mul, .div, .rem and

 * unsigned variants.

 */

#include "config.h"

#include "common_types.h"

#include "myassert.h"

#include "flpt.h"

#include "expmacs.h"

#include "tags.h"

#include "exptypes.h"

#include "exp.h"

#include "shapemacs.h"

#include "tempdecs.h"

#include "weights.h"

#include "proctypes.h"

#include "procrec.h"

#include "regalloc.h"

#include "codehere.h"

#include "makecode.h"

#include "eval.h"

#include "toktypes.h"

#include "flags.h"

#include "basicread.h"

#include "tags.h"

#include "bitsmacs.h"

#include "needscan.h"

#include "getregs.h"

#include "regmacs.h"

#include "labels.h"

#include "xalloc.h"

#include "comment.h"

#include "sparcdiags.h"

#include "installglob.h"

#include "externs.h"

#include "out.h"

#include "translat.h"

#include "optimise.h"

#include "proc.h"

#include "special.h"

#include "target_v.h"

#include "locate.h"

#include "sparctrans.h"

#ifdef NEWDWARF

#include "dw2_iface.h"

#include "dw2_config.h"

#endif

extern bool know_size ;

char * proc_name;

#if ADDUNDERSCORE

#define isINITproc(id) (!strncmp("___I.TDF",id,8))

#else

#define isINITproc(id) (!strncmp("__I.TDF",id,7))

#endif /* ADDUNDERSCORE */

/*

  VARIABLES

*/

int sysV_abi ;		/* System V version? */

int sysV_assembler ;	/* System V version? */

int optim_level ;	/* optimisation level */

int g_reg_max ;		/* the maximum number of G registers */

int maxfix_tregs ;	/* the maximum number of T registers */

FILE *as_file = NULL ;	/* assembler output file */

dec **main_globals ;	/* global declarations */

procrec *procrecs ;	/* procedure records */

dec *diag_def = NULL ;	/* diagnostics definition */

int main_globals_index = 0;	/* number of globals */

int caller_offset_used = 0;

enum section current_section = no_section ;

/*

    FIND THE SIZE AND ALIGNMENT OF A SHAPE

*/

ash ashof 

    PROTO_N ( ( s ) )

    PROTO_T ( shape s ){

  ash a ;

  a.ashsize =  shape_size ( s ) ;

  a.ashalign = shape_align ( s ) ;

  return ( a ) ;

}

/*

  IS A SHAPE OF KNOWN SIZE?

*/

#define varsize( s )	1

/*

  OUTPUT A SECTION DIRECTIVE

*/

void insection 

    PROTO_N ( ( s ) )

    PROTO_T ( enum section s ){

  if (!sysV_assembler && s == rodata_section)

    s = data_section;

  if ( s == current_section ) return ;

  current_section = s ;

  if ( sysV_assembler ) {

    switch ( s ) {

      case data_section : {

	if (do_prom)

	  failer ("prom .data");

	outs ( "\t.section\t\".data\"\n" ) ;

	return ;

      }

      case text_section : {

	outs ( "\t.section\t\".text\"\n" ) ;

	return ;

      }

      case rodata_section : {

	outs ( "\t.section\t\".rodata\"\n" ) ;

	return ;

      }

      case init_section : {

	outs ("\t.section\t\".init\"\n");

	return;

      }

      default : {

	break ;

      }

    } 

  }

  else {

    switch ( s ) {

      case data_section : {

	outs ( "\t.seg\t\"data\"\n" ) ;

	return ;

      }

      case text_section : {

	outs ( "\t.seg\t\"text\"\n" ) ;

	return ;

      }

      default : {

	break ;

      }

    }

  }

  current_section = no_section ;

  fail ( "bad \".section\" name" ) ;

  return ;

}	

/*

  MARK AN EXPRESSION AS UNALIASED

*/

void mark_unaliased 

    PROTO_N ( ( e ) )

    PROTO_T ( exp e ){

  exp p = pt ( e ) ;

  bool ca = 1 ;

  assert ( !separate_units ) ;

  while ( p != nilexp && ca ) {

    exp q = bro ( p ) ;

    if ( q == nilexp ) {

#ifdef NEWDIAGS

      if (!isdiaginfo(p))

#endif

        ca = 0 ;

    } 

    else {

      if ( !( last ( p ) && name ( q ) == cont_tag ) &&

	   !( !last ( p ) && last ( q ) &&

	      name ( bro ( q ) ) == ass_tag ) ) {

#ifdef NEWDIAGS

        if (!isdiaginfo(p))

#endif

	  ca = 0 ;

      }

    }

    p = pt ( p ) ;

  }

  if ( ca ) setcaonly ( e ) ;

  return ;

}	

/*

  RENAMING ROUTINE

*/

void out_rename 

    PROTO_N ( ( oldid, newid ) )

    PROTO_T ( char * oldid X char * newid ){

#if 0

  outs ( "\t" ) ;

  outs ( oldid ) ;

  outs ( "=" ) ;

  outs ( newid ) ;

  outnl () ;

#endif

  return ;

}

/*

  LIST OF WEAK SYMBOLS

*/

weak_cell *weak_list = null ;

/*

  INITIALISE TRANSLATOR

*/

void init_translator 

    PROTO_Z (){

  /* initialise nowhere */

  setregalt ( nowhere.answhere, 0 ) ;

  nowhere.ashwhere.ashsize = 0 ;

  nowhere.ashwhere.ashsize = 0 ;

  /* mark the as output as TDF compiled */

  outs ( lab_prefix ) ;

  outs ( "TDF.translated:\n" ) ;

  outs ( "!\tTDF->SPARC, " ) ;

  outn ( target_version ) ;

  outs ( " , " ) ;

  outn ( target_revision ) ;

  if ( sysV_assembler ) outs ( " (SysV)" ) ;

  outnl () ;

  /* start diagnostics if necessary */

#ifdef NEWDWARF

  if (dwarf2)

    init_dwarf2 ();

  else

#endif

  if ( diagnose ) {

#if DWARF

    out_diagnose_prelude () ;

#else

    init_stab () ;

#endif

  }

    /* start in text section */

  insection ( text_section ) ;

  return ;

}

/*

  Return the tag with name 'tag_name'

*/

baseoff find_tag 

    PROTO_N ( ( tag_name ) )

    PROTO_T ( char * tag_name ){

  int i;

  for (i=0; i<main_globals_index; ++i){

    exp newtag = main_globals[i]->dec_u.dec_val.dec_exp;

    char * id = main_globals[i]->dec_u.dec_val.dec_id;

    if(!strcmp(id,tag_name)) return boff(newtag);

  }

  printf("%s\n: ",tag_name);

  fail("tag not declared");

  exit(1);

}

/*

  EXIT TRANSLATOR

*/

void exit_translator 

    PROTO_Z (){

  output_special_routines () ;

  insection ( text_section ) ;

#ifdef NEWDWARF

  if (dwarf2)

    end_dwarf2 ();

  else

#endif

  if ( diagnose ) {

#if DWARF

    out_diagnose_postlude () ;

#else

    /* do nothing */

#endif

  }

  return ;

}

/*

  TRANSLATE AN ENTIRE TDF CAPSULE

*/

void translate_capsule 

    PROTO_Z (){

  int i ;

  int r ;

  dec *d ;

  int procno ;

  int noprocs ;

  space tempregs ;

  /* initialize diagnostics */

#ifdef NEWDWARF

  if ( diagnose && !dwarf2 ) {

#else

  if ( diagnose ) {

#endif

#if DWARF

    /* do nothing */

#else

    init_stab_aux () ;

#endif

  }

  /* apply all optimisations */

#ifdef NEWDIAGS

  if ( !diag_visible ) opt_all_exps () ;

#else

  if ( !diagnose ) opt_all_exps () ;

#endif

  /* mark all statics as unaliased and count procedures */

  noprocs = 0 ;

  for ( d = top_def ; d != null ; d = d->def_next ) {

    exp c = d->dec_u.dec_val.dec_exp ;

    if ( son ( c ) != nilexp ) {

#ifdef NEWDIAGS

      if ( !diag_visible && !separate_units && !d->dec_u.dec_val.extnamed

#else

      if ( !diagnose && !separate_units && !d->dec_u.dec_val.extnamed

#endif

	   && isvar ( c ) ) {

	mark_unaliased ( c ) ;

      }

      if ( name ( son ( c ) ) == proc_tag || 

	   name(son(c))==general_proc_tag) noprocs++ ;

    }	

  }	

#ifdef NEWDWARF

  if (dwarf2) {

    dwarf2_prelude ();

  }

#endif

  /* output weak symbols */

  while ( weak_list ) {

    outs ( "\t" ) ;

    outs ( weak_list->weak_id ) ;

    outs ( "=" ) ;

    outs ( weak_list->val_id ) ;

    outnl () ;

    weak_list = weak_list->next ;

  }

  /* allocate memory for procedures */

  procrecs = ( procrec * ) xcalloc ( noprocs, sizeof ( procrec ) ) ;

  /* number procedure definitions */

  procno = 0 ;

  for ( d = top_def ; d != null ; d = d->def_next ) {

    exp c = d->dec_u.dec_val.dec_exp ;

    exp s = son ( c ) ;

    if ( s != nilexp && (name ( s ) == proc_tag || 

			 name(s) == general_proc_tag)) {

      procrec *pr = &procrecs [ procno ] ;

      pr->nameproc = bro ( c ) ;

      no ( s ) = procno++ ;

    }

  }

    /*

      Scan to put everything in SPARC form, and calculate register 

      and stack space needs.  First work out which t fixed point 

      registers	(those not preserved over calls) can be used.  This 

      needs to be done before scan () which adds identities so that 

      temporary	register needs are within the available temporary 

      register set.  We dynamically calculate g registers we can use

      as temporaries so	that we can support :

	    SUNOS 4 : %g1..%g7 can be used,

	    SYSV SPARC ABI : %g1..%g4 can be used.

    */

    /* initialise register sets */

  tempregs.fixed = PROC_TREGS ;

  tempregs.flt = PROC_FLT_TREGS ;

  /*permit use of valid g registers(%g0 is not a proper register)*/

  /* ensure R_TMP not allocatable */

  /* scan all the procedures, to put everything in SPARC operand form */

  for ( d = top_def ; d != null ; d = d->def_next ) {

    exp c = d->dec_u.dec_val.dec_exp ;

    exp s = son ( c ) ;

    if ( s != nilexp && (name ( s ) == proc_tag ||

			 name(s) == general_proc_tag)) {

      exp *st = &s ;

      procrec *pr = &procrecs [ no ( s ) ] ;

      if (d->dec_u.dec_val.extnamed && isINITproc(d->dec_u.dec_val.dec_id))

	set_proc_uses_external (s);    /* for PIC_code, should be done in install_fns? */

      Has_vcallees = (name(s) == general_proc_tag) && 

	proc_has_vcallees(s);

      for (r=R_G1; r <= R_G0 + g_reg_max ; r++ ) {

	tempregs.fixed &= ~RMASK ( r ) ;

      }

      tempregs.fixed |= RMASK ( R_TMP ) ;

      /* count the number of fixed t registers */

      maxfix_tregs = 0 ;

      for ( r = R_FIRST ; r <= R_LAST ; r++ ) {

	if ( IS_TREG ( r ) && ( tempregs.fixed & RMASK ( r ) ) == 0 ) {

	  maxfix_tregs++ ;

	}

      }

      if (name(s) == general_proc_tag) {

	int any_envoff = 0;

	exp a = son (s);

	while (name(a) == ident_tag && isparam(a) && name(son(a)) != formal_callee_tag) {

	  if (isenvoff(a) && caller_offset_used)

	    any_envoff = 1;

	  else if (any_envoff) {

	    setvis(a);

	    setenvoff(a);

	  }

	  a = bro(son(a));

	}

#ifdef GENCOMPAT

	if ((name(a) == ident_tag && isparam(a)) || Has_vcallees) {

	  set_proc_may_have_callees(s);

	}

#endif

      }	

      pr->needsproc = scan ( st, &st ) ;

      pr->needsproc.callee_size = (callee_size+63)&~63;

    }

  }

#if 0

    /* apply dead variable analysis (not currently implemented) */

  if ( do_deadvars ) {

    init_dead () ;

    dead_flag = 0 ;

    for ( d = top_def ; d != null ; d = d->def_next ) {

      exp c = d->dec_u.dec_val.dec_exp ;

      exp s = son ( c ) ;

      if ( s != nilexp && (name ( s ) == proc_tag || 

			   name(s) == general_proc_tag)){

	deadvar ( s ) ;

      }

    }

  }

#endif

  /* calculate the break points for register allocation */

  for ( d = top_def ; d != null ; d = d->def_next ) {

    exp c = d->dec_u.dec_val.dec_exp ;

    exp s = son ( c ) ;

    if ( s != nilexp && (name ( s ) == proc_tag || 

			 name(s) == general_proc_tag)) {

      weights w ;	

      spacereq forrest ;

      int freefixed, freefloat ;

      procrec *pr = &procrecs [ no ( s ) ] ;

      avoid_L7 = ( bool )( PIC_code && proc_uses_external ( s ) ) ;

      Has_vcallees = (name(s) == general_proc_tag) && 

	proc_has_vcallees(s);

      in_general_proc = (name(s) == general_proc_tag);

#ifdef GENCOMPAT

      May_have_callees = proc_may_have_callees(s);

#endif

      /* calculate number of free registers */

      freefixed = ( R_L7 - R_L0 + 1 ) + ( R_I5 - R_I0 + 1 ) ;

      freefloat = 0 ;

      if ( avoid_L7 ) freefixed-- ;

#ifdef GENCOMPAT

      if (May_have_callees) freefixed--;

#else

      if(in_general_proc) freefixed--;

#endif

      if(Has_vcallees) freefixed --;

      /* estimate tag usage */

      w = weightsv ( 1.0, bro ( son ( s ) ) ) ;

      /* calculate register and stack allocation for tags */

      forrest = regalloc ( bro ( son ( s ) ), freefixed, freefloat, 0 ) ;

      pr->spacereqproc = forrest ;

    }

  }

  /* set up main_globals */

  i = 0 ;

  for ( d = top_def ; d != null ; d = d->def_next ) i++ ;

  main_globals_index = i;

  if ( i ) main_globals = ( dec ** ) xcalloc ( i, sizeof ( dec * ) ) ;

  i = 0 ;

  for ( d = top_def ; d != null ; d = d->def_next ) {

    main_globals [i] = d ;

    main_globals [i]->dec_u.dec_val.sym_number = i ;

    i++ ;

  }

  /* output global definitions */

  for ( d = top_def ; d != null ; d = d->def_next ) {

    exp tg = d->dec_u.dec_val.dec_exp ;

    exp stg = son ( tg ) ;

    char *id = d->dec_u.dec_val.dec_id ;

    bool extnamed = ( bool ) d->dec_u.dec_val.extnamed ;

    if ( stg != nilexp && (extnamed || no(tg)!= 0 ||

	 !strcmp(id,TDF_HANDLER) || !strcmp(id,TDF_STACKLIM))) {

      if ( extnamed ) {

	assert ( id [ 0 ] != '$' ) ;

	if ( name ( stg ) != proc_tag && name(stg)!=general_proc_tag) {

	  if (!isvar (tg) || (d -> dec_u.dec_val.acc & f_constant) || do_prom) 

	    insection ( rodata_section ) ;

	  else

	    insection ( data_section ) ;

	} 

	else if (isINITproc(id) && sysV_assembler) {

	  /* On solaris, this is easy.  Insert a call to the procedure

	     into the init segment */

	  insection (init_section);

	  fprintf(as_file,"\tcall %s\n",id);

	  outs("\tnop\n");

	  insection (text_section);

	}

	else{

	  insection ( text_section ) ;

	}

	outs ( "\t.global\t" ) ;

	outs ( id ) ;

	outnl () ;

      }

      if ( name ( stg ) != proc_tag && name(stg)!=general_proc_tag) {

	  /* evaluate all outer level constants */

	instore is ;

	long symdef = d->dec_u.dec_val.sym_number + 1 ;

	diag_global *diag_props = d->dec_u.dec_val.diag_info ;

	if ( isvar ( tg ) ) symdef = -symdef ;

	if ( diag_props ) {

	  DIAG_VAL_BEGIN ( diag_props, extnamed, symdef, id, stg ) ;

	}

	is = evaluated ( stg, symdef, 

		(!isvar (tg) || (d -> dec_u.dec_val.acc & f_constant)) ) ;

	if ( diag_props ) {

	  DIAG_VAL_END ( diag_props ) ;

	}

	if ( is.adval ) setvar ( tg ) ;

	if ( sysV_assembler ) {

	  outs ( "\t.type\t" ) ;

	  outs ( id ) ;

	  outs ( ",#object\n" ) ;

	  if ( !know_size ) {

	    outs ( "\t.size\t" ) ;

	    outs ( id ) ;

	    outs ( "," ) ;

	    outn ( shape_size ( sh ( stg ) ) / 8 ) ;

	    outnl () ;

	  }

	}

      }

    }

  }	

    /* translate procedures */

  for ( d = top_def ; d != null ; d = d->def_next ) {

    exp tg = d->dec_u.dec_val.dec_exp ;

    exp stg = son ( tg ) ;

    char *id = d->dec_u.dec_val.dec_id ;

    bool extnamed = ( bool ) d->dec_u.dec_val.extnamed ;

    if ( stg != nilexp && shape_size (sh(stg)) == 0 && name(stg) == asm_tag) {