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

* Replaced a lot of references to SCM_CHARS.

Browse source
This commit is contained in:
Dirk Herrmann 2000-09-26 18:37:26 +00:00
parent 1660782ecf
commit a002f1a2cb
16 changed files with 90 additions and 46 deletions
Download patch file Download diff file Expand all files Collapse all files

36
libguile/ChangeLog
View file

@ -1,3 +1,39 @@
2000-09-26 Dirk Herrmann <D.Herrmann@tu-bs.de>
* continuations.c (scm_make_cont, scm_dynthrow), print.c
(scm_iprin1), stacks.c (scm_make_stack, scm_stack_id,
scm_last_stack_frame): For continuations, use SCM_CONTREGS
instead of SCM_CHARS.
* coop-threads.c (scm_threads_mark_stacks): Eliminate references
to SCM_LENGTH and SCM_CHARS from comments.
* dynl.c (scm_dynamic_link, scm_dynamic_func), symbols.h
(SCM_ROCHARS, SCM_ROUCHARS): Cleanly distinguish between string
and symbol arguments.
* hash.c (scm_hasher), keywords.c (prin_keyword), objects.c
(scm_make_subclass_object), print.c (scm_iprin1), regex-posix.c
(scm_regexp_error_msg), stime.c (bdtime2c, scm_strftime), struct.c
(scm_struct_init, scm_struct_vtable_p, scm_struct_ref,
scm_struct_set_x): Use SCM_STRING_U?CHARS or SCM_SYMBOL_U?CHARS
instead of SCM_U?CHARS.
* strings.h (SCM_STRING_UCHARS): Added as a replacement for
SCM_UCHARS for string arguments.
* strorder.c: Include strings.h and symbols.h.
* symbols.h: Replaced SCM_CHARS in comment.
(SCM_SYMBOL_UCHARS): Added as a replacement for SCM_UCHARS for
symbol arguments.
(SCM_SLOPPY_SUBSTRP): Deprecated.
* tags.h: Fixed comments not to reference SCM_LENGTH or
SCM_CHARS.
2000-09-22 Dirk Herrmann <D.Herrmann@tu-bs.de>
* gc.c (scm_gc_mark, scm_gc_sweep), tags.h: Removed the

4
libguile/continuations.c
View file

@ -94,7 +94,7 @@ scm_make_cont (SCM *answer)
#ifndef SCM_STACK_GROWS_UP
src -= SCM_LENGTH (cont);
#endif /* ndef SCM_STACK_GROWS_UP */
dst = (SCM_STACKITEM *) (SCM_CHARS (cont) + sizeof (scm_contregs));
dst = (SCM_STACKITEM *) ((char *) SCM_CONTREGS (cont) + sizeof (scm_contregs));
/* memcpy should be safe: src and dst will never overlap */
memcpy (dst, src, sizeof (SCM_STACKITEM) * SCM_LENGTH (cont));
@ -166,7 +166,7 @@ scm_dynthrow (SCM cont, SCM val)
grow_stack (cont, val);
#endif /* def SCM_STACK_GROWS_UP */
SCM_FLUSH_REGISTER_WINDOWS;
src = (SCM_STACKITEM *) (SCM_CHARS (cont) + sizeof (scm_contregs));
src = (SCM_STACKITEM *) ((char *) SCM_CONTREGS (cont) + sizeof (scm_contregs));
copy_stack_and_call (cont, val, src, dst);
}

8
libguile/coop-threads.c
View file

@ -101,8 +101,8 @@ scm_threads_mark_stacks (void)
/* Protect from the C stack. This must be the first marking
* done because it provides information about what objects
* are "in-use" by the C code. "in-use" objects are those
* for which the values from SCM_LENGTH and SCM_CHARS must remain
* usable. This requirement is stricter than a liveness
* for which the information about length and base address must
* remain usable. This requirement is stricter than a liveness
* requirement -- in particular, it constrains the implementation
* of scm_resizuve.
*/
@ -122,8 +122,8 @@ scm_threads_mark_stacks (void)
/* Protect from the C stack. This must be the first marking
* done because it provides information about what objects
* are "in-use" by the C code. "in-use" objects are those
* for which the values from SCM_LENGTH and SCM_CHARS must remain
* usable. This requirement is stricter than a liveness
* for which the information about length and base address must
* remain usable. This requirement is stricter than a liveness
* requirement -- in particular, it constrains the implementation
* of scm_resizuve.
*/

