--- convert.i.c.~1.6.~ Mon Mar 11 18:51:52 2002 +++ convert.i.c Sun Jul 14 22:50:53 2002 @@ -245,17 +245,17 @@ CTYPES2SCM (const CTYPE *data, long n) { long i; - SCM v, *velts; - + SCM v; + SCM_ASSERT_RANGE (SCM_ARG2, scm_long2num (n), n > 0 && n <= SCM_VECTOR_MAX_LENGTH); v = scm_c_make_vector (n, SCM_UNSPECIFIED); - velts = SCM_VELTS (v); + for (i = 0; i < n; i++) #ifdef FLOATTYPE - velts[i] = scm_make_real ((double) data[i]); + SCM_VECTOR_SET (v, i, scm_make_real ((double) data[i])); #else - velts[i] = SCM_MAKINUM (data[i]); + SCM_VECTOR_SET (v, i, SCM_MAKINUM (data[i])); #endif return v; } --- environments.c.~1.27.~ Thu Mar 14 04:47:41 2002 +++ environments.c Sun Jul 14 22:53:21 2002 @@ -533,7 +533,7 @@ size_t hash = SCM_SYMBOL_HASH (symbol) % SCM_VECTOR_LENGTH (obarray); SCM entry = scm_cons (symbol, data); SCM slot = scm_cons (entry, SCM_VELTS (obarray)[hash]); - SCM_VELTS (obarray)[hash] = slot; + SCM_VECTOR_SET (obarray,hash, slot); return entry; } @@ -562,7 +562,7 @@ } slot = scm_cons (new_entry, SCM_VELTS (obarray)[hash]); - SCM_VELTS (obarray)[hash] = slot; + SCM_VECTOR_SET(obarray,hash,slot); return SCM_BOOL_F; } @@ -587,6 +587,46 @@ return SCM_UNDEFINED; } +/* + Remove first occurance of KEY from (cdr ALIST), + return (KEY . VAL) if found, otherwise return #f + + PRECONDITION: + + length (ALIST) >= 1 + */ +static +SCM +remove_key_from_alist (SCM alist, SCM key) +{ + SCM cell_cdr = alist; + alist =SCM_CDR (alist); + + /* + inv: cdr(cell_cdr) == alist + */ + while (!SCM_NULLP (alist)) + { + if (SCM_EQ_P(SCM_CAAR (alist), key)) + { + SCM entry = SCM_CAR(alist); + SCM_SETCDR(cell_cdr, SCM_CDR (alist)); + + return entry; + } + else + { + cell_cdr = SCM_CDR (cell_cdr); + } + + if (!SCM_NULLP(alist)) + alist = SCM_CDR (alist); + } + + return SCM_BOOL_F; +} + + /* * Remove entry from obarray. If the symbol was found and removed, the old @@ -596,22 +636,20 @@ obarray_remove (SCM obarray, SCM sym) { size_t hash = SCM_SYMBOL_HASH (sym) % SCM_VECTOR_LENGTH (obarray); - SCM lsym; - SCM *lsymp; + SCM table_entry = SCM_VELTS (obarray)[hash]; + + if (SCM_NULLP(table_entry)) + return SCM_BOOL_F; - /* Dirk:FIXME:: gc problem due to use of &SCM_VELTS[hash] */ - for (lsym = *(lsymp = &SCM_VELTS (obarray)[hash]); - !SCM_NULLP (lsym); - lsym = *(lsymp = SCM_CDRLOC (lsym))) + if (SCM_EQ_P (SCM_CAAR (table_entry), sym)) { - SCM entry = SCM_CAR (lsym); - if (SCM_EQ_P (SCM_CAR (entry), sym)) - { - *lsymp = SCM_CDR (lsym); - return entry; - } + SCM_VECTOR_SET(obarray,hash, SCM_CDR(table_entry)); + return SCM_CAR(table_entry); + } + else + { + return remove_key_from_alist (table_entry, sym); } - return SCM_BOOL_F; } @@ -623,7 +661,7 @@ for (i = 0; i < size; i++) { - SCM_VELTS (obarray)[i] = SCM_EOL; + SCM_VECTOR_SET(obarray,i,SCM_EOL); } } @@ -655,7 +693,7 @@ #define CORE_ENVIRONMENT_WEAK_OBSERVERS(env) \ (SCM_VELTS (CORE_ENVIRONMENT_WEAK_OBSERVER_VECTOR (env)) [0]) #define SCM_SET_CORE_ENVIRONMENT_WEAK_OBSERVERS(env, v) \ - (SCM_VELTS (CORE_ENVIRONMENT_WEAK_OBSERVER_VECTOR (env)) [0] = (v)) + (SCM_VECTOR_SET (CORE_ENVIRONMENT_WEAK_OBSERVER_VECTOR (env), 0, (v))) --- eval.c.~1.275.~ Sat Jul 13 12:39:41 2002 +++ eval.c Sun Jul 14 23:24:42 2002 @@ -798,7 +798,7 @@ else if (SCM_VECTORP (form)) { size_t i = SCM_VECTOR_LENGTH (form); - SCM *data = SCM_VELTS (form); + SCM const *data = SCM_VELTS (form); SCM tmp = SCM_EOL; while (i != 0) tmp = scm_cons (data[--i], tmp); @@ -3789,7 +3789,7 @@ SCM args, const char *who) { - SCM *ve = SCM_VELTS (argv); + SCM const *ve = SCM_VELTS (argv); long i; for (i = SCM_VECTOR_LENGTH (argv) - 1; i >= 1; i--) @@ -3828,7 +3828,7 @@ long i, len; SCM res = SCM_EOL; SCM *pres = &res; - SCM *ve = &args; /* Keep args from being optimized away. */ + SCM const *ve = &args; /* Keep args from being optimized away. */ len = scm_ilength (arg1); SCM_GASSERTn (len >= 0, @@ -3855,7 +3855,7 @@ if (SCM_IMP (ve[i])) return res; arg1 = scm_cons (SCM_CAR (ve[i]), arg1); - ve[i] = SCM_CDR (ve[i]); + SCM_VECTOR_SET(args, i, SCM_CDR (ve[i])); } *pres = scm_list_1 (scm_apply (proc, arg1, SCM_EOL)); pres = SCM_CDRLOC (*pres); @@ -3870,7 +3870,7 @@ scm_for_each (SCM proc, SCM arg1, SCM args) #define FUNC_NAME s_for_each { - SCM *ve = &args; /* Keep args from being optimized away. */ + SCM const *ve = &args; /* Keep args from being optimized away. */ long i, len; len = scm_ilength (arg1); SCM_GASSERTn (len >= 0, g_for_each, scm_cons2 (proc, arg1, args), @@ -3891,12 +3891,12 @@ while (1) { arg1 = SCM_EOL; - for (i = SCM_VECTOR_LENGTH (args) - 1; i >= 0; i--) + for (i = SCM_VECTOR_LENGTH (args); i--;) { if (SCM_IMP (ve[i])) return SCM_UNSPECIFIED; arg1 = scm_cons (SCM_CAR (ve[i]), arg1); - ve[i] = SCM_CDR (ve[i]); + SCM_VECTOR_SET(args,i, SCM_CDR (ve[i])); } scm_apply (proc, arg1, SCM_EOL); } @@ -4008,7 +4008,7 @@ unsigned long i = SCM_VECTOR_LENGTH (obj); ans = scm_c_make_vector (i, SCM_UNSPECIFIED); while (i--) - SCM_VELTS (ans)[i] = scm_copy_tree (SCM_VELTS (obj)[i]); + SCM_VECTOR_SET(ans,i,scm_copy_tree (SCM_VELTS (obj)[i])); return ans; } if (!SCM_CONSP (obj)) --- filesys.c.~1.114.~ Fri Mar 15 11:37:39 2002 +++ filesys.c Sun Jul 14 22:24:51 2002 @@ -448,7 +448,7 @@ scm_stat2scm (struct stat *stat_temp) { SCM ans = scm_c_make_vector (15, SCM_UNSPECIFIED); - SCM *ve = SCM_VELTS (ans); + SCM *ve = SCM_WRITABLE_VELTS (ans); ve[0] = scm_ulong2num ((unsigned long) stat_temp->st_dev); ve[1] = scm_ulong2num ((unsigned long) stat_temp->st_ino); @@ -1021,7 +1021,7 @@ if (SCM_VECTORP (list_or_vec)) { int i = SCM_VECTOR_LENGTH (list_or_vec); - SCM *ve = SCM_VELTS (list_or_vec); + SCM const *ve = SCM_VELTS (list_or_vec); while (--i >= 0) { @@ -1082,7 +1082,7 @@ if (SCM_VECTORP (list_or_vec)) { int i = SCM_VECTOR_LENGTH (list_or_vec); - SCM *ve = SCM_VELTS (list_or_vec); + SCM const *ve = SCM_VELTS (list_or_vec); while (--i >= 0) { --- fluids.c.~1.46.~ Thu Mar 14 04:47:42 2002 +++ fluids.c Sun Jul 14 22:23:42 2002 @@ -76,12 +76,12 @@ i = 0; while (i < old_length) { - SCM_VELTS(new_fluids)[i] = SCM_VELTS(old_fluids)[i]; + SCM_VECTOR_SET(new_fluids,i,SCM_VELTS(old_fluids)[i]); i++; } while (i < new_length) { - SCM_VELTS(new_fluids)[i] = SCM_BOOL_F; + SCM_VECTOR_SET(new_fluids,i,SCM_BOOL_F); i++; } @@ -171,7 +171,7 @@ if (SCM_VECTOR_LENGTH (scm_root->fluids) <= n) grow_fluids (scm_root, n+1); - SCM_VELTS (scm_root->fluids)[n] = value; + SCM_VECTOR_SET (scm_root->fluids,n, value); return SCM_UNSPECIFIED; } #undef FUNC_NAME --- gc.h.~1.89.~ Fri Mar 1 01:19:20 2002 +++ gc.h Sun Jul 14 22:55:21 2002 @@ -80,9 +80,39 @@ # define PTR2SCM(x) (SCM_PACK ((scm_t_bits) (x))) #endif /* def _UNICOS */ +#ifdef GENGC +/* + We store the generation of a card in the first word of the first + cell. It must be easily accessible, as it will be written for + every mutator operation. + + The flags are in the 2nd word of the 1st cell. + + The bitvector is in the 1st word of the 2nd cell. + */ +#define SCM_GC_CARD_N_HEADER_CELLS 2 +#define SCM_GC_CARD_N_CELLS 256 + +#define SCM_GC_CARD_GENERATION(card) ((long) ((card)->word_0)) +#define SCM_GC_FLAG_OBJECT_WRITE(x) SCM_GC_CARD_GENERATION(SCM_GC_CELL_CARD((x))) = 0 + +#define SCM_GC_CARD_BVEC(card) ((scm_t_c_bvec_limb *) ((card+1)->word_0)) +#define SCM_GC_SET_CARD_BVEC(card, bvec) \ + ((card+1)->word_0 = (scm_t_bits) (bvec)) +#else /* ! genGC */ + #define SCM_GC_CARD_N_HEADER_CELLS 1 #define SCM_GC_CARD_N_CELLS 256 +#define SCM_GC_CARD_GENERATION(card) +#define SCM_GC_FLAG_OBJECT_WRITE(x) + +#define SCM_GC_CARD_BVEC(card) ((scm_t_c_bvec_limb *) ((card)->word_0)) +#define SCM_GC_SET_CARD_BVEC(card, bvec) \ + ((card)->word_0 = (scm_t_bits) (bvec)) +#endif + + #define SCM_GC_CARD_SIZE (SCM_GC_CARD_N_CELLS * sizeof (scm_t_cell)) #define SCM_GC_CARD_N_DATA_CELLS (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS) @@ -92,10 +122,6 @@ #define SCM_GC_IN_CARD_HEADERP(x) \ SCM_PTR_LT ((scm_t_cell *) (x), SCM_GC_CELL_CARD (x) + SCM_GC_CARD_N_HEADER_CELLS) -#define SCM_GC_CARD_BVEC(card) ((scm_t_c_bvec_limb *) ((card)->word_0)) -#define SCM_GC_SET_CARD_BVEC(card, bvec) \ - ((card)->word_0 = (scm_t_bits) (bvec)) - #define SCM_GC_GET_CARD_FLAGS(card) ((long) ((card)->word_1)) #define SCM_GC_SET_CARD_FLAGS(card, flags) \ ((card)->word_1 = (scm_t_bits) (flags)) --- gh_data.c.~1.68.~ Fri Mar 1 01:19:20 2002 +++ gh_data.c Sun Jul 14 22:23:42 2002 @@ -122,10 +122,8 @@ { long i; SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED); - SCM *velts = SCM_VELTS(v); - for (i = 0; i < n; ++i) - velts[i] = (SCM_FIXABLE (d[i]) ? SCM_MAKINUM (d[i]) : scm_i_long2big (d[i])); + SCM_VECTOR_SET(v, i, (SCM_FIXABLE (d[i]) ? SCM_MAKINUM (d[i]) : scm_i_long2big (d[i]))); return v; } @@ -135,10 +133,9 @@ { long i; SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED); - SCM *velts = SCM_VELTS(v); for(i = 0; i < n; i++) - velts[i] = scm_make_real (d[i]); + SCM_VECTOR_SET(v,i,scm_make_real (d[i])); return v; } --- goops.c.~1.49.~ Mon Apr 22 19:46:06 2002 +++ goops.c Sun Jul 14 22:24:51 2002 @@ -1684,7 +1684,7 @@ } static int -more_specificp (SCM m1, SCM m2, SCM *targs) +more_specificp (SCM m1, SCM m2, SCM const *targs) { register SCM s1, s2; register long i; @@ -1731,13 +1731,13 @@ SCM z = scm_c_make_vector (len, SCM_UNDEFINED); for (j = 0; j < len; j++, l = SCM_CDR (l)) { - SCM_VELTS (z)[j] = SCM_CAR (l); + SCM_VECTOR_SET(z,j,SCM_CAR (l)); } return z; } static SCM -sort_applicable_methods (SCM method_list, long size, SCM *targs) +sort_applicable_methods (SCM method_list, long size, SCM const *targs) { long i, j, incr; SCM *v, vector = SCM_EOL; @@ -1761,7 +1761,11 @@ { /* Too many elements in method_list to keep everything locally */ vector = scm_i_vector2list (save, size); - v = SCM_VELTS (vector); + + /* + This is a new vector. Don't worry about the write barrier. + */ + v = SCM_WRITABLE_VELTS (vector); } /* Use a simple shell sort since it is generally faster than qsort on @@ -1807,7 +1811,9 @@ long count = 0; SCM l, fl, applicable = SCM_EOL; SCM save = args; - SCM buffer[BUFFSIZE], *types, *p; + SCM buffer[BUFFSIZE]; + SCM const *types; + SCM *p; SCM tmp; /* Build the list of arguments types */ @@ -1816,14 +1822,19 @@ /* NOTE: Using pointers to malloced memory won't work if we 1. have preemtive threading, and, 2. have a GC which moves objects. */ - types = p = SCM_VELTS(tmp); + types = p = SCM_WRITABLE_VELTS(tmp); + + /* + note that we don't have to work to reset the generation + count. TMP is a new vector anyway. + */ } else types = p = buffer; for ( ; !SCM_NULLP (args); args = SCM_CDR (args)) *p++ = scm_class_of (SCM_CAR (args)); - + /* Build a list of all applicable methods */ for (l = SCM_SLOT (gf, scm_si_methods); !SCM_NULLP (l); l = SCM_CDR (l)) { @@ -2135,7 +2146,7 @@ for (i = 0, l = targs; !SCM_NULLP (l); i++, l = SCM_CDR (l)) { SCM_ASSERT (SCM_CLASSP (SCM_CAR (l)), targs, SCM_ARG3, FUNC_NAME); - SCM_VELTS(v)[i] = SCM_CAR(l); + SCM_VECTOR_SET(v,i,SCM_CAR(l)); } return more_specificp (m1, m2, SCM_VELTS(v)) ? SCM_BOOL_T: SCM_BOOL_F; } --- hash.c.~1.47.~ Thu Mar 14 04:47:42 2002 +++ hash.c Sun Jul 14 21:14:01 2002 @@ -145,7 +145,7 @@ case scm_tc7_vector: { size_t len = SCM_VECTOR_LENGTH(obj); - SCM *data = SCM_VELTS(obj); + SCM const *data = SCM_VELTS(obj); if (len > 5) { size_t i = d/2; --- hashtab.c.~1.46.~ Thu Mar 14 04:47:42 2002 +++ hashtab.c Sun Jul 14 22:23:42 2002 @@ -107,7 +107,7 @@ SCM old_bucket; old_bucket = SCM_VELTS (table)[k]; new_bucket = scm_acons (obj, init, old_bucket); - SCM_VELTS(table)[k] = new_bucket; + SCM_VECTOR_SET(table,k,new_bucket); SCM_REALLOW_INTS; return SCM_CAR (new_bucket); } @@ -158,7 +158,7 @@ if (k >= SCM_VECTOR_LENGTH (table)) scm_out_of_range ("hash_fn_remove_x", scm_ulong2num (k)); h = assoc_fn (obj, SCM_VELTS (table)[k], closure); - SCM_VELTS(table)[k] = delete_fn (h, SCM_VELTS(table)[k]); + SCM_VECTOR_SET(table,k,delete_fn (h, SCM_VELTS(table)[k])); return h; } --- net_db.c.~1.70.~ Sat Jul 13 12:39:41 2002 +++ net_db.c Sun Jul 14 22:30:32 2002 @@ -154,7 +154,7 @@ #define FUNC_NAME s_scm_gethost { SCM ans = scm_c_make_vector (5, SCM_UNSPECIFIED); - SCM *ve = SCM_VELTS (ans); + SCM *ve = SCM_WRITABLE_VELTS (ans); SCM lst = SCM_EOL; struct hostent *entry; struct in_addr inad; @@ -237,7 +237,8 @@ struct netent *entry; ans = scm_c_make_vector (4, SCM_UNSPECIFIED); - ve = SCM_VELTS (ans); + ve = SCM_WRITABLE_VELTS (ans); + if (SCM_UNBNDP (net)) { entry = getnetent (); @@ -286,7 +287,7 @@ struct protoent *entry; ans = scm_c_make_vector (3, SCM_UNSPECIFIED); - ve = SCM_VELTS (ans); + ve = SCM_WRITABLE_VELTS (ans); if (SCM_UNBNDP (protocol)) { entry = getprotoent (); @@ -326,7 +327,7 @@ SCM *ve; ans = scm_c_make_vector (4, SCM_UNSPECIFIED); - ve = SCM_VELTS (ans); + ve = SCM_WRITABLE_VELTS (ans); ve[0] = scm_mem2string (entry->s_name, strlen (entry->s_name)); ve[1] = scm_makfromstrs (-1, entry->s_aliases); ve[2] = SCM_MAKINUM (ntohs (entry->s_port) + 0L); --- posix.c.~1.106.~ Sat Jul 13 12:39:41 2002 +++ posix.c Sun Jul 14 22:24:51 2002 @@ -236,9 +236,13 @@ getgroups (ngroups, groups); ans = scm_c_make_vector (ngroups, SCM_UNDEFINED); - while (--ngroups >= 0) - SCM_VELTS (ans) [ngroups] = SCM_MAKINUM (groups [ngroups]); + { + SCM * ve = SCM_WRITABLE_VELTS(ans); + + while (--ngroups >= 0) + ve[ngroups] = SCM_MAKINUM (groups [ngroups]); + } free (groups); return ans; } @@ -258,7 +262,7 @@ SCM *ve; result = scm_c_make_vector (7, SCM_UNSPECIFIED); - ve = SCM_VELTS (result); + ve = SCM_WRITABLE_VELTS (result); if (SCM_UNBNDP (user) || SCM_FALSEP (user)) { SCM_SYSCALL (entry = getpwent ()); @@ -327,9 +331,9 @@ { SCM result; struct group *entry; - SCM *ve; + SCM *ve; result = scm_c_make_vector (4, SCM_UNSPECIFIED); - ve = SCM_VELTS (result); + ve =SCM_WRITABLE_VELTS (result); if (SCM_UNBNDP (name) || SCM_FALSEP (name)) { SCM_SYSCALL (entry = getgrent ()); @@ -984,7 +988,7 @@ { struct utsname buf; SCM ans = scm_c_make_vector (5, SCM_UNSPECIFIED); - SCM *ve = SCM_VELTS (ans); + SCM *ve = SCM_WRITABLE_VELTS (ans); if (uname (&buf) < 0) SCM_SYSERROR; ve[0] = scm_makfrom0str (buf.sysname); --- print.c.~1.141.~ Sat Jul 13 12:39:41 2002 +++ print.c Sun Jul 14 22:28:10 2002 @@ -216,7 +216,7 @@ = scm_make_struct (scm_print_state_vtable, SCM_INUM0, SCM_EOL); scm_print_state *pstate = SCM_PRINT_STATE (print_state); pstate->ref_vect = scm_c_make_vector (PSTATE_SIZE, SCM_UNDEFINED); - pstate->ref_stack = SCM_VELTS (pstate->ref_vect); + pstate->ref_stack = SCM_WRITABLE_VELTS (pstate->ref_vect); pstate->ceiling = SCM_VECTOR_LENGTH (pstate->ref_vect); return print_state; } @@ -260,17 +260,16 @@ grow_ref_stack (scm_print_state *pstate) { unsigned long int old_size = SCM_VECTOR_LENGTH (pstate->ref_vect); - SCM *old_elts = SCM_VELTS (pstate->ref_vect); + SCM const *old_elts = SCM_VELTS (pstate->ref_vect); unsigned long int new_size = 2 * pstate->ceiling; SCM new_vect = scm_c_make_vector (new_size, SCM_UNDEFINED); - SCM *new_elts = SCM_VELTS (new_vect); unsigned long int i; for (i = 0; i != old_size; ++i) - new_elts [i] = old_elts [i]; + SCM_VECTOR_SET(new_vect,i,old_elts [i]); pstate->ref_vect = new_vect; - pstate->ref_stack = new_elts; + pstate->ref_stack = SCM_WRITABLE_VELTS(new_vect); pstate->ceiling = new_size; } --- ramap.c.~1.80.~ Thu Mar 14 04:47:42 2002 +++ ramap.c Sun Jul 14 22:30:32 2002 @@ -488,7 +488,7 @@ case scm_tc7_vector: case scm_tc7_wvect: for (i = base; n--; i += inc) - SCM_VELTS (ra)[i] = fill; + SCM_VECTOR_SET(ra,i,fill); break; case scm_tc7_string: SCM_ASRTGO (SCM_CHARP (fill), badarg2); @@ -1243,7 +1243,8 @@ else { SCM ra1 = SCM_CAR (ras); - SCM args, *ve = &ras; + SCM args; + SCM const *ve = &ras; unsigned long k, i1 = SCM_ARRAY_BASE (ra1); long inc1 = SCM_ARRAY_DIMS (ra1)->inc; ra1 = SCM_ARRAY_V (ra1); @@ -1255,6 +1256,7 @@ ras = scm_vector (ras); ve = SCM_VELTS (ras); } + for (; i <= n; i++, i1 += inc1) { args = SCM_EOL; @@ -1637,7 +1639,8 @@ else { SCM ra1 = SCM_CAR (ras); - SCM args, *ve = &ras; + SCM args; + SCM const*ve = &ras; unsigned long k, i1 = SCM_ARRAY_BASE (ra1); long inc1 = SCM_ARRAY_DIMS (ra1)->inc; ra1 = SCM_ARRAY_V (ra1); @@ -1706,7 +1709,8 @@ case scm_tc7_vector: case scm_tc7_wvect: { - SCM *ve = SCM_VELTS (ra); + SCM *ve = SCM_WRITABLE_VELTS (ra); + SCM_GC_FLAG_OBJECT_WRITE(ve); for (i = 0; i < SCM_VECTOR_LENGTH (ra); i++) ve[i] = scm_call_1 (proc, SCM_MAKINUM (i)); return SCM_UNSPECIFIED; --- random.c.~1.48.~ Thu Mar 14 04:47:42 2002 +++ random.c Sun Jul 14 22:23:42 2002 @@ -545,7 +545,7 @@ n = SCM_INUM (scm_uniform_vector_length (v)); if (SCM_VECTORP (v)) while (--n >= 0) - SCM_VELTS (v)[n] = scm_make_real (scm_c_normal01 (SCM_RSTATE (state))); + SCM_VECTOR_SET(v,n,scm_make_real (scm_c_normal01 (SCM_RSTATE (state)))); else while (--n >= 0) ((double *) SCM_VELTS (v))[n] = scm_c_normal01 (SCM_RSTATE (state)); --- scmsigs.c.~1.68.~ Thu Mar 14 04:47:43 2002 +++ scmsigs.c Sun Jul 14 23:04:22 2002 @@ -192,7 +192,7 @@ #endif int query_only = 0; int save_handler = 0; - SCM *scheme_handlers = SCM_VELTS (*signal_handlers); + SCM old_handler; SCM_VALIDATE_INUM_COPY (1,signum,csig); @@ -213,7 +213,7 @@ sigemptyset (&action.sa_mask); #endif SCM_DEFER_INTS; - old_handler = scheme_handlers[csig]; + old_handler = SCM_VELTS(*signal_handlers)[csig]; if (SCM_UNBNDP (handler)) query_only = 1; else if (SCM_EQ_P (scm_integer_p (handler), SCM_BOOL_T)) @@ -226,7 +226,7 @@ #else chandler = (SIGRETTYPE (*) (int)) SCM_INUM (handler); #endif - scheme_handlers[csig] = SCM_BOOL_F; + SCM_VECTOR_SET(*signal_handlers, csig, SCM_BOOL_F); } else SCM_OUT_OF_RANGE (2, handler); @@ -241,7 +241,8 @@ { action = orig_handlers[csig]; orig_handlers[csig].sa_handler = SIG_ERR; - scheme_handlers[csig] = SCM_BOOL_F; + SCM_VECTOR_SET(*signal_handlers, csig, SCM_BOOL_F); + } #else if (orig_handlers[csig] == SIG_ERR) @@ -250,7 +251,7 @@ { chandler = orig_handlers[csig]; orig_handlers[csig] = SIG_ERR; - scheme_handlers[csig] = SCM_BOOL_F; + SCM_VECTOR_SET(*signal_handlers, csig, SCM_BOOL_F); } #endif } @@ -266,7 +267,7 @@ if (orig_handlers[csig] == SIG_ERR) save_handler = 1; #endif - scheme_handlers[csig] = handler; + SCM_VECTOR_SET(*signal_handlers, csig, handler); } /* XXX - Silently ignore setting handlers for `program error signals' @@ -346,8 +347,6 @@ #define FUNC_NAME s_scm_restore_signals { int i; - SCM *scheme_handlers = SCM_VELTS (*signal_handlers); - for (i = 0; i < NSIG; i++) { #ifdef HAVE_SIGACTION @@ -356,7 +355,7 @@ if (sigaction (i, &orig_handlers[i], NULL) == -1) SCM_SYSERROR; orig_handlers[i].sa_handler = SIG_ERR; - scheme_handlers[i] = SCM_BOOL_F; + SCM_VECTOR_SET(*signal_handlers, i, SCM_BOOL_F); } #else if (orig_handlers[i] != SIG_ERR) @@ -364,7 +363,7 @@ if (signal (i, orig_handlers[i]) == SIG_ERR) SCM_SYSERROR; orig_handlers[i] = SIG_ERR; - scheme_handlers[i] = SCM_BOOL_F; + SCM_VECTOR_SET(*signal_handlers,i, SCM_BOOL_F); } #endif } --- socket.c.~1.88.~ Sat Jul 13 12:39:41 2002 +++ socket.c Sun Jul 14 22:24:51 2002 @@ -935,7 +935,7 @@ const struct sockaddr_in *nad = (struct sockaddr_in *) address; result = scm_c_make_vector (3, SCM_UNSPECIFIED); - ve = SCM_VELTS (result); + ve = SCM_WRITABLE_VELTS (result); ve[0] = scm_ulong2num ((unsigned long) fam); ve[1] = scm_ulong2num (ntohl (nad->sin_addr.s_addr)); ve[2] = scm_ulong2num ((unsigned long) ntohs (nad->sin_port)); @@ -947,7 +947,7 @@ const struct sockaddr_in6 *nad = (struct sockaddr_in6 *) address; result = scm_c_make_vector (5, SCM_UNSPECIFIED); - ve = SCM_VELTS (result); + ve = SCM_WRITABLE_VELTS (result); ve[0] = scm_ulong2num ((unsigned long) fam); ve[1] = ipv6_net_to_num (nad->sin6_addr.s6_addr); ve[2] = scm_ulong2num ((unsigned long) ntohs (nad->sin6_port)); @@ -966,7 +966,7 @@ const struct sockaddr_un *nad = (struct sockaddr_un *) address; result = scm_c_make_vector (2, SCM_UNSPECIFIED); - ve = SCM_VELTS (result); + ve = SCM_WRITABLE_VELTS (result); ve[0] = scm_ulong2num ((unsigned long) fam); ve[1] = scm_mem2string (nad->sun_path, strlen (nad->sun_path)); } --- sort.c.~1.41.~ Thu Mar 14 04:47:43 2002 +++ sort.c Sun Jul 14 22:29:38 2002 @@ -428,7 +428,7 @@ SCM_VALIDATE_VECTOR (1,vec); SCM_VALIDATE_NIM (2,less); - vp = SCM_VELTS (vec); /* vector pointer */ + vp = SCM_WRITABLE_VELTS (vec); /* vector pointer */ vlen = SCM_VECTOR_LENGTH (vec); SCM_VALIDATE_INUM_MIN_COPY (3, startpos, 0, spos); @@ -437,6 +437,8 @@ len = SCM_INUM (endpos) - spos; quicksort (&vp[spos], len, size, scm_cmp_function (less), less); + SCM_GC_FLAG_OBJECT_WRITE(vec); + return SCM_UNSPECIFIED; /* return vec; */ } @@ -455,7 +457,7 @@ { long len, j; /* list/vector length, temp j */ SCM item, rest; /* rest of items loop variable */ - SCM *vp; + SCM const *vp; cmp_fun_t cmp = scm_cmp_function (less); if (SCM_NULL_OR_NIL_P (items)) @@ -861,7 +863,14 @@ SCM *temp, *vp; len = SCM_VECTOR_LENGTH (items); temp = malloc (len * sizeof(SCM)); - vp = SCM_VELTS (items); + + + vp = SCM_WRITABLE_VELTS (items); + /* + This routine modifies VP + */ + + SCM_GC_FLAG_OBJECT_WRITE(items); scm_merge_vector_step (vp, temp, scm_cmp_function (less), @@ -906,7 +915,12 @@ retvec = scm_make_uve (len, scm_array_prototype (items)); scm_array_copy_x (items, retvec); temp = malloc (len * sizeof (SCM)); - vp = SCM_VELTS (retvec); + + /* + don't worry about write barrier: retvec is new anyway. + */ + vp = SCM_WRITABLE_VELTS (retvec); + scm_merge_vector_step (vp, temp, scm_cmp_function (less), --- stime.c.~1.74.~ Thu Mar 14 04:47:43 2002 +++ stime.c Sun Jul 14 22:23:42 2002 @@ -195,11 +195,11 @@ rv = times (&t); if (rv == -1) SCM_SYSERROR; - SCM_VELTS (result)[0] = scm_long2num (rv); - SCM_VELTS (result)[1] = scm_long2num (t.tms_utime); - SCM_VELTS (result)[2] = scm_long2num (t.tms_stime); - SCM_VELTS (result)[3] = scm_long2num (t.tms_cutime); - SCM_VELTS (result)[4] = scm_long2num (t.tms_cstime); + SCM_VECTOR_SET(result,0,scm_long2num (rv)); + SCM_VECTOR_SET(result,1,scm_long2num (t.tms_utime)); + SCM_VECTOR_SET(result,2,scm_long2num (t.tms_stime)); + SCM_VECTOR_SET(result,3,scm_long2num (t.tms_cutime)); + SCM_VECTOR_SET(result,4,scm_long2num (t.tms_cstime)); return result; } #undef FUNC_NAME @@ -282,17 +282,17 @@ { SCM result = scm_c_make_vector (11, SCM_UNDEFINED); - SCM_VELTS (result)[0] = SCM_MAKINUM (bd_time->tm_sec); - SCM_VELTS (result)[1] = SCM_MAKINUM (bd_time->tm_min); - SCM_VELTS (result)[2] = SCM_MAKINUM (bd_time->tm_hour); - SCM_VELTS (result)[3] = SCM_MAKINUM (bd_time->tm_mday); - SCM_VELTS (result)[4] = SCM_MAKINUM (bd_time->tm_mon); - SCM_VELTS (result)[5] = SCM_MAKINUM (bd_time->tm_year); - SCM_VELTS (result)[6] = SCM_MAKINUM (bd_time->tm_wday); - SCM_VELTS (result)[7] = SCM_MAKINUM (bd_time->tm_yday); - SCM_VELTS (result)[8] = SCM_MAKINUM (bd_time->tm_isdst); - SCM_VELTS (result)[9] = SCM_MAKINUM (zoff); - SCM_VELTS (result)[10] = zname ? scm_makfrom0str (zname) : SCM_BOOL_F; + SCM_VECTOR_SET(result,0,SCM_MAKINUM (bd_time->tm_sec)); + SCM_VECTOR_SET(result,1,SCM_MAKINUM (bd_time->tm_min)); + SCM_VECTOR_SET(result,2,SCM_MAKINUM (bd_time->tm_hour)); + SCM_VECTOR_SET(result,3,SCM_MAKINUM (bd_time->tm_mday)); + SCM_VECTOR_SET(result,4,SCM_MAKINUM (bd_time->tm_mon)); + SCM_VECTOR_SET(result,5,SCM_MAKINUM (bd_time->tm_year)); + SCM_VECTOR_SET(result,6,SCM_MAKINUM (bd_time->tm_wday)); + SCM_VECTOR_SET(result,7,SCM_MAKINUM (bd_time->tm_yday)); + SCM_VECTOR_SET(result,8,SCM_MAKINUM (bd_time->tm_isdst)); + SCM_VECTOR_SET(result,9,SCM_MAKINUM (zoff)); + SCM_VECTOR_SET(result,10,zname ? scm_makfrom0str (zname) : SCM_BOOL_F); return result; } @@ -439,7 +439,7 @@ static void bdtime2c (SCM sbd_time, struct tm *lt, int pos, const char *subr) { - SCM *velts; + SCM const *velts; int i; SCM_ASSERT (SCM_VECTORP (sbd_time) --- symbols.c.~1.102.~ Thu Mar 14 04:47:43 2002 +++ symbols.c Sun Jul 14 22:23:42 2002 @@ -133,7 +133,7 @@ slot = SCM_VELTS (symbols) [hash]; cell = scm_cons (symbol, SCM_UNDEFINED); - SCM_VELTS (symbols) [hash] = scm_cons (cell, slot); + SCM_VECTOR_SET (symbols,hash, scm_cons (cell, slot)); return symbol; } --- unif.c.~1.131.~ Thu Mar 14 23:25:31 2002 +++ unif.c Sun Jul 14 22:23:42 2002 @@ -802,7 +802,8 @@ "@end lisp") #define FUNC_NAME s_scm_transpose_array { - SCM res, vargs, *ve = &vargs; + SCM res, vargs; + SCM const *ve = &vargs; scm_t_array_dim *s, *r; int ndim, i, k; @@ -1350,7 +1351,7 @@ break; case scm_tc7_vector: case scm_tc7_wvect: - SCM_VELTS (v)[pos] = obj; + SCM_VECTOR_SET(v,pos,obj); break; } return SCM_UNSPECIFIED; --- vectors.c.~1.63.~ Thu Mar 14 04:47:43 2002 +++ vectors.c Sun Jul 14 22:24:51 2002 @@ -101,7 +101,8 @@ while the vector is being created. */ SCM_VALIDATE_LIST_COPYLEN (1, l, i); res = scm_c_make_vector (i, SCM_UNSPECIFIED); - data = SCM_VELTS (res); + + data = SCM_WRITABLE_VELTS (res); while (!SCM_NULL_OR_NIL_P (l)) { *data++ = SCM_CAR (l); @@ -165,7 +166,7 @@ g_vector_set_x, scm_list_3 (v, k, obj), SCM_ARG2, s_vector_set_x); SCM_ASSERT_RANGE (2, k, SCM_INUM (k) < SCM_VECTOR_LENGTH (v) && SCM_INUM (k) >= 0); - SCM_VELTS(v)[(long) SCM_INUM(k)] = obj; + SCM_VECTOR_SET(v, (long) SCM_INUM(k), obj); return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -235,7 +236,7 @@ { SCM res = SCM_EOL; long i; - SCM *data; + SCM const *data; SCM_VALIDATE_VECTOR (1,v); data = SCM_VELTS(v); for(i = SCM_VECTOR_LENGTH(v)-1;i >= 0;i--) res = scm_cons(data[i], res); @@ -253,7 +254,9 @@ register long i; register SCM *data; SCM_VALIDATE_VECTOR (1, v); - data = SCM_VELTS (v); + + + data = SCM_WRITABLE_VELTS (v); for(i = SCM_VECTOR_LENGTH (v) - 1; i >= 0; i--) data[i] = fill; return SCM_UNSPECIFIED; @@ -296,7 +299,10 @@ SCM_ASSERT_RANGE (5, start2, j <= SCM_VECTOR_LENGTH (vec2) && j >= 0); SCM_ASSERT_RANGE (3, end1, e <= SCM_VECTOR_LENGTH (vec1) && e >= 0); SCM_ASSERT_RANGE (5, start2, e-i+j <= SCM_VECTOR_LENGTH (vec2)); - while (i= 0, l, SCM_ARG1, FUNC_NAME); res = scm_make_weak_vector (SCM_MAKINUM (i), SCM_UNSPECIFIED); - data = SCM_VELTS (res); + data = SCM_WRITABLE_VELTS (res); while (!SCM_NULL_OR_NIL_P (l)) { @@ -261,7 +261,7 @@ { if (SCM_IS_WHVEC_ANY (w)) { - SCM *ptr; + SCM const *ptr; SCM obj; long j; long n; @@ -302,7 +302,7 @@ { register long j, n; - ptr = SCM_VELTS (w); + ptr = SCM_WRITABLE_VELTS (w); n = SCM_VECTOR_LENGTH (w); for (j = 0; j < n; ++j) if (SCM_FREE_CELL_P (ptr[j])) @@ -316,7 +316,7 @@ int weak_keys = SCM_IS_WHVEC (obj) || SCM_IS_WHVEC_B (obj); int weak_values = SCM_IS_WHVEC_V (obj) || SCM_IS_WHVEC_B (obj); - ptr = SCM_VELTS (w); + ptr = SCM_WRITABLE_VELTS (w); for (j = 0; j < n; ++j) {