mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-16 08:40:19 +02:00
Code Activity

* deprecated.h, deprecated.c, numbers.h (SCM_INUMP, SCM_NINUMP,

Browse source 
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.
This commit is contained in:
Marius Vollmer 2004-07-23 15:43:02 +00:00
parent 928e0f4210
commit e11e83f3d9
59 changed files with 840 additions and 1172 deletions
Download patch file Download diff file Expand all files Collapse all files

15
libguile/ChangeLog
View file

@ -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

28
libguile/backtrace.c
View file

@ -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;

24
libguile/convert.i.c
View file

@ -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)

2
libguile/debug-malloc.c
View file

@ -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;
}

2
libguile/dynl.c
View file

@ -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

12
libguile/environments.c
View file

@ -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);

4
libguile/error.c
View file

@ -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);
}
}

50
libguile/eval.c
View file

@ -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);

2
libguile/feature.c
View file

@ -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"
}

30
libguile/filesys.c
View file

@ -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

8
libguile/fports.c
View file

@ -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"
}

4
libguile/futures.c
View file

@ -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

30
libguile/gc.c
View file

@ -191,18 +191,11 @@ 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))
{
long int f = SCM_INUM (flag);
if (f <= 0)
SCM_OUT_OF_RANGE (1, flag);
scm_debug_cells_gc_interval = f;
scm_debug_cell_accesses_p = 1;
scm_expensive_debug_cell_accesses_p = 1;
}
else
{
SCM_WRONG_TYPE_ARG (1, flag);
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;
}
return SCM_UNSPECIFIED;
}
@ -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);

10
libguile/gdbint.c
View file

@ -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);

32
libguile/gh_data.c
View file

@ -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

52
libguile/goops.c
View file

@ -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);

6
libguile/gsubr.c
View file

@ -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++) {

2
libguile/guardians.c
View file

@ -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"
}

12
libguile/hash.c
View file

@ -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) {
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)));
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 */

4
libguile/hashtab.c
View file

@ -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

6
libguile/hooks.c
View file

@ -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;
}

8
libguile/ioext.c
View file

@ -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

2
libguile/list.c
View file

@ -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

12
libguile/net_db.c
View file

@ -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;
}

39
libguile/num2float.i.c
View file

@ -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:
*/

264
libguile/num2integral.i.c
View file

@ -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:
*/

430
libguile/numbers.c
View file

File diff suppressed because it is too large Load diff

24
libguile/objects.c
View file

@ -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

12
libguile/options.c
View file

@ -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);

20
libguile/ports.c
View file

@ -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);

82
libguile/posix.c
View file

@ -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"

2
libguile/print.c
View file

@ -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))

4
libguile/procprop.c
View file

@ -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

2
libguile/procs.c
View file

@ -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

99
libguile/ramap.c
View file

@ -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))

14
libguile/random.c
View file

@ -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))));

4
libguile/read.c
View file

@ -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]

10
libguile/regex-posix.c
View file

@ -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)));

8
libguile/rw.c
View file

@ -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;

16
libguile/scmsigs.c
View file

@ -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"

4
libguile/simpos.c
View file

@ -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

76
libguile/socket.c
View file

@ -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__

8
libguile/sort.c
View file

@ -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

10
libguile/srcprop.c
View file

@ -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"

24
libguile/stacks.c
View file

@ -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

11
libguile/stacks.h
View file

@ -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)

55
libguile/stime.c
View file

@ -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 */

16
libguile/strings.c
View file

@ -183,14 +183,9 @@ 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;
size_t i = scm_to_unsigned_integer (k, 0, SCM_STRING_MAX_LENGTH);
SCM res = scm_allocate_string (i);
SCM_ASSERT_RANGE (1, k, i >= 0);
res = scm_allocate_string (i);
if (!SCM_UNBNDP (chr))
{
unsigned char *dst;
@ -202,11 +197,6 @@ SCM_DEFINE (scm_make_string, "make-string", 1, 1, 0,
}
return res;
}
else if (SCM_BIGP (k))
SCM_OUT_OF_RANGE (1, k);
else
SCM_WRONG_TYPE_ARG (1, k);
}
#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

24
libguile/strop.c
View file

@ -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

9
libguile/strports.c
View file

@ -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;

12
libguile/struct.c
View file

@ -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"
}

2
libguile/symbols.c
View file

@ -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);
}

2
libguile/tags.h
View file

@ -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

4
libguile/throw.c
View file

@ -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;
}

223
libguile/unif.c
View file

@ -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"
}

30
libguile/vectors.c
View file

@ -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

12
libguile/version.c
View file

@ -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

19
libguile/weaks.c
View file

@ -75,13 +75,10 @@ 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);
c_size = scm_to_unsigned_integer (size, 0, SCM_VECTOR_MAX_LENGTH);
if (c_size > 0)
{
@ -91,7 +88,6 @@ scm_i_allocate_weak_vector (scm_t_bits type, SCM size, SCM fill, const char* cal
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);
@ -110,11 +106,6 @@ scm_i_allocate_weak_vector (scm_t_bits type, SCM size, SCM fill, const char* cal
}
return v;
}
else if (SCM_BIGP (size))
SCM_OUT_OF_RANGE (1, size);
else
SCM_WRONG_TYPE_ARG (1, size);
}
#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

4
libguile/win32-socket.c
View file

@ -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++;
}