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