OSDN Git Service

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