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