Commit 31b8b8f7 authored by Juan Jose Garcia Ripoll's avatar Juan Jose Garcia Ripoll
Browse files

Implemented type inliners for arithmetic operations

parent 1ca77df9
......@@ -15,14 +15,23 @@
(in-package "COMPILER")
(defun inlined-arg-loc (arg)
(second arg))
(defun inlined-arg-type (arg)
(first arg))
(defun inlined-arg-rep-type (arg)
(loc-representation-type (second arg)))
(defmacro define-c-inliner (fname lambda-list &body body)
`(setf (gethash fname *cinline-dispatch-table*)
#'(ext:lambda-block ,fname ,lambda-list ,@body)))
`(setf (gethash ',fname *cinline-dispatch-table*)
#'(lambda ,lambda-list (block nil ,@body))))
(defun apply-inliner (fname return-type inlined-args)
(let ((fd (gethash fname *cinline-dispatch-table*)))
(if fd
(apply fd inlined-args)
(apply fd return-type inlined-args)
(default-c-inliner fname return-type inlined-args))))
(defun default-c-inliner (fname return-type inlined-args)
......
......@@ -41,6 +41,18 @@
(incf *inline-blocks*)
var))))
(defun save-inline-loc (loc)
(let* ((rep-type (loc-representation-type (second loc)))
(temp (make-inline-temp-var (first loc) rep-type))
(*destination* temp))
(set-loc loc)
temp))
(defmacro with-inlined-loc ((temp-loc loc) &rest body)
`(let ((,temp-loc (save-inline-loc ,loc)))
(setf ,temp-loc (list (var-type ,temp-loc) ,temp-loc))
,@body))
(defun emit-inlined-variable (form rest-forms)
(let ((var (c1form-arg 0 form))
(value-type (c1form-primary-type form)))
......@@ -64,7 +76,7 @@
(return-type (c1form-primary-type form))
(fun (find fname *global-funs* :key #'fun-name :test #'same-fname-p))
(loc (call-global-loc fname fun args return-type expected-type))
(type (loc-type loc))
(type (type-and return-type (loc-type loc)))
(temp (make-inline-temp-var type (loc-representation-type loc)))
(*destination* temp))
(set-loc loc)
......
......@@ -122,6 +122,81 @@
(def-type-propagator / (fname op1 &rest others)
(arithmetic-propagator op1 others 'rational))
(defun inline-binop (expected-type arg1 arg2 integer-result-type
consing non-consing)
(multiple-value-bind (result t1 t2)
(maximum-number-type (inlined-arg-type arg1) (inlined-arg-type arg2))
(when (member result '(integer fixnum))
(setf result integer-result-type))
(let (c-rep-type)
(if (and (or (and (c-number-type-p result)
(setf c-rep-type (lisp-type->rep-type result)))
(and (policy-assume-right-type)
(c-number-type-p expected-type)
(setf c-rep-type (lisp-type->rep-type expected-type))))
(c-number-type-p t1)
(c-number-type-p t2))
(produce-inline-loc (list arg1 arg2) (list c-rep-type c-rep-type)
(list c-rep-type) non-consing nil t)
(produce-inline-loc (list arg1 arg2) '(:object :object) '(:object)
consing nil t)))))
(trace inline-binop)
(defun inline-arith-unop (arg1 consing non-consing)
(let ((c-rep-type (inlined-arg-rep-type arg1)))
(if (c-number-rep-type-p c-rep-type)
(produce-inline-loc (list arg1) (list c-rep-type)
(list c-rep-type) non-consing nil t)
(produce-inline-loc (list arg1) '(:object) '(:object)
consing nil t))))
(define-c-inliner + (return-type &rest arguments &aux arg1 arg2)
(when (null arguments)
(return '(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 'integer
"ecl_plus(#0,#1)" "(#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 arg1 "ecl_negate(#0)" "-(#0)")))
(loop for arg2 = (pop arguments)
for result = (inline-binop return-type arg1 arg2 'integer
"ecl_minus(#0,#1)" "(#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 '(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 'integer
"ecl_times(#0,#1)" "(#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 arg1 "ecl_divide(MAKE_FIXNUM(1),(#0))" "1/(#0)")))
(loop for arg2 = (pop arguments)
for result = (inline-binop return-type arg1 arg2 'rational
"ecl_divide(#0,#1)" "(#0)/(#1)")
do (if arguments
(setf arg1 (save-inline-loc result))
(return result))))
;;;
;;; SPECIAL FUNCTIONS
;;;
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment