diff --git a/libguile/control.c b/libguile/control.c index dc3fed250..9121d1791 100644 --- a/libguile/control.c +++ b/libguile/control.c @@ -163,7 +163,7 @@ reify_partial_continuation (SCM vm, SCM prompt, SCM extwinds, /* Since non-escape continuations should begin with a thunk application, the first bit of the stack should be a frame, with the saved fp equal to the fp that was current when the prompt was made. */ - if ((SCM*)(SCM_PROMPT_REGISTERS (prompt)->sp[1]) + if ((SCM*)SCM_UNPACK (SCM_PROMPT_REGISTERS (prompt)->sp[1]) != SCM_PROMPT_REGISTERS (prompt)->fp) abort (); diff --git a/libguile/eval.c b/libguile/eval.c index 009f3790b..0101f019e 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -102,7 +102,8 @@ */ static scm_t_bits scm_tc16_boot_closure; -#define RETURN_BOOT_CLOSURE(code, env) SCM_RETURN_NEWSMOB2 (scm_tc16_boot_closure, (code), (env)) +#define RETURN_BOOT_CLOSURE(code, env) \ + SCM_RETURN_NEWSMOB2 (scm_tc16_boot_closure, SCM_UNPACK (code), SCM_UNPACK (env)) #define BOOT_CLOSURE_P(obj) SCM_TYP16_PREDICATE (scm_tc16_boot_closure, (obj)) #define BOOT_CLOSURE_CODE(x) SCM_SMOB_OBJECT (x) #define BOOT_CLOSURE_ENV(x) SCM_SMOB_OBJECT_2 (x) diff --git a/libguile/frames.c b/libguile/frames.c index 62ba23fff..2e83cde9a 100644 --- a/libguile/frames.c +++ b/libguile/frames.c @@ -124,7 +124,7 @@ SCM_DEFINE (scm_frame_num_locals, "frame-num-locals", 1, 0, 0, p = SCM_FRAME_STACK_ADDRESS (SCM_VM_FRAME_FP (frame)); while (p <= sp) { - if (p[0] == (SCM)0) + if (SCM_UNPACK (p[0]) == 0) /* skip over not-yet-active frame */ p += 3; else @@ -154,7 +154,7 @@ SCM_DEFINE (scm_frame_local_ref, "frame-local-ref", 2, 0, 0, p = SCM_FRAME_STACK_ADDRESS (SCM_VM_FRAME_FP (frame)); while (p <= sp) { - if (p[0] == (SCM)0) + if (SCM_UNPACK (p[0]) == 0) /* skip over not-yet-active frame */ p += 3; else if (n == i) @@ -186,7 +186,7 @@ SCM_DEFINE (scm_frame_local_set_x, "frame-local-set!", 3, 0, 0, p = SCM_FRAME_STACK_ADDRESS (SCM_VM_FRAME_FP (frame)); while (p <= sp) { - if (p[0] == (SCM)0) + if (SCM_UNPACK (p[0]) == 0) /* skip over not-yet-active frame */ p += 3; else if (n == i) diff --git a/libguile/frames.h b/libguile/frames.h index 3d8a4b27a..47244c7a3 100644 --- a/libguile/frames.h +++ b/libguile/frames.h @@ -1,4 +1,4 @@ -/* Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc. +/* Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc. * * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -70,15 +70,15 @@ #define SCM_FRAME_RETURN_ADDRESS(fp) \ (SCM_FRAME_BYTE_CAST (SCM_FRAME_DATA_ADDRESS (fp)[2])) #define SCM_FRAME_SET_RETURN_ADDRESS(fp, ra) \ - ((SCM_FRAME_DATA_ADDRESS (fp)[2])) = (SCM)(ra); + ((SCM_FRAME_DATA_ADDRESS (fp)[2])) = SCM_PACK (ra) #define SCM_FRAME_MV_RETURN_ADDRESS(fp) \ (SCM_FRAME_BYTE_CAST (SCM_FRAME_DATA_ADDRESS (fp)[1])) #define SCM_FRAME_SET_MV_RETURN_ADDRESS(fp, mvra) \ - ((SCM_FRAME_DATA_ADDRESS (fp)[1])) = (SCM)(mvra); + ((SCM_FRAME_DATA_ADDRESS (fp)[1])) = SCM_PACK (mvra) #define SCM_FRAME_DYNAMIC_LINK(fp) \ (SCM_FRAME_STACK_CAST (SCM_FRAME_DATA_ADDRESS (fp)[0])) #define SCM_FRAME_SET_DYNAMIC_LINK(fp, dl) \ - ((SCM_FRAME_DATA_ADDRESS (fp)[0])) = (SCM)(dl); + ((SCM_FRAME_DATA_ADDRESS (fp)[0])) = SCM_PACK (dl) #define SCM_FRAME_VARIABLE(fp,i) SCM_FRAME_STACK_ADDRESS (fp)[i] #define SCM_FRAME_PROGRAM(fp) SCM_FRAME_STACK_ADDRESS (fp)[-1] diff --git a/libguile/goops.c b/libguile/goops.c index 1fca49150..33933965c 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -293,7 +293,8 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0, return scm_class_fraction; } case scm_tc7_program: - if (SCM_PROGRAM_IS_PRIMITIVE_GENERIC (x) && *SCM_SUBR_GENERIC (x)) + if (SCM_PROGRAM_IS_PRIMITIVE_GENERIC (x) + && SCM_UNPACK (*SCM_SUBR_GENERIC (x))) return scm_class_primitive_generic; else return scm_class_procedure; @@ -494,8 +495,8 @@ compute_getters_n_setters (SCM slots) SCM options = SCM_CDAR (slots); if (!scm_is_null (options)) { - init = scm_get_keyword (k_init_value, options, 0); - if (init) + init = scm_get_keyword (k_init_value, options, SCM_PACK (0)); + if (SCM_UNPACK (init)) { init = scm_primitive_eval (scm_list_3 (scm_sym_lambda, SCM_EOL, @@ -592,7 +593,7 @@ SCM_DEFINE (scm_sys_initialize_object, "%initialize-object", 2, 0, 0, get_n_set = SCM_CDR (get_n_set), slots = SCM_CDR (slots)) { SCM slot_name = SCM_CAR (slots); - SCM slot_value = 0; + SCM slot_value = SCM_PACK (0); if (!scm_is_null (SCM_CDR (slot_name))) { @@ -604,10 +605,10 @@ SCM_DEFINE (scm_sys_initialize_object, "%initialize-object", 2, 0, 0, tmp = scm_i_get_keyword (k_init_keyword, SCM_CDR (slot_name), n, - 0, + SCM_PACK (0), FUNC_NAME); slot_name = SCM_CAR (slot_name); - if (tmp) + if (SCM_UNPACK (tmp)) { /* an initarg was provided for this slot */ if (!scm_is_keyword (tmp)) @@ -616,12 +617,12 @@ SCM_DEFINE (scm_sys_initialize_object, "%initialize-object", 2, 0, 0, slot_value = scm_i_get_keyword (tmp, initargs, n_initargs, - 0, + SCM_PACK (0), FUNC_NAME); } } - if (slot_value) + if (SCM_UNPACK (slot_value)) /* set slot to provided value */ set_slot_value (class, obj, SCM_CAR (get_n_set), slot_value); else @@ -1775,7 +1776,7 @@ SCM_DEFINE (scm_primitive_generic_generic, "primitive-generic-generic", 1, 0, 0, { if (SCM_PRIMITIVE_GENERIC_P (subr)) { - if (!*SCM_SUBR_GENERIC (subr)) + if (!SCM_UNPACK (*SCM_SUBR_GENERIC (subr))) scm_enable_primitive_generic_x (scm_list_1 (subr)); return *SCM_SUBR_GENERIC (subr); } @@ -1802,7 +1803,7 @@ scm_c_extend_primitive_generic (SCM extended, SCM extension) if (goops_loaded_p) { SCM gf, gext; - if (!*SCM_SUBR_GENERIC (extended)) + if (!SCM_UNPACK (*SCM_SUBR_GENERIC (extended))) scm_enable_primitive_generic_x (scm_list_1 (extended)); gf = *SCM_SUBR_GENERIC (extended); gext = scm_call_2 (SCM_VARIABLE_REF (scm_var_make_extended_generic), diff --git a/libguile/guardians.c b/libguile/guardians.c index a341fbfdc..b11bf6430 100644 --- a/libguile/guardians.c +++ b/libguile/guardians.c @@ -151,7 +151,7 @@ finalize_guarded (GC_PTR ptr, GC_PTR finalizer_data) cell_pool = SCM_CDR (cell_pool); /* Compute and update G's zombie list. */ - SCM_SETCAR (zombies, SCM_PACK (obj)); + SCM_SETCAR (zombies, obj); SCM_SETCDR (zombies, g->zombies); g->zombies = zombies; diff --git a/libguile/list.c b/libguile/list.c index 704151519..221ee79d0 100644 --- a/libguile/list.c +++ b/libguile/list.c @@ -35,10 +35,10 @@ /* creating lists */ -#define SCM_I_CONS(cell, x, y) \ -do { \ - cell = scm_cell ((scm_t_bits)x, (scm_t_bits)y); \ -} while (0) +#define SCM_I_CONS(cell, x, y) \ + do { \ + cell = scm_cell (SCM_UNPACK (x), SCM_UNPACK (y)); \ + } while (0) SCM scm_list_1 (SCM e1) diff --git a/libguile/macros.c b/libguile/macros.c index aa6b9cd1c..556e60f57 100644 --- a/libguile/macros.c +++ b/libguile/macros.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003, 2006, 2008, 2009, 2010 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -64,9 +64,9 @@ scm_i_make_primitive_macro (const char *name, scm_t_macro_primitive fn) { SCM z = scm_words (scm_tc16_macro, 5); SCM_SET_SMOB_DATA_N (z, 1, (scm_t_bits)fn); - SCM_SET_SMOB_DATA_N (z, 2, scm_from_locale_symbol (name)); - SCM_SET_SMOB_DATA_N (z, 3, SCM_BOOL_F); - SCM_SET_SMOB_DATA_N (z, 4, SCM_BOOL_F); + SCM_SET_SMOB_OBJECT_N (z, 2, scm_from_locale_symbol (name)); + SCM_SET_SMOB_OBJECT_N (z, 3, SCM_BOOL_F); + SCM_SET_SMOB_OBJECT_N (z, 4, SCM_BOOL_F); return z; } @@ -104,9 +104,9 @@ SCM_DEFINE (scm_make_syntax_transformer, "make-syntax-transformer", 3, 0, 0, z = scm_words (scm_tc16_macro, 5); SCM_SET_SMOB_DATA_N (z, 1, prim); - SCM_SET_SMOB_DATA_N (z, 2, name); - SCM_SET_SMOB_DATA_N (z, 3, type); - SCM_SET_SMOB_DATA_N (z, 4, binding); + SCM_SET_SMOB_OBJECT_N (z, 2, name); + SCM_SET_SMOB_OBJECT_N (z, 3, type); + SCM_SET_SMOB_OBJECT_N (z, 4, binding); return z; } #undef FUNC_NAME diff --git a/libguile/memoize.c b/libguile/memoize.c index 49d294861..0b1aa5194 100644 --- a/libguile/memoize.c +++ b/libguile/memoize.c @@ -64,7 +64,8 @@ SCM_SYMBOL (sym_case_lambda_star, "case-lambda*"); scm_t_bits scm_tc16_memoized; -#define MAKMEMO(n, args) (scm_cell (scm_tc16_memoized | ((n) << 16), (scm_t_bits)(args))) +#define MAKMEMO(n, args) \ + (scm_cell (scm_tc16_memoized | ((n) << 16), SCM_UNPACK (args))) #define MAKMEMO_BEGIN(exps) \ MAKMEMO (SCM_M_BEGIN, exps) @@ -448,13 +449,13 @@ SCM_DEFINE (scm_memoize_expression, "memoize-expression", 1, 0, 0, #define SCM_MAKE_MEMOIZER(STR, MEMOIZER, N) \ (scm_cell (scm_tc16_memoizer, \ - (scm_t_bits)(scm_c_make_gsubr (STR, N, 0, 0, MEMOIZER)))) + SCM_UNPACK (scm_c_make_gsubr (STR, N, 0, 0, MEMOIZER)))) #define SCM_DEFINE_MEMOIZER(STR, MEMOIZER, N) \ SCM_SNARF_INIT(scm_c_define (STR, SCM_MAKE_MEMOIZER (STR, MEMOIZER, N))) #define SCM_MAKE_REST_MEMOIZER(STR, MEMOIZER, N) \ (scm_cell (scm_tc16_memoizer, \ - (scm_t_bits)(scm_c_make_gsubr (STR, N, 0, 1, MEMOIZER)))) + SCM_UNPACK ((scm_c_make_gsubr (STR, N, 0, 1, MEMOIZER))))) #define SCM_DEFINE_REST_MEMOIZER(STR, MEMOIZER, N) \ SCM_SNARF_INIT(scm_c_define (STR, SCM_MAKE_REST_MEMOIZER (STR, MEMOIZER, N))) diff --git a/libguile/modules.c b/libguile/modules.c index a9fe3b3d9..ca8875dab 100644 --- a/libguile/modules.c +++ b/libguile/modules.c @@ -947,7 +947,7 @@ SCM_DEFINE (scm_module_reverse_lookup, "module-reverse-lookup", 2, 0, 0, { handle = SCM_CAR (ls); - if (SCM_CAR (handle) == SCM_PACK (NULL)) + if (SCM_UNPACK (SCM_CAR (handle)) == 0) { /* FIXME: We hit a weak pair whose car has become unreachable. We should remove the pair in question or something. */ diff --git a/libguile/print.c b/libguile/print.c index b46296abb..4afd12c92 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -525,7 +525,7 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate) if (SCM_OBJ_CLASS_FLAGS (exp) & SCM_CLASSF_GOOPS) { SCM pwps, print = pstate->writingp ? g_write : g_display; - if (!print) + if (SCM_UNPACK (print) == 0) goto print_struct; pwps = scm_i_port_with_print_state (port, pstate->handle); pstate->revealed = 1; diff --git a/libguile/promises.c b/libguile/promises.c index 45a76a9e5..4aff15092 100644 --- a/libguile/promises.c +++ b/libguile/promises.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010 +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,2011 * Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or @@ -80,7 +80,7 @@ SCM_DEFINE (scm_make_promise, "make-promise", 1, 0, 0, SCM_VALIDATE_THUNK (1, thunk); SCM_RETURN_NEWSMOB2 (scm_tc16_promise, SCM_UNPACK (thunk), - scm_make_recursive_mutex ()); + SCM_UNPACK (scm_make_recursive_mutex ())); } #undef FUNC_NAME diff --git a/libguile/srcprop.c b/libguile/srcprop.c index f9b000c47..aee0b0985 100644 --- a/libguile/srcprop.c +++ b/libguile/srcprop.c @@ -140,8 +140,8 @@ scm_make_srcprops (long line, int col, SCM filename, SCM copy, SCM alist) SCM_RETURN_NEWSMOB3 (scm_tc16_srcprops, SRCPROPMAKPOS (line, col), - copy, - alist); + SCM_UNPACK (copy), + SCM_UNPACK (alist)); } diff --git a/libguile/vectors.c b/libguile/vectors.c index 2ab5b78ea..1cf8f2fc4 100644 --- a/libguile/vectors.c +++ b/libguile/vectors.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2006, 2008, 2009, 2010 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -213,7 +213,7 @@ scm_c_vector_ref (SCM v, size_t k) scm_out_of_range (NULL, scm_from_size_t (k)); elt = (SCM_I_VECTOR_ELTS(v))[k]; - if ((elt == SCM_PACK (NULL)) && SCM_I_WVECTP (v)) + if (SCM_UNPACK (elt) == 0 && SCM_I_WVECTP (v)) /* ELT was a weak pointer and got nullified by the GC. */ return SCM_BOOL_F; @@ -232,7 +232,7 @@ scm_c_vector_ref (SCM v, size_t k) k = SCM_I_ARRAY_BASE (v) + k*dim->inc; elt = (SCM_I_VECTOR_ELTS (vv))[k]; - if ((elt == SCM_PACK (NULL)) && (SCM_I_WVECTP (vv))) + if (SCM_UNPACK (elt) == 0 && (SCM_I_WVECTP (vv))) /* ELT was a weak pointer and got nullified by the GC. */ return SCM_BOOL_F; diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index e449b4372..22bd39c0e 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -89,17 +89,17 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs) /* Initial frame */ CACHE_REGISTER (); - PUSH ((SCM)fp); /* dynamic link */ - PUSH (0); /* mvra */ - PUSH ((SCM)ip); /* ra */ + PUSH (SCM_PACK (fp)); /* dynamic link */ + PUSH (SCM_PACK (0)); /* mvra */ + PUSH (SCM_PACK (ip)); /* ra */ CACHE_PROGRAM (); PUSH (program); fp = sp + 1; ip = SCM_C_OBJCODE_BASE (bp); /* MV-call frame, function & arguments */ - PUSH (0); /* dynamic link */ - PUSH (0); /* mvra */ - PUSH (0); /* ra */ + PUSH (SCM_PACK (0)); /* dynamic link */ + PUSH (SCM_PACK (0)); /* mvra */ + PUSH (SCM_PACK (0)); /* ra */ PUSH (prog); if (SCM_UNLIKELY (sp + nargs >= stack_limit)) goto vm_error_too_many_args; diff --git a/libguile/vm-i-scheme.c b/libguile/vm-i-scheme.c index 60e44521e..2d8501253 100644 --- a/libguile/vm-i-scheme.c +++ b/libguile/vm-i-scheme.c @@ -168,15 +168,15 @@ VM_DEFINE_INSTRUCTION (144, set_cdr, "set-cdr!", 0, 2, 0) */ #undef REL -#define REL(crel,srel) \ -{ \ - ARGS2 (x, y); \ - if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) \ - RETURN (scm_from_bool ((scm_t_signed_bits) (x) \ - crel (scm_t_signed_bits) (y))); \ - SYNC_REGISTER (); \ - RETURN (srel (x, y)); \ -} +#define REL(crel,srel) \ + { \ + ARGS2 (x, y); \ + if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) \ + RETURN (scm_from_bool (((scm_t_signed_bits) SCM_UNPACK (x)) \ + crel ((scm_t_signed_bits) SCM_UNPACK (y)))); \ + SYNC_REGISTER (); \ + RETURN (srel (x, y)); \ + } VM_DEFINE_FUNCTION (145, ee, "ee?", 2) { @@ -297,13 +297,13 @@ VM_DEFINE_FUNCTION (151, add1, "add1", 1) ARGS1 (x); /* Check for overflow. */ - if (SCM_LIKELY ((scm_t_intptr) x < INUM_MAX)) + if (SCM_LIKELY ((scm_t_intptr) SCM_UNPACK (x) < INUM_MAX)) { SCM result; /* Add the integers without untagging. */ - result = SCM_PACK ((scm_t_intptr) x - + (scm_t_intptr) SCM_I_MAKINUM (1) + result = SCM_PACK ((scm_t_intptr) SCM_UNPACK (x) + + (scm_t_intptr) SCM_UNPACK (SCM_I_MAKINUM (1)) - scm_tc2_int); if (SCM_LIKELY (SCM_I_INUMP (result))) @@ -331,13 +331,13 @@ VM_DEFINE_FUNCTION (153, sub1, "sub1", 1) ARGS1 (x); /* Check for underflow. */ - if (SCM_LIKELY ((scm_t_intptr) x > INUM_MIN)) + if (SCM_LIKELY ((scm_t_intptr) SCM_UNPACK (x) > INUM_MIN)) { SCM result; /* Substract the integers without untagging. */ - result = SCM_PACK ((scm_t_intptr) x - - (scm_t_intptr) SCM_I_MAKINUM (1) + result = SCM_PACK ((scm_t_intptr) SCM_UNPACK (x) + - (scm_t_intptr) SCM_UNPACK (SCM_I_MAKINUM (1)) + scm_tc2_int); if (SCM_LIKELY (SCM_I_INUMP (result))) diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c index d1ad64fc6..1b4136f3f 100644 --- a/libguile/vm-i-system.c +++ b/libguile/vm-i-system.c @@ -765,9 +765,9 @@ VM_DEFINE_INSTRUCTION (52, new_frame, "new-frame", 0, 0, 3) know that this frame will point to the current fp: it could be placed elsewhere on the stack if captured in a partial continuation, and invoked from some other context. */ - PUSH (0); /* dynamic link */ - PUSH (0); /* mvra */ - PUSH (0); /* ra */ + PUSH (SCM_PACK (0)); /* dynamic link */ + PUSH (SCM_PACK (0)); /* mvra */ + PUSH (SCM_PACK (0)); /* ra */ NEXT; } @@ -1182,9 +1182,9 @@ VM_DEFINE_INSTRUCTION (65, call_cc, "call/cc", 0, 1, 1) cont = scm_i_make_continuation (&first, vm, vm_cont); if (first) { - PUSH (0); /* dynamic link */ - PUSH (0); /* mvra */ - PUSH (0); /* ra */ + PUSH (SCM_PACK (0)); /* dynamic link */ + PUSH (SCM_PACK (0)); /* mvra */ + PUSH (SCM_PACK (0)); /* ra */ PUSH (proc); PUSH (cont); nargs = 1; diff --git a/libguile/weaks.h b/libguile/weaks.h index 5cb8bc388..fc16f8bf8 100644 --- a/libguile/weaks.h +++ b/libguile/weaks.h @@ -3,7 +3,7 @@ #ifndef SCM_WEAKS_H #define SCM_WEAKS_H -/* Copyright (C) 1995,1996,2000,2001, 2003, 2006, 2008, 2009 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000,2001, 2003, 2006, 2008, 2009, 2011 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -50,7 +50,7 @@ SCM_INTERNAL SCM scm_doubly_weak_pair (SCM car, SCM cdr); /* Testing the weak component(s) of a cell for reachability. */ #define SCM_WEAK_PAIR_WORD_DELETED_P(_cell, _word) \ - (SCM_CELL_OBJECT ((_cell), (_word)) == SCM_PACK (NULL)) + (SCM_UNPACK (SCM_CELL_OBJECT ((_cell), (_word))) == 0) #define SCM_WEAK_PAIR_CAR_DELETED_P(_cell) \ (SCM_WEAK_PAIR_WORD_DELETED_P ((_cell), 0)) #define SCM_WEAK_PAIR_CDR_DELETED_P(_cell) \