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