bfd/vms-tir.c

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