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