diff options
author | Marius Vollmer <mvo@zagadka.de> | 2004-07-23 15:43:02 +0000 |
---|---|---|
committer | Marius Vollmer <mvo@zagadka.de> | 2004-07-23 15:43:02 +0000 |
commit | e11e83f3d99305ada6354cae7123fb8c0e998703 (patch) | |
tree | 23dccd2a0fd1741abb8561214acadc347036480b | |
parent | 928e0f421070bb610f3375d5808a6378d5edfa1b (diff) | |
download | guile-e11e83f3d99305ada6354cae7123fb8c0e998703.tar.gz |
* deprecated.h, deprecated.c, numbers.h (SCM_INUMP, SCM_NINUMP,
SCM_INUM): Deprecated by reenaming them to SCM_I_INUMP, SCM_I_NINUMP
and SCM_I_INUM, respectively and adding deprecated versions to
deprecated.h and deprecated.c. Changed all uses to either use the
SCM_I_ variants or scm_is_*, scm_to_*, or scm_from_*, as appropriate.
59 files changed, 838 insertions, 1170 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 565f78fb2..650dbb8b4 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,7 +1,20 @@ +2004-07-23 Marius Vollmer <marius.vollmer@uni-dortmund.de> + + * deprecated.h, deprecated.c, numbers.h (SCM_INUMP, SCM_NINUMP, + SCM_INUM): Deprecated by reenaming them to SCM_I_INUMP, + SCM_I_NINUMP and SCM_I_INUM, respectively and adding deprecated + versions to deprecated.h and deprecated.c. Changed all uses to + either use the SCM_I_ variants or scm_is_*, scm_to_*, or + scm_from_*, as appropriate. + + * dynwind.c (scm_i_dowinds): Removed unused code that would call + the unexisting scm_cross_dynwind_binding_scope for inums on the + windlist. + 2004-07-10 Marius Vollmer <marius.vollmer@uni-dortmund.de> * socket.c (ipv6_net_to_num, scm_from_ipv6): Renamed - ipv6_net_to_num to scm_from_ipv6, for converting from an IPv& + ipv6_net_to_num to scm_from_ipv6, for converting from an IPv6 byte-wise address to a SCM integer. Changed all uses. (ipv6_num_to_net, scm_to_ipv6): Renamed ipv6_num_to_net to scm_to_ipv6 and added type and range checking, for converting from diff --git a/libguile/backtrace.c b/libguile/backtrace.c index 3e5080623..591108d14 100644 --- a/libguile/backtrace.c +++ b/libguile/backtrace.c @@ -92,9 +92,9 @@ display_header (SCM source, SCM port) if (scm_is_true (line) && scm_is_true (col)) { scm_putc (':', port); - scm_intprint (SCM_INUM (line) + 1, 10, port); + scm_intprint (scm_to_long (line) + 1, 10, port); scm_putc (':', port); - scm_intprint (SCM_INUM (col) + 1, 10, port); + scm_intprint (scm_to_long (col) + 1, 10, port); } } else @@ -339,10 +339,8 @@ SCM_DEFINE (scm_set_print_params_x, "set-print-params!", 1, 0, 0, SCM_VALIDATE_NONEMPTYLIST_COPYLEN (2, params, n); for (ls = params; !SCM_NULL_OR_NIL_P (ls); ls = SCM_CDR (ls)) SCM_ASSERT (scm_ilength (SCM_CAR (params)) == 2 - && SCM_INUMP (SCM_CAAR (ls)) - && SCM_INUM (SCM_CAAR (ls)) >= 0 - && SCM_INUMP (SCM_CADAR (ls)) - && SCM_INUM (SCM_CADAR (ls)) >= 0, + && scm_is_unsigned_integer (SCM_CAAR (ls), 0, INT_MAX) + && scm_is_unsigned_integer (SCM_CADAR (ls), 0, INT_MAX), params, SCM_ARG2, s_scm_set_print_params_x); @@ -352,8 +350,8 @@ SCM_DEFINE (scm_set_print_params_x, "set-print-params!", 1, 0, 0, print_params = new_params; for (i = 0; i < n; ++i) { - print_params[i].level = SCM_INUM (SCM_CAAR (params)); - print_params[i].length = SCM_INUM (SCM_CADAR (params)); + print_params[i].level = scm_to_int (SCM_CAAR (params)); + print_params[i].length = scm_to_int (SCM_CADAR (params)); params = SCM_CDR (params); } n_print_params = n; @@ -545,7 +543,7 @@ display_backtrace_file_and_line (SCM frame, SCM port, scm_print_state *pstate) else if (scm_is_true (line)) { int i, j=0; - for (i = SCM_INUM (line)+1; i > 0; i = i/10, j++) + for (i = scm_to_int (line)+1; i > 0; i = i/10, j++) ; indent (4-j, port); } @@ -553,7 +551,7 @@ display_backtrace_file_and_line (SCM frame, SCM port, scm_print_state *pstate) if (scm_is_false (line)) scm_puts (" ?", port); else - scm_intprint (SCM_INUM (line) + 1, 10, port); + scm_intprint (scm_to_int (line) + 1, 10, port); scm_puts (": ", port); } @@ -642,11 +640,11 @@ display_backtrace_body (struct display_backtrace_args *a) /* Argument checking and extraction. */ SCM_VALIDATE_STACK (1, a->stack); SCM_VALIDATE_OPOUTPORT (2, a->port); - n_frames = SCM_INUM (scm_stack_length (a->stack)); - n = SCM_INUMP (a->depth) ? SCM_INUM (a->depth) : SCM_BACKTRACE_DEPTH; + n_frames = scm_to_int (scm_stack_length (a->stack)); + n = scm_is_integer (a->depth) ? scm_to_int (a->depth) : SCM_BACKTRACE_DEPTH; if (SCM_BACKWARDS_P) { - beg = SCM_INUMP (a->first) ? SCM_INUM (a->first) : 0; + beg = scm_is_integer (a->first) ? scm_to_int (a->first) : 0; end = beg + n - 1; if (end >= n_frames) end = n_frames - 1; @@ -654,9 +652,9 @@ display_backtrace_body (struct display_backtrace_args *a) } else { - if (SCM_INUMP (a->first)) + if (scm_is_integer (a->first)) { - beg = SCM_INUM (a->first); + beg = scm_to_int (a->first); end = beg - n + 1; if (end < 0) end = 0; diff --git a/libguile/convert.i.c b/libguile/convert.i.c index b66e31806..df9f88359 100644 --- a/libguile/convert.i.c +++ b/libguile/convert.i.c @@ -23,9 +23,9 @@ SCM2CTYPES (SCM obj, CTYPE *data) val = SCM_CAR (list); #if SIZEOF_CTYPE && SIZEOF_CTYPE < SIZEOF_SCM_T_BITS /* check integer ranges */ - if (SCM_INUMP (val)) + if (SCM_I_INUMP (val)) { - scm_t_signed_bits v = SCM_INUM (val); + scm_t_signed_bits v = SCM_I_INUM (val); CTYPE c = (CTYPE) v; SCM_ASSERT_RANGE (SCM_ARG1, val, v != (scm_t_signed_bits) c); } @@ -41,9 +41,9 @@ SCM2CTYPES (SCM obj, CTYPE *data) #elif defined (FLOATTYPE) /* real values, big numbers and immediate values are valid for float conversions */ - if (!SCM_REALP (val) && !SCM_BIGP (val) && !SCM_INUMP (val)) + if (!SCM_REALP (val) && !SCM_BIGP (val) && !SCM_I_INUMP (val)) #else - if (!SCM_BIGP (val) && !SCM_INUMP (val)) + if (!SCM_BIGP (val) && !SCM_I_INUMP (val)) #endif /* FLOATTYPE */ SCM_WRONG_TYPE_ARG (SCM_ARG1, val); } @@ -58,8 +58,8 @@ SCM2CTYPES (SCM obj, CTYPE *data) for (i = 0; scm_is_true (scm_pair_p (list)); list = SCM_CDR (list), i++) { val = SCM_CAR (list); - if (SCM_INUMP (val)) - data[i] = (CTYPE) SCM_INUM (val); + if (SCM_I_INUMP (val)) + data[i] = (CTYPE) SCM_I_INUM (val); else if (SCM_BIGP (val)) data[i] = (CTYPE) scm_num2long (val, SCM_ARG1, FUNC_NAME); #if defined (FLOATTYPE) @@ -83,9 +83,9 @@ SCM2CTYPES (SCM obj, CTYPE *data) val = SCM_VELTS (obj)[i]; #if SIZEOF_CTYPE && SIZEOF_CTYPE < SIZEOF_SCM_T_BITS /* check integer ranges */ - if (SCM_INUMP (val)) + if (SCM_I_INUMP (val)) { - scm_t_signed_bits v = SCM_INUM (val); + scm_t_signed_bits v = SCM_I_INUM (val); CTYPE c = (CTYPE) v; SCM_ASSERT_RANGE (SCM_ARG1, val, v != (scm_t_signed_bits) c); } @@ -101,9 +101,9 @@ SCM2CTYPES (SCM obj, CTYPE *data) #elif defined (FLOATTYPE) /* real values, big numbers and immediate values are valid for float conversions */ - if (!SCM_REALP (val) && !SCM_BIGP (val) && !SCM_INUMP (val)) + if (!SCM_REALP (val) && !SCM_BIGP (val) && !SCM_I_INUMP (val)) #else - if (!SCM_BIGP (val) && !SCM_INUMP (val)) + if (!SCM_BIGP (val) && !SCM_I_INUMP (val)) #endif /* FLOATTYPE */ SCM_WRONG_TYPE_ARG (SCM_ARG1, val); } @@ -117,8 +117,8 @@ SCM2CTYPES (SCM obj, CTYPE *data) for (i = 0; i < n; i++) { val = SCM_VELTS (obj)[i]; - if (SCM_INUMP (val)) - data[i] = (CTYPE) SCM_INUM (val); + if (SCM_I_INUMP (val)) + data[i] = (CTYPE) SCM_I_INUM (val); else if (SCM_BIGP (val)) data[i] = (CTYPE) scm_num2long (val, SCM_ARG1, FUNC_NAME); #if defined (FLOATTYPE) diff --git a/libguile/debug-malloc.c b/libguile/debug-malloc.c index c51b3f9f8..55f30d80a 100644 --- a/libguile/debug-malloc.c +++ b/libguile/debug-malloc.c @@ -217,7 +217,7 @@ SCM_DEFINE (scm_malloc_stats, "malloc-stats", 0, 0, 0, for (i = 0; i < malloc_type_size + N_SEEK; ++i) if (malloc_type[i].key) res = scm_acons (scm_makfrom0str ((char *) malloc_type[i].key), - SCM_I_MAKINUM ((int) malloc_type[i].data), + scm_from_int ((int) malloc_type[i].data), res); return res; } diff --git a/libguile/dynl.c b/libguile/dynl.c index 775836cfa..834a98939 100644 --- a/libguile/dynl.c +++ b/libguile/dynl.c @@ -314,7 +314,7 @@ SCM_DEFINE (scm_dynamic_args_call, "dynamic-args-call", 3, 0, 0, result = (*fptr) (argc, argv); free (argv); - return SCM_I_MAKINUM (0L + result); + return scm_from_int (result); } #undef FUNC_NAME diff --git a/libguile/environments.c b/libguile/environments.c index e907f6f76..70e7dbc0a 100644 --- a/libguile/environments.c +++ b/libguile/environments.c @@ -481,7 +481,7 @@ static int observer_print (SCM type, SCM port, scm_print_state *pstate SCM_UNUSED) { SCM address = scm_ulong2num (SCM_UNPACK (type)); - SCM base16 = scm_number_to_string (address, SCM_I_MAKINUM (16)); + SCM base16 = scm_number_to_string (address, scm_from_int (16)); scm_puts ("#<observer ", port); scm_puts (SCM_STRING_CHARS (base16), port); @@ -745,7 +745,7 @@ core_environments_init (struct core_environments_base *body, { body->funcs = funcs; body->observers = SCM_EOL; - body->weak_observers = scm_make_weak_value_alist_vector (SCM_I_MAKINUM (1)); + body->weak_observers = scm_make_weak_value_alist_vector (scm_from_int (1)); } @@ -979,7 +979,7 @@ static int leaf_environment_print (SCM type, SCM port, scm_print_state *pstate SCM_UNUSED) { SCM address = scm_ulong2num (SCM_UNPACK (type)); - SCM base16 = scm_number_to_string (address, SCM_I_MAKINUM (16)); + SCM base16 = scm_number_to_string (address, scm_from_int (16)); scm_puts ("#<leaf environment ", port); scm_puts (SCM_STRING_CHARS (base16), port); @@ -1339,7 +1339,7 @@ static int eval_environment_print (SCM type, SCM port, scm_print_state *pstate SCM_UNUSED) { SCM address = scm_ulong2num (SCM_UNPACK (type)); - SCM base16 = scm_number_to_string (address, SCM_I_MAKINUM (16)); + SCM base16 = scm_number_to_string (address, scm_from_int (16)); scm_puts ("#<eval environment ", port); scm_puts (SCM_STRING_CHARS (base16), port); @@ -1758,7 +1758,7 @@ import_environment_print (SCM type, SCM port, scm_print_state *pstate SCM_UNUSED) { SCM address = scm_ulong2num (SCM_UNPACK (type)); - SCM base16 = scm_number_to_string (address, SCM_I_MAKINUM (16)); + SCM base16 = scm_number_to_string (address, scm_from_int (16)); scm_puts ("#<import environment ", port); scm_puts (SCM_STRING_CHARS (base16), port); @@ -2063,7 +2063,7 @@ export_environment_print (SCM type, SCM port, scm_print_state *pstate SCM_UNUSED) { SCM address = scm_ulong2num (SCM_UNPACK (type)); - SCM base16 = scm_number_to_string (address, SCM_I_MAKINUM (16)); + SCM base16 = scm_number_to_string (address, scm_from_int (16)); scm_puts ("#<export environment ", port); scm_puts (SCM_STRING_CHARS (base16), port); diff --git a/libguile/error.c b/libguile/error.c index 41588f7ce..849b0aaa6 100644 --- a/libguile/error.c +++ b/libguile/error.c @@ -240,7 +240,7 @@ scm_wrong_type_arg (const char *subr, int pos, SCM bad_value) (pos == 0) ? "Wrong type argument: ~S" : "Wrong type argument in position ~A: ~S", (pos == 0) ? scm_list_1 (bad_value) - : scm_list_2 (SCM_I_MAKINUM (pos), bad_value), + : scm_list_2 (scm_from_int (pos), bad_value), SCM_BOOL_F); } @@ -257,7 +257,7 @@ scm_wrong_type_arg_msg (const char *subr, int pos, SCM bad_value, const char *sz scm_error (scm_arg_type_key, subr, "Wrong type argument in position ~A (expecting ~A): ~S", - scm_list_3 (SCM_I_MAKINUM (pos), msg, bad_value), + scm_list_3 (scm_from_int (pos), msg, bad_value), SCM_BOOL_F); } } diff --git a/libguile/eval.c b/libguile/eval.c index af3d16719..8f7d89540 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -2179,7 +2179,7 @@ scm_m_atslot_ref (SCM expr, SCM env SCM_UNUSED) ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr); ASSERT_SYNTAX (scm_ilength (cdr_expr) == 2, s_expression, expr); slot_nr = SCM_CADR (cdr_expr); - ASSERT_SYNTAX_2 (SCM_INUMP (slot_nr), s_bad_slot_number, slot_nr, expr); + ASSERT_SYNTAX_2 (SCM_I_INUMP (slot_nr), s_bad_slot_number, slot_nr, expr); SCM_SETCAR (expr, SCM_IM_SLOT_REF); SCM_SETCDR (cdr_expr, slot_nr); @@ -2212,7 +2212,7 @@ scm_m_atslot_set_x (SCM expr, SCM env SCM_UNUSED) ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr); ASSERT_SYNTAX (scm_ilength (cdr_expr) == 3, s_expression, expr); slot_nr = SCM_CADR (cdr_expr); - ASSERT_SYNTAX_2 (SCM_INUMP (slot_nr), s_bad_slot_number, slot_nr, expr); + ASSERT_SYNTAX_2 (SCM_I_INUMP (slot_nr), s_bad_slot_number, slot_nr, expr); SCM_SETCAR (expr, SCM_IM_SLOT_SET_X); return expr; @@ -3729,14 +3729,24 @@ dispatch: { SCM z = SCM_CDDR (x); SCM tmp = SCM_CADR (z); - specializers = SCM_INUM (SCM_CAR (z)); + specializers = scm_to_ulong (SCM_CAR (z)); /* Compute a hash value for searching the method cache. There * are two variants for computing the hash value, a (rather) * complicated one, and a simple one. For the complicated one * explained below, tmp holds a number that is used in the * computation. */ - if (SCM_INUMP (tmp)) + if (SCM_VECTORP (tmp)) + { + /* This method of determining the hash value is much + * simpler: Set the hash value to zero and just perform a + * linear search through the method cache. */ + method_cache = tmp; + mask = (unsigned long int) ((long) -1); + hash_value = 0; + cache_end_pos = SCM_VECTOR_LENGTH (method_cache); + } + else { /* Use the signature of the actual arguments to determine * the hash value. This is done as follows: Each class has @@ -3753,7 +3763,7 @@ dispatch: * where dispatch is called, such that hopefully the hash * value that is computed will directly point to the right * method in the method cache. */ - unsigned long int hashset = SCM_INUM (tmp); + unsigned long int hashset = scm_to_ulong (tmp); unsigned long int counter = specializers + 1; SCM tmp_arg = arg1; hash_value = 0; @@ -3766,20 +3776,10 @@ dispatch: } z = SCM_CDDR (z); method_cache = SCM_CADR (z); - mask = SCM_INUM (SCM_CAR (z)); + mask = scm_to_ulong (SCM_CAR (z)); hash_value &= mask; cache_end_pos = hash_value; } - else - { - /* This method of determining the hash value is much - * simpler: Set the hash value to zero and just perform a - * linear search through the method cache. */ - method_cache = tmp; - mask = (unsigned long int) ((long) -1); - hash_value = 0; - cache_end_pos = SCM_VECTOR_LENGTH (method_cache); - } } { @@ -3830,7 +3830,7 @@ dispatch: x = SCM_CDR (x); { SCM instance = EVALCAR (x, env); - unsigned long int slot = SCM_INUM (SCM_CDR (x)); + unsigned long int slot = SCM_I_INUM (SCM_CDR (x)); RETURN (SCM_PACK (SCM_STRUCT_DATA (instance) [slot])); } @@ -3839,7 +3839,7 @@ dispatch: x = SCM_CDR (x); { SCM instance = EVALCAR (x, env); - unsigned long int slot = SCM_INUM (SCM_CADR (x)); + unsigned long int slot = SCM_I_INUM (SCM_CADR (x)); SCM value = EVALCAR (SCM_CDDR (x), env); SCM_STRUCT_DATA (instance) [slot] = SCM_UNPACK (value); RETURN (SCM_UNSPECIFIED); @@ -4142,9 +4142,9 @@ dispatch: case scm_tc7_subr_1o: RETURN (SCM_SUBRF (proc) (arg1)); case scm_tc7_dsubr: - if (SCM_INUMP (arg1)) + if (SCM_I_INUMP (arg1)) { - RETURN (scm_make_real (SCM_DSUBRF (proc) ((double) SCM_INUM (arg1)))); + RETURN (scm_make_real (SCM_DSUBRF (proc) ((double) SCM_I_INUM (arg1)))); } else if (SCM_REALP (arg1)) { @@ -4829,9 +4829,9 @@ tail: case scm_tc7_dsubr: if (SCM_UNBNDP (arg1) || !SCM_NULLP (args)) scm_wrong_num_args (proc); - if (SCM_INUMP (arg1)) + if (SCM_I_INUMP (arg1)) { - RETURN (scm_make_real (SCM_DSUBRF (proc) ((double) SCM_INUM (arg1)))); + RETURN (scm_make_real (SCM_DSUBRF (proc) ((double) SCM_I_INUM (arg1)))); } else if (SCM_REALP (arg1)) { @@ -5181,9 +5181,9 @@ call_lsubr_1 (SCM proc, SCM arg1) static SCM call_dsubr_1 (SCM proc, SCM arg1) { - if (SCM_INUMP (arg1)) + if (SCM_I_INUMP (arg1)) { - RETURN (scm_make_real (SCM_DSUBRF (proc) ((double) SCM_INUM (arg1)))); + RETURN (scm_make_real (SCM_DSUBRF (proc) ((double) SCM_I_INUM (arg1)))); } else if (SCM_REALP (arg1)) { @@ -5417,7 +5417,7 @@ check_map_args (SCM argv, } if (elt_len != len) - scm_out_of_range_pos (who, ve[i], SCM_I_MAKINUM (i + 2)); + scm_out_of_range_pos (who, ve[i], scm_from_long (i + 2)); } scm_remember_upto_here_1 (argv); diff --git a/libguile/feature.c b/libguile/feature.c index 1f67de618..e6b212351 100644 --- a/libguile/feature.c +++ b/libguile/feature.c @@ -98,7 +98,7 @@ scm_init_feature() #endif scm_add_feature ("threads"); - scm_c_define ("char-code-limit", SCM_I_MAKINUM (SCM_CHAR_CODE_LIMIT)); + scm_c_define ("char-code-limit", scm_from_int (SCM_CHAR_CODE_LIMIT)); #include "libguile/feature.x" } diff --git a/libguile/filesys.c b/libguile/filesys.c index 7ae482288..79cfa0131 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -299,7 +299,7 @@ SCM_DEFINE (scm_open_fdes, "open-fdes", 2, 1, 0, SCM_SYSCALL (fd = open (SCM_STRING_CHARS (path), iflags, imode)); if (fd == -1) SCM_SYSERROR; - return SCM_I_MAKINUM (fd); + return scm_from_int (fd); } #undef FUNC_NAME @@ -336,7 +336,7 @@ SCM_DEFINE (scm_open, "open", 2, 1, 0, int fd; int iflags; - fd = SCM_INUM (scm_open_fdes (path, flags, mode)); + fd = scm_to_int (scm_open_fdes (path, flags, mode)); iflags = SCM_NUM2INT (2, flags); if (iflags & O_RDWR) { @@ -476,7 +476,7 @@ scm_stat2scm (struct stat *stat_temp) else SCM_VECTOR_SET(ans, 13, scm_sym_unknown); - SCM_VECTOR_SET(ans, 14, SCM_I_MAKINUM ((~S_IFMT) & mode)); + SCM_VECTOR_SET(ans, 14, scm_from_int ((~S_IFMT) & mode)); /* the layout of the bits in ve[14] is intended to be portable. If there are systems that don't follow the usual convention, @@ -505,7 +505,7 @@ scm_stat2scm (struct stat *stat_temp) tmp <<= 1; if (S_IXOTH & mode) tmp += 1; - SCM_VECTOR_SET(ans, 14, SCM_I_MAKINUM (tmp)); + SCM_VECTOR_SET(ans, 14, scm_from_int (tmp)); */ } @@ -602,12 +602,12 @@ SCM_DEFINE (scm_stat, "stat", 1, 0, 0, int fdes; struct stat stat_temp; - if (SCM_INUMP (object)) + if (scm_is_integer (object)) { #ifdef __MINGW32__ - SCM_SYSCALL (rv = fstat_Win32 (SCM_INUM (object), &stat_temp)); + SCM_SYSCALL (rv = fstat_Win32 (scm_to_int (object), &stat_temp)); #else - SCM_SYSCALL (rv = fstat (SCM_INUM (object), &stat_temp)); + SCM_SYSCALL (rv = fstat (scm_to_int (object), &stat_temp)); #endif } else if (SCM_STRINGP (object)) @@ -974,9 +974,9 @@ set_element (SELECT_TYPE *set, SCM *ports_ready, SCM element, int pos) { int fd; - if (SCM_INUMP (element)) + if (scm_is_integer (element)) { - fd = SCM_INUM (element); + fd = scm_to_int (element); } else { @@ -1055,9 +1055,9 @@ get_element (SELECT_TYPE *set, SCM element, SCM list) { int fd; - if (SCM_INUMP (element)) + if (scm_is_integer (element)) { - fd = SCM_INUM (element); + fd = scm_to_int (element); } else { @@ -1478,12 +1478,12 @@ SCM_DEFINE (scm_dirname, "dirname", 1, 0, 0, #else if (len > 0 && s[0] == '/') #endif /* ndef __MINGW32__ */ - return scm_substring (filename, SCM_INUM0, SCM_I_MAKINUM (1)); + return scm_substring (filename, SCM_INUM0, scm_from_int (1)); else return scm_dot_string; } else - return scm_substring (filename, SCM_INUM0, SCM_I_MAKINUM (i + 1)); + return scm_substring (filename, SCM_INUM0, scm_from_int (i + 1)); } #undef FUNC_NAME @@ -1532,12 +1532,12 @@ SCM_DEFINE (scm_basename, "basename", 1, 1, 0, #else if (len > 0 && f[0] == '/') #endif /* ndef __MINGW32__ */ - return scm_substring (filename, SCM_INUM0, SCM_I_MAKINUM (1)); + return scm_substring (filename, SCM_INUM0, scm_from_int (1)); else return scm_dot_string; } else - return scm_substring (filename, SCM_I_MAKINUM (i + 1), SCM_I_MAKINUM (end + 1)); + return scm_substring (filename, scm_from_int (i+1), scm_from_int (end+1)); } #undef FUNC_NAME diff --git a/libguile/fports.c b/libguile/fports.c index b89a1999c..3cdf110b3 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -214,7 +214,7 @@ scm_evict_ports (int fd) fp->fdes = dup (fd); if (fp->fdes == -1) scm_syserror ("scm_evict_ports"); - scm_set_port_revealed_x (port, SCM_I_MAKINUM (0)); + scm_set_port_revealed_x (port, scm_from_int (0)); } } } @@ -845,9 +845,9 @@ scm_init_fports () { scm_tc16_fport = scm_make_fptob (); - scm_c_define ("_IOFBF", SCM_I_MAKINUM (_IOFBF)); - scm_c_define ("_IOLBF", SCM_I_MAKINUM (_IOLBF)); - scm_c_define ("_IONBF", SCM_I_MAKINUM (_IONBF)); + scm_c_define ("_IOFBF", scm_from_int (_IOFBF)); + scm_c_define ("_IOLBF", scm_from_int (_IOLBF)); + scm_c_define ("_IONBF", scm_from_int (_IONBF)); #include "libguile/fports.x" } diff --git a/libguile/futures.c b/libguile/futures.c index b2bb99e10..07cf6e6a3 100644 --- a/libguile/futures.c +++ b/libguile/futures.c @@ -60,7 +60,7 @@ count (SCM ls) ++n; ls = SCM_FUTURE_NEXT (ls); } - return SCM_I_MAKINUM (n); + return scm_from_int (n); } extern SCM scm_future_cache_status (void); @@ -76,7 +76,7 @@ SCM_DEFINE (scm_future_cache_status, "future-cache-status", 0, 0, 0, count (young), count (old), count (undead), - SCM_I_MAKINUM (nd)); + scm_from_int (nd)); } #undef FUNC_NAME diff --git a/libguile/gc.c b/libguile/gc.c index b1679c743..21657dc24 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -191,19 +191,12 @@ SCM_DEFINE (scm_set_debug_cell_accesses_x, "set-debug-cell-accesses!", 1, 0, 0, scm_debug_cell_accesses_p = 1; scm_expensive_debug_cell_accesses_p = 0; } - else if (SCM_INUMP (flag)) + else { - long int f = SCM_INUM (flag); - if (f <= 0) - SCM_OUT_OF_RANGE (1, flag); - scm_debug_cells_gc_interval = f; + scm_debug_cells_gc_interval = scm_to_signed_integer (flag, 0, INT_MAX); scm_debug_cell_accesses_p = 1; scm_expensive_debug_cell_accesses_p = 1; } - else - { - SCM_WRONG_TYPE_ARG (1, flag); - } return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -720,8 +713,8 @@ scm_gc_protect_object (SCM obj) /* This critical section barrier will be replaced by a mutex. */ SCM_REDEFER_INTS; - handle = scm_hashq_create_handle_x (scm_protects, obj, SCM_I_MAKINUM (0)); - SCM_SETCDR (handle, scm_sum (SCM_CDR (handle), SCM_I_MAKINUM (1))); + handle = scm_hashq_create_handle_x (scm_protects, obj, scm_from_int (0)); + SCM_SETCDR (handle, scm_sum (SCM_CDR (handle), scm_from_int (1))); protected_obj_count ++; @@ -752,8 +745,8 @@ scm_gc_unprotect_object (SCM obj) } else { - SCM count = scm_difference (SCM_CDR (handle), SCM_I_MAKINUM (1)); - if (SCM_EQ_P (count, SCM_I_MAKINUM (0))) + SCM count = scm_difference (SCM_CDR (handle), scm_from_int (1)); + if (SCM_EQ_P (count, scm_from_int (0))) scm_hashq_remove_x (scm_protects, obj); else SCM_SETCDR (handle, count); @@ -774,8 +767,9 @@ scm_gc_register_root (SCM *p) /* This critical section barrier will be replaced by a mutex. */ SCM_REDEFER_INTS; - handle = scm_hashv_create_handle_x (scm_gc_registered_roots, key, SCM_I_MAKINUM (0)); - SCM_SETCDR (handle, scm_sum (SCM_CDR (handle), SCM_I_MAKINUM (1))); + handle = scm_hashv_create_handle_x (scm_gc_registered_roots, key, + scm_from_int (0)); + SCM_SETCDR (handle, scm_sum (SCM_CDR (handle), scm_from_int (1))); SCM_REALLOW_INTS; } @@ -798,8 +792,8 @@ scm_gc_unregister_root (SCM *p) } else { - SCM count = scm_difference (SCM_CDR (handle), SCM_I_MAKINUM (1)); - if (SCM_EQ_P (count, SCM_I_MAKINUM (0))) + SCM count = scm_difference (SCM_CDR (handle), scm_from_int (1)); + if (SCM_EQ_P (count, scm_from_int (0))) scm_hashv_remove_x (scm_gc_registered_roots, key); else SCM_SETCDR (handle, count); diff --git a/libguile/gdbint.c b/libguile/gdbint.c index effd735e0..fe7cd7c94 100644 --- a/libguile/gdbint.c +++ b/libguile/gdbint.c @@ -183,10 +183,10 @@ gdb_read (char *str) } SCM_BEGIN_FOREIGN_BLOCK; unmark_port (gdb_input_port); - scm_seek (gdb_input_port, SCM_INUM0, SCM_I_MAKINUM (SEEK_SET)); + scm_seek (gdb_input_port, SCM_INUM0, scm_from_int (SEEK_SET)); scm_puts (str, gdb_input_port); scm_truncate_file (gdb_input_port, SCM_UNDEFINED); - scm_seek (gdb_input_port, SCM_INUM0, SCM_I_MAKINUM (SEEK_SET)); + scm_seek (gdb_input_port, SCM_INUM0, scm_from_int (SEEK_SET)); /* Read one object */ tok_buf_mark_p = SCM_GC_MARK_P (tok_buf); SCM_CLEAR_GC_MARK (tok_buf); @@ -242,7 +242,7 @@ gdb_print (SCM obj) RESET_STRING; SCM_BEGIN_FOREIGN_BLOCK; /* Reset stream */ - scm_seek (gdb_output_port, SCM_INUM0, SCM_I_MAKINUM (SEEK_SET)); + scm_seek (gdb_output_port, SCM_INUM0, scm_from_int (SEEK_SET)); scm_write (obj, gdb_output_port); scm_truncate_file (gdb_output_port, SCM_UNDEFINED); { @@ -285,13 +285,13 @@ scm_init_gdbint () scm_print_carefully_p = 0; port = scm_mkstrport (SCM_INUM0, - scm_make_string (SCM_I_MAKINUM (0), SCM_UNDEFINED), + scm_make_string (scm_from_int (0), SCM_UNDEFINED), SCM_OPN | SCM_WRTNG, s); gdb_output_port = scm_permanent_object (port); port = scm_mkstrport (SCM_INUM0, - scm_make_string (SCM_I_MAKINUM (0), SCM_UNDEFINED), + scm_make_string (scm_from_int (0), SCM_UNDEFINED), SCM_OPN | SCM_RDNG | SCM_WRTNG, s); gdb_input_port = scm_permanent_object (port); diff --git a/libguile/gh_data.c b/libguile/gh_data.c index 0bc5e4f1a..b1cfd5096 100644 --- a/libguile/gh_data.c +++ b/libguile/gh_data.c @@ -103,7 +103,7 @@ gh_ints2scm (const int *d, long n) long i; SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED); for (i = 0; i < n; ++i) - SCM_VECTOR_SET (v, i, (SCM_FIXABLE (d[i]) ? SCM_I_MAKINUM (d[i]) : scm_i_long2big (d[i]))); + SCM_VECTOR_SET (v, i, scm_from_int (d[i])); return v; } @@ -232,9 +232,9 @@ gh_scm2chars (SCM obj, char *m) for (i = 0; i < n; ++i) { val = SCM_VELTS (obj)[i]; - if (SCM_INUMP (val)) + if (SCM_I_INUMP (val)) { - v = SCM_INUM (val); + v = SCM_I_INUM (val); if (v < -128 || v > 255) scm_out_of_range (0, obj); } @@ -246,7 +246,7 @@ gh_scm2chars (SCM obj, char *m) if (m == NULL) return NULL; for (i = 0; i < n; ++i) - m[i] = SCM_INUM (SCM_VELTS (obj)[i]); + m[i] = SCM_I_INUM (SCM_VELTS (obj)[i]); break; #if SCM_HAVE_ARRAYS case scm_tc7_byvect: @@ -291,9 +291,9 @@ gh_scm2shorts (SCM obj, short *m) for (i = 0; i < n; ++i) { val = SCM_VELTS (obj)[i]; - if (SCM_INUMP (val)) + if (SCM_I_INUMP (val)) { - v = SCM_INUM (val); + v = SCM_I_INUM (val); if (v < -32768 || v > 65535) scm_out_of_range (0, obj); } @@ -305,7 +305,7 @@ gh_scm2shorts (SCM obj, short *m) if (m == NULL) return NULL; for (i = 0; i < n; ++i) - m[i] = SCM_INUM (SCM_VELTS (obj)[i]); + m[i] = SCM_I_INUM (SCM_VELTS (obj)[i]); break; #if SCM_HAVE_ARRAYS case scm_tc7_svect: @@ -341,7 +341,7 @@ gh_scm2longs (SCM obj, long *m) for (i = 0; i < n; ++i) { val = SCM_VELTS (obj)[i]; - if (!SCM_INUMP (val) && !SCM_BIGP (val)) + if (!SCM_I_INUMP (val) && !SCM_BIGP (val)) scm_wrong_type_arg (0, 0, obj); } if (m == 0) @@ -351,8 +351,8 @@ gh_scm2longs (SCM obj, long *m) for (i = 0; i < n; ++i) { val = SCM_VELTS (obj)[i]; - m[i] = SCM_INUMP (val) - ? SCM_INUM (val) + m[i] = SCM_I_INUMP (val) + ? SCM_I_INUM (val) : scm_num2long (val, 0, NULL); } break; @@ -391,7 +391,7 @@ gh_scm2floats (SCM obj, float *m) for (i = 0; i < n; ++i) { val = SCM_VELTS (obj)[i]; - if (!SCM_INUMP (val) + if (!SCM_I_INUMP (val) && !(SCM_BIGP (val) || SCM_REALP (val))) scm_wrong_type_arg (0, 0, val); } @@ -402,8 +402,8 @@ gh_scm2floats (SCM obj, float *m) for (i = 0; i < n; ++i) { val = SCM_VELTS (obj)[i]; - if (SCM_INUMP (val)) - m[i] = SCM_INUM (val); + if (SCM_I_INUMP (val)) + m[i] = SCM_I_INUM (val); else if (SCM_BIGP (val)) m[i] = scm_num2long (val, 0, NULL); else @@ -454,7 +454,7 @@ gh_scm2doubles (SCM obj, double *m) for (i = 0; i < n; ++i) { val = SCM_VELTS (obj)[i]; - if (!SCM_INUMP (val) + if (!SCM_I_INUMP (val) && !(SCM_BIGP (val) || SCM_REALP (val))) scm_wrong_type_arg (0, 0, val); } @@ -465,8 +465,8 @@ gh_scm2doubles (SCM obj, double *m) for (i = 0; i < n; ++i) { val = SCM_VELTS (obj)[i]; - if (SCM_INUMP (val)) - m[i] = SCM_INUM (val); + if (SCM_I_INUMP (val)) + m[i] = SCM_I_INUM (val); else if (SCM_BIGP (val)) m[i] = scm_num2long (val, 0, NULL); else diff --git a/libguile/goops.c b/libguile/goops.c index 29a1f06ea..bf6c03a51 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -310,7 +310,7 @@ compute_getters_n_setters (SCM slots) } *cdrloc = scm_cons (scm_cons (SCM_CAAR (slots), scm_cons (init, - SCM_I_MAKINUM (i++))), + scm_from_int (i++))), SCM_EOL); cdrloc = SCM_CDRLOC (*cdrloc); } @@ -454,18 +454,18 @@ SCM_DEFINE (scm_sys_initialize_object, "%initialize-object", 2, 0, 0, * in goops.scm:compute-getters-n-setters */ #define SCM_GNS_INSTANCE_ALLOCATED_P(gns) \ - (SCM_INUMP (SCM_CDDR (gns)) \ + (SCM_I_INUMP (SCM_CDDR (gns)) \ || (SCM_CONSP (SCM_CDDR (gns)) \ && SCM_CONSP (SCM_CDDDR (gns)) \ && SCM_CONSP (SCM_CDDDDR (gns)))) #define SCM_GNS_INDEX(gns) \ - (SCM_INUMP (SCM_CDDR (gns)) \ - ? SCM_INUM (SCM_CDDR (gns)) \ - : SCM_INUM (SCM_CAR (SCM_CDDDDR (gns)))) + (SCM_I_INUMP (SCM_CDDR (gns)) \ + ? SCM_I_INUM (SCM_CDDR (gns)) \ + : scm_to_long (SCM_CAR (SCM_CDDDDR (gns)))) #define SCM_GNS_SIZE(gns) \ - (SCM_INUMP (SCM_CDDR (gns)) \ + (SCM_I_INUMP (SCM_CDDR (gns)) \ ? 1 \ - : SCM_INUM (SCM_CADR (SCM_CDDDDR (gns)))) + : scm_to_long (SCM_CADR (SCM_CDDDDR (gns)))) SCM_KEYWORD (k_class, "class"); SCM_KEYWORD (k_allocation, "allocation"); @@ -484,10 +484,10 @@ SCM_DEFINE (scm_sys_prep_layout_x, "%prep-layout!", 1, 0, 0, slots = SCM_SLOT (class, scm_si_slots); getters_n_setters = SCM_SLOT (class, scm_si_getters_n_setters); nfields = SCM_SLOT (class, scm_si_nfields); - if (!SCM_INUMP (nfields) || SCM_INUM (nfields) < 0) + if (!SCM_I_INUMP (nfields) || SCM_I_INUM (nfields) < 0) SCM_MISC_ERROR ("bad value in nfields slot: ~S", scm_list_1 (nfields)); - n = 2 * SCM_INUM (nfields); + n = 2 * SCM_I_INUM (nfields); if (n < sizeof (SCM_CLASS_CLASS_LAYOUT) - 1 && SCM_SUBCLASSP (class, scm_class_class)) SCM_MISC_ERROR ("class object doesn't have enough fields: ~S", @@ -600,7 +600,7 @@ SCM_DEFINE (scm_sys_inherit_magic_x, "%inherit-magic!", 2, 0, 0, SCM_SET_CLASS_DESTRUCTOR (class, scm_struct_free_entity); else { - long n = SCM_INUM (SCM_SLOT (class, scm_si_nfields)); + long n = SCM_I_INUM (SCM_SLOT (class, scm_si_nfields)); #if 0 /* * We could avoid calling scm_gc_malloc in the allocation code @@ -649,7 +649,7 @@ scm_basic_basic_make_class (SCM class, SCM name, SCM dsupers, SCM dslots) SCM_SET_SLOT (z, scm_si_direct_supers, dsupers); cpl = compute_cpl (z); slots = build_slots_list (maplist (dslots), cpl); - nfields = SCM_I_MAKINUM (scm_ilength (slots)); + nfields = scm_from_int (scm_ilength (slots)); g_n_s = compute_getters_n_setters (slots); SCM_SET_SLOT (z, scm_si_name, name); @@ -779,7 +779,7 @@ create_basic_classes (void) SCM_SET_SLOT (scm_class_class, scm_si_direct_methods, SCM_EOL); SCM_SET_SLOT (scm_class_class, scm_si_cpl, SCM_EOL); /* will be changed */ /* SCM_SET_SLOT (scm_class_class, scm_si_slots, slots_of_class); */ - SCM_SET_SLOT (scm_class_class, scm_si_nfields, SCM_I_MAKINUM (SCM_N_CLASS_SLOTS)); + SCM_SET_SLOT (scm_class_class, scm_si_nfields, scm_from_int (SCM_N_CLASS_SLOTS)); /* SCM_SET_SLOT (scm_class_class, scm_si_getters_n_setters, compute_getters_n_setters (slots_of_class)); */ SCM_SET_SLOT (scm_class_class, scm_si_redefined, SCM_BOOL_F); @@ -1062,7 +1062,7 @@ SCM_DEFINE (scm_at_assert_bound_ref, "@assert-bound-ref", 2, 0, 0, "the value from @var{obj}.") #define FUNC_NAME s_scm_at_assert_bound_ref { - SCM value = SCM_SLOT (obj, SCM_INUM (index)); + SCM value = SCM_SLOT (obj, scm_to_int (index)); if (SCM_GOOPS_UNBOUNDP (value)) return CALL_GF1 ("slot-unbound", obj); return value; @@ -1129,9 +1129,12 @@ get_slot_value (SCM class SCM_UNUSED, SCM obj, SCM slotdef) /* Two cases here: * - access is an integer (the offset of this slot in the slots vector) * - otherwise (car access) is the getter function to apply + * + * Instances have never more than SCM_MOST_POSITIVE_FIXNUM slots, so + * we can just assume fixnums here. */ - if (SCM_INUMP (access)) - return SCM_SLOT (obj, SCM_INUM (access)); + if (SCM_I_INUMP (access)) + return SCM_SLOT (obj, SCM_I_INUM (access)); else { /* We must evaluate (apply (car access) (list obj)) @@ -1166,9 +1169,12 @@ set_slot_value (SCM class SCM_UNUSED, SCM obj, SCM slotdef, SCM value) /* Two cases here: * - access is an integer (the offset of this slot in the slots vector) * - otherwise (cadr access) is the setter function to apply + * + * Instances have never more than SCM_MOST_POSITIVE_FIXNUM slots, so + * we can just assume fixnums here. */ - if (SCM_INUMP (access)) - SCM_SET_SLOT (obj, SCM_INUM (access), value); + if (SCM_I_INUMP (access)) + SCM_SET_SLOT (obj, SCM_I_INUM (access), value); else { /* We must evaluate (apply (cadr l) (list obj value)) @@ -1382,7 +1388,7 @@ SCM_DEFINE (scm_sys_allocate_instance, "%allocate-instance", 2, 0, 0, /* Most instances */ if (SCM_CLASS_FLAGS (class) & SCM_STRUCTF_LIGHT) { - n = SCM_INUM (SCM_SLOT (class, scm_si_nfields)); + n = SCM_I_INUM (SCM_SLOT (class, scm_si_nfields)); m = (SCM *) scm_gc_malloc (n * sizeof (SCM), "struct"); return wrap_init (class, m, n); } @@ -1391,7 +1397,7 @@ SCM_DEFINE (scm_sys_allocate_instance, "%allocate-instance", 2, 0, 0, if (SCM_CLASS_FLAGS (class) & SCM_CLASSF_FOREIGN) return scm_make_foreign_object (class, initargs); - n = SCM_INUM (SCM_SLOT (class, scm_si_nfields)); + n = SCM_I_INUM (SCM_SLOT (class, scm_si_nfields)); /* Entities */ if (SCM_CLASS_FLAGS (class) & SCM_CLASSF_ENTITY) @@ -1622,7 +1628,7 @@ scm_make_method_cache (SCM gf) { return scm_list_5 (SCM_IM_DISPATCH, scm_sym_args, - SCM_I_MAKINUM (1), + scm_from_int (1), scm_c_make_vector (SCM_INITIAL_MCACHE_SIZE, list_of_no_method), gf); @@ -2712,11 +2718,11 @@ scm_add_slot (SCM class, char *slot_name, SCM slot_class, scm_list_1 (slot)))); { SCM n = SCM_SLOT (class, scm_si_nfields); - SCM gns = scm_list_n (name, SCM_BOOL_F, get, set, n, SCM_I_MAKINUM (1)); + SCM gns = scm_list_n (name, SCM_BOOL_F, get, set, n, scm_from_int (1)); SCM_SET_SLOT (class, scm_si_getters_n_setters, scm_append_x (scm_list_2 (SCM_SLOT (class, scm_si_getters_n_setters), scm_list_1 (gns)))); - SCM_SET_SLOT (class, scm_si_nfields, SCM_I_MAKINUM (SCM_INUM (n) + 1)); + SCM_SET_SLOT (class, scm_si_nfields, scm_sum (n, scm_from_int (1))); } } } @@ -2816,7 +2822,7 @@ scm_init_goops_builtins (void) scm_permanent_object (scm_goops_lookup_closure); scm_components = scm_permanent_object (scm_make_weak_key_hash_table - (SCM_I_MAKINUM (37))); + (scm_from_int (37))); goops_rstate = scm_c_make_rstate ("GOOPS", 5); diff --git a/libguile/gsubr.c b/libguile/gsubr.c index 419fad40d..4f8faefa0 100644 --- a/libguile/gsubr.c +++ b/libguile/gsubr.c @@ -86,7 +86,7 @@ create_gsubr (int define, const char *name, } SCM_SET_GSUBR_PROC (cclo, subr); SCM_SET_GSUBR_TYPE (cclo, - SCM_I_MAKINUM (SCM_GSUBR_MAKTYPE (req, opt, rst))); + scm_from_int (SCM_GSUBR_MAKTYPE (req, opt, rst))); if (SCM_REC_PROCNAMES_P) scm_set_procedure_property_x (cclo, scm_sym_name, sym); if (define) @@ -187,13 +187,13 @@ scm_gsubr_apply (SCM args) SCM self = SCM_CAR (args); SCM (*fcn)() = SCM_SUBRF (SCM_GSUBR_PROC (self)); SCM v[SCM_GSUBR_MAX]; - long typ = SCM_INUM (SCM_GSUBR_TYPE (self)); + int typ = scm_to_int (SCM_GSUBR_TYPE (self)); long i, n = SCM_GSUBR_REQ (typ) + SCM_GSUBR_OPT (typ) + SCM_GSUBR_REST (typ); #if 0 if (n > SCM_GSUBR_MAX) scm_misc_error (FUNC_NAME, "Function ~S has illegal arity ~S.", - scm_list_2 (self, SCM_I_MAKINUM (n))); + scm_list_2 (self, scm_from_int (n))); #endif args = SCM_CDR (args); for (i = 0; i < SCM_GSUBR_REQ (typ); i++) { diff --git a/libguile/guardians.c b/libguile/guardians.c index 95f95c745..706fbcb47 100644 --- a/libguile/guardians.c +++ b/libguile/guardians.c @@ -604,7 +604,7 @@ scm_init_guardians () whine_about_self_centered_zombies, 0, 0); greedily_guarded_whash = - scm_permanent_object (scm_make_doubly_weak_hash_table (SCM_I_MAKINUM (31))); + scm_permanent_object (scm_make_doubly_weak_hash_table (scm_from_int (31))); #include "libguile/guardians.x" } diff --git a/libguile/hash.c b/libguile/hash.c index 18c80c0dd..4415bf82f 100644 --- a/libguile/hash.c +++ b/libguile/hash.c @@ -57,7 +57,7 @@ scm_hasher(SCM obj, unsigned long n, size_t d) switch (SCM_ITAG3 (obj)) { case scm_tc3_int_1: case scm_tc3_int_2: - return SCM_INUM(obj) % n; /* SCM_INUMP(obj) */ + return SCM_I_INUM(obj) % n; /* SCM_INUMP(obj) */ case scm_tc3_imm24: if (SCM_CHARP(obj)) return (unsigned)(scm_c_downcase(SCM_CHAR(obj))) % n; @@ -91,20 +91,20 @@ scm_hasher(SCM obj, unsigned long n, size_t d) case scm_tc7_number: switch SCM_TYP16 (obj) { case scm_tc16_big: - return SCM_INUM (scm_modulo (obj, SCM_I_MAKINUM (n))); + return scm_to_ulong (scm_modulo (obj, scm_from_ulong (n))); case scm_tc16_real: { double r = SCM_REAL_VALUE (obj); - if (floor (r) == r) { - obj = scm_inexact_to_exact (obj); - if SCM_IMP (obj) return SCM_INUM (obj) % n; - return SCM_INUM (scm_modulo (obj, SCM_I_MAKINUM (n))); - } + if (floor (r) == r) + { + obj = scm_inexact_to_exact (obj); + return scm_to_ulong (scm_modulo (obj, scm_from_ulong (n))); + } } /* Fall through */ case scm_tc16_complex: case scm_tc16_fraction: - obj = scm_number_to_string (obj, SCM_I_MAKINUM (10)); + obj = scm_number_to_string (obj, scm_from_int (10)); /* Fall through */ } /* Fall through */ diff --git a/libguile/hashtab.c b/libguile/hashtab.c index eae2f304a..311827cce 100644 --- a/libguile/hashtab.c +++ b/libguile/hashtab.c @@ -90,7 +90,7 @@ make_hash_table (int flags, unsigned long k, const char *func_name) { perform the final scan for broken references. Instead we do that ourselves in scan_weak_hashtables. */ vector = scm_i_allocate_weak_vector (flags | SCM_WVECTF_NOSCAN, - SCM_I_MAKINUM (n), + scm_from_int (n), SCM_EOL, func_name); else @@ -155,7 +155,7 @@ scm_i_rehash (SCM table, if (SCM_HASHTABLE_WEAK_P (table)) new_buckets = scm_i_allocate_weak_vector (SCM_HASHTABLE_FLAGS (table) | SCM_WVECTF_NOSCAN, - SCM_I_MAKINUM (new_size), + scm_from_ulong (new_size), SCM_EOL, func_name); else diff --git a/libguile/hooks.c b/libguile/hooks.c index 10a3e6525..1c316ef69 100644 --- a/libguile/hooks.c +++ b/libguile/hooks.c @@ -202,9 +202,9 @@ SCM_DEFINE (scm_add_hook_x, "add-hook!", 2, 1, 0, SCM_ASSERT (scm_is_true (arity = scm_i_procedure_arity (proc)), proc, SCM_ARG2, FUNC_NAME); n_args = SCM_HOOK_ARITY (hook); - if (SCM_INUM (SCM_CAR (arity)) > n_args + if (scm_to_int (SCM_CAR (arity)) > n_args || (scm_is_false (SCM_CADDR (arity)) - && (SCM_INUM (SCM_CAR (arity)) + SCM_INUM (SCM_CADR (arity)) + && (scm_to_int (SCM_CAR (arity)) + scm_to_int (SCM_CADR (arity)) < n_args))) scm_wrong_type_arg (FUNC_NAME, 2, proc); rest = scm_delq_x (proc, SCM_HOOK_PROCEDURES (hook)); @@ -254,7 +254,7 @@ SCM_DEFINE (scm_run_hook, "run-hook", 1, 0, 1, SCM_VALIDATE_HOOK (1, hook); if (scm_ilength (args) != SCM_HOOK_ARITY (hook)) SCM_MISC_ERROR ("Hook ~S requires ~A arguments", - scm_list_2 (hook, SCM_I_MAKINUM (SCM_HOOK_ARITY (hook)))); + scm_list_2 (hook, scm_from_int (SCM_HOOK_ARITY (hook)))); scm_c_run_hook (hook, args); return SCM_UNSPECIFIED; } diff --git a/libguile/ioext.c b/libguile/ioext.c index 0abce7f00..09392c057 100644 --- a/libguile/ioext.c +++ b/libguile/ioext.c @@ -53,7 +53,7 @@ SCM_DEFINE (scm_ftell, "ftell", 1, 0, 0, "@end lisp") #define FUNC_NAME s_scm_ftell { - return scm_seek (fd_port, SCM_INUM0, SCM_I_MAKINUM (SEEK_CUR)); + return scm_seek (fd_port, SCM_INUM0, scm_from_int (SEEK_CUR)); } #undef FUNC_NAME @@ -114,8 +114,8 @@ SCM_DEFINE (scm_dup_to_fdes, "dup->fdes", 1, 1, 0, fd_or_port = SCM_COERCE_OUTPORT (fd_or_port); - if (SCM_INUMP (fd_or_port)) - oldfd = SCM_INUM (fd_or_port); + if (scm_is_integer (fd_or_port)) + oldfd = scm_to_int (fd_or_port); else { SCM_VALIDATE_OPFPORT (1, fd_or_port); @@ -178,7 +178,7 @@ SCM_DEFINE (scm_fileno, "fileno", 1, 0, 0, { port = SCM_COERCE_OUTPORT (port); SCM_VALIDATE_OPFPORT (1, port); - return SCM_I_MAKINUM (SCM_FPORT_FDES (port)); + return scm_from_int (SCM_FPORT_FDES (port)); } #undef FUNC_NAME diff --git a/libguile/list.c b/libguile/list.c index 7654f6617..18a0f70e7 100644 --- a/libguile/list.c +++ b/libguile/list.c @@ -196,7 +196,7 @@ SCM_DEFINE (scm_length, "length", 1, 0, 0, { long i; SCM_VALIDATE_LIST_COPYLEN (1, lst, i); - return SCM_I_MAKINUM (i); + return scm_from_long (i); } #undef FUNC_NAME diff --git a/libguile/net_db.c b/libguile/net_db.c index 7076ce40b..c1e2765fe 100644 --- a/libguile/net_db.c +++ b/libguile/net_db.c @@ -171,8 +171,8 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0, SCM_VECTOR_SET(result, 0, scm_mem2string (entry->h_name, strlen (entry->h_name))); SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->h_aliases)); - SCM_VECTOR_SET(result, 2, SCM_I_MAKINUM (entry->h_addrtype + 0L)); - SCM_VECTOR_SET(result, 3, SCM_I_MAKINUM (entry->h_length + 0L)); + SCM_VECTOR_SET(result, 2, scm_from_int (entry->h_addrtype)); + SCM_VECTOR_SET(result, 3, scm_from_int (entry->h_length)); if (sizeof (struct in_addr) != entry->h_length) { SCM_VECTOR_SET(result, 4, SCM_BOOL_F); @@ -239,8 +239,8 @@ SCM_DEFINE (scm_getnet, "getnet", 0, 1, 0, SCM_SYSERROR_MSG ("no such network ~A", scm_list_1 (net), errno); SCM_VECTOR_SET(result, 0, scm_mem2string (entry->n_name, strlen (entry->n_name))); SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->n_aliases)); - SCM_VECTOR_SET(result, 2, SCM_I_MAKINUM (entry->n_addrtype + 0L)); - SCM_VECTOR_SET(result, 3, scm_ulong2num (entry->n_net + 0L)); + SCM_VECTOR_SET(result, 2, scm_from_int (entry->n_addrtype)); + SCM_VECTOR_SET(result, 3, scm_from_ulong (entry->n_net)); return result; } #undef FUNC_NAME @@ -285,7 +285,7 @@ SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0, SCM_SYSERROR_MSG ("no such protocol ~A", scm_list_1 (protocol), errno); SCM_VECTOR_SET(result, 0, scm_mem2string (entry->p_name, strlen (entry->p_name))); SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->p_aliases)); - SCM_VECTOR_SET(result, 2, SCM_I_MAKINUM (entry->p_proto + 0L)); + SCM_VECTOR_SET(result, 2, scm_from_int (entry->p_proto)); return result; } #undef FUNC_NAME @@ -299,7 +299,7 @@ scm_return_entry (struct servent *entry) SCM_VECTOR_SET(result, 0, scm_mem2string (entry->s_name, strlen (entry->s_name))); SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->s_aliases)); - SCM_VECTOR_SET(result, 2, SCM_I_MAKINUM (ntohs (entry->s_port) + 0L)); + SCM_VECTOR_SET(result, 2, scm_from_uint16 (ntohs (entry->s_port))); SCM_VECTOR_SET(result, 3, scm_mem2string (entry->s_proto, strlen (entry->s_proto))); return result; } diff --git a/libguile/num2float.i.c b/libguile/num2float.i.c index bfcf4bd10..e69de29bb 100644 --- a/libguile/num2float.i.c +++ b/libguile/num2float.i.c @@ -1,39 +0,0 @@ -/* this file is #include'd (several times) by numbers.c */ - -FTYPE -NUM2FLOAT (SCM num, unsigned long int pos, const char *s_caller) -{ - if (SCM_INUMP (num)) - return SCM_INUM (num); - else if (SCM_BIGP (num)) - { /* bignum */ - FTYPE res = mpz_get_d (SCM_I_BIG_MPZ (num)); - if (! xisinf (res)) - return res; - else - scm_out_of_range (s_caller, num); - } - else if (SCM_REALP (num)) - return SCM_REAL_VALUE (num); - else - scm_wrong_type_arg (s_caller, pos, num); -} - -SCM -FLOAT2NUM (FTYPE n) -{ - SCM z = scm_double_cell (scm_tc16_real, 0, 0, 0); - SCM_REAL_VALUE (z) = n; - return z; -} - -/* clean up */ -#undef FLOAT2NUM -#undef NUM2FLOAT -#undef FTYPE - -/* - Local Variables: - c-file-style: "gnu" - End: -*/ diff --git a/libguile/num2integral.i.c b/libguile/num2integral.i.c index c5523b38f..e69de29bb 100644 --- a/libguile/num2integral.i.c +++ b/libguile/num2integral.i.c @@ -1,264 +0,0 @@ -/* this file is #include'd (many times) by numbers.c */ - -#if HAVE_CONFIG_H -# include <config.h> -#endif - -#ifndef UNSIGNED_ITYPE -# if UNSIGNED -# define UNSIGNED_ITYPE ITYPE -# else -# define UNSIGNED_ITYPE unsigned ITYPE -# endif -#endif - -#define UNSIGNED_ITYPE_MAX (~((UNSIGNED_ITYPE)0)) - -#ifndef SIZEOF_ITYPE -#error SIZEOF_ITYPE must be defined. -#endif - -#if UNSIGNED -# if SIZEOF_ITYPE == SIZEOF_UNSIGNED_SHORT -# define BIGMPZ_FITSP mpz_fits_ushort_p -# elif SIZEOF_ITYPE == SIZEOF_UNSIGNED_INT -# define BIGMPZ_FITSP mpz_fits_uint_p -# elif SIZEOF_ITYPE == SIZEOF_UNSIGNED_LONG -# define BIGMPZ_FITSP mpz_fits_ulong_p -# else -# define BIGMPZ_FITSP ((int (*)(void *)) 0) -# endif /* sizeof checks */ -#else -/* UNSIGNED is not defined */ -# if SIZEOF_ITYPE == SIZEOF_SHORT -# define BIGMPZ_FITSP mpz_fits_sshort_p -# elif SIZEOF_ITYPE == SIZEOF_INT -# define BIGMPZ_FITSP mpz_fits_sint_p -# elif SIZEOF_ITYPE == SIZEOF_LONG -# define BIGMPZ_FITSP mpz_fits_slong_p -# else -# define BIGMPZ_FITSP ((int (*)(void *)) 0) -# endif /* sizeof checks */ -#endif /* UNSIGNED check */ - -/* We rely heavily on the compiler's optimizer to remove branches that - have constant value guards. */ - -ITYPE -NUM2INTEGRAL (SCM num, unsigned long int pos, const char *s_caller) -{ - if (SCM_INUMP (num)) - { /* immediate */ - scm_t_signed_bits n = SCM_INUM (num); - - if (UNSIGNED && (n < 0)) - scm_out_of_range (s_caller, num); - - if (SIZEOF_ITYPE >= SIZEOF_SCM_T_BITS) - /* the target type is large enough to hold any possible inum */ - return (ITYPE) n; - else - { -#if SIZEOF_SCM_T_BITS > SIZEOF_ITYPE - /* an inum can be out of range, so check */ - if (UNSIGNED) /* n is known to be >= 0 */ - { - if (((scm_t_bits) n) > UNSIGNED_ITYPE_MAX) - scm_out_of_range (s_caller, num); - } - else if (((ITYPE) n) != n) - scm_out_of_range (s_caller, num); -#endif - return (ITYPE) n; - } - } - else if (SCM_BIGP (num)) - { /* bignum */ - if (SIZEOF_ITYPE < SIZEOF_SCM_T_BITS) - scm_out_of_range (s_caller, num); - else - { - /* make sure the result will fit */ - if (BIGMPZ_FITSP != 0) - { - int fits_p = BIGMPZ_FITSP (SCM_I_BIG_MPZ (num)); - scm_remember_upto_here_1 (num); - if (!fits_p) - scm_out_of_range (s_caller, num); - } - else - { - size_t itype_bits = sizeof (ITYPE) * SCM_CHAR_BIT; - int sgn = mpz_sgn (SCM_I_BIG_MPZ (num)); - size_t numbits; - - if (UNSIGNED) - { - if (sgn < 0) - scm_out_of_range (s_caller, num); - } - - numbits = mpz_sizeinbase (SCM_I_BIG_MPZ (num), 2); - - if (UNSIGNED) - { - if (numbits > itype_bits) - scm_out_of_range (s_caller, num); - } - else - { - if (sgn >= 0) - { - /* positive, require num < 2^(itype_bits-1) */ - if (numbits > itype_bits-1) - scm_out_of_range (s_caller, num); - } - else - { - /* negative, require abs(num) < 2^(itype_bits-1), but - also allow num == -2^(itype_bits-1), the latter - detected by numbits==itype_bits plus the lowest - (and only) 1 bit at position itype_bits-1 */ - if (numbits > itype_bits - || (numbits == itype_bits - && (mpz_scan1 (SCM_I_BIG_MPZ (num), 0) - != itype_bits - 1))) - scm_out_of_range (s_caller, num); - } - } - } - - if (UNSIGNED && (SIZEOF_ITYPE <= SIZEOF_UNSIGNED_LONG)) - { - ITYPE result = (ITYPE) mpz_get_ui (SCM_I_BIG_MPZ (num)); - scm_remember_upto_here_1 (num); - return result; - } - else if ((!UNSIGNED) && (SIZEOF_ITYPE <= SIZEOF_LONG)) - { - ITYPE result = (ITYPE) mpz_get_si (SCM_I_BIG_MPZ (num)); - scm_remember_upto_here_1 (num); - return result; - } - else - { - int sgn = mpz_sgn (SCM_I_BIG_MPZ (num)); - ITYPE result = 0; - size_t count; - - mpz_export (&result, - &count, -#ifdef WORDS_BIGENDIAN - 1, -#else - -1, -#endif - SIZEOF_ITYPE, - 0, - 0, - SCM_I_BIG_MPZ (num)); - /* mpz_export doesn't handle sign */ - if (sgn < 0) result = - result; - scm_remember_upto_here_1 (num); - return result; - } - } - } - else - scm_wrong_type_arg (s_caller, pos, num); -} - - -SCM -INTEGRAL2NUM (ITYPE n) -{ - /* If we know the size of the type, determine at compile time - whether we need to perform the FIXABLE test or not. This is not - done to get more optimal code out of the compiler (it can figure - this out on its own already), but to avoid a spurious warning. - If we don't know the size, assume that the test must be done. - */ - - /* have to use #if here rather than if because of gcc warnings about - limited range */ -#if SIZEOF_ITYPE < SIZEOF_SCM_T_BITS - return SCM_I_MAKINUM ((scm_t_signed_bits) n); -#else /* not SIZEOF_ITYPE < SIZEOF_SCM_T_BITS */ - if (UNSIGNED) - { - if (SCM_POSFIXABLE (n)) - return SCM_I_MAKINUM ((scm_t_signed_bits) n); - } - else - { - if (SCM_FIXABLE (n)) - return SCM_I_MAKINUM ((scm_t_signed_bits) n); - } - return INTEGRAL2BIG (n); -#endif /* not SIZEOF_ITYPE < SIZEOF_SCM_T_BITS */ -} - -SCM -INTEGRAL2BIG (ITYPE n) -{ - if (UNSIGNED && (SIZEOF_ITYPE <= SIZEOF_LONG)) - { - SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0); - mpz_init_set_ui (SCM_I_BIG_MPZ (z), n); - return z; - } - else if ((!UNSIGNED) && (SIZEOF_ITYPE <= SIZEOF_UNSIGNED_LONG)) - { - SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0); - mpz_init_set_si (SCM_I_BIG_MPZ (z), n); - return z; - } - else - { - int neg_input = 0; - SCM result = scm_i_mkbig (); - - /* mpz_import doesn't handle sign -- have to use #if here rather - than if b/c gcc warnings for ushort, etc. */ -#if !UNSIGNED - if (n < 0) - { - neg_input = 1; - n = - n; - } -#endif - - mpz_import (SCM_I_BIG_MPZ (result), - 1, /* one word */ - 1, /* word order irrelevant when just one word */ - SIZEOF_ITYPE, /* word size */ - 0, /* native endianness within word */ - 0, /* no nails */ - &n); - - /* mpz_import doesn't handle sign */ - if (!UNSIGNED) - { - if (neg_input) - mpz_neg (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (result)); - } - return result; - } -} - -/* clean up */ -#undef INTEGRAL2NUM -#undef INTEGRAL2BIG -#undef NUM2INTEGRAL -#undef UNSIGNED -#undef ITYPE -#undef SIZEOF_ITYPE -#undef UNSIGNED_ITYPE -#undef UNSIGNED_ITYPE_MAX -#undef BIGMPZ_FITSP - -/* - Local Variables: - c-file-style: "gnu" - End: -*/ diff --git a/libguile/numbers.c b/libguile/numbers.c index a41e8394d..a6e5c69e5 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -78,7 +78,7 @@ #define SCM_I_NUMTAG_REAL scm_tc16_real #define SCM_I_NUMTAG_COMPLEX scm_tc16_complex #define SCM_I_NUMTAG(x) \ - (SCM_INUMP(x) ? SCM_I_NUMTAG_INUM \ + (SCM_I_INUMP(x) ? SCM_I_NUMTAG_INUM \ : (SCM_IMP(x) ? SCM_I_NUMTAG_NOTNUM \ : (((0xfcff & SCM_CELL_TYPE (x)) == scm_tc7_number) ? SCM_TYP16(x) \ : SCM_I_NUMTAG_NOTNUM))) @@ -329,7 +329,7 @@ scm_make_ratio (SCM numerator, SCM denominator) { /* First make sure the arguments are proper. */ - if (SCM_INUMP (denominator)) + if (SCM_I_INUMP (denominator)) { if (SCM_EQ_P (denominator, SCM_INUM0)) scm_num_overflow ("make-ratio"); @@ -341,7 +341,7 @@ scm_make_ratio (SCM numerator, SCM denominator) if (!(SCM_BIGP(denominator))) SCM_WRONG_TYPE_ARG (2, denominator); } - if (!SCM_INUMP (numerator) && !SCM_BIGP (numerator)) + if (!SCM_I_INUMP (numerator) && !SCM_BIGP (numerator)) SCM_WRONG_TYPE_ARG (1, numerator); /* Then flip signs so that the denominator is positive. @@ -355,15 +355,15 @@ scm_make_ratio (SCM numerator, SCM denominator) /* Now consider for each of the four fixnum/bignum combinations whether the rational number is really an integer. */ - if (SCM_INUMP (numerator)) + if (SCM_I_INUMP (numerator)) { - long x = SCM_INUM (numerator); + long x = SCM_I_INUM (numerator); if (SCM_EQ_P (numerator, SCM_INUM0)) return SCM_INUM0; - if (SCM_INUMP (denominator)) + if (SCM_I_INUMP (denominator)) { long y; - y = SCM_INUM (denominator); + y = SCM_I_INUM (denominator); if (x == y) return SCM_I_MAKINUM(1); if ((x % y) == 0) @@ -383,9 +383,9 @@ scm_make_ratio (SCM numerator, SCM denominator) } else if (SCM_BIGP (numerator)) { - if (SCM_INUMP (denominator)) + if (SCM_I_INUMP (denominator)) { - long yy = SCM_INUM (denominator); + long yy = SCM_I_INUM (denominator); if (mpz_divisible_ui_p (SCM_I_BIG_MPZ (numerator), yy)) return scm_divide (numerator, denominator); } @@ -437,7 +437,7 @@ SCM_DEFINE (scm_exact_p, "exact?", 1, 0, 0, "otherwise.") #define FUNC_NAME s_scm_exact_p { - if (SCM_INUMP (x)) + if (SCM_I_INUMP (x)) return SCM_BOOL_T; if (SCM_BIGP (x)) return SCM_BOOL_T; @@ -456,9 +456,9 @@ SCM_DEFINE (scm_odd_p, "odd?", 1, 0, 0, "otherwise.") #define FUNC_NAME s_scm_odd_p { - if (SCM_INUMP (n)) + if (SCM_I_INUMP (n)) { - long val = SCM_INUM (n); + long val = SCM_I_INUM (n); return scm_from_bool ((val & 1L) != 0); } else if (SCM_BIGP (n)) @@ -491,9 +491,9 @@ SCM_DEFINE (scm_even_p, "even?", 1, 0, 0, "otherwise.") #define FUNC_NAME s_scm_even_p { - if (SCM_INUMP (n)) + if (SCM_I_INUMP (n)) { - long val = SCM_INUM (n); + long val = SCM_I_INUM (n); return scm_from_bool ((val & 1L) == 0); } else if (SCM_BIGP (n)) @@ -642,9 +642,9 @@ SCM_PRIMITIVE_GENERIC (scm_abs, "abs", 1, 0, 0, "Return the absolute value of @var{x}.") #define FUNC_NAME { - if (SCM_INUMP (x)) + if (SCM_I_INUMP (x)) { - long int xx = SCM_INUM (x); + long int xx = SCM_I_INUM (x); if (xx >= 0) return x; else if (SCM_POSFIXABLE (-xx)) @@ -688,12 +688,12 @@ SCM_GPROC (s_quotient, "quotient", 2, 0, 0, scm_quotient, g_quotient); SCM scm_quotient (SCM x, SCM y) { - if (SCM_INUMP (x)) + if (SCM_I_INUMP (x)) { - long xx = SCM_INUM (x); - if (SCM_INUMP (y)) + long xx = SCM_I_INUM (x); + if (SCM_I_INUMP (y)) { - long yy = SCM_INUM (y); + long yy = SCM_I_INUM (y); if (yy == 0) scm_num_overflow (s_quotient); else @@ -707,7 +707,7 @@ scm_quotient (SCM x, SCM y) } else if (SCM_BIGP (y)) { - if ((SCM_INUM (x) == SCM_MOST_NEGATIVE_FIXNUM) + if ((SCM_I_INUM (x) == SCM_MOST_NEGATIVE_FIXNUM) && (mpz_cmp_ui (SCM_I_BIG_MPZ (y), - SCM_MOST_NEGATIVE_FIXNUM) == 0)) { @@ -723,9 +723,9 @@ scm_quotient (SCM x, SCM y) } else if (SCM_BIGP (x)) { - if (SCM_INUMP (y)) + if (SCM_I_INUMP (y)) { - long yy = SCM_INUM (y); + long yy = SCM_I_INUM (y); if (yy == 0) scm_num_overflow (s_quotient); else if (yy == 1) @@ -772,22 +772,22 @@ SCM_GPROC (s_remainder, "remainder", 2, 0, 0, scm_remainder, g_remainder); SCM scm_remainder (SCM x, SCM y) { - if (SCM_INUMP (x)) + if (SCM_I_INUMP (x)) { - if (SCM_INUMP (y)) + if (SCM_I_INUMP (y)) { - long yy = SCM_INUM (y); + long yy = SCM_I_INUM (y); if (yy == 0) scm_num_overflow (s_remainder); else { - long z = SCM_INUM (x) % yy; + long z = SCM_I_INUM (x) % yy; return SCM_I_MAKINUM (z); } } else if (SCM_BIGP (y)) { - if ((SCM_INUM (x) == SCM_MOST_NEGATIVE_FIXNUM) + if ((SCM_I_INUM (x) == SCM_MOST_NEGATIVE_FIXNUM) && (mpz_cmp_ui (SCM_I_BIG_MPZ (y), - SCM_MOST_NEGATIVE_FIXNUM) == 0)) { @@ -803,9 +803,9 @@ scm_remainder (SCM x, SCM y) } else if (SCM_BIGP (x)) { - if (SCM_INUMP (y)) + if (SCM_I_INUMP (y)) { - long yy = SCM_INUM (y); + long yy = SCM_I_INUM (y); if (yy == 0) scm_num_overflow (s_remainder); else @@ -845,12 +845,12 @@ SCM_GPROC (s_modulo, "modulo", 2, 0, 0, scm_modulo, g_modulo); SCM scm_modulo (SCM x, SCM y) { - if (SCM_INUMP (x)) + if (SCM_I_INUMP (x)) { - long xx = SCM_INUM (x); - if (SCM_INUMP (y)) + long xx = SCM_I_INUM (x); + if (SCM_I_INUMP (y)) { - long yy = SCM_INUM (y); + long yy = SCM_I_INUM (y); if (yy == 0) scm_num_overflow (s_modulo); else @@ -921,9 +921,9 @@ scm_modulo (SCM x, SCM y) } else if (SCM_BIGP (x)) { - if (SCM_INUMP (y)) + if (SCM_I_INUMP (y)) { - long yy = SCM_INUM (y); + long yy = SCM_I_INUM (y); if (yy == 0) scm_num_overflow (s_modulo); else @@ -976,12 +976,12 @@ scm_gcd (SCM x, SCM y) if (SCM_UNBNDP (y)) return SCM_UNBNDP (x) ? SCM_INUM0 : x; - if (SCM_INUMP (x)) + if (SCM_I_INUMP (x)) { - if (SCM_INUMP (y)) + if (SCM_I_INUMP (y)) { - long xx = SCM_INUM (x); - long yy = SCM_INUM (y); + long xx = SCM_I_INUM (x); + long yy = SCM_I_INUM (y); long u = xx < 0 ? -xx : xx; long v = yy < 0 ? -yy : yy; long result; @@ -1034,12 +1034,12 @@ scm_gcd (SCM x, SCM y) } else if (SCM_BIGP (x)) { - if (SCM_INUMP (y)) + if (SCM_I_INUMP (y)) { unsigned long result; long yy; big_inum: - yy = SCM_INUM (y); + yy = SCM_I_INUM (y); if (yy == 0) return scm_abs (x); if (yy < 0) @@ -1080,14 +1080,14 @@ scm_lcm (SCM n1, SCM n2) n2 = SCM_I_MAKINUM (1L); } - SCM_GASSERT2 (SCM_INUMP (n1) || SCM_BIGP (n1), + SCM_GASSERT2 (SCM_I_INUMP (n1) || SCM_BIGP (n1), g_lcm, n1, n2, SCM_ARG1, s_lcm); - SCM_GASSERT2 (SCM_INUMP (n2) || SCM_BIGP (n2), + SCM_GASSERT2 (SCM_I_INUMP (n2) || SCM_BIGP (n2), g_lcm, n1, n2, SCM_ARGn, s_lcm); - if (SCM_INUMP (n1)) + if (SCM_I_INUMP (n1)) { - if (SCM_INUMP (n2)) + if (SCM_I_INUMP (n2)) { SCM d = scm_gcd (n1, n2); if (SCM_EQ_P (d, SCM_INUM0)) @@ -1101,7 +1101,7 @@ scm_lcm (SCM n1, SCM n2) inumbig: { SCM result = scm_i_mkbig (); - long nn1 = SCM_INUM (n1); + long nn1 = SCM_I_INUM (n1); if (nn1 == 0) return SCM_INUM0; if (nn1 < 0) nn1 = - nn1; mpz_lcm_ui (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (n2), nn1); @@ -1113,7 +1113,7 @@ scm_lcm (SCM n1, SCM n2) else { /* big n1 */ - if (SCM_INUMP (n2)) + if (SCM_I_INUMP (n2)) { SCM_SWAP (n1, n2); goto inumbig; @@ -1197,12 +1197,12 @@ SCM_DEFINE1 (scm_logand, "logand", scm_tc7_asubr, SCM_WRONG_TYPE_ARG (SCM_ARG1, n1); } - if (SCM_INUMP (n1)) + if (SCM_I_INUMP (n1)) { - nn1 = SCM_INUM (n1); - if (SCM_INUMP (n2)) + nn1 = SCM_I_INUM (n1); + if (SCM_I_INUMP (n2)) { - long nn2 = SCM_INUM (n2); + long nn2 = SCM_I_INUM (n2); return SCM_I_MAKINUM (nn1 & nn2); } else if SCM_BIGP (n2) @@ -1225,10 +1225,10 @@ SCM_DEFINE1 (scm_logand, "logand", scm_tc7_asubr, } else if (SCM_BIGP (n1)) { - if (SCM_INUMP (n2)) + if (SCM_I_INUMP (n2)) { SCM_SWAP (n1, n2); - nn1 = SCM_INUM (n1); + nn1 = SCM_I_INUM (n1); goto intbig; } else if (SCM_BIGP (n2)) @@ -1271,12 +1271,12 @@ SCM_DEFINE1 (scm_logior, "logior", scm_tc7_asubr, SCM_WRONG_TYPE_ARG (SCM_ARG1, n1); } - if (SCM_INUMP (n1)) + if (SCM_I_INUMP (n1)) { - nn1 = SCM_INUM (n1); - if (SCM_INUMP (n2)) + nn1 = SCM_I_INUM (n1); + if (SCM_I_INUMP (n2)) { - long nn2 = SCM_INUM (n2); + long nn2 = SCM_I_INUM (n2); return SCM_I_MAKINUM (nn1 | nn2); } else if (SCM_BIGP (n2)) @@ -1299,10 +1299,10 @@ SCM_DEFINE1 (scm_logior, "logior", scm_tc7_asubr, } else if (SCM_BIGP (n1)) { - if (SCM_INUMP (n2)) + if (SCM_I_INUMP (n2)) { SCM_SWAP (n1, n2); - nn1 = SCM_INUM (n1); + nn1 = SCM_I_INUM (n1); goto intbig; } else if (SCM_BIGP (n2)) @@ -1347,12 +1347,12 @@ SCM_DEFINE1 (scm_logxor, "logxor", scm_tc7_asubr, SCM_WRONG_TYPE_ARG (SCM_ARG1, n1); } - if (SCM_INUMP (n1)) + if (SCM_I_INUMP (n1)) { - nn1 = SCM_INUM (n1); - if (SCM_INUMP (n2)) + nn1 = SCM_I_INUM (n1); + if (SCM_I_INUMP (n2)) { - long nn2 = SCM_INUM (n2); + long nn2 = SCM_I_INUM (n2); return SCM_I_MAKINUM (nn1 ^ nn2); } else if (SCM_BIGP (n2)) @@ -1373,10 +1373,10 @@ SCM_DEFINE1 (scm_logxor, "logxor", scm_tc7_asubr, } else if (SCM_BIGP (n1)) { - if (SCM_INUMP (n2)) + if (SCM_I_INUMP (n2)) { SCM_SWAP (n1, n2); - nn1 = SCM_INUM (n1); + nn1 = SCM_I_INUM (n1); goto intbig; } else if (SCM_BIGP (n2)) @@ -1408,12 +1408,12 @@ SCM_DEFINE (scm_logtest, "logtest", 2, 0, 0, { long int nj; - if (SCM_INUMP (j)) + if (SCM_I_INUMP (j)) { - nj = SCM_INUM (j); - if (SCM_INUMP (k)) + nj = SCM_I_INUM (j); + if (SCM_I_INUMP (k)) { - long nk = SCM_INUM (k); + long nk = SCM_I_INUM (k); return scm_from_bool (nj & nk); } else if (SCM_BIGP (k)) @@ -1437,10 +1437,10 @@ SCM_DEFINE (scm_logtest, "logtest", 2, 0, 0, } else if (SCM_BIGP (j)) { - if (SCM_INUMP (k)) + if (SCM_I_INUMP (k)) { SCM_SWAP (j, k); - nj = SCM_INUM (j); + nj = SCM_I_INUM (j); goto intbig; } else if (SCM_BIGP (k)) @@ -1480,11 +1480,11 @@ SCM_DEFINE (scm_logbit_p, "logbit?", 2, 0, 0, unsigned long int iindex; iindex = scm_to_ulong (index); - if (SCM_INUMP (j)) + if (SCM_I_INUMP (j)) { /* bits above what's in an inum follow the sign bit */ iindex = min (iindex, SCM_LONG_BIT - 1); - return scm_from_bool ((1L << iindex) & SCM_INUM (j)); + return scm_from_bool ((1L << iindex) & SCM_I_INUM (j)); } else if (SCM_BIGP (j)) { @@ -1511,12 +1511,12 @@ SCM_DEFINE (scm_lognot, "lognot", 1, 0, 0, "@end lisp") #define FUNC_NAME s_scm_lognot { - if (SCM_INUMP (n)) { + if (SCM_I_INUMP (n)) { /* No overflow here, just need to toggle all the bits making up the inum. Enhancement: No need to strip the tag and add it back, could just xor a block of 1 bits, if that worked with the various debug versions of the SCM typedef. */ - return SCM_I_MAKINUM (~ SCM_INUM (n)); + return SCM_I_MAKINUM (~ SCM_I_INUM (n)); } else if (SCM_BIGP (n)) { SCM result = scm_i_mkbig (); @@ -1537,8 +1537,8 @@ coerce_to_big (SCM in, mpz_t out) { if (SCM_BIGP (in)) mpz_set (out, SCM_I_BIG_MPZ (in)); - else if (SCM_INUMP (in)) - mpz_set_si (out, SCM_INUM (in)); + else if (SCM_I_INUMP (in)) + mpz_set_si (out, SCM_I_INUM (in)); else return 0; @@ -1672,8 +1672,8 @@ SCM_DEFINE (scm_integer_expt, "integer-expt", 2, 0, 0, else if (SCM_EQ_P (n, SCM_I_MAKINUM (-1L))) return scm_is_false (scm_even_p (k)) ? n : acc; - if (SCM_INUMP (k)) - i2 = SCM_INUM (k); + if (SCM_I_INUMP (k)) + i2 = SCM_I_INUM (k); else if (SCM_BIGP (k)) { z_i2 = scm_i_clonebig (k, 1); @@ -1815,9 +1815,9 @@ SCM_DEFINE (scm_bit_extract, "bit-extract", 3, 0, 0, /* how many bits to keep */ bits = iend - istart; - if (SCM_INUMP (n)) + if (SCM_I_INUMP (n)) { - long int in = SCM_INUM (n); + long int in = SCM_I_INUM (n); /* When istart>=SCM_I_FIXNUM_BIT we can just limit the shift to SCM_I_FIXNUM_BIT-1 to get either 0 or -1 per the sign of "in". */ @@ -1886,10 +1886,10 @@ SCM_DEFINE (scm_logcount, "logcount", 1, 0, 0, "@end lisp") #define FUNC_NAME s_scm_logcount { - if (SCM_INUMP (n)) + if (SCM_I_INUMP (n)) { unsigned long int c = 0; - long int nn = SCM_INUM (n); + long int nn = SCM_I_INUM (n); if (nn < 0) nn = -1 - nn; while (nn) @@ -1934,11 +1934,11 @@ SCM_DEFINE (scm_integer_length, "integer-length", 1, 0, 0, "@end lisp") #define FUNC_NAME s_scm_integer_length { - if (SCM_INUMP (n)) + if (SCM_I_INUMP (n)) { unsigned long int c = 0; unsigned int l = 4; - long int nn = SCM_INUM (n); + long int nn = SCM_I_INUM (n); if (nn < 0) nn = -1 - nn; while (nn) @@ -2264,10 +2264,10 @@ SCM_DEFINE (scm_number_to_string, "number->string", 1, 1, 0, else base = scm_to_signed_integer (radix, 2, 36); - if (SCM_INUMP (n)) + if (SCM_I_INUMP (n)) { char num_buf [SCM_INTBUFLEN]; - size_t length = scm_iint2str (SCM_INUM (n), base, num_buf); + size_t length = scm_iint2str (SCM_I_INUM (n), base, num_buf); return scm_mem2string (num_buf, length); } else if (SCM_BIGP (n)) @@ -3064,7 +3064,7 @@ SCM_DEFINE (scm_rational_p, "rational?", 1, 0, 0, "fulfilled if @var{x} is an integer number.") #define FUNC_NAME s_scm_rational_p { - if (SCM_INUMP (x)) + if (SCM_I_INUMP (x)) return SCM_BOOL_T; else if (SCM_IMP (x)) return SCM_BOOL_F; @@ -3089,7 +3089,7 @@ SCM_DEFINE (scm_integer_p, "integer?", 1, 0, 0, #define FUNC_NAME s_scm_integer_p { double r; - if (SCM_INUMP (x)) + if (SCM_I_INUMP (x)) return SCM_BOOL_T; if (SCM_IMP (x)) return SCM_BOOL_F; @@ -3128,12 +3128,12 @@ SCM scm_num_eq_p (SCM x, SCM y) { again: - if (SCM_INUMP (x)) + if (SCM_I_INUMP (x)) { - long xx = SCM_INUM (x); - if (SCM_INUMP (y)) + long xx = SCM_I_INUM (x); + if (SCM_I_INUMP (y)) { - long yy = SCM_INUM (y); + long yy = SCM_I_INUM (y); return scm_from_bool (xx == yy); } else if (SCM_BIGP (y)) @@ -3150,7 +3150,7 @@ scm_num_eq_p (SCM x, SCM y) } else if (SCM_BIGP (x)) { - if (SCM_INUMP (y)) + if (SCM_I_INUMP (y)) return SCM_BOOL_F; else if (SCM_BIGP (y)) { @@ -3185,8 +3185,8 @@ scm_num_eq_p (SCM x, SCM y) } else if (SCM_REALP (x)) { - if (SCM_INUMP (y)) - return scm_from_bool (SCM_REAL_VALUE (x) == (double) SCM_INUM (y)); + if (SCM_I_INUMP (y)) + return scm_from_bool (SCM_REAL_VALUE (x) == (double) SCM_I_INUM (y)); else if (SCM_BIGP (y)) { int cmp; @@ -3216,8 +3216,8 @@ scm_num_eq_p (SCM x, SCM y) } else if (SCM_COMPLEXP (x)) { - if (SCM_INUMP (y)) - return scm_from_bool ((SCM_COMPLEX_REAL (x) == (double) SCM_INUM (y)) + if (SCM_I_INUMP (y)) + return scm_from_bool ((SCM_COMPLEX_REAL (x) == (double) SCM_I_INUM (y)) && (SCM_COMPLEX_IMAG (x) == 0.0)); else if (SCM_BIGP (y)) { @@ -3254,7 +3254,7 @@ scm_num_eq_p (SCM x, SCM y) } else if (SCM_FRACTIONP (x)) { - if (SCM_INUMP (y)) + if (SCM_I_INUMP (y)) return SCM_BOOL_F; else if (SCM_BIGP (y)) return SCM_BOOL_F; @@ -3305,12 +3305,12 @@ SCM scm_less_p (SCM x, SCM y) { again: - if (SCM_INUMP (x)) + if (SCM_I_INUMP (x)) { - long xx = SCM_INUM (x); - if (SCM_INUMP (y)) + long xx = SCM_I_INUM (x); + if (SCM_I_INUMP (y)) { - long yy = SCM_INUM (y); + long yy = SCM_I_INUM (y); return scm_from_bool (xx < yy); } else if (SCM_BIGP (y)) @@ -3334,7 +3334,7 @@ scm_less_p (SCM x, SCM y) } else if (SCM_BIGP (x)) { - if (SCM_INUMP (y)) + if (SCM_I_INUMP (y)) { int sgn = mpz_sgn (SCM_I_BIG_MPZ (x)); scm_remember_upto_here_1 (x); @@ -3362,8 +3362,8 @@ scm_less_p (SCM x, SCM y) } else if (SCM_REALP (x)) { - if (SCM_INUMP (y)) - return scm_from_bool (SCM_REAL_VALUE (x) < (double) SCM_INUM (y)); + if (SCM_I_INUMP (y)) + return scm_from_bool (SCM_REAL_VALUE (x) < (double) SCM_I_INUM (y)); else if (SCM_BIGP (y)) { int cmp; @@ -3390,7 +3390,7 @@ scm_less_p (SCM x, SCM y) } else if (SCM_FRACTIONP (x)) { - if (SCM_INUMP (y) || SCM_BIGP (y)) + if (SCM_I_INUMP (y) || SCM_BIGP (y)) { /* "a/b < y" becomes "a < y*b" */ y = scm_product (y, SCM_FRACTION_DENOMINATOR (x)); @@ -3491,7 +3491,7 @@ SCM_GPROC (s_zero_p, "zero?", 1, 0, 0, scm_zero_p, g_zero_p); SCM scm_zero_p (SCM z) { - if (SCM_INUMP (z)) + if (SCM_I_INUMP (z)) return scm_from_bool (SCM_EQ_P (z, SCM_INUM0)); else if (SCM_BIGP (z)) return SCM_BOOL_F; @@ -3514,8 +3514,8 @@ SCM_GPROC (s_positive_p, "positive?", 1, 0, 0, scm_positive_p, g_positive_p); SCM scm_positive_p (SCM x) { - if (SCM_INUMP (x)) - return scm_from_bool (SCM_INUM (x) > 0); + if (SCM_I_INUMP (x)) + return scm_from_bool (SCM_I_INUM (x) > 0); else if (SCM_BIGP (x)) { int sgn = mpz_sgn (SCM_I_BIG_MPZ (x)); @@ -3538,8 +3538,8 @@ SCM_GPROC (s_negative_p, "negative?", 1, 0, 0, scm_negative_p, g_negative_p); SCM scm_negative_p (SCM x) { - if (SCM_INUMP (x)) - return scm_from_bool (SCM_INUM (x) < 0); + if (SCM_I_INUMP (x)) + return scm_from_bool (SCM_I_INUM (x) < 0); else if (SCM_BIGP (x)) { int sgn = mpz_sgn (SCM_I_BIG_MPZ (x)); @@ -3571,18 +3571,18 @@ scm_max (SCM x, SCM y) { if (SCM_UNBNDP (x)) SCM_WTA_DISPATCH_0 (g_max, s_max); - else if (SCM_INUMP(x) || SCM_BIGP(x) || SCM_REALP(x) || SCM_FRACTIONP(x)) + else if (SCM_I_INUMP(x) || SCM_BIGP(x) || SCM_REALP(x) || SCM_FRACTIONP(x)) return x; else SCM_WTA_DISPATCH_1 (g_max, x, SCM_ARG1, s_max); } - if (SCM_INUMP (x)) + if (SCM_I_INUMP (x)) { - long xx = SCM_INUM (x); - if (SCM_INUMP (y)) + long xx = SCM_I_INUM (x); + if (SCM_I_INUMP (y)) { - long yy = SCM_INUM (y); + long yy = SCM_I_INUM (y); return (xx < yy) ? y : x; } else if (SCM_BIGP (y)) @@ -3607,7 +3607,7 @@ scm_max (SCM x, SCM y) } else if (SCM_BIGP (x)) { - if (SCM_INUMP (y)) + if (SCM_I_INUMP (y)) { int sgn = mpz_sgn (SCM_I_BIG_MPZ (x)); scm_remember_upto_here_1 (x); @@ -3637,9 +3637,9 @@ scm_max (SCM x, SCM y) } else if (SCM_REALP (x)) { - if (SCM_INUMP (y)) + if (SCM_I_INUMP (y)) { - double z = SCM_INUM (y); + double z = SCM_I_INUM (y); /* if x==NaN then "<" is false and we return NaN */ return (SCM_REAL_VALUE (x) < z) ? scm_make_real (z) : x; } @@ -3668,7 +3668,7 @@ scm_max (SCM x, SCM y) } else if (SCM_FRACTIONP (x)) { - if (SCM_INUMP (y)) + if (SCM_I_INUMP (y)) { goto use_less; } @@ -3703,18 +3703,18 @@ scm_min (SCM x, SCM y) { if (SCM_UNBNDP (x)) SCM_WTA_DISPATCH_0 (g_min, s_min); - else if (SCM_INUMP(x) || SCM_BIGP(x) || SCM_REALP(x) || SCM_FRACTIONP(x)) + else if (SCM_I_INUMP(x) || SCM_BIGP(x) || SCM_REALP(x) || SCM_FRACTIONP(x)) return x; else SCM_WTA_DISPATCH_1 (g_min, x, SCM_ARG1, s_min); } - if (SCM_INUMP (x)) + if (SCM_I_INUMP (x)) { - long xx = SCM_INUM (x); - if (SCM_INUMP (y)) + long xx = SCM_I_INUM (x); + if (SCM_I_INUMP (y)) { - long yy = SCM_INUM (y); + long yy = SCM_I_INUM (y); return (xx < yy) ? x : y; } else if (SCM_BIGP (y)) @@ -3739,7 +3739,7 @@ scm_min (SCM x, SCM y) } else if (SCM_BIGP (x)) { - if (SCM_INUMP (y)) + if (SCM_I_INUMP (y)) { int sgn = mpz_sgn (SCM_I_BIG_MPZ (x)); scm_remember_upto_here_1 (x); @@ -3769,9 +3769,9 @@ scm_min (SCM x, SCM y) } else if (SCM_REALP (x)) { - if (SCM_INUMP (y)) + if (SCM_I_INUMP (y)) { - double z = SCM_INUM (y); + double z = SCM_I_INUM (y); /* if x==NaN then "<" is false and we return NaN */ return (z < SCM_REAL_VALUE (x)) ? scm_make_real (z) : x; } @@ -3800,7 +3800,7 @@ scm_min (SCM x, SCM y) } else if (SCM_FRACTIONP (x)) { - if (SCM_INUMP (y)) + if (SCM_I_INUMP (y)) { goto use_less; } @@ -3839,12 +3839,12 @@ scm_sum (SCM x, SCM y) SCM_WTA_DISPATCH_1 (g_sum, x, SCM_ARG1, s_sum); } - if (SCM_INUMP (x)) + if (SCM_I_INUMP (x)) { - if (SCM_INUMP (y)) + if (SCM_I_INUMP (y)) { - long xx = SCM_INUM (x); - long yy = SCM_INUM (y); + long xx = SCM_I_INUM (x); + long yy = SCM_I_INUM (y); long int z = xx + yy; return SCM_FIXABLE (z) ? SCM_I_MAKINUM (z) : scm_i_long2big (z); } @@ -3855,12 +3855,12 @@ scm_sum (SCM x, SCM y) } else if (SCM_REALP (y)) { - long int xx = SCM_INUM (x); + long int xx = SCM_I_INUM (x); return scm_make_real (xx + SCM_REAL_VALUE (y)); } else if (SCM_COMPLEXP (y)) { - long int xx = SCM_INUM (x); + long int xx = SCM_I_INUM (x); return scm_make_complex (xx + SCM_COMPLEX_REAL (y), SCM_COMPLEX_IMAG (y)); } @@ -3872,12 +3872,12 @@ scm_sum (SCM x, SCM y) SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum); } else if (SCM_BIGP (x)) { - if (SCM_INUMP (y)) + if (SCM_I_INUMP (y)) { long int inum; int bigsgn; add_big_inum: - inum = SCM_INUM (y); + inum = SCM_I_INUM (y); if (inum == 0) return x; bigsgn = mpz_sgn (SCM_I_BIG_MPZ (x)); @@ -3938,8 +3938,8 @@ scm_sum (SCM x, SCM y) } else if (SCM_REALP (x)) { - if (SCM_INUMP (y)) - return scm_make_real (SCM_REAL_VALUE (x) + SCM_INUM (y)); + if (SCM_I_INUMP (y)) + return scm_make_real (SCM_REAL_VALUE (x) + SCM_I_INUM (y)); else if (SCM_BIGP (y)) { double result = mpz_get_d (SCM_I_BIG_MPZ (y)) + SCM_REAL_VALUE (x); @@ -3958,8 +3958,8 @@ scm_sum (SCM x, SCM y) } else if (SCM_COMPLEXP (x)) { - if (SCM_INUMP (y)) - return scm_make_complex (SCM_COMPLEX_REAL (x) + SCM_INUM (y), + if (SCM_I_INUMP (y)) + return scm_make_complex (SCM_COMPLEX_REAL (x) + SCM_I_INUM (y), SCM_COMPLEX_IMAG (x)); else if (SCM_BIGP (y)) { @@ -3982,7 +3982,7 @@ scm_sum (SCM x, SCM y) } else if (SCM_FRACTIONP (x)) { - if (SCM_INUMP (y)) + if (SCM_I_INUMP (y)) return scm_make_ratio (scm_sum (SCM_FRACTION_NUMERATOR (x), scm_product (y, SCM_FRACTION_DENOMINATOR (x))), SCM_FRACTION_DENOMINATOR (x)); @@ -4021,9 +4021,9 @@ scm_difference (SCM x, SCM y) if (SCM_UNBNDP (x)) SCM_WTA_DISPATCH_0 (g_difference, s_difference); else - if (SCM_INUMP (x)) + if (SCM_I_INUMP (x)) { - long xx = -SCM_INUM (x); + long xx = -SCM_I_INUM (x); if (SCM_FIXABLE (xx)) return SCM_I_MAKINUM (xx); else @@ -4044,12 +4044,12 @@ scm_difference (SCM x, SCM y) SCM_WTA_DISPATCH_1 (g_difference, x, SCM_ARG1, s_difference); } - if (SCM_INUMP (x)) + if (SCM_I_INUMP (x)) { - if (SCM_INUMP (y)) + if (SCM_I_INUMP (y)) { - long int xx = SCM_INUM (x); - long int yy = SCM_INUM (y); + long int xx = SCM_I_INUM (x); + long int yy = SCM_I_INUM (y); long int z = xx - yy; if (SCM_FIXABLE (z)) return SCM_I_MAKINUM (z); @@ -4059,7 +4059,7 @@ scm_difference (SCM x, SCM y) else if (SCM_BIGP (y)) { /* inum-x - big-y */ - long xx = SCM_INUM (x); + long xx = SCM_I_INUM (x); if (xx == 0) return scm_i_clonebig (y, 0); @@ -4087,12 +4087,12 @@ scm_difference (SCM x, SCM y) } else if (SCM_REALP (y)) { - long int xx = SCM_INUM (x); + long int xx = SCM_I_INUM (x); return scm_make_real (xx - SCM_REAL_VALUE (y)); } else if (SCM_COMPLEXP (y)) { - long int xx = SCM_INUM (x); + long int xx = SCM_I_INUM (x); return scm_make_complex (xx - SCM_COMPLEX_REAL (y), - SCM_COMPLEX_IMAG (y)); } @@ -4106,10 +4106,10 @@ scm_difference (SCM x, SCM y) } else if (SCM_BIGP (x)) { - if (SCM_INUMP (y)) + if (SCM_I_INUMP (y)) { /* big-x - inum-y */ - long yy = SCM_INUM (y); + long yy = SCM_I_INUM (y); int sgn_x = mpz_sgn (SCM_I_BIG_MPZ (x)); scm_remember_upto_here_1 (x); @@ -4169,8 +4169,8 @@ scm_difference (SCM x, SCM y) } else if (SCM_REALP (x)) { - if (SCM_INUMP (y)) - return scm_make_real (SCM_REAL_VALUE (x) - SCM_INUM (y)); + if (SCM_I_INUMP (y)) + return scm_make_real (SCM_REAL_VALUE (x) - SCM_I_INUM (y)); else if (SCM_BIGP (y)) { double result = SCM_REAL_VALUE (x) - mpz_get_d (SCM_I_BIG_MPZ (y)); @@ -4189,8 +4189,8 @@ scm_difference (SCM x, SCM y) } else if (SCM_COMPLEXP (x)) { - if (SCM_INUMP (y)) - return scm_make_complex (SCM_COMPLEX_REAL (x) - SCM_INUM (y), + if (SCM_I_INUMP (y)) + return scm_make_complex (SCM_COMPLEX_REAL (x) - SCM_I_INUM (y), SCM_COMPLEX_IMAG (x)); else if (SCM_BIGP (y)) { @@ -4213,7 +4213,7 @@ scm_difference (SCM x, SCM y) } else if (SCM_FRACTIONP (x)) { - if (SCM_INUMP (y)) + if (SCM_I_INUMP (y)) /* a/b - c = (a - cb) / b */ return scm_make_ratio (scm_difference (SCM_FRACTION_NUMERATOR (x), scm_product(y, SCM_FRACTION_DENOMINATOR (x))), @@ -4258,12 +4258,12 @@ scm_product (SCM x, SCM y) SCM_WTA_DISPATCH_1 (g_product, x, SCM_ARG1, s_product); } - if (SCM_INUMP (x)) + if (SCM_I_INUMP (x)) { long xx; intbig: - xx = SCM_INUM (x); + xx = SCM_I_INUM (x); switch (xx) { @@ -4271,12 +4271,12 @@ scm_product (SCM x, SCM y) case 1: return y; break; } - if (SCM_INUMP (y)) + if (SCM_I_INUMP (y)) { - long yy = SCM_INUM (y); + long yy = SCM_I_INUM (y); long kk = xx * yy; SCM k = SCM_I_MAKINUM (kk); - if ((kk == SCM_INUM (k)) && (kk / xx == yy)) + if ((kk == SCM_I_INUM (k)) && (kk / xx == yy)) return k; else { @@ -4305,7 +4305,7 @@ scm_product (SCM x, SCM y) } else if (SCM_BIGP (x)) { - if (SCM_INUMP (y)) + if (SCM_I_INUMP (y)) { SCM_SWAP (x, y); goto intbig; @@ -4340,8 +4340,8 @@ scm_product (SCM x, SCM y) } else if (SCM_REALP (x)) { - if (SCM_INUMP (y)) - return scm_make_real (SCM_INUM (y) * SCM_REAL_VALUE (x)); + if (SCM_I_INUMP (y)) + return scm_make_real (SCM_I_INUM (y) * SCM_REAL_VALUE (x)); else if (SCM_BIGP (y)) { double result = mpz_get_d (SCM_I_BIG_MPZ (y)) * SCM_REAL_VALUE (x); @@ -4360,9 +4360,9 @@ scm_product (SCM x, SCM y) } else if (SCM_COMPLEXP (x)) { - if (SCM_INUMP (y)) - return scm_make_complex (SCM_INUM (y) * SCM_COMPLEX_REAL (x), - SCM_INUM (y) * SCM_COMPLEX_IMAG (x)); + if (SCM_I_INUMP (y)) + return scm_make_complex (SCM_I_INUM (y) * SCM_COMPLEX_REAL (x), + SCM_I_INUM (y) * SCM_COMPLEX_IMAG (x)); else if (SCM_BIGP (y)) { double z = mpz_get_d (SCM_I_BIG_MPZ (y)); @@ -4391,7 +4391,7 @@ scm_product (SCM x, SCM y) } else if (SCM_FRACTIONP (x)) { - if (SCM_INUMP (y)) + if (SCM_I_INUMP (y)) return scm_make_ratio (scm_product (y, SCM_FRACTION_NUMERATOR (x)), SCM_FRACTION_DENOMINATOR (x)); else if (SCM_BIGP (y)) @@ -4422,8 +4422,8 @@ double scm_num2dbl (SCM a, const char *why) #define FUNC_NAME why { - if (SCM_INUMP (a)) - return (double) SCM_INUM (a); + if (SCM_I_INUMP (a)) + return (double) SCM_I_INUM (a); else if (SCM_BIGP (a)) { double result = mpz_get_d (SCM_I_BIG_MPZ (a)); @@ -4486,9 +4486,9 @@ scm_i_divide (SCM x, SCM y, int inexact) { if (SCM_UNBNDP (x)) SCM_WTA_DISPATCH_0 (g_divide, s_divide); - else if (SCM_INUMP (x)) + else if (SCM_I_INUMP (x)) { - long xx = SCM_INUM (x); + long xx = SCM_I_INUM (x); if (xx == 1 || xx == -1) return x; #ifndef ALLOW_DIVIDE_BY_EXACT_ZERO @@ -4542,12 +4542,12 @@ scm_i_divide (SCM x, SCM y, int inexact) SCM_WTA_DISPATCH_1 (g_divide, x, SCM_ARG1, s_divide); } - if (SCM_INUMP (x)) + if (SCM_I_INUMP (x)) { - long xx = SCM_INUM (x); - if (SCM_INUMP (y)) + long xx = SCM_I_INUM (x); + if (SCM_I_INUMP (y)) { - long yy = SCM_INUM (y); + long yy = SCM_I_INUM (y); if (yy == 0) { #ifndef ALLOW_DIVIDE_BY_EXACT_ZERO @@ -4617,9 +4617,9 @@ scm_i_divide (SCM x, SCM y, int inexact) } else if (SCM_BIGP (x)) { - if (SCM_INUMP (y)) + if (SCM_I_INUMP (y)) { - long int yy = SCM_INUM (y); + long int yy = SCM_I_INUM (y); if (yy == 0) { #ifndef ALLOW_DIVIDE_BY_EXACT_ZERO @@ -4726,9 +4726,9 @@ scm_i_divide (SCM x, SCM y, int inexact) else if (SCM_REALP (x)) { double rx = SCM_REAL_VALUE (x); - if (SCM_INUMP (y)) + if (SCM_I_INUMP (y)) { - long int yy = SCM_INUM (y); + long int yy = SCM_I_INUM (y); #ifndef ALLOW_DIVIDE_BY_EXACT_ZERO if (yy == 0) scm_num_overflow (s_divide); @@ -4766,9 +4766,9 @@ scm_i_divide (SCM x, SCM y, int inexact) { double rx = SCM_COMPLEX_REAL (x); double ix = SCM_COMPLEX_IMAG (x); - if (SCM_INUMP (y)) + if (SCM_I_INUMP (y)) { - long int yy = SCM_INUM (y); + long int yy = SCM_I_INUM (y); #ifndef ALLOW_DIVIDE_BY_EXACT_ZERO if (yy == 0) scm_num_overflow (s_divide); @@ -4822,9 +4822,9 @@ scm_i_divide (SCM x, SCM y, int inexact) } else if (SCM_FRACTIONP (x)) { - if (SCM_INUMP (y)) + if (SCM_I_INUMP (y)) { - long int yy = SCM_INUM (y); + long int yy = SCM_I_INUM (y); #ifndef ALLOW_DIVIDE_BY_EXACT_ZERO if (yy == 0) scm_num_overflow (s_divide); @@ -5001,7 +5001,7 @@ SCM_DEFINE (scm_round_number, "round", 1, 0, 0, "round towards the even one.") #define FUNC_NAME s_scm_round_number { - if (SCM_INUMP (x) || SCM_BIGP (x)) + if (SCM_I_INUMP (x) || SCM_BIGP (x)) return x; else if (SCM_REALP (x)) return scm_make_real (scm_round (SCM_REAL_VALUE (x))); @@ -5027,7 +5027,7 @@ SCM_PRIMITIVE_GENERIC (scm_floor, "floor", 1, 0, 0, "Round the number @var{x} towards minus infinity.") #define FUNC_NAME s_scm_floor { - if (SCM_INUMP (x) || SCM_BIGP (x)) + if (SCM_I_INUMP (x) || SCM_BIGP (x)) return x; else if (SCM_REALP (x)) return scm_make_real (floor (SCM_REAL_VALUE (x))); @@ -5058,7 +5058,7 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling, "ceiling", 1, 0, 0, "Round the number @var{x} towards infinity.") #define FUNC_NAME s_scm_ceiling { - if (SCM_INUMP (x) || SCM_BIGP (x)) + if (SCM_I_INUMP (x) || SCM_BIGP (x)) return x; else if (SCM_REALP (x)) return scm_make_real (ceil (SCM_REAL_VALUE (x))); @@ -5137,8 +5137,8 @@ static void scm_two_doubles (SCM x, static void scm_two_doubles (SCM x, SCM y, const char *sstring, struct dpair *xy) { - if (SCM_INUMP (x)) - xy->x = SCM_INUM (x); + if (SCM_I_INUMP (x)) + xy->x = SCM_I_INUM (x); else if (SCM_BIGP (x)) xy->x = scm_i_big2dbl (x); else if (SCM_REALP (x)) @@ -5148,8 +5148,8 @@ scm_two_doubles (SCM x, SCM y, const char *sstring, struct dpair *xy) else scm_wrong_type_arg (sstring, SCM_ARG1, x); - if (SCM_INUMP (y)) - xy->y = SCM_INUM (y); + if (SCM_I_INUMP (y)) + xy->y = SCM_I_INUM (y); else if (SCM_BIGP (y)) xy->y = scm_i_big2dbl (y); else if (SCM_REALP (y)) @@ -5229,7 +5229,7 @@ SCM_GPROC (s_real_part, "real-part", 1, 0, 0, scm_real_part, g_real_part); SCM scm_real_part (SCM z) { - if (SCM_INUMP (z)) + if (SCM_I_INUMP (z)) return z; else if (SCM_BIGP (z)) return z; @@ -5250,7 +5250,7 @@ SCM_GPROC (s_imag_part, "imag-part", 1, 0, 0, scm_imag_part, g_imag_part); SCM scm_imag_part (SCM z) { - if (SCM_INUMP (z)) + if (SCM_I_INUMP (z)) return SCM_INUM0; else if (SCM_BIGP (z)) return SCM_INUM0; @@ -5270,7 +5270,7 @@ SCM_GPROC (s_numerator, "numerator", 1, 0, 0, scm_numerator, g_numerator); SCM scm_numerator (SCM z) { - if (SCM_INUMP (z)) + if (SCM_I_INUMP (z)) return z; else if (SCM_BIGP (z)) return z; @@ -5292,7 +5292,7 @@ SCM_GPROC (s_denominator, "denominator", 1, 0, 0, scm_denominator, g_denominator SCM scm_denominator (SCM z) { - if (SCM_INUMP (z)) + if (SCM_I_INUMP (z)) return SCM_I_MAKINUM (1); else if (SCM_BIGP (z)) return SCM_I_MAKINUM (1); @@ -5314,9 +5314,9 @@ SCM_GPROC (s_magnitude, "magnitude", 1, 0, 0, scm_magnitude, g_magnitude); SCM scm_magnitude (SCM z) { - if (SCM_INUMP (z)) + if (SCM_I_INUMP (z)) { - long int zz = SCM_INUM (z); + long int zz = SCM_I_INUM (z); if (zz >= 0) return z; else if (SCM_POSFIXABLE (-zz)) @@ -5359,9 +5359,9 @@ scm_angle (SCM z) scm_flo0 to save allocating a new flonum with scm_make_real each time. But if atan2 follows the floating point rounding mode, then the value is not a constant. Maybe it'd be close enough though. */ - if (SCM_INUMP (z)) + if (SCM_I_INUMP (z)) { - if (SCM_INUM (z) >= 0) + if (SCM_I_INUM (z) >= 0) return scm_flo0; else return scm_make_real (atan2 (0.0, -1.0)); @@ -5401,8 +5401,8 @@ SCM_GPROC (s_exact_to_inexact, "exact->inexact", 1, 0, 0, scm_exact_to_inexact, SCM scm_exact_to_inexact (SCM z) { - if (SCM_INUMP (z)) - return scm_make_real ((double) SCM_INUM (z)); + if (SCM_I_INUMP (z)) + return scm_make_real ((double) SCM_I_INUM (z)); else if (SCM_BIGP (z)) return scm_make_real (scm_i_big2dbl (z)); else if (SCM_FRACTIONP (z)) @@ -5419,7 +5419,7 @@ SCM_DEFINE (scm_inexact_to_exact, "inexact->exact", 1, 0, 0, "Return an exact number that is numerically closest to @var{z}.") #define FUNC_NAME s_scm_inexact_to_exact { - if (SCM_INUMP (z)) + if (SCM_I_INUMP (z)) return z; else if (SCM_BIGP (z)) return z; @@ -5456,7 +5456,7 @@ SCM_DEFINE (scm_rationalize, "rationalize", 2, 0, 0, "Return an exact number that is within @var{err} of @var{x}.") #define FUNC_NAME s_scm_rationalize { - if (SCM_INUMP (x)) + if (SCM_I_INUMP (x)) return x; else if (SCM_BIGP (x)) return x; @@ -5656,9 +5656,9 @@ scm_is_integer (SCM val) int scm_is_signed_integer (SCM val, scm_t_intmax min, scm_t_intmax max) { - if (SCM_INUMP (val)) + if (SCM_I_INUMP (val)) { - scm_t_signed_bits n = SCM_INUM (val); + scm_t_signed_bits n = SCM_I_INUM (val); return n >= min && n <= max; } else if (SCM_BIGP (val)) @@ -5709,9 +5709,9 @@ scm_is_signed_integer (SCM val, scm_t_intmax min, scm_t_intmax max) int scm_is_unsigned_integer (SCM val, scm_t_uintmax min, scm_t_uintmax max) { - if (SCM_INUMP (val)) + if (SCM_I_INUMP (val)) { - scm_t_signed_bits n = SCM_INUM (val); + scm_t_signed_bits n = SCM_I_INUM (val); return n >= 0 && ((scm_t_uintmax)n) >= min && ((scm_t_uintmax)n) <= max; } else if (SCM_BIGP (val)) @@ -5753,9 +5753,9 @@ scm_is_unsigned_integer (SCM val, scm_t_uintmax min, scm_t_uintmax max) scm_t_intmax scm_to_signed_integer (SCM val, scm_t_intmax min, scm_t_intmax max) { - if (SCM_INUMP (val)) + if (SCM_I_INUMP (val)) { - scm_t_signed_bits n = SCM_INUM (val); + scm_t_signed_bits n = SCM_I_INUM (val); if (n >= min && n <= max) return n; else @@ -5822,9 +5822,9 @@ scm_to_signed_integer (SCM val, scm_t_intmax min, scm_t_intmax max) scm_t_uintmax scm_to_unsigned_integer (SCM val, scm_t_uintmax min, scm_t_uintmax max) { - if (SCM_INUMP (val)) + if (SCM_I_INUMP (val)) { - scm_t_signed_bits n = SCM_INUM (val); + scm_t_signed_bits n = SCM_I_INUM (val); if (n >= 0 && ((scm_t_uintmax)n) >= min && ((scm_t_uintmax)n) <= max) return n; else diff --git a/libguile/objects.c b/libguile/objects.c index f999a4f37..ca5c2c29f 100644 --- a/libguile/objects.c +++ b/libguile/objects.c @@ -234,18 +234,25 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0, SCM scm_mcache_lookup_cmethod (SCM cache, SCM args) { - long i, n, end, mask; + unsigned long i, mask, n, end; SCM ls, methods, z = SCM_CDDR (cache); - n = SCM_INUM (SCM_CAR (z)); /* maximum number of specializers */ + n = scm_to_ulong (SCM_CAR (z)); /* maximum number of specializers */ methods = SCM_CADR (z); - if (SCM_INUMP (methods)) + if (SCM_VECTORP (methods)) + { + /* cache format #1: prepare for linear search */ + mask = -1; + i = 0; + end = SCM_VECTOR_LENGTH (methods); + } + else { /* cache format #2: compute a hash value */ - long hashset = SCM_INUM (methods); + unsigned long hashset = scm_to_ulong (methods); long j = n; z = SCM_CDDR (z); - mask = SCM_INUM (SCM_CAR (z)); + mask = scm_to_ulong (SCM_CAR (z)); methods = SCM_CADR (z); i = 0; ls = args; @@ -260,13 +267,6 @@ scm_mcache_lookup_cmethod (SCM cache, SCM args) i &= mask; end = i; } - else /* SCM_VECTORP (methods) */ - { - /* cache format #1: prepare for linear search */ - mask = -1; - i = 0; - end = SCM_VECTOR_LENGTH (methods); - } /* Search for match */ do diff --git a/libguile/options.c b/libguile/options.c index 9262d34fa..41cadc7b5 100644 --- a/libguile/options.c +++ b/libguile/options.c @@ -92,9 +92,8 @@ SCM_SYMBOL (scm_no_sym, "no"); static SCM protected_objects = SCM_EOL; - -/* Return a list of the current option setting. The format of an option - * setting is described in the above documentation. */ +/* Return a list of the current option setting. The format of an + * option setting is described in the above documentation. */ static SCM get_option_setting (const scm_t_option options[], unsigned int n) { @@ -109,7 +108,7 @@ get_option_setting (const scm_t_option options[], unsigned int n) ls = scm_cons (SCM_PACK (options[i].name), ls); break; case SCM_OPTION_INTEGER: - ls = scm_cons (SCM_I_MAKINUM (options[i].val), ls); + ls = scm_cons (scm_from_unsigned_integer (options[i].val), ls); ls = scm_cons (SCM_PACK (options[i].name), ls); break; case SCM_OPTION_SCM: @@ -138,7 +137,7 @@ get_documented_option_setting (const scm_t_option options[], unsigned int n) ls = scm_cons (options[i].val ? scm_yes_sym : scm_no_sym, ls); break; case SCM_OPTION_INTEGER: - ls = scm_cons (SCM_I_MAKINUM (options[i].val), ls); + ls = scm_cons (scm_from_unsigned_integer (options[i].val), ls); break; case SCM_OPTION_SCM: ls = scm_cons (SCM_PACK (options[i].val), ls); @@ -189,8 +188,7 @@ change_option_setting (SCM args, scm_t_option options[], unsigned int n, const c case SCM_OPTION_INTEGER: args = SCM_CDR (args); SCM_ASSERT (SCM_CONSP (args), args, SCM_ARG1, s); - SCM_ASSERT (SCM_INUMP (SCM_CAR (args)), args, SCM_ARG1, s); - flags[i] = SCM_INUM (SCM_CAR (args)); + flags[i] = scm_to_size_t (SCM_CAR (args)); break; case SCM_OPTION_SCM: args = SCM_CDR (args); diff --git a/libguile/ports.c b/libguile/ports.c index e277a9d82..101244d84 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -587,7 +587,7 @@ SCM_DEFINE (scm_pt_size, "pt-size", 0, 0, 0, "is only included in @code{--enable-guile-debug} builds.") #define FUNC_NAME s_scm_pt_size { - return SCM_I_MAKINUM (scm_i_port_table_size); + return scm_from_int (scm_i_port_table_size); } #undef FUNC_NAME @@ -640,7 +640,7 @@ SCM_DEFINE (scm_port_revealed, "port-revealed", 1, 0, 0, { port = SCM_COERCE_OUTPORT (port); SCM_VALIDATE_OPENPORT (1, port); - return SCM_I_MAKINUM (scm_revealed_count (port)); + return scm_from_int (scm_revealed_count (port)); } #undef FUNC_NAME @@ -1412,16 +1412,16 @@ SCM_DEFINE (scm_truncate_file, "truncate-file", 1, 1, 0, if (SCM_STRINGP (object)) SCM_MISC_ERROR("must supply length if OBJECT is a filename", SCM_EOL); - length = scm_seek (object, SCM_INUM0, SCM_I_MAKINUM (SEEK_CUR)); + length = scm_seek (object, SCM_INUM0, scm_from_int (SEEK_CUR)); } c_length = SCM_NUM2LONG (2, length); if (c_length < 0) SCM_MISC_ERROR ("negative offset", SCM_EOL); object = SCM_COERCE_OUTPORT (object); - if (SCM_INUMP (object)) + if (scm_is_integer (object)) { - SCM_SYSCALL (rv = ftruncate (SCM_INUM (object), c_length)); + SCM_SYSCALL (rv = ftruncate (scm_to_int (object), c_length)); } else if (SCM_OPOUTPORTP (object)) { @@ -1461,7 +1461,7 @@ SCM_DEFINE (scm_port_line, "port-line", 1, 0, 0, { port = SCM_COERCE_OUTPORT (port); SCM_VALIDATE_OPENPORT (1, port); - return SCM_I_MAKINUM (SCM_LINUM (port)); + return scm_from_int (SCM_LINUM (port)); } #undef FUNC_NAME @@ -1492,7 +1492,7 @@ SCM_DEFINE (scm_port_column, "port-column", 1, 0, 0, { port = SCM_COERCE_OUTPORT (port); SCM_VALIDATE_OPENPORT (1, port); - return SCM_I_MAKINUM (SCM_COL (port)); + return scm_from_int (SCM_COL (port)); } #undef FUNC_NAME @@ -1635,9 +1635,9 @@ void scm_init_ports () { /* lseek() symbols. */ - scm_c_define ("SEEK_SET", SCM_I_MAKINUM (SEEK_SET)); - scm_c_define ("SEEK_CUR", SCM_I_MAKINUM (SEEK_CUR)); - scm_c_define ("SEEK_END", SCM_I_MAKINUM (SEEK_END)); + scm_c_define ("SEEK_SET", scm_from_int (SEEK_SET)); + scm_c_define ("SEEK_CUR", scm_from_int (SEEK_CUR)); + scm_c_define ("SEEK_END", scm_from_int (SEEK_END)); scm_tc16_void_port = scm_make_port_type ("void", fill_input_void_port, write_void_port); diff --git a/libguile/posix.c b/libguile/posix.c index 804e9a3d7..79f8ea2ad 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -283,7 +283,7 @@ SCM_DEFINE (scm_setgroups, "setgroups", 1, 0, 0, size = ngroups * sizeof (GETGROUPS_T); if (size / sizeof (GETGROUPS_T) != ngroups) - SCM_OUT_OF_RANGE (SCM_ARG1, SCM_I_MAKINUM (ngroups)); + SCM_OUT_OF_RANGE (SCM_ARG1, scm_from_int (ngroups)); groups = scm_malloc (size); for(i = 0; i < ngroups; i++) groups [i] = SCM_NUM2ULONG (1, SCM_VECTOR_REF (group_vec, i)); @@ -318,9 +318,9 @@ SCM_DEFINE (scm_getpwuid, "getpw", 0, 1, 0, return SCM_BOOL_F; } } - else if (SCM_INUMP (user)) + else if (scm_is_integer (user)) { - entry = getpwuid (SCM_INUM (user)); + entry = getpwuid (scm_to_int (user)); } else { @@ -387,8 +387,8 @@ SCM_DEFINE (scm_getgrgid, "getgr", 0, 1, 0, return SCM_BOOL_F; } } - else if (SCM_INUMP (name)) - SCM_SYSCALL (entry = getgrgid (SCM_INUM (name))); + else if (scm_is_integer (name)) + SCM_SYSCALL (entry = getgrgid (scm_to_int (name))); else { SCM_VALIDATE_STRING (1, name); @@ -530,7 +530,7 @@ SCM_DEFINE (scm_status_exit_val, "status:exit-val", 1, 0, 0, int lstatus; /* On Ultrix, the WIF... macros assume their argument is an lvalue; - go figure. SCM_INUM does not yield an lvalue. */ + go figure. */ lstatus = scm_to_int (status); if (WIFEXITED (lstatus)) return (scm_from_int (WEXITSTATUS (lstatus))); @@ -579,7 +579,7 @@ SCM_DEFINE (scm_getppid, "getppid", 0, 0, 0, "process.") #define FUNC_NAME s_scm_getppid { - return SCM_I_MAKINUM (0L + getppid ()); + return scm_from_int (getppid ()); } #undef FUNC_NAME #endif /* HAVE_GETPPID */ @@ -591,7 +591,7 @@ SCM_DEFINE (scm_getuid, "getuid", 0, 0, 0, "Return an integer representing the current real user ID.") #define FUNC_NAME s_scm_getuid { - return SCM_I_MAKINUM (0L + getuid ()); + return scm_from_int (getuid ()); } #undef FUNC_NAME @@ -602,7 +602,7 @@ SCM_DEFINE (scm_getgid, "getgid", 0, 0, 0, "Return an integer representing the current real group ID.") #define FUNC_NAME s_scm_getgid { - return SCM_I_MAKINUM (0L + getgid ()); + return scm_from_int (getgid ()); } #undef FUNC_NAME @@ -617,9 +617,9 @@ SCM_DEFINE (scm_geteuid, "geteuid", 0, 0, 0, #define FUNC_NAME s_scm_geteuid { #ifdef HAVE_GETEUID - return SCM_I_MAKINUM (0L + geteuid ()); + return scm_from_int (geteuid ()); #else - return SCM_I_MAKINUM (0L + getuid ()); + return scm_from_int (getuid ()); #endif } #undef FUNC_NAME @@ -634,9 +634,9 @@ SCM_DEFINE (scm_getegid, "getegid", 0, 0, 0, #define FUNC_NAME s_scm_getegid { #ifdef HAVE_GETEUID - return SCM_I_MAKINUM (0L + getegid ()); + return scm_from_int (getegid ()); #else - return SCM_I_MAKINUM (0L + getgid ()); + return scm_from_int (getgid ()); #endif } #undef FUNC_NAME @@ -727,7 +727,7 @@ SCM_DEFINE (scm_getpgrp, "getpgrp", 0, 0, 0, { int (*fn)(); fn = (int (*) ()) getpgrp; - return SCM_I_MAKINUM (fn (0)); + return scm_from_int (fn (0)); } #undef FUNC_NAME #endif /* HAVE_GETPGRP */ @@ -831,7 +831,7 @@ SCM_DEFINE (scm_tcgetpgrp, "tcgetpgrp", 1, 0, 0, fd = SCM_FPORT_FDES (port); if ((pgid = tcgetpgrp (fd)) == -1) SCM_SYSERROR; - return SCM_I_MAKINUM (pgid); + return scm_from_int (pgid); } #undef FUNC_NAME #endif /* HAVE_TCGETPGRP */ @@ -1016,7 +1016,7 @@ SCM_DEFINE (scm_fork, "primitive-fork", 0, 0, 0, pid = fork (); if (pid == -1) SCM_SYSERROR; - return SCM_I_MAKINUM (0L+pid); + return scm_from_int (pid); } #undef FUNC_NAME #endif /* HAVE_FORK */ @@ -1211,7 +1211,7 @@ SCM_DEFINE (scm_getpid, "getpid", 0, 0, 0, "Return an integer representing the current process ID.") #define FUNC_NAME s_scm_getpid { - return SCM_I_MAKINUM ((unsigned long) getpid ()); + return scm_from_ulong (getpid ()); } #undef FUNC_NAME @@ -1275,8 +1275,8 @@ SCM_DEFINE (scm_putenv, "putenv", 1, 0, 0, if (ptr[SCM_STRING_LENGTH (str) - 1] == '=') { char *alt; - SCM name = scm_substring (str, SCM_I_MAKINUM (0), - SCM_I_MAKINUM (SCM_STRING_LENGTH (str) - 1)); + SCM name = scm_substring (str, scm_from_int (0), + scm_from_int (SCM_STRING_LENGTH (str)-1)); if (getenv (SCM_STRING_CHARS (name)) == NULL) { alt = scm_malloc (SCM_STRING_LENGTH (str) + 2); @@ -1819,70 +1819,70 @@ scm_init_posix () scm_add_feature ("EIDs"); #endif #ifdef WAIT_ANY - scm_c_define ("WAIT_ANY", SCM_I_MAKINUM (WAIT_ANY)); + scm_c_define ("WAIT_ANY", scm_from_int (WAIT_ANY)); #endif #ifdef WAIT_MYPGRP - scm_c_define ("WAIT_MYPGRP", SCM_I_MAKINUM (WAIT_MYPGRP)); + scm_c_define ("WAIT_MYPGRP", scm_from_int (WAIT_MYPGRP)); #endif #ifdef WNOHANG - scm_c_define ("WNOHANG", SCM_I_MAKINUM (WNOHANG)); + scm_c_define ("WNOHANG", scm_from_int (WNOHANG)); #endif #ifdef WUNTRACED - scm_c_define ("WUNTRACED", SCM_I_MAKINUM (WUNTRACED)); + scm_c_define ("WUNTRACED", scm_from_int (WUNTRACED)); #endif /* access() symbols. */ - scm_c_define ("R_OK", SCM_I_MAKINUM (R_OK)); - scm_c_define ("W_OK", SCM_I_MAKINUM (W_OK)); - scm_c_define ("X_OK", SCM_I_MAKINUM (X_OK)); - scm_c_define ("F_OK", SCM_I_MAKINUM (F_OK)); + scm_c_define ("R_OK", scm_from_int (R_OK)); + scm_c_define ("W_OK", scm_from_int (W_OK)); + scm_c_define ("X_OK", scm_from_int (X_OK)); + scm_c_define ("F_OK", scm_from_int (F_OK)); #ifdef LC_COLLATE - scm_c_define ("LC_COLLATE", SCM_I_MAKINUM (LC_COLLATE)); + scm_c_define ("LC_COLLATE", scm_from_int (LC_COLLATE)); #endif #ifdef LC_CTYPE - scm_c_define ("LC_CTYPE", SCM_I_MAKINUM (LC_CTYPE)); + scm_c_define ("LC_CTYPE", scm_from_int (LC_CTYPE)); #endif #ifdef LC_MONETARY - scm_c_define ("LC_MONETARY", SCM_I_MAKINUM (LC_MONETARY)); + scm_c_define ("LC_MONETARY", scm_from_int (LC_MONETARY)); #endif #ifdef LC_NUMERIC - scm_c_define ("LC_NUMERIC", SCM_I_MAKINUM (LC_NUMERIC)); + scm_c_define ("LC_NUMERIC", scm_from_int (LC_NUMERIC)); #endif #ifdef LC_TIME - scm_c_define ("LC_TIME", SCM_I_MAKINUM (LC_TIME)); + scm_c_define ("LC_TIME", scm_from_int (LC_TIME)); #endif #ifdef LC_MESSAGES - scm_c_define ("LC_MESSAGES", SCM_I_MAKINUM (LC_MESSAGES)); + scm_c_define ("LC_MESSAGES", scm_from_int (LC_MESSAGES)); #endif #ifdef LC_ALL - scm_c_define ("LC_ALL", SCM_I_MAKINUM (LC_ALL)); + scm_c_define ("LC_ALL", scm_from_int (LC_ALL)); #endif #ifdef PIPE_BUF scm_c_define ("PIPE_BUF", scm_long2num (PIPE_BUF)); #endif #ifdef PRIO_PROCESS - scm_c_define ("PRIO_PROCESS", SCM_I_MAKINUM (PRIO_PROCESS)); + scm_c_define ("PRIO_PROCESS", scm_from_int (PRIO_PROCESS)); #endif #ifdef PRIO_PGRP - scm_c_define ("PRIO_PGRP", SCM_I_MAKINUM (PRIO_PGRP)); + scm_c_define ("PRIO_PGRP", scm_from_int (PRIO_PGRP)); #endif #ifdef PRIO_USER - scm_c_define ("PRIO_USER", SCM_I_MAKINUM (PRIO_USER)); + scm_c_define ("PRIO_USER", scm_from_int (PRIO_USER)); #endif #ifdef LOCK_SH - scm_c_define ("LOCK_SH", SCM_I_MAKINUM (LOCK_SH)); + scm_c_define ("LOCK_SH", scm_from_int (LOCK_SH)); #endif #ifdef LOCK_EX - scm_c_define ("LOCK_EX", SCM_I_MAKINUM (LOCK_EX)); + scm_c_define ("LOCK_EX", scm_from_int (LOCK_EX)); #endif #ifdef LOCK_UN - scm_c_define ("LOCK_UN", SCM_I_MAKINUM (LOCK_UN)); + scm_c_define ("LOCK_UN", scm_from_int (LOCK_UN)); #endif #ifdef LOCK_NB - scm_c_define ("LOCK_NB", SCM_I_MAKINUM (LOCK_NB)); + scm_c_define ("LOCK_NB", scm_from_int (LOCK_NB)); #endif #include "libguile/cpp_sig_symbols.c" diff --git a/libguile/print.c b/libguile/print.c index 1974b318c..e43462a51 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -366,7 +366,7 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate) break; case scm_tc3_int_1: case scm_tc3_int_2: - scm_intprint (SCM_INUM (exp), 10, port); + scm_intprint (SCM_I_INUM (exp), 10, port); break; case scm_tc3_imm24: if (SCM_CHARP (exp)) diff --git a/libguile/procprop.c b/libguile/procprop.c index 3ba22e0a5..1c6727e0f 100644 --- a/libguile/procprop.c +++ b/libguile/procprop.c @@ -87,7 +87,7 @@ scm_i_procedure_arity (SCM proc) case scm_tc7_cclo: if (SCM_EQ_P (SCM_CCLO_SUBR (proc), scm_f_gsubr_apply)) { - int type = SCM_INUM (SCM_GSUBR_TYPE (proc)); + int type = scm_to_int (SCM_GSUBR_TYPE (proc)); a += SCM_GSUBR_REQ (type); o = SCM_GSUBR_OPT (type); r = SCM_GSUBR_REST (type); @@ -130,7 +130,7 @@ scm_i_procedure_arity (SCM proc) default: return SCM_BOOL_F; } - return scm_list_3 (SCM_I_MAKINUM (a), SCM_I_MAKINUM (o), scm_from_bool(r)); + return scm_list_3 (scm_from_int (a), scm_from_int (o), scm_from_bool(r)); } static SCM diff --git a/libguile/procs.c b/libguile/procs.c index 68da589ac..42869182c 100644 --- a/libguile/procs.c +++ b/libguile/procs.c @@ -149,7 +149,7 @@ SCM_DEFINE (scm_make_cclo, "make-cclo", 2, 0, 0, "@var{len} objects for its usage.") #define FUNC_NAME s_scm_make_cclo { - return scm_makcclo (proc, SCM_INUM (len)); + return scm_makcclo (proc, scm_to_size_t (len)); } #undef FUNC_NAME #endif diff --git a/libguile/ramap.c b/libguile/ramap.c index f570d4807..62b04d62c 100644 --- a/libguile/ramap.c +++ b/libguile/ramap.c @@ -191,7 +191,7 @@ scm_ra_matchp (SCM ra0, SCM ras) case scm_tc7_cvect: s0->lbnd = 0; s0->inc = 1; - s0->ubnd = SCM_INUM (scm_uniform_vector_length (ra0)) - 1; + s0->ubnd = scm_to_long (scm_uniform_vector_length (ra0)) - 1; break; case scm_tc7_smob: if (!SCM_ARRAYP (ra0)) @@ -231,7 +231,7 @@ scm_ra_matchp (SCM ra0, SCM ras) if (1 != ndim) return 0; - length = SCM_INUM (scm_uniform_vector_length (ra1)); + length = scm_to_ulong (scm_uniform_vector_length (ra1)); switch (exact) { @@ -310,7 +310,7 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, const char *what) if (SCM_IMP (vra0)) goto gencase; if (!SCM_ARRAYP (vra0)) { - unsigned long int length = SCM_INUM (scm_uniform_vector_length (vra0)); + unsigned long int length = scm_to_ulong (scm_uniform_vector_length (vra0)); vra1 = scm_make_ra (1); SCM_ARRAY_BASE (vra1) = 0; SCM_ARRAY_DIMS (vra1)->lbnd = 0; @@ -368,7 +368,7 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, const char *what) } else { - unsigned long int length = SCM_INUM (scm_uniform_vector_length (ra0)); + unsigned long length = scm_to_ulong (scm_uniform_vector_length (ra0)); kmax = 0; SCM_ARRAY_DIMS (vra0)->lbnd = 0; SCM_ARRAY_DIMS (vra0)->ubnd = length - 1; @@ -399,7 +399,7 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, const char *what) *plvra = scm_cons (vra1, SCM_EOL); plvra = SCM_CDRLOC (*plvra); } - inds = scm_make_uve (SCM_ARRAY_NDIM (ra0), SCM_I_MAKINUM (-1L)); + inds = scm_make_uve (SCM_ARRAY_NDIM (ra0), scm_from_int (-1)); vinds = (long *) SCM_VELTS (inds); for (k = 0; k <= kmax; k++) vinds[k] = SCM_ARRAY_DIMS (ra0)[k].lbnd; @@ -459,7 +459,7 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED) { default: for (i = base; n--; i += inc) - scm_array_set_x (ra, fill, SCM_I_MAKINUM (i)); + scm_array_set_x (ra, fill, scm_from_ulong (i)); break; case scm_tc7_vector: case scm_tc7_wvect: @@ -474,11 +474,11 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED) case scm_tc7_byvect: if (SCM_CHARP (fill)) fill = SCM_I_MAKINUM ((char) SCM_CHAR (fill)); - SCM_ASRTGO (SCM_INUMP (fill) - && -128 <= SCM_INUM (fill) && SCM_INUM (fill) < 128, + SCM_ASRTGO (SCM_I_INUMP (fill) + && -128 <= SCM_I_INUM (fill) && SCM_I_INUM (fill) < 128, badarg2); for (i = base; n--; i += inc) - ((char *) SCM_UVECTOR_BASE (ra))[i] = SCM_INUM (fill); + ((char *) SCM_UVECTOR_BASE (ra))[i] = SCM_I_INUM (fill); break; case scm_tc7_bvect: { /* scope */ @@ -539,12 +539,12 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED) break; } case scm_tc7_svect: - SCM_ASRTGO (SCM_INUMP (fill), badarg2); + SCM_ASRTGO (SCM_I_INUMP (fill), badarg2); { /* scope */ - short f = SCM_INUM (fill); + short f = SCM_I_INUM (fill); short *ve = (short *) SCM_VELTS (ra); - if (f != SCM_INUM (fill)) + if (f != SCM_I_INUM (fill)) SCM_OUT_OF_RANGE (2, fill); for (i = base; n--; i += inc) ve[i] = f; @@ -625,7 +625,7 @@ racp (SCM src, SCM dst) for (; n-- > 0; i_s += inc_s, i_d += inc_d) scm_array_set_x (dst, scm_cvref (src, i_s, SCM_UNDEFINED), - SCM_I_MAKINUM (i_d)); + scm_from_ulong (i_d)); break; case scm_tc7_string: if (SCM_TYP7 (src) != scm_tc7_string) @@ -992,7 +992,7 @@ scm_ra_sum (SCM ra0, SCM ras) SCM e0 = SCM_UNDEFINED, e1 = SCM_UNDEFINED; for (; n-- > 0; i0 += inc0, i1 += inc1) scm_array_set_x (ra0, scm_sum (RVREF (ra0, i0, e0), RVREF (ra1, i1, e1)), - SCM_I_MAKINUM (i0)); + scm_from_ulong (i0)); break; } case scm_tc7_uvect: @@ -1028,7 +1028,7 @@ scm_ra_difference (SCM ra0, SCM ras) for (; n-- > 0; i0 += inc0) scm_array_set_x (ra0, scm_difference (RVREF (ra0, i0, e0), SCM_UNDEFINED), - SCM_I_MAKINUM (i0)); + scm_from_ulong (i0)); break; } case scm_tc7_fvect: @@ -1051,7 +1051,7 @@ scm_ra_difference (SCM ra0, SCM ras) { SCM e0 = SCM_UNDEFINED, e1 = SCM_UNDEFINED; for (; n-- > 0; i0 += inc0, i1 += inc1) - scm_array_set_x (ra0, scm_difference (RVREF (ra0, i0, e0), RVREF (ra1, i1, e1)), SCM_I_MAKINUM (i0)); + scm_array_set_x (ra0, scm_difference (RVREF (ra0, i0, e0), RVREF (ra1, i1, e1)), scm_from_ulong (i0)); break; } case scm_tc7_fvect: @@ -1087,7 +1087,7 @@ scm_ra_product (SCM ra0, SCM ras) SCM e0 = SCM_UNDEFINED, e1 = SCM_UNDEFINED; for (; n-- > 0; i0 += inc0, i1 += inc1) scm_array_set_x (ra0, scm_product (RVREF (ra0, i0, e0), RVREF (ra1, i1, e1)), - SCM_I_MAKINUM (i0)); + scm_from_ulong (i0)); break; } case scm_tc7_uvect: @@ -1133,7 +1133,7 @@ scm_ra_divide (SCM ra0, SCM ras) { SCM e0 = SCM_UNDEFINED; for (; n-- > 0; i0 += inc0) - scm_array_set_x (ra0, scm_divide (RVREF (ra0, i0, e0), SCM_UNDEFINED), SCM_I_MAKINUM (i0)); + scm_array_set_x (ra0, scm_divide (RVREF (ra0, i0, e0), SCM_UNDEFINED), scm_from_ulong (i0)); break; } case scm_tc7_fvect: @@ -1166,7 +1166,7 @@ scm_ra_divide (SCM ra0, SCM ras) { SCM e0 = SCM_UNDEFINED, e1 = SCM_UNDEFINED; for (; n-- > 0; i0 += inc0, i1 += inc1) - scm_array_set_x (ra0, scm_divide (RVREF (ra0, i0, e0), RVREF (ra1, i1, e1)), SCM_I_MAKINUM (i0)); + scm_array_set_x (ra0, scm_divide (RVREF (ra0, i0, e0), RVREF (ra1, i1, e1)), scm_from_ulong (i0)); break; } case scm_tc7_fvect: @@ -1213,7 +1213,7 @@ ramap (SCM ra0, SCM proc, SCM ras) ra0 = SCM_ARRAY_V (ra0); if (SCM_NULLP (ras)) for (; i <= n; i++) - scm_array_set_x (ra0, scm_call_0 (proc), SCM_I_MAKINUM (i * inc + base)); + scm_array_set_x (ra0, scm_call_0 (proc), scm_from_long (i * inc + base)); else { SCM ra1 = SCM_CAR (ras); @@ -1234,10 +1234,10 @@ ramap (SCM ra0, SCM proc, SCM ras) for (; i <= n; i++, i1 += inc1) { args = SCM_EOL; - for (k = SCM_INUM (scm_uniform_vector_length (ras)); k--;) - args = scm_cons (scm_uniform_vector_ref (ve[k], SCM_I_MAKINUM (i)), args); + for (k = scm_to_ulong (scm_uniform_vector_length (ras)); k--;) + args = scm_cons (scm_uniform_vector_ref (ve[k], scm_from_long (i)), args); args = scm_cons (scm_cvref (ra1, i1, SCM_UNDEFINED), args); - scm_array_set_x (ra0, scm_apply_0 (proc, args), SCM_I_MAKINUM (i * inc + base)); + scm_array_set_x (ra0, scm_apply_0 (proc, args), scm_from_long (i * inc + base)); } } return 1; @@ -1259,7 +1259,7 @@ ramap_dsubr (SCM ra0, SCM proc, SCM ras) default: gencase: for (; n-- > 0; i0 += inc0, i1 += inc1) - scm_array_set_x (ra0, scm_call_1 (proc, RVREF (ra1, i1, e1)), SCM_I_MAKINUM (i0)); + scm_array_set_x (ra0, scm_call_1 (proc, RVREF (ra1, i1, e1)), scm_from_ulong (i0)); break; case scm_tc7_fvect: { @@ -1332,11 +1332,10 @@ ramap_rp (SCM ra0, SCM proc, SCM ras) if (SCM_BITVEC_REF (ra0, i0)) { /* DIRK:FIXME:: There should be a way to access the elements - of a cell as raw data. Further: How can we be sure that - the values fit into an inum? + of a cell as raw data. */ - SCM n1 = SCM_I_MAKINUM (((long *) SCM_UNPACK (SCM_CDR (ra1)))[i1]); - SCM n2 = SCM_I_MAKINUM (((long *) SCM_UNPACK (SCM_CDR (ra2)))[i2]); + SCM n1 = scm_from_long (((long *) SCM_UNPACK (SCM_CDR (ra1)))[i1]); + SCM n2 = scm_from_long (((long *) SCM_UNPACK (SCM_CDR (ra2)))[i2]); if (scm_is_false (SCM_SUBRF (proc) (n1, n2))) SCM_BITVEC_CLR (ra0, i0); } @@ -1402,10 +1401,10 @@ ramap_1 (SCM ra0, SCM proc, SCM ras) ra1 = SCM_ARRAY_V (ra1); if (scm_tc7_vector == SCM_TYP7 (ra0) || scm_tc7_wvect == SCM_TYP7 (ra0)) for (; n-- > 0; i0 += inc0, i1 += inc1) - scm_array_set_x (ra0, SCM_SUBRF (proc) (scm_cvref (ra1, i1, SCM_UNDEFINED)), SCM_I_MAKINUM (i0)); + scm_array_set_x (ra0, SCM_SUBRF (proc) (scm_cvref (ra1, i1, SCM_UNDEFINED)), scm_from_ulong (i0)); else for (; n-- > 0; i0 += inc0, i1 += inc1) - scm_array_set_x (ra0, SCM_SUBRF (proc) (RVREF (ra1, i1, e1)), SCM_I_MAKINUM (i0)); + scm_array_set_x (ra0, SCM_SUBRF (proc) (RVREF (ra1, i1, e1)), scm_from_ulong (i0)); return 1; } @@ -1429,11 +1428,11 @@ ramap_2o (SCM ra0, SCM proc, SCM ras) for (; n-- > 0; i0 += inc0, i1 += inc1) scm_array_set_x (ra0, SCM_SUBRF (proc) (scm_cvref (ra1, i1, SCM_UNDEFINED), SCM_UNDEFINED), - SCM_I_MAKINUM (i0)); + scm_from_ulong (i0)); else for (; n-- > 0; i0 += inc0, i1 += inc1) scm_array_set_x (ra0, SCM_SUBRF (proc) (RVREF (ra1, i1, e1), SCM_UNDEFINED), - SCM_I_MAKINUM (i0)); + scm_from_ulong (i0)); } else { @@ -1446,12 +1445,12 @@ ramap_2o (SCM ra0, SCM proc, SCM ras) for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) scm_array_set_x (ra0, SCM_SUBRF (proc) (scm_cvref (ra1, i1, SCM_UNDEFINED), scm_cvref (ra2, i2, SCM_UNDEFINED)), - SCM_I_MAKINUM (i0)); + scm_from_ulong (i0)); else for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) scm_array_set_x (ra0, SCM_SUBRF (proc) (RVREF (ra1, i1, e1), RVREF (ra2, i2, e2)), - SCM_I_MAKINUM (i0)); + scm_from_ulong (i0)); } return 1; } @@ -1468,7 +1467,7 @@ ramap_a (SCM ra0, SCM proc, SCM ras) ra0 = SCM_ARRAY_V (ra0); if (SCM_NULLP (ras)) for (; n-- > 0; i0 += inc0) - scm_array_set_x (ra0, SCM_SUBRF (proc) (RVREF (ra0, i0, e0), SCM_UNDEFINED), SCM_I_MAKINUM (i0)); + scm_array_set_x (ra0, SCM_SUBRF (proc) (RVREF (ra0, i0, e0), SCM_UNDEFINED), scm_from_ulong (i0)); else { SCM ra1 = SCM_CAR (ras); @@ -1477,7 +1476,7 @@ ramap_a (SCM ra0, SCM proc, SCM ras) ra1 = SCM_ARRAY_V (ra1); for (; n-- > 0; i0 += inc0, i1 += inc1) scm_array_set_x (ra0, SCM_SUBRF (proc) (RVREF (ra0, i0, e0), RVREF (ra1, i1, e1)), - SCM_I_MAKINUM (i0)); + scm_from_ulong (i0)); } return 1; } @@ -1542,11 +1541,11 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1, if (SCM_NULLP (lra)) { SCM prot, fill = SCM_SUBRF (proc) (SCM_UNDEFINED, SCM_UNDEFINED); - if (SCM_INUMP(fill)) + if (SCM_I_INUMP(fill)) { prot = scm_array_prototype (ra0); if (SCM_INEXACTP (prot)) - fill = scm_make_real ((double) SCM_INUM (fill)); + fill = scm_make_real ((double) SCM_I_INUM (fill)); } scm_array_fill_x (ra0, fill); @@ -1627,8 +1626,8 @@ rafe (SCM ra0, SCM proc, SCM ras) for (; i <= n; i++, i0 += inc0, i1 += inc1) { args = SCM_EOL; - for (k = SCM_INUM (scm_uniform_vector_length (ras)); k--;) - args = scm_cons (scm_uniform_vector_ref (ve[k], SCM_I_MAKINUM (i)), args); + for (k = scm_to_ulong (scm_uniform_vector_length (ras)); k--;) + args = scm_cons (scm_uniform_vector_ref (ve[k], scm_from_long (i)), args); args = scm_cons2 (scm_cvref (ra0, i0, SCM_UNDEFINED), scm_cvref (ra1, i1, SCM_UNDEFINED), args); scm_apply_0 (proc, args); } @@ -1682,7 +1681,7 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0, case scm_tc7_wvect: { for (i = 0; i < SCM_VECTOR_LENGTH (ra); i++) - SCM_VECTOR_SET(ra, i, scm_call_1 (proc, SCM_I_MAKINUM (i))); + SCM_VECTOR_SET(ra, i, scm_call_1 (proc, scm_from_long (i))); return SCM_UNSPECIFIED; } case scm_tc7_string: @@ -1698,17 +1697,17 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0, case scm_tc7_dvect: case scm_tc7_cvect: { - unsigned long int length = SCM_INUM (scm_uniform_vector_length (ra)); + unsigned long int length = scm_to_ulong (scm_uniform_vector_length (ra)); for (i = 0; i < length; i++) - scm_array_set_x (ra, scm_call_1 (proc, SCM_I_MAKINUM (i)), - SCM_I_MAKINUM (i)); + scm_array_set_x (ra, scm_call_1 (proc, scm_from_ulong (i)), + scm_from_ulong (i)); return SCM_UNSPECIFIED; } case scm_tc7_smob: SCM_ASRTGO (SCM_ARRAYP (ra), badarg); { SCM args = SCM_EOL; - SCM inds = scm_make_uve (SCM_ARRAY_NDIM (ra), SCM_I_MAKINUM (-1L)); + SCM inds = scm_make_uve (SCM_ARRAY_NDIM (ra), scm_from_int (-1)); long *vinds = (long *) SCM_VELTS (inds); int j, k, kmax = SCM_ARRAY_NDIM (ra) - 1; if (kmax < 0) @@ -1725,10 +1724,10 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0, for (; vinds[k] <= SCM_ARRAY_DIMS (ra)[k].ubnd; vinds[k]++) { for (j = kmax + 1, args = SCM_EOL; j--;) - args = scm_cons (SCM_I_MAKINUM (vinds[j]), args); + args = scm_cons (scm_from_long (vinds[j]), args); scm_array_set_x (SCM_ARRAY_V (ra), scm_apply_0 (proc, args), - SCM_I_MAKINUM (i)); + scm_from_ulong (i)); i += SCM_ARRAY_DIMS (ra)[k].inc; } k--; @@ -1767,7 +1766,7 @@ raeql_1 (SCM ra0, SCM as_equal, SCM ra1) ra0 = SCM_ARRAY_V (ra0); } else - n = SCM_INUM (scm_uniform_vector_length (ra0)); + n = scm_to_ulong (scm_uniform_vector_length (ra0)); if (SCM_ARRAYP (ra1)) { i1 = SCM_ARRAY_BASE (ra1); @@ -1898,7 +1897,7 @@ raeql (SCM ra0, SCM as_equal, SCM ra1) { s0->inc = 1; s0->lbnd = 0; - s0->ubnd = SCM_INUM (scm_uniform_vector_length (v0)) - 1; + s0->ubnd = scm_to_long (scm_uniform_vector_length (v0)) - 1; unroll = 0; } if (SCM_ARRAYP (ra1)) @@ -1918,7 +1917,7 @@ raeql (SCM ra0, SCM as_equal, SCM ra1) return 0; s1->inc = 1; s1->lbnd = 0; - s1->ubnd = SCM_INUM (scm_uniform_vector_length (v1)) - 1; + s1->ubnd = scm_to_long (scm_uniform_vector_length (v1)) - 1; unroll = 0; } if (SCM_TYP7 (v0) != SCM_TYP7 (v1)) diff --git a/libguile/random.c b/libguile/random.c index a6ad9aae8..e98794ca4 100644 --- a/libguile/random.c +++ b/libguile/random.c @@ -349,11 +349,11 @@ SCM_DEFINE (scm_random, "random", 1, 1, 0, if (SCM_UNBNDP (state)) state = SCM_VARIABLE_REF (scm_var_random_state); SCM_VALIDATE_RSTATE (2, state); - if (SCM_INUMP (n)) + if (SCM_I_INUMP (n)) { - unsigned long m = SCM_INUM (n); + unsigned long m = SCM_I_INUM (n); SCM_ASSERT_RANGE (1, n, m > 0); - return SCM_I_MAKINUM (scm_c_random (SCM_RSTATE (state), m)); + return scm_from_ulong (scm_c_random (SCM_RSTATE (state), m)); } SCM_VALIDATE_NIM (1, n); if (SCM_REALP (n)) @@ -424,7 +424,7 @@ SCM_DEFINE (scm_random_normal, "random:normal", 0, 1, 0, static void vector_scale (SCM v, double c) { - int n = SCM_INUM (scm_uniform_vector_length (v)); + int n = scm_to_int (scm_uniform_vector_length (v)); if (SCM_VECTORP (v)) while (--n >= 0) SCM_REAL_VALUE (SCM_VELTS (v)[n]) *= c; @@ -437,7 +437,7 @@ static double vector_sum_squares (SCM v) { double x, sum = 0.0; - int n = SCM_INUM (scm_uniform_vector_length (v)); + int n = scm_to_int (scm_uniform_vector_length (v)); if (SCM_VECTORP (v)) while (--n >= 0) { @@ -475,7 +475,7 @@ SCM_DEFINE (scm_random_solid_sphere_x, "random:solid-sphere!", 1, 1, 0, scm_random_normal_vector_x (v, state); vector_scale (v, pow (scm_c_uniform01 (SCM_RSTATE (state)), - 1.0 / SCM_INUM (scm_uniform_vector_length (v))) + 1.0 / scm_to_int (scm_uniform_vector_length (v))) / sqrt (vector_sum_squares (v))); return SCM_UNSPECIFIED; } @@ -514,7 +514,7 @@ SCM_DEFINE (scm_random_normal_vector_x, "random:normal-vector!", 1, 1, 0, if (SCM_UNBNDP (state)) state = SCM_VARIABLE_REF (scm_var_random_state); SCM_VALIDATE_RSTATE (2, state); - n = SCM_INUM (scm_uniform_vector_length (v)); + n = scm_to_int (scm_uniform_vector_length (v)); if (SCM_VECTORP (v)) while (--n >= 0) SCM_VECTOR_SET (v, n, scm_make_real (scm_c_normal01 (SCM_RSTATE (state)))); diff --git a/libguile/read.c b/libguile/read.c index ebaf1ed29..7f301531b 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -462,8 +462,8 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) * checked whether the resulting fixnum is in the range of * characters. */ p = scm_i_mem2number (SCM_STRING_CHARS (*tok_buf), j, 8); - if (SCM_INUMP (p)) - return SCM_MAKE_CHAR (SCM_INUM (p)); + if (SCM_I_INUMP (p)) + return SCM_MAKE_CHAR (SCM_I_INUM (p)); } for (c = 0; c < scm_n_charnames; c++) if (scm_charnames[c] diff --git a/libguile/regex-posix.c b/libguile/regex-posix.c index a38f440ff..20d4e9274 100644 --- a/libguile/regex-posix.c +++ b/libguile/regex-posix.c @@ -98,12 +98,12 @@ scm_regexp_error_msg (int regerrno, regex_t *rx) never returns, we would never have the opportunity to free it. Creating it as a SCM object means that the system will GC it at some point. */ - errmsg = scm_make_string (SCM_I_MAKINUM (80), SCM_UNDEFINED); + errmsg = scm_make_string (scm_from_int (80), SCM_UNDEFINED); SCM_DEFER_INTS; l = regerror (regerrno, rx, SCM_STRING_CHARS (errmsg), 80); if (l > 80) { - errmsg = scm_make_string (SCM_I_MAKINUM (l), SCM_UNDEFINED); + errmsg = scm_make_string (scm_from_int (l), SCM_UNDEFINED); regerror (regerrno, rx, SCM_STRING_CHARS (errmsg), l); } SCM_ALLOW_INTS; @@ -174,10 +174,10 @@ SCM_DEFINE (scm_make_regexp, "make-regexp", 1, 0, 1, flag = flags; while (!SCM_NULLP (flag)) { - if (SCM_INUM (SCM_CAR (flag)) == REG_BASIC) + if (scm_to_int (SCM_CAR (flag)) == REG_BASIC) cflags &= ~REG_EXTENDED; else - cflags |= SCM_INUM (SCM_CAR (flag)); + cflags |= scm_to_int (SCM_CAR (flag)); flag = SCM_CDR (flag); } @@ -257,7 +257,7 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0, SCM_VECTOR_SET(mvec,0, str); for (i = 0; i < nmatches; ++i) if (matches[i].rm_so == -1) - SCM_VECTOR_SET(mvec,i+1, scm_cons (SCM_I_MAKINUM (-1), SCM_I_MAKINUM (-1))); + SCM_VECTOR_SET(mvec,i+1, scm_cons (scm_from_int (-1), scm_from_int (-1))); else SCM_VECTOR_SET(mvec,i+1,scm_cons (scm_long2num (matches[i].rm_so + offset), scm_long2num (matches[i].rm_eo + offset))); diff --git a/libguile/rw.c b/libguile/rw.c index 0b5eba9f2..15d1efd13 100644 --- a/libguile/rw.c +++ b/libguile/rw.c @@ -116,8 +116,8 @@ SCM_DEFINE (scm_read_string_x_partial, "read-string!/partial", 1, 3, 0, read_len = last - offset; } - if (SCM_INUMP (port_or_fdes)) - fdes = SCM_INUM (port_or_fdes); + if (scm_is_integer (port_or_fdes)) + fdes = scm_to_int (port_or_fdes); else { SCM port = SCM_UNBNDP (port_or_fdes) ? scm_cur_inp : port_or_fdes; @@ -212,8 +212,8 @@ SCM_DEFINE (scm_write_string_partial, "write-string/partial", 1, 3, 0, if (write_len == 0) return SCM_INUM0; - if (SCM_INUMP (port_or_fdes)) - fdes = SCM_INUM (port_or_fdes); + if (scm_is_integer (port_or_fdes)) + fdes = scm_to_int (port_or_fdes); else { SCM port = SCM_UNBNDP (port_or_fdes) ? scm_cur_outp : port_or_fdes; diff --git a/libguile/scmsigs.c b/libguile/scmsigs.c index ad58fabe7..fba285d24 100644 --- a/libguile/scmsigs.c +++ b/libguile/scmsigs.c @@ -327,15 +327,15 @@ SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0, old_handler = SCM_VECTOR_REF(*signal_handlers, csig); if (SCM_UNBNDP (handler)) query_only = 1; - else if (SCM_EQ_P (scm_integer_p (handler), SCM_BOOL_T)) + else if (scm_is_integer (handler)) { if (SCM_NUM2LONG (2, handler) == (long) SIG_DFL || SCM_NUM2LONG (2, handler) == (long) SIG_IGN) { #ifdef HAVE_SIGACTION - action.sa_handler = (SIGRETTYPE (*) (int)) SCM_INUM (handler); + action.sa_handler = (SIGRETTYPE (*) (int)) scm_to_int (handler); #else - chandler = (SIGRETTYPE (*) (int)) SCM_INUM (handler); + chandler = (SIGRETTYPE (*) (int)) scm_to_int (handler); #endif install_handler (csig, SCM_BOOL_F, SCM_BOOL_F); } @@ -426,7 +426,7 @@ SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0, if (old_action.sa_handler == SIG_DFL || old_action.sa_handler == SIG_IGN) old_handler = scm_long2num ((long) old_action.sa_handler); SCM_ALLOW_INTS; - return scm_cons (old_handler, SCM_I_MAKINUM (old_action.sa_flags)); + return scm_cons (old_handler, scm_from_int (old_action.sa_flags)); #else if (query_only) { @@ -445,7 +445,7 @@ SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0, if (old_chandler == SIG_DFL || old_chandler == SIG_IGN) old_handler = scm_long2num ((long) old_chandler); SCM_ALLOW_INTS; - return scm_cons (old_handler, SCM_I_MAKINUM (0)); + return scm_cons (old_handler, scm_from_int (0)); #endif } #undef FUNC_NAME @@ -688,9 +688,9 @@ scm_init_scmsigs () #if defined(HAVE_SETITIMER) || defined(HAVE_GETITIMER) /* Stuff needed by setitimer and getitimer. */ - scm_c_define ("ITIMER_REAL", SCM_I_MAKINUM (ITIMER_REAL)); - scm_c_define ("ITIMER_VIRTUAL", SCM_I_MAKINUM (ITIMER_VIRTUAL)); - scm_c_define ("ITIMER_PROF", SCM_I_MAKINUM (ITIMER_PROF)); + scm_c_define ("ITIMER_REAL", scm_from_int (ITIMER_REAL)); + scm_c_define ("ITIMER_VIRTUAL", scm_from_int (ITIMER_VIRTUAL)); + scm_c_define ("ITIMER_PROF", scm_from_int (ITIMER_PROF)); #endif /* defined(HAVE_SETITIMER) || defined(HAVE_GETITIMER) */ #include "libguile/scmsigs.x" diff --git a/libguile/simpos.c b/libguile/simpos.c index d23e949f4..a37423f56 100644 --- a/libguile/simpos.c +++ b/libguile/simpos.c @@ -75,7 +75,7 @@ SCM_DEFINE (scm_system, "system", 0, 1, 0, rv = system (SCM_STRING_CHARS (cmd)); if (rv == -1 || (rv == 127 && errno != 0)) SCM_SYSERROR; - return SCM_I_MAKINUM (rv); + return scm_from_int (rv); } #undef FUNC_NAME #endif /* HAVE_SYSTEM */ @@ -183,7 +183,7 @@ SCM_DEFINE (scm_system_star, "system*", 0, 0, 1, scm_sigaction (sigint, SCM_CAR (oldint), SCM_CDR (oldint)); scm_sigaction (sigquit, SCM_CAR (oldquit), SCM_CDR (oldquit)); scm_remember_upto_here_2 (oldint, oldquit); - return SCM_I_MAKINUM (0L + status); + return scm_from_int (status); } } else diff --git a/libguile/socket.c b/libguile/socket.c index 1582cb3c6..556ba4c0d 100644 --- a/libguile/socket.c +++ b/libguile/socket.c @@ -338,9 +338,9 @@ scm_from_ipv6 (const scm_t_uint8 *src) static void scm_to_ipv6 (scm_t_uint8 dst[16], SCM src) { - if (SCM_INUMP (src)) + if (SCM_I_INUMP (src)) { - scm_t_signed_bits n = SCM_INUM (src); + scm_t_signed_bits n = SCM_I_INUM (src); if (n < 0) scm_out_of_range (NULL, src); #ifdef WORDS_BIGENDIAN @@ -804,7 +804,7 @@ scm_fill_sockaddr (int fam, SCM address, SCM *args, int which_arg, } #endif default: - scm_out_of_range (proc, SCM_I_MAKINUM (fam)); + scm_out_of_range (proc, scm_from_int (fam)); } } #undef FUNC_NAME @@ -992,7 +992,7 @@ scm_addr_vector (const struct sockaddr *address, int addr_size, #endif default: scm_misc_error (proc, "Unrecognised address family: ~A", - scm_list_1 (SCM_I_MAKINUM (fam))); + scm_list_1 (scm_from_int (fam))); } return result; } @@ -1228,7 +1228,7 @@ SCM_DEFINE (scm_recvfrom, "recvfrom!", 2, 3, 0, else address = SCM_BOOL_F; - return scm_cons (SCM_I_MAKINUM (rv), address); + return scm_cons (scm_from_int (rv), address); } #undef FUNC_NAME @@ -1283,7 +1283,7 @@ SCM_DEFINE (scm_sendto, "sendto", 4, 0, 1, SCM_SYSERROR; } free (soka); - return SCM_I_MAKINUM (rv); + return scm_from_int (rv); } #undef FUNC_NAME @@ -1294,29 +1294,29 @@ scm_init_socket () { /* protocol families. */ #ifdef AF_UNSPEC - scm_c_define ("AF_UNSPEC", SCM_I_MAKINUM (AF_UNSPEC)); + scm_c_define ("AF_UNSPEC", scm_from_int (AF_UNSPEC)); #endif #ifdef AF_UNIX - scm_c_define ("AF_UNIX", SCM_I_MAKINUM (AF_UNIX)); + scm_c_define ("AF_UNIX", scm_from_int (AF_UNIX)); #endif #ifdef AF_INET - scm_c_define ("AF_INET", SCM_I_MAKINUM (AF_INET)); + scm_c_define ("AF_INET", scm_from_int (AF_INET)); #endif #ifdef AF_INET6 - scm_c_define ("AF_INET6", SCM_I_MAKINUM (AF_INET6)); + scm_c_define ("AF_INET6", scm_from_int (AF_INET6)); #endif #ifdef PF_UNSPEC - scm_c_define ("PF_UNSPEC", SCM_I_MAKINUM (PF_UNSPEC)); + scm_c_define ("PF_UNSPEC", scm_from_int (PF_UNSPEC)); #endif #ifdef PF_UNIX - scm_c_define ("PF_UNIX", SCM_I_MAKINUM (PF_UNIX)); + scm_c_define ("PF_UNIX", scm_from_int (PF_UNIX)); #endif #ifdef PF_INET - scm_c_define ("PF_INET", SCM_I_MAKINUM (PF_INET)); + scm_c_define ("PF_INET", scm_from_int (PF_INET)); #endif #ifdef PF_INET6 - scm_c_define ("PF_INET6", SCM_I_MAKINUM (PF_INET6)); + scm_c_define ("PF_INET6", scm_from_int (PF_INET6)); #endif /* standard addresses. */ @@ -1335,82 +1335,82 @@ scm_init_socket () /* socket types. */ #ifdef SOCK_STREAM - scm_c_define ("SOCK_STREAM", SCM_I_MAKINUM (SOCK_STREAM)); + scm_c_define ("SOCK_STREAM", scm_from_int (SOCK_STREAM)); #endif #ifdef SOCK_DGRAM - scm_c_define ("SOCK_DGRAM", SCM_I_MAKINUM (SOCK_DGRAM)); + scm_c_define ("SOCK_DGRAM", scm_from_int (SOCK_DGRAM)); #endif #ifdef SOCK_RAW - scm_c_define ("SOCK_RAW", SCM_I_MAKINUM (SOCK_RAW)); + scm_c_define ("SOCK_RAW", scm_from_int (SOCK_RAW)); #endif /* setsockopt level. */ #ifdef SOL_SOCKET - scm_c_define ("SOL_SOCKET", SCM_I_MAKINUM (SOL_SOCKET)); + scm_c_define ("SOL_SOCKET", scm_from_int (SOL_SOCKET)); #endif #ifdef SOL_IP - scm_c_define ("SOL_IP", SCM_I_MAKINUM (SOL_IP)); + scm_c_define ("SOL_IP", scm_from_int (SOL_IP)); #endif #ifdef SOL_TCP - scm_c_define ("SOL_TCP", SCM_I_MAKINUM (SOL_TCP)); + scm_c_define ("SOL_TCP", scm_from_int (SOL_TCP)); #endif #ifdef SOL_UDP - scm_c_define ("SOL_UDP", SCM_I_MAKINUM (SOL_UDP)); + scm_c_define ("SOL_UDP", scm_from_int (SOL_UDP)); #endif /* setsockopt names. */ #ifdef SO_DEBUG - scm_c_define ("SO_DEBUG", SCM_I_MAKINUM (SO_DEBUG)); + scm_c_define ("SO_DEBUG", scm_from_int (SO_DEBUG)); #endif #ifdef SO_REUSEADDR - scm_c_define ("SO_REUSEADDR", SCM_I_MAKINUM (SO_REUSEADDR)); + scm_c_define ("SO_REUSEADDR", scm_from_int (SO_REUSEADDR)); #endif #ifdef SO_STYLE - scm_c_define ("SO_STYLE", SCM_I_MAKINUM (SO_STYLE)); + scm_c_define ("SO_STYLE", scm_from_int (SO_STYLE)); #endif #ifdef SO_TYPE - scm_c_define ("SO_TYPE", SCM_I_MAKINUM (SO_TYPE)); + scm_c_define ("SO_TYPE", scm_from_int (SO_TYPE)); #endif #ifdef SO_ERROR - scm_c_define ("SO_ERROR", SCM_I_MAKINUM (SO_ERROR)); + scm_c_define ("SO_ERROR", scm_from_int (SO_ERROR)); #endif #ifdef SO_DONTROUTE - scm_c_define ("SO_DONTROUTE", SCM_I_MAKINUM (SO_DONTROUTE)); + scm_c_define ("SO_DONTROUTE", scm_from_int (SO_DONTROUTE)); #endif #ifdef SO_BROADCAST - scm_c_define ("SO_BROADCAST", SCM_I_MAKINUM (SO_BROADCAST)); + scm_c_define ("SO_BROADCAST", scm_from_int (SO_BROADCAST)); #endif #ifdef SO_SNDBUF - scm_c_define ("SO_SNDBUF", SCM_I_MAKINUM (SO_SNDBUF)); + scm_c_define ("SO_SNDBUF", scm_from_int (SO_SNDBUF)); #endif #ifdef SO_RCVBUF - scm_c_define ("SO_RCVBUF", SCM_I_MAKINUM (SO_RCVBUF)); + scm_c_define ("SO_RCVBUF", scm_from_int (SO_RCVBUF)); #endif #ifdef SO_KEEPALIVE - scm_c_define ("SO_KEEPALIVE", SCM_I_MAKINUM (SO_KEEPALIVE)); + scm_c_define ("SO_KEEPALIVE", scm_from_int (SO_KEEPALIVE)); #endif #ifdef SO_OOBINLINE - scm_c_define ("SO_OOBINLINE", SCM_I_MAKINUM (SO_OOBINLINE)); + scm_c_define ("SO_OOBINLINE", scm_from_int (SO_OOBINLINE)); #endif #ifdef SO_NO_CHECK - scm_c_define ("SO_NO_CHECK", SCM_I_MAKINUM (SO_NO_CHECK)); + scm_c_define ("SO_NO_CHECK", scm_from_int (SO_NO_CHECK)); #endif #ifdef SO_PRIORITY - scm_c_define ("SO_PRIORITY", SCM_I_MAKINUM (SO_PRIORITY)); + scm_c_define ("SO_PRIORITY", scm_from_int (SO_PRIORITY)); #endif #ifdef SO_LINGER - scm_c_define ("SO_LINGER", SCM_I_MAKINUM (SO_LINGER)); + scm_c_define ("SO_LINGER", scm_from_int (SO_LINGER)); #endif /* recv/send options. */ #ifdef MSG_OOB - scm_c_define ("MSG_OOB", SCM_I_MAKINUM (MSG_OOB)); + scm_c_define ("MSG_OOB", scm_from_int (MSG_OOB)); #endif #ifdef MSG_PEEK - scm_c_define ("MSG_PEEK", SCM_I_MAKINUM (MSG_PEEK)); + scm_c_define ("MSG_PEEK", scm_from_int (MSG_PEEK)); #endif #ifdef MSG_DONTROUTE - scm_c_define ("MSG_DONTROUTE", SCM_I_MAKINUM (MSG_DONTROUTE)); + scm_c_define ("MSG_DONTROUTE", scm_from_int (MSG_DONTROUTE)); #endif #ifdef __MINGW32__ diff --git a/libguile/sort.c b/libguile/sort.c index 3128ffa3d..35aea629f 100644 --- a/libguile/sort.c +++ b/libguile/sort.c @@ -592,8 +592,8 @@ SCM_DEFINE (scm_sort_x, "sort!", 2, 0, 0, len = SCM_VECTOR_LENGTH (items); scm_restricted_vector_sort_x (items, less, - SCM_I_MAKINUM (0L), - SCM_I_MAKINUM (len)); + scm_from_int (0), + scm_from_long (len)); return items; } else @@ -631,8 +631,8 @@ SCM_DEFINE (scm_sort, "sort", 2, 0, 0, scm_array_copy_x (items, sortvec); scm_restricted_vector_sort_x (sortvec, less, - SCM_I_MAKINUM (0L), - SCM_I_MAKINUM (len)); + scm_from_int (0), + scm_from_long (len)); return sortvec; } #endif diff --git a/libguile/srcprop.c b/libguile/srcprop.c index a237fb06c..72f2db490 100644 --- a/libguile/srcprop.c +++ b/libguile/srcprop.c @@ -141,8 +141,8 @@ scm_srcprops_to_plist (SCM obj) plist = scm_acons (scm_sym_copy, SRCPROPCOPY (obj), plist); if (!SCM_UNBNDP (SRCPROPFNAME (obj))) plist = scm_acons (scm_sym_filename, SRCPROPFNAME (obj), plist); - plist = scm_acons (scm_sym_column, SCM_I_MAKINUM (SRCPROPCOL (obj)), plist); - plist = scm_acons (scm_sym_line, SCM_I_MAKINUM (SRCPROPLINE (obj)), plist); + plist = scm_acons (scm_sym_column, scm_from_int (SRCPROPCOL (obj)), plist); + plist = scm_acons (scm_sym_line, scm_from_int (SRCPROPLINE (obj)), plist); plist = scm_acons (scm_sym_breakpoint, scm_from_bool (SRCPROPBRK (obj)), plist); return plist; } @@ -203,8 +203,8 @@ SCM_DEFINE (scm_source_property, "source-property", 2, 0, 0, if (!SRCPROPSP (p)) goto plist; if (SCM_EQ_P (scm_sym_breakpoint, key)) p = scm_from_bool (SRCPROPBRK (p)); - else if (SCM_EQ_P (scm_sym_line, key)) p = SCM_I_MAKINUM (SRCPROPLINE (p)); - else if (SCM_EQ_P (scm_sym_column, key)) p = SCM_I_MAKINUM (SRCPROPCOL (p)); + else if (SCM_EQ_P (scm_sym_line, key)) p = scm_from_int (SRCPROPLINE (p)); + else if (SCM_EQ_P (scm_sym_column, key)) p = scm_from_int (SRCPROPCOL (p)); else if (SCM_EQ_P (scm_sym_filename, key)) p = SRCPROPFNAME (p); else if (SCM_EQ_P (scm_sym_copy, key)) p = SRCPROPCOPY (p); else @@ -310,7 +310,7 @@ scm_init_srcprop () scm_set_smob_free (scm_tc16_srcprops, srcprops_free); scm_set_smob_print (scm_tc16_srcprops, srcprops_print); - scm_source_whash = scm_make_weak_key_hash_table (SCM_I_MAKINUM (2047)); + scm_source_whash = scm_make_weak_key_hash_table (scm_from_int (2047)); scm_c_define ("source-whash", scm_source_whash); #include "libguile/srcprop.x" diff --git a/libguile/stacks.c b/libguile/stacks.c index 483e3d4e5..8fd4dc8cc 100644 --- a/libguile/stacks.c +++ b/libguile/stacks.c @@ -457,7 +457,7 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1, size = n * SCM_FRAME_N_SLOTS; /* Make the stack object. */ - stack = scm_make_struct (scm_stack_type, SCM_I_MAKINUM (size), SCM_EOL); + stack = scm_make_struct (scm_stack_type, scm_from_long (size), SCM_EOL); SCM_STACK (stack) -> id = id; iframe = &SCM_STACK (stack) -> tail[0]; SCM_STACK (stack) -> frames = iframe; @@ -483,10 +483,10 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1, } narrow_stack (stack, - SCM_INUMP (inner_cut) ? SCM_INUM (inner_cut) : n, - SCM_INUMP (inner_cut) ? 0 : inner_cut, - SCM_INUMP (outer_cut) ? SCM_INUM (outer_cut) : n, - SCM_INUMP (outer_cut) ? 0 : outer_cut); + scm_is_integer (inner_cut) ? scm_to_int (inner_cut) : n, + scm_is_integer (inner_cut) ? 0 : inner_cut, + scm_is_integer (outer_cut) ? scm_to_int (outer_cut) : n, + scm_is_integer (outer_cut) ? 0 : outer_cut); n = SCM_STACK (stack) -> length; } @@ -562,7 +562,7 @@ SCM_DEFINE (scm_stack_length, "stack-length", 1, 0, 0, #define FUNC_NAME s_scm_stack_length { SCM_VALIDATE_STACK (1, stack); - return SCM_I_MAKINUM (SCM_STACK_LENGTH (stack)); + return scm_from_int (SCM_STACK_LENGTH (stack)); } #undef FUNC_NAME @@ -611,7 +611,7 @@ SCM_DEFINE (scm_last_stack_frame, "last-stack-frame", 1, 0, 0, if (!dframe || SCM_VOIDFRAMEP (*dframe)) return SCM_BOOL_F; - stack = scm_make_struct (scm_stack_type, SCM_I_MAKINUM (SCM_FRAME_N_SLOTS), + stack = scm_make_struct (scm_stack_type, scm_from_int (SCM_FRAME_N_SLOTS), SCM_EOL); SCM_STACK (stack) -> length = 1; SCM_STACK (stack) -> frames = &SCM_STACK (stack) -> tail[0]; @@ -628,7 +628,7 @@ SCM_DEFINE (scm_frame_number, "frame-number", 1, 0, 0, #define FUNC_NAME s_scm_frame_number { SCM_VALIDATE_FRAME (1, frame); - return SCM_I_MAKINUM (SCM_FRAME_NUMBER (frame)); + return scm_from_int (SCM_FRAME_NUMBER (frame)); } #undef FUNC_NAME @@ -673,11 +673,11 @@ SCM_DEFINE (scm_frame_previous, "frame-previous", 1, 0, 0, { unsigned long int n; SCM_VALIDATE_FRAME (1, frame); - n = SCM_INUM (SCM_CDR (frame)) + 1; + n = scm_to_ulong (SCM_CDR (frame)) + 1; if (n >= SCM_STACK_LENGTH (SCM_CAR (frame))) return SCM_BOOL_F; else - return scm_cons (SCM_CAR (frame), SCM_I_MAKINUM (n)); + return scm_cons (SCM_CAR (frame), scm_from_ulong (n)); } #undef FUNC_NAME @@ -689,11 +689,11 @@ SCM_DEFINE (scm_frame_next, "frame-next", 1, 0, 0, { unsigned long int n; SCM_VALIDATE_FRAME (1, frame); - n = SCM_INUM (SCM_CDR (frame)); + n = scm_to_ulong (SCM_CDR (frame)); if (n == 0) return SCM_BOOL_F; else - return scm_cons (SCM_CAR (frame), SCM_I_MAKINUM (n - 1)); + return scm_cons (SCM_CAR (frame), scm_from_ulong (n - 1)); } #undef FUNC_NAME diff --git a/libguile/stacks.h b/libguile/stacks.h index b15bf2ed0..4e68a67a5 100644 --- a/libguile/stacks.h +++ b/libguile/stacks.h @@ -53,18 +53,17 @@ SCM_API SCM scm_stack_type; #define SCM_FRAMEP(obj) \ (SCM_CONSP (obj) && SCM_STACKP (SCM_CAR (obj)) \ - && SCM_INUMP (SCM_CDR (obj)) && SCM_INUM (SCM_CDR (obj)) >= 0 \ - && ((unsigned long int) SCM_INUM (SCM_CDR (obj)) \ - < SCM_STACK_LENGTH (SCM_CAR (obj)))) + && scm_is_unsigned_integer (SCM_CDR (obj), \ + 0, SCM_STACK_LENGTH (SCM_CAR (obj))-1)) #define SCM_FRAME_REF(frame, slot) \ -(SCM_STACK (SCM_CAR (frame)) -> frames[SCM_INUM (SCM_CDR (frame))].slot) \ +(SCM_STACK (SCM_CAR (frame)) -> frames[scm_to_size_t (SCM_CDR (frame))].slot) #define SCM_FRAME_NUMBER(frame) \ (SCM_BACKWARDS_P \ - ? SCM_INUM (SCM_CDR (frame)) \ + ? scm_to_size_t (SCM_CDR (frame)) \ : (SCM_STACK_LENGTH (SCM_CAR (frame)) \ - - SCM_INUM (SCM_CDR (frame)) \ + - scm_to_size_t (SCM_CDR (frame)) \ - 1)) \ #define SCM_FRAME_FLAGS(frame) SCM_FRAME_REF (frame, flags) diff --git a/libguile/stime.c b/libguile/stime.c index 86fdab3ab..dcea1e237 100644 --- a/libguile/stime.c +++ b/libguile/stime.c @@ -124,10 +124,10 @@ SCM_DEFINE (scm_get_internal_real_time, "get-internal-real-time", 0, 0, 0, time_buffer.time -= scm_your_base.time; tmp = scm_long2num (time_buffer.millitm - scm_your_base.millitm); tmp = scm_sum (tmp, - scm_product (SCM_I_MAKINUM (1000), - SCM_I_MAKINUM (time_buffer.time))); + scm_product (scm_from_int (1000), + scm_from_int (time_buffer.time))); return scm_quotient (scm_product (tmp, SCM_I_MAKINUM (SCM_TIME_UNITS_PER_SECOND)), - SCM_I_MAKINUM (1000)); + scm_from_int (1000)); #else return scm_long2num((time((timet*)0) - scm_your_base) * (int)SCM_TIME_UNITS_PER_SECOND); #endif /* HAVE_FTIME */ @@ -243,7 +243,7 @@ SCM_DEFINE (scm_gettimeofday, "gettimeofday", 0, 0, 0, ftime(&time); return scm_cons (scm_long2num ((long) time.time), - SCM_I_MAKINUM (time.millitm * 1000)); + scm_from_int (time.millitm * 1000)); # else timet timv; @@ -251,7 +251,7 @@ SCM_DEFINE (scm_gettimeofday, "gettimeofday", 0, 0, 0, if ((timv = time (0)) == -1) SCM_SYSERROR; SCM_ALLOW_INTS; - return scm_cons (scm_long2num (timv), SCM_I_MAKINUM (0)); + return scm_cons (scm_long2num (timv), scm_from_int (0)); # endif #endif } @@ -262,16 +262,16 @@ filltime (struct tm *bd_time, int zoff, const char *zname) { SCM result = scm_c_make_vector (11, SCM_UNDEFINED); - SCM_VECTOR_SET (result,0, SCM_I_MAKINUM (bd_time->tm_sec)); - SCM_VECTOR_SET (result,1, SCM_I_MAKINUM (bd_time->tm_min)); - SCM_VECTOR_SET (result,2, SCM_I_MAKINUM (bd_time->tm_hour)); - SCM_VECTOR_SET (result,3, SCM_I_MAKINUM (bd_time->tm_mday)); - SCM_VECTOR_SET (result,4, SCM_I_MAKINUM (bd_time->tm_mon)); - SCM_VECTOR_SET (result,5, SCM_I_MAKINUM (bd_time->tm_year)); - SCM_VECTOR_SET (result,6, SCM_I_MAKINUM (bd_time->tm_wday)); - SCM_VECTOR_SET (result,7, SCM_I_MAKINUM (bd_time->tm_yday)); - SCM_VECTOR_SET (result,8, SCM_I_MAKINUM (bd_time->tm_isdst)); - SCM_VECTOR_SET (result,9, SCM_I_MAKINUM (zoff)); + SCM_VECTOR_SET (result,0, scm_from_int (bd_time->tm_sec)); + SCM_VECTOR_SET (result,1, scm_from_int (bd_time->tm_min)); + SCM_VECTOR_SET (result,2, scm_from_int (bd_time->tm_hour)); + SCM_VECTOR_SET (result,3, scm_from_int (bd_time->tm_mday)); + SCM_VECTOR_SET (result,4, scm_from_int (bd_time->tm_mon)); + SCM_VECTOR_SET (result,5, scm_from_int (bd_time->tm_year)); + SCM_VECTOR_SET (result,6, scm_from_int (bd_time->tm_wday)); + SCM_VECTOR_SET (result,7, scm_from_int (bd_time->tm_yday)); + SCM_VECTOR_SET (result,8, scm_from_int (bd_time->tm_isdst)); + SCM_VECTOR_SET (result,9, scm_from_int (zoff)); SCM_VECTOR_SET (result,10, zname ? scm_makfrom0str (zname) : SCM_BOOL_F); return result; } @@ -455,22 +455,22 @@ bdtime2c (SCM sbd_time, struct tm *lt, int pos, const char *subr) velts = SCM_VELTS (sbd_time); for (i = 0; i < 10; i++) { - SCM_ASSERT (SCM_INUMP (velts[i]), sbd_time, pos, subr); + SCM_ASSERT (scm_is_integer (velts[i]), sbd_time, pos, subr); } SCM_ASSERT (scm_is_false (velts[10]) || SCM_STRINGP (velts[10]), sbd_time, pos, subr); - lt->tm_sec = SCM_INUM (velts[0]); - lt->tm_min = SCM_INUM (velts[1]); - lt->tm_hour = SCM_INUM (velts[2]); - lt->tm_mday = SCM_INUM (velts[3]); - lt->tm_mon = SCM_INUM (velts[4]); - lt->tm_year = SCM_INUM (velts[5]); - lt->tm_wday = SCM_INUM (velts[6]); - lt->tm_yday = SCM_INUM (velts[7]); - lt->tm_isdst = SCM_INUM (velts[8]); + lt->tm_sec = scm_to_int (velts[0]); + lt->tm_min = scm_to_int (velts[1]); + lt->tm_hour = scm_to_int (velts[2]); + lt->tm_mday = scm_to_int (velts[3]); + lt->tm_mon = scm_to_int (velts[4]); + lt->tm_year = scm_to_int (velts[5]); + lt->tm_wday = scm_to_int (velts[6]); + lt->tm_yday = scm_to_int (velts[7]); + lt->tm_isdst = scm_to_int (velts[8]); #ifdef HAVE_TM_ZONE - lt->tm_gmtoff = SCM_INUM (velts[9]); + lt->tm_gmtoff = scm_to_int (velts[9]); if (scm_is_false (velts[10])) lt->tm_zone = NULL; else @@ -717,7 +717,8 @@ SCM_DEFINE (scm_strptime, "strptime", 2, 0, 0, } SCM_ALLOW_INTS; - return scm_cons (filltime (&t, 0, NULL), SCM_I_MAKINUM (rest - str)); + return scm_cons (filltime (&t, 0, NULL), + scm_from_signed_integer (rest - str)); } #undef FUNC_NAME #endif /* HAVE_STRPTIME */ diff --git a/libguile/strings.c b/libguile/strings.c index ad8486c1d..8d6b8b7b0 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -183,30 +183,20 @@ SCM_DEFINE (scm_make_string, "make-string", 1, 1, 0, "of the @var{string} are unspecified.") #define FUNC_NAME s_scm_make_string { - if (SCM_INUMP (k)) - { - long int i = SCM_INUM (k); - SCM res; - - SCM_ASSERT_RANGE (1, k, i >= 0); - - res = scm_allocate_string (i); - if (!SCM_UNBNDP (chr)) - { - unsigned char *dst; - - SCM_VALIDATE_CHAR (2, chr); - - dst = SCM_STRING_UCHARS (res); - memset (dst, SCM_CHAR (chr), i); - } + size_t i = scm_to_unsigned_integer (k, 0, SCM_STRING_MAX_LENGTH); + SCM res = scm_allocate_string (i); - return res; + if (!SCM_UNBNDP (chr)) + { + unsigned char *dst; + + SCM_VALIDATE_CHAR (2, chr); + + dst = SCM_STRING_UCHARS (res); + memset (dst, SCM_CHAR (chr), i); } - else if (SCM_BIGP (k)) - SCM_OUT_OF_RANGE (1, k); - else - SCM_WRONG_TYPE_ARG (1, k); + + return res; } #undef FUNC_NAME @@ -217,7 +207,7 @@ SCM_DEFINE (scm_string_length, "string-length", 1, 0, 0, #define FUNC_NAME s_scm_string_length { SCM_VALIDATE_STRING (1, string); - return SCM_I_MAKINUM (SCM_STRING_LENGTH (string)); + return scm_from_size_t (SCM_STRING_LENGTH (string)); } #undef FUNC_NAME diff --git a/libguile/strop.c b/libguile/strop.c index 415fd5068..0400870cc 100644 --- a/libguile/strop.c +++ b/libguile/strop.c @@ -61,27 +61,21 @@ scm_i_index (SCM *str, SCM chr, int direction, SCM sub_start, SCM_ASSERT (SCM_CHARP (chr), chr, SCM_ARG2, why); if (scm_is_false (sub_start)) - sub_start = SCM_I_MAKINUM (0); - - SCM_ASSERT (SCM_INUMP (sub_start), sub_start, SCM_ARG3, why); - lower = SCM_INUM (sub_start); - if (lower < 0 || lower > SCM_STRING_LENGTH (*str)) - scm_out_of_range (why, sub_start); + lower = 0; + else + lower = scm_to_signed_integer (sub_start, 0, SCM_STRING_LENGTH(*str)); if (scm_is_false (sub_end)) - sub_end = SCM_I_MAKINUM (SCM_STRING_LENGTH (*str)); - - SCM_ASSERT (SCM_INUMP (sub_end), sub_end, SCM_ARG4, why); - upper = SCM_INUM (sub_end); - if (upper < SCM_INUM (sub_start) || upper > SCM_STRING_LENGTH (*str)) - scm_out_of_range (why, sub_end); + upper = SCM_STRING_LENGTH (*str); + else + upper = scm_to_signed_integer (sub_end, lower, SCM_STRING_LENGTH(*str)); if (direction > 0) { p = SCM_STRING_UCHARS (*str) + lower; ch = SCM_CHAR (chr); - for (x = SCM_INUM (sub_start); x < upper; ++x, ++p) + for (x = lower; x < upper; ++x, ++p) if (*p == ch) return x; } @@ -124,7 +118,7 @@ SCM_DEFINE (scm_string_index, "string-index", 2, 2, 0, pos = scm_i_index (&str, chr, 1, frm, to, FUNC_NAME); return (pos < 0 ? SCM_BOOL_F - : SCM_I_MAKINUM (pos)); + : scm_from_long (pos)); } #undef FUNC_NAME @@ -154,7 +148,7 @@ SCM_DEFINE (scm_string_rindex, "string-rindex", 2, 2, 0, pos = scm_i_index (&str, chr, -1, frm, to, FUNC_NAME); return (pos < 0 ? SCM_BOOL_F - : SCM_I_MAKINUM (pos)); + : scm_from_long (pos)); } #undef FUNC_NAME diff --git a/libguile/strports.c b/libguile/strports.c index f718c07cb..30ce38509 100644 --- a/libguile/strports.c +++ b/libguile/strports.c @@ -250,13 +250,12 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller) { SCM z; scm_t_port *pt; - size_t str_len; + size_t str_len, c_pos; - SCM_ASSERT (SCM_INUMP(pos) && SCM_INUM(pos) >= 0, pos, SCM_ARG1, caller); SCM_ASSERT (SCM_STRINGP (str), str, SCM_ARG1, caller); str_len = SCM_STRING_LENGTH (str); - if (SCM_INUM (pos) > str_len) - scm_out_of_range (caller, pos); + c_pos = scm_to_unsigned_integer (pos, 0, str_len); + if (!((modes & SCM_WRTNG) || (modes & SCM_RDNG))) scm_misc_error ("scm_mkstrport", "port must read or write", SCM_EOL); @@ -266,7 +265,7 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller) SCM_SETSTREAM (z, SCM_UNPACK (str)); SCM_SET_CELL_TYPE(z, scm_tc16_strport|modes); pt->write_buf = pt->read_buf = SCM_STRING_UCHARS (str); - pt->read_pos = pt->write_pos = pt->read_buf + SCM_INUM (pos); + pt->read_pos = pt->write_pos = pt->read_buf + c_pos; pt->write_buf_size = pt->read_buf_size = str_len; pt->write_end = pt->read_end = pt->read_buf + pt->read_buf_size; diff --git a/libguile/struct.c b/libguile/struct.c index 3cc390784..6535064fd 100644 --- a/libguile/struct.c +++ b/libguile/struct.c @@ -114,7 +114,7 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0, { if (field_desc[x + 2] != '-') SCM_MISC_ERROR ("missing dash field at position ~A", - scm_list_1 (SCM_I_MAKINUM (x / 2))); + scm_list_1 (scm_from_int (x / 2))); x += 2; goto recheck_ref; } @@ -789,14 +789,14 @@ void scm_init_struct () { scm_struct_table - = scm_permanent_object (scm_make_weak_key_hash_table (SCM_I_MAKINUM (31))); + = scm_permanent_object (scm_make_weak_key_hash_table (scm_from_int (31))); required_vtable_fields = scm_makfrom0str ("prsrpw"); scm_permanent_object (required_vtable_fields); - scm_c_define ("vtable-index-layout", SCM_I_MAKINUM (scm_vtable_index_layout)); - scm_c_define ("vtable-index-vtable", SCM_I_MAKINUM (scm_vtable_index_vtable)); + scm_c_define ("vtable-index-layout", scm_from_int (scm_vtable_index_layout)); + scm_c_define ("vtable-index-vtable", scm_from_int (scm_vtable_index_vtable)); scm_c_define ("vtable-index-printer", - SCM_I_MAKINUM (scm_vtable_index_printer)); - scm_c_define ("vtable-offset-user", SCM_I_MAKINUM (scm_vtable_offset_user)); + scm_from_int (scm_vtable_index_printer)); + scm_c_define ("vtable-offset-user", scm_from_int (scm_vtable_offset_user)); #include "libguile/struct.x" } diff --git a/libguile/symbols.c b/libguile/symbols.c index 5fe06b269..1783a47bd 100644 --- a/libguile/symbols.c +++ b/libguile/symbols.c @@ -406,7 +406,7 @@ scm_c_symbol2str (SCM obj, char *str, size_t *lenp) void scm_symbols_prehistory () { - symbols = scm_make_weak_key_hash_table (SCM_I_MAKINUM (2139)); + symbols = scm_make_weak_key_hash_table (scm_from_int (2139)); scm_permanent_object (symbols); } diff --git a/libguile/tags.h b/libguile/tags.h index 82669e3cb..614d9e83f 100644 --- a/libguile/tags.h +++ b/libguile/tags.h @@ -384,7 +384,7 @@ typedef unsigned long scm_t_bits; /* Checking if a SCM variable holds an immediate integer: See numbers.h for * the definition of the following macros: SCM_I_FIXNUM_BIT, - * SCM_MOST_POSITIVE_FIXNUM, SCM_INUMP, SCM_I_MAKINUM, SCM_INUM. */ + * SCM_MOST_POSITIVE_FIXNUM, SCM_I_INUMP, SCM_I_MAKINUM, SCM_I_INUM. */ /* Checking if a SCM variable holds a pair (for historical reasons, in Guile * also known as a cons-cell): This is done by first checking that the SCM diff --git a/libguile/throw.c b/libguile/throw.c index c40000bdd..0f27e93a1 100644 --- a/libguile/throw.c +++ b/libguile/throw.c @@ -372,8 +372,8 @@ scm_exit_status (SCM args) { SCM cqa = SCM_CAR (args); - if (SCM_INUMP (cqa)) - return (SCM_INUM (cqa)); + if (scm_is_integer (cqa)) + return (scm_to_int (cqa)); else if (scm_is_false (cqa)) return 1; } diff --git a/libguile/unif.c b/libguile/unif.c index c383dd845..3d81b95c4 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -170,8 +170,8 @@ scm_make_uve (long k, SCM prot) return make_uve (scm_tc7_byvect, k, sizeof (char)); else if (SCM_CHARP (prot)) return scm_allocate_string (sizeof (char) * k); - else if (SCM_INUMP (prot)) - return make_uve (SCM_INUM (prot) > 0 ? scm_tc7_uvect : scm_tc7_ivect, + else if (SCM_I_INUMP (prot)) + return make_uve (SCM_I_INUM (prot) > 0 ? scm_tc7_uvect : scm_tc7_ivect, k, sizeof (long)); else if (SCM_FRACTIONP (prot)) @@ -218,11 +218,11 @@ SCM_DEFINE (scm_uniform_vector_length, "uniform-vector-length", 1, 0, 0, badarg1:SCM_WRONG_TYPE_ARG (1, v); case scm_tc7_vector: case scm_tc7_wvect: - return SCM_I_MAKINUM (SCM_VECTOR_LENGTH (v)); + return scm_from_size_t (SCM_VECTOR_LENGTH (v)); case scm_tc7_string: - return SCM_I_MAKINUM (SCM_STRING_LENGTH (v)); + return scm_from_size_t (SCM_STRING_LENGTH (v)); case scm_tc7_bvect: - return SCM_I_MAKINUM (SCM_BITVECTOR_LENGTH (v)); + return scm_from_size_t (SCM_BITVECTOR_LENGTH (v)); case scm_tc7_byvect: case scm_tc7_uvect: case scm_tc7_ivect: @@ -233,7 +233,7 @@ SCM_DEFINE (scm_uniform_vector_length, "uniform-vector-length", 1, 0, 0, #if SCM_SIZEOF_LONG_LONG != 0 case scm_tc7_llvect: #endif - return SCM_I_MAKINUM (SCM_UVECTOR_LENGTH (v)); + return scm_from_size_t (SCM_UVECTOR_LENGTH (v)); } } #undef FUNC_NAME @@ -280,10 +280,10 @@ SCM_DEFINE (scm_array_p, "array?", 1, 1, 0, protp = SCM_EQ_P (prot, SCM_MAKE_CHAR ('\0')); break; case scm_tc7_uvect: - protp = SCM_INUMP(prot) && SCM_INUM(prot)>0; + protp = SCM_I_INUMP(prot) && SCM_I_INUM(prot)>0; break; case scm_tc7_ivect: - protp = SCM_INUMP(prot) && SCM_INUM(prot)<=0; + protp = SCM_I_INUMP(prot) && SCM_I_INUM(prot)<=0; break; case scm_tc7_svect: protp = SCM_SYMBOLP (prot) @@ -347,10 +347,10 @@ SCM_DEFINE (scm_array_rank, "array-rank", 1, 0, 0, case scm_tc7_llvect: #endif case scm_tc7_svect: - return SCM_I_MAKINUM (1L); + return scm_from_int (1); case scm_tc7_smob: if (SCM_ARRAYP (ra)) - return SCM_I_MAKINUM (SCM_ARRAY_NDIM (ra)); + return scm_from_size_t (SCM_ARRAY_NDIM (ra)); return SCM_INUM0; } } @@ -397,10 +397,10 @@ SCM_DEFINE (scm_array_dimensions, "array-dimensions", 1, 0, 0, s = SCM_ARRAY_DIMS (ra); while (k--) res = scm_cons (s[k].lbnd - ? scm_cons2 (SCM_I_MAKINUM (s[k].lbnd), - SCM_I_MAKINUM (s[k].ubnd), + ? scm_cons2 (scm_from_long (s[k].lbnd), + scm_from_long (s[k].ubnd), SCM_EOL) - : SCM_I_MAKINUM (1 + s[k].ubnd), + : scm_from_long (1 + s[k].ubnd), res); return res; } @@ -425,7 +425,7 @@ SCM_DEFINE (scm_shared_array_offset, "shared-array-offset", 1, 0, 0, #define FUNC_NAME s_scm_shared_array_offset { SCM_ASSERT (SCM_ARRAYP (ra), ra, SCM_ARG1, FUNC_NAME); - return SCM_I_MAKINUM (SCM_ARRAY_BASE (ra)); + return scm_from_int (SCM_ARRAY_BASE (ra)); } #undef FUNC_NAME @@ -442,7 +442,7 @@ SCM_DEFINE (scm_shared_array_increments, "shared-array-increments", 1, 0, 0, k = SCM_ARRAY_NDIM (ra); s = SCM_ARRAY_DIMS (ra); while (k--) - res = scm_cons (SCM_I_MAKINUM (s[k].inc), res); + res = scm_cons (scm_from_long (s[k].inc), res); return res; } #undef FUNC_NAME @@ -460,19 +460,19 @@ scm_aind (SCM ra, SCM args, const char *what) register unsigned long pos = SCM_ARRAY_BASE (ra); register unsigned long k = SCM_ARRAY_NDIM (ra); scm_t_array_dim *s = SCM_ARRAY_DIMS (ra); - if (SCM_INUMP (args)) + if (scm_is_integer (args)) { if (k != 1) scm_error_num_args_subr (what); - return pos + (SCM_INUM (args) - s->lbnd) * (s->inc); + return pos + (scm_to_long (args) - s->lbnd) * (s->inc); } while (k && SCM_CONSP (args)) { ind = SCM_CAR (args); args = SCM_CDR (args); - if (!SCM_INUMP (ind)) + if (!scm_is_integer (ind)) scm_misc_error (what, s_bad_ind, SCM_EOL); - j = SCM_INUM (ind); + j = scm_to_long (ind); if (j < s->lbnd || j > s->ubnd) scm_out_of_range (what, ind); pos += (j - s->lbnd) * (s->inc); @@ -520,25 +520,25 @@ scm_shap2ra (SCM args, const char *what) for (; !SCM_NULLP (args); s++, args = SCM_CDR (args)) { spec = SCM_CAR (args); - if (SCM_INUMP (spec)) + if (scm_is_integer (spec)) { - if (SCM_INUM (spec) < 0) + if (scm_to_long (spec) < 0) scm_misc_error (what, s_bad_spec, SCM_EOL); s->lbnd = 0; - s->ubnd = SCM_INUM (spec) - 1; + s->ubnd = scm_to_long (spec) - 1; s->inc = 1; } else { - if (!SCM_CONSP (spec) || !SCM_INUMP (SCM_CAR (spec))) + if (!SCM_CONSP (spec) || !scm_is_integer (SCM_CAR (spec))) scm_misc_error (what, s_bad_spec, SCM_EOL); - s->lbnd = SCM_INUM (SCM_CAR (spec)); + s->lbnd = scm_to_long (SCM_CAR (spec)); sp = SCM_CDR (spec); if (!SCM_CONSP (sp) - || !SCM_INUMP (SCM_CAR (sp)) + || !scm_is_integer (SCM_CAR (sp)) || !SCM_NULLP (SCM_CDR (sp))) scm_misc_error (what, s_bad_spec, SCM_EOL); - s->ubnd = SCM_INUM (SCM_CAR (sp)); + s->ubnd = scm_to_long (SCM_CAR (sp)); s->inc = 1; } } @@ -559,13 +559,13 @@ SCM_DEFINE (scm_dimensions_to_uniform_array, "dimensions->uniform-array", 2, 1, scm_t_array_dim *s; SCM ra; - if (SCM_INUMP (dims)) + if (scm_is_integer (dims)) { - SCM answer = scm_make_uve (SCM_INUM (dims), prot); + SCM answer = scm_make_uve (scm_to_long (dims), prot); if (!SCM_UNBNDP (fill)) scm_array_fill_x (answer, fill); else if (SCM_SYMBOLP (prot)) - scm_array_fill_x (answer, SCM_I_MAKINUM (0)); + scm_array_fill_x (answer, scm_from_int (0)); else scm_array_fill_x (answer, prot); return answer; @@ -590,7 +590,7 @@ SCM_DEFINE (scm_dimensions_to_uniform_array, "dimensions->uniform-array", 2, 1, if (!SCM_UNBNDP (fill)) scm_array_fill_x (ra, fill); else if (SCM_SYMBOLP (prot)) - scm_array_fill_x (ra, SCM_I_MAKINUM (0)); + scm_array_fill_x (ra, scm_from_int (0)); else scm_array_fill_x (ra, prot); @@ -672,13 +672,13 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1, { SCM_ARRAY_V (ra) = oldra; old_min = 0; - old_max = SCM_INUM (scm_uniform_vector_length (oldra)) - 1; + old_max = scm_to_long (scm_uniform_vector_length (oldra)) - 1; } inds = SCM_EOL; s = SCM_ARRAY_DIMS (ra); for (k = 0; k < SCM_ARRAY_NDIM (ra); k++) { - inds = scm_cons (SCM_I_MAKINUM (s[k].lbnd), inds); + inds = scm_cons (scm_from_long (s[k].lbnd), inds); if (s[k].ubnd < s[k].lbnd) { if (1 == SCM_ARRAY_NDIM (ra)) @@ -693,14 +693,13 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1, i = (size_t) scm_aind (oldra, imap, FUNC_NAME); else { - if (SCM_NINUMP (imap)) - + if (!scm_is_integer (imap)) { - if (scm_ilength (imap) != 1 || !SCM_INUMP (SCM_CAR (imap))) + if (scm_ilength (imap) != 1 || !scm_is_integer (SCM_CAR (imap))) SCM_MISC_ERROR (s_bad_ind, SCM_EOL); imap = SCM_CAR (imap); } - i = SCM_INUM (imap); + i = scm_to_size_t (imap); } SCM_ARRAY_BASE (ra) = new_min = new_max = i; indptr = inds; @@ -709,20 +708,20 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1, { if (s[k].ubnd > s[k].lbnd) { - SCM_SETCAR (indptr, SCM_I_MAKINUM (SCM_INUM (SCM_CAR (indptr)) + 1)); + SCM_SETCAR (indptr, scm_sum (SCM_CAR (indptr), scm_from_int (1))); imap = scm_apply_0 (mapfunc, scm_reverse (inds)); if (SCM_ARRAYP (oldra)) s[k].inc = scm_aind (oldra, imap, FUNC_NAME) - i; else { - if (SCM_NINUMP (imap)) + if (!scm_is_integer (imap)) { - if (scm_ilength (imap) != 1 || !SCM_INUMP (SCM_CAR (imap))) + if (scm_ilength (imap) != 1 || !scm_is_integer (SCM_CAR (imap))) SCM_MISC_ERROR (s_bad_ind, SCM_EOL); imap = SCM_CAR (imap); } - s[k].inc = (long) SCM_INUM (imap) - i; + s[k].inc = scm_to_long (imap) - i; } i += s[k].inc; if (s[k].inc > 0) @@ -739,7 +738,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1, if (1 == SCM_ARRAY_NDIM (ra) && 0 == SCM_ARRAY_BASE (ra)) { SCM v = SCM_ARRAY_V (ra); - unsigned long int length = SCM_INUM (scm_uniform_vector_length (v)); + unsigned long int length = scm_to_ulong (scm_uniform_vector_length (v)); if (1 == s->inc && 0 == s->lbnd && length == 1 + s->ubnd) return v; if (s->ubnd < s->lbnd) @@ -812,11 +811,7 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1, ndim = 0; for (k = 0; k < SCM_ARRAY_NDIM (ra); k++) { - SCM_ASSERT (SCM_INUMP (ve[k]), ve[k], (SCM_ARG2 + k), - FUNC_NAME); - i = SCM_INUM (ve[k]); - if (i < 0 || i >= SCM_ARRAY_NDIM (ra)) - scm_out_of_range (FUNC_NAME, ve[k]); + i = scm_to_signed_integer (ve[k], 0, SCM_ARRAY_NDIM(ra)); if (ndim < i) ndim = i; } @@ -831,7 +826,7 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1, } for (k = SCM_ARRAY_NDIM (ra); k--;) { - i = SCM_INUM (ve[k]); + i = scm_to_int (ve[k]); s = &(SCM_ARRAY_DIMS (ra)[k]); r = &(SCM_ARRAY_DIMS (res)[i]); if (r->ubnd < r->lbnd) @@ -890,7 +885,7 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1, SCM_VALIDATE_REST_ARGUMENT (axes); if (SCM_NULLP (axes)) - axes = scm_cons ((SCM_ARRAYP (ra) ? SCM_I_MAKINUM (SCM_ARRAY_NDIM (ra) - 1) : SCM_INUM0), SCM_EOL); + axes = scm_cons ((SCM_ARRAYP (ra) ? scm_from_size_t (SCM_ARRAY_NDIM (ra) - 1) : SCM_INUM0), SCM_EOL); ninr = scm_ilength (axes); if (ninr < 0) SCM_WRONG_NUM_ARGS (); @@ -915,7 +910,7 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1, case scm_tc7_llvect: #endif s->lbnd = 0; - s->ubnd = SCM_INUM (scm_uniform_vector_length (ra)) - 1; + s->ubnd = scm_to_long (scm_uniform_vector_length (ra)) - 1; s->inc = 1; SCM_ARRAY_V (ra_inr) = ra; SCM_ARRAY_BASE (ra_inr) = 0; @@ -932,15 +927,15 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1, noutr = ndim - ninr; if (noutr < 0) SCM_WRONG_NUM_ARGS (); - axv = scm_make_string (SCM_I_MAKINUM (ndim), SCM_MAKE_CHAR (0)); + axv = scm_make_string (scm_from_int (ndim), SCM_MAKE_CHAR (0)); res = scm_make_ra (noutr); SCM_ARRAY_BASE (res) = SCM_ARRAY_BASE (ra_inr); SCM_ARRAY_V (res) = ra_inr; for (k = 0; k < ninr; k++, axes = SCM_CDR (axes)) { - if (!SCM_INUMP (SCM_CAR (axes))) + if (!scm_is_integer (SCM_CAR (axes))) SCM_MISC_ERROR ("bad axis", SCM_EOL); - j = SCM_INUM (SCM_CAR (axes)); + j = scm_to_int (SCM_CAR (axes)); SCM_ARRAY_DIMS (ra_inr)[k].lbnd = s[j].lbnd; SCM_ARRAY_DIMS (ra_inr)[k].ubnd = s[j].ubnd; SCM_ARRAY_DIMS (ra_inr)[k].inc = s[j].inc; @@ -981,8 +976,7 @@ SCM_DEFINE (scm_array_in_bounds_p, "array-in-bounds?", 1, 0, 1, { ind = SCM_CAR (args); args = SCM_CDR (args); - SCM_ASSERT (SCM_INUMP (ind), ind, SCM_ARG2, FUNC_NAME); - pos = SCM_INUM (ind); + pos = scm_to_long (ind); } tail: switch SCM_TYP7 (v) @@ -1002,7 +996,7 @@ tail: else while (!0) { - j = SCM_INUM (ind); + j = scm_to_long (ind); if (!(j >= (s->lbnd) && j <= (s->ubnd))) { SCM_ASRTGO (--k == scm_ilength (args), wna); @@ -1014,7 +1008,7 @@ tail: ind = SCM_CAR (args); args = SCM_CDR (args); s++; - if (!SCM_INUMP (ind)) + if (!scm_is_integer (ind)) SCM_MISC_ERROR (s_bad_ind, SCM_EOL); } SCM_ASRTGO (0 == k, wna); @@ -1035,8 +1029,8 @@ tail: case scm_tc7_vector: case scm_tc7_wvect: { - unsigned long int length = SCM_INUM (scm_uniform_vector_length (v)); - SCM_ASRTGO (SCM_NULLP (args) && SCM_INUMP (ind), wna); + unsigned long length = scm_to_ulong (scm_uniform_vector_length (v)); + SCM_ASRTGO (SCM_NULLP (args) && scm_is_integer (ind), wna); return scm_from_bool(pos >= 0 && pos < length); } } @@ -1071,15 +1065,15 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0, unsigned long int length; if (SCM_NIMP (args)) { - SCM_ASSERT (SCM_CONSP (args) && SCM_INUMP (SCM_CAR (args)), args, SCM_ARG2, FUNC_NAME); - pos = SCM_INUM (SCM_CAR (args)); + SCM_ASSERT (SCM_CONSP (args), args, SCM_ARG2, FUNC_NAME); + pos = scm_to_long (SCM_CAR (args)); SCM_ASRTGO (SCM_NULLP (SCM_CDR (args)), wna); } else { pos = scm_to_long (args); } - length = SCM_INUM (scm_uniform_vector_length (v)); + length = scm_to_ulong (scm_uniform_vector_length (v)); SCM_ASRTGO (pos >= 0 && pos < length, outrng); } switch SCM_TYP7 (v) @@ -1092,7 +1086,7 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0, /* not reached */ outrng: - scm_out_of_range (FUNC_NAME, SCM_I_MAKINUM (pos)); + scm_out_of_range (FUNC_NAME, scm_from_long (pos)); wna: SCM_WRONG_NUM_ARGS (); case scm_tc7_smob: @@ -1117,17 +1111,17 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0, case scm_tc7_string: return SCM_MAKE_CHAR (SCM_STRING_UCHARS (v)[pos]); case scm_tc7_byvect: - return SCM_I_MAKINUM (((char *) SCM_UVECTOR_BASE (v))[pos]); + return scm_from_char (((char *) SCM_UVECTOR_BASE (v))[pos]); case scm_tc7_uvect: - return scm_ulong2num (((unsigned long *) SCM_VELTS (v))[pos]); + return scm_from_ulong (((unsigned long *) SCM_VELTS (v))[pos]); case scm_tc7_ivect: - return scm_long2num (((signed long *) SCM_VELTS (v))[pos]); + return scm_from_long (((signed long *) SCM_VELTS (v))[pos]); case scm_tc7_svect: - return SCM_I_MAKINUM (((short *) SCM_CELL_WORD_1 (v))[pos]); + return scm_from_short (((short *) SCM_CELL_WORD_1 (v))[pos]); #if SCM_SIZEOF_LONG_LONG != 0 case scm_tc7_llvect: - return scm_long_long2num (((long long *) SCM_CELL_WORD_1 (v))[pos]); + return scm_from_long_long (((long long *) SCM_CELL_WORD_1 (v))[pos]); #endif case scm_tc7_fvect: @@ -1163,16 +1157,16 @@ scm_cvref (SCM v, unsigned long pos, SCM last) case scm_tc7_string: return SCM_MAKE_CHAR (SCM_STRING_UCHARS (v)[pos]); case scm_tc7_byvect: - return SCM_I_MAKINUM (((char *) SCM_UVECTOR_BASE (v))[pos]); + return scm_from_char (((char *) SCM_UVECTOR_BASE (v))[pos]); case scm_tc7_uvect: - return scm_ulong2num(((unsigned long *) SCM_VELTS (v))[pos]); + return scm_from_ulong (((unsigned long *) SCM_VELTS (v))[pos]); case scm_tc7_ivect: - return scm_long2num(((signed long *) SCM_VELTS (v))[pos]); + return scm_from_long (((signed long *) SCM_VELTS (v))[pos]); case scm_tc7_svect: - return SCM_I_MAKINUM (((short *) SCM_CELL_WORD_1 (v))[pos]); + return scm_from_short (((short *) SCM_CELL_WORD_1 (v))[pos]); #if SCM_SIZEOF_LONG_LONG != 0 case scm_tc7_llvect: - return scm_long_long2num (((long long *) SCM_CELL_WORD_1 (v))[pos]); + return scm_from_long_long (((long long *) SCM_CELL_WORD_1 (v))[pos]); #endif case scm_tc7_fvect: if (SCM_REALP (last) && !SCM_EQ_P (last, scm_flo0)) @@ -1244,15 +1238,14 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, unsigned long int length; if (SCM_CONSP (args)) { - SCM_ASSERT (SCM_INUMP (SCM_CAR (args)), args, SCM_ARG3, FUNC_NAME); SCM_ASRTGO (SCM_NULLP (SCM_CDR (args)), wna); - pos = SCM_INUM (SCM_CAR (args)); + pos = scm_to_long (SCM_CAR (args)); } else { pos = scm_to_long (args); } - length = SCM_INUM (scm_uniform_vector_length (v)); + length = scm_to_ulong (scm_uniform_vector_length (v)); SCM_ASRTGO (pos >= 0 && pos < length, outrng); } switch (SCM_TYP7 (v)) @@ -1261,7 +1254,7 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, SCM_WRONG_TYPE_ARG (1, v); /* not reached */ outrng: - scm_out_of_range (FUNC_NAME, SCM_I_MAKINUM (pos)); + scm_out_of_range (FUNC_NAME, scm_from_long (pos)); wna: SCM_WRONG_NUM_ARGS (); case scm_tc7_smob: /* enclosed */ @@ -1280,9 +1273,8 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, break; case scm_tc7_byvect: if (SCM_CHARP (obj)) - obj = SCM_I_MAKINUM ((char) SCM_CHAR (obj)); - SCM_ASRTGO (SCM_INUMP (obj), badobj); - ((char *) SCM_UVECTOR_BASE (v))[pos] = SCM_INUM (obj); + obj = scm_from_char ((char) SCM_CHAR (obj)); + ((char *) SCM_UVECTOR_BASE (v))[pos] = scm_to_char (obj); break; case scm_tc7_uvect: ((unsigned long *) SCM_UVECTOR_BASE (v))[pos] @@ -1293,8 +1285,7 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, = scm_num2long (obj, SCM_ARG2, FUNC_NAME); break; case scm_tc7_svect: - SCM_ASRTGO (SCM_INUMP (obj), badobj); - ((short *) SCM_UVECTOR_BASE (v))[pos] = SCM_INUM (obj); + ((short *) SCM_UVECTOR_BASE (v))[pos] = scm_to_short (obj); break; #if SCM_SIZEOF_LONG_LONG != 0 case scm_tc7_llvect: @@ -1390,7 +1381,7 @@ SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0, { SCM v = SCM_ARRAY_V (ra); - unsigned long int length = SCM_INUM (scm_uniform_vector_length (v)); + unsigned long length = scm_to_ulong (scm_uniform_vector_length (v)); if ((len == length) && 0 == SCM_ARRAY_BASE (ra) && SCM_ARRAY_DIMS (ra)->inc) return v; } @@ -1471,12 +1462,12 @@ SCM_DEFINE (scm_uniform_array_read_x, "uniform-array-read!", 1, 3, 0, if (SCM_UNBNDP (port_or_fd)) port_or_fd = scm_cur_inp; else - SCM_ASSERT (SCM_INUMP (port_or_fd) + SCM_ASSERT (scm_is_integer (port_or_fd) || (SCM_OPINPORTP (port_or_fd)), port_or_fd, SCM_ARG2, FUNC_NAME); vlen = (SCM_TYP7 (v) == scm_tc7_smob ? 0 - : SCM_INUM (scm_uniform_vector_length (v))); + : scm_to_long (scm_uniform_vector_length (v))); loop: switch SCM_TYP7 (v) @@ -1595,7 +1586,7 @@ loop: } else /* file descriptor. */ { - SCM_SYSCALL (ans = read (SCM_INUM (port_or_fd), + SCM_SYSCALL (ans = read (scm_to_int (port_or_fd), base + (cstart + offset) * sz, (sz * (cend - offset)))); if (ans == -1) @@ -1607,7 +1598,7 @@ loop: if (!SCM_EQ_P (v, ra) && !SCM_EQ_P (cra, ra)) scm_array_copy_x (cra, ra); - return SCM_I_MAKINUM (ans); + return scm_from_long (ans); } #undef FUNC_NAME @@ -1637,12 +1628,12 @@ SCM_DEFINE (scm_uniform_array_write, "uniform-array-write", 1, 3, 0, if (SCM_UNBNDP (port_or_fd)) port_or_fd = scm_cur_outp; else - SCM_ASSERT (SCM_INUMP (port_or_fd) + SCM_ASSERT (scm_is_integer (port_or_fd) || (SCM_OPOUTPORTP (port_or_fd)), port_or_fd, SCM_ARG2, FUNC_NAME); vlen = (SCM_TYP7 (v) == scm_tc7_smob ? 0 - : SCM_INUM (scm_uniform_vector_length (v))); + : scm_to_long (scm_uniform_vector_length (v))); loop: switch SCM_TYP7 (v) @@ -1729,7 +1720,7 @@ loop: } else /* file descriptor. */ { - SCM_SYSCALL (ans = write (SCM_INUM (port_or_fd), + SCM_SYSCALL (ans = write (scm_to_int (port_or_fd), base + (cstart + offset) * sz, (sz * (cend - offset)))); if (ans == -1) @@ -1738,7 +1729,7 @@ loop: if (SCM_TYP7 (v) == scm_tc7_bvect) ans *= SCM_LONG_BIT; - return SCM_I_MAKINUM (ans); + return scm_from_long (ans); } #undef FUNC_NAME @@ -1770,7 +1761,7 @@ SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0, w >>= 4; } if (i == 0) { - return SCM_I_MAKINUM (count); + return scm_from_ulong (count); } else { --i; w = SCM_UNPACK (SCM_VELTS (bitvector)[i]); @@ -1826,17 +1817,17 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0, switch (w & 0x0f) { default: - return SCM_I_MAKINUM (pos); + return scm_from_long (pos); case 2: case 6: case 10: case 14: - return SCM_I_MAKINUM (pos + 1); + return scm_from_long (pos + 1); case 4: case 12: - return SCM_I_MAKINUM (pos + 2); + return scm_from_long (pos + 2); case 8: - return SCM_I_MAKINUM (pos + 3); + return scm_from_long (pos + 3); case 0: pos += 4; w >>= 4; @@ -1897,7 +1888,7 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0, { k = SCM_UNPACK (SCM_VELTS (kv)[--i]); if (k >= vlen) - scm_out_of_range (FUNC_NAME, SCM_I_MAKINUM (k)); + scm_out_of_range (FUNC_NAME, scm_from_long (k)); SCM_BITVEC_CLR(v, k); } else if (SCM_EQ_P (obj, SCM_BOOL_T)) @@ -1905,7 +1896,7 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0, { k = SCM_UNPACK (SCM_VELTS (kv)[--i]); if (k >= vlen) - scm_out_of_range (FUNC_NAME, SCM_I_MAKINUM (k)); + scm_out_of_range (FUNC_NAME, scm_from_long (k)); SCM_BITVEC_SET(v, k); } else @@ -1967,7 +1958,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, { k = SCM_UNPACK (SCM_VELTS (kv)[--i]); if (k >= vlen) - scm_out_of_range (FUNC_NAME, SCM_I_MAKINUM (k)); + scm_out_of_range (FUNC_NAME, scm_from_long (k)); if (!SCM_BITVEC_REF(v, k)) count++; } @@ -1976,7 +1967,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, { k = SCM_UNPACK (SCM_VELTS (kv)[--i]); if (k >= vlen) - scm_out_of_range (FUNC_NAME, SCM_I_MAKINUM (k)); + scm_out_of_range (FUNC_NAME, scm_from_long (k)); if (SCM_BITVEC_REF (v, k)) count++; } @@ -1997,13 +1988,13 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, for (; k; k >>= 4) count += cnt_tab[k & 0x0f]; if (0 == i--) - return SCM_I_MAKINUM (count); + return scm_from_long (count); /* urg. repetitive (see above.) */ k = SCM_UNPACK (SCM_VELTS (kv)[i]) & (fObj ? SCM_UNPACK(SCM_VELTS (v)[i]) : ~SCM_UNPACK (SCM_VELTS (v)[i])); } } - return SCM_I_MAKINUM (count); + return scm_from_long (count); } #undef FUNC_NAME @@ -2080,7 +2071,7 @@ ra2l (SCM ra, unsigned long base, unsigned long k) do { i -= inc; - res = scm_cons (scm_uniform_vector_ref (SCM_ARRAY_V (ra), SCM_I_MAKINUM (i)), res); + res = scm_cons (scm_uniform_vector_ref (SCM_ARRAY_V (ra), scm_from_size_t (i)), res); } while (i != base); return res; @@ -2124,21 +2115,21 @@ SCM_DEFINE (scm_array_to_list, "array->list", 1, 0, 0, signed char *data = (signed char *) SCM_VELTS (v); unsigned long k = SCM_UVECTOR_LENGTH (v); while (k != 0) - res = scm_cons (SCM_I_MAKINUM (data[--k]), res); + res = scm_cons (scm_from_schar (data[--k]), res); return res; } case scm_tc7_uvect: { - long *data = (long *)SCM_VELTS(v); + unsigned long *data = (unsigned long *)SCM_VELTS(v); for (k = SCM_UVECTOR_LENGTH(v) - 1; k >= 0; k--) - res = scm_cons(scm_ulong2num(data[k]), res); + res = scm_cons(scm_from_ulong (data[k]), res); return res; } case scm_tc7_ivect: { long *data = (long *)SCM_VELTS(v); for (k = SCM_UVECTOR_LENGTH(v) - 1; k >= 0; k--) - res = scm_cons(scm_long2num(data[k]), res); + res = scm_cons(scm_from_long (data[k]), res); return res; } case scm_tc7_svect: @@ -2204,7 +2195,7 @@ SCM_DEFINE (scm_list_to_uniform_array, "list->uniform-array", 3, 0, 0, { n = scm_ilength (row); SCM_ASSERT (n >= 0, lst, SCM_ARG3, FUNC_NAME); - shp = scm_cons (SCM_I_MAKINUM (n), shp); + shp = scm_cons (scm_from_long (n), shp); if (SCM_NIMP (row)) row = SCM_CAR (row); } @@ -2218,9 +2209,9 @@ SCM_DEFINE (scm_list_to_uniform_array, "list->uniform-array", 3, 0, 0, } if (!SCM_ARRAYP (ra)) { - unsigned long int length = SCM_INUM (scm_uniform_vector_length (ra)); + unsigned long length = scm_to_ulong (scm_uniform_vector_length (ra)); for (k = 0; k < length; k++, lst = SCM_CDR (lst)) - scm_array_set_x (ra, SCM_CAR (lst), SCM_I_MAKINUM (k)); + scm_array_set_x (ra, SCM_CAR (lst), scm_from_ulong (k)); return ra; } if (l2ra (lst, ra, SCM_ARRAY_BASE (ra), 0)) @@ -2258,7 +2249,7 @@ l2ra (SCM lst, SCM ra, unsigned long base, unsigned long k) { if (!SCM_CONSP (lst)) return 0; - scm_array_set_x (SCM_ARRAY_V (ra), SCM_CAR (lst), SCM_I_MAKINUM (base)); + scm_array_set_x (SCM_ARRAY_V (ra), SCM_CAR (lst), scm_from_ulong (base)); base += inc; lst = SCM_CDR (lst); } @@ -2275,7 +2266,7 @@ rapr1 (SCM ra, unsigned long j, unsigned long k, SCM port, scm_print_state *psta long inc = 1; long n = (SCM_TYP7 (ra) == scm_tc7_smob ? 0 - : SCM_INUM (scm_uniform_vector_length (ra))); + : scm_to_long (scm_uniform_vector_length (ra))); int enclosed = 0; tail: switch SCM_TYP7 (ra) @@ -2325,7 +2316,7 @@ tail: default: /* scm_tc7_bvect and scm_tc7_llvect only? */ if (n-- > 0) - scm_iprin1 (scm_uniform_vector_ref (ra, SCM_I_MAKINUM (j)), port, pstate); + scm_iprin1 (scm_uniform_vector_ref (ra, scm_from_ulong (j)), port, pstate); for (j += inc; n-- > 0; j += inc) { scm_putc (' ', port); @@ -2568,9 +2559,9 @@ loop: case scm_tc7_byvect: return SCM_MAKE_CHAR ('\0'); case scm_tc7_uvect: - return SCM_I_MAKINUM (1L); + return scm_from_int (1); case scm_tc7_ivect: - return SCM_I_MAKINUM (-1L); + return scm_from_int (-1); case scm_tc7_svect: return scm_str2symbol ("s"); #if SCM_SIZEOF_LONG_LONG != 0 @@ -2613,8 +2604,8 @@ scm_init_unif () scm_set_smob_free (scm_tc16_array, array_free); scm_set_smob_print (scm_tc16_array, scm_raprin1); scm_set_smob_equalp (scm_tc16_array, scm_array_equal_p); - exactly_one_third = scm_permanent_object (scm_make_ratio (SCM_I_MAKINUM (1), - SCM_I_MAKINUM (3))); + exactly_one_third = scm_permanent_object (scm_make_ratio (scm_from_int (1), + scm_from_int (3))); scm_add_feature ("array"); #include "libguile/unif.x" } diff --git a/libguile/vectors.c b/libguile/vectors.c index 6aa9def6e..ea08b0c2a 100644 --- a/libguile/vectors.c +++ b/libguile/vectors.c @@ -46,7 +46,7 @@ scm_vector_length (SCM v) { SCM_GASSERT1 (SCM_VECTORP(v), g_vector_length, v, SCM_ARG1, s_vector_length); - return SCM_I_MAKINUM (SCM_VECTOR_LENGTH (v)); + return scm_from_size_t (SCM_VECTOR_LENGTH (v)); } SCM_REGISTER_PROC (s_list_to_vector, "list->vector", 1, 0, 0, scm_vector); @@ -114,10 +114,12 @@ scm_vector_ref (SCM v, SCM k) { SCM_GASSERT2 (SCM_VECTORP (v), g_vector_ref, v, k, SCM_ARG1, s_vector_ref); - SCM_GASSERT2 (SCM_INUMP (k), + SCM_GASSERT2 (SCM_I_INUMP (k), g_vector_ref, v, k, SCM_ARG2, s_vector_ref); - SCM_ASSERT_RANGE (2, k, SCM_INUM (k) < SCM_VECTOR_LENGTH (v) && SCM_INUM (k) >= 0); - return SCM_VELTS (v)[(long) SCM_INUM (k)]; + SCM_ASSERT_RANGE (2, k, + SCM_I_INUM (k) < SCM_VECTOR_LENGTH (v) + && SCM_I_INUM (k) >= 0); + return SCM_VELTS (v)[(long) SCM_I_INUM (k)]; } #undef FUNC_NAME @@ -141,11 +143,13 @@ scm_vector_set_x (SCM v, SCM k, SCM obj) SCM_GASSERTn (SCM_VECTORP (v), g_vector_set_x, scm_list_3 (v, k, obj), SCM_ARG1, s_vector_set_x); - SCM_GASSERTn (SCM_INUMP (k), + SCM_GASSERTn (SCM_I_INUMP (k), g_vector_set_x, scm_list_3 (v, k, obj), SCM_ARG2, s_vector_set_x); - SCM_ASSERT_RANGE (2, k, SCM_INUM (k) < SCM_VECTOR_LENGTH (v) && SCM_INUM (k) >= 0); - SCM_VECTOR_SET (v, (long) SCM_INUM(k), obj); + SCM_ASSERT_RANGE (2, k, + SCM_I_INUM (k) < SCM_VECTOR_LENGTH (v) + && SCM_I_INUM (k) >= 0); + SCM_VECTOR_SET (v, (long) SCM_I_INUM(k), obj); return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -159,18 +163,12 @@ SCM_DEFINE (scm_make_vector, "make-vector", 1, 1, 0, "unspecified.") #define FUNC_NAME s_scm_make_vector { + size_t l = scm_to_unsigned_integer (k, 0, SCM_VECTOR_MAX_LENGTH); + if (SCM_UNBNDP (fill)) fill = SCM_UNSPECIFIED; - - if (SCM_INUMP (k)) - { - SCM_ASSERT_RANGE (1, k, SCM_INUM (k) >= 0); - return scm_c_make_vector (SCM_INUM (k), fill); - } - else if (SCM_BIGP (k)) - SCM_OUT_OF_RANGE (1, k); - else - SCM_WRONG_TYPE_ARG (1, k); + + return scm_c_make_vector (l, fill); } #undef FUNC_NAME diff --git a/libguile/version.c b/libguile/version.c index 9c25cf608..3a811f01e 100644 --- a/libguile/version.c +++ b/libguile/version.c @@ -35,8 +35,8 @@ SCM_DEFINE (scm_major_version, "major-version", 0, 0, 0, "E.g., the 1 in \"1.6.5\".") #define FUNC_NAME s_scm_major_version { - return scm_number_to_string (SCM_I_MAKINUM(SCM_MAJOR_VERSION), - SCM_I_MAKINUM(10)); + return scm_number_to_string (scm_from_int (SCM_MAJOR_VERSION), + scm_from_int (10)); } #undef FUNC_NAME @@ -48,8 +48,8 @@ SCM_DEFINE (scm_minor_version, "minor-version", 0, 0, 0, "E.g., the 6 in \"1.6.5\".") #define FUNC_NAME s_scm_minor_version { - return scm_number_to_string (SCM_I_MAKINUM(SCM_MINOR_VERSION), - SCM_I_MAKINUM(10)); + return scm_number_to_string (scm_from_int (SCM_MINOR_VERSION), + scm_from_int (10)); } #undef FUNC_NAME @@ -61,8 +61,8 @@ SCM_DEFINE (scm_micro_version, "micro-version", 0, 0, 0, "E.g., the 5 in \"1.6.5\".") #define FUNC_NAME s_scm_micro_version { - return scm_number_to_string (SCM_I_MAKINUM(SCM_MICRO_VERSION), - SCM_I_MAKINUM(10)); + return scm_number_to_string (scm_from_int (SCM_MICRO_VERSION), + scm_from_int (10)); } #undef FUNC_NAME diff --git a/libguile/weaks.c b/libguile/weaks.c index 33df4519e..2b0eba6eb 100644 --- a/libguile/weaks.c +++ b/libguile/weaks.c @@ -75,46 +75,37 @@ SCM scm_i_allocate_weak_vector (scm_t_bits type, SCM size, SCM fill, const char* caller) #define FUNC_NAME caller { - if (SCM_INUMP (size)) - { - size_t c_size; - SCM v; - - SCM_ASSERT_RANGE (1, size, SCM_INUM (size) >= 0); - c_size = SCM_INUM (size); + size_t c_size; + SCM v; - if (c_size > 0) - { - scm_t_bits *base; - size_t j; - - if (SCM_UNBNDP (fill)) - fill = SCM_UNSPECIFIED; - - SCM_ASSERT_RANGE (1, size, c_size <= SCM_VECTOR_MAX_LENGTH); - base = scm_gc_malloc (c_size * sizeof (scm_t_bits), "weak vector"); - for (j = 0; j != c_size; ++j) - base[j] = SCM_UNPACK (fill); - v = scm_double_cell (SCM_MAKE_VECTOR_TAG (c_size, scm_tc7_wvect), - (scm_t_bits) base, - type, - SCM_UNPACK (SCM_EOL)); - scm_remember_upto_here_1 (fill); - } - else - { - v = scm_double_cell (SCM_MAKE_VECTOR_TAG (0, scm_tc7_wvect), - (scm_t_bits) NULL, - type, - SCM_UNPACK (SCM_EOL)); - } + c_size = scm_to_unsigned_integer (size, 0, SCM_VECTOR_MAX_LENGTH); - return v; + if (c_size > 0) + { + scm_t_bits *base; + size_t j; + + if (SCM_UNBNDP (fill)) + fill = SCM_UNSPECIFIED; + + base = scm_gc_malloc (c_size * sizeof (scm_t_bits), "weak vector"); + for (j = 0; j != c_size; ++j) + base[j] = SCM_UNPACK (fill); + v = scm_double_cell (SCM_MAKE_VECTOR_TAG (c_size, scm_tc7_wvect), + (scm_t_bits) base, + type, + SCM_UNPACK (SCM_EOL)); + scm_remember_upto_here_1 (fill); } - else if (SCM_BIGP (size)) - SCM_OUT_OF_RANGE (1, size); else - SCM_WRONG_TYPE_ARG (1, size); + { + v = scm_double_cell (SCM_MAKE_VECTOR_TAG (0, scm_tc7_wvect), + (scm_t_bits) NULL, + type, + SCM_UNPACK (SCM_EOL)); + } + + return v; } #undef FUNC_NAME @@ -150,7 +141,7 @@ SCM_DEFINE (scm_weak_vector, "weak-vector", 0, 0, 1, while the vector is being created. */ i = scm_ilength (l); SCM_ASSERT (i >= 0, l, SCM_ARG1, FUNC_NAME); - res = scm_make_weak_vector (SCM_I_MAKINUM (i), SCM_UNSPECIFIED); + res = scm_make_weak_vector (scm_from_int (i), SCM_UNSPECIFIED); /* no alloc, so this loop is safe. @@ -192,7 +183,7 @@ SCM_DEFINE (scm_make_weak_key_alist_vector, "make-weak-key-alist-vector", 0, 1, #define FUNC_NAME s_scm_make_weak_key_alist_vector { return scm_i_allocate_weak_vector - (1, SCM_UNBNDP (size) ? SCM_I_MAKINUM (31) : size, SCM_EOL, FUNC_NAME); + (1, SCM_UNBNDP (size) ? scm_from_int (31) : size, SCM_EOL, FUNC_NAME); } #undef FUNC_NAME @@ -204,7 +195,7 @@ SCM_DEFINE (scm_make_weak_value_alist_vector, "make-weak-value-alist-vector", 0, #define FUNC_NAME s_scm_make_weak_value_alist_vector { return scm_i_allocate_weak_vector - (2, SCM_UNBNDP (size) ? SCM_I_MAKINUM (31) : size, SCM_EOL, FUNC_NAME); + (2, SCM_UNBNDP (size) ? scm_from_int (31) : size, SCM_EOL, FUNC_NAME); } #undef FUNC_NAME @@ -216,7 +207,7 @@ SCM_DEFINE (scm_make_doubly_weak_alist_vector, "make-doubly-weak-alist-vector", #define FUNC_NAME s_scm_make_doubly_weak_alist_vector { return scm_i_allocate_weak_vector - (3, SCM_UNBNDP (size) ? SCM_I_MAKINUM (31) : size, SCM_EOL, FUNC_NAME); + (3, SCM_UNBNDP (size) ? scm_from_int (31) : size, SCM_EOL, FUNC_NAME); } #undef FUNC_NAME diff --git a/libguile/win32-socket.c b/libguile/win32-socket.c index 3d6cb6625..bc2d839de 100644 --- a/libguile/win32-socket.c +++ b/libguile/win32-socket.c @@ -614,9 +614,9 @@ scm_socket_symbols_Win32 (socket_error_t * e) if (e->error) { if (e->correct_str) - scm_c_define (e->correct_str, SCM_I_MAKINUM (e->error)); + scm_c_define (e->correct_str, scm_from_int (e->error)); if (e->replace && e->replace_str) - scm_c_define (e->replace_str, SCM_I_MAKINUM (e->replace)); + scm_c_define (e->replace_str, scm_from_int (e->replace)); } e++; } |