diff options
| -rw-r--r-- | ChangeLog | 110 | ||||
| -rw-r--r-- | eval.c | 257 | ||||
| -rw-r--r-- | eval.h | 2 | ||||
| -rw-r--r-- | gc.c | 1 | ||||
| -rw-r--r-- | genvim.txr | 15 | ||||
| -rw-r--r-- | lib.c | 38 | ||||
| -rw-r--r-- | lib.h | 10 | ||||
| -rw-r--r-- | rand.c | 29 | ||||
| -rw-r--r-- | rand.h | 2 | ||||
| -rw-r--r-- | signal.c | 74 | ||||
| -rw-r--r-- | stream.c | 146 | ||||
| -rw-r--r-- | stream.h | 13 | ||||
| -rw-r--r-- | syslog.c | 58 | ||||
| -rw-r--r-- | syslog.h | 2 | ||||
| -rw-r--r-- | tests/011/special-1.expected | 2 | ||||
| -rw-r--r-- | tests/011/special-1.txr | 3 | ||||
| -rw-r--r-- | txr.c | 9 | ||||
| -rw-r--r-- | txr.h | 1 |
18 files changed, 386 insertions, 386 deletions
@@ -1,5 +1,115 @@ 2014-02-28 Kaz Kylheku <kaz@kylheku.com> + Change in the design of how special variables work, to fix the broken + re-binding. C code now has to go through the dynamic environment lookup + to access things like *random-state*, or *stdout*. As part of this, + I'm moving some intrinsic variable and function initializations out of + eval.c and into their respective modules. Macros are are used to make + global variables look like ordinary C variables. This is very similar + to the errno trick in POSIX threads implementations. + + * eval.c (looup_var, lookup_var_l): Restructured to eliminate silly + goto, the cobjp handling is gone. + (reg_fun, reg_var): Internal function becomes external. + reg_var registers a simple cons cell binding now, without any + C pointer tricks to real C global variables. + (c_var_mark): Static function removed. + (c_var_ops): Static struct removed. + (eval_init): Numerous initializations for streams, syslog, rand, + signals and others moved to their respective modules. + The new symbol variables user_package_s, keyword_package_s + and system_package_s are interned here, and the variables are + created in a special way. + + * eval.h (reg_var, reg_fun): Declared. + + * gc.c (prot1): Added assert that the loc pointer isn't null. + This happened, and blew up during garbage collection. + + * lib.c (system_package, keyword_package, user_package): Variables + removed these become macros. + (system_package_var, keyword_package_var, user_package_var): New + global variables. + (system_package_s, keyword_package_s, user_package_s): New + symbol globals. + (get_user_package, get_system_package, get_keyword_package): New + functions. + (obj_init): Protect new variables. Initialization order of modules + tweaked: the modules sig_init, stream_init, and rand_init are moved + after eval_init because they register variables. + + * lib.h (keyword_package, system_pckage, user_package): Variables + turned into macros. + (system_package_var, keyword_package_var, user_package_var): Declared. + (system_package_s, keyword_package_s, user_package_s): Declared. + (get_user_package, get_system_package, get_keyword_package): Declared. + + * rand.c (struct random_state): Renamed to struct rand_state to + avoid clash with new random_state macro. + (random_state): Global variable removed. + (random_state_s): New symbol global. + (make_state, rand32, make_random_state, random_fixnum, random): + Follow rename of struct random_state. + (rand_init): Reference to random_state variable gone. Using + reg_var to create the *random-state* variable that is referenced + from C using the random_stat macro. + + * rand.h (random_state): Variable removed, replaced by macro + that performs dynamic lookup. + + * signal.c (sig_init): References to all the sig_* global variables + removed. The signal-related reg_var and reg_fun calls from eval.c moved + here. + + * stream.c (std_input, std_output, std_debug, std_error, std_null): + Variables removed. + (s_ifmt, s_ifsock, s_iflnk, s_ifreg, s_ifblk, s_ifdir, + s_ifchr, s_ififo, s_isuid, s_isgid, s_isvtx, s_irwxu, + s_irusr, s_iwusr, s_ixusr, s_irwxg, s_irgrp, s_iwgrp, + s_ixgrp, s_irwxo, s_iroth, s_iwoth, s_ixoth): Variables removed. + (stdin_s, stdout_s, stddebug_s, stderr_s, stdnull_s): New symbol + globals. + (stream_init): References to removed variables gone. Moved + stream-related initializations here from eval.c. The global + streams are set up differently. + + * stream.h (std_input, std_output, std_debug, std_error, std_null): + Variable declarations replaced by macros. + (lookup_var_l): Declared. + (s_ifmt, s_ifsock, s_iflnk, s_ifreg, s_ifblk, s_ifdir, + s_ifchr, s_ififo, s_isuid, s_isgid, s_isvtx, s_irwxu, + s_irusr, s_iwusr, s_ixusr, s_irwxg, s_irgrp, s_iwgrp, + s_ixgrp, s_irwxo, s_iroth, s_iwoth, s_ixoth): Declarations removed. + + * syslog.c (log_pid_v, log_cons_v, log_ndelay_v, log_odelay_v, + log_nowait_v, log_perror_v, log_user_v, log_daemon_v, log_auth_v, + log_authpriv_v, log_emerg_v, log_alert_v, log_crit_v, log_err_v, + log_warning_v, log_notice_v, log_info_v, + log_debug_v, std_log): Variables removed. + (syslog_init): References to removed variables removed. + Moved syslog-related initializations here out of eval_init. + + * syslog.h:x (std_log): Declration removed. + + * txr.c (self_path, prog_args_full, prog_args): Variables gone. + (txr_main): References to removed varaibles are gone. + Moved registration of special variables out of eval_init + here. + + * txr.h (self_path, prog_args_full, prog_args): Declarations gone. + + * tests/011/special-1.txr: Test case modified to properly test + special variables. Previously it produced the expected output + even though *stdout* wasn't rebound properly. + + * tests/011/special-1.expected: Updated. + + * genvim.txr: Updated to follow variable and function registration + moves. It has to scan more files than just eval.c. Produces identical + contents, so no change to txr.vim. + +2014-02-28 Kaz Kylheku <kaz@kylheku.com> + * eval.c (op_defvar): Remove the same-named symbol macro when a variable is defined. (op_defsymacro): Remove the same-named variable when a symbol macro is @@ -41,9 +41,6 @@ #ifdef HAVE_WINDOWS_H #include <windows.h> #endif -#ifdef HAVE_SYSLOG -#include <syslog.h> -#endif #include "lib.h" #include "gc.h" #include "arith.h" @@ -58,9 +55,6 @@ #include "rand.h" #include "filter.h" #include "txr.h" -#ifdef HAVE_SYSLOG -#include "syslog.h" -#endif #include "combi.h" #include "eval.h" @@ -141,24 +135,7 @@ noreturn static val eval_error(val form, val fmt, ...) val lookup_var(val env, val sym) { - if (nilp(env)) { -dyn: - for (env = dyn_env; env; env = env->e.up_env) { - val binding = assoc(sym, env->e.vbindings); - if (binding) - return binding; - } - - { - val bind = gethash(top_vb, sym); - if (cobjp(bind)) { - struct c_var *cv = (struct c_var *) cptr_get(bind); - set(cv->bind->c.cdr, *cv->loc); - return cv->bind; - } - return bind; - } - } else { + if (env) { type_check(env, ENV); for (; env; env = env->e.up_env) { @@ -166,32 +143,20 @@ dyn: if (binding) return binding; } - - goto dyn; } + + for (env = dyn_env; env; env = env->e.up_env) { + val binding = assoc(sym, env->e.vbindings); + if (binding) + return binding; + } + + return(gethash(top_vb, sym)); } val *lookup_var_l(val env, val sym) { - if (nilp(env)) { -dyn: - for (env = dyn_env; env; env = env->e.up_env) { - val binding = assoc(sym, env->e.vbindings); - if (binding) - return cdr_l(binding); - } - - { - val bind = gethash(top_vb, sym); - if (cobjp(bind)) { - struct c_var *cv = (struct c_var *) cptr_get(bind); - return cv->loc; - } - if (bind) - return cdr_l(bind); - return 0; - } - } else { + if (env) { type_check(env, ENV); for (; env; env = env->e.up_env) { @@ -199,8 +164,17 @@ dyn: if (binding) return cdr_l(binding); } + } + + for (env = dyn_env; env; env = env->e.up_env) { + val binding = assoc(sym, env->e.vbindings); + if (binding) + return cdr_l(binding); + } - goto dyn; + { + val binding = gethash(top_vb, sym); + return (binding) ? cdr_l(binding) : 0; } } @@ -2934,7 +2908,7 @@ static void reg_op(val sym, opfun_t fun) sethash(op_table, sym, cptr((mem_t *) fun)); } -static void reg_fun(val sym, val fun) +void reg_fun(val sym, val fun) { assert (sym != 0); sethash(top_fb, sym, cons(sym, fun)); @@ -2946,28 +2920,10 @@ static void reg_mac(val sym, mefun_t fun) sethash(top_mb, sym, cptr((mem_t *) fun)); } -static void c_var_mark(val obj) +void reg_var(val sym, val val) { - struct c_var *cv = (struct c_var *) obj->co.handle; - cv->bind->c.cdr = *cv->loc; /* synchronize shadow binding with variable */ - gc_mark(cv->bind); - /* we don't mark *loc since it should be a gc-protected C global! */ -} - -static struct cobj_ops c_var_ops = { - eq, - cobj_print_op, - cobj_destroy_free_op, - c_var_mark, - cobj_hash_op -}; - -static void reg_var(val sym, val *loc) -{ - struct c_var *cv = (struct c_var *) chk_malloc(sizeof *cv); - cv->loc = loc; - cv->bind = cons(sym, *loc); - sethash(top_vb, sym, cobj((mem_t *) cv, cptr_s, &c_var_ops)); + assert (sym != nil); + sethash(top_vb, sym, cons(sym, val)); mark_special(sym); } @@ -3322,84 +3278,23 @@ void eval_init(void) reg_fun(intern(lit("or"), user_package), func_n0v(or_fun)); reg_fun(intern(lit("and"), user_package), func_n0v(and_fun)); - reg_var(intern(lit("*stdout*"), user_package), &std_output); - reg_var(intern(lit("*stddebug*"), user_package), &std_debug); - reg_var(intern(lit("*stdin*"), user_package), &std_input); - reg_var(intern(lit("*stderr*"), user_package), &std_error); - reg_var(intern(lit("*stdnull*"), user_package), &std_null); -#ifdef HAVE_SYSLOG - reg_var(intern(lit("*stdlog*"), user_package), &std_log); -#endif - reg_fun(intern(lit("format"), user_package), func_n2v(formatv)); reg_fun(intern(lit("print"), user_package), func_n2o(obj_print, 1)); reg_fun(intern(lit("pprint"), user_package), func_n2o(obj_pprint, 1)); reg_fun(intern(lit("tostring"), user_package), func_n1(tostring)); reg_fun(intern(lit("tostringp"), user_package), func_n1(tostringp)); reg_fun(intern(lit("prinl"), user_package), func_n2o(prinl, 1)); reg_fun(intern(lit("pprinl"), user_package), func_n2o(pprinl, 1)); - reg_fun(intern(lit("make-string-input-stream"), user_package), func_n1(make_string_input_stream)); - reg_fun(intern(lit("make-string-byte-input-stream"), user_package), func_n1(make_string_byte_input_stream)); - reg_fun(intern(lit("make-string-output-stream"), user_package), func_n0(make_string_output_stream)); - reg_fun(intern(lit("get-string-from-stream"), user_package), func_n1(get_string_from_stream)); - reg_fun(intern(lit("make-strlist-output-stream"), user_package), func_n0(make_strlist_output_stream)); - reg_fun(intern(lit("get-list-from-stream"), user_package), func_n1(get_list_from_stream)); - reg_fun(intern(lit("close-stream"), user_package), func_n2o(close_stream, 1)); - reg_fun(intern(lit("get-line"), user_package), func_n1o(get_line, 0)); - reg_fun(intern(lit("get-char"), user_package), func_n1o(get_char, 0)); - reg_fun(intern(lit("get-byte"), user_package), func_n1o(get_byte, 0)); - reg_fun(intern(lit("put-string"), user_package), func_n2o(put_string, 1)); - reg_fun(intern(lit("put-line"), user_package), func_n2o(put_line, 1)); - reg_fun(intern(lit("put-char"), user_package), func_n2o(put_char, 1)); - reg_fun(intern(lit("put-byte"), user_package), func_n2o(put_byte, 1)); - reg_fun(intern(lit("unget-char"), user_package), func_n2o(unget_char, 1)); - reg_fun(intern(lit("unget-byte"), user_package), func_n2o(unget_byte, 1)); - reg_fun(intern(lit("flush-stream"), user_package), func_n1(flush_stream)); - reg_fun(intern(lit("seek-stream"), user_package), func_n3(seek_stream)); - reg_fun(intern(lit("stat"), user_package), func_n1(statf)); - reg_fun(intern(lit("streamp"), user_package), func_n1(streamp)); - reg_fun(intern(lit("real-time-stream-p"), user_package), func_n1(real_time_stream_p)); - reg_fun(intern(lit("stream-set-prop"), user_package), func_n3(stream_set_prop)); - reg_fun(intern(lit("stream-get-prop"), user_package), func_n2(stream_get_prop)); - reg_fun(intern(lit("make-catenated-stream"), user_package), func_n0v(make_catenated_stream)); - reg_var(intern(lit("s-ifmt"), user_package), &s_ifmt); - reg_var(intern(lit("s-ifsock"), user_package), &s_ifsock); - reg_var(intern(lit("s-iflnk"), user_package), &s_iflnk); - reg_var(intern(lit("s-ifreg"), user_package), &s_ifreg); - reg_var(intern(lit("s-ifblk"), user_package), &s_ifblk); - reg_var(intern(lit("s-ifdir"), user_package), &s_ifdir); - reg_var(intern(lit("s-ifchr"), user_package), &s_ifchr); - reg_var(intern(lit("s-ififo"), user_package), &s_ififo); - reg_var(intern(lit("s-isuid"), user_package), &s_isuid); - reg_var(intern(lit("s-isgid"), user_package), &s_isgid); - reg_var(intern(lit("s-isvtx"), user_package), &s_isvtx); - reg_var(intern(lit("s-irwxu"), user_package), &s_irwxu); - reg_var(intern(lit("s-irusr"), user_package), &s_irusr); - reg_var(intern(lit("s-iwusr"), user_package), &s_iwusr); - reg_var(intern(lit("s-ixusr"), user_package), &s_ixusr); - reg_var(intern(lit("s-irwxg"), user_package), &s_irwxg); - reg_var(intern(lit("s-irgrp"), user_package), &s_irgrp); - reg_var(intern(lit("s-iwgrp"), user_package), &s_iwgrp); - reg_var(intern(lit("s-ixgrp"), user_package), &s_ixgrp); - reg_var(intern(lit("s-irwxo"), user_package), &s_irwxo); - reg_var(intern(lit("s-iroth"), user_package), &s_iroth); - reg_var(intern(lit("s-iwoth"), user_package), &s_iwoth); - reg_var(intern(lit("s-ixoth"), user_package), &s_ixoth); - - reg_fun(intern(lit("open-directory"), user_package), func_n1(open_directory)); - reg_fun(intern(lit("open-file"), user_package), func_n2o(open_file, 1)); - reg_fun(intern(lit("open-tail"), user_package), func_n3o(open_tail, 1)); - reg_fun(intern(lit("open-command"), user_package), func_n2o(open_command, 1)); - reg_fun(intern(lit("open-pipe"), user_package), func_n2(open_command)); - reg_fun(intern(lit("open-process"), user_package), func_n3o(open_process, 2)); - reg_fun(intern(lit("remove-path"), user_package), func_n1(remove_path)); - reg_fun(intern(lit("rename-path"), user_package), func_n2(rename_path)); - - reg_var(intern(lit("*user-package*"), user_package), &user_package); - reg_var(intern(lit("*keyword-package*"), user_package), &keyword_package); - reg_var(intern(lit("*system-package*"), user_package), &system_package); + + reg_var(user_package_s = intern(lit("*user-package*"), user_package_var), + user_package_var); + reg_var(system_package_s = intern(lit("*system-package*"), user_package_var), + system_package_var); + reg_var(keyword_package_s = intern(lit("*keyword-package*"), user_package_var), + keyword_package_var); + 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(intern(lit("*gensym-counter*"), user_package), &gensym_counter); + reg_var(intern(lit("*gensym-counter*"), user_package), gensym_counter); reg_fun(intern(lit("make-package"), user_package), func_n1(make_package)); reg_fun(intern(lit("find-package"), user_package), func_n1(find_package)); reg_fun(intern(lit("delete-package"), user_package), func_n1(delete_package)); @@ -3522,7 +3417,6 @@ void eval_init(void) reg_fun(intern(lit("functionp"), user_package), func_n1(functionp)); reg_fun(intern(lit("interp-fun-p"), user_package), func_n1(interp_fun_p)); - reg_var(intern(lit("*random-state*"), user_package), &random_state); reg_fun(intern(lit("make-random-state"), user_package), func_n1(make_random_state)); reg_fun(intern(lit("random-state-p"), user_package), func_n1(random_state_p)); reg_fun(intern(lit("random-fixnum"), user_package), func_n1o(random_fixnum, 1)); @@ -3563,8 +3457,6 @@ void eval_init(void) reg_fun(intern(lit("env"), user_package), func_n0(env)); reg_fun(intern(lit("env-hash"), user_package), func_n0(env_hash)); - reg_var(intern(lit("*args*"), user_package), &prog_args); - reg_var(intern(lit("*full-args*"), user_package), &prog_args_full); #if HAVE_DAEMON reg_fun(intern(lit("daemon"), user_package), func_n2(daemon_wrap)); @@ -3593,93 +3485,10 @@ void eval_init(void) reg_fun(intern(lit("readlink"), user_package), func_n1(readlink_wrap)); #endif -#if HAVE_SYSLOG - reg_var(intern(lit("log-pid"), user_package), &log_pid_v); - reg_var(intern(lit("log-cons"), user_package), &log_cons_v); - reg_var(intern(lit("log-ndelay"), user_package), &log_ndelay_v); - reg_var(intern(lit("log-odelay"), user_package), &log_odelay_v); - reg_var(intern(lit("log-nowait"), user_package), &log_nowait_v); -#ifdef LOG_PERROR - reg_var(intern(lit("log-perror"), user_package), &log_perror_v); -#endif - reg_var(intern(lit("log-user"), user_package), &log_user_v); - reg_var(intern(lit("log-daemon"), user_package), &log_daemon_v); - reg_var(intern(lit("log-auth"), user_package), &log_auth_v); -#ifdef LOG_AUTHPRIV - reg_var(intern(lit("log-authpriv"), user_package), &log_authpriv_v); -#endif - reg_var(intern(lit("log-emerg"), user_package), &log_emerg_v); - reg_var(intern(lit("log-alert"), user_package), &log_alert_v); - reg_var(intern(lit("log-crit"), user_package), &log_crit_v); - reg_var(intern(lit("log-err"), user_package), &log_err_v); - reg_var(intern(lit("log-warning"), user_package), &log_warning_v); - reg_var(intern(lit("log-notice"), user_package), &log_notice_v); - reg_var(intern(lit("log-info"), user_package), &log_info_v); - reg_var(intern(lit("log-debug"), user_package), &log_debug_v); - reg_fun(intern(lit("openlog"), user_package), func_n3o(openlog_wrap, 1)); - reg_fun(intern(lit("closelog"), user_package), func_n0(closelog_wrap)); - reg_fun(intern(lit("setlogmask"), user_package), func_n1(setlogmask_wrap)); - reg_fun(intern(lit("syslog"), user_package), func_n2v(syslog_wrap)); -#endif - -#if HAVE_POSIX_SIGS - reg_fun(intern(lit("set-sig-handler"), user_package), func_n2(set_sig_handler)); - reg_fun(intern(lit("get-sig-handler"), user_package), func_n1(get_sig_handler)); - reg_fun(intern(lit("sig-check"), user_package), func_n0(sig_check)); - reg_var(intern(lit("sig-hup"), user_package), &sig_hup); - reg_var(intern(lit("sig-int"), user_package), &sig_int); - reg_var(intern(lit("sig-quit"), user_package), &sig_quit); - reg_var(intern(lit("sig-ill"), user_package), &sig_ill); - reg_var(intern(lit("sig-trap"), user_package), &sig_trap); - reg_var(intern(lit("sig-abrt"), user_package), &sig_abrt); - reg_var(intern(lit("sig-bus"), user_package), &sig_bus); - reg_var(intern(lit("sig-fpe"), user_package), &sig_fpe); - reg_var(intern(lit("sig-kill"), user_package), &sig_kill); - reg_var(intern(lit("sig-usr1"), user_package), &sig_usr1); - reg_var(intern(lit("sig-segv"), user_package), &sig_segv); - reg_var(intern(lit("sig-usr2"), user_package), &sig_usr2); - reg_var(intern(lit("sig-pipe"), user_package), &sig_pipe); - reg_var(intern(lit("sig-alrm"), user_package), &sig_alrm); - reg_var(intern(lit("sig-term"), user_package), &sig_term); - reg_var(intern(lit("sig-chld"), user_package), &sig_chld); - reg_var(intern(lit("sig-cont"), user_package), &sig_cont); - reg_var(intern(lit("sig-stop"), user_package), &sig_stop); - reg_var(intern(lit("sig-tstp"), user_package), &sig_tstp); - reg_var(intern(lit("sig-ttin"), user_package), &sig_ttin); - reg_var(intern(lit("sig-ttou"), user_package), &sig_ttou); - reg_var(intern(lit("sig-urg"), user_package), &sig_urg); - reg_var(intern(lit("sig-xcpu"), user_package), &sig_xcpu); - reg_var(intern(lit("sig-xfsz"), user_package), &sig_xfsz); - reg_var(intern(lit("sig-vtalrm"), user_package), &sigtalrm); - reg_var(intern(lit("sig-prof"), user_package), &sig_prof); - reg_var(intern(lit("sig-poll"), user_package), &sig_poll); - reg_var(intern(lit("sig-sys"), user_package), &sig_sys); -#ifdef SIGWINCH - reg_var(intern(lit("sig-winch"), user_package), &sig_winch); -#endif -#ifdef SIGIOT - reg_var(intern(lit("sig-iot"), user_package), &sig_iot); -#endif -#ifdef SIGSTKFLT - reg_var(intern(lit("sig-stkflt"), user_package), &sig_stkflt); -#endif -#ifdef SIGIO - reg_var(intern(lit("sig-io"), user_package), &sig_io); -#endif -#ifdef SIGLOST - reg_var(intern(lit("sig-lost"), user_package), &sig_lost); -#endif -#ifdef SIGPWR - reg_var(intern(lit("sig-pwr"), user_package), &sig_pwr); -#endif -#endif - reg_fun(intern(lit("source-loc"), user_package), func_n1(source_loc)); reg_fun(intern(lit("source-loc-str"), user_package), func_n1(source_loc_str)); reg_fun(intern(lit("rlcp"), user_package), func_n2(rlcp)); - reg_var(intern(lit("*self-path*"), user_package), &self_path); - eval_error_s = intern(lit("eval-error"), user_package); uw_register_subtype(eval_error_s, error_s); } @@ -36,6 +36,8 @@ val lookup_var(val env, val sym); val *lookup_var_l(val env, val sym); val lookup_fun(val env, val sym); val interp_fun(val env, val fun, val args); +void reg_var(val sym, val val); +void reg_fun(val sym, val fun); val apply(val fun, val arglist, val ctx_form); val eval_progn(val forms, val env, val ctx_form); val eval(val form, val env, val ctx_form); @@ -92,6 +92,7 @@ val break_obj; val prot1(val *loc) { assert (top < prot_stack_limit); + assert (loc != 0); *top++ = loc; return nil; /* for use in macros */ } @@ -7,10 +7,9 @@ static void dir_tables_init(void) @(until) } @(end) -@(next "eval.c") -@(skip) -void eval_init(void) -{ +@(next @[apply make-catenated-stream + [mapcar open-file '("eval.c" "rand.c" "signal.c" + "stream.c" "syslog.c" "txr.c")]]) @(collect) @ (cases) reg_@/op|mac/(@{txl-sym-nostar}_star_s,@(skip) @@ -18,17 +17,15 @@ void eval_init(void) @ (or) reg_@/op|mac/(@{txl-sym}_s,@(skip) @ (or) - reg_mac(intern(lit("@{txl-sym}"),@(skip) + reg_mac(intern(lit("@{txl-sym}")@(skip) @ (or) - reg_fun(intern(lit("@{txl-sym}"),@(skip) + reg_fun(intern(lit("@{txl-sym}")@(skip) @ (or) reg_fun(@{txl-sym}_s,@(skip) @ (or) - reg_var(intern(lit("@{txl-sym}"),@(skip) + @/ */reg_var(@(skip)intern(lit("@{txl-sym}")@(skip) @ (end) @ (set txl-sym @(regsub #/_/ #\- txl-sym)) -@(until) -} @(end) @(do (defun sortuniq (list) @@ -66,7 +66,8 @@ int async_sig_enabled = 0; val packages; -val system_package, keyword_package, user_package; +val system_package_var, keyword_package_var, user_package_var; +val system_package_s, keyword_package_s, user_package_s; val null_s, t, cons_s, str_s, chr_s, fixnum_s, sym_s, pkg_s, fun_s, vec_s; val lit_s, stream_s, hash_s, hash_iter_s, lcons_s, lstr_s, cobj_s, cptr_s; @@ -2814,6 +2815,27 @@ val keywordp(val sym) return (symbolp(sym) && symbol_package(sym) == keyword_package) ? t : nil; } +val *get_user_package(void) +{ + if (nilp(user_package_s)) + return &user_package_var; + return lookup_var_l(nil, user_package_s); +} + +val *get_system_package(void) +{ + if (nilp(system_package_s)) + return &system_package_var; + return lookup_var_l(nil, system_package_s); +} + +val *get_keyword_package(void) +{ + if (nilp(keyword_package_s)) + return &keyword_package_var; + return lookup_var_l(nil, keyword_package_s); +} + val func_f0(val env, val (*fun)(val)) { val obj = make_obj(); @@ -5064,8 +5086,8 @@ static void obj_init(void) * symbols. */ - protect(&packages, &system_package, &keyword_package, - &user_package, &null_string, &nil_string, + protect(&packages, &system_package_var, &keyword_package_var, + &user_package_var, &null_string, &nil_string, &null_list, &equal_f, &eq_f, &eql_f, &car_f, &cdr_f, &null_f, &identity_f, &prog_string, &env_list, (val *) 0); @@ -5734,15 +5756,15 @@ void init(const wchar_t *pn, mem_t *(*oom)(mem_t *, size_t), oom_realloc = oom; gc_init(stack_bottom); -#if HAVE_POSIX_SIGS - sig_init(); -#endif obj_init(); arith_init(); - rand_init(); uw_init(); - stream_init(); eval_init(); + rand_init(); + stream_init(); +#if HAVE_POSIX_SIGS + sig_init(); +#endif filter_init(); hash_init(); regex_init(); @@ -316,7 +316,12 @@ INLINE val chr(wchar_t ch) #define lit(strlit) lit_noex(strlit) -extern val keyword_package, system_package, user_package; +#define keyword_package (*get_keyword_package()) +#define user_package (*get_user_package()) +#define system_package (*get_system_package()) + +extern val system_package_var, keyword_package_var, user_package_var; +extern val keyword_package_s, system_package_s, user_package_s; extern val null_s, t, cons_s, str_s, chr_s, fixnum_sl; extern val sym_s, pkg_s, fun_s, vec_s; extern val stream_s, hash_s, hash_iter_s, lcons_s, lstr_s, cobj_s, cptr_s; @@ -568,6 +573,9 @@ val symbolp(val sym); val symbol_name(val sym); val symbol_package(val sym); val keywordp(val sym); +val *get_user_package(void); +val *get_system_package(void); +val *get_keyword_package(void); val func_f0(val, val (*fun)(val env)); val func_f1(val, val (*fun)(val env, val)); val func_f2(val, val (*fun)(val env, val, val)); @@ -43,6 +43,7 @@ #include "gc.h" #include "arith.h" #include "rand.h" +#include "eval.h" #if SIZEOF_INT == 4 typedef unsigned int rand32_t; @@ -54,12 +55,11 @@ typedef unsigned long rand32_t; * The algorithm here is WELL 512. * (Francois Panneton, Pierre L'Ecuyer.) */ -struct random_state { +struct rand_state { rand32_t state[16]; int cur; }; -val random_state; val random_state_s; static struct cobj_ops random_state_ops = { @@ -72,7 +72,7 @@ static struct cobj_ops random_state_ops = { static val make_state(void) { - struct random_state *r = (struct random_state *) chk_malloc(sizeof *r); + struct rand_state *r = (struct rand_state *) chk_malloc(sizeof *r); return cobj((mem_t *) r, random_state_s, &random_state_ops); } @@ -81,7 +81,7 @@ val random_state_p(val obj) return typeof(obj) == random_state_s ? t : nil; } -static rand32_t rand32(struct random_state *r) +static rand32_t rand32(struct rand_state *r) { #define RSTATE(r,i) ((r)->state[((r)->cur + i) % 16]) rand32_t s0 = RSTATE(r, 0); @@ -106,8 +106,7 @@ val make_random_state(val seed) { val rs = make_state(); int i; - struct random_state *r = (struct random_state *) - cobj_handle(rs, random_state_s); + struct rand_state *r = (struct rand_state *) cobj_handle(rs, random_state_s); r->cur = 0; @@ -142,8 +141,8 @@ val make_random_state(val seed) r->state[1] = (rand32_t) c_num(cdr(time)); memset(r->state + 2, 0xAA, sizeof r->state - 2 * sizeof r->state[0]); } else if (random_state_p(seed)) { - struct random_state *rseed = (struct random_state *) - cobj_handle(seed, random_state_s); + struct rand_state *rseed = (struct rand_state *) + cobj_handle(seed, random_state_s); *r = *rseed; } else { uw_throwf(error_s, lit("make-random-state: seed ~s is not a number"), @@ -159,16 +158,16 @@ val make_random_state(val seed) val random_fixnum(val state) { uses_or2; - struct random_state *r = (struct random_state *) - cobj_handle(or2(state, random_state), - random_state_s); + struct rand_state *r = (struct rand_state *) cobj_handle(or2(state, + random_state), + random_state_s); return num(rand32(r) & NUM_MAX); } val random(val state, val modulus) { - struct random_state *r = (struct random_state *) - cobj_handle(random_state, random_state_s); + struct rand_state *r = (struct rand_state *) cobj_handle(random_state, + random_state_s); if (bignump(modulus)) { mp_int *m = mp(modulus); @@ -250,7 +249,7 @@ val rnd(val modulus, val state) void rand_init(void) { - prot1(&random_state); random_state_s = intern(lit("random-state"), user_package); - random_state = make_random_state(num(42)); + reg_var(intern(lit("*random-state*"), user_package), + make_random_state(num_fast(42))); } @@ -24,7 +24,7 @@ * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. */ -extern val random_state; +#define random_state (*lookup_var_l(nil, random_state_s)) extern val random_state_s; val make_random_state(val seed); val random_state_p(val obj); @@ -40,6 +40,7 @@ #include "gc.h" #include "signal.h" #include "unwind.h" +#include "eval.h" #define MAX_SIG 32 @@ -82,54 +83,59 @@ void sig_init(void) prot1(&sig_lambda[i]); } - sig_hup = num_fast(SIGHUP); - sig_int = num_fast(SIGINT); - sig_quit = num_fast(SIGQUIT); - sig_ill = num_fast(SIGILL); - sig_trap = num_fast(SIGTRAP); - sig_abrt = num_fast(SIGABRT); - sig_bus = num_fast(SIGBUS); - sig_fpe = num_fast(SIGFPE); - sig_kill = num_fast(SIGKILL); - sig_usr1 = num_fast(SIGUSR1); - sig_segv = num_fast(SIGSEGV); - sig_usr2 = num_fast(SIGUSR2); - sig_pipe = num_fast(SIGPIPE); - sig_alrm = num_fast(SIGALRM); - sig_term = num_fast(SIGTERM); - sig_chld = num_fast(SIGCHLD); - sig_cont = num_fast(SIGCONT); - sig_stop = num_fast(SIGSTOP); - sig_tstp = num_fast(SIGTSTP); - sig_ttin = num_fast(SIGTTIN); - sig_ttou = num_fast(SIGTTOU); - sig_urg = num_fast(SIGURG); - sig_xcpu = num_fast(SIGXCPU); - sig_xfsz = num_fast(SIGXFSZ); - sigtalrm = num_fast(SIGVTALRM); - sig_prof = num_fast(SIGPROF); + reg_var(intern(lit("sig-hup"), user_package), num_fast(SIGHUP)); + reg_var(intern(lit("sig-int"), user_package), num_fast(SIGINT)); + reg_var(intern(lit("sig-quit"), user_package), num_fast(SIGQUIT)); + reg_var(intern(lit("sig-ill"), user_package), num_fast(SIGILL)); + reg_var(intern(lit("sig-trap"), user_package), num_fast(SIGTRAP)); + reg_var(intern(lit("sig-abrt"), user_package), num_fast(SIGABRT)); + reg_var(intern(lit("sig-bus"), user_package), num_fast(SIGBUS)); + reg_var(intern(lit("sig-fpe"), user_package), num_fast(SIGFPE)); + reg_var(intern(lit("sig-kill"), user_package), num_fast(SIGKILL)); + reg_var(intern(lit("sig-usr1"), user_package), num_fast(SIGUSR1)); + reg_var(intern(lit("sig-segv"), user_package), num_fast(SIGSEGV)); + reg_var(intern(lit("sig-usr2"), user_package), num_fast(SIGUSR2)); + reg_var(intern(lit("sig-pipe"), user_package), num_fast(SIGPIPE)); + reg_var(intern(lit("sig-alrm"), user_package), num_fast(SIGALRM)); + reg_var(intern(lit("sig-term"), user_package), num_fast(SIGTERM)); + reg_var(intern(lit("sig-chld"), user_package), num_fast(SIGCHLD)); + reg_var(intern(lit("sig-cont"), user_package), num_fast(SIGCONT)); + reg_var(intern(lit("sig-stop"), user_package), num_fast(SIGSTOP)); + reg_var(intern(lit("sig-tstp"), user_package), num_fast(SIGTSTP)); + reg_var(intern(lit("sig-ttin"), user_package), num_fast(SIGTTIN)); + reg_var(intern(lit("sig-ttou"), user_package), num_fast(SIGTTOU)); + reg_var(intern(lit("sig-urg"), user_package), num_fast(SIGURG)); + reg_var(intern(lit("sig-xcpu"), user_package), num_fast(SIGXCPU)); + reg_var(intern(lit("sig-xfsz"), user_package), num_fast(SIGXFSZ)); + reg_var(intern(lit("sig-vtalrm"), user_package), num_fast(SIGVTALRM)); + reg_var(intern(lit("sig-prof"), user_package), num_fast(SIGPROF)); #ifdef SIGPOLL - sig_poll = num_fast(SIGPOLL); + reg_var(intern(lit("sig-poll"), user_package), num_fast(SIGPOLL)); #endif - sig_sys = num_fast(SIGSYS); + reg_var(intern(lit("sig-sys"), user_package), num_fast(SIGSYS)); #ifdef SIGWINCH - sig_winch = num_fast(SIGWINCH); + reg_var(intern(lit("sig-winch"), user_package), num_fast(SIGWINCH)); #endif #ifdef SIGIOT - sig_iot = num_fast(SIGIOT); + reg_var(intern(lit("sig-iot"), user_package), num_fast(SIGIOT)); #endif #ifdef SIGSTKFLT - sig_stkflt = num_fast(SIGSTKFLT); + reg_var(intern(lit("sig-stkflt"), user_package), num_fast(SIGSTKFLT)); #endif #ifdef SIGIO - sig_io = num_fast(SIGIO); + reg_var(intern(lit("sig-io"), user_package), num_fast(SIGIO)); #endif #ifdef SIGLOST - sig_lost = num_fast(SIGLOST); + reg_var(intern(lit("sig-lost"), user_package), num_fast(SIGLOST)); #endif #ifdef SIGPWR - sig_pwr = num_fast(SIGPWR); + reg_var(intern(lit("sig-pwr"), user_package), num_fast(SIGPWR)); #endif + + reg_fun(intern(lit("set-sig-handler"), user_package), func_n2(set_sig_handler)); + reg_fun(intern(lit("get-sig-handler"), user_package), func_n1(get_sig_handler)); + reg_fun(intern(lit("sig-check"), user_package), func_n0(sig_check)); + } val set_sig_handler(val signo, val lambda) @@ -57,21 +57,18 @@ #include "unwind.h" #include "stream.h" #include "utf8.h" +#include "eval.h" -val std_input, std_output, std_debug, std_error, std_null; val output_produced; +val stdin_s, stdout_s, stddebug_s, stderr_s, stdnull_s; + val dev_k, ino_k, mode_k, nlink_k, uid_k; val gid_k, rdev_k, size_k, blksize_k, blocks_k; val atime_k, mtime_k, ctime_k; val from_start_k, from_current_k, from_end_k; val real_time_k, name_k; -val s_ifmt, s_ifsock, s_iflnk, s_ifreg, s_ifblk, s_ifdir; -val s_ifchr, s_ififo, s_isuid, s_isgid, s_isvtx, s_irwxu; -val s_irusr, s_iwusr, s_ixusr, s_irwxg, s_irgrp, s_iwgrp; -val s_ixgrp, s_irwxo, s_iroth, s_iwoth, s_ixoth; - static void common_destroy(val obj) { (void) close_stream(obj, nil); @@ -2553,11 +2550,6 @@ val readlink_wrap(val path) void stream_init(void) { protect(&std_input, &std_output, &std_debug, &std_error, &std_null, (val *) 0); - std_input = make_stdio_stream(stdin, lit("stdin")); - std_output = make_stdio_stream(stdout, lit("stdout")); - std_debug = make_stdio_stream(stdout, lit("debug")); - std_error = make_stdio_stream(stderr, lit("stderr")); - std_null = make_null_stream(); detect_format_string(); dev_k = intern(lit("dev"), keyword_package); @@ -2579,63 +2571,127 @@ void stream_init(void) real_time_k = intern(lit("real-time"), keyword_package); name_k = intern(lit("name"), keyword_package); - s_ifmt = num(S_IFMT); - -#ifdef S_IFSOCK - s_ifsock = num(S_IFSOCK); +#ifndef S_IFSOCK +#define S_IFSOCK 0 #endif -#ifdef S_IFLNK - s_iflnk = num(S_IFLNK); +#ifndef S_IFLNK +#define S_IFLNK 0 #endif - s_ifreg = num(S_IFREG); s_ifblk = num(S_IFBLK); s_ifdir = num(S_IFDIR); - s_ifchr = num(S_IFCHR); s_ififo = num(S_IFIFO); - -#ifdef S_ISUID - s_isuid = num(S_ISUID); +#ifndef S_ISUID +#define S_ISUID 0 #endif -#ifdef S_ISGID - s_isgid = num(S_ISGID); +#ifndef S_ISGID +#define S_ISGID 0 #endif -#ifdef S_ISVTX - s_isvtx = num(S_ISVTX); +#ifndef S_ISVTX +#define S_ISVTX 0 #endif - s_irwxu = num(S_IRWXU); s_irusr = num(S_IRUSR); s_iwusr = num(S_IWUSR); - s_ixusr = num(S_IXUSR); +#ifndef S_IRWXG +#define S_IRWXG 0 +#endif -#ifdef S_IRWXG - s_irwxg = num(S_IRWXG); +#ifndef S_IRGRP +#define S_IRGRP 0 #endif -#ifdef S_IRGRP - s_irgrp = num(S_IRGRP); +#ifndef S_IWGRP +#define S_IWGRP 0 #endif -#ifdef S_IWGRP - s_iwgrp = num(S_IWGRP); +#ifndef S_IXGRP +#define S_IXGRP 0 #endif -#ifdef S_IXGRP - s_ixgrp = num(S_IXGRP); +#ifndef S_IRWXO +#define S_IRWXO 0 #endif -#ifdef S_IRWXO - s_irwxo = num(S_IRWXO); +#ifndef S_IROTH +#define S_IROTH 0 #endif -#ifdef S_IROTH - s_iroth = num(S_IROTH); +#ifndef S_IWOTH +#define S_IWOTH 0 #endif -#ifdef S_IWOTH - s_iwoth = num(S_IWOTH); +#ifndef S_IXOTH +#define S_IXOTH 0 #endif -#ifdef S_IXOTH - s_ixoth = num(S_IXOTH); +#if HAVE_SYS_STAT + reg_var(intern(lit("s-ifmt"), user_package), num_fast(S_IFMT)); + reg_var(intern(lit("s-ifsock"), user_package), num_fast(S_IFSOCK)); + reg_var(intern(lit("s-iflnk"), user_package), num_fast(S_IFLNK)); + reg_var(intern(lit("s-ifreg"), user_package), num_fast(S_IFREG)); + reg_var(intern(lit("s-ifblk"), user_package), num_fast(S_IFBLK)); + reg_var(intern(lit("s-ifdir"), user_package), num_fast(S_IFDIR)); + reg_var(intern(lit("s-ifchr"), user_package), num_fast(S_IFCHR)); + reg_var(intern(lit("s-ififo"), user_package), num_fast(S_IFIFO)); + reg_var(intern(lit("s-isuid"), user_package), num_fast(S_ISUID)); + reg_var(intern(lit("s-isgid"), user_package), num_fast(S_ISGID)); + reg_var(intern(lit("s-isvtx"), user_package), num_fast(S_ISVTX)); + reg_var(intern(lit("s-irwxu"), user_package), num_fast(S_IRWXU)); + reg_var(intern(lit("s-irusr"), user_package), num_fast(S_IRUSR)); + reg_var(intern(lit("s-iwusr"), user_package), num_fast(S_IWUSR)); + reg_var(intern(lit("s-ixusr"), user_package), num_fast(S_IXUSR)); + reg_var(intern(lit("s-irwxg"), user_package), num_fast(S_IRWXG)); + reg_var(intern(lit("s-irgrp"), user_package), num_fast(S_IRGRP)); + reg_var(intern(lit("s-iwgrp"), user_package), num_fast(S_IWGRP)); + reg_var(intern(lit("s-ixgrp"), user_package), num_fast(S_IXGRP)); + reg_var(intern(lit("s-irwxo"), user_package), num_fast(S_IRWXO)); + reg_var(intern(lit("s-iroth"), user_package), num_fast(S_IROTH)); + reg_var(intern(lit("s-iwoth"), user_package), num_fast(S_IWOTH)); + reg_var(intern(lit("s-ixoth"), user_package), num_fast(S_IXOTH)); #endif -} + + reg_var(stdin_s = intern(lit("*stdin*"), user_package), + make_stdio_stream(stdin, lit("stdin"))); + reg_var(stdout_s = intern(lit("*stdout*"), user_package), + make_stdio_stream(stdout, lit("stdout"))); + reg_var(stddebug_s = intern(lit("*stddebug*"), user_package), + make_stdio_stream(stdout, lit("debug"))); + reg_var(stderr_s = intern(lit("*stderr*"), user_package), + make_stdio_stream(stderr, lit("stderr"))); + reg_var(stdnull_s = intern(lit("*stdnull*"), user_package), + make_null_stream()); + + reg_fun(intern(lit("format"), user_package), func_n2v(formatv)); + reg_fun(intern(lit("make-string-input-stream"), user_package), func_n1(make_string_input_stream)); + reg_fun(intern(lit("make-string-byte-input-stream"), user_package), func_n1(make_string_byte_input_stream)); + reg_fun(intern(lit("make-string-output-stream"), user_package), func_n0(make_string_output_stream)); + reg_fun(intern(lit("get-string-from-stream"), user_package), func_n1(get_string_from_stream)); + reg_fun(intern(lit("make-strlist-output-stream"), user_package), func_n0(make_strlist_output_stream)); + reg_fun(intern(lit("get-list-from-stream"), user_package), func_n1(get_list_from_stream)); + reg_fun(intern(lit("close-stream"), user_package), func_n2o(close_stream, 1)); + reg_fun(intern(lit("get-line"), user_package), func_n1o(get_line, 0)); + reg_fun(intern(lit("get-char"), user_package), func_n1o(get_char, 0)); + reg_fun(intern(lit("get-byte"), user_package), func_n1o(get_byte, 0)); + reg_fun(intern(lit("put-string"), user_package), func_n2o(put_string, 1)); + reg_fun(intern(lit("put-line"), user_package), func_n2o(put_line, 1)); + reg_fun(intern(lit("put-char"), user_package), func_n2o(put_char, 1)); + reg_fun(intern(lit("put-byte"), user_package), func_n2o(put_byte, 1)); + reg_fun(intern(lit("unget-char"), user_package), func_n2o(unget_char, 1)); + reg_fun(intern(lit("unget-byte"), user_package), func_n2o(unget_byte, 1)); + reg_fun(intern(lit("flush-stream"), user_package), func_n1(flush_stream)); + reg_fun(intern(lit("seek-stream"), user_package), func_n3(seek_stream)); + reg_fun(intern(lit("stat"), user_package), func_n1(statf)); + reg_fun(intern(lit("streamp"), user_package), func_n1(streamp)); + reg_fun(intern(lit("real-time-stream-p"), user_package), func_n1(real_time_stream_p)); + reg_fun(intern(lit("stream-set-prop"), user_package), func_n3(stream_set_prop)); + reg_fun(intern(lit("stream-get-prop"), user_package), func_n2(stream_get_prop)); + reg_fun(intern(lit("make-catenated-stream"), user_package), func_n0v(make_catenated_stream)); + + reg_fun(intern(lit("open-directory"), user_package), func_n1(open_directory)); + reg_fun(intern(lit("open-file"), user_package), func_n2o(open_file, 1)); + reg_fun(intern(lit("open-tail"), user_package), func_n3o(open_tail, 1)); + reg_fun(intern(lit("open-command"), user_package), func_n2o(open_command, 1)); + reg_fun(intern(lit("open-pipe"), user_package), func_n2(open_command)); + reg_fun(intern(lit("open-process"), user_package), func_n3o(open_process, 2)); + reg_fun(intern(lit("remove-path"), user_package), func_n1(remove_path)); + reg_fun(intern(lit("rename-path"), user_package), func_n2(rename_path)); +} @@ -47,7 +47,13 @@ struct strm_ops { val (*set_prop)(val, val ind, val); }; -extern val std_input, std_output, std_debug, std_error, std_null; +#define std_input (*lookup_var_l(nil, stdin_s)) +#define std_output (*lookup_var_l(nil, stdout_s)) +#define std_debug (*lookup_var_l(nil, stddebug_s)) +#define std_error (*lookup_var_l(nil, stderr_s)) +#define std_null (*lookup_var_l(nil, stdnull_s)) +val *lookup_var_l(val env, val sym); + extern val output_produced; extern val dev_k, ino_k, mode_k, nlink_k, uid_k; @@ -56,10 +62,7 @@ extern val atime_k, mtime_k, ctime_k; extern val from_start_k, from_current_k, from_end_k; extern val real_time_k, name_k; -extern val s_ifmt, s_ifsock, s_iflnk, s_ifreg, s_ifblk, s_ifdir; -extern val s_ifchr, s_ififo, s_isuid, s_isgid, s_isvtx, s_irwxu; -extern val s_irusr, s_iwusr, s_ixusr, s_irwxg, s_irgrp, s_iwgrp; -extern val s_ixgrp, s_irwxo, s_iroth, s_iwoth, s_ixoth; +val stdin_s, stdout_s, stddebug_s, stderr_s, stdnull_s; val make_null_stream(void); val make_stdio_stream(FILE *, val descr); @@ -40,53 +40,43 @@ #include "signal.h" #include "unwind.h" #include "utf8.h" +#include "eval.h" #include "syslog.h" -val log_pid_v, log_cons_v, log_ndelay_v; -val log_odelay_v, log_nowait_v, log_perror_v; - -val log_user_v, log_daemon_v, log_auth_v, log_authpriv_v; - -val log_emerg_v, log_alert_v, log_crit_v, log_err_v; -val log_warning_v, log_notice_v, log_info_v, log_debug_v; - val prio_k; -val std_log; - void syslog_init(void) { - prot1(&std_log); - - log_pid_v = num(LOG_PID); - log_cons_v = num(LOG_CONS); - log_ndelay_v = num(LOG_NDELAY); - - log_odelay_v = num(LOG_ODELAY); - log_nowait_v = num(LOG_NOWAIT); + reg_var(intern(lit("log-pid"), user_package), num_fast(LOG_PID)); + reg_var(intern(lit("log-cons"), user_package), num_fast(LOG_CONS)); + reg_var(intern(lit("log-ndelay"), user_package), num_fast(LOG_NDELAY)); + reg_var(intern(lit("log-odelay"), user_package), num_fast(LOG_ODELAY)); + reg_var(intern(lit("log-nowait"), user_package), num_fast(LOG_NOWAIT)); #ifdef LOG_PERROR - log_perror_v = num(LOG_PERROR); + reg_var(intern(lit("log-perror"), user_package), num_fast(LOG_PERROR)); #endif - - log_user_v = num(LOG_USER); - log_daemon_v = num(LOG_DAEMON); - log_auth_v = num(LOG_AUTH); + reg_var(intern(lit("log-user"), user_package), num_fast(LOG_USER)); + reg_var(intern(lit("log-daemon"), user_package), num_fast(LOG_DAEMON)); + reg_var(intern(lit("log-auth"), user_package), num_fast(LOG_AUTH)); #ifdef LOG_AUTHPRIV - log_authpriv_v = num(LOG_AUTHPRIV); + reg_var(intern(lit("log-authpriv"), user_package), num_fast(LOG_AUTHPRIV)); #endif - - log_emerg_v = num(LOG_EMERG); - log_alert_v = num(LOG_ALERT); - log_crit_v = num(LOG_CRIT); - log_err_v = num(LOG_ERR); - log_warning_v = num(LOG_WARNING); - log_notice_v = num(LOG_NOTICE); - log_info_v = num(LOG_INFO); - log_debug_v = num(LOG_DEBUG); + reg_var(intern(lit("log-emerg"), user_package), num_fast(LOG_EMERG)); + reg_var(intern(lit("log-alert"), user_package), num_fast(LOG_ALERT)); + reg_var(intern(lit("log-crit"), user_package), num_fast(LOG_CRIT)); + reg_var(intern(lit("log-err"), user_package), num_fast(LOG_ERR)); + reg_var(intern(lit("log-warning"), user_package), num_fast(LOG_WARNING)); + reg_var(intern(lit("log-notice"), user_package), num_fast(LOG_NOTICE)); + reg_var(intern(lit("log-info"), user_package), num_fast(LOG_INFO)); + reg_var(intern(lit("log-debug"), user_package), num_fast(LOG_DEBUG)); + reg_fun(intern(lit("openlog"), user_package), func_n3o(openlog_wrap, 1)); + reg_fun(intern(lit("closelog"), user_package), func_n0(closelog_wrap)); + reg_fun(intern(lit("setlogmask"), user_package), func_n1(setlogmask_wrap)); + reg_fun(intern(lit("syslog"), user_package), func_n2v(syslog_wrap)); prio_k = intern(lit("prio"), keyword_package); - std_log = make_syslog_stream(log_info_v); + reg_var(intern(lit("*stdlog*"), user_package), make_syslog_stream(num_fast(LOG_INFO))); } val openlog_wrap(val wident, val optmask, val facility) @@ -35,8 +35,6 @@ extern val log_warning_v, log_notice_v, log_info_v, log_debug_v; extern val prio_k; -extern val std_log; - void syslog_init(void); val openlog_wrap(val ident, val optmask, val facility); val closelog_wrap(void); diff --git a/tests/011/special-1.expected b/tests/011/special-1.expected index ce013625..af5626b4 100644 --- a/tests/011/special-1.expected +++ b/tests/011/special-1.expected @@ -1 +1 @@ -hello +Hello, world! diff --git a/tests/011/special-1.txr b/tests/011/special-1.txr index 7e51c483..23c15b48 100644 --- a/tests/011/special-1.txr +++ b/tests/011/special-1.txr @@ -4,5 +4,6 @@ (progn ,*forms (get-string-from-stream ,var)))) (let ((x (with-output-to-string (*stdout*) - (format t "hello")))) + (format t "world!")))) + (format *stdout* "Hello, ") (put-line x))) @@ -49,7 +49,6 @@ const wchli_t *version = wli("82"); const wchar_t *progname = L"txr"; -val self_path, prog_args_full, prog_args; /* * Can implement an emergency allocator here from a fixed storage @@ -182,7 +181,7 @@ int txr_main(int argc, char **argv) val arg; list_collect_decl(arg_list, arg_tail); - protect(&spec_file_str, &self_path, &prog_args, &prog_args_full, (val *) 0); + prot1(&spec_file_str); setvbuf(stderr, 0, _IOLBF, 0); @@ -196,7 +195,7 @@ int txr_main(int argc, char **argv) while (*argv) arg_tail = list_collect(arg_tail, string_utf8(*argv++)); - prog_args_full = arg_list; + reg_var(intern(lit("*full-args*"), user_package), arg_list); arg_list = cdr(arg_list); @@ -414,7 +413,7 @@ int txr_main(int argc, char **argv) } } - prog_args = arg_list; + reg_var(intern(lit("*args*"), user_package), arg_list); { int gc = gc_state(0); @@ -434,7 +433,7 @@ int txr_main(int argc, char **argv) format(std_error, lit("bindings:\n~s\n"), bindings, nao); } - self_path = spec_file_str; + reg_var(intern(lit("*self-path*"), user_package), spec_file_str); { int retval = extract(spec, arg_list, bindings); @@ -35,4 +35,3 @@ extern int opt_vg_debug; extern int opt_derivative_regex; extern const wchli_t *version; extern const wchar_t *progname; -extern val self_path, prog_args_full, prog_args; |