diff options
-rw-r--r-- | libguile/ChangeLog | 46 | ||||
-rw-r--r-- | libguile/debug.c | 4 | ||||
-rw-r--r-- | libguile/filesys.c | 18 | ||||
-rw-r--r-- | libguile/gsubr.c | 4 | ||||
-rw-r--r-- | libguile/numbers.c | 26 | ||||
-rw-r--r-- | libguile/numbers.h | 8 | ||||
-rw-r--r-- | libguile/posix.c | 2 | ||||
-rw-r--r-- | libguile/procs.c | 4 | ||||
-rw-r--r-- | libguile/ramap.c | 10 | ||||
-rw-r--r-- | libguile/regex-posix.h | 4 | ||||
-rw-r--r-- | libguile/throw.c | 34 | ||||
-rw-r--r-- | libguile/unif.c | 86 | ||||
-rw-r--r-- | libguile/unif.h | 4 | ||||
-rw-r--r-- | libguile/variable.c | 16 | ||||
-rw-r--r-- | libguile/vectors.c | 4 | ||||
-rw-r--r-- | libguile/vectors.h | 6 | ||||
-rw-r--r-- | libguile/vports.c | 8 |
17 files changed, 165 insertions, 119 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog index b9baad6f8..6ad428c29 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -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> * print.c: Removed promise to rewrite printer code before next diff --git a/libguile/debug.c b/libguile/debug.c index 3000cd424..4f021dff4 100644 --- a/libguile/debug.c +++ b/libguile/debug.c @@ -440,7 +440,7 @@ SCM_DEFINE (scm_procedure_source, "procedure-source", 1, 0, 0, return scm_procedure_property (proc, scm_sym_source); default: SCM_WTA(1,proc); - return 0; + return SCM_BOOL_F; } } #undef FUNC_NAME @@ -462,7 +462,7 @@ SCM_DEFINE (scm_procedure_environment, "procedure-environment", 1, 0, 0, return SCM_EOL; default: SCM_WTA(1,proc); - return 0; + return SCM_BOOL_F; } } #undef FUNC_NAME diff --git a/libguile/filesys.c b/libguile/filesys.c index 185038999..72e0bb1e4 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -697,7 +697,7 @@ SCM_DEFINE (scm_readdir, "readdir", 1, 0, 0, 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) @@ -714,7 +714,7 @@ SCM_DEFINE (scm_rewinddir, "rewinddir", 1, 0, 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 @@ -734,10 +734,10 @@ SCM_DEFINE (scm_closedir, "closedir", 1, 0, 0, { 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 @@ -752,7 +752,7 @@ scm_dir_print (SCM exp, SCM port, scm_print_state *pstate) 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; } @@ -762,7 +762,7 @@ static scm_sizet scm_dir_free (SCM p) { if (SCM_OPENP (p)) - closedir ((DIR *) SCM_CDR (p)); + closedir ((DIR *) SCM_CELL_WORD_1 (p)); return 0; } @@ -890,7 +890,7 @@ fill_select_type (SELECT_TYPE *set, SCM *ports_ready, SCM list_or_vec, int pos) } 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); @@ -950,7 +950,7 @@ retrieve_select_type (SELECT_TYPE *set, SCM ports_ready, SCM list_or_vec) 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); @@ -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 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; diff --git a/libguile/gsubr.c b/libguile/gsubr.c index db41d2098..43db9c76c 100644 --- a/libguile/gsubr.c +++ b/libguile/gsubr.c @@ -126,7 +126,7 @@ scm_make_gsubr_with_generic (const char *name, 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 */ } @@ -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 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. */ } diff --git a/libguile/numbers.c b/libguile/numbers.c index 0c3861bea..5aef9ca7f 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -106,7 +106,7 @@ SCM_DEFINE (scm_odd_p, "odd?", 1, 0, 0, #else SCM_VALIDATE_INUM (1,n); #endif - return SCM_BOOL(4 & (int) n); + return SCM_BOOL(4 & SCM_UNPACK (n)); } #undef FUNC_NAME @@ -124,7 +124,7 @@ SCM_DEFINE (scm_even_p, "even?", 1, 0, 0, #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 @@ -400,7 +400,7 @@ scm_gcd (SCM x, SCM y) /* 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; } @@ -485,7 +485,7 @@ scm_lcm (SCM n1, SCM n2) } 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))); } @@ -1026,10 +1026,10 @@ SCM_DEFINE (scm_integer_expt, "integer-expt", 2, 0, 0, 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) @@ -1557,7 +1557,7 @@ scm_addbig (SCM_BIGDIG *x, scm_sizet nx, int xsgn, SCM bigy, int sgny) { 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]; @@ -2147,7 +2147,7 @@ big2str (SCM b, unsigned int radix) 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); @@ -3110,7 +3110,7 @@ scm_zero_p (SCM z) 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)); } @@ -3721,9 +3721,9 @@ scm_product (SCM x, SCM y) 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 @@ -3931,7 +3931,7 @@ scm_divide (SCM x, SCM 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 scm_makdbl (1.0 / ((double) SCM_INUM (x)), 0.0); } diff --git a/libguile/numbers.h b/libguile/numbers.h index e6db92079..6b781514a 100644 --- a/libguile/numbers.h +++ b/libguile/numbers.h @@ -156,7 +156,7 @@ #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) \ @@ -185,8 +185,8 @@ #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) \ @@ -260,7 +260,7 @@ #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)) diff --git a/libguile/posix.c b/libguile/posix.c index 554a7297e..f71605de0 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -322,7 +322,7 @@ SCM_DEFINE (scm_getgrgid, "getgr", 0, 1, 0, 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) diff --git a/libguile/procs.c b/libguile/procs.c index 8578ff887..e09228fde 100644 --- a/libguile/procs.c +++ b/libguile/procs.c @@ -341,7 +341,7 @@ SCM_DEFINE (scm_procedure, "procedure", 1, 0, 0, return proc; } SCM_WRONG_TYPE_ARG (1, proc); - return 0; /* not reached */ + return SCM_BOOL_F; /* not reached */ } #undef FUNC_NAME @@ -366,7 +366,7 @@ scm_setter (SCM proc) /* fall through */ } SCM_WTA_DISPATCH_1 (g_setter, proc, SCM_ARG1, s_setter); - return 0; + return SCM_BOOL_F; } diff --git a/libguile/ramap.c b/libguile/ramap.c index c186de153..8c2f7bae2 100644 --- a/libguile/ramap.c +++ b/libguile/ramap.c @@ -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))) { 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)); @@ -515,7 +515,7 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore) 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); @@ -529,10 +529,10 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore) } 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 @@ -637,7 +637,7 @@ racp (SCM src, SCM dst) ugly UNICOS macros (IVDEP) to go . */ - if (src == dst) + if (SCM_EQ_P (src, dst)) return 1 ; switch SCM_TYP7 diff --git a/libguile/regex-posix.h b/libguile/regex-posix.h index 3750f2647..c56e5d205 100644 --- a/libguile/regex-posix.h +++ b/libguile/regex-posix.h @@ -51,8 +51,8 @@ #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); diff --git a/libguile/throw.c b/libguile/throw.c index 2976b8fae..3c209fa7a 100644 --- a/libguile/throw.c +++ b/libguile/throw.c @@ -70,23 +70,23 @@ static int 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 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 @@ -96,7 +96,7 @@ printjb (SCM exp, SCM port, scm_print_state *pstate) { 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 ; @@ -253,7 +253,7 @@ struct lazy_catch { 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>", @@ -546,7 +546,7 @@ SCM_DEFINE (scm_catch, "catch", 3, 0, 0, { 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; @@ -571,7 +571,7 @@ SCM_DEFINE (scm_lazy_catch, "lazy-catch", 3, 0, 0, { 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; @@ -629,7 +629,7 @@ scm_ithrow (SCM key, SCM args, int noreturn) { 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; } } @@ -637,14 +637,14 @@ scm_ithrow (SCM key, SCM args, int noreturn) /* 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 { @@ -662,7 +662,7 @@ scm_ithrow (SCM key, SCM args, int noreturn) } for (wind_goal = scm_dynwinds; - SCM_CDAR (wind_goal) != jmpbuf; + !SCM_EQ_P (SCM_CDAR (wind_goal), jmpbuf); 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. */ 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) diff --git a/libguile/unif.c b/libguile/unif.c index 0bab178c0..3eeaa85fa 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -156,12 +156,12 @@ scm_make_uve (long k, SCM prot) { 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; @@ -293,11 +293,11 @@ SCM_DEFINE (scm_array_p, "array?", 1, 1, 0, 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: @@ -791,7 +791,7 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 0, 0, 1, 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: @@ -1111,19 +1111,19 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0, 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]; @@ -1155,34 +1155,34 @@ scm_cvref (SCM v, scm_sizet pos, SCM last) 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]; @@ -1248,9 +1248,9 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, 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); @@ -1273,25 +1273,25 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, 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: @@ -1811,14 +1811,14 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0, 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]); @@ -1831,10 +1831,10 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0, 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 @@ -1875,7 +1875,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, 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]); @@ -1883,7 +1883,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, 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]); @@ -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); 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); @@ -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); int ok = 1; if (n <= 0) - return (SCM_EOL == lst); + return (SCM_NULLP (lst)); if (k < SCM_ARRAY_NDIM (ra) - 1) { while (n--) @@ -2255,11 +2255,11 @@ tail: 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; @@ -2292,11 +2292,11 @@ tail: 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; diff --git a/libguile/unif.h b/libguile/unif.h index 86312b3fa..0c133a27a 100644 --- a/libguile/unif.h +++ b/libguile/unif.h @@ -81,8 +81,8 @@ extern long scm_tc16_array; #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 diff --git a/libguile/variable.c b/libguile/variable.c index f453ce3ce..f96415fd3 100644 --- a/libguile/variable.c +++ b/libguile/variable.c @@ -59,11 +59,11 @@ static int 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); @@ -97,7 +97,7 @@ static SCM anonymous_variable_sym; 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, @@ -111,7 +111,7 @@ 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); @@ -135,7 +135,7 @@ SCM_DEFINE (scm_make_undefined_variable, "make-undefined-variable", 0, 1, 0, { SCM vcell; - if (name_hint == SCM_UNDEFINED) + if (SCM_UNBNDP (name_hint)) name_hint = anonymous_variable_sym; SCM_NEWCELL (vcell); @@ -198,15 +198,15 @@ SCM_DEFINE (scm_builtin_variable, "builtin-variable", 1, 0, 0, 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; diff --git a/libguile/vectors.c b/libguile/vectors.c index f4e992e14..b8d512aaa 100644 --- a/libguile/vectors.c +++ b/libguile/vectors.c @@ -88,13 +88,13 @@ scm_vector_set_length_x (SCM vect, SCM len) 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; } diff --git a/libguile/vectors.h b/libguile/vectors.h index c0692a0d0..dd189f56b 100644 --- a/libguile/vectors.h +++ b/libguile/vectors.h @@ -53,9 +53,9 @@ #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))) diff --git a/libguile/vports.c b/libguile/vports.c index fb3a6fb7a..4490d8fd5 100644 --- a/libguile/vports.c +++ b/libguile/vports.c @@ -84,7 +84,7 @@ sf_flush (SCM port) { SCM f = SCM_VELTS (stream)[2]; - if (f != SCM_BOOL_F) + if (!SCM_FALSEP (f)) scm_apply (f, SCM_EOL, SCM_EOL); } } @@ -131,11 +131,11 @@ sf_close (SCM port) { 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; } @@ -188,7 +188,7 @@ SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 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; |