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