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