summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2021-07-21 06:55:45 -0700
committerKaz Kylheku <kaz@kylheku.com>2021-07-21 06:55:45 -0700
commit16ea370778dcd9943fb11767992aebf6263acfd4 (patch)
tree02f66ea406e46eb7571a27ab6a4b3510d24fe05f
parent5613a3b0d42a89d061df18cd9ae4e1008696572c (diff)
downloadtxr-16ea370778dcd9943fb11767992aebf6263acfd4.tar.gz
txr-16ea370778dcd9943fb11767992aebf6263acfd4.tar.bz2
txr-16ea370778dcd9943fb11767992aebf6263acfd4.zip
compat: fix glaringly broken init-time handling.
We are doing numerous compat_ver checks in various init functions, to enact alternative symbol registrations. Only problem is, compat_ver is always zero during initialization; it is not set until the -C option is processed in txr_main. Registrations must be fixed up after initialization; that's what the compat_fixup mechanism is for. This is an long-standing problem which affects compatibility operation going back over 150 versions. * arith.c (arith_init): Move compat logic to arith_compat_fixup. (arith_compat_fixup): New function. * arith.h (arith_compat_fixup): Declared. * eval.c (eval_init): Move compat logic to eval_compat_fixup. * ffi.c (ffi_init): Move compat logic to ffi_compat_fixup. (ffi_compat_fixup): New function. * ffi.h (ffi_compat_fixup): Declared. * regex.c (regex_init): Move compat logic to regex_compat_fixup. (regex_compat_fixup): New function. * regex.h (regex_compat_fixup): Declared. * stream.c (stream_init): Move compat logic to stream_compat_fixup. (stream_compat_fixup): New function. * stream.h (stream_compat_fixup): Declared. * struct.c (struct_init): Move compat logic to struct_compat_fixup. (struct_compat_fixup): New function. * struct.h (stream_compat_fixup): Declared. * lib.c (compat_fixup): Call arith_compat_fixup, ffi_compat_fixup, regex_compat_fixup, stream_compat_fixup and struct_compat_fixup.
-rw-r--r--arith.c30
-rw-r--r--arith.h1
-rw-r--r--eval.c52
-rw-r--r--ffi.c22
-rw-r--r--ffi.h1
-rw-r--r--lib.c6
-rw-r--r--regex.c21
-rw-r--r--regex.h1
-rw-r--r--stream.c11
-rw-r--r--stream.h1
-rw-r--r--struct.c20
-rw-r--r--struct.h1
12 files changed, 106 insertions, 61 deletions
diff --git a/arith.c b/arith.c
index 941ed681..ad3a0eaa 100644
--- a/arith.c
+++ b/arith.c
@@ -4584,13 +4584,6 @@ void arith_init(void)
bitset_s = intern(lit("bitset"), user_package);
logcount_s = intern(lit("logcount"), user_package);
- if (opt_compat && opt_compat <= 199) {
- reg_varl(intern(lit("*flo-dig*"), user_package), num_fast(DBL_DIG));
- reg_varl(intern(lit("*flo-max*"), user_package), flo(DBL_MAX));
- reg_varl(intern(lit("*flo-min*"), user_package), flo(DBL_MIN));
- reg_varl(intern(lit("*flo-epsilon*"), user_package), flo(DBL_EPSILON));
- }
-
reg_varl(intern(lit("flo-dig"), user_package), num_fast(DBL_DIG));
reg_varl(intern(lit("flo-max-dig"), user_package), num_fast(FLO_MAX_DIG));
reg_varl(intern(lit("flo-max"), user_package), flo(DBL_MAX));
@@ -4608,11 +4601,6 @@ void arith_init(void)
#endif
reg_varl(intern(lit("%e%"), user_package), flo(M_E));
- if (opt_compat && opt_compat <= 199) {
- reg_varl(intern(lit("*pi*"), user_package), flo(M_PI));
- reg_varl(intern(lit("*e*"), user_package), flo(M_E));
- }
-
reg_fun(plus_s, func_n0v(plusv));
reg_fun(minus_s, func_n1v(minusv));
reg_fun(mul_s, func_n0v(mulv));
@@ -4675,8 +4663,7 @@ void arith_init(void)
reg_fun(sqrt_s, func_n1(sqroot));
reg_fun(logand_s, func_n0v(logandv));
reg_fun(logior_s, func_n0v(logiorv));
- reg_fun(logxor_s,
- func_n2(if3(opt_compat && opt_compat <= 202, logxor_old, logxor)));
+ reg_fun(logxor_s, func_n2(logxor));
reg_fun(intern(lit("logtest"), user_package), func_n2(logtest));
reg_fun(lognot_s, func_n2o(lognot, 1));
reg_fun(logtrunc_s, func_n2(logtrunc));
@@ -4731,6 +4718,21 @@ void arith_init(void)
#endif
}
+void arith_compat_fixup(int compat_ver)
+{
+ if (compat_ver <= 202)
+ reg_fun(logxor_s, func_n2(logxor_old));
+
+ if (compat_ver <= 199) {
+ reg_varl(intern(lit("*pi*"), user_package), flo(M_PI));
+ reg_varl(intern(lit("*e*"), user_package), flo(M_E));
+ reg_varl(intern(lit("*flo-dig*"), user_package), num_fast(DBL_DIG));
+ reg_varl(intern(lit("*flo-max*"), user_package), flo(DBL_MAX));
+ reg_varl(intern(lit("*flo-min*"), user_package), flo(DBL_MIN));
+ reg_varl(intern(lit("*flo-epsilon*"), user_package), flo(DBL_EPSILON));
+ }
+}
+
void arith_free_all(void)
{
}
diff --git a/arith.h b/arith.h
index c66e6844..f5646831 100644
--- a/arith.h
+++ b/arith.h
@@ -62,4 +62,5 @@ val rpoly(val x, val seq);
NORETURN void do_mp_error(val self, mp_err code);
void arith_init(void);
+void arith_compat_fixup(int compat_ver);
void arith_free_all(void);
diff --git a/eval.c b/eval.c
index 6ed4a7d1..77db6610 100644
--- a/eval.c
+++ b/eval.c
@@ -6703,10 +6703,6 @@ void eval_init(void)
reg_mac(gen_s, func_n2(me_gen));
reg_mac(gun_s, func_n2(me_gun));
reg_mac(intern(lit("delay"), user_package), func_n2(me_delay));
- if (opt_compat && opt_compat <= 184) {
- reg_mac(op_s, func_n2(me_op));
- reg_mac(do_s, func_n2(me_op));
- }
reg_mac(sys_l1_val_s, func_n2(me_l1_val));
reg_mac(sys_l1_setq_s, func_n2(me_l1_setq));
reg_mac(qquote_s, func_n2(me_qquote));
@@ -6830,8 +6826,7 @@ void eval_init(void)
reg_fun(intern(lit("copy-list"), user_package), func_n1(copy_list));
reg_fun(intern(lit("nreverse"), user_package), func_n1(nreverse));
reg_fun(intern(lit("reverse"), user_package), func_n1(reverse));
- reg_fun(intern(lit("ldiff"), user_package),
- func_n2(if3(opt_compat && opt_compat <= 190, ldiff_old, ldiff)));
+ reg_fun(intern(lit("ldiff"), user_package), func_n2(ldiff));
reg_fun(intern(lit("last"), user_package), func_n2o(last, 1));
reg_fun(intern(lit("butlast"), user_package), func_n2o(butlast, 1));
reg_fun(intern(lit("nthlast"), user_package), func_n2(nthlast));
@@ -6958,10 +6953,7 @@ void eval_init(void)
reg_fun(intern(lit("env-vbindings"), user_package), func_n1(env_vbindings));
reg_fun(intern(lit("env-fbindings"), user_package), func_n1(env_fbindings));
reg_fun(intern(lit("env-next"), user_package), func_n1(env_next));
- reg_fun(intern(lit("lexical-var-p"), user_package),
- func_n2(if3(opt_compat && opt_compat <= 257,
- old_lexical_var_p,
- lexical_var_p)));
+ reg_fun(intern(lit("lexical-var-p"), user_package), func_n2(lexical_var_p));
reg_fun(intern(lit("lexical-fun-p"), user_package), func_n2(lexical_fun_p));
reg_fun(intern(lit("lexical-lisp1-binding"), user_package),
func_n2(lexical_lisp1_binding));
@@ -7014,18 +7006,11 @@ void eval_init(void)
reg_varl(system_package_s = intern(lit("system-package"), user_package), system_package);
reg_varl(keyword_package_s = intern(lit("keyword-package"), user_package), keyword_package);
- if (opt_compat && opt_compat <= 156) {
- reg_varl(intern(lit("*user-package*"), user_package), user_package);
- reg_varl(intern(lit("*system-package*"), user_package), system_package);
- reg_varl(intern(lit("*keyword-package*"), user_package), keyword_package);
- }
-
reg_fun(intern(lit("make-sym"), user_package), func_n1(make_sym));
reg_fun(intern(lit("gensym"), user_package), func_n1o(gensym, 0));
reg_var(gensym_counter_s = intern(lit("*gensym-counter*"), user_package), zero);
reg_var(package_alist_s = intern(lit("*package-alist*"), user_package), packages);
- reg_var(package_s = intern(lit("*package*"), user_package),
- (opt_compat && opt_compat <= 190) ? user_package : public_package);
+ reg_var(package_s = intern(lit("*package*"), user_package), public_package);
reg_fun(intern(lit("make-package"), user_package), func_n2o(make_package, 1));
reg_fun(intern(lit("make-anon-package"), system_package), func_n1o(make_anon_package, 0));
reg_fun(intern(lit("find-package"), user_package), func_n1(find_package));
@@ -7190,11 +7175,9 @@ void eval_init(void)
reg_fun(intern(lit("improper-plist-to-alist"), user_package), func_n2(improper_plist_to_alist));
reg_fun(intern(lit("merge"), user_package), func_n4o(merge_wrap, 2));
reg_fun(intern(lit("nsort"), user_package), func_n3o(nsort, 1));
- reg_fun(intern(lit("sort"), user_package),
- func_n3o(if3(opt_compat && opt_compat <= 237, nsort, sort), 1));
+ reg_fun(intern(lit("sort"), user_package), func_n3o(sort, 1));
reg_fun(intern(lit("nshuffle"), user_package), func_n2o(nshuffle, 1));
- reg_fun(intern(lit("shuffle"), user_package),
- func_n2o(if3(opt_compat && opt_compat <= 237, nshuffle, shuffle), 1));
+ reg_fun(intern(lit("shuffle"), user_package), func_n2o(shuffle, 1));
reg_fun(intern(lit("find"), user_package), func_n4o(find, 2));
reg_fun(intern(lit("rfind"), user_package), func_n4o(rfind, 2));
reg_fun(intern(lit("find-if"), user_package), func_n3o(find_if, 2));
@@ -7351,6 +7334,31 @@ void eval_compat_fixup(int compat_ver)
tweak_hash(builtin, t, nil);
}
+ if (compat_ver <= 257)
+ reg_fun(intern(lit("lexical-var-p"), user_package),
+ func_n2(old_lexical_var_p));
+
+ if (compat_ver <= 237) {
+ reg_fun(intern(lit("sort"), user_package), func_n3o(nsort, 1));
+ reg_fun(intern(lit("shuffle"), user_package), func_n2o(nshuffle, 1));
+ }
+
+ if (compat_ver <= 190) {
+ reg_var(package_s, user_package);
+ reg_fun(intern(lit("ldiff"), user_package), func_n2(ldiff_old));
+ }
+
+ if (compat_ver <= 184) {
+ reg_mac(op_s, func_n2(me_op));
+ reg_mac(do_s, func_n2(me_op));
+ }
+
+ if (compat_ver <= 156) {
+ reg_varl(intern(lit("*user-package*"), user_package), user_package);
+ reg_varl(intern(lit("*system-package*"), user_package), system_package);
+ reg_varl(intern(lit("*keyword-package*"), user_package), keyword_package);
+ }
+
if (compat_ver <= 107)
reg_fun(intern(lit("flip"), user_package), func_n1(swap_12_21));
}
diff --git a/ffi.c b/ffi.c
index 282c9e55..4f8ec505 100644
--- a/ffi.c
+++ b/ffi.c
@@ -6464,13 +6464,6 @@ void ffi_init(void)
reg_fun(intern(lit("carray-int"), user_package), ca_int);
reg_fun(intern(lit("uint-carray"), user_package), uint_ca);
reg_fun(intern(lit("int-carray"), user_package), int_ca);
-
- if (opt_compat && opt_compat <= 227) {
- reg_fun(intern(lit("carray-unum"), user_package), ca_uint);
- reg_fun(intern(lit("carray-num"), user_package), ca_int);
- reg_fun(intern(lit("unum-carray"), user_package), uint_ca);
- reg_fun(intern(lit("num-carray"), user_package), int_ca);
- }
}
reg_fun(intern(lit("put-carray"), user_package), func_n3o(put_carray, 1));
reg_fun(intern(lit("fill-carray"), user_package), func_n3o(fill_carray, 1));
@@ -6493,3 +6486,18 @@ void ffi_init(void)
ffi_init_types();
ffi_init_extra_types();
}
+
+void ffi_compat_fixup(int compat_ver)
+{
+ if (compat_ver <= 227) {
+ val ca_uint = func_n2o(carray_uint, 1);
+ val ca_int = func_n2o(carray_int, 1);
+ val uint_ca = func_n1(uint_carray);
+ val int_ca = func_n1(int_carray);
+
+ reg_fun(intern(lit("carray-unum"), user_package), ca_uint);
+ reg_fun(intern(lit("carray-num"), user_package), ca_int);
+ reg_fun(intern(lit("unum-carray"), user_package), uint_ca);
+ reg_fun(intern(lit("num-carray"), user_package), int_ca);
+ }
+}
diff --git a/ffi.h b/ffi.h
index f8b1bc6d..cde839e4 100644
--- a/ffi.h
+++ b/ffi.h
@@ -141,3 +141,4 @@ val put_obj(val obj, val type, val stream);
val get_obj(val type, val stream);
val fill_obj(val obj, val type, val stream);
void ffi_init(void);
+void ffi_compat_fixup(int compat_ver);
diff --git a/lib.c b/lib.c
index 274d3956..38f19af7 100644
--- a/lib.c
+++ b/lib.c
@@ -14053,6 +14053,12 @@ int compat_fixup(int compat_ver)
eval_compat_fixup(compat_ver);
rand_compat_fixup(compat_ver);
parse_compat_fixup(compat_ver);
+ arith_compat_fixup(compat_ver);
+ ffi_compat_fixup(compat_ver);
+ regex_compat_fixup(compat_ver);
+ stream_compat_fixup(compat_ver);
+ struct_compat_fixup(compat_ver);
+
return 0;
}
diff --git a/regex.c b/regex.c
index e9567221..58e6d126 100644
--- a/regex.c
+++ b/regex.c
@@ -3354,16 +3354,12 @@ void regex_init(void)
reg_fun(intern(lit("search-regex"), user_package), func_n4o(search_regex, 2));
reg_fun(intern(lit("range-regex"), user_package), func_n4o(range_regex, 2));
reg_fun(intern(lit("search-regst"), user_package), func_n4o(search_regst, 2));
- reg_fun(intern(lit("match-regex"), user_package),
- func_n3o((opt_compat && opt_compat <= 150) ?
- match_regex : match_regex_len, 2));
+ reg_fun(intern(lit("match-regex"), user_package), func_n3o(match_regex_len, 2));
reg_fun(intern(lit("match-regst"), user_package), func_n3o(match_regst, 2));
reg_fun(intern(lit("match-regex-right"), user_package),
- func_n3o((opt_compat && opt_compat <= 150) ?
- match_regex_right_old : match_regex_right, 2));
+ func_n3o(match_regex_right, 2));
reg_fun(intern(lit("match-regst-right"), user_package),
- func_n3o((opt_compat && opt_compat <= 150) ?
- match_regst_right_old : match_regst_right, 2));
+ func_n3o(match_regst_right, 2));
reg_fun(intern(lit("regex-prefix-match"), user_package),
func_n3o(regex_prefix_match, 2));
reg_fun(intern(lit("regsub"), user_package), func_n3(regsub));
@@ -3395,6 +3391,17 @@ void regex_init(void)
init_special_char_sets();
}
+void regex_compat_fixup(int compat_ver)
+{
+ if (compat_ver <= 150) {
+ reg_fun(intern(lit("match-regex"), user_package), func_n3o(match_regex, 2));
+ reg_fun(intern(lit("match-regex-right"), user_package),
+ func_n3o(match_regex_right_old, 2));
+ reg_fun(intern(lit("match-regst-right"), user_package),
+ func_n3o(match_regst_right_old, 2));
+ }
+}
+
void regex_free_all(void)
{
char_set_destroy(space_cs, 1);
diff --git a/regex.h b/regex.h
index 58a7e9e3..31596722 100644
--- a/regex.h
+++ b/regex.h
@@ -66,4 +66,5 @@ val regex_range_right_fun(val regex, val end);
val regex_range_search_fun(val regex, val start, val from_end);
int wide_display_char_p(wchar_t ch);
void regex_init(void);
+void regex_compat_fixup(int compat_ver);
void regex_free_all(void);
diff --git a/stream.c b/stream.c
index e3be10f1..68ace85a 100644
--- a/stream.c
+++ b/stream.c
@@ -5521,9 +5521,7 @@ void stream_init(void)
reg_fun(intern(lit("open-files"), user_package), func_n3o(open_files, 1));
reg_fun(intern(lit("open-files*"), user_package), func_n3o(open_files_star, 1));
reg_fun(intern(lit("portable-abs-path-p"), user_package), func_n1(portable_abs_path_p));
- reg_fun(intern(lit("abs-path-p"), user_package),
- func_n1(if3(opt_compat && opt_compat <= 258,
- portable_abs_path_p, abs_path_p)));
+ reg_fun(intern(lit("abs-path-p"), user_package), func_n1(abs_path_p));
reg_fun(intern(lit("pure-rel-path-p"), user_package), func_n1(pure_rel_path_p));
reg_fun(intern(lit("base-name"), user_package), func_n2o(base_name, 1));
reg_fun(intern(lit("dir-name"), user_package), func_n1(dir_name));
@@ -5604,3 +5602,10 @@ void stream_init(void)
}
#endif
}
+
+void stream_compat_fixup(int compat_ver)
+{
+ if (compat_ver <= 258)
+ reg_fun(intern(lit("abs-path-p"), user_package),
+ func_n1(portable_abs_path_p));
+}
diff --git a/stream.h b/stream.h
index e705c694..3b9db2b3 100644
--- a/stream.h
+++ b/stream.h
@@ -268,3 +268,4 @@ val tmpfile_wrap(void);
val mkdtemp_wrap(val prefix);
val mkstemp_wrap(val prefix, val suffix);
void stream_init(void);
+void stream_compat_fixup(int compat_ver);
diff --git a/struct.c b/struct.c
index 2f643dae..1b9e5f1f 100644
--- a/struct.c
+++ b/struct.c
@@ -165,12 +165,8 @@ void struct_init(void)
static_slot_type_hash = make_hash(nil, nil, nil);
struct_type_finalize_f = func_n1(struct_type_finalize);
- if (opt_compat && opt_compat <= 117)
- reg_fun(intern(lit("make-struct-type"), user_package),
- func_n5(make_struct_type_compat));
- else
- reg_fun(intern(lit("make-struct-type"), user_package),
- func_n8o(make_struct_type, 7));
+ reg_fun(intern(lit("make-struct-type"), user_package),
+ func_n8o(make_struct_type, 7));
reg_fun(intern(lit("make-struct-type"), system_package),
func_n8(make_struct_type));
@@ -210,8 +206,6 @@ void struct_init(void)
reg_fun(intern(lit("call-super-fun"), user_package),
func_n2v(call_super_fun));
reg_fun(intern(lit("slotp"), user_package), func_n2(slotp));
- if (opt_compat && opt_compat <= 118)
- reg_fun(intern(lit("slot-p"), user_package), func_n2(slotp));
reg_fun(intern(lit("static-slot-p"), user_package), func_n2(static_slot_p));
reg_fun(intern(lit("structp"), user_package), func_n1(structp));
reg_fun(intern(lit("struct-type"), user_package), func_n1(struct_type));
@@ -225,6 +219,16 @@ void struct_init(void)
reg_fun(intern(lit("static-slot-types"), system_package), func_n1(static_slot_types));
}
+void struct_compat_fixup(int compat_ver)
+{
+ if (compat_ver <= 118)
+ reg_fun(intern(lit("slot-p"), user_package), func_n2(slotp));
+
+ if (compat_ver <= 117)
+ reg_fun(intern(lit("make-struct-type"), user_package),
+ func_n5(make_struct_type_compat));
+}
+
static NORETURN void no_such_struct(val ctx, val sym)
{
uw_throwf(error_s, lit("~a: ~s does not name a struct type"),
diff --git a/struct.h b/struct.h
index 6b139653..3549f7bf 100644
--- a/struct.h
+++ b/struct.h
@@ -95,3 +95,4 @@ val get_special_required_slot(val obj, enum special_slot spidx);
val get_special_slot_by_type(val stype, enum special_slot spidx);
INLINE int obj_struct_p(val obj) { return obj->co.ops == &struct_inst_ops; }
void struct_init(void);
+void struct_compat_fixup(int compat_ver);