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

* Eliminated all remaining calls to SCM_CHARS.

Browse source
This commit is contained in:
Dirk Herrmann 2000-09-26 21:53:49 +00:00
parent 548b925289
commit 405aaef932
9 changed files with 103 additions and 49 deletions
Download patch file Download diff file Expand all files Collapse all files

30
libguile/ChangeLog
View file

@ -1,3 +1,33 @@
2000-09-26 Dirk Herrmann <D.Herrmann@tu-bs.de>
* gc.c (scm_gc_sweep): Replace SCM_CHARS by SCM_COMPLEX_MEM.
* numbers.h (SCM_COMPLEX_MEM): Added as a replacement for
SCM_CHARS.
(SCM_COMPLEX_REAL, SCM_COMPLEX_IMAG): Use it.
* ramap.c (scm_array_fill_int, racp, raeql_1): Replace SCM_CHARS
with SCM_STRING_CHARS or SCM_UVECTOR_BASE.
(racp): Fix: Make sure that src and dst types match.
* read.c (scm_grow_tok_buf, scm_lreadr, scm_read_token): Replace
SCM_CHARS with SCM_STRING_CHARS.
* symbols.h (SCM_CHARS): Deprecated.
* unif.c (scm_enclose_array, scm_uniform_vector_ref, scm_cvref,
scm_array_set_x, scm_uniform_array_read_x, rapr1, freera,
scm_uniform_array_write): Replace SCM_CHARS with
SCM_STRING_CHARS, SCM_UVECTOR_BASE or SCM_ARRAY_MEM.
* unif.h (SCM_ARRAY_MEM): Added as a replacement for SCM_CHARS.
(SCM_ARRAY_V, SCM_ARRAY_BASE, SCM_ARRAY_DIMS): Use it.
* validate.h (SCM_COERCE_ROSTRING): Removed.
2000-09-26 Dirk Herrmann <D.Herrmann@tu-bs.de>
* gc.c (scm_igc): : Eliminate references to SCM_LENGTH and

2
libguile/gc.c
View file

