diff options
| -rw-r--r-- | Makefile | 2 | ||||
| -rw-r--r-- | genprotsym.txr | 32 | ||||
| -rw-r--r-- | lib.c | 33 | ||||
| -rw-r--r-- | protsym.c | 209 |
4 files changed, 273 insertions, 3 deletions
@@ -49,7 +49,7 @@ EXTRA_OBJS-y := OBJS := txr.o lex.yy.o y.tab.o match.o lib.o regex.o gc.o unwind.o stream.o OBJS += arith.o hash.o utf8.o filter.o eval.o parser.o rand.o combi.o sysif.o -OBJS += args.o lisplib.o cadr.o struct.o jmp.o +OBJS += args.o lisplib.o cadr.o struct.o jmp.o protsym.o OBJS-$(debug_support) += debug.o OBJS-$(have_syslog) += syslog.o OBJS-$(have_glob) += glob.o diff --git a/genprotsym.txr b/genprotsym.txr new file mode 100644 index 00000000..7d9f8c2a --- /dev/null +++ b/genprotsym.txr @@ -0,0 +1,32 @@ +@(next (open-files (glob "*.c"))) +@(collect :vars (sym)) +val @(coll)@{sym /[A-Za-z0-9_]+_[sk]/}@/[,;]/@(end) +@(end) +@(next "lib.c") +@(collect) +@copyright +@(until) + +@(end) +@(flatten sym) +@(bind gsym @(tuples 5 (sort sym))) +@(output "protsym.c") +/* This file is generated by genprotsym.txr */ + +@{copyright "\n"} + +#include <stddef.h> +#include "config.h" +#include "lib.h" + +@ (repeat) +extern val @(rep)@gsym, @(last)@gsym;@(end) +@ (end) + +val *protected_sym[] = { +@ (repeat) + @(rep)&@gsym, @(last)&@gsym,@(end) +@ (end) + convert(val *, 0) +}; +@(end) @@ -4940,6 +4940,27 @@ val package_foreign_symbols(val package_in) return out; } +static void prot_sym_check(val func, val symname, val package) +{ + extern val *protected_sym[]; + val **iter = protected_sym; + + if (package == user_package || + package == system_package || + package == keyword_package) + { + val sym = gethash(package->pk.symhash, symname); + + for (; sym && *iter; iter++) { + if (**iter == sym) + uw_throwf(error_s, + lit("~a: cannot remove built-in symbol ~s " + "from ~a package"), + func, sym, package_name(package), nao); + } + } +} + val use_sym(val symbol, val package_in) { val self = lit("use-sym"); @@ -4953,6 +4974,7 @@ val use_sym(val symbol, val package_in) if (found && symbol_package(existing) == package) { if (existing == nil) uw_throwf(error_s, lit("~a: cannot hide ~s"), self, existing, nao); + prot_sym_check(self, name, package); sethash(package->pk.hidhash, name, existing); existing->s.package = nil; } @@ -5123,12 +5145,15 @@ val intern(val str, val package_in) val unintern(val symbol, val package_in) { - val package = get_package(lit("unintern"), package_in, t); + val unint = lit("unintern"); + val package = get_package(unint, package_in, t); val name = symbol_name(symbol); val found_visible, found_hidden; val visible = gethash_f(package->pk.symhash, name, mkcloc(found_visible)); val hidden = gethash_f(package->pk.hidhash, name, mkcloc(found_hidden)); + prot_sym_check(unint, name, package); + if (!found_visible || visible != symbol) { if (found_hidden && hidden == symbol) { remhash(package->pk.hidhash, name); @@ -5158,12 +5183,16 @@ val unintern(val symbol, val package_in) val rehome_sym(val sym, val package_in) { - val package = get_package(lit("rehome-sym"), package_in, t); + val self = lit("rehome-sym"); + val package = get_package(self, package_in, t); val name = symbol_name(sym); if (!sym) uw_throwf(error_s, lit("rehome-sym: cannot rehome ~s"), sym, nao); + prot_sym_check(self, name, sym->s.package); + prot_sym_check(self, name, package); + if (sym->s.package) { val name = symbol_name(sym); if (sym->s.package == package) diff --git a/protsym.c b/protsym.c new file mode 100644 index 00000000..e02d1e23 --- /dev/null +++ b/protsym.c @@ -0,0 +1,209 @@ +/* This file is generated by genprotsym.txr */ + +/* Copyright 2009-2017 + * Kaz Kylheku <kaz@kylheku.com> + * Vancouver, Canada + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions are met: + * + * 1. Redistributions of source code must retain the above copyright notice, this + * list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND + * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED + * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE + * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE + * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR + * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, + * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE + * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + +#include <stddef.h> +#include "config.h" +#include "lib.h" + +extern val accept_s, addr_k, addr_s, addrinfo_s, all_s; +extern val and_s, ap_s, apf_s, append_each_s, append_each_star_s; +extern val append_k, append_s, apply_s, aret_s, args_k; +extern val assert_s, atime_k, atime_s, atom_s, auto_k; +extern val bignum_s, bind_s, blksize_k, blksize_s, block_s; +extern val block_star_s, blocks_k, blocks_s, byte_oriented_k, call_s; +extern val canonname_s, car_s, caseq_s, caseq_star_s, caseql_s; +extern val caseql_star_s, casequal_s, casequal_star_s, cases_s, cat_s; +extern val catch_s, cc_s, cdigit_k, cdr_s, cflag_s; +extern val chain_s, chand_s, chars_k, choose_s, chr_s; +extern val chset_s, circref_s, close_s, cobj_s, coll_s; +extern val collect_each_s, collect_each_star_s, collect_s, colon_k, compl_s; +extern val compound_s, cond_s, cons_s, continue_k, continue_s; +extern val counter_k, cptr_s, cset_s, cspace_k, ctime_k; +extern val ctime_s, cword_char_k, data_s, day_s, debug_quit_s; +extern val decline_k, defex_s, deffilter_s, define_s, defmacro_s; +extern val defparm_s, defparml_s, defr_warning_s, defsymacro_s, defun_s; +extern val defvar_s, defvarl_s, dev_k, dev_s, digit_k; +extern val dir_s, do_s, dohash_s, domainname_s, downcase_k; +extern val dst_s, dvbind_s, dwim_s, each_op_s, each_s; +extern val each_star_s, empty_s, env_k, env_s, eof_s; +extern val eol_s, eq_s, eql_s, equal_based_k, equal_s; +extern val error_s, eval_error_s, expr_s, fail_s, family_s; +extern val fbind_s, fd_k, file_error_s, filter_k, filter_s; +extern val finally_s, finish_k, first_s, fixnum_s, flags_s; +extern val flatten_s, flet_s, float_s, flow_info_s, for_op_s; +extern val for_s, for_star_s, force_s, forget_s, form_k; +extern val format_s, freeform_s, from_current_k, from_end_k, from_list_s; +extern val from_start_k, frombase64_k, fromhtml_k, frompercent_k, fromurl_k; +extern val fun_k, fun_s, fuzz_s, gap_k, gather_s; +extern val gecos_s, gen_s, generate_s, gensym_counter_s, gid_k; +extern val gid_s, gmtoff_s, greedy_k, group_s, gun_s; +extern val handler_bind_s, hash_construct_s, hash_iter_s, hash_lit_s, hash_s; +extern val hextoint_k, hour_s, iapply_s, identity_s, if_s; +extern val iflag_s, iflet_s, in_package_s, inc_s, include_s; +extern val ino_k, ino_s, integer_s, internal_error_s, into_k; +extern val intr_s, ipf_s, ispeed_s, keyword_package_s, labels_s; +extern val lambda_s, lambda_set_s, last_s, lbind_s, lcons_s; +extern val let_s, let_star_s, lfilt_k, lflag_s, line_s; +extern val lines_k, lisp1_setq_s, list_k, list_s, list_star_s; +extern val listener_hist_len_s, listener_multi_line_p_s, listener_sel_inclusive_p_s, lit_s, load_path_s; +extern val load_recursive_s, load_s, local_s, longest_k, lstr_s; +extern val mac_param_bind_s, machine_s, macro_s, macro_time_s, macrolet_s; +extern val make_struct_lit_s, mandatory_k, maxgap_k, maxtimes_k, maybe_s; +extern val mdo_s, mem_s, memq_s, memql_s, memqual_s; +extern val merge_s, meth_s, min_s, mingap_k, mintimes_k; +extern val mod_s, mode_k, mode_s, modlast_s, month_s; +extern val mtime_k, mtime_s, name_k, name_s, named_k; +extern val next_s, next_spec_k, nlink_k, nlink_s, nodename_s; +extern val none_s, nongreedy_s, not_s, nothrow_k, noval_s; +extern val null_s, nullify_s, number_s, numeric_error_s, oand_s; +extern val oflag_s, oneplus_s, op_s, opip_s, optional_s; +extern val or_s, ospeed_s, output_s, package_alist_s, package_s; +extern val panic_s, parser_s, passwd_s, path_s, pkg_s; +extern val plus_s, port_s, print_base_s, print_circle_s, print_flo_digits_s; +extern val print_flo_format_s, print_flo_precision_s, print_s, prio_k, process_error_s; +extern val prof_s, prog1_s, progn_s, promise_forced_s, promise_inprogress_s; +extern val promise_s, protocol_s, qquote_s, qref_s, quasi_s; +extern val quasilist_s, query_error_s, quote_s, random_state_s, random_state_var_s; +extern val random_warmup_s, range_error_s, range_s, rcons_s, rdev_k; +extern val rdev_s, real_time_k, rebind_s, reflect_k, regex_s; +extern val release_s, rep_s, repeat_s, repeat_spec_k, require_s; +extern val resolve_k, rest_s, restart_s, ret_s, return_from_s; +extern val return_s, rfilt_k, scope_id_s, sec_s, sequence_s; +extern val set_s, setq_s, setqf_s, shell_s, shortest_k; +extern val single_s, size_k, size_s, skip_s, slot_s; +extern val sockaddr_in6_s, sockaddr_in_s, sockaddr_un_s, socket_error_s, socktype_s; +extern val some_s, space_k, special_s, splice_s, stat_s; +extern val static_slot_s, stddebug_s, stderr_s, stdin_s, stdio_stream_s; +extern val stdnull_s, stdout_s, str_s, stream_s, string_k; +extern val string_s, struct_lit_s, struct_type_s, switch_s, sym_s; +extern val symacro_k, symacrolet_s, syntax_error_s, sys_abscond_from_s, sys_apply_s; +extern val sys_catch_s, sys_lisp1_value_s, sys_mark_special_s, sys_qquote_s, sys_splice_s; +extern val sys_unquote_s, sysname_s, system_error_s, system_package_s, termios_s; +extern val text_s, throw_s, time_local_s, time_parse_s, time_s; +extern val time_string_s, time_utc_s, timeout_error_s, times_k, tlist_k; +extern val tobase64_k, tofloat_k, tohtml_k, tohtml_star_k, toint_k; +extern val tonumber_k, topercent_k, tourl_k, trailer_s, tree_bind_s; +extern val tree_case_s, try_s, type_error_s, uid_k, uid_s; +extern val unbound_s, unique_s, unquote_s, until_s, until_star_s; +extern val upcase_k, uref_s, user_package_s, userdata_k, utsname_s; +extern val uw_protect_s, var_k, var_s, vars_k, vec_list_s; +extern val vec_s, vecref_s, vector_lit_s, version_s, warning_s; +extern val weak_keys_k, weak_vals_k, when_s, while_s, while_star_s; +extern val whole_k, wild_s, with_dyn_rebinds_s, word_char_k, wrap_k; +extern val year_s, zap_s, zeroplus_s, zone_s; + +val *protected_sym[] = { + &accept_s, &addr_k, &addr_s, &addrinfo_s, &all_s, + &and_s, &ap_s, &apf_s, &append_each_s, &append_each_star_s, + &append_k, &append_s, &apply_s, &aret_s, &args_k, + &assert_s, &atime_k, &atime_s, &atom_s, &auto_k, + &bignum_s, &bind_s, &blksize_k, &blksize_s, &block_s, + &block_star_s, &blocks_k, &blocks_s, &byte_oriented_k, &call_s, + &canonname_s, &car_s, &caseq_s, &caseq_star_s, &caseql_s, + &caseql_star_s, &casequal_s, &casequal_star_s, &cases_s, &cat_s, + &catch_s, &cc_s, &cdigit_k, &cdr_s, &cflag_s, + &chain_s, &chand_s, &chars_k, &choose_s, &chr_s, + &chset_s, &circref_s, &close_s, &cobj_s, &coll_s, + &collect_each_s, &collect_each_star_s, &collect_s, &colon_k, &compl_s, + &compound_s, &cond_s, &cons_s, &continue_k, &continue_s, + &counter_k, &cptr_s, &cset_s, &cspace_k, &ctime_k, + &ctime_s, &cword_char_k, &data_s, &day_s, &debug_quit_s, + &decline_k, &defex_s, &deffilter_s, &define_s, &defmacro_s, + &defparm_s, &defparml_s, &defr_warning_s, &defsymacro_s, &defun_s, + &defvar_s, &defvarl_s, &dev_k, &dev_s, &digit_k, + &dir_s, &do_s, &dohash_s, &domainname_s, &downcase_k, + &dst_s, &dvbind_s, &dwim_s, &each_op_s, &each_s, + &each_star_s, &empty_s, &env_k, &env_s, &eof_s, + &eol_s, &eq_s, &eql_s, &equal_based_k, &equal_s, + &error_s, &eval_error_s, &expr_s, &fail_s, &family_s, + &fbind_s, &fd_k, &file_error_s, &filter_k, &filter_s, + &finally_s, &finish_k, &first_s, &fixnum_s, &flags_s, + &flatten_s, &flet_s, &float_s, &flow_info_s, &for_op_s, + &for_s, &for_star_s, &force_s, &forget_s, &form_k, + &format_s, &freeform_s, &from_current_k, &from_end_k, &from_list_s, + &from_start_k, &frombase64_k, &fromhtml_k, &frompercent_k, &fromurl_k, + &fun_k, &fun_s, &fuzz_s, &gap_k, &gather_s, + &gecos_s, &gen_s, &generate_s, &gensym_counter_s, &gid_k, + &gid_s, &gmtoff_s, &greedy_k, &group_s, &gun_s, + &handler_bind_s, &hash_construct_s, &hash_iter_s, &hash_lit_s, &hash_s, + &hextoint_k, &hour_s, &iapply_s, &identity_s, &if_s, + &iflag_s, &iflet_s, &in_package_s, &inc_s, &include_s, + &ino_k, &ino_s, &integer_s, &internal_error_s, &into_k, + &intr_s, &ipf_s, &ispeed_s, &keyword_package_s, &labels_s, + &lambda_s, &lambda_set_s, &last_s, &lbind_s, &lcons_s, + &let_s, &let_star_s, &lfilt_k, &lflag_s, &line_s, + &lines_k, &lisp1_setq_s, &list_k, &list_s, &list_star_s, + &listener_hist_len_s, &listener_multi_line_p_s, &listener_sel_inclusive_p_s, &lit_s, &load_path_s, + &load_recursive_s, &load_s, &local_s, &longest_k, &lstr_s, + &mac_param_bind_s, &machine_s, ¯o_s, ¯o_time_s, ¯olet_s, + &make_struct_lit_s, &mandatory_k, &maxgap_k, &maxtimes_k, &maybe_s, + &mdo_s, &mem_s, &memq_s, &memql_s, &memqual_s, + &merge_s, &meth_s, &min_s, &mingap_k, &mintimes_k, + &mod_s, &mode_k, &mode_s, &modlast_s, &month_s, + &mtime_k, &mtime_s, &name_k, &name_s, &named_k, + &next_s, &next_spec_k, &nlink_k, &nlink_s, &nodename_s, + &none_s, &nongreedy_s, ¬_s, ¬hrow_k, &noval_s, + &null_s, &nullify_s, &number_s, &numeric_error_s, &oand_s, + &oflag_s, &oneplus_s, &op_s, &opip_s, &optional_s, + &or_s, &ospeed_s, &output_s, &package_alist_s, &package_s, + &panic_s, &parser_s, &passwd_s, &path_s, &pkg_s, + &plus_s, &port_s, &print_base_s, &print_circle_s, &print_flo_digits_s, + &print_flo_format_s, &print_flo_precision_s, &print_s, &prio_k, &process_error_s, + &prof_s, &prog1_s, &progn_s, &promise_forced_s, &promise_inprogress_s, + &promise_s, &protocol_s, &qquote_s, &qref_s, &quasi_s, + &quasilist_s, &query_error_s, "e_s, &random_state_s, &random_state_var_s, + &random_warmup_s, &range_error_s, &range_s, &rcons_s, &rdev_k, + &rdev_s, &real_time_k, &rebind_s, &reflect_k, ®ex_s, + &release_s, &rep_s, &repeat_s, &repeat_spec_k, &require_s, + &resolve_k, &rest_s, &restart_s, &ret_s, &return_from_s, + &return_s, &rfilt_k, &scope_id_s, &sec_s, &sequence_s, + &set_s, &setq_s, &setqf_s, &shell_s, &shortest_k, + &single_s, &size_k, &size_s, &skip_s, &slot_s, + &sockaddr_in6_s, &sockaddr_in_s, &sockaddr_un_s, &socket_error_s, &socktype_s, + &some_s, &space_k, &special_s, &splice_s, &stat_s, + &static_slot_s, &stddebug_s, &stderr_s, &stdin_s, &stdio_stream_s, + &stdnull_s, &stdout_s, &str_s, &stream_s, &string_k, + &string_s, &struct_lit_s, &struct_type_s, &switch_s, &sym_s, + &symacro_k, &symacrolet_s, &syntax_error_s, &sys_abscond_from_s, &sys_apply_s, + &sys_catch_s, &sys_lisp1_value_s, &sys_mark_special_s, &sys_qquote_s, &sys_splice_s, + &sys_unquote_s, &sysname_s, &system_error_s, &system_package_s, &termios_s, + &text_s, &throw_s, &time_local_s, &time_parse_s, &time_s, + &time_string_s, &time_utc_s, &timeout_error_s, ×_k, &tlist_k, + &tobase64_k, &tofloat_k, &tohtml_k, &tohtml_star_k, &toint_k, + &tonumber_k, &topercent_k, &tourl_k, &trailer_s, &tree_bind_s, + &tree_case_s, &try_s, &type_error_s, &uid_k, &uid_s, + &unbound_s, &unique_s, &unquote_s, &until_s, &until_star_s, + &upcase_k, &uref_s, &user_package_s, &userdata_k, &utsname_s, + &uw_protect_s, &var_k, &var_s, &vars_k, &vec_list_s, + &vec_s, &vecref_s, &vector_lit_s, &version_s, &warning_s, + &weak_keys_k, &weak_vals_k, &when_s, &while_s, &while_star_s, + &whole_k, &wild_s, &with_dyn_rebinds_s, &word_char_k, &wrap_k, + &year_s, &zap_s, &zeroplus_s, &zone_s, + convert(val *, 0) +}; |