From 9ff1420cf5e5a61f088c48e9df7aa788621d8e84 Mon Sep 17 00:00:00 2001 From: Kris Katterjohn Date: Tue, 27 Jun 2017 18:35:24 -0500 Subject: [PATCH 1/7] Check for a symbol before attempting to bind it in PROGV PROGV was attempting to bind whatever was in its variable list without checking its type. Using either the C-compiler or bytecode compiler/interpreter, the following example would lead to a segfault on my OpenBSD and Linux boxes: > (defun foo () (progv (list 3) (list 3))) FOO > (foo) Condition of type: SEGMENTATION-VIOLATION [...] Now give an error when attempting to bind something that is not a symbol in PROGV (in both the C-compiler and bytecode compiler and interpreter). --- src/c/stacks.d | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/c/stacks.d b/src/c/stacks.d index 885a223b9..2e0c15913 100644 --- a/src/c/stacks.d +++ b/src/c/stacks.d @@ -198,6 +198,8 @@ ecl_progv(cl_env_ptr env, cl_object vars0, cl_object values0) return n; } else { cl_object var = ECL_CONS_CAR(vars); + if (!ECL_SYMBOLP(var)) + FEerror("Not a valid variable name ~S.", 1, var); if (Null(values)) { ecl_bds_bind(env, var, OBJNULL); } else { From 74568641cd71e1628749d583a3f1fdba08fc9a48 Mon Sep 17 00:00:00 2001 From: Kris Katterjohn Date: Tue, 27 Jun 2017 18:42:20 -0500 Subject: [PATCH 2/7] No longer allow LET/LET* to bind constants in bytecode compiler/interpreter LET/LET* were allowed to lexically and dynamically bind constants in the bytecode compiler and interpreter: > (let ((pi 3)) pi) 3 > (progn (defconstant +c+ 'foo) (let ((+c+ 'bar)) +c+)) BAR > (flet ((hello () (format t "hi"))) (let ((t nil)) (declare (special t)) ; Oops, now this returns a string (hello))) "hi" Plus plenty of other ways to wreak havoc on unsuspecting code. CLHS says the behavior is undefined when attempting to bind or assign constant variables (CLHS 3.1.2.1.1.3 and the entry for defconstant). (Well, CLHS 3.4.1 explicitly says that constant variables cannot be used for variables in lambda lists.) The C-compiler gives errors for these sorts of things, and the bytecode compiler and interpreter gives errors when attempting to bind or assign constant variables in lambda expressions, SETQ and various other forms. So the behavior above in LET is inconsistent with both the C-compiler and other parts of the bytecode compiler and interpreter. Now give an error when attempting to bind a constant variable in LET/LET* in the bytecode compiler and interpreter. This also changes the behavior of PROG/PROG* and DESTRUCTURING-BIND so that they give errors when attempting to bind constants as well. --- src/c/compiler.d | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/c/compiler.d b/src/c/compiler.d index b5ee4df47..23fba03c9 100644 --- a/src/c/compiler.d +++ b/src/c/compiler.d @@ -1566,7 +1566,7 @@ c_let_leta(cl_env_ptr env, int op, cl_object args, int flags) { if (!Null(aux)) FEprogram_error_noreturn("LET: Ill formed declaration.",0); } - if (!ECL_SYMBOLP(var)) + if (!ECL_SYMBOLP(var) || (ecl_symbol_type(var) & ecl_stp_constant)) FEillegal_variable_name(var); if (op == OP_PBIND) { compile_form(env, value, FLAG_PUSH); From c9e7326275c954d1572a7acedb519930b34cfaac Mon Sep 17 00:00:00 2001 From: Kris Katterjohn Date: Tue, 27 Jun 2017 18:44:14 -0500 Subject: [PATCH 3/7] No longer allow M-V-B to bind constants in bytecode compiler/interpreter M-V-B was allowed to lexically and dynamically bind constants in the bytecode compiler and interpreter: > (multiple-value-bind (pi rem) (truncate pi) pi) 3 CLHS says the behavior is undefined when attempting to bind or assign constant variables (CLHS 3.1.2.1.1.3 and the entry for defconstant). The C-compiler gives errors for these sorts of things, and the bytecode compiler and interpreter gives errors when attempting to bind or assign constant variables in lambda expressions, LET, SETQ and various other binding/assignment forms. So the behavior above in M-V-B is inconsistent with the C-compiler and other parts of the bytecode compiler and interpreter. Now give an error when attempting to bind a constant variable in M-V-B in the bytecode compiler and interpreter. --- src/c/compiler.d | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/c/compiler.d b/src/c/compiler.d index 23fba03c9..8b53f1d0e 100644 --- a/src/c/compiler.d +++ b/src/c/compiler.d @@ -1702,7 +1702,7 @@ c_multiple_value_bind(cl_env_ptr env, cl_object args, int flags) compile_form(env, value, FLAG_VALUES); for (vars=cl_reverse(vars); n--; ) { cl_object var = pop(&vars); - if (!ECL_SYMBOLP(var)) + if (!ECL_SYMBOLP(var) || (ecl_symbol_type(var) & ecl_stp_constant)) FEillegal_variable_name(var); c_vbind(env, var, n, specials); } From 4e3283706f66e0312c4b2ff34a1f3d14f66278df Mon Sep 17 00:00:00 2001 From: Kris Katterjohn Date: Tue, 27 Jun 2017 18:46:55 -0500 Subject: [PATCH 4/7] No longer allow PROGV to bind constants PROGV was allowed to bind constants in the C-compiler and the bytecode compiler and interpreter, but the behavior would differ between them: > (defun foo () (flet ((memq (item list) (member item list :test #'eq))) (progv (list :test) (list :test-not) (memq 'bar '(bar baz quux))))) FOO > (foo) (BAZ QUUX) > (compile 'foo) FOO > (foo) (BAR BAZ QUUX) CLHS says the behavior is undefined when attempting to bind or assign constant variables (CLHS 3.1.2.1.1.3 and the entry for defconstant). The C-compiler and bytecode compiler and interpreter give errors when attempting to bind or assign constant variables in lambda expressions, LET, SETQ and various other binding/assignment forms. So the behavior above in PROGV is inconsistent. Now give an error when attempting to bind a constant variable in PROGV in the C-compiler and the bytecode compiler and interpreter. --- src/c/stacks.d | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/c/stacks.d b/src/c/stacks.d index 2e0c15913..2ea422038 100644 --- a/src/c/stacks.d +++ b/src/c/stacks.d @@ -198,7 +198,7 @@ ecl_progv(cl_env_ptr env, cl_object vars0, cl_object values0) return n; } else { cl_object var = ECL_CONS_CAR(vars); - if (!ECL_SYMBOLP(var)) + if (!ECL_SYMBOLP(var) || (ecl_symbol_type(var) & ecl_stp_constant)) FEerror("Not a valid variable name ~S.", 1, var); if (Null(values)) { ecl_bds_bind(env, var, OBJNULL); From 9051af7e606cd6e2047188ef171d8cca0a54251f Mon Sep 17 00:00:00 2001 From: Kris Katterjohn Date: Tue, 27 Jun 2017 19:31:52 -0500 Subject: [PATCH 5/7] Rename a constant variable to prevent "make check" failures Commit 745686 prevents LET from binding constant variables, but this sometimes caused a problem during "make check". The problem would only happen sometimes, depending on the order in which the tests were run. cmp.0026.defconstant-warn defines a constant variable named FOO and cmp.0015.setf-expander binds FOO using LET. Now rename the constant variable FOO to +FOO+. "make check" runs fine --- src/tests/normal-tests/compiler.lsp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/tests/normal-tests/compiler.lsp b/src/tests/normal-tests/compiler.lsp index f52870568..71c1ac85a 100644 --- a/src/tests/normal-tests/compiler.lsp +++ b/src/tests/normal-tests/compiler.lsp @@ -564,8 +564,8 @@ (let ((warn nil)) (with-dflet ((c::cmpwarn (setf warn t))) (with-compiler ("aux-compiler.0104.lsp") - '(defconstant foo (list 1 2 3)) - '(print foo))) + '(defconstant +foo+ (list 1 2 3)) + '(print +foo+))) (delete-file "aux-compiler.0104.lsp") (delete-file (compile-file-pathname "aux-compiler.0104.lsp" :type :fas)) warn))) From f5b9430c6c4f9c65852e31f7e0c1a323a7adef57 Mon Sep 17 00:00:00 2001 From: Kris Katterjohn Date: Wed, 28 Jun 2017 14:03:29 -0500 Subject: [PATCH 6/7] Introduce FEbinding_a_constant and use it where appropriate This is for signalling an error about binding a constant variable. This makes the error messages originally in commits 745686, c9e732 and 4e3283 more precise. --- src/c/compiler.d | 8 ++++++-- src/c/error.d | 6 ++++++ src/c/stacks.d | 4 +++- src/h/external.h | 1 + 4 files changed, 16 insertions(+), 3 deletions(-) diff --git a/src/c/compiler.d b/src/c/compiler.d index 8b53f1d0e..de477a188 100644 --- a/src/c/compiler.d +++ b/src/c/compiler.d @@ -1566,8 +1566,10 @@ c_let_leta(cl_env_ptr env, int op, cl_object args, int flags) { if (!Null(aux)) FEprogram_error_noreturn("LET: Ill formed declaration.",0); } - if (!ECL_SYMBOLP(var) || (ecl_symbol_type(var) & ecl_stp_constant)) + if (!ECL_SYMBOLP(var)) FEillegal_variable_name(var); + if (ecl_symbol_type(var) & ecl_stp_constant) + FEbinding_a_constant(var); if (op == OP_PBIND) { compile_form(env, value, FLAG_PUSH); if (ecl_member_eq(var, vars)) @@ -1702,8 +1704,10 @@ c_multiple_value_bind(cl_env_ptr env, cl_object args, int flags) compile_form(env, value, FLAG_VALUES); for (vars=cl_reverse(vars); n--; ) { cl_object var = pop(&vars); - if (!ECL_SYMBOLP(var) || (ecl_symbol_type(var) & ecl_stp_constant)) + if (!ECL_SYMBOLP(var)) FEillegal_variable_name(var); + if (ecl_symbol_type(var) & ecl_stp_constant) + FEbinding_a_constant(var); c_vbind(env, var, n, specials); } c_declare_specials(env, specials); diff --git a/src/c/error.d b/src/c/error.d index 49432bea2..2c42b789c 100644 --- a/src/c/error.d +++ b/src/c/error.d @@ -440,6 +440,12 @@ FEassignment_to_constant(cl_object v) FEprogram_error("SETQ: Tried to assign a value to the constant ~S.", 1, v); } +void +FEbinding_a_constant(cl_object v) +{ + FEprogram_error("The constant ~S is being bound.", 1, v); +} + void FEinvalid_function(cl_object obj) { diff --git a/src/c/stacks.d b/src/c/stacks.d index 2ea422038..3af6d75d5 100644 --- a/src/c/stacks.d +++ b/src/c/stacks.d @@ -198,8 +198,10 @@ ecl_progv(cl_env_ptr env, cl_object vars0, cl_object values0) return n; } else { cl_object var = ECL_CONS_CAR(vars); - if (!ECL_SYMBOLP(var) || (ecl_symbol_type(var) & ecl_stp_constant)) + if (!ECL_SYMBOLP(var)) FEerror("Not a valid variable name ~S.", 1, var); + if (ecl_symbol_type(var) & ecl_stp_constant) + FEbinding_a_constant(var); if (Null(values)) { ecl_bds_bind(env, var, OBJNULL); } else { diff --git a/src/h/external.h b/src/h/external.h index 20fe5dcbc..f85fb74ae 100755 --- a/src/h/external.h +++ b/src/h/external.h @@ -578,6 +578,7 @@ extern ECL_API void FEunbound_variable(cl_object sym) ecl_attr_noreturn; extern ECL_API void FEinvalid_macro_call(cl_object obj) ecl_attr_noreturn; extern ECL_API void FEinvalid_variable(const char *s, cl_object obj) ecl_attr_noreturn; extern ECL_API void FEassignment_to_constant(cl_object v) ecl_attr_noreturn; +extern ECL_API void FEbinding_a_constant(cl_object v) ecl_attr_noreturn; extern ECL_API void FEundefined_function(cl_object fname) ecl_attr_noreturn; extern ECL_API void FEinvalid_function(cl_object obj) ecl_attr_noreturn; extern ECL_API void FEinvalid_function_name(cl_object obj) ecl_attr_noreturn; From 643651e320152b159886e21d25cb1befbfe53ea7 Mon Sep 17 00:00:00 2001 From: Kris Katterjohn Date: Wed, 28 Jun 2017 14:21:28 -0500 Subject: [PATCH 7/7] Move FEillegal_variable_name to error.d and use it where appropriate This was local to compiler.d, but it should also be used in stacks.d. This is used in place of the error message introduced in commit 9ff142. --- src/c/compiler.d | 7 ------- src/c/error.d | 6 ++++++ src/c/stacks.d | 2 +- src/h/external.h | 1 + 4 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/c/compiler.d b/src/c/compiler.d index de477a188..b5025d3ff 100644 --- a/src/c/compiler.d +++ b/src/c/compiler.d @@ -130,7 +130,6 @@ static int c_listA(cl_env_ptr env, cl_object args, int push); static cl_object ecl_make_lambda(cl_env_ptr env, cl_object name, cl_object lambda); -static void FEillegal_variable_name(cl_object) ecl_attr_noreturn; static void FEill_formed_input(void) ecl_attr_noreturn; /* -------------------- SAFE LIST HANDLING -------------------- */ @@ -343,12 +342,6 @@ assert_type_symbol(cl_object v) FEprogram_error_noreturn("Expected a symbol, found ~S.", 1, v); } -static void -FEillegal_variable_name(cl_object v) -{ - FEprogram_error_noreturn("Not a valid variable name ~S.", 1, v); -} - static void FEill_formed_input() { diff --git a/src/c/error.d b/src/c/error.d index 2c42b789c..afe4f0ebd 100644 --- a/src/c/error.d +++ b/src/c/error.d @@ -434,6 +434,12 @@ FEinvalid_variable(const char *s, cl_object obj) FEerror(s, 1, obj); } +void +FEillegal_variable_name(cl_object v) +{ + FEprogram_error("Not a valid variable name ~S.", 1, v); +} + void FEassignment_to_constant(cl_object v) { diff --git a/src/c/stacks.d b/src/c/stacks.d index 3af6d75d5..e74e7efbd 100644 --- a/src/c/stacks.d +++ b/src/c/stacks.d @@ -199,7 +199,7 @@ ecl_progv(cl_env_ptr env, cl_object vars0, cl_object values0) } else { cl_object var = ECL_CONS_CAR(vars); if (!ECL_SYMBOLP(var)) - FEerror("Not a valid variable name ~S.", 1, var); + FEillegal_variable_name(var); if (ecl_symbol_type(var) & ecl_stp_constant) FEbinding_a_constant(var); if (Null(values)) { diff --git a/src/h/external.h b/src/h/external.h index f85fb74ae..b5c3dbb3e 100755 --- a/src/h/external.h +++ b/src/h/external.h @@ -577,6 +577,7 @@ extern ECL_API void FEwrong_index(cl_object function, cl_object a, int which, cl extern ECL_API void FEunbound_variable(cl_object sym) ecl_attr_noreturn; extern ECL_API void FEinvalid_macro_call(cl_object obj) ecl_attr_noreturn; extern ECL_API void FEinvalid_variable(const char *s, cl_object obj) ecl_attr_noreturn; +extern ECL_API void FEillegal_variable_name(cl_object) ecl_attr_noreturn; extern ECL_API void FEassignment_to_constant(cl_object v) ecl_attr_noreturn; extern ECL_API void FEbinding_a_constant(cl_object v) ecl_attr_noreturn; extern ECL_API void FEundefined_function(cl_object fname) ecl_attr_noreturn;