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