gas/config/obj-vms.c

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