From d437bd0779701db65791a4045d8dee4fcf0febfe Mon Sep 17 00:00:00 2001 From: Marius Gerbershagen Date: Sat, 22 Jul 2023 22:10:13 +0200 Subject: [PATCH] speed up looking up and setting values of dynamic variables Introduce ecl_cmp_symbol_value and ecl_cmp_setq which do the minimal amount of work needed to implement symbol-value and setq for dynamic variables which we have checked to be non-null and of type symbol in the compiler. Also introduce a type check in ecl_symbol_value to be consistent with ecl_setq which also checks the type. These two functions are mainly used for the embedding interface now, so for that reason it is also useful to have a type check in there. --- src/c/assignment.d | 35 ++++++++++------- src/c/compiler.d | 4 +- src/c/format.d | 2 +- src/c/load.d | 14 +++---- src/c/macros.d | 2 +- src/c/num_rand.d | 2 +- src/c/package.d | 4 +- src/c/pathname.d | 4 +- src/c/print.d | 50 +++++++++++++------------ src/c/printer/write_object.d | 17 +++++---- src/c/read.d | 2 +- src/c/symbol.d | 29 +++++++++----- src/c/threads/barrier.d | 4 +- src/c/threads/process.d | 2 +- src/c/threads/semaphore.d | 4 +- src/cmp/cmpbackend-cxx/cmppass2-var.lsp | 6 +-- src/h/external.h | 2 + 17 files changed, 105 insertions(+), 78 deletions(-) diff --git a/src/c/assignment.d b/src/c/assignment.d index e18633cbf..81aa4817d 100644 --- a/src/c/assignment.d +++ b/src/c/assignment.d @@ -34,10 +34,31 @@ cl_set(cl_object var, cl_object value) unlikely_if (ecl_t_of(var) != t_symbol) { FEwrong_type_nth_arg(@[set], 1, var, @[symbol]); } + ecl_return1(env, ecl_cmp_setq(env, var, value)); +} + +cl_object +ecl_setq(cl_env_ptr env, cl_object var, cl_object value) +{ + unlikely_if (Null(var)) { + FEconstant_assignment(var); + } + unlikely_if (ecl_t_of(var) != t_symbol) { + FEwrong_type_nth_arg(@[setq], 1, var, @[symbol]); + } + return ecl_cmp_setq(env, var, value); +} + +/* ecl_cmp_setq does the minimal amount of checking necessary to + * implement SETQ for objects that have been checked to be non-null + * symbols by the compiler. */ +cl_object +ecl_cmp_setq(cl_env_ptr env, cl_object var, cl_object value) +{ unlikely_if (var->symbol.stype & ecl_stp_constant) { FEconstant_assignment(var); } - ecl_return1(env, ECL_SETQ(env, var, value)); + return ECL_SETQ(env, var, value); } #ifdef ECL_THREADS @@ -72,18 +93,6 @@ mp_atomic_incf_symbol_value(cl_object var, cl_object increment) } #endif /* ECL_THREADS */ -cl_object -ecl_setq(cl_env_ptr env, cl_object var, cl_object value) -{ - unlikely_if (Null(var)) { - FEconstant_assignment(var); - } - unlikely_if (ecl_t_of(var) != t_symbol) { - FEwrong_type_nth_arg(@[setq], 1, var, @[symbol]); - } - return ECL_SETQ(env, var, value); -} - static cl_object unbound_setf_function_error(cl_narg narg, ...) { diff --git a/src/c/compiler.d b/src/c/compiler.d index 93f665b19..c7004553d 100644 --- a/src/c/compiler.d +++ b/src/c/compiler.d @@ -680,7 +680,7 @@ c_var_ref(cl_env_ptr env, cl_object var, int allow_symbol_macro, bool ensure_def } } if (ensure_defined) { - l = ecl_symbol_value(@'ext::*action-on-undefined-variable*'); + l = ecl_cmp_symbol_value(env, @'ext::*action-on-undefined-variable*'); if (l != ECL_NIL) { funcall(3, l, undefined_variable, var); } @@ -3241,7 +3241,7 @@ ecl_make_lambda(cl_env_ptr env, cl_object name, cl_object lambda) { c_undo_bindings(env, old_c_env->variables, 1); asm_op(env, OP_EXIT); - if (Null(ecl_symbol_value(@'si::*keep-definitions*'))) + if (Null(ecl_cmp_symbol_value(env, @'si::*keep-definitions*'))) lambda = ECL_NIL; output = asm_end(env, handle, lambda); output->bytecodes.name = name; diff --git a/src/c/format.d b/src/c/format.d index 013a3f0c8..9dc5aff56 100644 --- a/src/c/format.d +++ b/src/c/format.d @@ -2194,7 +2194,7 @@ format(format_stack fmt, cl_index start, cl_index end) #endif null_strm = 1; } else if (strm == ECL_T) { - strm = ecl_symbol_value(@'*standard-output*'); + strm = ecl_cmp_symbol_value(the_env, @'*standard-output*'); } if (ecl_stringp(strm)) { output = strm; diff --git a/src/c/load.d b/src/c/load.d index 88e08fb56..3b5efe069 100644 --- a/src/c/load.d +++ b/src/c/load.d @@ -45,7 +45,7 @@ si_load_binary(cl_object filename, cl_object verbose, goto GO_ON; /* Next try to call "init_FILE()" where FILE is the file name */ - prefix = ecl_symbol_value(@'si::*init-function-prefix*'); + prefix = ecl_cmp_symbol_value(the_env, @'si::*init-function-prefix*'); init_prefix = _ecl_library_init_prefix(); if (Null(prefix)) { prefix = init_prefix; @@ -200,11 +200,11 @@ si_load_bytecodes(cl_object source, cl_object verbose, cl_object print, cl_objec } @(defun load (source - &key (verbose ecl_symbol_value(@'*load-verbose*')) - (print ecl_symbol_value(@'*load-print*')) + &key (verbose ecl_cmp_symbol_value(the_env, @'*load-verbose*')) + (print ecl_cmp_symbol_value(the_env, @'*load-print*')) (if_does_not_exist @':error') (external_format @':default') - (search_list ecl_symbol_value(@'si::*load-search-list*')) + (search_list ecl_cmp_symbol_value(the_env, @'si::*load-search-list*')) &aux pathname pntype hooks filename function ok file_kind) bool not_a_filename = 0; @ @@ -222,7 +222,7 @@ si_load_bytecodes(cl_object source, cl_object verbose, cl_object print, cl_objec pntype = pathname->pathname.type; filename = ECL_NIL; - hooks = ecl_symbol_value(@'ext::*load-hooks*'); + hooks = ecl_cmp_symbol_value(the_env, @'ext::*load-hooks*'); if (Null(pathname->pathname.directory) && Null(pathname->pathname.host) && Null(pathname->pathname.device) && @@ -284,8 +284,8 @@ si_load_bytecodes(cl_object source, cl_object verbose, cl_object print, cl_objec cl_format(3, ECL_T, @"~&;;; Loading ~s~%", filename); } - ecl_bds_bind(the_env, @'*package*', ecl_symbol_value(@'*package*')); - ecl_bds_bind(the_env, @'*readtable*', ecl_symbol_value(@'*readtable*')); + ecl_bds_bind(the_env, @'*package*', ecl_cmp_symbol_value(the_env, @'*package*')); + ecl_bds_bind(the_env, @'*readtable*', ecl_cmp_symbol_value(the_env, @'*readtable*')); ecl_bds_bind(the_env, @'*load-pathname*', not_a_filename? ECL_NIL : source); ecl_bds_bind(the_env, @'*load-truename*', not_a_filename? ECL_NIL : (filename = cl_truename(filename))); diff --git a/src/c/macros.d b/src/c/macros.d index e9ce12677..de1d49280 100644 --- a/src/c/macros.d +++ b/src/c/macros.d @@ -102,7 +102,7 @@ search_macro_function(cl_object name, cl_object env) exp_fun = search_macro_function(head, env); } if (!Null(exp_fun)) { - cl_object hook = ecl_symbol_value(@'*macroexpand-hook*'); + cl_object hook = ecl_cmp_symbol_value(the_env, @'*macroexpand-hook*'); if (hook == @'funcall') form = _ecl_funcall3(exp_fun, form, env); else diff --git a/src/c/num_rand.d b/src/c/num_rand.d index 5da8db4cb..afb2b3ee6 100644 --- a/src/c/num_rand.d +++ b/src/c/num_rand.d @@ -320,7 +320,7 @@ ecl_make_random_state(cl_object rs) return z; } -@(defun random (x &optional (rs ecl_symbol_value(@'*random-state*'))) +@(defun random (x &optional (rs ecl_cmp_symbol_value(the_env, @'*random-state*'))) @ rs = ecl_check_cl_type(@'random', rs, t_random); @(return rando(x, rs)); diff --git a/src/c/package.d b/src/c/package.d index aa00c51b4..e6d6e3238 100644 --- a/src/c/package.d +++ b/src/c/package.d @@ -378,9 +378,9 @@ si_coerce_to_package(cl_object p) cl_object ecl_current_package(void) { - cl_object x = ecl_symbol_value(@'*package*'); + const cl_env_ptr env = ecl_process_env(); + cl_object x = ecl_cmp_symbol_value(env, @'*package*'); unlikely_if (!ECL_PACKAGEP(x)) { - const cl_env_ptr env = ecl_process_env(); ECL_SETQ(env, @'*package*', cl_core.user_package); FEerror("The value of *PACKAGE*, ~S, was not a package", 1, x); diff --git a/src/c/pathname.d b/src/c/pathname.d index efeca5cab..3f1c93a66 100644 --- a/src/c/pathname.d +++ b/src/c/pathname.d @@ -724,9 +724,9 @@ si_default_pathname_defaults(void) * coerced to type PATHNAME. Special care is taken so that we do * not enter an infinite loop when using PARSE-NAMESTRING, because * this routine might itself try to use the value of this variable. */ - cl_object path = ecl_symbol_value(@'*default-pathname-defaults*'); + const cl_env_ptr the_env = ecl_process_env(); + cl_object path = ecl_cmp_symbol_value(the_env, @'*default-pathname-defaults*'); unlikely_if (!ECL_PATHNAMEP(path)) { - const cl_env_ptr the_env = ecl_process_env(); ecl_bds_bind(the_env, @'*default-pathname-defaults*', si_getcwd(0)); FEwrong_type_key_arg(@[pathname], @[*default-pathname-defaults*], path, @'pathname'); diff --git a/src/c/print.d b/src/c/print.d index db60fed08..1b2464f22 100644 --- a/src/c/print.d +++ b/src/c/print.d @@ -29,10 +29,11 @@ _ecl_stream_or_default_output(cl_object stream) int ecl_print_base(void) { - cl_object object = ecl_symbol_value(@'*print-base*'); + const cl_env_ptr the_env = ecl_process_env(); + cl_object object = ecl_cmp_symbol_value(the_env, @'*print-base*'); cl_fixnum base; unlikely_if (!ECL_FIXNUMP(object) || (base = ecl_fixnum(object)) < 2 || base > 36) { - ECL_SETQ(ecl_process_env(), @'*print-base*', ecl_make_fixnum(10)); + ECL_SETQ(the_env, @'*print-base*', ecl_make_fixnum(10)); FEerror("The value of *PRINT-BASE*~% ~S~%" "is not of the expected type (INTEGER 2 36)", 1, object); } @@ -42,14 +43,15 @@ ecl_print_base(void) cl_fixnum ecl_print_level(void) { - cl_object object = ecl_symbol_value(@'*print-level*'); + const cl_env_ptr the_env = ecl_process_env(); + cl_object object = ecl_cmp_symbol_value(the_env, @'*print-level*'); cl_fixnum level; if (object == ECL_NIL) { level = MOST_POSITIVE_FIXNUM; } else if (ECL_FIXNUMP(object)) { level = ecl_fixnum(object); if (level < 0) { - ERROR: ECL_SETQ(ecl_process_env(), @'*print-level*', ECL_NIL); + ERROR: ECL_SETQ(the_env, @'*print-level*', ECL_NIL); FEerror("The value of *PRINT-LEVEL*~% ~S~%" "is not of the expected type (OR NULL (INTEGER 0 *))", 1, object); @@ -65,14 +67,15 @@ ecl_print_level(void) cl_fixnum ecl_print_length(void) { - cl_object object = ecl_symbol_value(@'*print-length*'); + const cl_env_ptr the_env = ecl_process_env(); + cl_object object = ecl_cmp_symbol_value(the_env, @'*print-length*'); cl_fixnum length; if (object == ECL_NIL) { length = MOST_POSITIVE_FIXNUM; } else if (ECL_FIXNUMP(object)) { length = ecl_fixnum(object); unlikely_if (length < 0) { - ERROR: ECL_SETQ(ecl_process_env(), @'*print-length*', ECL_NIL); + ERROR: ECL_SETQ(the_env, @'*print-length*', ECL_NIL); FEerror("The value of *PRINT-LENGTH*~% ~S~%" "is not of the expected type (OR NULL (INTEGER 0 *))", 1, object); @@ -94,12 +97,13 @@ ecl_print_radix(void) cl_object ecl_print_case(void) { - cl_object output = ecl_symbol_value(@'*print-case*'); + const cl_env_ptr the_env = ecl_process_env(); + cl_object output = ecl_cmp_symbol_value(the_env, @'*print-case*'); unlikely_if (output != @':upcase' && output != @':downcase' && output != @':capitalize') { - ECL_SETQ(ecl_process_env(), @'*print-case*', @':downcase'); + ECL_SETQ(the_env, @'*print-case*', @':downcase'); FEerror("The value of *PRINT-CASE*~% ~S~%" "is not of the expected type " "(MEMBER :UPCASE :DOWNCASE :CAPITALIZE)", 1, output); @@ -139,21 +143,21 @@ ecl_print_circle(void) @(defun write (x &key ((:stream strm) ECL_NIL) - (array ecl_symbol_value(@'*print-array*')) - (base ecl_symbol_value(@'*print-base*')) - ((:case cas) ecl_symbol_value(@'*print-case*')) - (circle ecl_symbol_value(@'*print-circle*')) - (escape ecl_symbol_value(@'*print-escape*')) - (gensym ecl_symbol_value(@'*print-gensym*')) - (length ecl_symbol_value(@'*print-length*')) - (level ecl_symbol_value(@'*print-level*')) - (lines ecl_symbol_value(@'*print-lines*')) - (miser_width ecl_symbol_value(@'*print-miser-width*')) - (pprint_dispatch ecl_symbol_value(@'*print-pprint-dispatch*')) - (pretty ecl_symbol_value(@'*print-pretty*')) - (radix ecl_symbol_value(@'*print-radix*')) - (readably ecl_symbol_value(@'*print-readably*')) - (right_margin ecl_symbol_value(@'*print-right-margin*'))) + (array ecl_cmp_symbol_value(the_env, @'*print-array*')) + (base ecl_cmp_symbol_value(the_env, @'*print-base*')) + ((:case cas) ecl_cmp_symbol_value(the_env, @'*print-case*')) + (circle ecl_cmp_symbol_value(the_env, @'*print-circle*')) + (escape ecl_cmp_symbol_value(the_env, @'*print-escape*')) + (gensym ecl_cmp_symbol_value(the_env, @'*print-gensym*')) + (length ecl_cmp_symbol_value(the_env, @'*print-length*')) + (level ecl_cmp_symbol_value(the_env, @'*print-level*')) + (lines ecl_cmp_symbol_value(the_env, @'*print-lines*')) + (miser_width ecl_cmp_symbol_value(the_env, @'*print-miser-width*')) + (pprint_dispatch ecl_cmp_symbol_value(the_env, @'*print-pprint-dispatch*')) + (pretty ecl_cmp_symbol_value(the_env, @'*print-pretty*')) + (radix ecl_cmp_symbol_value(the_env, @'*print-radix*')) + (readably ecl_cmp_symbol_value(the_env, @'*print-readably*')) + (right_margin ecl_cmp_symbol_value(the_env, @'*print-right-margin*'))) @ ecl_bds_bind(the_env, @'*print-array*', array); ecl_bds_bind(the_env, @'*print-base*', base); diff --git a/src/c/printer/write_object.d b/src/c/printer/write_object.d index e6559a297..1a8a0d614 100644 --- a/src/c/printer/write_object.d +++ b/src/c/printer/write_object.d @@ -19,8 +19,9 @@ bool _ecl_will_print_as_hash(cl_object x) { - cl_object circle_counter = ecl_symbol_value(@'si::*circle-counter*'); - cl_object circle_stack = ecl_symbol_value(@'si::*circle-stack*'); + const cl_env_ptr the_env = ecl_process_env(); + cl_object circle_counter = ecl_cmp_symbol_value(the_env, @'si::*circle-counter*'); + cl_object circle_stack = ecl_cmp_symbol_value(the_env, @'si::*circle-stack*'); cl_object code = ecl_gethash_safe(x, circle_stack, OBJNULL); if (ECL_FIXNUMP(circle_counter)) { return !(code == OBJNULL || code == ECL_NIL); @@ -44,8 +45,9 @@ _ecl_will_print_as_hash(cl_object x) cl_object si_search_print_circle(cl_object x) { - cl_object circle_counter = ecl_symbol_value(@'si::*circle-counter*'); - cl_object circle_stack = ecl_symbol_value(@'si::*circle-stack*'); + const cl_env_ptr the_env = ecl_process_env(); + cl_object circle_counter = ecl_cmp_symbol_value(the_env, @'si::*circle-counter*'); + cl_object circle_stack = ecl_cmp_symbol_value(the_env, @'si::*circle-stack*'); cl_object code; code = ecl_gethash_safe(x, circle_stack, OBJNULL); @@ -69,8 +71,7 @@ si_search_print_circle(cl_object x) /* This object is referenced twice, but has no code yet */ circle_counter = ecl_make_fixnum(ecl_fixnum(circle_counter) + 1); _ecl_sethash(x, circle_stack, circle_counter); - ECL_SETQ(ecl_process_env(), @'si::*circle-counter*', - circle_counter); + ECL_SETQ(the_env, @'si::*circle-counter*', circle_counter); return ecl_make_fixnum(-ecl_fixnum(circle_counter)); } else { return code; @@ -89,9 +90,9 @@ si_write_object_with_circle(cl_object x, cl_object stream, cl_object print_funct possibly contain cycles */ cl_object circle_counter; cl_fixnum code; - circle_counter = ecl_symbol_value(@'si::*circle-counter*'); + const cl_env_ptr env = ecl_process_env(); + circle_counter = ecl_cmp_symbol_value(env, @'si::*circle-counter*'); if (circle_counter == ECL_NIL) { - cl_env_ptr env = ecl_process_env(); cl_object hash = cl__make_hash_table(@'eq', ecl_make_fixnum(1024), diff --git a/src/c/read.d b/src/c/read.d index 6af306d83..cdeb392c5 100644 --- a/src/c/read.d +++ b/src/c/read.d @@ -1023,7 +1023,7 @@ sharp_dot_reader(cl_object in, cl_object c, cl_object d) if (read_suppress) { @(return ECL_NIL); } - unlikely_if (ecl_symbol_value(@'*read-eval*') == ECL_NIL) + unlikely_if (ecl_cmp_symbol_value(env, @'*read-eval*') == ECL_NIL) FEreader_error("Cannot evaluate the form #.~A", in, 1, c); /* FIXME! We should do something here to ensure that the #. * only uses the #n# that have been defined */ diff --git a/src/c/symbol.d b/src/c/symbol.d index b3c9e79fa..b55d83c6c 100644 --- a/src/c/symbol.d +++ b/src/c/symbol.d @@ -136,6 +136,21 @@ ecl_make_symbol(const char *s, const char *p) cl_object ecl_symbol_value(cl_object s) +{ + if (ecl_unlikely(Null(s))) { + return s; + } + if (ecl_unlikely(ecl_t_of(s) != t_symbol)) { + FEwrong_type_nth_arg(@[symbol-value], 1, s, @[symbol]); + } + return ecl_cmp_symbol_value(ecl_process_env(), s); +} + +/* ecl_cmp_symbol_value does the minimal amount of checking necessary + * to implement SYMBOL-VALUE for objects that have been checked to be + * non-null symbols by the compiler. */ +cl_object +ecl_cmp_symbol_value(cl_env_ptr the_env, cl_object s) { #ifndef ECL_FINAL /* Symbols are not initialized yet. This test is issued only during ECL @@ -144,16 +159,12 @@ ecl_symbol_value(cl_object s) ecl_internal_error("SYMBOL-VALUE: symbols are not initialized yet."); } #endif - if (Null(s)) { - return s; - } else { - /* FIXME: Should we check symbol type? */ - const cl_env_ptr the_env = ecl_process_env(); - cl_object value = ECL_SYM_VAL(the_env, s); - unlikely_if (value == OBJNULL) - FEunbound_variable(s); - return value; + /* FIXME: Should we check symbol type? */ + cl_object value = ECL_SYM_VAL(the_env, s); + if (ecl_unlikely(value == OBJNULL)) { + FEunbound_variable(s); } + return value; } static void diff --git a/src/c/threads/barrier.d b/src/c/threads/barrier.d index 3aaaf39d3..8a3d8a09c 100755 --- a/src/c/threads/barrier.d +++ b/src/c/threads/barrier.d @@ -149,9 +149,9 @@ mp_barrier_wait(cl_object barrier) { barrier->barrier.arrivers_count++; ECL_UNWIND_PROTECT_BEGIN(the_env) { do { - ecl_setq(the_env, ECL_INTERRUPTS_ENABLED, ECL_T); + ECL_SETQ(the_env, ECL_INTERRUPTS_ENABLED, ECL_T); ecl_cond_var_wait(&barrier->barrier.cv, &barrier->barrier.mutex); - ecl_setq(the_env, ECL_INTERRUPTS_ENABLED, ECL_NIL); + ECL_SETQ(the_env, ECL_INTERRUPTS_ENABLED, ECL_NIL); } while(!barrier->barrier.wakeup); wakeup = barrier->barrier.wakeup; if (barrier->barrier.arrivers_count - 1 == 0) { diff --git a/src/c/threads/process.d b/src/c/threads/process.d index b9bd18b00..96ef852b5 100755 --- a/src/c/threads/process.d +++ b/src/c/threads/process.d @@ -765,7 +765,7 @@ mp_block_signals(void) { #ifdef ECL_WINDOWS_THREADS cl_env_ptr the_env = ecl_process_env(); - cl_object previous = ecl_symbol_value(@'ext::*interrupts-enabled*'); + cl_object previous = ecl_cmp_symbol_value(the_env, @'ext::*interrupts-enabled*'); ECL_SETQ(the_env, @'ext::*interrupts-enabled*', ECL_NIL); @(return previous); #else diff --git a/src/c/threads/semaphore.d b/src/c/threads/semaphore.d index a8b542722..75cc973b3 100644 --- a/src/c/threads/semaphore.d +++ b/src/c/threads/semaphore.d @@ -92,9 +92,9 @@ semaphore_wait_unprotected(cl_object semaphore, cl_object count, cl_object timeo ecl_cond_var_t *cv = &semaphore->semaphore.cv; if (timeout == ECL_NIL) { do { - ecl_setq(the_env, ECL_INTERRUPTS_ENABLED, ECL_T); + ECL_SETQ(the_env, ECL_INTERRUPTS_ENABLED, ECL_T); ecl_cond_var_wait(cv, mutex); - ecl_setq(the_env, ECL_INTERRUPTS_ENABLED, ECL_NIL); + ECL_SETQ(the_env, ECL_INTERRUPTS_ENABLED, ECL_NIL); } while (semaphore->semaphore.counter < counter); } else { cl_object deadline = ecl_plus(cl_get_internal_real_time(), diff --git a/src/cmp/cmpbackend-cxx/cmppass2-var.lsp b/src/cmp/cmpbackend-cxx/cmppass2-var.lsp index 3d924b528..af4a3afe1 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-var.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-var.lsp @@ -357,14 +357,14 @@ (LEXICAL (wt-lex var-loc)) ((SPECIAL GLOBAL) (if (safe-compile) - (wt "ecl_symbol_value(" var-loc ")") + (wt "ecl_cmp_symbol_value(cl_env_copy," var-loc ")") (wt "ECL_SYM_VAL(cl_env_copy," var-loc ")"))) (t (wt var-loc)) ))) (defun set-var (loc var &aux (var-loc (var-loc var))) ; ccb (unless (var-p var) - (baboon :format-control "set-var: ~s is not a vairable." + (baboon :format-control "set-var: ~s is not a variable." :format-arguments (list var))) (case (var-kind var) (CLOSURE @@ -377,7 +377,7 @@ (wt #\;)) ((SPECIAL GLOBAL) (if (safe-compile) - (wt-nl "cl_set(" var-loc ",") + (wt-nl "ecl_cmp_setq(cl_env_copy," var-loc ",") (wt-nl "ECL_SETQ(cl_env_copy," var-loc ",")) (wt-coerce-loc (var-rep-type var) loc) (wt ");")) diff --git a/src/h/external.h b/src/h/external.h index 8638a8eeb..3ad3ce805 100755 --- a/src/h/external.h +++ b/src/h/external.h @@ -1733,7 +1733,9 @@ extern ECL_API void ecl_defparameter(cl_object s, cl_object v); extern ECL_API cl_object ecl_make_symbol(const char *s, const char*p); extern ECL_API cl_object ecl_make_keyword(const char *s); extern ECL_API cl_object ecl_symbol_value(cl_object s); +extern ECL_API cl_object ecl_cmp_symbol_value(cl_env_ptr the_env, cl_object s); extern ECL_API cl_object ecl_setq(cl_env_ptr env, cl_object var, cl_object value); +extern ECL_API cl_object ecl_cmp_setq(cl_env_ptr env, cl_object var, cl_object value); extern ECL_API cl_object ecl_symbol_name(cl_object s); extern ECL_API cl_object ecl_symbol_package(cl_object s); extern ECL_API int ecl_symbol_type(cl_object s);