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