mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2025-12-05 18:30:24 -08:00
Code Issues Projects Releases Packages Wiki Activity

cmpc: %def-inline: remove an option :inline-or-warn

Browse source
This commit is contained in:
Daniel Kochmański 2023-06-20 11:20:11 +02:00
parent 2d0ffd53b2
commit 49668f8dda
5 changed files with 26 additions and 47 deletions
Download patch file Download diff file Expand all files Collapse all files

12
contrib/cl-simd/ecl-sse-core.lisp
View file

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

10
src/cmp/cmpbackend-cxx/cmpc-inl-sysfun.lsp
View file

@ -35,7 +35,7 @@
(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
@ -58,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
@ -75,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)

37
src/cmp/cmpbackend-cxx/cmpc-inliner.lsp
View file

@ -100,30 +100,22 @@
(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))
@ -181,17 +173,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

4
src/cmp/cmpbackend-cxx/cmpc-opt-inl.lsp
View file

@ -159,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*))

10
src/cmp/cmpbackend-cxx/cmpc-wt.lsp
View file

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