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