diff options
48 files changed, 191 insertions, 191 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 97201f5aa..bd3febf12 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -5,7 +5,7 @@ * tags.h (SCM_NCELLP): Removed (SCMWORD). - * arbiters.c (SCM_ARB_LOCKED): Use SCM_CARBITS. + * arbiters.c (SCM_ARB_LOCKED): Use SCM_UNPACK_CAR. * async.c, boolean.h, debug.c, dynl.c, dynwind.c, eval.c, eval.h, feature.h, filesys.h, fluids.h, fports.c, fports.h, gc.c, gc.h, @@ -14,7 +14,7 @@ procs.h, ramap.c, read.c, smob.c, smob.h, srcprop.h, stacks.c, stacks.h, strports.c, struct.c, struct.h, tag.c, tags.h, throw.c, unif.c, unif.h, variable.h, vectors.h, weaks.c, - weaks.h (SCM_SCM, SCM_BITS, SCM_CARBITS): Renamed from + weaks.h (SCM_PACK, SCM_UNPACK, SCM_UNPACK_CAR): Renamed from SCM_ASSCM, SCM_ASWORD, SCM_CARW). * numbers.h (SCM_SRS, SCM_INUM): Corrected SCM_ASSCM/ASWORD fixes. diff --git a/libguile/arbiters.c b/libguile/arbiters.c index ec77331b3..d1be6d18e 100644 --- a/libguile/arbiters.c +++ b/libguile/arbiters.c @@ -63,7 +63,7 @@ static long scm_tc16_arbiter; -#define SCM_ARB_LOCKED(arb) ((SCM_CARBITS (arb)) & (1L << 16)) +#define SCM_ARB_LOCKED(arb) ((SCM_UNPACK_CAR (arb)) & (1L << 16)) #define SCM_LOCK_ARB(arb) SCM_SETCAR (arb, (SCM) (scm_tc16_arbiter | (1L << 16))); #define SCM_UNLOCK_ARB(arb) SCM_SETCAR (arb, (SCM) scm_tc16_arbiter); diff --git a/libguile/async.c b/libguile/async.c index 76f99899b..b6e7f0c67 100644 --- a/libguile/async.c +++ b/libguile/async.c @@ -390,7 +390,7 @@ SCM_DEFINE (scm_set_tick_rate, "set-tick-rate", 1, 0, 0, old_n = scm_tick_rate; - scm_desired_tick_rate = SCM_BITS (SCM_INUM (n)); + scm_desired_tick_rate = SCM_UNPACK (SCM_INUM (n)); scm_async_rate = 1 + scm_async_rate - scm_async_clock; scm_async_clock = 1; return SCM_MAKINUM (old_n); @@ -408,7 +408,7 @@ SCM_DEFINE (scm_set_switch_rate, "set-switch-rate", 1, 0, 0, unsigned int old_n; SCM_VALIDATE_INUM (1,n); old_n = scm_switch_rate; - scm_desired_switch_rate = SCM_BITS (SCM_INUM (n)); + scm_desired_switch_rate = SCM_UNPACK (SCM_INUM (n)); scm_async_rate = 1 + scm_async_rate - scm_async_clock; scm_async_clock = 1; return SCM_MAKINUM (old_n); diff --git a/libguile/boolean.h b/libguile/boolean.h index 4825c17ac..fe2184823 100644 --- a/libguile/boolean.h +++ b/libguile/boolean.h @@ -64,7 +64,7 @@ /* SCM_BOOL_NOT returns the other boolean. * The order of ^s here is important for Borland C++ (!?!?!) */ -#define SCM_BOOL_NOT(x) SCM_SCM(SCM_BITS(x) ^ (SCM_BITS (SCM_BOOL_T) ^ SCM_BITS (SCM_BOOL_F))) +#define SCM_BOOL_NOT(x) SCM_PACK(SCM_UNPACK(x) ^ (SCM_UNPACK (SCM_BOOL_T) ^ SCM_UNPACK (SCM_BOOL_F))) diff --git a/libguile/debug.c b/libguile/debug.c index 14c69130d..2870f704d 100644 --- a/libguile/debug.c +++ b/libguile/debug.c @@ -275,7 +275,7 @@ SCM_DEFINE (scm_gloc_p, "gloc?", 1, 0, 0, #define FUNC_NAME s_scm_gloc_p { return SCM_BOOL((SCM_MEMOIZEDP (obj) - && (SCM_BITS(SCM_MEMOIZED_EXP (obj)) & 7) == 1)); + && (SCM_UNPACK(SCM_MEMOIZED_EXP (obj)) & 7) == 1)); } #undef FUNC_NAME diff --git a/libguile/dynl.c b/libguile/dynl.c index bc7433148..b21153d65 100644 --- a/libguile/dynl.c +++ b/libguile/dynl.c @@ -414,7 +414,7 @@ static struct dynl_obj * get_dynl_obj (SCM dobj,const char *subr,int argn) { struct dynl_obj *d; - SCM_ASSERT (SCM_NIMP (dobj) && SCM_CARBITS (dobj) == scm_tc16_dynamic_obj, + SCM_ASSERT (SCM_NIMP (dobj) && SCM_UNPACK_CAR (dobj) == scm_tc16_dynamic_obj, dobj, argn, subr); d = (struct dynl_obj *)SCM_CDR (dobj); SCM_ASSERT (d->handle != NULL, dobj, argn, subr); @@ -427,7 +427,7 @@ SCM_DEFINE (scm_dynamic_object_p, "dynamic-object?", 1, 0, 0, "otherwise.") #define FUNC_NAME s_scm_dynamic_object_p { - return SCM_BOOL(SCM_NIMP (obj) && SCM_CARBITS (obj) == scm_tc16_dynamic_obj); + return SCM_BOOL(SCM_NIMP (obj) && SCM_UNPACK_CAR (obj) == scm_tc16_dynamic_obj); } #undef FUNC_NAME diff --git a/libguile/dynwind.c b/libguile/dynwind.c index bbac5918b..8a51f3e68 100644 --- a/libguile/dynwind.c +++ b/libguile/dynwind.c @@ -145,7 +145,7 @@ typedef struct guardsmem { #define SCM_BEFORE_GUARD(obj) (SCM_GUARDSMEM (obj)->before) #define SCM_AFTER_GUARD(obj) (SCM_GUARDSMEM (obj)->after) #define SCM_GUARD_DATA(obj) (SCM_GUARDSMEM (obj)->data) -#define SCM_GUARDSP(obj) (SCM_NIMP(obj) && (SCM_CARBITS (obj) == tc16_guards)) +#define SCM_GUARDSP(obj) (SCM_NIMP(obj) && (SCM_UNPACK_CAR (obj) == tc16_guards)) static long tc16_guards; @@ -160,7 +160,7 @@ static int printguards (SCM exp, SCM port, scm_print_state *pstate) { scm_puts ("#<guards ", port); - scm_intprint (SCM_BITS (SCM_CDR (exp)), 16, port); + scm_intprint (SCM_UNPACK (SCM_CDR (exp)), 16, port); scm_putc ('>', port); return 1; } diff --git a/libguile/eval.c b/libguile/eval.c index 244134744..f39a8a31c 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -319,7 +319,7 @@ scm_lookupcar (SCM vloc, SCM genv, int check) #endif } #ifdef MEMOIZE_LOCALS - iloc = SCM_SCM ((~SCM_IDSTMSK) & SCM_BITS(iloc + SCM_IFRINC)); + iloc = SCM_PACK ((~SCM_IDSTMSK) & SCM_UNPACK(iloc + SCM_IFRINC)); #endif } { @@ -367,7 +367,7 @@ scm_lookupcar (SCM vloc, SCM genv, int check) if (SCM_ITAG3 (var) == 1) return SCM_GLOC_VAL_LOC (var); #ifdef MEMOIZE_LOCALS - if ((SCM_BITS (var) & 127) == (127 & SCM_BITS (SCM_ILOC00))) + if ((SCM_UNPACK (var) & 127) == (127 & SCM_UNPACK (SCM_ILOC00))) return scm_ilookup (var, genv); #endif /* We can't cope with anything else than glocs and ilocs. When @@ -409,7 +409,7 @@ scm_unmemocar (SCM form, SCM env) if (SCM_IMP (form)) return form; c = SCM_CAR (form); - if (1 == (SCM_BITS (c) & 7)) + if (1 == (SCM_UNPACK (c) & 7)) SCM_SETCAR (form, SCM_CAR (c - 1)); #ifdef MEMOIZE_LOCALS #ifdef DEBUG_EXTENSIONS @@ -1262,7 +1262,7 @@ scm_macroexp (SCM x, SCM env) if (SCM_IMP (proc) || scm_tc16_macro != SCM_TYP16 (proc) - || (int) (SCM_CARBITS (proc) >> 16) != 2) + || (int) (SCM_UNPACK_CAR (proc) >> 16) != 2) return x; unmemocar (x, env); @@ -1295,7 +1295,7 @@ scm_macroexp (SCM x, SCM env) * readable style... :) */ -#define SCM_BIT8(x) (127 & SCM_BITS (x)) +#define SCM_BIT8(x) (127 & SCM_UNPACK (x)) static SCM unmemocopy (SCM x, SCM env) @@ -2299,7 +2299,7 @@ dispatch: if (SCM_NIMP (t.arg1)) do { - i += SCM_BITS ((SCM_STRUCT_DATA (scm_class_of (SCM_CAR (t.arg1)))) + i += SCM_UNPACK ((SCM_STRUCT_DATA (scm_class_of (SCM_CAR (t.arg1)))) [scm_si_hashsets + hashset]); t.arg1 = SCM_CDR (t.arg1); } @@ -2548,7 +2548,7 @@ dispatch: #ifdef DEVAL SCM_CLEAR_MACROEXP (debug); #endif - switch ((int) (SCM_CARBITS (proc) >> 16)) + switch ((int) (SCM_UNPACK_CAR (proc) >> 16)) { case 2: if (scm_ilength (t.arg1) <= 0) @@ -3711,10 +3711,10 @@ SCM_DEFINE (scm_force, "force", 1, 0, 0, #define FUNC_NAME s_scm_force { SCM_VALIDATE_SMOB (1,x,promise); - if (!((1L << 16) & SCM_CARBITS (x))) + if (!((1L << 16) & SCM_UNPACK_CAR (x))) { SCM ans = scm_apply (SCM_CDR (x), SCM_EOL, SCM_EOL); - if (!((1L << 16) & SCM_CARBITS (x))) + if (!((1L << 16) & SCM_UNPACK_CAR (x))) { SCM_DEFER_INTS; SCM_SETCDR (x, ans); diff --git a/libguile/eval.h b/libguile/eval.h index 72e2647cc..cc1ecffcd 100644 --- a/libguile/eval.h +++ b/libguile/eval.h @@ -83,7 +83,7 @@ extern SCM scm_eval_options_interface (SCM setting); #define SCM_IDSTMSK (-SCM_IDINC) #define SCM_IFRAME(n) ((int)((SCM_ICDR-SCM_IFRINC)>>8) & ((int)(n)>>8)) #define SCM_IDIST(n) (((unsigned long)(n))>>20) -#define SCM_ICDRP(n) (SCM_ICDR & SCM_BITS(n)) +#define SCM_ICDRP(n) (SCM_ICDR & SCM_UNPACK(n)) diff --git a/libguile/feature.h b/libguile/feature.h index d9132646e..5161db9c0 100644 --- a/libguile/feature.h +++ b/libguile/feature.h @@ -50,7 +50,7 @@ #include "libguile/__scm.h" #define SCM_HOOKP(x) (SCM_NIMP(x) && (SCM_TYP16 (x) == scm_tc16_hook)) -#define SCM_HOOK_ARITY(hook) (SCM_CARBITS (hook) >> 16) +#define SCM_HOOK_ARITY(hook) (SCM_UNPACK_CAR (hook) >> 16) #define SCM_HOOK_NAME(hook) SCM_CADR (hook) #define SCM_HOOK_PROCEDURES(hook) SCM_CDDR (hook) #define SCM_SET_HOOK_PROCEDURES(hook, procs) SCM_SETCDR (SCM_CDR (hook), procs) diff --git a/libguile/filesys.h b/libguile/filesys.h index 1b4e2773e..6d3ea1fcd 100644 --- a/libguile/filesys.h +++ b/libguile/filesys.h @@ -54,7 +54,7 @@ extern long scm_tc16_dir; #define SCM_DIRP(x) (SCM_NIMP(x) && (SCM_TYP16(x)==(scm_tc16_dir))) -#define SCM_OPDIRP(x) (SCM_NIMP(x) && (SCM_CARBITS(x)==(scm_tc16_dir | SCM_OPN))) +#define SCM_OPDIRP(x) (SCM_NIMP(x) && (SCM_UNPACK_CAR(x)==(scm_tc16_dir | SCM_OPN))) extern SCM scm_chown (SCM object, SCM owner, SCM group); diff --git a/libguile/fluids.h b/libguile/fluids.h index 94f522bd1..d2f3d5dde 100644 --- a/libguile/fluids.h +++ b/libguile/fluids.h @@ -75,8 +75,8 @@ extern long scm_tc16_fluid; -#define SCM_FLUIDP(x) (SCM_NIMP(x) && (SCM_CARBITS (x) == scm_tc16_fluid)) -#define SCM_FLUID_NUM(x) SCM_BITS (SCM_CDR(x)) +#define SCM_FLUIDP(x) (SCM_NIMP(x) && (SCM_UNPACK_CAR (x) == scm_tc16_fluid)) +#define SCM_FLUID_NUM(x) SCM_UNPACK (SCM_CDR(x)) /* The fastest way to acces/modify the value of a fluid. These macros do no error checking at all. You should only use them when you know diff --git a/libguile/fports.c b/libguile/fports.c index 09a7c82ff..5a1205f19 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -124,9 +124,9 @@ scm_fport_buffer_add (SCM port, int read_size, int write_size) pt->write_end = pt->write_buf + pt->write_buf_size; if (read_size > 0 || write_size > 0) - SCM_SETCAR (port, SCM_CARBITS (port) & ~SCM_BUF0); + SCM_SETCAR (port, SCM_UNPACK_CAR (port) & ~SCM_BUF0); else - SCM_SETCAR (port, (SCM_CARBITS (port) | SCM_BUF0)); + SCM_SETCAR (port, (SCM_UNPACK_CAR (port) | SCM_BUF0)); } SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0, @@ -180,12 +180,12 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0, if (cmode == _IOLBF) { - SCM_SETCAR (port, SCM_CARBITS (port) | SCM_BUFLINE); + SCM_SETCAR (port, SCM_UNPACK_CAR (port) | SCM_BUFLINE); cmode = _IOFBF; } else { - SCM_SETCAR (port, SCM_CARBITS (port) ^ SCM_BUFLINE); + SCM_SETCAR (port, SCM_UNPACK_CAR (port) ^ SCM_BUFLINE); } if (SCM_UNBNDP (size)) @@ -456,7 +456,7 @@ prinfport (SCM exp,SCM port,scm_print_state *pstate) { scm_puts (SCM_PTOBNAME (SCM_PTOBNUM (exp)), port); scm_putc (' ', port); - scm_intprint (SCM_BITS (SCM_CDR (exp)), 16, port); + scm_intprint (SCM_UNPACK (SCM_CDR (exp)), 16, port); } scm_putc ('>', port); return 1; @@ -610,7 +610,7 @@ fport_write (SCM port, const void *data, size_t size) } /* handle line buffering. */ - if ((SCM_CARBITS (port) & SCM_BUFLINE) && memchr (data, '\n', size)) + if ((SCM_UNPACK_CAR (port) & SCM_BUFLINE) && memchr (data, '\n', size)) fport_flush (port); } } diff --git a/libguile/fports.h b/libguile/fports.h index c71eb6fbb..d490f3b83 100644 --- a/libguile/fports.h +++ b/libguile/fports.h @@ -62,9 +62,9 @@ struct scm_fport { #define SCM_FPORT_FDES(x) (SCM_FSTREAM (x)->fdes) #define SCM_FPORTP(x) (SCM_NIMP(x) && (SCM_TYP16S(x)==scm_tc7_port)) -#define SCM_OPFPORTP(x) (SCM_NIMP(x) && (((0xfeff | SCM_OPN) & SCM_CARBITS (x))==(scm_tc7_port | SCM_OPN))) -#define SCM_OPINFPORTP(x) (SCM_NIMP(x) && (((0xfeff | SCM_OPN | SCM_RDNG) & SCM_CARBITS (x))==(scm_tc7_port | SCM_OPN | SCM_RDNG))) -#define SCM_OPOUTFPORTP(x) (SCM_NIMP(x) && (((0xfeff | SCM_OPN | SCM_WRTNG) & SCM_CARBITS (x))==(scm_tc7_port | SCM_OPN | SCM_WRTNG))) +#define SCM_OPFPORTP(x) (SCM_NIMP(x) && (((0xfeff | SCM_OPN) & SCM_UNPACK_CAR (x))==(scm_tc7_port | SCM_OPN))) +#define SCM_OPINFPORTP(x) (SCM_NIMP(x) && (((0xfeff | SCM_OPN | SCM_RDNG) & SCM_UNPACK_CAR (x))==(scm_tc7_port | SCM_OPN | SCM_RDNG))) +#define SCM_OPOUTFPORTP(x) (SCM_NIMP(x) && (((0xfeff | SCM_OPN | SCM_WRTNG) & SCM_UNPACK_CAR (x))==(scm_tc7_port | SCM_OPN | SCM_WRTNG))) /* test whether fdes supports random access. */ #define SCM_FDES_RANDOM_P(fdes) ((lseek (fdes, 0, SEEK_CUR) == -1) ? 0 : 1) diff --git a/libguile/gc.c b/libguile/gc.c index 1a2ebd190..f043599a6 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -668,7 +668,7 @@ gc_mark_nimp: { SCM vcell; vcell = SCM_CAR (ptr) - 1L; - switch (SCM_BITS (SCM_CDR (vcell))) + switch (SCM_UNPACK (SCM_CDR (vcell))) { default: scm_gc_mark (vcell); @@ -692,7 +692,7 @@ gc_mark_nimp: that it removes the mark */ mem = (SCM *)SCM_GCCDR (ptr); - if (SCM_BITS (vtable_data[scm_struct_i_flags]) & SCM_STRUCTF_ENTITY) + if (SCM_UNPACK (vtable_data[scm_struct_i_flags]) & SCM_STRUCTF_ENTITY) { scm_gc_mark (mem[scm_struct_i_procedure]); scm_gc_mark (mem[scm_struct_i_setter]); @@ -1140,7 +1140,7 @@ scm_gc_sweep () SCM vcell; vcell = SCM_CAR (scmptr) - 1L; - if ((SCM_CDR (vcell) == 0) || (SCM_BITS (SCM_CDR (vcell)) == 1)) + if ((SCM_CDR (vcell) == 0) || (SCM_UNPACK (SCM_CDR (vcell)) == 1)) { scm_struct_free_t free = (scm_struct_free_t) ((SCM*) vcell)[scm_struct_i_free]; @@ -1292,7 +1292,7 @@ scm_gc_sweep () case scm_tc16_flo: if SCM_GC8MARKP (scmptr) goto c8mrkcontinue; - switch ((int) (SCM_CARBITS (scmptr) >> 16)) + switch ((int) (SCM_UNPACK_CAR (scmptr) >> 16)) { case (SCM_IMAG_PART | SCM_REAL_PART) >> 16: m += sizeof (double); @@ -1784,7 +1784,7 @@ SCM_DEFINE (scm_unhash_name, "unhash-name", 1, 0, 0, --incar; if ( ((name == SCM_BOOL_T) || (SCM_CAR (incar) == name)) && (SCM_CDR (incar) != 0) - && (SCM_BITS (SCM_CDR (incar)) != 1)) + && (SCM_UNPACK (SCM_CDR (incar)) != 1)) { p->car = name; } diff --git a/libguile/gc.h b/libguile/gc.h index ea5b8d1f1..797fe487f 100644 --- a/libguile/gc.h +++ b/libguile/gc.h @@ -50,12 +50,12 @@ #include "libguile/__scm.h" -#define SCM_FREEP(x) (SCM_NIMP(x) && SCM_CARBITS (x)==scm_tc_free_cell) +#define SCM_FREEP(x) (SCM_NIMP(x) && SCM_UNPACK_CAR (x)==scm_tc_free_cell) #define SCM_NFREEP(x) (!SCM_FREEP(x)) /* 1. This shouldn't be used on immediates. 2. It thinks that subrs are always unmarked (harmless). */ -#define SCM_MARKEDP(x) ((SCM_CARBITS (x) & 5) == 5 \ +#define SCM_MARKEDP(x) ((SCM_UNPACK_CAR (x) & 5) == 5 \ ? SCM_GC8MARKP(x) \ : SCM_GCMARKP(x)) #define SCM_NMARKEDP(x) (!SCM_MARKEDP(x)) diff --git a/libguile/hash.c b/libguile/hash.c index 72aa4ef85..3d55c69d8 100644 --- a/libguile/hash.c +++ b/libguile/hash.c @@ -140,7 +140,7 @@ scm_hasher(SCM obj, unsigned long n, scm_sizet d) if (d) return (scm_hasher(SCM_CAR(obj), n, d/2)+scm_hasher(SCM_CDR(obj), n, d/2)) % n; else return 1; case scm_tc7_port: - return ((SCM_RDNG & SCM_CARBITS(obj)) ? 260 : 261) % n; + return ((SCM_RDNG & SCM_UNPACK_CAR(obj)) ? 260 : 261) % n; case scm_tcs_closures: case scm_tc7_contin: case scm_tcs_subrs: diff --git a/libguile/keywords.h b/libguile/keywords.h index cd6020971..6270125cf 100644 --- a/libguile/keywords.h +++ b/libguile/keywords.h @@ -52,7 +52,7 @@ extern int scm_tc16_keyword; -#define SCM_KEYWORDP(X) (SCM_NIMP(X) && (SCM_CARBITS (X) == scm_tc16_keyword)) +#define SCM_KEYWORDP(X) (SCM_NIMP(X) && (SCM_UNPACK_CAR (X) == scm_tc16_keyword)) #define SCM_KEYWORDSYM(X) (SCM_CDR(X)) diff --git a/libguile/macros.c b/libguile/macros.c index 9da48ecd0..e04539bb9 100644 --- a/libguile/macros.c +++ b/libguile/macros.c @@ -134,7 +134,7 @@ SCM_DEFINE (scm_macro_type, "macro-type", 1, 0, 0, { if (!(SCM_NIMP (m) && SCM_TYP16 (m) == scm_tc16_macro)) return SCM_BOOL_F; - switch ((int) (SCM_CARBITS (m) >> 16)) + switch ((int) (SCM_UNPACK_CAR (m) >> 16)) { case 0: return scm_sym_syntax; case 1: return scm_sym_macro; diff --git a/libguile/numbers.c b/libguile/numbers.c index ed93fcc81..0ed3e5207 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -201,7 +201,7 @@ scm_quotient (SCM x, SCM y) z = -z; if (z < SCM_BIGRAD) { - SCM sw = scm_copybig (x, SCM_BIGSIGN (x) ? (SCM_BITS (y) > 0) : (SCM_BITS (y) < 0)); + SCM sw = scm_copybig (x, SCM_BIGSIGN (x) ? (SCM_UNPACK (y) > 0) : (SCM_UNPACK (y) < 0)); scm_divbigdig (SCM_BDIGITS (sw), SCM_NUMDIGS (sw), (SCM_BIGDIG) z); return scm_normbig (sw); } @@ -1079,7 +1079,7 @@ SCM_DEFINE (scm_ash, "ash", 2, 0, 0, #define FUNC_NAME s_scm_ash { /* GJB:FIXME:: what is going on here? */ - SCM res = SCM_SCM (SCM_INUM (n)); + SCM res = SCM_PACK (SCM_INUM (n)); SCM_VALIDATE_INUM (2,cnt); #ifdef SCM_BIGDIG if (cnt < 0) @@ -1554,7 +1554,7 @@ scm_addbig (SCM_BIGDIG *x, scm_sizet nx, int xsgn, SCM bigy, int sgny) { num = 1; i = 0; - SCM_SETCAR (z, SCM_CARBITS (z) ^ 0x0100); + SCM_SETCAR (z, SCM_UNPACK_CAR (z) ^ 0x0100); do { num += (SCM_BIGRAD - 1) - zds[i]; @@ -4207,7 +4207,7 @@ scm_divide (SCM x, SCM y) SCM_BIGSIGN (x) ? (y > 0) : (y < 0), 3); } #endif - return z ? SCM_SCM (z) : scm_makdbl (scm_big2dbl (x) / SCM_INUM (y), 0.0); + return z ? SCM_PACK (z) : scm_makdbl (scm_big2dbl (x) / SCM_INUM (y), 0.0); } SCM_ASRTGO (SCM_NIMP (y), bady); if (SCM_BIGP (y)) diff --git a/libguile/numbers.h b/libguile/numbers.h index 35fe9a008..bbc20d5e8 100644 --- a/libguile/numbers.h +++ b/libguile/numbers.h @@ -71,9 +71,9 @@ /* shifts of more than one are done by a library call, single shifts are * performed in registers */ -# define SCM_MAKINUM(x) ((SCM) (((SCM_BITS(x)<<1)<<1)+2L)) +# define SCM_MAKINUM(x) ((SCM) (((SCM_UNPACK(x)<<1)<<1)+2L)) #else -# define SCM_MAKINUM(x) ((SCM)((SCM_BITS(x)<<2)+2L)) +# define SCM_MAKINUM(x) ((SCM)((SCM_UNPACK(x)<<2)+2L)) #endif /* def __TURBOC__ */ @@ -85,14 +85,14 @@ #if (-1==(((-1)<<2)+2)>>2) && (__TURBOC__ != 0x295) # define SCM_SRS(x, y) ((x) >> y) # ifdef __TURBOC__ -# define SCM_INUM(x) ((SCM_BITS (x) >>1) >>1) +# define SCM_INUM(x) ((SCM_UNPACK (x) >>1) >>1) # else -# define SCM_INUM(x) SCM_SRS (SCM_BITS (x), 2) +# define SCM_INUM(x) SCM_SRS (SCM_UNPACK (x), 2) # endif /* def __TURBOC__ */ #else # define SCM_SRS(x, y)\ - ((SCM_BITS (x) < 0) ? ~( (~SCM_BITS (x)) >> y) : (SCM_BITS (x) >> y)) -# define SCM_INUM(x) SCM_SRS (SCM_BITS (x), 2) + ((SCM_UNPACK (x) < 0) ? ~( (~SCM_UNPACK (x)) >> y) : (SCM_UNPACK (x) >> y)) +# define SCM_INUM(x) SCM_SRS (SCM_UNPACK (x), 2) #endif /* (-1==(((-1)<<2)+2)>>2) && (__TURBOC__ != 0x295) */ @@ -134,15 +134,15 @@ */ #define SCM_INEXP(x) (SCM_NIMP(x) && (SCM_TYP16(x)==scm_tc16_flo)) -#define SCM_CPLXP(x) (SCM_NIMP(x) && (SCM_CARBITS (x)==scm_tc_dblc)) +#define SCM_CPLXP(x) (SCM_NIMP(x) && (SCM_UNPACK_CAR (x)==scm_tc_dblc)) #define SCM_REAL(x) (*(((scm_dbl *) (SCM2PTR(x)))->real)) #define SCM_IMAG(x) (*((double *)(SCM_CHARS(x)+sizeof(double)))) /* ((&SCM_REAL(x))[1]) */ #ifdef SCM_SINGLES -#define SCM_REALP(x) (SCM_NIMP(x) && ((~SCM_REAL_PART & SCM_CARBITS (x))==scm_tc_flo)) -#define SCM_SINGP(x) (SCM_NIMP(x) && (SCM_CARBITS (x)==scm_tc_flo)) +#define SCM_REALP(x) (SCM_NIMP(x) && ((~SCM_REAL_PART & SCM_UNPACK_CAR (x))==scm_tc_flo)) +#define SCM_SINGP(x) (SCM_NIMP(x) && (SCM_UNPACK_CAR (x)==scm_tc_flo)) #define SCM_FLO(x) (((scm_flo *)(SCM2PTR(x)))->num) #define SCM_REALPART(x) (SCM_SINGP(x)?0.0+SCM_FLO(x):SCM_REAL(x)) #else /* SCM_SINGLES */ @@ -218,7 +218,7 @@ #define SCM_BIGP(x) (SCM_NIMP(x) && SCM_TYP16S(x)==scm_tc16_bigpos) #define SCM_BIGSIGN(x) (0x0100 & (int)SCM_CAR(x)) #define SCM_BDIGITS(x) ((SCM_BIGDIG *)(SCM_CDR(x))) -#define SCM_NUMDIGS(x) ((scm_sizet)(SCM_CARBITS (x)>>16)) +#define SCM_NUMDIGS(x) ((scm_sizet)(SCM_UNPACK_CAR (x)>>16)) #define SCM_SETNUMDIGS(x, v, t) SCM_SETCAR(x, (((v)+0L)<<16)+(t)) diff --git a/libguile/objects.c b/libguile/objects.c index 416e58fdc..5026f3b66 100644 --- a/libguile/objects.c +++ b/libguile/objects.c @@ -160,7 +160,7 @@ scm_class_of (SCM x) long type = SCM_TYP16 (x); if (type == scm_tc16_flo) { - if (SCM_CARBITS (x) & SCM_IMAG_PART) + if (SCM_UNPACK_CAR (x) & SCM_IMAG_PART) return scm_class_complex; else return scm_class_real; @@ -171,8 +171,8 @@ scm_class_of (SCM x) /* fall through to ports */ } case scm_tc7_port: - return scm_port_class[(SCM_WRTNG & SCM_CARBITS (x) - ? (SCM_RDNG & SCM_CARBITS (x) + return scm_port_class[(SCM_WRTNG & SCM_UNPACK_CAR (x) + ? (SCM_RDNG & SCM_UNPACK_CAR (x) ? SCM_INOUT_PCLASS_INDEX | SCM_PTOBNUM (x) : SCM_OUT_PCLASS_INDEX | SCM_PTOBNUM (x)) : SCM_IN_PCLASS_INDEX | SCM_PTOBNUM (x))]; @@ -280,7 +280,7 @@ scm_mcache_lookup_cmethod (SCM cache, SCM args) if (SCM_NIMP (ls)) do { - i += SCM_BITS (SCM_STRUCT_DATA (scm_class_of (SCM_CAR (ls))) + i += SCM_UNPACK (SCM_STRUCT_DATA (scm_class_of (SCM_CAR (ls))) [scm_si_hashsets + hashset]); ls = SCM_CDR (ls); } diff --git a/libguile/objects.h b/libguile/objects.h index 92ce44d8f..dab20a467 100644 --- a/libguile/objects.h +++ b/libguile/objects.h @@ -68,9 +68,9 @@ * graph would be too costly. */ #define SCM_CLASS_FLAGS(class)\ - SCM_BITS (SCM_STRUCT_DATA (class)[scm_struct_i_flags]) + SCM_UNPACK (SCM_STRUCT_DATA (class)[scm_struct_i_flags]) #define SCM_OBJ_CLASS_FLAGS(obj)\ - SCM_BITS (SCM_STRUCT_VTABLE_DATA (obj)[scm_struct_i_flags]) + SCM_UNPACK (SCM_STRUCT_VTABLE_DATA (obj)[scm_struct_i_flags]) #define SCM_SET_CLASS_FLAGS(c, f) (SCM_CLASS_FLAGS (c) |= (f)) #define SCM_CLEAR_CLASS_FLAGS(c, f) (SCM_CLASS_FLAGS (c) &= ~(f)) #define SCM_CLASSF_MASK SCM_STRUCTF_MASK @@ -98,7 +98,7 @@ #define SCM_SET_CLASS_DESTRUCTOR(c, d) SCM_SET_VTABLE_DESTRUCTOR (c, d) #define SCM_SET_CLASS_INSTANCE_SIZE(c, s) \ (SCM_STRUCT_DATA (c)[scm_struct_i_size] \ - = SCM_SCM ((SCM_BITS (SCM_STRUCT_DATA (c)[scm_struct_i_size])\ + = SCM_PACK ((SCM_UNPACK (SCM_STRUCT_DATA (c)[scm_struct_i_size])\ & SCM_STRUCTF_MASK)\ | s)) diff --git a/libguile/options.c b/libguile/options.c index 5ac0a4323..c8b89bd74 100644 --- a/libguile/options.c +++ b/libguile/options.c @@ -186,7 +186,7 @@ scm_options (SCM arg, scm_option options[], int n, const char *s) goto cont; case SCM_OPTION_SCM: new_mode = SCM_CDR (new_mode); - flags[i] = SCM_CARBITS (new_mode); + flags[i] = SCM_UNPACK_CAR (new_mode); goto cont; } #ifndef SCM_RECKLESS @@ -201,8 +201,8 @@ scm_options (SCM arg, scm_option options[], int n, const char *s) // scm_option doesn't know if its a long or an SCM if (options[i].type == SCM_OPTION_SCM) SCM_SETCDR (protected_objects, - scm_cons (SCM_SCM(flags[i]), - scm_delq1_x (SCM_SCM(options[i].val), + scm_cons (SCM_PACK(flags[i]), + scm_delq1_x (SCM_PACK(options[i].val), SCM_CDR (protected_objects)))); options[i].val = flags[i]; } @@ -224,7 +224,7 @@ scm_init_opts (SCM (*func) (SCM), scm_option options[], int n) (options[i].doc)); if (options[i].type == SCM_OPTION_SCM) SCM_SETCDR (protected_objects, - scm_cons (SCM_SCM(options[i].val), SCM_CDR (protected_objects))); + scm_cons (SCM_PACK(options[i].val), SCM_CDR (protected_objects))); } func (SCM_UNDEFINED); } diff --git a/libguile/pairs.h b/libguile/pairs.h index 38e9a0523..40af8ce62 100644 --- a/libguile/pairs.h +++ b/libguile/pairs.h @@ -104,21 +104,21 @@ typedef SCM huge *SCMPTR; #define SCM_CAR(x) (((scm_cell *)(SCM2PTR(x)))->car) #define SCM_CDR(x) (((scm_cell *)(SCM2PTR(x)))->cdr) -#define SCM_GCCDR(x) SCM_SCM(~1L & SCM_BITS (SCM_CDR(x))) -#define SCM_SETCAR(x, v) (SCM_CAR(x) = SCM_SCM(v)) -#define SCM_SETCDR(x, v) (SCM_CDR(x) = SCM_SCM(v)) +#define SCM_GCCDR(x) SCM_PACK(~1L & SCM_UNPACK (SCM_CDR(x))) +#define SCM_SETCAR(x, v) (SCM_CAR(x) = SCM_PACK(v)) +#define SCM_SETCDR(x, v) (SCM_CDR(x) = SCM_PACK(v)) #define SCM_CARLOC(x) (&SCM_CAR (x)) #define SCM_CDRLOC(x) (&SCM_CDR (x)) #define SCM_SETAND_CAR(x, y)\ - (SCM_CAR (x) = SCM_SCM (SCM_BITS (SCM_CAR (x)) & (y))) + (SCM_CAR (x) = SCM_PACK (SCM_UNPACK (SCM_CAR (x)) & (y))) #define SCM_SETAND_CDR(x, y)\ - (SCM_CDR (x) = SCM_SCM (SCM_BITS (SCM_CDR (x)) & (y))) + (SCM_CDR (x) = SCM_PACK (SCM_UNPACK (SCM_CDR (x)) & (y))) #define SCM_SETOR_CAR(x, y)\ - (SCM_CAR (x) = SCM_SCM (SCM_BITS (SCM_CAR (x)) | (y))) + (SCM_CAR (x) = SCM_PACK (SCM_UNPACK (SCM_CAR (x)) | (y))) #define SCM_SETOR_CDR(x, y)\ - (SCM_CDR (x) = SCM_SCM (SCM_BITS (SCM_CDR (x)) | (y))) + (SCM_CDR (x) = SCM_PACK (SCM_UNPACK (SCM_CDR (x)) | (y))) #define SCM_CAAR(OBJ) SCM_CAR (SCM_CAR (OBJ)) #define SCM_CDAR(OBJ) SCM_CDR (SCM_CAR (OBJ)) diff --git a/libguile/ports.c b/libguile/ports.c index 40112562a..43fc5dfbb 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -89,7 +89,7 @@ SCM scm_markstream (SCM ptr) { int openp; - openp = SCM_CARBITS (ptr) & SCM_OPN; + openp = SCM_UNPACK_CAR (ptr) & SCM_OPN; if (openp) return SCM_STREAM (ptr); else @@ -568,15 +568,15 @@ SCM_DEFINE (scm_port_mode, "port-mode", 1, 0, 0, port = SCM_COERCE_OUTPORT (port); SCM_VALIDATE_OPPORT (1,port); - if (SCM_CARBITS (port) & SCM_RDNG) { - if (SCM_CARBITS (port) & SCM_WRTNG) + if (SCM_UNPACK_CAR (port) & SCM_RDNG) { + if (SCM_UNPACK_CAR (port) & SCM_WRTNG) strcpy (modes, "r+"); else strcpy (modes, "r"); } - else if (SCM_CARBITS (port) & SCM_WRTNG) + else if (SCM_UNPACK_CAR (port) & SCM_WRTNG) strcpy (modes, "w"); - if (SCM_CARBITS (port) & SCM_BUF0) + if (SCM_UNPACK_CAR (port) & SCM_BUF0) strcat (modes, "0"); return scm_makfromstr (modes, strlen (modes), 0); } @@ -1252,11 +1252,11 @@ scm_print_port_mode (SCM exp, SCM port) { scm_puts (SCM_CLOSEDP (exp) ? "closed: " - : (SCM_RDNG & SCM_CARBITS (exp) - ? (SCM_WRTNG & SCM_CARBITS (exp) + : (SCM_RDNG & SCM_UNPACK_CAR (exp) + ? (SCM_WRTNG & SCM_UNPACK_CAR (exp) ? "input-output: " : "input: ") - : (SCM_WRTNG & SCM_CARBITS (exp) + : (SCM_WRTNG & SCM_UNPACK_CAR (exp) ? "output: " : "bogus: ")), port); diff --git a/libguile/ports.h b/libguile/ports.h index 7f0e1cd8e..53555bdcf 100644 --- a/libguile/ports.h +++ b/libguile/ports.h @@ -154,12 +154,12 @@ extern int scm_port_table_size; /* Number of ports in scm_port_table. */ #define SCM_BUFLINE (64L<<16) /* Is it line-buffered? */ #define SCM_PORTP(x) (SCM_NIMP(x) && (SCM_TYP7(x)==scm_tc7_port)) -#define SCM_OPPORTP(x) (SCM_NIMP(x) && (((0x7f | SCM_OPN) & SCM_CARBITS(x))==(scm_tc7_port | SCM_OPN))) -#define SCM_OPINPORTP(x) (SCM_NIMP(x) && (((0x7f | SCM_OPN | SCM_RDNG) & SCM_CARBITS(x))==(scm_tc7_port | SCM_OPN | SCM_RDNG))) -#define SCM_OPOUTPORTP(x) (SCM_NIMP(x) && (((0x7f | SCM_OPN | SCM_WRTNG) & SCM_CARBITS(x))==(scm_tc7_port | SCM_OPN | SCM_WRTNG))) -#define SCM_INPORTP(x) (SCM_NIMP(x) && (((0x7f | SCM_RDNG) & SCM_CARBITS(x))==(scm_tc7_port | SCM_RDNG))) -#define SCM_OUTPORTP(x) (SCM_NIMP(x) && (((0x7f | SCM_WRTNG) & SCM_CARBITS(x))==(scm_tc7_port | SCM_WRTNG))) -#define SCM_OPENP(x) (SCM_NIMP(x) && (SCM_OPN & SCM_CARBITS (x))) +#define SCM_OPPORTP(x) (SCM_NIMP(x) && (((0x7f | SCM_OPN) & SCM_UNPACK_CAR(x))==(scm_tc7_port | SCM_OPN))) +#define SCM_OPINPORTP(x) (SCM_NIMP(x) && (((0x7f | SCM_OPN | SCM_RDNG) & SCM_UNPACK_CAR(x))==(scm_tc7_port | SCM_OPN | SCM_RDNG))) +#define SCM_OPOUTPORTP(x) (SCM_NIMP(x) && (((0x7f | SCM_OPN | SCM_WRTNG) & SCM_UNPACK_CAR(x))==(scm_tc7_port | SCM_OPN | SCM_WRTNG))) +#define SCM_INPORTP(x) (SCM_NIMP(x) && (((0x7f | SCM_RDNG) & SCM_UNPACK_CAR(x))==(scm_tc7_port | SCM_RDNG))) +#define SCM_OUTPORTP(x) (SCM_NIMP(x) && (((0x7f | SCM_WRTNG) & SCM_UNPACK_CAR(x))==(scm_tc7_port | SCM_WRTNG))) +#define SCM_OPENP(x) (SCM_NIMP(x) && (SCM_OPN & SCM_UNPACK_CAR (x))) #define SCM_CLOSEDP(x) (!SCM_OPENP(x)) #define SCM_PTAB_ENTRY(x) ((scm_port *) SCM_CDR(x)) #define SCM_SETPTAB_ENTRY(x,ent) SCM_SETCDR ((x), (SCM)(ent)) @@ -199,7 +199,7 @@ typedef struct scm_ptob_descriptor } scm_ptob_descriptor; -#define SCM_TC2PTOBNUM(x) (0x0ff & (SCM_BITS(x) >> 8)) +#define SCM_TC2PTOBNUM(x) (0x0ff & (SCM_UNPACK(x) >> 8)) #define SCM_PTOBNUM(x) (SCM_TC2PTOBNUM (SCM_CAR (x))) /* SCM_PTOBNAME can be 0 if name is missing */ #define SCM_PTOBNAME(ptobnum) scm_ptobs[ptobnum].name diff --git a/libguile/print.c b/libguile/print.c index 746c0079c..ee2528471 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -123,7 +123,7 @@ char *scm_isymnames[] = }; scm_option scm_print_opts[] = { - { SCM_OPTION_SCM, "closure-hook", SCM_BITS(SCM_BOOL_F), + { SCM_OPTION_SCM, "closure-hook", SCM_UNPACK(SCM_BOOL_F), "Hook for printing closures." }, { SCM_OPTION_BOOLEAN, "source", 0, "Print closures with source." } @@ -404,11 +404,11 @@ taloop: env = SCM_ENV (SCM_CDR (exp)); scm_puts ("#<", port); } - if (SCM_CARBITS(exp) & (3L << 16)) + if (SCM_UNPACK_CAR(exp) & (3L << 16)) scm_puts ("macro", port); else scm_puts ("syntax", port); - if (SCM_CARBITS (exp) & (2L << 16)) + if (SCM_UNPACK_CAR (exp) & (2L << 16)) scm_putc ('!', port); } else diff --git a/libguile/procs.h b/libguile/procs.h index f282598b2..b360bbe41 100644 --- a/libguile/procs.h +++ b/libguile/procs.h @@ -84,7 +84,7 @@ typedef struct SCM documentation; } scm_subr_entry; -#define SCM_SUBRNUM(subr) (SCM_CARBITS (subr) >> 8) +#define SCM_SUBRNUM(subr) (SCM_UNPACK_CAR (subr) >> 8) #define SCM_SET_SUBRNUM(subr, num) \ SCM_SETCAR (subr, (num >> 8) + SCM_TYP7 (subr)) #define SCM_SUBR_ENTRY(x) (scm_subr_table[SCM_SUBRNUM (x)]) @@ -101,7 +101,7 @@ typedef struct */ #define SCM_CLOSUREP(x) (SCM_NIMP(x) && (SCM_TYP3 (x) == scm_tc3_closure)) -#define SCM_CLOSCAR(x) SCM_SCM (SCM_CARBITS (x) - scm_tc3_closure) +#define SCM_CLOSCAR(x) SCM_PACK (SCM_UNPACK_CAR (x) - scm_tc3_closure) #define SCM_CODE(x) SCM_CAR (SCM_CLOSCAR (x)) #define SCM_PROCPROPS(x) SCM_CDR (SCM_CLOSCAR (x)) #define SCM_SETPROCPROPS(x, p) SCM_SETCDR (SCM_CLOSCAR (x), p) diff --git a/libguile/ramap.c b/libguile/ramap.c index 43838f952..5c6c97d3e 100644 --- a/libguile/ramap.c +++ b/libguile/ramap.c @@ -1305,7 +1305,7 @@ ramap_cxr (SCM ra0,SCM proc,SCM ras) case scm_tc7_uvect: case scm_tc7_ivect: for (; n-- > 0; i0 += inc0, i1 += inc1) - dst[i0] = SCM_DSUBRF (proc) (SCM_BITS (SCM_VELTS (ra1)[i1])); + dst[i0] = SCM_DSUBRF (proc) (SCM_UNPACK (SCM_VELTS (ra1)[i1])); break; } break; @@ -1325,7 +1325,7 @@ ramap_cxr (SCM ra0,SCM proc,SCM ras) case scm_tc7_uvect: case scm_tc7_ivect: for (; n-- > 0; i0 += inc0, i1 += inc1) - dst[i0] = SCM_DSUBRF (proc) (SCM_BITS (SCM_VELTS (ra1)[i1])); + dst[i0] = SCM_DSUBRF (proc) (SCM_UNPACK (SCM_VELTS (ra1)[i1])); break; } break; diff --git a/libguile/read.c b/libguile/read.c index 171df758f..5edfcf709 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -70,7 +70,7 @@ scm_option scm_read_opts[] = { "Record positions of source code expressions." }, { SCM_OPTION_BOOLEAN, "case-insensitive", 0, "Convert symbols to lower case."}, - { SCM_OPTION_SCM, "keywords", SCM_BITS (SCM_BOOL_F), + { SCM_OPTION_SCM, "keywords", SCM_UNPACK (SCM_BOOL_F), "Style of keyword recognition: #f or 'prefix"} }; @@ -489,7 +489,7 @@ tryagain_no_flush_ws: goto tok; case ':': - if (SCM_SCM (SCM_KEYWORD_STYLE) == scm_keyword_prefix) + if (SCM_PACK (SCM_KEYWORD_STYLE) == scm_keyword_prefix) { j = scm_read_token ('-', tok_buf, port, 0); p = scm_intern (SCM_CHARS (*tok_buf), j); diff --git a/libguile/smob.c b/libguile/smob.c index a92d4a9ea..0e0eeb138 100644 --- a/libguile/smob.c +++ b/libguile/smob.c @@ -116,7 +116,7 @@ scm_smob_print (SCM exp, SCM port, scm_print_state *pstate) scm_puts ("#<", port); scm_puts (SCM_SMOBNAME (n) ? SCM_SMOBNAME (n) : "smob", port); scm_putc (' ', port); - scm_intprint (SCM_BITS (scm_smobs[n].size ? SCM_CDR (exp) : exp), 16, port); + scm_intprint (SCM_UNPACK (scm_smobs[n].size ? SCM_CDR (exp) : exp), 16, port); scm_putc ('>', port); return 1; } diff --git a/libguile/smob.h b/libguile/smob.h index a50867e85..73921961c 100644 --- a/libguile/smob.h +++ b/libguile/smob.h @@ -87,7 +87,7 @@ do { \ #define SCM_SMOB_DATA(x) SCM_CDR (x) #define SCM_SET_SMOB_DATA(x, data) SCM_SETCDR (x, data) -#define SCM_TC2SMOBNUM(x) (0x0ff & (SCM_BITS(x) >> 8)) +#define SCM_TC2SMOBNUM(x) (0x0ff & (SCM_UNPACK(x) >> 8)) #define SCM_SMOBNUM(x) (SCM_TC2SMOBNUM (SCM_CAR (x))) /* SCM_SMOBNAME can be 0 if name is missing */ #define SCM_SMOBNAME(smobnum) scm_smobs[smobnum].name diff --git a/libguile/srcprop.h b/libguile/srcprop.h index dd894c461..c7de9a1e3 100644 --- a/libguile/srcprop.h +++ b/libguile/srcprop.h @@ -96,7 +96,7 @@ typedef struct scm_srcprops_chunk } scm_srcprops_chunk; #define SRCPROPSP(p) (SCM_NIMP(p) && (SCM_TYP16 (p) == scm_tc16_srcprops)) -#define SRCPROPBRK(p) (SCM_BOOL((1L << 16) & SCM_CARBITS (p))) +#define SRCPROPBRK(p) (SCM_BOOL((1L << 16) & SCM_UNPACK_CAR (p))) #define SRCPROPPOS(p) ((scm_srcprops *) SCM_CDR (p))->pos #define SRCPROPLINE(p) (SRCPROPPOS(p) >> 12) #define SRCPROPCOL(p) (SRCPROPPOS(p) & 0x0fffL) @@ -112,7 +112,7 @@ typedef struct scm_srcprops_chunk #define SRCBRKP(x) (SCM_NIMP (t.arg1 = scm_whash_lookup (scm_source_whash, (x)))\ && SRCPROPSP (t.arg1)\ - && ((1L << 16) & SCM_BITS (SCM_CAR (t.arg1)))) + && ((1L << 16) & SCM_UNPACK (SCM_CAR (t.arg1)))) #define PROCTRACEP(x) SCM_NFALSEP (scm_procedure_property (x, scm_sym_trace)) diff --git a/libguile/stacks.c b/libguile/stacks.c index 40494ff67..b516d4f23 100644 --- a/libguile/stacks.c +++ b/libguile/stacks.c @@ -188,7 +188,7 @@ stack_depth (scm_debug_frame *dframe,long offset,SCM *id,int *maxp) static void read_frame (scm_debug_frame *dframe,long offset,scm_info_frame *iframe) { - scm_bits_t flags = SCM_BITS (SCM_INUM0); /* UGh. */ + scm_bits_t flags = SCM_UNPACK (SCM_INUM0); /* UGh. */ int size; scm_debug_info *info; if (SCM_EVALFRAMEP (*dframe)) @@ -291,7 +291,7 @@ read_frames (scm_debug_frame *dframe,long offset,int n,scm_info_frame *iframes) && !SCM_UNBNDP (info[1].a.proc)) { NEXT_FRAME (iframe, n, quit); - iframe->flags = SCM_BITS(SCM_INUM0) | SCM_FRAMEF_PROC; + iframe->flags = SCM_UNPACK(SCM_INUM0) | SCM_FRAMEF_PROC; iframe->proc = info[1].a.proc; iframe->args = info[1].a.args; } @@ -303,12 +303,12 @@ read_frames (scm_debug_frame *dframe,long offset,int n,scm_info_frame *iframes) { if (!SCM_UNBNDP (info[1].a.proc)) { - iframe->flags = SCM_BITS(SCM_INUM0) | SCM_FRAMEF_PROC; + iframe->flags = SCM_UNPACK(SCM_INUM0) | SCM_FRAMEF_PROC; iframe->proc = info[1].a.proc; iframe->args = info[1].a.args; } else - iframe->flags = SCM_BITS (SCM_INUM0); + iframe->flags = SCM_UNPACK (SCM_INUM0); iframe->source = scm_make_memoized (info[0].e.exp, info[0].e.env); info -= 2; diff --git a/libguile/stacks.h b/libguile/stacks.h index 1bf39b9e4..747ebcc16 100644 --- a/libguile/stacks.h +++ b/libguile/stacks.h @@ -108,11 +108,11 @@ extern SCM scm_stack_type; #define SCM_FRAMEF_EVAL_ARGS (1L << 5) #define SCM_FRAMEF_OVERFLOW (1L << 6) -#define SCM_FRAME_VOID_P(frame) (SCM_BITS (SCM_FRAME_FLAGS (frame)) & SCM_FRAMEF_VOID) -#define SCM_FRAME_REAL_P(frame) (SCM_BITS (SCM_FRAME_FLAGS (frame)) & SCM_FRAMEF_REAL) -#define SCM_FRAME_PROC_P(frame) (SCM_BITS (SCM_FRAME_FLAGS (frame)) & SCM_FRAMEF_PROC) -#define SCM_FRAME_EVAL_ARGS_P(frame) (SCM_BITS (SCM_FRAME_FLAGS (frame)) & SCM_FRAMEF_EVAL_ARGS) -#define SCM_FRAME_OVERFLOW_P(frame) (SCM_BITS (SCM_FRAME_FLAGS (frame)) & SCM_FRAMEF_OVERFLOW) +#define SCM_FRAME_VOID_P(frame) (SCM_UNPACK (SCM_FRAME_FLAGS (frame)) & SCM_FRAMEF_VOID) +#define SCM_FRAME_REAL_P(frame) (SCM_UNPACK (SCM_FRAME_FLAGS (frame)) & SCM_FRAMEF_REAL) +#define SCM_FRAME_PROC_P(frame) (SCM_UNPACK (SCM_FRAME_FLAGS (frame)) & SCM_FRAMEF_PROC) +#define SCM_FRAME_EVAL_ARGS_P(frame) (SCM_UNPACK (SCM_FRAME_FLAGS (frame)) & SCM_FRAMEF_EVAL_ARGS) +#define SCM_FRAME_OVERFLOW_P(frame) (SCM_UNPACK (SCM_FRAME_FLAGS (frame)) & SCM_FRAMEF_OVERFLOW) diff --git a/libguile/strports.c b/libguile/strports.c index 15b40535d..20e2991fe 100644 --- a/libguile/strports.c +++ b/libguile/strports.c @@ -207,7 +207,7 @@ st_seek (SCM port, off_t offset, int whence) if (target >= pt->write_buf_size) { - if (!(SCM_CARBITS (port) & SCM_WRTNG)) + if (!(SCM_UNPACK_CAR (port) & SCM_WRTNG)) { if (target > pt->write_buf_size) { diff --git a/libguile/struct.c b/libguile/struct.c index d6d2ea02d..26c0c1196 100644 --- a/libguile/struct.c +++ b/libguile/struct.c @@ -173,7 +173,7 @@ scm_struct_init (SCM handle, int tail_elts, SCM inits) { tailp = 1; prot = prot == 'R' ? 'r' : prot == 'W' ? 'w' : 'o'; - *mem++ = SCM_SCM (tail_elts); + *mem++ = SCM_PACK (tail_elts); n_fields += tail_elts - 1; if (n_fields == 0) break; @@ -199,7 +199,7 @@ scm_struct_init (SCM handle, int tail_elts, SCM inits) *mem = 0; else { - *mem = SCM_SCM (scm_num2ulong (SCM_CAR (inits), + *mem = SCM_PACK (scm_num2ulong (SCM_CAR (inits), SCM_ARGn, "scm_struct_init")); inits = SCM_CDR (inits); @@ -326,7 +326,7 @@ scm_alloc_struct (int n_words, int n_extra, char *who) SCM *p = block + n_extra; /* Adjust it even further so it's aligned on an eight-byte boundary. */ - p = (SCM *) (((scm_bits_t) SCM_BITS (p) + 7) & ~7); + p = (SCM *) (((scm_bits_t) SCM_UNPACK (p) + 7) & ~7); /* Initialize a few fields as described above. */ p[scm_struct_i_free] = (SCM) scm_struct_free_standard; @@ -347,13 +347,13 @@ scm_sizet scm_struct_free_light (SCM *vtable, SCM *data) { free (data); - return SCM_BITS (vtable[scm_struct_i_size]) & ~SCM_STRUCTF_MASK; + return SCM_UNPACK (vtable[scm_struct_i_size]) & ~SCM_STRUCTF_MASK; } scm_sizet scm_struct_free_standard (SCM *vtable, SCM *data) { - size_t n = ((SCM_BITS (data[scm_struct_i_n_words]) + scm_struct_n_extra_words) + size_t n = ((SCM_UNPACK (data[scm_struct_i_n_words]) + scm_struct_n_extra_words) * sizeof (SCM) + 7); free ((void *) data[scm_struct_i_ptr]); return n; @@ -362,7 +362,7 @@ scm_struct_free_standard (SCM *vtable, SCM *data) scm_sizet scm_struct_free_entity (SCM *vtable, SCM *data) { - size_t n = (SCM_BITS(data[scm_struct_i_n_words] + scm_struct_entity_n_extra_words) + size_t n = (SCM_UNPACK(data[scm_struct_i_n_words] + scm_struct_entity_n_extra_words) * sizeof (SCM) + 7); free ((void *) data[scm_struct_i_ptr]); return n; @@ -396,7 +396,7 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1, tail_elts = SCM_INUM (tail_array_size); SCM_NEWCELL (handle); SCM_DEFER_INTS; - if (SCM_BITS (SCM_STRUCT_DATA (vtable)[scm_struct_i_flags]) & SCM_STRUCTF_ENTITY) + if (SCM_UNPACK (SCM_STRUCT_DATA (vtable)[scm_struct_i_flags]) & SCM_STRUCTF_ENTITY) { data = scm_alloc_struct (basic_size + tail_elts, scm_struct_entity_n_extra_words, @@ -535,7 +535,7 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0, p = SCM_INUM (pos); fields_desc = (unsigned char *) SCM_CHARS (layout); - n_fields = SCM_BITS (data[scm_struct_i_n_words]); + n_fields = SCM_UNPACK (data[scm_struct_i_n_words]); SCM_ASSERT_RANGE(1,pos, p < n_fields); @@ -563,7 +563,7 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0, switch (field_type) { case 'u': - answer = scm_ulong2num (SCM_BITS (data[p])); + answer = scm_ulong2num (SCM_UNPACK (data[p])); break; #if 0 @@ -612,7 +612,7 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0, p = SCM_INUM (pos); fields_desc = (unsigned char *)SCM_CHARS (layout); - n_fields = SCM_BITS (data[scm_struct_i_n_words]); + n_fields = SCM_UNPACK (data[scm_struct_i_n_words]); SCM_ASSERT_RANGE (1,pos, p < n_fields); @@ -635,7 +635,7 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0, switch (field_type) { case 'u': - data[p] = SCM_SCM (SCM_NUM2ULONG (3, val)); + data[p] = SCM_PACK (SCM_NUM2ULONG (3, val)); break; #if 0 @@ -699,7 +699,7 @@ scm_struct_ihashq (SCM obj, unsigned int n) { /* The length of the hash table should be a relative prime it's not necessary to shift down the address. */ - return SCM_BITS (obj) % n; + return SCM_UNPACK (obj) % n; } SCM diff --git a/libguile/struct.h b/libguile/struct.h index ca51267a7..9e7bfba47 100644 --- a/libguile/struct.h +++ b/libguile/struct.h @@ -79,7 +79,7 @@ typedef scm_sizet (*scm_struct_free_t) (SCM *vtable, SCM *data); #define SCM_STRUCTP(X) (SCM_NIMP(X) && (SCM_TYP3(X) == scm_tc3_cons_gloc)) #define SCM_STRUCT_DATA(X) ((SCM*)(SCM_CDR(X))) -#define SCM_STRUCT_VTABLE_DATA(X) ((SCM *)(SCM_BITS (SCM_CAR(X)) - 1)) +#define SCM_STRUCT_VTABLE_DATA(X) ((SCM *)(SCM_UNPACK (SCM_CAR(X)) - 1)) #define SCM_STRUCT_LAYOUT(X) (SCM_STRUCT_VTABLE_DATA(X)[scm_vtable_index_layout]) #define SCM_STRUCT_VTABLE(X) (SCM_STRUCT_VTABLE_DATA(X)[scm_vtable_index_vtable]) #define SCM_STRUCT_PRINTER(X) (SCM_STRUCT_VTABLE_DATA(X)[scm_vtable_index_printer]) diff --git a/libguile/tag.c b/libguile/tag.c index 76b15fdfd..17dd260fb 100644 --- a/libguile/tag.c +++ b/libguile/tag.c @@ -105,8 +105,8 @@ SCM_DEFINE (scm_tag, "tag", 1, 0, 0, return SCM_CDR (scm_utag_immediate_char) ; else { - SCM tag = SCM_MAKINUM ((SCM_BITS (x) >> 8) & 0xff); - return SCM_MAKINUM (SCM_INUM (SCM_CDR (scm_utag_flag_base) ) | (SCM_BITS (tag) << 8)); + SCM tag = SCM_MAKINUM ((SCM_UNPACK (x) >> 8) & 0xff); + return SCM_MAKINUM (SCM_INUM (SCM_CDR (scm_utag_flag_base) ) | (SCM_UNPACK (tag) << 8)); } case scm_tc3_cons: diff --git a/libguile/tags.h b/libguile/tags.h index dc416a98b..f0d953c16 100644 --- a/libguile/tags.h +++ b/libguile/tags.h @@ -65,16 +65,16 @@ typedef long scm_bits_t; #define SCM_VOIDP_TEST #ifndef SCM_VOIDP_TEST typedef scm_bits_t SCM; -#define SCM_BITS(x) (x) -#define SCM_SCM(x) (x) +#define SCM_UNPACK(x) (x) +#define SCM_PACK(x) (x) #else typedef void * SCM; -#define SCM_BITS(x) ((scm_bits_t) (x)) -#define SCM_SCM(x) ((SCM) (x)) +#define SCM_UNPACK(x) ((scm_bits_t) (x)) +#define SCM_PACK(x) ((SCM) (x)) #endif -/* SCM_CARBITS is a convenience for treating the CAR of X as a word */ -#define SCM_CARBITS(x) SCM_BITS (SCM_CAR (x)) +/* SCM_UNPACK_CAR is a convenience for treating the CAR of X as a word */ +#define SCM_UNPACK_CAR(x) SCM_UNPACK (SCM_CAR (x)) /* Cray machines have pointers that are incremented once for each word, @@ -123,7 +123,7 @@ typedef void * SCM; * (Not always impossible but it is fair to say that many details of tags * are mutually dependent). */ -#define SCM_IMP(x) (6 & SCM_BITS (x)) +#define SCM_IMP(x) (6 & SCM_UNPACK (x)) #define SCM_NIMP(x) (!SCM_IMP (x)) /* Here is a summary of tagging in SCM values as they might occur in @@ -281,7 +281,7 @@ typedef void * SCM; * stored in the SCM_CAR of a non-immediate object have a 1 in bit 1: */ -#define SCM_SLOPPY_NCONSP(x) (1 & SCM_CARBITS (x)) +#define SCM_SLOPPY_NCONSP(x) (1 & SCM_UNPACK_CAR (x)) #define SCM_SLOPPY_CONSP(x) (!SCM_SLOPPY_NCONSP (x)) #define SCM_NCONSP(x) (SCM_IMP (x) || SCM_SLOPPY_NCONSP (x)) @@ -303,13 +303,13 @@ typedef void * SCM; #define SCM_CELLP(x) (!SCM_NCELLP (x)) -#define SCM_NCELLP(x) ((sizeof (scm_cell) - 1) & SCM_BITS (x)) +#define SCM_NCELLP(x) ((sizeof (scm_cell) - 1) & SCM_UNPACK (x)) /* See numbers.h for macros relating to immediate integers. */ -#define SCM_ITAG3(x) (7 & SCM_BITS (x)) -#define SCM_TYP3(x) (7 & SCM_CARBITS (x)) +#define SCM_ITAG3(x) (7 & SCM_UNPACK (x)) +#define SCM_TYP3(x) (7 & SCM_UNPACK_CAR (x)) #define scm_tc3_cons 0 #define scm_tc3_cons_gloc 1 #define scm_tc3_int_1 2 @@ -325,20 +325,20 @@ typedef void * SCM; */ -#define SCM_TYP7(x) (0x7f & SCM_CARBITS (x)) -#define SCM_TYP7S(x) ((0x7f & ~2) & SCM_CARBITS (x)) +#define SCM_TYP7(x) (0x7f & SCM_UNPACK_CAR (x)) +#define SCM_TYP7S(x) ((0x7f & ~2) & SCM_UNPACK_CAR (x)) -#define SCM_TYP16(x) (0xffff & SCM_CARBITS (x)) -#define SCM_TYP16S(x) (0xfeff & SCM_CARBITS (x)) -#define SCM_GCTYP16(x) (0xff7f & SCM_CARBITS (x)) +#define SCM_TYP16(x) (0xffff & SCM_UNPACK_CAR (x)) +#define SCM_TYP16S(x) (0xfeff & SCM_UNPACK_CAR (x)) +#define SCM_GCTYP16(x) (0xff7f & SCM_UNPACK_CAR (x)) /* Testing and Changing GC Marks in Various Standard Positions */ -#define SCM_GCMARKP(x) (1 & SCM_BITS (SCM_CDR (x))) -#define SCM_GC8MARKP(x) (0x80 & SCM_CARBITS (x)) +#define SCM_GCMARKP(x) (1 & SCM_UNPACK (SCM_CDR (x))) +#define SCM_GC8MARKP(x) (0x80 & SCM_UNPACK_CAR (x)) #define SCM_SETGCMARK(x) SCM_SETOR_CDR (x, 1) #define SCM_CLRGCMARK(x) SCM_SETAND_CDR (x, ~1L) #define SCM_SETGC8MARK(x) SCM_SETOR_CAR (x, 0x80) @@ -454,9 +454,9 @@ enum scm_tags scm_tc8_iloc = 0xfc }; -#define SCM_ITAG8(X) (SCM_BITS (X) & 0xff) -#define SCM_MAKE_ITAG8(X, TAG) SCM_SCM (((X) << 8) + TAG) -#define SCM_ITAG8_DATA(X) (SCM_BITS (X) >> 8) +#define SCM_ITAG8(X) (SCM_UNPACK (X) & 0xff) +#define SCM_MAKE_ITAG8(X, TAG) SCM_PACK (((X) << 8) + TAG) +#define SCM_ITAG8_DATA(X) (SCM_UNPACK (X) >> 8) @@ -464,15 +464,15 @@ enum scm_tags */ /* SCM_ISYMP tests for ISPCSYM and ISYM */ -#define SCM_ISYMP(n) ((0x187 & SCM_BITS (n)) == 4) +#define SCM_ISYMP(n) ((0x187 & SCM_UNPACK (n)) == 4) /* SCM_IFLAGP tests for ISPCSYM, ISYM and IFLAG */ -#define SCM_IFLAGP(n) ((0x87 & SCM_BITS (n)) == 4) -#define SCM_ISYMNUM(n) (SCM_BITS (n) >> 9) +#define SCM_IFLAGP(n) ((0x87 & SCM_UNPACK (n)) == 4) +#define SCM_ISYMNUM(n) (SCM_UNPACK (n) >> 9) #define SCM_ISYMCHARS(n) (scm_isymnames[SCM_ISYMNUM (n)]) -#define SCM_MAKSPCSYM(n) SCM_SCM (((n) << 9) + ((n) << 3) + 4L) -#define SCM_MAKISYM(n) SCM_SCM (((n) << 9) + 0x74L) -#define SCM_MAKIFLAG(n) SCM_SCM (((n) << 9) + 0x174L) +#define SCM_MAKSPCSYM(n) SCM_PACK (((n) << 9) + ((n) << 3) + 4L) +#define SCM_MAKISYM(n) SCM_PACK (((n) << 9) + 0x74L) +#define SCM_MAKIFLAG(n) SCM_PACK (((n) << 9) + 0x174L) extern char *scm_isymnames[]; /* defined in print.c */ diff --git a/libguile/throw.c b/libguile/throw.c index 43a08dd52..9096c8216 100644 --- a/libguile/throw.c +++ b/libguile/throw.c @@ -70,7 +70,7 @@ static int scm_tc16_jmpbuffer; #define SCM_JMPBUFP(OBJ) (SCM_NIMP(OBJ) && (SCM_TYP16(OBJ) == scm_tc16_jmpbuffer)) -#define JBACTIVE(OBJ) (SCM_CARBITS (OBJ) & (1L << 16L)) +#define JBACTIVE(OBJ) (SCM_UNPACK_CAR (OBJ) & (1L << 16L)) #define ACTIVATEJB(OBJ) (SCM_SETOR_CAR (OBJ, (1L << 16L))) #define DEACTIVATEJB(OBJ) (SCM_SETAND_CAR (OBJ, ~(1L << 16L))) @@ -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_BITS ( JBJMPBUF(exp) ), 16, port); + scm_intprint(SCM_UNPACK ( JBJMPBUF(exp) ), 16, port); scm_putc ('>', port); return 1 ; @@ -276,7 +276,7 @@ make_lazy_catch (struct lazy_catch *c) } #define SCM_LAZY_CATCH_P(obj) \ - (SCM_NIMP (obj) && (SCM_CARBITS (obj) == tc16_lazy_catch)) + (SCM_NIMP (obj) && (SCM_UNPACK_CAR (obj) == tc16_lazy_catch)) /* Exactly like scm_internal_catch, except: diff --git a/libguile/unif.c b/libguile/unif.c index cf2172a79..a6995dd41 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -1197,7 +1197,7 @@ scm_cvref (SCM v, scm_sizet pos, SCM last) #ifdef SCM_FLOATS #ifdef SCM_SINGLES case scm_tc7_fvect: - if (SCM_NIMP (last) && (last != scm_flo0) && (scm_tc_flo == SCM_CARBITS (last))) + if (SCM_NIMP (last) && (last != scm_flo0) && (scm_tc_flo == SCM_UNPACK_CAR (last))) { SCM_FLO (last) = ((float *) SCM_CDR (v))[pos]; return last; @@ -1206,7 +1206,7 @@ scm_cvref (SCM v, scm_sizet pos, SCM last) #endif case scm_tc7_dvect: #ifdef SCM_SINGLES - if (SCM_NIMP (last) && scm_tc_dblr == SCM_CARBITS (last)) + if (SCM_NIMP (last) && scm_tc_dblr == SCM_UNPACK_CAR (last)) #else if (SCM_NIMP (last) && (last != scm_flo0) && (scm_tc_dblr == SCM_CAR (last))) #endif @@ -1216,7 +1216,7 @@ scm_cvref (SCM v, scm_sizet pos, SCM last) } return scm_makdbl (((double *) SCM_CDR (v))[pos], 0.0); case scm_tc7_cvect: - if (SCM_NIMP (last) && scm_tc_dblc == SCM_CARBITS (last)) + if (SCM_NIMP (last) && scm_tc_dblc == SCM_UNPACK_CAR (last)) { SCM_REAL (last) = ((double *) SCM_CDR (v))[2 * pos]; SCM_IMAG (last) = ((double *) SCM_CDR (v))[2 * pos + 1]; @@ -1316,10 +1316,10 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, break; # else case scm_tc7_uvect: - SCM_VELTS(v)[pos] = SCM_SCM (scm_num2ulong(obj, (char *)SCM_ARG2, FUNC_NAME)); + SCM_VELTS(v)[pos] = SCM_PACK (scm_num2ulong(obj, (char *)SCM_ARG2, FUNC_NAME)); break; case scm_tc7_ivect: - SCM_VELTS(v)[pos] = SCM_SCM (scm_num2long(obj, (char *)SCM_ARG2, FUNC_NAME)); + SCM_VELTS(v)[pos] = SCM_PACK (scm_num2long(obj, (char *)SCM_ARG2, FUNC_NAME)); break; # endif case scm_tc7_svect: @@ -1762,7 +1762,7 @@ SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0, if (0 == SCM_LENGTH (seq)) return SCM_INUM0; i = (SCM_LENGTH (seq) - 1) / SCM_LONG_BIT; - w = SCM_BITS (SCM_VELTS (seq)[i]); + w = SCM_UNPACK (SCM_VELTS (seq)[i]); if (SCM_FALSEP (item)) w = ~w; w <<= SCM_LONG_BIT - 1 - ((SCM_LENGTH (seq) - 1) % SCM_LONG_BIT); @@ -1772,7 +1772,7 @@ SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0, cnt += cnt_tab[w & 0x0f]; if (0 == i--) return SCM_MAKINUM (cnt); - w = SCM_BITS (SCM_VELTS (seq)[i]); + w = SCM_UNPACK (SCM_VELTS (seq)[i]); if (SCM_FALSEP (item)) w = ~w; } @@ -1805,7 +1805,7 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0, return SCM_MAKINUM (-1L); lenw = (SCM_LENGTH (v) - 1) / SCM_LONG_BIT; /* watch for part words */ i = pos / SCM_LONG_BIT; - w = SCM_BITS (SCM_VELTS (v)[i]); + w = SCM_UNPACK (SCM_VELTS (v)[i]); if (SCM_FALSEP (item)) w = ~w; xbits = (pos % SCM_LONG_BIT); @@ -1839,7 +1839,7 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0, if (++i > lenw) break; pos += SCM_LONG_BIT; - w = SCM_BITS (SCM_VELTS (v)[i]); + w = SCM_UNPACK (SCM_VELTS (v)[i]); if (SCM_FALSEP (item)) w = ~w; } @@ -1877,14 +1877,14 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0, if (SCM_BOOL_F == obj) for (i = SCM_LENGTH (kv); i;) { - k = SCM_BITS (SCM_VELTS (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) for (i = SCM_LENGTH (kv); i;) { - k = SCM_BITS (SCM_VELTS (kv)[--i]); + k = SCM_UNPACK (SCM_VELTS (kv)[--i]); SCM_ASSERT ((k < vlen), SCM_MAKINUM (k), SCM_OUTOFRANGE, FUNC_NAME); SCM_BITVEC_SET(v,k); } @@ -1896,10 +1896,10 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0, SCM_ASRTGO (SCM_TYP7 (v) == scm_tc7_bvect && SCM_LENGTH (v) == SCM_LENGTH (kv), badarg1); if (SCM_BOOL_F == obj) for (k = (SCM_LENGTH (v) + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;) - SCM_BITS (SCM_VELTS (v)[k]) &= ~ SCM_BITS(SCM_VELTS (kv)[k]); + SCM_UNPACK (SCM_VELTS (v)[k]) &= ~ SCM_UNPACK(SCM_VELTS (kv)[k]); else if (SCM_BOOL_T == obj) for (k = (SCM_LENGTH (v) + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;) - SCM_BITS (SCM_VELTS (v)[k]) |= SCM_BITS (SCM_VELTS (kv)[k]); + SCM_UNPACK (SCM_VELTS (v)[k]) |= SCM_UNPACK (SCM_VELTS (kv)[k]); else goto badarg3; break; @@ -1941,7 +1941,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, if (SCM_BOOL_F == obj) for (i = SCM_LENGTH (kv); i;) { - k = SCM_BITS (SCM_VELTS (kv)[--i]); + k = SCM_UNPACK (SCM_VELTS (kv)[--i]); SCM_ASSERT ((k < vlen), SCM_MAKINUM (k), SCM_OUTOFRANGE, FUNC_NAME); if (!SCM_BITVEC_REF(v,k)) count++; @@ -1949,7 +1949,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, else if (SCM_BOOL_T == obj) for (i = SCM_LENGTH (kv); i;) { - k = SCM_BITS (SCM_VELTS (kv)[--i]); + k = SCM_UNPACK (SCM_VELTS (kv)[--i]); SCM_ASSERT ((k < vlen), SCM_MAKINUM (k), SCM_OUTOFRANGE, FUNC_NAME); if (SCM_BITVEC_REF (v,k)) count++; @@ -1965,7 +1965,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, SCM_ASRTGO (SCM_BOOL_T == obj || SCM_BOOL_F == obj, badarg3); fObj = (SCM_BOOL_T == obj); i = (SCM_LENGTH (v) - 1) / SCM_LONG_BIT; - k = SCM_BITS (SCM_VELTS (kv)[i]) & (fObj ? SCM_BITS (SCM_VELTS (v)[i]) : ~ SCM_BITS (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); while (1) { @@ -1975,7 +1975,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, return SCM_MAKINUM (count); /* urg. repetitive (see above.) */ - k = SCM_BITS (SCM_VELTS (kv)[i]) & (fObj ? SCM_BITS(SCM_VELTS (v)[i]) : ~SCM_BITS (SCM_VELTS (v)[i])); + k = SCM_UNPACK (SCM_VELTS (kv)[i]) & (fObj ? SCM_UNPACK(SCM_VELTS (v)[i]) : ~SCM_UNPACK (SCM_VELTS (v)[i])); } } return SCM_MAKINUM (count); @@ -1996,7 +1996,7 @@ SCM_DEFINE (scm_bit_invert_x, "bit-invert!", 1, 0, 0, { case scm_tc7_bvect: for (k = (k + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;) - SCM_BITS (SCM_VELTS (v)[k]) = ~SCM_BITS(SCM_VELTS (v)[k]); + SCM_UNPACK (SCM_VELTS (v)[k]) = ~SCM_UNPACK(SCM_VELTS (v)[k]); break; default: badarg1:SCM_WTA (1,v); @@ -2466,7 +2466,7 @@ tail: scm_putc ('*', port); for (i = 0; i < (SCM_LENGTH (exp)) / SCM_LONG_BIT; i++) { - scm_bits_t w = SCM_BITS (SCM_VELTS (exp)[i]); + scm_bits_t w = SCM_UNPACK (SCM_VELTS (exp)[i]); for (j = SCM_LONG_BIT; j; j--) { scm_putc (w & 1 ? '1' : '0', port); @@ -2476,7 +2476,7 @@ tail: j = SCM_LENGTH (exp) % SCM_LONG_BIT; if (j) { - w = SCM_BITS (SCM_VELTS (exp)[SCM_LENGTH (exp) / SCM_LONG_BIT]); + w = SCM_UNPACK (SCM_VELTS (exp)[SCM_LENGTH (exp) / SCM_LONG_BIT]); for (; j; j--) { scm_putc (w & 1 ? '1' : '0', port); diff --git a/libguile/unif.h b/libguile/unif.h index a6a5c9539..b7a4ac138 100644 --- a/libguile/unif.h +++ b/libguile/unif.h @@ -77,9 +77,9 @@ typedef struct scm_array_dim extern long scm_tc16_array; #define SCM_ARRAYP(a) (SCM_NIMP(a) && (scm_tc16_array == SCM_TYP16(a))) -#define SCM_ARRAY_NDIM(x) ((scm_sizet)(SCM_CARBITS(x)>>17)) +#define SCM_ARRAY_NDIM(x) ((scm_sizet)(SCM_UNPACK_CAR(x)>>17)) #define SCM_ARRAY_CONTIGUOUS 0x10000 -#define SCM_ARRAY_CONTP(x) (SCM_ARRAY_CONTIGUOUS & (int)(SCM_CARBITS(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_BASE(a) (((scm_array *)SCM_CDR(a))->base) diff --git a/libguile/variable.h b/libguile/variable.h index 8bfe9de3b..e69d86c39 100644 --- a/libguile/variable.h +++ b/libguile/variable.h @@ -56,7 +56,7 @@ extern int scm_tc16_variable; #define SCM_VARVCELL(V) SCM_CDR(V) -#define SCM_VARIABLEP(X) (SCM_NIMP(X) && (scm_tc16_variable == SCM_CARBITS(X))) +#define SCM_VARIABLEP(X) (SCM_NIMP(X) && (scm_tc16_variable == SCM_UNPACK_CAR(X))) #define SCM_UDVARIABLEP(X) (SCM_VARIABLEP(X) && SCM_UNBNDP (SCM_CDR (SCM_VARVCELL (X)))) #define SCM_DEFVARIABLEP(X) (SCM_VARIABLEP(X) && !SCM_UNBNDP (SCM_CDR (SCM_VARVCELL (X)))) diff --git a/libguile/vectors.h b/libguile/vectors.h index 9fec18b97..7fd8df06a 100644 --- a/libguile/vectors.h +++ b/libguile/vectors.h @@ -62,9 +62,9 @@ /* bit vectors */ -#define SCM_BITVEC_REF(a, i) ((SCM_BITS(SCM_VELTS(a)[(i)/SCM_LONG_BIT]) & (1L<<((i)%SCM_LONG_BIT))) ? 1 : 0) -#define SCM_BITVEC_SET(a, i) SCM_BITS(SCM_VELTS(a)[(i)/SCM_LONG_BIT]) |= (1L<<((i)%SCM_LONG_BIT)) -#define SCM_BITVEC_CLR(a, i) SCM_BITS(SCM_VELTS(a)[(i)/SCM_LONG_BIT]) &= ~(1L<<((i)%SCM_LONG_BIT)) +#define SCM_BITVEC_REF(a, i) ((SCM_UNPACK(SCM_VELTS(a)[(i)/SCM_LONG_BIT]) & (1L<<((i)%SCM_LONG_BIT))) ? 1 : 0) +#define SCM_BITVEC_SET(a, i) SCM_UNPACK(SCM_VELTS(a)[(i)/SCM_LONG_BIT]) |= (1L<<((i)%SCM_LONG_BIT)) +#define SCM_BITVEC_CLR(a, i) SCM_UNPACK(SCM_VELTS(a)[(i)/SCM_LONG_BIT]) &= ~(1L<<((i)%SCM_LONG_BIT)) diff --git a/libguile/weaks.c b/libguile/weaks.c index 5656d8b69..1c72f273c 100644 --- a/libguile/weaks.c +++ b/libguile/weaks.c @@ -133,7 +133,7 @@ SCM_DEFINE (scm_make_weak_key_hash_table, "make-weak-key-hash-table", 1, 0, 0, SCM_VALIDATE_INUM (1,k); v = scm_make_weak_vector (k, SCM_EOL); SCM_ALLOW_INTS; - SCM_BITS (SCM_VELTS (v)[-1]) = 1; + SCM_UNPACK (SCM_VELTS (v)[-1]) = 1; SCM_ALLOW_INTS; return v; } @@ -149,7 +149,7 @@ SCM_DEFINE (scm_make_weak_value_hash_table, "make-weak-value-hash-table", 1, 0, SCM_VALIDATE_INUM (1,k); v = scm_make_weak_vector (k, SCM_EOL); SCM_ALLOW_INTS; - SCM_BITS (SCM_VELTS (v)[-1]) = 2; + SCM_UNPACK (SCM_VELTS (v)[-1]) = 2; SCM_ALLOW_INTS; return v; } @@ -166,7 +166,7 @@ SCM_DEFINE (scm_make_doubly_weak_hash_table, "make-doubly-weak-hash-table", 1, 0 SCM_VALIDATE_INUM (1,k); v = scm_make_weak_vector (k, SCM_EOL); SCM_ALLOW_INTS; - SCM_BITS (SCM_VELTS (v)[-1]) = 3; + SCM_UNPACK (SCM_VELTS (v)[-1]) = 3; SCM_ALLOW_INTS; return v; } diff --git a/libguile/weaks.h b/libguile/weaks.h index 8e7d078df..26f9a0257 100644 --- a/libguile/weaks.h +++ b/libguile/weaks.h @@ -53,9 +53,9 @@ #define SCM_WVECTP(x) (SCM_NIMP(x) && (SCM_TYP7(x)==scm_tc7_wvect)) -#define SCM_IS_WHVEC(X) (SCM_BITS (SCM_VELTS(X)[-1]) == 1) -#define SCM_IS_WHVEC_V(X) (SCM_BITS (SCM_VELTS(X)[-1]) == 2) -#define SCM_IS_WHVEC_B(X) (SCM_BITS (SCM_VELTS(X)[-1]) == 3) +#define SCM_IS_WHVEC(X) (SCM_UNPACK (SCM_VELTS(X)[-1]) == 1) +#define SCM_IS_WHVEC_V(X) (SCM_UNPACK (SCM_VELTS(X)[-1]) == 2) +#define SCM_IS_WHVEC_B(X) (SCM_UNPACK (SCM_VELTS(X)[-1]) == 3) #define SCM_IS_WHVEC_ANY(X) (SCM_VELTS(X)[-1]) #define SCM_WVECT_GC_CHAIN(X) (SCM_VELTS(X)[-2]) |