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