1/* BFD back-end for VMS archive files.
2
3   Copyright (C) 2010-2020 Free Software Foundation, Inc.
4   Written by Tristan Gingold <gingold@adacore.com>, AdaCore.
5
6   This file is part of BFD, the Binary File Descriptor library.
7
8   This program is free software; you can redistribute it and/or modify
9   it under the terms of the GNU General Public License as published by
10   the Free Software Foundation; either version 3 of the License, or
11   (at your option) any later version.
12
13   This program is distributed in the hope that it will be useful,
14   but WITHOUT ANY WARRANTY; without even the implied warranty of
15   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16   GNU General Public License for more details.
17
18   You should have received a copy of the GNU General Public License
19   along with this program; if not, write to the Free Software
20   Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston,
21   MA 02110-1301, USA.  */
22
23#include "sysdep.h"
24#include "bfd.h"
25#include "libbfd.h"
26#include "safe-ctype.h"
27#include "bfdver.h"
28#include "libiberty.h"
29#include "vms.h"
30#include "vms/lbr.h"
31#include "vms/dcx.h"
32
33/* The standard VMS disk block size.  */
34#ifndef VMS_BLOCK_SIZE
35#define VMS_BLOCK_SIZE 512
36#endif
37
38/* Maximum key length (which is also the maximum symbol length in archive).  */
39#define MAX_KEYLEN 128
40#define MAX_EKEYLEN 1024
41
42/* DCX Submaps.  */
43
44struct dcxsbm_desc
45{
46  unsigned char min_char;
47  unsigned char max_char;
48  unsigned char *flags;
49  unsigned char *nodes;
50  unsigned short *next;
51};
52
53/* Kind of library.  Used to filter in archive_p.  */
54
55enum vms_lib_kind
56  {
57    vms_lib_vax,
58    vms_lib_alpha,
59    vms_lib_ia64,
60    vms_lib_txt
61  };
62
63/* Back-end private data.  */
64
65struct lib_tdata
66{
67  /* Standard tdata for an archive.  But we don't use many fields.  */
68  struct artdata artdata;
69
70  /* Major version.  */
71  unsigned char ver;
72
73  /* Type of the archive.  */
74  unsigned char type;
75
76  /* Kind of archive.  Summary of its type.  */
77  enum vms_lib_kind kind;
78
79  /* Total size of the mhd (element header).  */
80  unsigned int mhd_size;
81
82  /* Creation date.  */
83  unsigned int credat_lo;
84  unsigned int credat_hi;
85
86  /* Vector of modules (archive elements), already sorted.  */
87  unsigned int nbr_modules;
88  struct carsym *modules;
89  bfd **cache;
90
91  /* DCX (decompression) data.  */
92  unsigned int nbr_dcxsbm;
93  struct dcxsbm_desc *dcxsbm;
94};
95
96#define bfd_libdata(bfd) ((struct lib_tdata *)((bfd)->tdata.any))
97
98/* End-Of-Text pattern.  This is a special record to mark the end of file.  */
99
100static const unsigned char eotdesc[] = { 0x03, 0x00, 0x77, 0x00, 0x77, 0x00 };
101
102/* Describe the current state of carsym entries while building the archive
103   table of content.  Things are simple with Alpha archives as the number
104   of entries is known, but with IA64 archives a entry can make a reference
105   to severals members.  Therefore we must be able to extend the table on the
106   fly, but it should be allocated on the bfd - which doesn't support realloc.
107   To reduce the overhead, the table is initially allocated in the BFD's
108   objalloc and extended if necessary on the heap.  In the later case, it
109   is finally copied to the BFD's objalloc so that it will automatically be
110   freed.  */
111
112struct carsym_mem
113{
114  /* The table of content.  */
115  struct carsym *idx;
116
117  /* Number of entries used in the table.  */
118  unsigned int nbr;
119
120  /* Maximum number of entries.  */
121  unsigned int max;
122
123  /* If true, the table was reallocated on the heap.  If false, it is still
124     in the BFD's objalloc.  */
125  bfd_boolean realloced;
126};
127
128/* Simply add a name to the index.  */
129
130static bfd_boolean
131vms_add_index (struct carsym_mem *cs, char *name,
132	       unsigned int idx_vbn, unsigned int idx_off)
133{
134  if (cs->nbr == cs->max)
135    {
136      struct carsym *n;
137
138      cs->max = 2 * cs->max + 32;
139
140      if (!cs->realloced)
141	{
142	  n = bfd_malloc2 (cs->max, sizeof (struct carsym));
143	  if (n == NULL)
144	    return FALSE;
145	  memcpy (n, cs->idx, cs->nbr * sizeof (struct carsym));
146	  /* And unfortunately we can't free cs->idx.  */
147	}
148      else
149	{
150	  n = bfd_realloc_or_free (cs->idx, cs->nbr * sizeof (struct carsym));
151	  if (n == NULL)
152	    return FALSE;
153	}
154      cs->idx = n;
155      cs->realloced = TRUE;
156    }
157  cs->idx[cs->nbr].file_offset = (idx_vbn - 1) * VMS_BLOCK_SIZE + idx_off;
158  cs->idx[cs->nbr].name = name;
159  cs->nbr++;
160  return TRUE;
161}
162
163/* Follow all member of a lns list (pointed by RFA) and add indexes for
164   NAME.  Return FALSE in case of error.  */
165
166static bfd_boolean
167vms_add_indexes_from_list (bfd *abfd, struct carsym_mem *cs, char *name,
168			   struct vms_rfa *rfa)
169{
170  struct vms_lns lns;
171  unsigned int vbn;
172  file_ptr off;
173
174  while (1)
175    {
176      vbn = bfd_getl32 (rfa->vbn);
177      if (vbn == 0)
178	return TRUE;
179
180      /* Read the LHS.  */
181      off = (vbn - 1) * VMS_BLOCK_SIZE + bfd_getl16 (rfa->offset);
182      if (bfd_seek (abfd, off, SEEK_SET) != 0
183	  || bfd_bread (&lns, sizeof (lns), abfd) != sizeof (lns))
184	return FALSE;
185
186      if (!vms_add_index (cs, name,
187			  bfd_getl32 (lns.modrfa.vbn),
188			  bfd_getl16 (lns.modrfa.offset)))
189	return FALSE;
190
191      rfa = &lns.nxtrfa;
192    }
193}
194
195/* Read block VBN from ABFD and store it into BLK.  Return FALSE in case of error.  */
196
197static bfd_boolean
198vms_read_block (bfd *abfd, unsigned int vbn, void *blk)
199{
200  file_ptr off;
201
202  off = (vbn - 1) * VMS_BLOCK_SIZE;
203  if (bfd_seek (abfd, off, SEEK_SET) != 0
204      || bfd_bread (blk, VMS_BLOCK_SIZE, abfd) != VMS_BLOCK_SIZE)
205    return FALSE;
206
207  return TRUE;
208}
209
210/* Write the content of BLK to block VBN of ABFD.  Return FALSE in case of error.  */
211
212static bfd_boolean
213vms_write_block (bfd *abfd, unsigned int vbn, void *blk)
214{
215  file_ptr off;
216
217  off = (vbn - 1) * VMS_BLOCK_SIZE;
218  if (bfd_seek (abfd, off, SEEK_SET) != 0
219      || bfd_bwrite (blk, VMS_BLOCK_SIZE, abfd) != VMS_BLOCK_SIZE)
220    return FALSE;
221
222  return TRUE;
223}
224
225/* Read index block VBN and put the entry in **IDX (which is updated).
226   If the entry is indirect, recurse.  */
227
228static bfd_boolean
229vms_traverse_index (bfd *abfd, unsigned int vbn, struct carsym_mem *cs)
230{
231  struct vms_indexdef indexdef;
232  file_ptr off;
233  unsigned char *p;
234  unsigned char *endp;
235
236  /* Read the index block.  */
237  BFD_ASSERT (sizeof (indexdef) == VMS_BLOCK_SIZE);
238  if (!vms_read_block (abfd, vbn, &indexdef))
239    return FALSE;
240
241  /* Traverse it.  */
242  p = &indexdef.keys[0];
243  endp = p + bfd_getl16 (indexdef.used);
244  while (p < endp)
245    {
246      unsigned int idx_vbn;
247      unsigned int idx_off;
248      unsigned int keylen;
249      unsigned char *keyname;
250      unsigned int flags;
251
252      /* Extract key length.  */
253      if (bfd_libdata (abfd)->ver == LBR_MAJORID)
254	{
255	  struct vms_idx *ridx = (struct vms_idx *)p;
256
257	  idx_vbn = bfd_getl32 (ridx->rfa.vbn);
258	  idx_off = bfd_getl16 (ridx->rfa.offset);
259
260	  keylen = ridx->keylen;
261	  flags = 0;
262	  keyname = ridx->keyname;
263	}
264      else if (bfd_libdata (abfd)->ver == LBR_ELFMAJORID)
265	{
266	  struct vms_elfidx *ridx = (struct vms_elfidx *)p;
267
268	  idx_vbn = bfd_getl32 (ridx->rfa.vbn);
269	  idx_off = bfd_getl16 (ridx->rfa.offset);
270
271	  keylen = bfd_getl16 (ridx->keylen);
272	  flags = ridx->flags;
273	  keyname = ridx->keyname;
274	}
275      else
276	return FALSE;
277
278      /* Illegal value.  */
279      if (idx_vbn == 0)
280	return FALSE;
281
282      /* Point to the next index entry.  */
283      p = keyname + keylen;
284
285      if (idx_off == RFADEF__C_INDEX)
286	{
287	  /* Indirect entry.  Recurse.  */
288	  if (!vms_traverse_index (abfd, idx_vbn, cs))
289	    return FALSE;
290	}
291      else
292	{
293	  /* Add a new entry.  */
294	  char *name;
295
296	  if (flags & ELFIDX__SYMESC)
297	    {
298	      /* Extended key name.  */
299	      unsigned int noff = 0;
300	      unsigned int koff;
301	      unsigned int kvbn;
302	      struct vms_kbn *kbn;
303	      unsigned char kblk[VMS_BLOCK_SIZE];
304
305	      /* Sanity check.  */
306	      if (keylen != sizeof (struct vms_kbn))
307		return FALSE;
308
309	      kbn = (struct vms_kbn *)keyname;
310	      keylen = bfd_getl16 (kbn->keylen);
311
312	      name = bfd_alloc (abfd, keylen + 1);
313	      if (name == NULL)
314		return FALSE;
315	      kvbn = bfd_getl32 (kbn->rfa.vbn);
316	      koff = bfd_getl16 (kbn->rfa.offset);
317
318	      /* Read the key, chunk by chunk.  */
319	      do
320		{
321		  unsigned int klen;
322
323		  if (!vms_read_block (abfd, kvbn, kblk))
324		    return FALSE;
325		  kbn = (struct vms_kbn *)(kblk + koff);
326		  klen = bfd_getl16 (kbn->keylen);
327		  kvbn = bfd_getl32 (kbn->rfa.vbn);
328		  koff = bfd_getl16 (kbn->rfa.offset);
329
330		  memcpy (name + noff, kbn + 1, klen);
331		  noff += klen;
332		}
333	      while (kvbn != 0);
334
335	      /* Sanity check.  */
336	      if (noff != keylen)
337		return FALSE;
338	    }
339	  else
340	    {
341	      /* Usual key name.  */
342	      name = bfd_alloc (abfd, keylen + 1);
343	      if (name == NULL)
344		return FALSE;
345
346	      memcpy (name, keyname, keylen);
347	    }
348	  name[keylen] = 0;
349
350	  if (flags & ELFIDX__LISTRFA)
351	    {
352	      struct vms_lhs lhs;
353
354	      /* Read the LHS.  */
355	      off = (idx_vbn - 1) * VMS_BLOCK_SIZE + idx_off;
356	      if (bfd_seek (abfd, off, SEEK_SET) != 0
357		  || bfd_bread (&lhs, sizeof (lhs), abfd) != sizeof (lhs))
358		return FALSE;
359
360	      /* FIXME: this adds extra entries that were not accounted.  */
361	      if (!vms_add_indexes_from_list (abfd, cs, name, &lhs.ng_g_rfa))
362		return FALSE;
363	      if (!vms_add_indexes_from_list (abfd, cs, name, &lhs.ng_wk_rfa))
364		return FALSE;
365	      if (!vms_add_indexes_from_list (abfd, cs, name, &lhs.g_g_rfa))
366		return FALSE;
367	      if (!vms_add_indexes_from_list (abfd, cs, name, &lhs.g_wk_rfa))
368		return FALSE;
369	    }
370	  else
371	    {
372	      if (!vms_add_index (cs, name, idx_vbn, idx_off))
373		return FALSE;
374	    }
375	}
376    }
377
378  return TRUE;
379}
380
381/* Read index #IDX, which must have NBREL entries.  */
382
383static struct carsym *
384vms_lib_read_index (bfd *abfd, int idx, unsigned int *nbrel)
385{
386  struct vms_idd idd;
387  unsigned int flags;
388  unsigned int vbn;
389  struct carsym *csbuf;
390  struct carsym_mem csm;
391
392  /* Read index desription.  */
393  if (bfd_seek (abfd, LHD_IDXDESC + idx * IDD_LENGTH, SEEK_SET) != 0
394      || bfd_bread (&idd, sizeof (idd), abfd) != sizeof (idd))
395    return NULL;
396
397  /* Sanity checks.  */
398  flags = bfd_getl16 (idd.flags);
399  if (!(flags & IDD__FLAGS_ASCII)
400      || !(flags & IDD__FLAGS_VARLENIDX))
401    return NULL;
402
403  csbuf = bfd_alloc (abfd, *nbrel * sizeof (struct carsym));
404  if (csbuf == NULL)
405    return NULL;
406
407  csm.max = *nbrel;
408  csm.nbr = 0;
409  csm.realloced = FALSE;
410  csm.idx = csbuf;
411
412  /* Note: if the index is empty, there is no block to traverse.  */
413  vbn = bfd_getl32 (idd.vbn);
414  if (vbn != 0 && !vms_traverse_index (abfd, vbn, &csm))
415    {
416      if (csm.realloced && csm.idx != NULL)
417	free (csm.idx);
418
419      /* Note: in case of error, we can free what was allocated on the
420	 BFD's objalloc.  */
421      bfd_release (abfd, csbuf);
422      return NULL;
423    }
424
425  if (csm.realloced)
426    {
427      /* There are more entries than the first estimate.  Allocate on
428	 the BFD's objalloc.  */
429      csbuf = bfd_alloc (abfd, csm.nbr * sizeof (struct carsym));
430      if (csbuf == NULL)
431	return NULL;
432      memcpy (csbuf, csm.idx, csm.nbr * sizeof (struct carsym));
433      free (csm.idx);
434      *nbrel = csm.nbr;
435    }
436  return csbuf;
437}
438
439/* Standard function.  */
440
441static const bfd_target *
442_bfd_vms_lib_archive_p (bfd *abfd, enum vms_lib_kind kind)
443{
444  struct vms_lhd lhd;
445  unsigned int sanity;
446  unsigned int majorid;
447  struct lib_tdata *tdata_hold;
448  struct lib_tdata *tdata;
449  unsigned int dcxvbn;
450  unsigned int nbr_ent;
451
452  /* Read header.  */
453  if (bfd_bread (&lhd, sizeof (lhd), abfd) != sizeof (lhd))
454    {
455      if (bfd_get_error () != bfd_error_system_call)
456	bfd_set_error (bfd_error_wrong_format);
457      return NULL;
458    }
459
460  /* Check sanity (= magic) number.  */
461  sanity = bfd_getl32 (lhd.sanity);
462  if (!(sanity == LHD_SANEID3
463	|| sanity == LHD_SANEID6
464	|| sanity == LHD_SANEID_DCX))
465    {
466      bfd_set_error (bfd_error_wrong_format);
467      return NULL;
468    }
469  majorid = bfd_getl32 (lhd.majorid);
470
471  /* Check archive kind.  */
472  switch (kind)
473    {
474    case vms_lib_alpha:
475      if ((lhd.type != LBR__C_TYP_EOBJ && lhd.type != LBR__C_TYP_ESHSTB)
476	  || majorid != LBR_MAJORID
477	  || lhd.nindex != 2)
478	{
479	  bfd_set_error (bfd_error_wrong_format);
480	  return NULL;
481	}
482      break;
483    case vms_lib_ia64:
484      if ((lhd.type != LBR__C_TYP_IOBJ && lhd.type != LBR__C_TYP_ISHSTB)
485	  || majorid != LBR_ELFMAJORID
486	  || lhd.nindex != 2)
487	{
488	  bfd_set_error (bfd_error_wrong_format);
489	  return NULL;
490	}
491      break;
492    case vms_lib_txt:
493      if ((lhd.type != LBR__C_TYP_TXT
494	   && lhd.type != LBR__C_TYP_MLB
495	   && lhd.type != LBR__C_TYP_HLP)
496	  || majorid != LBR_MAJORID
497	  || lhd.nindex != 1)
498	{
499	  bfd_set_error (bfd_error_wrong_format);
500	  return NULL;
501	}
502      break;
503    default:
504      abort ();
505    }
506
507  /* Allocate and initialize private data.  */
508  tdata_hold = bfd_libdata (abfd);
509  tdata = (struct lib_tdata *) bfd_zalloc (abfd, sizeof (struct lib_tdata));
510  if (tdata == NULL)
511    return NULL;
512  abfd->tdata.any = (void *)tdata;
513  tdata->ver = majorid;
514  tdata->mhd_size = MHD__C_USRDAT + lhd.mhdusz;
515  tdata->type = lhd.type;
516  tdata->kind = kind;
517  tdata->credat_lo = bfd_getl32 (lhd.credat + 0);
518  tdata->credat_hi = bfd_getl32 (lhd.credat + 4);
519
520  /* Read indexes.  */
521  tdata->nbr_modules = bfd_getl32 (lhd.modcnt);
522  tdata->artdata.symdef_count = bfd_getl32 (lhd.idxcnt) - tdata->nbr_modules;
523  nbr_ent = tdata->nbr_modules;
524  tdata->modules = vms_lib_read_index (abfd, 0, &nbr_ent);
525  if (tdata->modules == NULL || nbr_ent != tdata->nbr_modules)
526    goto err;
527  if (lhd.nindex == 2)
528    {
529      nbr_ent = tdata->artdata.symdef_count;
530      tdata->artdata.symdefs = vms_lib_read_index (abfd, 1, &nbr_ent);
531      if (tdata->artdata.symdefs == NULL)
532	goto err;
533      /* Only IA64 archives may have more entries in the index that what
534	 was declared.  */
535      if (nbr_ent != tdata->artdata.symdef_count
536	  && kind != vms_lib_ia64)
537	goto err;
538      tdata->artdata.symdef_count = nbr_ent;
539    }
540  tdata->cache = bfd_zalloc (abfd, sizeof (bfd *) * tdata->nbr_modules);
541  if (tdata->cache == NULL)
542    goto err;
543
544  /* Read DCX submaps.  */
545  dcxvbn = bfd_getl32 (lhd.dcxmapvbn);
546  if (dcxvbn != 0)
547    {
548      unsigned char buf_reclen[4];
549      unsigned int reclen;
550      unsigned char *buf;
551      struct vms_dcxmap *map;
552      unsigned int sbm_off;
553      unsigned int i;
554
555      if (bfd_seek (abfd, (dcxvbn - 1) * VMS_BLOCK_SIZE, SEEK_SET) != 0
556	  || bfd_bread (buf_reclen, sizeof (buf_reclen), abfd)
557	  != sizeof (buf_reclen))
558	goto err;
559      reclen = bfd_getl32 (buf_reclen);
560      buf = bfd_malloc (reclen);
561      if (buf == NULL)
562	goto err;
563      if (bfd_bread (buf, reclen, abfd) != reclen)
564	{
565	  free (buf);
566	  goto err;
567	}
568      map = (struct vms_dcxmap *)buf;
569      tdata->nbr_dcxsbm = bfd_getl16 (map->nsubs);
570      sbm_off = bfd_getl16 (map->sub0);
571      tdata->dcxsbm = (struct dcxsbm_desc *)bfd_alloc
572	(abfd, tdata->nbr_dcxsbm * sizeof (struct dcxsbm_desc));
573      for (i = 0; i < tdata->nbr_dcxsbm; i++)
574	{
575	  struct vms_dcxsbm *sbm = (struct vms_dcxsbm *) (buf + sbm_off);
576	  struct dcxsbm_desc *sbmdesc = &tdata->dcxsbm[i];
577	  unsigned int sbm_len;
578	  unsigned int sbm_sz;
579	  unsigned int off;
580	  unsigned char *data = (unsigned char *)sbm;
581	  unsigned char *buf1;
582	  unsigned int l, j;
583
584	  sbm_sz = bfd_getl16 (sbm->size);
585	  sbm_off += sbm_sz;
586	  BFD_ASSERT (sbm_off <= reclen);
587
588	  sbmdesc->min_char = sbm->min_char;
589	  BFD_ASSERT (sbmdesc->min_char == 0);
590	  sbmdesc->max_char = sbm->max_char;
591	  sbm_len = sbmdesc->max_char - sbmdesc->min_char + 1;
592	  l = (2 * sbm_len + 7) / 8;
593	  BFD_ASSERT
594	    (sbm_sz >= sizeof (struct vms_dcxsbm) + l + 3 * sbm_len
595	     || (tdata->nbr_dcxsbm == 1
596		 && sbm_sz >= sizeof (struct vms_dcxsbm) + l + sbm_len));
597	  sbmdesc->flags = (unsigned char *)bfd_alloc (abfd, l);
598	  memcpy (sbmdesc->flags, data + bfd_getl16 (sbm->flags), l);
599	  sbmdesc->nodes = (unsigned char *)bfd_alloc (abfd, 2 * sbm_len);
600	  memcpy (sbmdesc->nodes, data + bfd_getl16 (sbm->nodes), 2 * sbm_len);
601	  off = bfd_getl16 (sbm->next);
602	  if (off != 0)
603	    {
604	      /* Read the 'next' array.  */
605	      sbmdesc->next = (unsigned short *)bfd_alloc
606		(abfd, sbm_len * sizeof (unsigned short));
607	      buf1 = data + off;
608	      for (j = 0; j < sbm_len; j++)
609		sbmdesc->next[j] = bfd_getl16 (buf1 + j * 2);
610	    }
611	  else
612	    {
613	      /* There is no next array if there is only one submap.  */
614	      BFD_ASSERT (tdata->nbr_dcxsbm == 1);
615	      sbmdesc->next = NULL;
616	    }
617	}
618      free (buf);
619    }
620  else
621    {
622      tdata->nbr_dcxsbm = 0;
623    }
624
625  /* The map is always present.  Also mark shared image library.  */
626  abfd->has_armap = TRUE;
627  if (tdata->type == LBR__C_TYP_ESHSTB || tdata->type == LBR__C_TYP_ISHSTB)
628    abfd->is_thin_archive = TRUE;
629
630  return abfd->xvec;
631
632 err:
633  bfd_release (abfd, tdata);
634  abfd->tdata.any = (void *)tdata_hold;
635  return NULL;
636}
637
638/* Standard function for alpha libraries.  */
639
640const bfd_target *
641_bfd_vms_lib_alpha_archive_p (bfd *abfd)
642{
643  return _bfd_vms_lib_archive_p (abfd, vms_lib_alpha);
644}
645
646/* Standard function for ia64 libraries.  */
647
648const bfd_target *
649_bfd_vms_lib_ia64_archive_p (bfd *abfd)
650{
651  return _bfd_vms_lib_archive_p (abfd, vms_lib_ia64);
652}
653
654/* Standard function for text libraries.  */
655
656static const bfd_target *
657_bfd_vms_lib_txt_archive_p (bfd *abfd)
658{
659  return _bfd_vms_lib_archive_p (abfd, vms_lib_txt);
660}
661
662/* Standard bfd function.  */
663
664static bfd_boolean
665_bfd_vms_lib_mkarchive (bfd *abfd, enum vms_lib_kind kind)
666{
667  struct lib_tdata *tdata;
668
669  tdata = (struct lib_tdata *) bfd_zalloc (abfd, sizeof (struct lib_tdata));
670  if (tdata == NULL)
671    return FALSE;
672
673  abfd->tdata.any = (void *)tdata;
674  vms_get_time (&tdata->credat_hi, &tdata->credat_lo);
675
676  tdata->kind = kind;
677  switch (kind)
678    {
679    case vms_lib_alpha:
680      tdata->ver = LBR_MAJORID;
681      tdata->mhd_size = offsetof (struct vms_mhd, pad1);
682      tdata->type = LBR__C_TYP_EOBJ;
683      break;
684    case vms_lib_ia64:
685      tdata->ver = LBR_ELFMAJORID;
686      tdata->mhd_size = sizeof (struct vms_mhd);
687      tdata->type = LBR__C_TYP_IOBJ;
688      break;
689    default:
690      abort ();
691    }
692
693  tdata->nbr_modules = 0;
694  tdata->artdata.symdef_count = 0;
695  tdata->modules = NULL;
696  tdata->artdata.symdefs = NULL;
697  tdata->cache = NULL;
698
699  return TRUE;
700}
701
702bfd_boolean
703_bfd_vms_lib_alpha_mkarchive (bfd *abfd)
704{
705  return _bfd_vms_lib_mkarchive (abfd, vms_lib_alpha);
706}
707
708bfd_boolean
709_bfd_vms_lib_ia64_mkarchive (bfd *abfd)
710{
711  return _bfd_vms_lib_mkarchive (abfd, vms_lib_ia64);
712}
713
714/* Find NAME in the symbol index.  Return the index.  */
715
716symindex
717_bfd_vms_lib_find_symbol (bfd *abfd, const char *name)
718{
719  struct lib_tdata *tdata = bfd_libdata (abfd);
720  carsym *syms = tdata->artdata.symdefs;
721  int lo, hi;
722
723  /* Open-coded binary search for speed.  */
724  lo = 0;
725  hi = tdata->artdata.symdef_count - 1;
726
727  while (lo <= hi)
728    {
729      int mid = lo + (hi - lo) / 2;
730      int diff;
731
732      diff = (char)(name[0] - syms[mid].name[0]);
733      if (diff == 0)
734	diff = strcmp (name, syms[mid].name);
735      if (diff == 0)
736	return mid;
737      else if (diff < 0)
738	hi = mid - 1;
739      else
740	lo = mid + 1;
741    }
742  return BFD_NO_MORE_SYMBOLS;
743}
744
745/* IO vector for archive member.  Need that because members are not linearly
746   stored in archives.  */
747
748struct vms_lib_iovec
749{
750  /* Current offset.  */
751  ufile_ptr where;
752
753  /* Length of the module, when known.  */
754  ufile_ptr file_len;
755
756  /* Current position in the record from bfd_bread point of view (ie, after
757     decompression).  0 means that no data byte have been read, -2 and -1
758     are reserved for the length word.  */
759  int rec_pos;
760#define REC_POS_NL   -4
761#define REC_POS_PAD  -3
762#define REC_POS_LEN0 -2
763#define REC_POS_LEN1 -1
764
765  /* Record length.  */
766  unsigned short rec_len;
767  /* Number of bytes to read in the current record.  */
768  unsigned short rec_rem;
769  /* Offset of the next block.  */
770  file_ptr next_block;
771  /* Current *data* offset in the data block.  */
772  unsigned short blk_off;
773
774  /* Offset of the first block.  Extracted from the index.  */
775  file_ptr first_block;
776
777  /* Initial next_block.  Extracted when the MHD is read.  */
778  file_ptr init_next_block;
779  /* Initial blk_off, once the MHD is read.  */
780  unsigned short init_blk_off;
781
782  /* Used to store any 3 byte record, which could be the EOF pattern.  */
783  unsigned char pattern[4];
784
785  /* DCX.  */
786  struct dcxsbm_desc *dcxsbms;
787  /* Current submap.  */
788  struct dcxsbm_desc *dcx_sbm;
789  /* Current offset in the submap.  */
790  unsigned int dcx_offset;
791  int dcx_pos;
792
793  /* Compressed buffer.  */
794  unsigned char *dcx_buf;
795  /* Size of the buffer.  Used to resize.  */
796  unsigned int dcx_max;
797  /* Number of valid bytes in the buffer.  */
798  unsigned int dcx_rlen;
799};
800
801/* Return the current position.  */
802
803static file_ptr
804vms_lib_btell (struct bfd *abfd)
805{
806  struct vms_lib_iovec *vec = (struct vms_lib_iovec *) abfd->iostream;
807  return vec->where;
808}
809
810/* Read the header of the next data block if all bytes of the current block
811   have been read.  */
812
813static bfd_boolean
814vms_lib_read_block (struct bfd *abfd)
815{
816  struct vms_lib_iovec *vec = (struct vms_lib_iovec *) abfd->iostream;
817
818  if (vec->blk_off == DATA__LENGTH)
819    {
820      unsigned char hdr[DATA__DATA];
821
822      /* Read next block.  */
823      if (bfd_seek (abfd->my_archive, vec->next_block, SEEK_SET) != 0)
824	return FALSE;
825      if (bfd_bread (hdr, sizeof (hdr), abfd->my_archive) != sizeof (hdr))
826	return FALSE;
827      vec->next_block = (bfd_getl32 (hdr + 2) - 1) * VMS_BLOCK_SIZE;
828      vec->blk_off = sizeof (hdr);
829    }
830  return TRUE;
831}
832
833/* Read NBYTES from ABFD into BUF if not NULL.  If BUF is NULL, bytes are
834   not stored.  Read linearly from the library, but handle blocks.  This
835   function does not handle records nor EOF.  */
836
837static file_ptr
838vms_lib_bread_raw (struct bfd *abfd, unsigned char *buf, file_ptr nbytes)
839{
840  struct vms_lib_iovec *vec = (struct vms_lib_iovec *) abfd->iostream;
841  file_ptr res;
842
843  res = 0;
844  while (nbytes > 0)
845    {
846      unsigned int l;
847
848      /* Be sure the current data block is read.  */
849      if (!vms_lib_read_block (abfd))
850	return -1;
851
852      /* Do not read past the data block, do not read more than requested.  */
853      l = DATA__LENGTH - vec->blk_off;
854      if (l > nbytes)
855	l = nbytes;
856      if (l == 0)
857	return 0;
858      if (buf != NULL)
859	{
860	  /* Really read into BUF.  */
861	  if (bfd_bread (buf, l, abfd->my_archive) != l)
862	    return -1;
863	}
864      else
865	{
866	  /* Make as if we are reading.  */
867	  if (bfd_seek (abfd->my_archive, l, SEEK_CUR) != 0)
868	    return -1;
869	}
870
871      if (buf != NULL)
872	buf += l;
873      vec->blk_off += l;
874      nbytes -= l;
875      res += l;
876    }
877  return res;
878}
879
880/* Decompress NBYTES from VEC.  Store the bytes into BUF if not NULL.  */
881
882static file_ptr
883vms_lib_dcx (struct vms_lib_iovec *vec, unsigned char *buf, file_ptr nbytes)
884{
885  struct dcxsbm_desc *sbm;
886  unsigned int i;
887  unsigned int offset;
888  unsigned int j;
889  file_ptr res = 0;
890
891  /* The loop below expect to deliver at least one byte.  */
892  if (nbytes == 0)
893    return 0;
894
895  /* Get the current state.  */
896  sbm = vec->dcx_sbm;
897  offset = vec->dcx_offset;
898  j = vec->dcx_pos & 7;
899
900  for (i = vec->dcx_pos >> 3; i < vec->dcx_rlen; i++)
901    {
902      unsigned char b = vec->dcx_buf[i];
903
904      for (; j < 8; j++)
905	{
906	  if (b & (1 << j))
907	    offset++;
908	  if (!(sbm->flags[offset >> 3] & (1 << (offset & 7))))
909	    {
910	      unsigned int n_offset = sbm->nodes[offset];
911	      if (n_offset == 0)
912		{
913		  /* End of buffer.  Stay where we are.  */
914		  vec->dcx_pos = (i << 3) + j;
915		  if (b & (1 << j))
916		    offset--;
917		  vec->dcx_offset = offset;
918		  vec->dcx_sbm = sbm;
919		  return res;
920		}
921	      offset = 2 * n_offset;
922	    }
923	  else
924	    {
925	      unsigned char v = sbm->nodes[offset];
926
927	      if (sbm->next != NULL)
928		sbm = vec->dcxsbms + sbm->next[v];
929	      offset = 0;
930	      res++;
931
932	      if (buf)
933		{
934		  *buf++ = v;
935		  nbytes--;
936
937		  if (nbytes == 0)
938		    {
939		      vec->dcx_pos = (i << 3) + j + 1;
940		      vec->dcx_offset = offset;
941		      vec->dcx_sbm = sbm;
942
943		      return res;
944		    }
945		}
946	    }
947	}
948      j = 0;
949    }
950  return -1;
951}
952
953/* Standard IOVEC function.  */
954
955static file_ptr
956vms_lib_bread (struct bfd *abfd, void *vbuf, file_ptr nbytes)
957{
958  struct vms_lib_iovec *vec = (struct vms_lib_iovec *) abfd->iostream;
959  file_ptr res;
960  file_ptr chunk;
961  unsigned char *buf = (unsigned char *)vbuf;
962
963  /* Do not read past the end.  */
964  if (vec->where >= vec->file_len)
965    return 0;
966
967  res = 0;
968  while (nbytes > 0)
969    {
970      if (vec->rec_rem == 0)
971	{
972	  unsigned char blen[2];
973
974	  /* Read record length.  */
975	  if (vms_lib_bread_raw (abfd, blen, sizeof (blen)) != sizeof (blen))
976	    return -1;
977	  vec->rec_len = bfd_getl16 (blen);
978	  if (bfd_libdata (abfd->my_archive)->kind == vms_lib_txt)
979	    {
980	      /* Discard record size and align byte.  */
981	      vec->rec_pos = 0;
982	      vec->rec_rem = vec->rec_len;
983	    }
984	  else
985	    {
986	      /* Prepend record size.  */
987	      vec->rec_pos = REC_POS_LEN0;
988	      vec->rec_rem = (vec->rec_len + 1) & ~1;	/* With align byte.  */
989	    }
990	  if (vec->rec_len == 3)
991	    {
992	      /* Possibly end of file.  Check the pattern.  */
993	      if (vms_lib_bread_raw (abfd, vec->pattern, 4) != 4)
994		return -1;
995	      if (!memcmp (vec->pattern, eotdesc + 2, 3))
996		{
997		  /* This is really an EOF.  */
998		  vec->where += res;
999		  vec->file_len = vec->where;
1000		  return res;
1001		}
1002	    }
1003
1004	  if (vec->dcxsbms != NULL)
1005	    {
1006	      /* This is a compressed member.  */
1007	      unsigned int len;
1008	      file_ptr elen;
1009
1010	      /* Be sure there is enough room for the expansion.  */
1011	      len = (vec->rec_len + 1) & ~1;
1012	      if (len > vec->dcx_max)
1013		{
1014		  while (len > vec->dcx_max)
1015		    vec->dcx_max *= 2;
1016		  vec->dcx_buf = bfd_alloc (abfd, vec->dcx_max);
1017		  if (vec->dcx_buf == NULL)
1018		    return -1;
1019		}
1020
1021	      /* Read the compressed record.  */
1022	      vec->dcx_rlen = len;
1023	      if (vec->rec_len == 3)
1024		{
1025		  /* Already read.  */
1026		  memcpy (vec->dcx_buf, vec->pattern, 3);
1027		}
1028	      else
1029		{
1030		  elen = vms_lib_bread_raw (abfd, vec->dcx_buf, len);
1031		  if (elen != len)
1032		    return -1;
1033		}
1034
1035	      /* Dummy expansion to get the expanded length.  */
1036	      vec->dcx_offset = 0;
1037	      vec->dcx_sbm = vec->dcxsbms;
1038	      vec->dcx_pos = 0;
1039	      elen = vms_lib_dcx (vec, NULL, 0x10000);
1040	      if (elen < 0)
1041		return -1;
1042	      vec->rec_len = elen;
1043	      vec->rec_rem = elen;
1044
1045	      /* Reset the state.  */
1046	      vec->dcx_offset = 0;
1047	      vec->dcx_sbm = vec->dcxsbms;
1048	      vec->dcx_pos = 0;
1049	    }
1050	}
1051      if (vec->rec_pos < 0)
1052	{
1053	  unsigned char c;
1054	  switch (vec->rec_pos)
1055	    {
1056	    case REC_POS_LEN0:
1057	      c = vec->rec_len & 0xff;
1058	      vec->rec_pos = REC_POS_LEN1;
1059	      break;
1060	    case REC_POS_LEN1:
1061	      c = (vec->rec_len >> 8) & 0xff;
1062	      vec->rec_pos = 0;
1063	      break;
1064	    case REC_POS_PAD:
1065	      c = 0;
1066	      vec->rec_rem = 0;
1067	      break;
1068	    case REC_POS_NL:
1069	      c = '\n';
1070	      vec->rec_rem = 0;
1071	      break;
1072	    default:
1073	      abort ();
1074	    }
1075	  if (buf != NULL)
1076	    {
1077	      *buf = c;
1078	      buf++;
1079	    }
1080	  nbytes--;
1081	  res++;
1082	  continue;
1083	}
1084
1085      if (nbytes > vec->rec_rem)
1086	chunk = vec->rec_rem;
1087      else
1088	chunk = nbytes;
1089
1090      if (vec->dcxsbms != NULL)
1091	{
1092	  /* Optimize the stat() case: no need to decompress again as we
1093	     know the length.  */
1094	  if (!(buf == NULL && chunk == vec->rec_rem))
1095	    chunk = vms_lib_dcx (vec, buf, chunk);
1096	}
1097      else
1098	{
1099	  if (vec->rec_len == 3)
1100	    {
1101	      if (buf != NULL)
1102		memcpy (buf, vec->pattern + vec->rec_pos, chunk);
1103	    }
1104	  else
1105	    chunk = vms_lib_bread_raw (abfd, buf, chunk);
1106	}
1107      if (chunk < 0)
1108	return -1;
1109      res += chunk;
1110      if (buf != NULL)
1111	buf += chunk;
1112      nbytes -= chunk;
1113      vec->rec_pos += chunk;
1114      vec->rec_rem -= chunk;
1115
1116      if (vec->rec_rem == 0)
1117	{
1118	  /* End of record reached.  */
1119	  if (bfd_libdata (abfd->my_archive)->kind == vms_lib_txt)
1120	    {
1121	      if ((vec->rec_len & 1) == 1
1122		  && vec->rec_len != 3
1123		  && vec->dcxsbms == NULL)
1124		{
1125		  /* Eat the pad byte.  */
1126		  unsigned char pad;
1127		  if (vms_lib_bread_raw (abfd, &pad, 1) != 1)
1128		    return -1;
1129		}
1130	      vec->rec_pos = REC_POS_NL;
1131	      vec->rec_rem = 1;
1132	    }
1133	  else
1134	    {
1135	      if ((vec->rec_len & 1) == 1 && vec->dcxsbms != NULL)
1136		{
1137		  vec->rec_pos = REC_POS_PAD;
1138		  vec->rec_rem = 1;
1139		}
1140	    }
1141	}
1142    }
1143  vec->where += res;
1144  return res;
1145}
1146
1147/* Standard function, but we currently only handle the rewind case.  */
1148
1149static int
1150vms_lib_bseek (struct bfd *abfd, file_ptr offset, int whence)
1151{
1152  struct vms_lib_iovec *vec = (struct vms_lib_iovec *) abfd->iostream;
1153
1154  if (whence == SEEK_SET && offset == 0)
1155    {
1156      vec->where = 0;
1157      vec->rec_rem = 0;
1158      vec->dcx_pos = -1;
1159      vec->blk_off = vec->init_blk_off;
1160      vec->next_block = vec->init_next_block;
1161
1162      if (bfd_seek (abfd->my_archive, vec->first_block, SEEK_SET) != 0)
1163	return -1;
1164    }
1165  else
1166    abort ();
1167  return 0;
1168}
1169
1170static file_ptr
1171vms_lib_bwrite (struct bfd *abfd ATTRIBUTE_UNUSED,
1172	      const void *where ATTRIBUTE_UNUSED,
1173	      file_ptr nbytes ATTRIBUTE_UNUSED)
1174{
1175  return -1;
1176}
1177
1178static int
1179vms_lib_bclose (struct bfd *abfd)
1180{
1181  abfd->iostream = NULL;
1182  return 0;
1183}
1184
1185static int
1186vms_lib_bflush (struct bfd *abfd ATTRIBUTE_UNUSED)
1187{
1188  return 0;
1189}
1190
1191static int
1192vms_lib_bstat (struct bfd *abfd ATTRIBUTE_UNUSED,
1193	       struct stat *sb ATTRIBUTE_UNUSED)
1194{
1195  /* Not supported.  */
1196  return 0;
1197}
1198
1199static void *
1200vms_lib_bmmap (struct bfd *abfd ATTRIBUTE_UNUSED,
1201	       void *addr ATTRIBUTE_UNUSED,
1202	       bfd_size_type len ATTRIBUTE_UNUSED,
1203	       int prot ATTRIBUTE_UNUSED,
1204	       int flags ATTRIBUTE_UNUSED,
1205	       file_ptr offset ATTRIBUTE_UNUSED,
1206	       void **map_addr ATTRIBUTE_UNUSED,
1207	       bfd_size_type *map_len ATTRIBUTE_UNUSED)
1208{
1209  return (void *) -1;
1210}
1211
1212static const struct bfd_iovec vms_lib_iovec = {
1213  &vms_lib_bread, &vms_lib_bwrite, &vms_lib_btell, &vms_lib_bseek,
1214  &vms_lib_bclose, &vms_lib_bflush, &vms_lib_bstat, &vms_lib_bmmap
1215};
1216
1217/* Open a library module.  FILEPOS is the position of the module header.  */
1218
1219static bfd_boolean
1220vms_lib_bopen (bfd *el, file_ptr filepos)
1221{
1222  struct vms_lib_iovec *vec;
1223  unsigned char buf[256];
1224  struct vms_mhd *mhd;
1225  struct lib_tdata *tdata = bfd_libdata (el->my_archive);
1226  unsigned int len;
1227
1228  /* Allocate and initialized the iovec.  */
1229  vec = bfd_zalloc (el, sizeof (*vec));
1230  if (vec == NULL)
1231    return FALSE;
1232
1233  el->iostream = vec;
1234  el->iovec = &vms_lib_iovec;
1235
1236  /* File length is not known.  */
1237  vec->file_len = -1;
1238
1239  /* Read the first data block.  */
1240  vec->next_block = filepos & ~(VMS_BLOCK_SIZE - 1);
1241  vec->blk_off = DATA__LENGTH;
1242  if (!vms_lib_read_block (el))
1243    return FALSE;
1244
1245  /* Prepare to read the first record.  */
1246  vec->blk_off = filepos & (VMS_BLOCK_SIZE - 1);
1247  vec->rec_rem = 0;
1248  if (bfd_seek (el->my_archive, filepos, SEEK_SET) != 0)
1249    return FALSE;
1250
1251  /* Read Record length + MHD + align byte.  */
1252  len = tdata->mhd_size;
1253  if (vms_lib_bread_raw (el, buf, 2) != 2)
1254    return FALSE;
1255  if (bfd_getl16 (buf) != len)
1256    return FALSE;
1257  len = (len + 1) & ~1;
1258  BFD_ASSERT (len <= sizeof (buf));
1259  if (vms_lib_bread_raw (el, buf, len) != len)
1260    return FALSE;
1261
1262  /* Get info from mhd.  */
1263  mhd = (struct vms_mhd *)buf;
1264  /* Check id.  */
1265  if (mhd->id != MHD__C_MHDID)
1266    return FALSE;
1267  if (len >= MHD__C_MHDLEN + 1)
1268    el->selective_search = (mhd->objstat & MHD__M_SELSRC) ? 1 : 0;
1269  el->mtime = vms_rawtime_to_time_t (mhd->datim);
1270  el->mtime_set = TRUE;
1271
1272  /* Reinit the iovec so that seek() will point to the first record after
1273     the mhd.  */
1274  vec->where = 0;
1275  vec->init_blk_off = vec->blk_off;
1276  vec->init_next_block = vec->next_block;
1277  vec->first_block = bfd_tell (el->my_archive);
1278  vec->dcxsbms = bfd_libdata (el->my_archive)->dcxsbm;
1279
1280  if (vec->dcxsbms != NULL)
1281    {
1282      /* Handle DCX.  */
1283      vec->dcx_max = 10 * 1024;
1284      vec->dcx_buf = bfd_alloc (el, vec->dcx_max);
1285      vec->dcx_pos = -1;
1286      if (vec->dcx_buf == NULL)
1287	return -1;
1288    }
1289  return TRUE;
1290}
1291
1292/* Get member MODIDX.  Return NULL in case of error.  */
1293
1294static bfd *
1295_bfd_vms_lib_get_module (bfd *abfd, unsigned int modidx)
1296{
1297  struct lib_tdata *tdata = bfd_libdata (abfd);
1298  bfd *res;
1299  file_ptr file_off;
1300  const char *name;
1301  char *newname;
1302  size_t namelen;
1303
1304  /* Sanity check.  */
1305  if (modidx >= tdata->nbr_modules)
1306    return NULL;
1307
1308  /* Already loaded.  */
1309  if (tdata->cache[modidx])
1310    return tdata->cache[modidx];
1311
1312  /* Build it.  */
1313  file_off = tdata->modules[modidx].file_offset;
1314  if (tdata->type != LBR__C_TYP_IOBJ)
1315    {
1316      res = _bfd_create_empty_archive_element_shell (abfd);
1317      if (res == NULL)
1318	return NULL;
1319
1320      /* Special reader to deal with data blocks.  */
1321      if (!vms_lib_bopen (res, file_off))
1322	return NULL;
1323    }
1324  else
1325    {
1326      char buf[256];
1327      struct vms_mhd *mhd;
1328      struct areltdata *arelt;
1329
1330      /* Sanity check.  The MHD must be big enough to contain module size.  */
1331      if (tdata->mhd_size < offsetof (struct vms_mhd, modsize) + 4)
1332	return NULL;
1333
1334      /* Read the MHD now.  */
1335      if (bfd_seek (abfd, file_off, SEEK_SET) != 0)
1336	return NULL;
1337      if (bfd_bread (buf, tdata->mhd_size, abfd) != tdata->mhd_size)
1338	return NULL;
1339
1340      mhd = (struct vms_mhd *) buf;
1341      if (mhd->id != MHD__C_MHDID)
1342	return NULL;
1343
1344      res = _bfd_create_empty_archive_element_shell (abfd);
1345      if (res == NULL)
1346	return NULL;
1347      arelt = bfd_zmalloc (sizeof (*arelt));
1348      if (arelt == NULL)
1349	{
1350	  bfd_close (res);
1351	  return NULL;
1352	}
1353      res->arelt_data = arelt;
1354
1355      /* Get info from mhd.  */
1356      if (tdata->mhd_size >= offsetof (struct vms_mhd, objstat) + 1)
1357	res->selective_search = (mhd->objstat & MHD__M_SELSRC) ? 1 : 0;
1358      res->mtime = vms_rawtime_to_time_t (mhd->datim);
1359      res->mtime_set = TRUE;
1360
1361      arelt->parsed_size = bfd_getl32 (mhd->modsize);
1362
1363      /* No need for a special reader as members are stored linearly.
1364	 Just skip the MHD.  */
1365      res->origin = file_off + tdata->mhd_size;
1366    }
1367
1368  /* Set filename.  */
1369  name = tdata->modules[modidx].name;
1370  namelen = strlen (name);
1371  newname = bfd_malloc (namelen + 4 + 1);
1372  if (newname == NULL)
1373    {
1374      bfd_close (res);
1375      return NULL;
1376    }
1377  strcpy (newname, name);
1378  switch (tdata->type)
1379    {
1380    case LBR__C_TYP_IOBJ:
1381    case LBR__C_TYP_EOBJ:
1382      /* For object archives, append .obj to mimic standard behaviour.  */
1383      strcpy (newname + namelen, ".obj");
1384      break;
1385    default:
1386      break;
1387    }
1388  bfd_set_filename (res, newname);
1389
1390  tdata->cache[modidx] = res;
1391
1392  return res;
1393}
1394
1395/* Standard function: get member at IDX.  */
1396
1397bfd *
1398_bfd_vms_lib_get_elt_at_index (bfd *abfd, symindex symidx)
1399{
1400  struct lib_tdata *tdata = bfd_libdata (abfd);
1401  file_ptr file_off;
1402  unsigned int modidx;
1403
1404  /* Check symidx.  */
1405  if (symidx > tdata->artdata.symdef_count)
1406    return NULL;
1407  file_off = tdata->artdata.symdefs[symidx].file_offset;
1408
1409  /* Linear-scan.  */
1410  for (modidx = 0; modidx < tdata->nbr_modules; modidx++)
1411    {
1412      if (tdata->modules[modidx].file_offset == file_off)
1413	break;
1414    }
1415  if (modidx >= tdata->nbr_modules)
1416    return NULL;
1417
1418  return _bfd_vms_lib_get_module (abfd, modidx);
1419}
1420
1421/* Elements of an imagelib are stubs.  You can get the real image with this
1422   function.  */
1423
1424bfd *
1425_bfd_vms_lib_get_imagelib_file (bfd *el)
1426{
1427  bfd *archive = el->my_archive;
1428  const char *modname = el->filename;
1429  int modlen = strlen (modname);
1430  char *filename;
1431  int j;
1432  bfd *res;
1433
1434  /* Convert module name to lower case and append '.exe'.  */
1435  filename = bfd_alloc (el, modlen + 5);
1436  if (filename == NULL)
1437    return NULL;
1438  for (j = 0; j < modlen; j++)
1439    if (ISALPHA (modname[j]))
1440      filename[j] = TOLOWER (modname[j]);
1441    else
1442      filename[j] = modname[j];
1443  memcpy (filename + modlen, ".exe", 5);
1444
1445  filename = _bfd_append_relative_path (archive, filename);
1446  if (filename == NULL)
1447    return NULL;
1448  res = bfd_openr (filename, NULL);
1449
1450  if (res == NULL)
1451    {
1452      /* xgettext:c-format */
1453      _bfd_error_handler(_("could not open shared image '%s' from '%s'"),
1454			 filename, archive->filename);
1455      bfd_release (archive, filename);
1456      return NULL;
1457    }
1458
1459  /* FIXME: put it in a cache ?  */
1460  return res;
1461}
1462
1463/* Standard function.  */
1464
1465bfd *
1466_bfd_vms_lib_openr_next_archived_file (bfd *archive,
1467				       bfd *last_file)
1468{
1469  unsigned int idx;
1470  bfd *res;
1471
1472  if (!last_file)
1473    idx = 0;
1474  else
1475    idx = last_file->proxy_origin + 1;
1476
1477  if (idx >= bfd_libdata (archive)->nbr_modules)
1478    {
1479      bfd_set_error (bfd_error_no_more_archived_files);
1480      return NULL;
1481    }
1482
1483  res = _bfd_vms_lib_get_module (archive, idx);
1484  if (res == NULL)
1485    return res;
1486  res->proxy_origin = idx;
1487  return res;
1488}
1489
1490/* Standard function.  Just compute the length.  */
1491
1492int
1493_bfd_vms_lib_generic_stat_arch_elt (bfd *abfd, struct stat *st)
1494{
1495  struct lib_tdata *tdata;
1496
1497  /* Sanity check.  */
1498  if (abfd->my_archive == NULL)
1499    {
1500      bfd_set_error (bfd_error_invalid_operation);
1501      return -1;
1502    }
1503
1504  tdata = bfd_libdata (abfd->my_archive);
1505  if (tdata->type != LBR__C_TYP_IOBJ)
1506    {
1507      struct vms_lib_iovec *vec = (struct vms_lib_iovec *) abfd->iostream;
1508
1509      if (vec->file_len == (ufile_ptr)-1)
1510	{
1511	  if (vms_lib_bseek (abfd, 0, SEEK_SET) != 0)
1512	    return -1;
1513
1514	  /* Compute length.  */
1515	  while (vms_lib_bread (abfd, NULL, 1 << 20) > 0)
1516	    ;
1517	}
1518      st->st_size = vec->file_len;
1519    }
1520  else
1521    {
1522      st->st_size = ((struct areltdata *)abfd->arelt_data)->parsed_size;
1523    }
1524
1525  if (abfd->mtime_set)
1526    st->st_mtime = abfd->mtime;
1527  else
1528    st->st_mtime = 0;
1529  st->st_uid = 0;
1530  st->st_gid = 0;
1531  st->st_mode = 0644;
1532
1533  return 0;
1534}
1535
1536/* Internal representation of an index entry.  */
1537
1538struct lib_index
1539{
1540  /* Corresponding archive member.  */
1541  bfd *abfd;
1542
1543  /* Number of reference to this entry.  */
1544  unsigned int ref;
1545
1546  /* Length of the key.  */
1547  unsigned short namlen;
1548
1549  /* Key.  */
1550  const char *name;
1551};
1552
1553/* Used to sort index entries.  */
1554
1555static int
1556lib_index_cmp (const void *lv, const void *rv)
1557{
1558  const struct lib_index *l = lv;
1559  const struct lib_index *r = rv;
1560
1561  return strcmp (l->name, r->name);
1562}
1563
1564/* Maximum number of index blocks level.  */
1565
1566#define MAX_LEVEL 10
1567
1568/* Get the size of an index entry.  */
1569
1570static unsigned int
1571get_idxlen (struct lib_index *idx, bfd_boolean is_elfidx)
1572{
1573  if (is_elfidx)
1574    {
1575      /* 9 is the size of struct vms_elfidx without keyname.  */
1576      if (idx->namlen > MAX_KEYLEN)
1577	return 9 + sizeof (struct vms_kbn);
1578      else
1579	return 9 + idx->namlen;
1580    }
1581  else
1582    {
1583      /* 7 is the size of struct vms_idx without keyname.  */
1584      return 7 + idx->namlen;
1585    }
1586}
1587
1588/* Write the index composed by NBR symbols contained in IDX.
1589   VBN is the first vbn to be used, and will contain on return the last vbn.
1590   Can be called with ABFD set to NULL just to size the index.
1591   If not null, TOPVBN will be assigned to the vbn of the root index tree.
1592   IS_ELFIDX is true for elfidx (ie ia64) indexes layout.
1593   Return TRUE on success.  */
1594
1595static bfd_boolean
1596vms_write_index (bfd *abfd,
1597		 struct lib_index *idx, unsigned int nbr, unsigned int *vbn,
1598		 unsigned int *topvbn, bfd_boolean is_elfidx)
1599{
1600  /* The index is organized as a tree.  This function implements a naive
1601     algorithm to balance the tree: it fills the leaves, and create a new
1602     branch when all upper leaves and branches are full.  We only keep in
1603     memory a path to the current leaf.  */
1604  unsigned int i;
1605  int j;
1606  int level;
1607  /* Disk blocks for the current path.  */
1608  struct vms_indexdef *rblk[MAX_LEVEL];
1609  /* Info on the current blocks.  */
1610  struct idxblk
1611  {
1612    unsigned int vbn;		/* VBN of the block.  */
1613    /* The last entry is identified so that it could be copied to the
1614       parent block.  */
1615    unsigned short len;		/* Length up to the last entry.  */
1616    unsigned short lastlen;	/* Length of the last entry.  */
1617  } blk[MAX_LEVEL];
1618
1619  /* The kbn blocks are used to store long symbol names.  */
1620  unsigned int kbn_sz = 0;   /* Number of bytes available in the kbn block.  */
1621  unsigned int kbn_vbn = 0;  /* VBN of the kbn block.  */
1622  unsigned char *kbn_blk = NULL; /* Contents of the kbn block.  */
1623
1624  if (nbr == 0)
1625    {
1626      /* No entries.  Very easy to handle.  */
1627      if (topvbn != NULL)
1628	*topvbn = 0;
1629      return TRUE;
1630    }
1631
1632  if (abfd == NULL)
1633    {
1634      /* Sort the index the first time this function is called.  */
1635      qsort (idx, nbr, sizeof (struct lib_index), lib_index_cmp);
1636    }
1637
1638  /* Allocate first index block.  */
1639  level = 1;
1640  if (abfd != NULL)
1641    rblk[0] = bfd_zmalloc (sizeof (struct vms_indexdef));
1642  blk[0].vbn = (*vbn)++;
1643  blk[0].len = 0;
1644  blk[0].lastlen = 0;
1645
1646  for (i = 0; i < nbr; i++, idx++)
1647    {
1648      unsigned int idxlen;
1649      int flush = 0;
1650      unsigned int key_vbn = 0;
1651      unsigned int key_off = 0;
1652
1653      idxlen = get_idxlen (idx, is_elfidx);
1654
1655      if (is_elfidx && idx->namlen > MAX_KEYLEN)
1656	{
1657	  /* If the key (ie name) is too long, write it in the kbn block.  */
1658	  unsigned int kl = idx->namlen;
1659	  unsigned int kl_chunk;
1660	  const char *key = idx->name;
1661
1662	  /* Write the key in the kbn, chunk after chunk.  */
1663	  do
1664	    {
1665	      if (kbn_sz < sizeof (struct vms_kbn))
1666		{
1667		  /* Not enough room in the kbn block.  */
1668		  if (abfd != NULL)
1669		    {
1670		      /* Write it to the disk (if there is one).  */
1671		      if (kbn_vbn != 0)
1672			{
1673			  if (!vms_write_block (abfd, kbn_vbn, kbn_blk))
1674			    return FALSE;
1675			}
1676		      else
1677			{
1678			  kbn_blk = bfd_malloc (VMS_BLOCK_SIZE);
1679			  if (kbn_blk == NULL)
1680			    return FALSE;
1681			}
1682		      *(unsigned short *)kbn_blk = 0;
1683		    }
1684		  /* Allocate a new block for the keys.  */
1685		  kbn_vbn = (*vbn)++;
1686		  kbn_sz = VMS_BLOCK_SIZE - 2;
1687		}
1688	      /* Size of the chunk written to the current key block.  */
1689	      if (kl + sizeof (struct vms_kbn) > kbn_sz)
1690		kl_chunk = kbn_sz - sizeof (struct vms_kbn);
1691	      else
1692		kl_chunk = kl;
1693
1694	      if (kbn_blk != NULL)
1695		{
1696		  struct vms_kbn *kbn;
1697
1698		  kbn = (struct vms_kbn *)(kbn_blk + VMS_BLOCK_SIZE - kbn_sz);
1699
1700		  if (key_vbn == 0)
1701		    {
1702		      /* Save the rfa of the first chunk.  */
1703		      key_vbn = kbn_vbn;
1704		      key_off = VMS_BLOCK_SIZE - kbn_sz;
1705		    }
1706
1707		  bfd_putl16 (kl_chunk, kbn->keylen);
1708		  if (kl_chunk == kl)
1709		    {
1710		      /* No next chunk.  */
1711		      bfd_putl32 (0, kbn->rfa.vbn);
1712		      bfd_putl16 (0, kbn->rfa.offset);
1713		    }
1714		  else
1715		    {
1716		      /* Next chunk will be at the start of the next block.  */
1717		      bfd_putl32 (*vbn, kbn->rfa.vbn);
1718		      bfd_putl16 (2, kbn->rfa.offset);
1719		    }
1720		  memcpy ((char *)(kbn + 1), key, kl_chunk);
1721		  key += kl_chunk;
1722		}
1723	      kl -= kl_chunk;
1724	      kl_chunk = (kl_chunk + 1) & ~1;	  /* Always align.  */
1725	      kbn_sz -= kl_chunk + sizeof (struct vms_kbn);
1726	    }
1727	  while (kl > 0);
1728	}
1729
1730      /* Check if a block might overflow.  In this case we will flush this
1731	 block and all the blocks below it.  */
1732      for (j = 0; j < level; j++)
1733	if (blk[j].len + blk[j].lastlen + idxlen > INDEXDEF__BLKSIZ)
1734	  flush = j + 1;
1735
1736      for (j = 0; j < level; j++)
1737	{
1738	  if (j < flush)
1739	    {
1740	      /* There is not enough room to write the new entry in this
1741		 block or in a parent block.  */
1742
1743	      if (j + 1 == level)
1744		{
1745		  BFD_ASSERT (level < MAX_LEVEL);
1746
1747		  /* Need to create a parent.  */
1748		  if (abfd != NULL)
1749		    {
1750		      rblk[level] = bfd_zmalloc (sizeof (struct vms_indexdef));
1751		      bfd_putl32 (*vbn, rblk[j]->parent);
1752		    }
1753		  blk[level].vbn = (*vbn)++;
1754		  blk[level].len = 0;
1755		  blk[level].lastlen = blk[j].lastlen;
1756
1757		  level++;
1758		}
1759
1760	      /* Update parent block: write the last entry from the current
1761		 block.  */
1762	      if (abfd != NULL)
1763		{
1764		  struct vms_rfa *rfa;
1765
1766		  /* Pointer to the last entry in parent block.  */
1767		  rfa = (struct vms_rfa *)(rblk[j + 1]->keys + blk[j + 1].len);
1768
1769		  /* Copy the whole entry.  */
1770		  BFD_ASSERT (blk[j + 1].lastlen == blk[j].lastlen);
1771		  memcpy (rfa, rblk[j]->keys + blk[j].len, blk[j].lastlen);
1772		  /* Fix the entry (which in always the first field of an
1773		     entry.  */
1774		  bfd_putl32 (blk[j].vbn, rfa->vbn);
1775		  bfd_putl16 (RFADEF__C_INDEX, rfa->offset);
1776		}
1777
1778	      if (j + 1 == flush)
1779		{
1780		  /* And allocate it.  Do it only on the block that won't be
1781		     flushed (so that the parent of the parent can be
1782		     updated too).  */
1783		  blk[j + 1].len += blk[j + 1].lastlen;
1784		  blk[j + 1].lastlen = 0;
1785		}
1786
1787	      /* Write this block on the disk.  */
1788	      if (abfd != NULL)
1789		{
1790		  bfd_putl16 (blk[j].len + blk[j].lastlen, rblk[j]->used);
1791		  if (!vms_write_block (abfd, blk[j].vbn, rblk[j]))
1792		    return FALSE;
1793		}
1794
1795	      /* Reset this block.  */
1796	      blk[j].len = 0;
1797	      blk[j].lastlen = 0;
1798	      blk[j].vbn = (*vbn)++;
1799	    }
1800
1801	  /* Append it to the block.  */
1802	  if (j == 0)
1803	    {
1804	      /* Keep the previous last entry.  */
1805	      blk[j].len += blk[j].lastlen;
1806
1807	      if (abfd != NULL)
1808		{
1809		  struct vms_rfa *rfa;
1810
1811		  rfa = (struct vms_rfa *)(rblk[j]->keys + blk[j].len);
1812		  bfd_putl32 ((idx->abfd->proxy_origin / VMS_BLOCK_SIZE) + 1,
1813			      rfa->vbn);
1814		  bfd_putl16
1815		    ((idx->abfd->proxy_origin % VMS_BLOCK_SIZE)
1816		     + (is_elfidx ? 0 : DATA__DATA),
1817		     rfa->offset);
1818
1819		  if (is_elfidx)
1820		    {
1821		      /* Use elfidx format.  */
1822		      struct vms_elfidx *en = (struct vms_elfidx *)rfa;
1823
1824		      en->flags = 0;
1825		      if (key_vbn != 0)
1826			{
1827			  /* Long symbol name.  */
1828			  struct vms_kbn *k = (struct vms_kbn *)(en->keyname);
1829			  bfd_putl16 (sizeof (struct vms_kbn), en->keylen);
1830			  bfd_putl16 (idx->namlen, k->keylen);
1831			  bfd_putl32 (key_vbn, k->rfa.vbn);
1832			  bfd_putl16 (key_off, k->rfa.offset);
1833			  en->flags |= ELFIDX__SYMESC;
1834			}
1835		      else
1836			{
1837			  bfd_putl16 (idx->namlen, en->keylen);
1838			  memcpy (en->keyname, idx->name, idx->namlen);
1839			}
1840		    }
1841		  else
1842		    {
1843		      /* Use idx format.  */
1844		      struct vms_idx *en = (struct vms_idx *)rfa;
1845		      en->keylen = idx->namlen;
1846		      memcpy (en->keyname, idx->name, idx->namlen);
1847		    }
1848		}
1849	    }
1850	  /* The last added key can now be the last one all blocks in the
1851	     path.  */
1852	  blk[j].lastlen = idxlen;
1853	}
1854    }
1855
1856  /* Save VBN of the root.  */
1857  if (topvbn != NULL)
1858    *topvbn = blk[level - 1].vbn;
1859
1860  if (abfd == NULL)
1861    return TRUE;
1862
1863  /* Flush.  */
1864  for (j = 1; j < level; j++)
1865    {
1866      /* Update parent block: write the new entry.  */
1867      unsigned char *en;
1868      unsigned char *par;
1869      struct vms_rfa *rfa;
1870
1871      en = rblk[j - 1]->keys + blk[j - 1].len;
1872      par = rblk[j]->keys + blk[j].len;
1873      BFD_ASSERT (blk[j].lastlen == blk[j - 1].lastlen);
1874      memcpy (par, en, blk[j - 1].lastlen);
1875      rfa = (struct vms_rfa *)par;
1876      bfd_putl32 (blk[j - 1].vbn, rfa->vbn);
1877      bfd_putl16 (RFADEF__C_INDEX, rfa->offset);
1878    }
1879
1880  for (j = 0; j < level; j++)
1881    {
1882      /* Write this block on the disk.  */
1883      bfd_putl16 (blk[j].len + blk[j].lastlen, rblk[j]->used);
1884      if (!vms_write_block (abfd, blk[j].vbn, rblk[j]))
1885	return FALSE;
1886
1887      free (rblk[j]);
1888    }
1889
1890  /* Write the last kbn (if any).  */
1891  if (kbn_vbn != 0)
1892    {
1893      if (!vms_write_block (abfd, kbn_vbn, kbn_blk))
1894	return FALSE;
1895      free (kbn_blk);
1896    }
1897
1898  return TRUE;
1899}
1900
1901/* Append data to the data block DATA.  Force write if PAD is true.  */
1902
1903static bfd_boolean
1904vms_write_data_block (bfd *arch, struct vms_datadef *data, file_ptr *off,
1905		      const unsigned char *buf, unsigned int len, int pad)
1906{
1907  while (len > 0 || pad)
1908    {
1909      unsigned int doff = *off & (VMS_BLOCK_SIZE - 1);
1910      unsigned int remlen = (DATA__LENGTH - DATA__DATA) - doff;
1911      unsigned int l;
1912
1913      l = (len > remlen) ? remlen : len;
1914      memcpy (data->data + doff, buf, l);
1915      buf += l;
1916      len -= l;
1917      doff += l;
1918      *off += l;
1919
1920      if (doff == (DATA__LENGTH - DATA__DATA) || (len == 0 && pad))
1921	{
1922	  data->recs = 0;
1923	  data->fill_1 = 0;
1924	  bfd_putl32 ((*off / VMS_BLOCK_SIZE) + 2, data->link);
1925
1926	  if (bfd_bwrite (data, sizeof (*data), arch) != sizeof (*data))
1927	    return FALSE;
1928
1929	  *off += DATA__LENGTH - doff;
1930
1931	  if (len == 0)
1932	    break;
1933	}
1934    }
1935  return TRUE;
1936}
1937
1938/* Build the symbols index.  */
1939
1940static bfd_boolean
1941_bfd_vms_lib_build_map (unsigned int nbr_modules,
1942			struct lib_index *modules,
1943			unsigned int *res_cnt,
1944			struct lib_index **res)
1945{
1946  unsigned int i;
1947  asymbol **syms = NULL;
1948  long syms_max = 0;
1949  struct lib_index *map = NULL;
1950  unsigned int map_max = 1024;		/* Fine initial default.  */
1951  unsigned int map_count = 0;
1952
1953  map = (struct lib_index *) bfd_malloc (map_max * sizeof (struct lib_index));
1954  if (map == NULL)
1955    goto error_return;
1956
1957  /* Gather symbols.  */
1958  for (i = 0; i < nbr_modules; i++)
1959    {
1960      long storage;
1961      long symcount;
1962      long src_count;
1963      bfd *current = modules[i].abfd;
1964
1965      if ((bfd_get_file_flags (current) & HAS_SYMS) == 0)
1966	continue;
1967
1968      storage = bfd_get_symtab_upper_bound (current);
1969      if (storage < 0)
1970	goto error_return;
1971
1972      if (storage != 0)
1973	{
1974	  if (storage > syms_max)
1975	    {
1976	      if (syms_max > 0)
1977		free (syms);
1978	      syms_max = storage;
1979	      syms = (asymbol **) bfd_malloc (syms_max);
1980	      if (syms == NULL)
1981		goto error_return;
1982	    }
1983	  symcount = bfd_canonicalize_symtab (current, syms);
1984	  if (symcount < 0)
1985	    goto error_return;
1986
1987	  /* Now map over all the symbols, picking out the ones we
1988	     want.  */
1989	  for (src_count = 0; src_count < symcount; src_count++)
1990	    {
1991	      flagword flags = (syms[src_count])->flags;
1992	      asection *sec = syms[src_count]->section;
1993
1994	      if ((flags & BSF_GLOBAL
1995		   || flags & BSF_WEAK
1996		   || flags & BSF_INDIRECT
1997		   || bfd_is_com_section (sec))
1998		  && ! bfd_is_und_section (sec))
1999		{
2000		  struct lib_index *new_map;
2001
2002		  /* This symbol will go into the archive header.  */
2003		  if (map_count == map_max)
2004		    {
2005		      map_max *= 2;
2006		      new_map = (struct lib_index *)
2007			bfd_realloc (map, map_max * sizeof (struct lib_index));
2008		      if (new_map == NULL)
2009			goto error_return;
2010		      map = new_map;
2011		    }
2012
2013		  map[map_count].abfd = current;
2014		  map[map_count].namlen = strlen (syms[src_count]->name);
2015		  map[map_count].name = syms[src_count]->name;
2016		  map_count++;
2017		  modules[i].ref++;
2018		}
2019	    }
2020	}
2021    }
2022
2023  *res_cnt = map_count;
2024  *res = map;
2025  return TRUE;
2026
2027 error_return:
2028  if (syms_max > 0)
2029    free (syms);
2030  if (map != NULL)
2031    free (map);
2032  return FALSE;
2033}
2034
2035/* Do the hard work: write an archive on the disk.  */
2036
2037bfd_boolean
2038_bfd_vms_lib_write_archive_contents (bfd *arch)
2039{
2040  bfd *current;
2041  unsigned int nbr_modules;
2042  struct lib_index *modules;
2043  unsigned int nbr_symbols;
2044  struct lib_index *symbols;
2045  struct lib_tdata *tdata = bfd_libdata (arch);
2046  unsigned int i;
2047  file_ptr off;
2048  unsigned int nbr_mod_iblk;
2049  unsigned int nbr_sym_iblk;
2050  unsigned int vbn;
2051  unsigned int mod_idx_vbn;
2052  unsigned int sym_idx_vbn;
2053  bfd_boolean is_elfidx = tdata->kind == vms_lib_ia64;
2054  unsigned int max_keylen = is_elfidx ? MAX_EKEYLEN : MAX_KEYLEN;
2055
2056  /* Count the number of modules (and do a first sanity check).  */
2057  nbr_modules = 0;
2058  for (current = arch->archive_head;
2059       current != NULL;
2060       current = current->archive_next)
2061    {
2062      /* This check is checking the bfds for the objects we're reading
2063	 from (which are usually either an object file or archive on
2064	 disk), not the archive entries we're writing to.  We don't
2065	 actually create bfds for the archive members, we just copy
2066	 them byte-wise when we write out the archive.  */
2067      if (bfd_write_p (current) || !bfd_check_format (current, bfd_object))
2068	{
2069	  bfd_set_error (bfd_error_invalid_operation);
2070	  goto input_err;
2071	}
2072
2073      nbr_modules++;
2074    }
2075
2076  /* Build the modules list.  */
2077  BFD_ASSERT (tdata->modules == NULL);
2078  modules = bfd_alloc (arch, nbr_modules * sizeof (struct lib_index));
2079  if (modules == NULL)
2080    return FALSE;
2081
2082  for (current = arch->archive_head, i = 0;
2083       current != NULL;
2084       current = current->archive_next, i++)
2085    {
2086      unsigned int nl;
2087
2088      modules[i].abfd = current;
2089      modules[i].name = vms_get_module_name (current->filename, FALSE);
2090      modules[i].ref = 1;
2091
2092      /* FIXME: silently truncate long names ?  */
2093      nl = strlen (modules[i].name);
2094      modules[i].namlen = (nl > max_keylen ? max_keylen : nl);
2095    }
2096
2097  /* Create the module index.  */
2098  vbn = 0;
2099  if (!vms_write_index (NULL, modules, nbr_modules, &vbn, NULL, is_elfidx))
2100    return FALSE;
2101  nbr_mod_iblk = vbn;
2102
2103  /* Create symbol index.  */
2104  if (!_bfd_vms_lib_build_map (nbr_modules, modules, &nbr_symbols, &symbols))
2105    return FALSE;
2106
2107  vbn = 0;
2108  if (!vms_write_index (NULL, symbols, nbr_symbols, &vbn, NULL, is_elfidx))
2109    return FALSE;
2110  nbr_sym_iblk = vbn;
2111
2112  /* Write modules and remember their position.  */
2113  off = (1 + nbr_mod_iblk + nbr_sym_iblk) * VMS_BLOCK_SIZE;
2114
2115  if (bfd_seek (arch, off, SEEK_SET) != 0)
2116    return FALSE;
2117
2118  for (i = 0; i < nbr_modules; i++)
2119    {
2120      struct vms_datadef data;
2121      unsigned char blk[VMS_BLOCK_SIZE];
2122      struct vms_mhd *mhd;
2123      unsigned int sz;
2124
2125      current = modules[i].abfd;
2126      current->proxy_origin = off;
2127
2128      if (is_elfidx)
2129	sz = 0;
2130      else
2131	{
2132	  /* Write the MHD as a record (ie, size first).  */
2133	  sz = 2;
2134	  bfd_putl16 (tdata->mhd_size, blk);
2135	}
2136      mhd = (struct vms_mhd *)(blk + sz);
2137      memset (mhd, 0, sizeof (struct vms_mhd));
2138      mhd->lbrflag = 0;
2139      mhd->id = MHD__C_MHDID;
2140      mhd->objidlng = 4;
2141      memcpy (mhd->objid, "V1.0", 4);
2142      bfd_putl32 (modules[i].ref, mhd->refcnt);
2143      /* FIXME: datim.  */
2144
2145      sz += tdata->mhd_size;
2146      sz = (sz + 1) & ~1;
2147
2148      /* Rewind the member to be put into the archive.  */
2149      if (bfd_seek (current, 0, SEEK_SET) != 0)
2150	goto input_err;
2151
2152      /* Copy the member into the archive.  */
2153      if (is_elfidx)
2154	{
2155	  unsigned int modsize = 0;
2156	  bfd_size_type amt;
2157	  file_ptr off_hdr = off;
2158
2159	  /* Read to complete the first block.  */
2160	  amt = bfd_bread (blk + sz, VMS_BLOCK_SIZE - sz, current);
2161	  if (amt == (bfd_size_type)-1)
2162	    goto input_err;
2163	  modsize = amt;
2164	  if (amt < VMS_BLOCK_SIZE - sz)
2165	    {
2166	      /* The member size is less than a block.  Pad the block.  */
2167	      memset (blk + sz + amt, 0, VMS_BLOCK_SIZE - sz - amt);
2168	    }
2169	  bfd_putl32 (modsize, mhd->modsize);
2170
2171	  /* Write the first block (which contains an mhd).  */
2172	  if (bfd_bwrite (blk, VMS_BLOCK_SIZE, arch) != VMS_BLOCK_SIZE)
2173	    goto input_err;
2174	  off += VMS_BLOCK_SIZE;
2175
2176	  if (amt == VMS_BLOCK_SIZE - sz)
2177	    {
2178	      /* Copy the remaining.  */
2179	      char buffer[DEFAULT_BUFFERSIZE];
2180
2181	      while (1)
2182		{
2183		  amt = bfd_bread (buffer, sizeof (buffer), current);
2184		  if (amt == (bfd_size_type)-1)
2185		    goto input_err;
2186		  if (amt == 0)
2187		    break;
2188		  modsize += amt;
2189		  if (amt != sizeof (buffer))
2190		    {
2191		      /* Clear the padding.  */
2192		      memset (buffer + amt, 0, sizeof (buffer) - amt);
2193		      amt = (amt + VMS_BLOCK_SIZE) & ~(VMS_BLOCK_SIZE - 1);
2194		    }
2195		  if (bfd_bwrite (buffer, amt, arch) != amt)
2196		    goto input_err;
2197		  off += amt;
2198		}
2199
2200	      /* Now that the size is known, write the first block (again).  */
2201	      bfd_putl32 (modsize, mhd->modsize);
2202	      if (bfd_seek (arch, off_hdr, SEEK_SET) != 0
2203		  || bfd_bwrite (blk, VMS_BLOCK_SIZE, arch) != VMS_BLOCK_SIZE)
2204		goto input_err;
2205	      if (bfd_seek (arch, off, SEEK_SET) != 0)
2206		goto input_err;
2207	    }
2208	}
2209      else
2210	{
2211	  /* Write the MHD.  */
2212	  if (vms_write_data_block (arch, &data, &off, blk, sz, 0) < 0)
2213	    goto input_err;
2214
2215	  /* Write the member.  */
2216	  while (1)
2217	    {
2218	      sz = bfd_bread (blk, sizeof (blk), current);
2219	      if (sz == 0)
2220		break;
2221	      if (vms_write_data_block (arch, &data, &off, blk, sz, 0) < 0)
2222		goto input_err;
2223	    }
2224
2225	  /* Write the end of module marker.  */
2226	  if (vms_write_data_block (arch, &data, &off,
2227				    eotdesc, sizeof (eotdesc), 1) < 0)
2228	    goto input_err;
2229	}
2230    }
2231
2232  /* Write the indexes.  */
2233  vbn = 2;
2234  if (!vms_write_index (arch, modules, nbr_modules, &vbn, &mod_idx_vbn,
2235			is_elfidx))
2236    return FALSE;
2237  if (!vms_write_index (arch, symbols, nbr_symbols, &vbn, &sym_idx_vbn,
2238			is_elfidx))
2239    return FALSE;
2240
2241  /* Write libary header.  */
2242  {
2243    unsigned char blk[VMS_BLOCK_SIZE];
2244    struct vms_lhd *lhd = (struct vms_lhd *)blk;
2245    struct vms_idd *idd = (struct vms_idd *)(blk + sizeof (*lhd));
2246    unsigned int idd_flags;
2247    unsigned int saneid;
2248
2249    memset (blk, 0, sizeof (blk));
2250
2251    lhd->type = tdata->type;
2252    lhd->nindex = 2;
2253    switch (tdata->kind)
2254      {
2255      case vms_lib_alpha:
2256	saneid = LHD_SANEID3;
2257	break;
2258      case vms_lib_ia64:
2259	saneid = LHD_SANEID6;
2260	break;
2261      default:
2262	abort ();
2263      }
2264    bfd_putl32 (saneid, lhd->sanity);
2265    bfd_putl16 (tdata->ver, lhd->majorid);
2266    bfd_putl16 (0, lhd->minorid);
2267    snprintf ((char *)lhd->lbrver + 1, sizeof (lhd->lbrver) - 1,
2268	      "GNU ar %u.%u.%u",
2269	      (unsigned)(BFD_VERSION / 100000000UL),
2270	      (unsigned)(BFD_VERSION / 1000000UL) % 100,
2271	      (unsigned)(BFD_VERSION / 10000UL) % 100);
2272    lhd->lbrver[sizeof (lhd->lbrver) - 1] = 0;
2273    lhd->lbrver[0] = strlen ((char *)lhd->lbrver + 1);
2274
2275    bfd_putl32 (tdata->credat_lo, lhd->credat + 0);
2276    bfd_putl32 (tdata->credat_hi, lhd->credat + 4);
2277    vms_raw_get_time (lhd->updtim);
2278
2279    lhd->mhdusz = tdata->mhd_size - MHD__C_USRDAT;
2280
2281    bfd_putl32 (nbr_modules + nbr_symbols, lhd->idxcnt);
2282    bfd_putl32 (nbr_modules, lhd->modcnt);
2283    bfd_putl32 (nbr_modules, lhd->modhdrs);
2284
2285    /* Number of blocks for index.  */
2286    bfd_putl32 (nbr_mod_iblk + nbr_sym_iblk, lhd->idxblks);
2287    bfd_putl32 (vbn - 1, lhd->hipreal);
2288    bfd_putl32 (vbn - 1, lhd->hiprusd);
2289
2290    /* VBN of the next free block.  */
2291    bfd_putl32 ((off / VMS_BLOCK_SIZE) + 1, lhd->nextvbn);
2292    bfd_putl32 ((off / VMS_BLOCK_SIZE) + 1, lhd->nextrfa + 0);
2293    bfd_putl16 (0, lhd->nextrfa + 4);
2294
2295    /* First index (modules name).  */
2296    idd_flags = IDD__FLAGS_ASCII | IDD__FLAGS_VARLENIDX
2297      | IDD__FLAGS_NOCASECMP | IDD__FLAGS_NOCASENTR;
2298    bfd_putl16 (idd_flags, idd->flags);
2299    bfd_putl16 (max_keylen + 1, idd->keylen);
2300    bfd_putl16 (mod_idx_vbn, idd->vbn);
2301    idd++;
2302
2303    /* Second index (symbols name).  */
2304    bfd_putl16 (idd_flags, idd->flags);
2305    bfd_putl16 (max_keylen + 1, idd->keylen);
2306    bfd_putl16 (sym_idx_vbn, idd->vbn);
2307    idd++;
2308
2309    if (!vms_write_block (arch, 1, blk))
2310      return FALSE;
2311  }
2312
2313  return TRUE;
2314
2315 input_err:
2316  bfd_set_input_error (current, bfd_get_error ());
2317  return FALSE;
2318}
2319
2320/* Add a target for text library.  This costs almost nothing and is useful to
2321   read VMS library on the host.  */
2322
2323const bfd_target alpha_vms_lib_txt_vec =
2324{
2325  "vms-libtxt",			/* Name.  */
2326  bfd_target_unknown_flavour,
2327  BFD_ENDIAN_UNKNOWN,		/* byteorder */
2328  BFD_ENDIAN_UNKNOWN,		/* header_byteorder */
2329  0,				/* Object flags.  */
2330  0,				/* Sect flags.  */
2331  0,				/* symbol_leading_char.  */
2332  ' ',				/* ar_pad_char.  */
2333  15,				/* ar_max_namelen.  */
2334  0,				/* match priority.  */
2335  bfd_getl64, bfd_getl_signed_64, bfd_putl64,
2336  bfd_getl32, bfd_getl_signed_32, bfd_putl32,
2337  bfd_getl16, bfd_getl_signed_16, bfd_putl16,
2338  bfd_getl64, bfd_getl_signed_64, bfd_putl64,
2339  bfd_getl32, bfd_getl_signed_32, bfd_putl32,
2340  bfd_getl16, bfd_getl_signed_16, bfd_putl16,
2341  {				/* bfd_check_format.  */
2342    _bfd_dummy_target,
2343    _bfd_dummy_target,
2344    _bfd_vms_lib_txt_archive_p,
2345    _bfd_dummy_target
2346  },
2347  {				/* bfd_set_format.  */
2348    _bfd_bool_bfd_false_error,
2349    _bfd_bool_bfd_false_error,
2350    _bfd_bool_bfd_false_error,
2351    _bfd_bool_bfd_false_error
2352  },
2353  {				/* bfd_write_contents.  */
2354    _bfd_bool_bfd_false_error,
2355    _bfd_bool_bfd_false_error,
2356    _bfd_bool_bfd_false_error,
2357    _bfd_bool_bfd_false_error
2358  },
2359  BFD_JUMP_TABLE_GENERIC (_bfd_generic),
2360  BFD_JUMP_TABLE_COPY (_bfd_generic),
2361  BFD_JUMP_TABLE_CORE (_bfd_nocore),
2362  BFD_JUMP_TABLE_ARCHIVE (_bfd_vms_lib),
2363  BFD_JUMP_TABLE_SYMBOLS (_bfd_nosymbols),
2364  BFD_JUMP_TABLE_RELOCS (_bfd_norelocs),
2365  BFD_JUMP_TABLE_WRITE (_bfd_nowrite),
2366  BFD_JUMP_TABLE_LINK (_bfd_nolink),
2367  BFD_JUMP_TABLE_DYNAMIC (_bfd_nodynamic),
2368
2369  NULL,
2370
2371  NULL
2372};
2373