mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-02 18:26:20 +02:00
* Changed the default definition of SCM.
* 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
parent
fc62c86a59
commit
729dbac32f
17 changed files with 147 additions and 81 deletions
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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) \
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 */
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue