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