15
libguile/dynl.c
View file

@ -353,9 +353,11 @@ SCM_DEFINE (scm_dynamic_link, "dynamic-link", 1, 0, 0,
#define FUNC_NAME s_scm_dynamic_link
{
void *handle;
char *chars;
SCM_COERCE_ROSTRING (1, fname);
handle = sysdep_dynl_link (SCM_CHARS (fname), FUNC_NAME);
fname = scm_coerce_rostring (fname, FUNC_NAME, 1);
chars = SCM_STRINGP (fname) ? SCM_STRING_CHARS (fname) : SCM_SYMBOL_CHARS (fname);
handle = sysdep_dynl_link (chars, FUNC_NAME);
SCM_RETURN_NEWSMOB2 (scm_tc16_dynamic_obj, SCM_UNPACK (fname), handle);
}
#undef FUNC_NAME
@ -416,16 +418,17 @@ SCM_DEFINE (scm_dynamic_func, "dynamic-func", 2, 0, 0,
{
void (*func) ();
SCM_COERCE_ROSTRING (1, symb);
symb = scm_coerce_rostring (symb, FUNC_NAME, 1);
/*fixme* GC-problem */
SCM_VALIDATE_SMOB (SCM_ARG2, dobj, dynamic_obj);
if (DYNL_HANDLE (dobj) == NULL) {
SCM_MISC_ERROR ("Already unlinked: ~S", dobj);
} else {
char *chars;
SCM_DEFER_INTS;
func = (void (*) ()) sysdep_dynl_func (SCM_CHARS (symb),
DYNL_HANDLE (dobj),
FUNC_NAME);
chars = SCM_STRINGP (symb) ? SCM_STRING_CHARS (symb) : SCM_SYMBOL_CHARS (symb);
func = (void (*) ()) sysdep_dynl_func (chars, DYNL_HANDLE (dobj), FUNC_NAME);
SCM_ALLOW_INTS;
return scm_ulong2num ((unsigned long) func);
}

3
libguile/hash.c
View file

@ -48,6 +48,8 @@
#include "libguile/_scm.h"
#include "libguile/chars.h"
#include "libguile/ports.h"
#include "libguile/strings.h"
#include "libguile/symbols.h"
#include "libguile/vectors.h"
#include "libguile/validate.h"
@ -117,6 +119,7 @@ scm_hasher(SCM obj, unsigned long n, scm_sizet d)
obj = scm_number_to_string(obj, SCM_MAKINUM(10));
}
case scm_tc7_string:
return scm_string_hash (SCM_STRING_UCHARS (obj), SCM_LENGTH (obj)) % n;
case scm_tc7_substring:
return scm_string_hash (SCM_ROUCHARS (obj), SCM_ROLENGTH (obj)) % n;
case scm_tc7_symbol:

2
libguile/keywords.c
View file

@ -59,7 +59,7 @@ static int
prin_keyword (SCM exp,SCM port,scm_print_state *pstate)
{
scm_puts ("#:", port);
scm_puts(1 + SCM_CHARS (SCM_CDR (exp)), port);
scm_puts(1 + SCM_SYMBOL_CHARS (SCM_CDR (exp)), port);
return 1;
}

2
libguile/objects.c
View file

@ -457,7 +457,7 @@ SCM_DEFINE (scm_make_subclass_object, "make-subclass-object", 2, 0, 0,
SCM_VALIDATE_STRING (2,layout);
pl = SCM_PACK (SCM_STRUCT_DATA (class) [scm_vtable_index_layout]);
/* Convert symbol->string */
pl = scm_makfromstr (SCM_CHARS (pl), (scm_sizet) SCM_LENGTH (pl), 0);
pl = scm_makfromstr (SCM_SYMBOL_CHARS (pl), (scm_sizet) SCM_LENGTH (pl), 0);
return scm_i_make_class_object (SCM_STRUCT_VTABLE (class),
scm_string_append (SCM_LIST2 (pl, layout)),
SCM_CLASS_FLAGS (class));

7
libguile/print.c
View file

@ -47,6 +47,7 @@
#include <stdio.h>
#include "libguile/_scm.h"
#include "libguile/chars.h"
#include "libguile/continuations.h"
#include "libguile/smob.h"
#include "libguile/eval.h"
#include "libguile/macros.h"
@ -620,7 +621,7 @@ taloop:
? "#<primitive-generic "
: "#<primitive-procedure ",
port);
scm_puts (SCM_CHARS (SCM_SNAME (exp)), port);
scm_puts (SCM_SYMBOL_CHARS (SCM_SNAME (exp)), port);
scm_putc ('>', port);
break;
#ifdef CCLO
@ -635,7 +636,7 @@ taloop:
if (SCM_NFALSEP (name))
{
scm_putc (' ', port);
scm_puts (SCM_CHARS (name), port);
scm_puts (SCM_SYMBOL_CHARS (name), port);
}
}
else
@ -663,7 +664,7 @@ taloop:
scm_puts ("#<continuation ", port);
scm_intprint (SCM_LENGTH (exp), 10, port);
scm_puts (" @ ", port);
scm_intprint ((long) SCM_CHARS (exp), 16, port);
scm_intprint ((long) SCM_CONTREGS (exp), 16, port);
scm_putc ('>', port);
break;
case scm_tc7_port:

2
libguile/regex-posix.c
View file

@ -128,7 +128,7 @@ scm_regexp_error_msg (int regerrno, regex_t *rx)
if (l > 80)
{
errmsg = scm_make_string (SCM_MAKINUM (l), SCM_UNDEFINED);
regerror (regerrno, rx, SCM_CHARS (errmsg), l);
regerror (regerrno, rx, SCM_STRING_CHARS (errmsg), l);
}
SCM_ALLOW_INTS;
return SCM_STRING_CHARS (errmsg);

6
libguile/stacks.c
View file

@ -435,7 +435,7 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
dframe = (scm_debug_frame *) SCM_DEBUGOBJ_FRAME (obj);
else if (scm_tc7_contin == SCM_TYP7 (obj))
{
offset = ((SCM_STACKITEM *) (SCM_CHARS (obj) + sizeof (scm_contregs))
offset = ((SCM_STACKITEM *) ((char *) SCM_CONTREGS (obj) + sizeof (scm_contregs))
- SCM_BASE (obj));
#ifndef STACK_GROWS_UP
offset += SCM_LENGTH (obj);
@ -519,7 +519,7 @@ SCM_DEFINE (scm_stack_id, "stack-id", 1, 0, 0,
dframe = (scm_debug_frame *) SCM_DEBUGOBJ_FRAME (stack);
else if (scm_tc7_contin == SCM_TYP7 (stack))
{
offset = ((SCM_STACKITEM *) (SCM_CHARS (stack) + sizeof (scm_contregs))
offset = ((SCM_STACKITEM *) ((char *) SCM_CONTREGS (stack) + sizeof (scm_contregs))
- SCM_BASE (stack));
#ifndef STACK_GROWS_UP
offset += SCM_LENGTH (stack);
@ -589,7 +589,7 @@ SCM_DEFINE (scm_last_stack_frame, "last-stack-frame", 1, 0, 0,
dframe = (scm_debug_frame *) SCM_DEBUGOBJ_FRAME (obj);
else if (scm_tc7_contin == SCM_TYP7 (obj))
{
offset = ((SCM_STACKITEM *) (SCM_CHARS (obj) + sizeof (scm_contregs))
offset = ((SCM_STACKITEM *) ((char *) SCM_CONTREGS (obj) + sizeof (scm_contregs))
- SCM_BASE (obj));
#ifndef STACK_GROWS_UP
offset += SCM_LENGTH (obj);

4
libguile/stime.c
View file

@ -461,7 +461,7 @@ bdtime2c (SCM sbd_time, struct tm *lt, int pos, const char *subr)
if (SCM_FALSEP (velts[10]))
lt->tm_zone = NULL;
else
lt->tm_zone = SCM_CHARS (velts[10]);
lt->tm_zone = SCM_STRING_CHARS (velts[10]);
#endif
}
@ -602,7 +602,7 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
SCM *velts = SCM_VELTS (stime);
int have_zone = 0;
if (SCM_NFALSEP (velts[10]) && *SCM_CHARS (velts[10]) != 0)
if (SCM_NFALSEP (velts[10]) && *SCM_STRING_CHARS (velts[10]) != 0)
{
/* it's not required that the TZ setting be correct, just that
it has the right name. so try something like TZ=EST0.

1
libguile/strings.h
View file

@ -52,6 +52,7 @@
#define SCM_STRINGP(x) (SCM_NIMP (x) && (SCM_TYP7S (x) == scm_tc7_string))
#define SCM_STRING_UCHARS(x) ((unsigned char *) (SCM_CELL_WORD_1 (x)))
#define SCM_STRING_CHARS(x) ((char *) (SCM_CELL_WORD_1 (x)))
/* Is X a writable string (i.e., not a substring)? */

2
libguile/strorder.c
View file

@ -46,6 +46,8 @@
#include <stdio.h>
#include "libguile/_scm.h"
#include "libguile/chars.h"
#include "libguile/strings.h"
#include "libguile/symbols.h"
#include "libguile/validate.h"
#include "libguile/strorder.h"

8
libguile/struct.c
View file

@ -151,7 +151,7 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
static void
scm_struct_init (SCM handle, SCM layout, scm_bits_t * mem, int tail_elts, SCM inits)
{
unsigned char * fields_desc = (unsigned char *) SCM_CHARS (layout) - 2;
unsigned char * fields_desc = (unsigned char *) SCM_SYMBOL_CHARS (layout) - 2;
unsigned char prot = 0;
int n_fields = SCM_LENGTH (layout) / 2;
int tailp = 0;
@ -259,7 +259,7 @@ SCM_DEFINE (scm_struct_vtable_p, "struct-vtable?", 1, 0, 0,
if (SCM_LENGTH (layout) < SCM_LENGTH (required_vtable_fields))
return SCM_BOOL_F;
if (strncmp (SCM_CHARS (layout), SCM_CHARS (required_vtable_fields),
if (strncmp (SCM_SYMBOL_CHARS (layout), SCM_STRING_CHARS (required_vtable_fields),
SCM_LENGTH (required_vtable_fields)))
return SCM_BOOL_F;
@ -577,7 +577,7 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
data = SCM_STRUCT_DATA (handle);
p = SCM_INUM (pos);
fields_desc = (unsigned char *) SCM_CHARS (layout);
fields_desc = SCM_SYMBOL_UCHARS (layout);
n_fields = data[scm_struct_i_n_words];
SCM_ASSERT_RANGE(1,pos, p < n_fields);
@ -654,7 +654,7 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
data = SCM_STRUCT_DATA (handle);
p = SCM_INUM (pos);
fields_desc = (unsigned char *)SCM_CHARS (layout);
fields_desc = SCM_SYMBOL_UCHARS (layout);
n_fields = data[scm_struct_i_n_words];
SCM_ASSERT_RANGE (1,pos, p < n_fields);

23
libguile/symbols.h
View file

@ -53,10 +53,11 @@
extern int scm_symhash_dim;
/* SCM_LENGTH(SYM) is the length of SYM's name in characters, and
* SCM_CHARS(SYM) is the address of the first character of SYM's name.
* SCM_SYMBOL_CHARS(SYM) is the address of the first character of SYM's name.
*/
#define SCM_SYMBOLP(x) (SCM_NIMP (x) && (SCM_TYP7 (x) == scm_tc7_symbol))
#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_LENGTH_MAX (0xffffffL)
@ -78,15 +79,18 @@ extern int scm_symhash_dim;
#define SCM_ROSTRINGP(x) (SCM_NIMP(x) && ((SCM_TYP7S(x)==scm_tc7_string) \
|| (SCM_TYP7(x) == scm_tc7_symbol)))
#define SCM_ROCHARS(x) ((char *)((SCM_TYP7(x) == scm_tc7_substring) \
? SCM_INUM (SCM_CADR (x)) + SCM_CHARS (SCM_CDDR (x)) \
: SCM_CHARS (x)))
#define SCM_ROUCHARS(x) ((unsigned char *) ((SCM_TYP7(x) == scm_tc7_substring) \
? SCM_INUM (SCM_CADR (x)) + SCM_UCHARS (SCM_CDDR (x))\
: SCM_UCHARS (x)))
#define SCM_ROCHARS(x) ((SCM_TYP7 (x) == scm_tc7_substring) \
? (SCM_INUM (SCM_CADR (x)) + SCM_STRING_CHARS (SCM_CDDR (x))) \
: ((SCM_TYP7 (x) == scm_tc7_string) \
? SCM_STRING_CHARS (x) \
: SCM_SYMBOL_CHARS (x)))
#define SCM_ROUCHARS(x) ((SCM_TYP7 (x) == scm_tc7_substring) \
? (SCM_INUM (SCM_CADR (x)) + SCM_STRING_UCHARS (SCM_CDDR (x))) \
: ((SCM_TYP7 (x) == scm_tc7_string) \
? SCM_STRING_UCHARS (x) \
: SCM_SYMBOL_UCHARS (x)))
#define SCM_ROLENGTH(x) SCM_LENGTH (x)
#define SCM_SLOPPY_SUBSTRP(x) (SCM_TYP7(x) == scm_tc7_substring)
#define SCM_SUBSTRP(x) (SCM_NIMP(x) && SCM_SLOPPY_SUBSTRP(x))
#define SCM_SUBSTRP(x) (SCM_NIMP (x) && (SCM_TYP7 (x) == scm_tc7_substring))
#define SCM_SUBSTR_STR(x) (SCM_CDDR (x))
#define SCM_SUBSTR_OFFSET(x) (SCM_CADR (x))
@ -133,6 +137,7 @@ extern void scm_init_symbols (void);
#if (SCM_DEBUG_DEPRECATED == 0)
#define SCM_SLOPPY_SUBSTRP(x) (SCM_SUBSTRP (x))
#define scm_strhash(str, len, n) (scm_string_hash ((str), (len)) % (n))
#endif /* SCM_DEBUG_DEPRECATED == 0 */

13
libguile/tags.h
View file

@ -210,7 +210,7 @@ typedef long scm_bits_t;
* gloc ..........SCM vcell..........001 ...........SCM cdr.............G
* struct ..........void * type........001 ...........void * data.........G
* closure ..........SCM code...........011 ...........SCM env.............G
* tc7 .........long length....Gxxxx1S1 ..........void *data............
* tc7 ......24.bits of data...Gxxxx1S1 ..........void *data............
*
*
*
@ -219,18 +219,11 @@ typedef long scm_bits_t;
* tc7_tags are 7 bit tags ending in 1x1. These tags
* occur only in the CAR of heap cells, and have the
* handy property that all bits of the CAR above the
* bottom eight can be used to store a length, thus
* bottom eight can be used to store some data, thus
* saving a word in the body itself. Thus, we use them
* for strings and vectors (among other things).
*
* SCM_LENGTH returns the bits in "length" (see the diagram).
* SCM_CHARS returns the data cast to "char *"
* SCM_CDR returns the data cast to "SCM"
* TYP7(X) returns bits 0...6 of SCM_CAR (X)
*
* For the interpretation of SCM_LENGTH and SCM_CHARS
* that applies to a particular type, see the header file
* for that type.
* TYP7(X) returns bits 0...6 of CELL_TYPE (X)
*
* Sometimes we choose the bottom seven bits carefully,
* so that the 2-valued bit (called S bit) can be masked