diff options
-rw-r--r-- | NEWS | 7 | ||||
-rw-r--r-- | RELEASE | 2 | ||||
-rw-r--r-- | libguile/ChangeLog | 16 | ||||
-rw-r--r-- | libguile/gc.c | 10 | ||||
-rw-r--r-- | libguile/gh_data.c | 2 | ||||
-rw-r--r-- | libguile/strings.c | 4 | ||||
-rw-r--r-- | libguile/strings.h | 1 | ||||
-rw-r--r-- | libguile/symbols.c | 4 | ||||
-rw-r--r-- | libguile/symbols.h | 3 | ||||
-rw-r--r-- | libguile/unif.c | 19 | ||||
-rw-r--r-- | libguile/unif.h | 2 |
11 files changed, 55 insertions, 15 deletions
@@ -243,7 +243,9 @@ SCM_BITVECTOR_LENGTH, SCM_VECTOR_LENGTH. Use these instead of SCM_LENGTH. -** New macros: SCM_SET_CONTINUATION_LENGTH, SCM_SET_VECTOR_LENGTH +** New macros: SCM_SET_CONTINUATION_LENGTH, SCM_SET_STRING_LENGTH, +SCM_SET_SYMBOL_LENGTH, SCM_SET_VECTOR_LENGTH, SCM_SET_UVECTOR_LENGTH, +SCM_SET_BITVECTOR_LENGTH Use these instead of SCM_SETLENGTH @@ -268,7 +270,7 @@ SCM_VALIDATE_ROSTRING, SCM_VALIDATE_ROSTRING_COPY, SCM_VALIDATE_NULLORROSTRING_COPY, SCM_ROLENGTH, SCM_LENGTH, SCM_HUGE_LENGTH, SCM_SUBSTRP, SCM_SUBSTR_STR, SCM_SUBSTR_OFFSET, SCM_COERCE_SUBSTR, SCM_ROSTRINGP, SCM_RWSTRINGP, SCM_VALIDATE_RWSTRING, SCM_ROCHARS, -SCM_ROUCHARS +SCM_ROUCHARS, SCM_SETLENGTH Use SCM_ASSERT_RANGE or SCM_VALIDATE_XXX_RANGE instead of SCM_OUTOFRANGE. Use scm_memory_error instead of SCM_NALLOC. @@ -284,6 +286,7 @@ Use SCM_STRINGP instead of SCM_RWSTRINGP. Use SCM_VALIDATE_STRING instead of SCM_VALIDATE_RWSTRING. Use SCM_STRING_CHARS instead of SCM_ROCHARS. Use SCM_STRING_UCHARS instead of SCM_ROUCHARS. +Use a type specific setter macro instead of SCM_SETLENGTH. ** Removed function: scm_struct_init @@ -50,7 +50,7 @@ In release 1.6: SCM_VALIDATE_ROSTRING_COPY, SCM_VALIDATE_NULLORROSTRING_COPY, SCM_ROLENGTH, SCM_LENGTH, SCM_HUGE_LENGTH, SCM_SUBSTRP, SCM_SUBSTR_STR, SCM_SUBSTR_OFFSET, SCM_COERCE_SUBSTR, SCM_ROSTRINGP, SCM_RWSTRINGP, SCM_VALIDATE_RWSTRING, - SCM_ROCHARS, SCM_ROUCHARS + SCM_ROCHARS, SCM_ROUCHARS, SCM_SETLENGTH - remove scm_vector_set_length_x - remove function scm_call_catching_errors (replaced by catch functions from throw.[ch]) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 7beb584ec..5d47dbfb5 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,5 +1,21 @@ 2000-11-22 Dirk Herrmann <D.Herrmann@tu-bs.de> + * gc.c (scm_gc_sweep), unif.c (scm_make_uve): Don't allocate or + free memory for empty bitvectors. + + * gh_data.c (makvect), strings.c (scm_makstr, scm_take_str), + symbols.c (scm_intern_obarray_soft, + scm_sysintern0_no_module_lookup), unif.c (scm_make_uve): Use + appropriate SCM_SET_<type>_LENGTH macro instead of SCM_SETLENGTH. + + * strings.h (SCM_SET_STRING_LENGTH), symbols.h + (SCM_SET_SYMBOL_LENGTH), unif.h (SCM_SET_UVECTOR_LENGTH, + SCM_SET_BITVECTOR_LENGTH): Added. + + * symbols.h (SCM_SETLENGTH): Deprecated. + +2000-11-22 Dirk Herrmann <D.Herrmann@tu-bs.de> + * continuations.c (scm_make_cont): Use SCM_SET_CONTINUATION_LENGTH instead of SCM_SETLENGTH. diff --git a/libguile/gc.c b/libguile/gc.c index 26c1c0c2a..0a6e968f3 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -1621,8 +1621,14 @@ scm_gc_sweep () #endif #ifdef HAVE_ARRAYS case scm_tc7_bvect: - m += sizeof (long) * ((SCM_BITVECTOR_LENGTH (scmptr) + SCM_LONG_BIT - 1) / SCM_LONG_BIT); - scm_must_free (SCM_BITVECTOR_BASE (scmptr)); + { + unsigned long int length = SCM_BITVECTOR_LENGTH (scmptr); + if (length > 0) + { + m += sizeof (long) * ((length + SCM_LONG_BIT - 1) / SCM_LONG_BIT); + scm_must_free (SCM_BITVECTOR_BASE (scmptr)); + } + } break; case scm_tc7_byvect: case scm_tc7_ivect: diff --git a/libguile/gh_data.c b/libguile/gh_data.c index 2d11c54a7..c16526bcf 100644 --- a/libguile/gh_data.c +++ b/libguile/gh_data.c @@ -170,7 +170,7 @@ makvect (char* m, int len, int type) SCM_NEWCELL (ans); SCM_DEFER_INTS; SCM_SETCHARS (ans, m); - SCM_SETLENGTH (ans, len, type); + SCM_SET_UVECTOR_LENGTH (ans, len, type); SCM_ALLOW_INTS; return ans; } diff --git a/libguile/strings.c b/libguile/strings.c index d17260746..470b3206f 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -133,7 +133,7 @@ scm_makstr (long len, int dummy) mem[len] = 0; SCM_NEWCELL (s); SCM_SETCHARS (s, mem); - SCM_SETLENGTH (s, len, scm_tc7_string); + SCM_SET_STRING_LENGTH (s, len); return s; } @@ -168,7 +168,7 @@ scm_take_str (char *s, int len) SCM answer; SCM_NEWCELL (answer); SCM_DEFER_INTS; - SCM_SETLENGTH (answer, len, scm_tc7_string); + SCM_SET_STRING_LENGTH (answer, len); scm_done_malloc (len + 1); SCM_SETCHARS (answer, s); SCM_ALLOW_INTS; diff --git a/libguile/strings.h b/libguile/strings.h index 343c655e6..b19707af9 100644 --- a/libguile/strings.h +++ b/libguile/strings.h @@ -57,6 +57,7 @@ #define SCM_STRING_CHARS(x) ((char *) (SCM_CELL_WORD_1 (x))) #endif #define SCM_STRING_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8) +#define SCM_SET_STRING_LENGTH(s, l) (SCM_SET_CELL_WORD_0 ((s), ((l) << 8) + scm_tc7_string)) #define SCM_STRING_COERCE_0TERMINATION_X(x) \ { if (SCM_NIMP (x) && (SCM_TYP7 (x) == scm_tc7_substring)) \ diff --git a/libguile/symbols.c b/libguile/symbols.c index 17d08981c..074573100 100644 --- a/libguile/symbols.c +++ b/libguile/symbols.c @@ -294,7 +294,7 @@ scm_intern_obarray_soft (const char *name,scm_sizet len,SCM obarray,unsigned int SCM_SETCHARS (lsym, duplicate_string (name, len)); SCM_SET_SYMBOL_HASH (lsym, raw_hash); SCM_SET_PROP_SLOTS (lsym, scm_cons (SCM_BOOL_F, SCM_EOL)); - SCM_SETLENGTH (lsym, (long) len, scm_tc7_symbol); + SCM_SET_SYMBOL_LENGTH (lsym, (long) len); if (SCM_FALSEP (obarray)) { @@ -369,7 +369,7 @@ scm_sysintern0_no_module_lookup (const char *name) SCM_SETCHARS (lsym, name); SCM_SET_SYMBOL_HASH (lsym, raw_hash); SCM_SET_PROP_SLOTS (lsym, scm_cons (SCM_BOOL_F, SCM_EOL)); - SCM_SETLENGTH (lsym, (long) len, scm_tc7_symbol); + SCM_SET_SYMBOL_LENGTH (lsym, (long) len); lsym = scm_cons (lsym, SCM_UNDEFINED); SCM_VELTS (scm_symhash)[hash] = scm_cons (lsym, SCM_VELTS (scm_symhash)[hash]); diff --git a/libguile/symbols.h b/libguile/symbols.h index 2654cf4fe..2e32a422f 100644 --- a/libguile/symbols.h +++ b/libguile/symbols.h @@ -60,9 +60,9 @@ extern int scm_symhash_dim; #define SCM_SYMBOL_UCHARS(x) ((unsigned char *) (SCM_CELL_WORD_1 (x))) #define SCM_SYMBOL_CHARS(x) ((char *) (SCM_CELL_WORD_1 (x))) #define SCM_SYMBOL_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8) +#define SCM_SET_SYMBOL_LENGTH(s, l) (SCM_SET_CELL_WORD_0 ((s), ((l) << 8) + scm_tc7_symbol)) #define SCM_LENGTH_MAX (0xffffffL) -#define SCM_SETLENGTH(x, v, t) (SCM_SET_CELL_WORD_0 ((x), ((v) << 8) + (t))) #define SCM_SETCHARS(x, v) (SCM_SET_CELL_WORD_1 ((x), (scm_bits_t) (v))) @@ -120,6 +120,7 @@ extern void scm_init_symbols (void); #define SCM_SUBSTR_STR(x) (SCM_CDDR (x)) #define SCM_SUBSTR_OFFSET(x) (SCM_CADR (x)) #define SCM_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8) +#define SCM_SETLENGTH(x, v, t) (SCM_SET_CELL_WORD_0 ((x), ((v) << 8) + (t))) #define SCM_ROSTRINGP(x) (SCM_NIMP(x) && ((SCM_TYP7S(x)==scm_tc7_string) \ || (SCM_TYP7(x) == scm_tc7_symbol))) #define SCM_ROLENGTH(x) SCM_LENGTH (x) diff --git a/libguile/unif.c b/libguile/unif.c index a4119be8e..77f9e7a42 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -162,8 +162,19 @@ scm_make_uve (long k, SCM prot) if (SCM_EQ_P (prot, SCM_BOOL_T)) { - i = sizeof (long) * ((k + SCM_LONG_BIT - 1) / SCM_LONG_BIT); - type = scm_tc7_bvect; + SCM_NEWCELL (v); + if (k > 0) + { + i = sizeof (long) * ((k + SCM_LONG_BIT - 1) / SCM_LONG_BIT); + SCM_SETCHARS (v, (char *) scm_must_malloc (i, "vector")); + SCM_SET_BITVECTOR_LENGTH (v, k); + } + else + { + SCM_SETCHARS (v, 0); + SCM_SET_BITVECTOR_LENGTH (v, 0); + } + return v; } else if (SCM_CHARP (prot) && (SCM_CHAR (prot) == '\0')) { @@ -173,7 +184,7 @@ scm_make_uve (long k, SCM prot) else if (SCM_CHARP (prot)) { i = sizeof (char) * k; - type = scm_tc7_string; + return scm_makstr (i, 0); } else if (SCM_INUMP (prot)) { @@ -229,7 +240,7 @@ scm_make_uve (long k, SCM prot) SCM_NEWCELL (v); SCM_DEFER_INTS; SCM_SETCHARS (v, (char *) scm_must_malloc (i ? i : 1, "vector")); - SCM_SETLENGTH (v, k, type); + SCM_SET_UVECTOR_LENGTH (v, k, type); SCM_ALLOW_INTS; return v; } diff --git a/libguile/unif.h b/libguile/unif.h index 932ceec82..4a859ce23 100644 --- a/libguile/unif.h +++ b/libguile/unif.h @@ -88,10 +88,12 @@ extern long scm_tc16_array; #define SCM_UVECTOR_BASE(x) ((void *) (SCM_CELL_WORD_1 (x))) #define SCM_UVECTOR_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8) +#define SCM_SET_UVECTOR_LENGTH(v, l, t) (SCM_SET_CELL_WORD_0 ((v), ((l) << 8) + (t))) #define SCM_BITVECTOR_P(x) (!SCM_IMP (x) && (SCM_TYP7 (x) == scm_tc7_bvect)) #define SCM_BITVECTOR_BASE(x) ((void *) (SCM_CELL_WORD_1 (x))) #define SCM_BITVECTOR_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8) +#define SCM_SET_BITVECTOR_LENGTH(v, l) (SCM_SET_CELL_WORD_0 ((v), ((l) << 8) + scm_tc7_bvect)) |