gas/config/obj-vms.c

   1 /* vms.c -- Write out a VAX/VMS object file
   2    Copyright 1987, 1988, 1992, 1993, 1994, 1995, 1997, 1998, 2000, 2001
   3    Free Software Foundation, Inc.
   4
   5 This file is part of GAS, the GNU Assembler.
   6
   7 GAS is free software; you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation; either version 2, or (at your option)
  10 any later version.
  11
  12 GAS is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with GAS; see the file COPYING.  If not, write to the Free
  19 Software Foundation, 59 Temple Place - Suite 330, Boston, MA
  20 02111-1307, USA.  */
  21
  22 /* Written by David L. Kashtan */
  23 /* Modified by Eric Youngdale to write VMS debug records for program
  24    variables */
  25
  26 /* Want all of obj-vms.h (as obj-format.h, via targ-env.h, via as.h).  */
  27 #define WANT_VMS_OBJ_DEFS
  28
  29 #include "as.h"
  30 #include "config.h"
  31 #include "safe-ctype.h"
  32 #include "subsegs.h"
  33 #include "obstack.h"
  34
  35 /* What we do if there is a goof.  */
  36 #define error as_fatal
  37
  38 #ifdef VMS                      /* These are of no use if we are cross assembling.  */
  39 #include <fab.h>                /* Define File Access Block       */
  40 #include <nam.h>                /* Define NAM Block               */
  41 #include <xab.h>                /* Define XAB - all different types*/
  42 extern int sys$open(), sys$close(), sys$asctim();
  43 #endif
  44
  45 /*
  46  *      Version string of the compiler that produced the code we are
  47  *      assembling.  (And this assembler, if we do not have compiler info.)
  48  */
  49 char *compiler_version_string;
  50
  51 extern int flag_hash_long_names;        /* -+ */
  52 extern int flag_one;                    /* -1; compatibility with gcc 1.x */
  53 extern int flag_show_after_trunc;       /* -H */
  54 extern int flag_no_hash_mixed_case;     /* -h NUM */
  55
  56 /* Flag that determines how we map names.  This takes several values, and
  57  * is set with the -h switch.  A value of zero implies names should be
  58  * upper case, and the presence of the -h switch inhibits the case hack.
  59  * No -h switch at all sets vms_name_mapping to 0, and allows case hacking.
  60  * A value of 2 (set with -h2) implies names should be
  61  * all lower case, with no case hack.  A value of 3 (set with -h3) implies
  62  * that case should be preserved.  */
  63
  64 /* If the -+ switch is given, then the hash is appended to any name that is
  65  * longer than 31 characters, regardless of the setting of the -h switch.
  66  */
  67
  68 char vms_name_mapping = 0;
  69
  70 static symbolS *Entry_Point_Symbol = 0; /* Pointer to "_main" */
  71
  72 /*
  73  *      We augment the "gas" symbol structure with this
  74  */
  75 struct VMS_Symbol
  76 {
  77   struct VMS_Symbol *Next;
  78   symbolS *Symbol;
  79   int Size;
  80   int Psect_Index;
  81   int Psect_Offset;
  82 };
  83
  84 struct VMS_Symbol *VMS_Symbols = 0;
  85 struct VMS_Symbol *Ctors_Symbols = 0;
  86 struct VMS_Symbol *Dtors_Symbols = 0;
  87
  88 /* We need this to keep track of the various input files, so that we can
  89  * give the debugger the correct source line.
  90  */
  91
  92 struct input_file
  93 {
  94   struct input_file *next;
  95   struct input_file *same_file_fpnt;
  96   int file_number;
  97   int max_line;
  98   int min_line;
  99   int offset;
 100   char flag;
 101   char *name;
 102   symbolS *spnt;
 103 };
 104
 105 static struct input_file *file_root = (struct input_file *) NULL;
 106
 107 /*
 108  * Styles of PSECTS (program sections) that we generate; just shorthand
 109  * to avoid lists of section attributes.  Used by VMS_Psect_Spec().
 110  */
 111 enum ps_type
 112 {
 113   ps_TEXT, ps_DATA, ps_COMMON, ps_CONST, ps_CTORS, ps_DTORS
 114 };
 115
 116 /*
 117  * This enum is used to keep track of the various types of variables that
 118  * may be present.
 119  */
 120
 121 enum advanced_type
 122 {
 123   BASIC, POINTER, ARRAY, ENUM, STRUCT, UNION, FUNCTION, VOID, ALIAS, UNKNOWN
 124 };
 125
 126 /*
 127  * This structure contains the information from the stabs directives, and the
 128  * information is filled in by VMS_typedef_parse.  Everything that is needed
 129  * to generate the debugging record for a given symbol is present here.
 130  * This could be done more efficiently, using nested struct/unions, but for now
 131  * I am happy that it works.
 132  */
 133 struct VMS_DBG_Symbol
 134 {
 135   struct VMS_DBG_Symbol *next;
 136   /* description of what this is */
 137   enum advanced_type advanced;
 138   /* this record is for this type */
 139   int dbx_type;
 140   /* For advanced types this is the type referred to.  I.e., the type
 141      a pointer points to, or the type of object that makes up an
 142      array.  */
 143   int type2;
 144   /* Use this type when generating a variable def */
 145   int VMS_type;
 146   /* used for arrays - this will be present for all */
 147   int index_min;
 148   /* entries, but will be meaningless for non-arrays */
 149   int index_max;
 150   /* Size in bytes of the data type.  For an array, this is the size
 151      of one element in the array */
 152   int data_size;
 153   /* Number of the structure/union/enum - used for ref */
 154   int struc_numb;
 155 };
 156
 157 #define SYMTYPLST_SIZE (1<<4)   /* 16; must be power of two */
 158 #define SYMTYP_HASH(x) ((unsigned) (x) & (SYMTYPLST_SIZE-1))
 159 struct VMS_DBG_Symbol *VMS_Symbol_type_list[SYMTYPLST_SIZE];
 160
 161 /*
 162  * We need this structure to keep track of forward references to
 163  * struct/union/enum that have not been defined yet.  When they are ultimately
 164  * defined, then we can go back and generate the TIR commands to make a back
 165  * reference.
 166  */
 167
 168 struct forward_ref
 169 {
 170   struct forward_ref *next;
 171   int dbx_type;
 172   int struc_numb;
 173   char resolved;
 174 };
 175
 176 struct forward_ref *f_ref_root = (struct forward_ref *) NULL;
 177
 178 /*
 179  * This routine is used to compare the names of certain types to various
 180  * fixed types that are known by the debugger.
 181  */
 182 #define type_check(X)  !strcmp (symbol_name, X)
 183
 184 /*
 185  * This variable is used to keep track of the name of the symbol we are
 186  * working on while we are parsing the stabs directives.
 187  */
 188 static const char *symbol_name;
 189
 190 /* We use this counter to assign numbers to all of the structures, unions
 191  * and enums that we define.  When we actually declare a variable to the
 192  * debugger, we can simply do it by number, rather than describing the
 193  * whole thing each time.
 194  */
 195
 196 static structure_count = 0;
 197
 198 /* This variable is used to indicate that we are making the last attempt to
 199    parse the stabs, and that we should define as much as we can, and ignore
 200    the rest */
 201
 202 static int final_pass;
 203
 204 /* This variable is used to keep track of the current structure number
 205  * for a given variable.  If this is < 0, that means that the structure
 206  * has not yet been defined to the debugger.  This is still cool, since
 207  * the VMS object language has ways of fixing things up after the fact,
 208  * so we just make a note of this, and generate fixups at the end.
 209  */
 210 static int struct_number;
 211
 212 /* This is used to distinguish between D_float and G_float for telling
 213    the debugger about doubles.  gcc outputs the same .stabs regardless
 214    of whether -mg is used to select alternate doubles.  */
 215
 216 static int vax_g_doubles = 0;
 217
 218 /* Local symbol references (used to handle N_ABS symbols; gcc does not
 219    generate those, but they're possible with hand-coded assembler input)
 220    are always made relative to some particular environment.  If the current
 221    input has any such symbols, then we expect this to get incremented
 222    exactly once and end up having all of them be in environment #0.  */
 223
 224 static int Current_Environment = -1;
 225
 226 /* Every object file must specify an module name, which is also used by
 227    traceback records.  Set in Write_VMS_MHD_Records().  */
 228
 229 static char Module_Name[255+1];
 230
 231 /*
 232  * Variable descriptors are used tell the debugger the data types of certain
 233  * more complicated variables (basically anything involving a structure,
 234  * union, enum, array or pointer).  Some non-pointer variables of the
 235  * basic types that the debugger knows about do not require a variable
 236  * descriptor.
 237  *
 238  * Since it is impossible to have a variable descriptor longer than 128
 239  * bytes by virtue of the way that the VMS object language is set up,
 240  * it makes not sense to make the arrays any longer than this, or worrying
 241  * about dynamic sizing of the array.
 242  *
 243  * These are the arrays and counters that we use to build a variable
 244  * descriptor.
 245  */
 246
 247 #define MAX_DEBUG_RECORD 128
 248 static char Local[MAX_DEBUG_RECORD];    /* buffer for variable descriptor */
 249 static char Asuffix[MAX_DEBUG_RECORD];  /* buffer for array descriptor */
 250 static int Lpnt;                /* index into Local */
 251 static int Apoint;              /* index into Asuffix */
 252 static char overflow;           /* flag to indicate we have written too much*/
 253 static int total_len;           /* used to calculate the total length of variable
 254                                 descriptor plus array descriptor - used for len byte*/
 255
 256 /* Flag if we have told user about finding global constants in the text
 257    section.  */
 258 static int gave_compiler_message = 0;
 259
 260 /*
 261  *      Global data (Object records limited to 512 bytes by VAX-11 "C" runtime)
 262  */
 263 static int VMS_Object_File_FD;  /* File Descriptor for object file */
 264 static char Object_Record_Buffer[512];  /* Buffer for object file records  */
 265 static int Object_Record_Offset;/* Offset to end of data           */
 266 static int Current_Object_Record_Type;  /* Type of record in above         */
 267
 268 /*
 269  *      Macros for moving data around.  Must work on big-endian systems.
 270  */
 271 #ifdef VMS  /* These are more efficient for VMS->VMS systems */
 272 #define COPY_LONG(dest,val)     ( *(long *) (dest) = (val) )
 273 #define COPY_SHORT(dest,val)    ( *(short *) (dest) = (val) )
 274 #else
 275 #define COPY_LONG(dest,val)     md_number_to_chars ((dest), (val), 4)
 276 #define COPY_SHORT(dest,val)    md_number_to_chars ((dest), (val), 2)
 277 #endif
 278 /*
 279  *      Macros for placing data into the object record buffer.
 280  */
 281 #define PUT_LONG(val) \
 282         ( COPY_LONG (&Object_Record_Buffer[Object_Record_Offset], (val)), \
 283           Object_Record_Offset += 4 )
 284
 285 #define PUT_SHORT(val) \
 286         ( COPY_SHORT (&Object_Record_Buffer[Object_Record_Offset], (val)), \
 287           Object_Record_Offset += 2 )
 288
 289 #define PUT_CHAR(val) ( Object_Record_Buffer[Object_Record_Offset++] = (val) )
 290
 291 #define PUT_COUNTED_STRING(cp) do { \
 292                         register const char *p = (cp); \
 293                         PUT_CHAR ((char) strlen (p)); \
 294                         while (*p) PUT_CHAR (*p++); } while (0)
 295
 296 /*
 297  *      Macro for determining if a Name has psect attributes attached
 298  *      to it.
 299  */
 300 #define PSECT_ATTRIBUTES_STRING         "$$PsectAttributes_"
 301 #define PSECT_ATTRIBUTES_STRING_LENGTH  18
 302
 303 #define HAS_PSECT_ATTRIBUTES(Name) \
 304                 (strncmp ((*Name == '_' ? Name + 1 : Name), \
 305                           PSECT_ATTRIBUTES_STRING, \
 306                           PSECT_ATTRIBUTES_STRING_LENGTH) == 0)
 307 \f
 308
 309  /* in: segT   out: N_TYPE bits */
 310 const short seg_N_TYPE[] =
 311 {
 312   N_ABS,
 313   N_TEXT,
 314   N_DATA,
 315   N_BSS,
 316   N_UNDF,                       /* unknown */
 317   N_UNDF,                       /* error */
 318   N_UNDF,                       /* expression */
 319   N_UNDF,                       /* debug */
 320   N_UNDF,                       /* ntv */
 321   N_UNDF,                       /* ptv */
 322   N_REGISTER,                   /* register */
 323 };
 324
 325 const segT N_TYPE_seg[N_TYPE + 2] =
 326 {                               /* N_TYPE == 0x1E = 32-2 */
 327   SEG_UNKNOWN,                  /* N_UNDF == 0 */
 328   SEG_GOOF,
 329   SEG_ABSOLUTE,                 /* N_ABS == 2 */
 330   SEG_GOOF,
 331   SEG_TEXT,                     /* N_TEXT == 4 */
 332   SEG_GOOF,
 333   SEG_DATA,                     /* N_DATA == 6 */
 334   SEG_GOOF,
 335   SEG_BSS,                      /* N_BSS == 8 */
 336   SEG_GOOF,
 337   SEG_GOOF, SEG_GOOF, SEG_GOOF, SEG_GOOF, SEG_GOOF, SEG_GOOF, SEG_GOOF, SEG_GOOF,
 338   SEG_GOOF, SEG_GOOF, SEG_GOOF, SEG_GOOF, SEG_GOOF, SEG_GOOF, SEG_GOOF, SEG_GOOF,
 339   SEG_GOOF, SEG_GOOF, SEG_GOOF, SEG_GOOF,
 340   SEG_REGISTER,                 /* dummy N_REGISTER for regs = 30 */
 341   SEG_GOOF,
 342 };
 343 \f
 344
 345 /* Local support routines which return a value.  */
 346
 347 static struct input_file *find_file PARAMS ((symbolS *));
 348 static struct VMS_DBG_Symbol *find_symbol PARAMS ((int));
 349 static symbolS *Define_Routine PARAMS ((symbolS *,int,symbolS *,int));
 350
 351 static char *cvt_integer PARAMS ((char *,int *));
 352 static char *fix_name PARAMS ((char *));
 353 static char *get_struct_name PARAMS ((char *));
 354
 355 static offsetT VMS_Initialized_Data_Size PARAMS ((symbolS *,unsigned));
 356
 357 static int VMS_TBT_Source_File PARAMS ((char *,int));
 358 static int gen1 PARAMS ((struct VMS_DBG_Symbol *,int));
 359 static int forward_reference PARAMS ((char *));
 360 static int final_forward_reference PARAMS ((struct VMS_DBG_Symbol *));
 361 static int VMS_typedef_parse PARAMS ((char *));
 362 static int hash_string PARAMS ((const char *));
 363 static int VMS_Psect_Spec PARAMS ((const char *,int,enum ps_type,
 364                                    struct VMS_Symbol *));
 365
 366 /* Local support routines which don't directly return any value.  */
 367
 368 static void s_const PARAMS ((int));
 369 static void Create_VMS_Object_File PARAMS ((void));
 370 static void Flush_VMS_Object_Record_Buffer PARAMS ((void));
 371 static void Set_VMS_Object_File_Record PARAMS ((int));
 372 static void Close_VMS_Object_File PARAMS ((void));
 373 static void vms_tir_stack_psect PARAMS ((int,int,int));
 374 static void VMS_Store_Immediate_Data PARAMS ((const char *,int,int));
 375 static void VMS_Set_Data PARAMS ((int,int,int,int));
 376 static void VMS_Store_Struct PARAMS ((int));
 377 static void VMS_Def_Struct PARAMS ((int));
 378 static void VMS_Set_Struct PARAMS ((int));
 379 static void VMS_TBT_Module_Begin PARAMS ((void));
 380 static void VMS_TBT_Module_End PARAMS ((void));
 381 static void VMS_TBT_Routine_Begin PARAMS ((symbolS *,int));
 382 static void VMS_TBT_Routine_End PARAMS ((int,symbolS *));
 383 static void VMS_TBT_Block_Begin PARAMS ((symbolS *,int,char *));
 384 static void VMS_TBT_Block_End PARAMS ((valueT));
 385 static void VMS_TBT_Line_PC_Correlation PARAMS ((int,int,int,int));
 386 static void VMS_TBT_Source_Lines PARAMS ((int,int,int));
 387 static void fpush PARAMS ((int,int));
 388 static void rpush PARAMS ((int,int));
 389 static void array_suffix PARAMS ((struct VMS_DBG_Symbol *));
 390 static void new_forward_ref PARAMS ((int));
 391 static void generate_suffix PARAMS ((struct VMS_DBG_Symbol *,int));
 392 static void bitfield_suffix PARAMS ((struct VMS_DBG_Symbol *,int));
 393 static void setup_basic_type PARAMS ((struct VMS_DBG_Symbol *));
 394 static void VMS_DBG_record PARAMS ((struct VMS_DBG_Symbol *,int,int,char *));
 395 static void VMS_local_stab_Parse PARAMS ((symbolS *));
 396 static void VMS_stab_parse PARAMS ((symbolS *,int,int,int,int));
 397 static void VMS_GSYM_Parse PARAMS ((symbolS *,int));
 398 static void VMS_LCSYM_Parse PARAMS ((symbolS *,int));
 399 static void VMS_STSYM_Parse PARAMS ((symbolS *,int));
 400 static void VMS_RSYM_Parse PARAMS ((symbolS *,symbolS *,int));
 401 static void VMS_LSYM_Parse PARAMS ((void));
 402 static void Define_Local_Symbols PARAMS ((symbolS *,symbolS *,symbolS *,int));
 403 static void Write_VMS_MHD_Records PARAMS ((void));
 404 static void Write_VMS_EOM_Record PARAMS ((int,valueT));
 405 static void VMS_Case_Hack_Symbol PARAMS ((const char *,char *));
 406 static void VMS_Modify_Psect_Attributes PARAMS ((const char *,int *));
 407 static void VMS_Global_Symbol_Spec PARAMS ((const char *,int,int,int));
 408 static void VMS_Local_Environment_Setup PARAMS ((const char *));
 409 static void VMS_Emit_Globalvalues PARAMS ((unsigned,unsigned,char *));
 410 static void VMS_Procedure_Entry_Pt PARAMS ((char *,int,int,int));
 411 static void VMS_Set_Psect PARAMS ((int,int,int));
 412 static void VMS_Store_Repeated_Data PARAMS ((int,char *,int,int));
 413 static void VMS_Store_PIC_Symbol_Reference PARAMS ((symbolS *,int,
 414                                                     int,int,int,int));
 415 static void VMS_Fix_Indirect_Reference PARAMS ((int,int,fragS *,fragS *));
 416
 417 /* Support code which used to be inline within vms_write_object_file.  */
 418 static void vms_fixup_text_section PARAMS ((unsigned,struct frag *,struct frag *));
 419 static void synthesize_data_segment PARAMS ((unsigned,unsigned,struct frag *));
 420 static void vms_fixup_data_section PARAMS ((unsigned,unsigned));
 421 static void global_symbol_directory PARAMS ((unsigned,unsigned));
 422 static void local_symbols_DST PARAMS ((symbolS *,symbolS *));
 423 static void vms_build_DST PARAMS ((unsigned));
 424 static void vms_fixup_xtors_section PARAMS ((struct VMS_Symbol *, int));
 425 \f
 426
 427 /* The following code defines the special types of pseudo-ops that we
 428    use with VMS.  */
 429
 430 unsigned char const_flag = IN_DEFAULT_SECTION;
 431
 432 static void
 433 s_const (arg)
 434      int arg;   /* 3rd field from obj_pseudo_table[]; not needed here */
 435 {
 436   /* Since we don't need `arg', use it as our scratch variable so that
 437      we won't get any "not used" warnings about it.  */
 438   arg = get_absolute_expression ();
 439   subseg_set (SEG_DATA, (subsegT) arg);
 440   const_flag = 1;
 441   demand_empty_rest_of_line ();
 442 }
 443
 444 const pseudo_typeS obj_pseudo_table[] =
 445 {
 446   {"const", s_const, 0},
 447   {0, 0, 0},
 448 };                              /* obj_pseudo_table */
 449
 450 /* Routine to perform RESOLVE_SYMBOL_REDEFINITION().  */
 451
 452 int
 453 vms_resolve_symbol_redef (sym)
 454      symbolS *sym;
 455 {
 456   /*
 457    *    If the new symbol is .comm AND it has a size of zero,
 458    *    we ignore it (i.e. the old symbol overrides it)
 459    */
 460   if (SEGMENT_TO_SYMBOL_TYPE ((int) now_seg) == (N_UNDF | N_EXT)
 461       && frag_now_fix () == 0)
 462     {
 463       as_warn (_("compiler emitted zero-size common symbol `%s' already defined"),
 464                S_GET_NAME (sym));
 465       return 1;
 466     }
 467   /*
 468    *    If the old symbol is .comm and it has a size of zero,
 469    *    we override it with the new symbol value.
 470    */
 471   if (S_IS_EXTERNAL (sym) && S_IS_DEFINED (sym) && S_GET_VALUE (sym) == 0)
 472     {
 473       as_warn (_("compiler redefined zero-size common symbol `%s'"),
 474                S_GET_NAME (sym));
 475       sym->sy_frag  = frag_now;
 476       S_SET_OTHER (sym, const_flag);
 477       S_SET_VALUE (sym, frag_now_fix ());
 478       /* Keep N_EXT bit.  */
 479       sym->sy_symbol.n_type |= SEGMENT_TO_SYMBOL_TYPE ((int) now_seg);
 480       return 1;
 481     }
 482
 483   return 0;
 484 }
 485
 486 /* `tc_frob_label' handler for colon(symbols.c), used to examine the
 487    dummy label(s) gcc inserts at the beginning of each file it generates.
 488    gcc 1.x put "gcc_compiled."; gcc 2.x (as of 2.7) puts "gcc2_compiled."
 489    and "__gnu_language_<name>" and possibly "__vax_<type>_doubles".  */
 490
 491 void
 492 vms_check_for_special_label (symbolP)
 493 symbolS *symbolP;
 494 {
 495   /* Special labels only occur prior to explicit section directives.  */
 496   if ((const_flag & IN_DEFAULT_SECTION) != 0)
 497     {
 498       char *sym_name = S_GET_NAME (symbolP);
 499
 500       if (*sym_name == '_')
 501         ++sym_name;
 502
 503       if (!strcmp (sym_name, "__vax_g_doubles"))
 504         vax_g_doubles = 1;
 505 #if 0   /* not necessary */
 506       else if (!strcmp (sym_name, "__vax_d_doubles"))
 507         vax_g_doubles = 0;
 508 #endif
 509 #if 0   /* these are potential alternatives to tc-vax.c's md_parse_options() */
 510       else if (!strcmp (sym_name, "gcc_compiled."))
 511         flag_one = 1;
 512       else if (!strcmp (sym_name, "__gnu_language_cplusplus"))
 513         flag_hash_long_names = 1;
 514 #endif
 515     }
 516   return;
 517 }
 518
 519 void
 520 obj_read_begin_hook ()
 521 {
 522   return;
 523 }
 524
 525 void
 526 obj_crawl_symbol_chain (headers)
 527      object_headers *headers;
 528 {
 529   symbolS *symbolP;
 530   symbolS **symbolPP;
 531   int symbol_number = 0;
 532
 533   symbolPP = &symbol_rootP;     /* -> last symbol chain link.  */
 534   while ((symbolP = *symbolPP) != NULL)
 535     {
 536       resolve_symbol_value (symbolP);
 537
 538      /* OK, here is how we decide which symbols go out into the
 539         brave new symtab.  Symbols that do are:
 540
 541         * symbols with no name (stabd's?)
 542         * symbols with debug info in their N_TYPE
 543         * symbols with \1 as their 3rd character (numeric labels)
 544         * "local labels" needed for PIC fixups
 545
 546         Symbols that don't are:
 547         * symbols that are registers
 548
 549         All other symbols are output.  We complain if a deleted
 550         symbol was marked external.  */
 551
 552       if (!S_IS_REGISTER (symbolP))
 553         {
 554           symbolP->sy_number = symbol_number++;
 555           symbolP->sy_name_offset = 0;
 556           symbolPP = &symbolP->sy_next;
 557         }
 558       else
 559         {
 560           if (S_IS_EXTERNAL (symbolP) || !S_IS_DEFINED (symbolP))
 561             {
 562               as_bad (_("Local symbol %s never defined"), S_GET_NAME (symbolP));
 563             }                   /* oops.  */
 564
 565           /* Unhook it from the chain.  */
 566           *symbolPP = symbol_next (symbolP);
 567         }                       /* if this symbol should be in the output */
 568
 569     }                   /* for each symbol */
 570
 571   H_SET_STRING_SIZE (headers, string_byte_count);
 572   H_SET_SYMBOL_TABLE_SIZE (headers, symbol_number);
 573 }                               /* obj_crawl_symbol_chain() */
 574 \f
 575
 576  /****** VMS OBJECT FILE HACKING ROUTINES *******/
 577
 578 /* Create the VMS object file.  */
 579
 580 static void
 581 Create_VMS_Object_File ()
 582 {
 583 #if     defined(eunice) || !defined(VMS)
 584   VMS_Object_File_FD = creat (out_file_name, 0777, "var");
 585 #else   /* eunice */
 586   VMS_Object_File_FD = creat (out_file_name, 0, "rfm=var",
 587                               "ctx=bin", "mbc=16", "deq=64", "fop=tef",
 588                               "shr=nil");
 589 #endif  /* eunice */
 590   /* Deal with errors.  */
 591   if (VMS_Object_File_FD < 0)
 592     as_fatal (_("Couldn't create VMS object file \"%s\""), out_file_name);
 593   /* Initialize object file hacking variables.  */
 594   Object_Record_Offset = 0;
 595   Current_Object_Record_Type = -1;
 596 }
 597
 598 /* Flush the object record buffer to the object file.  */
 599
 600 static void
 601 Flush_VMS_Object_Record_Buffer ()
 602 {
 603   /* If the buffer is empty, there's nothing to do.  */
 604   if (Object_Record_Offset == 0)
 605     return;
 606
 607 #ifndef VMS                     /* For cross-assembly purposes.  */
 608   {
 609     char RecLen[2];
 610
 611     /* "Variable-length record" files have a two byte length field
 612        prepended to each record.  It's normally out-of-band, and native
 613        VMS output will insert it automatically for this type of file.
 614        When cross-assembling, we must write it explicitly.  */
 615     md_number_to_chars (RecLen, Object_Record_Offset, 2);
 616     if (write (VMS_Object_File_FD, RecLen, 2) != 2)
 617       error (_("I/O error writing VMS object file (length prefix)"));
 618     /* We also need to force the actual record to be an even number of
 619        bytes.  For native output, that's automatic; when cross-assembling,
 620        pad with a NUL byte if length is odd.  Do so _after_ writing the
 621        pre-padded length.  Since our buffer is defined with even size,
 622        an odd offset implies that it has some room left.  */
 623     if ((Object_Record_Offset & 1) != 0)
 624       Object_Record_Buffer[Object_Record_Offset++] = '\0';
 625   }
 626 #endif /* not VMS */
 627
 628   /* Write the data to the file.  */
 629   if (write (VMS_Object_File_FD, Object_Record_Buffer, Object_Record_Offset)
 630       != Object_Record_Offset)
 631     error (_("I/O error writing VMS object file"));
 632
 633   /* The buffer is now empty.  */
 634   Object_Record_Offset = 0;
 635 }
 636
 637 /* Declare a particular type of object file record.  */
 638
 639 static void
 640 Set_VMS_Object_File_Record (Type)
 641      int Type;
 642 {
 643   /* If the type matches, we are done.  */
 644   if (Type == Current_Object_Record_Type)
 645     return;
 646   /* Otherwise: flush the buffer.  */
 647   Flush_VMS_Object_Record_Buffer ();
 648   /* Remember the new type.  */
 649   Current_Object_Record_Type = Type;
 650 }
 651
 652 /* Close the VMS Object file.  */
 653
 654 static void
 655 Close_VMS_Object_File ()
 656 {
 657   /* Flush (should never be necessary) and reset saved record-type context.  */
 658   Set_VMS_Object_File_Record (-1);
 659
 660 #ifndef VMS                     /* For cross-assembly purposes.  */
 661   {
 662     char RecLen[2];
 663     int minus_one = -1;
 664
 665     /* Write a 2 byte record-length field of -1 into the file, which
 666        means end-of-block when read, hence end-of-file when occurring
 667        in the file's last block.  It is only needed for variable-length
 668        record files transferred to VMS as fixed-length record files
 669        (typical for binary FTP; NFS shouldn't need it, but it won't hurt).  */
 670     md_number_to_chars (RecLen, minus_one, 2);
 671     write (VMS_Object_File_FD, RecLen, 2);
 672   }
 673 #else
 674     /* When written on a VMS system, the file header (cf inode) will record
 675        the actual end-of-file position and no inline marker is needed.  */
 676 #endif
 677
 678   close (VMS_Object_File_FD);
 679 }
 680 \f
 681
 682  /****** Text Information and Relocation routines ******/
 683
 684 /* Stack Psect base followed by signed, varying-sized offset.
 685    Common to several object records.  */
 686
 687 static void
 688 vms_tir_stack_psect (Psect_Index, Offset, Force)
 689      int Psect_Index;
 690      int Offset;
 691      int Force;
 692 {
 693   int psect_width, offset_width;
 694
 695   psect_width = ((unsigned) Psect_Index > 255) ? 2 : 1;
 696   offset_width = (Force || Offset > 32767 || Offset < -32768) ? 4
 697                  : (Offset > 127 || Offset < -128) ? 2 : 1;
 698 #define Sta_P(p,o) (((o)<<1) | ((p)-1))
 699   /* byte or word psect; byte, word, or longword offset */
 700   switch (Sta_P(psect_width,offset_width))
 701     {
 702       case Sta_P(1,1):  PUT_CHAR (TIR_S_C_STA_PB);
 703                         PUT_CHAR ((char) (unsigned char) Psect_Index);
 704                         PUT_CHAR ((char) Offset);
 705                         break;
 706       case Sta_P(1,2):  PUT_CHAR (TIR_S_C_STA_PW);
 707                         PUT_CHAR ((char) (unsigned char) Psect_Index);
 708                         PUT_SHORT (Offset);
 709                         break;
 710       case Sta_P(1,4):  PUT_CHAR (TIR_S_C_STA_PL);
 711                         PUT_CHAR ((char) (unsigned char) Psect_Index);
 712                         PUT_LONG (Offset);
 713                         break;
 714       case Sta_P(2,1):  PUT_CHAR (TIR_S_C_STA_WPB);
 715                         PUT_SHORT (Psect_Index);
 716                         PUT_CHAR ((char) Offset);
 717                         break;
 718       case Sta_P(2,2):  PUT_CHAR (TIR_S_C_STA_WPW);
 719                         PUT_SHORT (Psect_Index);
 720                         PUT_SHORT (Offset);
 721                         break;
 722       case Sta_P(2,4):  PUT_CHAR (TIR_S_C_STA_WPL);
 723                         PUT_SHORT (Psect_Index);
 724                         PUT_LONG (Offset);
 725                         break;
 726     }
 727 #undef Sta_P
 728 }
 729
 730 /* Store immediate data in current Psect.  */
 731
 732 static void
 733 VMS_Store_Immediate_Data (Pointer, Size, Record_Type)
 734      const char *Pointer;
 735      int Size;
 736      int Record_Type;
 737 {
 738   register int i;
 739
 740   Set_VMS_Object_File_Record (Record_Type);
 741   /* We can only store as most 128 bytes at a time due to the way that
 742      TIR commands are encoded.  */
 743   while (Size > 0)
 744     {
 745       i = (Size > 128) ? 128 : Size;
 746       Size -= i;
 747       /* If we cannot accommodate this record, flush the buffer.  */
 748       if ((Object_Record_Offset + i + 1) >= sizeof Object_Record_Buffer)
 749         Flush_VMS_Object_Record_Buffer ();
 750       /* If the buffer is empty we must insert record type.  */
 751       if (Object_Record_Offset == 0)
 752         PUT_CHAR (Record_Type);
 753       /* Store the count.  The Store Immediate TIR command is implied by
 754          a negative command byte, and the length of the immediate data
 755          is abs(command_byte).  So, we write the negated length value.  */
 756       PUT_CHAR ((char) (-i & 0xff));
 757       /* Now store the data.  */
 758       while (--i >= 0)
 759         PUT_CHAR (*Pointer++);
 760     }
 761   /* Flush the buffer if it is more than 75% full.  */
 762   if (Object_Record_Offset > (sizeof (Object_Record_Buffer) * 3 / 4))
 763     Flush_VMS_Object_Record_Buffer ();
 764 }
 765
 766 /* Make a data reference.  */
 767
 768 static void
 769 VMS_Set_Data (Psect_Index, Offset, Record_Type, Force)
 770      int Psect_Index;
 771      int Offset;
 772      int Record_Type;
 773      int Force;
 774 {
 775   Set_VMS_Object_File_Record (Record_Type);
 776   /* If the buffer is empty we must insert the record type.  */
 777   if (Object_Record_Offset == 0)
 778     PUT_CHAR (Record_Type);
 779   /* Stack the Psect base with its offset.  */
 780   vms_tir_stack_psect (Psect_Index, Offset, Force);
 781   /* Set relocation base.  */
 782   PUT_CHAR (TIR_S_C_STO_PIDR);
 783   /* Flush the buffer if it is more than 75% full.  */
 784   if (Object_Record_Offset > (sizeof (Object_Record_Buffer) * 3 / 4))
 785     Flush_VMS_Object_Record_Buffer ();
 786 }
 787
 788 /* Make a debugger reference to a struct, union or enum.  */
 789
 790 static void
 791 VMS_Store_Struct (Struct_Index)
 792      int Struct_Index;
 793 {
 794   /* We are writing a debug record.  */
 795   Set_VMS_Object_File_Record (OBJ_S_C_DBG);
 796   /* If the buffer is empty we must insert the record type.  */
 797   if (Object_Record_Offset == 0)
 798     PUT_CHAR (OBJ_S_C_DBG);
 799   PUT_CHAR (TIR_S_C_STA_UW);
 800   PUT_SHORT (Struct_Index);
 801   PUT_CHAR (TIR_S_C_CTL_STKDL);
 802   PUT_CHAR (TIR_S_C_STO_L);
 803   /* Flush the buffer if it is more than 75% full.  */
 804   if (Object_Record_Offset > (sizeof (Object_Record_Buffer) * 3 / 4))
 805     Flush_VMS_Object_Record_Buffer ();
 806 }
 807
 808 /* Make a debugger reference to partially define a struct, union or enum.  */
 809
 810 static void
 811 VMS_Def_Struct (Struct_Index)
 812      int Struct_Index;
 813 {
 814   /* We are writing a debug record.  */
 815   Set_VMS_Object_File_Record (OBJ_S_C_DBG);
 816   /* If the buffer is empty we must insert the record type.  */
 817   if (Object_Record_Offset == 0)
 818     PUT_CHAR (OBJ_S_C_DBG);
 819   PUT_CHAR (TIR_S_C_STA_UW);
 820   PUT_SHORT (Struct_Index);
 821   PUT_CHAR (TIR_S_C_CTL_DFLOC);
 822   /* Flush the buffer if it is more than 75% full.  */
 823   if (Object_Record_Offset > (sizeof (Object_Record_Buffer) * 3 / 4))
 824     Flush_VMS_Object_Record_Buffer ();
 825 }
 826
 827 static void
 828 VMS_Set_Struct (Struct_Index)
 829      int Struct_Index;
 830 {                               /* see previous functions for comments */
 831   Set_VMS_Object_File_Record (OBJ_S_C_DBG);
 832   if (Object_Record_Offset == 0)
 833     PUT_CHAR (OBJ_S_C_DBG);
 834   PUT_CHAR (TIR_S_C_STA_UW);
 835   PUT_SHORT (Struct_Index);
 836   PUT_CHAR (TIR_S_C_CTL_STLOC);
 837   if (Object_Record_Offset > (sizeof (Object_Record_Buffer) * 3 / 4))
 838     Flush_VMS_Object_Record_Buffer ();
 839 }
 840 \f
 841
 842  /****** Traceback Information routines ******/
 843
 844 /* Write the Traceback Module Begin record.  */
 845
 846 static void
 847 VMS_TBT_Module_Begin ()
 848 {
 849   register char *cp, *cp1;
 850   int Size;
 851   char Local[256];
 852
 853   /* Arrange to store the data locally (leave room for size byte).  */
 854   cp = &Local[1];
 855   /* Begin module.  */
 856   *cp++ = DST_S_C_MODBEG;
 857   *cp++ = 0;            /* flags; not used */
 858   /*
 859    *    Language type == "C"
 860    *
 861    * (FIXME:  this should be based on the input...)
 862    */
 863   COPY_LONG (cp, DST_S_C_C);
 864   cp += 4;
 865   /* Store the module name.  */
 866   *cp++ = (char) strlen (Module_Name);
 867   cp1 = Module_Name;
 868   while (*cp1)
 869     *cp++ = *cp1++;
 870   /* Now we can store the record size.  */
 871   Size = (cp - Local);
 872   Local[0] = Size - 1;
 873   /* Put it into the object record.  */
 874   VMS_Store_Immediate_Data (Local, Size, OBJ_S_C_TBT);
 875 }
 876
 877 /* Write the Traceback Module End record.  */
 878
 879 static void
 880 VMS_TBT_Module_End ()
 881 {
 882   char Local[2];
 883
 884   /* End module.  */
 885   Local[0] = 1;
 886   Local[1] = DST_S_C_MODEND;
 887   /* Put it into the object record.  */
 888   VMS_Store_Immediate_Data (Local, 2, OBJ_S_C_TBT);
 889 }
 890
 891 /* Write a Traceback Routine Begin record.  */
 892
 893 static void
 894 VMS_TBT_Routine_Begin (symbolP, Psect)
 895      symbolS *symbolP;
 896      int Psect;
 897 {
 898   register char *cp, *cp1;
 899   char *Name;
 900   int Offset;
 901   int Size;
 902   char Local[512];
 903
 904   /* Strip the leading "_" from the name.  */
 905   Name = S_GET_NAME (symbolP);
 906   if (*Name == '_')
 907     Name++;
 908   /* Get the text psect offset.  */
 909   Offset = S_GET_VALUE (symbolP);
 910   /* Set the record size.  */
 911   Size = 1 + 1 + 4 + 1 + strlen (Name);
 912   Local[0] = Size;
 913   /* DST type "routine begin".  */
 914   Local[1] = DST_S_C_RTNBEG;
 915   /* Uses CallS/CallG.  */
 916   Local[2] = 0;
 917   /* Store the data so far.  */
 918   VMS_Store_Immediate_Data (Local, 3, OBJ_S_C_TBT);
 919   /* Make sure we are still generating a OBJ_S_C_TBT record.  */
 920   if (Object_Record_Offset == 0)
 921     PUT_CHAR (OBJ_S_C_TBT);
 922   /* Stack the address.  */
 923   vms_tir_stack_psect (Psect, Offset, 0);
 924   /* Store the data reference.  */
 925   PUT_CHAR (TIR_S_C_STO_PIDR);
 926   /* Store the counted string as data.  */
 927   cp = Local;
 928   cp1 = Name;
 929   Size = strlen (cp1) + 1;
 930   *cp++ = Size - 1;
 931   while (*cp1)
 932     *cp++ = *cp1++;
 933   VMS_Store_Immediate_Data (Local, Size, OBJ_S_C_TBT);
 934 }
 935
 936 /* Write a Traceback Routine End record.
 937
 938    We *must* search the symbol table to find the next routine, since the
 939    assember has a way of reassembling the symbol table OUT OF ORDER Thus
 940    the next routine in the symbol list is not necessarily the next one in
 941    memory.  For debugging to work correctly we must know the size of the
 942    routine.  */
 943
 944 static void
 945 VMS_TBT_Routine_End (Max_Size, sp)
 946      int Max_Size;
 947      symbolS *sp;
 948 {
 949   symbolS *symbolP;
 950   int Size = 0x7fffffff;
 951   char Local[16];
 952   valueT sym_value, sp_value = S_GET_VALUE (sp);
 953
 954   for (symbolP = symbol_rootP; symbolP; symbolP = symbol_next (symbolP))
 955     {
 956       if (!S_IS_DEBUG (symbolP) && S_GET_TYPE (symbolP) == N_TEXT)
 957         {
 958           if (*S_GET_NAME (symbolP) == 'L')
 959             continue;
 960           sym_value = S_GET_VALUE (symbolP);
 961           if (sym_value > sp_value && sym_value < Size)
 962             Size = sym_value;
 963
 964           /*
 965            * Dummy labels like "gcc_compiled." should no longer reach here.
 966            */
 967 #if 0
 968           else
 969           /* check if gcc_compiled. has size of zero */
 970           if (sym_value == sp_value &&
 971               sp != symbolP &&
 972               (!strcmp (S_GET_NAME (sp), "gcc_compiled.") ||
 973                !strcmp (S_GET_NAME (sp), "gcc2_compiled.")))
 974             Size = sym_value;
 975 #endif
 976         }
 977     }
 978   if (Size == 0x7fffffff)
 979     Size = Max_Size;
 980   Size -= sp_value;             /* and get the size of the routine */
 981   /* Record Size.  */
 982   Local[0] = 6;
 983   /* DST type is "routine end".  */
 984   Local[1] = DST_S_C_RTNEND;
 985   Local[2] = 0;         /* unused */
 986   /* Size of routine.  */
 987   COPY_LONG (&Local[3], Size);
 988   /* Store the record.  */
 989   VMS_Store_Immediate_Data (Local, 7, OBJ_S_C_TBT);
 990 }
 991
 992 /* Write a Traceback Block Begin record.  */
 993
 994 static void
 995 VMS_TBT_Block_Begin (symbolP, Psect, Name)
 996      symbolS *symbolP;
 997      int Psect;
 998      char *Name;
 999 {
1000   register char *cp, *cp1;
1001   int Offset;
1002   int Size;
1003   char Local[512];
1004
1005   /* Set the record size.  */
1006   Size = 1 + 1 + 4 + 1 + strlen (Name);
1007   Local[0] = Size;
1008   /* DST type is "begin block"; we simulate with a phony routine.  */
1009   Local[1] = DST_S_C_BLKBEG;
1010   /* Uses CallS/CallG.  */
1011   Local[2] = 0;
1012   /* Store the data so far.  */
1013   VMS_Store_Immediate_Data (Local, 3, OBJ_S_C_DBG);
1014   /* Make sure we are still generating a debug record.  */
1015   if (Object_Record_Offset == 0)
1016     PUT_CHAR (OBJ_S_C_DBG);
1017   /* Now get the symbol address.  */
1018   PUT_CHAR (TIR_S_C_STA_WPL);
1019   PUT_SHORT (Psect);
1020   /* Get the text psect offset.  */
1021   Offset = S_GET_VALUE (symbolP);
1022   PUT_LONG (Offset);
1023   /* Store the data reference.  */
1024   PUT_CHAR (TIR_S_C_STO_PIDR);
1025   /* Store the counted string as data.  */
1026   cp = Local;
1027   cp1 = Name;
1028   Size = strlen (cp1) + 1;
1029   *cp++ = Size - 1;
1030   while (*cp1)
1031     *cp++ = *cp1++;
1032   VMS_Store_Immediate_Data (Local, Size, OBJ_S_C_DBG);
1033 }
1034
1035 /* Write a Traceback Block End record.  */
1036
1037 static void
1038 VMS_TBT_Block_End (Size)
1039      valueT Size;
1040 {
1041   char Local[16];
1042
1043   Local[0] = 6;         /* record length */
1044   /* DST type is "block end"; simulate with a phony end routine.  */
1045   Local[1] = DST_S_C_BLKEND;
1046   Local[2] = 0;         /* unused, must be zero */
1047   COPY_LONG (&Local[3], Size);
1048   VMS_Store_Immediate_Data (Local, 7, OBJ_S_C_DBG);
1049 }
1050 \f
1051
1052 /* Write a Line number <-> Program Counter correlation record.  */
1053
1054 static void
1055 VMS_TBT_Line_PC_Correlation (Line_Number, Offset, Psect, Do_Delta)
1056      int Line_Number;
1057      int Offset;
1058      int Psect;
1059      int Do_Delta;
1060 {
1061   register char *cp;
1062   char Local[64];
1063
1064   if (Do_Delta == 0)
1065     {
1066       /*
1067        *  If not delta, set our PC/Line number correlation.
1068        */
1069       cp = &Local[1];   /* Put size in Local[0] later.  */
1070       /* DST type is "Line Number/PC correlation".  */
1071       *cp++ = DST_S_C_LINE_NUM;
1072       /* Set Line number.  */
1073       if (Line_Number - 1 <= 255)
1074         {
1075           *cp++ = DST_S_C_SET_LINUM_B;
1076           *cp++ = (char) (Line_Number - 1);
1077         }
1078       else if (Line_Number - 1 <= 65535)
1079         {
1080           *cp++ = DST_S_C_SET_LINE_NUM;
1081           COPY_SHORT (cp, Line_Number - 1),  cp += 2;
1082         }
1083       else
1084         {
1085           *cp++ = DST_S_C_SET_LINUM_L;
1086           COPY_LONG (cp, Line_Number - 1),  cp += 4;
1087         }
1088       /* Set PC.  */
1089       *cp++ = DST_S_C_SET_ABS_PC;
1090       /* Store size now that we know it, then output the data.  */
1091       Local[0] = cp - &Local[1];
1092         /* Account for the space that TIR_S_C_STO_PIDR will use for the PC.  */
1093         Local[0] += 4;          /* size includes length of another longword */
1094       VMS_Store_Immediate_Data (Local, cp - Local, OBJ_S_C_TBT);
1095       /* Make sure we are still generating a OBJ_S_C_TBT record.  */
1096       if (Object_Record_Offset == 0)
1097         PUT_CHAR (OBJ_S_C_TBT);
1098       vms_tir_stack_psect (Psect, Offset, 0);
1099       PUT_CHAR (TIR_S_C_STO_PIDR);
1100       /* Do a PC offset of 0 to register the line number.  */
1101       Local[0] = 2;
1102       Local[1] = DST_S_C_LINE_NUM;
1103       Local[2] = 0;             /* Increment PC by 0 and register line # */
1104       VMS_Store_Immediate_Data (Local, 3, OBJ_S_C_TBT);
1105     }
1106   else
1107     {
1108       if (Do_Delta < 0)
1109         {
1110           /*
1111            *  When delta is negative, terminate the line numbers.
1112            */
1113           Local[0] = 1 + 1 + 4;
1114           Local[1] = DST_S_C_LINE_NUM;
1115           Local[2] = DST_S_C_TERM_L;
1116           COPY_LONG (&Local[3], Offset);
1117           VMS_Store_Immediate_Data (Local, 7, OBJ_S_C_TBT);
1118           return;
1119         }
1120       /*
1121        *  Do a PC/Line delta.
1122        */
1123       cp = &Local[1];
1124       *cp++ = DST_S_C_LINE_NUM;
1125       if (Line_Number > 1)
1126         {
1127           /* We need to increment the line number.  */
1128           if (Line_Number - 1 <= 255)
1129             {
1130               *cp++ = DST_S_C_INCR_LINUM;
1131               *cp++ = Line_Number - 1;
1132             }
1133           else if (Line_Number - 1 <= 65535)
1134             {
1135               *cp++ = DST_S_C_INCR_LINUM_W;
1136               COPY_SHORT (cp, Line_Number - 1),  cp += 2;
1137             }
1138           else
1139             {
1140               *cp++ = DST_S_C_INCR_LINUM_L;
1141               COPY_LONG (cp, Line_Number - 1),  cp += 4;
1142             }
1143         }
1144       /*
1145        *        Increment the PC
1146        */
1147       if (Offset <= 128)
1148         {
1149           /* Small offsets are encoded as negative numbers, rather than the
1150              usual non-negative type code followed by another data field.  */
1151           *cp++ = (char) -Offset;
1152         }
1153       else if (Offset <= 65535)
1154         {
1155           *cp++ = DST_S_C_DELTA_PC_W;
1156           COPY_SHORT (cp, Offset),  cp += 2;
1157         }
1158       else
1159         {
1160           *cp++ = DST_S_C_DELTA_PC_L;
1161           COPY_LONG (cp, Offset),  cp += 4;
1162         }
1163       /* Set size now that be know it, then output the data.  */
1164       Local[0] = cp - &Local[1];
1165       VMS_Store_Immediate_Data (Local, cp - Local, OBJ_S_C_TBT);
1166     }
1167 }
1168 \f
1169
1170 /* Describe a source file to the debugger.  */
1171
1172 static int
1173 VMS_TBT_Source_File (Filename, ID_Number)
1174      char *Filename;
1175      int ID_Number;
1176 {
1177   register char *cp;
1178   int len, rfo, ffb, ebk;
1179   char cdt[8];
1180   char Local[512];
1181 #ifdef VMS                      /* Used for native assembly */
1182   unsigned Status;
1183   struct FAB fab;                       /* RMS file access block */
1184   struct NAM nam;                       /* file name information */
1185   struct XABDAT xabdat;                 /* date+time fields */
1186   struct XABFHC xabfhc;                 /* file header characteristics */
1187   char resultant_string_buffer[255 + 1];
1188
1189   /*
1190    *    Set up RMS structures:
1191    */
1192   /* FAB -- file access block */
1193   memset ((char *) &fab, 0, sizeof fab);
1194   fab.fab$b_bid = FAB$C_BID;
1195   fab.fab$b_bln = (unsigned char) sizeof fab;
1196   fab.fab$l_fna = Filename;
1197   fab.fab$b_fns = (unsigned char) strlen (Filename);
1198   fab.fab$l_nam = (char *) &nam;
1199   fab.fab$l_xab = (char *) &xabdat;
1200   /* NAM -- file name block */
1201   memset ((char *) &nam, 0, sizeof nam);
1202   nam.nam$b_bid = NAM$C_BID;
1203   nam.nam$b_bln = (unsigned char) sizeof nam;
1204   nam.nam$l_rsa = resultant_string_buffer;
1205   nam.nam$b_rss = (unsigned char) (sizeof resultant_string_buffer - 1);
1206   /* XABs -- extended attributes blocks */
1207   memset ((char *) &xabdat, 0, sizeof xabdat);
1208   xabdat.xab$b_cod = XAB$C_DAT;
1209   xabdat.xab$b_bln = (unsigned char) sizeof xabdat;
1210   xabdat.xab$l_nxt = (char *) &xabfhc;
1211   memset ((char *) &xabfhc, 0, sizeof xabfhc);
1212   xabfhc.xab$b_cod = XAB$C_FHC;
1213   xabfhc.xab$b_bln = (unsigned char) sizeof xabfhc;
1214   xabfhc.xab$l_nxt = 0;
1215   /*
1216    *    Get the file information
1217    */
1218   Status = sys$open (&fab);
1219   if (!(Status & 1))
1220     {
1221       as_tsktsk (_("Couldn't find source file \"%s\", status=%%X%x"),
1222                  Filename, Status);
1223       return 0;
1224     }
1225   sys$close (&fab);
1226   /* Now extract fields of interest.  */
1227   memcpy (cdt, (char *) &xabdat.xab$q_cdt, 8);  /* creation date */
1228   ebk = xabfhc.xab$l_ebk;               /* end-of-file block */
1229   ffb = xabfhc.xab$w_ffb;               /* first free byte of last block */
1230   rfo = xabfhc.xab$b_rfo;               /* record format */
1231   len = nam.nam$b_rsl;                  /* length of Filename */
1232   resultant_string_buffer[len] = '\0';
1233   Filename = resultant_string_buffer;   /* full filename */
1234 #else                           /* Cross-assembly */
1235   /* [Perhaps we ought to use actual values derived from stat() here?]  */
1236   memset (cdt, 0, 8);                   /* null VMS quadword binary time */
1237   ebk = ffb = rfo = 0;
1238   len = strlen (Filename);
1239   if (len > 255)        /* a single byte is used as count prefix */
1240     {
1241       Filename += (len - 255);          /* tail end is more significant */
1242       len = 255;
1243     }
1244 #endif /* VMS */
1245
1246   cp = &Local[1];                       /* fill in record length later */
1247   *cp++ = DST_S_C_SOURCE;               /* DST type is "source file" */
1248   *cp++ = DST_S_C_SRC_FORMFEED;         /* formfeeds count as source records */
1249   *cp++ = DST_S_C_SRC_DECLFILE;         /* declare source file */
1250   know (cp == &Local[4]);
1251   *cp++ = 0;                            /* fill in this length below */
1252   *cp++ = 0;                            /* flags; must be zero */
1253   COPY_SHORT (cp, ID_Number),  cp += 2; /* file ID number */
1254   memcpy (cp, cdt, 8),  cp += 8;        /* creation date+time */
1255   COPY_LONG (cp, ebk),  cp += 4;        /* end-of-file block */
1256   COPY_SHORT (cp, ffb),  cp += 2;       /* first free byte of last block */
1257   *cp++ = (char) rfo;                   /* RMS record format */
1258   /* Filename.  */
1259   *cp++ = (char) len;
1260   while (--len >= 0)
1261     *cp++ = *Filename++;
1262   /* Library module name (none).  */
1263   *cp++ = 0;
1264   /* Now that size is known, fill it in and write out the record.  */
1265   Local[4] = cp - &Local[5];            /* source file declaration size */
1266   Local[0] = cp - &Local[1];            /* TBT record size */
1267   VMS_Store_Immediate_Data (Local, cp - Local, OBJ_S_C_TBT);
1268   return 1;
1269 }
1270
1271 /* Traceback information is described in terms of lines from compiler
1272    listing files, not lines from source files.  We need to set up the
1273    correlation between listing line numbers and source line numbers.
1274    Since gcc's .stabn directives refer to the source lines, we just
1275    need to describe a one-to-one correspondence.  */
1276
1277 static void
1278 VMS_TBT_Source_Lines (ID_Number, Starting_Line_Number, Number_Of_Lines)
1279      int ID_Number;
1280      int Starting_Line_Number;
1281      int Number_Of_Lines;
1282 {
1283   char *cp;
1284   int chunk_limit;
1285   char Local[128];      /* room enough to describe 1310700 lines...  */
1286
1287   cp = &Local[1];       /* Put size in Local[0] later.  */
1288   *cp++ = DST_S_C_SOURCE;               /* DST type is "source file".  */
1289   *cp++ = DST_S_C_SRC_SETFILE;          /* Set Source File.  */
1290   COPY_SHORT (cp, ID_Number),  cp += 2; /* File ID Number.  */
1291   /* Set record number and define lines.  Since no longword form of
1292      SRC_DEFLINES is available, we need to be able to cope with any huge
1293      files a chunk at a time.  It doesn't matter for tracebacks, since
1294      unspecified lines are mapped one-to-one and work out right, but it
1295      does matter within the debugger.  Without this explicit mapping,
1296      it will complain about lines not existing in the module.  */
1297   chunk_limit = (sizeof Local - 5) / 6;
1298   if (Number_Of_Lines > 65535 * chunk_limit)    /* avoid buffer overflow */
1299     Number_Of_Lines = 65535 * chunk_limit;
1300   while (Number_Of_Lines > 65535)
1301     {
1302       *cp++ = DST_S_C_SRC_SETREC_L;
1303       COPY_LONG (cp, Starting_Line_Number),  cp += 4;
1304       *cp++ = DST_S_C_SRC_DEFLINES_W;
1305       COPY_SHORT (cp, 65535),  cp += 2;
1306       Starting_Line_Number += 65535;
1307       Number_Of_Lines -= 65535;
1308     }
1309   /* Set record number and define lines, normal case.  */
1310   if (Starting_Line_Number <= 65535)
1311     {
1312       *cp++ = DST_S_C_SRC_SETREC_W;
1313       COPY_SHORT (cp, Starting_Line_Number),  cp += 2;
1314     }
1315   else
1316     {
1317       *cp++ = DST_S_C_SRC_SETREC_L;
1318       COPY_LONG (cp, Starting_Line_Number),  cp += 4;
1319     }
1320   *cp++ = DST_S_C_SRC_DEFLINES_W;
1321   COPY_SHORT (cp, Number_Of_Lines),  cp += 2;
1322   /* Set size now that be know it, then output the data.  */
1323   Local[0] = cp - &Local[1];
1324   VMS_Store_Immediate_Data (Local, cp - Local, OBJ_S_C_TBT);
1325 }
1326 \f
1327
1328  /****** Debugger Information support routines ******/
1329
1330 /* This routine locates a file in the list of files.  If an entry does
1331    not exist, one is created.  For include files, a new entry is always
1332    created such that inline functions can be properly debugged.  */
1333
1334 static struct input_file *
1335 find_file (sp)
1336      symbolS *sp;
1337 {
1338   struct input_file *same_file = 0;
1339   struct input_file *fpnt, *last = 0;
1340   char *sp_name;
1341
1342   for (fpnt = file_root; fpnt; fpnt = fpnt->next)
1343     {
1344       if (fpnt->spnt == sp)
1345         return fpnt;
1346       last = fpnt;
1347     }
1348   sp_name = S_GET_NAME (sp);
1349   for (fpnt = file_root; fpnt; fpnt = fpnt->next)
1350     {
1351       if (strcmp (sp_name, fpnt->name) == 0)
1352         {
1353           if (fpnt->flag == 1)
1354             return fpnt;
1355           same_file = fpnt;
1356           break;
1357         }
1358     }
1359   fpnt = (struct input_file *) xmalloc (sizeof (struct input_file));
1360   if (!file_root)
1361     file_root = fpnt;
1362   else
1363     last->next = fpnt;
1364   fpnt->next = 0;
1365   fpnt->name = sp_name;
1366   fpnt->min_line = 0x7fffffff;
1367   fpnt->max_line = 0;
1368   fpnt->offset = 0;
1369   fpnt->flag = 0;
1370   fpnt->file_number = 0;
1371   fpnt->spnt = sp;
1372   fpnt->same_file_fpnt = same_file;
1373   return fpnt;
1374 }
1375
1376 /* This routine converts a number string into an integer, and stops when
1377    it sees an invalid character.  The return value is the address of the
1378    character just past the last character read.  No error is generated.  */
1379
1380 static char *
1381 cvt_integer (str, rtn)
1382      char *str;
1383      int *rtn;
1384 {
1385   int ival = 0, sgn = 1;
1386
1387   if (*str == '-')
1388     sgn = -1,  ++str;
1389   while (*str >= '0' && *str <= '9')
1390     ival = 10 * ival + *str++ - '0';
1391   *rtn = sgn * ival;
1392   return str;
1393 }
1394 \f
1395
1396 /*
1397  * The following functions and definitions are used to generate object
1398  * records that will describe program variables to the VMS debugger.
1399  *
1400  * This file contains many of the routines needed to output debugging info
1401  * into the object file that the VMS debugger needs to understand symbols.
1402  * These routines are called very late in the assembly process, and thus
1403  * we can be fairly lax about changing things, since the GSD and the TIR
1404  * sections have already been output.
1405  */
1406
1407 /* This routine fixes the names that are generated by C++, ".this" is a good
1408    example.  The period does not work for the debugger, since it looks like
1409    the syntax for a structure element, and thus it gets mightily confused.
1410
1411    We also use this to strip the PsectAttribute hack from the name before we
1412    write a debugger record.  */
1413
1414 static char *
1415 fix_name (pnt)
1416      char *pnt;
1417 {
1418   char *pnt1;
1419
1420   /* Kill any leading "_".  */
1421   if (*pnt == '_')
1422     pnt++;
1423
1424   /* Is there a Psect Attribute to skip??  */
1425   if (HAS_PSECT_ATTRIBUTES (pnt))
1426     {
1427       /* Yes: Skip it.  */
1428       pnt += PSECT_ATTRIBUTES_STRING_LENGTH;
1429       while (*pnt)
1430         {
1431           if ((pnt[0] == '$') && (pnt[1] == '$'))
1432             {
1433               pnt += 2;
1434               break;
1435             }
1436           pnt++;
1437         }
1438     }
1439
1440   /* Here we fix the .this -> $this conversion.  */
1441   for (pnt1 = pnt; *pnt1 != 0; pnt1++)
1442     if (*pnt1 == '.')
1443       *pnt1 = '$';
1444
1445   return pnt;
1446 }
1447
1448 /* When defining a structure, this routine is called to find the name of
1449    the actual structure.  It is assumed that str points to the equal sign
1450    in the definition, and it moves backward until it finds the start of the
1451    name.  If it finds a 0, then it knows that this structure def is in the
1452    outermost level, and thus symbol_name points to the symbol name.  */
1453
1454 static char *
1455 get_struct_name (str)
1456      char *str;
1457 {
1458   char *pnt;
1459   pnt = str;
1460   while ((*pnt != ':') && (*pnt != '\0'))
1461     pnt--;
1462   if (*pnt == '\0')
1463     return (char *) symbol_name;
1464   *pnt-- = '\0';
1465   while ((*pnt != ';') && (*pnt != '='))
1466     pnt--;
1467   if (*pnt == ';')
1468     return pnt + 1;
1469   while ((*pnt < '0') || (*pnt > '9'))
1470     pnt++;
1471   while ((*pnt >= '0') && (*pnt <= '9'))
1472     pnt++;
1473   return pnt;
1474 }
1475
1476 /* Search symbol list for type number dbx_type.
1477    Return a pointer to struct.  */
1478
1479 static struct VMS_DBG_Symbol *
1480 find_symbol (dbx_type)
1481      int dbx_type;
1482 {
1483   struct VMS_DBG_Symbol *spnt;
1484
1485   spnt = VMS_Symbol_type_list[SYMTYP_HASH (dbx_type)];
1486   while (spnt)
1487     {
1488       if (spnt->dbx_type == dbx_type)
1489         break;
1490       spnt = spnt->next;
1491     }
1492   if (!spnt || spnt->advanced != ALIAS)
1493     return spnt;
1494   return find_symbol (spnt->type2);
1495 }
1496
1497 #if 0           /* obsolete */
1498 /* this routine puts info into either Local or Asuffix, depending on the sign
1499  * of size.  The reason is that it is easier to build the variable descriptor
1500  * backwards, while the array descriptor is best built forwards.  In the end
1501  * they get put together, if there is not a struct/union/enum along the way
1502  */
1503 static void
1504 push (value, size1)
1505      int value, size1;
1506 {
1507   if (size1 < 0)
1508     {
1509       size1 = -size1;
1510       if (Lpnt < size1)
1511         {
1512           overflow = 1;
1513           Lpnt = 1;
1514           return;
1515         }
1516       Lpnt -= size1;
1517       md_number_to_chars (&Local[Lpnt + 1], value, size1);
1518     }
1519   else
1520     {
1521       if (Apoint + size1 >= MAX_DEBUG_RECORD)
1522         {
1523           overflow = 1;
1524           Apoint = MAX_DEBUG_RECORD - 1;
1525           return;
1526         }
1527       md_number_to_chars (&Asuffix[Apoint], value, size1);
1528       Apoint += size1;
1529     }
1530 }
1531 #endif
1532
1533 static void
1534 fpush (value, size)
1535      int value, size;
1536 {
1537   if (Apoint + size >= MAX_DEBUG_RECORD)
1538     {
1539       overflow = 1;
1540       Apoint = MAX_DEBUG_RECORD - 1;
1541       return;
1542     }
1543   if (size == 1)
1544     Asuffix[Apoint++] = (char) value;
1545   else
1546     {
1547       md_number_to_chars (&Asuffix[Apoint], value, size);
1548       Apoint += size;
1549     }
1550 }
1551
1552 static void
1553 rpush (value, size)
1554      int value, size;
1555 {
1556   if (Lpnt < size)
1557     {
1558       overflow = 1;
1559       Lpnt = 1;
1560       return;
1561     }
1562   if (size == 1)
1563       Local[Lpnt--] = (char) value;
1564   else
1565     {
1566       Lpnt -= size;
1567       md_number_to_chars (&Local[Lpnt + 1], value, size);
1568     }
1569 }
1570
1571 /* This routine generates the array descriptor for a given array.  */
1572
1573 static void
1574 array_suffix (spnt2)
1575      struct VMS_DBG_Symbol *spnt2;
1576 {
1577   struct VMS_DBG_Symbol *spnt;
1578   struct VMS_DBG_Symbol *spnt1;
1579   int rank;
1580   int total_size;
1581
1582   rank = 0;
1583   spnt = spnt2;
1584   while (spnt->advanced != ARRAY)
1585     {
1586       spnt = find_symbol (spnt->type2);
1587       if (!spnt)
1588         return;
1589     }
1590   spnt1 = spnt;
1591   total_size = 1;
1592   while (spnt1->advanced == ARRAY)
1593     {
1594       rank++;
1595       total_size *= (spnt1->index_max - spnt1->index_min + 1);
1596       spnt1 = find_symbol (spnt1->type2);
1597     }
1598   total_size = total_size * spnt1->data_size;
1599   fpush (spnt1->data_size, 2);  /* element size */
1600   if (spnt1->VMS_type == DBG_S_C_ADVANCED_TYPE)
1601     fpush (0, 1);
1602   else
1603     fpush (spnt1->VMS_type, 1); /* element type */
1604   fpush (DSC_K_CLASS_A, 1);     /* descriptor class */
1605   fpush (0, 4);                 /* base address */
1606   fpush (0, 1);                 /* scale factor -- not applicable */
1607   fpush (0, 1);                 /* digit count -- not applicable */
1608   fpush (0xc0, 1);              /* flags: multiplier block & bounds present */
1609   fpush (rank, 1);              /* number of dimensions */
1610   fpush (total_size, 4);
1611   fpush (0, 4);                 /* pointer to element [0][0]...[0] */
1612   spnt1 = spnt;
1613   while (spnt1->advanced == ARRAY)
1614     {
1615       fpush (spnt1->index_max - spnt1->index_min + 1, 4);
1616       spnt1 = find_symbol (spnt1->type2);
1617     }
1618   spnt1 = spnt;
1619   while (spnt1->advanced == ARRAY)
1620     {
1621       fpush (spnt1->index_min, 4);
1622       fpush (spnt1->index_max, 4);
1623       spnt1 = find_symbol (spnt1->type2);
1624     }
1625 }
1626
1627 /* This routine generates the start of a variable descriptor based upon
1628    a struct/union/enum that has yet to be defined.  We define this spot as
1629    a new location, and save four bytes for the address.  When the struct is
1630    finally defined, then we can go back and plug in the correct address.  */
1631
1632 static void
1633 new_forward_ref (dbx_type)
1634      int dbx_type;
1635 {
1636   struct forward_ref *fpnt;
1637   fpnt = (struct forward_ref *) xmalloc (sizeof (struct forward_ref));
1638   fpnt->next = f_ref_root;
1639   f_ref_root = fpnt;
1640   fpnt->dbx_type = dbx_type;
1641   fpnt->struc_numb = ++structure_count;
1642   fpnt->resolved = 'N';
1643   rpush (DST_K_TS_IND, 1);      /* indirect type specification */
1644   total_len = 5;
1645   rpush (total_len, 2);
1646   struct_number = -fpnt->struc_numb;
1647 }
1648
1649 /* This routine generates the variable descriptor used to describe non-basic
1650    variables.  It calls itself recursively until it gets to the bottom of it
1651    all, and then builds the descriptor backwards.  It is easiest to do it
1652    this way since we must periodically write length bytes, and it is easiest
1653    if we know the value when it is time to write it.  */
1654
1655 static int
1656 gen1 (spnt, array_suffix_len)
1657      struct VMS_DBG_Symbol *spnt;
1658      int array_suffix_len;
1659 {
1660   struct VMS_DBG_Symbol *spnt1;
1661   int i;
1662
1663   switch (spnt->advanced)
1664     {
1665     case VOID:
1666       rpush (DBG_S_C_VOID, 1);
1667       total_len += 1;
1668       rpush (total_len, 2);
1669       return 0;
1670     case BASIC:
1671     case FUNCTION:
1672       if (array_suffix_len == 0)
1673         {
1674           rpush (spnt->VMS_type, 1);
1675           rpush (DBG_S_C_BASIC, 1);
1676           total_len = 2;
1677           rpush (total_len, 2);
1678           return 1;
1679         }
1680       rpush (0, 4);
1681       rpush (DST_K_VFLAGS_DSC, 1);
1682       rpush (DST_K_TS_DSC, 1);  /* descriptor type specification */
1683       total_len = -2;
1684       return 1;
1685     case STRUCT:
1686     case UNION:
1687     case ENUM:
1688       struct_number = spnt->struc_numb;
1689       if (struct_number < 0)
1690         {
1691           new_forward_ref (spnt->dbx_type);
1692           return 1;
1693         }
1694       rpush (DBG_S_C_STRUCT, 1);
1695       total_len = 5;
1696       rpush (total_len, 2);
1697       return 1;
1698     case POINTER:
1699       spnt1 = find_symbol (spnt->type2);
1700       i = 1;
1701       if (!spnt1)
1702         new_forward_ref (spnt->type2);
1703       else
1704         i = gen1 (spnt1, 0);
1705       if (i)
1706         {       /* (*void) is a special case, do not put pointer suffix */
1707           rpush (DBG_S_C_POINTER, 1);
1708           total_len += 3;
1709           rpush (total_len, 2);
1710         }
1711       return 1;
1712     case ARRAY:
1713       spnt1 = spnt;
1714       while (spnt1->advanced == ARRAY)
1715         {
1716           spnt1 = find_symbol (spnt1->type2);
1717           if (!spnt1)
1718             {
1719               as_tsktsk (_("debugger forward reference error, dbx type %d"),
1720                          spnt->type2);
1721               return 0;
1722             }
1723         }
1724 /* It is too late to generate forward references, so the user gets a message.
1725  * This should only happen on a compiler error */
1726       (void) gen1 (spnt1, 1);
1727       i = Apoint;
1728       array_suffix (spnt);
1729       array_suffix_len = Apoint - i;
1730       switch (spnt1->advanced)
1731         {
1732         case BASIC:
1733         case FUNCTION:
1734           break;
1735         default:
1736           rpush (0, 2);
1737           total_len += 2;
1738           rpush (total_len, 2);
1739           rpush (DST_K_VFLAGS_DSC, 1);
1740           rpush (1, 1);         /* flags: element value spec included */
1741           rpush (1, 1);         /* one dimension */
1742           rpush (DBG_S_C_COMPLEX_ARRAY, 1);
1743         }
1744       total_len += array_suffix_len + 8;
1745       rpush (total_len, 2);
1746       break;
1747     default:    /* lint suppression */
1748       break;
1749     }
1750   return 0;
1751 }
1752
1753 /* This generates a suffix for a variable.  If it is not a defined type yet,
1754    then dbx_type contains the type we are expecting so we can generate a
1755    forward reference.  This calls gen1 to build most of the descriptor, and
1756    then it puts the icing on at the end.  It then dumps whatever is needed
1757    to get a complete descriptor (i.e. struct reference, array suffix).  */
1758
1759 static void
1760 generate_suffix (spnt, dbx_type)
1761      struct VMS_DBG_Symbol *spnt;
1762      int dbx_type;
1763 {
1764   static const char pvoid[6] = {
1765                 5,              /* record.length == 5 */
1766                 DST_K_TYPSPEC,  /* record.type == 1 (type specification) */
1767                 0,              /* name.length == 0, no name follows */
1768                 1, 0,           /* type.length == 1 {2 bytes, little endian} */
1769                 DBG_S_C_VOID    /* type.type == 5 (pointer to unspecified) */
1770   };
1771   int i;
1772
1773   Apoint = 0;
1774   Lpnt = MAX_DEBUG_RECORD - 1;
1775   total_len = 0;
1776   struct_number = 0;
1777   overflow = 0;
1778   if (!spnt)
1779     new_forward_ref (dbx_type);
1780   else
1781     {
1782       if (spnt->VMS_type != DBG_S_C_ADVANCED_TYPE)
1783         return;         /* no suffix needed */
1784       gen1 (spnt, 0);
1785     }
1786   rpush (0, 1);         /* no name (len==0) */
1787   rpush (DST_K_TYPSPEC, 1);
1788   total_len += 4;
1789   rpush (total_len, 1);
1790   /* If the variable descriptor overflows the record, output a descriptor
1791      for a pointer to void.  */
1792   if ((total_len >= MAX_DEBUG_RECORD) || overflow)
1793     {
1794       as_warn (_("Variable descriptor %d too complicated.  Defined as `void *'."),
1795                 spnt->dbx_type);
1796       VMS_Store_Immediate_Data (pvoid, 6, OBJ_S_C_DBG);
1797       return;
1798     }
1799   i = 0;
1800   while (Lpnt < MAX_DEBUG_RECORD - 1)
1801     Local[i++] = Local[++Lpnt];
1802   Lpnt = i;
1803   /* we use this for reference to structure that has already been defined */
1804   if (struct_number > 0)
1805     {
1806       VMS_Store_Immediate_Data (Local, Lpnt, OBJ_S_C_DBG);
1807       Lpnt = 0;
1808       VMS_Store_Struct (struct_number);
1809     }
1810   /* We use this for a forward reference to a structure that has yet to
1811      be defined.  We store four bytes of zero to make room for the actual
1812      address once it is known.  */
1813   if (struct_number < 0)
1814     {
1815       struct_number = -struct_number;
1816       VMS_Store_Immediate_Data (Local, Lpnt, OBJ_S_C_DBG);
1817       Lpnt = 0;
1818       VMS_Def_Struct (struct_number);
1819       COPY_LONG (&Local[Lpnt], 0L);
1820       Lpnt += 4;
1821       VMS_Store_Immediate_Data (Local, Lpnt, OBJ_S_C_DBG);
1822       Lpnt = 0;
1823     }
1824   i = 0;
1825   while (i < Apoint)
1826     Local[Lpnt++] = Asuffix[i++];
1827   if (Lpnt != 0)
1828     VMS_Store_Immediate_Data (Local, Lpnt, OBJ_S_C_DBG);
1829   Lpnt = 0;
1830 }
1831
1832         /* "novel length" type doesn't work for simple atomic types */
1833 #define USE_BITSTRING_DESCRIPTOR(t) ((t)->advanced == BASIC)
1834 #undef SETUP_BASIC_TYPES
1835
1836 /* This routine generates a type description for a bitfield.  */
1837
1838 static void
1839 bitfield_suffix (spnt, width)
1840      struct VMS_DBG_Symbol *spnt;
1841      int width;
1842 {
1843   Local[Lpnt++] = 13;                   /* rec.len==13 */
1844   Local[Lpnt++] = DST_K_TYPSPEC;        /* a type specification record */
1845   Local[Lpnt++] = 0;                    /* not named */
1846   COPY_SHORT (&Local[Lpnt], 9);         /* typ.len==9 */
1847   Lpnt += 2;
1848   Local[Lpnt++] = DST_K_TS_NOV_LENG;    /* This type is a "novel length"
1849                                            incarnation of some other type.  */
1850   COPY_LONG (&Local[Lpnt], width);      /* size in bits == novel length */
1851   Lpnt += 4;
1852   VMS_Store_Immediate_Data (Local, Lpnt, OBJ_S_C_DBG);
1853   Lpnt = 0;
1854   /* assert( spnt->struc_numb > 0 ); */
1855   VMS_Store_Struct (spnt->struc_numb);  /* output 4 more bytes */
1856 }
1857
1858 /* Formally define a builtin type, so that it can serve as the target of
1859    an indirect reference.  It makes bitfield_suffix() easier by avoiding
1860    the need to use a forward reference for the first occurrence of each
1861    type used in a bitfield.  */
1862
1863 static void
1864 setup_basic_type (spnt)
1865      struct VMS_DBG_Symbol *spnt;
1866 {
1867 #ifdef SETUP_BASIC_TYPES
1868   /* This would be very useful if "novel length" fields actually worked
1869      with basic types like they do with enumerated types.  However,
1870      they do not, so this isn't worth doing just so that you can use
1871      EXAMINE/TYPE=(__long_long_int) instead of EXAMINE/QUAD.  */
1872   char *p;
1873 #ifndef SETUP_SYNONYM_TYPES
1874   /* This determines whether compatible things like `int' and `long int'
1875      ought to have distinct type records rather than sharing one.  */
1876   struct VMS_DBG_Symbol *spnt2;
1877
1878   /* first check whether this type has already been seen by another name */
1879   for (spnt2 = VMS_Symbol_type_list[SYMTYP_HASH (spnt->VMS_type)];
1880        spnt2;
1881        spnt2 = spnt2->next)
1882     if (spnt2 != spnt && spnt2->VMS_type == spnt->VMS_type)
1883       {
1884         spnt->struc_numb = spnt2->struc_numb;
1885         return;
1886       }
1887 #endif
1888
1889   /* `structure number' doesn't really mean `structure'; it means an index
1890      into a linker maintained set of saved locations which can be referenced
1891      again later.  */
1892   spnt->struc_numb = ++structure_count;
1893   VMS_Def_Struct (spnt->struc_numb);    /* remember where this type lives */
1894   /* define the simple scalar type */
1895   Local[Lpnt++] = 6 + strlen (symbol_name) + 2; /* rec.len */
1896   Local[Lpnt++] = DST_K_TYPSPEC;        /* rec.typ==type specification */
1897   Local[Lpnt++] = strlen (symbol_name) + 2;
1898   Local[Lpnt++] = '_';                  /* prefix name with "__" */
1899   Local[Lpnt++] = '_';
1900   for (p = symbol_name; *p; p++)
1901     Local[Lpnt++] = *p == ' ' ? '_' : *p;
1902   COPY_SHORT (&Local[Lpnt], 2);         /* typ.len==2 */
1903   Lpnt += 2;
1904   Local[Lpnt++] = DST_K_TS_ATOM;        /* typ.kind is simple type */
1905   Local[Lpnt++] = spnt->VMS_type;       /* typ.type */
1906   VMS_Store_Immediate_Data (Local, Lpnt, OBJ_S_C_DBG);
1907   Lpnt = 0;
1908 #endif  /* SETUP_BASIC_TYPES */
1909   return;
1910 }
1911
1912 /* This routine generates a symbol definition for a C symbol for the debugger.
1913    It takes a psect and offset for global symbols; if psect < 0, then this is
1914    a local variable and the offset is relative to FP.  In this case it can
1915    be either a variable (Offset < 0) or a parameter (Offset > 0).  */
1916
1917 static void
1918 VMS_DBG_record (spnt, Psect, Offset, Name)
1919      struct VMS_DBG_Symbol *spnt;
1920      int Psect;
1921      int Offset;
1922      char *Name;
1923 {
1924   char *Name_pnt;
1925   int len;
1926   int i = 0;
1927
1928   /* if there are bad characters in name, convert them */
1929   Name_pnt = fix_name (Name);
1930
1931   len = strlen (Name_pnt);
1932   if (Psect < 0)
1933     {                           /* this is a local variable, referenced to SP */
1934       Local[i++] = 7 + len;
1935       Local[i++] = spnt->VMS_type;
1936       Local[i++] = (Offset > 0) ? DBG_C_FUNCTION_PARAM : DBG_C_LOCAL_SYM;
1937       COPY_LONG (&Local[i], Offset);
1938       i += 4;
1939     }
1940   else
1941     {
1942       Local[i++] = 7 + len;
1943       Local[i++] = spnt->VMS_type;
1944       Local[i++] = DST_K_VALKIND_ADDR;
1945       VMS_Store_Immediate_Data (Local, i, OBJ_S_C_DBG);
1946       i = 0;
1947       VMS_Set_Data (Psect, Offset, OBJ_S_C_DBG, 0);
1948     }
1949   Local[i++] = len;
1950   while (*Name_pnt != '\0')
1951     Local[i++] = *Name_pnt++;
1952   VMS_Store_Immediate_Data (Local, i, OBJ_S_C_DBG);
1953   if (spnt->VMS_type == DBG_S_C_ADVANCED_TYPE)
1954     generate_suffix (spnt, 0);
1955 }
1956
1957 /* This routine parses the stabs entries in order to make the definition
1958    for the debugger of local symbols and function parameters.  */
1959
1960 static void
1961 VMS_local_stab_Parse (sp)
1962      symbolS *sp;
1963 {
1964   struct VMS_DBG_Symbol *spnt;
1965   char *pnt;
1966   char *pnt1;
1967   char *str;
1968   int dbx_type;
1969
1970   dbx_type = 0;
1971   str = S_GET_NAME (sp);
1972   pnt = (char *) strchr (str, ':');
1973   if (!pnt)
1974     return;                     /* no colon present */
1975   pnt1 = pnt++;                 /* save this for later, and skip colon */
1976   if (*pnt == 'c')
1977     return;                     /* ignore static constants */
1978
1979 /* there is one little catch that we must be aware of.  Sometimes function
1980  * parameters are optimized into registers, and the compiler, in its infiite
1981  * wisdom outputs stabs records for *both*.  In general we want to use the
1982  * register if it is present, so we must search the rest of the symbols for
1983  * this function to see if this parameter is assigned to a register.
1984  */
1985   {
1986     symbolS *sp1;
1987     char *str1;
1988     char *pnt2;
1989
1990     if (*pnt == 'p')
1991       {
1992         for (sp1 = symbol_next (sp); sp1; sp1 = symbol_next (sp1))
1993           {
1994             if (!S_IS_DEBUG (sp1))
1995               continue;
1996             if (S_GET_RAW_TYPE (sp1) == N_FUN)
1997               {
1998                 pnt2 = (char *) strchr (S_GET_NAME (sp1), ':') + 1;
1999                 if (*pnt2 == 'F' || *pnt2 == 'f')
2000                   break;
2001               }
2002             if (S_GET_RAW_TYPE (sp1) != N_RSYM)
2003               continue;
2004             str1 = S_GET_NAME (sp1);    /* and get the name */
2005             pnt2 = str;
2006             while (*pnt2 != ':')
2007               {
2008                 if (*pnt2 != *str1)
2009                   break;
2010                 pnt2++;
2011                 str1++;
2012               }
2013             if (*str1 == ':' && *pnt2 == ':')
2014               return;   /* They are the same!  Let's skip this one.  */
2015           }                     /* for */
2016         pnt++;                  /* skip p in case no register */
2017       }                 /* if */
2018   }                             /* p block */
2019
2020   pnt = cvt_integer (pnt, &dbx_type);
2021   spnt = find_symbol (dbx_type);
2022   if (!spnt)
2023     return;                     /*Dunno what this is*/
2024   *pnt1 = '\0';
2025   VMS_DBG_record (spnt, -1, S_GET_VALUE (sp), str);
2026   *pnt1 = ':';                  /* and restore the string */
2027   return;
2028 }
2029
2030 /* This routine parses a stabs entry to find the information required
2031    to define a variable.  It is used for global and static variables.
2032    Basically we need to know the address of the symbol.  With older
2033    versions of the compiler, const symbols are treated differently, in
2034    that if they are global they are written into the text psect.  The
2035    global symbol entry for such a const is actually written as a program
2036    entry point (Yuk!!), so if we cannot find a symbol in the list of
2037    psects, we must search the entry points as well.  static consts are
2038    even harder, since they are never assigned a memory address.  The
2039    compiler passes a stab to tell us the value, but I am not sure what
2040    to do with it.  */
2041
2042 static void
2043 VMS_stab_parse (sp, expected_type, type1, type2, Text_Psect)
2044      symbolS *sp;
2045      int expected_type; /* char */
2046      int type1, type2, Text_Psect;
2047 {
2048   char *pnt;
2049   char *pnt1;
2050   char *str;
2051   symbolS *sp1;
2052   struct VMS_DBG_Symbol *spnt;
2053   struct VMS_Symbol *vsp;
2054   int dbx_type;
2055
2056   dbx_type = 0;
2057   str = S_GET_NAME (sp);
2058   pnt = (char *) strchr (str, ':');
2059   if (!pnt)
2060     return;                     /* no colon present */
2061   pnt1 = pnt;                   /* save this for later*/
2062   pnt++;
2063   if (*pnt == expected_type)
2064     {
2065       pnt = cvt_integer (pnt + 1, &dbx_type);
2066       spnt = find_symbol (dbx_type);
2067       if (!spnt)
2068         return;         /*Dunno what this is*/
2069       /*
2070        * Now we need to search the symbol table to find the psect and
2071        * offset for this variable.
2072        */
2073       *pnt1 = '\0';
2074       vsp = VMS_Symbols;
2075       while (vsp)
2076         {
2077           pnt = S_GET_NAME (vsp->Symbol);
2078           if (pnt && *pnt++ == '_'
2079               /* make sure name is the same and symbol type matches */
2080               && strcmp (pnt, str) == 0
2081               && (S_GET_RAW_TYPE (vsp->Symbol) == type1
2082                   || S_GET_RAW_TYPE (vsp->Symbol) == type2))
2083             break;
2084           vsp = vsp->Next;
2085         }
2086       if (vsp)
2087         {
2088           VMS_DBG_record (spnt, vsp->Psect_Index, vsp->Psect_Offset, str);
2089           *pnt1 = ':';          /* and restore the string */
2090           return;
2091         }
2092       /* The symbol was not in the symbol list, but it may be an
2093          "entry point" if it was a constant.  */
2094       for (sp1 = symbol_rootP; sp1; sp1 = symbol_next (sp1))
2095         {
2096           /*
2097            *    Dispatch on STAB type
2098            */
2099           if (S_IS_DEBUG (sp1) || (S_GET_TYPE (sp1) != N_TEXT))
2100             continue;
2101           pnt = S_GET_NAME (sp1);
2102           if (*pnt == '_')
2103             pnt++;
2104           if (strcmp (pnt, str) == 0)
2105             {
2106               if (!gave_compiler_message && expected_type == 'G')
2107                 {
2108                   char *long_const_msg = _("\
2109 ***Warning - the assembly code generated by the compiler has placed \n\
2110  global constant(s) in the text psect.  These will not be available to \n\
2111  other modules, since this is not the correct way to handle this. You \n\
2112  have two options: 1) get a patched compiler that does not put global \n\
2113  constants in the text psect, or 2) remove the 'const' keyword from \n\
2114  definitions of global variables in your source module(s).  Don't say \n\
2115  I didn't warn you! \n");
2116
2117                   as_tsktsk (long_const_msg);
2118                   gave_compiler_message = 1;
2119                 }
2120               VMS_DBG_record (spnt,
2121                               Text_Psect,
2122                               S_GET_VALUE (sp1),
2123                               str);
2124               *pnt1 = ':';
2125               /* fool assembler to not output this as a routine in the TBT */
2126               pnt1 = S_GET_NAME (sp1);
2127               *pnt1 = 'L';
2128               S_SET_NAME (sp1, pnt1);
2129               return;
2130             }
2131         }
2132     }
2133   *pnt1 = ':';                  /* and restore the string */
2134   return;
2135 }
2136
2137 /* Simpler interfaces into VMS_stab_parse().  */
2138
2139 static void
2140 VMS_GSYM_Parse (sp, Text_Psect)
2141      symbolS *sp;
2142      int Text_Psect;
2143 {                               /* Global variables */
2144   VMS_stab_parse (sp, 'G', (N_UNDF | N_EXT), (N_DATA | N_EXT), Text_Psect);
2145 }
2146
2147 static void
2148 VMS_LCSYM_Parse (sp, Text_Psect)
2149      symbolS *sp;
2150      int Text_Psect;
2151 {                               /* Static symbols - uninitialized */
2152   VMS_stab_parse (sp, 'S', N_BSS, -1, Text_Psect);
2153 }
2154
2155 static void
2156 VMS_STSYM_Parse (sp, Text_Psect)
2157      symbolS *sp;
2158      int Text_Psect;
2159 {                               /* Static symbols - initialized */
2160   VMS_stab_parse (sp, 'S', N_DATA, -1, Text_Psect);
2161 }
2162
2163 /* For register symbols, we must figure out what range of addresses
2164    within the psect are valid.  We will use the brackets in the stab
2165    directives to give us guidance as to the PC range that this variable
2166    is in scope.  I am still not completely comfortable with this but
2167    as I learn more, I seem to get a better handle on what is going on.
2168    Caveat Emptor.  */
2169
2170 static void
2171 VMS_RSYM_Parse (sp, Current_Routine, Text_Psect)
2172      symbolS *sp, *Current_Routine;
2173      int Text_Psect;
2174 {
2175   symbolS *symbolP;
2176   struct VMS_DBG_Symbol *spnt;
2177   char *pnt;
2178   char *pnt1;
2179   char *str;
2180   int dbx_type;
2181   int len;
2182   int i = 0;
2183   int bcnt = 0;
2184   int Min_Offset = -1;          /* min PC of validity */
2185   int Max_Offset = 0;           /* max PC of validity */
2186
2187   for (symbolP = sp; symbolP; symbolP = symbol_next (symbolP))
2188     {
2189       /*
2190        *        Dispatch on STAB type
2191        */
2192       switch (S_GET_RAW_TYPE (symbolP))
2193         {
2194         case N_LBRAC:
2195           if (bcnt++ == 0)
2196             Min_Offset = S_GET_VALUE (symbolP);
2197           break;
2198         case N_RBRAC:
2199           if (--bcnt == 0)
2200             Max_Offset = S_GET_VALUE (symbolP) - 1;
2201           break;
2202         }
2203       if ((Min_Offset != -1) && (bcnt == 0))
2204         break;
2205       if (S_GET_RAW_TYPE (symbolP) == N_FUN)
2206         {
2207           pnt = (char *) strchr (S_GET_NAME (symbolP), ':') + 1;
2208           if (*pnt == 'F' || *pnt == 'f') break;
2209         }
2210     }
2211
2212   /* Check to see that the addresses were defined.  If not, then there
2213      were no brackets in the function, and we must try to search for
2214      the next function.  Since functions can be in any order, we should
2215      search all of the symbol list to find the correct ending address.  */
2216   if (Min_Offset == -1)
2217     {
2218       int Max_Source_Offset;
2219       int This_Offset;
2220
2221       Min_Offset = S_GET_VALUE (sp);
2222       Max_Source_Offset = Min_Offset;   /* just in case no N_SLINEs found */
2223       for (symbolP = symbol_rootP; symbolP; symbolP = symbol_next (symbolP))
2224         switch (S_GET_RAW_TYPE (symbolP))
2225           {
2226           case N_TEXT | N_EXT:
2227             This_Offset = S_GET_VALUE (symbolP);
2228             if (This_Offset > Min_Offset && This_Offset < Max_Offset)
2229               Max_Offset = This_Offset;
2230             break;
2231           case N_SLINE:
2232             This_Offset = S_GET_VALUE (symbolP);
2233             if (This_Offset > Max_Source_Offset)
2234               Max_Source_Offset = This_Offset;
2235             break;
2236           }
2237       /* If this is the last routine, then we use the PC of the last source
2238          line as a marker of the max PC for which this reg is valid.  */
2239       if (Max_Offset == 0x7fffffff)
2240         Max_Offset = Max_Source_Offset;
2241     }
2242
2243   dbx_type = 0;
2244   str = S_GET_NAME (sp);
2245   if ((pnt = (char *) strchr (str, ':')) == 0)
2246     return;                     /* no colon present */
2247   pnt1 = pnt;                   /* save this for later*/
2248   pnt++;
2249   if (*pnt != 'r')
2250     return;
2251   pnt = cvt_integer (pnt + 1, &dbx_type);
2252   spnt = find_symbol (dbx_type);
2253   if (!spnt)
2254     return;                     /*Dunno what this is yet*/
2255   *pnt1 = '\0';
2256   pnt = fix_name (S_GET_NAME (sp));     /* if there are bad characters in name, convert them */
2257   len = strlen (pnt);
2258   Local[i++] = 25 + len;
2259   Local[i++] = spnt->VMS_type;
2260   Local[i++] = DST_K_VFLAGS_TVS;        /* trailing value specified */
2261   COPY_LONG (&Local[i], 1 + len);       /* relative offset, beyond name */
2262   i += 4;
2263   Local[i++] = len;                     /* name length (ascic prefix) */
2264   while (*pnt != '\0')
2265     Local[i++] = *pnt++;
2266   Local[i++] = DST_K_VS_FOLLOWS;        /* value specification follows */
2267   COPY_SHORT (&Local[i], 15);           /* length of rest of record */
2268   i += 2;
2269   Local[i++] = DST_K_VS_ALLOC_SPLIT;    /* split lifetime */
2270   Local[i++] = 1;                       /* one binding follows */
2271   VMS_Store_Immediate_Data (Local, i, OBJ_S_C_DBG);
2272   i = 0;
2273   VMS_Set_Data (Text_Psect, Min_Offset, OBJ_S_C_DBG, 1);
2274   VMS_Set_Data (Text_Psect, Max_Offset, OBJ_S_C_DBG, 1);
2275   Local[i++] = DST_K_VALKIND_REG;               /* nested value spec */
2276   COPY_LONG (&Local[i], S_GET_VALUE (sp));
2277   i += 4;
2278   VMS_Store_Immediate_Data (Local, i, OBJ_S_C_DBG);
2279   *pnt1 = ':';
2280   if (spnt->VMS_type == DBG_S_C_ADVANCED_TYPE)
2281     generate_suffix (spnt, 0);
2282 }
2283
2284 /* This function examines a structure definition, checking all of the elements
2285    to make sure that all of them are fully defined.  The only thing that we
2286    kick out are arrays of undefined structs, since we do not know how big
2287    they are.  All others we can handle with a normal forward reference.  */
2288
2289 static int
2290 forward_reference (pnt)
2291      char *pnt;
2292 {
2293   struct VMS_DBG_Symbol *spnt, *spnt1;
2294   int i;
2295
2296   pnt = cvt_integer (pnt + 1, &i);
2297   if (*pnt == ';')
2298     return 0;                   /* no forward references */
2299   do
2300     {
2301       pnt = (char *) strchr (pnt, ':');
2302       pnt = cvt_integer (pnt + 1, &i);
2303       spnt = find_symbol (i);
2304       while (spnt && (spnt->advanced == POINTER || spnt->advanced == ARRAY))
2305         {
2306           spnt1 = find_symbol (spnt->type2);
2307           if (spnt->advanced == ARRAY && !spnt1)
2308             return 1;
2309           spnt = spnt1;
2310         }
2311       pnt = cvt_integer (pnt + 1, &i);
2312       pnt = cvt_integer (pnt + 1, &i);
2313     } while (*++pnt != ';');
2314   return 0;                     /* no forward refences found */
2315 }
2316
2317 /* Used to check a single element of a structure on the final pass.  */
2318
2319 static int
2320 final_forward_reference (spnt)
2321      struct VMS_DBG_Symbol *spnt;
2322 {
2323   struct VMS_DBG_Symbol *spnt1;
2324
2325   while (spnt && (spnt->advanced == POINTER || spnt->advanced == ARRAY))
2326     {
2327       spnt1 = find_symbol (spnt->type2);
2328       if (spnt->advanced == ARRAY && !spnt1)
2329         return 1;
2330       spnt = spnt1;
2331     }
2332   return 0;     /* no forward refences found */
2333 }
2334
2335 /* This routine parses the stabs directives to find any definitions of dbx
2336    type numbers.  It makes a note of all of them, creating a structure
2337    element of VMS_DBG_Symbol that describes it.  This also generates the
2338    info for the debugger that describes the struct/union/enum, so that
2339    further references to these data types will be by number
2340
2341    We have to process pointers right away, since there can be references
2342    to them later in the same stabs directive.  We cannot have forward
2343    references to pointers, (but we can have a forward reference to a
2344    pointer to a structure/enum/union) and this is why we process them
2345    immediately.  After we process the pointer, then we search for defs
2346    that are nested even deeper.
2347
2348    8/15/92: We have to process arrays right away too, because there can
2349    be multiple references to identical array types in one structure
2350    definition, and only the first one has the definition.  */
2351
2352 static int
2353 VMS_typedef_parse (str)
2354      char *str;
2355 {
2356   char *pnt;
2357   char *pnt1;
2358   const char *pnt2;
2359   int i;
2360   int dtype;
2361   struct forward_ref *fpnt;
2362   int i1, i2, i3, len;
2363   struct VMS_DBG_Symbol *spnt;
2364   struct VMS_DBG_Symbol *spnt1;
2365
2366   /* check for any nested def's */
2367   pnt = (char *) strchr (str + 1, '=');
2368   if (pnt && str[1] != '*' && (str[1] != 'a' || str[2] != 'r')
2369       && VMS_typedef_parse (pnt) == 1)
2370     return 1;
2371   /* now find dbx_type of entry */
2372   pnt = str - 1;
2373   if (*pnt == 'c')
2374     {                           /* check for static constants */
2375       *str = '\0';              /* for now we ignore them */
2376       return 0;
2377     }
2378   while ((*pnt <= '9') && (*pnt >= '0'))
2379     pnt--;
2380   pnt++;                        /* and get back to the number */
2381   cvt_integer (pnt, &i1);
2382   spnt = find_symbol (i1);
2383   /* first see if this has been defined already, due to forward reference */
2384   if (!spnt)
2385     {
2386       i2 = SYMTYP_HASH (i1);
2387       spnt = (struct VMS_DBG_Symbol *) xmalloc (sizeof (struct VMS_DBG_Symbol));
2388       spnt->next = VMS_Symbol_type_list[i2];
2389       VMS_Symbol_type_list[i2] = spnt;
2390       spnt->dbx_type = i1;      /* and save the type */
2391       spnt->type2 = spnt->VMS_type = spnt->data_size = 0;
2392       spnt->index_min = spnt->index_max = spnt->struc_numb = 0;
2393     }
2394   /*
2395    * For structs and unions, do a partial parse, otherwise we sometimes get
2396    * circular definitions that are impossible to resolve.  We read enough
2397    * info so that any reference to this type has enough info to be resolved.
2398    */
2399   pnt = str + 1;                /* point to character past equal sign */
2400   if (*pnt >= '0' && *pnt <= '9')
2401     {
2402       if (type_check ("void"))
2403         {                       /* this is the void symbol */
2404           *str = '\0';
2405           spnt->advanced = VOID;
2406           return 0;
2407         }
2408       if (type_check ("unknown type"))
2409         {
2410           *str = '\0';
2411           spnt->advanced = UNKNOWN;
2412           return 0;
2413         }
2414       pnt1 = cvt_integer (pnt, &i1);
2415       if (i1 != spnt->dbx_type)
2416         {
2417           spnt->advanced = ALIAS;
2418           spnt->type2 = i1;
2419           strcpy (str, pnt1);
2420           return 0;
2421         }
2422       as_tsktsk (_("debugginer output: %d is an unknown untyped variable."),
2423                  spnt->dbx_type);
2424       return 1;                 /* do not know what this is */
2425     }
2426
2427   pnt = str + 1;                /* point to character past equal sign */
2428   switch (*pnt)
2429     {
2430     case 'r':
2431       spnt->advanced = BASIC;
2432       if (type_check ("int"))
2433         {
2434           spnt->VMS_type = DBG_S_C_SLINT;
2435           spnt->data_size = 4;
2436         }
2437       else if (type_check ("long int"))
2438         {
2439           spnt->VMS_type = DBG_S_C_SLINT;
2440           spnt->data_size = 4;
2441         }
2442       else if (type_check ("unsigned int"))
2443         {
2444           spnt->VMS_type = DBG_S_C_ULINT;
2445           spnt->data_size = 4;
2446         }
2447       else if (type_check ("long unsigned int"))
2448         {
2449           spnt->VMS_type = DBG_S_C_ULINT;
2450           spnt->data_size = 4;
2451         }
2452       else if (type_check ("short int"))
2453         {
2454           spnt->VMS_type = DBG_S_C_SSINT;
2455           spnt->data_size = 2;
2456         }
2457       else if (type_check ("short unsigned int"))
2458         {
2459           spnt->VMS_type = DBG_S_C_USINT;
2460           spnt->data_size = 2;
2461         }
2462       else if (type_check ("char"))
2463         {
2464           spnt->VMS_type = DBG_S_C_SCHAR;
2465           spnt->data_size = 1;
2466         }
2467       else if (type_check ("signed char"))
2468         {
2469           spnt->VMS_type = DBG_S_C_SCHAR;
2470           spnt->data_size = 1;
2471         }
2472       else if (type_check ("unsigned char"))
2473         {
2474           spnt->VMS_type = DBG_S_C_UCHAR;
2475           spnt->data_size = 1;
2476         }
2477       else if (type_check ("float"))
2478         {
2479           spnt->VMS_type = DBG_S_C_REAL4;
2480           spnt->data_size = 4;
2481         }
2482       else if (type_check ("double"))
2483         {
2484           spnt->VMS_type = vax_g_doubles ? DBG_S_C_REAL8_G : DBG_S_C_REAL8;
2485           spnt->data_size = 8;
2486         }
2487       else if (type_check ("long double"))
2488         {
2489           /* same as double, at least for now */
2490           spnt->VMS_type = vax_g_doubles ? DBG_S_C_REAL8_G : DBG_S_C_REAL8;
2491           spnt->data_size = 8;
2492         }
2493       else if (type_check ("long long int"))
2494         {
2495           spnt->VMS_type = DBG_S_C_SQUAD;       /* signed quadword */
2496           spnt->data_size = 8;
2497         }
2498       else if (type_check ("long long unsigned int"))
2499         {
2500           spnt->VMS_type = DBG_S_C_UQUAD;       /* unsigned quadword */
2501           spnt->data_size = 8;
2502         }
2503       else if (type_check ("complex float"))
2504         {
2505           spnt->VMS_type = DBG_S_C_COMPLX4;
2506           spnt->data_size = 2 * 4;
2507         }
2508       else if (type_check ("complex double"))
2509         {
2510           spnt->VMS_type = vax_g_doubles ? DBG_S_C_COMPLX8_G : DBG_S_C_COMPLX8;
2511           spnt->data_size = 2 * 8;
2512         }
2513       else if (type_check ("complex long double"))
2514         {
2515           /* same as complex double, at least for now */
2516           spnt->VMS_type = vax_g_doubles ? DBG_S_C_COMPLX8_G : DBG_S_C_COMPLX8;
2517           spnt->data_size = 2 * 8;
2518         }
2519       else
2520         {
2521           /*    [pr]
2522            * Shouldn't get here, but if we do, something
2523            * more substantial ought to be done...
2524            */
2525           spnt->VMS_type = 0;
2526           spnt->data_size = 0;
2527         }
2528       if (spnt->VMS_type != 0)
2529         setup_basic_type (spnt);
2530       pnt1 = (char *) strchr (str, ';') + 1;
2531       break;
2532     case 's':
2533     case 'u':
2534       spnt->advanced = (*pnt == 's') ? STRUCT : UNION;
2535       spnt->VMS_type = DBG_S_C_ADVANCED_TYPE;
2536       pnt1 = cvt_integer (pnt + 1, &spnt->data_size);
2537       if (!final_pass && forward_reference (pnt))
2538         {
2539           spnt->struc_numb = -1;
2540           return 1;
2541         }
2542       spnt->struc_numb = ++structure_count;
2543       pnt1--;
2544       pnt = get_struct_name (str);
2545       VMS_Def_Struct (spnt->struc_numb);
2546       i = 0;
2547       for (fpnt = f_ref_root; fpnt; fpnt = fpnt->next)
2548         if (fpnt->dbx_type == spnt->dbx_type)
2549           {
2550             fpnt->resolved = 'Y';
2551             VMS_Set_Struct (fpnt->struc_numb);
2552             VMS_Store_Struct (spnt->struc_numb);
2553             i++;
2554           }
2555       if (i > 0)
2556         VMS_Set_Struct (spnt->struc_numb);
2557       i = 0;
2558       Local[i++] = 11 + strlen (pnt);
2559       Local[i++] = DBG_S_C_STRUCT_START;
2560       Local[i++] = DST_K_VFLAGS_NOVAL;  /* structure definition only */
2561       COPY_LONG (&Local[i], 0L);        /* hence value is unused */
2562       i += 4;
2563       Local[i++] = strlen (pnt);
2564       pnt2 = pnt;
2565       while (*pnt2 != '\0')
2566         Local[i++] = *pnt2++;
2567       i2 = spnt->data_size * 8; /* number of bits */
2568       COPY_LONG (&Local[i], i2);
2569       i += 4;
2570       VMS_Store_Immediate_Data (Local, i, OBJ_S_C_DBG);
2571       i = 0;
2572       if (pnt != symbol_name)
2573         {
2574           pnt += strlen (pnt);
2575           *pnt = ':';
2576         }                       /* replace colon for later */
2577       while (*++pnt1 != ';')
2578         {
2579           pnt = (char *) strchr (pnt1, ':');
2580           *pnt = '\0';
2581           pnt2 = pnt1;
2582           pnt1 = cvt_integer (pnt + 1, &dtype);
2583           pnt1 = cvt_integer (pnt1 + 1, &i2);
2584           pnt1 = cvt_integer (pnt1 + 1, &i3);
2585           spnt1 = find_symbol (dtype);
2586           len = strlen (pnt2);
2587           if (spnt1 && (spnt1->advanced == BASIC || spnt1->advanced == ENUM)
2588               && ((i3 != spnt1->data_size * 8) || (i2 % 8 != 0)))
2589             {                   /* bitfield */
2590               if (USE_BITSTRING_DESCRIPTOR (spnt1))
2591                 {
2592                   /* This uses a type descriptor, which doesn't work if
2593                      the enclosing structure has been placed in a register.
2594                      Also, enum bitfields degenerate to simple integers.  */
2595                   int unsigned_type = (spnt1->VMS_type == DBG_S_C_ULINT
2596                                     || spnt1->VMS_type == DBG_S_C_USINT
2597                                     || spnt1->VMS_type == DBG_S_C_UCHAR
2598                                     || spnt1->VMS_type == DBG_S_C_UQUAD
2599                                     || spnt1->advanced == ENUM); /* (approximate) */
2600                   Apoint = 0;
2601                   fpush (19 + len, 1);
2602                   fpush (unsigned_type ? DBG_S_C_UBITU : DBG_S_C_SBITU, 1);
2603                   fpush (DST_K_VFLAGS_DSC, 1);  /* specified by descriptor */
2604                   fpush (1 + len, 4);   /* relative offset to descriptor */
2605                   fpush (len, 1);               /* length byte (ascic prefix) */
2606                   while (*pnt2 != '\0') /* name bytes */
2607                     fpush (*pnt2++, 1);
2608                   fpush (i3, 2);        /* dsc length == size of bitfield */
2609                                         /* dsc type == un?signed bitfield */
2610                   fpush (unsigned_type ? DBG_S_C_UBITU : DBG_S_C_SBITU, 1);
2611                   fpush (DSC_K_CLASS_UBS, 1);   /* dsc class == unaligned bitstring */
2612                   fpush (0x00, 4);              /* dsc pointer == zeroes */
2613                   fpush (i2, 4);        /* start position */
2614                   VMS_Store_Immediate_Data (Asuffix, Apoint, OBJ_S_C_DBG);
2615                   Apoint = 0;
2616                 }
2617               else
2618                 {
2619                   /* Use a "novel length" type specification, which works
2620                      right for register structures and for enum bitfields
2621                      but results in larger object modules.  */
2622                   Local[i++] = 7 + len;
2623                   Local[i++] = DBG_S_C_ADVANCED_TYPE;   /* type spec follows */
2624                   Local[i++] = DBG_S_C_STRUCT_ITEM;     /* value is a bit offset */
2625                   COPY_LONG (&Local[i], i2);            /* bit offset */
2626                   i += 4;
2627                   Local[i++] = strlen (pnt2);
2628                   while (*pnt2 != '\0')
2629                     Local[i++] = *pnt2++;
2630                   VMS_Store_Immediate_Data (Local, i, OBJ_S_C_DBG);
2631                   i = 0;
2632                   bitfield_suffix (spnt1, i3);
2633              }
2634             }
2635           else
2636             {                   /* not a bitfield */
2637               /* check if this is a forward reference */
2638               if (final_pass && final_forward_reference (spnt1))
2639                 {
2640                   as_tsktsk (_("debugger output: structure element `%s' has undefined type"),
2641                            pnt2);
2642                   continue;
2643                 }
2644               Local[i++] = 7 + len;
2645               Local[i++] = spnt1 ? spnt1->VMS_type : DBG_S_C_ADVANCED_TYPE;
2646               Local[i++] = DBG_S_C_STRUCT_ITEM;
2647               COPY_LONG (&Local[i], i2);                /* bit offset */
2648               i += 4;
2649               Local[i++] = strlen (pnt2);
2650               while (*pnt2 != '\0')
2651                 Local[i++] = *pnt2++;
2652               VMS_Store_Immediate_Data (Local, i, OBJ_S_C_DBG);
2653               i = 0;
2654               if (!spnt1)
2655                 generate_suffix (spnt1, dtype);
2656               else if (spnt1->VMS_type == DBG_S_C_ADVANCED_TYPE)
2657                 generate_suffix (spnt1, 0);
2658             }
2659         }
2660       pnt1++;
2661       Local[i++] = 0x01;        /* length byte */
2662       Local[i++] = DBG_S_C_STRUCT_END;
2663       VMS_Store_Immediate_Data (Local, i, OBJ_S_C_DBG);
2664       i = 0;
2665       break;
2666     case 'e':
2667       spnt->advanced = ENUM;
2668       spnt->VMS_type = DBG_S_C_ADVANCED_TYPE;
2669       spnt->struc_numb = ++structure_count;
2670       spnt->data_size = 4;
2671       VMS_Def_Struct (spnt->struc_numb);
2672       i = 0;
2673       for (fpnt = f_ref_root; fpnt; fpnt = fpnt->next)
2674         if (fpnt->dbx_type == spnt->dbx_type)
2675           {
2676             fpnt->resolved = 'Y';
2677             VMS_Set_Struct (fpnt->struc_numb);
2678             VMS_Store_Struct (spnt->struc_numb);
2679             i++;
2680           }
2681       if (i > 0)
2682         VMS_Set_Struct (spnt->struc_numb);
2683       i = 0;
2684       len = strlen (symbol_name);
2685       Local[i++] = 3 + len;
2686       Local[i++] = DBG_S_C_ENUM_START;
2687       Local[i++] = 4 * 8;               /* enum values are 32 bits */
2688       Local[i++] = len;
2689       pnt2 = symbol_name;
2690       while (*pnt2 != '\0')
2691         Local[i++] = *pnt2++;
2692       VMS_Store_Immediate_Data (Local, i, OBJ_S_C_DBG);
2693       i = 0;
2694       while (*++pnt != ';')
2695         {
2696           pnt1 = (char *) strchr (pnt, ':');
2697           *pnt1++ = '\0';
2698           pnt1 = cvt_integer (pnt1, &i1);
2699           len = strlen (pnt);
2700           Local[i++] = 7 + len;
2701           Local[i++] = DBG_S_C_ENUM_ITEM;
2702           Local[i++] = DST_K_VALKIND_LITERAL;
2703           COPY_LONG (&Local[i], i1);
2704           i += 4;
2705           Local[i++] = len;
2706           pnt2 = pnt;
2707           while (*pnt != '\0')
2708             Local[i++] = *pnt++;
2709           VMS_Store_Immediate_Data (Local, i, OBJ_S_C_DBG);
2710           i = 0;
2711           pnt = pnt1;           /* Skip final semicolon */
2712         }
2713       Local[i++] = 0x01;        /* len byte */
2714       Local[i++] = DBG_S_C_ENUM_END;
2715       VMS_Store_Immediate_Data (Local, i, OBJ_S_C_DBG);
2716       i = 0;
2717       pnt1 = pnt + 1;
2718       break;
2719     case 'a':
2720       spnt->advanced = ARRAY;
2721       spnt->VMS_type = DBG_S_C_ADVANCED_TYPE;
2722       pnt = (char *) strchr (pnt, ';');
2723       if (!pnt)
2724         return 1;
2725       pnt1 = cvt_integer (pnt + 1, &spnt->index_min);
2726       pnt1 = cvt_integer (pnt1 + 1, &spnt->index_max);
2727       pnt1 = cvt_integer (pnt1 + 1, &spnt->type2);
2728       pnt = (char *) strchr (str + 1, '=');
2729       if (pnt && VMS_typedef_parse (pnt) == 1)
2730         return 1;
2731       break;
2732     case 'f':
2733       spnt->advanced = FUNCTION;
2734       spnt->VMS_type = DBG_S_C_FUNCTION_ADDR;
2735       /* this masquerades as a basic type*/
2736       spnt->data_size = 4;
2737       pnt1 = cvt_integer (pnt + 1, &spnt->type2);
2738       break;
2739     case '*':
2740       spnt->advanced = POINTER;
2741       spnt->VMS_type = DBG_S_C_ADVANCED_TYPE;
2742       spnt->data_size = 4;
2743       pnt1 = cvt_integer (pnt + 1, &spnt->type2);
2744       pnt = (char *) strchr (str + 1, '=');
2745       if (pnt && VMS_typedef_parse (pnt) == 1)
2746         return 1;
2747       break;
2748     default:
2749       spnt->advanced = UNKNOWN;
2750       spnt->VMS_type = 0;
2751       as_tsktsk (_("debugger output: %d is an unknown type of variable."),
2752                  spnt->dbx_type);
2753       return 1;                 /* unable to decipher */
2754     }
2755   /* This removes the evidence of the definition so that the outer levels
2756      of parsing do not have to worry about it.  */
2757   pnt = str;
2758   while (*pnt1 != '\0')
2759     *pnt++ = *pnt1++;
2760   *pnt = '\0';
2761   return 0;
2762 }
2763
2764 /* This is the root routine that parses the stabs entries for definitions.
2765    it calls VMS_typedef_parse, which can in turn call itself.  We need to
2766    be careful, since sometimes there are forward references to other symbol
2767    types, and these cannot be resolved until we have completed the parse.
2768
2769    Also check and see if we are using continuation stabs, if we are, then
2770    paste together the entire contents of the stab before we pass it to
2771    VMS_typedef_parse.  */
2772
2773 static void
2774 VMS_LSYM_Parse ()
2775 {
2776   char *pnt;
2777   char *pnt1;
2778   char *pnt2;
2779   char *str;
2780   char *parse_buffer = 0;
2781   char fixit[10];
2782   int incomplete, pass, incom1;
2783   struct forward_ref *fpnt;
2784   symbolS *sp;
2785
2786   pass = 0;
2787   final_pass = 0;
2788   incomplete = 0;
2789   do
2790     {
2791       incom1 = incomplete;
2792       incomplete = 0;
2793       for (sp = symbol_rootP; sp; sp = symbol_next (sp))
2794         {
2795           /*
2796            *    Deal with STAB symbols
2797            */
2798           if (S_IS_DEBUG (sp))
2799             {
2800               /*
2801                *        Dispatch on STAB type
2802                */
2803               switch (S_GET_RAW_TYPE (sp))
2804                 {
2805                 case N_GSYM:
2806                 case N_LCSYM:
2807                 case N_STSYM:
2808                 case N_PSYM:
2809                 case N_RSYM:
2810                 case N_LSYM:
2811                 case N_FUN:     /*sometimes these contain typedefs*/
2812                   str = S_GET_NAME (sp);
2813                   symbol_name = str;
2814                   pnt = str + strlen (str) - 1;
2815                   if (*pnt == '?')  /* Continuation stab.  */
2816                     {
2817                       symbolS *spnext;
2818                       int tlen = 0;
2819
2820                       spnext = sp;
2821                       do {
2822                         tlen += strlen (str) - 1;
2823                         spnext = symbol_next (spnext);
2824                         str = S_GET_NAME (spnext);
2825                         pnt = str + strlen (str) - 1;
2826                       } while (*pnt == '?');
2827                       tlen += strlen (str);
2828                       parse_buffer = (char *) xmalloc (tlen + 1);
2829                       strcpy (parse_buffer, S_GET_NAME (sp));
2830                       pnt2 = parse_buffer + strlen (parse_buffer) - 1;
2831                       *pnt2 = '\0';
2832                       spnext = sp;
2833                       do {
2834                         spnext = symbol_next (spnext);
2835                         str = S_GET_NAME (spnext);
2836                         strcat (pnt2, str);
2837                         pnt2 +=  strlen (str) - 1;
2838                         *str = '\0';  /* Erase this string  */
2839                      /* S_SET_NAME (spnext, str); */
2840                         if (*pnt2 != '?') break;
2841                         *pnt2 = '\0';
2842                       } while (1);
2843                       str = parse_buffer;
2844                       symbol_name = str;
2845                     }
2846                   if ((pnt = (char *) strchr (str, ':')) != 0)
2847                     {
2848                       *pnt = '\0';
2849                       pnt1 = pnt + 1;
2850                       if ((pnt2 = (char *) strchr (pnt1, '=')) != 0)
2851                         incomplete += VMS_typedef_parse (pnt2);
2852                       if (parse_buffer)
2853                         {
2854                           /*  At this point the parse buffer should just
2855                               contain name:nn.  If it does not, then we
2856                               are in real trouble.  Anyway, this is always
2857                               shorter than the original line.  */
2858                           pnt2 = S_GET_NAME (sp);
2859                           strcpy (pnt2, parse_buffer);
2860                        /* S_SET_NAME (sp, pnt2); */
2861                           free (parse_buffer),  parse_buffer = 0;
2862                         }
2863                       *pnt = ':';       /* put back colon to restore dbx_type */
2864                     }
2865                   break;
2866                 }               /*switch*/
2867             }                   /* if */
2868         }                       /*for*/
2869       pass++;
2870       /*
2871        * Make one last pass, if needed, and define whatever we can
2872        * that is left.
2873        */
2874       if (final_pass == 0 && incomplete == incom1)
2875         {
2876           final_pass = 1;
2877           incom1++;     /* Force one last pass through */
2878         }
2879   } while (incomplete != 0 && incomplete != incom1);
2880   /* repeat until all refs resolved if possible */
2881 /*      if (pass > 1) printf (" Required %d passes\n", pass); */
2882   if (incomplete != 0)
2883     {
2884       as_tsktsk (_("debugger output: Unable to resolve %d circular references."),
2885                  incomplete);
2886     }
2887   fpnt = f_ref_root;
2888   symbol_name = "\0";
2889   while (fpnt)
2890     {
2891       if (fpnt->resolved != 'Y')
2892         {
2893           if (find_symbol (fpnt->dbx_type))
2894             {
2895               as_tsktsk (_("debugger forward reference error, dbx type %d"),
2896                          fpnt->dbx_type);
2897               break;
2898             }
2899           fixit[0] = 0;
2900           sprintf (&fixit[1], "%d=s4;", fpnt->dbx_type);
2901           pnt2 = (char *) strchr (&fixit[1], '=');
2902           VMS_typedef_parse (pnt2);
2903         }
2904       fpnt = fpnt->next;
2905     }
2906 }
2907
2908 static void
2909 Define_Local_Symbols (s0P, s2P, Current_Routine, Text_Psect)
2910      symbolS *s0P, *s2P;
2911      symbolS *Current_Routine;
2912      int Text_Psect;
2913 {
2914   symbolS *s1P;         /* each symbol from s0P .. s2P (exclusive) */
2915
2916   for (s1P = symbol_next (s0P); s1P != s2P; s1P = symbol_next (s1P))
2917     {
2918       if (!s1P)
2919         break;          /* and return */
2920       if (S_GET_RAW_TYPE (s1P) == N_FUN)
2921         {
2922           char *pnt = (char *) strchr (S_GET_NAME (s1P), ':') + 1;
2923           if (*pnt == 'F' || *pnt == 'f') break;
2924         }
2925       if (!S_IS_DEBUG (s1P))
2926         continue;
2927       /*
2928        *        Dispatch on STAB type
2929        */
2930       switch (S_GET_RAW_TYPE (s1P))
2931         {
2932         default:
2933           continue;             /* not left or right brace */
2934
2935         case N_LSYM:
2936         case N_PSYM:
2937           VMS_local_stab_Parse (s1P);
2938           break;
2939
2940         case N_RSYM:
2941           VMS_RSYM_Parse (s1P, Current_Routine, Text_Psect);
2942           break;
2943         }                       /*switch*/
2944     }                           /* for */
2945 }
2946
2947 /* This function crawls the symbol chain searching for local symbols that
2948    need to be described to the debugger.  When we enter a new scope with
2949    a "{", it creates a new "block", which helps the debugger keep track
2950    of which scope we are currently in.  */
2951
2952 static symbolS *
2953 Define_Routine (s0P, Level, Current_Routine, Text_Psect)
2954      symbolS *s0P;
2955      int Level;
2956      symbolS *Current_Routine;
2957      int Text_Psect;
2958 {
2959   symbolS *s1P;
2960   valueT Offset;
2961   int rcount = 0;
2962
2963   for (s1P = symbol_next (s0P); s1P != 0; s1P = symbol_next (s1P))
2964     {
2965       if (S_GET_RAW_TYPE (s1P) == N_FUN)
2966         {
2967           char *pnt = (char *) strchr (S_GET_NAME (s1P), ':') + 1;
2968           if (*pnt == 'F' || *pnt == 'f') break;
2969         }
2970       if (!S_IS_DEBUG (s1P))
2971         continue;
2972       /*
2973        *        Dispatch on STAB type
2974        */
2975       switch (S_GET_RAW_TYPE (s1P))
2976         {
2977         default:
2978           continue;             /* not left or right brace */
2979
2980         case N_LBRAC:
2981           if (Level != 0)
2982             {
2983               char str[10];
2984               sprintf (str, "$%d", rcount++);
2985               VMS_TBT_Block_Begin (s1P, Text_Psect, str);
2986             }
2987           Offset = S_GET_VALUE (s1P);   /* side-effect: fully resolve symbol */
2988           Define_Local_Symbols (s0P, s1P, Current_Routine, Text_Psect);
2989           s1P = Define_Routine (s1P, Level + 1, Current_Routine, Text_Psect);
2990           if (Level != 0)
2991             VMS_TBT_Block_End (S_GET_VALUE (s1P) - Offset);
2992           s0P = s1P;
2993           break;
2994
2995         case N_RBRAC:
2996           return s1P;
2997         }                       /*switch*/
2998     }                           /* for */
2999
3000   /* We end up here if there were no brackets in this function.
3001      Define everything.  */
3002   Define_Local_Symbols (s0P, (symbolS *)0, Current_Routine, Text_Psect);
3003   return s1P;
3004 }
3005 \f
3006
3007 #ifndef VMS
3008 #include <sys/types.h>
3009 #include <time.h>
3010 static void get_VMS_time_on_unix PARAMS ((char *));
3011
3012 /* Manufacture a VMS-like time string on a Unix based system.  */
3013 static void
3014 get_VMS_time_on_unix (Now)
3015      char *Now;
3016 {
3017   char *pnt;
3018   time_t timeb;
3019
3020   time (&timeb);
3021   pnt = ctime (&timeb);
3022   pnt[3] = 0;
3023   pnt[7] = 0;
3024   pnt[10] = 0;
3025   pnt[16] = 0;
3026   pnt[24] = 0;
3027   sprintf (Now, "%2s-%3s-%s %s", pnt + 8, pnt + 4, pnt + 20, pnt + 11);
3028 }
3029 #endif /* not VMS */
3030
3031 /* Write the MHD (Module Header) records.  */
3032
3033 static void
3034 Write_VMS_MHD_Records ()
3035 {
3036   register const char *cp;
3037   register char *cp1;
3038   register int i;
3039 #ifdef VMS
3040   struct { unsigned short len, mbz; char *ptr; } Descriptor;
3041 #endif
3042   char Now[17+1];
3043
3044   /* We are writing a module header record.  */
3045   Set_VMS_Object_File_Record (OBJ_S_C_HDR);
3046   /*
3047    *    ***************************
3048    *    *MAIN MODULE HEADER RECORD*
3049    *    ***************************
3050    */
3051   /* Store record type and header type.  */
3052   PUT_CHAR (OBJ_S_C_HDR);
3053   PUT_CHAR (MHD_S_C_MHD);
3054   /* Structure level is 0.  */
3055   PUT_CHAR (OBJ_S_C_STRLVL);
3056   /* Maximum record size is size of the object record buffer.  */
3057   PUT_SHORT (sizeof (Object_Record_Buffer));
3058
3059         /*
3060          *      FIXME:  module name and version should be user
3061          *              specifiable via `.ident' and/or `#pragma ident'.
3062          */
3063
3064   /* Get module name (the FILENAME part of the object file).  */
3065   cp = out_file_name;
3066   cp1 = Module_Name;
3067   while (*cp)
3068     {
3069       if (*cp == ']' || *cp == '>' || *cp == ':' || *cp == '/')
3070         {
3071           cp1 = Module_Name;
3072           cp++;
3073           continue;
3074         }
3075       *cp1++ = TOUPPER (*cp++);
3076     }
3077   *cp1 = '\0';
3078
3079   /* Limit it to 31 characters and store in the object record.  */
3080   while (--cp1 >= Module_Name)
3081     if (*cp1 == '.')
3082       *cp1 = '\0';
3083   if (strlen (Module_Name) > 31)
3084     {
3085       if (flag_hash_long_names)
3086         as_tsktsk (_("Module name truncated: %s\n"), Module_Name);
3087       Module_Name[31] = '\0';
3088     }
3089   PUT_COUNTED_STRING (Module_Name);
3090   /* Module Version is "V1.0".  */
3091   PUT_COUNTED_STRING ("V1.0");
3092   /* Creation time is "now" (17 chars of time string): "dd-MMM-yyyy hh:mm".  */
3093 #ifndef VMS
3094   get_VMS_time_on_unix (Now);
3095 #else /* VMS */
3096   Descriptor.len = sizeof Now - 1;
3097   Descriptor.mbz = 0;           /* type & class unspecified */
3098   Descriptor.ptr = Now;
3099   (void) sys$asctim ((unsigned short *)0, &Descriptor, (long *)0, 0);
3100 #endif /* VMS */
3101   for (i = 0; i < 17; i++)
3102     PUT_CHAR (Now[i]);
3103   /* Patch time is "never" (17 zeros).  */
3104   for (i = 0; i < 17; i++)
3105     PUT_CHAR (0);
3106   /* Force this to be a separate output record.  */
3107   Flush_VMS_Object_Record_Buffer ();
3108
3109   /*
3110    *    *************************
3111    *    *LANGUAGE PROCESSOR NAME*
3112    *    *************************
3113    */
3114   /* Store record type and header type.  */
3115   PUT_CHAR (OBJ_S_C_HDR);
3116   PUT_CHAR (MHD_S_C_LNM);
3117   /*
3118    * Store language processor name and version (not a counted string!).
3119    *
3120    * This is normally supplied by the gcc driver for the command line
3121    * which invokes gas.  If absent, we fall back to gas's version.
3122    */
3123   cp = compiler_version_string;
3124   if (cp == 0)
3125     {
3126       cp = "GNU AS  V";
3127       while (*cp)
3128         PUT_CHAR (*cp++);
3129       cp = VERSION;
3130     }
3131   while (*cp >= ' ')
3132     PUT_CHAR (*cp++);
3133   /* Force this to be a separate output record.  */
3134   Flush_VMS_Object_Record_Buffer ();
3135 }
3136
3137 /* Write the EOM (End Of Module) record.  */
3138
3139 static void
3140 Write_VMS_EOM_Record (Psect, Offset)
3141      int Psect;
3142      valueT Offset;
3143 {
3144   /*
3145    *    We are writing an end-of-module record
3146    *    (this assumes that the entry point will always be in a psect
3147    *     represented by a single byte, which is the case for code in
3148    *     Text_Psect==0)
3149    */
3150   Set_VMS_Object_File_Record (OBJ_S_C_EOM);
3151   PUT_CHAR (OBJ_S_C_EOM);       /* Record type.  */
3152   PUT_CHAR (0);                 /* Error severity level (we ignore it).  */
3153   /*
3154    *    Store the entry point, if it exists
3155    */
3156   if (Psect >= 0)
3157     {
3158       PUT_CHAR (Psect);
3159       PUT_LONG (Offset);
3160     }
3161   /* Flush the record; this will be our final output.  */
3162   Flush_VMS_Object_Record_Buffer ();
3163 }
3164 \f
3165
3166 /* this hash routine borrowed from GNU-EMACS, and strengthened slightly  ERY*/
3167
3168 static int
3169 hash_string (ptr)
3170      const char *ptr;
3171 {
3172   register const unsigned char *p = (unsigned char *) ptr;
3173   register const unsigned char *end = p + strlen (ptr);
3174   register unsigned char c;
3175   register int hash = 0;
3176
3177   while (p != end)
3178     {
3179       c = *p++;
3180       hash = ((hash << 3) + (hash << 15) + (hash >> 28) + c);
3181     }
3182   return hash;
3183 }
3184
3185 /*
3186  *      Generate a Case-Hacked VMS symbol name (limited to 31 chars)
3187  */
3188 static void
3189 VMS_Case_Hack_Symbol (In, Out)
3190      register const char *In;
3191      register char *Out;
3192 {
3193   long int init;
3194   long int result;
3195   char *pnt = 0;
3196   char *new_name;
3197   const char *old_name;
3198   register int i;
3199   int destructor = 0;           /*hack to allow for case sens in a destructor*/
3200   int truncate = 0;
3201   int Case_Hack_Bits = 0;
3202   int Saw_Dollar = 0;
3203   static char Hex_Table[16] =
3204   {'0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F'};
3205
3206   /*
3207    *    Kill any leading "_"
3208    */
3209   if ((In[0] == '_') && ((In[1] > '9') || (In[1] < '0')))
3210     In++;
3211
3212   new_name = Out;               /* save this for later*/
3213
3214 #if barfoo                      /* Dead code */
3215   if ((In[0] == '_') && (In[1] == '$') && (In[2] == '_'))
3216     destructor = 1;
3217 #endif
3218
3219   /* We may need to truncate the symbol, save the hash for later*/
3220   result = (strlen (In) > 23) ? hash_string (In) : 0;
3221   /*
3222    *    Is there a Psect Attribute to skip??
3223    */
3224   if (HAS_PSECT_ATTRIBUTES (In))
3225     {
3226       /*
3227        *        Yes: Skip it
3228        */
3229       In += PSECT_ATTRIBUTES_STRING_LENGTH;
3230       while (*In)
3231         {
3232           if ((In[0] == '$') && (In[1] == '$'))
3233             {
3234               In += 2;
3235               break;
3236             }
3237           In++;
3238         }
3239     }
3240
3241   old_name = In;
3242 /*      if (strlen (In) > 31 && flag_hash_long_names)
3243           as_tsktsk ("Symbol name truncated: %s\n", In); */
3244   /*
3245    *    Do the case conversion
3246    */
3247   i = 23;                       /* Maximum of 23 chars */
3248   while (*In && (--i >= 0))
3249     {
3250       Case_Hack_Bits <<= 1;
3251       if (*In == '$')
3252         Saw_Dollar = 1;
3253       if ((destructor == 1) && (i == 21))
3254         Saw_Dollar = 0;
3255       switch (vms_name_mapping)
3256         {
3257         case 0:
3258           if (ISUPPER (*In)) {
3259             *Out++ = *In++;
3260             Case_Hack_Bits |= 1;
3261           } else {
3262             *Out++ = TOUPPER (*In++);
3263           }
3264           break;
3265         case 3: *Out++ = *In++;
3266           break;
3267         case 2:
3268           if (ISLOWER (*In)) {
3269             *Out++ = *In++;
3270           } else {
3271             *Out++ = TOLOWER (*In++);
3272           }
3273           break;
3274         }
3275     }
3276   /*
3277    *    If we saw a dollar sign, we don't do case hacking
3278    */
3279   if (flag_no_hash_mixed_case || Saw_Dollar)
3280     Case_Hack_Bits = 0;
3281
3282   /*
3283    *    If we have more than 23 characters and everything is lowercase
3284    *    we can insert the full 31 characters
3285    */
3286   if (*In)
3287     {
3288       /*
3289        *        We  have more than 23 characters
3290        * If we must add the case hack, then we have truncated the str
3291        */
3292       pnt = Out;
3293       truncate = 1;
3294       if (Case_Hack_Bits == 0)
3295         {
3296           /*
3297            *    And so far they are all lower case:
3298            *            Check up to 8 more characters
3299            *            and ensure that they are lowercase
3300            */
3301           for (i = 0; (In[i] != 0) && (i < 8); i++)
3302             if (ISUPPER (In[i]) && !Saw_Dollar && !flag_no_hash_mixed_case)
3303               break;
3304
3305           if (In[i] == 0)
3306             truncate = 0;
3307
3308           if ((i == 8) || (In[i] == 0))
3309             {
3310               /*
3311                *        They are:  Copy up to 31 characters
3312                *                        to the output string
3313                */
3314               i = 8;
3315               while ((--i >= 0) && (*In))
3316                 switch (vms_name_mapping){
3317                 case 0: *Out++ = TOUPPER (*In++);
3318                   break;
3319                 case 3: *Out++ = *In++;
3320                   break;
3321                 case 2: *Out++ = TOLOWER (*In++);
3322                   break;
3323                 }
3324             }
3325         }
3326     }
3327   /*
3328    *    If there were any uppercase characters in the name we
3329    *    take on the case hacking string
3330    */
3331
3332   /* Old behavior for regular GNU-C compiler */
3333   if (!flag_hash_long_names)
3334     truncate = 0;
3335   if ((Case_Hack_Bits != 0) || (truncate == 1))
3336     {
3337       if (truncate == 0)
3338         {
3339           *Out++ = '_';
3340           for (i = 0; i < 6; i++)
3341             {
3342               *Out++ = Hex_Table[Case_Hack_Bits & 0xf];
3343               Case_Hack_Bits >>= 4;
3344             }
3345           *Out++ = 'X';
3346         }
3347       else
3348         {
3349           Out = pnt;            /*Cut back to 23 characters maximum */
3350           *Out++ = '_';
3351           for (i = 0; i < 7; i++)
3352             {
3353               init = result & 0x01f;
3354               *Out++ = (init < 10) ? ('0' + init) : ('A' + init - 10);
3355               result = result >> 5;
3356             }
3357         }
3358     }                           /*Case Hack */
3359   /*
3360    *    Done
3361    */
3362   *Out = 0;
3363   if (truncate == 1 && flag_hash_long_names && flag_show_after_trunc)
3364     as_tsktsk (_("Symbol %s replaced by %s\n"), old_name, new_name);
3365 }
3366 \f
3367
3368 /*
3369  *      Scan a symbol name for a psect attribute specification
3370  */
3371 #define GLOBALSYMBOL_BIT        0x10000
3372 #define GLOBALVALUE_BIT         0x20000
3373
3374 static void
3375 VMS_Modify_Psect_Attributes (Name, Attribute_Pointer)
3376      const char *Name;
3377      int *Attribute_Pointer;
3378 {
3379   register int i;
3380   register const char *cp;
3381   int Negate;
3382   static const struct
3383   {
3384     const char *Name;
3385     int Value;
3386   } Attributes[] =
3387   {
3388     {"PIC", GPS_S_M_PIC},
3389     {"LIB", GPS_S_M_LIB},
3390     {"OVR", GPS_S_M_OVR},
3391     {"REL", GPS_S_M_REL},
3392     {"GBL", GPS_S_M_GBL},
3393     {"SHR", GPS_S_M_SHR},
3394     {"EXE", GPS_S_M_EXE},
3395     {"RD", GPS_S_M_RD},
3396     {"WRT", GPS_S_M_WRT},
3397     {"VEC", GPS_S_M_VEC},
3398     {"GLOBALSYMBOL", GLOBALSYMBOL_BIT},
3399     {"GLOBALVALUE", GLOBALVALUE_BIT},
3400     {0, 0}
3401   };
3402
3403   /*
3404    *    Kill leading "_"
3405    */
3406   if (*Name == '_')
3407     Name++;
3408   /*
3409    *    Check for a PSECT attribute list
3410    */
3411   if (!HAS_PSECT_ATTRIBUTES (Name))
3412     return;                     /* If not, return */
3413   /*
3414    *    Skip the attribute list indicator
3415    */
3416   Name += PSECT_ATTRIBUTES_STRING_LENGTH;
3417   /*
3418    *    Process the attributes ("_" separated, "$" terminated)
3419    */
3420   while (*Name != '$')
3421     {
3422       /*
3423        *        Assume not negating
3424        */
3425       Negate = 0;
3426       /*
3427        *        Check for "NO"
3428        */
3429       if ((Name[0] == 'N') && (Name[1] == 'O'))
3430         {
3431           /*
3432            *    We are negating (and skip the NO)
3433            */
3434           Negate = 1;
3435           Name += 2;
3436         }
3437       /*
3438        *        Find the token delimiter
3439        */
3440       cp = Name;
3441       while (*cp && (*cp != '_') && (*cp != '$'))
3442         cp++;
3443       /*
3444        *        Look for the token in the attribute list
3445        */
3446       for (i = 0; Attributes[i].Name; i++)
3447         {
3448           /*
3449            *    If the strings match, set/clear the attr.
3450            */
3451           if (strncmp (Name, Attributes[i].Name, cp - Name) == 0)
3452             {
3453               /*
3454                *        Set or clear
3455                */
3456               if (Negate)
3457                 *Attribute_Pointer &=
3458                   ~Attributes[i].Value;
3459               else
3460                 *Attribute_Pointer |=
3461                   Attributes[i].Value;
3462               /*
3463                *        Done
3464                */
3465               break;
3466             }
3467         }
3468       /*
3469        *        Now skip the attribute
3470        */
3471       Name = cp;
3472       if (*Name == '_')
3473         Name++;
3474     }
3475 }
3476 \f
3477
3478 #define GBLSYM_REF 0
3479 #define GBLSYM_DEF 1
3480 #define GBLSYM_VAL 2
3481 #define GBLSYM_LCL 4    /* not GBL after all...  */
3482 #define GBLSYM_WEAK 8
3483
3484 /*
3485  *      Define a global symbol (or possibly a local one).
3486  */
3487 static void
3488 VMS_Global_Symbol_Spec (Name, Psect_Number, Psect_Offset, Flags)
3489      const char *Name;
3490      int Psect_Number;
3491      int Psect_Offset;
3492      int Flags;
3493 {
3494   char Local[32];
3495
3496   /*
3497    *    We are writing a GSD record
3498    */
3499   Set_VMS_Object_File_Record (OBJ_S_C_GSD);
3500   /*
3501    *    If the buffer is empty we must insert the GSD record type
3502    */
3503   if (Object_Record_Offset == 0)
3504     PUT_CHAR (OBJ_S_C_GSD);
3505   /*
3506    *    We are writing a Global (or local) symbol definition subrecord.
3507    */
3508   PUT_CHAR ((Flags & GBLSYM_LCL) != 0 ? GSD_S_C_LSY :
3509             ((unsigned) Psect_Number <= 255) ? GSD_S_C_SYM : GSD_S_C_SYMW);
3510   /*
3511    *    Data type is undefined
3512    */
3513   PUT_CHAR (0);
3514   /*
3515    *    Switch on Definition/Reference
3516    */
3517   if ((Flags & GBLSYM_DEF) == 0)
3518     {
3519       /*
3520        *        Reference
3521        */
3522       PUT_SHORT (((Flags & GBLSYM_VAL) == 0) ? GSY_S_M_REL : 0);
3523       if ((Flags & GBLSYM_LCL) != 0)    /* local symbols have extra field */
3524         PUT_SHORT (Current_Environment);
3525     }
3526   else
3527     {
3528       int sym_flags;
3529
3530       /*
3531        *        Definition
3532        *[ assert (LSY_S_M_DEF == GSY_S_M_DEF && LSY_S_M_REL == GSY_S_M_REL); ]
3533        */
3534       sym_flags = GSY_S_M_DEF;
3535       if (Flags & GBLSYM_WEAK)
3536         sym_flags |= GSY_S_M_WEAK;
3537       if ((Flags & GBLSYM_VAL) == 0)
3538         sym_flags |= GSY_S_M_REL;
3539       PUT_SHORT (sym_flags);
3540       if ((Flags & GBLSYM_LCL) != 0)    /* local symbols have extra field */
3541         PUT_SHORT (Current_Environment);
3542       /*
3543        *        Psect Number
3544        */
3545       if ((Flags & GBLSYM_LCL) == 0 && (unsigned) Psect_Number <= 255)
3546         PUT_CHAR (Psect_Number);
3547       else
3548         PUT_SHORT (Psect_Number);
3549       /*
3550        *        Offset
3551        */
3552       PUT_LONG (Psect_Offset);
3553     }
3554   /*
3555    *    Finally, the global symbol name
3556    */
3557   VMS_Case_Hack_Symbol (Name, Local);
3558   PUT_COUNTED_STRING (Local);
3559   /*
3560    *    Flush the buffer if it is more than 75% full
3561    */
3562   if (Object_Record_Offset > (sizeof (Object_Record_Buffer) * 3 / 4))
3563     Flush_VMS_Object_Record_Buffer ();
3564 }
3565
3566 /*
3567  *      Define an environment to support local symbol references.
3568  *      This is just to mollify the linker; we don't actually do
3569  *      anything useful with it.
3570  */
3571 static void
3572 VMS_Local_Environment_Setup (Env_Name)
3573     const char *Env_Name;
3574 {
3575   /* We are writing a GSD record.  */
3576   Set_VMS_Object_File_Record (OBJ_S_C_GSD);
3577   /* If the buffer is empty we must insert the GSD record type.  */
3578   if (Object_Record_Offset == 0)
3579     PUT_CHAR (OBJ_S_C_GSD);
3580   /* We are writing an ENV subrecord.  */
3581   PUT_CHAR (GSD_S_C_ENV);
3582
3583   ++Current_Environment;        /* index of environment being defined */
3584
3585   /* ENV$W_FLAGS:  we are defining the next environment.  It's not nested.  */
3586   PUT_SHORT (ENV_S_M_DEF);
3587   /* ENV$W_ENVINDX:  index is always 0 for non-nested definitions.  */
3588   PUT_SHORT (0);
3589
3590   /* ENV$B_NAMLNG + ENV$T_NAME:  environment name in ASCIC format.  */
3591   if (!Env_Name) Env_Name = "";
3592   PUT_COUNTED_STRING ((char *)Env_Name);
3593
3594   /* Flush the buffer if it is more than 75% full.  */
3595   if (Object_Record_Offset > (sizeof (Object_Record_Buffer) * 3 / 4))
3596     Flush_VMS_Object_Record_Buffer ();
3597 }
3598 \f
3599
3600 /*
3601  *      Define a psect
3602  */
3603 static int
3604 VMS_Psect_Spec (Name, Size, Type, vsp)
3605      const char *Name;
3606      int Size;
3607      enum ps_type Type;
3608      struct VMS_Symbol *vsp;
3609 {
3610   char Local[32];
3611   int Psect_Attributes;
3612
3613   /*
3614    *    Generate the appropriate PSECT flags given the PSECT type
3615    */
3616   switch (Type)
3617     {
3618     case ps_TEXT:
3619       /* Text psects are PIC,noOVR,REL,noGBL,SHR,EXE,RD,noWRT.  */
3620       Psect_Attributes = (GPS_S_M_PIC|GPS_S_M_REL|GPS_S_M_SHR|GPS_S_M_EXE
3621                           |GPS_S_M_RD);
3622       break;
3623     case ps_DATA:
3624       /* Data psects are PIC,noOVR,REL,noGBL,noSHR,noEXE,RD,WRT.  */
3625       Psect_Attributes = (GPS_S_M_PIC|GPS_S_M_REL|GPS_S_M_RD|GPS_S_M_WRT);
3626       break;
3627     case ps_COMMON:
3628       /* Common block psects are:  PIC,OVR,REL,GBL,noSHR,noEXE,RD,WRT.  */
3629       Psect_Attributes = (GPS_S_M_PIC|GPS_S_M_OVR|GPS_S_M_REL|GPS_S_M_GBL
3630                           |GPS_S_M_RD|GPS_S_M_WRT);
3631       break;
3632     case ps_CONST:
3633       /* Const data psects are:  PIC,OVR,REL,GBL,noSHR,noEXE,RD,noWRT.  */
3634       Psect_Attributes = (GPS_S_M_PIC|GPS_S_M_OVR|GPS_S_M_REL|GPS_S_M_GBL
3635                           |GPS_S_M_RD);
3636       break;
3637     case ps_CTORS:
3638       /* Ctor psects are PIC,noOVR,REL,GBL,noSHR,noEXE,RD,noWRT.  */
3639       Psect_Attributes = (GPS_S_M_PIC|GPS_S_M_REL|GPS_S_M_GBL|GPS_S_M_RD);
3640       break;
3641     case ps_DTORS:
3642       /* Dtor psects are PIC,noOVR,REL,GBL,noSHR,noEXE,RD,noWRT.  */
3643       Psect_Attributes = (GPS_S_M_PIC|GPS_S_M_REL|GPS_S_M_GBL|GPS_S_M_RD);
3644       break;
3645     default:
3646       /* impossible */
3647       error (_("Unknown VMS psect type (%ld)"), (long) Type);
3648       break;
3649     }
3650   /*
3651    *    Modify the psect attributes according to any attribute string
3652    */
3653   if (vsp && S_GET_TYPE (vsp->Symbol) == N_ABS)
3654     Psect_Attributes |= GLOBALVALUE_BIT;
3655   else if (HAS_PSECT_ATTRIBUTES (Name))
3656     VMS_Modify_Psect_Attributes (Name, &Psect_Attributes);
3657   /*
3658    *    Check for globalref/def/val.
3659    */
3660   if ((Psect_Attributes & GLOBALVALUE_BIT) != 0)
3661     {
3662       /*
3663        * globalvalue symbols were generated before. This code
3664        * prevents unsightly psect buildup, and makes sure that
3665        * fixup references are emitted correctly.
3666        */
3667       vsp->Psect_Index = -1;    /* to catch errors */
3668       S_SET_TYPE (vsp->Symbol, N_UNDF);         /* make refs work */
3669       return 1;                 /* decrement psect counter */
3670     }
3671
3672   if ((Psect_Attributes & GLOBALSYMBOL_BIT) != 0)
3673     {
3674       switch (S_GET_RAW_TYPE (vsp->Symbol))
3675         {
3676         case N_UNDF | N_EXT:
3677           VMS_Global_Symbol_Spec (Name, vsp->Psect_Index,
3678                                   vsp->Psect_Offset, GBLSYM_REF);
3679           vsp->Psect_Index = -1;
3680           S_SET_TYPE (vsp->Symbol, N_UNDF);
3681           return 1;             /* return and indicate no psect */
3682         case N_DATA | N_EXT:
3683           VMS_Global_Symbol_Spec (Name, vsp->Psect_Index,
3684                                   vsp->Psect_Offset, GBLSYM_DEF);
3685           /* In this case we still generate the psect */
3686           break;
3687         default:
3688           as_fatal (_("Globalsymbol attribute for symbol %s was unexpected."),
3689                     Name);
3690           break;
3691         }                       /* switch */
3692     }
3693
3694   Psect_Attributes &= 0xffff;   /* clear out the globalref/def stuff */
3695   /*
3696    *    We are writing a GSD record
3697    */
3698   Set_VMS_Object_File_Record (OBJ_S_C_GSD);
3699   /*
3700    *    If the buffer is empty we must insert the GSD record type
3701    */
3702   if (Object_Record_Offset == 0)
3703     PUT_CHAR (OBJ_S_C_GSD);
3704   /*
3705    *    We are writing a PSECT definition subrecord
3706    */
3707   PUT_CHAR (GSD_S_C_PSC);
3708   /*
3709    *    Psects are always LONGWORD aligned
3710    */
3711   PUT_CHAR (2);
3712   /*
3713    *    Specify the psect attributes
3714    */
3715   PUT_SHORT (Psect_Attributes);
3716   /*
3717    *    Specify the allocation
3718    */
3719   PUT_LONG (Size);
3720   /*
3721    *    Finally, the psect name
3722    */
3723   VMS_Case_Hack_Symbol (Name, Local);
3724   PUT_COUNTED_STRING (Local);
3725   /*
3726    *    Flush the buffer if it is more than 75% full
3727    */
3728   if (Object_Record_Offset > (sizeof (Object_Record_Buffer) * 3 / 4))
3729     Flush_VMS_Object_Record_Buffer ();
3730   return 0;
3731 }
3732 \f
3733
3734 /* Given the pointer to a symbol we calculate how big the data at the
3735    symbol is.  We do this by looking for the next symbol (local or global)
3736    which will indicate the start of another datum.  */
3737
3738 static offsetT
3739 VMS_Initialized_Data_Size (s0P, End_Of_Data)
3740      register symbolS *s0P;
3741      unsigned End_Of_Data;
3742 {
3743   symbolS *s1P;
3744   valueT s0P_val = S_GET_VALUE (s0P), s1P_val,
3745          nearest_val = (valueT) End_Of_Data;
3746
3747   /* Find the nearest symbol what follows this one.  */
3748   for (s1P = symbol_rootP; s1P; s1P = symbol_next (s1P))
3749     {
3750       /* The data type must match.  */
3751       if (S_GET_TYPE (s1P) != N_DATA)
3752         continue;
3753       s1P_val = S_GET_VALUE (s1P);
3754       if (s1P_val > s0P_val && s1P_val < nearest_val)
3755         nearest_val = s1P_val;
3756     }
3757   /* Calculate its size.  */
3758   return (offsetT) (nearest_val - s0P_val);
3759 }
3760
3761 /* Check symbol names for the Psect hack with a globalvalue, and then
3762    generate globalvalues for those that have it.  */
3763
3764 static void
3765 VMS_Emit_Globalvalues (text_siz, data_siz, Data_Segment)
3766      unsigned text_siz;
3767      unsigned data_siz;
3768      char *Data_Segment;
3769 {
3770   register symbolS *sp;
3771   char *stripped_name, *Name;
3772   int Size;
3773   int Psect_Attributes;
3774   int globalvalue;
3775   int typ, abstyp;
3776
3777   /*
3778    * Scan the symbol table for globalvalues, and emit def/ref when
3779    * required.  These will be caught again later and converted to
3780    * N_UNDF
3781    */
3782   for (sp = symbol_rootP; sp; sp = sp->sy_next)
3783     {
3784       typ = S_GET_RAW_TYPE (sp);
3785       abstyp = ((typ & ~N_EXT) == N_ABS);
3786       /*
3787        *        See if this is something we want to look at.
3788        */
3789       if (!abstyp &&
3790           typ != (N_DATA | N_EXT) &&
3791           typ != (N_UNDF | N_EXT))
3792         continue;
3793       /*
3794        *        See if this has globalvalue specification.
3795        */
3796       Name = S_GET_NAME (sp);
3797
3798       if (abstyp)
3799         {
3800           stripped_name = 0;
3801           Psect_Attributes = GLOBALVALUE_BIT;
3802         }
3803       else if (HAS_PSECT_ATTRIBUTES (Name))
3804         {
3805           stripped_name = (char *) xmalloc (strlen (Name) + 1);
3806           strcpy (stripped_name, Name);
3807           Psect_Attributes = 0;
3808           VMS_Modify_Psect_Attributes (stripped_name, &Psect_Attributes);
3809         }
3810       else
3811         continue;
3812
3813       if ((Psect_Attributes & GLOBALVALUE_BIT) != 0)
3814         {
3815           switch (typ)
3816             {
3817             case N_ABS:
3818               /* Local symbol references will want
3819                  to have an environment defined.  */
3820               if (Current_Environment < 0)
3821                 VMS_Local_Environment_Setup (".N_ABS");
3822               VMS_Global_Symbol_Spec (Name, 0,
3823                                       S_GET_VALUE (sp),
3824                                       GBLSYM_DEF|GBLSYM_VAL|GBLSYM_LCL);
3825               break;
3826             case N_ABS | N_EXT:
3827               VMS_Global_Symbol_Spec (Name, 0,
3828                                       S_GET_VALUE (sp),
3829                                       GBLSYM_DEF|GBLSYM_VAL);
3830               break;
3831             case N_UNDF | N_EXT:
3832               VMS_Global_Symbol_Spec (stripped_name, 0, 0, GBLSYM_VAL);
3833               break;
3834             case N_DATA | N_EXT:
3835               Size = VMS_Initialized_Data_Size (sp, text_siz + data_siz);
3836               if (Size > 4)
3837                 error (_("Invalid data type for globalvalue"));
3838               globalvalue = md_chars_to_number (Data_Segment +
3839                      S_GET_VALUE (sp) - text_siz , Size);
3840               /* Three times for good luck.  The linker seems to get confused
3841                  if there are fewer than three */
3842               VMS_Global_Symbol_Spec (stripped_name, 0, 0, GBLSYM_VAL);
3843               VMS_Global_Symbol_Spec (stripped_name, 0, globalvalue,
3844                                       GBLSYM_DEF|GBLSYM_VAL);
3845               VMS_Global_Symbol_Spec (stripped_name, 0, globalvalue,
3846                                       GBLSYM_DEF|GBLSYM_VAL);
3847               break;
3848             default:
3849               as_warn (_("Invalid globalvalue of %s"), stripped_name);
3850               break;
3851             }                   /* switch */
3852         }                       /* if */
3853       if (stripped_name) free (stripped_name);  /* clean up */
3854     }                           /* for */
3855
3856 }
3857 \f
3858
3859 /*
3860  *      Define a procedure entry pt/mask
3861  */
3862 static void
3863 VMS_Procedure_Entry_Pt (Name, Psect_Number, Psect_Offset, Entry_Mask)
3864      char *Name;
3865      int Psect_Number;
3866      int Psect_Offset;
3867      int Entry_Mask;
3868 {
3869   char Local[32];
3870
3871   /*
3872    *    We are writing a GSD record
3873    */
3874   Set_VMS_Object_File_Record (OBJ_S_C_GSD);
3875   /*
3876    *    If the buffer is empty we must insert the GSD record type
3877    */
3878   if (Object_Record_Offset == 0)
3879     PUT_CHAR (OBJ_S_C_GSD);
3880   /*
3881    *    We are writing a Procedure Entry Pt/Mask subrecord
3882    */
3883   PUT_CHAR (((unsigned) Psect_Number <= 255) ? GSD_S_C_EPM : GSD_S_C_EPMW);
3884   /*
3885    *    Data type is undefined
3886    */
3887   PUT_CHAR (0);
3888   /*
3889    *    Flags = "RELOCATABLE" and "DEFINED"
3890    */
3891   PUT_SHORT (GSY_S_M_DEF | GSY_S_M_REL);
3892   /*
3893    *    Psect Number
3894    */
3895   if ((unsigned) Psect_Number <= 255)
3896     PUT_CHAR (Psect_Number);
3897   else
3898     PUT_SHORT (Psect_Number);
3899   /*
3900    *    Offset
3901    */
3902   PUT_LONG (Psect_Offset);
3903   /*
3904    *    Entry mask
3905    */
3906   PUT_SHORT (Entry_Mask);
3907   /*
3908    *    Finally, the global symbol name
3909    */
3910   VMS_Case_Hack_Symbol (Name, Local);
3911   PUT_COUNTED_STRING (Local);
3912   /*
3913    *    Flush the buffer if it is more than 75% full
3914    */
3915   if (Object_Record_Offset > (sizeof (Object_Record_Buffer) * 3 / 4))
3916     Flush_VMS_Object_Record_Buffer ();
3917 }
3918 \f
3919
3920 /*
3921  *      Set the current location counter to a particular Psect and Offset
3922  */
3923 static void
3924 VMS_Set_Psect (Psect_Index, Offset, Record_Type)
3925      int Psect_Index;
3926      int Offset;
3927      int Record_Type;
3928 {
3929   /*
3930    *    We are writing a "Record_Type" record
3931    */
3932   Set_VMS_Object_File_Record (Record_Type);
3933   /*
3934    *    If the buffer is empty we must insert the record type
3935    */
3936   if (Object_Record_Offset == 0)
3937     PUT_CHAR (Record_Type);
3938   /*
3939    *    Stack the Psect base + Offset
3940    */
3941   vms_tir_stack_psect (Psect_Index, Offset, 0);
3942   /*
3943    *    Set relocation base
3944    */
3945   PUT_CHAR (TIR_S_C_CTL_SETRB);
3946   /*
3947    *    Flush the buffer if it is more than 75% full
3948    */
3949   if (Object_Record_Offset > (sizeof (Object_Record_Buffer) * 3 / 4))
3950     Flush_VMS_Object_Record_Buffer ();
3951 }
3952 \f
3953
3954 /*
3955  *      Store repeated immediate data in current Psect
3956  */
3957 static void
3958 VMS_Store_Repeated_Data (Repeat_Count, Pointer, Size, Record_Type)
3959      int Repeat_Count;
3960      register char *Pointer;
3961      int Size;
3962      int Record_Type;
3963 {
3964
3965   /*
3966    *    Ignore zero bytes/words/longwords
3967    */
3968   switch (Size)
3969     {
3970     case 4:
3971       if (Pointer[3] != 0 || Pointer[2] != 0) break;
3972       /* else FALLTHRU */
3973     case 2:
3974       if (Pointer[1] != 0) break;
3975       /* else FALLTHRU */
3976     case 1:
3977       if (Pointer[0] != 0) break;
3978       /* zero value */
3979       return;
3980     default:
3981       break;
3982     }
3983   /*
3984    *    If the data is too big for a TIR_S_C_STO_RIVB sub-record
3985    *    then we do it manually
3986    */
3987   if (Size > 255)
3988     {
3989       while (--Repeat_Count >= 0)
3990         VMS_Store_Immediate_Data (Pointer, Size, Record_Type);
3991       return;
3992     }
3993   /*
3994    *    We are writing a "Record_Type" record
3995    */
3996   Set_VMS_Object_File_Record (Record_Type);
3997   /*
3998    *    If the buffer is empty we must insert record type
3999    */
4000   if (Object_Record_Offset == 0)
4001     PUT_CHAR (Record_Type);
4002   /*
4003    *    Stack the repeat count
4004    */
4005   PUT_CHAR (TIR_S_C_STA_LW);
4006   PUT_LONG (Repeat_Count);
4007   /*
4008    *    And now the command and its data
4009    */
4010   PUT_CHAR (TIR_S_C_STO_RIVB);
4011   PUT_CHAR (Size);
4012   while (--Size >= 0)
4013     PUT_CHAR (*Pointer++);
4014   /*
4015    *    Flush the buffer if it is more than 75% full
4016    */
4017   if (Object_Record_Offset > (sizeof (Object_Record_Buffer) * 3 / 4))
4018     Flush_VMS_Object_Record_Buffer ();
4019 }
4020 \f
4021
4022 /*
4023  *      Store a Position Independent Reference
4024  */
4025 static void
4026 VMS_Store_PIC_Symbol_Reference (Symbol, Offset, PC_Relative,
4027                                 Psect, Psect_Offset, Record_Type)
4028      symbolS *Symbol;
4029      int Offset;
4030      int PC_Relative;
4031      int Psect;
4032      int Psect_Offset;
4033      int Record_Type;
4034 {
4035   register struct VMS_Symbol *vsp = Symbol->sy_obj;
4036   char Local[32];
4037   int local_sym = 0;
4038
4039   /*
4040    *    We are writing a "Record_Type" record
4041    */
4042   Set_VMS_Object_File_Record (Record_Type);
4043   /*
4044    *    If the buffer is empty we must insert record type
4045    */
4046   if (Object_Record_Offset == 0)
4047     PUT_CHAR (Record_Type);
4048   /*
4049    *    Set to the appropriate offset in the Psect.
4050    *    For a Code reference we need to fix the operand
4051    *    specifier as well, so back up 1 byte;
4052    *    for a Data reference we just store HERE.
4053    */
4054   VMS_Set_Psect (Psect,
4055                  PC_Relative ? Psect_Offset - 1 : Psect_Offset,
4056                  Record_Type);
4057   /*
4058    *    Make sure we are still generating a "Record Type" record
4059    */
4060   if (Object_Record_Offset == 0)
4061     PUT_CHAR (Record_Type);
4062   /*
4063    *    Dispatch on symbol type (so we can stack its value)
4064    */
4065   switch (S_GET_RAW_TYPE (Symbol))
4066     {
4067       /*
4068        *        Global symbol
4069        */
4070     case N_ABS:
4071       local_sym = 1;
4072       /*FALLTHRU*/
4073     case N_ABS | N_EXT:
4074 #ifdef  NOT_VAX_11_C_COMPATIBLE
4075     case N_UNDF | N_EXT:
4076     case N_DATA | N_EXT:
4077 #endif  /* NOT_VAX_11_C_COMPATIBLE */
4078     case N_UNDF:
4079     case N_TEXT | N_EXT:
4080       /*
4081        *        Get the symbol name (case hacked)
4082        */
4083       VMS_Case_Hack_Symbol (S_GET_NAME (Symbol), Local);
4084       /*
4085        *        Stack the global symbol value
4086        */
4087       if (!local_sym)
4088         {
4089           PUT_CHAR (TIR_S_C_STA_GBL);
4090         }
4091       else
4092         {
4093           /* Local symbols have an extra field.  */
4094           PUT_CHAR (TIR_S_C_STA_LSY);
4095           PUT_SHORT (Current_Environment);
4096         }
4097       PUT_COUNTED_STRING (Local);
4098       if (Offset)
4099         {
4100           /*
4101            *    Stack the longword offset
4102            */
4103           PUT_CHAR (TIR_S_C_STA_LW);
4104           PUT_LONG (Offset);
4105           /*
4106            *    Add the two, leaving the result on the stack
4107            */
4108           PUT_CHAR (TIR_S_C_OPR_ADD);
4109         }
4110       break;
4111       /*
4112        *        Uninitialized local data
4113        */
4114     case N_BSS:
4115       /*
4116        *        Stack the Psect (+offset)
4117        */
4118       vms_tir_stack_psect (vsp->Psect_Index,
4119                            vsp->Psect_Offset + Offset,
4120                            0);
4121       break;
4122       /*
4123        *        Local text
4124        */
4125     case N_TEXT:
4126       /*
4127        *        Stack the Psect (+offset)
4128        */
4129       vms_tir_stack_psect (vsp->Psect_Index,
4130                            S_GET_VALUE (Symbol) + Offset,
4131                            0);
4132       break;
4133       /*
4134        *        Initialized local or global data
4135        */
4136     case N_DATA:
4137 #ifndef NOT_VAX_11_C_COMPATIBLE
4138     case N_UNDF | N_EXT:
4139     case N_DATA | N_EXT:
4140 #endif  /* NOT_VAX_11_C_COMPATIBLE */
4141       /*
4142        *        Stack the Psect (+offset)
4143        */
4144       vms_tir_stack_psect (vsp->Psect_Index,
4145                            vsp->Psect_Offset + Offset,
4146                            0);
4147       break;
4148     }
4149   /*
4150    *    Store either a code or data reference
4151    */
4152   PUT_CHAR (PC_Relative ? TIR_S_C_STO_PICR : TIR_S_C_STO_PIDR);
4153   /*
4154    *    Flush the buffer if it is more than 75% full
4155    */
4156   if (Object_Record_Offset > (sizeof (Object_Record_Buffer) * 3 / 4))
4157     Flush_VMS_Object_Record_Buffer ();
4158 }
4159 \f
4160
4161 /*
4162  *      Check in the text area for an indirect pc-relative reference
4163  *      and fix it up with addressing mode 0xff [PC indirect]
4164  *
4165  *      THIS SHOULD BE REPLACED BY THE USE OF TIR_S_C_STO_PIRR IN THE
4166  *      PIC CODE GENERATING FIXUP ROUTINE.
4167  */
4168 static void
4169 VMS_Fix_Indirect_Reference (Text_Psect, Offset, fragP, text_frag_root)
4170      int Text_Psect;
4171      int Offset;
4172      register fragS *fragP;
4173      fragS *text_frag_root;
4174 {
4175   /*
4176    *    The addressing mode byte is 1 byte before the address
4177    */
4178   Offset--;
4179   /*
4180    *    Is it in THIS frag??
4181    */
4182   if ((Offset < fragP->fr_address) ||
4183       (Offset >= (fragP->fr_address + fragP->fr_fix)))
4184     {
4185       /*
4186        *        We need to search for the fragment containing this
4187        *        Offset
4188        */
4189       for (fragP = text_frag_root; fragP; fragP = fragP->fr_next)
4190         {
4191           if ((Offset >= fragP->fr_address) &&
4192               (Offset < (fragP->fr_address + fragP->fr_fix)))
4193             break;
4194         }
4195       /*
4196        *        If we couldn't find the frag, things are BAD!!
4197        */
4198       if (fragP == 0)
4199         error (_("Couldn't find fixup fragment when checking for indirect reference"));
4200     }
4201   /*
4202    *    Check for indirect PC relative addressing mode
4203    */
4204   if (fragP->fr_literal[Offset - fragP->fr_address] == (char) 0xff)
4205     {
4206       static char Address_Mode = (char) 0xff;
4207
4208       /*
4209        *        Yes: Store the indirect mode back into the image
4210        *             to fix up the damage done by STO_PICR
4211        */
4212       VMS_Set_Psect (Text_Psect, Offset, OBJ_S_C_TIR);
4213       VMS_Store_Immediate_Data (&Address_Mode, 1, OBJ_S_C_TIR);
4214     }
4215 }
4216 \f
4217
4218 /*
4219  *      If the procedure "main()" exists we have to add the instruction
4220  *      "jsb c$main_args" at the beginning to be compatible with VAX-11 "C".
4221  *
4222  *      FIXME:  the macro name `HACK_DEC_C_STARTUP' should be renamed
4223  *              to `HACK_VAXCRTL_STARTUP' because Digital's compiler
4224  *              named "DEC C" uses run-time library "DECC$SHR", but this
4225  *              startup code is for "VAXCRTL", the library for Digital's
4226  *              older "VAX C".  Also, this extra code isn't needed for
4227  *              supporting gcc because it already generates the VAXCRTL
4228  *              startup call when compiling main().  The reference to
4229  *              `flag_hash_long_names' looks very suspicious too;
4230  *              probably an old-style command line option was inadvertently
4231  *              overloaded here, then blindly converted into the new one.
4232  */
4233 void
4234 vms_check_for_main ()
4235 {
4236   register symbolS *symbolP;
4237 #ifdef  HACK_DEC_C_STARTUP      /* JF */
4238   register struct frchain *frchainP;
4239   register fragS *fragP;
4240   register fragS **prev_fragPP;
4241   register struct fix *fixP;
4242   register fragS *New_Frag;
4243   int i;
4244 #endif  /* HACK_DEC_C_STARTUP */
4245
4246   symbolP = (symbolS *) symbol_find ("_main");
4247   if (symbolP && !S_IS_DEBUG (symbolP) &&
4248       S_IS_EXTERNAL (symbolP) && (S_GET_TYPE (symbolP) == N_TEXT))
4249     {
4250 #ifdef  HACK_DEC_C_STARTUP
4251       if (!flag_hash_long_names)
4252         {
4253 #endif
4254           /*
4255            *    Remember the entry point symbol
4256            */
4257           Entry_Point_Symbol = symbolP;
4258 #ifdef HACK_DEC_C_STARTUP
4259         }
4260       else
4261         {
4262           /*
4263            *    Scan all the fragment chains for the one with "_main"
4264            *    (Actually we know the fragment from the symbol, but we need
4265            *     the previous fragment so we can change its pointer)
4266            */
4267           frchainP = frchain_root;
4268           while (frchainP)
4269             {
4270               /*
4271                *        Scan all the fragments in this chain, remembering
4272                *        the "previous fragment"
4273                */
4274               prev_fragPP = &frchainP->frch_root;
4275               fragP = frchainP->frch_root;
4276               while (fragP && (fragP != frchainP->frch_last))
4277                 {
4278                   /*
4279                    *    Is this the fragment?
4280                    */
4281                   if (fragP == symbolP->sy_frag)
4282                     {
4283                       /*
4284                        *        Yes: Modify the fragment by replacing
4285                        *             it with a new fragment.
4286                        */
4287                       New_Frag = (fragS *)
4288                         xmalloc (sizeof (*New_Frag) +
4289                                  fragP->fr_fix +
4290                                  fragP->fr_var +
4291                                  5);
4292                       /*
4293                        *        The fragments are the same except
4294                        *        that the "fixed" area is larger
4295                        */
4296                       *New_Frag = *fragP;
4297                       New_Frag->fr_fix += 6;
4298                       /*
4299                        *        Copy the literal data opening a hole
4300                        *        2 bytes after "_main" (i.e. just after
4301                        *        the entry mask).  Into which we place
4302                        *        the JSB instruction.
4303                        */
4304                       New_Frag->fr_literal[0] = fragP->fr_literal[0];
4305                       New_Frag->fr_literal[1] = fragP->fr_literal[1];
4306                       New_Frag->fr_literal[2] = 0x16;   /* Jsb */
4307                       New_Frag->fr_literal[3] = 0xef;
4308                       New_Frag->fr_literal[4] = 0;
4309                       New_Frag->fr_literal[5] = 0;
4310                       New_Frag->fr_literal[6] = 0;
4311                       New_Frag->fr_literal[7] = 0;
4312                       for (i = 2; i < fragP->fr_fix + fragP->fr_var; i++)
4313                         New_Frag->fr_literal[i + 6] =
4314                           fragP->fr_literal[i];
4315                       /*
4316                        *        Now replace the old fragment with the
4317                        *        newly generated one.
4318                        */
4319                       *prev_fragPP = New_Frag;
4320                       /*
4321                        *        Remember the entry point symbol
4322                        */
4323                       Entry_Point_Symbol = symbolP;
4324                       /*
4325                        *        Scan the text area fixup structures
4326                        *        as offsets in the fragment may have
4327                        *        changed
4328                        */
4329                       for (fixP = text_fix_root; fixP; fixP = fixP->fx_next)
4330                         {
4331                           /*
4332                            *    Look for references to this
4333                            *    fragment.
4334                            */
4335                           if (fixP->fx_frag == fragP)
4336                             {
4337                               /*
4338                                *        Change the fragment
4339                                *        pointer
4340                                */
4341                               fixP->fx_frag = New_Frag;
4342                               /*
4343                                *        If the offset is after
4344                                *        the entry mask we need
4345                                *        to account for the JSB
4346                                *        instruction we just
4347                                *        inserted.
4348                                */
4349                               if (fixP->fx_where >= 2)
4350                                 fixP->fx_where += 6;
4351                             }
4352                         }
4353                       /*
4354                        *        Scan the symbols as offsets in the
4355                        *        fragment may have changed
4356                        */
4357                       for (symbolP = symbol_rootP;
4358                            symbolP;
4359                            symbolP = symbol_next (symbolP))
4360                         {
4361                           /*
4362                            *    Look for references to this
4363                            *    fragment.
4364                            */
4365                           if (symbolP->sy_frag == fragP)
4366                             {
4367                               /*
4368                                *        Change the fragment
4369                                *        pointer
4370                                */
4371                               symbolP->sy_frag = New_Frag;
4372                               /*
4373                                *        If the offset is after
4374                                *        the entry mask we need
4375                                *        to account for the JSB
4376                                *        instruction we just
4377                                *        inserted.
4378                                */
4379                               if (S_GET_VALUE (symbolP) >= 2)
4380                                 S_SET_VALUE (symbolP,
4381                                              S_GET_VALUE (symbolP) + 6);
4382                             }
4383                         }
4384                       /*
4385                        *        Make a symbol reference to
4386                        *        "_c$main_args" so we can get
4387                        *        its address inserted into the
4388                        *        JSB instruction.
4389                        */
4390                       symbolP = (symbolS *) xmalloc (sizeof (*symbolP));
4391                       S_SET_NAME (symbolP, "_C$MAIN_ARGS");
4392                       S_SET_TYPE (symbolP, N_UNDF);
4393                       S_SET_OTHER (symbolP, 0);
4394                       S_SET_DESC (symbolP, 0);
4395                       S_SET_VALUE (symbolP, 0);
4396                       symbolP->sy_name_offset = 0;
4397                       symbolP->sy_number = 0;
4398                       symbolP->sy_obj = 0;
4399                       symbolP->sy_frag = New_Frag;
4400                       symbolP->sy_resolved = 0;
4401                       symbolP->sy_resolving = 0;
4402                       /* this actually inserts at the beginning of the list */
4403                       symbol_append (symbol_rootP, symbolP,
4404                                      &symbol_rootP, &symbol_lastP);
4405
4406                       symbol_rootP = symbolP;
4407                       /*
4408                        *        Generate a text fixup structure
4409                        *        to get "_c$main_args" stored into the
4410                        *        JSB instruction.
4411                        */
4412                       fixP = (struct fix *) xmalloc (sizeof (*fixP));
4413                       fixP->fx_frag = New_Frag;
4414                       fixP->fx_where = 4;
4415                       fixP->fx_addsy = symbolP;
4416                       fixP->fx_subsy = 0;
4417                       fixP->fx_offset = 0;
4418                       fixP->fx_size = 4;
4419                       fixP->fx_pcrel = 1;
4420                       fixP->fx_next = text_fix_root;
4421                       text_fix_root = fixP;
4422                       /*
4423                        *        Now make sure we exit from the loop
4424                        */
4425                       frchainP = 0;
4426                       break;
4427                     }
4428                   /*
4429                    *    Try the next fragment
4430                    */
4431                   prev_fragPP = &fragP->fr_next;
4432                   fragP = fragP->fr_next;
4433                 }
4434               /*
4435                *        Try the next fragment chain
4436                */
4437               if (frchainP)
4438                 frchainP = frchainP->frch_next;
4439             }
4440         }
4441 #endif /* HACK_DEC_C_STARTUP */
4442     }
4443 }
4444 \f
4445
4446 /*
4447  *      Beginning of vms_write_object_file().
4448  */
4449
4450 static
4451 struct vms_obj_state {
4452
4453   /* Next program section index to use.  */
4454   int   psect_number;
4455
4456   /* Psect index for code.  Always ends up #0.  */
4457   int   text_psect;
4458
4459   /* Psect index for initialized static variables.  */
4460   int   data_psect;
4461
4462   /* Psect index for uninitialized static variables.  */
4463   int   bss_psect;
4464
4465   /* Psect index for static constructors.  */
4466   int   ctors_psect;
4467
4468   /* Psect index for static destructors.  */
4469   int   dtors_psect;
4470
4471   /* Number of bytes used for local symbol data.  */
4472   int   local_initd_data_size;
4473
4474   /* Dynamic buffer for initialized data.  */
4475   char *data_segment;
4476
4477 } vms_obj_state;
4478
4479 #define Psect_Number            vms_obj_state.psect_number
4480 #define Text_Psect              vms_obj_state.text_psect
4481 #define Data_Psect              vms_obj_state.data_psect
4482 #define Bss_Psect               vms_obj_state.bss_psect
4483 #define Ctors_Psect             vms_obj_state.ctors_psect
4484 #define Dtors_Psect             vms_obj_state.dtors_psect
4485 #define Local_Initd_Data_Size   vms_obj_state.local_initd_data_size
4486 #define Data_Segment            vms_obj_state.data_segment
4487
4488 #define IS_GXX_VTABLE(symP) (strncmp (S_GET_NAME (symP), "__vt.", 5) == 0)
4489 #define IS_GXX_XTOR(symP) (strncmp (S_GET_NAME (symP), "__GLOBAL_.", 10) == 0)
4490 #define XTOR_SIZE 4
4491 \f
4492
4493 /* Perform text segment fixups.  */
4494
4495 static void
4496 vms_fixup_text_section (text_siz, text_frag_root, data_frag_root)
4497      unsigned text_siz;
4498      struct frag *text_frag_root;
4499      struct frag *data_frag_root;
4500 {
4501   register fragS *fragP;
4502   register struct fix *fixP;
4503   offsetT dif;
4504
4505   /* Scan the text fragments.  */
4506   for (fragP = text_frag_root; fragP; fragP = fragP->fr_next)
4507     {
4508       /* Stop if we get to the data fragments.  */
4509       if (fragP == data_frag_root)
4510         break;
4511       /* Ignore fragments with no data.  */
4512       if ((fragP->fr_fix == 0) && (fragP->fr_var == 0))
4513         continue;
4514       /* Go the the appropriate offset in the Text Psect.  */
4515       VMS_Set_Psect (Text_Psect, fragP->fr_address, OBJ_S_C_TIR);
4516       /* Store the "fixed" part.  */
4517       if (fragP->fr_fix)
4518         VMS_Store_Immediate_Data (fragP->fr_literal,
4519                                   fragP->fr_fix,
4520                                   OBJ_S_C_TIR);
4521       /* Store the "variable" part.  */
4522       if (fragP->fr_var && fragP->fr_offset)
4523         VMS_Store_Repeated_Data (fragP->fr_offset,
4524                                  fragP->fr_literal + fragP->fr_fix,
4525                                  fragP->fr_var,
4526                                  OBJ_S_C_TIR);
4527     }                   /* text frag loop */
4528
4529   /*
4530    *    Now we go through the text segment fixups and generate
4531    *    TIR records to fix up addresses within the Text Psect.
4532    */
4533   for (fixP = text_fix_root; fixP; fixP = fixP->fx_next)
4534     {
4535       /* We DO handle the case of "Symbol - Symbol" as
4536          long as it is in the same segment.  */
4537       if (fixP->fx_subsy && fixP->fx_addsy)
4538         {
4539           /* They need to be in the same segment.  */
4540           if (S_GET_RAW_TYPE (fixP->fx_subsy) !=
4541               S_GET_RAW_TYPE (fixP->fx_addsy))
4542             error (_("Fixup data addsy and subsy don't have the same type"));
4543           /* And they need to be in one that we can check the psect on.  */
4544           if ((S_GET_TYPE (fixP->fx_addsy) != N_DATA) &&
4545                     (S_GET_TYPE (fixP->fx_addsy) != N_TEXT))
4546             error (_("Fixup data addsy and subsy don't have an appropriate type"));
4547           /* This had better not be PC relative!  */
4548           if (fixP->fx_pcrel)
4549             error (_("Fixup data is erroneously \"pcrel\""));
4550           /* Subtract their values to get the difference.  */
4551           dif = S_GET_VALUE (fixP->fx_addsy) - S_GET_VALUE (fixP->fx_subsy);
4552           md_number_to_chars (Local, (valueT)dif, fixP->fx_size);
4553           /* Now generate the fixup object records;
4554              set the psect and store the data.  */
4555           VMS_Set_Psect (Text_Psect,
4556                          fixP->fx_where + fixP->fx_frag->fr_address,
4557                          OBJ_S_C_TIR);
4558           VMS_Store_Immediate_Data (Local,
4559                                     fixP->fx_size,
4560                                     OBJ_S_C_TIR);
4561           continue;     /* done with this fixup */
4562             }           /* if fx_subsy && fx_addsy */
4563       /* Size will HAVE to be "long".  */
4564       if (fixP->fx_size != 4)
4565         error (_("Fixup datum is not a longword"));
4566       /* Symbol must be "added" (if it is ever
4567          subtracted we can fix this assumption).  */
4568       if (fixP->fx_addsy == 0)
4569         error (_("Fixup datum is not \"fixP->fx_addsy\""));
4570       /* Store the symbol value in a PIC fashion.  */
4571       VMS_Store_PIC_Symbol_Reference (fixP->fx_addsy,
4572                                       fixP->fx_offset,
4573                                       fixP->fx_pcrel,
4574                                       Text_Psect,
4575                                     fixP->fx_where + fixP->fx_frag->fr_address,
4576                                       OBJ_S_C_TIR);
4577           /*
4578            *  Check for indirect address reference, which has to be fixed up
4579            *  (as the linker will screw it up with TIR_S_C_STO_PICR)...
4580            */
4581       if (fixP->fx_pcrel)
4582         VMS_Fix_Indirect_Reference (Text_Psect,
4583                                     fixP->fx_where + fixP->fx_frag->fr_address,
4584                                     fixP->fx_frag,
4585                                     text_frag_root);
4586     }                   /* text fix loop */
4587 }
4588 \f
4589
4590 /* Create a buffer holding the data segment.  */
4591
4592 static void
4593 synthesize_data_segment (data_siz, text_siz, data_frag_root)
4594      unsigned data_siz, text_siz;
4595      struct frag *data_frag_root;
4596 {
4597   register fragS *fragP;
4598   char *fill_literal;
4599   long fill_size, count, i;
4600
4601   /* Allocate the data segment.  */
4602   Data_Segment = (char *) xmalloc (data_siz);
4603   /* Run through the data fragments, filling in the segment.  */
4604   for (fragP = data_frag_root; fragP; fragP = fragP->fr_next)
4605     {
4606       i = fragP->fr_address - text_siz;
4607       if (fragP->fr_fix)
4608         memcpy (Data_Segment + i, fragP->fr_literal, fragP->fr_fix);
4609       i += fragP->fr_fix;
4610
4611       if ((fill_size = fragP->fr_var) != 0)
4612         {
4613           fill_literal = fragP->fr_literal + fragP->fr_fix;
4614           for (count = fragP->fr_offset; count; count--)
4615             {
4616               memcpy (Data_Segment + i, fill_literal, fill_size);
4617               i += fill_size;
4618             }
4619         }
4620     }                   /* data frag loop */
4621
4622   return;
4623 }
4624
4625 /* Perform data segment fixups.  */
4626
4627 static void
4628 vms_fixup_data_section (data_siz, text_siz)
4629      unsigned data_siz, text_siz;
4630 {
4631   register struct VMS_Symbol *vsp;
4632   register struct fix *fixP;
4633   register symbolS *sp;
4634   addressT fr_address;
4635   offsetT dif;
4636   valueT val;
4637
4638   /* Run through all the data symbols and store the data.  */
4639   for (vsp = VMS_Symbols; vsp; vsp = vsp->Next)
4640     {
4641       /* Ignore anything other than data symbols.  */
4642       if (S_GET_TYPE (vsp->Symbol) != N_DATA)
4643         continue;
4644       /* Set the Psect + Offset.  */
4645       VMS_Set_Psect (vsp->Psect_Index,
4646                        vsp->Psect_Offset,
4647                        OBJ_S_C_TIR);
4648       /* Store the data.  */
4649       val = S_GET_VALUE (vsp->Symbol);
4650       VMS_Store_Immediate_Data (Data_Segment + val - text_siz,
4651                                 vsp->Size,
4652                                 OBJ_S_C_TIR);
4653     }                   /* N_DATA symbol loop */
4654
4655   /*
4656    *    Now we go through the data segment fixups and generate
4657    *    TIR records to fix up addresses within the Data Psects.
4658    */
4659   for (fixP = data_fix_root; fixP; fixP = fixP->fx_next)
4660     {
4661       /* Find the symbol for the containing datum.  */
4662       for (vsp = VMS_Symbols; vsp; vsp = vsp->Next)
4663         {
4664           /* Only bother with Data symbols.  */
4665           sp = vsp->Symbol;
4666           if (S_GET_TYPE (sp) != N_DATA)
4667             continue;
4668           /* Ignore symbol if After fixup.  */
4669           val = S_GET_VALUE (sp);
4670           fr_address = fixP->fx_frag->fr_address;
4671           if (val > fixP->fx_where + fr_address)
4672             continue;
4673           /* See if the datum is here.  */
4674           if (val + vsp->Size <= fixP->fx_where + fr_address)
4675             continue;
4676           /* We DO handle the case of "Symbol - Symbol" as
4677              long as it is in the same segment.  */
4678           if (fixP->fx_subsy && fixP->fx_addsy)
4679             {
4680               /* They need to be in the same segment.  */
4681               if (S_GET_RAW_TYPE (fixP->fx_subsy) !=
4682                   S_GET_RAW_TYPE (fixP->fx_addsy))
4683                 error (_("Fixup data addsy and subsy don't have the same type"));
4684               /* And they need to be in one that we can check the psect on.  */
4685               if ((S_GET_TYPE (fixP->fx_addsy) != N_DATA) &&
4686                   (S_GET_TYPE (fixP->fx_addsy) != N_TEXT))
4687                 error (_("Fixup data addsy and subsy don't have an appropriate type"));
4688               /* This had better not be PC relative!  */
4689               if (fixP->fx_pcrel)
4690                 error (_("Fixup data is erroneously \"pcrel\""));
4691               /* Subtract their values to get the difference.  */
4692               dif = S_GET_VALUE (fixP->fx_addsy) - S_GET_VALUE (fixP->fx_subsy);
4693               md_number_to_chars (Local, (valueT)dif, fixP->fx_size);
4694               /*
4695                * Now generate the fixup object records;
4696                * set the psect and store the data.
4697                */
4698               VMS_Set_Psect (vsp->Psect_Index,
4699                              fr_address + fixP->fx_where
4700                                  - val + vsp->Psect_Offset,
4701                              OBJ_S_C_TIR);
4702               VMS_Store_Immediate_Data (Local,
4703                                         fixP->fx_size,
4704                                         OBJ_S_C_TIR);
4705                   break;        /* done with this fixup */
4706                 }
4707           /* Size will HAVE to be "long".  */
4708           if (fixP->fx_size != 4)
4709             error (_("Fixup datum is not a longword"));
4710           /* Symbol must be "added" (if it is ever
4711              subtracted we can fix this assumption).  */
4712           if (fixP->fx_addsy == 0)
4713             error (_("Fixup datum is not \"fixP->fx_addsy\""));
4714           /* Store the symbol value in a PIC fashion.  */
4715           VMS_Store_PIC_Symbol_Reference (fixP->fx_addsy,
4716                                           fixP->fx_offset,
4717                                           fixP->fx_pcrel,
4718                                           vsp->Psect_Index,
4719                                           fr_address + fixP->fx_where
4720                                               - val + vsp->Psect_Offset,
4721                                           OBJ_S_C_TIR);
4722           /* Done with this fixup.  */
4723           break;
4724         }               /* vms_symbol loop */
4725
4726     }                   /* data fix loop */
4727 }
4728
4729 /* Perform ctors/dtors segment fixups.  */
4730
4731 static void
4732 vms_fixup_xtors_section (symbols, sect_no)
4733         struct VMS_Symbol *symbols;
4734         int sect_no;
4735 {
4736   register struct VMS_Symbol *vsp;
4737
4738   /* Run through all the symbols and store the data.  */
4739   for (vsp = symbols; vsp; vsp = vsp->Next)
4740     {
4741       register symbolS *sp;
4742
4743       /* Set relocation base.  */
4744       VMS_Set_Psect (vsp->Psect_Index, vsp->Psect_Offset, OBJ_S_C_TIR);
4745
4746       sp = vsp->Symbol;
4747       /* Stack the Psect base with its offset.  */
4748       VMS_Set_Data (Text_Psect, S_GET_VALUE (sp), OBJ_S_C_TIR, 0);
4749     }
4750   /* Flush the buffer if it is more than 75% full.  */
4751   if (Object_Record_Offset > (sizeof (Object_Record_Buffer) * 3 / 4))
4752     Flush_VMS_Object_Record_Buffer ();
4753
4754   return;
4755 }
4756 \f
4757
4758 /* Define symbols for the linker.  */
4759
4760 static void
4761 global_symbol_directory (text_siz, data_siz)
4762      unsigned text_siz, data_siz;
4763 {
4764   register fragS *fragP;
4765   register symbolS *sp;
4766   register struct VMS_Symbol *vsp;
4767   int Globalref, define_as_global_symbol;
4768
4769 #if 0
4770   /* The g++ compiler does not write out external references to
4771      vtables correctly.  Check for this and holler if we see it
4772      happening.  If that compiler bug is ever fixed we can remove
4773      this.
4774
4775      (Jun'95: gcc 2.7.0's cc1plus still exhibits this behavior.)
4776
4777      This was reportedly fixed as of June 2, 1998.   */
4778
4779   for (sp = symbol_rootP; sp; sp = symbol_next (sp))
4780     if (S_GET_RAW_TYPE (sp) == N_UNDF && IS_GXX_VTABLE (sp))
4781       {
4782         S_SET_TYPE (sp, N_UNDF | N_EXT);
4783         S_SET_OTHER (sp, 1);
4784         as_warn (_("g++ wrote an extern reference to `%s' as a routine.\nI will fix it, but I hope that it was note really a routine."),
4785                  S_GET_NAME (sp));
4786       }
4787 #endif
4788
4789   /*
4790    * Now scan the symbols and emit the appropriate GSD records
4791    */
4792   for (sp = symbol_rootP; sp; sp = symbol_next (sp))
4793     {
4794       define_as_global_symbol = 0;
4795       vsp = 0;
4796       /* Dispatch on symbol type.  */
4797       switch (S_GET_RAW_TYPE (sp))
4798         {
4799
4800         /* Global uninitialized data.  */
4801         case N_UNDF | N_EXT:
4802           /* Make a VMS data symbol entry.  */
4803           vsp = (struct VMS_Symbol *) xmalloc (sizeof *vsp);
4804           vsp->Symbol = sp;
4805           vsp->Size = S_GET_VALUE (sp);
4806           vsp->Psect_Index = Psect_Number++;
4807           vsp->Psect_Offset = 0;
4808           vsp->Next = VMS_Symbols;
4809           VMS_Symbols = vsp;
4810           sp->sy_obj = vsp;
4811           /* Make the psect for this data.  */
4812           Globalref = VMS_Psect_Spec (S_GET_NAME (sp),
4813                                       vsp->Size,
4814                                       S_GET_OTHER (sp) ? ps_CONST : ps_COMMON,
4815                                       vsp);
4816           if (Globalref)
4817             Psect_Number--;
4818 #ifdef  NOT_VAX_11_C_COMPATIBLE
4819           define_as_global_symbol = 1;
4820 #else
4821           /* See if this is an external vtable.  We want to help the
4822              linker find these things in libraries, so we make a symbol
4823              reference.  This is not compatible with VAX-C usage for
4824              variables, but since vtables are only used internally by
4825              g++, we can get away with this hack.  */
4826           define_as_global_symbol = IS_GXX_VTABLE (sp);
4827 #endif
4828           break;
4829
4830         /* Local uninitialized data.  */
4831         case N_BSS:
4832           /* Make a VMS data symbol entry.  */
4833           vsp = (struct VMS_Symbol *) xmalloc (sizeof *vsp);
4834           vsp->Symbol = sp;
4835           vsp->Size = 0;
4836           vsp->Psect_Index = Bss_Psect;
4837           vsp->Psect_Offset = S_GET_VALUE (sp) - bss_address_frag.fr_address;
4838           vsp->Next = VMS_Symbols;
4839           VMS_Symbols = vsp;
4840           sp->sy_obj = vsp;
4841           break;
4842
4843         /* Global initialized data.  */
4844         case N_DATA | N_EXT:
4845           /* Make a VMS data symbol entry.  */
4846           vsp = (struct VMS_Symbol *) xmalloc (sizeof *vsp);
4847           vsp->Symbol = sp;
4848           vsp->Size = VMS_Initialized_Data_Size (sp, text_siz + data_siz);
4849           vsp->Psect_Index = Psect_Number++;
4850           vsp->Psect_Offset = 0;
4851           vsp->Next = VMS_Symbols;
4852           VMS_Symbols = vsp;
4853           sp->sy_obj = vsp;
4854           /* Make its psect.  */
4855           Globalref = VMS_Psect_Spec (S_GET_NAME (sp),
4856                                       vsp->Size,
4857                                       S_GET_OTHER (sp) ? ps_CONST : ps_COMMON,
4858                                       vsp);
4859           if (Globalref)
4860             Psect_Number--;
4861 #ifdef  NOT_VAX_11_C_COMPATIBLE
4862           define_as_global_symbol = 1;
4863 #else
4864           /* See N_UNDF|N_EXT above for explanation.  */
4865           define_as_global_symbol = IS_GXX_VTABLE (sp);
4866 #endif
4867           break;
4868
4869         /* Local initialized data.  */
4870         case N_DATA:
4871           {
4872             char *sym_name = S_GET_NAME (sp);
4873
4874             /* Always suppress local numeric labels.  */
4875             if (sym_name && strcmp (sym_name, FAKE_LABEL_NAME) == 0)
4876               break;
4877
4878             /* Make a VMS data symbol entry.  */
4879             vsp = (struct VMS_Symbol *) xmalloc (sizeof *vsp);
4880             vsp->Symbol = sp;
4881             vsp->Size = VMS_Initialized_Data_Size (sp, text_siz + data_siz);
4882             vsp->Psect_Index = Data_Psect;
4883             vsp->Psect_Offset = Local_Initd_Data_Size;
4884             Local_Initd_Data_Size += vsp->Size;
4885             vsp->Next = VMS_Symbols;
4886             VMS_Symbols = vsp;
4887             sp->sy_obj = vsp;
4888           }
4889           break;
4890
4891         /* Global Text definition.  */
4892         case N_TEXT | N_EXT:
4893           {
4894
4895             if (IS_GXX_XTOR (sp))
4896               {
4897                 vsp = (struct VMS_Symbol *) xmalloc (sizeof *vsp);
4898                 vsp->Symbol = sp;
4899                 vsp->Size = XTOR_SIZE;
4900                 sp->sy_obj = vsp;
4901                 switch ((S_GET_NAME (sp))[10])
4902                   {
4903                     case 'I':
4904                       vsp->Psect_Index = Ctors_Psect;
4905                       vsp->Psect_Offset = (Ctors_Symbols==0)?0:(Ctors_Symbols->Psect_Offset+XTOR_SIZE);
4906                       vsp->Next = Ctors_Symbols;
4907                       Ctors_Symbols = vsp;
4908                       break;
4909                     case 'D':
4910                       vsp->Psect_Index = Dtors_Psect;
4911                       vsp->Psect_Offset = (Dtors_Symbols==0)?0:(Dtors_Symbols->Psect_Offset+XTOR_SIZE);
4912                       vsp->Next = Dtors_Symbols;
4913                       Dtors_Symbols = vsp;
4914                       break;
4915                     case 'G':
4916                       as_warn (_("Can't handle global xtors symbols yet."));
4917                       break;
4918                     default:
4919                       as_warn (_("Unknown %s"), S_GET_NAME (sp));
4920                       break;
4921                   }
4922               }
4923             else
4924               {
4925                 unsigned short Entry_Mask;
4926
4927                 /* Get the entry mask.  */
4928                 fragP = sp->sy_frag;
4929                 /* First frag might be empty if we're generating listings.
4930                    So skip empty rs_fill frags.  */
4931                 while (fragP && fragP->fr_type == rs_fill && fragP->fr_fix == 0)
4932                   fragP = fragP->fr_next;
4933
4934                 /* If first frag doesn't contain the data, what do we do?
4935                    If it's possibly smaller than two bytes, that would
4936                    imply that the entry mask is not stored where we're
4937                    expecting it.
4938
4939                    If you can find a test case that triggers this, report
4940                    it (and tell me what the entry mask field ought to be),
4941                    and I'll try to fix it.  KR */
4942                 if (fragP->fr_fix < 2)
4943                   abort ();
4944
4945                 Entry_Mask = (fragP->fr_literal[0] & 0x00ff) |
4946                              ((fragP->fr_literal[1] & 0x00ff) << 8);
4947                 /* Define the procedure entry point.  */
4948                 VMS_Procedure_Entry_Pt (S_GET_NAME (sp),
4949                                     Text_Psect,
4950                                     S_GET_VALUE (sp),
4951                                     Entry_Mask);
4952               }
4953             break;
4954           }
4955
4956         /* Local Text definition.  */
4957         case N_TEXT:
4958           /* Make a VMS data symbol entry.  */
4959           if (Text_Psect != -1)
4960             {
4961               vsp = (struct VMS_Symbol *) xmalloc (sizeof *vsp);
4962               vsp->Symbol = sp;
4963               vsp->Size = 0;
4964               vsp->Psect_Index = Text_Psect;
4965               vsp->Psect_Offset = S_GET_VALUE (sp);
4966               vsp->Next = VMS_Symbols;
4967               VMS_Symbols = vsp;
4968               sp->sy_obj = vsp;
4969             }
4970           break;
4971
4972         /* Global Reference.  */
4973         case N_UNDF:
4974           /* Make a GSD global symbol reference record.  */
4975           VMS_Global_Symbol_Spec (S_GET_NAME (sp),
4976                                   0,
4977                                   0,
4978                                   GBLSYM_REF);
4979           break;
4980
4981         /* Absolute symbol.  */
4982         case N_ABS:
4983         case N_ABS | N_EXT:
4984           /* gcc doesn't generate these;
4985              VMS_Emit_Globalvalue handles them though.  */
4986           vsp = (struct VMS_Symbol *) xmalloc (sizeof *vsp);
4987           vsp->Symbol = sp;
4988           vsp->Size = 4;                /* always assume 32 bits */
4989           vsp->Psect_Index = 0;
4990           vsp->Psect_Offset = S_GET_VALUE (sp);
4991           vsp->Next = VMS_Symbols;
4992           VMS_Symbols = vsp;
4993           sp->sy_obj = vsp;
4994           break;
4995
4996         /* Anything else.  */
4997         default:
4998           /* Ignore STAB symbols, including .stabs emitted by g++.  */
4999           if (S_IS_DEBUG (sp) || (S_GET_TYPE (sp) == 22))
5000             break;
5001           /*
5002            *    Error otherwise.
5003            */
5004           as_tsktsk (_("unhandled stab type %d"), S_GET_TYPE (sp));
5005           break;
5006         }
5007
5008       /* Global symbols have different linkage than external variables.  */
5009       if (define_as_global_symbol)
5010         VMS_Global_Symbol_Spec (S_GET_NAME (sp),
5011                                 vsp->Psect_Index,
5012                                 0,
5013                                 GBLSYM_DEF);
5014     }
5015
5016   return;
5017 }
5018 \f
5019
5020 /* Output debugger symbol table information for symbols which
5021    are local to a specific routine.  */
5022
5023 static void
5024 local_symbols_DST (s0P, Current_Routine)
5025      symbolS *s0P, *Current_Routine;
5026 {
5027   symbolS *s1P;
5028   char *s0P_name, *pnt0, *pnt1;
5029
5030   s0P_name = S_GET_NAME (s0P);
5031   if (*s0P_name++ != '_')
5032     return;
5033
5034   for (s1P = Current_Routine; s1P; s1P = symbol_next (s1P))
5035     {
5036 #if 0           /* redundant; RAW_TYPE != N_FUN suffices */
5037       if (!S_IS_DEBUG (s1P))
5038         continue;
5039 #endif
5040       if (S_GET_RAW_TYPE (s1P) != N_FUN)
5041         continue;
5042       pnt0 = s0P_name;
5043       pnt1 = S_GET_NAME (s1P);
5044       /* We assume the two strings are never exactly equal...  */
5045       while (*pnt0++ == *pnt1++)
5046         {
5047         }
5048       /* Found it if s0P name is exhausted and s1P name has ":F" or ":f" next.
5049          Note:  both pointers have advanced one past the non-matching char.  */
5050       if ((*pnt1 == 'F' || *pnt1 == 'f') && *--pnt1 == ':' && *--pnt0 == '\0')
5051         {
5052           Define_Routine (s1P, 0, Current_Routine, Text_Psect);
5053           return;
5054         }
5055     }
5056 }
5057
5058 /* Construct and output the debug symbol table.  */
5059
5060 static void
5061 vms_build_DST (text_siz)
5062      unsigned text_siz;
5063 {
5064   register symbolS *symbolP;
5065   symbolS *Current_Routine = 0;
5066   struct input_file *Cur_File = 0;
5067   offsetT Cur_Offset = -1;
5068   int Cur_Line_Number = 0;
5069   int File_Number = 0;
5070   int Debugger_Offset = 0;
5071   int file_available;
5072   int dsc;
5073   offsetT val;
5074
5075   /* Write the Traceback Begin Module record.  */
5076   VMS_TBT_Module_Begin ();
5077
5078   /*
5079    *    Output debugging info for global variables and static variables
5080    *    that are not specific to one routine.  We also need to examine
5081    *    all stabs directives, to find the definitions to all of the
5082    *    advanced data types, and this is done by VMS_LSYM_Parse.  This
5083    *    needs to be done before any definitions are output to the object
5084    *    file, since there can be forward references in the stabs
5085    *    directives.  When through with parsing, the text of the stabs
5086    *    directive is altered, with the definitions removed, so that later
5087    *    passes will see directives as they would be written if the type
5088    *    were already defined.
5089    *
5090    *    We also look for files and include files, and make a list of
5091    *    them.  We examine the source file numbers to establish the actual
5092    *    lines that code was generated from, and then generate offsets.
5093    */
5094   VMS_LSYM_Parse ();
5095   for (symbolP = symbol_rootP; symbolP; symbolP = symbol_next (symbolP))
5096     {
5097       /* Only deal with STAB symbols here.  */
5098       if (!S_IS_DEBUG (symbolP))
5099         continue;
5100       /*
5101        *        Dispatch on STAB type.
5102        */
5103       switch (S_GET_RAW_TYPE (symbolP))
5104         {
5105         case N_SLINE:
5106           dsc = S_GET_DESC (symbolP);
5107           if (dsc > Cur_File->max_line)
5108             Cur_File->max_line = dsc;
5109           if (dsc < Cur_File->min_line)
5110             Cur_File->min_line = dsc;
5111           break;
5112         case N_SO:
5113           Cur_File = find_file (symbolP);
5114           Cur_File->flag = 1;
5115           Cur_File->min_line = 1;
5116           break;
5117         case N_SOL:
5118           Cur_File = find_file (symbolP);
5119           break;
5120         case N_GSYM:
5121           VMS_GSYM_Parse (symbolP, Text_Psect);
5122           break;
5123         case N_LCSYM:
5124           VMS_LCSYM_Parse (symbolP, Text_Psect);
5125           break;
5126         case N_FUN:             /* For static constant symbols */
5127         case N_STSYM:
5128           VMS_STSYM_Parse (symbolP, Text_Psect);
5129           break;
5130         default:
5131           break;
5132         }               /* switch */
5133     }                   /* for */
5134
5135   /*
5136    *    Now we take a quick sweep through the files and assign offsets
5137    *    to each one.  This will essentially be the starting line number to
5138    *    the debugger for each file.  Output the info for the debugger to
5139    *    specify the files, and then tell it how many lines to use.
5140    */
5141   for (Cur_File = file_root; Cur_File; Cur_File = Cur_File->next)
5142     {
5143       if (Cur_File->max_line == 0)
5144         continue;
5145       if ((strncmp (Cur_File->name, "GNU_GXX_INCLUDE:", 16) == 0) &&
5146           !flag_debug)
5147         continue;
5148       if ((strncmp (Cur_File->name, "GNU_CC_INCLUDE:", 15) == 0) &&
5149           !flag_debug)
5150         continue;
5151       /* show a few extra lines at the start of the region selected */
5152       if (Cur_File->min_line > 2)
5153         Cur_File->min_line -= 2;
5154       Cur_File->offset = Debugger_Offset - Cur_File->min_line + 1;
5155       Debugger_Offset += Cur_File->max_line - Cur_File->min_line + 1;
5156       if (Cur_File->same_file_fpnt)
5157         {
5158           Cur_File->file_number = Cur_File->same_file_fpnt->file_number;
5159         }
5160       else
5161         {
5162           Cur_File->file_number = ++File_Number;
5163           file_available = VMS_TBT_Source_File (Cur_File->name,
5164                                                 Cur_File->file_number);
5165           if (!file_available)
5166             {
5167               Cur_File->file_number = 0;
5168               File_Number--;
5169               continue;
5170             }
5171         }
5172       VMS_TBT_Source_Lines (Cur_File->file_number,
5173                             Cur_File->min_line,
5174                             Cur_File->max_line - Cur_File->min_line + 1);
5175   }                     /* for */
5176   Cur_File = (struct input_file *) NULL;
5177
5178   /*
5179    *    Scan the symbols and write out the routines
5180    *    (this makes the assumption that symbols are in
5181    *     order of ascending text segment offset)
5182    */
5183   for (symbolP = symbol_rootP; symbolP; symbolP = symbol_next (symbolP))
5184     {
5185       /*
5186        *        Deal with text symbols.
5187        */
5188       if (!S_IS_DEBUG (symbolP) && S_GET_TYPE (symbolP) == N_TEXT)
5189         {
5190           /*
5191            * Ignore symbols starting with "L", as they are local symbols.
5192            */
5193           if (*S_GET_NAME (symbolP) == 'L')
5194             continue;
5195           /*
5196            * If there is a routine start defined, terminate it.
5197            */
5198           if (Current_Routine)
5199             VMS_TBT_Routine_End (text_siz, Current_Routine);
5200
5201           /*
5202            * Check for & skip dummy labels like "gcc_compiled.".
5203            * They're identified by the IN_DEFAULT_SECTION flag.
5204            */
5205           if ((S_GET_OTHER (symbolP) & IN_DEFAULT_SECTION) != 0 &&
5206               S_GET_VALUE (symbolP) == 0)
5207             continue;
5208           /*
5209            * Store the routine begin traceback info.
5210            */
5211           VMS_TBT_Routine_Begin (symbolP, Text_Psect);
5212           Current_Routine = symbolP;
5213           /*
5214            * Define symbols local to this routine.
5215            */
5216           local_symbols_DST (symbolP, Current_Routine);
5217           /*
5218            *    Done
5219            */
5220           continue;
5221
5222         }
5223       /*
5224        *        Deal with STAB symbols.
5225        */
5226       else if (S_IS_DEBUG (symbolP))
5227         {
5228           /*
5229            *  Dispatch on STAB type.
5230            */
5231           switch (S_GET_RAW_TYPE (symbolP))
5232             {
5233                 /*
5234                  *      Line number
5235                  */
5236             case N_SLINE:
5237               /* Offset the line into the correct portion of the file.  */
5238               if (Cur_File->file_number == 0)
5239                 break;
5240               val = S_GET_VALUE (symbolP);
5241               /* Sometimes the same offset gets several source lines
5242                  assigned to it.  We should be selective about which
5243                  lines we allow, we should prefer lines that are in
5244                  the main source file when debugging inline functions.  */
5245               if (val == Cur_Offset && Cur_File->file_number != 1)
5246                 break;
5247
5248               /* calculate actual debugger source line */
5249               dsc = S_GET_DESC (symbolP) + Cur_File->offset;
5250               S_SET_DESC (symbolP, dsc);
5251               /*
5252                * Define PC/Line correlation.
5253                */
5254               if (Cur_Offset == -1)
5255                 {
5256                   /*
5257                    * First N_SLINE; set up initial correlation.
5258                    */
5259                   VMS_TBT_Line_PC_Correlation (dsc,
5260                                                val,
5261                                                Text_Psect,
5262                                                0);
5263                 }
5264               else if ((dsc - Cur_Line_Number) <= 0)
5265                 {
5266                   /*
5267                    * Line delta is not +ve, we need to close the line and
5268                    * start a new PC/Line correlation.
5269                    */
5270                   VMS_TBT_Line_PC_Correlation (0,
5271                                                val - Cur_Offset,
5272                                                0,
5273                                                -1);
5274                   VMS_TBT_Line_PC_Correlation (dsc,
5275                                                val,
5276                                                Text_Psect,
5277                                                0);
5278                 }
5279               else
5280                 {
5281                   /*
5282                    * Line delta is +ve, all is well.
5283                    */
5284                   VMS_TBT_Line_PC_Correlation (dsc - Cur_Line_Number,
5285                                                val - Cur_Offset,
5286                                                0,
5287                                                1);
5288                 }
5289               /* Update the current line/PC info.  */
5290               Cur_Line_Number = dsc;
5291               Cur_Offset = val;
5292               break;
5293
5294                 /*
5295                  *      Source file
5296                  */
5297             case N_SO:
5298               /* Remember that we had a source file and emit
5299                  the source file debugger record.  */
5300               Cur_File = find_file (symbolP);
5301               break;
5302
5303             case N_SOL:
5304               /* We need to make sure that we are really in the actual
5305                  source file when we compute the maximum line number.
5306                  Otherwise the debugger gets really confused.  */
5307               Cur_File = find_file (symbolP);
5308               break;
5309
5310             default:
5311               break;
5312             }           /* switch */
5313         }               /* if (IS_DEBUG) */
5314     }                   /* for */
5315
5316     /*
5317      * If there is a routine start defined, terminate it
5318      * (and the line numbers).
5319      */
5320     if (Current_Routine)
5321       {
5322         /* Terminate the line numbers.  */
5323         VMS_TBT_Line_PC_Correlation (0,
5324                                      text_siz - S_GET_VALUE (Current_Routine),
5325                                      0,
5326                                      -1);
5327         /* Terminate the routine.  */
5328         VMS_TBT_Routine_End (text_siz, Current_Routine);
5329       }
5330
5331   /* Write the Traceback End Module TBT record.  */
5332   VMS_TBT_Module_End ();
5333 }
5334 \f
5335
5336 /* Write a VAX/VMS object file (everything else has been done!).  */
5337
5338 void
5339 vms_write_object_file (text_siz, data_siz, bss_siz, text_frag_root,
5340                        data_frag_root)
5341      unsigned text_siz;
5342      unsigned data_siz;
5343      unsigned bss_siz;
5344      fragS *text_frag_root;
5345      fragS *data_frag_root;
5346 {
5347   register struct VMS_Symbol *vsp;
5348
5349   /*
5350    * Initialize program section indices; values get updated later.
5351    */
5352   Psect_Number = 0;             /* next Psect Index to use */
5353   Text_Psect = -1;              /* Text Psect Index   */
5354   Data_Psect = -2;              /* Data Psect Index   JF: Was -1 */
5355   Bss_Psect = -3;               /* Bss Psect Index    JF: Was -1 */
5356   Ctors_Psect = -4;             /* Ctors Psect Index  */
5357   Dtors_Psect = -5;             /* Dtors Psect Index  */
5358   /* Initialize other state variables.  */
5359   Data_Segment = 0;
5360   Local_Initd_Data_Size = 0;
5361
5362   /*
5363    *    Create the actual output file and populate it with required
5364    *    "module header" information.
5365    */
5366   Create_VMS_Object_File ();
5367   Write_VMS_MHD_Records ();
5368
5369   /*
5370    *    Create the Data segment:
5371    *
5372    *    Since this is REALLY hard to do any other way,
5373    *    we actually manufacture the data segment and
5374    *    then store the appropriate values out of it.
5375    *    We need to generate this early, so that globalvalues
5376    *    can be properly emitted.
5377    */
5378   if (data_siz > 0)
5379     synthesize_data_segment (data_siz, text_siz, data_frag_root);
5380
5381   /*******  Global Symbol Directory  *******/
5382
5383   /*
5384    *    Emit globalvalues now.  We must do this before the text psect is
5385    *    defined, or we will get linker warnings about multiply defined
5386    *    symbols.  All of the globalvalues "reference" psect 0, although
5387    *    it really does not have anything to do with it.
5388    */
5389   VMS_Emit_Globalvalues (text_siz, data_siz, Data_Segment);
5390   /*
5391    *    Define the Text Psect
5392    */
5393   Text_Psect = Psect_Number++;
5394   VMS_Psect_Spec ("$code", text_siz, ps_TEXT, 0);
5395   /*
5396    *    Define the BSS Psect
5397    */
5398   if (bss_siz > 0)
5399     {
5400       Bss_Psect = Psect_Number++;
5401       VMS_Psect_Spec ("$uninitialized_data", bss_siz, ps_DATA, 0);
5402     }
5403   /*
5404    * Define symbols to the linker.
5405    */
5406   global_symbol_directory (text_siz, data_siz);
5407   /*
5408    *    Define the Data Psect
5409    */
5410   if (data_siz > 0 && Local_Initd_Data_Size > 0)
5411     {
5412       Data_Psect = Psect_Number++;
5413       VMS_Psect_Spec ("$data", Local_Initd_Data_Size, ps_DATA, 0);
5414       /*
5415        * Local initialized data (N_DATA) symbols need to be updated to the
5416        * proper value of Data_Psect now that it's actually been defined.
5417        * (A dummy value was used in global_symbol_directory() above.)
5418        */
5419       for (vsp = VMS_Symbols; vsp; vsp = vsp->Next)
5420         if (vsp->Psect_Index < 0 && S_GET_RAW_TYPE (vsp->Symbol) == N_DATA)
5421           vsp->Psect_Index = Data_Psect;
5422     }
5423
5424   if (Ctors_Symbols != 0)
5425     {
5426       char *ps_name = "$ctors";
5427       Ctors_Psect = Psect_Number++;
5428       VMS_Psect_Spec (ps_name, Ctors_Symbols->Psect_Offset + XTOR_SIZE,
5429                       ps_CTORS, 0);
5430       VMS_Global_Symbol_Spec (ps_name, Ctors_Psect,
5431                                   0, GBLSYM_DEF|GBLSYM_WEAK);
5432       for (vsp = Ctors_Symbols; vsp; vsp = vsp->Next)
5433         vsp->Psect_Index = Ctors_Psect;
5434     }
5435
5436   if (Dtors_Symbols != 0)
5437     {
5438       char *ps_name = "$dtors";
5439       Dtors_Psect = Psect_Number++;
5440       VMS_Psect_Spec (ps_name, Dtors_Symbols->Psect_Offset + XTOR_SIZE,
5441                       ps_DTORS, 0);
5442       VMS_Global_Symbol_Spec (ps_name, Dtors_Psect,
5443                                   0, GBLSYM_DEF|GBLSYM_WEAK);
5444       for (vsp = Dtors_Symbols; vsp; vsp = vsp->Next)
5445         vsp->Psect_Index = Dtors_Psect;
5446     }
5447
5448   /*******  Text Information and Relocation Records  *******/
5449
5450   /*
5451    *    Write the text segment data
5452    */
5453   if (text_siz > 0)
5454     vms_fixup_text_section (text_siz, text_frag_root, data_frag_root);
5455   /*
5456    *    Write the data segment data, then discard it.
5457    */
5458   if (data_siz > 0)
5459     {
5460       vms_fixup_data_section (data_siz, text_siz);
5461       free (Data_Segment),  Data_Segment = 0;
5462     }
5463
5464   if (Ctors_Symbols != 0)
5465     {
5466       vms_fixup_xtors_section (Ctors_Symbols, Ctors_Psect);
5467     }
5468
5469   if (Dtors_Symbols != 0)
5470     {
5471       vms_fixup_xtors_section (Dtors_Symbols, Dtors_Psect);
5472     }
5473
5474   /*******  Debugger Symbol Table Records  *******/
5475
5476   vms_build_DST (text_siz);
5477
5478   /*******  Wrap things up  *******/
5479
5480   /*
5481    *    Write the End Of Module record
5482    */
5483   if (Entry_Point_Symbol)
5484     Write_VMS_EOM_Record (Text_Psect, S_GET_VALUE (Entry_Point_Symbol));
5485   else
5486     Write_VMS_EOM_Record (-1, (valueT) 0);
5487
5488   /*
5489    *    All done, close the object file
5490    */
5491   Close_VMS_Object_File ();
5492 }