gas/config/obj-vms.c

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