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

Lots of fixes with respect to strict typing.

Browse source
This commit is contained in:
Dirk Herrmann 2000-04-04 12:13:41 +00:00
parent 304b56da60
commit 4260a7fced
17 changed files with 165 additions and 119 deletions
Download patch file Download diff file Expand all files Collapse all files

46
libguile/ChangeLog
View file

@ -1,3 +1,49 @@
2000-04-04 Dirk Herrmann <D.Herrmann@tu-bs.de>
* debug.c (scm_procedure_source, scm_procedure_environment),
gsubr.c (scm_make_gsubr_with_generic, scm_gsubr_apply), procs.c
(scm_procedure, scm_setter): Return valid scheme value as dummy.
* filesys.c (scm_readdir, scm_rewinddir, scm_closedir,
scm_dir_print, scm_dir_free), numbers.h (SCM_COMPLEX_REAL,
SCM_COMPLEX_IMAG), regex-posix.h (SCM_RGX), throw.c (JBJMPBUF,
SETJBJMPBUF, JBJMPBUF, SETJBJMPBUF, freejb, print_lazy_catch,
scm_ithrow), unif.c (scm_uniform_vector_ref, scm_cvref,
scm_array_set_x, rapr1), unif.h (SCM_ARRAY_V, SCM_ARRAY_BASE),
vectors.h (SCM_VELTS, SCM_VELTS_AS_STACKITEMS, SCM_SETVELTS): Use
SCM_{SET_}?CELL_WORD* to access cell entries with raw data.
* filesys.c (scm_closedir), numbers.c (scm_addbig), numbers.h
(SCM_SETNUMDIGS), throw.c (JBACTIVE, SCM_JBDFRAME,
SCM_SETJBDFRAME): Read and modify data bits in cell entry #0 using
SCM_{SET_}?CELL_WORD_0.
* filesys.c (fill_select_type, retrieve_select_type, scm_select),
numbers.c (scm_gcd, scm_lcm, scm_integer_expt, scm_zero_p,
scm_product, scm_divide), posix.c (scm_getgrgid), ramap.c
(scm_array_fill_int, racp), throw.c (scm_catch, scm_lazy_catch,
scm_ithrow), unif.c (scm_make_uve, scm_array_p,
scm_transpose_array, scm_array_set_x, scm_bit_set_star_x,
scm_bit_count_star, l2ra), variable.c (prin_var,
scm_make_variable, scm_make_undefined_variable,
scm_builtin_variable), vectors.c (scm_vector_set_length_x),
vports.c (sf_flush, sf_close): Don't use C operators to compare
SCM values.
* numbers.c (scm_odd_p, scm_even_p), variable.c (prin_var): Must
unpack SCM values to access their raw contents.
* numbers.c (big2str): Eliminate unnecessary casts to SCM.
* numbers.h (SCM_NEWREAL), regex-posix.h (SCM_RGXP), vports.c
(scm_make_soft_port): Use SCM_{SET_}?CELL_TYPE to access the cell
type information.
* throw.c (printjb): Eliminated unnecessary unpack.
* variable.c (make_vcell_variable): Smob data is of type
scm_bits_t.
2000-04-04 Mikael Djurfeldt <mdj@mdj.nada.kth.se> 2000-04-04 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
* print.c: Removed promise to rewrite printer code before next * print.c: Removed promise to rewrite printer code before next

4
libguile/debug.c
View file

@ -440,7 +440,7 @@ SCM_DEFINE (scm_procedure_source, "procedure-source", 1, 0, 0,
return scm_procedure_property (proc, scm_sym_source); return scm_procedure_property (proc, scm_sym_source);
default: default:
SCM_WTA(1,proc); SCM_WTA(1,proc);
return 0; return SCM_BOOL_F;
} }
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -462,7 +462,7 @@ SCM_DEFINE (scm_procedure_environment, "procedure-environment", 1, 0, 0,
return SCM_EOL; return SCM_EOL;
default: default:
SCM_WTA(1,proc); SCM_WTA(1,proc);
return 0; return SCM_BOOL_F;
} }
} }
#undef FUNC_NAME #undef FUNC_NAME

18
libguile/filesys.c
View file

