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))) 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)))) 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)