+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>
* print.c: Removed promise to rewrite printer code before next
return scm_procedure_property (proc, scm_sym_source);
default:
SCM_WTA(1,proc);
- return 0;
+ return SCM_BOOL_F;
}
}
#undef FUNC_NAME
return SCM_EOL;
default:
SCM_WTA(1,proc);
- return 0;
+ return SCM_BOOL_F;
}
}
#undef FUNC_NAME
struct dirent *rdent;
SCM_VALIDATE_OPDIR (1,port);
errno = 0;
- SCM_SYSCALL (rdent = readdir ((DIR *) SCM_CDR (port)));
+ SCM_SYSCALL (rdent = readdir ((DIR *) SCM_CELL_WORD_1 (port)));
if (errno != 0)
SCM_SYSERROR;
return (rdent ? scm_makfromstr (rdent->d_name, NAMLEN (rdent), 0)
#define FUNC_NAME s_scm_rewinddir
{
SCM_VALIDATE_OPDIR (1,port);
- rewinddir ((DIR *) SCM_CDR (port));
+ rewinddir ((DIR *) SCM_CELL_WORD_1 (port));
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
{
return SCM_UNSPECIFIED;
}
- SCM_SYSCALL (sts = closedir ((DIR *) SCM_CDR (port)));
+ SCM_SYSCALL (sts = closedir ((DIR *) SCM_CELL_WORD_1 (port)));
if (sts != 0)
SCM_SYSERROR;
- SCM_SETCAR (port, scm_tc16_dir);
+ SCM_SET_CELL_WORD_0 (port, scm_tc16_dir);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
if (SCM_CLOSEDP (exp))
scm_puts ("closed: ", 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);
return 1;
}
scm_dir_free (SCM p)
{
if (SCM_OPENP (p))
- closedir ((DIR *) SCM_CDR (p));
+ closedir ((DIR *) SCM_CELL_WORD_1 (p));
return 0;
}
}
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);
else
{
/* 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);
list_or_vec = SCM_CDR (list_or_vec);
/* if there's a port with a ready buffer, don't block, just
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_usec = 0;
scm_misc_error ("scm_make_gsubr_with_generic",
"can't make primitive-generic with this arity",
SCM_EOL);
- return 0; /* never reached */
+ return SCM_BOOL_F; /* never reached */
}
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]);
}
- return 0; /* Never reached. */
+ return SCM_BOOL_F; /* Never reached. */
}
#else
SCM_VALIDATE_INUM (1,n);
#endif
- return SCM_BOOL(4 & (int) n);
+ return SCM_BOOL(4 & SCM_UNPACK (n));
}
#undef FUNC_NAME
#else
SCM_VALIDATE_INUM (1,n);
#endif
- return SCM_NEGATE_BOOL(4 & (int) n);
+ return SCM_NEGATE_BOOL(4 & SCM_UNPACK (n));
}
#undef FUNC_NAME
/* instead of the switch, we could just
return scm_gcd (y, scm_modulo (x, y)); */
}
- if (SCM_INUM0 == y)
+ if (SCM_EQ_P (y, SCM_INUM0))
return x;
goto swaprec;
}
}
d = scm_gcd (n1, n2);
- if (SCM_INUM0 == d)
+ if (SCM_EQ_P (d, SCM_INUM0))
return d;
return scm_abs (scm_product (n1, scm_quotient (n2, d)));
}
SCM acc = SCM_MAKINUM (1L);
int i2;
#ifdef SCM_BIGDIG
- if (SCM_INUM0 == n || acc == n)
+ if (SCM_EQ_P (n, SCM_INUM0) || SCM_EQ_P (n, acc))
return n;
- else if (SCM_MAKINUM (-1L) == n)
- return SCM_BOOL_F == scm_even_p (k) ? n : acc;
+ else if (SCM_EQ_P (n, SCM_MAKINUM (-1L)))
+ return SCM_FALSEP (scm_even_p (k)) ? n : acc;
#endif
SCM_VALIDATE_ULONG_COPY (2,k,i2);
if (i2 < 0)
{
num = 1;
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
{
num += (SCM_BIGRAD - 1) - zds[i];
for (i = j; j < SCM_LENGTH (ss); j++)
s[ch + j - i] = s[j]; /* 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_BOOL (SCM_COMPLEX_REAL (z) == 0.0
&& SCM_COMPLEX_IMAG (z) == 0.0);
}
- return SCM_BOOL(z == SCM_INUM0);
+ return SCM_BOOL (SCM_EQ_P (z, SCM_INUM0));
}
if (SCM_BIGP (y))
{
intbig:
- if (SCM_INUM0 == x)
+ if (SCM_EQ_P (x, SCM_INUM0))
return x;
- if (SCM_MAKINUM (1L) == x)
+ if (SCM_EQ_P (x, SCM_MAKINUM (1L)))
return y;
{
#ifndef SCM_DIGSTOOBIG
}
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 scm_makdbl (1.0 / ((double) SCM_INUM (x)), 0.0);
}
#define SCM_NEWREAL(z, x) \
do { \
SCM_NEWCELL2 (z); \
- SCM_SETCAR (z, scm_tc16_real); \
+ SCM_SET_CELL_TYPE (z, scm_tc16_real); \
SCM_REAL_VALUE (z) = (x); \
} while (0) \
#define SCM_CPLXP(x) SCM_COMPLEXP(x) /* Deprecated */
#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_IMAG(x) (((scm_complex_t *) SCM_UNPACK (SCM_CDR (x)))->imag)
+#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_REAL(x) \
(SCM_SLOPPY_REALP (x) \
? SCM_REAL_VALUE (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_SETNUMDIGS(x, v, sign) \
- SCM_SETCAR (x, \
+ SCM_SET_CELL_WORD_0 (x, \
scm_tc16_big \
| ((sign) ? SCM_BIGSIGNFLAG : 0) \
| (((v) + 0L) << SCM_BIGSIZEFIELD))
SCM *ve;
result = scm_make_vector (SCM_MAKINUM (4), SCM_UNSPECIFIED);
ve = SCM_VELTS (result);
- if (SCM_UNBNDP (name) || (name == SCM_BOOL_F))
+ if (SCM_UNBNDP (name) || SCM_FALSEP (name))
{
SCM_SYSCALL (entry = getgrent ());
if (! entry)
return proc;
}
SCM_WRONG_TYPE_ARG (1, proc);
- return 0; /* not reached */
+ return SCM_BOOL_F; /* not reached */
}
#undef FUNC_NAME
/* fall through */
}
SCM_WTA_DISPATCH_1 (g_setter, proc, SCM_ARG1, s_setter);
- return 0;
+ return SCM_BOOL_F;
}
if (1 == inc && (n >= SCM_LONG_BIT || n == SCM_LENGTH (ra)))
{
i = base / SCM_LONG_BIT;
- if (SCM_BOOL_F == fill)
+ if (SCM_FALSEP (fill))
{
if (base % SCM_LONG_BIT) /* leading partial word */
ve[i++] &= ~(~0L << (base % SCM_LONG_BIT));
if ((base + n) % SCM_LONG_BIT) /* trailing partial word */
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)
ve[i++] |= ~0L << (base % SCM_LONG_BIT);
}
else
{
- if (SCM_BOOL_F == fill)
+ if (SCM_FALSEP (fill))
for (i = base; n--; i += inc)
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)
ve[i / SCM_LONG_BIT] |= (1L << (i % SCM_LONG_BIT));
else
ugly UNICOS macros (IVDEP) to go .
*/
- if (src == dst)
+ if (SCM_EQ_P (src, dst))
return 1 ;
switch SCM_TYP7
#include "libguile/__scm.h"
extern long scm_tc16_regex;
-#define SCM_RGX(X) ((regex_t *) SCM_CDR(X))
-#define SCM_RGXP(X) (SCM_NIMP(X) && (SCM_CAR (X) == (SCM) scm_tc16_regex))
+#define SCM_RGX(X) ((regex_t *) SCM_CELL_WORD_1 (X))
+#define SCM_RGXP(X) (SCM_NIMP (X) && (SCM_CELL_TYPE (X) == scm_tc16_regex))
extern SCM scm_make_regexp (SCM pat, SCM flags);
SCM scm_regexp_p (SCM x);
#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 DEACTIVATEJB(OBJ) (SCM_SETAND_CAR (OBJ, ~(1L << 16L)))
#ifndef DEBUG_EXTENSIONS
-#define JBJMPBUF(OBJ) ((jmp_buf*)SCM_CDR (OBJ) )
-#define SETJBJMPBUF SCM_SETCDR
+#define JBJMPBUF(OBJ) ((jmp_buf *) SCM_CELL_WORD_1 (OBJ))
+#define SETJBJMPBUF(x,v) (SCM_SET_CELL_WORD_1 ((x), (v)))
#else
-#define SCM_JBDFRAME(OBJ) ((scm_debug_frame*)SCM_CAR (SCM_CDR (OBJ)) )
-#define JBJMPBUF(OBJ) ((jmp_buf*)SCM_CDR (SCM_CDR (OBJ)) )
-#define SCM_SETJBDFRAME(OBJ,X) SCM_SETCAR (SCM_CDR (OBJ), (SCM)(X))
-#define SETJBJMPBUF(OBJ,X) SCM_SETCDR(SCM_CDR (OBJ), X)
+#define SCM_JBDFRAME(x) ((scm_debug_frame *) SCM_CELL_WORD_0 (SCM_CDR (x)))
+#define JBJMPBUF(OBJ) ((jmp_buf *) SCM_CELL_WORD_1 (SCM_CDR (OBJ)))
+#define SCM_SETJBDFRAME(OBJ,X) (SCM_SET_CELL_WORD_0 (SCM_CDR (OBJ), (X)))
+#define SETJBJMPBUF(OBJ,X) (SCM_SET_CELL_WORD_1 (SCM_CDR (OBJ), (X)))
static scm_sizet
freejb (SCM jbsmob)
{
- scm_must_free ((char *) SCM_CDR (jbsmob));
+ scm_must_free ((char *) SCM_CELL_WORD_1 (jbsmob));
return sizeof (scm_cell);
}
#endif
{
scm_puts ("#<jmpbuffer ", 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);
return 1 ;
static int
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];
sprintf (buf, "#<lazy-catch 0x%lx 0x%lx>",
{
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);
c.tag = tag;
{
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);
c.tag = tag;
{
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;
}
}
/* If we didn't find anything, abort. scm_boot_guile should
have established a catch-all, but obviously things are
thoroughly screwed up. */
- if (winds == SCM_EOL)
+ if (SCM_NULLP (winds))
abort ();
/* If the wind list is malformed, bail. */
if (SCM_IMP (winds) || SCM_NCONSP (winds))
abort ();
- if (dynpair != SCM_BOOL_F)
+ if (!SCM_FALSEP (dynpair))
jmpbuf = SCM_CDR (dynpair);
else
{
}
for (wind_goal = scm_dynwinds;
- SCM_CDAR (wind_goal) != jmpbuf;
+ !SCM_EQ_P (SCM_CDAR (wind_goal), jmpbuf);
wind_goal = SCM_CDR (wind_goal))
;
is bound to a lazy_catch smob, not a 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 handle, answer;
scm_dowinds (wind_goal, (scm_ilength (scm_dynwinds)
{
SCM v;
long i, type;
- if (SCM_BOOL_T == prot)
+ if (SCM_TRUE_P (prot))
{
i = sizeof (long) * ((k + SCM_LONG_BIT - 1) / SCM_LONG_BIT);
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;
type = scm_tc7_byvect;
switch (SCM_TYP7 (v))
{
case scm_tc7_bvect:
- protp = (SCM_BOOL_T==prot);
+ protp = (SCM_TRUE_P (prot));
case scm_tc7_string:
- protp = SCM_ICHRP(prot) && (prot != SCM_MAKICHR('\0'));
+ protp = SCM_CHARP(prot) && (SCM_CHAR (prot) != '\0');
case scm_tc7_byvect:
- protp = prot == SCM_MAKICHR('\0');
+ protp = SCM_EQ_P (prot, SCM_MAKE_CHAR ('\0'));
case scm_tc7_uvect:
protp = SCM_INUMP(prot) && SCM_INUM(prot)>0;
case scm_tc7_ivect:
scm_makfrom0str (FUNC_NAME), SCM_WNA, NULL);
SCM_ASSERT (SCM_INUMP (SCM_CAR (args)), SCM_CAR (args), SCM_ARG2,
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);
return ra;
case scm_tc7_smob:
return scm_long2num((long) SCM_VELTS(v)[pos]);
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
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
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:
- return scm_make_real (((double *) SCM_CDR (v))[pos]);
+ return scm_make_real (((double *) SCM_CELL_WORD_1 (v))[pos]);
case scm_tc7_cvect:
- return scm_make_complex (((double *) SCM_CDR (v))[2 * pos],
- ((double *) SCM_CDR (v))[2 * pos + 1]);
+ return scm_make_complex (((double *) SCM_CELL_WORD_1 (v))[2 * pos],
+ ((double *) SCM_CELL_WORD_1 (v))[2 * pos + 1]);
case scm_tc7_vector:
case scm_tc7_wvect:
return SCM_VELTS (v)[pos];
case scm_tc7_ivect:
return scm_long2num((long) SCM_VELTS(v)[pos]);
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
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
case scm_tc7_fvect:
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 scm_make_real (((float *) SCM_CDR (v))[pos]);
+ return scm_make_real (((float *) SCM_CELL_WORD_1 (v))[pos]);
case scm_tc7_dvect:
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 scm_make_real (((double *) SCM_CDR (v))[pos]);
+ return scm_make_real (((double *) SCM_CELL_WORD_1 (v))[pos]);
case scm_tc7_cvect:
if (SCM_NIMP (last) && SCM_SLOPPY_COMPLEXP (last))
{
- SCM_COMPLEX_REAL (last) = ((double *) SCM_CDR (v))[2 * pos];
- SCM_COMPLEX_IMAG (last) = ((double *) SCM_CDR (v))[2 * pos + 1];
+ SCM_COMPLEX_REAL (last) = ((double *) SCM_CELL_WORD_1 (v))[2 * pos];
+ SCM_COMPLEX_IMAG (last) = ((double *) SCM_CELL_WORD_1 (v))[2 * pos + 1];
return last;
}
- return scm_make_complex (((double *) SCM_CDR (v))[2 * pos],
- ((double *) SCM_CDR (v))[2 * pos + 1]);
+ return scm_make_complex (((double *) SCM_CELL_WORD_1 (v))[2 * pos],
+ ((double *) SCM_CELL_WORD_1 (v))[2 * pos + 1]);
case scm_tc7_vector:
case scm_tc7_wvect:
return SCM_VELTS (v)[pos];
case scm_tc7_smob: /* enclosed */
goto badarg1;
case scm_tc7_bvect:
- if (SCM_BOOL_F == obj)
+ if (SCM_FALSEP (obj))
SCM_BITVEC_CLR(v,pos);
- else if (SCM_BOOL_T == obj)
+ else if (SCM_TRUE_P (obj))
SCM_BITVEC_SET(v,pos);
else
badobj:SCM_WTA (2,obj);
break;
case scm_tc7_svect:
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;
#ifdef HAVE_LONG_LONGS
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;
#endif
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;
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;
case scm_tc7_cvect:
SCM_ASRTGO (SCM_INEXP (obj), badobj);
- ((double *) SCM_CDR (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] = SCM_REALPART (obj);
+ ((double *) SCM_CELL_WORD_1 (v))[2 * pos + 1] = SCM_CPLXP (obj) ? SCM_IMAG (obj) : 0.0;
break;
case scm_tc7_vector:
case scm_tc7_wvect:
badarg1: SCM_WTA (1,v);
case scm_tc7_bvect:
vlen = SCM_LENGTH (v);
- if (SCM_BOOL_F == obj)
+ if (SCM_FALSEP (obj))
for (i = SCM_LENGTH (kv); i;)
{
k = SCM_UNPACK (SCM_VELTS (kv)[--i]);
SCM_ASSERT ((k < vlen), SCM_MAKINUM (k), SCM_OUTOFRANGE, FUNC_NAME);
SCM_BITVEC_CLR(v,k);
}
- else if (SCM_BOOL_T == obj)
+ else if (SCM_TRUE_P (obj))
for (i = SCM_LENGTH (kv); i;)
{
k = SCM_UNPACK (SCM_VELTS (kv)[--i]);
break;
case scm_tc7_bvect:
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--;)
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--;)
SCM_UNPACK (SCM_VELTS (v)[k]) |= SCM_UNPACK (SCM_VELTS (kv)[k]);
else
SCM_WTA (1,v);
case scm_tc7_bvect:
vlen = SCM_LENGTH (v);
- if (SCM_BOOL_F == obj)
+ if (SCM_FALSEP (obj))
for (i = SCM_LENGTH (kv); i;)
{
k = SCM_UNPACK (SCM_VELTS (kv)[--i]);
if (!SCM_BITVEC_REF(v,k))
count++;
}
- else if (SCM_BOOL_T == obj)
+ else if (SCM_TRUE_P (obj))
for (i = SCM_LENGTH (kv); i;)
{
k = SCM_UNPACK (SCM_VELTS (kv)[--i]);
SCM_ASRTGO (SCM_TYP7 (v) == scm_tc7_bvect && SCM_LENGTH (v) == SCM_LENGTH (kv), badarg1);
if (0 == SCM_LENGTH (v))
return SCM_INUM0;
- SCM_ASRTGO (SCM_BOOL_T == obj || SCM_BOOL_F == obj, badarg3);
- fObj = (SCM_BOOL_T == obj);
+ SCM_ASRTGO (SCM_BOOLP (obj), badarg3);
+ fObj = SCM_TRUE_P (obj);
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_LONG_BIT - 1 - ((SCM_LENGTH (v) - 1) % SCM_LONG_BIT);
register long n = (1 + SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd);
int ok = 1;
if (n <= 0)
- return (SCM_EOL == lst);
+ return (SCM_NULLP (lst));
if (k < SCM_ARRAY_NDIM (ra) - 1)
{
while (n--)
break;
case scm_tc7_byvect:
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)
{
scm_putc (' ', port);
- scm_intprint (((char *)SCM_CDR (ra))[j], 10, port);
+ scm_intprint (((char *)SCM_CELL_WORD_1 (ra))[j], 10, port);
}
break;
case scm_tc7_svect:
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)
{
scm_putc (' ', port);
- scm_intprint (((short *)SCM_CDR (ra))[j], 10, port);
+ scm_intprint (((short *) SCM_CELL_WORD_1 (ra))[j], 10, port);
}
break;
#define SCM_ARRAY_CONTIGUOUS 0x10000
#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_BASE(a) (((scm_array *)SCM_CDR(a))->base)
+#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)))
/* apparently it's possible to have more than SCM_LENGTH_MAX elements
prin_var (SCM exp,SCM port,scm_print_state *pstate)
{
scm_puts ("#<variable ", port);
- scm_intprint((int) exp, 16, port);
+ scm_intprint(SCM_UNPACK (exp), 16, port);
{
SCM val_cell;
val_cell = SCM_CDR(exp);
- if (SCM_CAR (val_cell) != SCM_UNDEFINED)
+ if (!SCM_UNBNDP (SCM_CAR (val_cell)))
{
scm_puts (" name: ", port);
scm_iprin1 (SCM_CAR (val_cell), port, pstate);
static SCM
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 val_cell;
- if (name_hint == SCM_UNDEFINED)
+ if (SCM_UNBNDP (name_hint))
name_hint = anonymous_variable_sym;
SCM_NEWCELL(val_cell);
{
SCM vcell;
- if (name_hint == SCM_UNDEFINED)
+ if (SCM_UNBNDP (name_hint))
name_hint = anonymous_variable_sym;
SCM_NEWCELL (vcell);
SCM_VALIDATE_SYMBOL (1,name);
vcell = scm_sym2vcell (name, SCM_BOOL_F, SCM_BOOL_T);
- if (vcell == SCM_BOOL_F)
+ if (SCM_FALSEP (vcell))
return SCM_BOOL_F;
scm_intern_symbol (scm_symhash_vars, name);
var_slot = scm_sym2ovcell (name, scm_symhash_vars);
SCM_DEFER_INTS;
- if ( SCM_IMP (SCM_CDR (var_slot))
- || (SCM_VARVCELL (var_slot) != vcell))
+ if (SCM_IMP (SCM_CDR (var_slot))
+ || !SCM_EQ_P (SCM_VARVCELL (var_slot), vcell))
SCM_SETCDR (var_slot, make_vcell_variable (vcell));
SCM_ALLOW_INTS;
default:
badarg1: scm_wta (vect, (char *) SCM_ARG1, s_vector_set_length_x);
case scm_tc7_string:
- SCM_ASRTGO (vect != scm_nullstr, badarg1);
+ SCM_ASRTGO (!SCM_EQ_P (vect, scm_nullstr), badarg1);
sz = sizeof (char);
l++;
break;
case scm_tc7_vector:
case scm_tc7_wvect:
- SCM_ASRTGO (vect != scm_nullvect, badarg1);
+ SCM_ASRTGO (!SCM_EQ_P (vect, scm_nullvect), badarg1);
sz = sizeof (SCM);
break;
}
#define SCM_VECTORP(x) (SCM_NIMP (x) && (SCM_TYP7S (x) == scm_tc7_vector))
#define SCM_NVECTORP(x) (!SCM_VECTORP (x))
-#define SCM_VELTS(x) ((SCM *) SCM_UNPACK (SCM_CDR (x)))
-#define SCM_VELTS_AS_STACKITEMS(x) ((SCM_STACKITEM *) SCM_UNPACK (SCM_CDR (x)))
-#define SCM_SETVELTS SCM_SETCDR
+#define SCM_VELTS(x) ((SCM *) SCM_CELL_WORD_1 (x))
+#define SCM_VELTS_AS_STACKITEMS(x) ((SCM_STACKITEM *) SCM_CELL_WORD_1 (x))
+#define SCM_SETVELTS(x,v) (SCM_SET_CELL_WORD_1 ((x), (v)))
\f
{
SCM f = SCM_VELTS (stream)[2];
- if (f != SCM_BOOL_F)
+ if (!SCM_FALSEP (f))
scm_apply (f, SCM_EOL, SCM_EOL);
}
}
{
SCM p = SCM_PACK (SCM_STREAM (port));
SCM f = SCM_VELTS (p)[4];
- if (SCM_BOOL_F == f)
+ if (SCM_FALSEP (f))
return 0;
f = scm_apply (f, SCM_EOL, SCM_EOL);
errno = 0;
- return SCM_BOOL_F == f ? EOF : 0;
+ return SCM_FALSEP (f) ? EOF : 0;
}
SCM_DEFER_INTS;
pt = scm_add_to_port_table (z);
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_SETSTREAM (z, SCM_UNPACK (pv));
SCM_ALLOW_INTS;
HCoop / bpt / guile.git / commitdiff