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