~ chicken-core (chicken-5) 79d654ec75d152cea1c7b79696bc0ab8d071aff4
commit 79d654ec75d152cea1c7b79696bc0ab8d071aff4
Author: Peter Bex <peter@more-magic.net>
AuthorDate: Fri May 19 13:05:46 2017 +0200
Commit: Evan Hanson <evhan@foldling.org>
CommitDate: Thu May 25 09:44:09 2017 +1200
Remove obsolete, unused numeric procedures
This just drops those primitives that have been unused but were only
still present for bootstrapping reasons.
Signed-off-by: Evan Hanson <evhan@foldling.org>
diff --git a/c-platform.scm b/c-platform.scm
index c34dc4fb..46beaa8e 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -802,7 +802,7 @@
;; -> (##core#inline "C_fixnum_shift_right" <x> -<int>)
;; (arithmetic-shift <x> <+int>)
;; -> (##core#inline "C_fixnum_shift_left" <x> <int>)
- ;; _ -> (##core#inline "C_a_i_arithmetic_shift" <x> <y>)
+ ;; _ -> (##core#inline "C_i_fixnum_arithmetic_shift" <x> <y>)
;;
;; not in fixnum-mode:
;; _ -> (##core#inline_allocate ("C_s_a_i_arithmetic_shift" 6) <x> <y>)
diff --git a/chicken.h b/chicken.h
index d9bcfab7..6addd311 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1364,8 +1364,6 @@ typedef void (C_ccall *C_proc)(C_word, C_word *) C_noret;
#define C_pointer_eqp(x, y) C_mk_bool(C_c_pointer_nn(x) == C_c_pointer_nn(y))
#define C_a_int_to_num(ptr, n, i) C_int_to_num(ptr, i)
#define C_a_unsigned_int_to_num(ptr, n, i) C_unsigned_int_to_num(ptr, i)
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-backend.scm */
-#define C_a_double_to_num(ptr, n) C_double_to_number(C_flonum(ptr, n))
#define C_a_i_vector C_vector
#define C_list C_a_i_list
#define C_i_setslot(x, i, y) (C_mutate2(&C_block_item(x, C_unfix(i)), y), C_SCHEME_UNDEFINED)
@@ -1426,12 +1424,6 @@ typedef void (C_ccall *C_proc)(C_word, C_word *) C_noret;
#define C_u_i_cdddar(x) C_u_i_cdr( C_u_i_cddar( x ) )
#define C_u_i_cddddr(x) C_u_i_cdr( C_u_i_cdddr( x ) )
-/* XXX TODO OBSOLETE: These 4 can be removed after recompiling c-platform.scm */
-#define C_a_i_times( ptr, n, x, y) C_2_times( ptr, x, y)
-#define C_a_i_plus( ptr, n, x, y) C_2_plus( ptr, x, y)
-#define C_a_i_minus( ptr, n, x, y) C_2_minus( ptr, x, y)
-#define C_a_i_divide(ptr, n, x, y) C_2_divide(ptr, x, y)
-
#ifdef HAVE_STATEMENT_EXPRESSIONS
# define C_i_not_pair_p(x) ({C_word tmp = (x); C_mk_bool(C_immediatep(tmp) || C_block_header(tmp) != C_PAIR_TAG);})
#else
@@ -1910,8 +1902,6 @@ C_fctexport C_cpsproc(C_u_call_with_values) C_noret;
C_fctexport C_cpsproc(C_times) C_noret;
C_fctexport C_cpsproc(C_plus) C_noret;
C_fctexport C_cpsproc(C_minus) C_noret;
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-C_fctexport C_cpsproc(C_divide) C_noret;
C_fctexport C_cpsproc(C_quotient_and_remainder) C_noret;
C_fctexport C_cpsproc(C_u_integer_quotient_and_remainder) C_noret;
C_fctexport C_cpsproc(C_bitwise_and) C_noret;
@@ -1928,8 +1918,6 @@ C_fctexport C_cpsproc(C_open_file_port) C_noret;
C_fctexport C_cpsproc(C_allocate_vector) C_noret;
C_fctexport C_cpsproc(C_string_to_symbol) C_noret;
C_fctexport C_cpsproc(C_build_symbol) C_noret;
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-C_fctexport C_cpsproc(C_quotient) C_noret;
C_fctexport C_cpsproc(C_number_to_string) C_noret;
C_fctexport C_cpsproc(C_fixnum_to_string) C_noret;
C_fctexport C_cpsproc(C_flonum_to_string) C_noret;
@@ -1973,8 +1961,6 @@ C_fctexport C_word C_a_i_string(C_word **a, int c, ...);
C_fctexport C_word C_a_i_record(C_word **a, int c, ...);
C_fctexport C_word C_a_i_port(C_word **a, int c);
C_fctexport C_word C_fcall C_a_i_bytevector(C_word **a, int c, C_word x) C_regparm;
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-C_fctexport C_word C_fcall C_a_i_abs(C_word **a, int c, C_word n) C_regparm;
C_fctexport C_word C_fcall C_i_listp(C_word x) C_regparm;
C_fctexport C_word C_fcall C_i_string_equal_p(C_word x, C_word y) C_regparm;
C_fctexport C_word C_fcall C_i_string_ci_equal_p(C_word x, C_word y) C_regparm;
@@ -2030,8 +2016,6 @@ C_fctexport C_word C_fcall C_i_memv(C_word x, C_word lst) C_regparm;
C_fctexport C_word C_fcall C_i_member(C_word x, C_word lst) C_regparm;
C_fctexport C_word C_fcall C_i_length(C_word lst) C_regparm;
C_fctexport C_word C_fcall C_u_i_length(C_word lst) C_regparm;
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-C_fctexport C_word C_fcall C_i_inexact_to_exact(C_word n) C_regparm;
C_fctexport C_word C_fcall C_i_check_closure_2(C_word x, C_word loc) C_regparm;
C_fctexport C_word C_fcall C_i_check_fixnum_2(C_word x, C_word loc) C_regparm;
C_fctexport C_word C_fcall C_i_check_exact_2(C_word x, C_word loc) C_regparm;
@@ -2048,14 +2032,6 @@ C_fctexport C_word C_fcall C_i_check_vector_2(C_word x, C_word loc) C_regparm;
C_fctexport C_word C_fcall C_i_check_structure_2(C_word x, C_word st, C_word loc) C_regparm;
C_fctexport C_word C_fcall C_i_check_char_2(C_word x, C_word loc) C_regparm;
C_fctexport C_word C_fcall C_i_check_port_2(C_word x, C_word in, C_word op, C_word loc) C_regparm;
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-C_fctexport C_word C_fcall C_2_times(C_word **ptr, C_word x, C_word y) C_regparm;
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-C_fctexport C_word C_fcall C_2_plus(C_word **ptr, C_word x, C_word y) C_regparm;
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-C_fctexport C_word C_fcall C_2_minus(C_word **ptr, C_word x, C_word y) C_regparm;
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-C_fctexport C_word C_fcall C_2_divide(C_word **ptr, C_word x, C_word y) C_regparm;
C_fctexport C_word C_fcall C_i_bignum_cmp(C_word x, C_word y) C_regparm;
C_fctexport C_word C_fcall C_i_nequalp(C_word x, C_word y) C_regparm;
C_fctexport C_word C_fcall C_i_integer_equalp(C_word x, C_word y) C_regparm;
@@ -2080,18 +2056,8 @@ C_fctexport C_word C_fcall C_a_i_locative_ref(C_word **a, int c, C_word loc) C_r
C_fctexport C_word C_fcall C_i_locative_set(C_word loc, C_word x) C_regparm;
C_fctexport C_word C_fcall C_i_locative_to_object(C_word loc) C_regparm;
C_fctexport C_word C_fcall C_a_i_make_locative(C_word **a, int c, C_word type, C_word object, C_word index, C_word weak) C_regparm;
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-C_fctexport C_word C_fcall C_a_i_bitwise_and(C_word **a, int c, C_word n1, C_word n2) C_regparm;
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-C_fctexport C_word C_fcall C_a_i_bitwise_ior(C_word **a, int c, C_word n1, C_word n2) C_regparm;
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-C_fctexport C_word C_fcall C_a_i_bitwise_not(C_word **a, int c, C_word n1) C_regparm;
C_fctexport C_word C_fcall C_i_bit_setp(C_word n, C_word i) C_regparm;
C_fctexport C_word C_fcall C_i_integer_length(C_word x) C_regparm;
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-C_fctexport C_word C_fcall C_a_i_bitwise_xor(C_word **a, int c, C_word n1, C_word n2) C_regparm;
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-C_fctexport C_word C_fcall C_a_i_arithmetic_shift(C_word **a, int c, C_word n1, C_word n2) C_regparm;
C_fctexport C_word C_fcall C_a_i_exp(C_word **a, int c, C_word n) C_regparm;
C_fctexport C_word C_fcall C_a_i_log(C_word **a, int c, C_word n) C_regparm;
C_fctexport C_word C_fcall C_a_i_sin(C_word **a, int c, C_word n) C_regparm;
@@ -2131,8 +2097,6 @@ C_fctexport C_word C_fcall C_i_tty_forcedp(void) C_regparm;
C_fctexport C_word C_fcall C_a_i_cpu_time(C_word **a, int c, C_word buf) C_regparm;
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-C_fctexport C_word C_fcall C_a_i_string_to_number(C_word **a, int c, C_word str, C_word radix) C_regparm;
C_fctexport C_word C_fcall C_a_i_exact_to_inexact(C_word **a, int c, C_word n) C_regparm;
C_fctexport C_word C_fcall C_i_file_exists_p(C_word name, C_word file, C_word dir) C_regparm;
@@ -2173,12 +2137,6 @@ C_fctexport C_word C_fcall C_i_foreign_pointer_argumentp(C_word x) C_regparm;
C_fctexport C_word C_fcall C_i_foreign_scheme_or_c_pointer_argumentp(C_word x) C_regparm;
/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
C_fctexport C_word C_fcall C_i_foreign_integer_argumentp(C_word x) C_regparm;
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-C_fctexport C_word C_fcall C_i_foreign_unsigned_integer_argumentp(C_word x) C_regparm;
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-C_fctexport C_word C_fcall C_i_foreign_integer64_argumentp(C_word x) C_regparm;
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-C_fctexport C_word C_fcall C_i_foreign_unsigned_integer64_argumentp(C_word x) C_regparm;
C_fctexport C_word C_fcall C_i_foreign_ranged_integer_argumentp(C_word x, C_word bits) C_regparm;
C_fctexport C_word C_fcall C_i_foreign_unsigned_ranged_integer_argumentp(C_word x, C_word bits) C_regparm;
@@ -2282,25 +2240,6 @@ inline static C_word C_string_to_pbytevector(C_word s)
}
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-inline static C_word C_flonum_in_fixnum_range_p(C_word n)
-{
- double f = C_flonum_magnitude(n);
-
- return C_mk_bool(f <= (double)C_MOST_POSITIVE_FIXNUM && f >= (double)C_MOST_NEGATIVE_FIXNUM);
-}
-
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-backend.scm */
-inline static C_word C_double_to_number(C_word n)
-{
- double m, f = C_flonum_magnitude(n);
-
- if(f <= (double)C_MOST_POSITIVE_FIXNUM
- && f >= (double)C_MOST_NEGATIVE_FIXNUM && C_modf(f, &m) == 0.0)
- return C_fix(f);
- else return n;
-}
-
inline static C_word C_a_i_record1(C_word **ptr, int n, C_word x1)
{
C_word *p = *ptr, *p0 = p;
@@ -2497,25 +2436,7 @@ inline static C_word C_i_bignump(C_word x)
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-inline static C_word C_fits_in_int_p(C_word x)
-{
- double n, m;
-
- if(x & C_FIXNUM_BIT) return C_SCHEME_TRUE;
-
- if(C_truep(C_i_bignump(x))) {
- return C_mk_bool(C_bignum_size(x) == 1 &&
- (!C_bignum_negativep(x) ||
- !(C_bignum_digits(x)[0] & C_INT_SIGN_BIT)));
- }
-
- n = C_flonum_magnitude(x);
- return C_mk_bool(C_modf(n, &m) == 0.0 && n >= C_WORD_MIN && n <= C_WORD_MAX);
-}
-
-
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
+/* XXX TODO OBSOLETE (but still used by C_flonum_to_string) */
inline static C_word C_fits_in_unsigned_int_p(C_word x)
{
double n, m;
@@ -2523,7 +2444,6 @@ inline static C_word C_fits_in_unsigned_int_p(C_word x)
if(x & C_FIXNUM_BIT) return C_SCHEME_TRUE;
if(C_truep(C_i_bignump(x))) return C_mk_bool(C_bignum_size(x) == 1);
- /* XXX OBSOLETE remove on the next round, remove check above */
n = C_flonum_magnitude(x);
return C_mk_bool(C_modf(n, &m) == 0.0 && n >= 0 && n <= C_UWORD_MAX);
}
diff --git a/library.scm b/library.scm
index d7a0580e..5daada94 100644
--- a/library.scm
+++ b/library.scm
@@ -5017,15 +5017,9 @@ EOF
(define (##sys#foreign-symbol-argument x) (##core#inline "C_i_foreign_symbol_argumentp" x))
(define (##sys#foreign-pointer-argument x) (##core#inline "C_i_foreign_pointer_argumentp" x))
(define (##sys#foreign-tagged-pointer-argument x tx) (##core#inline "C_i_foreign_tagged_pointer_argumentp" x tx))
+
+;; OBSOLETE (but still used by "enum"
(define (##sys#foreign-integer-argument x) (##core#inline "C_i_foreign_integer_argumentp" x))
-;; OBSOLETE
-(define (##sys#foreign-integer64-argument x) (##core#inline "C_i_foreign_integer64_argumentp" x))
-;; OBSOLETE
-(define (##sys#foreign-unsigned-integer-argument x)
- (##core#inline "C_i_foreign_unsigned_integer_argumentp" x))
-;; OBSOLETE
-(define (##sys#foreign-unsigned-integer64-argument x)
- (##core#inline "C_i_foreign_unsigned_integer64_argumentp" x))
(define (##sys#foreign-ranged-integer-argument obj size)
(##core#inline "C_i_foreign_ranged_integer_argumentp" obj size))
diff --git a/runtime.c b/runtime.c
index 1d6dedec..c13115ca 100644
--- a/runtime.c
+++ b/runtime.c
@@ -246,36 +246,6 @@ static C_TLS int timezone;
else v = C_flonum_magnitude(x);
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-#ifdef BITWISE_UINT_ONLY
-#define C_check_uint(x, f, n, w) if(((x) & C_FIXNUM_BIT) != 0) n = C_unfix(x); \
- else if(C_immediatep(x) || C_block_header(x) != C_FLONUM_TAG) \
- barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, w, x); \
- else { double _m; \
- f = C_flonum_magnitude(x); \
- if(modf(f, &_m) != 0.0 || f < 0 || f > C_UWORD_MAX) \
- barf(C_BAD_ARGUMENT_TYPE_NO_UINTEGER_ERROR, w, x); \
- else n = (C_uword)f; \
- }
-#else
-#define C_check_uint(x, f, n, w) if(((x) & C_FIXNUM_BIT) != 0) n = C_unfix(x); \
- else if(C_immediatep(x) || C_block_header(x) != C_FLONUM_TAG) \
- barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, w, x); \
- else { double _m; \
- f = C_flonum_magnitude(x); \
- if(modf(f, &_m) != 0.0 || f > C_UWORD_MAX) \
- barf(C_BAD_ARGUMENT_TYPE_NO_UINTEGER_ERROR, w, x); \
- else n = (C_uword)f; \
- }
-#endif
-
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-#ifdef C_SIXTY_FOUR
-#define C_limit_fixnum(n) ((n) & C_MOST_POSITIVE_FIXNUM)
-#else
-#define C_limit_fixnum(n) (n)
-#endif
-
#define C_pte(name) pt[ i ].id = #name; pt[ i++ ].ptr = (void *)name;
#ifndef SIGBUS
@@ -549,8 +519,6 @@ static C_word C_fcall lookup_bucket(C_word sym, C_SYMBOL_TABLE *stable) C_regpar
static double compute_symbol_table_load(double *avg_bucket_len, int *total);
static C_word C_fcall convert_string_to_number(C_char *str, int radix, C_word *fix, double *flo) C_regparm;
static C_regparm C_word str_to_bignum(C_word bignum, char *str, char *str_end, int radix);
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-static C_word C_fcall maybe_inexact_to_exact(C_word n) C_regparm;
static void C_fcall mark_system_globals(void) C_regparm;
static void C_fcall remark_system_globals(void) C_regparm;
static void C_fcall really_remark(C_word *x) C_regparm;
@@ -890,7 +858,7 @@ static C_PTABLE_ENTRY *create_initial_ptable()
{
/* IMPORTANT: hardcoded table size -
this must match the number of C_pte calls + 1 (NULL terminator)! */
- C_PTABLE_ENTRY *pt = (C_PTABLE_ENTRY *)C_malloc(sizeof(C_PTABLE_ENTRY) * 66);
+ C_PTABLE_ENTRY *pt = (C_PTABLE_ENTRY *)C_malloc(sizeof(C_PTABLE_ENTRY) * 64);
int i = 0;
if(pt == NULL)
@@ -917,15 +885,12 @@ static C_PTABLE_ENTRY *create_initial_ptable()
C_pte(C_times);
C_pte(C_minus);
C_pte(C_plus);
- /* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
- C_pte(C_divide);
C_pte(C_nequalp);
C_pte(C_greaterp);
/* IMPORTANT: have you read the comments at the start and the end of this function? */
C_pte(C_lessp);
C_pte(C_greater_or_equal_p);
C_pte(C_less_or_equal_p);
- C_pte(C_quotient);
C_pte(C_number_to_string);
C_pte(C_make_symbol);
C_pte(C_string_to_symbol);
@@ -5748,38 +5713,6 @@ C_regparm C_word C_fcall C_u_i_length(C_word lst)
return C_fix(n);
}
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-C_regparm C_word maybe_inexact_to_exact(C_word n)
-{
- double m;
- C_word r;
-
- if(modf(C_flonum_magnitude(n), &m) == 0.0) {
- r = (C_word)m;
-
- if(r == m && C_fitsinfixnump(r))
- return C_fix(r);
- }
- return C_SCHEME_FALSE;
-}
-
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-C_regparm C_word C_fcall C_i_inexact_to_exact(C_word n)
-{
- C_word r;
-
- if(n & C_FIXNUM_BIT) return n;
- else if(C_immediatep(n) || C_block_header(n) != C_FLONUM_TAG)
- barf(C_BAD_ARGUMENT_TYPE_ERROR, "inexact->exact", n);
-
- r = maybe_inexact_to_exact(n);
- if (r != C_SCHEME_FALSE) return r;
-
- barf(C_CANT_REPRESENT_INEXACT_ERROR, "inexact->exact", n);
- return 0;
-}
-
-
C_regparm C_word C_fcall C_i_set_car(C_word x, C_word val)
{
if(C_immediatep(x) || C_block_header(x) != C_PAIR_TAG)
@@ -5865,17 +5798,6 @@ void C_ccall C_signum(C_word c, C_word *av)
}
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-C_regparm C_word C_fcall C_a_i_abs(C_word **a, int c, C_word x)
-{
- if(x & C_FIXNUM_BIT) return C_fix(labs(C_unfix(x)));
-
- if(C_immediatep(x) || C_block_header(x) != C_FLONUM_TAG)
- barf(C_BAD_ARGUMENT_TYPE_ERROR, "abs", x);
-
- return C_flonum(a, fabs(C_flonum_magnitude(x)));
-}
-
/* The maximum this can allocate is a cplxnum which consists of two
* ratnums that consist of 2 fix bignums each. So that's
* C_SIZEOF_CPLXNUM + C_SIZEOF_RATNUM * 2 + C_SIZEOF_FIX_BIGNUM * 4 = 29 words!
@@ -5931,50 +5853,6 @@ C_s_a_u_i_integer_negate(C_word **ptr, C_word n, C_word x)
}
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-C_regparm C_word C_fcall C_a_i_bitwise_and(C_word **a, int c, C_word n1, C_word n2)
-{
- double f1, f2;
- C_uword nn1, nn2;
-
- C_check_uint(n1, f1, nn1, "bitwise-and");
- C_check_uint(n2, f2, nn2, "bitwise-and");
- nn1 = C_limit_fixnum(nn1 & nn2);
-
- if(C_ufitsinfixnump(nn1)) return C_fix(nn1);
- else return C_flonum(a, nn1);
-}
-
-
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-C_regparm C_word C_fcall C_a_i_bitwise_ior(C_word **a, int c, C_word n1, C_word n2)
-{
- double f1, f2;
- C_uword nn1, nn2;
-
- C_check_uint(n1, f1, nn1, "bitwise-ior");
- C_check_uint(n2, f2, nn2, "bitwise-ior");
- nn1 = C_limit_fixnum(nn1 | nn2);
-
- if(C_ufitsinfixnump(nn1)) return C_fix(nn1);
- else return C_flonum(a, nn1);
-}
-
-
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-C_regparm C_word C_fcall C_a_i_bitwise_xor(C_word **a, int c, C_word n1, C_word n2)
-{
- double f1, f2;
- C_uword nn1, nn2;
-
- C_check_uint(n1, f1, nn1, "bitwise-xor");
- C_check_uint(n2, f2, nn2, "bitwise-xor");
- nn1 = C_limit_fixnum(nn1 ^ nn2);
-
- if(C_ufitsinfixnump(nn1)) return C_fix(nn1);
- else return C_flonum(a, nn1);
-}
-
/* Faster version that ignores sign in bignums. TODO: Omit labs() too? */
inline static int integer_length_abs(C_word x)
{
@@ -6102,19 +5980,6 @@ C_regparm C_word C_fcall C_i_bit_setp(C_word n, C_word i)
}
}
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-C_regparm C_word C_fcall C_a_i_bitwise_not(C_word **a, int c, C_word n)
-{
- double f;
- C_uword nn;
-
- C_check_uint(n, f, nn, "bitwise-not");
- nn = C_limit_fixnum(~nn);
-
- if(C_ufitsinfixnump(nn)) return C_fix(nn);
- else return C_flonum(a, nn);
-}
-
C_regparm C_word C_fcall
C_s_a_i_bitwise_and(C_word **ptr, C_word n, C_word x, C_word y)
{
@@ -6353,65 +6218,6 @@ C_s_a_i_bitwise_not(C_word **ptr, C_word n, C_word x)
}
}
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-C_regparm C_word C_fcall C_a_i_arithmetic_shift(C_word **a, int c, C_word n1, C_word n2)
-{
- C_word nn;
- C_uword unn;
- C_word s;
- int sgn = 1;
-
- if((n1 & C_FIXNUM_BIT) != 0) {
- nn = C_unfix(n1);
-
- if((sgn = nn < 0 ? -1 : 1) >= 0) unn = nn;
- }
- else if(C_immediatep(n1) || C_block_header(n1) != C_FLONUM_TAG)
- barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "arithmetic-shift", n1);
- else {
- double m, f;
-
- f = C_flonum_magnitude(n1);
-
- if(C_isnan(f) || C_isinf(f) || C_modf(f, &m) != 0.0)
- barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, "arithmetic-shift", n1);
-
- if(f < C_WORD_MIN || f > C_UWORD_MAX)
- barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, "arithmetic-shift", n1);
- else if(f < 0) {
- if(f > C_WORD_MAX)
- barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, "arithmetic-shift", n1);
- else {
- sgn = -1;
- nn = (C_word)f;
- }
- }
- else if(f > C_WORD_MAX) unn = (C_uword)f;
- else {
- nn = (C_word)f;
- sgn = -1;
- }
- }
-
- if((n2 & C_FIXNUM_BIT) != 0) s = C_unfix(n2);
- else barf(C_BAD_ARGUMENT_TYPE_NO_FIXNUM_ERROR, "arithmetic-shift", n2);
-
- if(sgn < 0) {
- if(s < 0) nn >>= -s;
- else nn = (C_word)((C_uword)nn << s);
-
- if(C_fitsinfixnump(nn)) return C_fix(nn);
- else return C_flonum(a, nn);
- }
- else {
- if(s < 0) unn >>= -s;
- else unn <<= s;
-
- if(C_ufitsinfixnump(unn)) return C_fix(unn);
- else return C_flonum(a, unn);
- }
-}
-
C_regparm C_word C_fcall
C_s_a_i_arithmetic_shift(C_word **ptr, C_word n, C_word x, C_word y)
{
@@ -7033,7 +6839,6 @@ C_regparm C_word C_fcall C_i_foreign_ranged_integer_argumentp(C_word x, C_word b
}
}
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
C_regparm C_word C_fcall C_i_foreign_unsigned_ranged_integer_argumentp(C_word x, C_word bits)
{
if((x & C_FIXNUM_BIT) != 0) {
@@ -7073,83 +6878,6 @@ C_regparm C_word C_fcall C_i_foreign_integer_argumentp(C_word x)
}
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-C_regparm C_word C_fcall C_i_foreign_integer64_argumentp(C_word x)
-{
- double m, r;
-
- if((x & C_FIXNUM_BIT) != 0) return x;
-
- if(C_truep(C_i_bignump(x))) {
-#ifdef C_SIXTY_FOUR
- if (C_bignum_size(x) == 1) return x;
-#else
- if (C_bignum_size(x) <= 2) return x;
-#endif
- else barf(C_BAD_ARGUMENT_TYPE_FOREIGN_LIMITATION, NULL, x);
- }
-
- /* XXX OBSOLETE: This should be removed on the next round */
- if(!C_immediatep(x) && C_block_header(x) == C_FLONUM_TAG) {
- m = C_flonum_magnitude(x);
-
- if(m >= C_S64_MIN && m <= C_S64_MAX && C_modf(m, &r) == 0.0) return x;
- }
-
- barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, NULL, x);
- return C_SCHEME_UNDEFINED;
-}
-
-
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-C_regparm C_word C_fcall C_i_foreign_unsigned_integer_argumentp(C_word x)
-{
- double m ,r;
-
- if((x & C_FIXNUM_BIT) != 0) return x;
-
- if(C_truep(C_i_bignump(x))) {
- if (C_bignum_size(x) == 1) return x;
- else barf(C_BAD_ARGUMENT_TYPE_FOREIGN_LIMITATION, NULL, x);
- }
-
- if(!C_immediatep(x) && C_block_header(x) == C_FLONUM_TAG) {
- m = C_flonum_magnitude(x);
-
- if(m >= 0 && m <= C_UWORD_MAX && C_modf(m, &r) == 0.0) return x;
- }
-
- barf(C_BAD_ARGUMENT_TYPE_NO_UINTEGER_ERROR, NULL, x);
- return C_SCHEME_UNDEFINED;
-}
-
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-C_regparm C_word C_fcall C_i_foreign_unsigned_integer64_argumentp(C_word x)
-{
- double m, r;
-
- if((x & C_FIXNUM_BIT) != 0) return x;
-
- if(C_truep(C_i_bignump(x))) {
-#ifdef C_SIXTY_FOUR
- if (C_bignum_size(x) == 1) return x;
-#else
- if (C_bignum_size(x) <= 2) return x;
-#endif
- else barf(C_BAD_ARGUMENT_TYPE_FOREIGN_LIMITATION, NULL, x);
- }
-
- if(!C_immediatep(x) && C_block_header(x) == C_FLONUM_TAG) {
- m = C_flonum_magnitude(x);
-
- if(m >= 0 && m <= C_U64_MAX && C_modf(m, &r) == 0.0) return x;
- }
-
- barf(C_BAD_ARGUMENT_TYPE_NO_UINTEGER_ERROR, NULL, x);
- return C_SCHEME_UNDEFINED;
-}
-
-
/* I */
C_regparm C_word C_fcall C_i_not_pair_p_2(C_word x)
{
@@ -7879,35 +7607,6 @@ void C_ccall C_times(C_word c, C_word *av)
}
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-C_regparm C_word C_fcall C_2_times(C_word **ptr, C_word x, C_word y)
-{
- C_word iresult;
-
- if(x & C_FIXNUM_BIT) {
- if(y & C_FIXNUM_BIT) {
- iresult = C_i_o_fixnum_times(x, y);
-
- if(iresult == C_SCHEME_FALSE)
- return C_flonum(ptr, (double)C_unfix(x) * (double)C_unfix(y));
- else return iresult;
- }
- else if(!C_immediatep(y) && C_block_header(y) == C_FLONUM_TAG)
- return C_flonum(ptr, (double)C_unfix(x) * C_flonum_magnitude(y));
- else barf(C_BAD_ARGUMENT_TYPE_ERROR, "*", y);
- }
- else if(!C_immediatep(x) && C_block_header(x) == C_FLONUM_TAG) {
- if(y & C_FIXNUM_BIT)
- return C_flonum(ptr, C_flonum_magnitude(x) * (double)C_unfix(y));
- else if(!C_immediatep(y) && C_block_header(y) == C_FLONUM_TAG)
- return C_flonum(ptr, C_flonum_magnitude(x) * C_flonum_magnitude(y));
- else barf(C_BAD_ARGUMENT_TYPE_ERROR, "*", y);
- }
- else barf(C_BAD_ARGUMENT_TYPE_ERROR, "*", x);
- /* shutup compiler */
- return C_flonum(ptr, 0.0/0.0);
-}
-
static C_word bignum_plus_unsigned(C_word **ptr, C_word x, C_word y, C_word negp)
{
C_word size, result;
@@ -8213,35 +7912,6 @@ void C_ccall C_plus(C_word c, C_word *av)
C_kontinue(k, result);
}
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-C_regparm C_word C_fcall C_2_plus(C_word **ptr, C_word x, C_word y)
-{
- C_word iresult;
-
- if(x & C_FIXNUM_BIT) {
- if(y & C_FIXNUM_BIT) {
- iresult = C_i_o_fixnum_plus(x, y);
-
- if(iresult == C_SCHEME_FALSE)
- return C_flonum(ptr, (double)C_unfix(x) + (double)C_unfix(y));
- else return iresult;
- }
- else if(!C_immediatep(y) && C_block_header(y) == C_FLONUM_TAG)
- return C_flonum(ptr, (double)C_unfix(x) + C_flonum_magnitude(y));
- else barf(C_BAD_ARGUMENT_TYPE_ERROR, "+", y);
- }
- else if(!C_immediatep(x) && C_block_header(x) == C_FLONUM_TAG) {
- if(y & C_FIXNUM_BIT)
- return C_flonum(ptr, C_flonum_magnitude(x) + (double)C_unfix(y));
- else if(!C_immediatep(y) && C_block_header(y) == C_FLONUM_TAG)
- return C_flonum(ptr, C_flonum_magnitude(x) + C_flonum_magnitude(y));
- else barf(C_BAD_ARGUMENT_TYPE_ERROR, "+", y);
- }
- else barf(C_BAD_ARGUMENT_TYPE_ERROR, "+", x);
- /* shutup compiler */
- return C_flonum(ptr, 0.0/0.0);
-}
-
static C_word bignum_minus_unsigned(C_word **ptr, C_word x, C_word y)
{
C_word res, size;
@@ -8459,131 +8129,6 @@ void C_ccall C_minus(C_word c, C_word *av)
}
}
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-C_regparm C_word C_fcall C_2_minus(C_word **ptr, C_word x, C_word y)
-{
- C_word iresult;
-
- if(x & C_FIXNUM_BIT) {
- if(y & C_FIXNUM_BIT) {
- iresult = C_i_o_fixnum_difference(x, y);
-
- if(iresult == C_SCHEME_FALSE)
- return C_flonum(ptr, (double)C_unfix(x) - (double)C_unfix(y));
- else return iresult;
- }
- else if(!C_immediatep(y) && C_block_header(y) == C_FLONUM_TAG)
- return C_flonum(ptr, (double)C_unfix(x) - C_flonum_magnitude(y));
- else barf(C_BAD_ARGUMENT_TYPE_ERROR, "-", y);
- }
- else if(!C_immediatep(x) && C_block_header(x) == C_FLONUM_TAG) {
- if(y & C_FIXNUM_BIT)
- return C_flonum(ptr, C_flonum_magnitude(x) - (double)C_unfix(y));
- else if(!C_immediatep(y) && C_block_header(y) == C_FLONUM_TAG)
- return C_flonum(ptr, C_flonum_magnitude(x) - C_flonum_magnitude(y));
- else barf(C_BAD_ARGUMENT_TYPE_ERROR, "-", y);
- }
- else barf(C_BAD_ARGUMENT_TYPE_ERROR, "-", x);
- /* shutup compiler */
- return C_flonum(ptr, 0.0/0.0);
-}
-
-
-
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-void C_ccall C_divide(C_word c, C_word *av)
-{
- C_word
- /* closure = av[ 0 ] */
- k = av[ 1 ],
- n1, n2,
- iresult, n3;
- int fflag;
- double fresult, f2;
- C_alloc_flonum;
-
- if(c < 3) C_bad_min_argc(c, 3);
-
- n1 = av[ 2 ];
-
- if(n1 & C_FIXNUM_BIT) {
- iresult = C_unfix(n1);
- fflag = 0;
- }
- else if(!C_immediatep(n1) && C_block_header(n1) == C_FLONUM_TAG) {
- fresult = C_flonum_magnitude(n1);
- fflag = 1;
- }
- else barf(C_BAD_ARGUMENT_TYPE_ERROR, "/", n1);
-
- if(c == 3) {
- if(fflag) {
- if(fresult == 0) barf(C_DIVISION_BY_ZERO_ERROR, "/");
-
- fresult = 1.0 / fresult;
- }
- else {
- if(iresult == 0) barf(C_DIVISION_BY_ZERO_ERROR, "/");
- else if(iresult == 1) C_kontinue(k, C_fix(1));
-
- fresult = 1.0 / (double)iresult;
- fflag = 1;
- }
-
- goto cont;
- }
-
- c -= 3;
- av += 3;
-
- while(c--) {
- n1 = *(av++);
-
- if(n1 & C_FIXNUM_BIT) {
- if(fflag) {
- if((n1 = C_unfix(n1)) == 0)
- barf(C_DIVISION_BY_ZERO_ERROR, "/");
-
- fresult /= n1;
- }
- else {
- if((n2 = C_unfix(n1)) == 0)
- barf(C_DIVISION_BY_ZERO_ERROR, "/");
-
- n3 = iresult / n2;
-
- if((fresult = (double)iresult / (double)n2) != n3)
- fflag = 1;
- else iresult = n3;
- }
- }
- else if(!C_immediatep(n1) && C_block_header(n1) == C_FLONUM_TAG) {
- if(fflag) {
- if((f2 = C_flonum_magnitude(n1)) == 0)
- barf(C_DIVISION_BY_ZERO_ERROR, "/");
-
- fresult /= f2;
- }
- else {
- fflag = 1;
-
- if((f2 = C_flonum_magnitude(n1)) == 0)
- barf(C_DIVISION_BY_ZERO_ERROR, "/");
-
- fresult = (double)iresult / f2;
- }
- }
- else barf(C_BAD_ARGUMENT_TYPE_ERROR, "/", n1);
- }
-
- cont:
- if(fflag) {
- C_kontinue_flonum(k, fresult);
- }
- else n1 = C_fix(iresult);
-
- C_kontinue(k, n1);
-}
static C_regparm void
integer_divrem(C_word **ptr, C_word x, C_word y, C_word *q, C_word *r)
@@ -9183,52 +8728,6 @@ bignum_divide_unsigned(C_word **ptr, C_word num, C_word denom, C_word *q, C_word
}
}
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-C_regparm C_word C_fcall C_2_divide(C_word **ptr, C_word x, C_word y)
-{
- C_word iresult;
- double fresult;
- int fflag = 0;
-
- if(x & C_FIXNUM_BIT) {
- if(y & C_FIXNUM_BIT) {
- if((iresult = C_unfix(y)) == 0) barf(C_DIVISION_BY_ZERO_ERROR, "/");
-
- fresult = (double)C_unfix(x) / (double)iresult;
- iresult = C_unfix(x) / iresult;
- }
- else if(!C_immediatep(y) && C_block_header(y) == C_FLONUM_TAG) {
- if((fresult = C_flonum_magnitude(y)) == 0.0)
- barf(C_DIVISION_BY_ZERO_ERROR, "/");
-
- fresult = (double)C_unfix(x) / fresult;
- fflag = 1;
- }
- else barf(C_BAD_ARGUMENT_TYPE_ERROR, "/", y);
- }
- else if(!C_immediatep(x) && C_block_header(x) == C_FLONUM_TAG) {
- fflag = 1;
-
- if(y & C_FIXNUM_BIT) {
- fresult = C_flonum_magnitude(x);
-
- if((iresult = C_unfix(y)) == 0) barf(C_DIVISION_BY_ZERO_ERROR, "/");
-
- fresult = fresult / (double)iresult;
- }
- else if(!C_immediatep(y) && C_block_header(y) == C_FLONUM_TAG) {
- if((fresult = C_flonum_magnitude(y)) == 0.0) barf(C_DIVISION_BY_ZERO_ERROR, "/");
-
- fresult = C_flonum_magnitude(x) / fresult;
- }
- else barf(C_BAD_ARGUMENT_TYPE_ERROR, "/", y);
- }
- else barf(C_BAD_ARGUMENT_TYPE_ERROR, "/", x);
-
- if(fflag || (double)iresult != fresult) return C_flonum(ptr, fresult);
- else return C_fix(iresult);
-}
-
/* Compare two numbers as ratnums. Either may be rat-, fix- or bignums */
static C_word rat_cmp(C_word x, C_word y)
{
@@ -10695,205 +10194,6 @@ C_s_a_u_i_integer_gcd(C_word **ptr, C_word n, C_word x, C_word y)
}
-/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
-void C_ccall C_quotient(C_word c, C_word *av)
-{
- C_word
- /* closure = av[ 0 ] */
- k = av[ 1 ],
- n1, n2;
- double f1, f2, r;
- C_word result;
- C_alloc_flonum;
-
- if(c != 4) C_bad_argc(c, 4);
-
- n1 = av[ 2 ];
- n2 = av[ 3 ];
-
- if(n1 &C_FIXNUM_BIT) {
- if(n2 &C_FIXNUM_BIT) {
- if((n2 = C_unfix(n2)) == 0)
- barf(C_DIVISION_BY_ZERO_ERROR, "quotient");
-
- result = C_fix(C_unfix(n1) / n2);
- C_kontinue(k, result);
- }
- else if(!C_immediatep(n2) && C_block_header(n2) == C_FLONUM_TAG) {
- f1 = (double)C_unfix(n1);
- f2 = C_flonum_magnitude(n2);
- if(C_isnan(f2) || C_isinf(f2) || C_modf(f2, &r) != 0.0)
- barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, "quotient", n2);
- }
- else barf(C_BAD_ARGUMENT_TYPE_ERROR, "quotient", n2);
- }
- else if(!C_immediatep(n1) && C_block_header(n1) == C_FLONUM_TAG) {
- f1 = C_flonum_magnitude(n1);
- if(C_isnan(f1) || C_isinf(f1) || C_modf(f1, &r) != 0.0)
- barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, "quotient", n1);
-
- if(n2 &C_FIXNUM_BIT)
- f2 = (double)C_unfix(n2);
- else if(!C_immediatep(n2) && C_block_header(n2) == C_FLONUM_TAG) {
- f2 = C_flonum_magnitude(n2);
- if(C_isnan(f2) || C_isinf(f2) || C_modf(f2, &r) != 0.0)
- barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, "quotient", n2);
- }
- else barf(C_BAD_ARGUMENT_TYPE_ERROR, "quotient", n2);
- }
- else barf(C_BAD_ARGUMENT_TYPE_ERROR, "quotient", n1);
-
- if(f2 == 0)
- barf(C_DIVISION_BY_ZERO_ERROR, "quotient");
-
- modf(f1 / f2, &r);
- C_kontinue_flonum(k, r);
-}
-
-
-/* TODO OBSOLETE XXX: This needs to go, but still translated by c-platform */
-C_regparm C_word C_fcall
-C_a_i_string_to_number(C_word **a, int c, C_word str, C_word radix0)
-{
- int radix, radixpf = 0, sharpf = 0, ratf = 0, exactf = 0, exactpf = 0, periodf = 0, expf = 0;
- C_word n1, n;
- C_char *sptr, *eptr, *rptr;
- double fn1, fn;
-
- if(radix0 & C_FIXNUM_BIT) radix = C_unfix(radix0);
- else barf(C_BAD_ARGUMENT_TYPE_BAD_BASE_ERROR, "string->number", radix0);
-
- if (radix < 2 || radix > 36) /* Makes no sense and isn't supported */
- barf(C_BAD_ARGUMENT_TYPE_BAD_BASE_ERROR, "string->number", radix0);
-
- if(C_immediatep(str) || C_header_bits(str) != C_STRING_TYPE)
- barf(C_BAD_ARGUMENT_TYPE_ERROR, "string->number", str);
-
- if((n = C_header_size(str)) == 0) {
- fail:
- n = C_SCHEME_FALSE;
- goto fini;
- }
-
- if(n >= STRING_BUFFER_SIZE - 1) goto fail;
-
- C_memcpy(sptr = buffer, C_c_string(str), n > (STRING_BUFFER_SIZE - 1) ? STRING_BUFFER_SIZE : n);
- buffer[ n ] = '\0';
- if (n != strlen(buffer)) /* Don't barf; this is simply invalid number syntax */
- goto fail;
-
- while(*sptr == '#') {
- switch(C_tolower((int)*(++sptr))) {
- case 'b': if(radixpf) goto fail; else { radix = 2; radixpf = 1; } break;
- case 'o': if(radixpf) goto fail; else { radix = 8; radixpf = 1; } break;
- case 'd': if(radixpf) goto fail; else { radix = 10; radixpf = 1; } break;
- case 'x': if(radixpf) goto fail; else { radix = 16; radixpf = 1; } break;
- case 'e': if(exactpf) goto fail; else { exactf = 1; exactpf = 1; } break;
- case 'i': if(exactpf) goto fail; else { exactf = 0; exactpf = 1; } break;
- default: goto fail; /* Unknown prefix type */
- }
-
- ++sptr;
- }
-
- /* Scan for embedded special characters and do basic sanity checking: */
- for(eptr = sptr, rptr = sptr; *eptr != '\0'; ++eptr) {
- switch(C_tolower((int)*eptr)) {
- case '.':
- if(periodf || ratf || expf) goto fail;
-
- periodf = 1;
- break;
-
- case '#':
- if (expf || (eptr == rptr) ||
- (!sharpf && (eptr == rptr+1) && (C_strchr("+-.", *rptr) != NULL)))
- goto fail;
-
- sharpf = 1;
- *eptr = '0';
-
- break;
- case '/':
- if(periodf || ratf || expf || eptr == sptr) goto fail;
-
- sharpf = 0; /* Allow sharp signs in the denominator */
- ratf = 1;
- rptr = eptr+1;
- break;
- case 'e':
- case 'd':
- case 'f':
- case 'l':
- case 's':
- /* Don't set exp flag if we see the "f" in "inf.0" (preceded by 'n') */
- /* Other failure modes are handled elsewhere. */
- if(radix == 10 && eptr > sptr && C_tolower((int)*(eptr-1)) != 'n') {
- if (ratf) goto fail;
-
- expf = 1;
- sharpf = 0;
- *eptr = 'e'; /* strtod() normally only understands 'e', not dfls */
- }
- break;
- default:
- if(sharpf) goto fail;
- break;
- }
- }
- if (eptr == rptr) goto fail; /* Disallow "empty" numbers like "#x" and "1/" */
-
- /* check for rational representation: */
- if(rptr != sptr) {
- if (*(rptr) == '-' || *(rptr) == '+') {
- n = C_SCHEME_FALSE;
- goto fini;
- }
- *(rptr-1) = '\0';
-
- switch(convert_string_to_number(sptr, radix, &n1, &fn1)) {
- case 0:
- n = C_SCHEME_FALSE;
- goto fini;
-
- case 1:
- fn1 = (double)n1;
- break;
-
- /* case 2: nop */
- }
-
- sptr = rptr;
- }
-
- /* convert number and return result: */
- switch(convert_string_to_number(sptr, radix, &n, &fn)) {
- case 0: /* failed */
- n = C_SCHEME_FALSE;
- break;
-
- case 1: /* fixnum */
- if(sharpf || ratf || (exactpf && !exactf)) {
- n = C_flonum(a, ratf ? fn1 / (double)n : (double)n);
-
- if(exactpf && exactf) n = maybe_inexact_to_exact(n);
- }
- else n = C_fix(n);
-
- break;
-
- case 2: /* flonum */
- n = C_flonum(a, ratf ? fn1 / fn : fn);
-
- if(exactpf && exactf) n = maybe_inexact_to_exact(n);
-
- break;
- }
-
- fini:
- return n;
-}
-
C_regparm C_word C_fcall
C_s_a_i_digits_to_integer(C_word **ptr, C_word n, C_word str, C_word start, C_word end, C_word radix, C_word negp)
{
Trap