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
   4    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 2 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, MA 02110-1301, USA.  */
  27
  28 /* The following type abbreviations are used:
  29
  30         cs      counted string (ascii string with length byte)
  31         by      byte (1 byte)
  32         sh      short (2 byte, 16 bit)
  33         lw      longword (4 byte, 32 bit)
  34         qw      quadword (8 byte, 64 bit)
  35         da      data stream  */
  36
  37 #include "bfd.h"
  38 #include "sysdep.h"
  39 #include "bfdlink.h"
  40 #include "libbfd.h"
  41 #include "vms.h"
  42 \f
  43 static int
  44 check_section (bfd * abfd, int size)
  45 {
  46   bfd_size_type offset;
  47
  48   offset = PRIV (image_ptr) - PRIV (image_section)->contents;
  49   if (offset + size > PRIV (image_section)->size)
  50     {
  51       PRIV (image_section)->contents
  52         = bfd_realloc (PRIV (image_section)->contents, offset + size);
  53       if (PRIV (image_section)->contents == 0)
  54         {
  55           (*_bfd_error_handler) (_("No Mem !"));
  56           return -1;
  57         }
  58       PRIV (image_section)->size = offset + size;
  59       PRIV (image_ptr) = PRIV (image_section)->contents + offset;
  60     }
  61
  62   return 0;
  63 }
  64
  65 /* Routines to fill sections contents during tir/etir read.  */
  66
  67 /* Initialize image buffer pointer to be filled.  */
  68
  69 static void
  70 image_set_ptr (bfd * abfd, int psect, uquad offset)
  71 {
  72 #if VMS_DEBUG
  73   _bfd_vms_debug (4, "image_set_ptr (%d=%s, %d)\n",
  74                   psect, PRIV (sections)[psect]->name, offset);
  75 #endif
  76
  77   PRIV (image_ptr) = PRIV (sections)[psect]->contents + offset;
  78   PRIV (image_section) = PRIV (sections)[psect];
  79 }
  80
  81 /* Increment image buffer pointer by offset.  */
  82
  83 static void
  84 image_inc_ptr (bfd * abfd, uquad offset)
  85 {
  86 #if VMS_DEBUG
  87   _bfd_vms_debug (4, "image_inc_ptr (%d)\n", offset);
  88 #endif
  89
  90   PRIV (image_ptr) += offset;
  91 }
  92
  93 /* Dump multiple bytes to section image.  */
  94
  95 static void
  96 image_dump (bfd * abfd,
  97             unsigned char *ptr,
  98             int size,
  99             int offset ATTRIBUTE_UNUSED)
 100 {
 101 #if VMS_DEBUG
 102   _bfd_vms_debug (8, "image_dump from (%p, %d) to (%p)\n", ptr, size,
 103                   PRIV (image_ptr));
 104   _bfd_hexdump (9, ptr, size, offset);
 105 #endif
 106
 107   if (PRIV (is_vax) && check_section (abfd, size))
 108     return;
 109
 110   while (size-- > 0)
 111     *PRIV (image_ptr)++ = *ptr++;
 112 }
 113
 114 /* Write byte to section image.  */
 115
 116 static void
 117 image_write_b (bfd * abfd, unsigned int value)
 118 {
 119 #if VMS_DEBUG
 120   _bfd_vms_debug (6, "image_write_b (%02x)\n", (int) value);
 121 #endif
 122
 123   if (PRIV (is_vax) && check_section (abfd, 1))
 124     return;
 125
 126   *PRIV (image_ptr)++ = (value & 0xff);
 127 }
 128
 129 /* Write 2-byte word to image.  */
 130
 131 static void
 132 image_write_w (bfd * abfd, unsigned int value)
 133 {
 134 #if VMS_DEBUG
 135   _bfd_vms_debug (6, "image_write_w (%04x)\n", (int) value);
 136 #endif
 137
 138   if (PRIV (is_vax) && check_section (abfd, 2))
 139     return;
 140
 141   bfd_putl16 ((bfd_vma) value, PRIV (image_ptr));
 142   PRIV (image_ptr) += 2;
 143 }
 144
 145 /* Write 4-byte long to image.  */
 146
 147 static void
 148 image_write_l (bfd * abfd, unsigned long value)
 149 {
 150 #if VMS_DEBUG
 151   _bfd_vms_debug (6, "image_write_l (%08lx)\n", value);
 152 #endif
 153
 154   if (PRIV (is_vax) && check_section (abfd, 4))
 155     return;
 156
 157   bfd_putl32 ((bfd_vma) value, PRIV (image_ptr));
 158   PRIV (image_ptr) += 4;
 159 }
 160
 161 /* Write 8-byte quad to image.  */
 162
 163 static void
 164 image_write_q (bfd * abfd, uquad value)
 165 {
 166 #if VMS_DEBUG
 167   _bfd_vms_debug (6, "image_write_q (%016lx)\n", value);
 168 #endif
 169
 170   if (PRIV (is_vax) && check_section (abfd, 8))
 171     return;
 172
 173   bfd_putl64 (value, PRIV (image_ptr));
 174   PRIV (image_ptr) += 8;
 175 }
 176 \f
 177 static const char *
 178 cmd_name (int cmd)
 179 {
 180   switch (cmd)
 181     {
 182     case ETIR_S_C_STA_GBL: return "ETIR_S_C_STA_GBL";
 183     case ETIR_S_C_STA_PQ: return "ETIR_S_C_STA_PQ";
 184     case ETIR_S_C_STA_LI: return "ETIR_S_C_STA_LI";
 185     case ETIR_S_C_STA_MOD: return "ETIR_S_C_STA_MOD";
 186     case ETIR_S_C_STA_CKARG: return "ETIR_S_C_STA_CKARG";
 187     case ETIR_S_C_STO_B: return "ETIR_S_C_STO_B";
 188     case ETIR_S_C_STO_W: return "ETIR_S_C_STO_W";
 189     case ETIR_S_C_STO_GBL: return "ETIR_S_C_STO_GBL";
 190     case ETIR_S_C_STO_CA: return "ETIR_S_C_STO_CA";
 191     case ETIR_S_C_STO_RB: return "ETIR_S_C_STO_RB";
 192     case ETIR_S_C_STO_AB: return "ETIR_S_C_STO_AB";
 193     case ETIR_S_C_STO_GBL_LW: return "ETIR_S_C_STO_GBL_LW";
 194     case ETIR_S_C_STO_LP_PSB: return "ETIR_S_C_STO_LP_PSB";
 195     case ETIR_S_C_STO_HINT_GBL: return "ETIR_S_C_STO_HINT_GBL";
 196     case ETIR_S_C_STO_HINT_PS: return "ETIR_S_C_STO_HINT_PS";
 197     case ETIR_S_C_OPR_INSV: return "ETIR_S_C_OPR_INSV";
 198     case ETIR_S_C_OPR_USH: return "ETIR_S_C_OPR_USH";
 199     case ETIR_S_C_OPR_ROT: return "ETIR_S_C_OPR_ROT";
 200     case ETIR_S_C_OPR_REDEF: return "ETIR_S_C_OPR_REDEF";
 201     case ETIR_S_C_OPR_DFLIT: return "ETIR_S_C_OPR_DFLIT";
 202     case ETIR_S_C_STC_LP: return "ETIR_S_C_STC_LP";
 203     case ETIR_S_C_STC_GBL: return "ETIR_S_C_STC_GBL";
 204     case ETIR_S_C_STC_GCA: return "ETIR_S_C_STC_GCA";
 205     case ETIR_S_C_STC_PS: return "ETIR_S_C_STC_PS";
 206     case ETIR_S_C_STC_NBH_PS: return "ETIR_S_C_STC_NBH_PS";
 207     case ETIR_S_C_STC_NOP_GBL: return "ETIR_S_C_STC_NOP_GBL";
 208     case ETIR_S_C_STC_NOP_PS: return "ETIR_S_C_STC_NOP_PS";
 209     case ETIR_S_C_STC_BSR_GBL: return "ETIR_S_C_STC_BSR_GBL";
 210     case ETIR_S_C_STC_BSR_PS: return "ETIR_S_C_STC_BSR_PS";
 211     case ETIR_S_C_STC_LDA_GBL: return "ETIR_S_C_STC_LDA_GBL";
 212     case ETIR_S_C_STC_LDA_PS: return "ETIR_S_C_STC_LDA_PS";
 213     case ETIR_S_C_STC_BOH_GBL: return "ETIR_S_C_STC_BOH_GBL";
 214     case ETIR_S_C_STC_BOH_PS: return "ETIR_S_C_STC_BOH_PS";
 215     case ETIR_S_C_STC_NBH_GBL: return "ETIR_S_C_STC_NBH_GBL";
 216
 217     default:
 218       /* These names have not yet been added to this switch statement.  */
 219       abort ();
 220     }
 221 }
 222 #define HIGHBIT(op) ((op & 0x80000000L) == 0x80000000L)
 223
 224 /* etir_sta
 225
 226    vms stack commands
 227
 228    handle sta_xxx commands in etir section
 229    ptr points to data area in record
 230
 231    see table B-8 of the openVMS linker manual.  */
 232
 233 static bfd_boolean
 234 etir_sta (bfd * abfd, int cmd, unsigned char *ptr)
 235 {
 236 #if VMS_DEBUG
 237   _bfd_vms_debug (5, "etir_sta %d/%x\n", cmd, cmd);
 238   _bfd_hexdump (8, ptr, 16, (int) ptr);
 239 #endif
 240
 241   switch (cmd)
 242     {
 243       /* stack global
 244          arg: cs        symbol name
 245
 246          stack 32 bit value of symbol (high bits set to 0).  */
 247     case ETIR_S_C_STA_GBL:
 248       {
 249         char *name;
 250         vms_symbol_entry *entry;
 251
 252         name = _bfd_vms_save_counted_string (ptr);
 253         entry = (vms_symbol_entry *)
 254           bfd_hash_lookup (PRIV (vms_symbol_table), name, FALSE, FALSE);
 255         if (entry == NULL)
 256           {
 257 #if VMS_DEBUG
 258             _bfd_vms_debug (3, "%s: no symbol \"%s\"\n",
 259                             cmd_name (cmd), name);
 260 #endif
 261             _bfd_vms_push (abfd, (uquad) 0, -1);
 262           }
 263         else
 264           _bfd_vms_push (abfd, (uquad) (entry->symbol->value), -1);
 265       }
 266       break;
 267
 268       /* stack longword
 269          arg: lw        value
 270
 271          stack 32 bit value, sign extend to 64 bit.  */
 272     case ETIR_S_C_STA_LW:
 273       _bfd_vms_push (abfd, (uquad) bfd_getl32 (ptr), -1);
 274       break;
 275
 276       /* stack global
 277          arg: qw        value
 278
 279          stack 64 bit value of symbol.  */
 280     case ETIR_S_C_STA_QW:
 281       _bfd_vms_push (abfd, (uquad) bfd_getl64 (ptr), -1);
 282       break;
 283
 284       /* stack psect base plus quadword offset
 285          arg: lw        section index
 286          qw     signed quadword offset (low 32 bits)
 287
 288          stack qw argument and section index
 289          (see ETIR_S_C_STO_OFF, ETIR_S_C_CTL_SETRB).  */
 290     case ETIR_S_C_STA_PQ:
 291       {
 292         uquad dummy;
 293         unsigned int psect;
 294
 295         psect = bfd_getl32 (ptr);
 296         if (psect >= PRIV (section_count))
 297           {
 298             (*_bfd_error_handler) (_("bad section index in %s"),
 299                                    cmd_name (cmd));
 300             bfd_set_error (bfd_error_bad_value);
 301             return FALSE;
 302           }
 303         dummy = bfd_getl64 (ptr + 4);
 304         _bfd_vms_push (abfd, dummy, (int) psect);
 305       }
 306       break;
 307
 308     case ETIR_S_C_STA_LI:
 309     case ETIR_S_C_STA_MOD:
 310     case ETIR_S_C_STA_CKARG:
 311       (*_bfd_error_handler) (_("unsupported STA cmd %s"), cmd_name (cmd));
 312       return FALSE;
 313       break;
 314
 315     default:
 316       (*_bfd_error_handler) (_("reserved STA cmd %d"), cmd);
 317       return FALSE;
 318       break;
 319     }
 320 #if VMS_DEBUG
 321   _bfd_vms_debug (5, "etir_sta true\n");
 322 #endif
 323   return TRUE;
 324 }
 325
 326 /* etir_sto
 327
 328    vms store commands
 329
 330    handle sto_xxx commands in etir section
 331    ptr points to data area in record
 332
 333    see table B-9 of the openVMS linker manual.  */
 334
 335 static bfd_boolean
 336 etir_sto (bfd * abfd, int cmd, unsigned char *ptr)
 337 {
 338   uquad dummy;
 339   int psect;
 340
 341 #if VMS_DEBUG
 342   _bfd_vms_debug (5, "etir_sto %d/%x\n", cmd, cmd);
 343   _bfd_hexdump (8, ptr, 16, (int) ptr);
 344 #endif
 345
 346   switch (cmd)
 347     {
 348       /* Store byte: pop stack, write byte
 349          arg: -.  */
 350     case ETIR_S_C_STO_B:
 351       dummy = _bfd_vms_pop (abfd, &psect);
 352       /* FIXME: check top bits.  */
 353       image_write_b (abfd, (unsigned int) dummy & 0xff);
 354       break;
 355
 356       /* Store word: pop stack, write word
 357          arg: -.  */
 358     case ETIR_S_C_STO_W:
 359       dummy = _bfd_vms_pop (abfd, &psect);
 360       /* FIXME: check top bits */
 361       image_write_w (abfd, (unsigned int) dummy & 0xffff);
 362       break;
 363
 364       /* Store longword: pop stack, write longword
 365          arg: -.  */
 366     case ETIR_S_C_STO_LW:
 367       dummy = _bfd_vms_pop (abfd, &psect);
 368       dummy += (PRIV (sections)[psect])->vma;
 369       /* FIXME: check top bits.  */
 370       image_write_l (abfd, (unsigned int) dummy & 0xffffffff);
 371       break;
 372
 373       /* Store quadword: pop stack, write quadword
 374          arg: -.  */
 375     case ETIR_S_C_STO_QW:
 376       dummy = _bfd_vms_pop (abfd, &psect);
 377       dummy += (PRIV (sections)[psect])->vma;
 378       /* FIXME: check top bits.  */
 379       image_write_q (abfd, dummy);
 380       break;
 381
 382       /* Store immediate repeated: pop stack for repeat count
 383          arg: lw        byte count
 384          da     data.  */
 385     case ETIR_S_C_STO_IMMR:
 386       {
 387         int size;
 388
 389         size = bfd_getl32 (ptr);
 390         dummy = (unsigned long) _bfd_vms_pop (abfd, NULL);
 391         while (dummy-- > 0)
 392           image_dump (abfd, ptr+4, size, 0);
 393       }
 394       break;
 395
 396       /* Store global: write symbol value
 397          arg: cs        global symbol name.  */
 398     case ETIR_S_C_STO_GBL:
 399       {
 400         vms_symbol_entry *entry;
 401         char *name;
 402
 403         name = _bfd_vms_save_counted_string (ptr);
 404         entry = (vms_symbol_entry *) bfd_hash_lookup (PRIV (vms_symbol_table),
 405                                                       name, FALSE, FALSE);
 406         if (entry == NULL)
 407           {
 408             (*_bfd_error_handler) (_("%s: no symbol \"%s\""),
 409                                    cmd_name (cmd), name);
 410             return FALSE;
 411           }
 412         else
 413           /* FIXME, reloc.  */
 414           image_write_q (abfd, (uquad) (entry->symbol->value));
 415       }
 416       break;
 417
 418       /* Store code address: write address of entry point
 419          arg: cs        global symbol name (procedure).  */
 420     case ETIR_S_C_STO_CA:
 421       {
 422         vms_symbol_entry *entry;
 423         char *name;
 424
 425         name = _bfd_vms_save_counted_string (ptr);
 426         entry = (vms_symbol_entry *) bfd_hash_lookup (PRIV (vms_symbol_table),
 427                                                       name, FALSE, FALSE);
 428         if (entry == NULL)
 429           {
 430             (*_bfd_error_handler) (_("%s: no symbol \"%s\""),
 431                                    cmd_name (cmd), name);
 432             return FALSE;
 433           }
 434         else
 435           /* FIXME, reloc.  */
 436           image_write_q (abfd, (uquad) (entry->symbol->value));
 437       }
 438       break;
 439
 440       /* Store offset to psect: pop stack, add low 32 bits to base of psect
 441          arg: none.  */
 442     case ETIR_S_C_STO_OFF:
 443       {
 444         uquad q;
 445         int psect1;
 446
 447         q = _bfd_vms_pop (abfd, & psect1);
 448         q += (PRIV (sections)[psect1])->vma;
 449         image_write_q (abfd, q);
 450       }
 451       break;
 452
 453       /* Store immediate
 454          arg: lw        count of bytes
 455               da        data.  */
 456     case ETIR_S_C_STO_IMM:
 457       {
 458         int size;
 459
 460         size = bfd_getl32 (ptr);
 461         image_dump (abfd, ptr+4, size, 0);
 462       }
 463       break;
 464
 465       /* This code is 'reserved to digital' according to the openVMS
 466          linker manual, however it is generated by the DEC C compiler
 467          and defined in the include file.
 468          FIXME, since the following is just a guess
 469          store global longword: store 32bit value of symbol
 470          arg: cs        symbol name.  */
 471     case ETIR_S_C_STO_GBL_LW:
 472       {
 473         vms_symbol_entry *entry;
 474         char *name;
 475
 476         name = _bfd_vms_save_counted_string (ptr);
 477         entry = (vms_symbol_entry *) bfd_hash_lookup (PRIV (vms_symbol_table),
 478                                                       name, FALSE, FALSE);
 479         if (entry == NULL)
 480           {
 481 #if VMS_DEBUG
 482             _bfd_vms_debug (3, "%s: no symbol \"%s\"\n", cmd_name (cmd), name);
 483 #endif
 484             image_write_l (abfd, (unsigned long) 0);    /* FIXME, reloc */
 485           }
 486         else
 487           /* FIXME, reloc.  */
 488           image_write_l (abfd, (unsigned long) (entry->symbol->value));
 489       }
 490       break;
 491
 492     case ETIR_S_C_STO_RB:
 493     case ETIR_S_C_STO_AB:
 494     case ETIR_S_C_STO_LP_PSB:
 495       (*_bfd_error_handler) (_("%s: not supported"), cmd_name (cmd));
 496       break;
 497
 498     case ETIR_S_C_STO_HINT_GBL:
 499     case ETIR_S_C_STO_HINT_PS:
 500       (*_bfd_error_handler) (_("%s: not implemented"), cmd_name (cmd));
 501       break;
 502
 503     default:
 504       (*_bfd_error_handler) (_("reserved STO cmd %d"), cmd);
 505       break;
 506     }
 507
 508   return TRUE;
 509 }
 510
 511 /* Stack operator commands
 512    all 32 bit signed arithmetic
 513    all word just like a stack calculator
 514    arguments are popped from stack, results are pushed on stack
 515
 516    see table B-10 of the openVMS linker manual.  */
 517
 518 static bfd_boolean
 519 etir_opr (bfd * abfd, int cmd, unsigned char *ptr ATTRIBUTE_UNUSED)
 520 {
 521   long op1, op2;
 522
 523 #if VMS_DEBUG
 524   _bfd_vms_debug (5, "etir_opr %d/%x\n", cmd, cmd);
 525   _bfd_hexdump (8, ptr, 16, (int) ptr);
 526 #endif
 527
 528   switch (cmd)
 529     {
 530     case ETIR_S_C_OPR_NOP:      /* No-op.  */
 531       break;
 532
 533     case ETIR_S_C_OPR_ADD:      /* Add.  */
 534       op1 = (long) _bfd_vms_pop (abfd, NULL);
 535       op2 = (long) _bfd_vms_pop (abfd, NULL);
 536       _bfd_vms_push (abfd, (uquad) (op1 + op2), -1);
 537       break;
 538
 539     case ETIR_S_C_OPR_SUB:      /* Subtract.  */
 540       op1 = (long) _bfd_vms_pop (abfd, NULL);
 541       op2 = (long) _bfd_vms_pop (abfd, NULL);
 542       _bfd_vms_push (abfd, (uquad) (op2 - op1), -1);
 543       break;
 544
 545     case ETIR_S_C_OPR_MUL:      /* Multiply.  */
 546       op1 = (long) _bfd_vms_pop (abfd, NULL);
 547       op2 = (long) _bfd_vms_pop (abfd, NULL);
 548       _bfd_vms_push (abfd, (uquad) (op1 * op2), -1);
 549       break;
 550
 551     case ETIR_S_C_OPR_DIV:      /* Divide.  */
 552       op1 = (long) _bfd_vms_pop (abfd, NULL);
 553       op2 = (long) _bfd_vms_pop (abfd, NULL);
 554       if (op2 == 0)
 555         _bfd_vms_push (abfd, (uquad) 0, -1);
 556       else
 557         _bfd_vms_push (abfd, (uquad) (op2 / op1), -1);
 558       break;
 559
 560     case ETIR_S_C_OPR_AND:      /* Logical AND.  */
 561       op1 = (long) _bfd_vms_pop (abfd, NULL);
 562       op2 = (long) _bfd_vms_pop (abfd, NULL);
 563       _bfd_vms_push (abfd, (uquad) (op1 & op2), -1);
 564       break;
 565
 566     case ETIR_S_C_OPR_IOR:      /* Logical inclusive OR.  */
 567       op1 = (long) _bfd_vms_pop (abfd, NULL);
 568       op2 = (long) _bfd_vms_pop (abfd, NULL);
 569       _bfd_vms_push (abfd, (uquad) (op1 | op2), -1);
 570       break;
 571
 572     case ETIR_S_C_OPR_EOR:      /* Logical exclusive OR.  */
 573       op1 = (long) _bfd_vms_pop (abfd, NULL);
 574       op2 = (long) _bfd_vms_pop (abfd, NULL);
 575       _bfd_vms_push (abfd, (uquad) (op1 ^ op2), -1);
 576       break;
 577
 578     case ETIR_S_C_OPR_NEG:      /* Negate.  */
 579       op1 = (long) _bfd_vms_pop (abfd, NULL);
 580       _bfd_vms_push (abfd, (uquad) (-op1), -1);
 581       break;
 582
 583     case ETIR_S_C_OPR_COM:      /* Complement.  */
 584       op1 = (long) _bfd_vms_pop (abfd, NULL);
 585       _bfd_vms_push (abfd, (uquad) (op1 ^ -1L), -1);
 586       break;
 587
 588     case ETIR_S_C_OPR_ASH:      /* Arithmetic shift.  */
 589       op1 = (long) _bfd_vms_pop (abfd, NULL);
 590       op2 = (long) _bfd_vms_pop (abfd, NULL);
 591       if (op2 < 0)              /* Shift right.  */
 592         op1 >>= -op2;
 593       else                      /* Shift left.  */
 594         op1 <<= op2;
 595       _bfd_vms_push (abfd, (uquad) op1, -1);
 596       break;
 597
 598     case ETIR_S_C_OPR_INSV:      /* Insert field.   */
 599       (void) _bfd_vms_pop (abfd, NULL);
 600     case ETIR_S_C_OPR_USH:       /* Unsigned shift.   */
 601     case ETIR_S_C_OPR_ROT:       /* Rotate.  */
 602     case ETIR_S_C_OPR_REDEF:     /* Redefine symbol to current location.  */
 603     case ETIR_S_C_OPR_DFLIT:     /* Define a literal.  */
 604       (*_bfd_error_handler) (_("%s: not supported"), cmd_name (cmd));
 605       break;
 606
 607     case ETIR_S_C_OPR_SEL:      /* Select.  */
 608       if ((long) _bfd_vms_pop (abfd, NULL) & 0x01L)
 609         (void) _bfd_vms_pop (abfd, NULL);
 610       else
 611         {
 612           op1 = (long) _bfd_vms_pop (abfd, NULL);
 613           (void) _bfd_vms_pop (abfd, NULL);
 614           _bfd_vms_push (abfd, (uquad) op1, -1);
 615         }
 616       break;
 617
 618     default:
 619       (*_bfd_error_handler) (_("reserved OPR cmd %d"), cmd);
 620       break;
 621     }
 622
 623   return TRUE;
 624 }
 625
 626 /* Control commands.
 627
 628    See table B-11 of the openVMS linker manual.  */
 629
 630 static bfd_boolean
 631 etir_ctl (bfd * abfd, int cmd, unsigned char *ptr)
 632 {
 633   uquad  dummy;
 634   int psect;
 635
 636 #if VMS_DEBUG
 637   _bfd_vms_debug (5, "etir_ctl %d/%x\n", cmd, cmd);
 638   _bfd_hexdump (8, ptr, 16, (int) ptr);
 639 #endif
 640
 641   switch (cmd)
 642     {
 643       /* Det relocation base: pop stack, set image location counter
 644          arg: none.  */
 645     case ETIR_S_C_CTL_SETRB:
 646       dummy = _bfd_vms_pop (abfd, &psect);
 647       image_set_ptr (abfd, psect, dummy);
 648       break;
 649
 650       /* Augment relocation base: increment image location counter by offset
 651          arg: lw        offset value.  */
 652     case ETIR_S_C_CTL_AUGRB:
 653       dummy = bfd_getl32 (ptr);
 654       image_inc_ptr (abfd, dummy);
 655       break;
 656
 657       /* Define location: pop index, save location counter under index
 658          arg: none.  */
 659     case ETIR_S_C_CTL_DFLOC:
 660       dummy = _bfd_vms_pop (abfd, NULL);
 661       /* FIXME */
 662       break;
 663
 664       /* Set location: pop index, restore location counter from index
 665          arg: none.  */
 666     case ETIR_S_C_CTL_STLOC:
 667       dummy = _bfd_vms_pop (abfd, &psect);
 668       /* FIXME */
 669       break;
 670
 671       /* Stack defined location: pop index, push location counter from index
 672          arg: none.  */
 673     case ETIR_S_C_CTL_STKDL:
 674       dummy = _bfd_vms_pop (abfd, &psect);
 675       /* FIXME.  */
 676       break;
 677
 678     default:
 679       (*_bfd_error_handler) (_("reserved CTL cmd %d"), cmd);
 680       break;
 681     }
 682   return TRUE;
 683 }
 684
 685 /* Store conditional commands
 686
 687    See table B-12 and B-13 of the openVMS linker manual.  */
 688
 689 static bfd_boolean
 690 etir_stc (bfd * abfd, int cmd, unsigned char *ptr ATTRIBUTE_UNUSED)
 691 {
 692 #if VMS_DEBUG
 693   _bfd_vms_debug (5, "etir_stc %d/%x\n", cmd, cmd);
 694   _bfd_hexdump (8, ptr, 16, (int) ptr);
 695 #endif
 696
 697   switch (cmd)
 698     {
 699       /* 200 Store-conditional Linkage Pair
 700          arg: none.  */
 701     case ETIR_S_C_STC_LP:
 702       (*_bfd_error_handler) (_("%s: not supported"), cmd_name (cmd));
 703       break;
 704
 705       /* 201 Store-conditional Linkage Pair with Procedure Signature
 706          arg:   lw      linkage index
 707                 cs      procedure name
 708                 by      signature length
 709                 da      signature.  */
 710     case ETIR_S_C_STC_LP_PSB:
 711       image_inc_ptr (abfd, (uquad) 16); /* skip entry,procval */
 712       break;
 713
 714       /* 202 Store-conditional Address at global address
 715          arg:   lw      linkage index
 716                 cs      global name.  */
 717
 718     case ETIR_S_C_STC_GBL:
 719       (*_bfd_error_handler) (_("%s: not supported"), cmd_name (cmd));
 720       break;
 721
 722       /* 203 Store-conditional Code Address at global address
 723          arg:   lw      linkage index
 724                 cs      procedure name.  */
 725     case ETIR_S_C_STC_GCA:
 726       (*_bfd_error_handler) (_("%s: not supported"), cmd_name (cmd));
 727       break;
 728
 729       /* 204 Store-conditional Address at psect + offset
 730          arg:   lw      linkage index
 731                 lw      psect index
 732                 qw      offset.  */
 733     case ETIR_S_C_STC_PS:
 734       (*_bfd_error_handler) (_("%s: not supported"), cmd_name (cmd));
 735       break;
 736
 737       /* 205 Store-conditional NOP at address of global
 738          arg: none.  */
 739     case ETIR_S_C_STC_NOP_GBL:
 740
 741       /* 206 Store-conditional NOP at pect + offset
 742          arg: none.  */
 743     case ETIR_S_C_STC_NOP_PS:
 744
 745       /* 207 Store-conditional BSR at global address
 746          arg: none.  */
 747     case ETIR_S_C_STC_BSR_GBL:
 748
 749       /* 208 Store-conditional BSR at pect + offset
 750          arg: none.  */
 751     case ETIR_S_C_STC_BSR_PS:
 752
 753       /* 209 Store-conditional LDA at global address
 754          arg: none.  */
 755     case ETIR_S_C_STC_LDA_GBL:
 756
 757       /* 210 Store-conditional LDA at psect + offset
 758          arg: none.  */
 759     case ETIR_S_C_STC_LDA_PS:
 760
 761       /* 211 Store-conditional BSR or Hint at global address
 762          arg: none.  */
 763     case ETIR_S_C_STC_BOH_GBL:
 764
 765       /* 212 Store-conditional BSR or Hint at pect + offset
 766          arg: none.  */
 767     case ETIR_S_C_STC_BOH_PS:
 768
 769       /* 213 Store-conditional NOP,BSR or HINT at global address
 770          arg: none.  */
 771     case ETIR_S_C_STC_NBH_GBL:
 772
 773       /* 214 Store-conditional NOP,BSR or HINT at psect + offset
 774          arg: none.  */
 775     case ETIR_S_C_STC_NBH_PS:
 776       /* FIXME */
 777       break;
 778
 779     default:
 780 #if VMS_DEBUG
 781       _bfd_vms_debug (3,  "reserved STC cmd %d", cmd);
 782 #endif
 783       break;
 784     }
 785   return TRUE;
 786 }
 787
 788 static asection *
 789 new_section (bfd * abfd ATTRIBUTE_UNUSED, int idx)
 790 {
 791   asection *section;
 792   char sname[16];
 793   char *name;
 794
 795 #if VMS_DEBUG
 796   _bfd_vms_debug (5, "new_section %d\n", idx);
 797 #endif
 798   sprintf (sname, SECTION_NAME_TEMPLATE, idx);
 799
 800   name = bfd_malloc ((bfd_size_type) strlen (sname) + 1);
 801   if (name == 0)
 802     return NULL;
 803   strcpy (name, sname);
 804
 805   section = bfd_malloc ((bfd_size_type) sizeof (asection));
 806   if (section == 0)
 807     {
 808 #if VMS_DEBUG
 809       _bfd_vms_debug (6,  "bfd_make_section (%s) failed", name);
 810 #endif
 811       return NULL;
 812     }
 813
 814   section->size = 0;
 815   section->vma = 0;
 816   section->contents = 0;
 817   section->name = name;
 818   section->index = idx;
 819
 820   return section;
 821 }
 822
 823 static int
 824 alloc_section (bfd * abfd, unsigned int idx)
 825 {
 826   bfd_size_type amt;
 827
 828 #if VMS_DEBUG
 829   _bfd_vms_debug (4, "alloc_section %d\n", idx);
 830 #endif
 831
 832   amt = idx + 1;
 833   amt *= sizeof (asection *);
 834   PRIV (sections) = bfd_realloc (PRIV (sections), amt);
 835   if (PRIV (sections) == 0)
 836     return -1;
 837
 838   while (PRIV (section_count) <= idx)
 839     {
 840       PRIV (sections)[PRIV (section_count)]
 841         = new_section (abfd, (int) PRIV (section_count));
 842       if (PRIV (sections)[PRIV (section_count)] == 0)
 843         return -1;
 844       PRIV (section_count)++;
 845     }
 846
 847   return 0;
 848 }
 849
 850 /* tir_sta
 851
 852    vax stack commands
 853
 854    Handle sta_xxx commands in tir section
 855    ptr points to data area in record
 856
 857    See table 7-3 of the VAX/VMS linker manual.  */
 858
 859 static unsigned char *
 860 tir_sta (bfd * abfd, unsigned char *ptr)
 861 {
 862   int cmd = *ptr++;
 863
 864 #if VMS_DEBUG
 865   _bfd_vms_debug (5, "tir_sta %d\n", cmd);
 866 #endif
 867
 868   switch (cmd)
 869     {
 870       /* stack */
 871     case TIR_S_C_STA_GBL:
 872       /* stack global
 873          arg: cs        symbol name
 874
 875          stack 32 bit value of symbol (high bits set to 0).  */
 876       {
 877         char *name;
 878         vms_symbol_entry *entry;
 879
 880         name = _bfd_vms_save_counted_string (ptr);
 881
 882         entry = _bfd_vms_enter_symbol (abfd, name);
 883         if (entry == NULL)
 884           return NULL;
 885
 886         _bfd_vms_push (abfd, (uquad) (entry->symbol->value), -1);
 887         ptr += *ptr + 1;
 888       }
 889       break;
 890
 891     case TIR_S_C_STA_SB:
 892       /* stack signed byte
 893          arg: by        value
 894
 895          stack byte value, sign extend to 32 bit.  */
 896       _bfd_vms_push (abfd, (uquad) *ptr++, -1);
 897       break;
 898
 899     case TIR_S_C_STA_SW:
 900       /* stack signed short word
 901          arg: sh        value
 902
 903          stack 16 bit value, sign extend to 32 bit.  */
 904       _bfd_vms_push (abfd, (uquad) bfd_getl16 (ptr), -1);
 905       ptr += 2;
 906       break;
 907
 908     case TIR_S_C_STA_LW:
 909       /* stack signed longword
 910          arg: lw        value
 911
 912          stack 32 bit value.  */
 913       _bfd_vms_push (abfd, (uquad) bfd_getl32 (ptr), -1);
 914       ptr += 4;
 915       break;
 916
 917     case TIR_S_C_STA_PB:
 918     case TIR_S_C_STA_WPB:
 919       /* stack psect base plus byte offset (word index)
 920          arg: by        section index
 921                 (sh     section index)
 922                 by      signed byte offset.  */
 923       {
 924         unsigned long dummy;
 925         unsigned int psect;
 926
 927         if (cmd == TIR_S_C_STA_PB)
 928           psect = *ptr++;
 929         else
 930           {
 931             psect = bfd_getl16 (ptr);
 932             ptr += 2;
 933           }
 934
 935         if (psect >= PRIV (section_count))
 936           alloc_section (abfd, psect);
 937
 938         dummy = (long) *ptr++;
 939         dummy += (PRIV (sections)[psect])->vma;
 940         _bfd_vms_push (abfd, (uquad) dummy, (int) psect);
 941       }
 942       break;
 943
 944     case TIR_S_C_STA_PW:
 945     case TIR_S_C_STA_WPW:
 946       /* stack psect base plus word offset (word index)
 947          arg: by        section index
 948                 (sh     section index)
 949                 sh      signed short offset.  */
 950       {
 951         unsigned long dummy;
 952         unsigned int psect;
 953
 954         if (cmd == TIR_S_C_STA_PW)
 955           psect = *ptr++;
 956         else
 957           {
 958             psect = bfd_getl16 (ptr);
 959             ptr += 2;
 960           }
 961
 962         if (psect >= PRIV (section_count))
 963           alloc_section (abfd, psect);
 964
 965         dummy = bfd_getl16 (ptr); ptr+=2;
 966         dummy += (PRIV (sections)[psect])->vma;
 967         _bfd_vms_push (abfd, (uquad) dummy, (int) psect);
 968       }
 969       break;
 970
 971     case TIR_S_C_STA_PL:
 972     case TIR_S_C_STA_WPL:
 973       /* stack psect base plus long offset (word index)
 974          arg: by        section index
 975                 (sh     section index)
 976                 lw      signed longword offset.  */
 977       {
 978         unsigned long dummy;
 979         unsigned int psect;
 980
 981         if (cmd == TIR_S_C_STA_PL)
 982           psect = *ptr++;
 983         else
 984           {
 985             psect = bfd_getl16 (ptr);
 986             ptr += 2;
 987           }
 988
 989         if (psect >= PRIV (section_count))
 990           alloc_section (abfd, psect);
 991
 992         dummy = bfd_getl32 (ptr); ptr += 4;
 993         dummy += (PRIV (sections)[psect])->vma;
 994         _bfd_vms_push (abfd, (uquad) dummy, (int) psect);
 995       }
 996       break;
 997
 998     case TIR_S_C_STA_UB:
 999       /* stack unsigned byte
1000          arg: by        value
1001
1002          stack byte value.  */
1003       _bfd_vms_push (abfd, (uquad) *ptr++, -1);
1004       break;
1005
1006     case TIR_S_C_STA_UW:
1007       /* stack unsigned short word
1008          arg: sh        value
1009
1010          stack 16 bit value.  */
1011       _bfd_vms_push (abfd, (uquad) bfd_getl16 (ptr), -1);
1012       ptr += 2;
1013       break;
1014
1015     case TIR_S_C_STA_BFI:
1016       /* stack byte from image
1017          arg: none.  */
1018       /* FALLTHRU  */
1019     case TIR_S_C_STA_WFI:
1020       /* stack byte from image
1021          arg: none.  */
1022       /* FALLTHRU */
1023     case TIR_S_C_STA_LFI:
1024       /* stack byte from image
1025          arg: none.  */
1026       (*_bfd_error_handler) (_("stack-from-image not implemented"));
1027       return NULL;
1028
1029     case TIR_S_C_STA_EPM:
1030       /* stack entry point mask
1031          arg: cs        symbol name
1032
1033          stack (unsigned) entry point mask of symbol
1034          err if symbol is no entry point.  */
1035       {
1036         char *name;
1037         vms_symbol_entry *entry;
1038
1039         name = _bfd_vms_save_counted_string (ptr);
1040         entry = _bfd_vms_enter_symbol (abfd, name);
1041         if (entry == NULL)
1042           return NULL;
1043
1044         (*_bfd_error_handler) (_("stack-entry-mask not fully implemented"));
1045         _bfd_vms_push (abfd, (uquad) 0, -1);
1046         ptr += *ptr + 1;
1047       }
1048       break;
1049
1050     case TIR_S_C_STA_CKARG:
1051       /* compare procedure argument
1052          arg: cs        symbol name
1053                 by      argument index
1054                 da      argument descriptor
1055
1056          compare argument descriptor with symbol argument (ARG$V_PASSMECH)
1057          and stack TRUE (args match) or FALSE (args dont match) value.  */
1058       (*_bfd_error_handler) (_("PASSMECH not fully implemented"));
1059       _bfd_vms_push (abfd, (uquad) 1, -1);
1060       break;
1061
1062     case TIR_S_C_STA_LSY:
1063       /* stack local symbol value
1064          arg:   sh      environment index
1065                 cs      symbol name.  */
1066       {
1067         int envidx;
1068         char *name;
1069         vms_symbol_entry *entry;
1070
1071         envidx = bfd_getl16 (ptr);
1072         ptr += 2;
1073         name = _bfd_vms_save_counted_string (ptr);
1074         entry = _bfd_vms_enter_symbol (abfd, name);
1075         if (entry == NULL)
1076           return NULL;
1077         (*_bfd_error_handler) (_("stack-local-symbol not fully implemented"));
1078         _bfd_vms_push (abfd, (uquad) 0, -1);
1079         ptr += *ptr + 1;
1080       }
1081       break;
1082
1083     case TIR_S_C_STA_LIT:
1084       /* stack literal
1085          arg:   by      literal index
1086
1087          stack literal.  */
1088       ptr++;
1089       _bfd_vms_push (abfd, (uquad) 0, -1);
1090       (*_bfd_error_handler) (_("stack-literal not fully implemented"));
1091       break;
1092
1093     case TIR_S_C_STA_LEPM:
1094       /* stack local symbol entry point mask
1095          arg:   sh      environment index
1096                 cs      symbol name
1097
1098          stack (unsigned) entry point mask of symbol
1099          err if symbol is no entry point.  */
1100       {
1101         int envidx;
1102         char *name;
1103         vms_symbol_entry *entry;
1104
1105         envidx = bfd_getl16 (ptr);
1106         ptr += 2;
1107         name = _bfd_vms_save_counted_string (ptr);
1108         entry = _bfd_vms_enter_symbol (abfd, name);
1109         if (entry == NULL)
1110           return NULL;
1111         (*_bfd_error_handler) (_("stack-local-symbol-entry-point-mask not fully implemented"));
1112         _bfd_vms_push (abfd, (uquad) 0, -1);
1113         ptr += *ptr + 1;
1114       }
1115       break;
1116
1117     default:
1118       (*_bfd_error_handler) (_("reserved STA cmd %d"), ptr[-1]);
1119       return NULL;
1120       break;
1121     }
1122
1123   return ptr;
1124 }
1125
1126 static const char *
1127 tir_cmd_name (int cmd)
1128 {
1129   switch (cmd)
1130     {
1131     case TIR_S_C_STO_RSB: return "TIR_S_C_STO_RSB";
1132     case TIR_S_C_STO_RSW: return "TIR_S_C_STO_RSW";
1133     case TIR_S_C_STO_RL: return "TIR_S_C_STO_RL";
1134     case TIR_S_C_STO_VPS: return "TIR_S_C_STO_VPS";
1135     case TIR_S_C_STO_USB: return "TIR_S_C_STO_USB";
1136     case TIR_S_C_STO_USW: return "TIR_S_C_STO_USW";
1137     case TIR_S_C_STO_RUB: return "TIR_S_C_STO_RUB";
1138     case TIR_S_C_STO_RUW: return "TIR_S_C_STO_RUW";
1139     case TIR_S_C_STO_PIRR: return "TIR_S_C_STO_PIRR";
1140     case TIR_S_C_OPR_INSV: return "TIR_S_C_OPR_INSV";
1141     case TIR_S_C_OPR_DFLIT: return "TIR_S_C_OPR_DFLIT";
1142     case TIR_S_C_OPR_REDEF: return "TIR_S_C_OPR_REDEF";
1143     case TIR_S_C_OPR_ROT: return "TIR_S_C_OPR_ROT";
1144     case TIR_S_C_OPR_USH: return "TIR_S_C_OPR_USH";
1145     case TIR_S_C_OPR_ASH: return "TIR_S_C_OPR_ASH";
1146     case TIR_S_C_CTL_DFLOC: return "TIR_S_C_CTL_DFLOC";
1147     case TIR_S_C_CTL_STLOC: return "TIR_S_C_CTL_STLOC";
1148     case TIR_S_C_CTL_STKDL: return "TIR_S_C_CTL_STKDL";
1149
1150     default:
1151       /* These strings have not been added yet.  */
1152       abort ();
1153     }
1154 }
1155
1156 /* tir_sto
1157
1158    vax store commands
1159
1160    handle sto_xxx commands in tir section
1161    ptr points to data area in record
1162
1163    See table 7-4 of the VAX/VMS linker manual.  */
1164
1165 static unsigned char *
1166 tir_sto (bfd * abfd, unsigned char *ptr)
1167 {
1168   unsigned long dummy;
1169   int size;
1170   int psect;
1171
1172 #if VMS_DEBUG
1173   _bfd_vms_debug (5, "tir_sto %d\n", *ptr);
1174 #endif
1175
1176   switch (*ptr++)
1177     {
1178     case TIR_S_C_STO_SB:
1179       /* Store signed byte: pop stack, write byte
1180          arg: none.  */
1181       dummy = _bfd_vms_pop (abfd, &psect);
1182       image_write_b (abfd, dummy & 0xff);       /* FIXME: check top bits */
1183       break;
1184
1185     case TIR_S_C_STO_SW:
1186       /* Store signed word: pop stack, write word
1187          arg: none.  */
1188       dummy = _bfd_vms_pop (abfd, &psect);
1189       image_write_w (abfd, dummy & 0xffff);     /* FIXME: check top bits */
1190       break;
1191
1192     case TIR_S_C_STO_LW:
1193       /* Store longword: pop stack, write longword
1194          arg: none.  */
1195       dummy = _bfd_vms_pop (abfd, &psect);
1196       image_write_l (abfd, dummy & 0xffffffff); /* FIXME: check top bits */
1197       break;
1198
1199     case TIR_S_C_STO_BD:
1200       /* Store byte displaced: pop stack, sub lc+1, write byte
1201          arg: none.  */
1202       dummy = _bfd_vms_pop (abfd, &psect);
1203       dummy -= ((PRIV (sections)[psect])->vma + 1);
1204       image_write_b (abfd, dummy & 0xff);/* FIXME: check top bits */
1205       break;
1206
1207     case TIR_S_C_STO_WD:
1208       /* Store word displaced: pop stack, sub lc+2, write word
1209          arg: none.  */
1210       dummy = _bfd_vms_pop (abfd, &psect);
1211       dummy -= ((PRIV (sections)[psect])->vma + 2);
1212       image_write_w (abfd, dummy & 0xffff);/* FIXME: check top bits */
1213       break;
1214
1215     case TIR_S_C_STO_LD:
1216       /* Store long displaced: pop stack, sub lc+4, write long
1217          arg: none.  */
1218       dummy = _bfd_vms_pop (abfd, &psect);
1219       dummy -= ((PRIV (sections)[psect])->vma + 4);
1220       image_write_l (abfd, dummy & 0xffffffff);/* FIXME: check top bits */
1221       break;
1222
1223     case TIR_S_C_STO_LI:
1224       /* Store short literal: pop stack, write byte
1225          arg: none.  */
1226       dummy = _bfd_vms_pop (abfd, &psect);
1227       image_write_b (abfd, dummy & 0xff);/* FIXME: check top bits */
1228       break;
1229
1230     case TIR_S_C_STO_PIDR:
1231       /* Store position independent data reference: pop stack, write longword
1232          arg: none.
1233          FIXME: incomplete !  */
1234       dummy = _bfd_vms_pop (abfd, &psect);
1235       image_write_l (abfd, dummy & 0xffffffff);
1236       break;
1237
1238     case TIR_S_C_STO_PICR:
1239       /* Store position independent code reference: pop stack, write longword
1240          arg: none.
1241          FIXME: incomplete !  */
1242       dummy = _bfd_vms_pop (abfd, &psect);
1243       image_write_b (abfd, 0x9f);
1244       image_write_l (abfd, dummy & 0xffffffff);
1245       break;
1246
1247     case TIR_S_C_STO_RIVB:
1248       /* Store repeated immediate variable bytes
1249          1-byte count n field followed by n bytes of data
1250          pop stack, write n bytes <stack> times.  */
1251       size = *ptr++;
1252       dummy = (unsigned long) _bfd_vms_pop (abfd, NULL);
1253       while (dummy-- > 0L)
1254         image_dump (abfd, ptr, size, 0);
1255       ptr += size;
1256       break;
1257
1258     case TIR_S_C_STO_B:
1259       /* Store byte from top longword.  */
1260       dummy = (unsigned long) _bfd_vms_pop (abfd, NULL);
1261       image_write_b (abfd, dummy & 0xff);
1262       break;
1263
1264     case TIR_S_C_STO_W:
1265       /* Store word from top longword.  */
1266       dummy = (unsigned long) _bfd_vms_pop (abfd, NULL);
1267       image_write_w (abfd, dummy & 0xffff);
1268       break;
1269
1270     case TIR_S_C_STO_RB:
1271       /* Store repeated byte from top longword.  */
1272       size = (unsigned long) _bfd_vms_pop (abfd, NULL);
1273       dummy = (unsigned long) _bfd_vms_pop (abfd, NULL);
1274       while (size-- > 0)
1275         image_write_b (abfd, dummy & 0xff);
1276       break;
1277
1278     case TIR_S_C_STO_RW:
1279       /* Store repeated word from top longword.  */
1280       size = (unsigned long) _bfd_vms_pop (abfd, NULL);
1281       dummy = (unsigned long) _bfd_vms_pop (abfd, NULL);
1282       while (size-- > 0)
1283         image_write_w (abfd, dummy & 0xffff);
1284       break;
1285
1286     case TIR_S_C_STO_RSB:
1287     case TIR_S_C_STO_RSW:
1288     case TIR_S_C_STO_RL:
1289     case TIR_S_C_STO_VPS:
1290     case TIR_S_C_STO_USB:
1291     case TIR_S_C_STO_USW:
1292     case TIR_S_C_STO_RUB:
1293     case TIR_S_C_STO_RUW:
1294     case TIR_S_C_STO_PIRR:
1295       (*_bfd_error_handler) (_("%s: not implemented"), tir_cmd_name (ptr[-1]));
1296       break;
1297
1298     default:
1299       (*_bfd_error_handler) (_("reserved STO cmd %d"), ptr[-1]);
1300       break;
1301     }
1302
1303   return ptr;
1304 }
1305
1306 /* Stack operator commands
1307    All 32 bit signed arithmetic
1308    All word just like a stack calculator
1309    Arguments are popped from stack, results are pushed on stack
1310
1311    See table 7-5 of the VAX/VMS linker manual.  */
1312
1313 static unsigned char *
1314 tir_opr (bfd * abfd, unsigned char *ptr)
1315 {
1316   long op1, op2;
1317
1318 #if VMS_DEBUG
1319   _bfd_vms_debug (5, "tir_opr %d\n", *ptr);
1320 #endif
1321
1322   /* Operation.  */
1323   switch (*ptr++)
1324     {
1325     case TIR_S_C_OPR_NOP: /* No-op.  */
1326       break;
1327
1328     case TIR_S_C_OPR_ADD: /* Add.  */
1329       op1 = (long) _bfd_vms_pop (abfd, NULL);
1330       op2 = (long) _bfd_vms_pop (abfd, NULL);
1331       _bfd_vms_push (abfd, (uquad) (op1 + op2), -1);
1332       break;
1333
1334     case TIR_S_C_OPR_SUB: /* Subtract.  */
1335       op1 = (long) _bfd_vms_pop (abfd, NULL);
1336       op2 = (long) _bfd_vms_pop (abfd, NULL);
1337       _bfd_vms_push (abfd, (uquad) (op2 - op1), -1);
1338       break;
1339
1340     case TIR_S_C_OPR_MUL: /* Multiply.  */
1341       op1 = (long) _bfd_vms_pop (abfd, NULL);
1342       op2 = (long) _bfd_vms_pop (abfd, NULL);
1343       _bfd_vms_push (abfd, (uquad) (op1 * op2), -1);
1344       break;
1345
1346     case TIR_S_C_OPR_DIV: /* Divide.  */
1347       op1 = (long) _bfd_vms_pop (abfd, NULL);
1348       op2 = (long) _bfd_vms_pop (abfd, NULL);
1349       if (op2 == 0)
1350         _bfd_vms_push (abfd, (uquad) 0, -1);
1351       else
1352         _bfd_vms_push (abfd, (uquad) (op2 / op1), -1);
1353       break;
1354
1355     case TIR_S_C_OPR_AND: /* Logical AND.  */
1356       op1 = (long) _bfd_vms_pop (abfd, NULL);
1357       op2 = (long) _bfd_vms_pop (abfd, NULL);
1358       _bfd_vms_push (abfd, (uquad) (op1 & op2), -1);
1359       break;
1360
1361     case TIR_S_C_OPR_IOR: /* Logical inclusive OR.  */
1362       op1 = (long) _bfd_vms_pop (abfd, NULL);
1363       op2 = (long) _bfd_vms_pop (abfd, NULL);
1364       _bfd_vms_push (abfd, (uquad) (op1 | op2), -1);
1365       break;
1366
1367     case TIR_S_C_OPR_EOR: /* Logical exclusive OR.  */
1368       op1 = (long) _bfd_vms_pop (abfd, NULL);
1369       op2 = (long) _bfd_vms_pop (abfd, NULL);
1370       _bfd_vms_push (abfd, (uquad) (op1 ^ op2), -1);
1371       break;
1372
1373     case TIR_S_C_OPR_NEG: /* Negate.  */
1374       op1 = (long) _bfd_vms_pop (abfd, NULL);
1375       _bfd_vms_push (abfd, (uquad) (-op1), -1);
1376       break;
1377
1378     case TIR_S_C_OPR_COM: /* Complement.  */
1379       op1 = (long) _bfd_vms_pop (abfd, NULL);
1380       _bfd_vms_push (abfd, (uquad) (op1 ^ -1L), -1);
1381       break;
1382
1383     case TIR_S_C_OPR_INSV: /* Insert field.  */
1384       (void) _bfd_vms_pop (abfd, NULL);
1385       (*_bfd_error_handler)  (_("%s: not fully implemented"),
1386                               tir_cmd_name (ptr[-1]));
1387       break;
1388
1389     case TIR_S_C_OPR_ASH: /* Arithmetic shift.  */
1390       op1 = (long) _bfd_vms_pop (abfd, NULL);
1391       op2 = (long) _bfd_vms_pop (abfd, NULL);
1392       if (HIGHBIT (op1))        /* Shift right.  */
1393         op2 >>= op1;
1394       else                      /* Shift left.  */
1395         op2 <<= op1;
1396       _bfd_vms_push (abfd, (uquad) op2, -1);
1397       (*_bfd_error_handler)  (_("%s: not fully implemented"),
1398                               tir_cmd_name (ptr[-1]));
1399       break;
1400
1401     case TIR_S_C_OPR_USH: /* Unsigned shift.  */
1402       op1 = (long) _bfd_vms_pop (abfd, NULL);
1403       op2 = (long) _bfd_vms_pop (abfd, NULL);
1404       if (HIGHBIT (op1))        /* Shift right.  */
1405         op2 >>= op1;
1406       else                      /* Shift left.  */
1407         op2 <<= op1;
1408       _bfd_vms_push (abfd, (uquad) op2, -1);
1409       (*_bfd_error_handler)  (_("%s: not fully implemented"),
1410                               tir_cmd_name (ptr[-1]));
1411       break;
1412
1413     case TIR_S_C_OPR_ROT: /* Rotate.  */
1414       op1 = (long) _bfd_vms_pop (abfd, NULL);
1415       op2 = (long) _bfd_vms_pop (abfd, NULL);
1416       if (HIGHBIT (0))  /* Shift right.  */
1417         op2 >>= op1;
1418       else              /* Shift left.  */
1419         op2 <<= op1;
1420       _bfd_vms_push (abfd, (uquad) op2, -1);
1421       (*_bfd_error_handler)  (_("%s: not fully implemented"),
1422                               tir_cmd_name (ptr[-1]));
1423       break;
1424
1425     case TIR_S_C_OPR_SEL: /* Select.  */
1426       if ((long) _bfd_vms_pop (abfd, NULL) & 0x01L)
1427         (void) _bfd_vms_pop (abfd, NULL);
1428       else
1429         {
1430           op1 = (long) _bfd_vms_pop (abfd, NULL);
1431           (void) _bfd_vms_pop (abfd, NULL);
1432           _bfd_vms_push (abfd, (uquad) op1, -1);
1433         }
1434       break;
1435
1436     case TIR_S_C_OPR_REDEF: /* Redefine symbol to current location.  */
1437     case TIR_S_C_OPR_DFLIT: /* Define a literal.  */
1438       (*_bfd_error_handler) (_("%s: not supported"),
1439                              tir_cmd_name (ptr[-1]));
1440       break;
1441
1442     default:
1443       (*_bfd_error_handler) (_("reserved OPR cmd %d"), ptr[-1]);
1444       break;
1445     }
1446
1447   return ptr;
1448 }
1449
1450 /* Control commands
1451
1452    See table 7-6 of the VAX/VMS linker manual.  */
1453
1454 static unsigned char *
1455 tir_ctl (bfd * abfd, unsigned char *ptr)
1456 {
1457   unsigned long dummy;
1458   unsigned int psect;
1459
1460 #if VMS_DEBUG
1461   _bfd_vms_debug (5, "tir_ctl %d\n", *ptr);
1462 #endif
1463
1464   switch (*ptr++)
1465     {
1466     case TIR_S_C_CTL_SETRB:
1467       /* Set relocation base: pop stack, set image location counter
1468          arg: none.  */
1469       dummy = _bfd_vms_pop (abfd, (int *) &psect);
1470       if (psect >= PRIV (section_count))
1471         alloc_section (abfd, psect);
1472       image_set_ptr (abfd, (int) psect, (uquad) dummy);
1473       break;
1474
1475     case TIR_S_C_CTL_AUGRB:
1476       /* Augment relocation base: increment image location counter by offset
1477          arg: lw        offset value.  */
1478       dummy = bfd_getl32 (ptr);
1479       image_inc_ptr (abfd, (uquad) dummy);
1480       break;
1481
1482     case TIR_S_C_CTL_DFLOC:
1483       /* Define location: pop index, save location counter under index
1484          arg: none.  */
1485       dummy = _bfd_vms_pop (abfd, NULL);
1486       (*_bfd_error_handler) (_("%s: not fully implemented"),
1487                              tir_cmd_name (ptr[-1]));
1488       break;
1489
1490     case TIR_S_C_CTL_STLOC:
1491       /* Set location: pop index, restore location counter from index
1492          arg: none.  */
1493       dummy = _bfd_vms_pop (abfd, (int *) &psect);
1494       (*_bfd_error_handler) (_("%s: not fully implemented"),
1495                              tir_cmd_name (ptr[-1]));
1496       break;
1497
1498     case TIR_S_C_CTL_STKDL:
1499       /* Stack defined location: pop index, push location counter from index
1500          arg: none.  */
1501       dummy = _bfd_vms_pop (abfd, (int *) &psect);
1502       (*_bfd_error_handler) (_("%s: not fully implemented"),
1503                              tir_cmd_name (ptr[-1]));
1504       break;
1505
1506     default:
1507       (*_bfd_error_handler) (_("reserved CTL cmd %d"), ptr[-1]);
1508       break;
1509     }
1510   return ptr;
1511 }
1512
1513 /* Handle command from TIR section.  */
1514
1515 static unsigned char *
1516 tir_cmd (bfd * abfd, unsigned char *ptr)
1517 {
1518   struct
1519   {
1520     int mincod;
1521     int maxcod;
1522     unsigned char * (*explain) (bfd *, unsigned char *);
1523   }
1524   tir_table[] =
1525   {
1526     { 0,                 TIR_S_C_MAXSTACOD, tir_sta },
1527     { TIR_S_C_MINSTOCOD, TIR_S_C_MAXSTOCOD, tir_sto },
1528     { TIR_S_C_MINOPRCOD, TIR_S_C_MAXOPRCOD, tir_opr },
1529     { TIR_S_C_MINCTLCOD, TIR_S_C_MAXCTLCOD, tir_ctl },
1530     { -1, -1, NULL }
1531   };
1532   int i = 0;
1533
1534 #if VMS_DEBUG
1535   _bfd_vms_debug (4, "tir_cmd %d/%x\n", *ptr, *ptr);
1536   _bfd_hexdump (8, ptr, 16, (int) ptr);
1537 #endif
1538
1539   if (*ptr & 0x80)
1540     {
1541       /* Store immediate.  */
1542       i = 128 - (*ptr++ & 0x7f);
1543       image_dump (abfd, ptr, i, 0);
1544       ptr += i;
1545     }
1546   else
1547     {
1548       while (tir_table[i].mincod >= 0)
1549         {
1550           if ( (tir_table[i].mincod <= *ptr)
1551                && (*ptr <= tir_table[i].maxcod))
1552             {
1553               ptr = tir_table[i].explain (abfd, ptr);
1554               break;
1555             }
1556           i++;
1557         }
1558       if (tir_table[i].mincod < 0)
1559         {
1560           (*_bfd_error_handler) (_("obj code %d not found"), *ptr);
1561           ptr = 0;
1562         }
1563     }
1564
1565   return ptr;
1566 }
1567
1568 /* Handle command from ETIR section.  */
1569
1570 static int
1571 etir_cmd (bfd * abfd, int cmd, unsigned char *ptr)
1572 {
1573   static struct
1574   {
1575     int mincod;
1576     int maxcod;
1577     bfd_boolean (*explain) (bfd *, int, unsigned char *);
1578   }
1579   etir_table[] =
1580   {
1581     { ETIR_S_C_MINSTACOD, ETIR_S_C_MAXSTACOD, etir_sta },
1582     { ETIR_S_C_MINSTOCOD, ETIR_S_C_MAXSTOCOD, etir_sto },
1583     { ETIR_S_C_MINOPRCOD, ETIR_S_C_MAXOPRCOD, etir_opr },
1584     { ETIR_S_C_MINCTLCOD, ETIR_S_C_MAXCTLCOD, etir_ctl },
1585     { ETIR_S_C_MINSTCCOD, ETIR_S_C_MAXSTCCOD, etir_stc },
1586     { -1, -1, NULL }
1587   };
1588
1589   int i = 0;
1590
1591 #if VMS_DEBUG
1592   _bfd_vms_debug (4, "etir_cmd %d/%x\n", cmd, cmd);
1593   _bfd_hexdump (8, ptr, 16, (int) ptr);
1594 #endif
1595
1596   while (etir_table[i].mincod >= 0)
1597     {
1598       if ( (etir_table[i].mincod <= cmd)
1599            && (cmd <= etir_table[i].maxcod))
1600         {
1601           if (!etir_table[i].explain (abfd, cmd, ptr))
1602             return -1;
1603           break;
1604         }
1605       i++;
1606     }
1607
1608 #if VMS_DEBUG
1609   _bfd_vms_debug (4, "etir_cmd: = 0\n");
1610 #endif
1611   return 0;
1612 }
1613
1614 /* Text Information and Relocation Records (OBJ$C_TIR)
1615    handle tir record.  */
1616
1617 static int
1618 analyze_tir (bfd * abfd, unsigned char *ptr, unsigned int length)
1619 {
1620   unsigned char *maxptr;
1621
1622 #if VMS_DEBUG
1623   _bfd_vms_debug (3, "analyze_tir: %d bytes\n", length);
1624 #endif
1625
1626   maxptr = ptr + length;
1627
1628   while (ptr < maxptr)
1629     {
1630       ptr = tir_cmd (abfd, ptr);
1631       if (ptr == 0)
1632         return -1;
1633     }
1634
1635   return 0;
1636 }
1637
1638 /* Text Information and Relocation Records (EOBJ$C_ETIR)
1639    handle etir record.  */
1640
1641 static int
1642 analyze_etir (bfd * abfd, unsigned char *ptr, unsigned int length)
1643 {
1644   int cmd;
1645   unsigned char *maxptr;
1646   int result = 0;
1647
1648 #if VMS_DEBUG
1649   _bfd_vms_debug (3, "analyze_etir: %d bytes\n", length);
1650 #endif
1651
1652   maxptr = ptr + length;
1653
1654   while (ptr < maxptr)
1655     {
1656       cmd = bfd_getl16 (ptr);
1657       length = bfd_getl16 (ptr + 2);
1658       result = etir_cmd (abfd, cmd, ptr+4);
1659       if (result != 0)
1660         break;
1661       ptr += length;
1662     }
1663
1664 #if VMS_DEBUG
1665   _bfd_vms_debug (3, "analyze_etir: = %d\n", result);
1666 #endif
1667
1668   return result;
1669 }
1670
1671 /* Process ETIR record
1672    Return 0 on success, -1 on error.  */
1673
1674 int
1675 _bfd_vms_slurp_tir (bfd * abfd, int objtype)
1676 {
1677   int result;
1678
1679 #if VMS_DEBUG
1680   _bfd_vms_debug (2, "TIR/ETIR\n");
1681 #endif
1682
1683   switch (objtype)
1684     {
1685     case EOBJ_S_C_ETIR:
1686       PRIV (vms_rec) += 4;      /* Skip type, size.  */
1687       PRIV (rec_size) -= 4;
1688       result = analyze_etir (abfd, PRIV (vms_rec), (unsigned) PRIV (rec_size));
1689       break;
1690     case OBJ_S_C_TIR:
1691       PRIV (vms_rec) += 1;      /* Skip type.  */
1692       PRIV (rec_size) -= 1;
1693       result = analyze_tir (abfd, PRIV (vms_rec), (unsigned) PRIV (rec_size));
1694       break;
1695     default:
1696       result = -1;
1697       break;
1698     }
1699
1700   return result;
1701 }
1702
1703 /* Process EDBG record
1704    Return 0 on success, -1 on error
1705
1706    Not implemented yet.  */
1707
1708 int
1709 _bfd_vms_slurp_dbg (bfd * abfd, int objtype ATTRIBUTE_UNUSED)
1710 {
1711 #if VMS_DEBUG
1712   _bfd_vms_debug (2, "DBG/EDBG\n");
1713 #endif
1714
1715   abfd->flags |= (HAS_DEBUG | HAS_LINENO);
1716   return 0;
1717 }
1718
1719 /* Process ETBT record
1720    Return 0 on success, -1 on error
1721
1722    Not implemented yet.  */
1723
1724 int
1725 _bfd_vms_slurp_tbt (bfd * abfd ATTRIBUTE_UNUSED,
1726                     int objtype ATTRIBUTE_UNUSED)
1727 {
1728 #if VMS_DEBUG
1729   _bfd_vms_debug (2, "TBT/ETBT\n");
1730 #endif
1731
1732   return 0;
1733 }
1734
1735 /* Process LNK record
1736    Return 0 on success, -1 on error
1737
1738    Not implemented yet.  */
1739
1740 int
1741 _bfd_vms_slurp_lnk (bfd * abfd ATTRIBUTE_UNUSED,
1742                     int objtype ATTRIBUTE_UNUSED)
1743 {
1744 #if VMS_DEBUG
1745   _bfd_vms_debug (2, "LNK\n");
1746 #endif
1747
1748   return 0;
1749 }
1750 \f
1751 /* Start ETIR record for section #index at virtual addr offset.  */
1752
1753 static void
1754 start_etir_record (bfd * abfd, int index, uquad offset, bfd_boolean justoffset)
1755 {
1756   if (!justoffset)
1757     {
1758       /* One ETIR per section.  */
1759       _bfd_vms_output_begin (abfd, EOBJ_S_C_ETIR, -1);
1760       _bfd_vms_output_push (abfd);
1761     }
1762
1763   /* Push start offset.  */
1764   _bfd_vms_output_begin (abfd, ETIR_S_C_STA_PQ, -1);
1765   _bfd_vms_output_long (abfd, (unsigned long) index);
1766   _bfd_vms_output_quad (abfd, (uquad) offset);
1767   _bfd_vms_output_flush (abfd);
1768
1769   /* Start = pop ().  */
1770   _bfd_vms_output_begin (abfd, ETIR_S_C_CTL_SETRB, -1);
1771   _bfd_vms_output_flush (abfd);
1772 }
1773
1774 static void
1775 end_etir_record (bfd * abfd)
1776 {
1777   _bfd_vms_output_pop (abfd);
1778   _bfd_vms_output_end (abfd);
1779 }
1780
1781 /* WRITE ETIR SECTION
1782
1783    This is still under construction and therefore not documented.  */
1784
1785 static void
1786 sto_imm (bfd * abfd, vms_section *sptr, bfd_vma vaddr, int index)
1787 {
1788   int size;
1789   int ssize;
1790   unsigned char *cptr;
1791
1792 #if VMS_DEBUG
1793   _bfd_vms_debug (8, "sto_imm %d bytes\n", sptr->size);
1794   _bfd_hexdump (9, sptr->contents, (int) sptr->size, (int) vaddr);
1795 #endif
1796
1797   ssize = sptr->size;
1798   cptr = sptr->contents;
1799
1800   while (ssize > 0)
1801     {
1802       /* Try all the rest.  */
1803       size = ssize;
1804
1805       if (_bfd_vms_output_check (abfd, size) < 0)
1806         {
1807           /* Doesn't fit, split !  */
1808           end_etir_record (abfd);
1809           start_etir_record (abfd, index, vaddr, FALSE);
1810           /* Get max size.  */
1811           size = _bfd_vms_output_check (abfd, 0);
1812           /* More than what's left ?  */
1813           if (size > ssize)
1814             size = ssize;
1815         }
1816
1817       _bfd_vms_output_begin (abfd, ETIR_S_C_STO_IMM, -1);
1818       _bfd_vms_output_long (abfd, (unsigned long) (size));
1819       _bfd_vms_output_dump (abfd, cptr, size);
1820       _bfd_vms_output_flush (abfd);
1821
1822 #if VMS_DEBUG
1823       _bfd_vms_debug (10, "dumped %d bytes\n", size);
1824       _bfd_hexdump (10, cptr, (int) size, (int) vaddr);
1825 #endif
1826
1827       vaddr += size;
1828       ssize -= size;
1829       cptr += size;
1830     }
1831 }
1832
1833 /* Write section contents for bfd abfd.  */
1834
1835 int
1836 _bfd_vms_write_tir (bfd * abfd, int objtype ATTRIBUTE_UNUSED)
1837 {
1838   asection *section;
1839   vms_section *sptr;
1840   int nextoffset;
1841
1842 #if VMS_DEBUG
1843   _bfd_vms_debug (2, "vms_write_tir (%p, %d)\n", abfd, objtype);
1844 #endif
1845
1846   _bfd_vms_output_alignment (abfd, 4);
1847
1848   nextoffset = 0;
1849   PRIV (vms_linkage_index) = 1;
1850
1851   /* Dump all other sections.  */
1852   section = abfd->sections;
1853
1854   while (section != NULL)
1855     {
1856
1857 #if VMS_DEBUG
1858       _bfd_vms_debug (4, "writing %d. section '%s' (%d bytes)\n",
1859                       section->index, section->name,
1860                       (int) (section->size));
1861 #endif
1862
1863       if (section->flags & SEC_RELOC)
1864         {
1865           int i;
1866
1867           if ((i = section->reloc_count) <= 0)
1868             (*_bfd_error_handler) (_("SEC_RELOC with no relocs in section %s"),
1869                                    section->name);
1870 #if VMS_DEBUG
1871           else
1872             {
1873               arelent **rptr;
1874               _bfd_vms_debug (4, "%d relocations:\n", i);
1875               rptr = section->orelocation;
1876               while (i-- > 0)
1877                 {
1878                   _bfd_vms_debug (4, "sym %s in sec %s, value %08lx, addr %08lx, off %08lx, len %d: %s\n",
1879                                   (*(*rptr)->sym_ptr_ptr)->name,
1880                                   (*(*rptr)->sym_ptr_ptr)->section->name,
1881                                   (long) (*(*rptr)->sym_ptr_ptr)->value,
1882                                   (*rptr)->address, (*rptr)->addend,
1883                                   bfd_get_reloc_size ((*rptr)->howto),
1884                                   (*rptr)->howto->name);
1885                   rptr++;
1886                 }
1887             }
1888 #endif
1889         }
1890
1891       if ((section->flags & SEC_HAS_CONTENTS)
1892           && (! bfd_is_com_section (section)))
1893         {
1894           /* Virtual addr in section.  */
1895           bfd_vma vaddr;
1896
1897           sptr = _bfd_get_vms_section (abfd, section->index);
1898           if (sptr == NULL)
1899             {
1900               bfd_set_error (bfd_error_no_contents);
1901               return -1;
1902             }
1903
1904           vaddr = (bfd_vma) (sptr->offset);
1905
1906           start_etir_record (abfd, section->index, (uquad) sptr->offset,
1907                              FALSE);
1908
1909           while (sptr != NULL)
1910             {
1911               /* One STA_PQ, CTL_SETRB per vms_section.  */
1912               if (section->flags & SEC_RELOC)
1913                 {
1914                   /* Check for relocs.  */
1915                   arelent **rptr = section->orelocation;
1916                   int i = section->reloc_count;
1917
1918                   for (;;)
1919                     {
1920                       bfd_size_type addr = (*rptr)->address;
1921                       bfd_size_type len = bfd_get_reloc_size ((*rptr)->howto);
1922                       if (sptr->offset < addr)
1923                         {
1924                           /* Sptr starts before reloc.  */
1925                           bfd_size_type before = addr - sptr->offset;
1926                           if (sptr->size <= before)
1927                             {
1928                               /* Complete before.  */
1929                               sto_imm (abfd, sptr, vaddr, section->index);
1930                               vaddr += sptr->size;
1931                               break;
1932                             }
1933                           else
1934                             {
1935                               /* Partly before.  */
1936                               int after = sptr->size - before;
1937
1938                               sptr->size = before;
1939                               sto_imm (abfd, sptr, vaddr, section->index);
1940                               vaddr += sptr->size;
1941                               sptr->contents += before;
1942                               sptr->offset += before;
1943                               sptr->size = after;
1944                             }
1945                         }
1946                       else if (sptr->offset == addr)
1947                         {
1948                           /* Sptr starts at reloc.  */
1949                           asymbol *sym = *(*rptr)->sym_ptr_ptr;
1950                           asection *sec = sym->section;
1951
1952                           switch ((*rptr)->howto->type)
1953                             {
1954                             case ALPHA_R_IGNORE:
1955                               break;
1956
1957                             case ALPHA_R_REFLONG:
1958                               {
1959                                 if (bfd_is_und_section (sym->section))
1960                                   {
1961                                     int slen = strlen ((char *) sym->name);
1962                                     char *hash;
1963
1964                                     if (_bfd_vms_output_check (abfd, slen) < 0)
1965                                       {
1966                                         end_etir_record (abfd);
1967                                         start_etir_record (abfd,
1968                                                            section->index,
1969                                                            vaddr, FALSE);
1970                                       }
1971                                     _bfd_vms_output_begin (abfd,
1972                                                            ETIR_S_C_STO_GBL_LW,
1973                                                            -1);
1974                                     hash = (_bfd_vms_length_hash_symbol
1975                                             (abfd, sym->name, EOBJ_S_C_SYMSIZ));
1976                                     _bfd_vms_output_counted (abfd, hash);
1977                                     _bfd_vms_output_flush (abfd);
1978                                   }
1979                                 else if (bfd_is_abs_section (sym->section))
1980                                   {
1981                                     if (_bfd_vms_output_check (abfd, 16) < 0)
1982                                       {
1983                                         end_etir_record (abfd);
1984                                         start_etir_record (abfd,
1985                                                            section->index,
1986                                                            vaddr, FALSE);
1987                                       }
1988                                     _bfd_vms_output_begin (abfd,
1989                                                            ETIR_S_C_STA_LW,
1990                                                            -1);
1991                                     _bfd_vms_output_quad (abfd,
1992                                                           (uquad) sym->value);
1993                                     _bfd_vms_output_flush (abfd);
1994                                     _bfd_vms_output_begin (abfd,
1995                                                            ETIR_S_C_STO_LW,
1996                                                            -1);
1997                                     _bfd_vms_output_flush (abfd);
1998                                   }
1999                                 else
2000                                   {
2001                                     if (_bfd_vms_output_check (abfd, 32) < 0)
2002                                       {
2003                                         end_etir_record (abfd);
2004                                         start_etir_record (abfd,
2005                                                            section->index,
2006                                                            vaddr, FALSE);
2007                                       }
2008                                     _bfd_vms_output_begin (abfd,
2009                                                            ETIR_S_C_STA_PQ,
2010                                                            -1);
2011                                     _bfd_vms_output_long (abfd,
2012                                                           (unsigned long) (sec->index));
2013                                     _bfd_vms_output_quad (abfd,
2014                                                           ((uquad) (*rptr)->addend
2015                                                            + (uquad) sym->value));
2016                                     _bfd_vms_output_flush (abfd);
2017                                     _bfd_vms_output_begin (abfd,
2018                                                            ETIR_S_C_STO_LW,
2019                                                            -1);
2020                                     _bfd_vms_output_flush (abfd);
2021                                   }
2022                               }
2023                               break;
2024
2025                             case ALPHA_R_REFQUAD:
2026                               {
2027                                 if (bfd_is_und_section (sym->section))
2028                                   {
2029                                     int slen = strlen ((char *) sym->name);
2030                                     char *hash;
2031
2032                                     if (_bfd_vms_output_check (abfd, slen) < 0)
2033                                       {
2034                                         end_etir_record (abfd);
2035                                         start_etir_record (abfd,
2036                                                            section->index,
2037                                                            vaddr, FALSE);
2038                                       }
2039                                     _bfd_vms_output_begin (abfd,
2040                                                            ETIR_S_C_STO_GBL,
2041                                                            -1);
2042                                     hash = (_bfd_vms_length_hash_symbol
2043                                             (abfd, sym->name, EOBJ_S_C_SYMSIZ));
2044                                     _bfd_vms_output_counted (abfd, hash);
2045                                     _bfd_vms_output_flush (abfd);
2046                                   }
2047                                 else if (bfd_is_abs_section (sym->section))
2048                                   {
2049                                     if (_bfd_vms_output_check (abfd, 16) < 0)
2050                                       {
2051                                         end_etir_record (abfd);
2052                                         start_etir_record (abfd,
2053                                                            section->index,
2054                                                            vaddr, FALSE);
2055                                       }
2056                                     _bfd_vms_output_begin (abfd,
2057                                                            ETIR_S_C_STA_QW,
2058                                                            -1);
2059                                     _bfd_vms_output_quad (abfd,
2060                                                           (uquad) sym->value);
2061                                     _bfd_vms_output_flush (abfd);
2062                                     _bfd_vms_output_begin (abfd,
2063                                                            ETIR_S_C_STO_QW,
2064                                                            -1);
2065                                     _bfd_vms_output_flush (abfd);
2066                                   }
2067                                 else
2068                                   {
2069                                     if (_bfd_vms_output_check (abfd, 32) < 0)
2070                                       {
2071                                         end_etir_record (abfd);
2072                                         start_etir_record (abfd,
2073                                                            section->index,
2074                                                            vaddr, FALSE);
2075                                       }
2076                                     _bfd_vms_output_begin (abfd,
2077                                                            ETIR_S_C_STA_PQ,
2078                                                            -1);
2079                                     _bfd_vms_output_long (abfd,
2080                                                           (unsigned long) (sec->index));
2081                                     _bfd_vms_output_quad (abfd,
2082                                                           ((uquad) (*rptr)->addend
2083                                                            + (uquad) sym->value));
2084                                     _bfd_vms_output_flush (abfd);
2085                                     _bfd_vms_output_begin (abfd,
2086                                                            ETIR_S_C_STO_OFF,
2087                                                            -1);
2088                                     _bfd_vms_output_flush (abfd);
2089                                   }
2090                               }
2091                               break;
2092
2093                             case ALPHA_R_HINT:
2094                               {
2095                                 int hint_size;
2096                                 char *hash ATTRIBUTE_UNUSED;
2097
2098                                 hint_size = sptr->size;
2099                                 sptr->size = len;
2100                                 sto_imm (abfd, sptr, vaddr, section->index);
2101                                 sptr->size = hint_size;
2102                               }
2103                               break;
2104                             case ALPHA_R_LINKAGE:
2105                               {
2106                                 char *hash;
2107
2108                                 if (_bfd_vms_output_check (abfd, 64) < 0)
2109                                   {
2110                                     end_etir_record (abfd);
2111                                     start_etir_record (abfd, section->index,
2112                                                        vaddr, FALSE);
2113                                   }
2114                                 _bfd_vms_output_begin (abfd,
2115                                                        ETIR_S_C_STC_LP_PSB,
2116                                                        -1);
2117                                 _bfd_vms_output_long (abfd,
2118                                                       (unsigned long) PRIV (vms_linkage_index));
2119                                 PRIV (vms_linkage_index) += 2;
2120                                 hash = (_bfd_vms_length_hash_symbol
2121                                         (abfd, sym->name, EOBJ_S_C_SYMSIZ));
2122                                 _bfd_vms_output_counted (abfd, hash);
2123                                 _bfd_vms_output_byte (abfd, 0);
2124                                 _bfd_vms_output_flush (abfd);
2125                               }
2126                               break;
2127
2128                             case ALPHA_R_CODEADDR:
2129                               {
2130                                 int slen = strlen ((char *) sym->name);
2131                                 char *hash;
2132                                 if (_bfd_vms_output_check (abfd, slen) < 0)
2133                                   {
2134                                     end_etir_record (abfd);
2135                                     start_etir_record (abfd,
2136                                                        section->index,
2137                                                        vaddr, FALSE);
2138                                   }
2139                                 _bfd_vms_output_begin (abfd,
2140                                                        ETIR_S_C_STO_CA,
2141                                                        -1);
2142                                 hash = (_bfd_vms_length_hash_symbol
2143                                         (abfd, sym->name, EOBJ_S_C_SYMSIZ));
2144                                 _bfd_vms_output_counted (abfd, hash);
2145                                 _bfd_vms_output_flush (abfd);
2146                               }
2147                               break;
2148
2149                             default:
2150                               (*_bfd_error_handler) (_("Unhandled relocation %s"),
2151                                                      (*rptr)->howto->name);
2152                               break;
2153                             }
2154
2155                           vaddr += len;
2156
2157                           if (len == sptr->size)
2158                             {
2159                               break;
2160                             }
2161                           else
2162                             {
2163                               sptr->contents += len;
2164                               sptr->offset += len;
2165                               sptr->size -= len;
2166                               i--;
2167                               rptr++;
2168                             }
2169                         }
2170                       else
2171                         {
2172                           /* Sptr starts after reloc.  */
2173                           i--;
2174                           /* Check next reloc.  */
2175                           rptr++;
2176                         }
2177
2178                       if (i == 0)
2179                         {
2180                           /* All reloc checked.  */
2181                           if (sptr->size > 0)
2182                             {
2183                               /* Dump rest.  */
2184                               sto_imm (abfd, sptr, vaddr, section->index);
2185                               vaddr += sptr->size;
2186                             }
2187                           break;
2188                         }
2189                     }
2190                 }
2191               else
2192                 {
2193                   /* No relocs, just dump.  */
2194                   sto_imm (abfd, sptr, vaddr, section->index);
2195                   vaddr += sptr->size;
2196                 }
2197
2198               sptr = sptr->next;
2199             }
2200
2201           end_etir_record (abfd);
2202         }
2203
2204       section = section->next;
2205     }
2206
2207   _bfd_vms_output_alignment (abfd, 2);
2208   return 0;
2209 }
2210
2211 /* Write traceback data for bfd abfd.  */
2212
2213 int
2214 _bfd_vms_write_tbt (bfd * abfd ATTRIBUTE_UNUSED,
2215                     int objtype ATTRIBUTE_UNUSED)
2216 {
2217 #if VMS_DEBUG
2218   _bfd_vms_debug (2, "vms_write_tbt (%p, %d)\n", abfd, objtype);
2219 #endif
2220
2221   return 0;
2222 }
2223
2224 /* Write debug info for bfd abfd.  */
2225
2226 int
2227 _bfd_vms_write_dbg (bfd * abfd ATTRIBUTE_UNUSED,
2228                     int objtype ATTRIBUTE_UNUSED)
2229 {
2230 #if VMS_DEBUG
2231   _bfd_vms_debug (2, "vms_write_dbg (%p, objtype)\n", abfd, objtype);
2232 #endif
2233
2234   return 0;
2235 }