bfd/vms-tir.c

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