diff --git a/contrib/cl-simd/ecl-sse-core.lisp b/contrib/cl-simd/ecl-sse-core.lisp index fcf3b2a2e..7df19654c 100644 --- a/contrib/cl-simd/ecl-sse-core.lisp +++ b/contrib/cl-simd/ecl-sse-core.lisp @@ -137,8 +137,7 @@ `((defun ,name ,asyms (declare (optimize (speed 0) (debug 0) (safety 1))) (ffi:c-inline ,asyms ,aftypes ,rftype ,(or defun-body call-str) :one-liner t)))) - (def-inline ,name :always ,(mapcar #'inline-arg-type-of arg-types) ,rftype - ,call-str :inline-or-warn t)))) + (def-inline ,name :always ,(mapcar #'inline-arg-type-of arg-types) ,rftype ,call-str)))) (defmacro def-unary-intrinsic (name ret-type insn cost c-name &key (arg-type ret-type) partial result-size immediate-arg) @@ -211,8 +210,7 @@ :one-liner t)) ;; AREF (def-inline ,rm-aref-name :always (t t) ,rftype - ,(fmtr "ecl_row_major_ptr(#0,fixint(#1),~A)" bsize) - :inline-or-warn t) + ,(fmtr "ecl_row_major_ptr(#0,fixint(#1),~A)" bsize)) (def-inline ,rm-aref-name :always (t fixnum) ,rftype ,(fmtr "ecl_row_major_ptr(#0,#1,~A)" bsize)) ;; AREF unsafe @@ -237,8 +235,7 @@ (defsetf ,rm-aref-name ,rm-aset-name) ;; ASET (def-inline ,rm-aset-name :always (t t ,val-type) ,rftype - ,(fmtw "ecl_row_major_ptr(#0,fixint(#1),~A)" bsize) - :inline-or-warn t) + ,(fmtw "ecl_row_major_ptr(#0,fixint(#1),~A)" bsize)) (def-inline ,rm-aset-name :always (t fixnum ,val-type) ,rftype ,(fmtw "ecl_row_major_ptr(#0,#1,~A)" bsize)) ;; ASET unsafe @@ -290,8 +287,7 @@ ,(fmt "(((char*)#~A) + #~A)") :one-liner t)) (def-inline ,name :always (,@prefix-itypes t ,@postfix-itypes) ,rftype - ,(fmt "ecl_to_pointer(#~A)") - :inline-or-warn t) + ,(fmt "ecl_to_pointer(#~A)")) (def-inline ,name :always (,@prefix-itypes t ,@postfix-itypes t) ,rftype ,(fmt "(((char*)ecl_to_pointer(#~A)) + fixint(#~A))")) (def-inline ,name :always (,@prefix-itypes t ,@postfix-itypes fixnum) ,rftype diff --git a/contrib/sockets/sockets.lisp b/contrib/sockets/sockets.lisp index 7a80b40c6..8f3260f35 100755 --- a/contrib/sockets/sockets.lisp +++ b/contrib/sockets/sockets.lisp @@ -210,7 +210,7 @@ containing the whole rest of the given `string', if any." HOST-NAME may also be an IP address in dotted quad notation or some other weird stuff - see getaddrinfo(3) for details." (multiple-value-bind (errno canonical-name addresses aliases) - (c-inline (host-name) (:cstring) + (c-inline (host-name :test #'equalp) (:cstring :object :object) (values :int :object :object :object) " { @@ -247,7 +247,7 @@ other weird stuff - see getaddrinfo(3) for details." ecl_aset(vector,1, ecl_make_fixnum( (ip>>16) & 0xFF)); ecl_aset(vector,2, ecl_make_fixnum( (ip>>8) & 0xFF)); ecl_aset(vector,3, ecl_make_fixnum( ip & 0xFF )); - addresses = cl_adjoin(4, vector, addresses, @':test, @'equalp); + addresses = cl_adjoin(4, vector, addresses, #1, #2); if ( rp->ai_canonname != 0 ) { cl_object alias = ecl_make_simple_base_string( rp->ai_canonname, -1 ); aliases = CONS(alias, aliases); diff --git a/src/c/compiler.d b/src/c/compiler.d index 9be698e23..93f665b19 100644 --- a/src/c/compiler.d +++ b/src/c/compiler.d @@ -2767,6 +2767,9 @@ si_need_to_make_load_form_p(cl_object object) case t_csfloat: case t_cdfloat: case t_clfloat: +#endif +#ifdef ECL_SSE2 + case t_sse_pack: #endif case t_symbol: case t_pathname: diff --git a/src/clos/method.lsp b/src/clos/method.lsp index 7d242f31b..b2ec572eb 100644 --- a/src/clos/method.lsp +++ b/src/clos/method.lsp @@ -143,38 +143,39 @@ (not (member '&allow-other-keys lambda-list))) (let ((x (position '&aux lambda-list))) (setf lambda-list - (append (subseq lambda-list 0 x) - '(&allow-other-keys) - (and x (subseq lambda-list x)) - nil)))) + (append (subseq lambda-list 0 x) + '(&allow-other-keys) + (and x (subseq lambda-list x)) + nil)))) (let* ((copied-variables '()) (ignorable `(declare (ignorable ,@required-parameters))) + (block-name (si:function-block-name name)) (class-declarations - (nconc (when *add-method-argument-declarations* - (loop for name in required-parameters - for type in specializers - when (and (not (eq type t)) (symbolp type)) - do (push `(,name ,name) copied-variables) and - nconc `((type ,type ,name) - (si::no-check-type ,name)))) - (list (list 'si::function-block-name name)) - (cdar declarations))) - (block `(block ,(si::function-block-name name) ,@real-body)) + (nconc (when *add-method-argument-declarations* + (loop for name in required-parameters + for type in specializers + when (and (not (eq type t)) (symbolp type)) + do (push `(,name ,name) copied-variables) and + nconc `((type ,type ,name) + (si::no-check-type ,name)))) + (list (list 'si:function-block-name block-name)) + (cdar declarations))) + (block `(block ,block-name ,@real-body)) (method-lambda - ;; Remove the documentation string and insert the - ;; appropriate class declarations. The documentation - ;; string is removed to make it easy for us to insert - ;; new declarations later, they will just go after the - ;; second of the method lambda. The class declarations - ;; are inserted to communicate the class of the method's - ;; arguments to the code walk. - `(lambda ,lambda-list - ,@(and class-declarations `((declare ,@class-declarations))) - ,ignorable - ,(if copied-variables - `(let* ,copied-variables - ,ignorable - ,block) + ;; Remove the documentation string and insert the + ;; appropriate class declarations. The documentation + ;; string is removed to make it easy for us to insert + ;; new declarations later, they will just go after the + ;; second of the method lambda. The class declarations + ;; are inserted to communicate the class of the method's + ;; arguments to the code walk. + `(lambda ,lambda-list + ,@(and class-declarations `((declare ,@class-declarations))) + ,ignorable + ,(if copied-variables + `(let* ,copied-variables + ,ignorable + ,block) block)))) (values method-lambda declarations documentation)))) diff --git a/src/cmp/cmpbackend-cxx/cmpc-inl-sysfun.lsp b/src/cmp/cmpbackend-cxx/cmpc-inl-sysfun.lsp index 0c57ca0f6..ff1ec496e 100644 --- a/src/cmp/cmpbackend-cxx/cmpc-inl-sysfun.lsp +++ b/src/cmp/cmpbackend-cxx/cmpc-inl-sysfun.lsp @@ -23,9 +23,9 @@ ;;; Here, ARG-TYPE is the list of argument types belonging to the lisp family, ;;; while RETURN-REP-TYPE is a representation type, i.e. the C type of the ;;; output expression. EXPANSION-STRING is a C/C++ expression template, like the -;;; ones used by C-INLINE. Finally, KIND can be :ALWAYS, :SAFE or :UNSAFE, -;;; depending on whether the inline expression should be applied always, in safe -;;; or in unsafe compilation mode, respectively. +;;; ones used by C-INLINE. Finally, KIND can be :ALWAYS or :UNSAFE, depending on +;;; whether the inline expression should be applied always or only in the unsafe +;;; compilation mode, respectively. ;;; (defun inline-information (name safety) @@ -35,15 +35,14 @@ (setf (gethash (list name safety) *inline-information*) value)) (defun %def-inline (name safety arg-types return-rep-type expansion - &key (one-liner t) (exact-return-type nil) (inline-or-warn nil) + &key (one-liner t) (exact-return-type nil) (multiple-values t) &aux arg-rep-types) (setf safety (case safety (:unsafe :inline-unsafe) - (:safe :inline-safe) (:always :inline-always) - (t (error "In DEF-INLINE, wrong value of SAFETY")))) + (t (error "In DEF-INLINE, ~s is a wrong value of SAFETY." safety)))) ;; Ensure we can inline this form. We only inline when the features are ;; there (checked above) and when the C types are part of this machine ;; (checked here). @@ -59,8 +58,6 @@ arg-types)) (when (eq return-rep-type t) (setf return-rep-type :object)) - (when inline-or-warn - (setf (inline-information name 'should-be-inlined) t)) (let* ((return-type (if (and (consp return-rep-type) (eq (first return-rep-type) 'values)) t @@ -76,12 +73,6 @@ ;; :side-effects (not (si:get-sysprop name 'no-side-effects)) :one-liner one-liner :expansion expansion))) - #+(or) - (loop for i in (inline-information name safety) - when (and (equalp (inline-info-arg-types i) arg-types) - (not (equalp return-type (inline-info-return-type i)))) - do (format t "~&;;; Redundand inline definition for ~A~&;;; ~<~A~>~&;;; ~<~A~>" - name i inline-info)) (push inline-info (gethash (list name safety) *inline-information*)))) (defmacro def-inline (&rest args) @@ -333,7 +324,7 @@ (def-inline cl:cons :always (t t) t "CONS(#0,#1)") - (def-inline cl:endp :safe (t) :bool "ecl_endp(#0)") + (def-inline cl:endp :always (t) :bool "ecl_endp(#0)") (def-inline cl:endp :unsafe (t) :bool "#0==ECL_NIL") (def-inline cl:nth :always (t t) t "ecl_nth(ecl_to_size(#0),#1)") @@ -653,6 +644,11 @@ (def-inline cl:boundp :always (t) :bool "ecl_boundp(cl_env_copy,#0)") (def-inline cl:boundp :unsafe ((and symbol (not null))) :bool "ECL_SYM_VAL(cl_env_copy,#0)!=OBJNULL") + (def-inline cl:terpri :always (t) :object "(ecl_terpri(#0))") + (def-inline cl:print :always (t t) :object "(ecl_print(#0,#1))") + (def-inline cl:prin1 :always (t t) :object "(ecl_prin1(#0,#1))") + (def-inline cl:princ :always (t t) :object "(ecl_princ(#0,#1))") + ;; file unixsys.d ;; file sequence.d @@ -815,3 +811,8 @@ (def-inline clos:funcallable-standard-instance-access :unsafe (clos:funcallable-standard-object fixnum) t "(#0)->instance.slots[#1]")) *inline-information*)) + +;;; XXX this should be part of the initializer for the compiler instance (but +;;; currently the compiler is a singleton). +(setf (machine-inline-information *default-machine*) + (make-inline-information *default-machine*)) diff --git a/src/cmp/cmpbackend-cxx/cmpc-inliner.lsp b/src/cmp/cmpbackend-cxx/cmpc-inliner.lsp index e35189339..b73efc7a7 100644 --- a/src/cmp/cmpbackend-cxx/cmpc-inliner.lsp +++ b/src/cmp/cmpbackend-cxx/cmpc-inliner.lsp @@ -14,8 +14,18 @@ (in-package "COMPILER") -(setf (machine-inline-information *default-machine*) - (make-inline-information *default-machine*)) +(defstruct (inline-info) + name ;;; Function name + arg-rep-types ;;; List of representation types for the arguments + return-rep-type ;;; Representation type for the output + arg-types ;;; List of lisp types for the arguments + return-type ;;; Lisp type for the output + exact-return-type ;;; Only use this expansion when the output is + ;;; declared to have a subtype of RETURN-TYPE + multiple-values ;;; Works with all destinations, including VALUES / RETURN + expansion ;;; C template containing the expansion + one-liner ;;; Whether the expansion spans more than one line +) (defun inlined-arg-loc (arg) (second arg)) @@ -47,8 +57,8 @@ ;;; returns NIL if inline expansion of the function is not possible ;;; (defun inline-function (fname arg-types return-type &optional (return-rep-type 'any)) - ;; Those functions that use INLINE-FUNCTION must rebind - ;; the variable *INLINE-BLOCKS*. + ;; Those functions that use INLINE-FUNCTION must rebind the variable + ;; *INLINE-BLOCKS*. (and (inline-possible fname) (not (gethash fname *c2-dispatch-table*)) (let* (;; (dest-rep-type (loc-representation-type *destination*)) @@ -96,38 +106,26 @@ (let ((other (inline-type-matches x types return-type))) (when other (setf output (choose-inline-info output other return-type return-rep-type)))))) - (dolist (x (inline-information fname ':INLINE-SAFE)) - (let ((other (inline-type-matches x types return-type))) - (when other - (setf output (choose-inline-info output other return-type return-rep-type))))) (dolist (x (inline-information fname ':INLINE-ALWAYS)) (let ((other (inline-type-matches x types return-type))) (when other (setf output (choose-inline-info output other return-type return-rep-type))))) - (when (and (null output) - (inline-information fname 'should-be-inlined) - (>= (cmp-env-optimization 'speed) 1)) - (cmpwarn-style "Could not inline call to ~S ~S - performance may be degraded." - fname types)) output)) (defun to-fixnum-float-type (type) - (dolist (i '(FIXNUM DOUBLE-FLOAT SINGLE-FLOAT LONG-FLOAT) - nil) + (dolist (i '(CL:FIXNUM CL:DOUBLE-FLOAT CL:SINGLE-FLOAT CL:LONG-FLOAT) nil) (when (type>= i type) (return i)))) (defun maximum-float-type (t1 t2) - (cond ((null t1) - t2) - ((or (eq t1 'LONG-FLOAT) (eq t2 'LONG-FLOAT)) - 'LONG-FLOAT) - ((or (eq t1 'DOUBLE-FLOAT) (eq t2 'DOUBLE-FLOAT)) - 'DOUBLE-FLOAT) - ((or (eq t1 'SINGLE-FLOAT) (eq t2 'SINGLE-FLOAT)) - 'SINGLE-FLOAT) - (T - 'FIXNUM))) + (macrolet ((try-type (type) + `(and (or (eq t1 ,type) (eq t2 ,type)) + ,type))) + (or (and (null t1) t2) + (try-type 'CL:LONG-FLOAT) + (try-type 'CL:DOUBLE-FLOAT) + (try-type 'CL:SINGLE-FLOAT) + 'CL:FIXNUM))) (defun inline-type-matches (inline-info arg-types return-type) (when (and (not (inline-info-multiple-values inline-info)) @@ -185,17 +183,6 @@ (nreverse rts)) inline-info)))) -(defun c-inline-safe-string (constant-string) - ;; Produce a text representation of a string that can be used - ;; in a C-INLINE form, without triggering the @ or # escape - ;; characters - (c-filtered-string - (concatenate 'string - (loop for c across constant-string - when (member c '(#\# #\@)) - collect c - collect c)))) - (defun produce-inline-loc (inlined-arguments arg-types output-rep-type c-expression side-effects one-liner) (let* (args-to-be-saved diff --git a/src/cmp/cmpbackend-cxx/cmpc-mach.lsp b/src/cmp/cmpbackend-cxx/cmpc-mach.lsp index 5b6161940..c10273eb9 100644 --- a/src/cmp/cmpbackend-cxx/cmpc-mach.lsp +++ b/src/cmp/cmpbackend-cxx/cmpc-mach.lsp @@ -17,8 +17,6 @@ sorted-types inline-information) -;;; FIXME currently all definitions assume C machine (see cmpc-machine.lsp). - (defstruct (rep-type (:constructor %make-rep-type)) (index 0) ; Precedence order in the type list (name t) diff --git a/src/cmp/cmpbackend-cxx/cmpc-opt-ct.lsp b/src/cmp/cmpbackend-cxx/cmpc-opt-ct.lsp index 7cf5550cb..51e5bf39d 100644 --- a/src/cmp/cmpbackend-cxx/cmpc-opt-ct.lsp +++ b/src/cmp/cmpbackend-cxx/cmpc-opt-ct.lsp @@ -24,7 +24,7 @@ :one-liner t :side-effects nil)))) ((floatp name) (let* ((value name) - (type (type-of value)) + (type (type-of value)) (loc-type (case type (cl:single-float 'single-float-value) (cl:double-float 'double-float-value) diff --git a/src/cmp/cmpbackend-cxx/cmpc-opt-inl.lsp b/src/cmp/cmpbackend-cxx/cmpc-opt-inl.lsp index 7bf2e431d..469b53100 100644 --- a/src/cmp/cmpbackend-cxx/cmpc-opt-inl.lsp +++ b/src/cmp/cmpbackend-cxx/cmpc-opt-inl.lsp @@ -14,7 +14,6 @@ ;;; Valid property names for open coded functions are: ;;; :INLINE-ALWAYS -;;; :INLINE-SAFE safe-compile only ;;; :INLINE-UNSAFE non-safe-compile only ;;; ;;; Each property is a list of 'inline-info's, where each inline-info is: @@ -22,12 +21,14 @@ ;;; ;;; For each open-codable function, open coding will occur only if there exits ;;; an appropriate property with the argument types equal to 'types' and with -;;; the return-type equal to 'type'. The third element -;;; is T if and only if side effects may occur by the call of the function. -;;; Even if *DESTINATION* is TRASH, open code for such a function with side -;;; effects must be included in the compiled code. -;;; The forth element is T if and only if the result value is a new Lisp -;;; object, i.e., it must be explicitly protected against GBC. +;;; the return-type equal to 'type'. +;;; +;;; The third element is T if and only if side effects may occur by the call of +;;; the function. Even if *DESTINATION* is TRASH, open code for such a function +;;; with side effects must be included in the compiled code. +;;; +;;; The forth element is T if and only if the result value is a new Lisp object, +;;; i.e., it must be explicitly protected against GBC. (defun make-inline-temp-var (value-type &optional rep-type) (let ((out-rep-type (or rep-type (lisp-type->rep-type value-type)))) @@ -58,10 +59,11 @@ (defun emit-inlined-setq (form rest-forms) (let ((vref (c1form-arg 0 form)) (form1 (c1form-arg 1 form))) - (let ((*destination* vref)) (c2expr* form1)) + (let ((*destination* vref)) + (c2expr* form1)) (if (eq (c1form-name form1) 'LOCATION) (list (c1form-primary-type form1) (c1form-arg 0 form1)) - (emit-inlined-variable (make-c1form 'VAR form vref) rest-forms)))) + (emit-inlined-variable (make-c1form 'VAR form vref nil) rest-forms)))) (defun emit-inlined-call-global (form expected-type) (let* ((fname (c1form-arg 0 form)) @@ -157,8 +159,8 @@ ;;; (defun inline-args (forms) (loop for form-list on forms - for form = (first form-list) - collect (emit-inline-form form (rest form-list)))) + for form = (first form-list) + collect (emit-inline-form form (rest form-list)))) (defun destination-type () (rep-type->lisp-type (loc-representation-type *destination*)) diff --git a/src/cmp/cmpbackend-cxx/cmpc-opt-printer.lsp b/src/cmp/cmpbackend-cxx/cmpc-opt-printer.lsp index 494b97d71..4f4d57858 100644 --- a/src/cmp/cmpbackend-cxx/cmpc-opt-printer.lsp +++ b/src/cmp/cmpbackend-cxx/cmpc-opt-printer.lsp @@ -12,30 +12,7 @@ (in-package "COMPILER") -;;; TODO move mundane inliners to the sysfun database. - -(define-c-inliner terpri (return-type &optional stream) - (produce-inline-loc (list stream) - '(:object) '(:object) - "ecl_terpri(#0)" t t)) - -(define-c-inliner print (return-type value &optional stream) - (produce-inline-loc (list value stream) - '(:object :object) '(:object) - "ecl_print(#0,#1)" t t)) - -(define-c-inliner prin1 (return-type value &optional stream) - (produce-inline-loc (list value stream) - '(:object :object) '(:object) - "ecl_prin1(#0,#1)" t t)) - -#+ (or) -(define-c-inliner princ (return-type expression &optional stream) - (produce-inline-loc (list expression stream) - '(:object :object) '(:object) - "ecl_princ(#0,#1)" t t)) - -(define-c-inliner princ (return-type expression &optional stream) +(define-c-inliner cl:princ (return-type expression &optional stream) (multiple-value-bind (foundp value) (loc-immediate-value-p (inlined-arg-loc expression)) (cond diff --git a/src/cmp/cmpbackend-cxx/cmpc-util.lsp b/src/cmp/cmpbackend-cxx/cmpc-util.lsp index fdfe63f1b..3bde7430f 100644 --- a/src/cmp/cmpbackend-cxx/cmpc-util.lsp +++ b/src/cmp/cmpbackend-cxx/cmpc-util.lsp @@ -10,6 +10,7 @@ (defvar *opened-c-braces* 0) (defvar *emitted-local-funs* nil) +(defvar *inline-information* nil) ;;; Compiled code uses the following kinds of variables: ;;; 1. Vi, declared explicitely, either unboxed or not (*lcl*, next-lcl) @@ -67,7 +68,11 @@ (*temp* 0) (*max-temp* 0) (*next-cfun* 0) - (*last-label* 0)) + (*last-label* 0) + (*inline-information* + (ext:if-let ((r (machine-inline-information *machine*))) + (si:copy-hash-table r) + (make-inline-information *machine*)))) ,@body)) (defun-cached env-var-name (n) eql diff --git a/src/cmp/cmpbackend-cxx/cmpc-wt.lsp b/src/cmp/cmpbackend-cxx/cmpc-wt.lsp index 93dc130f2..85b01f027 100644 --- a/src/cmp/cmpbackend-cxx/cmpc-wt.lsp +++ b/src/cmp/cmpbackend-cxx/cmpc-wt.lsp @@ -210,3 +210,13 @@ (defun c-filtered-string (string &rest args) (with-output-to-string (aux-stream) (apply #'wt-filtered-data string aux-stream :one-liner t args))) + +(defun c-inline-safe-string (constant-string) + ;; Produce a text representation of a string that can be used in a C-INLINE + ;; form, without triggering the @ or # escape characters + (c-filtered-string + (concatenate 'string + (loop for c across constant-string + when (member c '(#\# #\@)) + collect c + collect c)))) diff --git a/src/cmp/cmpbackend-cxx/cmppass2-ffi.lsp b/src/cmp/cmpbackend-cxx/cmppass2-ffi.lsp index b6a628fc7..01342c6b5 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-ffi.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-ffi.lsp @@ -33,25 +33,13 @@ '(progn)) (defun output-clines (output-stream) - (flet ((parse-one-string (s output-stream) - (with-input-from-string (stream s) - (loop for c = (read-char stream nil nil) - while c - do (if (eq c #\@) - (let ((object (handler-case (read stream) - (serious-condition (c) - (cmperr "Unable to parse FFI:CLINES string~& ~S" - s))))) - (let ((*compiler-output1* output-stream)) - (wt (add-object object :permanent t)))) - (write-char c output-stream)))))) - (loop for s in *clines-string-list* - do (terpri output-stream) - do (if (find #\@ s) - (parse-one-string s output-stream) - (write-string s output-stream))) - (terpri output-stream) - (setf *clines-string-list* nil))) + (loop for s in *clines-string-list* + do (terpri output-stream) + do (if (find #\@ s) + (cmperr "The character #\\@ is not allowed in ~s." 'FFI:CLINES) + (write-string s output-stream))) + (terpri output-stream) + (setf *clines-string-list* nil)) ;; ---------------------------------------------------------------------- ;; C/C++ INLINE CODE diff --git a/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp b/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp index 114486c96..d2fb35b35 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp @@ -159,7 +159,7 @@ ;;; FDEFINITION, MAKE-CLOSURE ;;; (defun wt-fdefinition (fun-name) - (let* ((name (si::function-block-name fun-name)) + (let* ((name (si:function-block-name fun-name)) (package (symbol-package name)) (safe (or (not (safe-compile)) (and (or (eq package (find-package "CL")) @@ -385,19 +385,16 @@ (case c (#\@ (let ((object (read s))) - (cond ((and (consp object) (equal (first object) 'RETURN)) - (if (eq output-vars 'VALUES) - (cmperr "User @(RETURN ...) in a C-INLINE form with no output values") - (let ((ndx (or (second object) 0)) - (l (length output-vars))) - (if (< ndx l) - (wt (nth ndx output-vars)) - (cmperr "Used @(RETURN ~D) in a C-INLINE form with ~D output values" - ndx l))))) - (t - (when (and (consp object) (eq (first object) 'QUOTE)) - (setq object (second object))) - (wt (add-object object :permanent t)))))) + (unless (and (consp object) (eq (car object) 'RETURN)) + (cmperr "Used @~s in C-INLINE form. Expected syntax is @(RETURN ...)." object)) + (if (eq output-vars 'VALUES) + (cmperr "Used @(RETURN ...) in a C-INLINE form with no output values.") + (let ((ndx (or (second object) 0)) + (l (length output-vars))) + (if (< ndx l) + (wt (nth ndx output-vars)) + (cmperr "Used @(RETURN ~D) in a C-INLINE form with ~D output values." + ndx l)))))) (#\# (let* ((k (read-char s)) (next-char (peek-char nil s nil nil)) diff --git a/src/cmp/cmpbackend-cxx/cmppass2-special.lsp b/src/cmp/cmpbackend-cxx/cmppass2-special.lsp index d649804cb..3e794287f 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-special.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-special.lsp @@ -18,16 +18,9 @@ (declare (ignore c1form)) (progv symbols values (c2expr body))) -(defun c2function (c1form kind funob fun) - (declare (ignore c1form funob)) - (case kind - (GLOBAL - (unwind-exit `(FDEFINITION ,fun))) - (CLOSURE - ;; XXX: we have some code after baboon – is CLOSURE legal or not? - (baboon :format-control "c2function: c1form is of unexpected kind.") - (new-local fun) - (unwind-exit `(MAKE-CCLOSURE ,fun))))) +(defun c2function (c1form fname) + (declare (ignore c1form)) + (unwind-exit `(FDEFINITION ,fname))) ;;; Mechanism for sharing code. (defun new-local (fun) diff --git a/src/cmp/cmpbackend-cxx/cmppass2-var.lsp b/src/cmp/cmpbackend-cxx/cmppass2-var.lsp index ae1ec2e09..3d924b528 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-var.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-var.lsp @@ -133,10 +133,15 @@ ;; 6) Close the C expression. (close-inline-blocks))) -(defun c2var/location (c1form loc) - #+(or) (unwind-exit loc) +(defun c2location (c1form loc) (unwind-exit (precise-loc-type loc (c1form-primary-type c1form)))) +;;; When LOC is not NIL, then the variable is a constant. +(defun c2var (c1form var loc) + (if loc + (c2location loc (c1form-arg 0 loc)) + (c2location c1form var))) + (defun c2setq (c1form vref form) (declare (ignore c1form)) ;; First comes the assignement @@ -144,7 +149,7 @@ (c2expr* form)) ;; Then the returned value (if (eq (c1form-name form) 'LOCATION) - (c2var/location form (c1form-arg 0 form)) + (c2location form (c1form-arg 0 form)) (unwind-exit vref))) (defun c2progv (c1form symbols values body) diff --git a/src/cmp/cmpclos.lsp b/src/cmp/cmpclos.lsp index 20a3011cb..58a4ecc6c 100644 --- a/src/cmp/cmpclos.lsp +++ b/src/cmp/cmpclos.lsp @@ -101,7 +101,7 @@ (when (typep reader 'clos:standard-reader-method) (let* ((slotd (clos:accessor-method-slot-definition reader)) (index (clos::safe-slot-definition-location slotd))) - (when (si::fixnump index) + (when (ext:fixnump index) `(clos::safe-instance-ref ,object ,index)))))))) (defun try-optimize-slot-writer (orig-writers args) @@ -113,7 +113,7 @@ (when (typep writer 'clos:standard-writer-method) (let* ((slotd (clos:accessor-method-slot-definition writer)) (index (clos::safe-slot-definition-location slotd))) - (when (si::fixnump index) + (when (ext:fixnump index) `(si::instance-set ,(second args) ,index ,(first args))))))))) #+(or) diff --git a/src/cmp/cmpfun.lsp b/src/cmp/cmpfun.lsp index 7b1908496..dc3100892 100644 --- a/src/cmp/cmpfun.lsp +++ b/src/cmp/cmpfun.lsp @@ -166,10 +166,12 @@ The function thus belongs to the type of functions that ecl_make_cfun accepts." ;;; searches for a (FUNCTION-BLOCK-NAME ...) declaration (defun function-block-name-declaration (declarations) (loop for i in declarations - if (and (consp i) (eql (car i) 'si::function-block-name) - (consp (cdr i))) - return (cadr i) - finally (return nil))) + do (when (and (consp i) (eql (car i) 'si:function-block-name)) + (let ((name (second i)) + (rest (cddr i))) + (unless (and (symbolp name) (null rest)) + (cmperr "Invalid ~s declaration:~%~s" 'si:function-block-name i)) + (return name))))) (defun exported-fname (name) (let (cname) diff --git a/src/cmp/cmpglobals.lsp b/src/cmp/cmpglobals.lsp index 98078ea82..7b52c3826 100644 --- a/src/cmp/cmpglobals.lsp +++ b/src/cmp/cmpglobals.lsp @@ -22,7 +22,6 @@ (defvar *inline-max-depth* 3 "Depth at which inlining of functions stops.") -(defvar *inline-information* nil) ;;; --cmputil.lsp-- ;;; @@ -33,6 +32,7 @@ (defvar *compile-file-position* -1) (defvar *active-protection* nil) (defvar *pending-actions* nil) +(defvar *empty-loc* (gensym)) (defvar *compiler-conditions* '() "This variable determines whether conditions are printed or just accumulated.") @@ -266,9 +266,5 @@ be deleted if they have been opened with LoadLibrary.") (*clines-string-list* '()) (si::*defun-inline-hook* 'maybe-install-inline-function) (*machine* (or *machine* *default-machine*)) - (*optimizable-constants* (make-optimizable-constants *machine*)) - (*inline-information* - (ext:if-let ((r (machine-inline-information *machine*))) - (si:copy-hash-table r) - (make-inline-information *machine*))))) + (*optimizable-constants* (make-optimizable-constants *machine*)))) diff --git a/src/cmp/cmplocs.lsp b/src/cmp/cmplocs.lsp index 46b07d087..04e6f5388 100644 --- a/src/cmp/cmplocs.lsp +++ b/src/cmp/cmplocs.lsp @@ -24,11 +24,13 @@ (permanent-p t) (value nil)) +;;; When the value is the "empty location" then it was created to be filled +;;; later and the real type of the object is not known. See DATA-EMPTY-LOC. (defun vv-type (loc) (let ((value (vv-value loc))) - (if (and value (not (ext:fixnump value))) - (type-of value) - t))) + (if (eq value *empty-loc*) + t + (type-of value)))) (defun loc-movable-p (loc) (if (atom loc) @@ -225,7 +227,7 @@ (values t loc)) ((vv-p loc) (let ((value (vv-value loc))) - (if (or (null value) (ext:fixnump value)) + (if (eq value *empty-loc*) (values nil nil) (values t value)))) ((atom loc) diff --git a/src/cmp/cmpopt-cons.lsp b/src/cmp/cmpopt-cons.lsp index acf9b9920..6b83d210e 100644 --- a/src/cmp/cmpopt-cons.lsp +++ b/src/cmp/cmpopt-cons.lsp @@ -6,40 +6,11 @@ ;;;; ;;;; Copyright (c) 2010, Juan Jose Garcia-Ripoll ;;;; -;;;; This program is free software; you can redistribute it and/or -;;;; modify it under the terms of the GNU Library General Public -;;;; License as published by the Free Software Foundation; either -;;;; version 2 of the License, or (at your option) any later version. +;;;; See the file 'LICENSE' for the copyright details. ;;;; -;;;; See file '../Copyright' for full details. (in-package "COMPILER") -(defun expand-simple-optimizer (values arg-types inline-form env) - (declare (si::c-local)) - `(ffi:c-inline ,(if (policy-assume-right-type env) - values - (loop for v in values - for value-and-type in arg-types - collect (if (consp value-and-type) - `(ext:checked-value ,(second value-and-type) ,v) - v))) - ,@inline-form)) - -(defun simple-optimizer-function (name args inline-form) - (declare (si::c-local)) - (si:put-sysprop - name 'si::compiler-macro - (if (every #'symbolp args) - #'(lambda (whole env) - (if (policy-inline-accessors env) - `(ffi:c-inline ,(rest whole) ,@inline-form) - whole)) - #'(lambda (whole env) - (if (policy-inline-accessors env) - (expand-simple-optimizer (rest whole) args inline-form env) - whole))))) - (defun si:cons-car (x) (declare (type cons x) (optimize (safety 0) (speed 3))) (car x)) @@ -74,16 +45,25 @@ ;;; RPLACA / RPLACD ;;; -(defmacro define-simple-optimizer (name args &rest inline-form) - `(simple-optimizer-function ',name ',args ',inline-form)) +(define-compiler-macro rplaca (&whole whole place value) + (if (policy-inline-accessors) + `(ffi:c-inline (,(if (policy-assume-right-type) + place + `(ext:checked-value cons ,place)) + ,value) + (:object :object) :object + "(ECL_CONS_CAR(#0)=#1,#0)" :one-liner t) + whole)) -(define-simple-optimizer rplaca ((c cons) value) - (:object :object) :object - "@0;(ECL_CONS_CAR(#0)=#1,#0)" :one-liner t) - -(define-simple-optimizer rplacd ((c cons) value) - (:object :object) :object - "@0;(ECL_CONS_CDR(#0)=#1,#0)" :one-liner t) +(define-compiler-macro rplacd (&whole whole place value) + (if (policy-inline-accessors) + `(ffi:c-inline (,(if (policy-assume-right-type) + place + `(ext:checked-value cons ,place)) + ,value) + (:object :object) :object + "(ECL_CONS_CDR(#0)=#1,#0)" :one-liner t) + whole)) ;;; ;;; NTH / NTHCDR diff --git a/src/cmp/cmpopt-sequence.lsp b/src/cmp/cmpopt-sequence.lsp index e6f793572..f61dfc0fb 100644 --- a/src/cmp/cmpopt-sequence.lsp +++ b/src/cmp/cmpopt-sequence.lsp @@ -57,7 +57,7 @@ `(let* ((%seq ,seq) (%iterator ,iterator)) (declare (optimize (safety 0))) - (if (si::fixnump %iterator) + (if (ext:fixnump %iterator) ;; Fixnum iterators are always fine (aref %seq %iterator) ;; Error check in case we may have been passed an improper list diff --git a/src/cmp/cmpopt.lsp b/src/cmp/cmpopt.lsp index a3b66d992..edcc46298 100644 --- a/src/cmp/cmpopt.lsp +++ b/src/cmp/cmpopt.lsp @@ -87,9 +87,9 @@ type (first type)) 'SI::DEFTYPE-DEFINITION)) - (expand-typep form object `',(funcall function (if (atom type) - nil - (rest type))) + (expand-typep form object `(quote ,(funcall function (if (atom type) + nil + (rest type)))) env)) ;; ;; There exists a function which checks for this type? @@ -162,7 +162,8 @@ ;; Compound COMPLEX types. ((and (eq first 'COMPLEX) (= (list-length type) 2)) - `(and (typep (realpart ,object) ',(second type)) + `(and (complexp ,object) + (typep (realpart ,object) ',(second type)) (typep (imagpart ,object) ',(second type)))) ;; ;; (SATISFIES predicate) diff --git a/src/cmp/cmppass1-data.lsp b/src/cmp/cmppass1-data.lsp index e990a1680..beb2eb013 100644 --- a/src/cmp/cmppass1-data.lsp +++ b/src/cmp/cmppass1-data.lsp @@ -77,7 +77,7 @@ (maybe-init location init-form))))))) (defun data-empty-loc () - (add-object 0 :duplicate t :permanent t)) + (add-object *empty-loc* :duplicate t :permanent t)) ;;; Note that we can't use GET-OBJECT to probe for referenced objects because ;;; ADD-OBJECT (when failed and :DUPLICATE is T) may return an object that is diff --git a/src/cmp/cmppass1-eval.lsp b/src/cmp/cmppass1-eval.lsp index 5060b47c3..e8ea796f1 100644 --- a/src/cmp/cmppass1-eval.lsp +++ b/src/cmp/cmppass1-eval.lsp @@ -24,10 +24,16 @@ ((eq form t) (c1t)) ((keywordp form) (make-c1form* 'LOCATION :type (object-type form) - :args (add-symbol form))) - ((and (constantp form *cmp-env*) - (c1constant-value (symbol-value form)))) - (t (c1var form)))) + :args (add-symbol form))) + ((constantp form *cmp-env*) + ;; FIXME the compiler inlines some constants in the first pass. + ;; This is about to be addressed soon. For now we respect that. + (let ((value (symbol-value form))) + (if (assoc value *optimizable-constants*) + (c1constant-symbol-value form value) + (c1var form (c1constant-symbol-value form value))))) + (t + (c1var form nil)))) ((consp form) (cmpck (not (si:proper-list-p form)) "Improper list found in lisp form~%~A" form) @@ -150,6 +156,12 @@ :args (add-object val))) (t nil))) +;;; To inline a constant it must be possible to externalize its value or copies +;;; of the value must be EQL to each other. +(defun c1constant-symbol-value (name val) + (declare (ignore name)) + (c1constant-value val)) + #+sse2 (defun c1constant-value/sse (value) (let* ((bytes (ext:sse-pack-to-vector value '(unsigned-byte 8))) diff --git a/src/cmp/cmppass1-ffi.lsp b/src/cmp/cmppass1-ffi.lsp index bc9ffa75d..9d7792282 100644 --- a/src/cmp/cmppass1-ffi.lsp +++ b/src/cmp/cmppass1-ffi.lsp @@ -175,6 +175,6 @@ `(progn (defun ,name ,(reverse arg-variables) ,@body) (si:put-sysprop ',name :callback - (ffi:c-inline () () :object - ,(format nil "ecl_make_foreign_data(@':pointer-void,0,(void*)~a)" c-name) + (ffi:c-inline (:pointer-void) (:object) :object + ,(format nil "ecl_make_foreign_data(#0,0,(void*)~a)" c-name) :one-liner t))))))) diff --git a/src/cmp/cmppass1-special.lsp b/src/cmp/cmppass1-special.lsp index e40b681ae..ffe886698 100644 --- a/src/cmp/cmppass1-special.lsp +++ b/src/cmp/cmppass1-special.lsp @@ -64,17 +64,16 @@ (defun c1function (args) (check-args-number 'FUNCTION args 1 1) (let ((fun (car args))) - (cond ((si::valid-function-name-p fun) - (let ((funob (local-function-ref fun t))) - (if funob - (let* ((var (fun-var funob))) - (add-to-read-nodes var (make-c1form* 'VAR :args var))) - (make-c1form* 'FUNCTION - :type 'FUNCTION - :sp-change (not (and (symbolp fun) - (si:get-sysprop fun 'NO-SP-CHANGE))) - :args 'GLOBAL nil fun)))) - ((and (consp fun) (member (car fun) '(LAMBDA EXT::LAMBDA-BLOCK))) + (cond ((si:valid-function-name-p fun) + (ext:if-let ((funob (local-function-ref fun t))) + (let ((var (fun-var funob))) + (add-to-read-nodes var (make-c1form* 'VAR :args var nil))) + (make-c1form* 'FUNCTION + :type 'FUNCTION + :sp-change (not (and (symbolp fun) + (si:get-sysprop fun 'NO-SP-CHANGE))) + :args fun))) + ((and (consp fun) (member (car fun) '(LAMBDA EXT:LAMBDA-BLOCK))) (cmpck (endp (cdr fun)) "The lambda expression ~s is illegal." fun) (let (name body) diff --git a/src/cmp/cmppass1-var.lsp b/src/cmp/cmppass1-var.lsp index 0d41aae6c..7cb28fb53 100644 --- a/src/cmp/cmppass1-var.lsp +++ b/src/cmp/cmppass1-var.lsp @@ -242,11 +242,12 @@ :kind kind :ignorable ignorable :ref 0))))) -(defun c1var (name) +;;; When LOC is not NIL then we deal with a constant. +(defun c1var (name loc) (let* ((var (c1vref name)) (output (make-c1form* 'VAR :type (var-type var) - :args var))) + :args var loc))) (add-to-read-nodes var output) output)) diff --git a/src/cmp/cmpprop.lsp b/src/cmp/cmpprop.lsp index 4021f05a2..bcd30adfc 100644 --- a/src/cmp/cmpprop.lsp +++ b/src/cmp/cmpprop.lsp @@ -51,11 +51,12 @@ (declare (ignore rest)) (c1form-type form)) -(defun p1var (form var) - (let* (;; Use the type of C1FORM because it might have been - ;; coerced by a THE form. +(defun p1var (form var loc) + ;; Use the type of C1FORM because it might have been coerced by a THE form. + (let* ((loc-type (if loc (values-type-primary-type (p1propagate loc)) t)) (var-type (var-type var)) - (type (type-and var-type (c1form-primary-type form)))) + (type (type-and (type-and loc-type var-type) + (c1form-primary-type form)))) (prop-message "~&;;; Querying variable ~A gives ~A" (var-name var) type) type)) diff --git a/src/cmp/cmptables.lsp b/src/cmp/cmptables.lsp index 739c4fc85..b9e618481 100644 --- a/src/cmp/cmptables.lsp +++ b/src/cmp/cmptables.lsp @@ -24,7 +24,7 @@ (CL:PROGN body :pure) ;; sub-level forms (LOCATION loc :pure :single-valued) - (VAR var :single-valued) + (VAR var value :single-valued) (CL:SETQ var value-c1form :side-effects) (CL:PSETQ var-list value-c1form-list :side-effects) (CL:BLOCK blk-var progn-c1form :pure) @@ -62,7 +62,7 @@ (CL:MULTIPLE-VALUE-SETQ vars-list values-c1form-list :side-effects) (CL:MULTIPLE-VALUE-BIND vars-list init-c1form body :pure) - (CL:FUNCTION (GLOBAL/CLOSURE) lambda-form fun-object :single-valued) + (CL:FUNCTION fname :single-valued) (CL:RPLACD (dest-c1form value-c1form) :side-effects) (SI:STRUCTURE-REF struct-c1form type-name slot-index (:UNSAFE/NIL) :pure) @@ -240,8 +240,8 @@ (cl:tagbody . c2tagbody) (cl:go . c2go) - (var . c2var/location) - (location . c2var/location) + (var . c2var) + (location . c2location) (cl:setq . c2setq) (cl:progv . c2progv) (cl:psetq . c2psetq) diff --git a/src/cmp/cmptype.lsp b/src/cmp/cmptype.lsp index 7fe8c6598..59109714d 100644 --- a/src/cmp/cmptype.lsp +++ b/src/cmp/cmptype.lsp @@ -42,20 +42,18 @@ (defun default-init (var &optional warn) (declare (ignore warn)) (let ((new-value (cdr (assoc (var-type var) - '((fixnum . 0) + `((fixnum . 0) (character . #\space) (long-float . 0.0L1) (double-float . 0.0D1) (single-float . 0.0F1) - #+complex-float - (si:complex-single-float . #c(0.0f0 0.0f0)) - #+complex-float - (si:complex-double-float . #c(0.0d0 0.0d0)) - #+complex-float - (si:complex-single-float . #c(0.0l0 0.0l0))) + ,@(when (member :complex-float *features*) + '((si:complex-single-float . #c(0.0f0 0.0f0)) + (si:complex-double-float . #c(0.0d0 0.0d0)) + (si:complex-single-float . #c(0.0l0 0.0l0))))) :test #'subtypep)))) (if new-value - (c1constant-value new-value) + (c1constant-value new-value :always t) (c1nil)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/src/cmp/cmptypes.lsp b/src/cmp/cmptypes.lsp index 053bc99c7..73c6cbdf8 100644 --- a/src/cmp/cmptypes.lsp +++ b/src/cmp/cmptypes.lsp @@ -49,16 +49,3 @@ (format t "~% ~D > ~A, parent ~A" *c1form-level* form (c1form-parents form)) (print-c1forms (c1form-args form)) form))) - -(defstruct (inline-info) - name ;;; Function name - arg-rep-types ;;; List of representation types for the arguments - return-rep-type ;;; Representation type for the output - arg-types ;;; List of lisp types for the arguments - return-type ;;; Lisp type for the output - exact-return-type ;;; Only use this expansion when the output is - ;;; declared to have a subtype of RETURN-TYPE - multiple-values ;;; Works with all destinations, including VALUES / RETURN - expansion ;;; C template containing the expansion - one-liner ;;; Whether the expansion spans more than one line -) diff --git a/src/cmp/load.lsp.in b/src/cmp/load.lsp.in index 4d0458811..2ee92144f 100644 --- a/src/cmp/load.lsp.in +++ b/src/cmp/load.lsp.in @@ -48,9 +48,10 @@ "src:cmp;cmpbackend-cxx;cmpc-util.lsp" "src:cmp;cmpbackend-cxx;cmpc-mach.lsp" "src:cmp;cmpbackend-cxx;cmpc-wt.lsp" - "src:cmp;cmpbackend-cxx;cmpc-inl-sysfun.lsp" - "src:cmp;cmpbackend-cxx;cmpc-inl-lspfun.lsp" "src:cmp;cmpbackend-cxx;cmpc-inliner.lsp" + ;; Inliner definitions + "src:cmp;cmpbackend-cxx;cmpc-inl-lspfun.lsp" + "src:cmp;cmpbackend-cxx;cmpc-inl-sysfun.lsp" "src:cmp;cmpbackend-cxx;cmpc-opt-inl.lsp" "src:cmp;cmpbackend-cxx;cmpc-opt-num.lsp" "src:cmp;cmpbackend-cxx;cmpc-opt-ct.lsp" diff --git a/src/lsp/ffi.lsp b/src/lsp/ffi.lsp index 017aaaa99..894c9642f 100644 --- a/src/lsp/ffi.lsp +++ b/src/lsp/ffi.lsp @@ -477,12 +477,13 @@ translate ASCII and binary strings." Converts a Lisp string to a foreign string. Memory should be freed with free-foreign-object." - (let ((lisp-string (string string-designator))) - (c-inline (lisp-string) (t) t + (let ((lisp-string (string string-designator)) + (foreign-type '(* :char))) + (c-inline (lisp-string foreign-type) (t t) t "{ cl_object lisp_string = #0; cl_index size = lisp_string->base_string.fillp; - cl_object output = ecl_allocate_foreign_data(@(* :char), size+1); + cl_object output = ecl_allocate_foreign_data(#1, size+1); memcpy(output->foreign.data, lisp_string->base_string.self, size); output->foreign.data[size] = '\\0'; @(return) = output; diff --git a/src/lsp/top.lsp b/src/lsp/top.lsp index 4d602e5b3..efa2c48e1 100644 --- a/src/lsp/top.lsp +++ b/src/lsp/top.lsp @@ -843,7 +843,7 @@ Use special code 0 to cancel this operation.") #-ecl-min (defun decode-env-elt (env ndx) - (ffi:c-inline (env ndx) (:object :fixnum) :object + (ffi:c-inline (env ndx :utf-8) (:object :fixnum :object) :object " cl_object v = #0; cl_index ndx = #1; @@ -851,7 +851,7 @@ Use special code 0 to cancel this operation.") pinfo d = (pinfo)(v->vector.self.t[1]) + ndx; cl_object name; #ifdef ECL_UNICODE - name = ecl_decode_from_cstring(d->name,-1,@:utf-8); + name = ecl_decode_from_cstring(d->name,-1,#2); if (!name) #endif name = ecl_make_constant_base_string(d->name,-1); diff --git a/src/tests/normal-tests/compiler.lsp b/src/tests/normal-tests/compiler.lsp index 9d7dfb405..fed4dbe93 100644 --- a/src/tests/normal-tests/compiler.lsp +++ b/src/tests/normal-tests/compiler.lsp @@ -2337,3 +2337,10 @@ (check-yfn (cmplambda* (a b) (multiple-value-call #'list (values a b) (nth-v3) (nth-v4)))) (check-yfn (cmplambda* (a b) (multiple-value-call #'list (values a b) (y-vals)))) (check-nfn (cmplambda* (a b) (multiple-value-call #'list (values a b) (n-vals))))))) + +;;; Unreleased refactor branch had a regression where constants were not +;;; properly initialized in the LET form. +(test cmp.0096.c1var/location + (is (floatp (funcall (cmplambda () + (let ((x most-positive-single-float)) + x))))))