From c20a53921e29bc3a660f85a222173457f9090701 Mon Sep 17 00:00:00 2001 From: Marius Gerbershagen Date: Sat, 7 Mar 2026 17:41:27 +0100 Subject: [PATCH 1/3] cmp: don't handle floats as immediate values for inlining purposes This introduces unneeded boxing of constant values, e.g. in > (disassemble (lambda (x) (< x 4.0))) /* function definition for GAZONK */ /* optimize speed 3, debug 0, space 0, safety 2 */ static cl_object L1c__gazonk(cl_object v1x) { cl_object env0 = ECL_NIL; const cl_env_ptr cl_env_copy = ecl_process_env(); cl_object value0; ecl_cs_check(cl_env_copy,value0); L1:; value0 = ecl_make_bool(ecl_lower(v1x,ecl_make_single_float((float) 4. ))); cl_env_copy->nvalues = 1; return value0; } The same would apply to complex floats if we were to handle them in the same manner. --- src/cmp/cmpbackend-cxx/cmppass2-data.lsp | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/cmp/cmpbackend-cxx/cmppass2-data.lsp b/src/cmp/cmpbackend-cxx/cmppass2-data.lsp index f90d47b17..6c42be9fe 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-data.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-data.lsp @@ -280,10 +280,8 @@ (make-vv :value object :location cname))))) (defun try-immediate-value (value) - ;; FIXME we could inline here also (COMPLEX FLOAT). That requires adding an - ;; emmiter of C complex floats in the function WT1. (cond - ((typep value '(or fixnum character float #|#+complex-float (complex float)|#) *cmp-env*) + ((typep value '(or fixnum character) *cmp-env*) (make-vv :value value :location nil :host-type (lisp-type->host-type (type-of value)))) From 5426270f8b377b8f691a550af56bcbdec1f0273f Mon Sep 17 00:00:00 2001 From: Marius Gerbershagen Date: Sat, 14 Mar 2026 15:39:52 +0100 Subject: [PATCH 2/3] cmp: resurrect a previously removed optimization The optimization allows the compiler to use more precise type information. This can be used to remove unnecessary boxing of variables, see e.g. the disassembly of the following code: (lambda (i) (declare (fixnum i)) (code-char (mod i 128))) The optimization was removed in commit c7da5bc919b47e38179391baf20412d8b335cc4b. The promised FCALL-ARG destination has not been implemented so far, thus we restore the old implementation for now. --- src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp b/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp index 1354e3884..81bacd49c 100644 --- a/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp +++ b/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp @@ -108,6 +108,21 @@ (let ((var-form (make-c1form 'VARIABLE form var nil))) (emit-inlined-temp-var var-form lisp-type (var-host-type var))))))) +(defun emit-inlined-fcall (form) + (let ((args (c1form-arg 1 form)) + (fname (c1form-arg 2 form)) + (call-type (c1form-arg 3 form))) + (if (not (and (eq call-type :global) + (<= (length args) si:c-arguments-limit))) + (emit-inlined-temp-var form t :object) + (let* ((return-type (c1form-primary-type form)) + (fun (find fname *global-funs* :key #'fun-name :test #'same-fname-p)) + (loc (call-global-loc fname fun (inline-args args) return-type)) + (type (type-and return-type (loc-lisp-type loc))) + (temp (make-inlined-temp-var type (loc-host-type loc)))) + (set-loc temp loc) + (precise-loc-lisp-type temp type))))) + (defun emit-inlined-progn (form rest-forms) (let ((args (c1form-arg 0 form))) (loop with *destination* = 'TRASH @@ -137,9 +152,10 @@ (with-c1form-env (form form) (precise-loc-lisp-type (case (c1form-name form) - (LOCATION (c1form-arg 0 form) ) + (LOCATION (c1form-arg 0 form)) (VARIABLE (emit-inlined-variable form forms)) (SETQ (emit-inlined-setq form forms)) + (FCALL (emit-inlined-fcall form)) (PROGN (emit-inlined-progn form forms)) (VALUES (emit-inlined-values form forms)) (t (emit-inlined-temp-var form t :object))) From 66c1bd9b4016e97a6914f6f4a0bf7909076bb812 Mon Sep 17 00:00:00 2001 From: Marius Gerbershagen Date: Sat, 14 Mar 2026 17:07:24 +0100 Subject: [PATCH 3/3] cmp: better handling of type declarations in let forms We were dropping type information in some cases. First, let bindings are implemented by first assigning the result of evaluating the initialization forms to temporary variables and then setting the real variables once all initialization forms have been evaluated. If type declarations for the variables in the let form were present, we were not applying them to the temporary variables. This is particularly problematic for variables which are later on found to be constant. The compiler has become slightly smarter now and will eliminate the variables, leaving only the temporary variables and forgetting the type information in the process. Second, if the type was declared to be read-only, then we were not taking into account type declarations and only relying on the inferred type of the initalization form. --- src/cmp/cmppass1-var.lsp | 52 +++++++++++++++++++++++----------------- 1 file changed, 30 insertions(+), 22 deletions(-) diff --git a/src/cmp/cmppass1-var.lsp b/src/cmp/cmppass1-var.lsp index 225e5a621..ceb76eb2f 100644 --- a/src/cmp/cmppass1-var.lsp +++ b/src/cmp/cmppass1-var.lsp @@ -20,25 +20,32 @@ (c1let/let* 'let* bindings args)) (t (loop :with temp - :for b :in bindings - :if (atom b) - :collect b :into real-bindings :and - :collect b :into names - :else - :collect (setf temp (gensym "LET")) :into temp-names :and - :collect (cons temp (cdr b)) :into temp-bindings :and - :collect (list (car b) temp) :into real-bindings :and - :collect (car b) :into names - :do - (cmpck (member (car names) (cdr names) :test #'eq) - "LET: The variable ~s occurs more than once in the LET." - (car names)) - :finally - (return (c1let/let* 'let* - (nconc temp-bindings real-bindings) - `((declare (ignorable ,@temp-names) - (:read-only ,@temp-names)) - ,@args))))) + :with type-decls = (nth-value 2 (c1body args nil)) + :with temp-type-decls = '() + :for b :in bindings + :if (atom b) + :collect b :into real-bindings :and + :collect b :into names + :else + :collect (setf temp (gensym "LET")) :into temp-names :and + :collect (cons temp (cdr b)) :into temp-bindings :and + :collect (list (car b) temp) :into real-bindings :and + :collect (car b) :into names :and + :do + (ext:when-let ((type-decl (find (car b) type-decls :key #'car :test #'eq))) + (push `(type ,(cdr type-decl) ,temp) + temp-type-decls)) + :do + (cmpck (member (car names) (cdr names) :test #'eq) + "LET: The variable ~s occurs more than once in the LET." + (car names)) + :finally + (return (c1let/let* 'let* + (nconc temp-bindings real-bindings) + `((declare (ignorable ,@temp-names) + (:read-only ,@temp-names) + ,@temp-type-decls) + ,@args))))) (t (c1let/let* 'let bindings args))))) @@ -97,7 +104,9 @@ (if (global-var-p var) (cmpwarn "Found :READ-ONLY declaration for global var ~A" name) - (setf (var-type var) (c1form-primary-type init))) + (setf (var-type var) (type-and + type + (c1form-primary-type init)))) (multiple-value-bind (constantp value) (c1form-constant-p init) (when constantp @@ -130,8 +139,7 @@ :args vars forms body)) (defun c1let-optimize-read-only-vars (all-vars all-forms body) - (loop with base = (list body) - for vars on all-vars + (loop for vars on all-vars for forms on (nconc all-forms (list body)) for var = (first vars) for form = (first forms)