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 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 ((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;
 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           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;
 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;
 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;
 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      int idx;
 951 {
 952   asection *section;
 953
 954 #if VMS_DEBUG
 955   _bfd_vms_debug (4,  "alloc_section %d\n", idx);
 956 #endif
 957
 958   PRIV(sections) = ((asection **)
 959                     bfd_realloc (PRIV(sections), (idx+1) * sizeof (asection *)));
 960   if (PRIV(sections) == 0)
 961     return -1;
 962
 963   while (PRIV(section_count) <= idx)
 964     {
 965       PRIV(sections)[PRIV(section_count)] = new_section (abfd, PRIV(section_count));
 966       if (PRIV(sections)[PRIV(section_count)] == 0)
 967         return -1;
 968       PRIV(section_count)++;
 969     }
 970
 971   return 0;
 972 }
 973
 974
 975 /*
 976  * tir_sta
 977  *
 978  * vax stack commands
 979  *
 980  * handle sta_xxx commands in tir section
 981  * ptr points to data area in record
 982  *
 983  * see table 7-3 of the VAX/VMS linker manual
 984  */
 985
 986 static unsigned char *
 987 tir_sta (bfd *abfd, unsigned char *ptr)
 988 {
 989   int cmd = *ptr++;
 990
 991 #if VMS_DEBUG
 992   _bfd_vms_debug (5, "tir_sta %d\n", cmd);
 993 #endif
 994
 995   switch (cmd)
 996     {
 997   /* stack */
 998       case TIR_S_C_STA_GBL:
 999         /*
1000          * stack global
1001          * arg: cs      symbol name
1002          *
1003          * stack 32 bit value of symbol (high bits set to 0)
1004          */
1005         {
1006           char *name;
1007           vms_symbol_entry *entry;
1008
1009           name = _bfd_vms_save_counted_string (ptr);
1010
1011           entry = _bfd_vms_enter_symbol (abfd, name);
1012           if (entry == (vms_symbol_entry *)NULL)
1013             return 0;
1014
1015           _bfd_vms_push (abfd, (unsigned long)(entry->symbol->value), -1);
1016           ptr += *ptr + 1;
1017         }
1018       break;
1019
1020       case TIR_S_C_STA_SB:
1021         /*
1022          * stack signed byte
1023          * arg: by      value
1024          *
1025          * stack byte value, sign extend to 32 bit
1026          */
1027         _bfd_vms_push (abfd, (long)*ptr++, -1);
1028       break;
1029
1030       case TIR_S_C_STA_SW:
1031         /*
1032          * stack signed short word
1033          * arg: sh      value
1034          *
1035          * stack 16 bit value, sign extend to 32 bit
1036          */
1037         _bfd_vms_push (abfd, (long)bfd_getl16(ptr), -1);
1038         ptr += 2;
1039       break;
1040
1041       case TIR_S_C_STA_LW:
1042         /*
1043          * stack signed longword
1044          * arg: lw      value
1045          *
1046          * stack 32 bit value
1047          */
1048         _bfd_vms_push (abfd, (long)bfd_getl32 (ptr), -1);
1049         ptr += 4;
1050       break;
1051
1052       case TIR_S_C_STA_PB:
1053       case TIR_S_C_STA_WPB:
1054         /*
1055          * stack psect base plus byte offset (word index)
1056          * arg: by      section index
1057          *      (sh     section index)
1058          *      by      signed byte offset
1059          *
1060          */
1061         {
1062           unsigned long dummy;
1063           int psect;
1064
1065           if (cmd == TIR_S_C_STA_PB)
1066             psect = *ptr++;
1067           else
1068             {
1069               psect = bfd_getl16(ptr);
1070               ptr += 2;
1071             }
1072
1073           if (psect >= PRIV(section_count))
1074             {
1075               alloc_section (abfd, psect);
1076             }
1077
1078           dummy = (long)*ptr++;
1079           dummy += (PRIV(sections)[psect])->vma;
1080           _bfd_vms_push (abfd, dummy, psect);
1081         }
1082       break;
1083
1084       case TIR_S_C_STA_PW:
1085       case TIR_S_C_STA_WPW:
1086         /*
1087          * stack psect base plus word offset (word index)
1088          * arg: by      section index
1089          *      (sh     section index)
1090          *      sh      signed short offset
1091          *
1092          */
1093         {
1094           unsigned long dummy;
1095           int psect;
1096
1097           if (cmd == TIR_S_C_STA_PW)
1098             psect = *ptr++;
1099           else
1100             {
1101               psect = bfd_getl16(ptr);
1102               ptr += 2;
1103             }
1104
1105           if (psect >= PRIV(section_count))
1106             {
1107               alloc_section (abfd, psect);
1108             }
1109
1110           dummy = bfd_getl16(ptr); ptr+=2;
1111           dummy += (PRIV(sections)[psect])->vma;
1112           _bfd_vms_push (abfd, dummy, psect);
1113         }
1114       break;
1115
1116       case TIR_S_C_STA_PL:
1117       case TIR_S_C_STA_WPL:
1118         /*
1119          * stack psect base plus long offset (word index)
1120          * arg: by      section index
1121          *      (sh     section index)
1122          *      lw      signed longword offset
1123          *
1124          */
1125         {
1126           unsigned long dummy;
1127           int psect;
1128
1129           if (cmd == TIR_S_C_STA_PL)
1130             psect = *ptr++;
1131           else
1132             {
1133               psect = bfd_getl16(ptr);
1134               ptr += 2;
1135             }
1136
1137           if (psect >= PRIV(section_count))
1138             {
1139               alloc_section (abfd, psect);
1140             }
1141
1142           dummy = bfd_getl32 (ptr); ptr += 4;
1143           dummy += (PRIV(sections)[psect])->vma;
1144           _bfd_vms_push (abfd, dummy, psect);
1145         }
1146       break;
1147
1148       case TIR_S_C_STA_UB:
1149         /*
1150          * stack unsigned byte
1151          * arg: by      value
1152          *
1153          * stack byte value
1154          */
1155         _bfd_vms_push (abfd, (unsigned long)*ptr++, -1);
1156       break;
1157
1158       case TIR_S_C_STA_UW:
1159         /*
1160          * stack unsigned short word
1161          * arg: sh      value
1162          *
1163          * stack 16 bit value
1164          */
1165         _bfd_vms_push (abfd, (unsigned long)bfd_getl16(ptr), -1);
1166         ptr += 2;
1167       break;
1168
1169       case TIR_S_C_STA_BFI:
1170         /*
1171          * stack byte from image
1172          * arg: -
1173          *
1174          */
1175         /*FALLTHRU*/
1176       case TIR_S_C_STA_WFI:
1177         /*
1178          * stack byte from image
1179          * arg: -
1180          *
1181          */
1182         /*FALLTHRU*/
1183       case TIR_S_C_STA_LFI:
1184         /*
1185          * stack byte from image
1186          * arg: -
1187          *
1188          */
1189         (*_bfd_error_handler) (_("Stack-from-image not implemented"));
1190         return NULL;
1191
1192       case TIR_S_C_STA_EPM:
1193         /*
1194          * stack entry point mask
1195          * arg: cs      symbol name
1196          *
1197          * stack (unsigned) entry point mask of symbol
1198          * err if symbol is no entry point
1199          */
1200         {
1201           char *name;
1202           vms_symbol_entry *entry;
1203
1204           name = _bfd_vms_save_counted_string (ptr);
1205           entry = _bfd_vms_enter_symbol (abfd, name);
1206           if (entry == (vms_symbol_entry *)NULL)
1207             return 0;
1208
1209           (*_bfd_error_handler) (_("Stack-entry-mask not fully implemented"));
1210           _bfd_vms_push (abfd, 0L, -1);
1211           ptr += *ptr + 1;
1212         }
1213       break;
1214
1215       case TIR_S_C_STA_CKARG:
1216         /*
1217          * compare procedure argument
1218          * arg: cs      symbol name
1219          *      by      argument index
1220          *      da      argument descriptor
1221          *
1222          * compare argument descriptor with symbol argument (ARG$V_PASSMECH)
1223          * and stack TRUE (args match) or FALSE (args dont match) value
1224          */
1225         (*_bfd_error_handler) (_("PASSMECH not fully implemented"));
1226         _bfd_vms_push (abfd, 1L, -1);
1227         break;
1228
1229       case TIR_S_C_STA_LSY:
1230         /*
1231          * stack local symbol value
1232          * arg: sh      environment index
1233          *      cs      symbol name
1234          */
1235         {
1236           int envidx;
1237           char *name;
1238           vms_symbol_entry *entry;
1239
1240           envidx = bfd_getl16(ptr); ptr += 2;
1241           name = _bfd_vms_save_counted_string (ptr);
1242           entry = _bfd_vms_enter_symbol (abfd, name);
1243           if (entry == (vms_symbol_entry *)NULL)
1244             return 0;
1245           (*_bfd_error_handler) (_("Stack-local-symbol not fully implemented"));
1246           _bfd_vms_push (abfd, 0L, -1);
1247           ptr += *ptr + 1;
1248         }
1249       break;
1250
1251       case TIR_S_C_STA_LIT:
1252         /*
1253          * stack literal
1254          * arg: by      literal index
1255          *
1256          * stack literal
1257          */
1258         ptr++;
1259         _bfd_vms_push (abfd, 0L, -1);
1260         (*_bfd_error_handler) (_("Stack-literal not fully implemented"));
1261         break;
1262
1263       case TIR_S_C_STA_LEPM:
1264         /*
1265          * stack local symbol entry point mask
1266          * arg: sh      environment index
1267          *      cs      symbol name
1268          *
1269          * stack (unsigned) entry point mask of symbol
1270          * err if symbol is no entry point
1271          */
1272         {
1273           int envidx;
1274           char *name;
1275           vms_symbol_entry *entry;
1276
1277           envidx = bfd_getl16(ptr); ptr += 2;
1278           name = _bfd_vms_save_counted_string (ptr);
1279           entry = _bfd_vms_enter_symbol (abfd, name);
1280           if (entry == (vms_symbol_entry *)NULL)
1281             return 0;
1282           (*_bfd_error_handler) (_("Stack-local-symbol-entry-point-mask not fully implemented"));
1283           _bfd_vms_push (abfd, 0L, -1);
1284           ptr += *ptr + 1;
1285         }
1286       break;
1287
1288       default:
1289         (*_bfd_error_handler) (_("Reserved STA cmd %d"), ptr[-1]);
1290         return NULL;
1291       break;
1292   }
1293
1294   return ptr;
1295 }
1296
1297
1298 /*
1299  * tir_sto
1300  *
1301  * vax store commands
1302  *
1303  * handle sto_xxx commands in tir section
1304  * ptr points to data area in record
1305  *
1306  * see table 7-4 of the VAX/VMS linker manual
1307  */
1308
1309 static unsigned char *
1310 tir_sto (bfd *abfd, unsigned char *ptr)
1311 {
1312   unsigned long dummy;
1313   int size;
1314   int psect;
1315
1316 #if VMS_DEBUG
1317   _bfd_vms_debug (5, "tir_sto %d\n", *ptr);
1318 #endif
1319
1320   switch (*ptr++)
1321     {
1322       case TIR_S_C_STO_SB:
1323         /*
1324          * store signed byte: pop stack, write byte
1325          * arg: -
1326          */
1327         dummy = _bfd_vms_pop (abfd, &psect);
1328         image_write_b (abfd, dummy & 0xff);     /* FIXME: check top bits */
1329       break;
1330
1331       case TIR_S_C_STO_SW:
1332         /*
1333          * store signed word: pop stack, write word
1334          * arg: -
1335          */
1336         dummy = _bfd_vms_pop (abfd, &psect);
1337         image_write_w (abfd, dummy & 0xffff);   /* FIXME: check top bits */
1338       break;
1339
1340       case TIR_S_C_STO_LW:
1341         /*
1342          * store longword: pop stack, write longword
1343          * arg: -
1344          */
1345         dummy = _bfd_vms_pop (abfd, &psect);
1346         image_write_l (abfd, dummy & 0xffffffff);/* FIXME: check top bits */
1347       break;
1348
1349       case TIR_S_C_STO_BD:
1350         /*
1351          * store byte displaced: pop stack, sub lc+1, write byte
1352          * arg: -
1353          */
1354         dummy = _bfd_vms_pop (abfd, &psect);
1355         dummy -= ((PRIV(sections)[psect])->vma + 1);
1356         image_write_b (abfd, dummy & 0xff);/* FIXME: check top bits */
1357       break;
1358
1359       case TIR_S_C_STO_WD:
1360         /*
1361          * store word displaced: pop stack, sub lc+2, write word
1362          * arg: -
1363          */
1364         dummy = _bfd_vms_pop (abfd, &psect);
1365         dummy -= ((PRIV(sections)[psect])->vma + 2);
1366         image_write_w (abfd, dummy & 0xffff);/* FIXME: check top bits */
1367       break;
1368       case TIR_S_C_STO_LD:
1369         /*
1370          * store long displaced: pop stack, sub lc+4, write long
1371          * arg: -
1372          */
1373         dummy = _bfd_vms_pop (abfd, &psect);
1374         dummy -= ((PRIV(sections)[psect])->vma + 4);
1375         image_write_l (abfd, dummy & 0xffffffff);/* FIXME: check top bits */
1376       break;
1377       case TIR_S_C_STO_LI:
1378         /*
1379          * store short literal: pop stack, write byte
1380          * arg: -
1381          */
1382         dummy = _bfd_vms_pop (abfd, &psect);
1383         image_write_b (abfd, dummy & 0xff);/* FIXME: check top bits */
1384       break;
1385       case TIR_S_C_STO_PIDR:
1386         /*
1387          * store position independent data reference: pop stack, write longword
1388          * arg: -
1389          * FIXME: incomplete !
1390          */
1391         dummy = _bfd_vms_pop (abfd, &psect);
1392         image_write_l (abfd, dummy & 0xffffffff);
1393       break;
1394       case TIR_S_C_STO_PICR:
1395         /*
1396          * store position independent code reference: pop stack, write longword
1397          * arg: -
1398          * FIXME: incomplete !
1399          */
1400         dummy = _bfd_vms_pop (abfd, &psect);
1401         image_write_b (abfd, 0x9f);
1402         image_write_l (abfd, dummy & 0xffffffff);
1403       break;
1404       case TIR_S_C_STO_RIVB:
1405         /*
1406          * store repeated immediate variable bytes
1407          * 1-byte count n field followed by n bytes of data
1408          * pop stack, write n bytes <stack> times
1409          */
1410         size = *ptr++;
1411         dummy = (unsigned long)_bfd_vms_pop (abfd, NULL);
1412         while (dummy-- > 0L)
1413           image_dump (abfd, ptr, size, 0);
1414         ptr += size;
1415         break;
1416       case TIR_S_C_STO_B:
1417         /*
1418          * store byte from top longword
1419          */
1420         dummy = (unsigned long)_bfd_vms_pop (abfd, NULL);
1421         image_write_b (abfd, dummy & 0xff);
1422         break;
1423       case TIR_S_C_STO_W:
1424         /*
1425          * store word from top longword
1426          */
1427         dummy = (unsigned long)_bfd_vms_pop (abfd, NULL);
1428         image_write_w (abfd, dummy & 0xffff);
1429         break;
1430       case TIR_S_C_STO_RB:
1431         /*
1432          * store repeated byte from top longword
1433          */
1434         size = (unsigned long)_bfd_vms_pop (abfd, NULL);
1435         dummy = (unsigned long)_bfd_vms_pop (abfd, NULL);
1436         while (size-- > 0)
1437           image_write_b (abfd, dummy & 0xff);
1438         break;
1439       case TIR_S_C_STO_RW:
1440         /*
1441          * store repeated word from top longword
1442          */
1443         size = (unsigned long)_bfd_vms_pop (abfd, NULL);
1444         dummy = (unsigned long)_bfd_vms_pop (abfd, NULL);
1445         while (size-- > 0)
1446           image_write_w (abfd, dummy & 0xffff);
1447         break;
1448
1449       case TIR_S_C_STO_RSB:
1450       case TIR_S_C_STO_RSW:
1451       case TIR_S_C_STO_RL:
1452       case TIR_S_C_STO_VPS:
1453       case TIR_S_C_STO_USB:
1454       case TIR_S_C_STO_USW:
1455       case TIR_S_C_STO_RUB:
1456       case TIR_S_C_STO_RUW:
1457       case TIR_S_C_STO_PIRR:
1458         (*_bfd_error_handler) (_("Unimplemented STO cmd %d"), ptr[-1]);
1459       break;
1460
1461       default:
1462         (*_bfd_error_handler) (_("Reserved STO cmd %d"), ptr[-1]);
1463       break;
1464   }
1465
1466   return ptr;
1467 }
1468
1469
1470 /*
1471  * stack operator commands
1472  * all 32 bit signed arithmetic
1473  * all word just like a stack calculator
1474  * arguments are popped from stack, results are pushed on stack
1475  *
1476  * see table 7-5 of the VAX/VMS linker manual
1477  */
1478
1479 static unsigned char *
1480 tir_opr (bfd *abfd, unsigned char *ptr)
1481 {
1482   long op1, op2;
1483
1484 #if VMS_DEBUG
1485   _bfd_vms_debug (5, "tir_opr %d\n", *ptr);
1486 #endif
1487
1488   switch (*ptr++)
1489     {
1490   /* operation */
1491       case TIR_S_C_OPR_NOP:
1492         /*
1493          * no-op
1494          */
1495       break;
1496
1497       case TIR_S_C_OPR_ADD:
1498         /*
1499          * add
1500          */
1501         op1 = (long)_bfd_vms_pop (abfd, NULL);
1502         op2 = (long)_bfd_vms_pop (abfd, NULL);
1503         _bfd_vms_push (abfd, (unsigned long)(op1 + op2), -1);
1504       break;
1505
1506       case TIR_S_C_OPR_SUB:
1507         /*
1508          * subtract
1509          */
1510         op1 = (long)_bfd_vms_pop (abfd, NULL);
1511         op2 = (long)_bfd_vms_pop (abfd, NULL);
1512         _bfd_vms_push (abfd, (unsigned long)(op2 - op1), -1);
1513       break;
1514
1515       case TIR_S_C_OPR_MUL:
1516         /*
1517          * multiply
1518          */
1519         op1 = (long)_bfd_vms_pop (abfd, NULL);
1520         op2 = (long)_bfd_vms_pop (abfd, NULL);
1521         _bfd_vms_push (abfd, (unsigned long)(op1 * op2), -1);
1522       break;
1523
1524       case TIR_S_C_OPR_DIV:
1525         /*
1526          * divide
1527          */
1528         op1 = (long)_bfd_vms_pop (abfd, NULL);
1529         op2 = (long)_bfd_vms_pop (abfd, NULL);
1530         if (op2 == 0)
1531           _bfd_vms_push (abfd, (unsigned long)0L, -1);
1532         else
1533           _bfd_vms_push (abfd, (unsigned long)(op2 / op1), -1);
1534       break;
1535
1536       case TIR_S_C_OPR_AND:
1537         /*
1538          * logical and
1539          */
1540         op1 = (long)_bfd_vms_pop (abfd, NULL);
1541         op2 = (long)_bfd_vms_pop (abfd, NULL);
1542         _bfd_vms_push (abfd, (unsigned long)(op1 & op2), -1);
1543       break;
1544
1545       case TIR_S_C_OPR_IOR:
1546         op1 = (long)_bfd_vms_pop (abfd, NULL);
1547         /*
1548          * logical inclusive or
1549          */
1550         op2 = (long)_bfd_vms_pop (abfd, NULL);
1551         _bfd_vms_push (abfd, (unsigned long)(op1 | op2), -1);
1552       break;
1553
1554       case TIR_S_C_OPR_EOR:
1555         /*
1556          * logical exclusive or
1557          */
1558         op1 = (long)_bfd_vms_pop (abfd, NULL);
1559         op2 = (long)_bfd_vms_pop (abfd, NULL);
1560         _bfd_vms_push (abfd, (unsigned long)(op1 ^ op2), -1);
1561       break;
1562
1563       case TIR_S_C_OPR_NEG:
1564         /*
1565          * negate
1566          */
1567         op1 = (long)_bfd_vms_pop (abfd, NULL);
1568         _bfd_vms_push (abfd, (unsigned long)(-op1), -1);
1569       break;
1570
1571       case TIR_S_C_OPR_COM:
1572         /*
1573          * complement
1574          */
1575         op1 = (long)_bfd_vms_pop (abfd, NULL);
1576         _bfd_vms_push (abfd, (unsigned long)(op1 ^ -1L), -1);
1577       break;
1578
1579       case TIR_S_C_OPR_INSV:
1580         /*
1581          * insert field
1582          */
1583         (void)_bfd_vms_pop (abfd, NULL);
1584         (*_bfd_error_handler)  ("TIR_S_C_OPR_INSV incomplete");
1585       break;
1586
1587       case TIR_S_C_OPR_ASH:
1588         /*
1589          * arithmetic shift
1590          */
1591         op1 = (long)_bfd_vms_pop (abfd, NULL);
1592         op2 = (long)_bfd_vms_pop (abfd, NULL);
1593         if (HIGHBIT(op1))               /* shift right */
1594           op2 >>= op1;
1595         else                    /* shift left */
1596           op2 <<= op1;
1597         _bfd_vms_push (abfd, (unsigned long)op2, -1);
1598         (*_bfd_error_handler) (_("TIR_S_C_OPR_ASH incomplete"));
1599       break;
1600
1601       case TIR_S_C_OPR_USH:
1602         /*
1603          * unsigned shift
1604          */
1605         op1 = (long)_bfd_vms_pop (abfd, NULL);
1606         op2 = (long)_bfd_vms_pop (abfd, NULL);
1607         if (HIGHBIT(op1))               /* shift right */
1608           op2 >>= op1;
1609         else                    /* shift left */
1610           op2 <<= op1;
1611         _bfd_vms_push (abfd, (unsigned long)op2, -1);
1612         (*_bfd_error_handler) (_("TIR_S_C_OPR_USH incomplete"));
1613       break;
1614
1615       case TIR_S_C_OPR_ROT:
1616         /*
1617          * rotate
1618          */
1619         op1 = (long)_bfd_vms_pop (abfd, NULL);
1620         op2 = (long)_bfd_vms_pop (abfd, NULL);
1621         if (HIGHBIT(0))         /* shift right */
1622           op2 >>= op1;
1623         else                    /* shift left */
1624           op2 <<= op1;
1625         _bfd_vms_push (abfd, (unsigned long)op2, -1);
1626         (*_bfd_error_handler) (_("TIR_S_C_OPR_ROT incomplete"));
1627       break;
1628
1629       case TIR_S_C_OPR_SEL:
1630         /*
1631          * select
1632          */
1633         if ((long)_bfd_vms_pop (abfd, NULL) & 0x01L)
1634           (void)_bfd_vms_pop (abfd, NULL);
1635         else
1636           {
1637             op1 = (long)_bfd_vms_pop (abfd, NULL);
1638             (void)_bfd_vms_pop (abfd, NULL);
1639             _bfd_vms_push (abfd, (unsigned long)op1, -1);
1640           }
1641       break;
1642
1643       case TIR_S_C_OPR_REDEF:
1644         /*
1645          * redefine symbol to current location
1646          */
1647         (*_bfd_error_handler) (_("TIR_S_C_OPR_REDEF not supported"));
1648       break;
1649
1650       case TIR_S_C_OPR_DFLIT:
1651         /*
1652          * define a literal
1653          */
1654         (*_bfd_error_handler) (_("TIR_S_C_OPR_DFLIT not supported"));
1655       break;
1656
1657       default:
1658         (*_bfd_error_handler) (_("Reserved OPR cmd %d"), ptr[-1]);
1659       break;
1660     }
1661
1662   return ptr;
1663 }
1664
1665
1666 static unsigned char *
1667 tir_ctl (bfd *abfd, unsigned char *ptr)
1668 /*
1669  * control commands
1670  *
1671  * see table 7-6 of the VAX/VMS linker manual
1672  */
1673 {
1674   unsigned long dummy;
1675   int psect;
1676
1677 #if VMS_DEBUG
1678   _bfd_vms_debug (5, "tir_ctl %d\n", *ptr);
1679 #endif
1680
1681   switch (*ptr++)
1682     {
1683       case TIR_S_C_CTL_SETRB:
1684         /*
1685          * set relocation base: pop stack, set image location counter
1686          * arg: -
1687          */
1688         dummy = _bfd_vms_pop (abfd, &psect);
1689         if (psect >= PRIV(section_count))
1690           {
1691             alloc_section (abfd, psect);
1692           }
1693         image_set_ptr (abfd, psect, dummy);
1694       break;
1695       case TIR_S_C_CTL_AUGRB:
1696         /*
1697          * augment relocation base: increment image location counter by offset
1698          * arg: lw      offset value
1699          */
1700         dummy = bfd_getl32 (ptr);
1701         image_inc_ptr (abfd, dummy);
1702       break;
1703       case TIR_S_C_CTL_DFLOC:
1704         /*
1705          * define location: pop index, save location counter under index
1706          * arg: -
1707          */
1708         dummy = _bfd_vms_pop (abfd, NULL);
1709         (*_bfd_error_handler) (_("TIR_S_C_CTL_DFLOC not fully implemented"));
1710       break;
1711       case TIR_S_C_CTL_STLOC:
1712         /*
1713          * set location: pop index, restore location counter from index
1714          * arg: -
1715          */
1716         dummy = _bfd_vms_pop (abfd, &psect);
1717         (*_bfd_error_handler) (_("TIR_S_C_CTL_STLOC not fully implemented"));
1718       break;
1719     case TIR_S_C_CTL_STKDL:
1720         /*
1721          * stack defined location: pop index, push location counter from index
1722          * arg: -
1723          */
1724         dummy = _bfd_vms_pop (abfd, &psect);
1725         (*_bfd_error_handler) (_("TIR_S_C_CTL_STKDL not fully implemented"));
1726       break;
1727     default:
1728         (*_bfd_error_handler) (_("Reserved CTL cmd %d"), ptr[-1]);
1729         break;
1730   }
1731   return ptr;
1732 }
1733
1734
1735 /*
1736  * handle command from TIR section
1737  */
1738
1739 static unsigned char *
1740 tir_cmd (bfd *abfd, unsigned char *ptr)
1741 {
1742   struct {
1743     int mincod;
1744     int maxcod;
1745     unsigned char * (*explain)(bfd *, unsigned char *);
1746   } tir_table[] = {
1747     { 0,                 TIR_S_C_MAXSTACOD, tir_sta }
1748    ,{ TIR_S_C_MINSTOCOD, TIR_S_C_MAXSTOCOD, tir_sto }
1749    ,{ TIR_S_C_MINOPRCOD, TIR_S_C_MAXOPRCOD, tir_opr }
1750    ,{ TIR_S_C_MINCTLCOD, TIR_S_C_MAXCTLCOD, tir_ctl }
1751    ,{ -1, -1, NULL }
1752   };
1753   int i = 0;
1754
1755 #if VMS_DEBUG
1756   _bfd_vms_debug (4, "tir_cmd %d/%x\n", *ptr, *ptr);
1757   _bfd_hexdump (8, ptr, 16, (int)ptr);
1758 #endif
1759
1760   if (*ptr & 0x80)                              /* store immediate */
1761     {
1762       i = 128 - (*ptr++ & 0x7f);
1763       image_dump (abfd, ptr, i, 0);
1764       ptr += i;
1765     }
1766   else
1767     {
1768       while (tir_table[i].mincod >= 0)
1769         {
1770           if ( (tir_table[i].mincod <= *ptr)
1771             && (*ptr <= tir_table[i].maxcod))
1772             {
1773               ptr = tir_table[i].explain (abfd, ptr);
1774               break;
1775             }
1776           i++;
1777         }
1778       if (tir_table[i].mincod < 0)
1779         {
1780           (*_bfd_error_handler) (_("Obj code %d not found"), *ptr);
1781           ptr = 0;
1782         }
1783     }
1784
1785   return ptr;
1786 }
1787
1788
1789 /* handle command from ETIR section  */
1790
1791 static int
1792 etir_cmd (abfd, cmd, ptr)
1793      bfd *abfd;
1794      int cmd;
1795      unsigned char *ptr;
1796 {
1797   static struct {
1798     int mincod;
1799     int maxcod;
1800     boolean (*explain) PARAMS((bfd *, int, unsigned char *));
1801   } etir_table[] = {
1802     { ETIR_S_C_MINSTACOD, ETIR_S_C_MAXSTACOD, etir_sta },
1803     { ETIR_S_C_MINSTOCOD, ETIR_S_C_MAXSTOCOD, etir_sto },
1804     { ETIR_S_C_MINOPRCOD, ETIR_S_C_MAXOPRCOD, etir_opr },
1805     { ETIR_S_C_MINCTLCOD, ETIR_S_C_MAXCTLCOD, etir_ctl },
1806     { ETIR_S_C_MINSTCCOD, ETIR_S_C_MAXSTCCOD, etir_stc },
1807     { -1, -1, NULL }
1808   };
1809
1810   int i = 0;
1811
1812 #if VMS_DEBUG
1813   _bfd_vms_debug (4, "etir_cmd %d/%x\n", cmd, cmd);
1814   _bfd_hexdump (8, ptr, 16, (int)ptr);
1815 #endif
1816
1817   while (etir_table[i].mincod >= 0)
1818     {
1819       if ( (etir_table[i].mincod <= cmd)
1820         && (cmd <= etir_table[i].maxcod))
1821         {
1822           if (!etir_table[i].explain (abfd, cmd, ptr))
1823             return -1;
1824           break;
1825         }
1826       i++;
1827     }
1828
1829 #if VMS_DEBUG
1830   _bfd_vms_debug (4, "etir_cmd: = 0\n");
1831 #endif
1832   return 0;
1833 }
1834
1835
1836 /* Text Information and Relocation Records (OBJ$C_TIR)
1837    handle tir record  */
1838
1839 static int
1840 analyze_tir (abfd, ptr, length)
1841      bfd *abfd;
1842      unsigned char *ptr;
1843      unsigned int length;
1844 {
1845   unsigned char *maxptr;
1846
1847 #if VMS_DEBUG
1848   _bfd_vms_debug (3, "analyze_tir: %d bytes\n", length);
1849 #endif
1850
1851   maxptr = ptr + length;
1852
1853   while (ptr < maxptr)
1854     {
1855       ptr = tir_cmd (abfd, ptr);
1856       if (ptr == 0)
1857         return -1;
1858     }
1859
1860   return 0;
1861 }
1862
1863
1864 /* Text Information and Relocation Records (EOBJ$C_ETIR)
1865    handle etir record  */
1866
1867 static int
1868 analyze_etir (abfd, ptr, length)
1869      bfd *abfd;
1870      unsigned char *ptr;
1871      unsigned int length;
1872 {
1873   int cmd;
1874   unsigned char *maxptr;
1875   int result = 0;
1876
1877 #if VMS_DEBUG
1878   _bfd_vms_debug (3, "analyze_etir: %d bytes\n", length);
1879 #endif
1880
1881   maxptr = ptr + length;
1882
1883   while (ptr < maxptr)
1884     {
1885       cmd = bfd_getl16 (ptr);
1886       length = bfd_getl16 (ptr + 2);
1887       result = etir_cmd (abfd, cmd, ptr+4);
1888       if (result != 0)
1889         break;
1890       ptr += length;
1891     }
1892
1893 #if VMS_DEBUG
1894   _bfd_vms_debug (3, "analyze_etir: = %d\n", result);
1895 #endif
1896
1897   return result;
1898 }
1899
1900
1901 /* process ETIR record
1902
1903    return 0 on success, -1 on error  */
1904
1905 int
1906 _bfd_vms_slurp_tir (abfd, objtype)
1907      bfd *abfd;
1908      int objtype;
1909 {
1910   int result;
1911
1912 #if VMS_DEBUG
1913   _bfd_vms_debug (2, "TIR/ETIR\n");
1914 #endif
1915
1916   switch (objtype)
1917     {
1918       case EOBJ_S_C_ETIR:
1919         PRIV(vms_rec) += 4;     /* skip type, size */
1920         PRIV(rec_size) -= 4;
1921         result = analyze_etir (abfd, PRIV(vms_rec), PRIV(rec_size));
1922         break;
1923       case OBJ_S_C_TIR:
1924         PRIV(vms_rec) += 1;     /* skip type */
1925         PRIV(rec_size) -= 1;
1926         result = analyze_tir (abfd, PRIV(vms_rec), PRIV(rec_size));
1927         break;
1928       default:
1929         result = -1;
1930         break;
1931     }
1932
1933   return result;
1934 }
1935
1936
1937 /* process EDBG record
1938    return 0 on success, -1 on error
1939
1940    not implemented yet  */
1941
1942 int
1943 _bfd_vms_slurp_dbg (abfd, objtype)
1944      bfd *abfd;
1945      int objtype;
1946 {
1947 #if VMS_DEBUG
1948   _bfd_vms_debug (2, "DBG/EDBG\n");
1949 #endif
1950
1951   abfd->flags |= (HAS_DEBUG | HAS_LINENO);
1952   return 0;
1953 }
1954
1955
1956 /* process ETBT record
1957    return 0 on success, -1 on error
1958
1959    not implemented yet  */
1960
1961 int
1962 _bfd_vms_slurp_tbt (abfd, objtype)
1963      bfd *abfd;
1964      int objtype;
1965 {
1966 #if VMS_DEBUG
1967   _bfd_vms_debug (2, "TBT/ETBT\n");
1968 #endif
1969
1970   return 0;
1971 }
1972
1973
1974 /* process LNK record
1975    return 0 on success, -1 on error
1976
1977    not implemented yet  */
1978
1979 int
1980 _bfd_vms_slurp_lnk (abfd, objtype)
1981      bfd *abfd;
1982      int objtype;
1983 {
1984 #if VMS_DEBUG
1985   _bfd_vms_debug (2, "LNK\n");
1986 #endif
1987
1988   return 0;
1989 }
1990 \f
1991 /*----------------------------------------------------------------------*/
1992 /*                                                                      */
1993 /*      WRITE ETIR SECTION                                              */
1994 /*                                                                      */
1995 /*      this is still under construction and therefore not documented   */
1996 /*                                                                      */
1997 /*----------------------------------------------------------------------*/
1998
1999 static void start_etir_record PARAMS ((bfd *abfd, int index, uquad offset, boolean justoffset));
2000 static void sto_imm PARAMS ((bfd *abfd, vms_section *sptr, bfd_vma vaddr, int index));
2001 static void end_etir_record PARAMS ((bfd *abfd));
2002
2003 static void
2004 sto_imm (abfd, sptr, vaddr, index)
2005      bfd *abfd;
2006      vms_section *sptr;
2007      bfd_vma vaddr;
2008      int index;
2009 {
2010   int size;
2011   int ssize;
2012   unsigned char *cptr;
2013
2014 #if VMS_DEBUG
2015   _bfd_vms_debug (8, "sto_imm %d bytes\n", sptr->size);
2016   _bfd_hexdump (9, sptr->contents, (int)sptr->size, (int)vaddr);
2017 #endif
2018
2019   ssize = sptr->size;
2020   cptr = sptr->contents;
2021
2022   while (ssize > 0)
2023     {
2024
2025       size = ssize;                             /* try all the rest */
2026
2027       if (_bfd_vms_output_check (abfd, size) < 0)
2028         {                                       /* doesn't fit, split ! */
2029           end_etir_record (abfd);
2030           start_etir_record (abfd, index, vaddr, false);
2031           size = _bfd_vms_output_check (abfd, 0);       /* get max size */
2032           if (size > ssize)                     /* more than what's left ? */
2033             size = ssize;
2034         }
2035
2036       _bfd_vms_output_begin (abfd, ETIR_S_C_STO_IMM, -1);
2037       _bfd_vms_output_long (abfd, (unsigned long)(size));
2038       _bfd_vms_output_dump (abfd, cptr, size);
2039       _bfd_vms_output_flush (abfd);
2040
2041 #if VMS_DEBUG
2042       _bfd_vms_debug (10, "dumped %d bytes\n", size);
2043       _bfd_hexdump (10, cptr, (int)size, (int)vaddr);
2044 #endif
2045
2046       vaddr += size;
2047       ssize -= size;
2048       cptr += size;
2049     }
2050
2051   return;
2052 }
2053
2054 /*-------------------------------------------------------------------*/
2055
2056 /* start ETIR record for section #index at virtual addr offset.  */
2057
2058 static void
2059 start_etir_record (abfd, index, offset, justoffset)
2060     bfd *abfd;
2061     int index;
2062     uquad offset;
2063     boolean justoffset;
2064 {
2065   if (!justoffset)
2066     {
2067       _bfd_vms_output_begin (abfd, EOBJ_S_C_ETIR, -1);  /* one ETIR per section */
2068       _bfd_vms_output_push (abfd);
2069     }
2070
2071   _bfd_vms_output_begin (abfd, ETIR_S_C_STA_PQ, -1);    /* push start offset */
2072   _bfd_vms_output_long (abfd, (unsigned long)index);
2073   _bfd_vms_output_quad (abfd, (uquad)offset);
2074   _bfd_vms_output_flush (abfd);
2075
2076   _bfd_vms_output_begin (abfd, ETIR_S_C_CTL_SETRB, -1); /* start = pop () */
2077   _bfd_vms_output_flush (abfd);
2078
2079   return;
2080 }
2081
2082
2083 /* end etir record  */
2084 static void
2085 end_etir_record (abfd)
2086     bfd *abfd;
2087 {
2088   _bfd_vms_output_pop (abfd);
2089   _bfd_vms_output_end (abfd);
2090 }
2091
2092 /* write section contents for bfd abfd  */
2093
2094 int
2095 _bfd_vms_write_tir (abfd, objtype)
2096      bfd *abfd;
2097      int objtype;
2098 {
2099   asection *section;
2100   vms_section *sptr;
2101   int nextoffset;
2102
2103 #if VMS_DEBUG
2104   _bfd_vms_debug (2, "vms_write_tir (%p, %d)\n", abfd, objtype);
2105 #endif
2106
2107   _bfd_vms_output_alignment (abfd, 4);
2108
2109   nextoffset = 0;
2110   PRIV(vms_linkage_index) = 1;
2111
2112   /* dump all other sections  */
2113
2114   section = abfd->sections;
2115
2116   while (section != NULL)
2117     {
2118
2119 #if VMS_DEBUG
2120       _bfd_vms_debug (4, "writing %d. section '%s' (%d bytes)\n", section->index, section->name, (int)(section->_raw_size));
2121 #endif
2122
2123       if (section->flags & SEC_RELOC)
2124         {
2125           int i;
2126
2127           if ((i = section->reloc_count) <= 0)
2128             {
2129               (*_bfd_error_handler) (_("SEC_RELOC with no relocs in section %s"),
2130                                      section->name);
2131             }
2132 #if VMS_DEBUG
2133           else
2134             {
2135               arelent **rptr;
2136               _bfd_vms_debug (4, "%d relocations:\n", i);
2137               rptr = section->orelocation;
2138               while (i-- > 0)
2139                 {
2140                   _bfd_vms_debug (4, "sym %s in sec %s, value %08lx, addr %08lx, off %08lx, len %d: %s\n",
2141                               (*(*rptr)->sym_ptr_ptr)->name,
2142                               (*(*rptr)->sym_ptr_ptr)->section->name,
2143                               (long)(*(*rptr)->sym_ptr_ptr)->value,
2144                               (*rptr)->address, (*rptr)->addend,
2145                               bfd_get_reloc_size((*rptr)->howto),
2146                               (*rptr)->howto->name);
2147                   rptr++;
2148                 }
2149             }
2150 #endif
2151         }
2152
2153       if ((section->flags & SEC_HAS_CONTENTS)
2154         && (! bfd_is_com_section (section)))
2155         {
2156           bfd_vma vaddr;                /* virtual addr in section */
2157
2158           sptr = _bfd_get_vms_section (abfd, section->index);
2159           if (sptr == NULL)
2160             {
2161               bfd_set_error (bfd_error_no_contents);
2162               return -1;
2163             }
2164
2165           vaddr = (bfd_vma)(sptr->offset);
2166
2167           start_etir_record (abfd, section->index, (uquad) sptr->offset,
2168                              false);
2169
2170           while (sptr != NULL)                          /* one STA_PQ, CTL_SETRB per vms_section */
2171             {
2172
2173               if (section->flags & SEC_RELOC)                   /* check for relocs */
2174                 {
2175                   arelent **rptr = section->orelocation;
2176                   int i = section->reloc_count;
2177                   for (;;)
2178                     {
2179                       bfd_size_type addr = (*rptr)->address;
2180                       int len = bfd_get_reloc_size ((*rptr)->howto);
2181                       if (sptr->offset < addr)          /* sptr starts before reloc */
2182                         {
2183                           int before = addr - sptr->offset;
2184                           if (sptr->size <= before)             /* complete before */
2185                             {
2186                               sto_imm (abfd, sptr, vaddr, section->index);
2187                               vaddr += sptr->size;
2188                               break;
2189                             }
2190                           else                          /* partly before */
2191                             {
2192                               int after = sptr->size - before;
2193                               sptr->size = before;
2194                               sto_imm (abfd, sptr, vaddr, section->index);
2195                               vaddr += sptr->size;
2196                               sptr->contents += before;
2197                               sptr->offset += before;
2198                               sptr->size = after;
2199                             }
2200                         }
2201                       else if (sptr->offset == addr)    /* sptr starts at reloc */
2202                         {
2203                           asymbol *sym = *(*rptr)->sym_ptr_ptr;
2204                           asection *sec = sym->section;
2205
2206                           switch ((*rptr)->howto->type)
2207                             {
2208                             case ALPHA_R_IGNORE:
2209                               break;
2210
2211                             case ALPHA_R_REFLONG:
2212                               {
2213                                 if (bfd_is_und_section (sym->section))
2214                                   {
2215                                     if (_bfd_vms_output_check (abfd,
2216                                                                 strlen((char *)sym->name))
2217                                         < 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_STO_GBL_LW,
2226                                                             -1);
2227                                     _bfd_vms_output_counted (abfd,
2228                                                               _bfd_vms_length_hash_symbol (abfd, sym->name, EOBJ_S_C_SYMSIZ));
2229                                     _bfd_vms_output_flush (abfd);
2230                                   }
2231                                 else if (bfd_is_abs_section (sym->section))
2232                                   {
2233                                     if (_bfd_vms_output_check (abfd, 16) < 0)
2234                                       {
2235                                         end_etir_record (abfd);
2236                                         start_etir_record (abfd,
2237                                                            section->index,
2238                                                            vaddr, false);
2239                                       }
2240                                     _bfd_vms_output_begin (abfd,
2241                                                             ETIR_S_C_STA_LW,
2242                                                             -1);
2243                                     _bfd_vms_output_quad (abfd,
2244                                                            (uquad)sym->value);
2245                                     _bfd_vms_output_flush (abfd);
2246                                     _bfd_vms_output_begin (abfd,
2247                                                             ETIR_S_C_STO_LW,
2248                                                             -1);
2249                                     _bfd_vms_output_flush (abfd);
2250                                   }
2251                                 else
2252                                   {
2253                                     if (_bfd_vms_output_check (abfd, 32) < 0)
2254                                       {
2255                                         end_etir_record (abfd);
2256                                         start_etir_record (abfd,
2257                                                            section->index,
2258                                                            vaddr, false);
2259                                       }
2260                                     _bfd_vms_output_begin (abfd,
2261                                                             ETIR_S_C_STA_PQ,
2262                                                             -1);
2263                                     _bfd_vms_output_long (abfd,
2264                                                            (unsigned long)(sec->index));
2265                                     _bfd_vms_output_quad (abfd,
2266                                                            ((uquad)(*rptr)->addend
2267                                                             + (uquad)sym->value));
2268                                     _bfd_vms_output_flush (abfd);
2269                                     _bfd_vms_output_begin (abfd,
2270                                                             ETIR_S_C_STO_LW,
2271                                                             -1);
2272                                     _bfd_vms_output_flush (abfd);
2273                                   }
2274                               }
2275                               break;
2276
2277                             case ALPHA_R_REFQUAD:
2278                               {
2279                                 if (bfd_is_und_section (sym->section))
2280                                   {
2281                                     if (_bfd_vms_output_check (abfd,
2282                                                                 strlen((char *)sym->name))
2283                                         < 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_STO_GBL,
2292                                                             -1);
2293                                     _bfd_vms_output_counted (abfd,
2294                                                               _bfd_vms_length_hash_symbol (abfd, sym->name, EOBJ_S_C_SYMSIZ));
2295                                     _bfd_vms_output_flush (abfd);
2296                                   }
2297                                 else if (bfd_is_abs_section (sym->section))
2298                                   {
2299                                     if (_bfd_vms_output_check (abfd, 16) < 0)
2300                                       {
2301                                         end_etir_record (abfd);
2302                                         start_etir_record (abfd,
2303                                                            section->index,
2304                                                            vaddr, false);
2305                                       }
2306                                     _bfd_vms_output_begin (abfd,
2307                                                             ETIR_S_C_STA_QW,
2308                                                             -1);
2309                                     _bfd_vms_output_quad (abfd,
2310                                                            (uquad)sym->value);
2311                                     _bfd_vms_output_flush (abfd);
2312                                     _bfd_vms_output_begin (abfd,
2313                                                             ETIR_S_C_STO_QW,
2314                                                             -1);
2315                                     _bfd_vms_output_flush (abfd);
2316                                   }
2317                                 else
2318                                   {
2319                                     if (_bfd_vms_output_check (abfd, 32) < 0)
2320                                       {
2321                                         end_etir_record (abfd);
2322                                         start_etir_record (abfd,
2323                                                            section->index,
2324                                                            vaddr, false);
2325                                       }
2326                                     _bfd_vms_output_begin (abfd,
2327                                                             ETIR_S_C_STA_PQ,
2328                                                             -1);
2329                                     _bfd_vms_output_long (abfd,
2330                                                            (unsigned long)(sec->index));
2331                                     _bfd_vms_output_quad (abfd,
2332                                                            ((uquad)(*rptr)->addend
2333                                                             + (uquad)sym->value));
2334                                     _bfd_vms_output_flush (abfd);
2335                                     _bfd_vms_output_begin (abfd,
2336                                                             ETIR_S_C_STO_OFF,
2337                                                             -1);
2338                                     _bfd_vms_output_flush (abfd);
2339                                   }
2340                               }
2341                               break;
2342
2343                             case ALPHA_R_HINT:
2344                               {
2345                                 int hint_size;
2346
2347                                 hint_size = sptr->size;
2348                                 sptr->size = len;
2349                                 sto_imm (abfd, sptr, vaddr, section->index);
2350                                 sptr->size = hint_size;
2351 #if 0
2352                                 vms_output_begin(abfd, ETIR_S_C_STO_HINT_GBL, -1);
2353                                 vms_output_long(abfd, (unsigned long)(sec->index));
2354                                 vms_output_quad(abfd, (uquad)addr);
2355
2356                                 vms_output_counted(abfd, _bfd_vms_length_hash_symbol (abfd, sym->name, EOBJ_S_C_SYMSIZ));
2357                                 vms_output_flush(abfd);
2358 #endif
2359                               }
2360                               break;
2361                             case ALPHA_R_LINKAGE:
2362                               {
2363                                 if (_bfd_vms_output_check (abfd, 64) < 0)
2364                                   {
2365                                     end_etir_record (abfd);
2366                                     start_etir_record (abfd, section->index,
2367                                                        vaddr, false);
2368                                   }
2369                                 _bfd_vms_output_begin (abfd,
2370                                                         ETIR_S_C_STC_LP_PSB,
2371                                                         -1);
2372                                 _bfd_vms_output_long (abfd,
2373                                                        (unsigned long)PRIV(vms_linkage_index));
2374                                 PRIV(vms_linkage_index) += 2;
2375                                 _bfd_vms_output_counted (abfd,
2376                                                           _bfd_vms_length_hash_symbol (abfd, sym->name, EOBJ_S_C_SYMSIZ));
2377                                 _bfd_vms_output_byte (abfd, 0);
2378                                 _bfd_vms_output_flush (abfd);
2379                               }
2380                               break;
2381
2382                             case ALPHA_R_CODEADDR:
2383                               {
2384                                 if (_bfd_vms_output_check (abfd,
2385                                                             strlen((char *)sym->name))
2386                                     < 0)
2387                                   {
2388                                     end_etir_record (abfd);
2389                                     start_etir_record (abfd,
2390                                                        section->index,
2391                                                        vaddr, false);
2392                                   }
2393                                 _bfd_vms_output_begin (abfd,
2394                                                         ETIR_S_C_STO_CA,
2395                                                         -1);
2396                                 _bfd_vms_output_counted (abfd,
2397                                                           _bfd_vms_length_hash_symbol (abfd, sym->name, EOBJ_S_C_SYMSIZ));
2398                                 _bfd_vms_output_flush (abfd);
2399                               }
2400                               break;
2401
2402                             default:
2403                               (*_bfd_error_handler) (_("Unhandled relocation %s"),
2404                                                      (*rptr)->howto->name);
2405                               break;
2406                             }
2407
2408                           vaddr += len;
2409
2410                           if (len == sptr->size)
2411                             {
2412                               break;
2413                             }
2414                           else
2415                             {
2416                               sptr->contents += len;
2417                               sptr->offset += len;
2418                               sptr->size -= len;
2419                               i--;
2420                               rptr++;
2421                             }
2422                         }
2423                       else                                      /* sptr starts after reloc */
2424                         {
2425                           i--;                          /* check next reloc */
2426                           rptr++;
2427                         }
2428
2429                       if (i==0)                         /* all reloc checked */
2430                         {
2431                           if (sptr->size > 0)
2432                             {
2433                               sto_imm (abfd, sptr, vaddr, section->index);      /* dump rest */
2434                               vaddr += sptr->size;
2435                             }
2436                           break;
2437                         }
2438                     } /* for (;;) */
2439                 } /* if SEC_RELOC */
2440               else                                              /* no relocs, just dump */
2441                 {
2442                   sto_imm (abfd, sptr, vaddr, section->index);
2443                   vaddr += sptr->size;
2444                 }
2445
2446               sptr = sptr->next;
2447
2448             } /* while (sptr != 0) */
2449
2450           end_etir_record (abfd);
2451
2452         } /* has_contents */
2453
2454       section = section->next;
2455     }
2456
2457   _bfd_vms_output_alignment(abfd, 2);
2458   return 0;
2459 }
2460
2461
2462 /* write traceback data for bfd abfd  */
2463
2464 int
2465 _bfd_vms_write_tbt (abfd, objtype)
2466      bfd *abfd;
2467      int objtype;
2468 {
2469 #if VMS_DEBUG
2470   _bfd_vms_debug (2, "vms_write_tbt (%p, %d)\n", abfd, objtype);
2471 #endif
2472
2473   return 0;
2474 }
2475
2476
2477 /* write debug info for bfd abfd  */
2478
2479 int
2480 _bfd_vms_write_dbg (abfd, objtype)
2481      bfd *abfd;
2482      int objtype;
2483 {
2484 #if VMS_DEBUG
2485   _bfd_vms_debug (2, "vms_write_dbg (%p, objtype)\n", abfd, objtype);
2486 #endif
2487
2488   return 0;
2489 }