diff options
-rw-r--r-- | libguile/Makefile.am | 14 | ||||
-rw-r--r-- | libguile/gc-card.c | 485 | ||||
-rw-r--r-- | libguile/gc-freelist.c | 192 | ||||
-rw-r--r-- | libguile/gc-mark.c | 511 | ||||
-rw-r--r-- | libguile/gc-segment.c | 561 | ||||
-rw-r--r-- | libguile/gc_os_dep.c | 1939 |
6 files changed, 7 insertions, 3695 deletions
diff --git a/libguile/Makefile.am b/libguile/Makefile.am index fc0a9e374..531390183 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -96,8 +96,8 @@ libguile_la_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.c \ chars.c continuations.c convert.c debug.c deprecation.c \ deprecated.c discouraged.c dynwind.c environments.c eq.c error.c \ eval.c evalext.c extensions.c feature.c fluids.c fports.c \ - futures.c gc.c gc-malloc.c \ - gdbint.c gh_data.c gh_eval.c gh_funcs.c \ + futures.c gc.c gc-malloc.c \ + gdbint.c gh_data.c gh_eval.c gh_funcs.c \ gh_init.c gh_io.c gh_list.c gh_predicates.c goops.c gsubr.c \ guardians.c hash.c hashtab.c hooks.c i18n.c init.c inline.c \ ioext.c keywords.c lang.c list.c load.c macros.c mallocs.c \ @@ -112,8 +112,8 @@ libguile_la_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.c \ DOT_X_FILES = alist.x arbiters.x async.x backtrace.x boolean.x chars.x \ continuations.x debug.x deprecation.x deprecated.x discouraged.x \ dynl.x dynwind.x environments.x eq.x error.x eval.x evalext.x \ - extensions.x feature.x fluids.x fports.x futures.x gc.x \ - goops.x gsubr.x guardians.x \ + extensions.x feature.x fluids.x fports.x futures.x gc.x \ + goops.x gsubr.x guardians.x \ hash.x hashtab.x hooks.x i18n.x init.x ioext.x keywords.x lang.x \ list.x load.x macros.x mallocs.x modules.x numbers.x objects.x \ objprop.x options.x pairs.x ports.x print.x procprop.x procs.x \ @@ -130,8 +130,8 @@ DOT_DOC_FILES = alist.doc arbiters.doc async.doc backtrace.doc \ deprecated.doc discouraged.doc dynl.doc dynwind.doc \ environments.doc eq.doc error.doc eval.doc evalext.doc \ extensions.doc feature.doc fluids.doc fports.doc futures.doc \ - gc.doc goops.doc gsubr.doc \ - gc-malloc.doc guardians.doc hash.doc hashtab.doc \ + gc.doc goops.doc gsubr.doc \ + gc-malloc.doc guardians.doc hash.doc hashtab.doc \ hooks.doc i18n.doc init.doc ioext.doc keywords.doc lang.doc \ list.doc load.doc macros.doc mallocs.doc modules.doc numbers.doc \ objects.doc objprop.doc options.doc pairs.doc ports.doc print.doc \ @@ -153,7 +153,7 @@ EXTRA_libguile_la_SOURCES = _scm.h \ inet_aton.c memmove.c putenv.c strerror.c \ dynl.c regex-posix.c \ filesys.c posix.c net_db.c socket.c \ - debug-malloc.c mkstemp.c \ + debug-malloc.c mkstemp.c \ win32-uname.c win32-dirent.c win32-socket.c ## delete guile-snarf.awk from the installation bindir, in case it's diff --git a/libguile/gc-card.c b/libguile/gc-card.c deleted file mode 100644 index 5477f650c..000000000 --- a/libguile/gc-card.c +++ /dev/null @@ -1,485 +0,0 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2004, 2005, 2006 Free Software Foundation, Inc. - * - * This library is free software; you can redistribute it and/or - * modify it under the terms of the GNU Lesser General Public - * License as published by the Free Software Foundation; either - * version 2.1 of the License, or (at your option) any later version. - * - * This library is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - * Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public - * License along with this library; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA - */ - - -#include <stdio.h> -#include <gmp.h> - -#include "libguile/_scm.h" -#include "libguile/eval.h" -#include "libguile/numbers.h" -#include "libguile/stime.h" -#include "libguile/stackchk.h" -#include "libguile/struct.h" -#include "libguile/smob.h" -#include "libguile/unif.h" -#include "libguile/async.h" -#include "libguile/ports.h" -#include "libguile/root.h" -#include "libguile/strings.h" -#include "libguile/vectors.h" -#include "libguile/weaks.h" -#include "libguile/hashtab.h" -#include "libguile/tags.h" -#include "libguile/private-gc.h" -#include "libguile/validate.h" -#include "libguile/deprecation.h" -#include "libguile/gc.h" -#include "libguile/srfi-4.h" - -#include "libguile/private-gc.h" - -long int scm_i_deprecated_memory_return; - - -/* During collection, this accumulates structures which are to be freed. - */ -SCM scm_i_structs_to_free; - - -/* - Init all the free cells in CARD, prepending to *FREE_LIST. - - Return: number of free cells found in this card. - - It would be cleaner to have a separate function sweep_value(), but - that is too slow (functions with switch statements can't be - inlined). - - - - - NOTE: - - This function is quite efficient. However, for many types of cells, - allocation and a de-allocation involves calling malloc() and - free(). - - This is costly for small objects (due to malloc/free overhead.) - (should measure this). - - It might also be bad for threads: if several threads are allocating - strings concurrently, then mallocs for both threads may have to - fiddle with locks. - - It might be interesting to add a separate memory pool for small - objects to each freelist. - - --hwn. - */ -int -scm_i_sweep_card (scm_t_cell * p, SCM *free_list, scm_t_heap_segment*seg) -#define FUNC_NAME "sweep_card" -{ - scm_t_c_bvec_long *bitvec = SCM_GC_CARD_BVEC(p); - scm_t_cell * end = p + SCM_GC_CARD_N_CELLS; - int span = seg->span; - int offset =SCM_MAX (SCM_GC_CARD_N_HEADER_CELLS, span); - int free_count = 0; - - /* - I tried something fancy with shifting by one bit every word from - the bitvec in turn, but it wasn't any faster, but quite a bit - hairier. - */ - for (p += offset; p < end; p += span, offset += span) - { - SCM scmptr = PTR2SCM (p); - if (SCM_C_BVEC_GET (bitvec, offset)) - continue; - - switch (SCM_TYP7 (scmptr)) - { - case scm_tcs_struct: - /* The card can be swept more than once. Check that it's - * the first time! - */ - if (!SCM_STRUCT_GC_CHAIN (scmptr)) - { - /* Structs need to be freed in a special order. - * This is handled by GC C hooks in struct.c. - */ - SCM_SET_STRUCT_GC_CHAIN (scmptr, scm_i_structs_to_free); - scm_i_structs_to_free = scmptr; - } - continue; - - case scm_tcs_cons_imcar: - case scm_tcs_cons_nimcar: - case scm_tcs_closures: - case scm_tc7_pws: - break; - case scm_tc7_wvect: - case scm_tc7_vector: - scm_i_vector_free (scmptr); - break; - -#ifdef CCLO - case scm_tc7_cclo: - scm_gc_free (SCM_CCLO_BASE (scmptr), - SCM_CCLO_LENGTH (scmptr) * sizeof (SCM), - "compiled closure"); - break; -#endif - - case scm_tc7_number: - switch SCM_TYP16 (scmptr) - { - case scm_tc16_real: - break; - case scm_tc16_big: - mpz_clear (SCM_I_BIG_MPZ (scmptr)); - /* nothing else to do here since the mpz is in a double cell */ - break; - case scm_tc16_complex: - scm_gc_free (SCM_COMPLEX_MEM (scmptr), sizeof (scm_t_complex), - "complex"); - break; - case scm_tc16_fraction: - /* nothing to do here since the num/denum of a fraction - are proper SCM objects themselves. */ - break; - } - break; - case scm_tc7_string: - scm_i_string_free (scmptr); - break; - case scm_tc7_stringbuf: - scm_i_stringbuf_free (scmptr); - break; - case scm_tc7_symbol: - scm_i_symbol_free (scmptr); - break; - case scm_tc7_variable: - break; - case scm_tcs_subrs: - /* the various "subrs" (primitives) are never freed */ - continue; - case scm_tc7_port: - if SCM_OPENP (scmptr) - { - int k = SCM_PTOBNUM (scmptr); - size_t mm; -#if (SCM_DEBUG_CELL_ACCESSES == 1) - if (!(k < scm_numptob)) - { - fprintf (stderr, "undefined port type"); - abort(); - } -#endif - /* Keep "revealed" ports alive. */ - if (scm_revealed_count (scmptr) > 0) - continue; - - /* Yes, I really do mean scm_ptobs[k].free */ - /* rather than ftobs[k].close. .close */ - /* is for explicit CLOSE-PORT by user */ - mm = scm_ptobs[k].free (scmptr); - - if (mm != 0) - { -#if SCM_ENABLE_DEPRECATED == 1 - scm_c_issue_deprecation_warning - ("Returning non-0 from a port free function is " - "deprecated. Use scm_gc_free et al instead."); - scm_c_issue_deprecation_warning_fmt - ("(You just returned non-0 while freeing a %s.)", - SCM_PTOBNAME (k)); - scm_i_deprecated_memory_return += mm; -#else - abort (); -#endif - } - - SCM_SETSTREAM (scmptr, 0); - scm_remove_from_port_table (scmptr); - scm_gc_ports_collected++; - SCM_CLR_PORT_OPEN_FLAG (scmptr); - } - break; - case scm_tc7_smob: - switch SCM_TYP16 (scmptr) - { - case scm_tc_free_cell: - free_count --; - break; - default: - { - int k; - k = SCM_SMOBNUM (scmptr); -#if (SCM_DEBUG_CELL_ACCESSES == 1) - if (!(k < scm_numsmob)) - { - fprintf (stderr, "undefined smob type"); - abort(); - } -#endif - if (scm_smobs[k].free) - { - size_t mm; - mm = scm_smobs[k].free (scmptr); - if (mm != 0) - { -#if SCM_ENABLE_DEPRECATED == 1 - scm_c_issue_deprecation_warning - ("Returning non-0 from a smob free function is " - "deprecated. Use scm_gc_free et al instead."); - scm_c_issue_deprecation_warning_fmt - ("(You just returned non-0 while freeing a %s.)", - SCM_SMOBNAME (k)); - scm_i_deprecated_memory_return += mm; -#else - abort(); -#endif - } - } - break; - } - } - break; - default: - fprintf (stderr, "unknown type"); - abort(); - } - - SCM_GC_SET_CELL_WORD (scmptr, 0, scm_tc_free_cell); - SCM_SET_FREE_CELL_CDR (scmptr, PTR2SCM (*free_list)); - *free_list = scmptr; - free_count ++; - } - - return free_count; -} -#undef FUNC_NAME - - -/* - Like sweep, but no complicated logic to do the sweeping. - */ -int -scm_i_init_card_freelist (scm_t_cell * card, SCM *free_list, - scm_t_heap_segment*seg) -{ - int span = seg->span; - scm_t_cell *end = card + SCM_GC_CARD_N_CELLS; - scm_t_cell *p = end - span; - - scm_t_c_bvec_long * bvec_ptr = (scm_t_c_bvec_long* ) seg->bounds[1]; - int idx = (card - seg->bounds[0]) / SCM_GC_CARD_N_CELLS; - - bvec_ptr += idx *SCM_GC_CARD_BVEC_SIZE_IN_LONGS; - SCM_GC_SET_CELL_BVEC (card, bvec_ptr); - - /* - ASSUMPTION: n_header_cells <= 2. - */ - for (; p > card; p -= span) - { - const SCM scmptr = PTR2SCM (p); - SCM_GC_SET_CELL_WORD (scmptr, 0, scm_tc_free_cell); - SCM_SET_FREE_CELL_CDR (scmptr, PTR2SCM (*free_list)); - *free_list = scmptr; - } - - return SCM_GC_CARD_N_CELLS - SCM_MAX(span, SCM_GC_CARD_N_HEADER_CELLS); -} - - -void -scm_i_card_statistics (scm_t_cell *p, SCM hashtab, scm_t_heap_segment *seg) -{ - scm_t_c_bvec_long *bitvec = SCM_GC_CARD_BVEC(p); - scm_t_cell * end = p + SCM_GC_CARD_N_CELLS; - int span = seg->span; - int offset = SCM_MAX (SCM_GC_CARD_N_HEADER_CELLS, span); - - if (!bitvec) - /* Card P hasn't been initialized yet by `scm_i_init_card_freelist ()'. */ - return; - - for (p += offset; p < end; p += span, offset += span) - { - scm_t_bits tag = -1; - SCM scmptr = PTR2SCM (p); - - if (!SCM_C_BVEC_GET (bitvec, offset)) - continue; - - tag = SCM_TYP7 (scmptr); - if (tag == scm_tc7_smob) - { - tag = SCM_TYP16(scmptr); - } - else - switch (tag) - { - case scm_tcs_cons_imcar: - tag = scm_tc2_int; - break; - case scm_tcs_cons_nimcar: - tag = scm_tc3_cons; - break; - - case scm_tcs_struct: - tag = scm_tc3_struct; - break; - case scm_tcs_closures: - tag = scm_tc3_closure; - break; - case scm_tcs_subrs: - tag = scm_tc7_asubr; - break; - } - - { - SCM tag_as_scm = scm_from_int (tag); - SCM current = scm_hashq_ref (hashtab, tag_as_scm, SCM_I_MAKINUM (0)); - - scm_hashq_set_x (hashtab, tag_as_scm, - scm_from_int (scm_to_int (current) + 1)); - } - } -} - - -char const * -scm_i_tag_name (scm_t_bits tag) -{ - if (tag >= 255) - { - if (tag == scm_tc_free_cell) - return "free cell"; - - { - int k = 0xff & (tag >> 8); - return (scm_smobs[k].name); - } - } - - switch (tag) /* 7 bits */ - { - case scm_tcs_struct: - return "struct"; - case scm_tcs_cons_imcar: - return "cons (immediate car)"; - case scm_tcs_cons_nimcar: - return "cons (non-immediate car)"; - case scm_tcs_closures: - return "closures"; - case scm_tc7_pws: - return "pws"; - case scm_tc7_wvect: - return "weak vector"; - case scm_tc7_vector: - return "vector"; -#ifdef CCLO - case scm_tc7_cclo: - return "compiled closure"; -#endif - case scm_tc7_number: - switch (tag) - { - case scm_tc16_real: - return "real"; - break; - case scm_tc16_big: - return "bignum"; - break; - case scm_tc16_complex: - return "complex number"; - break; - case scm_tc16_fraction: - return "fraction"; - break; - } - break; - case scm_tc7_string: - return "string"; - break; - case scm_tc7_stringbuf: - return "string buffer"; - break; - case scm_tc7_symbol: - return "symbol"; - break; - case scm_tc7_variable: - return "variable"; - break; - case scm_tcs_subrs: - return "subrs"; - break; - case scm_tc7_port: - return "port"; - break; - case scm_tc7_smob: - return "smob"; /* should not occur. */ - break; - } - - return NULL; -} - - -#if (SCM_DEBUG_DEBUGGING_SUPPORT == 1) - -typedef struct scm_dbg_t_list_cell { - scm_t_bits car; - struct scm_dbg_t_list_cell * cdr; -} scm_dbg_t_list_cell; - - -typedef struct scm_dbg_t_double_cell { - scm_t_bits word_0; - scm_t_bits word_1; - scm_t_bits word_2; - scm_t_bits word_3; -} scm_dbg_t_double_cell; - - -int scm_dbg_gc_marked_p (SCM obj); -scm_t_cell * scm_dbg_gc_get_card (SCM obj); -scm_t_c_bvec_long * scm_dbg_gc_get_bvec (SCM obj); - - -int -scm_dbg_gc_marked_p (SCM obj) -{ - if (!SCM_IMP (obj)) - return SCM_GC_MARK_P(obj); - else - return 0; -} - -scm_t_cell * -scm_dbg_gc_get_card (SCM obj) -{ - if (!SCM_IMP (obj)) - return SCM_GC_CELL_CARD(obj); - else - return NULL; -} - -scm_t_c_bvec_long * -scm_dbg_gc_get_bvec (SCM obj) -{ - if (!SCM_IMP (obj)) - return SCM_GC_CARD_BVEC (SCM_GC_CELL_CARD (obj)); - else - return NULL; -} - -#endif diff --git a/libguile/gc-freelist.c b/libguile/gc-freelist.c deleted file mode 100644 index b3b558257..000000000 --- a/libguile/gc-freelist.c +++ /dev/null @@ -1,192 +0,0 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2006 Free Software Foundation, Inc. - * - * This library is free software; you can redistribute it and/or - * modify it under the terms of the GNU Lesser General Public - * License as published by the Free Software Foundation; either - * version 2.1 of the License, or (at your option) any later version. - * - * This library is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - * Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public - * License along with this library; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA - */ - -#include <assert.h> -#include <stdio.h> - -#include "libguile/private-gc.h" -#include "libguile/gc.h" -#include "libguile/deprecation.h" -#include "libguile/private-gc.h" - -scm_t_cell_type_statistics scm_i_master_freelist; -scm_t_cell_type_statistics scm_i_master_freelist2; - - - - -/* - -In older versions of GUILE GC there was extensive support for -debugging freelists. This was useful, since the freelist was kept -inside the heap, and writing to an object that was GC'd would mangle -the list. Mark bits are now separate, and checking for sane cell -access can be done much more easily by simply checking if the mark bit -is unset before allocation. --hwn - - - -*/ - -#if (SCM_ENABLE_DEPRECATED == 1) -#if defined(GUILE_DEBUG_FREELIST) - -SCM_DEFINE (scm_map_free_list, "map-free-list", 0, 0, 0, - (), - "DEPRECATED\n") -#define FUNC_NAME "s_scm_map_free_list" -{ - scm_c_issue_deprecation_warning ("map-free-list has been removed from GUILE. Doing nothing\n"); - return SCM_UNSPECIFIED; -} -#undef FUNC_NAME - -SCM_DEFINE (scm_gc_set_debug_check_freelist_x, "gc-set-debug-check-freelist!", 1, 0, 0, - (SCM flag), - "DEPRECATED.\n") -#define FUNC_NAME "s_scm_gc_set_debug_check_freelist_x" -{ - scm_c_issue_deprecation_warning ("gc-set-debug-check-freelist! has been removed from GUILE. Doing nothing\n"); - return SCM_UNSPECIFIED; -} -#undef FUNC_NAME - - -#endif /* defined (GUILE_DEBUG) */ -#endif /* deprecated */ - - - - -/* - This adjust FREELIST variables to decide wether or not to allocate - more heap in the next GC run. It uses scm_gc_cells_collected and scm_gc_cells_collected1 - */ - -void -scm_i_adjust_min_yield (scm_t_cell_type_statistics *freelist, - scm_t_sweep_statistics sweep_stats) -{ - /* min yield is adjusted upwards so that next predicted total yield - * (allocated cells actually freed by GC) becomes - * `min_yield_fraction' of total heap size. Note, however, that - * the absolute value of min_yield will correspond to `collected' - * on one master (the one which currently is triggering GC). - * - * The reason why we look at total yield instead of cells collected - * on one list is that we want to take other freelists into account. - * On this freelist, we know that (local) yield = collected cells, - * but that's probably not the case on the other lists. - * - * (We might consider computing a better prediction, for example - * by computing an average over multiple GC:s.) - */ - if (freelist->min_yield_fraction) - { - /* Pick largest of last two yields. */ - long delta = ((SCM_HEAP_SIZE * freelist->min_yield_fraction / 100) - - (long) sweep_stats.collected); -#ifdef DEBUGINFO - fprintf (stderr, " after GC = %lu, delta = %ld\n", - (unsigned long) scm_cells_allocated, - (long) delta); -#endif - if (delta > 0) - freelist->min_yield += delta; - } -} - - -static void -scm_init_freelist (scm_t_cell_type_statistics *freelist, - int span, - int min_yield) -{ - if (min_yield < 1) - min_yield = 1; - if (min_yield > 99) - min_yield = 99; - - freelist->heap_segment_idx = -1; - freelist->min_yield = 0; - freelist->min_yield_fraction = min_yield; - freelist->span = span; - freelist->collected = 0; - freelist->collected_1 = 0; - freelist->heap_size = 0; -} - -#if (SCM_ENABLE_DEPRECATED == 1) - size_t scm_default_init_heap_size_1; - int scm_default_min_yield_1; - size_t scm_default_init_heap_size_2; - int scm_default_min_yield_2; - size_t scm_default_max_segment_size; -#endif - -void -scm_gc_init_freelist (void) -{ - int init_heap_size_1 - = scm_getenv_int ("GUILE_INIT_SEGMENT_SIZE_1", SCM_DEFAULT_INIT_HEAP_SIZE_1); - int init_heap_size_2 - = scm_getenv_int ("GUILE_INIT_SEGMENT_SIZE_2", SCM_DEFAULT_INIT_HEAP_SIZE_2); - - scm_init_freelist (&scm_i_master_freelist2, 2, - scm_getenv_int ("GUILE_MIN_YIELD_2", SCM_DEFAULT_MIN_YIELD_2)); - scm_init_freelist (&scm_i_master_freelist, 1, - scm_getenv_int ("GUILE_MIN_YIELD_1", SCM_DEFAULT_MIN_YIELD_1)); - - scm_max_segment_size = scm_getenv_int ("GUILE_MAX_SEGMENT_SIZE", SCM_DEFAULT_MAX_SEGMENT_SIZE); - - if (scm_max_segment_size <= 0) - scm_max_segment_size = SCM_DEFAULT_MAX_SEGMENT_SIZE; - - - scm_i_make_initial_segment (init_heap_size_1, &scm_i_master_freelist); - scm_i_make_initial_segment (init_heap_size_2, &scm_i_master_freelist2); - -#if (SCM_ENABLE_DEPRECATED == 1) - if ( scm_default_init_heap_size_1 || - scm_default_min_yield_1|| - scm_default_init_heap_size_2|| - scm_default_min_yield_2|| - scm_default_max_segment_size) - { - scm_c_issue_deprecation_warning ("Tuning heap parameters with C variables is deprecated. Use environment variables instead."); - } -#endif -} - - -void -scm_i_gc_sweep_freelist_reset (scm_t_cell_type_statistics *freelist) -{ - freelist->collected_1 = freelist->collected; - freelist->collected = 0; - - /* - at the end we simply start with the lowest segment again. - */ - freelist->heap_segment_idx = -1; -} - -int -scm_i_gc_grow_heap_p (scm_t_cell_type_statistics * freelist) -{ - return SCM_MAX (freelist->collected,freelist->collected_1) < freelist->min_yield; -} diff --git a/libguile/gc-mark.c b/libguile/gc-mark.c deleted file mode 100644 index 77f3ec2af..000000000 --- a/libguile/gc-mark.c +++ /dev/null @@ -1,511 +0,0 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. - * - * This library is free software; you can redistribute it and/or - * modify it under the terms of the GNU Lesser General Public - * License as published by the Free Software Foundation; either - * version 2.1 of the License, or (at your option) any later version. - * - * This library is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - * Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public - * License along with this library; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA - */ - - - -#if HAVE_CONFIG_H -# include <config.h> -#endif - -#include <stdio.h> -#include <errno.h> -#include <string.h> -#include <assert.h> - -#ifdef __ia64__ -#include <ucontext.h> -extern unsigned long * __libc_ia64_register_backing_store_base; -#endif - -#include "libguile/_scm.h" -#include "libguile/eval.h" -#include "libguile/stime.h" -#include "libguile/stackchk.h" -#include "libguile/struct.h" -#include "libguile/smob.h" -#include "libguile/unif.h" -#include "libguile/async.h" -#include "libguile/ports.h" -#include "libguile/root.h" -#include "libguile/strings.h" -#include "libguile/vectors.h" -#include "libguile/weaks.h" -#include "libguile/hashtab.h" -#include "libguile/tags.h" -#include "libguile/private-gc.h" -#include "libguile/validate.h" -#include "libguile/deprecation.h" -#include "libguile/gc.h" -#include "libguile/guardians.h" - -#ifdef GUILE_DEBUG_MALLOC -#include "libguile/debug-malloc.h" -#endif - -#ifdef HAVE_MALLOC_H -#include <malloc.h> -#endif - -#ifdef HAVE_UNISTD_H -#include <unistd.h> -#endif - -/* - Entry point for this file. - */ -void -scm_mark_all (void) -{ - long j; - int loops; - - scm_i_init_weak_vectors_for_gc (); - scm_i_init_guardians_for_gc (); - - scm_i_clear_mark_space (); - - /* Mark every thread's stack and registers */ - scm_threads_mark_stacks (); - - j = SCM_NUM_PROTECTS; - while (j--) - scm_gc_mark (scm_sys_protects[j]); - - /* mark the registered roots */ - { - size_t i; - for (i = 0; i < SCM_HASHTABLE_N_BUCKETS (scm_gc_registered_roots); ++i) - { - SCM l = SCM_HASHTABLE_BUCKET (scm_gc_registered_roots, i); - for (; !scm_is_null (l); l = SCM_CDR (l)) - { - SCM *p = (SCM *) (scm_to_ulong (SCM_CAAR (l))); - scm_gc_mark (*p); - } - } - } - - scm_mark_subr_table (); - - loops = 0; - while (1) - { - int again; - loops++; - - /* Mark the non-weak references of weak vectors. For a weak key - alist vector, this would mark the values for keys that are - marked. We need to do this in a loop until everything - settles down since the newly marked values might be keys in - other weak key alist vectors, for example. - */ - again = scm_i_mark_weak_vectors_non_weaks (); - if (again) - continue; - - /* Now we scan all marked guardians and move all unmarked objects - from the accessible to the inaccessible list. - */ - scm_i_identify_inaccessible_guardeds (); - - /* When we have identified all inaccessible objects, we can mark - them. - */ - again = scm_i_mark_inaccessible_guardeds (); - - /* This marking might have changed the situation for weak vectors - and might have turned up new guardians that need to be processed, - so we do it all over again. - */ - if (again) - continue; - - /* Nothing new marked in this round, we are done. - */ - break; - } - - /* fprintf (stderr, "%d loops\n", loops); */ - - /* Remove all unmarked entries from the weak vectors. - */ - scm_i_remove_weaks_from_weak_vectors (); - - /* Bring hashtables upto date. - */ - scm_i_scan_weak_hashtables (); -} - -/* {Mark/Sweep} - */ - -/* - Mark an object precisely, then recurse. - */ -void -scm_gc_mark (SCM ptr) -{ - if (SCM_IMP (ptr)) - return; - - if (SCM_GC_MARK_P (ptr)) - return; - - SCM_SET_GC_MARK (ptr); - scm_gc_mark_dependencies (ptr); -} - -/* - -Mark the dependencies of an object. - -Prefetching: - -Should prefetch objects before marking, i.e. if marking a cell, we -should prefetch the car, and then mark the cdr. This will improve CPU -cache misses, because the car is more likely to be in core when we -finish the cdr. - -See http://www.hpl.hp.com/techreports/2000/HPL-2000-99.pdf, reducing -garbage collector cache misses. - -Prefetch is supported on GCC >= 3.1 - -(Some time later.) - -Tried this with GCC 3.1.1 -- the time differences are barely measurable. -Perhaps this would work better with an explicit markstack? - - -*/ - -void -scm_gc_mark_dependencies (SCM p) -#define FUNC_NAME "scm_gc_mark_dependencies" -{ - register long i; - register SCM ptr; - SCM cell_type; - - ptr = p; - scm_mark_dependencies_again: - - cell_type = SCM_GC_CELL_TYPE (ptr); - switch (SCM_ITAG7 (cell_type)) - { - case scm_tcs_cons_nimcar: - if (SCM_IMP (SCM_CDR (ptr))) - { - ptr = SCM_CAR (ptr); - goto gc_mark_nimp; - } - - - scm_gc_mark (SCM_CAR (ptr)); - ptr = SCM_CDR (ptr); - goto gc_mark_nimp; - case scm_tcs_cons_imcar: - ptr = SCM_CDR (ptr); - goto gc_mark_loop; - case scm_tc7_pws: - - scm_gc_mark (SCM_SETTER (ptr)); - ptr = SCM_PROCEDURE (ptr); - goto gc_mark_loop; - case scm_tcs_struct: - { - /* XXX - use less explicit code. */ - scm_t_bits word0 = SCM_CELL_WORD_0 (ptr) - scm_tc3_struct; - scm_t_bits * vtable_data = (scm_t_bits *) word0; - SCM layout = SCM_PACK (vtable_data [scm_vtable_index_layout]); - long len = scm_i_symbol_length (layout); - const char *fields_desc = scm_i_symbol_chars (layout); - scm_t_bits *struct_data = (scm_t_bits *) SCM_STRUCT_DATA (ptr); - - if (vtable_data[scm_struct_i_flags] & SCM_STRUCTF_ENTITY) - { - scm_gc_mark (SCM_PACK (struct_data[scm_struct_i_procedure])); - scm_gc_mark (SCM_PACK (struct_data[scm_struct_i_setter])); - } - if (len) - { - long x; - - for (x = 0; x < len - 2; x += 2, ++struct_data) - if (fields_desc[x] == 'p') - scm_gc_mark (SCM_PACK (*struct_data)); - if (fields_desc[x] == 'p') - { - if (SCM_LAYOUT_TAILP (fields_desc[x + 1])) - for (x = *struct_data++; x; --x, ++struct_data) - scm_gc_mark (SCM_PACK (*struct_data)); - else - scm_gc_mark (SCM_PACK (*struct_data)); - } - } - /* mark vtable */ - ptr = SCM_PACK (vtable_data [scm_vtable_index_vtable]); - goto gc_mark_loop; - } - break; - case scm_tcs_closures: - if (SCM_IMP (SCM_ENV (ptr))) - { - ptr = SCM_CLOSCAR (ptr); - goto gc_mark_nimp; - } - scm_gc_mark (SCM_CLOSCAR (ptr)); - ptr = SCM_ENV (ptr); - goto gc_mark_nimp; - case scm_tc7_vector: - i = SCM_SIMPLE_VECTOR_LENGTH (ptr); - if (i == 0) - break; - while (--i > 0) - { - SCM elt = SCM_SIMPLE_VECTOR_REF (ptr, i); - if (SCM_NIMP (elt)) - scm_gc_mark (elt); - } - ptr = SCM_SIMPLE_VECTOR_REF (ptr, 0); - goto gc_mark_loop; -#ifdef CCLO - case scm_tc7_cclo: - { - size_t i = SCM_CCLO_LENGTH (ptr); - size_t j; - for (j = 1; j != i; ++j) - { - SCM obj = SCM_CCLO_REF (ptr, j); - if (!SCM_IMP (obj)) - scm_gc_mark (obj); - } - ptr = SCM_CCLO_REF (ptr, 0); - goto gc_mark_loop; - } -#endif - - case scm_tc7_string: - ptr = scm_i_string_mark (ptr); - goto gc_mark_loop; - case scm_tc7_stringbuf: - ptr = scm_i_stringbuf_mark (ptr); - goto gc_mark_loop; - - case scm_tc7_number: - if (SCM_TYP16 (ptr) == scm_tc16_fraction) - { - scm_gc_mark (SCM_CELL_OBJECT_1 (ptr)); - ptr = SCM_CELL_OBJECT_2 (ptr); - goto gc_mark_loop; - } - break; - - case scm_tc7_wvect: - scm_i_mark_weak_vector (ptr); - break; - - case scm_tc7_symbol: - ptr = scm_i_symbol_mark (ptr); - goto gc_mark_loop; - case scm_tc7_variable: - ptr = SCM_CELL_OBJECT_1 (ptr); - goto gc_mark_loop; - case scm_tcs_subrs: - break; - case scm_tc7_port: - i = SCM_PTOBNUM (ptr); -#if (SCM_DEBUG_CELL_ACCESSES == 1) - if (!(i < scm_numptob)) - { - fprintf (stderr, "undefined port type"); - abort(); - } -#endif - if (SCM_PTAB_ENTRY(ptr)) - scm_gc_mark (SCM_FILENAME (ptr)); - if (scm_ptobs[i].mark) - { - ptr = (scm_ptobs[i].mark) (ptr); - goto gc_mark_loop; - } - else - return; - break; - case scm_tc7_smob: - switch (SCM_TYP16 (ptr)) - { /* should be faster than going through scm_smobs */ - case scm_tc_free_cell: - /* We have detected a free cell. This can happen if non-object data - * on the C stack points into guile's heap and is scanned during - * conservative marking. */ - break; - default: - i = SCM_SMOBNUM (ptr); -#if (SCM_DEBUG_CELL_ACCESSES == 1) - if (!(i < scm_numsmob)) - { - fprintf (stderr, "undefined smob type"); - abort(); - } -#endif - if (scm_smobs[i].mark) - { - ptr = (scm_smobs[i].mark) (ptr); - goto gc_mark_loop; - } - else - return; - } - break; - default: - fprintf (stderr, "unknown type"); - abort(); - } - - /* - If we got here, then exhausted recursion options for PTR. we - return (careful not to mark PTR, it might be the argument that we - were called with.) - */ - return ; - - gc_mark_loop: - if (SCM_IMP (ptr)) - return; - - gc_mark_nimp: - { - int valid_cell = CELL_P (ptr); - - -#if (SCM_DEBUG_CELL_ACCESSES == 1) - if (scm_debug_cell_accesses_p) - { - /* We are in debug mode. Check the ptr exhaustively. */ - - valid_cell = valid_cell && (scm_i_find_heap_segment_containing_object (ptr) >= 0); - } - -#endif - if (!valid_cell) - { - fprintf (stderr, "rogue pointer in heap"); - abort(); - } - } - - if (SCM_GC_MARK_P (ptr)) - { - return; - } - - SCM_SET_GC_MARK (ptr); - - goto scm_mark_dependencies_again; - -} -#undef FUNC_NAME - - - - -/* Mark a region conservatively */ -void -scm_mark_locations (SCM_STACKITEM x[], unsigned long n) -{ - unsigned long m; - - for (m = 0; m < n; ++m) - { - SCM obj = * (SCM *) &x[m]; - long int segment = scm_i_find_heap_segment_containing_object (obj); - if (segment >= 0) - scm_gc_mark (obj); - } -} - - -/* The function scm_in_heap_p determines whether an SCM value can be regarded as a - * pointer to a cell on the heap. - */ -int -scm_in_heap_p (SCM value) -{ - long int segment = scm_i_find_heap_segment_containing_object (value); - return (segment >= 0); -} - - -#if SCM_ENABLE_DEPRECATED == 1 - -/* If an allocated cell is detected during garbage collection, this - * means that some code has just obtained the object but was preempted - * before the initialization of the object was completed. This meanst - * that some entries of the allocated cell may already contain SCM - * objects. Therefore, allocated cells are scanned conservatively. - */ - -scm_t_bits scm_tc16_allocated; - -static SCM -allocated_mark (SCM cell) -{ - unsigned long int cell_segment = scm_i_find_heap_segment_containing_object (cell); - unsigned int span = scm_i_heap_segment_table[cell_segment]->span; - unsigned int i; - - for (i = 1; i != span * 2; ++i) - { - SCM obj = SCM_CELL_OBJECT (cell, i); - long int obj_segment = scm_i_find_heap_segment_containing_object (obj); - if (obj_segment >= 0) - scm_gc_mark (obj); - } - return SCM_BOOL_F; -} - -SCM -scm_deprecated_newcell (void) -{ - scm_c_issue_deprecation_warning - ("SCM_NEWCELL is deprecated. Use `scm_cell' instead.\n"); - - return scm_cell (scm_tc16_allocated, 0); -} - -SCM -scm_deprecated_newcell2 (void) -{ - scm_c_issue_deprecation_warning - ("SCM_NEWCELL2 is deprecated. Use `scm_double_cell' instead.\n"); - - return scm_double_cell (scm_tc16_allocated, 0, 0, 0); -} - -#endif /* SCM_ENABLE_DEPRECATED == 1 */ - - -void -scm_gc_init_mark(void) -{ -#if SCM_ENABLE_DEPRECATED == 1 - scm_tc16_allocated = scm_make_smob_type ("allocated cell", 0); - scm_set_smob_mark (scm_tc16_allocated, allocated_mark); -#endif -} - diff --git a/libguile/gc-segment.c b/libguile/gc-segment.c deleted file mode 100644 index 6e744184d..000000000 --- a/libguile/gc-segment.c +++ /dev/null @@ -1,561 +0,0 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2006 Free Software Foundation, Inc. - * - * This library is free software; you can redistribute it and/or - * modify it under the terms of the GNU Lesser General Public - * License as published by the Free Software Foundation; either - * version 2.1 of the License, or (at your option) any later version. - * - * This library is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - * Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public - * License along with this library; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA - */ - -#include <assert.h> -#include <stdio.h> -#include <string.h> - -#include "libguile/_scm.h" -#include "libguile/pairs.h" -#include "libguile/gc.h" -#include "libguile/private-gc.h" - - - - - -size_t scm_max_segment_size; - -scm_t_heap_segment * -scm_i_make_empty_heap_segment (scm_t_cell_type_statistics *fl) -{ - scm_t_heap_segment * shs = malloc (sizeof (scm_t_heap_segment)); - - if (!shs) - { - fprintf (stderr, "scm_i_get_new_heap_segment: out of memory.\n"); - abort (); - } - - shs->bounds[0] = NULL; - shs->bounds[1] = NULL; - shs->malloced = NULL; - shs->span = fl->span; - shs->freelist = fl; - shs->next_free_card = NULL; - - return shs; -} - - -void -scm_i_heap_segment_statistics (scm_t_heap_segment *seg, SCM tab) -{ - scm_t_cell *p = seg->bounds[0]; - while (p < seg->bounds[1]) - { - scm_i_card_statistics (p, tab, seg); - p += SCM_GC_CARD_N_CELLS; - } -} - - - -/* - Fill SEGMENT with memory both for data and mark bits. - - RETURN: 1 on success, 0 failure - */ -int -scm_i_initialize_heap_segment_data (scm_t_heap_segment * segment, size_t requested) -{ - /* - round upwards - */ - int card_data_cell_count = (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS); - int card_count =1 + (requested / sizeof (scm_t_cell)) / card_data_cell_count; - - /* - one card extra due to alignment - */ - size_t mem_needed = (1+card_count) * SCM_GC_SIZEOF_CARD - + SCM_GC_CARD_BVEC_SIZE_IN_LONGS * card_count * SCM_SIZEOF_LONG - ; - scm_t_c_bvec_long * bvec_ptr = 0; - scm_t_cell * memory = 0; - - /* - We use calloc to alloc the heap. On GNU libc this is - equivalent to mmapping /dev/zero - */ - SCM_SYSCALL (memory = (scm_t_cell * ) calloc (1, mem_needed)); - - if (memory == NULL) - return 0; - - segment->malloced = memory; - segment->bounds[0] = SCM_GC_CARD_UP (memory); - segment->bounds[1] = segment->bounds[0] + card_count * SCM_GC_CARD_N_CELLS; - - segment->freelist->heap_size += scm_i_segment_cell_count (segment); - - bvec_ptr = (scm_t_c_bvec_long*) segment->bounds[1]; - - /* - Don't init the mem or the bitvector. This is handled by lazy - sweeping. - */ - - segment->next_free_card = segment->bounds[0]; - segment->first_time = 1; - return 1; -} - -int -scm_i_segment_card_count (scm_t_heap_segment * seg) -{ - return (seg->bounds[1] - seg->bounds[0]) / SCM_GC_CARD_N_CELLS; -} - -/* - Return the number of available single-cell data cells. - */ -int -scm_i_segment_cell_count (scm_t_heap_segment * seg) -{ - return scm_i_segment_card_count (seg) * (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS) - + ((seg->span == 2) ? -1 : 0); -} - -void -scm_i_clear_segment_mark_space (scm_t_heap_segment *seg) -{ - scm_t_cell * markspace = seg->bounds[1]; - - memset (markspace, 0x00, - scm_i_segment_card_count (seg) * SCM_GC_CARD_BVEC_SIZE_IN_LONGS * SCM_SIZEOF_LONG); -} - -/* Sweep cards from SEG until we've gathered THRESHOLD cells. On return, - *CELLS_SWEPT contains the number of cells that have been visited and - *CELLS_COLLECTED contains the number of cells actually collected. A - freelist is returned, potentially empty. */ -SCM -scm_i_sweep_some_cards (scm_t_heap_segment *seg, - scm_t_sweep_statistics *sweep_stats) -{ - SCM cells = SCM_EOL; - int threshold = 512; - int collected = 0; - int (*sweeper) (scm_t_cell *, SCM *, scm_t_heap_segment* ) - = (seg->first_time) ? &scm_i_init_card_freelist : &scm_i_sweep_card; - - scm_t_cell * next_free = seg->next_free_card; - int cards_swept = 0; - - while (collected < threshold && next_free < seg->bounds[1]) - { - collected += (*sweeper) (next_free, &cells, seg); - next_free += SCM_GC_CARD_N_CELLS; - cards_swept ++; - } - - sweep_stats->swept = cards_swept * seg->span - * (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS); - - if (!seg->first_time) - { - /* scm_cells_allocated -= collected * seg->span; */ - sweep_stats->collected = collected * seg->span; - } - else - sweep_stats->collected = 0; - - seg->freelist->collected += collected * seg->span; - - if(next_free == seg->bounds[1]) - { - seg->first_time = 0; - } - - seg->next_free_card = next_free; - return cells; -} - - -/* - Force a sweep of this entire segment. This doesn't modify sweep - statistics, it just frees the memory pointed to by to-be-swept - cells. - - Implementation is slightly ugh. - - FIXME: if you do scm_i_sweep_segment(), and then allocate from this - segment again, the statistics are off. - */ -void -scm_i_sweep_segment (scm_t_heap_segment *seg, - scm_t_sweep_statistics *sweep_stats) -{ - scm_t_sweep_statistics sweep; - scm_t_cell * p = seg->next_free_card; - - scm_i_sweep_statistics_init (sweep_stats); - - while (scm_i_sweep_some_cards (seg, &sweep) != SCM_EOL) - scm_i_sweep_statistics_sum (sweep_stats, sweep); - - seg->next_free_card =p; -} - -void -scm_i_sweep_all_segments (char const *reason, - scm_t_sweep_statistics *sweep_stats) -{ - unsigned i= 0; - - scm_i_sweep_statistics_init (sweep_stats); - for (i = 0; i < scm_i_heap_segment_table_size; i++) - { - scm_t_sweep_statistics sweep; - - scm_i_sweep_segment (scm_i_heap_segment_table[i], &sweep); - scm_i_sweep_statistics_sum (sweep_stats, sweep); - } -} - - -/* - Heap segment table. - - The table is sorted by the address of the data itself. This makes - for easy lookups. This is not portable: according to ANSI C, - pointers can only be compared within the same object (i.e. the same - block of malloced memory.). For machines with weird architectures, - this should be revised. - - (Apparently, for this reason 1.6 and earlier had macros for pointer - comparison. ) - - perhaps it is worthwhile to remove the 2nd level of indirection in - the table, but this certainly makes for cleaner code. -*/ -scm_t_heap_segment ** scm_i_heap_segment_table; -size_t scm_i_heap_segment_table_size; -scm_t_cell *lowest_cell; -scm_t_cell *highest_cell; - - -void -scm_i_clear_mark_space (void) -{ - int i = 0; - for (; i < scm_i_heap_segment_table_size; i++) - { - scm_i_clear_segment_mark_space (scm_i_heap_segment_table[i]); - } -} - - -/* - RETURN: index of inserted segment. - */ -int -scm_i_insert_segment (scm_t_heap_segment * seg) -{ - size_t size = (scm_i_heap_segment_table_size + 1) * sizeof (scm_t_heap_segment *); - SCM_SYSCALL(scm_i_heap_segment_table = ((scm_t_heap_segment **) - realloc ((char *)scm_i_heap_segment_table, size))); - - /* - We can't alloc 4 more bytes. This is hopeless. - */ - if (!scm_i_heap_segment_table) - { - fprintf (stderr, "scm_i_get_new_heap_segment: Could not grow heap segment table.\n"); - abort (); - } - - if (!lowest_cell) - { - lowest_cell = seg->bounds[0]; - highest_cell = seg->bounds[1]; - } - else - { - lowest_cell = SCM_MIN (lowest_cell, seg->bounds[0]); - highest_cell = SCM_MAX (highest_cell, seg->bounds[1]); - } - - - { - int i = 0; - int j = 0; - - while (i < scm_i_heap_segment_table_size - && scm_i_heap_segment_table[i]->bounds[0] <= seg->bounds[0]) - i++; - - /* - We insert a new entry; if that happens to be before the - "current" segment of a freelist, we must move the freelist index - as well. - */ - if (scm_i_master_freelist.heap_segment_idx >= i) - scm_i_master_freelist.heap_segment_idx ++; - if (scm_i_master_freelist2.heap_segment_idx >= i) - scm_i_master_freelist2.heap_segment_idx ++; - - for (j = scm_i_heap_segment_table_size; j > i; --j) - scm_i_heap_segment_table[j] = scm_i_heap_segment_table[j - 1]; - - scm_i_heap_segment_table [i] = seg; - scm_i_heap_segment_table_size ++; - - return i; - } -} - -SCM -scm_i_sweep_some_segments (scm_t_cell_type_statistics *fl, - scm_t_sweep_statistics *sweep_stats) -{ - int i = fl->heap_segment_idx; - SCM collected = SCM_EOL; - - scm_i_sweep_statistics_init (sweep_stats); - if (i == -1) - i++; - - for (; - i < scm_i_heap_segment_table_size; i++) - { - scm_t_sweep_statistics sweep; - - if (scm_i_heap_segment_table[i]->freelist != fl) - continue; - - collected = scm_i_sweep_some_cards (scm_i_heap_segment_table[i], - &sweep); - - scm_i_sweep_statistics_sum (sweep_stats, sweep); - - if (collected != SCM_EOL) /* Don't increment i */ - break; - } - - fl->heap_segment_idx = i; - - return collected; -} - - -void -scm_i_reset_segments (void) -{ - int i = 0; - for (; i < scm_i_heap_segment_table_size; i++) - { - scm_t_heap_segment * seg = scm_i_heap_segment_table[i]; - seg->next_free_card = seg->bounds[0]; - } -} - -/* - Return a hashtab with counts of live objects, with tags as keys. - */ - - -SCM -scm_i_all_segments_statistics (SCM tab) -{ - int i = 0; - for (; i < scm_i_heap_segment_table_size; i++) - { - scm_t_heap_segment * seg = scm_i_heap_segment_table[i]; - scm_i_heap_segment_statistics (seg, tab); - } - - return tab; -} - - - - -/* - Determine whether the given value does actually represent a cell in - some heap segment. If this is the case, the number of the heap - segment is returned. Otherwise, -1 is returned. Binary search is - used to determine the heap segment that contains the cell. - - - I think this function is too long to be inlined. --hwn -*/ -long int -scm_i_find_heap_segment_containing_object (SCM obj) -{ - if (!CELL_P (obj)) - return -1; - - if ((scm_t_cell* ) obj < lowest_cell || (scm_t_cell*) obj >= highest_cell) - return -1; - - - { - scm_t_cell * ptr = SCM2PTR (obj); - unsigned long int i = 0; - unsigned long int j = scm_i_heap_segment_table_size - 1; - - if (ptr < scm_i_heap_segment_table[i]->bounds[0]) - return -1; - else if (scm_i_heap_segment_table[j]->bounds[1] <= ptr) - return -1; - else - { - while (i < j) - { - if (ptr < scm_i_heap_segment_table[i]->bounds[1]) - { - break; - } - else if (scm_i_heap_segment_table[j]->bounds[0] <= ptr) - { - i = j; - break; - } - else - { - unsigned long int k = (i + j) / 2; - - if (k == i) - return -1; - else if (ptr < scm_i_heap_segment_table[k]->bounds[1]) - { - j = k; - ++i; - if (ptr < scm_i_heap_segment_table[i]->bounds[0]) - return -1; - } - else if (scm_i_heap_segment_table[k]->bounds[0] <= ptr) - { - i = k; - --j; - if (scm_i_heap_segment_table[j]->bounds[1] <= ptr) - return -1; - } - } - } - - if (!SCM_DOUBLECELL_ALIGNED_P (obj) && scm_i_heap_segment_table[i]->span == 2) - return -1; - else if (SCM_GC_IN_CARD_HEADERP (ptr)) - return -1; - else - return i; - } - } -} - - -/* - Important entry point: try to grab some memory, and make it into a - segment. - - RETURN: the index of the segment. - */ -int -scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist, - policy_on_error error_policy) -{ - size_t len; - - { - /* Assure that the new segment is predicted to be large enough. - * - * New yield should at least equal GC fraction of new heap size, i.e. - * - * y + dh > f * (h + dh) - * - * y : yield - * f : min yield fraction - * h : heap size - * dh : size of new heap segment - * - * This gives dh > (f * h - y) / (1 - f) - */ - float f = freelist->min_yield_fraction / 100.0; - float h = SCM_HEAP_SIZE; - float min_cells = (f * h - scm_gc_cells_collected) / (1.0 - f); - - /* Make heap grow with factor 1.5 */ - len = freelist->heap_size / 2; -#ifdef DEBUGINFO - fprintf (stderr, "(%ld < %ld)", (long) len, (long) min_cells); -#endif - - if (len < min_cells) - len = (unsigned long) min_cells; - len *= sizeof (scm_t_cell); - /* force new sampling */ - freelist->collected = LONG_MAX; - } - - if (len > scm_max_segment_size) - len = scm_max_segment_size; - if (len < SCM_MIN_HEAP_SEG_SIZE) - len = SCM_MIN_HEAP_SEG_SIZE; - - { - scm_t_heap_segment * seg = scm_i_make_empty_heap_segment (freelist); - - /* Allocate with decaying ambition. */ - while (len >= SCM_MIN_HEAP_SEG_SIZE) - { - if (scm_i_initialize_heap_segment_data (seg, len)) - { - return scm_i_insert_segment (seg); - } - - len /= 2; - } - } - - if (error_policy == abort_on_error) - { - fprintf (stderr, "scm_i_get_new_heap_segment: Could not grow heap.\n"); - abort (); - } - return -1; -} - -void -scm_i_make_initial_segment (int init_heap_size, scm_t_cell_type_statistics *freelist) -{ - scm_t_heap_segment * seg = scm_i_make_empty_heap_segment (freelist); - - if (init_heap_size < 1) - { - init_heap_size = SCM_DEFAULT_INIT_HEAP_SIZE_1; - } - - if (scm_i_initialize_heap_segment_data (seg, init_heap_size)) - { - freelist->heap_segment_idx = scm_i_insert_segment (seg); - } - - /* - Why the fuck try twice? --hwn - */ - if (!seg->malloced) - { - scm_i_initialize_heap_segment_data (seg, SCM_HEAP_SEG_SIZE); - } - - if (freelist->min_yield_fraction) - freelist->min_yield = (freelist->heap_size * freelist->min_yield_fraction - / 100); -} diff --git a/libguile/gc_os_dep.c b/libguile/gc_os_dep.c deleted file mode 100644 index a0e60e9d7..000000000 --- a/libguile/gc_os_dep.c +++ /dev/null @@ -1,1939 +0,0 @@ -/* - * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers - * Copyright (c) 1991-1995 by Xerox Corporation. All rights reserved. - * Copyright (c) 1996-1999 by Silicon Graphics. All rights reserved. - * Copyright (c) 1999 by Hewlett-Packard Company. All rights reserved. - * Copyright (c) 2000, 2001, 2002, 2003, 2004, 2006 Free Software Foundation - * - * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED - * OR IMPLIED. ANY USE IS AT YOUR OWN RISK. - * - * Permission is hereby granted to use or copy this program - * for any purpose, provided the above notices are retained on all copies. - * Permission to modify the code and to distribute modified code is granted, - * provided the above notices are retained, and a notice that the code was - * modified is included with the above copyright notice. - * - */ - -/* - * Copied from gc5.2, files "os_dep.c", "gc_priv.h", "mark.c" and "gcconfig.h", - * and modified for Guile by Marius Vollmer. - */ - -#if HAVE_CONFIG_H -# include <config.h> -#endif - -#include <ctype.h> -#include "libguile/gc.h" -#include "libguile/scmconfig.h" - -#ifdef HAVE_LIBC_STACK_END - -extern void *__libc_stack_end; - -void * -scm_get_stack_base () -{ - return __libc_stack_end; -} - -#else - -#define ABORT(msg) abort () - -typedef char * ptr_t; /* A generic pointer to which we can add */ - /* byte displacements. */ - /* Preferably identical to caddr_t, if it */ - /* exists. */ - -/* Define word and signed_word to be unsigned and signed types of the */ -/* size as char * or void *. There seems to be no way to do this */ -/* even semi-portably. The following is probably no better/worse */ -/* than almost anything else. */ -/* The ANSI standard suggests that size_t and ptr_diff_t might be */ -/* better choices. But those appear to have incorrect definitions */ -/* on may systems. Notably "typedef int size_t" seems to be both */ -/* frequent and WRONG. */ -typedef unsigned long GC_word; -typedef long GC_signed_word; - -typedef GC_word word; -typedef GC_signed_word signed_word; - -typedef int GC_bool; -# define TRUE 1 -# define FALSE 0 - -#if defined(__STDC__) -# include <stdlib.h> -# if !(defined( sony_news ) ) -# include <stddef.h> -# endif -# define VOLATILE volatile -#else -# ifdef MSWIN32 -# include <stdlib.h> -# endif -# define VOLATILE -#endif - -/* Machine dependent parameters. Some tuning parameters can be found */ -/* near the top of gc_private.h. */ - -/* Machine specific parts contributed by various people. See README file. */ - -/* First a unified test for Linux: */ -# if defined(linux) || defined(__linux__) -# define LINUX -# endif - -/* Determine the machine type: */ -# if defined(sun) && defined(mc68000) -# define M68K -# define SUNOS4 -# define mach_type_known -# endif -# if defined(hp9000s300) -# define M68K -# define HP -# define mach_type_known -# endif -# if defined(__OpenBSD__) && defined(m68k) -# define M68K -# define OPENBSD -# define mach_type_known -# endif -# if defined(__OpenBSD__) && defined(__sparc__) -# define SPARC -# define OPENBSD -# define mach_type_known -# endif -# if defined(__NetBSD__) && defined(__powerpc__) -# define POWERPC -# define NETBSD -# define mach_type_known -# endif -/* in netbsd 2.0 only __m68k__ is defined, not m68k */ -# if defined(__NetBSD__) && (defined(m68k) || defined(__m68k__)) -# define M68K -# define NETBSD -# define mach_type_known -# endif -/* in netbsd 2.0 only __arm__ is defined, not arm32 */ -# if defined(__NetBSD__) && (defined(arm32) || defined(__arm__)) -# define ARM32 -# define NETBSD -# define mach_type_known -# endif -# if defined(__NetBSD__) && defined(__sparc__) -# define SPARC -# define NETBSD -# define mach_type_known -# endif -# if defined(vax) -# define VAX -# ifdef ultrix -# define ULTRIX -# else -# define BSD -# endif -# define mach_type_known -# endif -# if defined(mips) || defined(__mips) -# define MIPS -# if !defined(LINUX) -# if defined(ultrix) || defined(__ultrix) || defined(__NetBSD__) -# define ULTRIX -# else -# if defined(_SYSTYPE_SVR4) || defined(SYSTYPE_SVR4) \ - || defined(__SYSTYPE_SVR4__) -# define IRIX5 /* or IRIX 6.X */ -# else -# define RISCOS /* or IRIX 4.X */ -# endif -# endif -# endif /* !LINUX */ -# define mach_type_known -# endif -# if defined(sequent) && defined(i386) -# define I386 -# define SEQUENT -# define mach_type_known -# endif -# if defined(sun) && defined(i386) -# define I386 -# define SUNOS5 -# define mach_type_known -# endif -# if (defined(__OS2__) || defined(__EMX__)) && defined(__32BIT__) -# define I386 -# define OS2 -# define mach_type_known -# endif -# if defined(ibm032) -# define RT -# define mach_type_known -# endif -# if defined(sun) && (defined(sparc) || defined(__sparc)) -# define SPARC - /* Test for SunOS 5.x */ -# include <errno.h> -# ifdef ECHRNG -# define SUNOS5 -# else -# define SUNOS4 -# endif -# define mach_type_known -# endif -# if defined(sparc) && defined(unix) && !defined(sun) && !defined(linux) \ - && !defined(__OpenBSD__) -# define SPARC -# define DRSNX -# define mach_type_known -# endif -# if defined(_IBMR2) -# define RS6000 -# define mach_type_known -# endif -# if defined(_M_XENIX) && defined(_M_SYSV) && defined(_M_I386) - /* The above test may need refinement */ -# define I386 -# if defined(_SCO_ELF) -# define SCO_ELF -# else -# define SCO -# endif -# define mach_type_known -# endif -# if defined(_AUX_SOURCE) -# define M68K -# define SYSV -# define mach_type_known -# endif -# if defined(_PA_RISC1_0) || defined(_PA_RISC1_1) || defined(_PA_RISC2_0) \ - || defined(hppa) || defined(__hppa__) -# define HP_PA -# ifndef LINUX -# define HPUX -# endif -# define mach_type_known -# endif -# if defined(LINUX) && (defined(i386) || defined(__i386__)) -# define I386 -# define mach_type_known -# endif -# if defined(LINUX) && (defined(__ia64__) || defined(__ia64)) -# define IA64 -# define mach_type_known -# endif -# if defined(LINUX) && defined(powerpc) -# define POWERPC -# define mach_type_known -# endif -# if defined(LINUX) && defined(__mc68000__) -# define M68K -# define mach_type_known -# endif -# if defined(LINUX) && (defined(sparc) || defined(__sparc__)) -# define SPARC -# define mach_type_known -# endif -# if defined(LINUX) && (defined(arm) || defined (__arm__)) -# define ARM32 -# define mach_type_known -# endif -# if defined(__alpha) || defined(__alpha__) -# define ALPHA -# if !defined(LINUX) -# define OSF1 /* a.k.a Digital Unix */ -# endif -# define mach_type_known -# endif -# if defined(_AMIGA) && !defined(AMIGA) -# define AMIGA -# endif -# ifdef AMIGA -# define M68K -# define mach_type_known -# endif -# if defined(THINK_C) || defined(__MWERKS__) && !defined(__powerc) -# define M68K -# define MACOS -# define mach_type_known -# endif -# if defined(__MWERKS__) && defined(__powerc) -# define POWERPC -# define MACOS -# define mach_type_known -# endif -# if defined(macosx) || \ - (defined(__APPLE__) && defined(__MACH__) && defined(__ppc__)) -# define MACOSX -# define POWERPC -# define mach_type_known -# endif -# if defined(NeXT) && defined(mc68000) -# define M68K -# define NEXT -# define mach_type_known -# endif -# if defined(NeXT) && defined(i386) -# define I386 -# define NEXT -# define mach_type_known -# endif -# if defined(__OpenBSD__) && (defined(i386) || defined(__i386__)) -# define I386 -# define OPENBSD -# define mach_type_known -# endif -# if defined(__FreeBSD__) && defined(i386) -# define I386 -# define FREEBSD -# define mach_type_known -# endif -# if defined(__NetBSD__) && defined(i386) -# define I386 -# define NETBSD -# define mach_type_known -# endif -# if defined(bsdi) && defined(i386) -# define I386 -# define BSDI -# define mach_type_known -# endif -# if !defined(mach_type_known) && defined(__386BSD__) -# define I386 -# define THREE86BSD -# define mach_type_known -# endif -# if defined(_CX_UX) && defined(_M88K) -# define M88K -# define CX_UX -# define mach_type_known -# endif -# if defined(DGUX) -# define M88K - /* DGUX defined */ -# define mach_type_known -# endif -# if (defined(_MSDOS) || defined(_MSC_VER)) && (_M_IX86 >= 300) \ - || defined(_WIN32) && !defined(__CYGWIN32__) && !defined(__CYGWIN__) -# define I386 -# define MSWIN32 /* or Win32s */ -# define mach_type_known -# endif -# if defined(__DJGPP__) -# define I386 -# ifndef DJGPP -# define DJGPP /* MSDOS running the DJGPP port of GCC */ -# endif -# define mach_type_known -# endif -# if defined(__CYGWIN32__) || defined(__CYGWIN__) -# define I386 -# define CYGWIN32 -# define mach_type_known -# endif -# if defined(__MINGW32__) -# define I386 -# define MSWIN32 -# define mach_type_known -# endif -# if defined(__BORLANDC__) -# define I386 -# define MSWIN32 -# define mach_type_known -# endif -# if defined(_UTS) && !defined(mach_type_known) -# define S370 -# define UTS4 -# define mach_type_known -# endif -# if defined(__pj__) -# define PJ -# define mach_type_known -# endif -/* Ivan Demakov */ -# if defined(__WATCOMC__) && defined(__386__) -# define I386 -# if !defined(OS2) && !defined(MSWIN32) && !defined(DOS4GW) -# if defined(__OS2__) -# define OS2 -# else -# if defined(__WINDOWS_386__) || defined(__NT__) -# define MSWIN32 -# else -# define DOS4GW -# endif -# endif -# endif -# define mach_type_known -# endif -# if defined(__s390__) && defined(LINUX) -# define S370 -# define mach_type_known -# endif -# if defined(__GNU__) -# define I386 -# define GNU -# define mach_type_known -# endif -# if defined(__SCO_VERSION__) -# define I386 -# define SYSV -# define mach_type_known -# endif - -/* Feel free to add more clauses here */ - -/* Or manually define the machine type here. A machine type is */ -/* characterized by the architecture. Some */ -/* machine types are further subdivided by OS. */ -/* the macros ULTRIX, RISCOS, and BSD to distinguish. */ -/* Note that SGI IRIX is treated identically to RISCOS. */ -/* SYSV on an M68K actually means A/UX. */ -/* The distinction in these cases is usually the stack starting address */ -# ifndef mach_type_known - -void * -scm_get_stack_base () -{ - ABORT ("Can't determine stack base"); - return NULL; -} - -# else - /* Mapping is: M68K ==> Motorola 680X0 */ - /* (SUNOS4,HP,NEXT, and SYSV (A/UX), */ - /* MACOS and AMIGA variants) */ - /* I386 ==> Intel 386 */ - /* (SEQUENT, OS2, SCO, LINUX, NETBSD, */ - /* FREEBSD, THREE86BSD, MSWIN32, */ - /* BSDI,SUNOS5, NEXT, other variants) */ - /* NS32K ==> Encore Multimax */ - /* MIPS ==> R2000 or R3000 */ - /* (RISCOS, ULTRIX variants) */ - /* VAX ==> DEC VAX */ - /* (BSD, ULTRIX variants) */ - /* RS6000 ==> IBM RS/6000 AIX3.X */ - /* RT ==> IBM PC/RT */ - /* HP_PA ==> HP9000/700 & /800 */ - /* HP/UX */ - /* SPARC ==> SPARC under SunOS */ - /* (SUNOS4, SUNOS5, */ - /* DRSNX variants) */ - /* ALPHA ==> DEC Alpha */ - /* (OSF1 and LINUX variants) */ - /* M88K ==> Motorola 88XX0 */ - /* (CX_UX and DGUX) */ - /* S370 ==> 370-like machine */ - /* running Amdahl UTS4 */ - /* ARM32 ==> Intel StrongARM */ - /* IA64 ==> Intel IA64 */ - /* (e.g. Itanium) */ - - -/* - * For each architecture and OS, the following need to be defined: - * - * CPP_WORD_SZ is a simple integer constant representing the word size. - * in bits. We assume byte addressibility, where a byte has 8 bits. - * We also assume CPP_WORD_SZ is either 32 or 64. - * (We care about the length of pointers, not hardware - * bus widths. Thus a 64 bit processor with a C compiler that uses - * 32 bit pointers should use CPP_WORD_SZ of 32, not 64. Default is 32.) - * - * MACH_TYPE is a string representation of the machine type. - * OS_TYPE is analogous for the OS. - * - * ALIGNMENT is the largest N, such that - * all pointer are guaranteed to be aligned on N byte boundaries. - * defining it to be 1 will always work, but perform poorly. - * - * DATASTART is the beginning of the data segment. - * On UNIX systems, the collector will scan the area between DATASTART - * and DATAEND for root pointers. - * - * DATAEND, if not &end. - * - * ALIGN_DOUBLE of GC_malloc should return blocks aligned to twice - * the pointer size. - * - * STACKBOTTOM is the cool end of the stack, which is usually the - * highest address in the stack. - * Under PCR or OS/2, we have other ways of finding thread stacks. - * For each machine, the following should: - * 1) define SCM_STACK_GROWS_UP if the stack grows toward higher addresses, and - * 2) define exactly one of - * STACKBOTTOM (should be defined to be an expression) - * HEURISTIC1 - * HEURISTIC2 - * If either of the last two macros are defined, then STACKBOTTOM is computed - * during collector startup using one of the following two heuristics: - * HEURISTIC1: Take an address inside GC_init's frame, and round it up to - * the next multiple of STACK_GRAN. - * HEURISTIC2: Take an address inside GC_init's frame, increment it repeatedly - * in small steps (decrement if SCM_STACK_GROWS_UP), and read the value - * at each location. Remember the value when the first - * Segmentation violation or Bus error is signalled. Round that - * to the nearest plausible page boundary, and use that instead - * of STACKBOTTOM. - * - * Gustavo Rodriguez-Rivera points out that on most (all?) Unix machines, - * the value of environ is a pointer that can serve as STACKBOTTOM. - * I expect that HEURISTIC2 can be replaced by this approach, which - * interferes far less with debugging. - * - * If no expression for STACKBOTTOM can be found, and neither of the above - * heuristics are usable, the collector can still be used with all of the above - * undefined, provided one of the following is done: - * 1) GC_mark_roots can be changed to somehow mark from the correct stack(s) - * without reference to STACKBOTTOM. This is appropriate for use in - * conjunction with thread packages, since there will be multiple stacks. - * (Allocating thread stacks in the heap, and treating them as ordinary - * heap data objects is also possible as a last resort. However, this is - * likely to introduce significant amounts of excess storage retention - * unless the dead parts of the thread stacks are periodically cleared.) - * 2) Client code may set GC_stackbottom before calling any GC_ routines. - * If the author of the client code controls the main program, this is - * easily accomplished by introducing a new main program, setting - * GC_stackbottom to the address of a local variable, and then calling - * the original main program. The new main program would read something - * like: - * - * # include "gc_private.h" - * - * main(argc, argv, envp) - * int argc; - * char **argv, **envp; - * { - * int dummy; - * - * GC_stackbottom = (ptr_t)(&dummy); - * return(real_main(argc, argv, envp)); - * } - * - * - * Each architecture may also define the style of virtual dirty bit - * implementation to be used: - * MPROTECT_VDB: Write protect the heap and catch faults. - * PROC_VDB: Use the SVR4 /proc primitives to read dirty bits. - * - * An architecture may define DYNAMIC_LOADING if dynamic_load.c - * defined GC_register_dynamic_libraries() for the architecture. - * - * An architecture may define PREFETCH(x) to preload the cache with *x. - * This defaults to a no-op. - * - * PREFETCH_FOR_WRITE(x) is used if *x is about to be written. - * - * An architecture may also define CLEAR_DOUBLE(x) to be a fast way to - * clear the two words at GC_malloc-aligned address x. By default, - * word stores of 0 are used instead. - */ - - -# define STACK_GRAN 0x1000000 -# ifdef M68K -# define MACH_TYPE "M68K" -# define ALIGNMENT 2 -# ifdef OPENBSD -# define OS_TYPE "OPENBSD" -# define HEURISTIC2 - extern char etext; -# define DATASTART ((ptr_t)(&etext)) -# endif -# ifdef NETBSD -# define OS_TYPE "NETBSD" -# define HEURISTIC2 - extern char etext; -# define DATASTART ((ptr_t)(&etext)) -# endif -# ifdef LINUX -# define OS_TYPE "LINUX" -# define STACKBOTTOM ((ptr_t)0xf0000000) -# define MPROTECT_VDB -# ifdef __ELF__ -# define DYNAMIC_LOADING - extern char **__environ; -# define DATASTART ((ptr_t)(&__environ)) - /* hideous kludge: __environ is the first */ - /* word in crt0.o, and delimits the start */ - /* of the data segment, no matter which */ - /* ld options were passed through. */ - /* We could use _etext instead, but that */ - /* would include .rodata, which may */ - /* contain large read-only data tables */ - /* that we'd rather not scan. */ - extern int _end; -# define DATAEND (&_end) -# else - extern int etext; -# define DATASTART ((ptr_t)((((word) (&etext)) + 0xfff) & ~0xfff)) -# endif -# endif -# ifdef SUNOS4 -# define OS_TYPE "SUNOS4" - extern char etext; -# define DATASTART ((ptr_t)((((word) (&etext)) + 0x1ffff) & ~0x1ffff)) -# define HEURISTIC1 /* differs */ -# define DYNAMIC_LOADING -# endif -# ifdef HP -# define OS_TYPE "HP" - extern char etext; -# define DATASTART ((ptr_t)((((word) (&etext)) + 0xfff) & ~0xfff)) -# define STACKBOTTOM ((ptr_t) 0xffeffffc) - /* empirically determined. seems to work. */ -# include <unistd.h> -# define GETPAGESIZE() sysconf(_SC_PAGE_SIZE) -# endif -# ifdef SYSV -# define OS_TYPE "SYSV" - extern etext; -# define DATASTART ((ptr_t)((((word) (&etext)) + 0x3fffff) \ - & ~0x3fffff) \ - +((word)&etext & 0x1fff)) - /* This only works for shared-text binaries with magic number 0413. - The other sorts of SysV binaries put the data at the end of the text, - in which case the default of &etext would work. Unfortunately, - handling both would require having the magic-number available. - -- Parag - */ -# define STACKBOTTOM ((ptr_t)0xFFFFFFFE) - /* The stack starts at the top of memory, but */ - /* 0x0 cannot be used as setjump_test complains */ - /* that the stack direction is incorrect. Two */ - /* bytes down from 0x0 should be safe enough. */ - /* --Parag */ -# include <sys/mmu.h> -# define GETPAGESIZE() PAGESIZE /* Is this still right? */ -# endif -# ifdef AMIGA -# define OS_TYPE "AMIGA" - /* STACKBOTTOM and DATASTART handled specially */ - /* in os_dep.c */ -# define DATAEND /* not needed */ -# define GETPAGESIZE() 4096 -# endif -# ifdef MACOS -# ifndef __LOWMEM__ -# include <LowMem.h> -# endif -# define OS_TYPE "MACOS" - /* see os_dep.c for details of global data segments. */ -# define STACKBOTTOM ((ptr_t) LMGetCurStackBase()) -# define DATAEND /* not needed */ -# define GETPAGESIZE() 4096 -# endif -# ifdef NEXT -# define OS_TYPE "NEXT" -# define DATASTART ((ptr_t) get_etext()) -# define STACKBOTTOM ((ptr_t) 0x4000000) -# define DATAEND /* not needed */ -# endif -# endif - -# ifdef POWERPC -# define MACH_TYPE "POWERPC" -# ifdef MACOS -# define ALIGNMENT 2 /* Still necessary? Could it be 4? */ -# ifndef __LOWMEM__ -# include <LowMem.h> -# endif -# define OS_TYPE "MACOS" - /* see os_dep.c for details of global data segments. */ -# define STACKBOTTOM ((ptr_t) LMGetCurStackBase()) -# define DATAEND /* not needed */ -# endif -# ifdef LINUX -# define ALIGNMENT 4 /* Guess. Can someone verify? */ - /* This was 2, but that didn't sound right. */ -# define OS_TYPE "LINUX" -# define HEURISTIC1 -# define DYNAMIC_LOADING -# undef STACK_GRAN -# define STACK_GRAN 0x10000000 - /* Stack usually starts at 0x80000000 */ -# define LINUX_DATA_START - extern int _end; -# define DATAEND (&_end) -# endif -# ifdef MACOSX -# define ALIGNMENT 4 -# define OS_TYPE "MACOSX" -# define DATASTART ((ptr_t) get_etext()) -# define STACKBOTTOM ((ptr_t) 0xc0000000) -# define DATAEND /* not needed */ -# endif -# endif - -# ifdef VAX -# define MACH_TYPE "VAX" -# define ALIGNMENT 4 /* Pointers are longword aligned by 4.2 C compiler */ - extern char etext; -# define DATASTART ((ptr_t)(&etext)) -# ifdef BSD -# define OS_TYPE "BSD" -# define HEURISTIC1 - /* HEURISTIC2 may be OK, but it's hard to test. */ -# endif -# ifdef ULTRIX -# define OS_TYPE "ULTRIX" -# define STACKBOTTOM ((ptr_t) 0x7fffc800) -# endif -# endif - -# ifdef RT -# define MACH_TYPE "RT" -# define ALIGNMENT 4 -# define DATASTART ((ptr_t) 0x10000000) -# define STACKBOTTOM ((ptr_t) 0x1fffd800) -# endif - -# ifdef SPARC -# define MACH_TYPE "SPARC" -# define ALIGNMENT 4 /* Required by hardware */ -# define ALIGN_DOUBLE - extern int etext; -# ifdef SUNOS5 -# define OS_TYPE "SUNOS5" - extern int _etext; - extern int _end; - extern char * GC_SysVGetDataStart(); -# define DATASTART (ptr_t)GC_SysVGetDataStart(0x10000, &_etext) -# define DATAEND (&_end) -# ifndef USE_MMAP -# define USE_MMAP -# endif -# ifdef USE_MMAP -# define HEAP_START (ptr_t)0x40000000 -# else -# define HEAP_START DATAEND -# endif -# define PROC_VDB -/* HEURISTIC1 reportedly no longer works under 2.7. Thus we */ -/* switched to HEURISTIC2, eventhough it creates some debugging */ -/* issues. */ -# define HEURISTIC2 -# include <unistd.h> -# define GETPAGESIZE() sysconf(_SC_PAGESIZE) - /* getpagesize() appeared to be missing from at least one */ - /* Solaris 5.4 installation. Weird. */ -# define DYNAMIC_LOADING -# endif -# ifdef SUNOS4 -# define OS_TYPE "SUNOS4" - /* [If you have a weak stomach, don't read this.] */ - /* We would like to use: */ -/* # define DATASTART ((ptr_t)((((word) (&etext)) + 0x1fff) & ~0x1fff)) */ - /* This fails occasionally, due to an ancient, but very */ - /* persistent ld bug. &etext is set 32 bytes too high. */ - /* We instead read the text segment size from the a.out */ - /* header, which happens to be mapped into our address space */ - /* at the start of the text segment. The detective work here */ - /* was done by Robert Ehrlich, Manuel Serrano, and Bernard */ - /* Serpette of INRIA. */ - /* This assumes ZMAGIC, i.e. demand-loadable executables. */ -# define TEXTSTART 0x2000 -# define DATASTART ((ptr_t)(*(int *)(TEXTSTART+0x4)+TEXTSTART)) -# define MPROTECT_VDB -# define HEURISTIC1 -# define DYNAMIC_LOADING -# endif -# ifdef DRSNX -# define CPP_WORDSZ 32 -# define OS_TYPE "DRSNX" - extern char * GC_SysVGetDataStart(); - extern int etext; -# define DATASTART (ptr_t)GC_SysVGetDataStart(0x10000, &etext) -# define MPROTECT_VDB -# define STACKBOTTOM ((ptr_t) 0xdfff0000) -# define DYNAMIC_LOADING -# endif -# ifdef LINUX -# define OS_TYPE "LINUX" -# ifdef __ELF__ -# define LINUX_DATA_START -# define DYNAMIC_LOADING -# else - Linux Sparc non elf ? -# endif - extern int _end; -# define DATAEND (&_end) -# define SVR4 -# define STACKBOTTOM ((ptr_t) 0xf0000000) -# endif -# ifdef OPENBSD -# define OS_TYPE "OPENBSD" -# define STACKBOTTOM ((ptr_t) 0xf8000000) -# define DATASTART ((ptr_t)(&etext)) -# endif -# endif - -# ifdef I386 -# define MACH_TYPE "I386" -# define ALIGNMENT 4 /* Appears to hold for all "32 bit" compilers */ - /* except Borland. The -a4 option fixes */ - /* Borland. */ - /* Ivan Demakov: For Watcom the option is -zp4. */ -# ifndef SMALL_CONFIG -# define ALIGN_DOUBLE /* Not strictly necessary, but may give speed */ - /* improvement on Pentiums. */ -# endif -# ifdef SEQUENT -# define OS_TYPE "SEQUENT" - extern int etext; -# define DATASTART ((ptr_t)((((word) (&etext)) + 0xfff) & ~0xfff)) -# define STACKBOTTOM ((ptr_t) 0x3ffff000) -# endif -# ifdef SUNOS5 -# define OS_TYPE "SUNOS5" - extern int etext, _start; - extern char * GC_SysVGetDataStart(); -# define DATASTART GC_SysVGetDataStart(0x1000, &etext) -# define STACKBOTTOM ((ptr_t)(&_start)) -/** At least in Solaris 2.5, PROC_VDB gives wrong values for dirty bits. */ -/*# define PROC_VDB*/ -# define DYNAMIC_LOADING -# ifndef USE_MMAP -# define USE_MMAP -# endif -# ifdef USE_MMAP -# define HEAP_START (ptr_t)0x40000000 -# else -# define HEAP_START DATAEND -# endif -# endif -# ifdef SCO -# define OS_TYPE "SCO" - extern int etext; -# define DATASTART ((ptr_t)((((word) (&etext)) + 0x3fffff) \ - & ~0x3fffff) \ - +((word)&etext & 0xfff)) -# define STACKBOTTOM ((ptr_t) 0x7ffffffc) -# endif -# ifdef SCO_ELF -# define OS_TYPE "SCO_ELF" - extern int etext; -# define DATASTART ((ptr_t)(&etext)) -# define STACKBOTTOM ((ptr_t) 0x08048000) -# define DYNAMIC_LOADING -# define ELF_CLASS ELFCLASS32 -# endif -# ifdef LINUX -# define OS_TYPE "LINUX" -# define LINUX_STACKBOTTOM -# if 0 -# define HEURISTIC1 -# undef STACK_GRAN -# define STACK_GRAN 0x10000000 - /* STACKBOTTOM is usually 0xc0000000, but this changes with */ - /* different kernel configurations. In particular, systems */ - /* with 2GB physical memory will usually move the user */ - /* address space limit, and hence initial SP to 0x80000000. */ -# endif -# if !defined(LINUX_THREADS) || !defined(REDIRECT_MALLOC) -# define MPROTECT_VDB -# else - /* We seem to get random errors in incremental mode, */ - /* possibly because Linux threads is itself a malloc client */ - /* and can't deal with the signals. */ -# endif -# ifdef __ELF__ -# define DYNAMIC_LOADING -# ifdef UNDEFINED /* includes ro data */ - extern int _etext; -# define DATASTART ((ptr_t)((((word) (&_etext)) + 0xfff) & ~0xfff)) -# endif -# include <features.h> -# if defined(__GLIBC__) && __GLIBC__ >= 2 -# define LINUX_DATA_START -# else - extern char **__environ; -# define DATASTART ((ptr_t)(&__environ)) - /* hideous kludge: __environ is the first */ - /* word in crt0.o, and delimits the start */ - /* of the data segment, no matter which */ - /* ld options were passed through. */ - /* We could use _etext instead, but that */ - /* would include .rodata, which may */ - /* contain large read-only data tables */ - /* that we'd rather not scan. */ -# endif - extern int _end; -# define DATAEND (&_end) -# else - extern int etext; -# define DATASTART ((ptr_t)((((word) (&etext)) + 0xfff) & ~0xfff)) -# endif -# ifdef USE_I686_PREFETCH -# define PREFETCH(x) \ - __asm__ __volatile__ (" prefetchnta %0": : "m"(*(char *)(x))) - /* Empirically prefetcht0 is much more effective at reducing */ - /* cache miss stalls for the targetted load instructions. But it */ - /* seems to interfere enough with other cache traffic that the net */ - /* result is worse than prefetchnta. */ -# if 0 - /* Using prefetches for write seems to have a slight negative */ - /* impact on performance, at least for a PIII/500. */ -# define PREFETCH_FOR_WRITE(x) \ - __asm__ __volatile__ (" prefetcht0 %0": : "m"(*(char *)(x))) -# endif -# endif -# ifdef USE_3DNOW_PREFETCH -# define PREFETCH(x) \ - __asm__ __volatile__ (" prefetch %0": : "m"(*(char *)(x))) -# define PREFETCH_FOR_WRITE(x) - __asm__ __volatile__ (" prefetchw %0": : "m"(*(char *)(x))) -# endif -# endif -# ifdef CYGWIN32 -# define OS_TYPE "CYGWIN32" - extern int _data_start__; - extern int _data_end__; - extern int _bss_start__; - extern int _bss_end__; - /* For binutils 2.9.1, we have */ - /* DATASTART = _data_start__ */ - /* DATAEND = _bss_end__ */ - /* whereas for some earlier versions it was */ - /* DATASTART = _bss_start__ */ - /* DATAEND = _data_end__ */ - /* To get it right for both, we take the */ - /* minumum/maximum of the two. */ -# define MAX(x,y) ((x) > (y) ? (x) : (y)) -# define MIN(x,y) ((x) < (y) ? (x) : (y)) -# define DATASTART ((ptr_t) MIN(&_data_start__, &_bss_start__)) -# define DATAEND ((ptr_t) MAX(&_data_end__, &_bss_end__)) -# undef STACK_GRAN -# define STACK_GRAN 0x10000 -# define HEURISTIC1 -# endif -# ifdef OS2 -# define OS_TYPE "OS2" - /* STACKBOTTOM and DATASTART are handled specially in */ - /* os_dep.c. OS2 actually has the right */ - /* system call! */ -# define DATAEND /* not needed */ -# endif -# ifdef MSWIN32 -# define OS_TYPE "MSWIN32" - /* STACKBOTTOM and DATASTART are handled specially in */ - /* os_dep.c. */ -# ifndef __WATCOMC__ -# define MPROTECT_VDB -# endif -# define DATAEND /* not needed */ -# endif -# ifdef DJGPP -# define OS_TYPE "DJGPP" -# include "stubinfo.h" - extern int etext; - extern int _stklen; - extern int __djgpp_stack_limit; -# define DATASTART ((ptr_t)((((word) (&etext)) + 0x1ff) & ~0x1ff)) -/* # define STACKBOTTOM ((ptr_t)((word) _stubinfo + _stubinfo->size \ - + _stklen)) */ -# define STACKBOTTOM ((ptr_t)((word) __djgpp_stack_limit + _stklen)) - /* This may not be right. */ -# endif -# ifdef OPENBSD -# define OS_TYPE "OPENBSD" -# endif -# ifdef FREEBSD -# define OS_TYPE "FREEBSD" -# define MPROTECT_VDB -# endif -# ifdef NETBSD -# define OS_TYPE "NETBSD" -# endif -# ifdef THREE86BSD -# define OS_TYPE "THREE86BSD" -# endif -# ifdef BSDI -# define OS_TYPE "BSDI" -# endif -# if defined(OPENBSD) || defined(FREEBSD) || defined(NETBSD) \ - || defined(THREE86BSD) || defined(BSDI) -# define HEURISTIC2 - extern char etext; -# define DATASTART ((ptr_t)(&etext)) -# endif -# ifdef NEXT -# define OS_TYPE "NEXT" -# define DATASTART ((ptr_t) get_etext()) -# define STACKBOTTOM ((ptr_t)0xc0000000) -# define DATAEND /* not needed */ -# endif -# ifdef DOS4GW -# define OS_TYPE "DOS4GW" - extern long __nullarea; - extern char _end; - extern char *_STACKTOP; - /* Depending on calling conventions Watcom C either precedes - or does not precedes with undescore names of C-variables. - Make sure startup code variables always have the same names. */ - #pragma aux __nullarea "*"; - #pragma aux _end "*"; -# define STACKBOTTOM ((ptr_t) _STACKTOP) - /* confused? me too. */ -# define DATASTART ((ptr_t) &__nullarea) -# define DATAEND ((ptr_t) &_end) -# endif -# ifdef GNU -# define OS_TYPE "GNU" -# endif -# endif - -# ifdef NS32K -# define MACH_TYPE "NS32K" -# define ALIGNMENT 4 - extern char **environ; -# define DATASTART ((ptr_t)(&environ)) - /* hideous kludge: environ is the first */ - /* word in crt0.o, and delimits the start */ - /* of the data segment, no matter which */ - /* ld options were passed through. */ -# define STACKBOTTOM ((ptr_t) 0xfffff000) /* for Encore */ -# endif - -# ifdef MIPS -# define MACH_TYPE "MIPS" -/* # define STACKBOTTOM ((ptr_t)0x7fff8000) sometimes also works. */ -# ifdef LINUX - /* This was developed for a linuxce style platform. Probably */ - /* needs to be tweaked for workstation class machines. */ -# define OS_TYPE "LINUX" - extern int __data_start; -# define DATASTART ((ptr_t)(&__data_start)) -# define ALIGNMENT 4 -# define USE_GENERIC_PUSH_REGS 1 -# define STACKBOTTOM 0x80000000 - /* In many cases, this should probably use LINUX_STACKBOTTOM */ - /* instead. But some kernel versions seem to give the wrong */ - /* value from /proc. */ -# endif /* Linux */ -# ifdef ULTRIX -# define HEURISTIC2 -# define DATASTART (ptr_t)0x10000000 - /* Could probably be slightly higher since */ - /* startup code allocates lots of stuff. */ -# define OS_TYPE "ULTRIX" -# define ALIGNMENT 4 -# endif -# ifdef RISCOS -# define HEURISTIC2 -# define DATASTART (ptr_t)0x10000000 -# define OS_TYPE "RISCOS" -# define ALIGNMENT 4 /* Required by hardware */ -# endif -# ifdef IRIX5 -# define HEURISTIC2 - extern int _fdata; -# define DATASTART ((ptr_t)(&_fdata)) -# ifdef USE_MMAP -# define HEAP_START (ptr_t)0x30000000 -# else -# define HEAP_START DATASTART -# endif - /* Lowest plausible heap address. */ - /* In the MMAP case, we map there. */ - /* In either case it is used to identify */ - /* heap sections so they're not */ - /* considered as roots. */ -# define OS_TYPE "IRIX5" -# define MPROTECT_VDB -# ifdef _MIPS_SZPTR -# define CPP_WORDSZ _MIPS_SZPTR -# define ALIGNMENT (_MIPS_SZPTR/8) -# if CPP_WORDSZ != 64 -# define ALIGN_DOUBLE -# endif -# else -# define ALIGNMENT 4 -# define ALIGN_DOUBLE -# endif -# define DYNAMIC_LOADING -# endif -# endif - -# ifdef RS6000 -# define MACH_TYPE "RS6000" -# define ALIGNMENT 4 -# define DATASTART ((ptr_t)0x20000000) - extern int errno; -# define STACKBOTTOM ((ptr_t)((ulong)&errno)) -# define DYNAMIC_LOADING - /* For really old versions of AIX, this may have to be removed. */ -# endif - -# ifdef HP_PA - /* OS is assumed to be HP/UX */ -# define MACH_TYPE "HP_PA" -# define OS_TYPE "HPUX" -# ifdef __LP64__ -# define CPP_WORDSZ 64 -# define ALIGNMENT 8 -# else -# define CPP_WORDSZ 32 -# define ALIGNMENT 4 -# define ALIGN_DOUBLE -# endif - extern int __data_start; -# define DATASTART ((ptr_t)(&__data_start)) -# if 0 - /* The following appears to work for 7xx systems running HP/UX */ - /* 9.xx Furthermore, it might result in much faster */ - /* collections than HEURISTIC2, which may involve scanning */ - /* segments that directly precede the stack. It is not the */ - /* default, since it may not work on older machine/OS */ - /* combinations. (Thanks to Raymond X.T. Nijssen for uncovering */ - /* this.) */ -# define STACKBOTTOM ((ptr_t) 0x7b033000) /* from /etc/conf/h/param.h */ -# else - /* Gustavo Rodriguez-Rivera suggested changing HEURISTIC2 */ - /* to this. We'll probably do this on other platforms, too. */ - /* For now I'll use it where I can test it. */ - extern char ** environ; -# define STACKBOTTOM ((ptr_t)environ) -# endif -# ifndef SCM_STACK_GROWS_UP /* don't fight with scmconfig.h */ -# define SCM_STACK_GROWS_UP 1 -# endif -# define DYNAMIC_LOADING -# ifndef HPUX_THREADS -# define MPROTECT_VDB -# endif -# include <unistd.h> -# define GETPAGESIZE() sysconf(_SC_PAGE_SIZE) -# endif - -# ifdef ALPHA -# define MACH_TYPE "ALPHA" -# define ALIGNMENT 8 -# define USE_GENERIC_PUSH_REGS - /* Gcc and probably the DEC/Compaq compiler spill pointers to preserved */ - /* fp registers in some cases when the target is a 21264. The assembly */ - /* code doesn't handle that yet, and version dependencies make that a */ - /* bit tricky. Do the easy thing for now. */ -# ifdef OSF1 -# define OS_TYPE "OSF1" -# define DATASTART ((ptr_t) 0x140000000) - extern _end; -# define DATAEND ((ptr_t) &_end) -# define HEURISTIC2 - /* Normally HEURISTIC2 is too conervative, since */ - /* the text segment immediately follows the stack. */ - /* Hence we give an upper pound. */ - extern int __start; -# define HEURISTIC2_LIMIT ((ptr_t)((word)(&__start) & ~(getpagesize()-1))) -# define CPP_WORDSZ 64 -# define MPROTECT_VDB -# define DYNAMIC_LOADING -# endif -# ifdef LINUX -# define OS_TYPE "LINUX" -# define CPP_WORDSZ 64 -# define STACKBOTTOM ((ptr_t) 0x120000000) -# ifdef __ELF__ -# define LINUX_DATA_START -# define DYNAMIC_LOADING - /* This doesn't work if the collector is in a dynamic library. */ -# else -# define DATASTART ((ptr_t) 0x140000000) -# endif - extern int _end; -# define DATAEND (&_end) -# define MPROTECT_VDB - /* Has only been superficially tested. May not */ - /* work on all versions. */ -# endif -# endif - -# ifdef IA64 -# define MACH_TYPE "IA64" -# define ALIGN_DOUBLE - /* Requires 16 byte alignment for malloc */ -# define ALIGNMENT 8 -# define USE_GENERIC_PUSH_REGS - /* We need to get preserved registers in addition to register windows. */ - /* That's easiest to do with setjmp. */ -# ifdef HPUX - --> needs work -# endif -# ifdef LINUX -# define OS_TYPE "LINUX" -# define CPP_WORDSZ 64 - /* This should really be done through /proc, but that */ - /* requires we run on an IA64 kernel. */ -# define STACKBOTTOM ((ptr_t) 0xa000000000000000l) - /* We also need the base address of the register stack */ - /* backing store. There is probably a better way to */ - /* get that, too ... */ -# define BACKING_STORE_BASE ((ptr_t) 0x9fffffff80000000l) -# if 1 -# define SEARCH_FOR_DATA_START -# define DATASTART GC_data_start -# else - extern int data_start; -# define DATASTART ((ptr_t)(&data_start)) -# endif -# define DYNAMIC_LOADING -# define MPROTECT_VDB - /* Requires Linux 2.3.47 or later. */ - extern int _end; -# define DATAEND (&_end) -# define PREFETCH(x) \ - __asm__ (" lfetch [%0]": : "r"((void *)(x))) -# define PREFETCH_FOR_WRITE(x) \ - __asm__ (" lfetch.excl [%0]": : "r"((void *)(x))) -# define CLEAR_DOUBLE(x) \ - __asm__ (" stf.spill [%0]=f0": : "r"((void *)(x))) -# endif -# endif - -# ifdef M88K -# define MACH_TYPE "M88K" -# define ALIGNMENT 4 -# define ALIGN_DOUBLE - extern int etext; -# ifdef CX_UX -# define OS_TYPE "CX_UX" -# define DATASTART ((((word)&etext + 0x3fffff) & ~0x3fffff) + 0x10000) -# endif -# ifdef DGUX -# define OS_TYPE "DGUX" - extern char * GC_SysVGetDataStart(); -# define DATASTART (ptr_t)GC_SysVGetDataStart(0x10000, &etext) -# endif -# define STACKBOTTOM ((char*)0xf0000000) /* determined empirically */ -# endif - -# ifdef S370 -# define MACH_TYPE "S370" -# define OS_TYPE "UTS4" -# define ALIGNMENT 4 /* Required by hardware */ - extern int etext; - extern int _etext; - extern int _end; - extern char * GC_SysVGetDataStart(); -# define DATASTART (ptr_t)GC_SysVGetDataStart(0x10000, &_etext) -# define DATAEND (&_end) -# define HEURISTIC2 -# endif - -# if defined(PJ) -# define ALIGNMENT 4 - extern int _etext; -# define DATASTART ((ptr_t)(&_etext)) -# define HEURISTIC1 -# endif - -# ifdef ARM32 -# define CPP_WORDSZ 32 -# define MACH_TYPE "ARM32" -# define ALIGNMENT 4 -# ifdef NETBSD -# define OS_TYPE "NETBSD" -# define HEURISTIC2 - extern char etext; -# define DATASTART ((ptr_t)(&etext)) -# define USE_GENERIC_PUSH_REGS -# endif -# ifdef LINUX -# define OS_TYPE "LINUX" -# define HEURISTIC1 -# undef STACK_GRAN -# define STACK_GRAN 0x10000000 -# define USE_GENERIC_PUSH_REGS -# ifdef __ELF__ -# define DYNAMIC_LOADING -# include <features.h> -# if defined(__GLIBC__) && __GLIBC__ >= 2 -# define LINUX_DATA_START -# else - extern char **__environ; -# define DATASTART ((ptr_t)(&__environ)) - /* hideous kludge: __environ is the first */ - /* word in crt0.o, and delimits the start */ - /* of the data segment, no matter which */ - /* ld options were passed through. */ - /* We could use _etext instead, but that */ - /* would include .rodata, which may */ - /* contain large read-only data tables */ - /* that we'd rather not scan. */ -# endif - extern int _end; -# define DATAEND (&_end) -# else - extern int etext; -# define DATASTART ((ptr_t)((((word) (&etext)) + 0xfff) & ~0xfff)) -# endif -# endif -#endif - -#ifdef LINUX_DATA_START - /* Some Linux distributions arrange to define __data_start. Some */ - /* define data_start as a weak symbol. The latter is technically */ - /* broken, since the user program may define data_start, in which */ - /* case we lose. Nonetheless, we try both, prefering __data_start. */ - /* We assume gcc. */ -# pragma weak __data_start - extern int __data_start; -# pragma weak data_start - extern int data_start; -# define DATASTART ((ptr_t)(&__data_start != 0? &__data_start : &data_start)) -#endif - -# if SCM_STACK_GROWS_UP -# define STACK_GROWS_DOWN 0 -# else -# define STACK_GROWS_DOWN 1 -#endif - -# ifndef CPP_WORDSZ -# define CPP_WORDSZ 32 -# endif - -# ifndef OS_TYPE -# define OS_TYPE "" -# endif - -# ifndef DATAEND - extern int end; -# define DATAEND (&end) -# endif - -# if defined(SVR4) && !defined(GETPAGESIZE) -# include <unistd.h> -# define GETPAGESIZE() sysconf(_SC_PAGESIZE) -# endif - -# ifndef GETPAGESIZE -# if defined(SUNOS5) || defined(IRIX5) -# include <unistd.h> -# endif -# define GETPAGESIZE() getpagesize() -# endif - -# if defined(SUNOS5) || defined(DRSNX) || defined(UTS4) - /* OS has SVR4 generic features. Probably others also qualify. */ -# define SVR4 -# endif - -# if defined(SUNOS5) || defined(DRSNX) - /* OS has SUNOS5 style semi-undocumented interface to dynamic */ - /* loader. */ -# define SUNOS5DL - /* OS has SUNOS5 style signal handlers. */ -# define SUNOS5SIGS -# endif - -# if defined(HPUX) -# define SUNOS5SIGS -# endif - -# if CPP_WORDSZ != 32 && CPP_WORDSZ != 64 - -> bad word size -# endif - -# ifdef PCR -# undef DYNAMIC_LOADING -# undef STACKBOTTOM -# undef HEURISTIC1 -# undef HEURISTIC2 -# undef PROC_VDB -# undef MPROTECT_VDB -# define PCR_VDB -# endif - -# ifdef SRC_M3 -/* Postponed for now. */ -# undef PROC_VDB -# undef MPROTECT_VDB -# endif - -# ifdef SMALL_CONFIG -/* Presumably not worth the space it takes. */ -# undef PROC_VDB -# undef MPROTECT_VDB -# endif - -# ifdef USE_MUNMAP -# undef MPROTECT_VDB /* Can't deal with address space holes. */ -# endif - -# if !defined(PCR_VDB) && !defined(PROC_VDB) && !defined(MPROTECT_VDB) -# define DEFAULT_VDB -# endif - -# ifndef PREFETCH -# define PREFETCH(x) -# define NO_PREFETCH -# endif - -# ifndef PREFETCH_FOR_WRITE -# define PREFETCH_FOR_WRITE(x) -# define NO_PREFETCH_FOR_WRITE -# endif - -# ifndef CACHE_LINE_SIZE -# define CACHE_LINE_SIZE 32 /* Wild guess */ -# endif - -# ifndef CLEAR_DOUBLE -# define CLEAR_DOUBLE(x) \ - ((word*)x)[0] = 0; \ - ((word*)x)[1] = 0; -# endif /* CLEAR_DOUBLE */ - -# if defined(_SOLARIS_PTHREADS) && !defined(SOLARIS_THREADS) -# define SOLARIS_THREADS -# endif -# if defined(IRIX_THREADS) && !defined(IRIX5) ---> inconsistent configuration -# endif -# if defined(IRIX_JDK_THREADS) && !defined(IRIX5) ---> inconsistent configuration -# endif -# if defined(LINUX_THREADS) && !defined(LINUX) ---> inconsistent configuration -# endif -# if defined(SOLARIS_THREADS) && !defined(SUNOS5) ---> inconsistent configuration -# endif -# if defined(HPUX_THREADS) && !defined(HPUX) ---> inconsistent configuration -# endif -# if defined(PCR) || defined(SRC_M3) || \ - defined(SOLARIS_THREADS) || defined(WIN32_THREADS) || \ - defined(IRIX_THREADS) || defined(LINUX_THREADS) || \ - defined(IRIX_JDK_THREADS) || defined(HPUX_THREADS) -# define THREADS -# endif - -# if defined(HP_PA) || defined(M88K) || defined(POWERPC) \ - || (defined(I386) && defined(OS2)) || defined(UTS4) || defined(LINT) - /* Use setjmp based hack to mark from callee-save registers. */ -# define USE_GENERIC_PUSH_REGS -# endif -# if defined(SPARC) && !defined(LINUX) -# define SAVE_CALL_CHAIN -# define ASM_CLEAR_CODE /* Stack clearing is crucial, and we */ - /* include assembly code to do it well. */ -# endif - -# if defined(LINUX) && !defined(POWERPC) - -# if 0 -# include <linux/version.h> -# if (LINUX_VERSION_CODE <= 0x10400) - /* Ugly hack to get struct sigcontext_struct definition. Required */ - /* for some early 1.3.X releases. Will hopefully go away soon. */ - /* in some later Linux releases, asm/sigcontext.h may have to */ - /* be included instead. */ -# define __KERNEL__ -# include <asm/signal.h> -# undef __KERNEL__ -# endif - -# else - - /* Kernels prior to 2.1.1 defined struct sigcontext_struct instead of */ - /* struct sigcontext. libc6 (glibc2) uses "struct sigcontext" in */ - /* prototypes, so we have to include the top-level sigcontext.h to */ - /* make sure the former gets defined to be the latter if appropriate. */ -# include <features.h> -# if 2 <= __GLIBC__ -# if 2 == __GLIBC__ && 0 == __GLIBC_MINOR__ - /* glibc 2.1 no longer has sigcontext.h. But signal.h */ - /* has the right declaration for glibc 2.1. */ -# include <sigcontext.h> -# endif /* 0 == __GLIBC_MINOR__ */ -# else /* not 2 <= __GLIBC__ */ - /* libc5 doesn't have <sigcontext.h>: go directly with the kernel */ - /* one. Check LINUX_VERSION_CODE to see which we should reference. */ -# include <asm/sigcontext.h> -# endif /* 2 <= __GLIBC__ */ -# endif -# endif -# if !defined(OS2) && !defined(PCR) && !defined(AMIGA) && !defined(MACOS) -# include <sys/types.h> -# if !defined(MSWIN32) && !defined(SUNOS4) -# include <unistd.h> -# endif -# endif - -# include <signal.h> - -/* Blatantly OS dependent routines, except for those that are related */ -/* to dynamic loading. */ - -# if !defined(THREADS) && !defined(STACKBOTTOM) && defined(HEURISTIC2) -# define NEED_FIND_LIMIT -# endif - -# if defined(IRIX_THREADS) || defined(HPUX_THREADS) -# define NEED_FIND_LIMIT -# endif - -# if (defined(SUNOS4) && defined(DYNAMIC_LOADING)) && !defined(PCR) -# define NEED_FIND_LIMIT -# endif - -# if (defined(SVR4) || defined(AUX) || defined(DGUX)) && !defined(PCR) -# define NEED_FIND_LIMIT -# endif - -# if defined(LINUX) && \ - (defined(POWERPC) || defined(SPARC) || defined(ALPHA) || defined(IA64) \ - || defined(MIPS)) -# define NEED_FIND_LIMIT -# endif - -#ifdef NEED_FIND_LIMIT -# include <setjmp.h> -#endif - -#ifdef FREEBSD -# include <machine/trap.h> -#endif - -#ifdef AMIGA -# include <proto/exec.h> -# include <proto/dos.h> -# include <dos/dosextens.h> -# include <workbench/startup.h> -#endif - -#ifdef MSWIN32 -# define WIN32_LEAN_AND_MEAN -# define NOSERVICE -# include <windows.h> -#endif - -#ifdef MACOS -# include <Processes.h> -#endif - -#ifdef IRIX5 -# include <sys/uio.h> -# include <malloc.h> /* for locking */ -#endif -#ifdef USE_MMAP -# include <sys/types.h> -# include <sys/mman.h> -# include <sys/stat.h> -# include <fcntl.h> -#endif - -#ifdef SUNOS5SIGS -# include <sys/siginfo.h> -# undef setjmp -# undef longjmp -# define setjmp(env) sigsetjmp(env, 1) -# define longjmp(env, val) siglongjmp(env, val) -# define jmp_buf sigjmp_buf -#endif - -#ifdef DJGPP - /* Apparently necessary for djgpp 2.01. May casuse problems with */ - /* other versions. */ - typedef long unsigned int caddr_t; -#endif - -#ifdef PCR -# include "il/PCR_IL.h" -# include "th/PCR_ThCtl.h" -# include "mm/PCR_MM.h" -#endif - -#if !defined(NO_EXECUTE_PERMISSION) -# define OPT_PROT_EXEC PROT_EXEC -#else -# define OPT_PROT_EXEC 0 -#endif - -# ifdef OS2 - -# include <stddef.h> - -# if !defined(__IBMC__) && !defined(__WATCOMC__) /* e.g. EMX */ - -# else /* IBM's compiler */ - -/* A kludge to get around what appears to be a header file bug */ -# ifndef WORD -# define WORD unsigned short -# endif -# ifndef DWORD -# define DWORD unsigned long -# endif - -# define EXE386 1 -# include <newexe.h> -# include <exe386.h> - -# endif /* __IBMC__ */ - -# define INCL_DOSEXCEPTIONS -# define INCL_DOSPROCESS -# define INCL_DOSERRORS -# define INCL_DOSMODULEMGR -# define INCL_DOSMEMMGR -# include <os2.h> - -# endif /*!OS/2 */ - -/* - * Find the base of the stack. - * Used only in single-threaded environment. - * With threads, GC_mark_roots needs to know how to do this. - * Called with allocator lock held. - */ -# ifdef MSWIN32 -# define is_writable(prot) ((prot) == PAGE_READWRITE \ - || (prot) == PAGE_WRITECOPY \ - || (prot) == PAGE_EXECUTE_READWRITE \ - || (prot) == PAGE_EXECUTE_WRITECOPY) -/* Return the number of bytes that are writable starting at p. */ -/* The pointer p is assumed to be page aligned. */ -/* If base is not 0, *base becomes the beginning of the */ -/* allocation region containing p. */ -static word GC_get_writable_length(ptr_t p, ptr_t *base) -{ - MEMORY_BASIC_INFORMATION buf; - word result; - word protect; - - result = VirtualQuery(p, &buf, sizeof(buf)); - if (result != sizeof(buf)) ABORT("Weird VirtualQuery result"); - if (base != 0) *base = (ptr_t)(buf.AllocationBase); - protect = (buf.Protect & ~(PAGE_GUARD | PAGE_NOCACHE)); - if (!is_writable(protect)) { - return(0); - } - if (buf.State != MEM_COMMIT) return(0); - return(buf.RegionSize); -} - -void *scm_get_stack_base() -{ - int dummy; - ptr_t sp = (ptr_t)(&dummy); - ptr_t trunc_sp; - word size; - static word GC_page_size = 0; - if (!GC_page_size) { - SYSTEM_INFO sysinfo; - GetSystemInfo(&sysinfo); - GC_page_size = sysinfo.dwPageSize; - } - trunc_sp = (ptr_t)((word)sp & ~(GC_page_size - 1)); - size = GC_get_writable_length(trunc_sp, 0); - return(trunc_sp + size); -} - - -# else - -# ifdef OS2 - -void *scm_get_stack_base() -{ - PTIB ptib; - PPIB ppib; - - if (DosGetInfoBlocks(&ptib, &ppib) != NO_ERROR) { - GC_err_printf0("DosGetInfoBlocks failed\n"); - ABORT("DosGetInfoBlocks failed\n"); - } - return((ptr_t)(ptib -> tib_pstacklimit)); -} - -# else - -# ifdef AMIGA - -void *scm_get_stack_base() -{ - struct Process *proc = (struct Process*)SysBase->ThisTask; - - /* Reference: Amiga Guru Book Pages: 42,567,574 */ - if (proc->pr_Task.tc_Node.ln_Type==NT_PROCESS - && proc->pr_CLI != NULL) { - /* first ULONG is StackSize */ - /*longPtr = proc->pr_ReturnAddr; - size = longPtr[0];*/ - - return (char *)proc->pr_ReturnAddr + sizeof(ULONG); - } else { - return (char *)proc->pr_Task.tc_SPUpper; - } -} - -#if 0 /* old version */ -void *scm_get_stack_base() -{ - extern struct WBStartup *_WBenchMsg; - extern long __base; - extern long __stack; - struct Task *task; - struct Process *proc; - struct CommandLineInterface *cli; - long size; - - if ((task = FindTask(0)) == 0) { - GC_err_puts("Cannot find own task structure\n"); - ABORT("task missing"); - } - proc = (struct Process *)task; - cli = BADDR(proc->pr_CLI); - - if (_WBenchMsg != 0 || cli == 0) { - size = (char *)task->tc_SPUpper - (char *)task->tc_SPLower; - } else { - size = cli->cli_DefaultStack * 4; - } - return (ptr_t)(__base + GC_max(size, __stack)); -} -#endif /* 0 */ - -# else /* !AMIGA, !OS2, ... */ - -# ifdef NEED_FIND_LIMIT - /* Some tools to implement HEURISTIC2 */ -# define MIN_PAGE_SIZE 256 /* Smallest conceivable page size, bytes */ - /* static */ jmp_buf GC_jmp_buf; - - /*ARGSUSED*/ - static void GC_fault_handler(sig) - int sig; - { - longjmp(GC_jmp_buf, 1); - } - -# ifdef __STDC__ - typedef void (*handler)(int); -# else - typedef void (*handler)(); -# endif - -# if defined(SUNOS5SIGS) || defined(IRIX5) || defined(OSF1) - static struct sigaction old_segv_act; -# if defined(_sigargs) || defined(HPUX) /* !Irix6.x */ - static struct sigaction old_bus_act; -# endif -# else - static handler old_segv_handler, old_bus_handler; -# endif - - static void GC_setup_temporary_fault_handler() - { -# if defined(SUNOS5SIGS) || defined(IRIX5) || defined(OSF1) - struct sigaction act; - - act.sa_handler = GC_fault_handler; - act.sa_flags = SA_RESTART | SA_NODEFER; - /* The presence of SA_NODEFER represents yet another gross */ - /* hack. Under Solaris 2.3, siglongjmp doesn't appear to */ - /* interact correctly with -lthread. We hide the confusion */ - /* by making sure that signal handling doesn't affect the */ - /* signal mask. */ - - (void) sigemptyset(&act.sa_mask); -# ifdef IRIX_THREADS - /* Older versions have a bug related to retrieving and */ - /* and setting a handler at the same time. */ - (void) sigaction(SIGSEGV, 0, &old_segv_act); - (void) sigaction(SIGSEGV, &act, 0); -# else - (void) sigaction(SIGSEGV, &act, &old_segv_act); -# if defined(IRIX5) && defined(_sigargs) /* Irix 5.x, not 6.x */ \ - || defined(HPUX) - /* Under Irix 5.x or HP/UX, we may get SIGBUS. */ - /* Pthreads doesn't exist under Irix 5.x, so we */ - /* don't have to worry in the threads case. */ - (void) sigaction(SIGBUS, &act, &old_bus_act); -# endif -# endif /* IRIX_THREADS */ -# else - old_segv_handler = signal(SIGSEGV, GC_fault_handler); -# ifdef SIGBUS - old_bus_handler = signal(SIGBUS, GC_fault_handler); -# endif -# endif - } - - static void GC_reset_fault_handler() - { -# if defined(SUNOS5SIGS) || defined(IRIX5) || defined(OSF1) - (void) sigaction(SIGSEGV, &old_segv_act, 0); -# if defined(IRIX5) && defined(_sigargs) /* Irix 5.x, not 6.x */ \ - || defined(HPUX) - (void) sigaction(SIGBUS, &old_bus_act, 0); -# endif -# else - (void) signal(SIGSEGV, old_segv_handler); -# ifdef SIGBUS - (void) signal(SIGBUS, old_bus_handler); -# endif -# endif - } - - /* Single argument version, robust against whole program analysis. */ - static void - GC_noop1(x) - word x; - { - static VOLATILE word sink; - sink = x; - } - - /* Return the first nonaddressible location > p (up) or */ - /* the smallest location q s.t. [q,p] is addressible (!up). */ - static ptr_t GC_find_limit(p, up) - ptr_t p; - GC_bool up; - { - static VOLATILE ptr_t result; - /* Needs to be static, since otherwise it may not be */ - /* preserved across the longjmp. Can safely be */ - /* static since it's only called once, with the */ - /* allocation lock held. */ - - - GC_setup_temporary_fault_handler(); - if (setjmp(GC_jmp_buf) == 0) { - result = (ptr_t)(((word)(p)) - & ~(MIN_PAGE_SIZE-1)); - for (;;) { - if (up) { - result += MIN_PAGE_SIZE; - } else { - result -= MIN_PAGE_SIZE; - } - GC_noop1((word)(*result)); - } - } - GC_reset_fault_handler(); - if (!up) { - result += MIN_PAGE_SIZE; - } - return(result); - } - -# endif - -#ifdef LINUX_STACKBOTTOM - -#include <sys/types.h> -#include <sys/stat.h> -#include <fcntl.h> - -# define STAT_SKIP 27 /* Number of fields preceding startstack */ - /* field in /proc/self/stat */ - - static ptr_t GC_linux_stack_base(void) - { - /* We read the stack base value from /proc/self/stat. We do this */ - /* using direct I/O system calls in order to avoid calling malloc */ - /* in case REDIRECT_MALLOC is defined. */ -# define STAT_BUF_SIZE 4096 -# ifdef USE_LD_WRAP -# define STAT_READ __real_read -# else -# define STAT_READ read -# endif - char stat_buf[STAT_BUF_SIZE]; - int f; - char c; - word result = 0; - size_t i, buf_offset = 0; - - f = open("/proc/self/stat", O_RDONLY); - if (f < 0 || STAT_READ(f, stat_buf, STAT_BUF_SIZE) < 2 * STAT_SKIP) { - ABORT("Couldn't read /proc/self/stat"); - } - c = stat_buf[buf_offset++]; - /* Skip the required number of fields. This number is hopefully */ - /* constant across all Linux implementations. */ - for (i = 0; i < STAT_SKIP; ++i) { - while (isspace(c)) c = stat_buf[buf_offset++]; - while (!isspace(c)) c = stat_buf[buf_offset++]; - } - while (isspace(c)) c = stat_buf[buf_offset++]; - while (isdigit(c)) { - result *= 10; - result += c - '0'; - c = stat_buf[buf_offset++]; - } - close(f); - if (result < 0x10000000) ABORT("Absurd stack bottom value"); - return (ptr_t)result; - } - -#endif /* LINUX_STACKBOTTOM */ - -void *scm_get_stack_base() -{ - word dummy; - void *result; - - result = &dummy; /* initialize to silence compiler */ - -# define STACKBOTTOM_ALIGNMENT_M1 ((word)STACK_GRAN - 1) - -# ifdef STACKBOTTOM - return(STACKBOTTOM); -# else -# ifdef HEURISTIC1 -# if STACK_GROWS_DOWN - result = (ptr_t)((((word)(&dummy)) - + STACKBOTTOM_ALIGNMENT_M1) - & ~STACKBOTTOM_ALIGNMENT_M1); -# else - result = (ptr_t)(((word)(&dummy)) - & ~STACKBOTTOM_ALIGNMENT_M1); -# endif -# endif /* HEURISTIC1 */ -# ifdef LINUX_STACKBOTTOM - result = GC_linux_stack_base(); -# endif -# ifdef HEURISTIC2 -# if STACK_GROWS_DOWN - result = GC_find_limit((ptr_t)(&dummy), TRUE); -# ifdef HEURISTIC2_LIMIT - if (result > HEURISTIC2_LIMIT - && (ptr_t)(&dummy) < HEURISTIC2_LIMIT) { - result = HEURISTIC2_LIMIT; - } -# endif -# else - result = GC_find_limit((ptr_t)(&dummy), FALSE); -# ifdef HEURISTIC2_LIMIT - if (result < HEURISTIC2_LIMIT - && (ptr_t)(&dummy) > HEURISTIC2_LIMIT) { - result = HEURISTIC2_LIMIT; - } -# endif -# endif - -# endif /* HEURISTIC2 */ -# if STACK_GROWS_DOWN - if (result == 0) result = (ptr_t)(signed_word)(-sizeof(ptr_t)); -# endif - return(result); -# endif /* STACKBOTTOM */ -} - -# endif /* ! AMIGA */ -# endif /* ! OS2 */ -# endif /* ! MSWIN32 */ - -#endif /* mach_type_known */ -#endif /* ! HAVE_LIBC_STACK_END */ |