From b1bebbdb2cfb7f1dbf6f305ae658f82e7de46d41 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Wed, 6 Dec 2023 10:28:26 +0100 Subject: [PATCH] cmp: inl: remove the friction between inlined args and locations Previously inlined args were not treated as locations (they were CONS, and later INLINED-ARG). This commit makes inlined args VV instances with an appropriate type assigned. Thanks to that we may use location operations directly on arguments. --- src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp | 20 ++++++++------------ src/cmp/cmpbackend-cxx/cmpc-fun-inl.lsp | 4 ++-- src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp | 20 ++++++++++---------- src/cmp/cmpbackend-cxx/cmpc-opt-printer.lsp | 2 +- src/cmp/cmpbackend-cxx/cmppass2-call.lsp | 4 ++-- src/cmp/cmpglobals.lsp | 1 + src/cmp/cmplocs.lsp | 10 +++++++--- 7 files changed, 31 insertions(+), 30 deletions(-) diff --git a/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp b/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp index 9fc42ca0a..997b6cae0 100644 --- a/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp +++ b/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp @@ -12,14 +12,11 @@ (in-package "COMPILER") -(defstruct (inlined-arg (:constructor %make-inlined-arg)) - loc - type - host-type) - (defun make-inlined-arg (loc lisp-type) - (%make-inlined-arg :loc loc :type lisp-type - :host-type (loc-host-type loc))) + (make-vv :location loc + :value *inline-loc* + :type lisp-type + :host-type (loc-host-type loc))) (defun maybe-open-inline-block () (unless (plusp *inline-blocks*) @@ -35,7 +32,7 @@ (defun coerce-locs (inlined-args &optional types args-to-be-saved) ;; INLINED-ARGS is a list of INLINED-ARG produced by the argument inliner. - ;; The structure contains a location, a lisp type, and the mach rep type. + ;; Each arg is a location, "inlined" means "evaluated in the correct order". ;; ;; ARGS-TO-BE-SAVED is a positional list created by C-INLINE, instructing that ;; the value should be saved in a temporary variable. @@ -47,9 +44,8 @@ ;; - A lisp type (T, INTEGER, STRING, CHARACTER, ...)) ;; (loop with block-opened = nil - for arg in inlined-args - for loc = (inlined-arg-loc arg) - for arg-host-type = (inlined-arg-host-type arg) + for loc in inlined-args + for arg-host-type = (loc-host-type loc) for type in (or types '#1=(:object . #1#)) for i from 0 for host-type = (lisp-type->host-type type) @@ -138,7 +134,7 @@ ;;; ;;; inline-args: -;;; returns a list of pairs (type loc) +;;; returns locations that contain results of evaluating forms ;;; side effects: emits code for temporary variables ;;; ;;; Whoever calls this function must wrap the body in WITH-INLINE-BLOCKS. diff --git a/src/cmp/cmpbackend-cxx/cmpc-fun-inl.lsp b/src/cmp/cmpbackend-cxx/cmpc-fun-inl.lsp index 278ffa734..cdbde60e1 100644 --- a/src/cmp/cmpbackend-cxx/cmpc-fun-inl.lsp +++ b/src/cmp/cmpbackend-cxx/cmpc-fun-inl.lsp @@ -38,7 +38,7 @@ (default-c-inliner fname return-type inlined-args))) (defun default-c-inliner (fname return-type inlined-args) - (let* ((arg-types (mapcar #'inlined-arg-type inlined-args)) + (let* ((arg-types (mapcar #'loc-type inlined-args)) (ii (inline-function fname arg-types return-type))) (and ii (apply-inline-info ii inlined-args)))) @@ -243,7 +243,7 @@ ;;; Whoever calls this function must wrap the body in WITH-INLINE-BLOCKS. (defun negate-argument (argument dest-loc) (let* ((inlined-arg (emit-inline-form argument nil)) - (host-type (inlined-arg-host-type inlined-arg))) + (host-type (loc-host-type inlined-arg))) (apply #'produce-inline-loc (list inlined-arg) (if (eq (loc-host-type dest-loc) :bool) diff --git a/src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp b/src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp index b06723e81..bd2aa16d1 100644 --- a/src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp +++ b/src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp @@ -18,10 +18,10 @@ ;;; cases the compiler may do whatever it wants (and gcc does!) ;;; (define-c-inliner shift (return-type argument orig-shift) - (let* ((arg-type (inlined-arg-type argument)) + (let* ((arg-type (loc-type argument)) (arg-c-type (lisp-type->host-type arg-type)) (return-c-type (lisp-type->host-type return-type)) - (shift (loc-immediate-value (inlined-arg-loc orig-shift)))) + (shift (loc-immediate-value orig-shift))) (if (or (not (c-integer-host-type-p arg-c-type)) (not (c-integer-host-type-p return-c-type))) (produce-inline-loc (list argument orig-shift) '(:object :fixnum) '(:object) @@ -52,8 +52,8 @@ r1)))) (defun inline-binop (expected-type arg1 arg2 consing non-consing) - (let ((arg1-type (inlined-arg-type arg1)) - (arg2-type (inlined-arg-type arg2))) + (let ((arg1-type (loc-type arg1)) + (arg2-type (loc-type arg2))) (if (and (policy-assume-right-type) (c-number-type-p expected-type) (c-number-type-p arg1-type) @@ -82,7 +82,7 @@ consing nil t)))) (defun inline-arith-unop (expected-type arg1 consing non-consing) - (let ((arg1-type (inlined-arg-type arg1))) + (let ((arg1-type (loc-type arg1))) (if (and (policy-assume-right-type) (c-number-type-p expected-type) (c-number-type-p arg1-type)) @@ -98,7 +98,7 @@ (return (make-vv :host-type :fixnum :value 1))) (setf arg1 (pop arguments)) (when (null arguments) - (return (inlined-arg-loc arg1))) + (return arg1)) (setf arg2 (pop arguments)) (when (null arguments) (return (inline-binop return-type arg1 arg2 "ecl_times(#0,#1)" #\*))) @@ -109,7 +109,7 @@ (return (make-vv :host-type :fixnum :value 0))) (setf arg1 (pop arguments)) (when (null arguments) - (return (inlined-arg-loc arg1))) + (return arg1)) (setf arg2 (pop arguments)) (when (null arguments) (return (inline-binop return-type arg1 arg2 "ecl_plus(#0,#1)" #\+))) @@ -133,11 +133,11 @@ (cmperr "The C inliner for (FUNCTION /) expected at most 2 arguments.")) (define-c-inliner float (return-type arg &optional float) - (let ((arg-c-type (lisp-type->host-type (inlined-arg-type arg))) - (flt-c-type (and float (lisp-type->host-type (inlined-arg-type float))))) + (let ((arg-c-type (lisp-type->host-type (loc-type arg))) + (flt-c-type (and float (lisp-type->host-type (loc-type float))))) (if (member arg-c-type '(:float :double :long-double)) (when (or (null float) (eq arg-c-type flt-c-type)) - (inlined-arg-loc arg)) + arg) (when (member flt-c-type '(:float :double :long-double)) (produce-inline-loc (list arg) (list :object) diff --git a/src/cmp/cmpbackend-cxx/cmpc-opt-printer.lsp b/src/cmp/cmpbackend-cxx/cmpc-opt-printer.lsp index b68d56040..5f75d819b 100644 --- a/src/cmp/cmpbackend-cxx/cmpc-opt-printer.lsp +++ b/src/cmp/cmpbackend-cxx/cmpc-opt-printer.lsp @@ -16,7 +16,7 @@ (unless stream (setf stream (emit-inline-form (c1nil) nil))) (multiple-value-bind (foundp value) - (loc-immediate-value-p (inlined-arg-loc expression)) + (loc-immediate-value-p expression) (cond ((and foundp (characterp value)) (produce-inline-loc (list expression stream) diff --git a/src/cmp/cmpbackend-cxx/cmppass2-call.lsp b/src/cmp/cmpbackend-cxx/cmppass2-call.lsp index 6bbf24de9..f9a324a00 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-call.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-call.lsp @@ -48,7 +48,7 @@ (defun c2call-stack (c1form form args values-p) (declare (ignore c1form)) (with-stack-frame (frame) - (let ((loc (inlined-arg-loc (inline-arg0 form args)))) + (let ((loc (inline-arg0 form args))) (let ((*destination* (if values-p 'VALUEZ 'LEAVE))) (dolist (arg args) (c2expr* arg) @@ -90,7 +90,7 @@ (let* ((form-type (c1form-primary-type form)) (function-p (and (subtypep form-type 'function) (policy-assume-right-type))) - (loc (inlined-arg-loc (inline-arg0 form args))) + (loc (inline-arg0 form args)) (args (inline-args args))) (unwind-exit (call-unknown-global-loc loc args function-p)))) diff --git a/src/cmp/cmpglobals.lsp b/src/cmp/cmpglobals.lsp index f62e95c79..a00c76467 100644 --- a/src/cmp/cmpglobals.lsp +++ b/src/cmp/cmpglobals.lsp @@ -29,6 +29,7 @@ (defvar *active-protection* nil) (defvar *pending-actions* nil) (defvar *empty-loc* (gensym)) +(defvar *inline-loc* (gensym)) (defvar *compiler-conditions* '() "This variable determines whether conditions are printed or just accumulated.") diff --git a/src/cmp/cmplocs.lsp b/src/cmp/cmplocs.lsp index ee9b9407d..b1b824f96 100644 --- a/src/cmp/cmplocs.lsp +++ b/src/cmp/cmplocs.lsp @@ -175,9 +175,13 @@ (values t loc)) ((vv-p loc) (let ((value (vv-value loc))) - (if (eq value *empty-loc*) - (values nil nil) - (values t value)))) + (cond + ((eq value *empty-loc*) + (values nil nil)) + ((eq value *inline-loc*) + (loc-immediate-value-p (vv-location loc))) + (t + (values t value))))) ((atom loc) (values nil nil)) ((eq (first loc) 'THE)