Merge commit '122f24cc8a3637ed42d7792ad1ff8ec0c49c58df'
[bpt/guile.git] / libguile / loader.c
1 /* Copyright (C) 2001, 2009, 2010, 2011, 2012
2 * 2013, 2014 Free Software Foundation, Inc.
3 *
4 * This library is free software; you can redistribute it and/or
5 * modify it under the terms of the GNU Lesser General Public License
6 * as published by the Free Software Foundation; either version 3 of
7 * the License, or (at your option) any later version.
8 *
9 * This library is distributed in the hope that it will be useful, but
10 * WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 * Lesser General Public License for more details.
13 *
14 * You should have received a copy of the GNU Lesser General Public
15 * License along with this library; if not, write to the Free Software
16 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
17 * 02110-1301 USA
18 */
19
20 #if HAVE_CONFIG_H
21 # include <config.h>
22 #endif
23
24 #include <string.h>
25 #include <fcntl.h>
26 #include <unistd.h>
27
28 #ifdef HAVE_SYS_MMAN_H
29 #include <sys/mman.h>
30 #endif
31
32 #include <sys/stat.h>
33 #include <sys/types.h>
34 #include <assert.h>
35 #include <alignof.h>
36 #include <byteswap.h>
37 #include <verify.h>
38
39 #include <full-read.h>
40
41 #include "_scm.h"
42 #include "elf.h"
43 #include "programs.h"
44 #include "loader.h"
45
46 /* This file contains the loader for Guile's on-disk format: ELF with
47 some custom tags in the dynamic segment. */
48
49 #if SIZEOF_SCM_T_BITS == 4
50 #define Elf_Half Elf32_Half
51 #define Elf_Word Elf32_Word
52 #define Elf_Ehdr Elf32_Ehdr
53 #define ELFCLASS ELFCLASS32
54 #define Elf_Phdr Elf32_Phdr
55 #define Elf_Dyn Elf32_Dyn
56 #elif SIZEOF_SCM_T_BITS == 8
57 #define Elf_Half Elf64_Half
58 #define Elf_Word Elf64_Word
59 #define Elf_Ehdr Elf64_Ehdr
60 #define ELFCLASS ELFCLASS64
61 #define Elf_Phdr Elf64_Phdr
62 #define Elf_Dyn Elf64_Dyn
63 #else
64 #error
65 #endif
66
67 #define DT_LOGUILE 0x37146000 /* Start of Guile-specific */
68 #define DT_GUILE_GC_ROOT 0x37146000 /* Offset of GC roots */
69 #define DT_GUILE_GC_ROOT_SZ 0x37146001 /* Size in machine words of GC
70 roots */
71 #define DT_GUILE_ENTRY 0x37146002 /* Address of entry thunk */
72 #define DT_GUILE_VM_VERSION 0x37146003 /* Bytecode version */
73 #define DT_GUILE_FRAME_MAPS 0x37146004 /* Frame maps */
74 #define DT_HIGUILE 0x37146fff /* End of Guile-specific */
75
76 #ifdef WORDS_BIGENDIAN
77 #define ELFDATA ELFDATA2MSB
78 #else
79 #define ELFDATA ELFDATA2LSB
80 #endif
81
82 static void register_elf (char *data, size_t len, char *frame_maps);
83
84 enum bytecode_kind
85 {
86 BYTECODE_KIND_NONE,
87 BYTECODE_KIND_GUILE_2_2
88 };
89
90 static SCM
91 pointer_to_procedure (enum bytecode_kind bytecode_kind, char *ptr)
92 {
93 switch (bytecode_kind)
94 {
95 case BYTECODE_KIND_GUILE_2_2:
96 {
97 return scm_i_make_program ((scm_t_uint32 *) ptr);
98 }
99 case BYTECODE_KIND_NONE:
100 default:
101 abort ();
102 }
103 }
104
105 static const char*
106 check_elf_header (const Elf_Ehdr *header)
107 {
108 if (!(header->e_ident[EI_MAG0] == ELFMAG0
109 && header->e_ident[EI_MAG1] == ELFMAG1
110 && header->e_ident[EI_MAG2] == ELFMAG2
111 && header->e_ident[EI_MAG3] == ELFMAG3))
112 return "not an ELF file";
113
114 if (header->e_ident[EI_CLASS] != ELFCLASS)
115 return "ELF file does not have native word size";
116
117 if (header->e_ident[EI_DATA] != ELFDATA)
118 return "ELF file does not have native byte order";
119
120 if (header->e_ident[EI_VERSION] != EV_CURRENT)
121 return "bad ELF version";
122
123 if (header->e_ident[EI_OSABI] != ELFOSABI_STANDALONE)
124 return "unexpected OS ABI";
125
126 if (header->e_ident[EI_ABIVERSION] != 0)
127 return "unexpected ABI version";
128
129 if (header->e_type != ET_DYN)
130 return "unexpected ELF type";
131
132 if (header->e_machine != EM_NONE)
133 return "unexpected machine";
134
135 if (header->e_version != EV_CURRENT)
136 return "unexpected ELF version";
137
138 if (header->e_ehsize != sizeof *header)
139 return "unexpected header size";
140
141 if (header->e_phentsize != sizeof (Elf_Phdr))
142 return "unexpected program header size";
143
144 return NULL;
145 }
146
147 #define IS_ALIGNED(offset, alignment) \
148 (!((offset) & ((alignment) - 1)))
149 #define ALIGN(offset, alignment) \
150 ((offset + (alignment - 1)) & ~(alignment - 1))
151
152 /* Return the alignment required by the ELF at DATA, of LEN bytes. */
153 static size_t
154 elf_alignment (const char *data, size_t len)
155 {
156 Elf_Ehdr *header;
157 int i;
158 size_t alignment = 8;
159
160 if (len < sizeof(Elf_Ehdr))
161 return alignment;
162 header = (Elf_Ehdr *) data;
163 if (header->e_phoff + header->e_phnum * header->e_phentsize >= len)
164 return alignment;
165 for (i = 0; i < header->e_phnum; i++)
166 {
167 Elf_Phdr *phdr;
168 const char *phdr_addr = data + header->e_phoff + i * header->e_phentsize;
169
170 if (!IS_ALIGNED ((scm_t_uintptr) phdr_addr, alignof_type (Elf_Phdr)))
171 return alignment;
172 phdr = (Elf_Phdr *) phdr_addr;
173
174 if (phdr->p_align & (phdr->p_align - 1))
175 return alignment;
176
177 if (phdr->p_align > alignment)
178 alignment = phdr->p_align;
179 }
180
181 return alignment;
182 }
183
184 /* This function leaks the memory that it allocates. */
185 static char*
186 alloc_aligned (size_t len, unsigned alignment)
187 {
188 char *ret;
189
190 if (alignment == 8)
191 {
192 /* FIXME: Assert that we actually have an 8-byte-aligned malloc. */
193 ret = malloc (len);
194 }
195 #if defined(HAVE_SYS_MMAN_H) && defined(MMAP_ANONYMOUS)
196 else if (alignment == SCM_PAGE_SIZE)
197 {
198 ret = mmap (NULL, len, PROT_READ | PROT_WRITE, -1, 0);
199 if (ret == MAP_FAILED)
200 SCM_SYSERROR;
201 }
202 #endif
203 else
204 {
205 if (len + alignment < len)
206 abort ();
207
208 ret = malloc (len + alignment - 1);
209 if (!ret)
210 abort ();
211 ret = (char *) ALIGN ((scm_t_uintptr) ret, alignment);
212 }
213
214 return ret;
215 }
216
217 static char*
218 copy_and_align_elf_data (const char *data, size_t len)
219 {
220 size_t alignment;
221 char *copy;
222
223 alignment = elf_alignment (data, len);
224 copy = alloc_aligned (len, alignment);
225 memcpy(copy, data, len);
226
227 return copy;
228 }
229
230 #ifdef HAVE_SYS_MMAN_H
231 static int
232 segment_flags_to_prot (Elf_Word flags)
233 {
234 int prot = 0;
235
236 if (flags & PF_X)
237 prot |= PROT_EXEC;
238 if (flags & PF_W)
239 prot |= PROT_WRITE;
240 if (flags & PF_R)
241 prot |= PROT_READ;
242
243 return prot;
244 }
245 #endif
246
247 static char*
248 process_dynamic_segment (char *base, Elf_Phdr *dyn_phdr,
249 SCM *init_out, SCM *entry_out, char **frame_maps_out)
250 {
251 char *dyn_addr = base + dyn_phdr->p_vaddr;
252 Elf_Dyn *dyn = (Elf_Dyn *) dyn_addr;
253 size_t i, dyn_size = dyn_phdr->p_memsz / sizeof (Elf_Dyn);
254 char *init = 0, *gc_root = 0, *entry = 0, *frame_maps = 0;
255 scm_t_ptrdiff gc_root_size = 0;
256 enum bytecode_kind bytecode_kind = BYTECODE_KIND_NONE;
257
258 for (i = 0; i < dyn_size; i++)
259 {
260 if (dyn[i].d_tag == DT_NULL)
261 break;
262
263 switch (dyn[i].d_tag)
264 {
265 case DT_INIT:
266 if (init)
267 return "duplicate DT_INIT";
268 init = base + dyn[i].d_un.d_val;
269 break;
270 case DT_GUILE_GC_ROOT:
271 if (gc_root)
272 return "duplicate DT_GUILE_GC_ROOT";
273 gc_root = base + dyn[i].d_un.d_val;
274 break;
275 case DT_GUILE_GC_ROOT_SZ:
276 if (gc_root_size)
277 return "duplicate DT_GUILE_GC_ROOT_SZ";
278 gc_root_size = dyn[i].d_un.d_val;
279 break;
280 case DT_GUILE_ENTRY:
281 if (entry)
282 return "duplicate DT_GUILE_ENTRY";
283 entry = base + dyn[i].d_un.d_val;
284 break;
285 case DT_GUILE_VM_VERSION:
286 if (bytecode_kind != BYTECODE_KIND_NONE)
287 return "duplicate DT_GUILE_VM_VERSION";
288 {
289 scm_t_uint16 major = dyn[i].d_un.d_val >> 16;
290 scm_t_uint16 minor = dyn[i].d_un.d_val & 0xffff;
291 switch (major)
292 {
293 case 0x0202:
294 bytecode_kind = BYTECODE_KIND_GUILE_2_2;
295 /* As we get closer to 2.2, we will allow for backwards
296 compatibility and we can change this test to ">"
297 instead of "!=". However until then, to deal with VM
298 churn it's best to keep these things in
299 lock-step. */
300 if (minor != SCM_OBJCODE_MINOR_VERSION)
301 return "incompatible bytecode version";
302 break;
303 default:
304 return "incompatible bytecode kind";
305 }
306 break;
307 }
308 case DT_GUILE_FRAME_MAPS:
309 if (frame_maps)
310 return "duplicate DT_GUILE_FRAME_MAPS";
311 frame_maps = base + dyn[i].d_un.d_val;
312 break;
313 }
314 }
315
316 if (!entry)
317 return "missing DT_GUILE_ENTRY";
318
319 switch (bytecode_kind)
320 {
321 case BYTECODE_KIND_GUILE_2_2:
322 if ((scm_t_uintptr) init % 4)
323 return "unaligned DT_INIT";
324 if ((scm_t_uintptr) entry % 4)
325 return "unaligned DT_GUILE_ENTRY";
326 break;
327 case BYTECODE_KIND_NONE:
328 default:
329 return "missing DT_GUILE_VM_VERSION";
330 }
331
332 if (gc_root)
333 GC_add_roots (gc_root, gc_root + gc_root_size);
334
335 *init_out = init ? pointer_to_procedure (bytecode_kind, init) : SCM_BOOL_F;
336 *entry_out = pointer_to_procedure (bytecode_kind, entry);
337 *frame_maps_out = frame_maps;
338
339 return NULL;
340 }
341
342 #define ABORT(msg) do { err_msg = msg; goto cleanup; } while (0)
343
344 static SCM
345 load_thunk_from_memory (char *data, size_t len, int is_read_only)
346 #define FUNC_NAME "load-thunk-from-memory"
347 {
348 Elf_Ehdr *header;
349 Elf_Phdr *ph;
350 const char *err_msg = 0;
351 size_t n, alignment = 8;
352 int i;
353 int dynamic_segment = -1;
354 SCM init = SCM_BOOL_F, entry = SCM_BOOL_F;
355 char *frame_maps = 0;
356
357 if (len < sizeof *header)
358 ABORT ("object file too small");
359
360 header = (Elf_Ehdr*) data;
361
362 if ((err_msg = check_elf_header (header)))
363 goto cleanup;
364
365 if (header->e_phnum == 0)
366 ABORT ("no loadable segments");
367 n = header->e_phnum;
368
369 if (len < header->e_phoff + n * sizeof (Elf_Phdr))
370 ABORT ("object file too small");
371
372 ph = (Elf_Phdr*) (data + header->e_phoff);
373
374 /* Check that the segment table is sane. */
375 for (i = 0; i < n; i++)
376 {
377 if (ph[i].p_filesz != ph[i].p_memsz)
378 ABORT ("expected p_filesz == p_memsz");
379
380 if (!ph[i].p_flags)
381 ABORT ("expected nonzero segment flags");
382
383 if (ph[i].p_align < alignment)
384 {
385 if (ph[i].p_align % alignment)
386 ABORT ("expected new alignment to be multiple of old");
387 alignment = ph[i].p_align;
388 }
389
390 if (ph[i].p_type == PT_DYNAMIC)
391 {
392 if (dynamic_segment >= 0)
393 ABORT ("expected only one PT_DYNAMIC segment");
394 dynamic_segment = i;
395 }
396
397 if (i == 0)
398 {
399 if (ph[i].p_vaddr != 0)
400 ABORT ("first loadable vaddr is not 0");
401 }
402 else
403 {
404 if (ph[i].p_vaddr < ph[i-1].p_vaddr + ph[i-1].p_memsz)
405 ABORT ("overlapping segments");
406
407 if (ph[i].p_offset + ph[i].p_filesz > len)
408 ABORT ("segment beyond end of byte array");
409 }
410 }
411
412 if (dynamic_segment < 0)
413 ABORT ("no PT_DYNAMIC segment");
414
415 if (!IS_ALIGNED ((scm_t_uintptr) data, alignment))
416 ABORT ("incorrectly aligned base");
417
418 /* Allow writes to writable pages. */
419 if (is_read_only)
420 {
421 #ifdef HAVE_SYS_MMAN_H
422 for (i = 0; i < n; i++)
423 {
424 if (ph[i].p_flags == PF_R)
425 continue;
426 if (ph[i].p_align != 4096)
427 continue;
428
429 if (mprotect (data + ph[i].p_vaddr,
430 ph[i].p_memsz,
431 segment_flags_to_prot (ph[i].p_flags)))
432 goto cleanup;
433 }
434 #else
435 ABORT ("expected writable pages");
436 #endif
437 }
438
439 if ((err_msg = process_dynamic_segment (data, &ph[dynamic_segment],
440 &init, &entry, &frame_maps)))
441 goto cleanup;
442
443 if (scm_is_true (init))
444 scm_call_0 (init);
445
446 register_elf (data, len, frame_maps);
447
448 /* Finally! Return the thunk. */
449 return entry;
450
451 cleanup:
452 {
453 if (errno)
454 SCM_SYSERROR;
455 scm_misc_error (FUNC_NAME, err_msg ? err_msg : "error loading ELF file",
456 SCM_EOL);
457 }
458 }
459 #undef FUNC_NAME
460
461 #define SCM_PAGE_SIZE 4096
462
463 static char*
464 map_file_contents (int fd, size_t len, int *is_read_only)
465 #define FUNC_NAME "load-thunk-from-file"
466 {
467 char *data;
468
469 #ifdef HAVE_SYS_MMAN_H
470 data = mmap (NULL, len, PROT_READ, MAP_PRIVATE, fd, 0);
471 if (data == MAP_FAILED)
472 SCM_SYSERROR;
473 *is_read_only = 1;
474 #else
475 if (lseek (fd, 0, SEEK_START) < 0)
476 {
477 int errno_save = errno;
478 (void) close (fd);
479 errno = errno_save;
480 SCM_SYSERROR;
481 }
482
483 /* Given that we are using the read fallback, optimistically assume
484 that the .go files were made with 8-byte alignment.
485 alignment. */
486 data = malloc (end);
487 if (!data)
488 {
489 (void) close (fd);
490 scm_misc_error (FUNC_NAME, "failed to allocate ~A bytes",
491 scm_list_1 (scm_from_size_t (end)));
492 }
493
494 if (full_read (fd, data, end) != end)
495 {
496 int errno_save = errno;
497 (void) close (fd);
498 errno = errno_save;
499 if (errno)
500 SCM_SYSERROR;
501 scm_misc_error (FUNC_NAME, "short read while loading objcode",
502 SCM_EOL);
503 }
504
505 /* If our optimism failed, fall back. */
506 {
507 unsigned alignment = sniff_elf_alignment (data, end);
508
509 if (alignment != 8)
510 {
511 char *copy = copy_and_align_elf_data (data, end, alignment);
512 free (data);
513 data = copy;
514 }
515 }
516
517 *is_read_only = 0;
518 #endif
519
520 return data;
521 }
522 #undef FUNC_NAME
523
524 SCM_DEFINE (scm_load_thunk_from_file, "load-thunk-from-file", 1, 0, 0,
525 (SCM filename),
526 "")
527 #define FUNC_NAME s_scm_load_thunk_from_file
528 {
529 char *c_filename;
530 int fd, is_read_only;
531 off_t end;
532 char *data;
533
534 SCM_VALIDATE_STRING (1, filename);
535
536 c_filename = scm_to_locale_string (filename);
537 fd = open (c_filename, O_RDONLY | O_BINARY | O_CLOEXEC);
538 free (c_filename);
539 if (fd < 0) SCM_SYSERROR;
540
541 end = lseek (fd, 0, SEEK_END);
542 if (end < 0)
543 SCM_SYSERROR;
544
545 data = map_file_contents (fd, end, &is_read_only);
546
547 (void) close (fd);
548
549 return load_thunk_from_memory (data, end, is_read_only);
550 }
551 #undef FUNC_NAME
552
553 SCM_DEFINE (scm_load_thunk_from_memory, "load-thunk-from-memory", 1, 0, 0,
554 (SCM bv),
555 "")
556 #define FUNC_NAME s_scm_load_thunk_from_memory
557 {
558 char *data;
559 size_t len;
560
561 SCM_VALIDATE_BYTEVECTOR (1, bv);
562
563 data = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
564 len = SCM_BYTEVECTOR_LENGTH (bv);
565
566 /* Copy data in order to align it, to trace its GC roots and
567 writable sections, and to keep it in memory. */
568
569 data = copy_and_align_elf_data (data, len);
570
571 return load_thunk_from_memory (data, len, 0);
572 }
573 #undef FUNC_NAME
574
575 \f
576
577 struct mapped_elf_image
578 {
579 char *start;
580 char *end;
581 char *frame_maps;
582 };
583
584 static struct mapped_elf_image *mapped_elf_images = NULL;
585 static size_t mapped_elf_images_count = 0;
586 static size_t mapped_elf_images_allocated = 0;
587
588 static size_t
589 find_mapped_elf_insertion_index (char *ptr)
590 {
591 /* "mapped_elf_images_count" must never be dereferenced. */
592 size_t start = 0, end = mapped_elf_images_count;
593
594 while (start < end)
595 {
596 size_t n = start + (end - start) / 2;
597
598 if (ptr < mapped_elf_images[n].end)
599 end = n;
600 else
601 start = n + 1;
602 }
603
604 return start;
605 }
606
607 static void
608 register_elf (char *data, size_t len, char *frame_maps)
609 {
610 scm_i_pthread_mutex_lock (&scm_i_misc_mutex);
611 {
612 /* My kingdom for a generic growable sorted vector library. */
613 if (mapped_elf_images_count == mapped_elf_images_allocated)
614 {
615 struct mapped_elf_image *prev;
616 size_t n;
617
618 if (mapped_elf_images_allocated)
619 mapped_elf_images_allocated *= 2;
620 else
621 mapped_elf_images_allocated = 16;
622
623 prev = mapped_elf_images;
624 mapped_elf_images =
625 scm_gc_malloc_pointerless (sizeof (*mapped_elf_images)
626 * mapped_elf_images_allocated,
627 "mapped elf images");
628
629 for (n = 0; n < mapped_elf_images_count; n++)
630 {
631 mapped_elf_images[n].start = prev[n].start;
632 mapped_elf_images[n].end = prev[n].end;
633 mapped_elf_images[n].frame_maps = prev[n].frame_maps;
634 }
635 }
636
637 {
638 size_t end;
639 size_t n = find_mapped_elf_insertion_index (data);
640
641 for (end = mapped_elf_images_count; n < end; end--)
642 {
643 const struct mapped_elf_image *prev = &mapped_elf_images[end - 1];
644 mapped_elf_images[end].start = prev->start;
645 mapped_elf_images[end].end = prev->end;
646 mapped_elf_images[end].frame_maps = prev->frame_maps;
647 }
648 mapped_elf_images_count++;
649
650 mapped_elf_images[n].start = data;
651 mapped_elf_images[n].end = data + len;
652 mapped_elf_images[n].frame_maps = frame_maps;
653 }
654 }
655 scm_i_pthread_mutex_unlock (&scm_i_misc_mutex);
656 }
657
658 static struct mapped_elf_image *
659 find_mapped_elf_image_unlocked (char *ptr)
660 {
661 size_t n = find_mapped_elf_insertion_index ((char *) ptr);
662
663 if (n < mapped_elf_images_count
664 && mapped_elf_images[n].start <= ptr
665 && ptr < mapped_elf_images[n].end)
666 return &mapped_elf_images[n];
667
668 return NULL;
669 }
670
671 static int
672 find_mapped_elf_image (char *ptr, struct mapped_elf_image *image)
673 {
674 int result;
675
676 scm_i_pthread_mutex_lock (&scm_i_misc_mutex);
677 {
678 struct mapped_elf_image *img = find_mapped_elf_image_unlocked (ptr);
679 if (img)
680 {
681 memcpy (image, img, sizeof (*image));
682 result = 1;
683 }
684 else
685 result = 0;
686 }
687 scm_i_pthread_mutex_unlock (&scm_i_misc_mutex);
688
689 return result;
690 }
691
692 static SCM
693 scm_find_mapped_elf_image (SCM ip)
694 {
695 struct mapped_elf_image image;
696
697 if (find_mapped_elf_image ((char *) scm_to_uintptr_t (ip), &image))
698 {
699 signed char *data = (signed char *) image.start;
700 size_t len = image.end - image.start;
701
702 return scm_c_take_gc_bytevector (data, len, SCM_BOOL_F);
703 }
704
705 return SCM_BOOL_F;
706 }
707
708 static SCM
709 scm_all_mapped_elf_images (void)
710 {
711 SCM result = SCM_EOL;
712
713 scm_i_pthread_mutex_lock (&scm_i_misc_mutex);
714 {
715 size_t n;
716 for (n = 0; n < mapped_elf_images_count; n++)
717 {
718 signed char *data = (signed char *) mapped_elf_images[n].start;
719 size_t len = mapped_elf_images[n].end - mapped_elf_images[n].start;
720 result = scm_cons (scm_c_take_gc_bytevector (data, len, SCM_BOOL_F),
721 result);
722 }
723 }
724 scm_i_pthread_mutex_unlock (&scm_i_misc_mutex);
725
726 return result;
727 }
728
729 struct frame_map_prefix
730 {
731 scm_t_uint32 text_offset;
732 scm_t_uint32 maps_offset;
733 };
734
735 struct frame_map_header
736 {
737 scm_t_uint32 addr;
738 scm_t_uint32 map_offset;
739 };
740
741 verify (sizeof (struct frame_map_prefix) == 8);
742 verify (sizeof (struct frame_map_header) == 8);
743
744 const scm_t_uint8 *
745 scm_find_dead_slot_map_unlocked (const scm_t_uint32 *ip)
746 {
747 struct mapped_elf_image *image;
748 char *base;
749 struct frame_map_prefix *prefix;
750 struct frame_map_header *headers;
751 scm_t_uintptr addr = (scm_t_uintptr) ip;
752 size_t start, end;
753
754 image = find_mapped_elf_image_unlocked ((char *) ip);
755 if (!image || !image->frame_maps)
756 return NULL;
757
758 base = image->frame_maps;
759 prefix = (struct frame_map_prefix *) base;
760 headers = (struct frame_map_header *) (base + sizeof (*prefix));
761
762 if (addr < ((scm_t_uintptr) image->start) + prefix->text_offset)
763 return NULL;
764 addr -= ((scm_t_uintptr) image->start) + prefix->text_offset;
765
766 start = 0;
767 end = (prefix->maps_offset - sizeof (*prefix)) / sizeof (*headers);
768
769 if (end == 0 || addr > headers[end - 1].addr)
770 return NULL;
771
772 while (start < end)
773 {
774 size_t n = start + (end - start) / 2;
775
776 if (addr == headers[n].addr)
777 return (const scm_t_uint8*) (base + headers[n].map_offset);
778 else if (addr < headers[n].addr)
779 end = n;
780 else
781 start = n + 1;
782 }
783
784 return NULL;
785 }
786
787 \f
788 void
789 scm_bootstrap_loader (void)
790 {
791 scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
792 "scm_init_loader",
793 (scm_t_extension_init_func)scm_init_loader, NULL);
794 }
795
796 void
797 scm_init_loader (void)
798 {
799 #ifndef SCM_MAGIC_SNARFER
800 #include "libguile/loader.x"
801 #endif
802
803 scm_c_define_gsubr ("find-mapped-elf-image", 1, 0, 0,
804 (scm_t_subr) scm_find_mapped_elf_image);
805 scm_c_define_gsubr ("all-mapped-elf-images", 0, 0, 0,
806 (scm_t_subr) scm_all_mapped_elf_images);
807 }
808
809 /*
810 Local Variables:
811 c-file-style: "gnu"
812 End:
813 */