diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2021-07-21 06:55:45 -0700 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2021-07-21 06:55:45 -0700 |
commit | 16ea370778dcd9943fb11767992aebf6263acfd4 (patch) | |
tree | 02f66ea406e46eb7571a27ab6a4b3510d24fe05f | |
parent | 5613a3b0d42a89d061df18cd9ae4e1008696572c (diff) | |
download | txr-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.c | 30 | ||||
-rw-r--r-- | arith.h | 1 | ||||
-rw-r--r-- | eval.c | 52 | ||||
-rw-r--r-- | ffi.c | 22 | ||||
-rw-r--r-- | ffi.h | 1 | ||||
-rw-r--r-- | lib.c | 6 | ||||
-rw-r--r-- | regex.c | 21 | ||||
-rw-r--r-- | regex.h | 1 | ||||
-rw-r--r-- | stream.c | 11 | ||||
-rw-r--r-- | stream.h | 1 | ||||
-rw-r--r-- | struct.c | 20 | ||||
-rw-r--r-- | struct.h | 1 |
12 files changed, 106 insertions, 61 deletions
@@ -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) { } @@ -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); @@ -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)); } @@ -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); + } +} @@ -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); @@ -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; } @@ -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); @@ -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); @@ -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)); +} @@ -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); @@ -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"), @@ -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); |