summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/ChangeLog68
-rw-r--r--libguile/__scm.h8
-rw-r--r--libguile/eval.c5
-rw-r--r--libguile/eval.h8
-rw-r--r--libguile/gc.c4
-rw-r--r--libguile/gh_data.c7
-rw-r--r--libguile/goops.c15
-rw-r--r--libguile/goops.h12
-rw-r--r--libguile/modules.c4
-rw-r--r--libguile/modules.h12
-rw-r--r--libguile/objects.h14
-rw-r--r--libguile/sort.c4
-rw-r--r--libguile/strports.c2
-rw-r--r--libguile/struct.h10
-rw-r--r--libguile/symbols.h20
-rw-r--r--libguile/tags.h8
-rw-r--r--libguile/unif.c27
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: