mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-06 04:00:26 +02:00
Code Activity

* Changed the default definition of SCM.

Browse source 
* Fixed some typing problems detected by the above change.
* Fixed some problems that were detected by compiling guile with -W.
This commit is contained in:
Dirk Herrmann 2001-05-27 22:00:03 +00:00
parent fc62c86a59
commit 729dbac32f
17 changed files with 147 additions and 81 deletions
Download patch file Download diff file Expand all files Collapse all files

66
libguile/ChangeLog
View file

@ -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> 2001-05-27 Michael Livshin <mlivshin@bigfoot.com>
* gc.c (scm_init_storage): init `scm_gc_registered_roots'. * gc.c (scm_init_storage): init `scm_gc_registered_roots'.
@ -25,6 +90,7 @@
* modules.c (scm_env_module): Exported to Scheme. * modules.c (scm_env_module): Exported to Scheme.
* eval.c (scm_debug_opts): New option `show-file-name'. * eval.c (scm_debug_opts): New option `show-file-name'.
* debug.h (SCM_SHOW_FILE_NAME): New. * debug.h (SCM_SHOW_FILE_NAME): New.
* backtrace.c: Include "libguile/filesys.h". * backtrace.c: Include "libguile/filesys.h".

8
libguile/__scm.h
View file

@ -1,7 +1,7 @@
/* classes: h_files */ /* classes: h_files */
#ifndef __SCMH #ifndef SCM___SCM_H
#define __SCMH #define SCM___SCM_H
/* Copyright (C) 1995,1996,1998,1999,2000,2001 Free Software Foundation, Inc. /* Copyright (C) 1995,1996,1998,1999,2000,2001 Free Software Foundation, Inc.
* *
* This program is free software; you can redistribute it and/or modify * This program is free software; you can redistribute it and/or modify
@ -192,7 +192,7 @@
* errors, and then do 'make clean; make'. * errors, and then do 'make clean; make'.
*/ */
#ifndef SCM_DEBUG_TYPING_STRICTNESS #ifndef SCM_DEBUG_TYPING_STRICTNESS
#define SCM_DEBUG_TYPING_STRICTNESS 0 #define SCM_DEBUG_TYPING_STRICTNESS 1
#endif #endif
/* If SCM_ENABLE_VCELLS is set to 1, a couple of functions that deal /* 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: Local Variables:

5
libguile/eval.c
View file

@ -2321,7 +2321,8 @@ dispatch:
/* Compute a hash value */ /* Compute a hash value */
long hashset = SCM_INUM (proc); long hashset = SCM_INUM (proc);
long j = n; 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); proc = SCM_CADR (z);
i = 0; i = 0;
t.arg1 = arg2; t.arg1 = arg2;
@ -3786,7 +3787,7 @@ promise_print (SCM exp, SCM port, scm_print_state *pstate)
int writingp = SCM_WRITINGP (pstate); int writingp = SCM_WRITINGP (pstate);
scm_puts ("#<promise ", port); scm_puts ("#<promise ", port);
SCM_SET_WRITINGP (pstate, 1); 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_SET_WRITINGP (pstate, writingp);
scm_putc ('>', port); scm_putc ('>', port);
return !0; return !0;

8
libguile/eval.h
View file

@ -95,9 +95,11 @@ extern SCM scm_eval_options_interface (SCM setting);
* *
* For an explanation of symbols containing "EVAL", see beginning of eval.c. * For an explanation of symbols containing "EVAL", see beginning of eval.c.
*/ */
#define SCM_EVALIM2(x) ((SCM_EQ_P ((x), SCM_EOL)) \ #define SCM_EVALIM2(x) \
? scm_misc_error (NULL, scm_s_expression, SCM_EOL), 0 \ ((SCM_EQ_P ((x), SCM_EOL) \
: (x)) ? scm_misc_error (NULL, scm_s_expression, SCM_EOL), 0 \
: 0), \
(x))
#ifdef MEMOIZE_LOCALS #ifdef MEMOIZE_LOCALS
#define SCM_EVALIM(x, env) (SCM_ILOCP (x) \ #define SCM_EVALIM(x, env) (SCM_ILOCP (x) \
? *scm_ilookup ((x), env) \ ? *scm_ilookup ((x), env) \

4
libguile/gc.c
View file

