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