bfd/vms-tir.c

   1 /* vms-tir.c -- BFD back-end for VAX (openVMS/VAX) and
   2    EVAX (openVMS/Alpha) files.
   3    Copyright 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2004, 2005, 2007,
   4    2008, 2009 Free Software Foundation, Inc.
   5
   6    TIR record handling functions
   7    ETIR record handling functions
   8
   9    Go and read the openVMS linker manual (esp. appendix B)
  10    if you don't know what's going on here :-)
  11
  12    Written by Klaus K"ampf (kkaempf@rmi.de)
  13
  14    This program is free software; you can redistribute it and/or modify
  15    it under the terms of the GNU General Public License as published by
  16    the Free Software Foundation; either version 3 of the License, or
  17    (at your option) any later version.
  18
  19    This program is distributed in the hope that it will be useful,
  20    but WITHOUT ANY WARRANTY; without even the implied warranty of
  21    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22    GNU General Public License for more details.
  23
  24    You should have received a copy of the GNU General Public License
  25    along with this program; if not, write to the Free Software
  26    Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston,
  27    MA 02110-1301, USA.  */
  28
  29 /* The following type abbreviations are used:
  30
  31         cs      counted string (ascii string with length byte)
  32         by      byte (1 byte)
  33         sh      short (2 byte, 16 bit)
  34         lw      longword (4 byte, 32 bit)
  35         qw      quadword (8 byte, 64 bit)
  36         da      data stream  */
  37
  38 #include "sysdep.h"
  39 #include "bfd.h"
  40 #include "bfdlink.h"
  41 #include "libbfd.h"
  42 #include "vms.h"
  43
  44 static int check_section (bfd *, int);
  45 static void image_set_ptr (bfd *abfd, int psect, uquad offset);
  46 static void image_inc_ptr (bfd *abfd, uquad offset);
  47 static void dst_define_location (bfd *abfd, uquad loc);
  48 static void dst_restore_location (bfd *abfd, uquad loc);
  49 static unsigned int dst_retrieve_location (bfd *abfd, uquad loc);
  50 static void dst_check_allocation (bfd *abfd, unsigned int size);
  51 static void image_dump (bfd *abfd, unsigned char *ptr, int size, int offset);
  52 static void image_write_b (bfd *abfd, unsigned int value);
  53 static void image_write_w (bfd *abfd, unsigned int value);
  54 static void image_write_l (bfd *abfd, unsigned long value);
  55 static void image_write_q (bfd *abfd, uquad value);
  56 static bfd_boolean etir_sta (bfd *, int, unsigned char *, int *);
  57 static bfd_boolean etir_sto (bfd *, int, unsigned char *, int *);
  58 static bfd_boolean etir_opr (bfd *, int, unsigned char *, int *);
  59 static bfd_boolean etir_ctl (bfd *, int, unsigned char *, int *);
  60 static bfd_boolean etir_stc (bfd *, int, unsigned char *, int *);
  61 static asection *new_section (bfd *, int);
  62 static int alloc_section (bfd *, unsigned int);
  63 static int etir_cmd (bfd *, int, unsigned char *, int *);
  64 static int analyze_tir (bfd *, unsigned char *, unsigned int);
  65 static int analyze_etir (bfd *, unsigned char *, unsigned int);
  66 static unsigned char *tir_opr (bfd *, unsigned char *);
  67 static const char *tir_cmd_name (int);
  68 static const char *cmd_name (int);
  69
  70 \f
  71 static int
  72 check_section (bfd * abfd, int size)
  73 {
  74   bfd_size_type offset;
  75
  76   offset = PRIV (image_ptr) - PRIV (image_section)->contents;
  77   if (offset + size > PRIV (image_section)->size)
  78     {
  79       PRIV (image_section)->contents
  80         = bfd_realloc_or_free (PRIV (image_section)->contents, offset + size);
  81       if (PRIV (image_section)->contents == NULL)
  82         {
  83           (*_bfd_error_handler) (_("No Mem !"));
  84           return -1;
  85         }
  86       PRIV (image_section)->size = offset + size;
  87       PRIV (image_ptr) = PRIV (image_section)->contents + offset;
  88     }
  89
  90   return 0;
  91 }
  92
  93 /* Routines to fill sections contents during tir/etir read.  */
  94
  95 /* Initialize image buffer pointer to be filled.  */
  96
  97 static void
  98 image_set_ptr (bfd * abfd, int psect, uquad offset)
  99 {
 100 #if VMS_DEBUG
 101   _bfd_vms_debug (4, "image_set_ptr (%d=%s, %d)\n",
 102                   psect, PRIV (sections)[psect]->name, offset);
 103 #endif
 104
 105   PRIV (image_ptr) = PRIV (sections)[psect]->contents + offset;
 106   PRIV (image_section) = PRIV (sections)[psect];
 107 }
 108
 109 /* Increment image buffer pointer by offset.  */
 110
 111 static void
 112 image_inc_ptr (bfd * abfd, uquad offset)
 113 {
 114 #if VMS_DEBUG
 115   _bfd_vms_debug (4, "image_inc_ptr (%d)\n", offset);
 116 #endif
 117
 118   PRIV (image_ptr) += offset;
 119 }
 120
 121 /* Save current DST location counter under specified index.  */
 122
 123 static void
 124 dst_define_location (bfd *abfd, uquad loc)
 125 {
 126   asection *dst_section = PRIV (dst_section);
 127
 128 #if VMS_DEBUG
 129   _bfd_vms_debug (4, "dst_define_location (%d)\n", (int)loc);
 130 #endif
 131
 132   /* Grow the ptr offset table if necessary.  */
 133   if (loc + 1 > PRIV (dst_ptr_offsets_count))
 134     {
 135       PRIV (dst_ptr_offsets) = bfd_realloc (PRIV (dst_ptr_offsets),
 136                                            (loc + 1) * sizeof (unsigned int));
 137       PRIV (dst_ptr_offsets_count) = loc + 1;
 138     }
 139
 140   PRIV (dst_ptr_offsets)[loc] = PRIV (image_ptr) - dst_section->contents;
 141 }
 142
 143 /* Restore saved DST location counter from specified index.  */
 144
 145 static void
 146 dst_restore_location (bfd *abfd, uquad loc)
 147 {
 148   asection *dst_section = PRIV (dst_section);
 149
 150 #if VMS_DEBUG
 151   _bfd_vms_debug (4, "dst_restore_location (%d)\n", (int)loc);
 152 #endif
 153
 154   PRIV (image_ptr) = dst_section->contents + PRIV (dst_ptr_offsets)[loc];
 155 }
 156
 157 /* Retrieve saved DST location counter from specified index.  */
 158
 159 static unsigned int
 160 dst_retrieve_location (bfd *abfd, uquad loc)
 161 {
 162 #if VMS_DEBUG
 163   _bfd_vms_debug (4, "dst_retrieve_location (%d)\n", (int)loc);
 164 #endif
 165
 166   return PRIV (dst_ptr_offsets)[loc];
 167 }
 168
 169 /* Check that the DST section is big enough for the specified
 170    amount of bytes.  */
 171
 172 static void
 173 dst_check_allocation (bfd *abfd, unsigned int size)
 174 {
 175   asection *dst_section = PRIV (dst_section);
 176
 177   bfd_size_type used = PRIV (image_ptr) - dst_section->contents;
 178   bfd_size_type left = dst_section->size - used;
 179
 180   /* Grow the DST section as necessary */
 181   if (size > left)
 182     {
 183       dst_section->size *= 2;
 184       dst_section->contents
 185         = bfd_realloc (dst_section->contents, dst_section->size);
 186       PRIV (image_ptr) = dst_section->contents + used;
 187
 188       dst_check_allocation (abfd, size);
 189     }
 190 }
 191
 192 /* Dump multiple bytes to section image.  */
 193
 194 static void
 195 image_dump (bfd * abfd,
 196             unsigned char *ptr,
 197             int size,
 198             int offset ATTRIBUTE_UNUSED)
 199 {
 200 #if VMS_DEBUG
 201   _bfd_vms_debug (8, "image_dump from (%p, %d) to (%p)\n", ptr, size,
 202                   PRIV (image_ptr));
 203   _bfd_hexdump (9, ptr, size, offset);
 204 #endif
 205
 206   if (PRIV (is_vax) && check_section (abfd, size))
 207     return;
 208
 209   if (PRIV (dst_section))
 210     dst_check_allocation (abfd, size);
 211
 212   while (size-- > 0)
 213     *PRIV (image_ptr)++ = *ptr++;
 214 }
 215
 216 /* Write byte to section image.  */
 217
 218 static void
 219 image_write_b (bfd * abfd, unsigned int value)
 220 {
 221 #if VMS_DEBUG
 222   _bfd_vms_debug (6, "image_write_b (%02x)\n", (int) value);
 223 #endif
 224
 225   if (PRIV (is_vax) && check_section (abfd, 1))
 226     return;
 227
 228   if (PRIV (dst_section))
 229     dst_check_allocation (abfd, 1);
 230
 231   *PRIV (image_ptr)++ = (value & 0xff);
 232 }
 233
 234 /* Write 2-byte word to image.  */
 235
 236 static void
 237 image_write_w (bfd * abfd, unsigned int value)
 238 {
 239 #if VMS_DEBUG
 240   _bfd_vms_debug (6, "image_write_w (%04x)\n", (int) value);
 241 #endif
 242
 243   if (PRIV (is_vax) && check_section (abfd, 2))
 244     return;
 245
 246   if (PRIV (dst_section))
 247     dst_check_allocation (abfd, 2);
 248
 249   bfd_putl16 ((bfd_vma) value, PRIV (image_ptr));
 250   PRIV (image_ptr) += 2;
 251 }
 252
 253 /* Write 4-byte long to image.  */
 254
 255 static void
 256 image_write_l (bfd * abfd, unsigned long value)
 257 {
 258 #if VMS_DEBUG
 259   _bfd_vms_debug (6, "image_write_l (%08lx)\n", value);
 260 #endif
 261
 262   if (PRIV (is_vax) && check_section (abfd, 4))
 263     return;
 264
 265   if (PRIV (dst_section))
 266     dst_check_allocation (abfd, 4);
 267
 268   bfd_putl32 ((bfd_vma) value, PRIV (image_ptr));
 269   PRIV (image_ptr) += 4;
 270 }
 271
 272 /* Write 8-byte quad to image.  */
 273
 274 static void
 275 image_write_q (bfd * abfd, uquad value)
 276 {
 277 #if VMS_DEBUG
 278   _bfd_vms_debug (6, "image_write_q (%016lx)\n", value);
 279 #endif
 280
 281   if (PRIV (is_vax) && check_section (abfd, 8))
 282     return;
 283
 284   if (PRIV (dst_section))
 285     dst_check_allocation (abfd, 8);
 286
 287   bfd_putl64 (value, PRIV (image_ptr));
 288   PRIV (image_ptr) += 8;
 289 }
 290 \f
 291 static const char *
 292 cmd_name (int cmd)
 293 {
 294   switch (cmd)
 295     {
 296     case ETIR_S_C_STA_GBL: return "ETIR_S_C_STA_GBL";
 297     case ETIR_S_C_STA_LW: return "ETIR_S_C_STA_LW";
 298     case ETIR_S_C_STA_QW: return "ETIR_S_C_STA_QW";
 299     case ETIR_S_C_STA_PQ: return "ETIR_S_C_STA_PQ";
 300     case ETIR_S_C_STA_LI: return "ETIR_S_C_STA_LI";
 301     case ETIR_S_C_STA_MOD: return "ETIR_S_C_STA_MOD";
 302     case ETIR_S_C_STA_CKARG: return "ETIR_S_C_STA_CKARG";
 303     case ETIR_S_C_STO_B: return "ETIR_S_C_STO_B";
 304     case ETIR_S_C_STO_W: return "ETIR_S_C_STO_W";
 305     case ETIR_S_C_STO_GBL: return "ETIR_S_C_STO_GBL";
 306     case ETIR_S_C_STO_CA: return "ETIR_S_C_STO_CA";
 307     case ETIR_S_C_STO_RB: return "ETIR_S_C_STO_RB";
 308     case ETIR_S_C_STO_AB: return "ETIR_S_C_STO_AB";
 309     case ETIR_S_C_STO_OFF: return "ETIR_S_C_STO_OFF";
 310     case ETIR_S_C_STO_IMM: return "ETIR_S_C_STO_IMM";
 311     case ETIR_S_C_STO_IMMR: return "ETIR_S_C_STO_IMMR";
 312     case ETIR_S_C_STO_LW: return "ETIR_S_C_STO_LW";
 313     case ETIR_S_C_STO_QW: return "ETIR_S_C_STO_QW";
 314     case ETIR_S_C_STO_GBL_LW: return "ETIR_S_C_STO_GBL_LW";
 315     case ETIR_S_C_STO_LP_PSB: return "ETIR_S_C_STO_LP_PSB";
 316     case ETIR_S_C_STO_HINT_GBL: return "ETIR_S_C_STO_HINT_GBL";
 317     case ETIR_S_C_STO_HINT_PS: return "ETIR_S_C_STO_HINT_PS";
 318     case ETIR_S_C_OPR_ADD: return "ETIR_S_C_OPR_ADD";
 319     case ETIR_S_C_OPR_INSV: return "ETIR_S_C_OPR_INSV";
 320     case ETIR_S_C_OPR_USH: return "ETIR_S_C_OPR_USH";
 321     case ETIR_S_C_OPR_ROT: return "ETIR_S_C_OPR_ROT";
 322     case ETIR_S_C_OPR_REDEF: return "ETIR_S_C_OPR_REDEF";
 323     case ETIR_S_C_OPR_DFLIT: return "ETIR_S_C_OPR_DFLIT";
 324     case ETIR_S_C_STC_LP: return "ETIR_S_C_STC_LP";
 325     case ETIR_S_C_STC_GBL: return "ETIR_S_C_STC_GBL";
 326     case ETIR_S_C_STC_GCA: return "ETIR_S_C_STC_GCA";
 327     case ETIR_S_C_STC_PS: return "ETIR_S_C_STC_PS";
 328     case ETIR_S_C_STC_NBH_PS: return "ETIR_S_C_STC_NBH_PS";
 329     case ETIR_S_C_STC_NOP_GBL: return "ETIR_S_C_STC_NOP_GBL";
 330     case ETIR_S_C_STC_NOP_PS: return "ETIR_S_C_STC_NOP_PS";
 331     case ETIR_S_C_STC_BSR_GBL: return "ETIR_S_C_STC_BSR_GBL";
 332     case ETIR_S_C_STC_BSR_PS: return "ETIR_S_C_STC_BSR_PS";
 333     case ETIR_S_C_STC_LDA_GBL: return "ETIR_S_C_STC_LDA_GBL";
 334     case ETIR_S_C_STC_LDA_PS: return "ETIR_S_C_STC_LDA_PS";
 335     case ETIR_S_C_STC_BOH_GBL: return "ETIR_S_C_STC_BOH_GBL";
 336     case ETIR_S_C_STC_BOH_PS: return "ETIR_S_C_STC_BOH_PS";
 337     case ETIR_S_C_STC_NBH_GBL: return "ETIR_S_C_STC_NBH_GBL";
 338     case ETIR_S_C_CTL_SETRB: return "ETIR_S_C_CTL_SETRB";
 339     case ETIR_S_C_STC_LP_PSB: return "ETIR_S_C_STC_LP_PSB";
 340     case ETIR_S_C_CTL_DFLOC: return "ETIR_S_C_CTL_DFLOC";
 341     case ETIR_S_C_CTL_STLOC: return "ETIR_S_C_CTL_STLOC";
 342     case ETIR_S_C_CTL_STKDL: return "ETIR_S_C_CTL_STKDL";
 343
 344     default:
 345       /* These names have not yet been added to this switch statement.  */
 346       (*_bfd_error_handler) (_("unknown ETIR command %d"), cmd);
 347     }
 348
 349   return NULL;
 350 }
 351 #define HIGHBIT(op) ((op & 0x80000000L) == 0x80000000L)
 352
 353 /* etir_sta
 354
 355    Vms stack commands.
 356
 357    Handle sta_xxx commands in etir section,
 358    ptr points to data area in record.
 359
 360    See table B-8 of the openVMS linker manual.  */
 361
 362 static bfd_boolean
 363 etir_sta (bfd *abfd, int cmd, unsigned char *ptr, int *quarter_relocs)
 364 {
 365 #if VMS_DEBUG
 366   _bfd_vms_debug (5, "etir_sta %d/%x\n", cmd, cmd);
 367   _bfd_hexdump (8, ptr, 16, (long) ptr);
 368 #endif
 369
 370   switch (cmd)
 371     {
 372       /* Stack global
 373          arg: cs        symbol name
 374
 375          stack 32 bit value of symbol (high bits set to 0).  */
 376     case ETIR_S_C_STA_GBL:
 377       {
 378         char *name;
 379         vms_symbol_entry *entry;
 380
 381         name = _bfd_vms_save_counted_string (ptr);
 382         entry = (vms_symbol_entry *)
 383           bfd_hash_lookup (PRIV (vms_symbol_table), name, FALSE, FALSE);
 384         if (entry == NULL)
 385           {
 386 #if VMS_DEBUG
 387             _bfd_vms_debug (3, "%s: no symbol \"%s\"\n",
 388                             cmd_name (cmd), name);
 389 #endif
 390             _bfd_vms_push (abfd, (uquad) 0, -1);
 391           }
 392         else
 393           _bfd_vms_push (abfd, (uquad) (entry->symbol->value), -1);
 394       }
 395       *quarter_relocs = 1;
 396       break;
 397
 398       /* Stack longword
 399          arg: lw        value
 400
 401          stack 32 bit value, sign extend to 64 bit.  */
 402     case ETIR_S_C_STA_LW:
 403       _bfd_vms_push (abfd, (uquad) bfd_getl32 (ptr), -1);
 404       /* This one is special as it is both part of the section header
 405          and of the ALPHA_R_REFLONG relocation.  */
 406       if (bfd_getl16 (ptr - 4 + bfd_getl16 (ptr - 2)) == ETIR_S_C_CTL_DFLOC)
 407         *quarter_relocs = 0;
 408       else if (*quarter_relocs)
 409         *quarter_relocs += 1;
 410       else
 411         *quarter_relocs = 2;
 412       break;
 413
 414       /* Stack quadword
 415          arg: qw        value
 416
 417          stack 64 bit value of symbol.  */
 418     case ETIR_S_C_STA_QW:
 419       _bfd_vms_push (abfd, (uquad) bfd_getl64 (ptr), -1);
 420       if (*quarter_relocs)
 421         *quarter_relocs += 1;
 422       else
 423         *quarter_relocs = 2;
 424       break;
 425
 426       /* Stack psect base plus quadword offset
 427          arg: lw        section index
 428          qw     signed quadword offset (low 32 bits)
 429
 430          Stack qw argument and section index
 431          (see ETIR_S_C_STO_OFF, ETIR_S_C_CTL_SETRB).  */
 432     case ETIR_S_C_STA_PQ:
 433       {
 434         uquad dummy;
 435         int psect;
 436
 437         psect = bfd_getl32 (ptr);
 438         if ((unsigned int) psect >= PRIV (section_count))
 439           {
 440             (*_bfd_error_handler) (_("bad section index in %s"),
 441                                    cmd_name (cmd));
 442             bfd_set_error (bfd_error_bad_value);
 443             return FALSE;
 444           }
 445         dummy = bfd_getl64 (ptr + 4);
 446         _bfd_vms_push (abfd, dummy, (int) psect);
 447       }
 448       /* This one is special as it is both part of the section header
 449          and of the ALPHA_R_REFLONG and ALPHA_R_REFQUAD relocations.  */
 450       if (bfd_getl16 (ptr - 4 + bfd_getl16 (ptr - 2)) == ETIR_S_C_CTL_SETRB)
 451         *quarter_relocs = 0;
 452       else
 453         *quarter_relocs = 2;
 454       break;
 455
 456     case ETIR_S_C_STA_LI:
 457     case ETIR_S_C_STA_MOD:
 458     case ETIR_S_C_STA_CKARG:
 459       (*_bfd_error_handler) (_("unsupported STA cmd %s"), cmd_name (cmd));
 460       *quarter_relocs = 0;
 461       return FALSE;
 462
 463     default:
 464       (*_bfd_error_handler) (_("reserved STA cmd %d"), cmd);
 465       *quarter_relocs = 0;
 466       return FALSE;
 467     }
 468
 469 #if VMS_DEBUG
 470   _bfd_vms_debug (5, "etir_sta true\n");
 471 #endif
 472
 473   return TRUE;
 474 }
 475
 476 /* etir_sto
 477
 478    vms store commands
 479
 480    handle sto_xxx commands in etir section
 481    ptr points to data area in record
 482
 483    see table B-9 of the openVMS linker manual.  */
 484
 485 static bfd_boolean
 486 etir_sto (bfd *abfd, int cmd, unsigned char *ptr, int *quarter_relocs)
 487 {
 488   uquad dummy;
 489   int psect;
 490
 491 #if VMS_DEBUG
 492   _bfd_vms_debug (5, "etir_sto %d/%x\n", cmd, cmd);
 493   _bfd_hexdump (8, ptr, 16, (long) ptr);
 494 #endif
 495
 496   switch (cmd)
 497     {
 498       /* Store byte: pop stack, write byte
 499          arg: -.  */
 500     case ETIR_S_C_STO_B:
 501       dummy = _bfd_vms_pop (abfd, &psect);
 502       /* FIXME: check top bits.  */
 503       image_write_b (abfd, (unsigned int) dummy & 0xff);
 504       *quarter_relocs = 0;
 505       break;
 506
 507       /* Store word: pop stack, write word
 508          arg: -.  */
 509     case ETIR_S_C_STO_W:
 510       dummy = _bfd_vms_pop (abfd, &psect);
 511       /* FIXME: check top bits */
 512       image_write_w (abfd, (unsigned int) dummy & 0xffff);
 513       *quarter_relocs = 0;
 514       break;
 515
 516       /* Store longword: pop stack, write longword
 517          arg: -.  */
 518     case ETIR_S_C_STO_LW:
 519       dummy = _bfd_vms_pop (abfd, &psect);
 520       dummy += (PRIV (sections)[psect])->vma;
 521       /* FIXME: check top bits.  */
 522       image_write_l (abfd, (unsigned int) dummy & 0xffffffff);
 523       if (*quarter_relocs == 2)
 524         *quarter_relocs = 4;
 525       else
 526         *quarter_relocs += 1;
 527       break;
 528
 529       /* Store quadword: pop stack, write quadword
 530          arg: -.  */
 531     case ETIR_S_C_STO_QW:
 532       dummy = _bfd_vms_pop (abfd, &psect);
 533       dummy += (PRIV (sections)[psect])->vma;
 534       /* FIXME: check top bits.  */
 535       image_write_q (abfd, dummy);
 536       if (*quarter_relocs == 2)
 537         *quarter_relocs = 4;
 538       else
 539         *quarter_relocs += 1;
 540       break;
 541
 542       /* Store immediate repeated: pop stack for repeat count
 543          arg: lw        byte count
 544          da     data.  */
 545     case ETIR_S_C_STO_IMMR:
 546       {
 547         int size;
 548
 549         size = bfd_getl32 (ptr);
 550         dummy = (unsigned long) _bfd_vms_pop (abfd, NULL);
 551         while (dummy-- > 0)
 552           image_dump (abfd, ptr+4, size, 0);
 553       }
 554       *quarter_relocs = 0;
 555       break;
 556
 557       /* Store global: write symbol value
 558          arg: cs        global symbol name.  */
 559     case ETIR_S_C_STO_GBL:
 560       {
 561         vms_symbol_entry *entry;
 562         char *name;
 563
 564         name = _bfd_vms_save_counted_string (ptr);
 565         entry = (vms_symbol_entry *) bfd_hash_lookup (PRIV (vms_symbol_table),
 566                                                       name, FALSE, FALSE);
 567         if (entry == NULL)
 568           /* FIXME, reloc.  */
 569           image_write_q (abfd, (uquad) (0));
 570         else
 571           /* FIXME, reloc.  */
 572           image_write_q (abfd, (uquad) (entry->symbol->value));
 573       }
 574       *quarter_relocs = 4;
 575       break;
 576
 577       /* Store code address: write address of entry point
 578          arg: cs        global symbol name (procedure).  */
 579     case ETIR_S_C_STO_CA:
 580       {
 581         vms_symbol_entry *entry;
 582         char *name;
 583
 584         name = _bfd_vms_save_counted_string (ptr);
 585         entry = (vms_symbol_entry *) bfd_hash_lookup (PRIV (vms_symbol_table),
 586                                                       name, FALSE, FALSE);
 587         if (entry == NULL)
 588           /* FIXME, reloc.  */
 589           image_write_q (abfd, (uquad) (0));
 590         else
 591           /* FIXME, reloc.  */
 592           image_write_q (abfd, (uquad) (entry->symbol->value));
 593       }
 594       *quarter_relocs = 4;
 595       break;
 596
 597       /* Store offset to psect: pop stack, add low 32 bits to base of psect
 598          arg: none.  */
 599     case ETIR_S_C_STO_OFF:
 600       {
 601         uquad q;
 602         int psect1;
 603
 604         q = _bfd_vms_pop (abfd, & psect1);
 605         q += (PRIV (sections)[psect1])->vma;
 606         image_write_q (abfd, q);
 607       }
 608       *quarter_relocs += 2;
 609       break;
 610
 611       /* Store immediate
 612          arg: lw        count of bytes
 613               da        data.  */
 614     case ETIR_S_C_STO_IMM:
 615       {
 616         int size;
 617
 618         size = bfd_getl32 (ptr);
 619         image_dump (abfd, ptr+4, size, 0);
 620       }
 621       *quarter_relocs = 0;
 622       break;
 623
 624       /* This code is 'reserved to digital' according to the openVMS
 625          linker manual, however it is generated by the DEC C compiler
 626          and defined in the include file.
 627          FIXME, since the following is just a guess
 628          store global longword: store 32bit value of symbol
 629          arg: cs        symbol name.  */
 630     case ETIR_S_C_STO_GBL_LW:
 631       {
 632         vms_symbol_entry *entry;
 633         char *name;
 634
 635         name = _bfd_vms_save_counted_string (ptr);
 636         entry = (vms_symbol_entry *) bfd_hash_lookup (PRIV (vms_symbol_table),
 637                                                       name, FALSE, FALSE);
 638         if (entry == NULL)
 639           {
 640 #if VMS_DEBUG
 641             _bfd_vms_debug (3, "%s: no symbol \"%s\"\n", cmd_name (cmd), name);
 642 #endif
 643             image_write_l (abfd, (unsigned long) 0);    /* FIXME, reloc */
 644           }
 645         else
 646           /* FIXME, reloc.  */
 647           image_write_l (abfd, (unsigned long) (entry->symbol->value));
 648       }
 649       *quarter_relocs = 4;
 650       break;
 651
 652     case ETIR_S_C_STO_RB:
 653     case ETIR_S_C_STO_AB:
 654     case ETIR_S_C_STO_LP_PSB:
 655       (*_bfd_error_handler) (_("%s: not supported"), cmd_name (cmd));
 656       *quarter_relocs = 0;
 657       return FALSE;
 658
 659     case ETIR_S_C_STO_HINT_GBL:
 660     case ETIR_S_C_STO_HINT_PS:
 661       (*_bfd_error_handler) (_("%s: not implemented"), cmd_name (cmd));
 662       *quarter_relocs = 0;
 663       return FALSE;
 664
 665     default:
 666       (*_bfd_error_handler) (_("reserved STO cmd %d"), cmd);
 667       *quarter_relocs = 0;
 668       return FALSE;
 669     }
 670
 671   return TRUE;
 672 }
 673
 674 /* Stack operator commands
 675    all 32 bit signed arithmetic
 676    all word just like a stack calculator
 677    arguments are popped from stack, results are pushed on stack
 678
 679    see table B-10 of the openVMS linker manual.  */
 680
 681 static bfd_boolean
 682 etir_opr (bfd *abfd, int cmd, unsigned char *ptr ATTRIBUTE_UNUSED,
 683           int *quarter_relocs)
 684 {
 685   long op1, op2;
 686
 687 #if VMS_DEBUG
 688   _bfd_vms_debug (5, "etir_opr %d/%x\n", cmd, cmd);
 689   _bfd_hexdump (8, ptr, 16, (long) ptr);
 690 #endif
 691
 692   /* No relocation uses OPR commands except ETIR_S_C_OPR_ADD.  */
 693   if (cmd == ETIR_S_C_OPR_ADD)
 694     *quarter_relocs += 1;
 695   else
 696     *quarter_relocs = 0;
 697
 698   switch (cmd)
 699     {
 700     case ETIR_S_C_OPR_NOP:      /* No-op.  */
 701       break;
 702
 703     case ETIR_S_C_OPR_ADD:      /* Add.  */
 704       op1 = (long) _bfd_vms_pop (abfd, NULL);
 705       op2 = (long) _bfd_vms_pop (abfd, NULL);
 706       _bfd_vms_push (abfd, (uquad) (op1 + op2), -1);
 707       break;
 708
 709     case ETIR_S_C_OPR_SUB:      /* Subtract.  */
 710       op1 = (long) _bfd_vms_pop (abfd, NULL);
 711       op2 = (long) _bfd_vms_pop (abfd, NULL);
 712       _bfd_vms_push (abfd, (uquad) (op2 - op1), -1);
 713       break;
 714
 715     case ETIR_S_C_OPR_MUL:      /* Multiply.  */
 716       op1 = (long) _bfd_vms_pop (abfd, NULL);
 717       op2 = (long) _bfd_vms_pop (abfd, NULL);
 718       _bfd_vms_push (abfd, (uquad) (op1 * op2), -1);
 719       break;
 720
 721     case ETIR_S_C_OPR_DIV:      /* Divide.  */
 722       op1 = (long) _bfd_vms_pop (abfd, NULL);
 723       op2 = (long) _bfd_vms_pop (abfd, NULL);
 724       if (op2 == 0)
 725         _bfd_vms_push (abfd, (uquad) 0, -1);
 726       else
 727         _bfd_vms_push (abfd, (uquad) (op2 / op1), -1);
 728       break;
 729
 730     case ETIR_S_C_OPR_AND:      /* Logical AND.  */
 731       op1 = (long) _bfd_vms_pop (abfd, NULL);
 732       op2 = (long) _bfd_vms_pop (abfd, NULL);
 733       _bfd_vms_push (abfd, (uquad) (op1 & op2), -1);
 734       break;
 735
 736     case ETIR_S_C_OPR_IOR:      /* Logical inclusive OR.  */
 737       op1 = (long) _bfd_vms_pop (abfd, NULL);
 738       op2 = (long) _bfd_vms_pop (abfd, NULL);
 739       _bfd_vms_push (abfd, (uquad) (op1 | op2), -1);
 740       break;
 741
 742     case ETIR_S_C_OPR_EOR:      /* Logical exclusive OR.  */
 743       op1 = (long) _bfd_vms_pop (abfd, NULL);
 744       op2 = (long) _bfd_vms_pop (abfd, NULL);
 745       _bfd_vms_push (abfd, (uquad) (op1 ^ op2), -1);
 746       break;
 747
 748     case ETIR_S_C_OPR_NEG:      /* Negate.  */
 749       op1 = (long) _bfd_vms_pop (abfd, NULL);
 750       _bfd_vms_push (abfd, (uquad) (-op1), -1);
 751       break;
 752
 753     case ETIR_S_C_OPR_COM:      /* Complement.  */
 754       op1 = (long) _bfd_vms_pop (abfd, NULL);
 755       _bfd_vms_push (abfd, (uquad) (op1 ^ -1L), -1);
 756       break;
 757
 758     case ETIR_S_C_OPR_ASH:      /* Arithmetic shift.  */
 759       op1 = (long) _bfd_vms_pop (abfd, NULL);
 760       op2 = (long) _bfd_vms_pop (abfd, NULL);
 761       if (op2 < 0)              /* Shift right.  */
 762         op1 >>= -op2;
 763       else                      /* Shift left.  */
 764         op1 <<= op2;
 765       _bfd_vms_push (abfd, (uquad) op1, -1);
 766       break;
 767
 768     case ETIR_S_C_OPR_INSV:      /* Insert field.   */
 769       (void) _bfd_vms_pop (abfd, NULL);
 770     case ETIR_S_C_OPR_USH:       /* Unsigned shift.   */
 771     case ETIR_S_C_OPR_ROT:       /* Rotate.  */
 772     case ETIR_S_C_OPR_REDEF:     /* Redefine symbol to current location.  */
 773     case ETIR_S_C_OPR_DFLIT:     /* Define a literal.  */
 774       (*_bfd_error_handler) (_("%s: not supported"), cmd_name (cmd));
 775       return FALSE;
 776
 777     case ETIR_S_C_OPR_SEL:      /* Select.  */
 778       if ((long) _bfd_vms_pop (abfd, NULL) & 0x01L)
 779         (void) _bfd_vms_pop (abfd, NULL);
 780       else
 781         {
 782           op1 = (long) _bfd_vms_pop (abfd, NULL);
 783           (void) _bfd_vms_pop (abfd, NULL);
 784           _bfd_vms_push (abfd, (uquad) op1, -1);
 785         }
 786       break;
 787
 788     default:
 789       (*_bfd_error_handler) (_("reserved OPR cmd %d"), cmd);
 790       return FALSE;
 791     }
 792
 793   return TRUE;
 794 }
 795
 796 /* Control commands.
 797
 798    See table B-11 of the openVMS linker manual.  */
 799
 800 static bfd_boolean
 801 etir_ctl (bfd *abfd, int cmd, unsigned char *ptr, int *quarter_relocs)
 802 {
 803   uquad dummy;
 804   int psect;
 805
 806 #if VMS_DEBUG
 807   _bfd_vms_debug (5, "etir_ctl %d/%x\n", cmd, cmd);
 808   _bfd_hexdump (8, ptr, 16, (long) ptr);
 809 #endif
 810
 811   /* No relocation uses CTL commands.  */
 812   *quarter_relocs = 0;
 813
 814   switch (cmd)
 815     {
 816       /* Det relocation base: pop stack, set image location counter
 817          arg: none.  */
 818     case ETIR_S_C_CTL_SETRB:
 819       dummy = _bfd_vms_pop (abfd, &psect);
 820       image_set_ptr (abfd, psect, dummy);
 821       break;
 822
 823       /* Augment relocation base: increment image location counter by offset
 824          arg: lw        offset value.  */
 825     case ETIR_S_C_CTL_AUGRB:
 826       dummy = bfd_getl32 (ptr);
 827       image_inc_ptr (abfd, dummy);
 828       break;
 829
 830       /* Define location: pop index, save location counter under index
 831          arg: none.  */
 832     case ETIR_S_C_CTL_DFLOC:
 833       dummy = _bfd_vms_pop (abfd, NULL);
 834       dst_define_location (abfd, dummy);
 835       break;
 836
 837       /* Set location: pop index, restore location counter from index
 838          arg: none.  */
 839     case ETIR_S_C_CTL_STLOC:
 840       dummy = _bfd_vms_pop (abfd, NULL);
 841       dst_restore_location (abfd, dummy);
 842       break;
 843
 844       /* Stack defined location: pop index, push location counter from index
 845          arg: none.  */
 846     case ETIR_S_C_CTL_STKDL:
 847       dummy = _bfd_vms_pop (abfd, NULL);
 848       _bfd_vms_push (abfd, dst_retrieve_location (abfd, dummy), -1);
 849       break;
 850
 851     default:
 852       (*_bfd_error_handler) (_("reserved CTL cmd %d"), cmd);
 853       return FALSE;
 854     }
 855
 856   return TRUE;
 857 }
 858
 859 /* Store conditional commands
 860
 861    See table B-12 and B-13 of the openVMS linker manual.  */
 862
 863 static bfd_boolean
 864 etir_stc (bfd *abfd, int cmd, unsigned char *ptr ATTRIBUTE_UNUSED,
 865           int *quarter_relocs)
 866 {
 867 #if VMS_DEBUG
 868   _bfd_vms_debug (5, "etir_stc %d/%x\n", cmd, cmd);
 869   _bfd_hexdump (8, ptr, 16, (long) ptr);
 870 #endif
 871
 872   switch (cmd)
 873     {
 874       /* 200 Store-conditional Linkage Pair
 875          arg: none.  */
 876     case ETIR_S_C_STC_LP:
 877
 878       /* 202 Store-conditional Address at global address
 879          arg:   lw      linkage index
 880                 cs      global name.  */
 881
 882     case ETIR_S_C_STC_GBL:
 883
 884       /* 203 Store-conditional Code Address at global address
 885          arg:   lw      linkage index
 886                 cs      procedure name.  */
 887     case ETIR_S_C_STC_GCA:
 888
 889       /* 204 Store-conditional Address at psect + offset
 890          arg:   lw      linkage index
 891                 lw      psect index
 892                 qw      offset.  */
 893     case ETIR_S_C_STC_PS:
 894       (*_bfd_error_handler) (_("%s: not supported"), cmd_name (cmd));
 895       *quarter_relocs = 0;
 896       return FALSE;
 897
 898       /* 201 Store-conditional Linkage Pair with Procedure Signature
 899          arg:   lw      linkage index
 900                 cs      procedure name
 901                 by      signature length
 902                 da      signature.  */
 903
 904     case ETIR_S_C_STC_LP_PSB:
 905       image_inc_ptr (abfd, (uquad) 16); /* skip entry,procval */
 906       *quarter_relocs = 4;
 907       break;
 908
 909       /* 205 Store-conditional NOP at address of global
 910          arg: none.  */
 911     case ETIR_S_C_STC_NOP_GBL:
 912       /* ALPHA_R_NOP */
 913
 914       /* 207 Store-conditional BSR at global address
 915          arg: none.  */
 916
 917     case ETIR_S_C_STC_BSR_GBL:
 918       /* ALPHA_R_BSR */
 919
 920       /* 209 Store-conditional LDA at global address
 921          arg: none.  */
 922
 923     case ETIR_S_C_STC_LDA_GBL:
 924       /* ALPHA_R_LDA */
 925
 926       /* 211 Store-conditional BSR or Hint at global address
 927          arg: none.  */
 928
 929     case ETIR_S_C_STC_BOH_GBL:
 930       *quarter_relocs = 4;
 931       break;
 932
 933       /* 213 Store-conditional NOP,BSR or HINT at global address
 934          arg: none.  */
 935
 936     case ETIR_S_C_STC_NBH_GBL:
 937
 938       /* 206 Store-conditional NOP at pect + offset
 939          arg: none.  */
 940
 941     case ETIR_S_C_STC_NOP_PS:
 942
 943       /* 208 Store-conditional BSR at pect + offset
 944          arg: none.  */
 945
 946     case ETIR_S_C_STC_BSR_PS:
 947
 948       /* 210 Store-conditional LDA at psect + offset
 949          arg: none.  */
 950
 951     case ETIR_S_C_STC_LDA_PS:
 952
 953       /* 212 Store-conditional BSR or Hint at pect + offset
 954          arg: none.  */
 955
 956     case ETIR_S_C_STC_BOH_PS:
 957
 958       /* 214 Store-conditional NOP, BSR or HINT at psect + offset
 959          arg: none.  */
 960     case ETIR_S_C_STC_NBH_PS:
 961       (*_bfd_error_handler) ("%s: not supported", cmd_name (cmd));
 962       *quarter_relocs = 0;
 963       return FALSE;
 964
 965     default:
 966       (*_bfd_error_handler) (_("reserved STC cmd %d"), cmd);
 967       *quarter_relocs = 0;
 968       return FALSE;
 969     }
 970
 971   return TRUE;
 972 }
 973
 974 static asection *
 975 new_section (bfd * abfd ATTRIBUTE_UNUSED, int idx)
 976 {
 977   asection *section;
 978   char sname[16];
 979   char *name;
 980
 981 #if VMS_DEBUG
 982   _bfd_vms_debug (5, "new_section %d\n", idx);
 983 #endif
 984   sprintf (sname, SECTION_NAME_TEMPLATE, idx);
 985
 986   name = bfd_malloc ((bfd_size_type) strlen (sname) + 1);
 987   if (name == 0)
 988     return NULL;
 989   strcpy (name, sname);
 990
 991   section = bfd_malloc ((bfd_size_type) sizeof (asection));
 992   if (section == 0)
 993     {
 994 #if VMS_DEBUG
 995       _bfd_vms_debug (6,  "new_section (%s) failed", name);
 996 #endif
 997       return NULL;
 998     }
 999
1000   section->size = 0;
1001   section->vma = 0;
1002   section->contents = 0;
1003   section->name = name;
1004   section->index = idx;
1005
1006   return section;
1007 }
1008
1009 static int
1010 alloc_section (bfd * abfd, unsigned int idx)
1011 {
1012   bfd_size_type amt;
1013
1014 #if VMS_DEBUG
1015   _bfd_vms_debug (4, "alloc_section %d\n", idx);
1016 #endif
1017
1018   amt = idx + 1;
1019   amt *= sizeof (asection *);
1020   PRIV (sections) = bfd_realloc_or_free (PRIV (sections), amt);
1021   if (PRIV (sections) == NULL)
1022     return -1;
1023
1024   while (PRIV (section_count) <= idx)
1025     {
1026       PRIV (sections)[PRIV (section_count)]
1027         = new_section (abfd, (int) PRIV (section_count));
1028       if (PRIV (sections)[PRIV (section_count)] == 0)
1029         return -1;
1030       PRIV (section_count)++;
1031     }
1032
1033   return 0;
1034 }
1035
1036 /* tir_sta
1037
1038    Vax stack commands.
1039
1040    Handle sta_xxx commands in tir section,
1041    ptr points to data area in record.
1042
1043    See table 7-3 of the VAX/VMS linker manual.  */
1044
1045 static unsigned char *
1046 tir_sta (bfd * abfd, unsigned char *ptr)
1047 {
1048   int cmd = *ptr++;
1049
1050 #if VMS_DEBUG
1051   _bfd_vms_debug (5, "tir_sta %d\n", cmd);
1052 #endif
1053
1054   switch (cmd)
1055     {
1056       /* stack */
1057     case TIR_S_C_STA_GBL:
1058       /* stack global
1059          arg: cs        symbol name
1060
1061          stack 32 bit value of symbol (high bits set to 0).  */
1062       {
1063         char *name;
1064         vms_symbol_entry *entry;
1065
1066         name = _bfd_vms_save_counted_string (ptr);
1067
1068         entry = _bfd_vms_enter_symbol (abfd, name);
1069         if (entry == NULL)
1070           return NULL;
1071
1072         _bfd_vms_push (abfd, (uquad) (entry->symbol->value), -1);
1073         ptr += *ptr + 1;
1074       }
1075       break;
1076
1077     case TIR_S_C_STA_SB:
1078       /* stack signed byte
1079          arg: by        value
1080
1081          stack byte value, sign extend to 32 bit.  */
1082       _bfd_vms_push (abfd, (uquad) *ptr++, -1);
1083       break;
1084
1085     case TIR_S_C_STA_SW:
1086       /* stack signed short word
1087          arg: sh        value
1088
1089          stack 16 bit value, sign extend to 32 bit.  */
1090       _bfd_vms_push (abfd, (uquad) bfd_getl16 (ptr), -1);
1091       ptr += 2;
1092       break;
1093
1094     case TIR_S_C_STA_LW:
1095       /* stack signed longword
1096          arg: lw        value
1097
1098          stack 32 bit value.  */
1099       _bfd_vms_push (abfd, (uquad) bfd_getl32 (ptr), -1);
1100       ptr += 4;
1101       break;
1102
1103     case TIR_S_C_STA_PB:
1104     case TIR_S_C_STA_WPB:
1105       /* stack psect base plus byte offset (word index)
1106          arg: by        section index
1107                 (sh     section index)
1108                 by      signed byte offset.  */
1109       {
1110         unsigned long dummy;
1111         int psect;
1112
1113         if (cmd == TIR_S_C_STA_PB)
1114           psect = *ptr++;
1115         else
1116           {
1117             psect = bfd_getl16 (ptr);
1118             ptr += 2;
1119           }
1120
1121         if ((unsigned int) psect >= PRIV (section_count))
1122           alloc_section (abfd, psect);
1123
1124         dummy = (long) *ptr++;
1125         dummy += (PRIV (sections)[psect])->vma;
1126         _bfd_vms_push (abfd, (uquad) dummy, psect);
1127       }
1128       break;
1129
1130     case TIR_S_C_STA_PW:
1131     case TIR_S_C_STA_WPW:
1132       /* stack psect base plus word offset (word index)
1133          arg: by        section index
1134                 (sh     section index)
1135                 sh      signed short offset.  */
1136       {
1137         unsigned long dummy;
1138         int psect;
1139
1140         if (cmd == TIR_S_C_STA_PW)
1141           psect = *ptr++;
1142         else
1143           {
1144             psect = bfd_getl16 (ptr);
1145             ptr += 2;
1146           }
1147
1148         if ((unsigned int) psect >= PRIV (section_count))
1149           alloc_section (abfd, psect);
1150
1151         dummy = bfd_getl16 (ptr); ptr+=2;
1152         dummy += (PRIV (sections)[psect])->vma;
1153         _bfd_vms_push (abfd, (uquad) dummy, psect);
1154       }
1155       break;
1156
1157     case TIR_S_C_STA_PL:
1158     case TIR_S_C_STA_WPL:
1159       /* stack psect base plus long offset (word index)
1160          arg: by        section index
1161                 (sh     section index)
1162                 lw      signed longword offset.  */
1163       {
1164         unsigned long dummy;
1165         int psect;
1166
1167         if (cmd == TIR_S_C_STA_PL)
1168           psect = *ptr++;
1169         else
1170           {
1171             psect = bfd_getl16 (ptr);
1172             ptr += 2;
1173           }
1174
1175         if ((unsigned int) psect >= PRIV (section_count))
1176           alloc_section (abfd, psect);
1177
1178         dummy = bfd_getl32 (ptr); ptr += 4;
1179         dummy += (PRIV (sections)[psect])->vma;
1180         _bfd_vms_push (abfd, (uquad) dummy, psect);
1181       }
1182       break;
1183
1184     case TIR_S_C_STA_UB:
1185       /* stack unsigned byte
1186          arg: by        value
1187
1188          stack byte value.  */
1189       _bfd_vms_push (abfd, (uquad) *ptr++, -1);
1190       break;
1191
1192     case TIR_S_C_STA_UW:
1193       /* stack unsigned short word
1194          arg: sh        value
1195
1196          stack 16 bit value.  */
1197       _bfd_vms_push (abfd, (uquad) bfd_getl16 (ptr), -1);
1198       ptr += 2;
1199       break;
1200
1201     case TIR_S_C_STA_BFI:
1202       /* stack byte from image
1203          arg: none.  */
1204       /* FALLTHRU  */
1205     case TIR_S_C_STA_WFI:
1206       /* stack byte from image
1207          arg: none.  */
1208       /* FALLTHRU */
1209     case TIR_S_C_STA_LFI:
1210       /* stack byte from image
1211          arg: none.  */
1212       (*_bfd_error_handler) (_("stack-from-image not implemented"));
1213       return NULL;
1214
1215     case TIR_S_C_STA_EPM:
1216       /* stack entry point mask
1217          arg: cs        symbol name
1218
1219          stack (unsigned) entry point mask of symbol
1220          err if symbol is no entry point.  */
1221       {
1222         char *name;
1223         vms_symbol_entry *entry;
1224
1225         name = _bfd_vms_save_counted_string (ptr);
1226         entry = _bfd_vms_enter_symbol (abfd, name);
1227         if (entry == NULL)
1228           return NULL;
1229
1230         (*_bfd_error_handler) (_("stack-entry-mask not fully implemented"));
1231         _bfd_vms_push (abfd, (uquad) 0, -1);
1232         ptr += *ptr + 1;
1233       }
1234       break;
1235
1236     case TIR_S_C_STA_CKARG:
1237       /* compare procedure argument
1238          arg: cs        symbol name
1239                 by      argument index
1240                 da      argument descriptor
1241
1242          compare argument descriptor with symbol argument (ARG$V_PASSMECH)
1243          and stack TRUE (args match) or FALSE (args dont match) value.  */
1244       (*_bfd_error_handler) (_("PASSMECH not fully implemented"));
1245       _bfd_vms_push (abfd, (uquad) 1, -1);
1246       break;
1247
1248     case TIR_S_C_STA_LSY:
1249       /* stack local symbol value
1250          arg:   sh      environment index
1251                 cs      symbol name.  */
1252       {
1253         int envidx;
1254         char *name;
1255         vms_symbol_entry *entry;
1256
1257         envidx = bfd_getl16 (ptr);
1258         ptr += 2;
1259         name = _bfd_vms_save_counted_string (ptr);
1260         entry = _bfd_vms_enter_symbol (abfd, name);
1261         if (entry == NULL)
1262           return NULL;
1263         (*_bfd_error_handler) (_("stack-local-symbol not fully implemented"));
1264         _bfd_vms_push (abfd, (uquad) 0, -1);
1265         ptr += *ptr + 1;
1266       }
1267       break;
1268
1269     case TIR_S_C_STA_LIT:
1270       /* stack literal
1271          arg:   by      literal index
1272
1273          stack literal.  */
1274       ptr++;
1275       _bfd_vms_push (abfd, (uquad) 0, -1);
1276       (*_bfd_error_handler) (_("stack-literal not fully implemented"));
1277       break;
1278
1279     case TIR_S_C_STA_LEPM:
1280       /* stack local symbol entry point mask
1281          arg:   sh      environment index
1282                 cs      symbol name
1283
1284          stack (unsigned) entry point mask of symbol
1285          err if symbol is no entry point.  */
1286       {
1287         int envidx;
1288         char *name;
1289         vms_symbol_entry *entry;
1290
1291         envidx = bfd_getl16 (ptr);
1292         ptr += 2;
1293         name = _bfd_vms_save_counted_string (ptr);
1294         entry = _bfd_vms_enter_symbol (abfd, name);
1295         if (entry == NULL)
1296           return NULL;
1297         (*_bfd_error_handler) (_("stack-local-symbol-entry-point-mask not fully implemented"));
1298         _bfd_vms_push (abfd, (uquad) 0, -1);
1299         ptr += *ptr + 1;
1300       }
1301       break;
1302
1303     default:
1304       (*_bfd_error_handler) (_("reserved STA cmd %d"), ptr[-1]);
1305       return NULL;
1306       break;
1307     }
1308
1309   return ptr;
1310 }
1311
1312 static const char *
1313 tir_cmd_name (int cmd)
1314 {
1315   switch (cmd)
1316     {
1317     case TIR_S_C_STO_RSB: return "TIR_S_C_STO_RSB";
1318     case TIR_S_C_STO_RSW: return "TIR_S_C_STO_RSW";
1319     case TIR_S_C_STO_RL: return "TIR_S_C_STO_RL";
1320     case TIR_S_C_STO_VPS: return "TIR_S_C_STO_VPS";
1321     case TIR_S_C_STO_USB: return "TIR_S_C_STO_USB";
1322     case TIR_S_C_STO_USW: return "TIR_S_C_STO_USW";
1323     case TIR_S_C_STO_RUB: return "TIR_S_C_STO_RUB";
1324     case TIR_S_C_STO_RUW: return "TIR_S_C_STO_RUW";
1325     case TIR_S_C_STO_PIRR: return "TIR_S_C_STO_PIRR";
1326     case TIR_S_C_OPR_INSV: return "TIR_S_C_OPR_INSV";
1327     case TIR_S_C_OPR_DFLIT: return "TIR_S_C_OPR_DFLIT";
1328     case TIR_S_C_OPR_REDEF: return "TIR_S_C_OPR_REDEF";
1329     case TIR_S_C_OPR_ROT: return "TIR_S_C_OPR_ROT";
1330     case TIR_S_C_OPR_USH: return "TIR_S_C_OPR_USH";
1331     case TIR_S_C_OPR_ASH: return "TIR_S_C_OPR_ASH";
1332     case TIR_S_C_CTL_DFLOC: return "TIR_S_C_CTL_DFLOC";
1333     case TIR_S_C_CTL_STLOC: return "TIR_S_C_CTL_STLOC";
1334     case TIR_S_C_CTL_STKDL: return "TIR_S_C_CTL_STKDL";
1335
1336     default:
1337       /* These strings have not been added yet.  */
1338       abort ();
1339     }
1340 }
1341
1342 /* tir_sto
1343
1344    vax store commands
1345
1346    handle sto_xxx commands in tir section
1347    ptr points to data area in record
1348
1349    See table 7-4 of the VAX/VMS linker manual.  */
1350
1351 static unsigned char *
1352 tir_sto (bfd * abfd, unsigned char *ptr)
1353 {
1354   unsigned long dummy;
1355   int size;
1356   int psect;
1357
1358 #if VMS_DEBUG
1359   _bfd_vms_debug (5, "tir_sto %d\n", *ptr);
1360 #endif
1361
1362   switch (*ptr++)
1363     {
1364     case TIR_S_C_STO_SB:
1365       /* Store signed byte: pop stack, write byte
1366          arg: none.  */
1367       dummy = _bfd_vms_pop (abfd, &psect);
1368       image_write_b (abfd, dummy & 0xff);       /* FIXME: check top bits */
1369       break;
1370
1371     case TIR_S_C_STO_SW:
1372       /* Store signed word: pop stack, write word
1373          arg: none.  */
1374       dummy = _bfd_vms_pop (abfd, &psect);
1375       image_write_w (abfd, dummy & 0xffff);     /* FIXME: check top bits */
1376       break;
1377
1378     case TIR_S_C_STO_LW:
1379       /* Store longword: pop stack, write longword
1380          arg: none.  */
1381       dummy = _bfd_vms_pop (abfd, &psect);
1382       image_write_l (abfd, dummy & 0xffffffff); /* FIXME: check top bits */
1383       break;
1384
1385     case TIR_S_C_STO_BD:
1386       /* Store byte displaced: pop stack, sub lc+1, write byte
1387          arg: none.  */
1388       dummy = _bfd_vms_pop (abfd, &psect);
1389       dummy -= ((PRIV (sections)[psect])->vma + 1);
1390       image_write_b (abfd, dummy & 0xff);/* FIXME: check top bits */
1391       break;
1392
1393     case TIR_S_C_STO_WD:
1394       /* Store word displaced: pop stack, sub lc+2, write word
1395          arg: none.  */
1396       dummy = _bfd_vms_pop (abfd, &psect);
1397       dummy -= ((PRIV (sections)[psect])->vma + 2);
1398       image_write_w (abfd, dummy & 0xffff);/* FIXME: check top bits */
1399       break;
1400
1401     case TIR_S_C_STO_LD:
1402       /* Store long displaced: pop stack, sub lc+4, write long
1403          arg: none.  */
1404       dummy = _bfd_vms_pop (abfd, &psect);
1405       dummy -= ((PRIV (sections)[psect])->vma + 4);
1406       image_write_l (abfd, dummy & 0xffffffff);/* FIXME: check top bits */
1407       break;
1408
1409     case TIR_S_C_STO_LI:
1410       /* Store short literal: pop stack, write byte
1411          arg: none.  */
1412       dummy = _bfd_vms_pop (abfd, &psect);
1413       image_write_b (abfd, dummy & 0xff);/* FIXME: check top bits */
1414       break;
1415
1416     case TIR_S_C_STO_PIDR:
1417       /* Store position independent data reference: pop stack, write longword
1418          arg: none.
1419          FIXME: incomplete !  */
1420       dummy = _bfd_vms_pop (abfd, &psect);
1421       image_write_l (abfd, dummy & 0xffffffff);
1422       break;
1423
1424     case TIR_S_C_STO_PICR:
1425       /* Store position independent code reference: pop stack, write longword
1426          arg: none.
1427          FIXME: incomplete !  */
1428       dummy = _bfd_vms_pop (abfd, &psect);
1429       image_write_b (abfd, 0x9f);
1430       image_write_l (abfd, dummy & 0xffffffff);
1431       break;
1432
1433     case TIR_S_C_STO_RIVB:
1434       /* Store repeated immediate variable bytes
1435          1-byte count n field followed by n bytes of data
1436          pop stack, write n bytes <stack> times.  */
1437       size = *ptr++;
1438       dummy = (unsigned long) _bfd_vms_pop (abfd, NULL);
1439       while (dummy-- > 0L)
1440         image_dump (abfd, ptr, size, 0);
1441       ptr += size;
1442       break;
1443
1444     case TIR_S_C_STO_B:
1445       /* Store byte from top longword.  */
1446       dummy = (unsigned long) _bfd_vms_pop (abfd, NULL);
1447       image_write_b (abfd, dummy & 0xff);
1448       break;
1449
1450     case TIR_S_C_STO_W:
1451       /* Store word from top longword.  */
1452       dummy = (unsigned long) _bfd_vms_pop (abfd, NULL);
1453       image_write_w (abfd, dummy & 0xffff);
1454       break;
1455
1456     case TIR_S_C_STO_RB:
1457       /* Store repeated byte from top longword.  */
1458       size = (unsigned long) _bfd_vms_pop (abfd, NULL);
1459       dummy = (unsigned long) _bfd_vms_pop (abfd, NULL);
1460       while (size-- > 0)
1461         image_write_b (abfd, dummy & 0xff);
1462       break;
1463
1464     case TIR_S_C_STO_RW:
1465       /* Store repeated word from top longword.  */
1466       size = (unsigned long) _bfd_vms_pop (abfd, NULL);
1467       dummy = (unsigned long) _bfd_vms_pop (abfd, NULL);
1468       while (size-- > 0)
1469         image_write_w (abfd, dummy & 0xffff);
1470       break;
1471
1472     case TIR_S_C_STO_RSB:
1473     case TIR_S_C_STO_RSW:
1474     case TIR_S_C_STO_RL:
1475     case TIR_S_C_STO_VPS:
1476     case TIR_S_C_STO_USB:
1477     case TIR_S_C_STO_USW:
1478     case TIR_S_C_STO_RUB:
1479     case TIR_S_C_STO_RUW:
1480     case TIR_S_C_STO_PIRR:
1481       (*_bfd_error_handler) (_("%s: not implemented"), tir_cmd_name (ptr[-1]));
1482       break;
1483
1484     default:
1485       (*_bfd_error_handler) (_("reserved STO cmd %d"), ptr[-1]);
1486       break;
1487     }
1488
1489   return ptr;
1490 }
1491
1492 /* Stack operator commands
1493    All 32 bit signed arithmetic
1494    All word just like a stack calculator
1495    Arguments are popped from stack, results are pushed on stack
1496
1497    See table 7-5 of the VAX/VMS linker manual.  */
1498
1499 static unsigned char *
1500 tir_opr (bfd * abfd, unsigned char *ptr)
1501 {
1502   long op1, op2;
1503
1504 #if VMS_DEBUG
1505   _bfd_vms_debug (5, "tir_opr %d\n", *ptr);
1506 #endif
1507
1508   /* Operation.  */
1509   switch (*ptr++)
1510     {
1511     case TIR_S_C_OPR_NOP: /* No-op.  */
1512       break;
1513
1514     case TIR_S_C_OPR_ADD: /* Add.  */
1515       op1 = (long) _bfd_vms_pop (abfd, NULL);
1516       op2 = (long) _bfd_vms_pop (abfd, NULL);
1517       _bfd_vms_push (abfd, (uquad) (op1 + op2), -1);
1518       break;
1519
1520     case TIR_S_C_OPR_SUB: /* Subtract.  */
1521       op1 = (long) _bfd_vms_pop (abfd, NULL);
1522       op2 = (long) _bfd_vms_pop (abfd, NULL);
1523       _bfd_vms_push (abfd, (uquad) (op2 - op1), -1);
1524       break;
1525
1526     case TIR_S_C_OPR_MUL: /* Multiply.  */
1527       op1 = (long) _bfd_vms_pop (abfd, NULL);
1528       op2 = (long) _bfd_vms_pop (abfd, NULL);
1529       _bfd_vms_push (abfd, (uquad) (op1 * op2), -1);
1530       break;
1531
1532     case TIR_S_C_OPR_DIV: /* Divide.  */
1533       op1 = (long) _bfd_vms_pop (abfd, NULL);
1534       op2 = (long) _bfd_vms_pop (abfd, NULL);
1535       if (op2 == 0)
1536         _bfd_vms_push (abfd, (uquad) 0, -1);
1537       else
1538         _bfd_vms_push (abfd, (uquad) (op2 / op1), -1);
1539       break;
1540
1541     case TIR_S_C_OPR_AND: /* Logical AND.  */
1542       op1 = (long) _bfd_vms_pop (abfd, NULL);
1543       op2 = (long) _bfd_vms_pop (abfd, NULL);
1544       _bfd_vms_push (abfd, (uquad) (op1 & op2), -1);
1545       break;
1546
1547     case TIR_S_C_OPR_IOR: /* Logical inclusive OR.  */
1548       op1 = (long) _bfd_vms_pop (abfd, NULL);
1549       op2 = (long) _bfd_vms_pop (abfd, NULL);
1550       _bfd_vms_push (abfd, (uquad) (op1 | op2), -1);
1551       break;
1552
1553     case TIR_S_C_OPR_EOR: /* Logical exclusive OR.  */
1554       op1 = (long) _bfd_vms_pop (abfd, NULL);
1555       op2 = (long) _bfd_vms_pop (abfd, NULL);
1556       _bfd_vms_push (abfd, (uquad) (op1 ^ op2), -1);
1557       break;
1558
1559     case TIR_S_C_OPR_NEG: /* Negate.  */
1560       op1 = (long) _bfd_vms_pop (abfd, NULL);
1561       _bfd_vms_push (abfd, (uquad) (-op1), -1);
1562       break;
1563
1564     case TIR_S_C_OPR_COM: /* Complement.  */
1565       op1 = (long) _bfd_vms_pop (abfd, NULL);
1566       _bfd_vms_push (abfd, (uquad) (op1 ^ -1L), -1);
1567       break;
1568
1569     case TIR_S_C_OPR_INSV: /* Insert field.  */
1570       (void) _bfd_vms_pop (abfd, NULL);
1571       (*_bfd_error_handler)  (_("%s: not fully implemented"),
1572                               tir_cmd_name (ptr[-1]));
1573       break;
1574
1575     case TIR_S_C_OPR_ASH: /* Arithmetic shift.  */
1576       op1 = (long) _bfd_vms_pop (abfd, NULL);
1577       op2 = (long) _bfd_vms_pop (abfd, NULL);
1578       if (HIGHBIT (op1))        /* Shift right.  */
1579         op2 >>= op1;
1580       else                      /* Shift left.  */
1581         op2 <<= op1;
1582       _bfd_vms_push (abfd, (uquad) op2, -1);
1583       (*_bfd_error_handler)  (_("%s: not fully implemented"),
1584                               tir_cmd_name (ptr[-1]));
1585       break;
1586
1587     case TIR_S_C_OPR_USH: /* Unsigned shift.  */
1588       op1 = (long) _bfd_vms_pop (abfd, NULL);
1589       op2 = (long) _bfd_vms_pop (abfd, NULL);
1590       if (HIGHBIT (op1))        /* Shift right.  */
1591         op2 >>= op1;
1592       else                      /* Shift left.  */
1593         op2 <<= op1;
1594       _bfd_vms_push (abfd, (uquad) op2, -1);
1595       (*_bfd_error_handler)  (_("%s: not fully implemented"),
1596                               tir_cmd_name (ptr[-1]));
1597       break;
1598
1599     case TIR_S_C_OPR_ROT: /* Rotate.  */
1600       op1 = (long) _bfd_vms_pop (abfd, NULL);
1601       op2 = (long) _bfd_vms_pop (abfd, NULL);
1602       if (HIGHBIT (0))  /* Shift right.  */
1603         op2 >>= op1;
1604       else              /* Shift left.  */
1605         op2 <<= op1;
1606       _bfd_vms_push (abfd, (uquad) op2, -1);
1607       (*_bfd_error_handler)  (_("%s: not fully implemented"),
1608                               tir_cmd_name (ptr[-1]));
1609       break;
1610
1611     case TIR_S_C_OPR_SEL: /* Select.  */
1612       if ((long) _bfd_vms_pop (abfd, NULL) & 0x01L)
1613         (void) _bfd_vms_pop (abfd, NULL);
1614       else
1615         {
1616           op1 = (long) _bfd_vms_pop (abfd, NULL);
1617           (void) _bfd_vms_pop (abfd, NULL);
1618           _bfd_vms_push (abfd, (uquad) op1, -1);
1619         }
1620       break;
1621
1622     case TIR_S_C_OPR_REDEF: /* Redefine symbol to current location.  */
1623     case TIR_S_C_OPR_DFLIT: /* Define a literal.  */
1624       (*_bfd_error_handler) (_("%s: not supported"),
1625                              tir_cmd_name (ptr[-1]));
1626       break;
1627
1628     default:
1629       (*_bfd_error_handler) (_("reserved OPR cmd %d"), ptr[-1]);
1630       break;
1631     }
1632
1633   return ptr;
1634 }
1635
1636 /* Control commands
1637
1638    See table 7-6 of the VAX/VMS linker manual.  */
1639
1640 static unsigned char *
1641 tir_ctl (bfd * abfd, unsigned char *ptr)
1642 {
1643   unsigned long dummy;
1644   int psect;
1645
1646 #if VMS_DEBUG
1647   _bfd_vms_debug (5, "tir_ctl %d\n", *ptr);
1648 #endif
1649
1650   switch (*ptr++)
1651     {
1652     case TIR_S_C_CTL_SETRB:
1653       /* Set relocation base: pop stack, set image location counter
1654          arg: none.  */
1655       dummy = _bfd_vms_pop (abfd, &psect);
1656       if ((unsigned int) psect >= PRIV (section_count))
1657         alloc_section (abfd, psect);
1658       image_set_ptr (abfd, psect, (uquad) dummy);
1659       break;
1660
1661     case TIR_S_C_CTL_AUGRB:
1662       /* Augment relocation base: increment image location counter by offset
1663          arg: lw        offset value.  */
1664       dummy = bfd_getl32 (ptr);
1665       image_inc_ptr (abfd, (uquad) dummy);
1666       break;
1667
1668     case TIR_S_C_CTL_DFLOC:
1669       /* Define location: pop index, save location counter under index
1670          arg: none.  */
1671       dummy = _bfd_vms_pop (abfd, NULL);
1672       (*_bfd_error_handler) (_("%s: not fully implemented"),
1673                              tir_cmd_name (ptr[-1]));
1674       break;
1675
1676     case TIR_S_C_CTL_STLOC:
1677       /* Set location: pop index, restore location counter from index
1678          arg: none.  */
1679       dummy = _bfd_vms_pop (abfd, &psect);
1680       (*_bfd_error_handler) (_("%s: not fully implemented"),
1681                              tir_cmd_name (ptr[-1]));
1682       break;
1683
1684     case TIR_S_C_CTL_STKDL:
1685       /* Stack defined location: pop index, push location counter from index
1686          arg: none.  */
1687       dummy = _bfd_vms_pop (abfd, &psect);
1688       (*_bfd_error_handler) (_("%s: not fully implemented"),
1689                              tir_cmd_name (ptr[-1]));
1690       break;
1691
1692     default:
1693       (*_bfd_error_handler) (_("reserved CTL cmd %d"), ptr[-1]);
1694       break;
1695     }
1696   return ptr;
1697 }
1698
1699 /* Handle command from TIR section.  */
1700
1701 static unsigned char *
1702 tir_cmd (bfd * abfd, unsigned char *ptr)
1703 {
1704   static const struct
1705   {
1706     int mincod;
1707     int maxcod;
1708     unsigned char * (*explain) (bfd *, unsigned char *);
1709   }
1710   tir_table[] =
1711   {
1712     { 0,                 TIR_S_C_MAXSTACOD, tir_sta },
1713     { TIR_S_C_MINSTOCOD, TIR_S_C_MAXSTOCOD, tir_sto },
1714     { TIR_S_C_MINOPRCOD, TIR_S_C_MAXOPRCOD, tir_opr },
1715     { TIR_S_C_MINCTLCOD, TIR_S_C_MAXCTLCOD, tir_ctl },
1716     { -1, -1, NULL }
1717   };
1718   int i = 0;
1719
1720 #if VMS_DEBUG
1721   _bfd_vms_debug (4, "tir_cmd %d/%x\n", *ptr, *ptr);
1722   _bfd_hexdump (8, ptr, 16, (long) ptr);
1723 #endif
1724
1725   if (*ptr & 0x80)
1726     {
1727       /* Store immediate.  */
1728       i = 128 - (*ptr++ & 0x7f);
1729       image_dump (abfd, ptr, i, 0);
1730       ptr += i;
1731     }
1732   else
1733     {
1734       while (tir_table[i].mincod >= 0)
1735         {
1736           if ( (tir_table[i].mincod <= *ptr)
1737                && (*ptr <= tir_table[i].maxcod))
1738             {
1739               ptr = tir_table[i].explain (abfd, ptr);
1740               break;
1741             }
1742           i++;
1743         }
1744       if (tir_table[i].mincod < 0)
1745         {
1746           (*_bfd_error_handler) (_("obj code %d not found"), *ptr);
1747           ptr = 0;
1748         }
1749     }
1750
1751   return ptr;
1752 }
1753
1754 /* Handle command from ETIR section.  */
1755
1756 static int
1757 etir_cmd (bfd *abfd, int cmd, unsigned char *ptr, int *quarter_relocs)
1758 {
1759   static const struct
1760   {
1761     int mincod;
1762     int maxcod;
1763     bfd_boolean (*explain) (bfd *, int, unsigned char *, int *);
1764   }
1765   etir_table[] =
1766   {
1767     { ETIR_S_C_MINSTACOD, ETIR_S_C_MAXSTACOD, etir_sta },
1768     { ETIR_S_C_MINSTOCOD, ETIR_S_C_MAXSTOCOD, etir_sto },
1769     { ETIR_S_C_MINOPRCOD, ETIR_S_C_MAXOPRCOD, etir_opr },
1770     { ETIR_S_C_MINCTLCOD, ETIR_S_C_MAXCTLCOD, etir_ctl },
1771     { ETIR_S_C_MINSTCCOD, ETIR_S_C_MAXSTCCOD, etir_stc },
1772     { -1, -1, NULL }
1773   };
1774
1775   int i = 0;
1776
1777 #if VMS_DEBUG
1778   _bfd_vms_debug (4, "etir_cmd: %s(%d)\n", cmd_name (cmd), cmd);
1779   _bfd_hexdump (8, ptr, 16, (long) ptr);
1780 #endif
1781
1782   while (etir_table[i].mincod >= 0)
1783     {
1784       if ( (etir_table[i].mincod <= cmd)
1785            && (cmd <= etir_table[i].maxcod))
1786         {
1787           if (!etir_table[i].explain (abfd, cmd, ptr, quarter_relocs))
1788             return -1;
1789           break;
1790         }
1791       i++;
1792     }
1793
1794 #if VMS_DEBUG
1795   _bfd_vms_debug (4, "etir_cmd: result = 0\n");
1796 #endif
1797   return 0;
1798 }
1799
1800 /* Text Information and Relocation Records (OBJ$C_TIR)
1801    handle tir record.  */
1802
1803 static int
1804 analyze_tir (bfd * abfd, unsigned char *ptr, unsigned int length)
1805 {
1806   unsigned char *maxptr;
1807
1808 #if VMS_DEBUG
1809   _bfd_vms_debug (3, "analyze_tir: %d bytes\n", length);
1810 #endif
1811
1812   maxptr = ptr + length;
1813
1814   while (ptr < maxptr)
1815     {
1816       ptr = tir_cmd (abfd, ptr);
1817       if (ptr == 0)
1818         return -1;
1819     }
1820
1821   return 0;
1822 }
1823
1824 /* Text Information and Relocation Records (EOBJ$C_ETIR)
1825    handle etir record.  */
1826
1827 static int
1828 analyze_etir (bfd * abfd, unsigned char *ptr, unsigned int length)
1829 {
1830   unsigned char *maxptr = ptr + length;
1831   /* Relocations are made of 1, 2 or 4 ETIR commands.
1832      We therefore count them using quarters.  */
1833   int quarter_relocs = 0;
1834   int result = 0;
1835
1836 #if VMS_DEBUG
1837   _bfd_vms_debug (3, "analyze_etir: %d bytes\n", length);
1838 #endif
1839
1840   while (ptr < maxptr)
1841     {
1842       int cmd = bfd_getl16 (ptr);
1843       int cmd_length = bfd_getl16 (ptr + 2);
1844       result = etir_cmd (abfd, cmd, ptr + 4, &quarter_relocs);
1845       if (result != 0)
1846         break;
1847
1848       /* If we have a relocation, we record its length to size
1849          future buffers and bump the reloc count of the section.  */
1850       if (quarter_relocs)
1851         {
1852           vms_section_data (PRIV (image_section))->reloc_size += cmd_length;
1853           abfd->flags |= HAS_RELOC;
1854
1855           if (quarter_relocs == 4)
1856             {
1857               PRIV (image_section)->reloc_count++;
1858
1859 #if VMS_DEBUG
1860               _bfd_vms_debug (4, "-> reloc %d at 0x%x\n",
1861                               PRIV (image_section)->reloc_count-1,
1862                               ptr - (maxptr - length));
1863 #endif
1864
1865               quarter_relocs = 0;
1866             }
1867           else if (quarter_relocs > 4)
1868             {
1869
1870 #if VMS_DEBUG
1871               _bfd_vms_debug (4, "Reloc count error (%d) in section %s\n",
1872                               PRIV (image_section)->reloc_count,
1873                               PRIV (image_section)->name);
1874 #endif
1875
1876               quarter_relocs = 0;
1877             }
1878         }
1879
1880       /* If we have a Store Immediate, we reserve space for the
1881          count argument.  */
1882       else if (cmd == ETIR_S_C_STO_IMM)
1883         vms_section_data (PRIV (image_section))->reloc_size
1884           += ETIR_S_C_HEADER_SIZE + 4;
1885
1886       ptr += cmd_length;
1887     }
1888
1889 #if VMS_DEBUG
1890   _bfd_vms_debug (3, "analyze_etir: result = %d\n", result);
1891 #endif
1892
1893   return result;
1894 }
1895
1896 /* Process ETIR record
1897    Return 0 on success, -1 on error.  */
1898
1899 int
1900 _bfd_vms_slurp_tir (bfd * abfd, int objtype)
1901 {
1902   int result;
1903
1904 #if VMS_DEBUG
1905   _bfd_vms_debug (2, "TIR/ETIR\n");
1906 #endif
1907
1908   switch (objtype)
1909     {
1910     case EOBJ_S_C_ETIR:
1911       PRIV (vms_rec) += ETIR_S_C_HEADER_SIZE;
1912       PRIV (rec_size) -= ETIR_S_C_HEADER_SIZE;
1913       result = analyze_etir (abfd, PRIV (vms_rec), (unsigned) PRIV (rec_size));
1914       break;
1915     case OBJ_S_C_TIR:
1916       PRIV (vms_rec) += 1;      /* Skip type.  */
1917       PRIV (rec_size) -= 1;
1918       result = analyze_tir (abfd, PRIV (vms_rec), (unsigned) PRIV (rec_size));
1919       break;
1920     default:
1921       result = -1;
1922       break;
1923     }
1924
1925   return result;
1926 }
1927
1928  /* Slurp relocs from ETIR sections and (temporarily) save them
1929     in the per-section reloc buffer.  */
1930
1931 int
1932 _bfd_vms_slurp_relocs (bfd *abfd)
1933 {
1934   struct vms_section_data_struct *vsd;
1935   unsigned char *begin = PRIV (vms_rec) + 4;
1936   unsigned char *end = PRIV (vms_rec) + PRIV (rec_size);
1937   unsigned char *ptr;
1938   int cmd, length, slurped_length;
1939
1940 #if VMS_DEBUG
1941   _bfd_vms_debug (3, "_bfd_vms_slurp_relocs: %d bytes\n", PRIV (rec_size));
1942 #endif
1943
1944   for (ptr = begin; ptr < end; ptr += length)
1945     {
1946       cmd = bfd_getl16 (ptr);
1947       length = bfd_getl16 (ptr + 2);
1948       slurped_length = length;
1949
1950       switch (cmd)
1951         {
1952         case ETIR_S_C_STA_PQ: /* ALPHA_R_REF{LONG|QUAD}, others part 1 */
1953           /* This one is special as it is both part of the section header
1954              and of the ALPHA_R_REFLONG and ALPHA_R_REFQUAD relocations.  */
1955           if (bfd_getl16 (ptr + length) == ETIR_S_C_CTL_SETRB)
1956             {
1957               int psect = bfd_getl32 (ptr + ETIR_S_C_HEADER_SIZE);
1958               PRIV (image_section) = PRIV (sections)[psect];
1959               continue;
1960             }
1961
1962         case ETIR_S_C_STA_GBL: /* ALPHA_R_REFLONG und_section, step 1 */
1963                                /* ALPHA_R_REFQUAD und_section, step 1 */
1964           break;
1965
1966         case ETIR_S_C_STA_LW: /* ALPHA_R_REFLONG und_section, step 2 */
1967                               /* ALPHA_R_REFLONG abs_section, step 1 */
1968           /* This one is special as it is both part of the section header
1969              and of the ALPHA_R_REFLONG relocation.  */
1970           if (bfd_getl16 (ptr + length) == ETIR_S_C_CTL_DFLOC)
1971             {
1972               PRIV (image_section) = PRIV (dst_section);
1973               continue;
1974             }
1975
1976         case ETIR_S_C_STA_QW: /* ALPHA_R_REFQUAD und_section, step 2 */
1977                               /* ALPHA_R_REFQUAD abs_section, step 1 */
1978
1979         case ETIR_S_C_STO_LW: /* ALPHA_R_REFLONG und_section, step 4 */
1980                               /* ALPHA_R_REFLONG abs_section, step 2 */
1981                               /* ALPHA_R_REFLONG others, step 2 */
1982
1983         case ETIR_S_C_STO_QW: /* ALPHA_R_REFQUAD und_section, step 4 */
1984                               /* ALPHA_R_REFQUAD abs_section, step 2 */
1985
1986         case ETIR_S_C_STO_OFF: /* ALPHA_R_REFQUAD others, step 2 */
1987
1988         case ETIR_S_C_OPR_ADD: /* ALPHA_R_REFLONG und_section, step 3 */
1989                                /* ALPHA_R_REFQUAD und_section, step 3 */
1990
1991         case ETIR_S_C_STO_CA:      /* ALPHA_R_CODEADDR */
1992         case ETIR_S_C_STO_GBL:     /* ALPHA_R_REFQUAD und_section */
1993         case ETIR_S_C_STO_GBL_LW:  /* ALPHA_R_REFLONG und_section */
1994         case ETIR_S_C_STC_LP_PSB:  /* ALPHA_R_LINKAGE */
1995         case ETIR_S_C_STC_NOP_GBL: /* ALPHA_R_NOP */
1996         case ETIR_S_C_STC_BSR_GBL: /* ALPHA_R_BSR */
1997         case ETIR_S_C_STC_LDA_GBL: /* ALPHA_R_LDA */
1998         case ETIR_S_C_STC_BOH_GBL: /* ALPHA_R_BOH */
1999           break;
2000
2001         case ETIR_S_C_STO_IMM:
2002           if (PRIV (image_section)->reloc_count == 0)
2003             continue;
2004           /* This is not a relocation, but we nevertheless slurp the
2005              count argument.  We'll use it to compute the addresses
2006              of the relocations.  */
2007           slurped_length = ETIR_S_C_HEADER_SIZE + 4;
2008           break;
2009
2010         default:
2011           continue;
2012         }
2013
2014       vsd = vms_section_data (PRIV (image_section));
2015       memcpy (vsd->reloc_stream + vsd->reloc_offset, ptr, slurped_length);
2016       vsd->reloc_offset += slurped_length;
2017       if (vsd->reloc_offset > vsd->reloc_size)
2018         {
2019           (*_bfd_error_handler) (_("Reloc size error in section %s"),
2020                                  PRIV (image_section)->name);
2021           return -1;
2022         }
2023     }
2024
2025 #if VMS_DEBUG
2026   _bfd_vms_debug (3, "_bfd_vms_slurp_relocs: result = 0\n");
2027 #endif
2028
2029   return 0;
2030 }
2031
2032 /* Decode relocs from the reloc buffer of the specified section
2033    and internalize them in the specified buffer.  */
2034
2035 int
2036 _bfd_vms_decode_relocs (bfd *abfd, arelent *relocs, asection *section,
2037                         asymbol **symbols ATTRIBUTE_UNUSED)
2038 {
2039   int saved_cmd, saved_sym_offset, saved_sec_offset, saved_addend_offset;
2040   int cmd, sym_offset, sec_offset, address_offset, addend_offset;
2041   struct vms_section_data_struct *vsd = vms_section_data (section);
2042   bfd_reloc_code_real_type reloc_code;
2043   vms_symbol_entry *entry;
2044   bfd_vma vaddr = 0;
2045   unsigned char *begin = vsd->reloc_stream;
2046   unsigned char *end = vsd->reloc_stream + vsd->reloc_size;
2047   unsigned char *ptr, *arg_ptr;
2048   const char *name;
2049   int length;
2050
2051 #if VMS_DEBUG
2052   _bfd_vms_debug (3, "_bfd_vms_decode_relocs: %d bytes\n", vsd->reloc_size);
2053 #endif
2054
2055   #define PUSH_CMD()                                    \
2056     {                                                   \
2057       saved_cmd = cmd;                                  \
2058       saved_sym_offset = sym_offset - length;           \
2059       saved_sec_offset = sec_offset - length;           \
2060       saved_addend_offset = addend_offset - length;     \
2061       continue;                                         \
2062     }
2063
2064   #define POP_CMD()                                     \
2065     {                                                   \
2066       cmd = saved_cmd;                                  \
2067       saved_cmd = ETIR_S_C_MAXSTCCOD + 1;               \
2068       sym_offset = saved_sym_offset;                    \
2069       sec_offset = saved_sec_offset;                    \
2070       addend_offset= saved_addend_offset;               \
2071     }
2072
2073   #define CMD_PUSHED (saved_cmd != ETIR_S_C_MAXSTCCOD + 1)
2074
2075   #define NO_OFFSET -128
2076
2077   saved_cmd = ETIR_S_C_MAXSTCCOD + 1;
2078   saved_sym_offset = NO_OFFSET;
2079   saved_sec_offset = NO_OFFSET;
2080   saved_addend_offset = NO_OFFSET;
2081
2082   for (ptr = begin; ptr < end; ptr += length)
2083     {
2084       cmd = bfd_getl16 (ptr);
2085       length = bfd_getl16 (ptr + 2);
2086
2087       arg_ptr = ptr + ETIR_S_C_HEADER_SIZE;
2088       sym_offset = NO_OFFSET;
2089       sec_offset = NO_OFFSET;
2090       address_offset = NO_OFFSET;
2091       addend_offset = NO_OFFSET;
2092
2093       switch (cmd)
2094         {
2095         case ETIR_S_C_STA_GBL: /* ALPHA_R_REFLONG und_section, step 1 */
2096                                /* ALPHA_R_REFQUAD und_section, step 1 */
2097           sym_offset = 0;
2098           PUSH_CMD ()
2099
2100         case ETIR_S_C_STA_PQ: /* ALPHA_R_REF{LONG|QUAD}, others part 1 */
2101           sec_offset = 0;
2102           addend_offset = 4;
2103           PUSH_CMD ()
2104
2105         case ETIR_S_C_STA_LW: /* ALPHA_R_REFLONG abs_section, step 1 */
2106                               /* ALPHA_R_REFLONG und_section, step 2 */
2107           if (CMD_PUSHED)
2108             {
2109               POP_CMD ()
2110               if (cmd != ETIR_S_C_STA_GBL)
2111                 {
2112                   (*_bfd_error_handler) (_("Unknown reloc %s + %s"),
2113                                          cmd_name (cmd),
2114                                          cmd_name (ETIR_S_C_STA_LW));
2115                   return 0;
2116                 }
2117               cmd = ETIR_S_C_STA_LW;
2118             }
2119           addend_offset = 0;
2120           PUSH_CMD ()
2121
2122         case ETIR_S_C_STA_QW: /* ALPHA_R_REFQUAD abs_section, step 1 */
2123                               /* ALPHA_R_REFQUAD und_section, step 2 */
2124           if (CMD_PUSHED)
2125             {
2126               POP_CMD ()
2127               if (cmd != ETIR_S_C_STA_GBL)
2128                 {
2129                   (*_bfd_error_handler) (_("Unknown reloc %s + %s"),
2130                                          cmd_name (cmd),
2131                                          cmd_name (ETIR_S_C_STA_QW));
2132                   return 0;
2133                 }
2134               cmd = ETIR_S_C_STA_QW;
2135             }
2136           addend_offset = 0;
2137           PUSH_CMD ()
2138
2139         case ETIR_S_C_STO_LW: /* ALPHA_R_REFLONG und_section, step 4 */
2140                               /* ALPHA_R_REFLONG abs_section, step 2 */
2141                               /* ALPHA_R_REFLONG others, step 2 */
2142           POP_CMD ()
2143           if (cmd != ETIR_S_C_OPR_ADD
2144               && cmd != ETIR_S_C_STA_LW
2145               && cmd != ETIR_S_C_STA_PQ)
2146             {
2147               (*_bfd_error_handler) (_("Unknown reloc %s + %s"),
2148                 cmd_name (cmd), cmd_name (ETIR_S_C_STO_LW));
2149               return 0;
2150             }
2151           reloc_code = BFD_RELOC_32;
2152           break;
2153
2154         case ETIR_S_C_STO_QW: /* ALPHA_R_REFQUAD und_section, step 4 */
2155                               /* ALPHA_R_REFQUAD abs_section, step 2 */
2156           POP_CMD ()
2157           if (cmd != ETIR_S_C_OPR_ADD && cmd != ETIR_S_C_STA_QW)
2158             {
2159               (*_bfd_error_handler) (_("Unknown reloc %s + %s"),
2160                 cmd_name (cmd), cmd_name (ETIR_S_C_STO_QW));
2161               return 0;
2162             }
2163           reloc_code = BFD_RELOC_64;
2164           break;
2165
2166         case ETIR_S_C_STO_OFF: /* ALPHA_R_REFQUAD others, step 2 */
2167           POP_CMD ()
2168           if (cmd != ETIR_S_C_STA_PQ)
2169             {
2170               (*_bfd_error_handler) (_("Unknown reloc %s + %s"),
2171                 cmd_name (cmd), cmd_name (ETIR_S_C_STO_OFF));
2172               return 0;
2173             }
2174           reloc_code = BFD_RELOC_64;
2175           break;
2176
2177         case ETIR_S_C_OPR_ADD: /* ALPHA_R_REFLONG und_section, step 3 */
2178                                /* ALPHA_R_REFQUAD und_section, step 3 */
2179           POP_CMD ()
2180           if (cmd != ETIR_S_C_STA_LW && cmd != ETIR_S_C_STA_QW)
2181             {
2182               (*_bfd_error_handler) (_("Unknown reloc %s + %s"),
2183                 cmd_name (cmd), cmd_name (ETIR_S_C_OPR_ADD));
2184               return 0;
2185             }
2186           cmd = ETIR_S_C_OPR_ADD;
2187           PUSH_CMD ()
2188
2189         case ETIR_S_C_STO_CA: /* ALPHA_R_CODEADDR */
2190           reloc_code = BFD_RELOC_ALPHA_CODEADDR;
2191           sym_offset = 0;
2192           break;
2193
2194         case ETIR_S_C_STO_GBL: /* ALPHA_R_REFQUAD und_section */
2195           reloc_code = BFD_RELOC_64;
2196           sym_offset = 0;
2197           break;
2198
2199         case ETIR_S_C_STO_GBL_LW: /* ALPHA_R_REFLONG und_section */
2200           reloc_code = BFD_RELOC_32;
2201           sym_offset = 0;
2202           break;
2203
2204         case ETIR_S_C_STC_LP_PSB: /* ALPHA_R_LINKAGE */
2205           reloc_code = BFD_RELOC_ALPHA_LINKAGE;
2206           sym_offset = 4;
2207           break;
2208
2209         case ETIR_S_C_STC_NOP_GBL: /* ALPHA_R_NOP */
2210           reloc_code = BFD_RELOC_ALPHA_NOP;
2211           goto call_reloc;
2212
2213         case ETIR_S_C_STC_BSR_GBL: /* ALPHA_R_BSR */
2214           reloc_code = BFD_RELOC_ALPHA_BSR;
2215           goto call_reloc;
2216
2217         case ETIR_S_C_STC_LDA_GBL: /* ALPHA_R_LDA */
2218           reloc_code = BFD_RELOC_ALPHA_LDA;
2219           goto call_reloc;
2220
2221         case ETIR_S_C_STC_BOH_GBL: /* ALPHA_R_BOH */
2222           reloc_code = BFD_RELOC_ALPHA_BOH;
2223           goto call_reloc;
2224
2225         call_reloc:
2226           sym_offset = 32;
2227           address_offset = 8;
2228           addend_offset = 24;
2229           break;
2230
2231         case ETIR_S_C_STO_IMM:
2232           vaddr += bfd_getl32 (arg_ptr);
2233           length = ETIR_S_C_HEADER_SIZE + 4;
2234           continue;
2235
2236         default:
2237           continue;
2238         }
2239
2240       relocs->howto = bfd_reloc_type_lookup (abfd, reloc_code);
2241
2242       if (sym_offset > NO_OFFSET)
2243         {
2244           name = _bfd_vms_save_counted_string (arg_ptr + sym_offset);
2245           entry = (vms_symbol_entry *)
2246             bfd_hash_lookup (PRIV (vms_symbol_table), name, FALSE, FALSE);
2247           if (entry == NULL)
2248             {
2249               (*_bfd_error_handler) (_("Unknown symbol %s in command %s"),
2250                                      name, cmd_name (cmd));
2251               relocs->sym_ptr_ptr = NULL;
2252             }
2253           else
2254             /* ??? This is a hack.  We should point in 'symbols'.  */
2255             relocs->sym_ptr_ptr = &entry->symbol;
2256         }
2257       else if (sec_offset > NO_OFFSET)
2258         relocs->sym_ptr_ptr
2259           = PRIV (sections)[bfd_getl32 (arg_ptr + sec_offset)]->symbol_ptr_ptr;
2260       else
2261         relocs->sym_ptr_ptr = NULL;
2262
2263       if (address_offset > NO_OFFSET)
2264         relocs->address = bfd_getl64 (arg_ptr + address_offset);
2265       else
2266         relocs->address = vaddr;
2267
2268       if (addend_offset > NO_OFFSET)
2269         relocs->addend = bfd_getl64 (arg_ptr + addend_offset);
2270       else
2271         relocs->addend = 0;
2272
2273       vaddr += bfd_get_reloc_size (relocs->howto);
2274       relocs++;
2275     }
2276
2277   #undef PUSH_CMD
2278   #undef POP_CMD
2279   #undef NO_OFFSET
2280
2281 #if VMS_DEBUG
2282   _bfd_vms_debug (3, "_bfd_vms_decode_relocs: result = 0\n");
2283 #endif
2284
2285   return 0;
2286 }
2287
2288 /* Process LNK record
2289    Return 0 on success, -1 on error
2290
2291    Not implemented yet.  */
2292
2293 int
2294 _bfd_vms_slurp_lnk (bfd * abfd ATTRIBUTE_UNUSED,
2295                     int objtype ATTRIBUTE_UNUSED)
2296 {
2297 #if VMS_DEBUG
2298   _bfd_vms_debug (2, "LNK\n");
2299 #endif
2300
2301   return 0;
2302 }
2303 \f
2304 /* WRITE ETIR SECTION
2305
2306    This is still under construction and therefore not documented.  */
2307
2308 static void start_etir_record (bfd *abfd, int index, uquad offset,
2309                                bfd_boolean justoffset);
2310 static void start_first_etbt_record (bfd *abfd);
2311 static void start_another_etbt_record (bfd *abfd);
2312 static void sto_imm (bfd *abfd, bfd_size_type, unsigned char *, bfd_vma vaddr,
2313                      int index, const char *name);
2314 static void end_etir_record (bfd *abfd);
2315 static void etir_output_check (bfd *abfd, asection *section, bfd_vma vaddr,
2316                                int checklen);
2317
2318 /* Start ETIR record for section #index at virtual addr offset.  */
2319
2320 static void
2321 start_etir_record (bfd * abfd, int sec_index, uquad offset, bfd_boolean justoffset)
2322 {
2323   if (!justoffset)
2324     {
2325       /* One ETIR per section.  */
2326       _bfd_vms_output_begin (abfd, EOBJ_S_C_ETIR, -1);
2327       _bfd_vms_output_push (abfd);
2328     }
2329
2330   /* Push start offset.  */
2331   _bfd_vms_output_begin (abfd, ETIR_S_C_STA_PQ, -1);
2332   _bfd_vms_output_long (abfd, (unsigned long) sec_index);
2333   _bfd_vms_output_quad (abfd, (uquad) offset);
2334   _bfd_vms_output_flush (abfd);
2335
2336   /* Start = pop ().  */
2337   _bfd_vms_output_begin (abfd, ETIR_S_C_CTL_SETRB, -1);
2338   _bfd_vms_output_flush (abfd);
2339 }
2340
2341 static void
2342 end_etir_record (bfd * abfd)
2343 {
2344   _bfd_vms_output_pop (abfd);
2345   _bfd_vms_output_end (abfd);
2346 }
2347
2348 /* Output a STO_IMM command for SSIZE bytes of data from CPR at virtual
2349    address VADDR in section specified by SEC_INDEX and NAME.  */
2350
2351 static void
2352 sto_imm (bfd *abfd, bfd_size_type ssize, unsigned char *cptr, bfd_vma vaddr,
2353          int sec_index, const char *name)
2354 {
2355   bfd_size_type size;
2356
2357 #if VMS_DEBUG
2358   _bfd_vms_debug (8, "sto_imm %d bytes\n", ssize);
2359   _bfd_hexdump (9, cptr, (int) ssize, (int) vaddr);
2360 #endif
2361
2362   while (ssize > 0)
2363     {
2364       /* Try all the rest.  */
2365       size = ssize;
2366
2367       if (_bfd_vms_output_check (abfd, size) < 0)
2368         {
2369           /* Doesn't fit, split !  */
2370           end_etir_record (abfd);
2371
2372           if (name [0] && name[1] == 'v' && !strcmp (name, ".vmsdebug"))
2373             start_another_etbt_record (abfd);
2374           else
2375             start_etir_record (abfd, sec_index, vaddr, FALSE);
2376
2377           size = _bfd_vms_output_check (abfd, 0);       /* get max size */
2378           if (size > ssize)                     /* more than what's left ? */
2379             size = ssize;
2380         }
2381
2382       _bfd_vms_output_begin (abfd, ETIR_S_C_STO_IMM, -1);
2383       _bfd_vms_output_long (abfd, (unsigned long) (size));
2384       _bfd_vms_output_dump (abfd, cptr, size);
2385       _bfd_vms_output_flush (abfd);
2386
2387 #if VMS_DEBUG
2388       _bfd_vms_debug (10, "dumped %d bytes\n", size);
2389       _bfd_hexdump (10, cptr, (int) size, (int) vaddr);
2390 #endif
2391
2392       vaddr += size;
2393       cptr += size;
2394       ssize -= size;
2395     }
2396 }
2397
2398 /* Start ETBT record for section #index at virtual addr offset.  */
2399
2400 static void
2401 start_first_etbt_record (bfd *abfd)
2402 {
2403   _bfd_vms_output_begin (abfd, EOBJ_S_C_ETBT, -1);
2404   _bfd_vms_output_push (abfd);
2405
2406   _bfd_vms_output_begin (abfd, ETIR_S_C_STA_LW, -1);    /* push start offset */
2407   _bfd_vms_output_long (abfd, (unsigned long) 0);
2408   _bfd_vms_output_flush (abfd);
2409
2410   _bfd_vms_output_begin (abfd, ETIR_S_C_CTL_DFLOC, -1); /* start = pop() */
2411   _bfd_vms_output_flush (abfd);
2412 }
2413
2414 static void
2415 start_another_etbt_record (bfd *abfd)
2416 {
2417   _bfd_vms_output_begin (abfd, EOBJ_S_C_ETBT, -1);
2418   _bfd_vms_output_push (abfd);
2419 }
2420
2421 static void
2422 etir_output_check (bfd *abfd, asection *section, bfd_vma vaddr, int checklen)
2423 {
2424   if (_bfd_vms_output_check (abfd, checklen) < 0)
2425     {
2426       end_etir_record (abfd);
2427       if (section->name[0] && section->name[1] == 'v'
2428           && !strcmp (section->name, ".vmsdebug"))
2429         start_another_etbt_record (abfd);
2430       else
2431         start_etir_record (abfd, section->index, vaddr, FALSE);
2432     }
2433 }
2434
2435 /* Return whether RELOC must be deferred till the end.  */
2436
2437 static int
2438 defer_reloc_p (arelent *reloc)
2439 {
2440   switch (reloc->howto->type)
2441     {
2442     case ALPHA_R_NOP:
2443     case ALPHA_R_LDA:
2444     case ALPHA_R_BSR:
2445     case ALPHA_R_BOH:
2446       return 1;
2447
2448     default:
2449       return 0;
2450     }
2451 }
2452
2453 /* Write section contents for bfd abfd.  */
2454
2455 int
2456 _bfd_vms_write_tir (bfd * abfd, int objtype ATTRIBUTE_UNUSED)
2457 {
2458   asection *section;
2459
2460 #if VMS_DEBUG
2461   _bfd_vms_debug (2, "vms_write_tir (%p, %d)\n", abfd, objtype);
2462 #endif
2463
2464   _bfd_vms_output_alignment (abfd, 4);
2465
2466   PRIV (vms_linkage_index) = 1;
2467
2468   for (section = abfd->sections; section; section = section->next)
2469     {
2470 #if VMS_DEBUG
2471       _bfd_vms_debug (4, "writing %d. section '%s' (%d bytes)\n",
2472                       section->index, section->name,
2473                       (int) (section->size));
2474 #endif
2475
2476       if (!(section->flags & SEC_HAS_CONTENTS)
2477           || bfd_is_com_section (section))
2478         continue;
2479
2480       if (!section->contents)
2481         {
2482           bfd_set_error (bfd_error_no_contents);
2483           return -1;
2484         }
2485
2486       if (section->name[0]
2487           && section->name[1] == 'v'
2488           && !strcmp (section->name, ".vmsdebug"))
2489         start_first_etbt_record (abfd);
2490       else
2491         start_etir_record (abfd, section->index, 0, FALSE);
2492
2493       if (section->flags & SEC_RELOC)
2494         {
2495           bfd_vma curr_addr = 0;
2496           unsigned char *curr_data = section->contents;
2497           bfd_size_type size;
2498           int pass2_needed = 0;
2499           int pass2_in_progress = 0;
2500           unsigned int irel;
2501
2502           if (section->reloc_count <= 0)
2503             (*_bfd_error_handler)
2504               (_("SEC_RELOC with no relocs in section %s"), section->name);
2505
2506 #if VMS_DEBUG
2507           else
2508             {
2509               int i = section->reloc_count;
2510               arelent **rptr = section->orelocation;
2511               _bfd_vms_debug (4, "%d relocations:\n", i);
2512               while (i-- > 0)
2513                 {
2514                   _bfd_vms_debug (4, "sym %s in sec %s, value %08lx, "
2515                                      "addr %08lx, off %08lx, len %d: %s\n",
2516                                   (*(*rptr)->sym_ptr_ptr)->name,
2517                                   (*(*rptr)->sym_ptr_ptr)->section->name,
2518                                   (long) (*(*rptr)->sym_ptr_ptr)->value,
2519                                   (*rptr)->address, (*rptr)->addend,
2520                                   bfd_get_reloc_size ((*rptr)->howto),
2521                                    ( *rptr)->howto->name);
2522                   rptr++;
2523                 }
2524             }
2525 #endif
2526
2527         new_pass:
2528           for (irel = 0; irel < section->reloc_count; irel++)
2529             {
2530               struct evax_private_udata_struct *udata;
2531               arelent *rptr = section->orelocation [irel];
2532               bfd_vma addr = rptr->address;
2533               asymbol *sym = *rptr->sym_ptr_ptr;
2534               asection *sec = sym->section;
2535               int defer = defer_reloc_p (rptr);
2536               unsigned int slen;
2537               char *hash;
2538
2539               if (pass2_in_progress)
2540                 {
2541                   /* Non-deferred relocs have already been output.  */
2542                   if (!defer)
2543                     continue;
2544                 }
2545               else
2546                 {
2547                   /* Deferred relocs must be output at the very end.  */
2548                   if (defer)
2549                     {
2550                       pass2_needed = 1;
2551                       continue;
2552                     }
2553
2554                   /* Regular relocs are intertwined with binary data.  */
2555                   if (curr_addr > addr)
2556                     (*_bfd_error_handler) (_("Size error in section %s"),
2557                                            section->name);
2558                   size = addr - curr_addr;
2559                   sto_imm (abfd, size, curr_data, curr_addr,
2560                           section->index, section->name);
2561                   curr_data += size;
2562                   curr_addr += size;
2563                 }
2564
2565               size = bfd_get_reloc_size (rptr->howto);
2566
2567               switch (rptr->howto->type)
2568                 {
2569                 case ALPHA_R_IGNORE:
2570                   break;
2571
2572                 case ALPHA_R_REFLONG:
2573                   if (bfd_is_und_section (sym->section))
2574                     {
2575                       bfd_vma addend = rptr->addend;
2576                       slen = strlen ((char *) sym->name);
2577                       hash = _bfd_vms_length_hash_symbol
2578                                (abfd, sym->name, EOBJ_S_C_SYMSIZ);
2579                       etir_output_check (abfd, section, curr_addr, slen);
2580                       if (addend)
2581                         {
2582                           _bfd_vms_output_begin (abfd, ETIR_S_C_STA_GBL, -1);
2583                           _bfd_vms_output_counted (abfd, hash);
2584                           _bfd_vms_output_flush (abfd);
2585                           _bfd_vms_output_begin (abfd, ETIR_S_C_STA_LW, -1);
2586                           _bfd_vms_output_long (abfd, (unsigned long) addend);
2587                           _bfd_vms_output_flush (abfd);
2588                           _bfd_vms_output_begin (abfd, ETIR_S_C_OPR_ADD, -1);
2589                           _bfd_vms_output_flush (abfd);
2590                           _bfd_vms_output_begin (abfd, ETIR_S_C_STO_LW, -1);
2591                           _bfd_vms_output_flush (abfd);
2592                         }
2593                       else
2594                         {
2595                           _bfd_vms_output_begin (abfd, ETIR_S_C_STO_GBL_LW, -1);
2596                           _bfd_vms_output_counted (abfd, hash);
2597                           _bfd_vms_output_flush (abfd);
2598                         }
2599                     }
2600                   else if (bfd_is_abs_section (sym->section))
2601                     {
2602                       etir_output_check (abfd, section, curr_addr, 16);
2603                       _bfd_vms_output_begin (abfd, ETIR_S_C_STA_LW, -1);
2604                       _bfd_vms_output_long (abfd, (unsigned long) sym->value);
2605                       _bfd_vms_output_flush (abfd);
2606                       _bfd_vms_output_begin (abfd, ETIR_S_C_STO_LW, -1);
2607                       _bfd_vms_output_flush (abfd);
2608                     }
2609                   else
2610                     {
2611                       etir_output_check (abfd, section, curr_addr, 32);
2612                       _bfd_vms_output_begin (abfd, ETIR_S_C_STA_PQ, -1);
2613                       _bfd_vms_output_long (abfd, (unsigned long) sec->index);
2614                       _bfd_vms_output_quad (abfd, (uquad) rptr->addend
2615                                                     + (uquad) sym->value);
2616                       _bfd_vms_output_flush (abfd);
2617                       /* ??? Table B-8 of the OpenVMS Linker Utilily Manual
2618                          says that we should have a ETIR_S_C_STO_OFF here.
2619                          But the relocation would not be BFD_RELOC_32 then.
2620                          This case is very likely unreachable.  */
2621                       _bfd_vms_output_begin (abfd, ETIR_S_C_STO_LW, -1);
2622                       _bfd_vms_output_flush (abfd);
2623                     }
2624                   break;
2625
2626                 case ALPHA_R_REFQUAD:
2627                   if (bfd_is_und_section (sym->section))
2628                     {
2629                       bfd_vma addend = rptr->addend;
2630                       slen = strlen ((char *) sym->name);
2631                       hash = _bfd_vms_length_hash_symbol
2632                                (abfd, sym->name, EOBJ_S_C_SYMSIZ);
2633                       etir_output_check (abfd, section, curr_addr, slen);
2634                       if (addend)
2635                         {
2636                           _bfd_vms_output_begin (abfd, ETIR_S_C_STA_GBL, -1);
2637                           _bfd_vms_output_counted (abfd, hash);
2638                           _bfd_vms_output_flush (abfd);
2639                           _bfd_vms_output_begin (abfd, ETIR_S_C_STA_QW, -1);
2640                           _bfd_vms_output_quad (abfd, (uquad) addend);
2641                           _bfd_vms_output_flush (abfd);
2642                           _bfd_vms_output_begin (abfd, ETIR_S_C_OPR_ADD, -1);
2643                           _bfd_vms_output_flush (abfd);
2644                           _bfd_vms_output_begin (abfd, ETIR_S_C_STO_QW, -1);
2645                           _bfd_vms_output_flush (abfd);
2646                         }
2647                       else
2648                         {
2649                           _bfd_vms_output_begin (abfd, ETIR_S_C_STO_GBL, -1);
2650                           _bfd_vms_output_counted (abfd, hash);
2651                           _bfd_vms_output_flush (abfd);
2652                         }
2653                     }
2654                   else if (bfd_is_abs_section (sym->section))
2655                     {
2656                       etir_output_check (abfd, section, curr_addr, 16);
2657                       _bfd_vms_output_begin (abfd, ETIR_S_C_STA_QW, -1);
2658                       _bfd_vms_output_quad (abfd, (uquad) sym->value);
2659                       _bfd_vms_output_flush (abfd);
2660                       _bfd_vms_output_begin (abfd, ETIR_S_C_STO_QW, -1);
2661                       _bfd_vms_output_flush (abfd);
2662                     }
2663                   else
2664                     {
2665                       etir_output_check (abfd, section, curr_addr, 32);
2666                       _bfd_vms_output_begin (abfd, ETIR_S_C_STA_PQ, -1);
2667                       _bfd_vms_output_long (abfd, (unsigned long) sec->index);
2668                       _bfd_vms_output_quad (abfd, (uquad) rptr->addend
2669                                                     + (uquad) sym->value);
2670                       _bfd_vms_output_flush (abfd);
2671                       _bfd_vms_output_begin (abfd, ETIR_S_C_STO_OFF, -1);
2672                       _bfd_vms_output_flush (abfd);
2673                     }
2674                   break;
2675
2676                 case ALPHA_R_HINT:
2677                   sto_imm (abfd, size, curr_data, curr_addr,
2678                            section->index, section->name);
2679                   break;
2680
2681                 case ALPHA_R_LINKAGE:
2682                   etir_output_check (abfd, section, curr_addr, 64);
2683                   _bfd_vms_output_begin (abfd, ETIR_S_C_STC_LP_PSB, -1);
2684                   _bfd_vms_output_long
2685                     (abfd, (unsigned long) PRIV (vms_linkage_index));
2686                   PRIV (vms_linkage_index) += 2;
2687                   hash = _bfd_vms_length_hash_symbol
2688                            (abfd, sym->name, EOBJ_S_C_SYMSIZ);
2689                   _bfd_vms_output_counted (abfd, hash);
2690                   _bfd_vms_output_byte (abfd, 0);
2691                   _bfd_vms_output_flush (abfd);
2692                   break;
2693
2694                 case ALPHA_R_CODEADDR:
2695                   slen = strlen ((char *) sym->name);
2696                   hash = _bfd_vms_length_hash_symbol
2697                            (abfd, sym->name, EOBJ_S_C_SYMSIZ);
2698                   etir_output_check (abfd, section, curr_addr, slen);
2699                   _bfd_vms_output_begin (abfd, ETIR_S_C_STO_CA, -1);
2700                   _bfd_vms_output_counted (abfd, hash);
2701                   _bfd_vms_output_flush (abfd);
2702                   break;
2703
2704                 case ALPHA_R_NOP:
2705                   udata
2706                     = (struct evax_private_udata_struct *) rptr->sym_ptr_ptr;
2707                   etir_output_check (abfd, section, curr_addr,
2708                                      32 + 1 + strlen (udata->origname));
2709                   _bfd_vms_output_begin (abfd, ETIR_S_C_STC_NOP_GBL, -1);
2710                   _bfd_vms_output_long (abfd, (unsigned long) udata->lkindex);
2711                   _bfd_vms_output_long
2712                     (abfd, (unsigned long) udata->enbsym->section->index);
2713                   _bfd_vms_output_quad (abfd, (uquad) rptr->address);
2714                   _bfd_vms_output_long (abfd, (unsigned long) 0x47ff041f);
2715                   _bfd_vms_output_long
2716                     (abfd, (unsigned long) udata->enbsym->section->index);
2717                   _bfd_vms_output_quad (abfd, (uquad) rptr->addend);
2718                   _bfd_vms_output_counted
2719                     (abfd, _bfd_vms_length_hash_symbol
2720                              (abfd, udata->origname, EOBJ_S_C_SYMSIZ));
2721                   _bfd_vms_output_flush (abfd);
2722                   break;
2723
2724                 case ALPHA_R_BSR:
2725                   (*_bfd_error_handler) (_("Spurious ALPHA_R_BSR reloc"));
2726                   break;
2727
2728                 case ALPHA_R_LDA:
2729                   udata
2730                     = (struct evax_private_udata_struct *) rptr->sym_ptr_ptr;
2731                   etir_output_check (abfd, section, curr_addr,
2732                                      32 + 1 + strlen (udata->origname));
2733                   _bfd_vms_output_begin (abfd, ETIR_S_C_STC_LDA_GBL, -1);
2734                   _bfd_vms_output_long
2735                     (abfd, (unsigned long) udata->lkindex + 1);
2736                   _bfd_vms_output_long
2737                     (abfd, (unsigned long) udata->enbsym->section->index);
2738                   _bfd_vms_output_quad (abfd, (uquad) rptr->address);
2739                   _bfd_vms_output_long (abfd, (unsigned long) 0x237B0000);
2740                   _bfd_vms_output_long
2741                     (abfd, (unsigned long) udata->bsym->section->index);
2742                   _bfd_vms_output_quad (abfd, (uquad) rptr->addend);
2743                   _bfd_vms_output_counted
2744                     (abfd, _bfd_vms_length_hash_symbol
2745                             (abfd, udata->origname, EOBJ_S_C_SYMSIZ));
2746                   _bfd_vms_output_flush (abfd);
2747                   break;
2748
2749                 case ALPHA_R_BOH:
2750                   udata
2751                     = (struct evax_private_udata_struct *) rptr->sym_ptr_ptr;
2752                   etir_output_check (abfd, section, curr_addr,
2753                                        32 + 1 + strlen (udata->origname));
2754                   _bfd_vms_output_begin (abfd, ETIR_S_C_STC_BOH_GBL, -1);
2755                   _bfd_vms_output_long (abfd, (unsigned long) udata->lkindex);
2756                   _bfd_vms_output_long
2757                     (abfd, (unsigned long) udata->enbsym->section->index);
2758                   _bfd_vms_output_quad (abfd, (uquad) rptr->address);
2759                   _bfd_vms_output_long (abfd, (unsigned long) 0xD3400000);
2760                   _bfd_vms_output_long
2761                     (abfd, (unsigned long) udata->enbsym->section->index);
2762                   _bfd_vms_output_quad (abfd, (uquad) rptr->addend);
2763                   _bfd_vms_output_counted
2764                     (abfd, _bfd_vms_length_hash_symbol
2765                              (abfd, udata->origname, EOBJ_S_C_SYMSIZ));
2766                   _bfd_vms_output_flush (abfd);
2767                   break;
2768
2769                 default:
2770                   (*_bfd_error_handler) (_("Unhandled relocation %s"),
2771                                          rptr->howto->name);
2772                   break;
2773                 }
2774
2775               curr_data += size;
2776               curr_addr += size;
2777             } /* End of relocs loop.  */
2778
2779           if (!pass2_in_progress)
2780             {
2781               /* Output rest of section.  */
2782               if (curr_addr > section->size)
2783                 (*_bfd_error_handler) (_("Size error in section %s"),
2784                                        section->name);
2785               size = section->size - curr_addr;
2786               sto_imm (abfd, size, curr_data, curr_addr,
2787                        section->index, section->name);
2788               curr_data += size;
2789               curr_addr += size;
2790
2791               if (pass2_needed)
2792                 {
2793                   pass2_in_progress = 1;
2794                   goto new_pass;
2795                 }
2796             }
2797         }
2798
2799       else /* (section->flags & SEC_RELOC) */
2800         sto_imm (abfd, section->size, section->contents, 0,
2801                  section->index, section->name);
2802
2803       end_etir_record (abfd);
2804     }
2805
2806   _bfd_vms_output_alignment (abfd, 2);
2807   return 0;
2808 }