@ -312,11 +312,11 @@ typedef struct scm_freelist_t {
SCM scm_freelist = SCM_EOL; SCM scm_freelist = SCM_EOL;
scm_freelist_t scm_master_freelist = { 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 scm_freelist2 = SCM_EOL;
scm_freelist_t scm_master_freelist2 = { 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 /* scm_mtrigger

7
libguile/gh_data.c
View file

@ -99,17 +99,14 @@ gh_set_substr (char *src, SCM dst, long start, size_t len)
{ {
char *dst_ptr; char *dst_ptr;
size_t dst_len; size_t dst_len;
size_t effective_length;
SCM_ASSERT (SCM_STRINGP (dst), dst, SCM_ARG3, "gh_set_substr"); SCM_ASSERT (SCM_STRINGP (dst), dst, SCM_ARG3, "gh_set_substr");
dst_ptr = SCM_STRING_CHARS (dst); dst_ptr = SCM_STRING_CHARS (dst);
dst_len = SCM_STRING_LENGTH (dst); dst_len = SCM_STRING_LENGTH (dst);
SCM_ASSERT (len >= 0 && len <= dst_len, SCM_ASSERT (start + len <= dst_len, dst, SCM_ARG4, "gh_set_substr");
dst, SCM_ARG4, "gh_set_substr");
effective_length = (len < dst_len) ? len : dst_len; memmove (dst_ptr + start, src, len);
memmove (dst_ptr + start, src, effective_length);
scm_remember_upto_here_1 (dst); scm_remember_upto_here_1 (dst);
} }

15
libguile/goops.c
View file

@ -1129,8 +1129,8 @@ test_slot_existence (SCM class, SCM obj, SCM slot_name)
{ {
register SCM l; register SCM l;
for (l = SCM_ACCESSORS_OF (obj); SCM_NNULLP (l); l = SCM_CDR (l)) for (l = SCM_ACCESSORS_OF (obj); !SCM_NULLP (l); l = SCM_CDR (l))
if (SCM_CAAR (l) == slot_name) if (SCM_EQ_P (SCM_CAAR (l), slot_name))
return SCM_BOOL_T; return SCM_BOOL_T;
return SCM_BOOL_F; return SCM_BOOL_F;
@ -1289,9 +1289,10 @@ wrap_init (SCM class, SCM *m, long n)
m[i] = SCM_GOOPS_UNBOUND; m[i] = SCM_GOOPS_UNBOUND;
SCM_NEWCELL2 (z); SCM_NEWCELL2 (z);
SCM_SETCDR (z, (SCM) m);
SCM_SET_STRUCT_GC_CHAIN (z, 0); 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; return z;
} }
@ -1435,10 +1436,10 @@ SCM_DEFINE (scm_sys_modify_class, "%modify-class", 2, 0, 0,
SCM cdr = SCM_CDR (old); SCM cdr = SCM_CDR (old);
SCM_SETCAR (old, SCM_CAR (new)); SCM_SETCAR (old, SCM_CAR (new));
SCM_SETCDR (old, SCM_CDR (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_SETCAR (new, car);
SCM_SETCDR (new, cdr); 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; SCM_REALLOW_INTS;
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
@ -1462,7 +1463,7 @@ SCM_DEFINE (scm_sys_invalidate_class, "%invalidate-class", 1, 0, 0,
* infinite recursions. * infinite recursions.
*/ */
static SCM **hell; static scm_bits_t **hell;
static long n_hell = 1; /* one place for the evil one himself */ static long n_hell = 1; /* one place for the evil one himself */
static long hell_size = 4; static long hell_size = 4;
#ifdef USE_THREADS #ifdef USE_THREADS

12
libguile/goops.h
View file

@ -1,8 +1,8 @@
/* classes: h_files */ /* classes: h_files */
#ifndef GOOPSH #ifndef SCM_GOOPS_H
#define GOOPSH #define SCM_GOOPS_H
/* Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. /* Copyright (C) 1998,1999,2000,2001 Free Software Foundation, Inc.
* *
* This program is free software; you can redistribute it and/or modify * 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 * 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) #define SCM_INST_TYPE(x) SCM_OBJ_CLASS_FLAGS (x)
/* Also defined in libguuile/objects.c */ /* Also defined in libguuile/objects.c */
#define SCM_CLASS_OF(x) SCM_STRUCT_VTABLE (x) #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)\ #define SCM_NUMBER_OF_SLOTS(x)\
(SCM_UNPACK (SCM_STRUCT_DATA (x)[scm_struct_i_n_words]) \ (SCM_UNPACK (SCM_STRUCT_DATA (x)[scm_struct_i_n_words]) \
- scm_struct_n_extra_words) \ - scm_struct_n_extra_words) \
@ -140,7 +140,7 @@ typedef struct scm_method_t {
& (SCM_CLASSF_ACCESSOR_METHOD \ & (SCM_CLASSF_ACCESSOR_METHOD \
| SCM_CLASSF_SIMPLE_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_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) \ #define SCM_IS_A_P(x, c) (SCM_NIMP (x) \
&& SCM_INSTANCEP (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); SCM scm_init_goops_builtins (void);
void scm_init_goops (void); void scm_init_goops (void);
#endif /* GOOPSH */ #endif /* SCM_GOOPS_H */

4
libguile/modules.c
View file

@ -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 * 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 * it under the terms of the GNU General Public License as published by
@ -62,7 +62,7 @@
int scm_module_system_booted_p = 0; int scm_module_system_booted_p = 0;
SCM scm_module_tag; scm_bits_t scm_module_tag;
static SCM the_module; static SCM the_module;

12
libguile/modules.h
View file

@ -1,8 +1,8 @@
/* classes: h_files */ /* classes: h_files */
#ifndef MODULESH #ifndef SCM_MODULES_H
#define MODULESH #define SCM_MODULES_H
/* 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 * 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 * 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 int scm_module_system_booted_p;
extern SCM scm_module_tag; extern scm_bits_t scm_module_tag;
#define SCM_MODULEP(OBJ) \ #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) #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
#endif /* MODULESH */ #endif /* SCM_MODULES_H */
/* /*
Local Variables: Local Variables:

14
libguile/objects.h
View file

@ -1,9 +1,9 @@
/* classes: h_files */ /* classes: h_files */
#ifndef OBJECTSH #ifndef SCM_OBJECTS_H
#define OBJECTSH #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 * 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 * 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_DESTRUCTOR(c, d) SCM_SET_VTABLE_DESTRUCTOR (c, d)
#define SCM_SET_CLASS_INSTANCE_SIZE(c, s) \ #define SCM_SET_CLASS_INSTANCE_SIZE(c, s) \
(SCM_STRUCT_DATA (c)[scm_struct_i_size] \ (SCM_STRUCT_DATA (c)[scm_struct_i_size] \
= SCM_PACK ((SCM_UNPACK (SCM_STRUCT_DATA (c)[scm_struct_i_size])\ = (SCM_STRUCT_DATA (c) [scm_struct_i_size] & SCM_STRUCTF_MASK) | s)
& SCM_STRUCTF_MASK)\
| s))
/* {Operator classes} /* {Operator classes}
* *
@ -242,7 +240,7 @@ extern SCM scm_i_make_class_object (SCM metaclass, SCM layout_string,
unsigned long flags); unsigned long flags);
extern void scm_init_objects (void); extern void scm_init_objects (void);
#endif /* OBJECTSH */ #endif /* SCM_OBJECTS_H */
/* /*
Local Variables: Local Variables:

4
libguile/sort.c
View file

@ -434,8 +434,8 @@ SCM_DEFINE (scm_restricted_vector_sort_x, "restricted-vector-sort!", 4, 0, 0,
vp = SCM_VELTS (vec); /* vector pointer */ vp = SCM_VELTS (vec); /* vector pointer */
vlen = SCM_VECTOR_LENGTH (vec); vlen = SCM_VECTOR_LENGTH (vec);
SCM_VALIDATE_INUM_COPY (3,startpos,spos); SCM_VALIDATE_INUM_MIN_COPY (3, startpos, 0, spos);
SCM_ASSERT_RANGE (3,startpos,(spos >= 0) && (spos <= vlen)); SCM_ASSERT_RANGE (3,startpos, spos <= vlen);
SCM_VALIDATE_INUM_RANGE (4,endpos,0,vlen+1); SCM_VALIDATE_INUM_RANGE (4,endpos,0,vlen+1);
len = SCM_INUM (endpos) - spos; len = SCM_INUM (endpos) - spos;

2
libguile/strports.c
View file

@ -114,7 +114,7 @@ st_resize_port (scm_port_t *pt, off_t new_size)
/* reset buffer. */ /* 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_buf = pt->write_buf = SCM_STRING_UCHARS (new_stream);
pt->read_pos = pt->write_pos = pt->write_buf + index; pt->read_pos = pt->write_pos = pt->write_buf + index;
pt->write_end = pt->write_buf + pt->write_buf_size; pt->write_end = pt->write_buf + pt->write_buf_size;

10
libguile/struct.h
View file

@ -1,8 +1,8 @@
/* classes: h_files */ /* classes: h_files */
#ifndef STRUCTH #ifndef SCM_STRUCT_H
#define STRUCTH #define SCM_STRUCT_H
/* Copyright (C) 1995, 1997, 1999, 2000 Free Software Foundation, Inc. /* Copyright (C) 1995,1997,1999,2000,2001 Free Software Foundation, Inc.
* *
* This program is free software; you can redistribute it and/or modify * 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 * 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_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_STRUCT_PRINTER(X) (SCM_PACK (SCM_STRUCT_VTABLE_DATA (X) [scm_vtable_index_printer]))
#define SCM_SET_STRUCT_PRINTER(x, v)\ #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)) #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 */ /* 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 */ #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_struct_prehistory (void);
extern void scm_init_struct (void); extern void scm_init_struct (void);
#endif /* STRUCTH */ #endif /* SCM_STRUCT_H */
/* /*
Local Variables: Local Variables:

20
libguile/symbols.h
View file

@ -1,8 +1,8 @@
/* classes: h_files */ /* classes: h_files */
#ifndef SYMBOLSH #ifndef SCM_SYMBOLS_H
#define SYMBOLSH #define SCM_SYMBOLS_H
/* Copyright (C) 1995,1996,1997,1998, 2000, 2001 Free Software Foundation, Inc. /* Copyright (C) 1995,1996,1997,1998,2000,2001 Free Software Foundation, Inc.
* *
* This program is free software; you can redistribute it and/or modify * 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 * 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_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_SET_SYMBOL_HASH(X, v) (SCM_SET_CELL_WORD_2 ((X), (v)))
#define SCM_PROP_SLOTS(X) (SCM_CELL_WORD_3 (X)) #define SCM_PROP_SLOTS(X) (SCM_CELL_OBJECT_3 (X))
#define SCM_SET_PROP_SLOTS(X, v) (SCM_SET_CELL_WORD_3 ((X), (v))) #define SCM_SET_PROP_SLOTS(X, v) (SCM_SET_CELL_OBJECT_3 ((X), (v)))
#define SCM_SYMBOL_FUNC(X) (SCM_CAR (SCM_CELL_WORD_3 (X))) #define SCM_SYMBOL_FUNC(X) (SCM_CAR (SCM_CELL_OBJECT_3 (X)))
#define SCM_SET_SYMBOL_FUNC(X, v) (SCM_SETCAR (SCM_CELL_WORD_3 (X), (v))) #define SCM_SET_SYMBOL_FUNC(X, v) (SCM_SETCAR (SCM_CELL_OBJECT_3 (X), (v)))
#define SCM_SYMBOL_PROPS(X) (SCM_CDR (SCM_CELL_WORD_3 (X))) #define SCM_SYMBOL_PROPS(X) (SCM_CDR (SCM_CELL_OBJECT_3 (X)))
#define SCM_SET_SYMBOL_PROPS(X, v) (SCM_SETCDR (SCM_CELL_WORD_3 (X), (v))) #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 /* SCM_ENABLE_VCELLS */
#endif /* SYMBOLSH */ #endif /* SCM_SYMBOLS_H */
/* /*
Local Variables: Local Variables:

8
libguile/tags.h
View file

@ -54,8 +54,6 @@
/* #define SCM_VOIDP_TEST */
/* In the beginning was the Word: /* In the beginning was the Word:
*/ */
typedef long scm_bits_t; 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 /* But as external interface, we use SCM, which may, according to the desired
* level of type checking, be defined in several ways: * 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; 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; } 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_UNPACK(x) ((x).n.n)
# define SCM_PACK(x) (scm_pack ((scm_bits_t) (x))) # 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 /* This is the default, which provides an intermediate level of compile time
* type checking while still resulting in very efficient code. * 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_UNPACK(x) ((scm_bits_t) (x))
# define SCM_PACK(x) ((SCM) (x)) # define SCM_PACK(x) ((SCM) (x))
#else #else

27
libguile/unif.c
View file

@ -1321,36 +1321,39 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1,
((char *) SCM_UVECTOR_BASE (v))[pos] = SCM_INUM (obj); ((char *) SCM_UVECTOR_BASE (v))[pos] = SCM_INUM (obj);
break; break;
case scm_tc7_uvect: 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; break;
case scm_tc7_ivect: 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; break;
case scm_tc7_svect: case scm_tc7_svect:
SCM_ASRTGO (SCM_INUMP (obj), badobj); 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; break;
#ifdef HAVE_LONG_LONGS #ifdef HAVE_LONG_LONGS
case scm_tc7_llvect: 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; break;
#endif #endif
case scm_tc7_fvect: 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; break;
case scm_tc7_dvect: 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; break;
case scm_tc7_cvect: case scm_tc7_cvect:
SCM_ASRTGO (SCM_INEXACTP (obj), badobj); SCM_ASRTGO (SCM_INEXACTP (obj), badobj);
if (SCM_REALP (obj)) { if (SCM_REALP (obj)) {
((double *) SCM_CELL_WORD_1 (v))[2 * pos] = SCM_REAL_VALUE (obj); ((double *) SCM_UVECTOR_BASE (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 + 1] = 0.0;
} else { } else {
((double *) SCM_CELL_WORD_1 (v))[2 * pos] = SCM_COMPLEX_REAL (obj); ((double *) SCM_UVECTOR_BASE (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 + 1] = SCM_COMPLEX_IMAG (obj);
} }
break; break;
case scm_tc7_vector: case scm_tc7_vector: