From ccd014fef380d1cf57556f65d28a6f2981484f32 Mon Sep 17 00:00:00 2001 From: jgarcia Date: Sat, 17 Jun 2006 16:04:40 +0000 Subject: [PATCH] Make MACROLET safer by blocking all references to local variables and functions. --- src/CHANGELOG | 10 +++++-- src/c/compiler.d | 26 +++++------------- src/c/symbols_list.h | 2 ++ src/c/symbols_list2.h | 2 ++ src/h/external.h | 1 + src/lsp/defmacro.lsp | 63 +++++++++++++++++++++++++++++++++++++++++++ 6 files changed, 83 insertions(+), 21 deletions(-) diff --git a/src/CHANGELOG b/src/CHANGELOG index 92f7bfa44..06471f111 100644 --- a/src/CHANGELOG +++ b/src/CHANGELOG @@ -251,8 +251,14 @@ ECL 0.9i (a) => 1 This has been achieved by merging the C and bytecodes compiler environments. We have tried to implement this questionable feaure in the safest way, so - that references to local variables and functions cause an error at least in - compiled forms. + that references to local variables, functions, blocks and tags cause an error. + > (defun a (x) + (macrolet ((m () x)) + (m))) + In a MACROLET function you tried to access a local variable, X, + from the function in which it appears. + Top level. + >> * Documentation: diff --git a/src/c/compiler.d b/src/c/compiler.d index 2e93511b5..5c8000242 100644 --- a/src/c/compiler.d +++ b/src/c/compiler.d @@ -308,7 +308,8 @@ asm_op2c(register int code, register cl_object o) { } /* - * Note: the following should match the definitions in cmpenv.lsp + * Note: the following should match the definitions in cmp/cmpenv.lsp, as + * well as CMP-ENV-REGISTER-MACROLET (lsp/defmacro.lsp) * * The compiler environment consists of two lists, one stored in * env->variables, the other one stored in env->macros. @@ -1334,29 +1335,16 @@ c_locally(cl_object args, int flags) { static int c_macrolet(cl_object args, int flags) { - cl_object def_list; - cl_object old_macros = ENV->macros; - - /* Pop the list of definitions */ - for (def_list = pop(&args); !endp(def_list); ) { - cl_object definition = pop(&def_list); - cl_object name = pop(&definition); - cl_object arglist = pop(&definition); - cl_object macro, function; - macro = funcall(4, @'si::expand-defmacro', name, arglist, - definition); - function = make_lambda(name, CDDR(macro)); - c_register_macro(name, function); - } - /* Remove declarations */ + cl_object old_env = ENV->macros; + cl_object env = funcall(3, @'si::cmp-env-register-macrolet', pop(&args), + CONS(ENV->variables, ENV->macros)); + ENV->macros = CDR(env); args = c_process_declarations(args); flags = compile_body(args, flags); - ENV->macros = old_macros; - + ENV->macros = old_env; return flags; } - static int c_multiple_value_bind(cl_object args, int flags) { diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index 5896a2f2f..6556ab39e 100644 --- a/src/c/symbols_list.h +++ b/src/c/symbols_list.h @@ -1646,6 +1646,8 @@ cl_symbols[] = { {KEY_ "LINE-BUFFERED", KEYWORD, NULL, -1, OBJNULL}, {KEY_ "FULLY-BUFFERED", KEYWORD, NULL, -1, OBJNULL}, +{SYS_ "CMP-ENV-REGISTER-MACROLET", SI_ORDINARY, NULL, -1, OBJNULL}, + /* Tag for end of list */ {NULL, CL_ORDINARY, NULL, -1, OBJNULL}}; diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h index 5b59456fa..5871b91e6 100644 --- a/src/c/symbols_list2.h +++ b/src/c/symbols_list2.h @@ -1646,6 +1646,8 @@ cl_symbols[] = { {KEY_ "LINE-BUFFERED",NULL}, {KEY_ "FULLY-BUFFERED",NULL}, +{SYS_ "CMP-ENV-REGISTER-MACROLET",NULL}, + /* Tag for end of list */ {NULL,NULL}}; diff --git a/src/h/external.h b/src/h/external.h index d805385d0..69c1e9bea 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -397,6 +397,7 @@ extern cl_object cl_grab_rest_args(cl_va_list args); /* compiler.c */ +extern cl_object si_macrolet_function(cl_object form, cl_object env); extern cl_object si_process_lambda_list(cl_object lambda_list, cl_object context); extern cl_object si_process_lambda(cl_object lambda); extern cl_object si_make_lambda(cl_object name, cl_object body); diff --git a/src/lsp/defmacro.lsp b/src/lsp/defmacro.lsp index fada525ec..0a5e72d63 100644 --- a/src/lsp/defmacro.lsp +++ b/src/lsp/defmacro.lsp @@ -329,3 +329,66 @@ (list* 'let* (cons (list whole list) *dl*) body))) (defun warn (&rest foo) nil) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; MACROLET HELPER +;;; + +(defun cmp-env-for-bytecodes (old-env) + "Produce an environment which is safe to pass to the bytecodes +compiler. We remove all blocks and tags and ensure that +references to local variables will cause an error. This +environment can be used to bytecompile the functions in MACROLET +or SYMBOL-MACRO forms, and also to evaluate other forms." + (declare (si::c-local)) + (flet ((local-var-error-function (name) + #'(lambda (whole env) + (error +"In a MACROLET function you tried to access a local variable, ~A, +from the function in which it appears." name))) + (local-fun-error-function (name) + #'(lambda (whole env) + (error +"In a MACROLET function you tried to access a local function, ~A, +from the function in which it appears." name)))) + (cons (do ((env (car old-env) (cdr env)) + (variables '())) + ((endp env) (nreverse variables)) + (let ((i (car env))) + (if (consp i) + (let ((name (first i))) + (if (not (keywordp name)) + (push (if (second i) + i + (list name 'si::symbol-macro (local-var-error-function name))) + variables)))))) + (do ((env (cdr old-env) (cdr env)) + (macros '())) + ((endp env) (nreverse macros)) + (let ((i (car env))) + (if (consp i) + (push (if (eq (second i) 'SI::MACRO) + i + (list (first i) 'SI:MACRO (local-fun-error-function (first i)))) + macros))))))) + +(defun macrolet-functions (definitions old-env) + (declare (si::c-local)) + (let ((env (cmp-env-for-bytecodes old-env))) + (si::eval-with-env + (cons 'list + (mapcar #'(lambda (x) + (let* ((name (first x)) + (llist (second x)) + (def (cddr x))) + `(list ',name ,(si::expand-defmacro name llist def)))) + definitions)) + env nil t))) + +(defun cmp-env-register-macrolet (definitions old-env) + (let ((macros (cdr old-env))) + (dolist (record (macrolet-functions definitions old-env)) + (push (list (first record) 'si::macro (second record)) + macros)) + (rplacd old-env macros)))