--- ../../guile-orig/libguile/gc.c Mon May 29 09:57:31 2000 +++ gc.c Fri Jun 9 18:19:47 2000 @@ -45,6 +45,8 @@ /* #define DEBUGINFO */ +#include +#include #include #include "libguile/_scm.h" #include "libguile/stime.h" @@ -84,6 +86,9 @@ #endif +/* + FIXME: this tuning junk should go in a separate file --hwn */ + /* {heap tuning parameters} * * These are parameters for controlling memory allocation. The heap @@ -271,6 +276,8 @@ SCM_SYMBOL (sym_heap_segments, "cell-heap-segments"); SCM_SYMBOL (sym_gc_time_taken, "gc-time-taken"); +typedef unsigned int markword; +#define BITSPERWORD 32 typedef struct scm_heap_seg_data_t { /* lower and upper bounds of the segment */ @@ -282,9 +289,26 @@ /* number of cells per object in this segment */ int span; + + markword *mark_bits; } scm_heap_seg_data_t; +static int +scm_number_markwords (scm_heap_seg_data_t *p) +{ + int ncells = p->bounds[1] - p->bounds[0]; + int reqd_markwords = ncells / BITSPERWORD + 1; + return reqd_markwords; +} + +static void +clear_mark_bits () +{ + int i =0; + for (i = 0; i < scm_n_heap_segs; i++) + memset (scm_heap_table[i].mark_bits, 0, scm_number_markwords (scm_heap_table + i) *sizeof (markword)); +} static scm_sizet init_heap_seg (SCM_CELLPTR, scm_sizet, scm_freelist_t *); static void alloc_some_heap (scm_freelist_t *); @@ -834,7 +858,8 @@ } scm_c_hook_run (&scm_before_mark_c_hook, 0); - + clear_mark_bits (); + #ifndef USE_THREADS /* Protect from the C stack. This must be the first marking @@ -873,18 +898,20 @@ * in scm_vector_set_length_x. */ + j = SCM_NUM_PROTECTS; while (j--) scm_gc_mark (scm_sys_protects[j]); +#ifndef USE_THREADS + scm_gc_mark (scm_root->handle); +#endif + /* FIXME: we should have a means to register C functions to be run * in different phases of GC */ scm_mark_subr_table (); -#ifndef USE_THREADS - scm_gc_mark (scm_root->handle); -#endif scm_c_hook_run (&scm_before_sweep_c_hook, 0); @@ -902,6 +929,90 @@ } +/* + return the current mark bit, and set then set the mark bit. + */ +/* + fixme: use binary search. --hwn + */ +#define GET_SET_CODE(set, clear) \ + int i; \ + \ + SCM_CELLPTR p = SCM2PTR (cell); \ + for (i = 0; i < scm_n_heap_segs; i++) \ + if (SCM_PTR_LE (scm_heap_table[i].bounds[0], p) \ + && SCM_PTR_GT (scm_heap_table[i].bounds[1], p)) \ + { \ + int j = p - scm_heap_table[i].bounds[0]; \ + int mask = 0x1 << (j % BITSPERWORD); \ + markword * wp = scm_heap_table[i].mark_bits + (j / BITSPERWORD); \ + int r = *wp & mask; \ + if (clear) \ + *wp &= ~mask ; \ + \ + if (set) \ + *wp |= mask; \ + \ + return r; \ + } \ + \ + \ + fprintf (stderr, "which_seg: can't find segment containing cell %lx\n", \ + SCM_UNPACK (cell)); \ + abort (); \ + + +int +scm_get_set_mark_p (SCM cell) +{ + scm_cell * ptr = SCM2PTR (cell); + unsigned int i = 0; + unsigned int j = scm_n_heap_segs - 1; + while (i < j) { + int k = (i + j) / 2; + if (SCM_PTR_GT (scm_heap_table[k].bounds[1], ptr)) { + j = k; + } else if (SCM_PTR_LE (scm_heap_table[k].bounds[0], ptr)) { + i = k + 1; + } + } + + { + int j = ptr - scm_heap_table[i].bounds[0]; + int mask = 0x1 << (j % BITSPERWORD); + markword * wp = scm_heap_table[i].mark_bits + (j / BITSPERWORD); + int r = *wp & mask; + + if (1) + *wp |= mask; + + return r; + } +} +/* debugging */ +SCM +scm_my_vecref(SCM vec, int i) +{ + return SCM_VELTS (vec)[i]; +} + +/* + fixme: cut & paste programming --hwn + */ + int +scm_get_mark_p (SCM cell) +{ + GET_SET_CODE(0,0); +} + +int +scm_clear_mark (SCM cell) +{ + GET_SET_CODE(0,1); +} + + + /* {Mark/Sweep} */ @@ -925,38 +1036,31 @@ if (SCM_NCELLP (ptr)) scm_wta (ptr, "rogue pointer in heap", NULL); + + if (scm_get_set_mark_p (ptr)) + return; + switch (SCM_TYP7 (ptr)) { case scm_tcs_cons_nimcar: - if (SCM_GCMARKP (ptr)) - break; - SCM_SETGCMARK (ptr); if (SCM_IMP (SCM_CDR (ptr))) /* SCM_IMP works even with a GC mark */ { ptr = SCM_CAR (ptr); goto gc_mark_nimp; } scm_gc_mark (SCM_CAR (ptr)); - ptr = SCM_GCCDR (ptr); + ptr = SCM_CDR (ptr); goto gc_mark_nimp; case scm_tcs_cons_imcar: - if (SCM_GCMARKP (ptr)) - break; - SCM_SETGCMARK (ptr); - ptr = SCM_GCCDR (ptr); + + ptr = SCM_CDR (ptr); goto gc_mark_loop; case scm_tc7_pws: - if (SCM_GCMARKP (ptr)) - break; - SCM_SETGCMARK (ptr); scm_gc_mark (SCM_CELL_OBJECT_2 (ptr)); - ptr = SCM_GCCDR (ptr); + ptr = SCM_CDR (ptr); goto gc_mark_loop; case scm_tcs_cons_gloc: - if (SCM_GCMARKP (ptr)) - break; - SCM_SETGCMARK (ptr); - { + { /* Dirk:FIXME:: The following code is super ugly: ptr may be a struct * or a gloc. If it is a gloc, the cell word #0 of ptr is a pointer * to a heap cell. If it is a struct, the cell word #0 of ptr is a @@ -973,7 +1077,7 @@ /* ptr is a gloc */ SCM gloc_car = SCM_PACK (word0); scm_gc_mark (gloc_car); - ptr = SCM_GCCDR (ptr); + ptr = SCM_CDR (ptr); goto gc_mark_loop; } case 1: /* ! */ @@ -983,9 +1087,9 @@ SCM layout = SCM_PACK (vtable_data [scm_vtable_index_layout]); int len = SCM_LENGTH (layout); char * fields_desc = SCM_CHARS (layout); - /* We're using SCM_GCCDR here like STRUCT_DATA, except + /* We're using SCM_CDR here like STRUCT_DATA, except that it removes the mark */ - scm_bits_t * struct_data = (scm_bits_t *) SCM_UNPACK (SCM_GCCDR (ptr)); + scm_bits_t * struct_data = (scm_bits_t *) SCM_UNPACK (SCM_CDR (ptr)); if (vtable_data[scm_struct_i_flags] & SCM_STRUCTF_ENTITY) { @@ -1019,25 +1123,21 @@ } break; case scm_tcs_closures: - if (SCM_GCMARKP (ptr)) - break; - SCM_SETGCMARK (ptr); + if (SCM_IMP (SCM_CDR (ptr))) { ptr = SCM_CLOSCAR (ptr); goto gc_mark_nimp; } scm_gc_mark (SCM_CLOSCAR (ptr)); - ptr = SCM_GCCDR (ptr); + ptr = SCM_CDR (ptr); goto gc_mark_nimp; case scm_tc7_vector: case scm_tc7_lvector: #ifdef CCLO case scm_tc7_cclo: #endif - if (SCM_GC8MARKP (ptr)) - break; - SCM_SETGC8MARK (ptr); + i = SCM_LENGTH (ptr); if (i == 0) break; @@ -1047,9 +1147,7 @@ ptr = SCM_VELTS (ptr)[0]; goto gc_mark_loop; case scm_tc7_contin: - if SCM_GC8MARKP - (ptr) break; - SCM_SETGC8MARK (ptr); + if (SCM_VELTS (ptr)) scm_mark_locations (SCM_VELTS_AS_STACKITEMS (ptr), (scm_sizet) @@ -1072,22 +1170,20 @@ #endif #endif case scm_tc7_string: - SCM_SETGC8MARK (ptr); - break; + break; case scm_tc7_substring: - if (SCM_GC8MARKP(ptr)) - break; - SCM_SETGC8MARK (ptr); - ptr = SCM_CDR (ptr); + ptr = SCM_CDR (ptr); goto gc_mark_loop; case scm_tc7_wvect: - if (SCM_GC8MARKP(ptr)) - break; + /* + All weak vectors in memory are chained onto SCM_WEAK_VECTORS, + so that the weak after mark hook can later look at all weak + vectors to determine what can go. */ SCM_WVECT_GC_CHAIN (ptr) = scm_weak_vectors; scm_weak_vectors = ptr; - SCM_SETGC8MARK (ptr); + if (SCM_IS_WHVEC_ANY (ptr)) { int x; @@ -1106,8 +1202,8 @@ /* mark everything on the alist except the keys or * values, according to weak_values and weak_keys. */ - while ( SCM_CONSP (alist) - && !SCM_GCMARKP (alist) + while (SCM_CONSP (alist) + && !scm_get_mark_p (alist) && SCM_CONSP (SCM_CAR (alist))) { SCM kvpair; @@ -1135,7 +1231,7 @@ if (!weak_keys) scm_gc_mark (SCM_CAR (kvpair)); if (!weak_values) - scm_gc_mark (SCM_GCCDR (kvpair)); + scm_gc_mark (SCM_CDR (kvpair)); alist = next_alist; } if (SCM_NIMP (alist)) @@ -1145,16 +1241,10 @@ break; case scm_tc7_msymbol: - if (SCM_GC8MARKP(ptr)) - break; - SCM_SETGC8MARK (ptr); scm_gc_mark (SCM_SYMBOL_FUNC (ptr)); ptr = SCM_SYMBOL_PROPS (ptr); goto gc_mark_loop; case scm_tc7_ssymbol: - if (SCM_GC8MARKP(ptr)) - break; - SCM_SETGC8MARK (ptr); break; case scm_tcs_subrs: break; @@ -1162,9 +1252,6 @@ i = SCM_PTOBNUM (ptr); if (!(i < scm_numptob)) goto def; - if (SCM_GC8MARKP (ptr)) - break; - SCM_SETGC8MARK (ptr); if (SCM_PTAB_ENTRY(ptr)) scm_gc_mark (SCM_PTAB_ENTRY(ptr)->file_name); if (scm_ptobs[i].mark) @@ -1176,9 +1263,6 @@ return; break; case scm_tc7_smob: - if (SCM_GC8MARKP (ptr)) - break; - SCM_SETGC8MARK (ptr); switch (SCM_GCTYP16 (ptr)) { /* should be faster than going through scm_smobs */ case scm_tc_free_cell: @@ -1391,7 +1475,7 @@ */ scm_bits_t word0 = SCM_CELL_WORD_0 (scmptr) - scm_tc3_cons_gloc; scm_bits_t * vtable_data = (scm_bits_t *) word0; /* access as struct */ - if (SCM_GCMARKP (scmptr)) + if (scm_get_mark_p (scmptr)) { if (vtable_data [scm_vtable_index_vcell] == 1) vtable_data [scm_vtable_index_vcell] = 0; @@ -1404,7 +1488,7 @@ { scm_struct_free_t free = (scm_struct_free_t) vtable_data[scm_struct_i_free]; - m += free (vtable_data, (scm_bits_t *) SCM_UNPACK (SCM_GCCDR (scmptr))); + m += free (vtable_data, (scm_bits_t *) SCM_UNPACK (SCM_CDR (scmptr))); } } } @@ -1413,11 +1497,11 @@ case scm_tcs_cons_nimcar: case scm_tcs_closures: case scm_tc7_pws: - if (SCM_GCMARKP (scmptr)) + if (scm_get_mark_p (scmptr)) goto cmrkcontinue; break; case scm_tc7_wvect: - if (SCM_GC8MARKP (scmptr)) + if (scm_get_mark_p (scmptr)) { goto c8mrkcontinue; } @@ -1433,7 +1517,7 @@ #ifdef CCLO case scm_tc7_cclo: #endif - if (SCM_GC8MARKP (scmptr)) + if (scm_get_mark_p (scmptr)) goto c8mrkcontinue; m += (SCM_LENGTH (scmptr) * sizeof (SCM)); @@ -1443,79 +1527,79 @@ break; #ifdef HAVE_ARRAYS case scm_tc7_bvect: - if SCM_GC8MARKP (scmptr) + if (scm_get_mark_p (scmptr)) goto c8mrkcontinue; m += sizeof (long) * ((SCM_HUGE_LENGTH (scmptr) + SCM_LONG_BIT - 1) / SCM_LONG_BIT); goto freechars; case scm_tc7_byvect: - if SCM_GC8MARKP (scmptr) + if (scm_get_mark_p (scmptr)) goto c8mrkcontinue; m += SCM_HUGE_LENGTH (scmptr) * sizeof (char); goto freechars; case scm_tc7_ivect: case scm_tc7_uvect: - if SCM_GC8MARKP (scmptr) + if (scm_get_mark_p (scmptr)) goto c8mrkcontinue; m += SCM_HUGE_LENGTH (scmptr) * sizeof (long); goto freechars; case scm_tc7_svect: - if SCM_GC8MARKP (scmptr) + if (scm_get_mark_p (scmptr)) goto c8mrkcontinue; m += SCM_HUGE_LENGTH (scmptr) * sizeof (short); goto freechars; #ifdef HAVE_LONG_LONGS case scm_tc7_llvect: - if SCM_GC8MARKP (scmptr) + if (scm_get_mark_p (scmptr)) goto c8mrkcontinue; m += SCM_HUGE_LENGTH (scmptr) * sizeof (long_long); goto freechars; #endif case scm_tc7_fvect: - if SCM_GC8MARKP (scmptr) + if (scm_get_mark_p (scmptr)) goto c8mrkcontinue; m += SCM_HUGE_LENGTH (scmptr) * sizeof (float); goto freechars; case scm_tc7_dvect: - if SCM_GC8MARKP (scmptr) + if (scm_get_mark_p (scmptr)) goto c8mrkcontinue; m += SCM_HUGE_LENGTH (scmptr) * sizeof (double); goto freechars; case scm_tc7_cvect: - if SCM_GC8MARKP (scmptr) + if (scm_get_mark_p (scmptr)) goto c8mrkcontinue; m += SCM_HUGE_LENGTH (scmptr) * 2 * sizeof (double); goto freechars; #endif case scm_tc7_substring: - if (SCM_GC8MARKP (scmptr)) + if (scm_get_mark_p (scmptr)) goto c8mrkcontinue; break; case scm_tc7_string: - if (SCM_GC8MARKP (scmptr)) + if (scm_get_mark_p (scmptr)) goto c8mrkcontinue; m += SCM_HUGE_LENGTH (scmptr) + 1; goto freechars; case scm_tc7_msymbol: - if (SCM_GC8MARKP (scmptr)) + if (scm_get_mark_p (scmptr)) goto c8mrkcontinue; m += (SCM_LENGTH (scmptr) + 1 + (SCM_CHARS (scmptr) - (char *) SCM_SLOTS (scmptr))); scm_must_free ((char *)SCM_SLOTS (scmptr)); break; case scm_tc7_contin: - if SCM_GC8MARKP (scmptr) + if (scm_get_mark_p (scmptr)) goto c8mrkcontinue; m += SCM_LENGTH (scmptr) * sizeof (SCM_STACKITEM) + sizeof (scm_contregs); if (SCM_VELTS (scmptr)) goto freechars; case scm_tc7_ssymbol: - if SCM_GC8MARKP(scmptr) + if (scm_get_mark_p (scmptr)) goto c8mrkcontinue; break; case scm_tcs_subrs: continue; case scm_tc7_port: - if SCM_GC8MARKP (scmptr) + if (scm_get_mark_p (scmptr)) goto c8mrkcontinue; if SCM_OPENP (scmptr) { @@ -1540,23 +1624,23 @@ { case scm_tc_free_cell: case scm_tc16_real: - if SCM_GC8MARKP (scmptr) + if (scm_get_mark_p (scmptr)) goto c8mrkcontinue; break; #ifdef SCM_BIGDIG case scm_tc16_big: - if SCM_GC8MARKP (scmptr) + if (scm_get_mark_p (scmptr)) goto c8mrkcontinue; m += (SCM_NUMDIGS (scmptr) * SCM_BITSPERDIG / SCM_CHAR_BIT); goto freechars; #endif /* def SCM_BIGDIG */ case scm_tc16_complex: - if SCM_GC8MARKP (scmptr) + if (scm_get_mark_p (scmptr)) goto c8mrkcontinue; m += 2 * sizeof (double); goto freechars; default: - if SCM_GC8MARKP (scmptr) + if (scm_get_mark_p (scmptr)) goto c8mrkcontinue; { @@ -1599,10 +1683,8 @@ continue; c8mrkcontinue: - SCM_CLRGC8MARK (scmptr); continue; cmrkcontinue: - SCM_CLRGCMARK (scmptr); } #ifdef GC_FREE_SEGMENTS if (n == seg_size) @@ -1881,8 +1963,15 @@ scm_heap_table[new_seg_index].freelist = freelist; scm_heap_table[new_seg_index].bounds[0] = ptr; scm_heap_table[new_seg_index].bounds[1] = seg_end; + + /* + fixme: check for error condition. + */ + SCM_SYSCALL (scm_heap_table[new_seg_index].mark_bits = + (markword*) malloc (sizeof (markword) + * scm_number_markwords (scm_heap_table + new_seg_index))); - + /* Compute the least valid object pointer w/in this segment */ ptr = CELL_UP (ptr, span); --- ../../guile-orig/libguile/gc.h Tue May 23 17:20:54 2000 +++ gc.h Tue May 30 21:05:29 2000 @@ -196,12 +196,9 @@ #define SCM_FREEP(x) (SCM_NIMP (x) && (SCM_CELL_TYPE (x) == scm_tc_free_cell)) #define SCM_NFREEP(x) (!SCM_FREEP (x)) -/* 1. This shouldn't be used on immediates. - 2. It thinks that subrs are always unmarked (harmless). */ -#define SCM_MARKEDP(x) ((SCM_CELL_TYPE (x) & 5) == 5 \ - ? SCM_GC8MARKP (x) \ - : SCM_GCMARKP (x)) -#define SCM_NMARKEDP(x) (!SCM_MARKEDP (x)) +#define SCM_MARKEDP(x) error +#define SCM_NMARKEDP(x) error + extern struct scm_heap_seg_data_t *scm_heap_table; extern int scm_n_heap_segs; --- ../../guile-orig/libguile/gdbint.c Tue May 16 14:11:08 2000 +++ gdbint.c Tue May 30 21:09:22 2000 @@ -143,14 +143,14 @@ unmark_port (SCM port) { SCM stream, string; - port_mark_p = SCM_GC8MARKP (port); - SCM_CLRGC8MARK (port); + port_mark_p = scm_get_set_mark_p (port); + scm_clear_mark (port); stream = SCM_PACK (SCM_STREAM (port)); - stream_mark_p = SCM_GCMARKP (stream); - SCM_CLRGCMARK (stream); + stream_mark_p = scm_get_set_mark_p (stream); + scm_clear_mark (stream); string = SCM_CDR (stream); - string_mark_p = SCM_GC8MARKP (string); - SCM_CLRGC8MARK (string); + string_mark_p = scm_get_set_mark_p (string); + scm_clear_mark (string); } @@ -159,9 +159,9 @@ { SCM stream = SCM_PACK (SCM_STREAM (port)); SCM string = SCM_CDR (stream); - if (string_mark_p) SCM_SETGC8MARK (string); - if (stream_mark_p) SCM_SETGCMARK (stream); - if (port_mark_p) SCM_SETGC8MARK (port); + if (string_mark_p) scm_get_set_mark_p (string); + if (stream_mark_p) scm_get_set_mark_p (stream); + if (port_mark_p) scm_get_set_mark_p (port); } @@ -212,8 +212,8 @@ scm_truncate_file (gdb_input_port, SCM_UNDEFINED); scm_seek (gdb_input_port, SCM_INUM0, SCM_MAKINUM (SEEK_SET)); /* Read one object */ - tok_buf_mark_p = SCM_GC8MARKP (tok_buf); - SCM_CLRGC8MARK (tok_buf); + tok_buf_mark_p = scm_get_set_mark_p (tok_buf); + scm_clear_mark (tok_buf); ans = scm_lreadr (&tok_buf, gdb_input_port, &ans); if (SCM_GC_P) { @@ -230,7 +230,7 @@ scm_permanent_object (ans); exit: if (tok_buf_mark_p) - SCM_SETGC8MARK (tok_buf); + scm_get_set_mark_p (tok_buf); remark_port (gdb_input_port); SCM_END_FOREIGN_BLOCK; return status; --- ../../guile-orig/libguile/guardians.c Sat Apr 22 01:12:09 2000 +++ guardians.c Tue May 30 21:04:56 2000 @@ -263,7 +263,7 @@ { SCM next_pair = SCM_CDR (pair); - if (SCM_NMARKEDP (SCM_CAR (pair))) + if (! scm_get_mark_p (SCM_CAR (pair))) { /* got you, zombie! */ @@ -282,8 +282,8 @@ /* Mark the cells of the live list (yes, the cells in the list, even though we don't care about objects pointed to by the list cars, since we know they are already marked). */ - for (pair = g->live.head; SCM_NIMP (pair); pair = SCM_GCCDR (pair)) - SCM_SETGCMARK (pair); + for (pair = g->live.head; SCM_NIMP (pair); pair = SCM_CDR (pair)) + scm_get_set_mark_p (pair); } /* ghouston: Doesn't it seem a bit disturbing that if a zombie --- ../../guile-orig/libguile/numbers.h Tue May 30 18:01:34 2000 +++ numbers.h Thu May 25 15:53:49 2000 @@ -173,7 +173,7 @@ #define SCM_NUMBERP(x) (SCM_INUMP(x) || SCM_NUMP(x)) #define SCM_NUMP(x) (!SCM_IMP(x) && (0xfcff & SCM_CELL_TYPE (x)) == scm_tc7_smob) -#define SCM_BIGP(x) (!SCM_IMP (x) && (SCM_TYP16 (x) == scm_tc16_big)) +#define SCM_BIGP(x) SCM_SMOB_PREDICATE (scm_tc16_big, x) #define SCM_BIGSIGNFLAG 0x10000L #define SCM_BIGSIZEFIELD 17 #define SCM_BIGSIGN(x) (SCM_CELL_WORD_0 (x) & SCM_BIGSIGNFLAG) --- ../../guile-orig/libguile/pairs.c Fri May 5 18:19:30 2000 +++ pairs.c Fri Jun 9 17:28:14 2000 @@ -180,3 +180,17 @@ c-file-style: "gnu" End: */ + +/* analogous to the Scheme car operator */ +SCM +scm_car (SCM x) +{ + return SCM_CAR (x); +} + +/* analogous to the Scheme cdr operator */ +SCM +scm_cdr (SCM x) +{ + return SCM_CDR (x); +} --- ../../guile-orig/libguile/procs.c Tue Apr 25 11:45:16 2000 +++ procs.c Tue May 30 21:09:57 2000 @@ -137,7 +137,7 @@ int i; for (i = 0; i < scm_subr_table_size; ++i) { - SCM_SETGC8MARK (scm_subr_table[i].name); + scm_get_set_mark_p (scm_subr_table[i].name); if (scm_subr_table[i].generic && *scm_subr_table[i].generic) scm_gc_mark (*scm_subr_table[i].generic); if (SCM_NIMP (scm_subr_table[i].properties)) --- ../../guile-orig/libguile/root.c Fri Apr 21 16:16:31 2000 +++ root.c Fri Jun 9 17:44:07 2000 @@ -99,6 +99,12 @@ } +static size_t +free_root (SCM root) +{ + return scm_smob_free (root); +} + static int print_root (SCM exp,SCM port,scm_print_state *pstate) { @@ -442,7 +448,7 @@ scm_init_root () { scm_tc16_root = scm_make_smob_type_mfpe ("root", sizeof (struct scm_root_state), - mark_root, NULL, print_root, NULL); + mark_root, free_root, print_root, NULL); #include "libguile/root.x" } --- ../../guile-orig/libguile/scmsigs.c Tue May 30 17:56:55 2000 +++ scmsigs.c Tue May 9 00:49:44 2000 @@ -74,6 +74,13 @@ +#ifdef USE_MIT_PTHREADS +#undef signal +#define signal pthread_signal +#endif + + + /* SIGRETTYPE is the type that signal handlers return. See */ #ifdef RETSIGTYPE --- ../../guile-orig/libguile/tags.h Thu May 25 15:53:49 2000 +++ tags.h Tue May 30 21:09:08 2000 @@ -336,14 +336,19 @@ /* Testing and Changing GC Marks in Various Standard Positions */ -#define SCM_GCCDR(x) SCM_PACK(~1L & SCM_UNPACK (SCM_CDR (x))) -#define SCM_GCMARKP(x) (1 & SCM_UNPACK (SCM_CDR (x))) -#define SCM_GC8MARKP(x) (0x80 & SCM_CELL_TYPE (x)) -#define SCM_SETGCMARK(x) SCM_SETOR_CDR (x, 1) -#define SCM_CLRGCMARK(x) SCM_SETAND_CDR (x, ~1L) -#define SCM_SETGC8MARK(x) SCM_SETOR_CAR (x, 0x80) -#define SCM_CLRGC8MARK(x) SCM_SETAND_CAR (x, ~0x80L) +#define SCM_GCCDR(x) error +#define SCM_GCMARKP(x) error +#define SCM_GC8MARKP(x) error +#define SCM_SETGCMARK(x) error +#define SCM_CLRGCMARK(x) error +#define SCM_SETGC8MARK(x) error +#define SCM_CLRGC8MARK(x) error + + +int scm_get_set_mark_p (SCM cell); +int scm_get_mark_p (SCM cell); +int scm_clear_mark (SCM cell); --- ../../guile-orig/libguile/threads.c Tue May 30 17:56:55 2000 +++ threads.c Fri Apr 21 16:16:31 2000 @@ -52,6 +52,7 @@ threads.h coop-defs.h iselect.h + mit-pthreads.c coop-threads.c coop-threads.h coop-defs.h* @@ -132,6 +133,10 @@ SCM_REGISTER_PROC(s_signal_condition_variable, "signal-condition-variable", 1, 0, 0, scm_signal_condition_variable); + +#ifdef USE_MIT_PTHREADS +#include "mit-pthreads.c" +#endif #ifdef USE_COOP_THREADS #include "libguile/coop-threads.c" --- ../../guile-orig/libguile/threads.h Tue May 30 17:56:55 2000 +++ threads.h Sun Mar 19 20:01:14 2000 @@ -3,7 +3,7 @@ #ifndef THREADSH #define THREADSH -/* Copyright (C) 1996, 1997, 1998, 2000 Free Software Foundation, Inc. +/* Copyright (C) 1996, 1997, 1998, 2000 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -52,21 +52,19 @@ #include "libguile/procs.h" #include "libguile/throw.h" - - /* smob tags for the thread datatypes */ extern long scm_tc16_thread; extern long scm_tc16_mutex; extern long scm_tc16_condvar; -#define SCM_THREADP(x) (!SCM_IMP (x) && (SCM_TYP16 (x) == scm_tc16_thread)) -#define SCM_THREAD_DATA(x) ((void *) SCM_CELL_WORD_1 (x)) +#define SCM_THREADP(obj) (SCM_NIMP(obj) && (scm_tc16_thread == SCM_TYP16 (obj))) +#define SCM_THREAD_DATA(obj) ((void *) SCM_CDR (obj)) -#define SCM_MUTEXP(x) (!SCM_IMP (x) && (SCM_TYP16 (x) == scm_tc16_mutex)) -#define SCM_MUTEX_DATA(x) ((void *) SCM_CELL_WORD_1 (x)) +#define SCM_MUTEXP(obj) (SCM_NIMP(obj) && (scm_tc16_mutex == SCM_TYP16 (obj))) +#define SCM_MUTEX_DATA(obj) ((void *) SCM_CDR (obj)) -#define SCM_CONDVARP(x) (!SCM_IMP (x) && (SCM_TYP16 (x) == scm_tc16_condvar)) -#define SCM_CONDVAR_DATA(x) ((void *) SCM_CELL_WORD_1 (x)) +#define SCM_CONDVARP(obj) (SCM_NIMP(obj) && (scm_tc16_condvar == SCM_TYP16 (obj))) +#define SCM_CONDVAR_DATA(obj) ((void *) SCM_CDR (obj)) /* Initialize implementation specific details of the threads support */ void scm_threads_init (SCM_STACKITEM *); @@ -101,6 +99,17 @@ extern SCM scm_make_condition_variable (void); extern SCM scm_wait_condition_variable (SCM cond, SCM mutex); extern SCM scm_signal_condition_variable (SCM cond); + +#if 0 +/* These don't work any more. */ +#ifdef USE_MIT_PTHREADS +#include "mit-pthreads.h" +#endif + +#ifdef USE_FSU_PTHREADS +#include "fsu-pthreads.h" +#endif +#endif #ifdef USE_COOP_THREADS #include "libguile/coop-defs.h" --- ../../guile-orig/libguile/weaks.c Fri May 5 13:10:57 2000 +++ weaks.c Wed Jun 7 19:10:24 2000 @@ -214,6 +214,13 @@ return 0; } + +/* + See the comment in gc.c. The spines haven't been marked yet, to + ensure that protecting part of the alist does the right thing. + We now mark them, as the last thing here. + */ + static void * scm_mark_weak_vector_spines (void *dummy1, void *dummy2, void *dummy3) { @@ -237,12 +244,12 @@ alist = ptr[j]; while ( SCM_CONSP (alist) - && !SCM_GCMARKP (alist) + && !scm_get_mark_p (alist) && SCM_CONSP (SCM_CAR (alist))) { - SCM_SETGCMARK (alist); - SCM_SETGCMARK (SCM_CAR (alist)); - alist = SCM_GCCDR (alist); + scm_get_set_mark_p (alist); + scm_get_set_mark_p (SCM_CAR (alist)); + alist = SCM_CDR (alist); } } } @@ -254,14 +261,14 @@ static void * scm_scan_weak_vectors (void *dummy1, void *dummy2, void *dummy3) { - SCM *ptr, w; + SCM w; + int q =0; for (w = scm_weak_vectors; !SCM_NULLP (w); w = SCM_WVECT_GC_CHAIN (w)) { if (!SCM_IS_WHVEC_ANY (w)) { register long j, n; - - ptr = SCM_VELTS (w); + SCM * ptr = SCM_VELTS (w); n = SCM_LENGTH (w); for (j = 0; j < n; ++j) if (SCM_FREEP (ptr[j])) @@ -272,8 +279,7 @@ SCM obj = w; register long n = SCM_LENGTH (w); register long j; - - ptr = SCM_VELTS (w); + SCM * ptr = SCM_VELTS (w); for (j = 0; j < n; ++j) { @@ -307,9 +313,10 @@ } } } + q++; } - return 0; + return q; }