d3df0a0821f490b9df09c025ec50f750b85c8ddd
[fw/sdcc] / support / gc / dyn_load.c
1 /*
2  * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
3  * Copyright (c) 1997 by Silicon Graphics.  All rights reserved.
4  *
5  * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
6  * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
7  *
8  * Permission is hereby granted to use or copy this program
9  * for any purpose,  provided the above notices are retained on all copies.
10  * Permission to modify the code and to distribute modified code is granted,
11  * provided the above notices are retained, and a notice that the code was
12  * modified is included with the above copyright notice.
13  *
14  * Original author: Bill Janssen
15  * Heavily modified by Hans Boehm and others
16  */
17
18 /*
19  * This is incredibly OS specific code for tracking down data sections in
20  * dynamic libraries.  There appears to be no way of doing this quickly
21  * without groveling through undocumented data structures.  We would argue
22  * that this is a bug in the design of the dlopen interface.  THIS CODE
23  * MAY BREAK IN FUTURE OS RELEASES.  If this matters to you, don't hesitate
24  * to let your vendor know ...
25  *
26  * None of this is safe with dlclose and incremental collection.
27  * But then not much of anything is safe in the presence of dlclose.
28  */
29 #ifndef MACOS
30 #  include <sys/types.h>
31 #endif
32 #include "gc_priv.h"
33
34 /* BTL: avoid circular redefinition of dlopen if SOLARIS_THREADS defined */
35 # if defined(SOLARIS_THREADS) && defined(dlopen)
36     /* To support threads in Solaris, gc.h interposes on dlopen by       */
37     /* defining "dlopen" to be "GC_dlopen", which is implemented below.  */
38     /* However, both GC_FirstDLOpenedLinkMap() and GC_dlopen() use the   */
39     /* real system dlopen() in their implementation. We first remove     */
40     /* gc.h's dlopen definition and restore it later, after GC_dlopen(). */
41 #   undef dlopen
42 #   define GC_must_restore_redefined_dlopen
43 # else
44 #   undef GC_must_restore_redefined_dlopen
45 # endif
46
47 #if (defined(DYNAMIC_LOADING) || defined(MSWIN32)) && !defined(PCR)
48 #if !defined(SUNOS4) && !defined(SUNOS5DL) && !defined(IRIX5) && \
49     !defined(MSWIN32) && !(defined(ALPHA) && defined(OSF1)) && \
50     !defined(HP_PA) && !(defined(LINUX) && defined(__ELF__)) && \
51     !defined(RS6000) && !defined(SCO_ELF)
52  --> We only know how to find data segments of dynamic libraries for the
53  --> above.  Additional SVR4 variants might not be too
54  --> hard to add.
55 #endif
56
57 #include <stdio.h>
58 #ifdef SUNOS5DL
59 #   include <sys/elf.h>
60 #   include <dlfcn.h>
61 #   include <link.h>
62 #endif
63 #ifdef SUNOS4
64 #   include <dlfcn.h>
65 #   include <link.h>
66 #   include <a.out.h>
67   /* struct link_map field overrides */
68 #   define l_next       lm_next
69 #   define l_addr       lm_addr
70 #   define l_name       lm_name
71 #endif
72
73
74 #if defined(SUNOS5DL) && !defined(USE_PROC_FOR_LIBRARIES)
75
76 #ifdef LINT
77     Elf32_Dyn _DYNAMIC;
78 #endif
79
80 static struct link_map *
81 GC_FirstDLOpenedLinkMap()
82 {
83     extern Elf32_Dyn _DYNAMIC;
84     Elf32_Dyn *dp;
85     struct r_debug *r;
86     static struct link_map * cachedResult = 0;
87     static Elf32_Dyn *dynStructureAddr = 0;
88                         /* BTL: added to avoid Solaris 5.3 ld.so _DYNAMIC bug */
89
90 #   ifdef SUNOS53_SHARED_LIB
91         /* BTL: Avoid the Solaris 5.3 bug that _DYNAMIC isn't being set */
92         /* up properly in dynamically linked .so's. This means we have  */
93         /* to use its value in the set of original object files loaded  */
94         /* at program startup.                                          */
95         if( dynStructureAddr == 0 ) {
96           void* startupSyms = dlopen(0, RTLD_LAZY);
97           dynStructureAddr = (Elf32_Dyn*)dlsym(startupSyms, "_DYNAMIC");
98                 }
99 #   else
100         dynStructureAddr = &_DYNAMIC;
101 #   endif
102
103     if( dynStructureAddr == 0) {
104         return(0);
105     }
106     if( cachedResult == 0 ) {
107         int tag;
108         for( dp = ((Elf32_Dyn *)(&_DYNAMIC)); (tag = dp->d_tag) != 0; dp++ ) {
109             if( tag == DT_DEBUG ) {
110                 struct link_map *lm
111                         = ((struct r_debug *)(dp->d_un.d_ptr))->r_map;
112                 if( lm != 0 ) cachedResult = lm->l_next; /* might be NIL */
113                 break;
114             }
115         }
116     }
117     return cachedResult;
118 }
119
120 #endif /* SUNOS5DL ... */
121
122 #if defined(SUNOS4) && !defined(USE_PROC_FOR_LIBRARIES)
123
124 #ifdef LINT
125     struct link_dynamic _DYNAMIC;
126 #endif
127
128 static struct link_map *
129 GC_FirstDLOpenedLinkMap()
130 {
131     extern struct link_dynamic _DYNAMIC;
132
133     if( &_DYNAMIC == 0) {
134         return(0);
135     }
136     return(_DYNAMIC.ld_un.ld_1->ld_loaded);
137 }
138
139 /* Return the address of the ld.so allocated common symbol      */
140 /* with the least address, or 0 if none.                        */
141 static ptr_t GC_first_common()
142 {
143     ptr_t result = 0;
144     extern struct link_dynamic _DYNAMIC;
145     struct rtc_symb * curr_symbol;
146     
147     if( &_DYNAMIC == 0) {
148         return(0);
149     }
150     curr_symbol = _DYNAMIC.ldd -> ldd_cp;
151     for (; curr_symbol != 0; curr_symbol = curr_symbol -> rtc_next) {
152         if (result == 0
153             || (ptr_t)(curr_symbol -> rtc_sp -> n_value) < result) {
154             result = (ptr_t)(curr_symbol -> rtc_sp -> n_value);
155         }
156     }
157     return(result);
158 }
159
160 #endif  /* SUNOS4 ... */
161
162 # if defined(SUNOS4) || defined(SUNOS5DL)
163 /* Add dynamic library data sections to the root set.           */
164 # if !defined(PCR) && !defined(SOLARIS_THREADS) && defined(THREADS)
165 #   ifndef SRC_M3
166         --> fix mutual exclusion with dlopen
167 #   endif  /* We assume M3 programs don't call dlopen for now */
168 # endif
169
170 # ifdef SOLARIS_THREADS
171   /* Redefine dlopen to guarantee mutual exclusion with */
172   /* GC_register_dynamic_libraries.                     */
173   /* assumes that dlopen doesn't need to call GC_malloc */
174   /* and friends.                                       */
175 # include <thread.h>
176 # include <synch.h>
177
178 void * GC_dlopen(const char *path, int mode)
179 {
180     void * result;
181     
182 #   ifndef USE_PROC_FOR_LIBRARIES
183       mutex_lock(&GC_allocate_ml);
184 #   endif
185     result = dlopen(path, mode);
186 #   ifndef USE_PROC_FOR_LIBRARIES
187       mutex_unlock(&GC_allocate_ml);
188 #   endif
189     return(result);
190 }
191 # endif  /* SOLARIS_THREADS */
192
193 /* BTL: added to fix circular dlopen definition if SOLARIS_THREADS defined */
194 # if defined(GC_must_restore_redefined_dlopen)
195 #   define dlopen GC_dlopen
196 # endif
197
198 # ifndef USE_PROC_FOR_LIBRARIES
199 void GC_register_dynamic_libraries()
200 {
201   struct link_map *lm = GC_FirstDLOpenedLinkMap();
202   
203
204   for (lm = GC_FirstDLOpenedLinkMap();
205        lm != (struct link_map *) 0;  lm = lm->l_next)
206     {
207 #     ifdef SUNOS4
208         struct exec *e;
209          
210         e = (struct exec *) lm->lm_addr;
211         GC_add_roots_inner(
212                     ((char *) (N_DATOFF(*e) + lm->lm_addr)),
213                     ((char *) (N_BSSADDR(*e) + e->a_bss + lm->lm_addr)),
214                     TRUE);
215 #     endif
216 #     ifdef SUNOS5DL
217         Elf32_Ehdr * e;
218         Elf32_Phdr * p;
219         unsigned long offset;
220         char * start;
221         register int i;
222         
223         e = (Elf32_Ehdr *) lm->l_addr;
224         p = ((Elf32_Phdr *)(((char *)(e)) + e->e_phoff));
225         offset = ((unsigned long)(lm->l_addr));
226         for( i = 0; i < (int)(e->e_phnum); ((i++),(p++)) ) {
227           switch( p->p_type ) {
228             case PT_LOAD:
229               {
230                 if( !(p->p_flags & PF_W) ) break;
231                 start = ((char *)(p->p_vaddr)) + offset;
232                 GC_add_roots_inner(
233                   start,
234                   start + p->p_memsz,
235                   TRUE
236                 );
237               }
238               break;
239             default:
240               break;
241           }
242         }
243 #     endif
244     }
245 #   ifdef SUNOS4
246       {
247         static ptr_t common_start = 0;
248         ptr_t common_end;
249         extern ptr_t GC_find_limit();
250         
251         if (common_start == 0) common_start = GC_first_common();
252         if (common_start != 0) {
253             common_end = GC_find_limit(common_start, TRUE);
254             GC_add_roots_inner((char *)common_start, (char *)common_end, TRUE);
255         }
256       }
257 #   endif
258 }
259
260 # endif /* !USE_PROC ... */
261 # endif /* SUNOS */
262
263 #if defined(LINUX) && defined(__ELF__) || defined(SCO_ELF)
264
265 /* Dynamic loading code for Linux running ELF. Somewhat tested on
266  * Linux/x86, untested but hopefully should work on Linux/Alpha. 
267  * This code was derived from the Solaris/ELF support. Thanks to
268  * whatever kind soul wrote that.  - Patrick Bridges */
269
270 #include <elf.h>
271 #include <link.h>
272
273 /* Newer versions of Linux/Alpha and Linux/x86 define this macro.  We
274  * define it for those older versions that don't.  */
275 #  ifndef ElfW
276 #    if !defined(ELF_CLASS) || ELF_CLASS == ELFCLASS32
277 #      define ElfW(type) Elf32_##type
278 #    else
279 #      define ElfW(type) Elf64_##type
280 #    endif
281 #  endif
282
283 static struct link_map *
284 GC_FirstDLOpenedLinkMap()
285 {
286 #   ifdef __GNUC__
287 #     pragma weak _DYNAMIC
288 #   endif
289     extern ElfW(Dyn) _DYNAMIC[];
290     ElfW(Dyn) *dp;
291     struct r_debug *r;
292     static struct link_map *cachedResult = 0;
293
294     if( _DYNAMIC == 0) {
295         return(0);
296     }
297     if( cachedResult == 0 ) {
298         int tag;
299         for( dp = _DYNAMIC; (tag = dp->d_tag) != 0; dp++ ) {
300             if( tag == DT_DEBUG ) {
301                 struct link_map *lm
302                         = ((struct r_debug *)(dp->d_un.d_ptr))->r_map;
303                 if( lm != 0 ) cachedResult = lm->l_next; /* might be NIL */
304                 break;
305             }
306         }
307     }
308     return cachedResult;
309 }
310
311
312 void GC_register_dynamic_libraries()
313 {
314   struct link_map *lm = GC_FirstDLOpenedLinkMap();
315   
316
317   for (lm = GC_FirstDLOpenedLinkMap();
318        lm != (struct link_map *) 0;  lm = lm->l_next)
319     {
320         ElfW(Ehdr) * e;
321         ElfW(Phdr) * p;
322         unsigned long offset;
323         char * start;
324         register int i;
325         
326         e = (ElfW(Ehdr) *) lm->l_addr;
327         p = ((ElfW(Phdr) *)(((char *)(e)) + e->e_phoff));
328         offset = ((unsigned long)(lm->l_addr));
329         for( i = 0; i < (int)(e->e_phnum); ((i++),(p++)) ) {
330           switch( p->p_type ) {
331             case PT_LOAD:
332               {
333                 if( !(p->p_flags & PF_W) ) break;
334                 start = ((char *)(p->p_vaddr)) + offset;
335                 GC_add_roots_inner(start, start + p->p_memsz, TRUE);
336               }
337               break;
338             default:
339               break;
340           }
341         }
342     }
343 }
344
345 #endif
346
347 #if defined(IRIX5) || defined(USE_PROC_FOR_LIBRARIES)
348
349 #include <sys/procfs.h>
350 #include <sys/stat.h>
351 #include <fcntl.h>
352 #include <elf.h>
353 #include <errno.h>
354
355 extern void * GC_roots_present();
356         /* The type is a lie, since the real type doesn't make sense here, */
357         /* and we only test for NULL.                                      */
358
359 extern ptr_t GC_scratch_last_end_ptr; /* End of GC_scratch_alloc arena  */
360
361 /* We use /proc to track down all parts of the address space that are   */
362 /* mapped by the process, and throw out regions we know we shouldn't    */
363 /* worry about.  This may also work under other SVR4 variants.          */
364 void GC_register_dynamic_libraries()
365 {
366     static int fd = -1;
367     char buf[30];
368     static prmap_t * addr_map = 0;
369     static int current_sz = 0;  /* Number of records currently in addr_map */
370     static int needed_sz;       /* Required size of addr_map            */
371     register int i;
372     register long flags;
373     register ptr_t start;
374     register ptr_t limit;
375     ptr_t heap_start = (ptr_t)HEAP_START;
376     ptr_t heap_end = heap_start;
377
378 #   ifdef SUNOS5DL
379 #     define MA_PHYS 0
380 #   endif /* SUNOS5DL */
381
382     if (fd < 0) {
383       sprintf(buf, "/proc/%d", getpid());
384         /* The above generates a lint complaint, since pid_t varies.    */
385         /* It's unclear how to improve this.                            */
386       fd = open(buf, O_RDONLY);
387       if (fd < 0) {
388         ABORT("/proc open failed");
389       }
390     }
391     if (ioctl(fd, PIOCNMAP, &needed_sz) < 0) {
392         GC_err_printf2("fd = %d, errno = %d\n", fd, errno);
393         ABORT("/proc PIOCNMAP ioctl failed");
394     }
395     if (needed_sz >= current_sz) {
396         current_sz = needed_sz * 2 + 1;
397                         /* Expansion, plus room for 0 record */
398         addr_map = (prmap_t *)GC_scratch_alloc((word)
399                                                 (current_sz * sizeof(prmap_t)));
400     }
401     if (ioctl(fd, PIOCMAP, addr_map) < 0) {
402         GC_err_printf4("fd = %d, errno = %d, needed_sz = %d, addr_map = 0x%X\n",
403                         fd, errno, needed_sz, addr_map);
404         ABORT("/proc PIOCMAP ioctl failed");
405     };
406     if (GC_n_heap_sects > 0) {
407         heap_end = GC_heap_sects[GC_n_heap_sects-1].hs_start
408                         + GC_heap_sects[GC_n_heap_sects-1].hs_bytes;
409         if (heap_end < GC_scratch_last_end_ptr) heap_end = GC_scratch_last_end_ptr; 
410     }
411     for (i = 0; i < needed_sz; i++) {
412         flags = addr_map[i].pr_mflags;
413         if ((flags & (MA_BREAK | MA_STACK | MA_PHYS)) != 0) goto irrelevant;
414         if ((flags & (MA_READ | MA_WRITE)) != (MA_READ | MA_WRITE))
415             goto irrelevant;
416           /* The latter test is empirically useless.  Other than the    */
417           /* main data and stack segments, everything appears to be     */
418           /* mapped readable, writable, executable, and shared(!!).     */
419           /* This makes no sense to me. - HB                            */
420         start = (ptr_t)(addr_map[i].pr_vaddr);
421         if (GC_roots_present(start)) goto irrelevant;
422         if (start < heap_end && start >= heap_start)
423                 goto irrelevant;
424 #       ifdef MMAP_STACKS
425           if (GC_is_thread_stack(start)) goto irrelevant;
426 #       endif /* MMAP_STACKS */
427
428         limit = start + addr_map[i].pr_size;
429         if (addr_map[i].pr_off == 0 && strncmp(start, ELFMAG, 4) == 0) {
430             /* Discard text segments, i.e. 0-offset mappings against    */
431             /* executable files which appear to have ELF headers.       */
432             caddr_t arg;
433             int obj;
434 #           define MAP_IRR_SZ 10
435             static ptr_t map_irr[MAP_IRR_SZ];
436                                         /* Known irrelevant map entries */
437             static int n_irr = 0;
438             struct stat buf;
439             register int i;
440             
441             for (i = 0; i < n_irr; i++) {
442                 if (map_irr[i] == start) goto irrelevant;
443             }
444             arg = (caddr_t)start;
445             obj = ioctl(fd, PIOCOPENM, &arg);
446             if (obj >= 0) {
447                 fstat(obj, &buf);
448                 close(obj);
449                 if ((buf.st_mode & 0111) != 0) {
450                     if (n_irr < MAP_IRR_SZ) {
451                         map_irr[n_irr++] = start;
452                     }
453                     goto irrelevant;
454                 }
455             }
456         }
457         GC_add_roots_inner(start, limit, TRUE);
458       irrelevant: ;
459     }
460     /* Dont keep cached descriptor, for now.  Some kernels don't like us */
461     /* to keep a /proc file descriptor around during kill -9.            */
462         if (close(fd) < 0) ABORT("Couldnt close /proc file");
463         fd = -1;
464 }
465
466 # endif /* USE_PROC || IRIX5 */
467
468 # ifdef MSWIN32
469
470 # define WIN32_LEAN_AND_MEAN
471 # define NOSERVICE
472 # include <windows.h>
473 # include <stdlib.h>
474
475   /* We traverse the entire address space and register all segments     */
476   /* that could possibly have been written to.                          */
477   DWORD GC_allocation_granularity;
478   
479   extern GC_bool GC_is_heap_base (ptr_t p);
480
481 # ifdef WIN32_THREADS
482     extern void GC_get_next_stack(char *start, char **lo, char **hi);
483 # endif
484   
485   void GC_cond_add_roots(char *base, char * limit)
486   {
487     char dummy;
488     char * stack_top
489            = (char *) ((word)(&dummy) & ~(GC_allocation_granularity-1));
490     if (base == limit) return;
491 #   ifdef WIN32_THREADS
492     {
493         char * curr_base = base;
494         char * next_stack_lo;
495         char * next_stack_hi;
496         
497         for(;;) {
498             GC_get_next_stack(curr_base, &next_stack_lo, &next_stack_hi);
499             if (next_stack_lo >= limit) break;
500             GC_add_roots_inner(curr_base, next_stack_lo, TRUE);
501             curr_base = next_stack_hi;
502         }
503         if (curr_base < limit) GC_add_roots_inner(curr_base, limit, TRUE);
504     }
505 #   else
506         if (limit > stack_top && base < GC_stackbottom) {
507             /* Part of the stack; ignore it. */
508             return;
509         }
510         GC_add_roots_inner(base, limit, TRUE);
511 #   endif
512   }
513   
514   extern GC_bool GC_win32s;
515   
516   void GC_register_dynamic_libraries()
517   {
518     MEMORY_BASIC_INFORMATION buf;
519     SYSTEM_INFO sysinfo;
520     DWORD result;
521     DWORD protect;
522     LPVOID p;
523     char * base;
524     char * limit, * new_limit;
525     
526     if (GC_win32s) return;
527     GetSystemInfo(&sysinfo);
528     base = limit = p = sysinfo.lpMinimumApplicationAddress;
529     GC_allocation_granularity = sysinfo.dwAllocationGranularity;
530     while (p < sysinfo.lpMaximumApplicationAddress) {
531         result = VirtualQuery(p, &buf, sizeof(buf));
532         if (result != sizeof(buf)) {
533             ABORT("Weird VirtualQuery result");
534         }
535         new_limit = (char *)p + buf.RegionSize;
536         protect = buf.Protect;
537         if (buf.State == MEM_COMMIT
538             && (protect == PAGE_EXECUTE_READWRITE
539                 || protect == PAGE_READWRITE)
540             && !GC_is_heap_base(buf.AllocationBase)) {
541             if ((char *)p == limit) {
542                 limit = new_limit;
543             } else {
544                 GC_cond_add_roots(base, limit);
545                 base = p;
546                 limit = new_limit;
547             }
548         }
549         if (p > (LPVOID)new_limit /* overflow */) break;
550         p = (LPVOID)new_limit;
551     }
552     GC_cond_add_roots(base, limit);
553   }
554
555 #endif /* MSWIN32 */
556
557 #if defined(ALPHA) && defined(OSF1)
558
559 #include <loader.h>
560
561 void GC_register_dynamic_libraries()
562 {
563   int status;
564   ldr_process_t mypid;
565
566   /* module */
567     ldr_module_t moduleid = LDR_NULL_MODULE;
568     ldr_module_info_t moduleinfo;
569     size_t moduleinfosize = sizeof(moduleinfo);
570     size_t modulereturnsize;    
571
572   /* region */
573     ldr_region_t region; 
574     ldr_region_info_t regioninfo;
575     size_t regioninfosize = sizeof(regioninfo);
576     size_t regionreturnsize;
577
578   /* Obtain id of this process */
579     mypid = ldr_my_process();
580   
581   /* For each module */
582     while (TRUE) {
583
584       /* Get the next (first) module */
585         status = ldr_next_module(mypid, &moduleid);
586
587       /* Any more modules? */
588         if (moduleid == LDR_NULL_MODULE)
589             break;    /* No more modules */
590
591       /* Check status AFTER checking moduleid because */
592       /* of a bug in the non-shared ldr_next_module stub */
593         if (status != 0 ) {
594             GC_printf1("dynamic_load: status = %ld\n", (long)status);
595             {
596                 extern char *sys_errlist[];
597                 extern int sys_nerr;
598                 extern int errno;
599                 if (errno <= sys_nerr) {
600                     GC_printf1("dynamic_load: %s\n", (long)sys_errlist[errno]);
601                } else {
602                     GC_printf1("dynamic_load: %d\n", (long)errno);
603                 }
604         }
605             ABORT("ldr_next_module failed");
606          }
607
608       /* Get the module information */
609         status = ldr_inq_module(mypid, moduleid, &moduleinfo,
610                                 moduleinfosize, &modulereturnsize); 
611         if (status != 0 )
612             ABORT("ldr_inq_module failed");
613
614       /* is module for the main program (i.e. nonshared portion)? */
615           if (moduleinfo.lmi_flags & LDR_MAIN)
616               continue;    /* skip the main module */
617
618 #     ifdef VERBOSE
619           GC_printf("---Module---\n");
620           GC_printf("Module ID            = %16ld\n", moduleinfo.lmi_modid);
621           GC_printf("Count of regions     = %16d\n", moduleinfo.lmi_nregion);
622           GC_printf("flags for module     = %16lx\n", moduleinfo.lmi_flags); 
623           GC_printf("pathname of module   = \"%s\"\n", moduleinfo.lmi_name);
624 #     endif
625
626       /* For each region in this module */
627         for (region = 0; region < moduleinfo.lmi_nregion; region++) {
628
629           /* Get the region information */
630             status = ldr_inq_region(mypid, moduleid, region, &regioninfo,
631                                     regioninfosize, &regionreturnsize);
632             if (status != 0 )
633                 ABORT("ldr_inq_region failed");
634
635           /* only process writable (data) regions */
636             if (! (regioninfo.lri_prot & LDR_W))
637                 continue;
638
639 #         ifdef VERBOSE
640               GC_printf("--- Region ---\n");
641               GC_printf("Region number    = %16ld\n",
642                         regioninfo.lri_region_no);
643               GC_printf("Protection flags = %016x\n",  regioninfo.lri_prot);
644               GC_printf("Virtual address  = %16p\n",   regioninfo.lri_vaddr);
645               GC_printf("Mapped address   = %16p\n",   regioninfo.lri_mapaddr);
646               GC_printf("Region size      = %16ld\n",  regioninfo.lri_size);
647               GC_printf("Region name      = \"%s\"\n", regioninfo.lri_name);
648 #         endif
649
650           /* register region as a garbage collection root */
651             GC_add_roots_inner (
652                 (char *)regioninfo.lri_mapaddr,
653                 (char *)regioninfo.lri_mapaddr + regioninfo.lri_size,
654                 TRUE);
655
656         }
657     }
658 }
659 #endif
660
661 #if defined(HP_PA)
662
663 #include <errno.h>
664 #include <dl.h>
665
666 extern int errno;
667 extern char *sys_errlist[];
668 extern int sys_nerr;
669
670 void GC_register_dynamic_libraries()
671 {
672   int status;
673   int index = 1; /* Ordinal position in shared library search list */
674   struct shl_descriptor *shl_desc; /* Shared library info, see dl.h */
675
676   /* For each dynamic library loaded */
677     while (TRUE) {
678
679       /* Get info about next shared library */
680         status = shl_get(index, &shl_desc);
681
682       /* Check if this is the end of the list or if some error occured */
683         if (status != 0) {
684           if (errno == EINVAL) {
685               break; /* Moved past end of shared library list --> finished */
686           } else {
687               if (errno <= sys_nerr) {
688                     GC_printf1("dynamic_load: %s\n", (long) sys_errlist[errno]);
689               } else {
690                     GC_printf1("dynamic_load: %d\n", (long) errno);
691               }
692               ABORT("shl_get failed");
693           }
694         }
695
696 #     ifdef VERBOSE
697           GC_printf0("---Shared library---\n");
698           GC_printf1("\tfilename        = \"%s\"\n", shl_desc->filename);
699           GC_printf1("\tindex           = %d\n", index);
700           GC_printf1("\thandle          = %08x\n",
701                                         (unsigned long) shl_desc->handle);
702           GC_printf1("\ttext seg. start = %08x\n", shl_desc->tstart);
703           GC_printf1("\ttext seg. end   = %08x\n", shl_desc->tend);
704           GC_printf1("\tdata seg. start = %08x\n", shl_desc->dstart);
705           GC_printf1("\tdata seg. end   = %08x\n", shl_desc->dend);
706           GC_printf1("\tref. count      = %lu\n", shl_desc->ref_count);
707 #     endif
708
709       /* register shared library's data segment as a garbage collection root */
710         GC_add_roots_inner((char *) shl_desc->dstart,
711                            (char *) shl_desc->dend, TRUE);
712
713         index++;
714     }
715 }
716 #endif /* HP_PA */
717
718 #ifdef RS6000
719 #pragma alloca
720 #include <sys/ldr.h>
721 #include <sys/errno.h>
722 void GC_register_dynamic_libraries()
723 {
724         int len;
725         char *ldibuf;
726         int ldibuflen;
727         struct ld_info *ldi;
728
729         ldibuf = alloca(ldibuflen = 8192);
730
731         while ( (len = loadquery(L_GETINFO,ldibuf,ldibuflen)) < 0) {
732                 if (errno != ENOMEM) {
733                         ABORT("loadquery failed");
734                 }
735                 ldibuf = alloca(ldibuflen *= 2);
736         }
737
738         ldi = (struct ld_info *)ldibuf;
739         while (ldi) {
740                 len = ldi->ldinfo_next;
741                 GC_add_roots_inner(
742                                 ldi->ldinfo_dataorg,
743                                 (unsigned long)ldi->ldinfo_dataorg
744                                 + ldi->ldinfo_datasize,
745                                 TRUE);
746                 ldi = len ? (struct ld_info *)((char *)ldi + len) : 0;
747         }
748 }
749 #endif /* RS6000 */
750
751
752
753 #else /* !DYNAMIC_LOADING */
754
755 #ifdef PCR
756
757 #   include "il/PCR_IL.h"
758 #   include "th/PCR_ThCtl.h"
759 #   include "mm/PCR_MM.h"
760
761 void GC_register_dynamic_libraries()
762 {
763     /* Add new static data areas of dynamically loaded modules. */
764         {
765           PCR_IL_LoadedFile * p = PCR_IL_GetLastLoadedFile();
766           PCR_IL_LoadedSegment * q;
767           
768           /* Skip uncommited files */
769           while (p != NIL && !(p -> lf_commitPoint)) {
770               /* The loading of this file has not yet been committed    */
771               /* Hence its description could be inconsistent.           */
772               /* Furthermore, it hasn't yet been run.  Hence its data   */
773               /* segments can't possibly reference heap allocated       */
774               /* objects.                                               */
775               p = p -> lf_prev;
776           }
777           for (; p != NIL; p = p -> lf_prev) {
778             for (q = p -> lf_ls; q != NIL; q = q -> ls_next) {
779               if ((q -> ls_flags & PCR_IL_SegFlags_Traced_MASK)
780                   == PCR_IL_SegFlags_Traced_on) {
781                 GC_add_roots_inner
782                         ((char *)(q -> ls_addr), 
783                          (char *)(q -> ls_addr) + q -> ls_bytes,
784                          TRUE);
785               }
786             }
787           }
788         }
789 }
790
791
792 #else /* !PCR */
793
794 void GC_register_dynamic_libraries(){}
795
796 int GC_no_dynamic_loading;
797
798 #endif /* !PCR */
799 #endif /* !DYNAMIC_LOADING */