@ -697,7 +697,7 @@ SCM_DEFINE (scm_readdir, "readdir", 1, 0, 0,
struct dirent *rdent; struct dirent *rdent;
SCM_VALIDATE_OPDIR (1,port); SCM_VALIDATE_OPDIR (1,port);
errno = 0; errno = 0;
SCM_SYSCALL (rdent = readdir ((DIR *) SCM_CDR (port))); SCM_SYSCALL (rdent = readdir ((DIR *) SCM_CELL_WORD_1 (port)));
if (errno != 0) if (errno != 0)
SCM_SYSERROR; SCM_SYSERROR;
return (rdent ? scm_makfromstr (rdent->d_name, NAMLEN (rdent), 0) return (rdent ? scm_makfromstr (rdent->d_name, NAMLEN (rdent), 0)
@ -714,7 +714,7 @@ SCM_DEFINE (scm_rewinddir, "rewinddir", 1, 0, 0,
#define FUNC_NAME s_scm_rewinddir #define FUNC_NAME s_scm_rewinddir
{ {
SCM_VALIDATE_OPDIR (1,port); SCM_VALIDATE_OPDIR (1,port);
rewinddir ((DIR *) SCM_CDR (port)); rewinddir ((DIR *) SCM_CELL_WORD_1 (port));
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -734,10 +734,10 @@ SCM_DEFINE (scm_closedir, "closedir", 1, 0, 0,
{ {
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
SCM_SYSCALL (sts = closedir ((DIR *) SCM_CDR (port))); SCM_SYSCALL (sts = closedir ((DIR *) SCM_CELL_WORD_1 (port)));
if (sts != 0) if (sts != 0)
SCM_SYSERROR; SCM_SYSERROR;
SCM_SETCAR (port, scm_tc16_dir); SCM_SET_CELL_WORD_0 (port, scm_tc16_dir);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -752,7 +752,7 @@ scm_dir_print (SCM exp, SCM port, scm_print_state *pstate)
if (SCM_CLOSEDP (exp)) if (SCM_CLOSEDP (exp))
scm_puts ("closed: ", port); scm_puts ("closed: ", port);
scm_puts ("directory stream ", port); scm_puts ("directory stream ", port);
scm_intprint ((int)SCM_CDR (exp), 16, port); scm_intprint (SCM_CELL_WORD_1 (exp), 16, port);
scm_putc ('>', port); scm_putc ('>', port);
return 1; return 1;
} }
@ -762,7 +762,7 @@ static scm_sizet
scm_dir_free (SCM p) scm_dir_free (SCM p)
{ {
if (SCM_OPENP (p)) if (SCM_OPENP (p))
closedir ((DIR *) SCM_CDR (p)); closedir ((DIR *) SCM_CELL_WORD_1 (p));
return 0; return 0;
} }
@ -890,7 +890,7 @@ fill_select_type (SELECT_TYPE *set, SCM *ports_ready, SCM list_or_vec, int pos)
} }
else else
{ {
while (list_or_vec != SCM_EOL) while (!SCM_NULLP (list_or_vec))
{ {
int fd = set_element (set, ports_ready, SCM_CAR (list_or_vec), pos); int fd = set_element (set, ports_ready, SCM_CAR (list_or_vec), pos);
@ -950,7 +950,7 @@ retrieve_select_type (SELECT_TYPE *set, SCM ports_ready, SCM list_or_vec)
else else
{ {
/* list_or_vec must be a list. */ /* list_or_vec must be a list. */
while (list_or_vec != SCM_EOL) while (!SCM_NULLP (list_or_vec))
{ {
answer_list = get_element (set, SCM_CAR (list_or_vec), answer_list); answer_list = get_element (set, SCM_CAR (list_or_vec), answer_list);
list_or_vec = SCM_CDR (list_or_vec); list_or_vec = SCM_CDR (list_or_vec);
@ -1053,7 +1053,7 @@ SCM_DEFINE (scm_select, "select", 3, 2, 0,
/* if there's a port with a ready buffer, don't block, just /* if there's a port with a ready buffer, don't block, just
check for ready file descriptors. */ check for ready file descriptors. */
if (read_ports_ready != SCM_EOL || write_ports_ready != SCM_EOL) if (!SCM_NULLP (read_ports_ready) || !SCM_NULLP (write_ports_ready))
{ {
timeout.tv_sec = 0; timeout.tv_sec = 0;
timeout.tv_usec = 0; timeout.tv_usec = 0;

4
libguile/gsubr.c
View file

@ -126,7 +126,7 @@ scm_make_gsubr_with_generic (const char *name,
scm_misc_error ("scm_make_gsubr_with_generic", scm_misc_error ("scm_make_gsubr_with_generic",
"can't make primitive-generic with this arity", "can't make primitive-generic with this arity",
SCM_EOL); SCM_EOL);
return 0; /* never reached */ return SCM_BOOL_F; /* never reached */
} }
@ -174,7 +174,7 @@ scm_gsubr_apply (SCM args)
case 9: return (*fcn)(v[0], v[1], v[2], v[3], v[4], v[5], v[6], v[7], v[8]); case 9: return (*fcn)(v[0], v[1], v[2], v[3], v[4], v[5], v[6], v[7], v[8]);
case 10: return (*fcn)(v[0], v[1], v[2], v[3], v[4], v[5], v[6], v[7], v[8], v[9]); case 10: return (*fcn)(v[0], v[1], v[2], v[3], v[4], v[5], v[6], v[7], v[8], v[9]);
} }
return 0; /* Never reached. */ return SCM_BOOL_F; /* Never reached. */
} }

26
libguile/numbers.c
View file

@ -106,7 +106,7 @@ SCM_DEFINE (scm_odd_p, "odd?", 1, 0, 0,
#else #else
SCM_VALIDATE_INUM (1,n); SCM_VALIDATE_INUM (1,n);
#endif #endif
return SCM_BOOL(4 & (int) n); return SCM_BOOL(4 & SCM_UNPACK (n));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -124,7 +124,7 @@ SCM_DEFINE (scm_even_p, "even?", 1, 0, 0,
#else #else
SCM_VALIDATE_INUM (1,n); SCM_VALIDATE_INUM (1,n);
#endif #endif
return SCM_NEGATE_BOOL(4 & (int) n); return SCM_NEGATE_BOOL(4 & SCM_UNPACK (n));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -400,7 +400,7 @@ scm_gcd (SCM x, SCM y)
/* instead of the switch, we could just /* instead of the switch, we could just
return scm_gcd (y, scm_modulo (x, y)); */ return scm_gcd (y, scm_modulo (x, y)); */
} }
if (SCM_INUM0 == y) if (SCM_EQ_P (y, SCM_INUM0))
return x; return x;
goto swaprec; goto swaprec;
} }
@ -485,7 +485,7 @@ scm_lcm (SCM n1, SCM n2)
} }
d = scm_gcd (n1, n2); d = scm_gcd (n1, n2);
if (SCM_INUM0 == d) if (SCM_EQ_P (d, SCM_INUM0))
return d; return d;
return scm_abs (scm_product (n1, scm_quotient (n2, d))); return scm_abs (scm_product (n1, scm_quotient (n2, d)));
} }
@ -1026,10 +1026,10 @@ SCM_DEFINE (scm_integer_expt, "integer-expt", 2, 0, 0,
SCM acc = SCM_MAKINUM (1L); SCM acc = SCM_MAKINUM (1L);
int i2; int i2;
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
if (SCM_INUM0 == n || acc == n) if (SCM_EQ_P (n, SCM_INUM0) || SCM_EQ_P (n, acc))
return n; return n;
else if (SCM_MAKINUM (-1L) == n) else if (SCM_EQ_P (n, SCM_MAKINUM (-1L)))
return SCM_BOOL_F == scm_even_p (k) ? n : acc; return SCM_FALSEP (scm_even_p (k)) ? n : acc;
#endif #endif
SCM_VALIDATE_ULONG_COPY (2,k,i2); SCM_VALIDATE_ULONG_COPY (2,k,i2);
if (i2 < 0) if (i2 < 0)
@ -1557,7 +1557,7 @@ scm_addbig (SCM_BIGDIG *x, scm_sizet nx, int xsgn, SCM bigy, int sgny)
{ {
num = 1; num = 1;
i = 0; i = 0;
SCM_SETCAR (z, SCM_UNPACK_CAR (z) ^ SCM_BIGSIGNFLAG); SCM_SET_CELL_WORD_0 (z, SCM_CELL_WORD_0 (z) ^ SCM_BIGSIGNFLAG);
do do
{ {
num += (SCM_BIGRAD - 1) - zds[i]; num += (SCM_BIGRAD - 1) - zds[i];
@ -2147,7 +2147,7 @@ big2str (SCM b, unsigned int radix)
for (i = j; j < SCM_LENGTH (ss); j++) for (i = j; j < SCM_LENGTH (ss); j++)
s[ch + j - i] = s[j]; /* jeh */ s[ch + j - i] = s[j]; /* jeh */
scm_vector_set_length_x (ss, /* jeh */ scm_vector_set_length_x (ss, /* jeh */
(SCM) SCM_MAKINUM (ch + SCM_LENGTH (ss) - i)); SCM_MAKINUM (ch + SCM_LENGTH (ss) - i));
} }
return scm_return_first (ss, t); return scm_return_first (ss, t);
@ -3110,7 +3110,7 @@ scm_zero_p (SCM z)
return SCM_BOOL (SCM_COMPLEX_REAL (z) == 0.0 return SCM_BOOL (SCM_COMPLEX_REAL (z) == 0.0
&& SCM_COMPLEX_IMAG (z) == 0.0); && SCM_COMPLEX_IMAG (z) == 0.0);
} }
return SCM_BOOL(z == SCM_INUM0); return SCM_BOOL (SCM_EQ_P (z, SCM_INUM0));
} }
@ -3721,9 +3721,9 @@ scm_product (SCM x, SCM y)
if (SCM_BIGP (y)) if (SCM_BIGP (y))
{ {
intbig: intbig:
if (SCM_INUM0 == x) if (SCM_EQ_P (x, SCM_INUM0))
return x; return x;
if (SCM_MAKINUM (1L) == x) if (SCM_EQ_P (x, SCM_MAKINUM (1L)))
return y; return y;
{ {
#ifndef SCM_DIGSTOOBIG #ifndef SCM_DIGSTOOBIG
@ -3931,7 +3931,7 @@ scm_divide (SCM x, SCM y)
} }
if (SCM_UNBNDP (y)) if (SCM_UNBNDP (y))
{ {
if ((SCM_MAKINUM (1L) == x) || (SCM_MAKINUM (-1L) == x)) if (SCM_EQ_P (x, SCM_MAKINUM (1L)) || SCM_EQ_P (x, SCM_MAKINUM (-1L)))
return x; return x;
return scm_makdbl (1.0 / ((double) SCM_INUM (x)), 0.0); return scm_makdbl (1.0 / ((double) SCM_INUM (x)), 0.0);
} }

8
libguile/numbers.h
View file

@ -156,7 +156,7 @@
#define SCM_NEWREAL(z, x) \ #define SCM_NEWREAL(z, x) \
do { \ do { \
SCM_NEWCELL2 (z); \ SCM_NEWCELL2 (z); \
SCM_SETCAR (z, scm_tc16_real); \ SCM_SET_CELL_TYPE (z, scm_tc16_real); \
SCM_REAL_VALUE (z) = (x); \ SCM_REAL_VALUE (z) = (x); \
} while (0) \ } while (0) \
@ -185,8 +185,8 @@
#define SCM_CPLXP(x) SCM_COMPLEXP(x) /* Deprecated */ #define SCM_CPLXP(x) SCM_COMPLEXP(x) /* Deprecated */
#define SCM_REAL_VALUE(x) (((scm_double_t *) SCM2PTR (x))->real) #define SCM_REAL_VALUE(x) (((scm_double_t *) SCM2PTR (x))->real)
#define SCM_COMPLEX_REAL(x) (((scm_complex_t *) SCM_UNPACK (SCM_CDR (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_UNPACK (SCM_CDR (x)))->imag) #define SCM_COMPLEX_IMAG(x) (((scm_complex_t *) SCM_CELL_WORD_1 (x))->imag)
#define SCM_REAL(x) \ #define SCM_REAL(x) \
(SCM_SLOPPY_REALP (x) \ (SCM_SLOPPY_REALP (x) \
? SCM_REAL_VALUE (x) \ ? SCM_REAL_VALUE (x) \
@ -260,7 +260,7 @@
#define SCM_BDIGITS(x) ((SCM_BIGDIG *) SCM_UNPACK (SCM_CDR (x))) #define SCM_BDIGITS(x) ((SCM_BIGDIG *) SCM_UNPACK (SCM_CDR (x)))
#define SCM_NUMDIGS(x) ((scm_sizet) (SCM_UNPACK_CAR (x) >> SCM_BIGSIZEFIELD)) #define SCM_NUMDIGS(x) ((scm_sizet) (SCM_UNPACK_CAR (x) >> SCM_BIGSIZEFIELD))
#define SCM_SETNUMDIGS(x, v, sign) \ #define SCM_SETNUMDIGS(x, v, sign) \
SCM_SETCAR (x, \ SCM_SET_CELL_WORD_0 (x, \
scm_tc16_big \ scm_tc16_big \
| ((sign) ? SCM_BIGSIGNFLAG : 0) \ | ((sign) ? SCM_BIGSIGNFLAG : 0) \
| (((v) + 0L) << SCM_BIGSIZEFIELD)) | (((v) + 0L) << SCM_BIGSIZEFIELD))

2
libguile/posix.c
View file

@ -322,7 +322,7 @@ SCM_DEFINE (scm_getgrgid, "getgr", 0, 1, 0,
SCM *ve; SCM *ve;
result = scm_make_vector (SCM_MAKINUM (4), SCM_UNSPECIFIED); result = scm_make_vector (SCM_MAKINUM (4), SCM_UNSPECIFIED);
ve = SCM_VELTS (result); ve = SCM_VELTS (result);
if (SCM_UNBNDP (name) || (name == SCM_BOOL_F)) if (SCM_UNBNDP (name) || SCM_FALSEP (name))
{ {
SCM_SYSCALL (entry = getgrent ()); SCM_SYSCALL (entry = getgrent ());
if (! entry) if (! entry)

4
libguile/procs.c
View file

@ -341,7 +341,7 @@ SCM_DEFINE (scm_procedure, "procedure", 1, 0, 0,
return proc; return proc;
} }
SCM_WRONG_TYPE_ARG (1, proc); SCM_WRONG_TYPE_ARG (1, proc);
return 0; /* not reached */ return SCM_BOOL_F; /* not reached */
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -366,7 +366,7 @@ scm_setter (SCM proc)
/* fall through */ /* fall through */
} }
SCM_WTA_DISPATCH_1 (g_setter, proc, SCM_ARG1, s_setter); SCM_WTA_DISPATCH_1 (g_setter, proc, SCM_ARG1, s_setter);
return 0; return SCM_BOOL_F;
} }

10
libguile/ramap.c
View file

@ -506,7 +506,7 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore)
if (1 == inc && (n >= SCM_LONG_BIT || n == SCM_LENGTH (ra))) if (1 == inc && (n >= SCM_LONG_BIT || n == SCM_LENGTH (ra)))
{ {
i = base / SCM_LONG_BIT; i = base / SCM_LONG_BIT;
if (SCM_BOOL_F == fill) if (SCM_FALSEP (fill))
{ {
if (base % SCM_LONG_BIT) /* leading partial word */ if (base % SCM_LONG_BIT) /* leading partial word */
ve[i++] &= ~(~0L << (base % SCM_LONG_BIT)); ve[i++] &= ~(~0L << (base % SCM_LONG_BIT));
@ -515,7 +515,7 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore)
if ((base + n) % SCM_LONG_BIT) /* trailing partial word */ if ((base + n) % SCM_LONG_BIT) /* trailing partial word */
ve[i] &= (~0L << ((base + n) % SCM_LONG_BIT)); ve[i] &= (~0L << ((base + n) % SCM_LONG_BIT));
} }
else if (SCM_BOOL_T == fill) else if (SCM_TRUE_P (fill))
{ {
if (base % SCM_LONG_BIT) if (base % SCM_LONG_BIT)
ve[i++] |= ~0L << (base % SCM_LONG_BIT); ve[i++] |= ~0L << (base % SCM_LONG_BIT);
@ -529,10 +529,10 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore)
} }
else else
{ {
if (SCM_BOOL_F == fill) if (SCM_FALSEP (fill))
for (i = base; n--; i += inc) for (i = base; n--; i += inc)
ve[i / SCM_LONG_BIT] &= ~(1L << (i % SCM_LONG_BIT)); ve[i / SCM_LONG_BIT] &= ~(1L << (i % SCM_LONG_BIT));
else if (SCM_BOOL_T == fill) else if (SCM_TRUE_P (fill))
for (i = base; n--; i += inc) for (i = base; n--; i += inc)
ve[i / SCM_LONG_BIT] |= (1L << (i % SCM_LONG_BIT)); ve[i / SCM_LONG_BIT] |= (1L << (i % SCM_LONG_BIT));
else else
@ -637,7 +637,7 @@ racp (SCM src, SCM dst)
ugly UNICOS macros (IVDEP) to go . ugly UNICOS macros (IVDEP) to go .
*/ */
if (src == dst) if (SCM_EQ_P (src, dst))
return 1 ; return 1 ;
switch SCM_TYP7 switch SCM_TYP7

4
libguile/regex-posix.h
View file

@ -51,8 +51,8 @@
#include "libguile/__scm.h" #include "libguile/__scm.h"
extern long scm_tc16_regex; extern long scm_tc16_regex;
#define SCM_RGX(X) ((regex_t *) SCM_CDR(X)) #define SCM_RGX(X) ((regex_t *) SCM_CELL_WORD_1 (X))
#define SCM_RGXP(X) (SCM_NIMP(X) && (SCM_CAR (X) == (SCM) scm_tc16_regex)) #define SCM_RGXP(X) (SCM_NIMP (X) && (SCM_CELL_TYPE (X) == scm_tc16_regex))
extern SCM scm_make_regexp (SCM pat, SCM flags); extern SCM scm_make_regexp (SCM pat, SCM flags);
SCM scm_regexp_p (SCM x); SCM scm_regexp_p (SCM x);

34
libguile/throw.c
View file

@ -70,23 +70,23 @@ static int scm_tc16_jmpbuffer;
#define SCM_JMPBUFP(OBJ) (SCM_NIMP(OBJ) && (SCM_TYP16(OBJ) == scm_tc16_jmpbuffer)) #define SCM_JMPBUFP(OBJ) (SCM_NIMP(OBJ) && (SCM_TYP16(OBJ) == scm_tc16_jmpbuffer))
#define JBACTIVE(OBJ) (SCM_UNPACK_CAR (OBJ) & (1L << 16L)) #define JBACTIVE(OBJ) (SCM_CELL_WORD_0 (OBJ) & (1L << 16L))
#define ACTIVATEJB(OBJ) (SCM_SETOR_CAR (OBJ, (1L << 16L))) #define ACTIVATEJB(OBJ) (SCM_SETOR_CAR (OBJ, (1L << 16L)))
#define DEACTIVATEJB(OBJ) (SCM_SETAND_CAR (OBJ, ~(1L << 16L))) #define DEACTIVATEJB(OBJ) (SCM_SETAND_CAR (OBJ, ~(1L << 16L)))
#ifndef DEBUG_EXTENSIONS #ifndef DEBUG_EXTENSIONS
#define JBJMPBUF(OBJ) ((jmp_buf*)SCM_CDR (OBJ) ) #define JBJMPBUF(OBJ) ((jmp_buf *) SCM_CELL_WORD_1 (OBJ))
#define SETJBJMPBUF SCM_SETCDR #define SETJBJMPBUF(x,v) (SCM_SET_CELL_WORD_1 ((x), (v)))
#else #else
#define SCM_JBDFRAME(OBJ) ((scm_debug_frame*)SCM_CAR (SCM_CDR (OBJ)) ) #define SCM_JBDFRAME(x) ((scm_debug_frame *) SCM_CELL_WORD_0 (SCM_CDR (x)))
#define JBJMPBUF(OBJ) ((jmp_buf*)SCM_CDR (SCM_CDR (OBJ)) ) #define JBJMPBUF(OBJ) ((jmp_buf *) SCM_CELL_WORD_1 (SCM_CDR (OBJ)))
#define SCM_SETJBDFRAME(OBJ,X) SCM_SETCAR (SCM_CDR (OBJ), (SCM)(X)) #define SCM_SETJBDFRAME(OBJ,X) (SCM_SET_CELL_WORD_0 (SCM_CDR (OBJ), (X)))
#define SETJBJMPBUF(OBJ,X) SCM_SETCDR(SCM_CDR (OBJ), X) #define SETJBJMPBUF(OBJ,X) (SCM_SET_CELL_WORD_1 (SCM_CDR (OBJ), (X)))
static scm_sizet static scm_sizet
freejb (SCM jbsmob) freejb (SCM jbsmob)
{ {
scm_must_free ((char *) SCM_CDR (jbsmob)); scm_must_free ((char *) SCM_CELL_WORD_1 (jbsmob));
return sizeof (scm_cell); return sizeof (scm_cell);
} }
#endif #endif
@ -96,7 +96,7 @@ printjb (SCM exp, SCM port, scm_print_state *pstate)
{ {
scm_puts ("#<jmpbuffer ", port); scm_puts ("#<jmpbuffer ", port);
scm_puts (JBACTIVE(exp) ? "(active) " : "(inactive) ", port); scm_puts (JBACTIVE(exp) ? "(active) " : "(inactive) ", port);
scm_intprint(SCM_UNPACK ( JBJMPBUF(exp) ), 16, port); scm_intprint((long) JBJMPBUF (exp), 16, port);
scm_putc ('>', port); scm_putc ('>', port);
return 1 ; return 1 ;
@ -253,7 +253,7 @@ struct lazy_catch {
static int static int
print_lazy_catch (SCM closure, SCM port, scm_print_state *pstate) print_lazy_catch (SCM closure, SCM port, scm_print_state *pstate)
{ {
struct lazy_catch *c = (struct lazy_catch *) SCM_CDR (closure); struct lazy_catch *c = (struct lazy_catch *) SCM_CELL_WORD_1 (closure);
char buf[200]; char buf[200];
sprintf (buf, "#<lazy-catch 0x%lx 0x%lx>", sprintf (buf, "#<lazy-catch 0x%lx 0x%lx>",
@ -546,7 +546,7 @@ SCM_DEFINE (scm_catch, "catch", 3, 0, 0,
{ {
struct scm_body_thunk_data c; struct scm_body_thunk_data c;
SCM_ASSERT (SCM_SYMBOLP(tag) || tag == SCM_BOOL_T, SCM_ASSERT (SCM_SYMBOLP(tag) || SCM_TRUE_P (tag),
tag, SCM_ARG1, FUNC_NAME); tag, SCM_ARG1, FUNC_NAME);
c.tag = tag; c.tag = tag;
@ -571,7 +571,7 @@ SCM_DEFINE (scm_lazy_catch, "lazy-catch", 3, 0, 0,
{ {
struct scm_body_thunk_data c; struct scm_body_thunk_data c;
SCM_ASSERT (SCM_SYMBOLP(tag) || (tag == SCM_BOOL_T), SCM_ASSERT (SCM_SYMBOLP(tag) || SCM_TRUE_P (tag),
tag, SCM_ARG1, FUNC_NAME); tag, SCM_ARG1, FUNC_NAME);
c.tag = tag; c.tag = tag;
@ -629,7 +629,7 @@ scm_ithrow (SCM key, SCM args, int noreturn)
{ {
SCM this_key = SCM_CAR (dynpair); SCM this_key = SCM_CAR (dynpair);
if (this_key == SCM_BOOL_T || this_key == key) if (SCM_TRUE_P (this_key) || SCM_EQ_P (this_key, key))
break; break;
} }
} }
@ -637,14 +637,14 @@ scm_ithrow (SCM key, SCM args, int noreturn)
/* If we didn't find anything, abort. scm_boot_guile should /* If we didn't find anything, abort. scm_boot_guile should
have established a catch-all, but obviously things are have established a catch-all, but obviously things are
thoroughly screwed up. */ thoroughly screwed up. */
if (winds == SCM_EOL) if (SCM_NULLP (winds))
abort (); abort ();
/* If the wind list is malformed, bail. */ /* If the wind list is malformed, bail. */
if (SCM_IMP (winds) || SCM_NCONSP (winds)) if (SCM_IMP (winds) || SCM_NCONSP (winds))
abort (); abort ();
if (dynpair != SCM_BOOL_F) if (!SCM_FALSEP (dynpair))
jmpbuf = SCM_CDR (dynpair); jmpbuf = SCM_CDR (dynpair);
else else
{ {
@ -662,7 +662,7 @@ scm_ithrow (SCM key, SCM args, int noreturn)
} }
for (wind_goal = scm_dynwinds; for (wind_goal = scm_dynwinds;
SCM_CDAR (wind_goal) != jmpbuf; !SCM_EQ_P (SCM_CDAR (wind_goal), jmpbuf);
wind_goal = SCM_CDR (wind_goal)) wind_goal = SCM_CDR (wind_goal))
; ;
@ -670,7 +670,7 @@ scm_ithrow (SCM key, SCM args, int noreturn)
is bound to a lazy_catch smob, not a jmpbuf. */ is bound to a lazy_catch smob, not a jmpbuf. */
if (SCM_LAZY_CATCH_P (jmpbuf)) if (SCM_LAZY_CATCH_P (jmpbuf))
{ {
struct lazy_catch *c = (struct lazy_catch *) SCM_CDR (jmpbuf); struct lazy_catch *c = (struct lazy_catch *) SCM_CELL_WORD_1 (jmpbuf);
SCM oldwinds = scm_dynwinds; SCM oldwinds = scm_dynwinds;
SCM handle, answer; SCM handle, answer;
scm_dowinds (wind_goal, (scm_ilength (scm_dynwinds) scm_dowinds (wind_goal, (scm_ilength (scm_dynwinds)

86
libguile/unif.c
View file

@ -156,12 +156,12 @@ scm_make_uve (long k, SCM prot)
{ {
SCM v; SCM v;
long i, type; long i, type;
if (SCM_BOOL_T == prot) if (SCM_TRUE_P (prot))
{ {
i = sizeof (long) * ((k + SCM_LONG_BIT - 1) / SCM_LONG_BIT); i = sizeof (long) * ((k + SCM_LONG_BIT - 1) / SCM_LONG_BIT);
type = scm_tc7_bvect; type = scm_tc7_bvect;
} }
else if (SCM_CHARP (prot) && (prot == SCM_MAKE_CHAR ('\0'))) else if (SCM_CHARP (prot) && (SCM_CHAR (prot) == '\0'))
{ {
i = sizeof (char) * k; i = sizeof (char) * k;
type = scm_tc7_byvect; type = scm_tc7_byvect;
@ -293,11 +293,11 @@ SCM_DEFINE (scm_array_p, "array?", 1, 1, 0,
switch (SCM_TYP7 (v)) switch (SCM_TYP7 (v))
{ {
case scm_tc7_bvect: case scm_tc7_bvect:
protp = (SCM_BOOL_T==prot); protp = (SCM_TRUE_P (prot));
case scm_tc7_string: case scm_tc7_string:
protp = SCM_ICHRP(prot) && (prot != SCM_MAKICHR('\0')); protp = SCM_CHARP(prot) && (SCM_CHAR (prot) != '\0');
case scm_tc7_byvect: case scm_tc7_byvect:
protp = prot == SCM_MAKICHR('\0'); protp = SCM_EQ_P (prot, SCM_MAKE_CHAR ('\0'));
case scm_tc7_uvect: case scm_tc7_uvect:
protp = SCM_INUMP(prot) && SCM_INUM(prot)>0; protp = SCM_INUMP(prot) && SCM_INUM(prot)>0;
case scm_tc7_ivect: case scm_tc7_ivect:
@ -791,7 +791,7 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 0, 0, 1,
scm_makfrom0str (FUNC_NAME), SCM_WNA, NULL); scm_makfrom0str (FUNC_NAME), SCM_WNA, NULL);
SCM_ASSERT (SCM_INUMP (SCM_CAR (args)), SCM_CAR (args), SCM_ARG2, SCM_ASSERT (SCM_INUMP (SCM_CAR (args)), SCM_CAR (args), SCM_ARG2,
FUNC_NAME); FUNC_NAME);
SCM_ASSERT (SCM_INUM0 == SCM_CAR (args), SCM_CAR (args), SCM_OUTOFRANGE, SCM_ASSERT (SCM_EQ_P (SCM_INUM0, SCM_CAR (args)), SCM_CAR (args), SCM_OUTOFRANGE,
FUNC_NAME); FUNC_NAME);
return ra; return ra;
case scm_tc7_smob: case scm_tc7_smob:
@ -1111,19 +1111,19 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0,
return scm_long2num((long) SCM_VELTS(v)[pos]); return scm_long2num((long) SCM_VELTS(v)[pos]);
case scm_tc7_svect: case scm_tc7_svect:
return SCM_MAKINUM (((short *) SCM_CDR (v))[pos]); return SCM_MAKINUM (((short *) SCM_CELL_WORD_1 (v))[pos]);
#ifdef HAVE_LONG_LONGS #ifdef HAVE_LONG_LONGS
case scm_tc7_llvect: case scm_tc7_llvect:
return scm_long_long2num (((long_long *) SCM_CDR (v))[pos]); return scm_long_long2num (((long_long *) SCM_CELL_WORD_1 (v))[pos]);
#endif #endif
case scm_tc7_fvect: case scm_tc7_fvect:
return scm_make_real (((float *) SCM_CDR (v))[pos]); return scm_make_real (((float *) SCM_CELL_WORD_1 (v))[pos]);
case scm_tc7_dvect: case scm_tc7_dvect:
return scm_make_real (((double *) SCM_CDR (v))[pos]); return scm_make_real (((double *) SCM_CELL_WORD_1 (v))[pos]);
case scm_tc7_cvect: case scm_tc7_cvect:
return scm_make_complex (((double *) SCM_CDR (v))[2 * pos], return scm_make_complex (((double *) SCM_CELL_WORD_1 (v))[2 * pos],
((double *) SCM_CDR (v))[2 * pos + 1]); ((double *) SCM_CELL_WORD_1 (v))[2 * pos + 1]);
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect: case scm_tc7_wvect:
return SCM_VELTS (v)[pos]; return SCM_VELTS (v)[pos];
@ -1155,34 +1155,34 @@ scm_cvref (SCM v, scm_sizet pos, SCM last)
case scm_tc7_ivect: case scm_tc7_ivect:
return scm_long2num((long) SCM_VELTS(v)[pos]); return scm_long2num((long) SCM_VELTS(v)[pos]);
case scm_tc7_svect: case scm_tc7_svect:
return SCM_MAKINUM (((short *) SCM_CDR (v))[pos]); return SCM_MAKINUM (((short *) SCM_CELL_WORD_1 (v))[pos]);
#ifdef HAVE_LONG_LONGS #ifdef HAVE_LONG_LONGS
case scm_tc7_llvect: case scm_tc7_llvect:
return scm_long_long2num (((long_long *) SCM_CDR (v))[pos]); return scm_long_long2num (((long_long *) SCM_CELL_WORD_1 (v))[pos]);
#endif #endif
case scm_tc7_fvect: case scm_tc7_fvect:
if (SCM_NIMP (last) && last != scm_flo0 && SCM_SLOPPY_REALP (last)) if (SCM_NIMP (last) && last != scm_flo0 && SCM_SLOPPY_REALP (last))
{ {
SCM_REAL_VALUE (last) = ((float *) SCM_CDR (v))[pos]; SCM_REAL_VALUE (last) = ((float *) SCM_CELL_WORD_1 (v))[pos];
return last; return last;
} }
return scm_make_real (((float *) SCM_CDR (v))[pos]); return scm_make_real (((float *) SCM_CELL_WORD_1 (v))[pos]);
case scm_tc7_dvect: case scm_tc7_dvect:
if (SCM_NIMP (last) && last != scm_flo0 && SCM_SLOPPY_REALP (last)) if (SCM_NIMP (last) && last != scm_flo0 && SCM_SLOPPY_REALP (last))
{ {
SCM_REAL_VALUE (last) = ((double *) SCM_CDR (v))[pos]; SCM_REAL_VALUE (last) = ((double *) SCM_CELL_WORD_1 (v))[pos];
return last; return last;
} }
return scm_make_real (((double *) SCM_CDR (v))[pos]); return scm_make_real (((double *) SCM_CELL_WORD_1 (v))[pos]);
case scm_tc7_cvect: case scm_tc7_cvect:
if (SCM_NIMP (last) && SCM_SLOPPY_COMPLEXP (last)) if (SCM_NIMP (last) && SCM_SLOPPY_COMPLEXP (last))
{ {
SCM_COMPLEX_REAL (last) = ((double *) SCM_CDR (v))[2 * pos]; SCM_COMPLEX_REAL (last) = ((double *) SCM_CELL_WORD_1 (v))[2 * pos];
SCM_COMPLEX_IMAG (last) = ((double *) SCM_CDR (v))[2 * pos + 1]; SCM_COMPLEX_IMAG (last) = ((double *) SCM_CELL_WORD_1 (v))[2 * pos + 1];
return last; return last;
} }
return scm_make_complex (((double *) SCM_CDR (v))[2 * pos], return scm_make_complex (((double *) SCM_CELL_WORD_1 (v))[2 * pos],
((double *) SCM_CDR (v))[2 * pos + 1]); ((double *) SCM_CELL_WORD_1 (v))[2 * pos + 1]);
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect: case scm_tc7_wvect:
return SCM_VELTS (v)[pos]; return SCM_VELTS (v)[pos];
@ -1248,9 +1248,9 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1,
case scm_tc7_smob: /* enclosed */ case scm_tc7_smob: /* enclosed */
goto badarg1; goto badarg1;
case scm_tc7_bvect: case scm_tc7_bvect:
if (SCM_BOOL_F == obj) if (SCM_FALSEP (obj))
SCM_BITVEC_CLR(v,pos); SCM_BITVEC_CLR(v,pos);
else if (SCM_BOOL_T == obj) else if (SCM_TRUE_P (obj))
SCM_BITVEC_SET(v,pos); SCM_BITVEC_SET(v,pos);
else else
badobj:SCM_WTA (2,obj); badobj:SCM_WTA (2,obj);
@ -1273,25 +1273,25 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1,
break; break;
case scm_tc7_svect: case scm_tc7_svect:
SCM_ASRTGO (SCM_INUMP (obj), badobj); SCM_ASRTGO (SCM_INUMP (obj), badobj);
((short *) SCM_CDR (v))[pos] = SCM_INUM (obj); ((short *) SCM_CELL_WORD_1 (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_CDR (v))[pos] = scm_num2long_long (obj, (char *)SCM_ARG2, FUNC_NAME); ((long_long *) SCM_CELL_WORD_1 (v))[pos] = scm_num2long_long (obj, (char *)SCM_ARG2, FUNC_NAME);
break; break;
#endif #endif
case scm_tc7_fvect: case scm_tc7_fvect:
((float *) SCM_CDR (v))[pos] = (float) scm_num2dbl (obj, FUNC_NAME); ((float *) SCM_CELL_WORD_1 (v))[pos] = (float) scm_num2dbl (obj, FUNC_NAME);
break; break;
case scm_tc7_dvect: case scm_tc7_dvect:
((double *) SCM_CDR (v))[pos] = scm_num2dbl (obj, FUNC_NAME); ((double *) SCM_CELL_WORD_1 (v))[pos] = scm_num2dbl (obj, FUNC_NAME);
break; break;
case scm_tc7_cvect: case scm_tc7_cvect:
SCM_ASRTGO (SCM_INEXP (obj), badobj); SCM_ASRTGO (SCM_INEXP (obj), badobj);
((double *) SCM_CDR (v))[2 * pos] = SCM_REALPART (obj); ((double *) SCM_CELL_WORD_1 (v))[2 * pos] = SCM_REALPART (obj);
((double *) SCM_CDR (v))[2 * pos + 1] = SCM_CPLXP (obj) ? SCM_IMAG (obj) : 0.0; ((double *) SCM_CELL_WORD_1 (v))[2 * pos + 1] = SCM_CPLXP (obj) ? SCM_IMAG (obj) : 0.0;
break; break;
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect: case scm_tc7_wvect:
@ -1811,14 +1811,14 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
badarg1: SCM_WTA (1,v); badarg1: SCM_WTA (1,v);
case scm_tc7_bvect: case scm_tc7_bvect:
vlen = SCM_LENGTH (v); vlen = SCM_LENGTH (v);
if (SCM_BOOL_F == obj) if (SCM_FALSEP (obj))
for (i = SCM_LENGTH (kv); i;) for (i = SCM_LENGTH (kv); i;)
{ {
k = SCM_UNPACK (SCM_VELTS (kv)[--i]); k = SCM_UNPACK (SCM_VELTS (kv)[--i]);
SCM_ASSERT ((k < vlen), SCM_MAKINUM (k), SCM_OUTOFRANGE, FUNC_NAME); SCM_ASSERT ((k < vlen), SCM_MAKINUM (k), SCM_OUTOFRANGE, FUNC_NAME);
SCM_BITVEC_CLR(v,k); SCM_BITVEC_CLR(v,k);
} }
else if (SCM_BOOL_T == obj) else if (SCM_TRUE_P (obj))
for (i = SCM_LENGTH (kv); i;) for (i = SCM_LENGTH (kv); i;)
{ {
k = SCM_UNPACK (SCM_VELTS (kv)[--i]); k = SCM_UNPACK (SCM_VELTS (kv)[--i]);
@ -1831,10 +1831,10 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
break; break;
case scm_tc7_bvect: case scm_tc7_bvect:
SCM_ASRTGO (SCM_TYP7 (v) == scm_tc7_bvect && SCM_LENGTH (v) == SCM_LENGTH (kv), badarg1); SCM_ASRTGO (SCM_TYP7 (v) == scm_tc7_bvect && SCM_LENGTH (v) == SCM_LENGTH (kv), badarg1);
if (SCM_BOOL_F == obj) if (SCM_FALSEP (obj))
for (k = (SCM_LENGTH (v) + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;) for (k = (SCM_LENGTH (v) + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;)
SCM_UNPACK (SCM_VELTS (v)[k]) &= ~ SCM_UNPACK(SCM_VELTS (kv)[k]); SCM_UNPACK (SCM_VELTS (v)[k]) &= ~ SCM_UNPACK(SCM_VELTS (kv)[k]);
else if (SCM_BOOL_T == obj) else if (SCM_TRUE_P (obj))
for (k = (SCM_LENGTH (v) + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;) for (k = (SCM_LENGTH (v) + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;)
SCM_UNPACK (SCM_VELTS (v)[k]) |= SCM_UNPACK (SCM_VELTS (kv)[k]); SCM_UNPACK (SCM_VELTS (v)[k]) |= SCM_UNPACK (SCM_VELTS (kv)[k]);
else else
@ -1875,7 +1875,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
SCM_WTA (1,v); SCM_WTA (1,v);
case scm_tc7_bvect: case scm_tc7_bvect:
vlen = SCM_LENGTH (v); vlen = SCM_LENGTH (v);
if (SCM_BOOL_F == obj) if (SCM_FALSEP (obj))
for (i = SCM_LENGTH (kv); i;) for (i = SCM_LENGTH (kv); i;)
{ {
k = SCM_UNPACK (SCM_VELTS (kv)[--i]); k = SCM_UNPACK (SCM_VELTS (kv)[--i]);
@ -1883,7 +1883,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
if (!SCM_BITVEC_REF(v,k)) if (!SCM_BITVEC_REF(v,k))
count++; count++;
} }
else if (SCM_BOOL_T == obj) else if (SCM_TRUE_P (obj))
for (i = SCM_LENGTH (kv); i;) for (i = SCM_LENGTH (kv); i;)
{ {
k = SCM_UNPACK (SCM_VELTS (kv)[--i]); k = SCM_UNPACK (SCM_VELTS (kv)[--i]);
@ -1899,8 +1899,8 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
SCM_ASRTGO (SCM_TYP7 (v) == scm_tc7_bvect && SCM_LENGTH (v) == SCM_LENGTH (kv), badarg1); SCM_ASRTGO (SCM_TYP7 (v) == scm_tc7_bvect && SCM_LENGTH (v) == SCM_LENGTH (kv), badarg1);
if (0 == SCM_LENGTH (v)) if (0 == SCM_LENGTH (v))
return SCM_INUM0; return SCM_INUM0;
SCM_ASRTGO (SCM_BOOL_T == obj || SCM_BOOL_F == obj, badarg3); SCM_ASRTGO (SCM_BOOLP (obj), badarg3);
fObj = (SCM_BOOL_T == obj); fObj = SCM_TRUE_P (obj);
i = (SCM_LENGTH (v) - 1) / SCM_LONG_BIT; i = (SCM_LENGTH (v) - 1) / SCM_LONG_BIT;
k = SCM_UNPACK (SCM_VELTS (kv)[i]) & (fObj ? SCM_UNPACK (SCM_VELTS (v)[i]) : ~ SCM_UNPACK (SCM_VELTS (v)[i])); k = SCM_UNPACK (SCM_VELTS (kv)[i]) & (fObj ? SCM_UNPACK (SCM_VELTS (v)[i]) : ~ SCM_UNPACK (SCM_VELTS (v)[i]));
k <<= SCM_LONG_BIT - 1 - ((SCM_LENGTH (v) - 1) % SCM_LONG_BIT); k <<= SCM_LONG_BIT - 1 - ((SCM_LENGTH (v) - 1) % SCM_LONG_BIT);
@ -2147,7 +2147,7 @@ l2ra (SCM lst, SCM ra, scm_sizet base, scm_sizet k)
register long n = (1 + SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd); register long n = (1 + SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd);
int ok = 1; int ok = 1;
if (n <= 0) if (n <= 0)
return (SCM_EOL == lst); return (SCM_NULLP (lst));
if (k < SCM_ARRAY_NDIM (ra) - 1) if (k < SCM_ARRAY_NDIM (ra) - 1)
{ {
while (n--) while (n--)
@ -2255,11 +2255,11 @@ tail:
break; break;
case scm_tc7_byvect: case scm_tc7_byvect:
if (n-- > 0) if (n-- > 0)
scm_intprint (((char *)SCM_CDR (ra))[j], 10, port); scm_intprint (((char *) SCM_CELL_WORD_1 (ra))[j], 10, port);
for (j += inc; n-- > 0; j += inc) for (j += inc; n-- > 0; j += inc)
{ {
scm_putc (' ', port); scm_putc (' ', port);
scm_intprint (((char *)SCM_CDR (ra))[j], 10, port); scm_intprint (((char *)SCM_CELL_WORD_1 (ra))[j], 10, port);
} }
break; break;
@ -2292,11 +2292,11 @@ tail:
case scm_tc7_svect: case scm_tc7_svect:
if (n-- > 0) if (n-- > 0)
scm_intprint (((short *)SCM_CDR (ra))[j], 10, port); scm_intprint (((short *) SCM_CELL_WORD_1 (ra))[j], 10, port);
for (j += inc; n-- > 0; j += inc) for (j += inc; n-- > 0; j += inc)
{ {
scm_putc (' ', port); scm_putc (' ', port);
scm_intprint (((short *)SCM_CDR (ra))[j], 10, port); scm_intprint (((short *) SCM_CELL_WORD_1 (ra))[j], 10, port);
} }
break; break;

4
libguile/unif.h
View file

@ -81,8 +81,8 @@ extern long scm_tc16_array;
#define SCM_ARRAY_CONTIGUOUS 0x10000 #define SCM_ARRAY_CONTIGUOUS 0x10000
#define SCM_ARRAY_CONTP(x) (SCM_ARRAY_CONTIGUOUS & (int)(SCM_UNPACK_CAR(x))) #define SCM_ARRAY_CONTP(x) (SCM_ARRAY_CONTIGUOUS & (int)(SCM_UNPACK_CAR(x)))
#define SCM_ARRAY_V(a) (((scm_array *)SCM_CDR(a))->v) #define SCM_ARRAY_V(a) (((scm_array *) SCM_CELL_WORD_1 (a))->v)
#define SCM_ARRAY_BASE(a) (((scm_array *)SCM_CDR(a))->base) #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_DIMS(a) ((scm_array_dim *)(SCM_CHARS(a)+sizeof(scm_array)))
/* apparently it's possible to have more than SCM_LENGTH_MAX elements /* apparently it's possible to have more than SCM_LENGTH_MAX elements

16
libguile/variable.c
View file

@ -59,11 +59,11 @@ static int
prin_var (SCM exp,SCM port,scm_print_state *pstate) prin_var (SCM exp,SCM port,scm_print_state *pstate)
{ {
scm_puts ("#<variable ", port); scm_puts ("#<variable ", port);
scm_intprint((int) exp, 16, port); scm_intprint(SCM_UNPACK (exp), 16, port);
{ {
SCM val_cell; SCM val_cell;
val_cell = SCM_CDR(exp); val_cell = SCM_CDR(exp);
if (SCM_CAR (val_cell) != SCM_UNDEFINED) if (!SCM_UNBNDP (SCM_CAR (val_cell)))
{ {
scm_puts (" name: ", port); scm_puts (" name: ", port);
scm_iprin1 (SCM_CAR (val_cell), port, pstate); scm_iprin1 (SCM_CAR (val_cell), port, pstate);
@ -97,7 +97,7 @@ static SCM anonymous_variable_sym;
static SCM static SCM
make_vcell_variable (SCM vcell) make_vcell_variable (SCM vcell)
{ {
SCM_RETURN_NEWSMOB (scm_tc16_variable, vcell); SCM_RETURN_NEWSMOB (scm_tc16_variable, SCM_UNPACK (vcell));
} }
SCM_DEFINE (scm_make_variable, "make-variable", 1, 1, 0, SCM_DEFINE (scm_make_variable, "make-variable", 1, 1, 0,
@ -111,7 +111,7 @@ SCM_DEFINE (scm_make_variable, "make-variable", 1, 1, 0,
{ {
SCM val_cell; SCM val_cell;
if (name_hint == SCM_UNDEFINED) if (SCM_UNBNDP (name_hint))
name_hint = anonymous_variable_sym; name_hint = anonymous_variable_sym;
SCM_NEWCELL(val_cell); SCM_NEWCELL(val_cell);
@ -135,7 +135,7 @@ SCM_DEFINE (scm_make_undefined_variable, "make-undefined-variable", 0, 1, 0,
{ {
SCM vcell; SCM vcell;
if (name_hint == SCM_UNDEFINED) if (SCM_UNBNDP (name_hint))
name_hint = anonymous_variable_sym; name_hint = anonymous_variable_sym;
SCM_NEWCELL (vcell); SCM_NEWCELL (vcell);
@ -198,15 +198,15 @@ SCM_DEFINE (scm_builtin_variable, "builtin-variable", 1, 0, 0,
SCM_VALIDATE_SYMBOL (1,name); SCM_VALIDATE_SYMBOL (1,name);
vcell = scm_sym2vcell (name, SCM_BOOL_F, SCM_BOOL_T); vcell = scm_sym2vcell (name, SCM_BOOL_F, SCM_BOOL_T);
if (vcell == SCM_BOOL_F) if (SCM_FALSEP (vcell))
return SCM_BOOL_F; return SCM_BOOL_F;
scm_intern_symbol (scm_symhash_vars, name); scm_intern_symbol (scm_symhash_vars, name);
var_slot = scm_sym2ovcell (name, scm_symhash_vars); var_slot = scm_sym2ovcell (name, scm_symhash_vars);
SCM_DEFER_INTS; SCM_DEFER_INTS;
if ( SCM_IMP (SCM_CDR (var_slot)) if (SCM_IMP (SCM_CDR (var_slot))
|| (SCM_VARVCELL (var_slot) != vcell)) || !SCM_EQ_P (SCM_VARVCELL (var_slot), vcell))
SCM_SETCDR (var_slot, make_vcell_variable (vcell)); SCM_SETCDR (var_slot, make_vcell_variable (vcell));
SCM_ALLOW_INTS; SCM_ALLOW_INTS;

4
libguile/vectors.c
View file

@ -88,13 +88,13 @@ scm_vector_set_length_x (SCM vect, SCM len)
default: default:
badarg1: scm_wta (vect, (char *) SCM_ARG1, s_vector_set_length_x); badarg1: scm_wta (vect, (char *) SCM_ARG1, s_vector_set_length_x);
case scm_tc7_string: case scm_tc7_string:
SCM_ASRTGO (vect != scm_nullstr, badarg1); SCM_ASRTGO (!SCM_EQ_P (vect, scm_nullstr), badarg1);
sz = sizeof (char); sz = sizeof (char);
l++; l++;
break; break;
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect: case scm_tc7_wvect:
SCM_ASRTGO (vect != scm_nullvect, badarg1); SCM_ASRTGO (!SCM_EQ_P (vect, scm_nullvect), badarg1);
sz = sizeof (SCM); sz = sizeof (SCM);
break; break;
} }

6
libguile/vectors.h
View file

@ -53,9 +53,9 @@
#define SCM_VECTORP(x) (SCM_NIMP (x) && (SCM_TYP7S (x) == scm_tc7_vector)) #define SCM_VECTORP(x) (SCM_NIMP (x) && (SCM_TYP7S (x) == scm_tc7_vector))
#define SCM_NVECTORP(x) (!SCM_VECTORP (x)) #define SCM_NVECTORP(x) (!SCM_VECTORP (x))
#define SCM_VELTS(x) ((SCM *) SCM_UNPACK (SCM_CDR (x))) #define SCM_VELTS(x) ((SCM *) SCM_CELL_WORD_1 (x))
#define SCM_VELTS_AS_STACKITEMS(x) ((SCM_STACKITEM *) SCM_UNPACK (SCM_CDR (x))) #define SCM_VELTS_AS_STACKITEMS(x) ((SCM_STACKITEM *) SCM_CELL_WORD_1 (x))
#define SCM_SETVELTS SCM_SETCDR #define SCM_SETVELTS(x,v) (SCM_SET_CELL_WORD_1 ((x), (v)))

8
libguile/vports.c
View file

@ -84,7 +84,7 @@ sf_flush (SCM port)
{ {
SCM f = SCM_VELTS (stream)[2]; SCM f = SCM_VELTS (stream)[2];
if (f != SCM_BOOL_F) if (!SCM_FALSEP (f))
scm_apply (f, SCM_EOL, SCM_EOL); scm_apply (f, SCM_EOL, SCM_EOL);
} }
} }
@ -131,11 +131,11 @@ sf_close (SCM port)
{ {
SCM p = SCM_PACK (SCM_STREAM (port)); SCM p = SCM_PACK (SCM_STREAM (port));
SCM f = SCM_VELTS (p)[4]; SCM f = SCM_VELTS (p)[4];
if (SCM_BOOL_F == f) if (SCM_FALSEP (f))
return 0; return 0;
f = scm_apply (f, SCM_EOL, SCM_EOL); f = scm_apply (f, SCM_EOL, SCM_EOL);
errno = 0; errno = 0;
return SCM_BOOL_F == f ? EOF : 0; return SCM_FALSEP (f) ? EOF : 0;
} }
@ -188,7 +188,7 @@ SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 0,
SCM_DEFER_INTS; SCM_DEFER_INTS;
pt = scm_add_to_port_table (z); pt = scm_add_to_port_table (z);
scm_port_non_buffer (pt); scm_port_non_buffer (pt);
SCM_SETCAR (z, scm_tc16_sfport | scm_mode_bits (SCM_ROCHARS (modes))); SCM_SET_CELL_TYPE (z, scm_tc16_sfport | scm_mode_bits (SCM_ROCHARS (modes)));
SCM_SETPTAB_ENTRY (z, pt); SCM_SETPTAB_ENTRY (z, pt);
SCM_SETSTREAM (z, SCM_UNPACK (pv)); SCM_SETSTREAM (z, SCM_UNPACK (pv));
SCM_ALLOW_INTS; SCM_ALLOW_INTS;