From 210c0325d38abc7409b34b6b4724a297c5524eb5 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 13 May 2011 10:19:48 +0200 Subject: [PATCH] allow iflags to be constant expressions with typing-strictness==2 * libguile/tags.h (SCM_MAKE_ITAG8_BITS): New helper, produces a scm_t_bits instead of a SCM, because SCM_UNPACK is not a constant expression with SCM_DEBUG_TYPING_STRICTNESS==2. (SCM_MAKIFLAG_BITS): Remove SCM_MAKIFLAG, and replace with this, which returns bits. (SCM_BOOL_F_BITS, SCM_ELISP_NIL_BITS, SCM_EOL_BITS, SCM_BOOL_T_BITS): (SCM_UNSPECIFIED_BITS, SCM_UNDEFINED_BITS, SCM_EOF_VAL_BITS): (SCM_UNBOUND_BITS): New definitions. Defined SCM_BOOL_F, etc in terms of them. (SCM_XXX_ANOTHER_BOOLEAN_DONT_USE_0): (SCM_XXX_ANOTHER_BOOLEAN_DONT_USE_1): (SCM_XXX_ANOTHER_BOOLEAN_DONT_USE_2): (SCM_XXX_ANOTHER_LISP_FALSE_DONT_USE): Be bits instead of SCM values. (SCM_BITS_DIFFER_IN_EXACTLY_ONE_BIT_POSITION): (SCM_BITS_DIFFER_IN_EXACTLY_TWO_BIT_POSITIONS): Rename from SCM_VALUES_DIFFER_..., and take unpacked bits as the args. * libguile/boolean.c: Update verify block to use SCM_BITS_DIFFER_IN_EXACTLY_TWO_BIT_POSITIONS et al. * libguile/debug.c (scm_debug_opts): * libguile/print.c (scm_print_opts): * libguile/read.c (scm_read_opts): Use iflags bits for initializers. * libguile/hash.c (scm_hasher): Use _BITS for iflags as case labels. * libguile/pairs.c: Nil/null compile-time check uses SCM_ELISP_NIL_BITS. --- libguile/boolean.c | 26 +++++++++++------------ libguile/debug.c | 4 ++-- libguile/hash.c | 10 ++++----- libguile/pairs.c | 6 +++--- libguile/print.c | 6 +++--- libguile/read.c | 2 +- libguile/tags.h | 52 ++++++++++++++++++++++++++++------------------ 7 files changed, 58 insertions(+), 48 deletions(-) diff --git a/libguile/boolean.c b/libguile/boolean.c index 452b8adda..3bf672d6d 100644 --- a/libguile/boolean.c +++ b/libguile/boolean.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995, 1996, 2000, 2001, 2006, 2008, 2009, 2010 Free Software Foundation, Inc. +/* Copyright (C) 1995, 1996, 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 @@ -40,18 +40,18 @@ * See the comments preceeding the definitions of SCM_BOOL_F and * SCM_MATCHES_BITS_IN_COMMON in tags.h for more information. */ -verify (SCM_VALUES_DIFFER_IN_EXACTLY_ONE_BIT_POSITION \ - (SCM_BOOL_F, SCM_BOOL_T)); -verify (SCM_VALUES_DIFFER_IN_EXACTLY_ONE_BIT_POSITION \ - (SCM_ELISP_NIL, SCM_BOOL_F)); -verify (SCM_VALUES_DIFFER_IN_EXACTLY_ONE_BIT_POSITION \ - (SCM_ELISP_NIL, SCM_EOL)); -verify (SCM_VALUES_DIFFER_IN_EXACTLY_TWO_BIT_POSITIONS \ - (SCM_ELISP_NIL, SCM_BOOL_F, SCM_BOOL_T, \ - SCM_XXX_ANOTHER_BOOLEAN_DONT_USE_0)); -verify (SCM_VALUES_DIFFER_IN_EXACTLY_TWO_BIT_POSITIONS \ - (SCM_ELISP_NIL, SCM_BOOL_F, SCM_EOL, \ - SCM_XXX_ANOTHER_LISP_FALSE_DONT_USE)); +verify (SCM_BITS_DIFFER_IN_EXACTLY_ONE_BIT_POSITION \ + (SCM_BOOL_F_BITS, SCM_BOOL_T_BITS)); +verify (SCM_BITS_DIFFER_IN_EXACTLY_ONE_BIT_POSITION \ + (SCM_ELISP_NIL_BITS, SCM_BOOL_F_BITS)); +verify (SCM_BITS_DIFFER_IN_EXACTLY_ONE_BIT_POSITION \ + (SCM_ELISP_NIL_BITS, SCM_EOL_BITS)); +verify (SCM_BITS_DIFFER_IN_EXACTLY_TWO_BIT_POSITIONS \ + (SCM_ELISP_NIL_BITS, SCM_BOOL_F_BITS, SCM_BOOL_T_BITS, \ + SCM_XXX_ANOTHER_BOOLEAN_DONT_USE_0)); +verify (SCM_BITS_DIFFER_IN_EXACTLY_TWO_BIT_POSITIONS \ + (SCM_ELISP_NIL_BITS, SCM_BOOL_F_BITS, SCM_EOL_BITS, \ + SCM_XXX_ANOTHER_LISP_FALSE_DONT_USE)); SCM_DEFINE (scm_not, "not", 1, 0, 0, (SCM x), diff --git a/libguile/debug.c b/libguile/debug.c index e059a3135..88a01d6aa 100644 --- a/libguile/debug.c +++ b/libguile/debug.c @@ -1,5 +1,5 @@ /* Debugging extensions for Guile - * Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008, 2009, 2010 Free Software Foundation + * Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008, 2009, 2010, 2011 Free Software Foundation * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -82,7 +82,7 @@ scm_t_option scm_debug_opts[] = { for anyone!) or a whoppin' 1280 KB on 64-bit arches. */ { SCM_OPTION_INTEGER, "stack", 160000, "Stack size limit (measured in words; 0 = no check)." }, - { SCM_OPTION_SCM, "show-file-name", (scm_t_bits)SCM_BOOL_T, + { SCM_OPTION_SCM, "show-file-name", SCM_BOOL_T_BITS, "Show file names and line numbers " "in backtraces when not `#f'. A value of `base' " "displays only base names, while `#t' displays full names."}, diff --git a/libguile/hash.c b/libguile/hash.c index 8448c7ce9..a79f03d95 100644 --- a/libguile/hash.c +++ b/libguile/hash.c @@ -160,18 +160,16 @@ scm_hasher(SCM obj, unsigned long n, size_t d) if (SCM_CHARP(obj)) return (unsigned)(scm_c_downcase(SCM_CHAR(obj))) % n; switch (SCM_UNPACK (obj)) { -#ifndef SICP - case SCM_UNPACK(SCM_EOL): + case SCM_EOL_BITS: d = 256; break; -#endif - case SCM_UNPACK(SCM_BOOL_T): + case SCM_BOOL_T_BITS: d = 257; break; - case SCM_UNPACK(SCM_BOOL_F): + case SCM_BOOL_F_BITS: d = 258; break; - case SCM_UNPACK(SCM_EOF_VAL): + case SCM_EOF_VAL_BITS: d = 259; break; default: diff --git a/libguile/pairs.c b/libguile/pairs.c index 68fa4c901..5dbbab566 100644 --- a/libguile/pairs.c +++ b/libguile/pairs.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,2000,2001, 2004, 2005, 2006, 2008, 2009 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000,2001, 2004, 2005, 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 @@ -42,8 +42,8 @@ * See the comments preceeding the definitions of SCM_BOOL_F and * SCM_MATCHES_BITS_IN_COMMON in tags.h for more information. */ -verify (SCM_VALUES_DIFFER_IN_EXACTLY_ONE_BIT_POSITION \ - (SCM_ELISP_NIL, SCM_EOL)); +verify (SCM_BITS_DIFFER_IN_EXACTLY_ONE_BIT_POSITION \ + (SCM_ELISP_NIL_BITS, SCM_EOL_BITS)); #if (SCM_DEBUG_PAIR_ACCESSES == 1) diff --git a/libguile/print.c b/libguile/print.c index 453c8a9f0..b46296abb 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -100,11 +100,11 @@ static const char *iflagnames[] = SCM_SYMBOL (sym_reader, "reader"); scm_t_option scm_print_opts[] = { - { SCM_OPTION_SCM, "highlight-prefix", (scm_t_bits)SCM_BOOL_F, + { SCM_OPTION_SCM, "highlight-prefix", (scm_t_bits)SCM_BOOL_F_BITS, "The string to print before highlighted values." }, - { SCM_OPTION_SCM, "highlight-suffix", (scm_t_bits)SCM_BOOL_F, + { SCM_OPTION_SCM, "highlight-suffix", (scm_t_bits)SCM_BOOL_F_BITS, "The string to print after highlighted values." }, - { SCM_OPTION_SCM, "quote-keywordish-symbols", (scm_t_bits)SCM_BOOL_F, + { SCM_OPTION_SCM, "quote-keywordish-symbols", (scm_t_bits)SCM_BOOL_F_BITS, "How to print symbols that have a colon as their first or last character. " "The value '#f' does not quote the colons; '#t' quotes them; " "'reader' quotes them when the reader option 'keywords' is not '#f'." diff --git a/libguile/read.c b/libguile/read.c index 676ccf753..ad809ef56 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -70,7 +70,7 @@ scm_t_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_t_bits) SCM_BOOL_F, + { SCM_OPTION_SCM, "keywords", (scm_t_bits) SCM_BOOL_F_BITS, "Style of keyword recognition: #f, 'prefix or 'postfix."}, { SCM_OPTION_BOOLEAN, "r6rs-hex-escapes", 0, "Use R6RS variable-length character and string hex escapes."}, diff --git a/libguile/tags.h b/libguile/tags.h index 147895dd1..26ec16425 100644 --- a/libguile/tags.h +++ b/libguile/tags.h @@ -464,7 +464,8 @@ enum scm_tc8_tags }; #define SCM_ITAG8(X) (SCM_UNPACK (X) & 0xff) -#define SCM_MAKE_ITAG8(X, TAG) SCM_PACK (((X) << 8) + TAG) +#define SCM_MAKE_ITAG8_BITS(X, TAG) (((X) << 8) + TAG) +#define SCM_MAKE_ITAG8(X, TAG) (SCM_PACK (SCM_MAKE_ITAG8_BITS (X, TAG))) #define SCM_ITAG8_DATA(X) (SCM_UNPACK (X) >> 8) @@ -473,7 +474,7 @@ enum scm_tc8_tags * declarations in print.c: iflagnames. */ #define SCM_IFLAGP(n) (SCM_ITAG8 (n) == scm_tc8_flag) -#define SCM_MAKIFLAG(n) SCM_MAKE_ITAG8 ((n), scm_tc8_flag) +#define SCM_MAKIFLAG_BITS(n) (SCM_MAKE_ITAG8_BITS ((n), scm_tc8_flag)) #define SCM_IFLAGNUM(n) (SCM_ITAG8_DATA (n)) /* @@ -507,25 +508,35 @@ enum scm_tc8_tags * defined below. The properties are checked at compile-time using * `verify' macros near the top of boolean.c and pairs.c. */ -#define SCM_BOOL_F SCM_MAKIFLAG (0) -#define SCM_ELISP_NIL SCM_MAKIFLAG (1) +#define SCM_BOOL_F_BITS SCM_MAKIFLAG_BITS (0) +#define SCM_ELISP_NIL_BITS SCM_MAKIFLAG_BITS (1) + +#define SCM_BOOL_F SCM_PACK (SCM_BOOL_F_BITS) +#define SCM_ELISP_NIL SCM_PACK (SCM_ELISP_NIL_BITS) #ifdef BUILDING_LIBGUILE -#define SCM_XXX_ANOTHER_LISP_FALSE_DONT_USE SCM_MAKIFLAG (2) +#define SCM_XXX_ANOTHER_LISP_FALSE_DONT_USE SCM_MAKIFLAG_BITS (2) #endif -#define SCM_EOL SCM_MAKIFLAG (3) -#define SCM_BOOL_T SCM_MAKIFLAG (4) +#define SCM_EOL_BITS SCM_MAKIFLAG_BITS (3) +#define SCM_BOOL_T_BITS SCM_MAKIFLAG_BITS (4) + +#define SCM_EOL SCM_PACK (SCM_EOL_BITS) +#define SCM_BOOL_T SCM_PACK (SCM_BOOL_T_BITS) #ifdef BUILDING_LIBGUILE -#define SCM_XXX_ANOTHER_BOOLEAN_DONT_USE_0 SCM_MAKIFLAG (5) -#define SCM_XXX_ANOTHER_BOOLEAN_DONT_USE_1 SCM_MAKIFLAG (6) -#define SCM_XXX_ANOTHER_BOOLEAN_DONT_USE_2 SCM_MAKIFLAG (7) +#define SCM_XXX_ANOTHER_BOOLEAN_DONT_USE_0 SCM_MAKIFLAG_BITS (5) +#define SCM_XXX_ANOTHER_BOOLEAN_DONT_USE_1 SCM_MAKIFLAG_BITS (6) +#define SCM_XXX_ANOTHER_BOOLEAN_DONT_USE_2 SCM_MAKIFLAG_BITS (7) #endif -#define SCM_UNSPECIFIED SCM_MAKIFLAG (8) -#define SCM_UNDEFINED SCM_MAKIFLAG (9) -#define SCM_EOF_VAL SCM_MAKIFLAG (10) +#define SCM_UNSPECIFIED_BITS SCM_MAKIFLAG_BITS (8) +#define SCM_UNDEFINED_BITS SCM_MAKIFLAG_BITS (9) +#define SCM_EOF_VAL_BITS SCM_MAKIFLAG_BITS (10) + +#define SCM_UNSPECIFIED SCM_PACK (SCM_UNSPECIFIED_BITS) +#define SCM_UNDEFINED SCM_PACK (SCM_UNDEFINED_BITS) +#define SCM_EOF_VAL SCM_PACK (SCM_EOF_VAL_BITS) /* When a variable is unbound this is marked by the SCM_UNDEFINED * value. The following is an unbound value which can be handled on @@ -535,7 +546,8 @@ enum scm_tc8_tags * the code which handles this value in C so that SCM_UNDEFINED can be * used instead. It is not ideal to let this kind of unique and * strange values loose on the Scheme level. */ -#define SCM_UNBOUND SCM_MAKIFLAG (11) +#define SCM_UNBOUND_BITS SCM_MAKIFLAG_BITS (11) +#define SCM_UNBOUND SCM_PACK (SCM_UNBOUND_BITS) #define SCM_UNBNDP(x) (scm_is_eq ((x), SCM_UNDEFINED)) @@ -574,12 +586,12 @@ enum scm_tc8_tags #define SCM_HAS_EXACTLY_TWO_BITS_SET(x) \ (SCM_HAS_EXACTLY_ONE_BIT_SET (SCM_WITH_LEAST_SIGNIFICANT_1_BIT_CLEARED (x))) -#define SCM_VALUES_DIFFER_IN_EXACTLY_ONE_BIT_POSITION(a,b) \ - (SCM_HAS_EXACTLY_ONE_BIT_SET (SCM_UNPACK(a) ^ SCM_UNPACK(b))) -#define SCM_VALUES_DIFFER_IN_EXACTLY_TWO_BIT_POSITIONS(a,b,c,d) \ - (SCM_HAS_EXACTLY_TWO_BITS_SET ((SCM_UNPACK(a) ^ SCM_UNPACK(b)) | \ - (SCM_UNPACK(b) ^ SCM_UNPACK(c)) | \ - (SCM_UNPACK(c) ^ SCM_UNPACK(d)))) +#define SCM_BITS_DIFFER_IN_EXACTLY_ONE_BIT_POSITION(a,b) \ + (SCM_HAS_EXACTLY_ONE_BIT_SET ((a) ^ (b))) +#define SCM_BITS_DIFFER_IN_EXACTLY_TWO_BIT_POSITIONS(a,b,c,d) \ + (SCM_HAS_EXACTLY_TWO_BITS_SET (((a) ^ (b)) | \ + ((b) ^ (c)) | \ + ((c) ^ (d)))) #endif /* BUILDING_LIBGUILE */