diff --git a/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp b/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp index 05d3fd2a3..a915f16b3 100644 --- a/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp +++ b/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp @@ -31,7 +31,7 @@ (defun close-inline-blocks () (loop for i of-type fixnum from 0 below *inline-blocks* - do (wt-nl-close-brace))) + do (wt-nl-close-brace))) (defun coerce-locs (inlined-args &optional types args-to-be-saved) ;; INLINED-ARGS is a list of INLINED-ARG produced by the argument inliner. @@ -82,12 +82,6 @@ (wt-nl (rep-type->c-name out-rep-type) " " var ";") var)))) -(defun save-inline-loc (loc) - (let* ((rep-type (loc-representation-type (second loc))) - (temp (make-inline-temp-var (first loc) rep-type))) - (set-loc temp loc) - temp)) - (defun emit-inlined-variable (form rest-forms) (let ((var (c1form-arg 0 form)) (lisp-type (c1form-primary-type form))) @@ -120,8 +114,8 @@ (defun emit-inlined-progn (form forms) (let ((args (c1form-arg 0 form))) (loop with *destination* = 'TRASH - while (rest args) - do (c2expr* (pop args))) + while (rest args) + do (c2expr* (pop args))) (emit-inline-form (first args) forms))) (defun emit-inlined-values (form forms) @@ -132,8 +126,8 @@ ;; effects in the correct order (append args forms)) (loop with *destination* = 'TRASH - for form in args - do (c2expr* form))))) + for form in args + do (c2expr* form))))) (defun emit-inlined-structure-ref (form rest-forms) (let ((type (c1form-primary-type form))) diff --git a/src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp b/src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp index d5620b9a5..fbcb8d7b7 100644 --- a/src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp +++ b/src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp @@ -93,48 +93,44 @@ (produce-inline-loc (list arg1) '(:object :object) '(:object) consing nil t)))) -(define-c-inliner + (return-type &rest arguments &aux arg1 arg2) - (when (null arguments) - (return (make-vv :rep-type :fixnum :value 0))) - (setf arg1 (pop arguments)) - (when (null arguments) - (return (inlined-arg-loc arg1))) - (loop for arg2 = (pop arguments) - for result = (inline-binop return-type arg1 arg2 "ecl_plus(#0,#1)" #\+) - do (if arguments - (setf arg1 (save-inline-loc result)) - (return result)))) - -(define-c-inliner - (return-type arg1 &rest arguments &aux arg2) - (when (null arguments) - (return (inline-arith-unop return-type arg1 "ecl_negate(#0)" "-(#0)"))) - (loop for arg2 = (pop arguments) - for result = (inline-binop return-type arg1 arg2 "ecl_minus(#0,#1)" #\-) - do (if arguments - (setf arg1 (save-inline-loc result)) - (return result)))) - (define-c-inliner * (return-type &rest arguments &aux arg1 arg2) (when (null arguments) (return (make-vv :rep-type :fixnum :value 1))) (setf arg1 (pop arguments)) (when (null arguments) (return (inlined-arg-loc arg1))) - (loop for arg2 = (pop arguments) - for result = (inline-binop return-type arg1 arg2 "ecl_times(#0,#1)" #\*) - do (if arguments - (setf arg1 (save-inline-loc result)) - (return result)))) + (setf arg2 (pop arguments)) + (when (null arguments) + (return (inline-binop return-type arg1 arg2 "ecl_times(#0,#1)" #\*))) + (cmperr "The C inliner for (FUNCTION *) expected at most 2 arguments.")) + +(define-c-inliner + (return-type &rest arguments &aux arg1 arg2) + (when (null arguments) + (return (make-vv :rep-type :fixnum :value 0))) + (setf arg1 (pop arguments)) + (when (null arguments) + (return (inlined-arg-loc arg1))) + (setf arg2 (pop arguments)) + (when (null arguments) + (return (inline-binop return-type arg1 arg2 "ecl_plus(#0,#1)" #\+))) + (cmperr "The C inliner for (FUNCTION +) expected at most 2 arguments.")) + +(define-c-inliner - (return-type arg1 &rest arguments &aux arg2) + (when (null arguments) + (return (inline-arith-unop return-type arg1 "ecl_negate(#0)" "-(#0)"))) + (setf arg2 (pop arguments)) + (when (null arguments) + (return (inline-binop return-type arg1 arg2 "ecl_minus(#0,#1)" #\-))) + (cmperr "The C inliner for (FUNCTION -) expected at most 2 arguments.")) (define-c-inliner / (return-type arg1 &rest arguments &aux arg2) (when (null arguments) (return (inline-arith-unop return-type arg1 "ecl_divide(ecl_make_fixnum(1),(#0))" "1/(#0)"))) - (loop for arg2 = (pop arguments) - for result = (inline-binop return-type arg1 arg2 "ecl_divide(#0,#1)" #\/) - do (if arguments - (setf arg1 (save-inline-loc result)) - (return result)))) + (setf arg2 (pop arguments)) + (when (null arguments) + (return (inline-binop return-type arg1 arg2 "ecl_divide(#0,#1)" #\/))) + (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->rep-type (inlined-arg-type arg))) diff --git a/src/cmp/cmpopt-num.lsp b/src/cmp/cmpopt-num.lsp index 4a02ab562..03ac67fe8 100644 --- a/src/cmp/cmpopt-num.lsp +++ b/src/cmp/cmpopt-num.lsp @@ -184,6 +184,9 @@ :format-arguments (list operator (or whole (list* operator args))))))))) +;;; INV These compiler macros are expected to be in effect by C inliners +;;; defined for corresponding operators. -- jd 2023-12-04 + (define-compiler-macro * (&whole all &rest args) (simplify-arithmetic '* args all))