@ -1692,7 +1692,7 @@ scm_gc_sweep ()
#endif /* def SCM_BIGDIG */
case scm_tc16_complex:
m += sizeof (scm_complex_t);
scm_must_free (SCM_CHARS (scmptr));
scm_must_free (SCM_COMPLEX_MEM (scmptr));
break;
default:
{

5
libguile/numbers.h
View file

@ -134,8 +134,9 @@
#define SCM_COMPLEXP(x) (SCM_NIMP (x) && SCM_TYP16 (x) == scm_tc16_complex)
#define SCM_REAL_VALUE(x) (((scm_double_t *) SCM2PTR (x))->real)
#define SCM_COMPLEX_REAL(x) (((scm_complex_t *) SCM_CELL_WORD_1 (x))->real)
#define SCM_COMPLEX_IMAG(x) (((scm_complex_t *) SCM_CELL_WORD_1 (x))->imag)
#define SCM_COMPLEX_MEM(x) ((scm_complex_t *) SCM_CELL_WORD_1 (x))
#define SCM_COMPLEX_REAL(x) (SCM_COMPLEX_MEM (x)->real)
#define SCM_COMPLEX_IMAG(x) (SCM_COMPLEX_MEM (x)->imag)
/* Define SCM_BIGDIG to an integer type whose size is smaller than long if
* you want bignums. SCM_BIGRAD is one greater than the biggest SCM_BIGDIG.

33
libguile/ramap.c
View file

@ -53,6 +53,7 @@
#include <stdio.h>
#include "libguile/_scm.h"
#include "libguile/strings.h"
#include "libguile/unif.h"
#include "libguile/smob.h"
#include "libguile/chars.h"
@ -489,7 +490,7 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore)
case scm_tc7_string:
SCM_ASRTGO (SCM_CHARP (fill), badarg2);
for (i = base; n--; i += inc)
SCM_CHARS (ra)[i] = SCM_CHAR (fill);
SCM_STRING_CHARS (ra)[i] = SCM_CHAR (fill);
break;
case scm_tc7_byvect:
if (SCM_CHARP (fill))
@ -498,7 +499,7 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore)
&& -128 <= SCM_INUM (fill) && SCM_INUM (fill) < 128,
badarg2);
for (i = base; n--; i += inc)
SCM_CHARS (ra)[i] = SCM_INUM (fill);
((char *) SCM_UVECTOR_BASE (ra))[i] = SCM_INUM (fill);
break;
case scm_tc7_bvect:
{ /* scope */
@ -645,8 +646,7 @@ racp (SCM src, SCM dst)
if (SCM_EQ_P (src, dst))
return 1 ;
switch SCM_TYP7
(dst)
switch SCM_TYP7 (dst)
{
default:
gencase:
@ -657,14 +657,19 @@ racp (SCM src, SCM dst)
scm_array_set_x (dst, scm_cvref (src, i_s, SCM_UNDEFINED), SCM_MAKINUM (i_d));
break;
case scm_tc7_string:
case scm_tc7_byvect:
if (scm_tc7_string != SCM_TYP7 (dst))
if (SCM_TYP7 (src) != scm_tc7_string)
goto gencase;
for (; n-- > 0; i_s += inc_s, i_d += inc_d)
SCM_CHARS (dst)[i_d] = SCM_CHARS (src)[i_s];
SCM_STRING_CHARS (dst)[i_d] = SCM_STRING_CHARS (src)[i_s];
break;
case scm_tc7_byvect:
if (SCM_TYP7 (src) != scm_tc7_byvect)
goto gencase;
for (; n-- > 0; i_s += inc_s, i_d += inc_d)
((char *) SCM_UVECTOR_BASE (dst))[i_d] = ((char *) SCM_UVECTOR_BASE (src))[i_s];
break;
case scm_tc7_bvect:
if (scm_tc7_bvect != SCM_TYP7 (dst))
if (SCM_TYP7 (src) != scm_tc7_bvect)
goto gencase;
if (1 == inc_d && 1 == inc_s && i_s % SCM_LONG_BIT == i_d % SCM_LONG_BIT && n >= SCM_LONG_BIT)
{
@ -1797,10 +1802,18 @@ raeql_1 (SCM ra0,SCM as_equal,SCM ra1)
}
return 1;
case scm_tc7_string:
{
char *v0 = SCM_STRING_CHARS (ra0) + i0;
char *v1 = SCM_STRING_CHARS (ra1) + i1;
for (; n--; v0 += inc0, v1 += inc1)
if (*v0 != *v1)
return 0;
return 1;
}
case scm_tc7_byvect:
{
char *v0 = SCM_CHARS (ra0) + i0;
char *v1 = SCM_CHARS (ra1) + i1;
char *v0 = ((char *) SCM_UVECTOR_BASE (ra0)) + i0;
char *v1 = ((char *) SCM_UVECTOR_BASE (ra1)) + i1;
for (; n--; v0 += inc0, v1 += inc1)
if (*v0 != *v1)
return 0;

32
libguile/read.c
View file

@ -123,7 +123,7 @@ char *
scm_grow_tok_buf (SCM *tok_buf)
{
scm_vector_set_length_x (*tok_buf, SCM_MAKINUM (2 * SCM_LENGTH (*tok_buf)));
return SCM_CHARS (*tok_buf);
return SCM_STRING_CHARS (*tok_buf);
}
@ -365,7 +365,7 @@ tryagain_no_flush_ws:
#ifdef HAVE_ARRAYS
case '*':
j = scm_read_token (c, tok_buf, port, 0);
p = scm_istr2bve (SCM_CHARS (*tok_buf) + 1, (long) (j - 1));
p = scm_istr2bve (SCM_STRING_CHARS (*tok_buf) + 1, (long) (j - 1));
if (SCM_NFALSEP (p))
return p;
else
@ -374,7 +374,7 @@ tryagain_no_flush_ws:
case '{':
j = scm_read_token (c, tok_buf, port, 1);
p = scm_intern (SCM_CHARS (*tok_buf), j);
p = scm_intern (SCM_STRING_CHARS (*tok_buf), j);
return SCM_CAR (p);
case '\\':
@ -384,20 +384,20 @@ tryagain_no_flush_ws:
return SCM_MAKE_CHAR (c);
if (c >= '0' && c < '8')
{
p = scm_istr2int (SCM_CHARS (*tok_buf), (long) j, 8);
p = scm_istr2int (SCM_STRING_CHARS (*tok_buf), (long) j, 8);
if (SCM_NFALSEP (p))
return SCM_MAKE_CHAR (SCM_INUM (p));
}
for (c = 0; c < scm_n_charnames; c++)
if (scm_charnames[c]
&& (scm_casei_streq (scm_charnames[c], SCM_CHARS (*tok_buf))))
&& (scm_casei_streq (scm_charnames[c], SCM_STRING_CHARS (*tok_buf))))
return SCM_MAKE_CHAR (scm_charnums[c]);
scm_wta (SCM_UNDEFINED, "unknown # object: #\\", SCM_CHARS (*tok_buf));
scm_wta (SCM_UNDEFINED, "unknown # object: #\\", SCM_STRING_CHARS (*tok_buf));
/* #:SYMBOL is a syntax for keywords supported in all contexts. */
case ':':
j = scm_read_token ('-', tok_buf, port, 0);
p = scm_intern (SCM_CHARS (*tok_buf), j);
p = scm_intern (SCM_STRING_CHARS (*tok_buf), j);
return scm_make_keyword_from_dash_symbol (SCM_CAR (p));
default:
@ -464,15 +464,15 @@ tryagain_no_flush_ws:
c = '\v';
break;
}
SCM_CHARS (*tok_buf)[j] = c;
SCM_STRING_CHARS (*tok_buf)[j] = c;
++j;
}
if (j == 0)
return scm_nullstr;
SCM_CHARS (*tok_buf)[j] = 0;
SCM_STRING_CHARS (*tok_buf)[j] = 0;
{
SCM str;
str = scm_makfromstr (SCM_CHARS (*tok_buf), j, 0);
str = scm_makfromstr (SCM_STRING_CHARS (*tok_buf), j, 0);
return str;
}
@ -483,7 +483,7 @@ tryagain_no_flush_ws:
case '+':
num:
j = scm_read_token (c, tok_buf, port, 0);
p = scm_istring2number (SCM_CHARS (*tok_buf), (long) j, 10L);
p = scm_istring2number (SCM_STRING_CHARS (*tok_buf), (long) j, 10L);
if (SCM_NFALSEP (p))
return p;
if (c == '#')
@ -491,10 +491,10 @@ tryagain_no_flush_ws:
if ((j == 2) && (scm_getc (port) == '('))
{
scm_ungetc ('(', port);
c = SCM_CHARS (*tok_buf)[1];
c = SCM_STRING_CHARS (*tok_buf)[1];
goto callshrp;
}
scm_wta (SCM_UNDEFINED, "unknown # object", SCM_CHARS (*tok_buf));
scm_wta (SCM_UNDEFINED, "unknown # object", SCM_STRING_CHARS (*tok_buf));
}
goto tok;
@ -502,7 +502,7 @@ tryagain_no_flush_ws:
if (SCM_EQ_P (SCM_PACK (SCM_KEYWORD_STYLE), scm_keyword_prefix))
{
j = scm_read_token ('-', tok_buf, port, 0);
p = scm_intern (SCM_CHARS (*tok_buf), j);
p = scm_intern (SCM_STRING_CHARS (*tok_buf), j);
return scm_make_keyword_from_dash_symbol (SCM_CAR (p));
}
/* fallthrough */
@ -511,7 +511,7 @@ tryagain_no_flush_ws:
/* fallthrough */
tok:
p = scm_intern (SCM_CHARS (*tok_buf), j);
p = scm_intern (SCM_STRING_CHARS (*tok_buf), j);
return SCM_CAR (p);
}
}
@ -528,7 +528,7 @@ scm_read_token (int ic, SCM *tok_buf, SCM port, int weird)
register char *p;
c = (SCM_CASE_INSENSITIVE_P ? scm_downcase(ic) : ic);
p = SCM_CHARS (*tok_buf);
p = SCM_STRING_CHARS (*tok_buf);
if (weird)
j = 0;

