diff --git a/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp b/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp index d8e500d9d..181563e96 100644 --- a/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp +++ b/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp @@ -23,7 +23,14 @@ (loop for i of-type fixnum from 0 below *inline-blocks* do (wt-nl-close-brace))) -(defun coerce-locs (inlined-args &optional types args-to-be-saved) +(defun coerce-args (inlined-args) + (mapcar (lambda (loc) + (if (eq (loc-host-type loc) :object) + loc + `(COERCE-LOC :object ,LOC))) + inlined-args)) + +(defun coerce-locs (inlined-args types args-to-be-saved) ;; INLINED-ARGS is a list of INLINED-ARG produced by the argument inliner. ;; Each arg is a location, "inlined" means "evaluated in the correct order". ;; @@ -33,18 +40,17 @@ ;; TYPES is a list of destination types, to which the former values are ;; coerced. The destination type can be: ;; - ;; - A machine rep type (:OBJECT, :FIXNUM, :INT, ...) + ;; - A host type (:OBJECT, :FIXNUM, :INT, :CHAR, ...) ;; - A lisp type (T, INTEGER, STRING, CHARACTER, ...)) ;; (loop with block-opened = nil for loc in inlined-args for arg-host-type = (loc-host-type loc) - for type in (or types '#1=(:object . #1#)) + for type in types for i from 0 for host-type = (lisp-type->host-type type) collect - (cond ((and args-to-be-saved - (member i args-to-be-saved :test #'eql) + (cond ((and (member i args-to-be-saved :test #'eql) (not (loc-movable-p loc))) (let ((lcl (make-lcl-var :host-type host-type))) (wt-nl) diff --git a/src/cmp/cmpbackend-cxx/cmppass2-call.lsp b/src/cmp/cmpbackend-cxx/cmppass2-call.lsp index f9a324a00..7cec2aad9 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-call.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-call.lsp @@ -157,7 +157,7 @@ ;;; (defun call-loc (fname fun args type) (declare (ignore fname)) - `(CALL-NORMAL ,fun ,(coerce-locs args) ,type)) + `(CALL-NORMAL ,fun ,(coerce-args args) ,type)) ;;; ;;; call-global: @@ -252,7 +252,7 @@ ;;; FUNCTION-P: true when we can assume that LOC is the function ;;; (defun call-unknown-global-loc (loc args function-p) - `(CALL-INDIRECT ,loc ,(coerce-locs args) nil ,function-p)) + `(CALL-INDIRECT ,loc ,(coerce-args args) nil ,function-p)) ;;; ;;; call-unknown-global-fun @@ -261,10 +261,10 @@ ;;; ARGS: a list of INLINED-ARGs ;;; (defun call-unknown-global-fun (fname args) - `(CALL-INDIRECT (FDEFINITION ,fname) ,(coerce-locs args) ,fname t)) + `(CALL-INDIRECT (FDEFINITION ,fname) ,(coerce-args args) ,fname t)) #+ (or) ;;; 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-locs args) ,fname nil)) + `(CALL-INDIRECT ,(get-object fname) ,(coerce-args args) ,fname nil)) diff --git a/src/cmp/cmpbackend-cxx/cmppass2-eval.lsp b/src/cmp/cmpbackend-cxx/cmppass2-eval.lsp index ab166ce36..b1f7d0181 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-eval.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-eval.lsp @@ -220,7 +220,7 @@ (t (with-inline-blocks () (let* ((nv (length forms)) - (forms (nreverse (coerce-locs (inline-args forms))))) + (forms (nreverse (coerce-args (inline-args forms))))) ;; By inlining arguments we make sure that VL has no call to funct. ;; Reverse args to avoid clobbering VALUES(0) (wt-nl "cl_env_copy->nvalues = " nv ";") diff --git a/src/cmp/cmpbackend-cxx/cmppass2-var.lsp b/src/cmp/cmpbackend-cxx/cmppass2-var.lsp index 598b2fcd1..a9fbf1d6d 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-var.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-var.lsp @@ -300,7 +300,7 @@ ;; environments, global environments, etc. If we use `(BIND var) ;; as destination, BIND might receive the wrong environment. (with-inline-blocks () - (let ((locs (coerce-locs (inline-args (list form))))) + (let ((locs (coerce-args (inline-args (list form))))) (bind (first locs) var) ;; Notice that we do not need to update *UNWIND-EXIT* because BIND ;; does it for us.