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