diff options
-rw-r--r-- | libguile/ChangeLog | 68 | ||||
-rw-r--r-- | libguile/__scm.h | 8 | ||||
-rw-r--r-- | libguile/eval.c | 5 | ||||
-rw-r--r-- | libguile/eval.h | 8 | ||||
-rw-r--r-- | libguile/gc.c | 4 | ||||
-rw-r--r-- | libguile/gh_data.c | 7 | ||||
-rw-r--r-- | libguile/goops.c | 15 | ||||
-rw-r--r-- | libguile/goops.h | 12 | ||||
-rw-r--r-- | libguile/modules.c | 4 | ||||
-rw-r--r-- | libguile/modules.h | 12 | ||||
-rw-r--r-- | libguile/objects.h | 14 | ||||
-rw-r--r-- | libguile/sort.c | 4 | ||||
-rw-r--r-- | libguile/strports.c | 2 | ||||
-rw-r--r-- | libguile/struct.h | 10 | ||||
-rw-r--r-- | libguile/symbols.h | 20 | ||||
-rw-r--r-- | libguile/tags.h | 8 | ||||
-rw-r--r-- | libguile/unif.c | 27 |
17 files changed, 147 insertions, 81 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 07474e65d..9c375df04 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,68 @@ +2001-05-26 Dirk Herrmann <D.Herrmann@tu-bs.de> + + * __scm.h (SCM_DEBUG_TYPING_STRICTNESS): Make 1 the default. + + * eval.c (promise_print): Read the promise's value as an object. + + (SCM_CEVAL): Don't perform side-effecting operations in macro + parameters. + + * eval.h (SCM_EVALIM2): Fix the typing strictness of the + conditional expression. + + * gc.c (scm_master_freelist, scm_master_freelist2): Added missing + initializer. + + * gh_data.c (gh_set_substr): Removed redundant unsigned >= 0 + text, removed redundant computation of effective_length and fixed + the overflow check. + + * goops.c (test_slot_existence): Use SCM_EQ_P to compare SCM + values. + + (wrap_init): Don't use SCM_C[AD]R for non pairs. + + (hell): Make it a scm_bits_t pointer rather than a SCM pointer. + + * goops.c (scm_sys_modify_class), strports.c (st_resize_port), + struct.h (SCM_SET_STRUCT_PRINTER): Store unpacked values. + + * goops.h (SCM_ACCESSORS_OF, SCM_SLOT): Return a SCM value. + + * goops.h (GOOPSH, SCM_GOOPS_H), modules.h (MODULESH, + SCM_MODULES_H), objects.h (OBJECTSH, SCM_OBJECTS_H), struct.h + (STRUCTH, SCM_STRUCT_H), symbols.h (SYMBOLSH, SCM_SYMBOLS_H), + __scm.h (__SCMH, SCM___SCM_H): Change <foo>H to SCM_<foo>_H. + + * modules.[ch] (scm_module_tag): Make it a scm_bits_t value. + + * objects.h (SCM_SET_CLASS_INSTANCE_SIZE): Fixed typing. + + * ramap.c (ramap_rp): Removed bogus `;´. + + * sort.c (scm_restricted_vector_sort_x): Fixed signedness + problem. + + * symbols.h (SCM_PROP_SLOTS, SCM_SET_PROP_SLOTS, SCM_SYMBOL_FUNC, + SCM_SET_SYMBOL_FUNC, SCM_SYMBOL_PROPS, SCM_SET_SYMBOL_PROPS): + Read SCM objects rather than scm_bits_t values. + + * tags.h (SCM_VOIDP_TEST): Removed. + + (SCM_DEBUG_TYPING_STRICTNESS): Now takes values 0, 1, 2. The + value of 2 now corresponds to the former 1, the current 1 + corresponds to the former situation that SCM_VOIDP_TEST was + defined. + + (SCM): Now defined as typedef struct scm_unused_struct * SCM; + If this appears to be not ANSI compliant, we will change it to + typedef struct scm_unused_struct { } * SCM; + Thanks to Han-Wen Nienhuys for the suggestion. + + * unif.c (scm_array_set_x): Fix typing problem, and use + SCM_UVECTOR_BASE instead of SCM_VELTS or SCM_CELL_WORD_1 when + dealing with uniform vectors. + 2001-05-27 Michael Livshin <mlivshin@bigfoot.com> * gc.c (scm_init_storage): init `scm_gc_registered_roots'. @@ -25,8 +90,9 @@ * modules.c (scm_env_module): Exported to Scheme. * eval.c (scm_debug_opts): New option `show-file-name'. + * debug.h (SCM_SHOW_FILE_NAME): New. - + * backtrace.c: Include "libguile/filesys.h". (sym_base, display_backtrace_get_file_line, display_backtrace_file, display_backtrace_file_and_line): New. diff --git a/libguile/__scm.h b/libguile/__scm.h index 5e7637f0d..2a06b9caa 100644 --- a/libguile/__scm.h +++ b/libguile/__scm.h @@ -1,7 +1,7 @@ /* classes: h_files */ -#ifndef __SCMH -#define __SCMH +#ifndef SCM___SCM_H +#define SCM___SCM_H /* Copyright (C) 1995,1996,1998,1999,2000,2001 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify @@ -192,7 +192,7 @@ * errors, and then do 'make clean; make'. */ #ifndef SCM_DEBUG_TYPING_STRICTNESS -#define SCM_DEBUG_TYPING_STRICTNESS 0 +#define SCM_DEBUG_TYPING_STRICTNESS 1 #endif /* If SCM_ENABLE_VCELLS is set to 1, a couple of functions that deal @@ -636,7 +636,7 @@ extern SCM scm_apply_generic (SCM gf, SCM args); -#endif /* __SCMH */ +#endif /* SCM___SCM_H */ /* Local Variables: diff --git a/libguile/eval.c b/libguile/eval.c index 0274da4fe..df458d50a 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -2321,7 +2321,8 @@ dispatch: /* Compute a hash value */ long hashset = SCM_INUM (proc); long j = n; - mask = SCM_INUM (SCM_CAR (z = SCM_CDDR (z))); + z = SCM_CDDR (z); + mask = SCM_INUM (SCM_CAR (z)); proc = SCM_CADR (z); i = 0; t.arg1 = arg2; @@ -3786,7 +3787,7 @@ promise_print (SCM exp, SCM port, scm_print_state *pstate) int writingp = SCM_WRITINGP (pstate); scm_puts ("#<promise ", port); SCM_SET_WRITINGP (pstate, 1); - scm_iprin1 (SCM_CELL_WORD_1 (exp), port, pstate); + scm_iprin1 (SCM_CELL_OBJECT_1 (exp), port, pstate); SCM_SET_WRITINGP (pstate, writingp); scm_putc ('>', port); return !0; diff --git a/libguile/eval.h b/libguile/eval.h index 06ad86969..4bd167f48 100644 --- a/libguile/eval.h +++ b/libguile/eval.h @@ -95,9 +95,11 @@ extern SCM scm_eval_options_interface (SCM setting); * * For an explanation of symbols containing "EVAL", see beginning of eval.c. */ -#define SCM_EVALIM2(x) ((SCM_EQ_P ((x), SCM_EOL)) \ - ? scm_misc_error (NULL, scm_s_expression, SCM_EOL), 0 \ - : (x)) +#define SCM_EVALIM2(x) \ + ((SCM_EQ_P ((x), SCM_EOL) \ + ? scm_misc_error (NULL, scm_s_expression, SCM_EOL), 0 \ + : 0), \ + (x)) #ifdef MEMOIZE_LOCALS #define SCM_EVALIM(x, env) (SCM_ILOCP (x) \ ? *scm_ilookup ((x), env) \ diff --git a/libguile/gc.c b/libguile/gc.c index 750ef4969..0a0f92288 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -312,11 +312,11 @@ typedef struct scm_freelist_t { SCM scm_freelist = SCM_EOL; scm_freelist_t scm_master_freelist = { - SCM_EOL, 0, 0, SCM_EOL, 0, SCM_CLUSTER_SIZE_1, 0, 0, 0, 1, 0, 0 + SCM_EOL, 0, 0, SCM_EOL, 0, SCM_CLUSTER_SIZE_1, 0, 0, 0, 1, 0, 0, 0 }; SCM scm_freelist2 = SCM_EOL; scm_freelist_t scm_master_freelist2 = { - SCM_EOL, 0, 0, SCM_EOL, 0, SCM_CLUSTER_SIZE_2, 0, 0, 0, 2, 0, 0 + SCM_EOL, 0, 0, SCM_EOL, 0, SCM_CLUSTER_SIZE_2, 0, 0, 0, 2, 0, 0, 0 }; /* scm_mtrigger diff --git a/libguile/gh_data.c b/libguile/gh_data.c index dc31bae09..3843a0741 100644 --- a/libguile/gh_data.c +++ b/libguile/gh_data.c @@ -99,17 +99,14 @@ gh_set_substr (char *src, SCM dst, long start, size_t len) { char *dst_ptr; size_t dst_len; - size_t effective_length; SCM_ASSERT (SCM_STRINGP (dst), dst, SCM_ARG3, "gh_set_substr"); dst_ptr = SCM_STRING_CHARS (dst); dst_len = SCM_STRING_LENGTH (dst); - SCM_ASSERT (len >= 0 && len <= dst_len, - dst, SCM_ARG4, "gh_set_substr"); + SCM_ASSERT (start + len <= dst_len, dst, SCM_ARG4, "gh_set_substr"); - effective_length = (len < dst_len) ? len : dst_len; - memmove (dst_ptr + start, src, effective_length); + memmove (dst_ptr + start, src, len); scm_remember_upto_here_1 (dst); } diff --git a/libguile/goops.c b/libguile/goops.c index 1fe133828..a85f4975c 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -1129,8 +1129,8 @@ test_slot_existence (SCM class, SCM obj, SCM slot_name) { register SCM l; - for (l = SCM_ACCESSORS_OF (obj); SCM_NNULLP (l); l = SCM_CDR (l)) - if (SCM_CAAR (l) == slot_name) + for (l = SCM_ACCESSORS_OF (obj); !SCM_NULLP (l); l = SCM_CDR (l)) + if (SCM_EQ_P (SCM_CAAR (l), slot_name)) return SCM_BOOL_T; return SCM_BOOL_F; @@ -1289,9 +1289,10 @@ wrap_init (SCM class, SCM *m, long n) m[i] = SCM_GOOPS_UNBOUND; SCM_NEWCELL2 (z); - SCM_SETCDR (z, (SCM) m); SCM_SET_STRUCT_GC_CHAIN (z, 0); - SCM_SETCAR (z, (scm_bits_t) SCM_STRUCT_DATA (class) | scm_tc3_cons_gloc); + SCM_SET_CELL_WORD_1 (z, m); + SCM_SET_CELL_WORD_0 (z, (scm_bits_t) SCM_STRUCT_DATA (class) + | scm_tc3_cons_gloc); return z; } @@ -1435,10 +1436,10 @@ SCM_DEFINE (scm_sys_modify_class, "%modify-class", 2, 0, 0, SCM cdr = SCM_CDR (old); SCM_SETCAR (old, SCM_CAR (new)); SCM_SETCDR (old, SCM_CDR (new)); - SCM_STRUCT_DATA (old)[scm_vtable_index_vtable] = old; + SCM_STRUCT_DATA (old)[scm_vtable_index_vtable] = SCM_UNPACK (old); SCM_SETCAR (new, car); SCM_SETCDR (new, cdr); - SCM_STRUCT_DATA (new)[scm_vtable_index_vtable] = new; + SCM_STRUCT_DATA (new)[scm_vtable_index_vtable] = SCM_UNPACK (new); } SCM_REALLOW_INTS; return SCM_UNSPECIFIED; @@ -1462,7 +1463,7 @@ SCM_DEFINE (scm_sys_invalidate_class, "%invalidate-class", 1, 0, 0, * infinite recursions. */ -static SCM **hell; +static scm_bits_t **hell; static long n_hell = 1; /* one place for the evil one himself */ static long hell_size = 4; #ifdef USE_THREADS diff --git a/libguile/goops.h b/libguile/goops.h index 481ff0067..5aefcfe6d 100644 --- a/libguile/goops.h +++ b/libguile/goops.h @@ -1,8 +1,8 @@ /* classes: h_files */ -#ifndef GOOPSH -#define GOOPSH -/* Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. +#ifndef SCM_GOOPS_H +#define SCM_GOOPS_H +/* Copyright (C) 1998,1999,2000,2001 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 @@ -120,7 +120,7 @@ typedef struct scm_method_t { #define SCM_INST_TYPE(x) SCM_OBJ_CLASS_FLAGS (x) /* Also defined in libguuile/objects.c */ #define SCM_CLASS_OF(x) SCM_STRUCT_VTABLE (x) -#define SCM_ACCESSORS_OF(x) (SCM_STRUCT_VTABLE_DATA (x)[scm_si_getters_n_setters]) +#define SCM_ACCESSORS_OF(x) (SCM_PACK (SCM_STRUCT_VTABLE_DATA (x)[scm_si_getters_n_setters])) #define SCM_NUMBER_OF_SLOTS(x)\ (SCM_UNPACK (SCM_STRUCT_DATA (x)[scm_struct_i_n_words]) \ - scm_struct_n_extra_words) \ @@ -140,7 +140,7 @@ typedef struct scm_method_t { & (SCM_CLASSF_ACCESSOR_METHOD \ | SCM_CLASSF_SIMPLE_METHOD)) -#define SCM_SLOT(x, i) (SCM_INST(x)[i]) +#define SCM_SLOT(x, i) (SCM_PACK (SCM_INST (x) [i])) #define SCM_SUBCLASSP(c1, c2) (!SCM_FALSEP (scm_c_memq (c2, SCM_SLOT (c1, scm_si_cpl)))) #define SCM_IS_A_P(x, c) (SCM_NIMP (x) \ && SCM_INSTANCEP (x) \ @@ -284,4 +284,4 @@ SCM scm_sys_method_more_specific_p (SCM m1, SCM m2, SCM targs); SCM scm_init_goops_builtins (void); void scm_init_goops (void); -#endif /* GOOPSH */ +#endif /* SCM_GOOPS_H */ diff --git a/libguile/modules.c b/libguile/modules.c index 5bf40ac89..5e893dc9d 100644 --- a/libguile/modules.c +++ b/libguile/modules.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1998, 2000 Free Software Foundation, Inc. +/* Copyright (C) 1998,2000,2001 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 @@ -62,7 +62,7 @@ int scm_module_system_booted_p = 0; -SCM scm_module_tag; +scm_bits_t scm_module_tag; static SCM the_module; diff --git a/libguile/modules.h b/libguile/modules.h index 632668ebe..2dd058524 100644 --- a/libguile/modules.h +++ b/libguile/modules.h @@ -1,8 +1,8 @@ /* classes: h_files */ -#ifndef MODULESH -#define MODULESH -/* Copyright (C) 1998, 2000 Free Software Foundation, Inc. +#ifndef SCM_MODULES_H +#define SCM_MODULES_H +/* Copyright (C) 1998,2000,2001 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 @@ -51,10 +51,10 @@ extern int scm_module_system_booted_p; -extern SCM scm_module_tag; +extern scm_bits_t scm_module_tag; #define SCM_MODULEP(OBJ) \ - (SCM_NIMP (OBJ) && SCM_CELL_TYPE (OBJ) == scm_module_tag) + (!SCM_IMP (OBJ) && SCM_CELL_TYPE (OBJ) == scm_module_tag) #define SCM_VALIDATE_MODULE(pos, scm) SCM_MAKE_VALIDATE (pos, scm, MODULEP) @@ -139,7 +139,7 @@ extern SCM scm_load_scheme_module (SCM name); #endif -#endif /* MODULESH */ +#endif /* SCM_MODULES_H */ /* Local Variables: diff --git a/libguile/objects.h b/libguile/objects.h index 3f9b5e9a8..649d3fb1e 100644 --- a/libguile/objects.h +++ b/libguile/objects.h @@ -1,9 +1,9 @@ /* classes: h_files */ -#ifndef OBJECTSH -#define OBJECTSH +#ifndef SCM_OBJECTS_H +#define SCM_OBJECTS_H -/* Copyright (C) 1996, 1999, 2000 Free Software Foundation, Inc. +/* Copyright (C) 1996,1999,2000,2001 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 @@ -99,10 +99,8 @@ #define SCM_SET_CLASS_DESTRUCTOR(c, d) SCM_SET_VTABLE_DESTRUCTOR (c, d) #define SCM_SET_CLASS_INSTANCE_SIZE(c, s) \ -(SCM_STRUCT_DATA (c)[scm_struct_i_size] \ - = SCM_PACK ((SCM_UNPACK (SCM_STRUCT_DATA (c)[scm_struct_i_size])\ - & SCM_STRUCTF_MASK)\ - | s)) + (SCM_STRUCT_DATA (c)[scm_struct_i_size] \ + = (SCM_STRUCT_DATA (c) [scm_struct_i_size] & SCM_STRUCTF_MASK) | s) /* {Operator classes} * @@ -242,7 +240,7 @@ extern SCM scm_i_make_class_object (SCM metaclass, SCM layout_string, unsigned long flags); extern void scm_init_objects (void); -#endif /* OBJECTSH */ +#endif /* SCM_OBJECTS_H */ /* Local Variables: diff --git a/libguile/sort.c b/libguile/sort.c index 5f849328f..76867843a 100644 --- a/libguile/sort.c +++ b/libguile/sort.c @@ -434,8 +434,8 @@ SCM_DEFINE (scm_restricted_vector_sort_x, "restricted-vector-sort!", 4, 0, 0, vp = SCM_VELTS (vec); /* vector pointer */ vlen = SCM_VECTOR_LENGTH (vec); - SCM_VALIDATE_INUM_COPY (3,startpos,spos); - SCM_ASSERT_RANGE (3,startpos,(spos >= 0) && (spos <= vlen)); + SCM_VALIDATE_INUM_MIN_COPY (3, startpos, 0, spos); + SCM_ASSERT_RANGE (3,startpos, spos <= vlen); SCM_VALIDATE_INUM_RANGE (4,endpos,0,vlen+1); len = SCM_INUM (endpos) - spos; diff --git a/libguile/strports.c b/libguile/strports.c index 21bffde78..de9dfbc79 100644 --- a/libguile/strports.c +++ b/libguile/strports.c @@ -114,7 +114,7 @@ st_resize_port (scm_port_t *pt, off_t new_size) /* reset buffer. */ { - pt->stream = new_stream; + pt->stream = SCM_UNPACK (new_stream); pt->read_buf = pt->write_buf = SCM_STRING_UCHARS (new_stream); pt->read_pos = pt->write_pos = pt->write_buf + index; pt->write_end = pt->write_buf + pt->write_buf_size; diff --git a/libguile/struct.h b/libguile/struct.h index bd952f7eb..cf7a027fd 100644 --- a/libguile/struct.h +++ b/libguile/struct.h @@ -1,8 +1,8 @@ /* classes: h_files */ -#ifndef STRUCTH -#define STRUCTH -/* Copyright (C) 1995, 1997, 1999, 2000 Free Software Foundation, Inc. +#ifndef SCM_STRUCT_H +#define SCM_STRUCT_H +/* Copyright (C) 1995,1997,1999,2000,2001 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 @@ -88,7 +88,7 @@ typedef size_t (*scm_struct_free_t) (scm_bits_t * vtable, scm_bits_t * data); #define SCM_STRUCT_VTABLE(X) (SCM_PACK (SCM_STRUCT_VTABLE_DATA (X) [scm_vtable_index_vtable])) #define SCM_STRUCT_PRINTER(X) (SCM_PACK (SCM_STRUCT_VTABLE_DATA (X) [scm_vtable_index_printer])) #define SCM_SET_STRUCT_PRINTER(x, v)\ - (SCM_STRUCT_VTABLE_DATA (x) [scm_vtable_index_printer] = (v)) + (SCM_STRUCT_VTABLE_DATA (x) [scm_vtable_index_printer] = SCM_UNPACK (v)) #define SCM_SET_VTABLE_DESTRUCTOR(X, D) (SCM_STRUCT_DATA (X) [scm_struct_i_free] = (scm_bits_t) (D)) /* Efficiency is important in the following macro, since it's used in GC */ #define SCM_LAYOUT_TAILP(X) (((X) & 32) == 0) /* R, W or O */ @@ -127,7 +127,7 @@ extern void scm_print_struct (SCM exp, SCM port, scm_print_state *); extern void scm_struct_prehistory (void); extern void scm_init_struct (void); -#endif /* STRUCTH */ +#endif /* SCM_STRUCT_H */ /* Local Variables: diff --git a/libguile/symbols.h b/libguile/symbols.h index 3691ac46e..2c4973b9d 100644 --- a/libguile/symbols.h +++ b/libguile/symbols.h @@ -1,8 +1,8 @@ /* classes: h_files */ -#ifndef SYMBOLSH -#define SYMBOLSH -/* Copyright (C) 1995,1996,1997,1998, 2000, 2001 Free Software Foundation, Inc. +#ifndef SCM_SYMBOLS_H +#define SCM_SYMBOLS_H +/* Copyright (C) 1995,1996,1997,1998,2000,2001 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 @@ -62,12 +62,12 @@ #define SCM_SYMBOL_HASH(X) ((unsigned long) SCM_CELL_WORD_2 (X)) #define SCM_SET_SYMBOL_HASH(X, v) (SCM_SET_CELL_WORD_2 ((X), (v))) -#define SCM_PROP_SLOTS(X) (SCM_CELL_WORD_3 (X)) -#define SCM_SET_PROP_SLOTS(X, v) (SCM_SET_CELL_WORD_3 ((X), (v))) -#define SCM_SYMBOL_FUNC(X) (SCM_CAR (SCM_CELL_WORD_3 (X))) -#define SCM_SET_SYMBOL_FUNC(X, v) (SCM_SETCAR (SCM_CELL_WORD_3 (X), (v))) -#define SCM_SYMBOL_PROPS(X) (SCM_CDR (SCM_CELL_WORD_3 (X))) -#define SCM_SET_SYMBOL_PROPS(X, v) (SCM_SETCDR (SCM_CELL_WORD_3 (X), (v))) +#define SCM_PROP_SLOTS(X) (SCM_CELL_OBJECT_3 (X)) +#define SCM_SET_PROP_SLOTS(X, v) (SCM_SET_CELL_OBJECT_3 ((X), (v))) +#define SCM_SYMBOL_FUNC(X) (SCM_CAR (SCM_CELL_OBJECT_3 (X))) +#define SCM_SET_SYMBOL_FUNC(X, v) (SCM_SETCAR (SCM_CELL_OBJECT_3 (X), (v))) +#define SCM_SYMBOL_PROPS(X) (SCM_CDR (SCM_CELL_OBJECT_3 (X))) +#define SCM_SET_SYMBOL_PROPS(X, v) (SCM_SETCDR (SCM_CELL_OBJECT_3 (X), (v))) @@ -152,7 +152,7 @@ extern void scm_init_symbols_deprecated (void); #endif /* SCM_ENABLE_VCELLS */ -#endif /* SYMBOLSH */ +#endif /* SCM_SYMBOLS_H */ /* Local Variables: diff --git a/libguile/tags.h b/libguile/tags.h index e64ad4c35..3de11fec8 100644 --- a/libguile/tags.h +++ b/libguile/tags.h @@ -54,8 +54,6 @@ -/* #define SCM_VOIDP_TEST */ - /* In the beginning was the Word: */ typedef long scm_bits_t; @@ -63,16 +61,16 @@ typedef long scm_bits_t; /* But as external interface, we use SCM, which may, according to the desired * level of type checking, be defined in several ways: */ -#if (SCM_DEBUG_TYPING_STRICTNESS == 1) +#if (SCM_DEBUG_TYPING_STRICTNESS == 2) typedef union { struct { scm_bits_t n; } n; } SCM; static SCM scm_pack(scm_bits_t b) { SCM s; s.n.n = b; return s; } # define SCM_UNPACK(x) ((x).n.n) # define SCM_PACK(x) (scm_pack ((scm_bits_t) (x))) -#elif defined (SCM_VOIDP_TEST) +#elif (SCM_DEBUG_TYPING_STRICTNESS == 1) /* This is the default, which provides an intermediate level of compile time * type checking while still resulting in very efficient code. */ - typedef void * SCM; + typedef struct scm_unused_struct * SCM; # define SCM_UNPACK(x) ((scm_bits_t) (x)) # define SCM_PACK(x) ((SCM) (x)) #else diff --git a/libguile/unif.c b/libguile/unif.c index fbb9b96d7..5e0a801df 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -1321,36 +1321,39 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, ((char *) SCM_UVECTOR_BASE (v))[pos] = SCM_INUM (obj); break; case scm_tc7_uvect: - ((unsigned long *) SCM_VELTS(v))[pos] = SCM_PACK (scm_num2ulong(obj, SCM_ARG2, FUNC_NAME)); + ((unsigned long *) SCM_UVECTOR_BASE (v))[pos] + = scm_num2ulong (obj, SCM_ARG2, FUNC_NAME); break; case scm_tc7_ivect: - ((long *) SCM_VELTS(v))[pos] = SCM_PACK (scm_num2long (obj, SCM_ARG2, FUNC_NAME)); + ((long *) SCM_UVECTOR_BASE (v))[pos] + = scm_num2long (obj, SCM_ARG2, FUNC_NAME); break; case scm_tc7_svect: SCM_ASRTGO (SCM_INUMP (obj), badobj); - ((short *) SCM_CELL_WORD_1 (v))[pos] = SCM_INUM (obj); + ((short *) SCM_UVECTOR_BASE (v))[pos] = SCM_INUM (obj); break; #ifdef HAVE_LONG_LONGS case scm_tc7_llvect: - ((long long *) SCM_CELL_WORD_1 (v))[pos] = scm_num2long_long (obj, SCM_ARG2, FUNC_NAME); + ((long long *) SCM_UVECTOR_BASE (v))[pos] + = scm_num2long_long (obj, SCM_ARG2, FUNC_NAME); break; #endif - - case scm_tc7_fvect: - ((float *) SCM_CELL_WORD_1 (v))[pos] = (float) scm_num2dbl (obj, FUNC_NAME); + ((float *) SCM_UVECTOR_BASE (v))[pos] + = (float) scm_num2dbl (obj, FUNC_NAME); break; case scm_tc7_dvect: - ((double *) SCM_CELL_WORD_1 (v))[pos] = scm_num2dbl (obj, FUNC_NAME); + ((double *) SCM_UVECTOR_BASE (v))[pos] + = scm_num2dbl (obj, FUNC_NAME); break; case scm_tc7_cvect: SCM_ASRTGO (SCM_INEXACTP (obj), badobj); if (SCM_REALP (obj)) { - ((double *) SCM_CELL_WORD_1 (v))[2 * pos] = SCM_REAL_VALUE (obj); - ((double *) SCM_CELL_WORD_1 (v))[2 * pos + 1] = 0.0; + ((double *) SCM_UVECTOR_BASE (v))[2 * pos] = SCM_REAL_VALUE (obj); + ((double *) SCM_UVECTOR_BASE (v))[2 * pos + 1] = 0.0; } else { - ((double *) SCM_CELL_WORD_1 (v))[2 * pos] = SCM_COMPLEX_REAL (obj); - ((double *) SCM_CELL_WORD_1 (v))[2 * pos + 1] = SCM_COMPLEX_IMAG (obj); + ((double *) SCM_UVECTOR_BASE (v))[2 * pos] = SCM_COMPLEX_REAL (obj); + ((double *) SCM_UVECTOR_BASE (v))[2 * pos + 1] = SCM_COMPLEX_IMAG (obj); } break; case scm_tc7_vector: |