2
libguile/symbols.h
View file

@ -64,7 +64,6 @@ extern int scm_symhash_dim;
#define SCM_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8)
#define SCM_SETLENGTH(x, v, t) (SCM_SET_CELL_WORD_0 ((x), ((v) << 8) + (t)))
#define SCM_CHARS(x) ((char *) (SCM_CELL_WORD_1 (x)))
#define SCM_UCHARS(x) ((unsigned char *) (SCM_CELL_WORD_1 (x)))
#define SCM_SETCHARS(x, v) (SCM_SET_CELL_WORD_1 ((x), (scm_bits_t) (v)))
@ -137,6 +136,7 @@ extern void scm_init_symbols (void);
#if (SCM_DEBUG_DEPRECATED == 0)
#define SCM_CHARS(x) ((char *) (SCM_CELL_WORD_1 (x)))
#define SCM_SLOPPY_SUBSTRP(x) (SCM_SUBSTRP (x))
#define scm_strhash(str, len, n) (scm_string_hash ((str), (len)) % (n))

36
libguile/unif.c
View file

@ -972,11 +972,11 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1,
SCM_ARRAY_DIMS (ra_inr)[k].lbnd = s[j].lbnd;
SCM_ARRAY_DIMS (ra_inr)[k].ubnd = s[j].ubnd;
SCM_ARRAY_DIMS (ra_inr)[k].inc = s[j].inc;
SCM_CHARS (axv)[j] = 1;
SCM_STRING_CHARS (axv)[j] = 1;
}
for (j = 0, k = 0; k < noutr; k++, j++)
{
while (SCM_CHARS (axv)[j])
while (SCM_STRING_CHARS (axv)[j])
j++;
SCM_ARRAY_DIMS (res)[k].lbnd = s[j].lbnd;
SCM_ARRAY_DIMS (res)[k].ubnd = s[j].ubnd;
@ -1140,7 +1140,7 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0,
case scm_tc7_string:
return SCM_MAKE_CHAR (SCM_UCHARS (v)[pos]);
case scm_tc7_byvect:
return SCM_MAKINUM (((char *)SCM_CHARS (v))[pos]);
return SCM_MAKINUM (((char *) SCM_UVECTOR_BASE (v))[pos]);
case scm_tc7_uvect:
return scm_ulong2num (((unsigned long *) SCM_VELTS (v))[pos]);
case scm_tc7_ivect:
@ -1185,7 +1185,7 @@ scm_cvref (SCM v, scm_sizet pos, SCM last)
case scm_tc7_string:
return SCM_MAKE_CHAR (SCM_UCHARS (v)[pos]);
case scm_tc7_byvect:
return SCM_MAKINUM (((char *)SCM_CHARS (v))[pos]);
return SCM_MAKINUM (((char *) SCM_UVECTOR_BASE (v))[pos]);
case scm_tc7_uvect:
return scm_ulong2num(((unsigned long *) SCM_VELTS (v))[pos]);
case scm_tc7_ivect:
@ -1300,7 +1300,7 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1,
if (SCM_CHARP (obj))
obj = SCM_MAKINUM ((char) SCM_CHAR (obj));
SCM_ASRTGO (SCM_INUMP (obj), badobj);
((char *)SCM_CHARS (v))[pos] = SCM_INUM (obj);
((char *) SCM_UVECTOR_BASE (v))[pos] = SCM_INUM (obj);
break;
case scm_tc7_uvect:
SCM_VELTS(v)[pos] = SCM_PACK (scm_num2ulong(obj, (char *)SCM_ARG2, FUNC_NAME));
@ -1475,6 +1475,7 @@ SCM_DEFINE (scm_uniform_array_read_x, "uniform-array-read!", 1, 3, 0,
long cstart = 0;
long cend;
long offset = 0;
char *base;
SCM_ASRTGO (SCM_NIMP (v), badarg1);
if (SCM_UNBNDP (port_or_fd))
@ -1527,7 +1528,12 @@ loop:
sz = 2 * sizeof (double);
break;
}
if (SCM_STRINGP (v))
base = SCM_STRING_CHARS (v);
else
base = (char *) SCM_UVECTOR_BASE (v);
cend = vlen;
if (!SCM_UNBNDP (start))
{
@ -1552,7 +1558,7 @@ loop:
{
scm_port *pt = SCM_PTAB_ENTRY (port_or_fd);
int remaining = (cend - offset) * sz;
char *dest = SCM_CHARS (v) + (cstart + offset) * sz;
char *dest = base + (cstart + offset) * sz;
if (pt->rw_active == SCM_PORT_WRITE)
scm_flush (port_or_fd);
@ -1590,7 +1596,7 @@ loop:
else /* file descriptor. */
{
SCM_SYSCALL (ans = read (SCM_INUM (port_or_fd),
SCM_CHARS (v) + (cstart + offset) * sz,
base + (cstart + offset) * sz,
(scm_sizet) (sz * (cend - offset))));
if (ans == -1)
SCM_SYSERROR;
@ -1623,6 +1629,7 @@ SCM_DEFINE (scm_uniform_array_write, "uniform-array-write", 1, 3, 0,
long offset = 0;
long cstart = 0;
long cend;
char *base;
port_or_fd = SCM_COERCE_OUTPORT (port_or_fd);
@ -1678,6 +1685,11 @@ loop:
break;
}
if (SCM_STRINGP (v))
base = SCM_STRING_CHARS (v);
else
base = (char *) SCM_UVECTOR_BASE (v);
cend = vlen;
if (!SCM_UNBNDP (start))
{
@ -1700,7 +1712,7 @@ loop:
if (SCM_NIMP (port_or_fd))
{
char *source = SCM_CHARS (v) + (cstart + offset) * sz;
char *source = base + (cstart + offset) * sz;
ans = cend - offset;
scm_lfwrite (source, ans * sz, port_or_fd);
@ -1708,7 +1720,7 @@ loop:
else /* file descriptor. */
{
SCM_SYSCALL (ans = write (SCM_INUM (port_or_fd),
SCM_CHARS (v) + (cstart + offset) * sz,
base + (cstart + offset) * sz,
(scm_sizet) (sz * (cend - offset))));
if (ans == -1)
SCM_SYSERROR;
@ -2298,7 +2310,7 @@ tail:
}
else
for (j += inc; n-- > 0; j += inc)
scm_putc (SCM_CHARS (ra)[j], port);
scm_putc (SCM_STRING_CHARS (ra)[j], port);
break;
case scm_tc7_byvect:
if (n-- > 0)
@ -2554,7 +2566,7 @@ markra (SCM ptr)
static scm_sizet
freera (SCM ptr)
{
scm_must_free (SCM_CHARS (ptr));
scm_must_free (SCM_ARRAY_MEM (ptr));
return sizeof (scm_array) + SCM_ARRAY_NDIM (ptr) * sizeof (scm_array_dim);
}

7
libguile/unif.h
View file

@ -81,9 +81,10 @@ extern long scm_tc16_array;
#define SCM_ARRAY_CONTIGUOUS 0x10000
#define SCM_ARRAY_CONTP(x) (SCM_ARRAY_CONTIGUOUS & (SCM_CELL_WORD_0 (x)))
#define SCM_ARRAY_V(a) (((scm_array *) SCM_CELL_WORD_1 (a))->v)
#define SCM_ARRAY_BASE(a) (((scm_array *) SCM_CELL_WORD_1 (a))->base)
#define SCM_ARRAY_DIMS(a) ((scm_array_dim *)(SCM_CHARS(a)+sizeof(scm_array)))
#define SCM_ARRAY_MEM(a) ((scm_array *) SCM_CELL_WORD_1 (a))
#define SCM_ARRAY_V(a) (SCM_ARRAY_MEM (a)->v)
#define SCM_ARRAY_BASE(a) (SCM_ARRAY_MEM (a)->base)
#define SCM_ARRAY_DIMS(a) ((scm_array_dim *)((char *) SCM_ARRAY_MEM (a) + sizeof (scm_array)))
#define SCM_UVECTOR_BASE(x) ((void *) (SCM_CELL_WORD_1 (x)))

5
libguile/validate.h
View file

@ -1,4 +1,4 @@
/* $Id: validate.h,v 1.15 2000-09-22 17:17:55 dirk Exp $ */
/* $Id: validate.h,v 1.16 2000-09-26 21:53:49 dirk Exp $ */
/* Copyright (C) 1999, 2000 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
@ -54,9 +54,6 @@
#define SCM_SYSERROR_MSG(str, args, val) \
do { scm_syserror_msg (FUNC_NAME, (str), (args), (val)); } while (0)
#define SCM_COERCE_ROSTRING(pos, scm) \
do { scm = scm_coerce_rostring (scm, FUNC_NAME, pos); } while (0)
#define SCM_WTA(pos, scm) \
do { scm_wta (scm, (char *) pos, FUNC_NAME); } while (0)