From da4c49cd2f5e118d6b0a8935dafb329cda48700a Mon Sep 17 00:00:00 2001 From: Marius Gerbershagen Date: Sat, 16 Mar 2024 20:00:04 +0100 Subject: [PATCH] cmp: make sure that setf functions are found in the vv in the second pass Only applies for COMPILE calls where the name of a setf function definition will not be equal under the EQ test to the name of the same function at a later call. Thus, we have to use EQUAL to find those names in the vv array. --- src/cmp/cmpbackend-cxx/cmppass2-call.lsp | 2 +- src/cmp/cmpbackend-cxx/cmppass2-data.lsp | 8 ++++---- src/cmp/cmpbackend-cxx/cmppass2-fun.lsp | 4 ++-- src/cmp/cmpbackend-cxx/cmppass2-loc.lsp | 4 ++-- 4 files changed, 9 insertions(+), 9 deletions(-) diff --git a/src/cmp/cmpbackend-cxx/cmppass2-call.lsp b/src/cmp/cmpbackend-cxx/cmppass2-call.lsp index 3e0e2674c..aa9537782 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-call.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-call.lsp @@ -267,4 +267,4 @@ ;;; This version is correct but unnecessarily slow - it goes through ;;; ecl_function_dispatch. wt-fdefinition handles all proper names. (defun call-unknown-global-fun (fname args) - `(CALL-INDIRECT ,(get-object fname) ,(coerce-args args) ,fname nil)) + `(CALL-INDIRECT ,(get-object fname :test #'equal) ,(coerce-args args) ,fname nil)) diff --git a/src/cmp/cmpbackend-cxx/cmppass2-data.lsp b/src/cmp/cmpbackend-cxx/cmppass2-data.lsp index b6422afa5..589a2d145 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-data.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-data.lsp @@ -325,8 +325,8 @@ (setf (vv-location vv) ndx) vv)) -(defun search-vv (object &key permanent (errorp t)) - (let* ((test (if si:*compiler-constants* 'eq 'equal-with-circularity)) +(defun search-vv (object &key permanent (errorp t) test) + (let* ((test (or test (if si:*compiler-constants* 'eq 'equal-with-circularity))) (item (if permanent (find object *permanent-objects* :test test :key #'vv-value) (or (find object *permanent-objects* :test test :key #'vv-value) @@ -335,8 +335,8 @@ (cmperr "Unable to find object ~s." object)) item)) -(defun get-object (object &key (permanent t) (errorp t)) - (or (search-vv object :permanent permanent :errorp nil) +(defun get-object (object &key (permanent t) (errorp t) test) + (or (search-vv object :permanent permanent :errorp nil :test test) (try-inline-core-sym object) (and errorp (cmperr "Unable to find object ~s." object)))) diff --git a/src/cmp/cmpbackend-cxx/cmppass2-fun.lsp b/src/cmp/cmpbackend-cxx/cmppass2-fun.lsp index fe205d0af..31c192d15 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-fun.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-fun.lsp @@ -196,7 +196,7 @@ (mapc #'bind required-lcls requireds) (when fname-in-ihs-p - (let ((fname (get-object (or description fname)))) + (let ((fname (get-object (or description fname) :test #'equal))) (open-inline-block) (setf *ihs-used-p* t) (push 'IHS *unwind-exit*) @@ -306,7 +306,7 @@ (when (and (policy-check-nargs) use-narg) (flet ((wrong-num-arguments () (if fname - (wt " FEwrong_num_arguments(" (get-object fname) ");") + (wt " FEwrong_num_arguments(" (get-object fname :test #'equal) ");") (wt " FEwrong_num_arguments_anonym();")))) (if (and minarg maxarg (= minarg maxarg)) (progn (wt-nl "if (ecl_unlikely(narg!=" minarg "))") diff --git a/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp b/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp index 408c047fe..1ea6e4e0c 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp @@ -156,7 +156,7 @@ (functionp (fdefinition fun-name)))))) (cond ((not safe) - (let ((vv (get-object fun-name))) + (let ((vv (get-object fun-name :test #'equal))) (wt "ecl_fdefinition(" vv ")"))) ((eq name fun-name) ;; #'symbol @@ -167,7 +167,7 @@ (let ((setf-loc (assoc name *setf-definitions*))) (unless setf-loc (let* ((setf-vv (data-empty-loc*)) - (name-vv (get-object name))) + (name-vv (get-object name :test #'equal))) (setf setf-loc (list name setf-vv name-vv)) (push setf-loc *setf-definitions*))) (wt "ECL_CONS_CAR(" (second setf-loc) ")"))))))