diff options
| -rw-r--r-- | eval.c | 6 | ||||
| -rw-r--r-- | eval.h | 1 | ||||
| -rw-r--r-- | itypes.c | 5 | ||||
| -rw-r--r-- | itypes.h | 1 | ||||
| -rw-r--r-- | lib.c | 109 | ||||
| -rw-r--r-- | lib.h | 9 | ||||
| -rw-r--r-- | mpi/mpi-config.h | 4 | ||||
| -rw-r--r-- | mpi/mpi.c | 18 | ||||
| -rw-r--r-- | utf8.c | 10 |
9 files changed, 23 insertions, 140 deletions
@@ -593,12 +593,6 @@ loc lookup_var_l(val env, val sym) return if3(binding, cdr_l(binding), nulloc); } -loc lookup_global_var_l(val sym) -{ - val binding = lookup_global_var(sym); - return if3(binding, cdr_l(binding), nulloc); -} - static val lookup_mac(val menv, val sym); val lookup_fun(val env, val sym) @@ -55,7 +55,6 @@ val env_vbind(val env, val sym, val obj); val lookup_var(val env, val sym); val lookup_global_var(val sym); loc lookup_var_l(val env, val sym); -loc lookup_global_var_l(val sym); val lookup_fun(val env, val sym); val lookup_sym_lisp1(val env, val sym); val set_dyn_env(val de); @@ -193,11 +193,6 @@ char c_char(val n, val self) #endif } -signed char c_schar(val n, val self) -{ - return c_i8(n, self); -} - unsigned char c_uchar(val n, val self) { return c_u8(n, self); @@ -106,7 +106,6 @@ val unum_64(u64_t n); #endif char c_char(val, val self); -signed char c_schar(val, val self); unsigned char c_uchar(val, val self); short c_short(val, val self); @@ -125,7 +125,6 @@ val wrap_k, reflect_k; val null_string; val nil_string; -val null_list; val identity_f, identity_star_f; val equal_f, eql_f, eq_f, car_f, cdr_f, null_f; @@ -4487,19 +4486,6 @@ void rcyc_cons(val cons) recycled_conses = cons; } -void rcyc_list(val list) -{ - if (list) { - val rl_orig = recycled_conses; - recycled_conses = list; - - while (list->c.cdr) - list = list->c.cdr; - - list->c.cdr = rl_orig; - } -} - void rcyc_empty(void) { recycled_conses = nil; @@ -6409,12 +6395,6 @@ val lequal(val left, val right) return or2(equal(left, right), less(left, right)); } -val gequal(val left, val right) -{ - uses_or2; - return or2(equal(left, right), less(right, left)); -} - val lessv(val first, struct args *rest) { cnum index = 0; @@ -7693,45 +7673,6 @@ val func_n5v(val (*fun)(val, val, val, val, val, varg)) return obj; } -val func_n6v(val (*fun)(val, val, val, val, val, val, varg)) -{ - val obj = make_obj(); - obj->f.type = FUN; - obj->f.functype = N6; - obj->f.env = nil; - obj->f.f.n6v = fun; - obj->f.variadic = 1; - obj->f.fixparam = 6; - obj->f.optargs = 0; - return obj; -} - -val func_n7v(val (*fun)(val, val, val, val, val, val, val, varg)) -{ - val obj = make_obj(); - obj->f.type = FUN; - obj->f.functype = N7; - obj->f.env = nil; - obj->f.f.n7v = fun; - obj->f.variadic = 1; - obj->f.fixparam = 7; - obj->f.optargs = 0; - return obj; -} - -val func_n8v(val (*fun)(val, val, val, val, val, val, val, val, varg)) -{ - val obj = make_obj(); - obj->f.type = FUN; - obj->f.functype = N8; - obj->f.env = nil; - obj->f.f.n8v = fun; - obj->f.variadic = 1; - obj->f.fixparam = 8; - obj->f.optargs = 0; - return obj; -} - val func_n1o(val (*fun)(val), int reqargs) { val obj = func_n1(fun); @@ -8618,16 +8559,6 @@ val pa_123_1(val fun3, val arg2, val arg3) return func_f1(cons(fun3, cons(arg2, arg3)), do_pa_123_1); } -static val do_pa_123_23(val fcons, val arg2, val arg3) -{ - return funcall3(car(fcons), cdr(fcons), arg2, arg3); -} - -val pa_123_23(val fun3, val arg1) -{ - return func_f2(cons(fun3, arg1), do_pa_123_23); -} - static val do_pa_1234_1(val fcons, val arg1) { cons_bind (fun, dr, fcons); @@ -8828,25 +8759,6 @@ static val do_or(val fun1_list, struct args *args_in) return ret; } -val orf(val first_fun, ...) -{ - va_list vl; - list_collect_decl (out, iter); - - if (first_fun != nao) { - val next_fun; - va_start (vl, first_fun); - iter = list_collect(iter, first_fun); - - while ((next_fun = va_arg(vl, val)) != nao) - iter = list_collect(iter, next_fun); - - va_end (vl); - } - - return func_f0v(out, do_or); -} - val orv(struct args *funlist) { return func_f0v(args_get_list(funlist), do_or); @@ -10028,24 +9940,6 @@ val aconsql_new(val key, val value, val list) } } -val aconsql_new_c(val key, loc new_p, loc list) -{ - val existing = assql(key, deref(list)); - - if (existing) { - if (!nullocp(new_p)) - deref(new_p) = nil; - return existing; - } else { - val nc = cons(key, nil); - set(list, cons(nc, deref(list))); - if (!nullocp(new_p)) - deref(new_p) = t; - return nc; - } -} - - static val alist_remove_test(val item, val key) { return equal(car(item), key); @@ -13114,7 +13008,7 @@ static void obj_init(void) protect(&packages, &system_package, &keyword_package, &user_package, &public_package, - &null_list, &equal_f, &eq_f, &eql_f, + &equal_f, &eq_f, &eql_f, &car_f, &cdr_f, &null_f, &list_f, &identity_f, &identity_star_f, &less_f, &greater_f, &prog_string, &cobj_hash, @@ -13122,7 +13016,6 @@ static void obj_init(void) nil_string = lit("nil"); null_string = lit(""); - null_list = cons(nil, nil); hash_s = make_sym(lit("hash")); system_package = make_package(lit("sys"), nil); @@ -556,7 +556,6 @@ extern val rplaca_s, rplacd_s, seq_iter_s; extern val nothrow_k, args_k, colon_k, auto_k, fun_k; extern val null_string; -extern val null_list; /* (nil) */ extern val identity_f, identity_star_f; extern val equal_f, eql_f, eq_f, car_f, cdr_f, null_f; @@ -748,7 +747,6 @@ val make_lazy_cons_pub(val func, val car, val cdr); val lcons_car(val lcons); val lcons_cdr(val lcons); void rcyc_cons(val cons); -void rcyc_list(val list); void rcyc_empty(void); val lcons_fun(val lcons); INLINE val us_lcons_fun(val lcons) { return lcons->lc.func; } @@ -940,7 +938,6 @@ val flo_int(val i); val less(val left, val right); val greater(val left, val right); val lequal(val left, val right); -val gequal(val left, val right); val lessv(val first, struct args *rest); val greaterv(val first, struct args *rest); val lequalv(val first, struct args *rest); @@ -1032,9 +1029,6 @@ val func_n2v(val (*fun)(val, val, varg)); val func_n3v(val (*fun)(val, val, val, varg)); val func_n4v(val (*fun)(val, val, val, val, varg)); val func_n5v(val (*fun)(val, val, val, val, val, varg)); -val func_n6v(val (*fun)(val, val, val, val, val, val, varg)); -val func_n7v(val (*fun)(val, val, val, val, val, val, val, varg)); -val func_n8v(val (*fun)(val, val, val, val, val, val, val, val, varg)); val func_n1o(val (*fun)(val), int reqargs); val func_n2o(val (*fun)(val, val), int reqargs); val func_n3o(val (*fun)(val, val, val), int reqargs); @@ -1078,7 +1072,6 @@ val pa_12_1(val fun2, val arg2); val pa_123_3(val fun3, val arg1, val arg2); val pa_123_2(val fun3, val arg1, val arg3); val pa_123_1(val fun3, val arg2, val arg3); -val pa_123_23(val fun3, val arg1); val pa_1234_1(val fun4, val arg2, val arg3, val arg4); val pa_1234_34(val fun3, val arg1, val arg2); val chain(val first_fun, ...); @@ -1087,7 +1080,6 @@ val chandv(struct args *funlist); val juxtv(struct args *funlist); val andf(val first_fun, ...); val andv(struct args *funlist); -val orf(val first_fun, ...); val orv(struct args *funlist); val notf(val fun); val nandv(struct args *funlist); @@ -1158,7 +1150,6 @@ val acons(val car, val cdr, val list); val acons_new(val key, val value, val list); val acons_new_c(val key, loc new_p, loc list); val aconsql_new(val key, val value, val list); -val aconsql_new_c(val key, loc new_p, loc list); val alist_remove(val list, val keys); val alist_removev(val list, struct args *keys); val alist_remove1(val list, val key); diff --git a/mpi/mpi-config.h b/mpi/mpi-config.h index e3574aef..19ee91bb 100644 --- a/mpi/mpi-config.h +++ b/mpi/mpi-config.h @@ -8,6 +8,10 @@ #define MP_MODARITH 1 /* include modular arithmetic ? */ #endif +#ifndef MP_FOR_TXR +#define MP_FOR_TXR 1 +#endif + #ifndef MP_NUMTH #define MP_NUMTH 1 /* include number theoretic functions? */ #endif @@ -150,6 +150,7 @@ int s_mp_tovalue(wchar_t ch, int r); /* convert ch to value */ char s_mp_todigit(int val, int r, int low); /* convert val to digit */ size_t s_mp_outlen(mp_size bits, int r); /* output length in bytes */ +#if !MP_FOR_TXR unsigned int mp_get_prec(void) { return s_mp_defprec; @@ -162,6 +163,7 @@ void mp_set_prec(unsigned int prec) else s_mp_defprec = prec; } +#endif /* Initialize a new zero-valued mp_int. Returns MP_OKAY if successful, * MP_MEM if memory could not be allocated for the structure. @@ -171,6 +173,7 @@ mp_err mp_init(mp_int *mp) return mp_init_size(mp, s_mp_defprec); } +#if !MP_FOR_TXR mp_err mp_init_array(mp_int mp[], int count) { mp_err res; @@ -191,6 +194,7 @@ mp_err mp_init_array(mp_int mp[], int count) return res; } +#endif /* Initialize a new zero-valued mp_int with at least the given * precision; returns MP_OKAY if successful, or MP_MEM if memory could @@ -323,6 +327,7 @@ void mp_clear(mp_int *mp) ALLOC(mp) = 0; } +#if !MP_FOR_TXR void mp_clear_array(mp_int mp[], int count) { ARGCHK(mp != NULL && count > 0, MP_BADARG); @@ -330,6 +335,7 @@ void mp_clear_array(mp_int mp[], int count) while (--count >= 0) mp_clear(&mp[count]); } +#endif /* Set mp to zero. Does not change the allocated size of the structure, * and therefore cannot fail (except on a bad argument, which we ignore) @@ -621,6 +627,7 @@ int mp_in_double_uintptr_range(mp_int *mp) #endif +#if !MP_FOR_TXR mp_err mp_set_word(mp_int *mp, mp_word w, int sign) { USED(mp) = 2; @@ -629,6 +636,7 @@ mp_err mp_set_word(mp_int *mp, mp_word w, int sign) SIGN(mp) = sign; return MP_OKAY; } +#endif /* Compute the sum b = a + d, for a single digit d. Respects the sign of * its primary addend (single digits are unsigned anyway). @@ -1574,6 +1582,7 @@ mp_err mp_exptmod(mp_int *a, mp_int *b, mp_int *m, mp_int *c) return res; } +#if !MP_FOR_TXR mp_err mp_exptmod_d(mp_int *a, mp_digit d, mp_int *m, mp_int *c) { mp_int s, x; @@ -1611,6 +1620,7 @@ X: return res; } +#endif #endif /* if MP_MODARITH */ @@ -1626,6 +1636,7 @@ int mp_cmp_z(mp_int *a) } /* Compare a <=> d. Returns <0 if a<d, 0 if a=d, >0 if a>d */ +#if !MP_FOR_TXR int mp_cmp_d(mp_int *a, mp_digit d) { ARGCHK(a != NULL, MP_EQ); @@ -1635,6 +1646,7 @@ int mp_cmp_d(mp_int *a, mp_digit d) return s_mp_cmp_d(a, d); } +#endif int mp_cmp(mp_int *a, mp_int *b) { @@ -1658,6 +1670,7 @@ int mp_cmp(mp_int *a, mp_int *b) } } +#if !MP_FOR_TXR /* Compares |a| <=> |b|, and returns an appropriate comparison result */ int mp_cmp_mag(mp_int *a, mp_int *b) { @@ -1684,6 +1697,7 @@ int mp_cmp_int(mp_int *a, long z) return out; } +#endif /* Returns a true (non-zero) value if a is odd, false (zero) otherwise. */ @@ -1823,6 +1837,7 @@ mp_err mp_gcd(mp_int *a, mp_int *b, mp_int *c) return res; } +#if !MP_FOR_TXR /* We compute the least common multiple using the rule: * * ab = [a, b](a, b) @@ -2009,6 +2024,7 @@ X: return res; } +#endif #endif /* if MP_NUMTH */ @@ -2845,10 +2861,12 @@ mp_err mp_toradix(mp_int *mp, unsigned char *str, int radix) return mp_toradix_case(mp, str, radix, 0); } +#if !MP_FOR_TXR int mp_char2value(char ch, int r) { return s_mp_tovalue(ch, r); } +#endif /* Return a string describing the meaning of error code 'ec'. The * string returned is allocated in static memory, so the caller should @@ -387,16 +387,6 @@ FILE *w_popen(const wchar_t *wcmd, const wchar_t *wmode) } #endif -FILE *w_freopen(const wchar_t *wname, const wchar_t *wmode, FILE *fold) -{ - char *name = utf8_dup_to(wname); - char *mode = utf8_dup_to(wmode); - FILE *f = fold ? freopen(name, mode, fold) : fopen(name, mode); - free(name); - free(mode); - return f; -} - FILE *w_fdopen(int fd, const wchar_t *wmode) { char *mode = utf8_dup_to(wmode); |