From a07b39ad657bac96c8196517d41f26c698c9e5ef Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Wed, 6 Dec 2023 10:51:54 +0100 Subject: [PATCH] cmp: cleanup: rename REP-TYPE to HOST-TYPE The name HOST-TYPE is less ambiguous. --- src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp | 30 +++--- src/cmp/cmpbackend-cxx/cmpc-fun-inl.lsp | 64 ++++++------- src/cmp/cmpbackend-cxx/cmpc-inl-sysfun.lsp | 26 +++--- src/cmp/cmpbackend-cxx/cmpc-mach.lsp | 100 ++++++++++---------- src/cmp/cmpbackend-cxx/cmpc-opt-ct.lsp | 6 +- src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp | 44 ++++----- src/cmp/cmpbackend-cxx/cmppass2-data.lsp | 8 +- src/cmp/cmpbackend-cxx/cmppass2-exit.lsp | 10 +- src/cmp/cmpbackend-cxx/cmppass2-fun.lsp | 2 +- src/cmp/cmpbackend-cxx/cmppass2-loc.lsp | 104 ++++++++++----------- src/cmp/cmpbackend-cxx/cmppass2-top.lsp | 4 +- src/cmp/cmpbackend-cxx/cmppass2-var.lsp | 22 ++--- src/cmp/cmplocs.lsp | 26 +++--- src/cmp/cmppass1-ffi.lsp | 16 ++-- src/cmp/cmppass1-var.lsp | 2 +- src/cmp/cmptables.lsp | 2 +- src/cmp/cmpvar.lsp | 14 +-- 17 files changed, 240 insertions(+), 240 deletions(-) diff --git a/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp b/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp index 6ca478510..b5a04bd54 100644 --- a/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp +++ b/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp @@ -15,11 +15,11 @@ (defstruct (inlined-arg (:constructor %make-inlined-arg)) loc type - rep-type) + host-type) (defun make-inlined-arg (loc lisp-type) (%make-inlined-arg :loc loc :type lisp-type - :rep-type (loc-representation-type loc))) + :host-type (loc-host-type loc))) (defun maybe-open-inline-block () (unless (plusp *inline-blocks*) @@ -49,43 +49,43 @@ (loop with block-opened = nil for arg in inlined-args for loc = (inlined-arg-loc arg) - for arg-rep-type = (inlined-arg-rep-type arg) + for arg-host-type = (inlined-arg-host-type arg) for type in (or types '#1=(:object . #1#)) for i from 0 - for rep-type = (lisp-type->rep-type type) + for host-type = (lisp-type->host-type type) collect (cond ((and args-to-be-saved (member i args-to-be-saved :test #'eql) (not (loc-movable-p loc))) - (let ((lcl (make-lcl-var :rep-type rep-type))) + (let ((lcl (make-lcl-var :host-type host-type))) (wt-nl) (unless block-opened (setf block-opened t) (open-inline-block)) - (wt (rep-type->c-name rep-type) " " lcl "= ") - (wt-coerce-loc rep-type loc) + (wt (host-type->c-name host-type) " " lcl "= ") + (wt-coerce-loc host-type loc) (wt ";") lcl)) - ((equal rep-type arg-rep-type) + ((equal host-type arg-host-type) loc) (t - `(COERCE-LOC ,rep-type ,loc))))) + `(COERCE-LOC ,host-type ,loc))))) -(defun make-inline-temp-var (value-type &optional rep-type) - (let ((out-rep-type (or rep-type (lisp-type->rep-type value-type)))) - (if (eq out-rep-type :object) +(defun make-inline-temp-var (value-type &optional host-type) + (let ((out-host-type (or host-type (lisp-type->host-type value-type)))) + (if (eq out-host-type :object) (make-temp-var value-type) - (let ((var (make-lcl-var :rep-type out-rep-type + (let ((var (make-lcl-var :host-type out-host-type :type value-type))) (open-inline-block) - (wt-nl (rep-type->c-name out-rep-type) " " var ";") + (wt-nl (host-type->c-name out-host-type) " " var ";") var)))) (defun emit-inlined-variable (form rest-forms) (let ((var (c1form-arg 0 form)) (lisp-type (c1form-primary-type form))) (if (var-changed-in-form-list var rest-forms) - (let ((temp (make-inline-temp-var lisp-type (var-rep-type var)))) + (let ((temp (make-inline-temp-var lisp-type (var-host-type var)))) (set-loc temp var) (make-inlined-arg temp lisp-type)) (make-inlined-arg var lisp-type)))) diff --git a/src/cmp/cmpbackend-cxx/cmpc-fun-inl.lsp b/src/cmp/cmpbackend-cxx/cmpc-fun-inl.lsp index 632d2f7f0..278ffa734 100644 --- a/src/cmp/cmpbackend-cxx/cmpc-fun-inl.lsp +++ b/src/cmp/cmpbackend-cxx/cmpc-fun-inl.lsp @@ -17,8 +17,8 @@ (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-host-types ;;; List of representation types for the arguments + return-host-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 @@ -47,33 +47,33 @@ ;;; locs are typed locs as produced by inline-args ;;; returns NIL if inline expansion of the function is not possible ;;; -(defun inline-function (fname arg-types return-type &optional (return-rep-type 'any)) +(defun inline-function (fname arg-types return-type &optional (return-host-type 'any)) ;; 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*)) - (ii (get-inline-info fname arg-types return-type return-rep-type))) + (let* (;; (dest-host-type (loc-host-type *destination*)) + (ii (get-inline-info fname arg-types return-type return-host-type))) ii))) (defun apply-inline-info (ii inlined-locs) (let* ((arg-types (inline-info-arg-types ii)) - (out-rep-type (inline-info-return-rep-type ii)) + (out-host-type (inline-info-return-host-type ii)) ;; (out-type (inline-info-return-type ii)) (side-effects-p (function-may-have-side-effects (inline-info-name ii))) (fun (inline-info-expansion ii)) (one-liner (inline-info-one-liner ii))) - (produce-inline-loc inlined-locs arg-types (list out-rep-type) + (produce-inline-loc inlined-locs arg-types (list out-host-type) fun side-effects-p one-liner))) -(defun choose-inline-info (ia ib return-type return-rep-type) +(defun choose-inline-info (ia ib return-type return-host-type) (declare (ignore return-type)) (cond ;; Only accept inliners that have the right rep type - ((not (or (eq return-rep-type 'any) - (eq return-rep-type :void) - (let ((info-type (inline-info-return-rep-type ib))) - (or (eq return-rep-type info-type) + ((not (or (eq return-host-type 'any) + (eq return-host-type :void) + (let ((info-type (inline-info-return-host-type ib))) + (or (eq return-host-type info-type) ;; :bool can be coerced to any other location type (eq info-type :bool))))) ia) @@ -89,16 +89,16 @@ (t ia))) -(defun get-inline-info (fname types return-type return-rep-type) +(defun get-inline-info (fname types return-type return-host-type) (declare (si::c-local)) (let ((output nil)) (unless (safe-compile) (dolist (x (inline-information fname ':INLINE-UNSAFE)) (ext:when-let ((other (inline-type-matches x types return-type))) - (setf output (choose-inline-info output other return-type return-rep-type))))) + (setf output (choose-inline-info output other return-type return-host-type))))) (dolist (x (inline-information fname ':INLINE-ALWAYS)) (ext:when-let ((other (inline-type-matches x types return-type))) - (setf output (choose-inline-info output other return-type return-rep-type)))) + (setf output (choose-inline-info output other return-type return-host-type)))) output)) (defun to-fixnum-float-type (type) @@ -150,7 +150,7 @@ ;; Now there is an optional check of the return type. This check is ;; only used when enforced by the inliner. ;; - (when (or (eq (inline-info-return-rep-type inline-info) :bool) + (when (or (eq (inline-info-return-host-type inline-info) :bool) (null (inline-info-exact-return-type inline-info)) (and (policy-assume-right-type) (let ((inline-return-type (inline-info-return-type inline-info))) @@ -172,7 +172,7 @@ (nreverse rts)) inline-info)))) -(defun produce-inline-loc (inlined-arguments arg-types output-rep-type +(defun produce-inline-loc (inlined-arguments arg-types output-host-type c-expression side-effects one-liner) (let* (args-to-be-saved coerced-arguments) @@ -193,15 +193,15 @@ args-to-be-saved)))) (setf coerced-arguments (coerce-locs inlined-arguments arg-types args-to-be-saved)) - ;;(setf output-rep-type (lisp-type->rep-type output-rep-type)) + ;;(setf output-host-type (lisp-type->host-type output-host-type)) ;; If the form does not output any data, and there are no side ;; effects, try to omit it. - (when (null output-rep-type) + (when (null output-host-type) (if side-effects (progn (wt-nl) - (wt-c-inline-loc output-rep-type c-expression coerced-arguments t nil) + (wt-c-inline-loc output-host-type c-expression coerced-arguments t nil) (when one-liner (wt ";"))) (cmpnote "Ignoring form ~S" c-expression)) (wt-nl "value0 = ECL_NIL;") @@ -212,25 +212,25 @@ ;; place where the value is used. (when one-liner (return-from produce-inline-loc - `(ffi:c-inline ,output-rep-type ,c-expression ,coerced-arguments ,side-effects - ,(if (equalp output-rep-type '((VALUES &REST T))) + `(ffi:c-inline ,output-host-type ,c-expression ,coerced-arguments ,side-effects + ,(if (equalp output-host-type '((VALUES &REST T))) 'VALUES NIL)))) ;; If the output is a in the VALUES vector, just write down the form and ;; output the location of the data. - (when (equalp output-rep-type '((VALUES &REST T))) - (wt-c-inline-loc output-rep-type c-expression coerced-arguments side-effects + (when (equalp output-host-type '((VALUES &REST T))) + (wt-c-inline-loc output-host-type c-expression coerced-arguments side-effects 'VALUES) (return-from produce-inline-loc 'VALUEZ)) ;; Otherwise we have to set up variables for holding the output. (flet ((make-output-var (type) - (let ((var (make-lcl-var :rep-type type))) - (wt-nl (rep-type->c-name type) " " var ";") + (let ((var (make-lcl-var :host-type type))) + (wt-nl (host-type->c-name type) " " var ";") var))) (open-inline-block) - (let ((output-vars (mapcar #'make-output-var output-rep-type))) - (wt-c-inline-loc output-rep-type c-expression coerced-arguments side-effects output-vars) + (let ((output-vars (mapcar #'make-output-var output-host-type))) + (wt-c-inline-loc output-host-type c-expression coerced-arguments side-effects output-vars) (cond ((= (length output-vars) 1) (first output-vars)) (t @@ -243,15 +243,15 @@ ;;; Whoever calls this function must wrap the body in WITH-INLINE-BLOCKS. (defun negate-argument (argument dest-loc) (let* ((inlined-arg (emit-inline-form argument nil)) - (rep-type (inlined-arg-rep-type inlined-arg))) + (host-type (inlined-arg-host-type inlined-arg))) (apply #'produce-inline-loc (list inlined-arg) - (if (eq (loc-representation-type dest-loc) :bool) - (case rep-type + (if (eq (loc-host-type dest-loc) :bool) + (case host-type (:bool '((:bool) (:bool) "(#0)==ECL_NIL" nil t)) (:object '((:object) (:bool) "(#0)!=ECL_NIL" nil t)) (otherwise (return-from negate-argument nil))) - (case rep-type + (case host-type (:bool '((:bool) (:object) "(#0)?ECL_NIL:ECL_T" nil t)) (:object '((:object) (:object) "Null(#0)?ECL_T:ECL_NIL" nil t)) (otherwise (return-from negate-argument *vv-nil*))))))) diff --git a/src/cmp/cmpbackend-cxx/cmpc-inl-sysfun.lsp b/src/cmp/cmpbackend-cxx/cmpc-inl-sysfun.lsp index 831e43985..045cb3de4 100644 --- a/src/cmp/cmpbackend-cxx/cmpc-inl-sysfun.lsp +++ b/src/cmp/cmpbackend-cxx/cmpc-inl-sysfun.lsp @@ -17,7 +17,7 @@ ;;; ;;; DATABASE OF INLINE EXPANSIONS ;;; -;;; (DEF-INLINE function-name kind ([arg-type]*) return-rep-type +;;; (DEF-INLINE function-name kind ([arg-type]*) return-host-type ;;; expansion-string) ;;; ;;; Here, ARG-TYPE is the list of argument types belonging to the lisp family, @@ -52,10 +52,10 @@ (defun (setf inline-information) (value name safety) (setf (gethash (list name safety) *inline-information*) value)) -(defun %def-inline (name safety arg-types return-rep-type expansion +(defun %def-inline (name safety arg-types return-host-type expansion &key (one-liner t) (exact-return-type nil) (multiple-values t) - &aux arg-rep-types) + &aux arg-host-types) (setf safety (case safety (:unsafe :inline-unsafe) @@ -64,26 +64,26 @@ ;; 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). - (loop for type in (list* return-rep-type arg-types) + (loop for type in (list* return-host-type arg-types) unless (or (eq type 'fixnum-float) (and (consp type) (eq (car type) 'values)) (lisp-type-p type) (machine-c-type-p type)) do (warn "Dropping inline form for ~A because of missing type ~A" name type) (return-from %def-inline)) - (setf arg-rep-types - (mapcar #'(lambda (x) (if (eq x '*) x (lisp-type->rep-type x))) + (setf arg-host-types + (mapcar #'(lambda (x) (if (eq x '*) x (lisp-type->host-type x))) arg-types)) - (when (eq return-rep-type t) - (setf return-rep-type :object)) - (let* ((return-type (if (and (consp return-rep-type) - (eq (first return-rep-type) 'values)) + (when (eq return-host-type t) + (setf return-host-type :object)) + (let* ((return-type (if (and (consp return-host-type) + (eq (first return-host-type) 'values)) t - (rep-type->lisp-type return-rep-type))) + (host-type->lisp-type return-host-type))) (inline-info (make-inline-info :name name - :arg-rep-types arg-rep-types - :return-rep-type return-rep-type + :arg-host-types arg-host-types + :return-host-type return-host-type :return-type return-type :arg-types arg-types :exact-return-type exact-return-type diff --git a/src/cmp/cmpbackend-cxx/cmpc-mach.lsp b/src/cmp/cmpbackend-cxx/cmpc-mach.lsp index c10273eb9..abdd87ef3 100644 --- a/src/cmp/cmpbackend-cxx/cmpc-mach.lsp +++ b/src/cmp/cmpbackend-cxx/cmpc-mach.lsp @@ -13,11 +13,11 @@ (defstruct machine (c-types '()) - rep-type-hash + host-type-hash sorted-types inline-information) -(defstruct (rep-type (:constructor %make-rep-type)) +(defstruct (host-type (:constructor %make-host-type)) (index 0) ; Precedence order in the type list (name t) (lisp-type t) @@ -32,63 +32,63 @@ (defun lisp-type-p (type) (subtypep type 'T)) -(defun rep-type-record-unsafe (rep-type) - (gethash rep-type (machine-rep-type-hash *machine*))) +(defun host-type-record-unsafe (host-type) + (gethash host-type (machine-host-type-hash *machine*))) -(defun rep-type-record (rep-type) - (ext:if-let ((record (gethash rep-type (machine-rep-type-hash *machine*)))) +(defun host-type-record (host-type) + (ext:if-let ((record (gethash host-type (machine-host-type-hash *machine*)))) record - (cmperr "Not a valid C type name ~A" rep-type))) + (cmperr "Not a valid C type name ~A" host-type))) -(defun rep-type->lisp-type (name) - (let ((output (rep-type-record-unsafe name))) +(defun host-type->lisp-type (name) + (let ((output (host-type-record-unsafe name))) (cond (output - (rep-type-lisp-type output)) + (host-type-lisp-type output)) ((lisp-type-p name) name) (t (error "Unknown representation type ~S" name))))) -(defun lisp-type->rep-type (type) +(defun lisp-type->host-type (type) (cond ;; We expect type = NIL when we have no information. Should be fixed. FIXME! ((null type) :object) - ((let ((r (rep-type-record-unsafe type))) - (and r (rep-type-name r)))) + ((let ((r (host-type-record-unsafe type))) + (and r (host-type-name r)))) (t ;; Find the most specific type that fits (dolist (record (machine-sorted-types *machine*) :object) - (when (subtypep type (rep-type-lisp-type record)) - (return-from lisp-type->rep-type (rep-type-name record))))))) + (when (subtypep type (host-type-lisp-type record)) + (return-from lisp-type->host-type (host-type-name record))))))) -(defun c-number-rep-type-p (rep-type) - (let ((r (rep-type-record-unsafe rep-type))) - (and r (rep-type-numberp r)))) +(defun c-number-host-type-p (host-type) + (let ((r (host-type-record-unsafe host-type))) + (and r (host-type-numberp r)))) -(defun c-integer-rep-type-p (rep-type) - (let ((r (rep-type-record-unsafe rep-type))) - (and r (rep-type-integerp r)))) +(defun c-integer-host-type-p (host-type) + (let ((r (host-type-record-unsafe host-type))) + (and r (host-type-integerp r)))) -(defun c-integer-rep-type-bits (rep-type) - (let ((r (rep-type-record-unsafe rep-type))) - (and r (rep-type-bits r)))) +(defun c-integer-host-type-bits (host-type) + (let ((r (host-type-record-unsafe host-type))) + (and r (host-type-bits r)))) (defun c-number-type-p (type) - (c-number-rep-type-p (lisp-type->rep-type type))) + (c-number-host-type-p (lisp-type->host-type type))) (defun c-integer-type-p (type) - (c-integer-rep-type-p (lisp-type->rep-type type))) + (c-integer-host-type-p (lisp-type->host-type type))) (defun c-integer-type-bits (type) - (c-number-rep-type-bits (lisp-type->rep-type type))) + (c-number-host-type-bits (lisp-type->host-type type))) -(defun rep-type->c-name (type) - (rep-type-c-name (rep-type-record type))) +(defun host-type->c-name (type) + (host-type-c-name (host-type-record type))) ;; These types can be used by ECL to unbox data They are sorted from ;; the most specific, to the least specific one. All functions must ;; be declared in external.h (not internal.h) header file. -(defconstant +representation-types+ - ;; ffi-type lisp type c type convert C->Lisp convert Lisp->C unbox Lisp->C (unsafe) +(defconstant +host-types+ + ;; host type lisp type c type convert C->Lisp convert Lisp->C unbox Lisp->C (unsafe) '((:byte . #1=((signed-byte 8) "int8_t" "ecl_make_int8_t" "ecl_to_int8_t" "ecl_fixnum")) (:unsigned-byte . #2=((unsigned-byte 8) "uint8_t" "ecl_make_uint8_t" "ecl_to_uint8_t" "ecl_fixnum")) (:fixnum integer "cl_fixnum" "ecl_make_fixnum" "ecl_to_fixnum" "ecl_fixnum") @@ -177,7 +177,7 @@ (:void) (:pointer-void))) -(defun make-rep-type (all-c-types name lisp-type c-name &optional to-lisp from-lisp from-lisp-unsafe) +(defun make-host-type (all-c-types name lisp-type c-name &optional to-lisp from-lisp from-lisp-unsafe) (let* ((record (assoc name all-c-types)) (bits (cdr record))) (when record @@ -187,7 +187,7 @@ (setf lisp-type `(unsigned-byte ,bits)) (setf bits (- bits) lisp-type `(signed-byte ,bits)))) - (%make-rep-type + (%make-host-type :name name :lisp-type lisp-type :bits bits @@ -201,34 +201,34 @@ (defun default-machine () (let* ((all-c-types (append +this-machine-c-types+ +all-machines-c-types+)) (table (make-hash-table :size 128 :test 'eq)) - (sorted-rep-types - ;; Create the rep-type objects + (sorted-host-types + ;; Create the host-type objects (loop for i from 0 - for record in +representation-types+ - for rep-type = (apply #'make-rep-type all-c-types record) - when rep-type - do (setf (rep-type-index rep-type) i) - and collect (setf (gethash (rep-type-name rep-type) table) rep-type)))) + for record in +host-types+ + for host-type = (apply #'make-host-type all-c-types record) + when host-type + do (setf (host-type-index host-type) i) + and collect (setf (gethash (host-type-name host-type) table) host-type)))) ;; hack: sse-pack -> int, but int -> int-sse-pack (let ((r (gethash :int-sse-pack table))) (when r - (setf (rep-type-index r) 'ext:int-sse-pack))) + (setf (host-type-index r) 'ext:int-sse-pack))) ;; On a second pass, we replace types with more general ones - (loop with fixnum-rep-type = (gethash ':fixnum table) - with fixnum-lisp-type = (rep-type-lisp-type fixnum-rep-type) - for (name . rest) in +representation-types+ + (loop with fixnum-host-type = (gethash ':fixnum table) + with fixnum-lisp-type = (host-type-lisp-type fixnum-host-type) + for (name . rest) in +host-types+ for r = (gethash name table) - when (and r (subtypep (rep-type-lisp-type r) fixnum-lisp-type)) - do (setf (rep-type-from-lisp-unsafe r) "ecl_fixnum")) + when (and r (subtypep (host-type-lisp-type r) fixnum-lisp-type)) + do (setf (host-type-from-lisp-unsafe r) "ecl_fixnum")) ;; Create machine object (make-machine :c-types all-c-types - :rep-type-hash table - :sorted-types sorted-rep-types))) + :host-type-hash table + :sorted-types sorted-host-types))) (defun machine-c-type-p (name) - (gethash name (machine-rep-type-hash *machine*))) + (gethash name (machine-host-type-hash *machine*))) (defun machine-fixnump (number) - (typep number (rep-type-lisp-type (gethash :fixnum number)))) + (typep number (host-type-lisp-type (gethash :fixnum number)))) (defvar *default-machine* (setf *machine* (default-machine))) diff --git a/src/cmp/cmpbackend-cxx/cmpc-opt-ct.lsp b/src/cmp/cmpbackend-cxx/cmpc-opt-ct.lsp index 8b14750a0..6516c7c40 100644 --- a/src/cmp/cmpbackend-cxx/cmpc-opt-ct.lsp +++ b/src/cmp/cmpbackend-cxx/cmpc-opt-ct.lsp @@ -19,12 +19,12 @@ (defun make-single-constant-optimizer (name c-value) (cond ((symbolp name) (let* ((value (symbol-value name)) - (rep-type (lisp-type->rep-type (type-of value))) - (location (make-vv :location c-value :value value :rep-type rep-type))) + (host-type (lisp-type->host-type (type-of value))) + (location (make-vv :location c-value :value value :host-type host-type))) (cons value location))) ((floatp name) (let* ((value name) - (location (make-vv :location c-value :value value :rep-type :object))) + (location (make-vv :location c-value :value value :host-type :object))) (cons value location))) (t (cons name (make-vv :location c-value :value name))))) diff --git a/src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp b/src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp index fbcb8d7b7..b06723e81 100644 --- a/src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp +++ b/src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp @@ -19,15 +19,15 @@ ;;; (define-c-inliner shift (return-type argument orig-shift) (let* ((arg-type (inlined-arg-type argument)) - (arg-c-type (lisp-type->rep-type arg-type)) - (return-c-type (lisp-type->rep-type return-type)) + (arg-c-type (lisp-type->host-type arg-type)) + (return-c-type (lisp-type->host-type return-type)) (shift (loc-immediate-value (inlined-arg-loc orig-shift)))) - (if (or (not (c-integer-rep-type-p arg-c-type)) - (not (c-integer-rep-type-p return-c-type))) + (if (or (not (c-integer-host-type-p arg-c-type)) + (not (c-integer-host-type-p return-c-type))) (produce-inline-loc (list argument orig-shift) '(:object :fixnum) '(:object) "ecl_ash(#0,#1)" nil t) - (let* ((arg-bits (c-integer-rep-type-bits arg-c-type)) - (return-bits (c-integer-rep-type-bits return-c-type)) + (let* ((arg-bits (c-integer-host-type-bits arg-c-type)) + (return-bits (c-integer-host-type-bits return-c-type)) (max-type (if (and (plusp shift) (< arg-bits return-bits)) return-c-type @@ -44,10 +44,10 @@ ;;; Inliners for arithmetic operations. ;;; -(defun most-generic-number-rep-type (r1 r2) - (let* ((r1 (rep-type-record r1)) - (r2 (rep-type-record r2))) - (rep-type-name (if (< (rep-type-index r1) (rep-type-index r2)) +(defun most-generic-number-host-type (r1 r2) + (let* ((r1 (host-type-record r1)) + (r2 (host-type-record r2))) + (host-type-name (if (< (host-type-index r1) (host-type-index r2)) r2 r1)))) @@ -62,13 +62,13 @@ ;; type that fits the output, to avoid overflow which ;; would happen if we used say, long c = (int)a * (int)b ;; as the output would be an integer, not a long. - (let* ((arg1-rep (lisp-type->rep-type arg1-type)) - (arg2-rep (lisp-type->rep-type arg2-type)) - (out-rep (lisp-type->rep-type expected-type)) - (max-rep (most-generic-number-rep-type - (most-generic-number-rep-type + (let* ((arg1-rep (lisp-type->host-type arg1-type)) + (arg2-rep (lisp-type->host-type arg2-type)) + (out-rep (lisp-type->host-type expected-type)) + (max-rep (most-generic-number-host-type + (most-generic-number-host-type arg1-rep arg2-rep) out-rep)) - (max-name (rep-type->c-name max-rep))) + (max-name (host-type->c-name max-rep))) (produce-inline-loc (list arg1 arg2) (list arg1-rep arg2-rep) @@ -87,15 +87,15 @@ (c-number-type-p expected-type) (c-number-type-p arg1-type)) (produce-inline-loc (list arg1) - (list (lisp-type->rep-type arg1-type)) - (list (lisp-type->rep-type expected-type)) + (list (lisp-type->host-type arg1-type)) + (list (lisp-type->host-type expected-type)) non-consing nil t) (produce-inline-loc (list arg1) '(:object :object) '(:object) consing nil t)))) (define-c-inliner * (return-type &rest arguments &aux arg1 arg2) (when (null arguments) - (return (make-vv :rep-type :fixnum :value 1))) + (return (make-vv :host-type :fixnum :value 1))) (setf arg1 (pop arguments)) (when (null arguments) (return (inlined-arg-loc arg1))) @@ -106,7 +106,7 @@ (define-c-inliner + (return-type &rest arguments &aux arg1 arg2) (when (null arguments) - (return (make-vv :rep-type :fixnum :value 0))) + (return (make-vv :host-type :fixnum :value 0))) (setf arg1 (pop arguments)) (when (null arguments) (return (inlined-arg-loc arg1))) @@ -133,8 +133,8 @@ (cmperr "The C inliner for (FUNCTION /) expected at most 2 arguments.")) (define-c-inliner float (return-type arg &optional float) - (let ((arg-c-type (lisp-type->rep-type (inlined-arg-type arg))) - (flt-c-type (and float (lisp-type->rep-type (inlined-arg-type float))))) + (let ((arg-c-type (lisp-type->host-type (inlined-arg-type arg))) + (flt-c-type (and float (lisp-type->host-type (inlined-arg-type float))))) (if (member arg-c-type '(:float :double :long-double)) (when (or (null float) (eq arg-c-type flt-c-type)) (inlined-arg-loc arg)) diff --git a/src/cmp/cmpbackend-cxx/cmppass2-data.lsp b/src/cmp/cmpbackend-cxx/cmppass2-data.lsp index c66838d59..137fe5f13 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-data.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-data.lsp @@ -289,7 +289,7 @@ ((or fixnum character float #|#+complex-float (complex float)|#) (make-vv :value value :location nil - :rep-type (lisp-type->rep-type (type-of value)))) + :host-type (lisp-type->host-type (type-of value)))) #+sse2 (ext:sse-pack (let* ((bytes (ext:sse-pack-to-vector value '(unsigned-byte 8))) @@ -302,7 +302,7 @@ (make-vv :value value :location (format nil "~A(_mm_setr_epi8(~{~A~^,~}))" wrapper (coerce bytes 'list)) - :rep-type rtype)))) + :host-type rtype)))) (otherwise nil))) @@ -315,7 +315,7 @@ (defun update-vv (target source) (assert (eql (vv-value target) (vv-value source))) (setf (vv-location target) (vv-location source) - (vv-rep-type target) (vv-rep-type source))) + (vv-host-type target) (vv-host-type source))) (defun insert-vv (vv) (let* ((arr (if (vv-permanent-p vv) @@ -355,7 +355,7 @@ ;;; module is loaded. Then the code refers to such objects as VV[13]. ;;; ;;; TODO we could further optimize immediate values by duplicating some entries -;;; depending on the expected rep-type, to avoid unnecessary coercions. +;;; depending on the expected host-type, to avoid unnecessary coercions. (defun optimize-cxx-data (objects) (flet ((optimize-vv (object) (let ((value (vv-value object))) diff --git a/src/cmp/cmpbackend-cxx/cmppass2-exit.lsp b/src/cmp/cmpbackend-cxx/cmppass2-exit.lsp index e3957d497..21300b52e 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-exit.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-exit.lsp @@ -211,16 +211,16 @@ (ecase kind (:jump-t (destructuring-bind (loc) args - (case (loc-representation-type loc) + (case (loc-host-type loc) (:bool (wt-nl "if (" loc ") ")) (:object (wt-nl "if (" loc "!=ECL_NIL) ")) (otherwise (wt-nl "if ((") (wt-coerce-loc :object loc) (wt ")!=ECL_NIL) "))))) (:jump-f (destructuring-bind (loc) args - (case (loc-representation-type loc) - (:bool (wt-nl "if (!(" loc ")) ")) - (:object (wt-nl "if (Null(" loc ")) ")) - (otherwise (wt-nl "if (Null(") (wt-coerce-loc :object loc) (wt ")) "))))) + (case (loc-host-type loc) + (:bool (wt-nl "if (!(" loc "))")) + (:object (wt-nl "if (Null(" loc "))")) + (otherwise (wt-nl "if (Null(") (wt-coerce-loc :object loc) (wt "))"))))) (:jump-eq (destructuring-bind (x y) args (wt-nl "if (" `(coerce-loc :object ,x) "==" `(coerce-loc :object ,y) ") ")))) diff --git a/src/cmp/cmpbackend-cxx/cmppass2-fun.lsp b/src/cmp/cmpbackend-cxx/cmppass2-fun.lsp index 0bb04d3d0..b53122d6d 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-fun.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-fun.lsp @@ -143,7 +143,7 @@ (labels ((wt-decl (var) (let ((lcl (next-lcl (var-name var)))) (wt-nl) - (wt (rep-type->c-name (var-rep-type var)) " " *volatile* lcl ";") + (wt (host-type->c-name (var-host-type var)) " " *volatile* lcl ";") lcl)) (do-decl (var) (when (local var) ; no LCL needed for SPECIAL or LEX diff --git a/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp b/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp index 7f0f85913..3440e75d1 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp @@ -48,8 +48,8 @@ ;; overflow if we use a smaller integer type (overflows in long long ;; computations are taken care of by the compiler before we get to ;; this point). - #+msvc (princ (cond ((typep value (rep-type->lisp-type :long-long)) "LL") - ((typep value (rep-type->lisp-type :unsigned-long-long)) "ULL") + #+msvc (princ (cond ((typep value (host-type->lisp-type :long-long)) "LL") + ((typep value (host-type->lisp-type :unsigned-long-long)) "ULL") (t (baboon :format-control "wt-fixnum: The number ~A doesn't fit any integer type." value))) @@ -197,36 +197,36 @@ ;;; COERCE-LOC ;;; -(defun wt-to-object-conversion (loc-rep-type loc) +(defun wt-to-object-conversion (loc-host-type loc) ;; FIXME we can do better for constant locations. - (let* ((record (rep-type-record loc-rep-type)) - (coercer (and record (rep-type-to-lisp record)))) + (let* ((record (host-type-record loc-host-type)) + (coercer (and record (host-type-to-lisp record)))) (unless coercer - (cmperr "Cannot coerce C variable of type ~S to lisp object" loc-rep-type)) + (cmperr "Cannot coerce C variable of type ~S to lisp object" loc-host-type)) (wt coercer "(" loc ")"))) -(defun wt-from-object-conversion (dest-type loc-type rep-type loc) - (let* ((record (rep-type-record rep-type)) - (coercer (and record (rep-type-from-lisp record)))) +(defun wt-from-object-conversion (dest-type loc-type host-type loc) + (let* ((record (host-type-record host-type)) + (coercer (and record (host-type-from-lisp record)))) (unless coercer - (cmperr "Cannot coerce lisp object to C type ~A" rep-type)) + (cmperr "Cannot coerce lisp object to C type ~A" host-type)) (wt (if (or (policy-assume-no-errors) (subtypep loc-type dest-type)) - (rep-type-from-lisp-unsafe record) + (host-type-from-lisp-unsafe record) coercer) "(" loc ")"))) -(defun wt-coerce-loc (dest-rep-type loc) - (setq dest-rep-type (lisp-type->rep-type dest-rep-type)) - ;(print dest-rep-type) +(defun wt-coerce-loc (dest-host-type loc) + (setq dest-host-type (lisp-type->host-type dest-host-type)) + ;(print dest-host-type) ;(print loc) - (let* ((dest-type (rep-type->lisp-type dest-rep-type)) + (let* ((dest-type (host-type->lisp-type dest-host-type)) (loc-type (loc-type loc)) - (loc-rep-type (loc-representation-type loc))) + (loc-host-type (loc-host-type loc))) (labels ((coercion-error (&optional (write-zero t)) (cmpwarn "Unable to coerce lisp object from type (~S,~S)~%~ to C/C++ type (~S,~S)" - loc-type loc-rep-type dest-type dest-rep-type) + loc-type loc-host-type dest-type dest-host-type) (when write-zero ;; It is possible to reach this point due to a bug ;; but also due to a failure of the dead code @@ -237,60 +237,60 @@ (ensure-valid-object-type (a-lisp-type) (when (subtypep `(AND ,loc-type ,a-lisp-type) NIL) (coercion-error nil)))) - (when (eq dest-rep-type loc-rep-type) + (when (eq dest-host-type loc-host-type) (wt loc) (return-from wt-coerce-loc)) - (case dest-rep-type + (case dest-host-type ((:char :unsigned-char :wchar) - (case loc-rep-type + (case loc-host-type ((:char :unsigned-char :wchar) - (wt "(" (rep-type->c-name dest-rep-type) ")(" loc ")")) + (wt "(" (host-type->c-name dest-host-type) ")(" loc ")")) ((:object) (ensure-valid-object-type dest-type) - (wt-from-object-conversion dest-type loc-type dest-rep-type loc)) + (wt-from-object-conversion dest-type loc-type dest-host-type loc)) (otherwise (coercion-error)))) ((:float :double :long-double) (cond - ((c-number-rep-type-p loc-rep-type) - (wt "(" (rep-type->c-name dest-rep-type) ")(" loc ")")) - ((eq loc-rep-type :object) + ((c-number-host-type-p loc-host-type) + (wt "(" (host-type->c-name dest-host-type) ")(" loc ")")) + ((eq loc-host-type :object) ;; We relax the check a bit, because it is valid in C to coerce ;; between floats of different types. (ensure-valid-object-type 'FLOAT) - (wt-from-object-conversion dest-type loc-type dest-rep-type loc)) + (wt-from-object-conversion dest-type loc-type dest-host-type loc)) (t (coercion-error)))) ((:csfloat :cdfloat :clfloat) (cond - ((c-number-rep-type-p loc-rep-type) - (wt "(" (rep-type->c-name dest-rep-type) ")(" loc ")")) - ((eq loc-rep-type :object) + ((c-number-host-type-p loc-host-type) + (wt "(" (host-type->c-name dest-host-type) ")(" loc ")")) + ((eq loc-host-type :object) ;; We relax the check a bit, because it is valid in C to coerce ;; between COMPLEX floats of different types. (ensure-valid-object-type 'SI:COMPLEX-FLOAT) - (wt-from-object-conversion dest-type loc-type dest-rep-type loc)) + (wt-from-object-conversion dest-type loc-type dest-host-type loc)) (t (coercion-error)))) ((:bool) (cond - ((c-number-rep-type-p loc-rep-type) + ((c-number-host-type-p loc-host-type) (wt "1")) - ((eq loc-rep-type :object) + ((eq loc-host-type :object) (wt "(" loc ")!=ECL_NIL")) (t (coercion-error)))) ((:object) - (case loc-rep-type + (case loc-host-type ((:int-sse-pack :float-sse-pack :double-sse-pack) (when (>= (cmp-env-optimization 'speed) 1) (cmpwarn-style "Boxing a value of type ~S - performance degraded." - loc-rep-type)))) - (wt-to-object-conversion loc-rep-type loc)) + loc-host-type)))) + (wt-to-object-conversion loc-host-type loc)) ((:pointer-void) - (case loc-rep-type + (case loc-host-type ((:object) - (wt-from-object-conversion dest-type loc-type dest-rep-type loc)) + (wt-from-object-conversion dest-type loc-type dest-host-type loc)) ((:cstring) (wt "(char *)(" loc ")")) (otherwise @@ -298,7 +298,7 @@ ((:cstring) (coercion-error)) ((:char*) - (case loc-rep-type + (case loc-host-type ((:object) (wt "ecl_base_string_pointer_safe(" loc ")")) ((:pointer-void) @@ -306,19 +306,19 @@ (otherwise (coercion-error)))) ((:int-sse-pack :float-sse-pack :double-sse-pack) - (case loc-rep-type + (case loc-host-type ((:object) - (wt-from-object-conversion 'ext:sse-pack loc-type dest-rep-type loc)) + (wt-from-object-conversion 'ext:sse-pack loc-type dest-host-type loc)) ;; Implicitly cast between SSE subtypes ((:int-sse-pack :float-sse-pack :double-sse-pack) - (wt (ecase dest-rep-type - (:int-sse-pack (ecase loc-rep-type + (wt (ecase dest-host-type + (:int-sse-pack (ecase loc-host-type (:float-sse-pack "_mm_castps_si128") (:double-sse-pack "_mm_castpd_si128"))) - (:float-sse-pack (ecase loc-rep-type + (:float-sse-pack (ecase loc-host-type (:int-sse-pack "_mm_castsi128_ps") (:double-sse-pack "_mm_castpd_ps"))) - (:double-sse-pack (ecase loc-rep-type + (:double-sse-pack (ecase loc-host-type (:int-sse-pack "_mm_castsi128_pd") (:float-sse-pack "_mm_castps_pd")))) "(" loc ")")) @@ -327,13 +327,13 @@ (t ;; At this point we only have coercions to integers (cond - ((not (c-integer-rep-type-p dest-rep-type)) + ((not (c-integer-host-type-p dest-host-type)) (coercion-error)) - ((c-number-rep-type-p loc-rep-type) - (wt "(" (rep-type->c-name dest-rep-type) ")(" loc ")")) - ((eq :object loc-rep-type) + ((c-number-host-type-p loc-host-type) + (wt "(" (host-type->c-name dest-host-type) ")(" loc ")")) + ((eq :object loc-host-type) (ensure-valid-object-type dest-type) - (wt-from-object-conversion dest-type loc-type dest-rep-type loc)) + (wt-from-object-conversion dest-type loc-type dest-host-type loc)) (t (coercion-error)))))))) @@ -342,8 +342,8 @@ ;;; INLINE-LOC ;;; -(defun wt-c-inline-loc (output-rep-type c-expression coerced-arguments side-effects output-vars) - (declare (ignore output-rep-type side-effects)) +(defun wt-c-inline-loc (output-host-type c-expression coerced-arguments side-effects output-vars) + (declare (ignore output-host-type side-effects)) (with-input-from-string (s c-expression) (when (and output-vars (not (eq output-vars 'VALUES))) (wt-nl)) @@ -403,7 +403,7 @@ (progn (wt-nl) (wt-loc destination) (wt " = ") - (wt-coerce-loc (loc-representation-type destination) loc) + (wt-coerce-loc (loc-host-type destination) loc) (wt ";")))))) (defun set-the-loc (loc type orig-loc) diff --git a/src/cmp/cmpbackend-cxx/cmppass2-top.lsp b/src/cmp/cmpbackend-cxx/cmppass2-top.lsp index 7e1cb4d1b..959c997d5 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-top.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-top.lsp @@ -271,7 +271,7 @@ (with-bir-env (:env 0 :level 0 :volatile "volatile ") (when (eql return-type :void) (setf return-p nil)) - (let ((return-type-name (rep-type->c-name (ffi::%convert-to-arg-type return-type))) + (let ((return-type-name (host-type->c-name (ffi::%convert-to-arg-type return-type))) (vars (loop for n from 0 below (length arg-types) collect (format nil "var~d" n))) (fmod (case call-type @@ -284,7 +284,7 @@ (loop with comma = "" for var in vars for type in arg-types - for arg-type-name = (rep-type->c-name (ffi::%convert-to-arg-type type)) + for arg-type-name = (host-type->c-name (ffi::%convert-to-arg-type type)) do (wt-h comma arg-type-name " " var) (wt comma arg-type-name " " var) (setf comma ",")) diff --git a/src/cmp/cmpbackend-cxx/cmppass2-var.lsp b/src/cmp/cmpbackend-cxx/cmppass2-var.lsp index 6f7621522..43f6346a2 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-var.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-var.lsp @@ -103,7 +103,7 @@ do (when kind (maybe-open-inline-block) (bind (next-lcl (var-name var)) var) - (wt-nl *volatile* (rep-type->c-name kind) " " var ";"))) + (wt-nl *volatile* (host-type->c-name kind) " " var ";"))) ;; Create closure bindings for closed-over variables (when (some #'var-ref-ccb vars) @@ -159,7 +159,7 @@ (when (useful-var-p var) (maybe-open-inline-block) (bind (next-lcl) var) - (wt-nl (rep-type->c-name kind) " " *volatile* var ";") + (wt-nl (host-type->c-name kind) " " *volatile* var ";") (wt-comment (var-name var))) (unless env-grows (setq env-grows (var-ref-ccb var)))))) ;; 3) If there are closure variables, set up an environment. @@ -228,11 +228,11 @@ (LOCATION (push (cons var (c1form-arg 0 form)) saves)) (otherwise (if (local var) - (let* ((rep-type (var-rep-type var)) - (rep-type-c-name (rep-type->c-name rep-type)) - (temp (make-lcl-var :rep-type rep-type))) + (let* ((host-type (var-host-type var)) + (host-type-c-name (host-type->c-name host-type)) + (temp (make-lcl-var :host-type host-type))) (wt-nl-open-brace) - (wt-nl rep-type-c-name " " *volatile* temp ";") + (wt-nl host-type-c-name " " *volatile* temp ";") (let ((*destination* temp)) (c2expr* form)) (push (cons var temp) saves)) (let ((*destination* (make-temp-var))) @@ -283,7 +283,7 @@ ;; check they are not the same (unless (equal (var-loc var) loc) (wt-nl var " = ") - (wt-coerce-loc (var-rep-type var) loc) + (wt-coerce-loc (var-host-type var) loc) (wt ";"))) ((and (consp loc) (eql (car loc) 'LCL)) ;; set location for lambda list requireds @@ -412,21 +412,21 @@ (case (var-kind var) (CLOSURE (wt-nl)(wt-env var-loc)(wt " = ") - (wt-coerce-loc (var-rep-type var) loc) + (wt-coerce-loc (var-host-type var) loc) (wt #\;)) (LEXICAL (wt-nl)(wt-lex var-loc)(wt " = ") - (wt-coerce-loc (var-rep-type var) loc) + (wt-coerce-loc (var-host-type var) loc) (wt #\;)) ((SPECIAL GLOBAL) (if (safe-compile) (wt-nl "ecl_cmp_setq(cl_env_copy," var-loc ",") (wt-nl "ECL_SETQ(cl_env_copy," var-loc ",")) - (wt-coerce-loc (var-rep-type var) loc) + (wt-coerce-loc (var-host-type var) loc) (wt ");")) (t (wt-nl var-loc " = ") - (wt-coerce-loc (var-rep-type var) loc) + (wt-coerce-loc (var-host-type var) loc) (wt #\;)) )) diff --git a/src/cmp/cmplocs.lsp b/src/cmp/cmplocs.lsp index 2a4213f40..f14ac7c8d 100644 --- a/src/cmp/cmplocs.lsp +++ b/src/cmp/cmplocs.lsp @@ -29,7 +29,7 @@ (always nil) ; when true then vv is never optimized (permanent-p t) (value nil) - (rep-type :object)) + (host-type :object)) ;;; 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. @@ -51,37 +51,37 @@ (cond ((eq loc NIL) 'NULL) ((var-p loc) (var-type loc)) ((vv-p loc) (vv-type loc)) - ((numberp loc) (lisp-type->rep-type (type-of loc))) + ((numberp loc) (lisp-type->host-type (type-of loc))) ((atom loc) 'T) (t (case (first loc) (FFI:C-INLINE (let ((type (first (second loc)))) (cond ((and (consp type) (eq (first type) 'VALUES)) T) ((lisp-type-p type) type) - (t (rep-type->lisp-type type))))) + (t (host-type->lisp-type type))))) (BIND (var-type (second loc))) (LCL (or (third loc) T)) (THE (second loc)) (CALL-NORMAL (fourth loc)) (otherwise T))))) -(defun loc-representation-type (loc) +(defun loc-host-type (loc) (cond ((member loc '(NIL T)) :object) - ((var-p loc) (var-rep-type loc)) - ((vv-p loc) (vv-rep-type loc)) - ((numberp loc) (lisp-type->rep-type (type-of loc))) + ((var-p loc) (var-host-type loc)) + ((vv-p loc) (vv-host-type loc)) + ((numberp loc) (lisp-type->host-type (type-of loc))) ((eq loc 'TRASH) :void) ((atom loc) :object) (t (case (first loc) (FFI:C-INLINE (let ((type (first (second loc)))) (cond ((and (consp type) (eq (first type) 'VALUES)) :object) - ((lisp-type-p type) (lisp-type->rep-type type)) + ((lisp-type-p type) (lisp-type->host-type type)) (t type)))) - (BIND (var-rep-type (second loc))) - (LCL (lisp-type->rep-type (or (third loc) T))) + (BIND (var-host-type (second loc))) + (LCL (lisp-type->host-type (or (third loc) T))) ((JUMP-TRUE JUMP-FALSE) :bool) - (THE (loc-representation-type (third loc))) + (THE (loc-host-type (third loc))) (otherwise :object))))) (defun loc-with-side-effects-p (loc &aux name) @@ -119,14 +119,14 @@ ;;; ( VALUE i ) VALUES(i) ;;; ( VV vv-index ) ;;; ( VV-temp vv-index ) -;;; ( LCL lcl [representation-type]) local variable, type unboxed +;;; ( LCL lcl [host-type]) local variable, type unboxed ;;; ( TEMP temp ) local variable, type object ;;; ( FRAME ndx ) variable in local frame stack ;;; ( CALL-NORMAL fun locs 1st-type ) similar as CALL, but number of arguments is fixed ;;; ( CALL-INDIRECT fun narg args) similar as CALL, but unknown function ;;; ( CALL-STACK fun) similar as CALL-INDIRECT, but args are on the stack ;;; ( FFI:C-INLINE output-type fun/string locs side-effects output-var ) -;;; ( COERCE-LOC representation-type location) +;;; ( COERCE-LOC host-type location) ;;; ( FDEFINITION vv-index ) ;;; ( MAKE-CCLOSURE cfun ) ;;; ( STACK-POINTER index ) retrieve a value from the stack diff --git a/src/cmp/cmppass1-ffi.lsp b/src/cmp/cmppass1-ffi.lsp index 6eb22df4e..84be2eeef 100644 --- a/src/cmp/cmppass1-ffi.lsp +++ b/src/cmp/cmppass1-ffi.lsp @@ -20,7 +20,7 @@ (destructuring-bind (arguments arg-types output-type c-expression &rest rest &key (side-effects t) one-liner - &aux output-rep-type) + &aux output-host-type) args (unless (= (length arguments) (length arg-types)) (cmperr "In a C-INLINE form the number of declare arguments and the number of supplied ones do not match:~%~S" @@ -44,21 +44,21 @@ ;; output-type = lisp-type | c-type | (values {lisp-type | c-type}*) (flet ((produce-type-pair (type) (if (lisp-type-p type) - (cons type (lisp-type->rep-type type)) - (cons (rep-type->lisp-type type) type)))) + (cons type (lisp-type->host-type type)) + (cons (host-type->lisp-type type) type)))) (cond ((eq output-type ':void) - (setf output-rep-type '() + (setf output-host-type '() output-type 'NIL)) ((equal output-type '(VALUES &REST t)) - (setf output-rep-type '((VALUES &REST t)))) + (setf output-host-type '((VALUES &REST t)))) ((and (consp output-type) (eql (first output-type) 'VALUES)) (let ((x (mapcar #'produce-type-pair (rest output-type)))) - (setf output-rep-type (mapcar #'cdr x) + (setf output-host-type (mapcar #'cdr x) output-type `(VALUES ,@(mapcar #'car x))))) (t (let ((x (produce-type-pair output-type))) (setf output-type (car x) - output-rep-type (list (cdr x))))))) + output-host-type (list (cdr x))))))) (unless (and (listp arguments) (listp arg-types) (stringp c-expression)) @@ -72,7 +72,7 @@ (form (make-c1form* 'ffi:c-inline :type output-type :side-effects side-effects :args arguments arg-types - output-rep-type + output-host-type c-expression side-effects one-liner))) diff --git a/src/cmp/cmppass1-var.lsp b/src/cmp/cmppass1-var.lsp index 7871fcf05..225e5a621 100644 --- a/src/cmp/cmppass1-var.lsp +++ b/src/cmp/cmppass1-var.lsp @@ -224,7 +224,7 @@ (setq type 'T)) ((machine-c-type-p (setq type (cdr type))) (setf kind type - type (rep-type->lisp-type type)))) + type (host-type->lisp-type type)))) (cond ((or (member name specials) (special-variable-p name)) (unless (eq kind 'LEXICAL) (cmperr "Special variable ~A cannot be declared to have C type ~A" diff --git a/src/cmp/cmptables.lsp b/src/cmp/cmptables.lsp index b9e904b13..f69482165 100644 --- a/src/cmp/cmptables.lsp +++ b/src/cmp/cmptables.lsp @@ -63,7 +63,7 @@ (ext:COMPILER-TYPECASE var expressions) (ext:CHECKED-VALUE type value-c1form let-form) ;; Backend-specific operators - (FFI:C-INLINE (arg-c1form*) (arg-type-symbol*) output-rep-type + (FFI:C-INLINE (arg-c1form*) (arg-type-symbol*) output-host-type c-expression-string side-effects-p one-liner-p) (FFI:C-PROGN variables forms)))) diff --git a/src/cmp/cmpvar.lsp b/src/cmp/cmpvar.lsp index c51d4f15a..845260360 100644 --- a/src/cmp/cmpvar.lsp +++ b/src/cmp/cmpvar.lsp @@ -44,12 +44,12 @@ (push var (fun-local-vars *current-function*)))) var)) -(defun make-lcl-var (&key rep-type (type 'T)) - (unless rep-type - (setq rep-type (if type (lisp-type->rep-type type) :object))) +(defun make-lcl-var (&key host-type (type 'T)) + (unless host-type + (setq host-type (if type (lisp-type->host-type type) :object))) (unless type (setq type 'T)) - (make-var :kind rep-type :type type :loc (next-lcl))) + (make-var :kind host-type :type type :loc (next-lcl))) (defun make-global-var (name &key (type (or (si:get-sysprop name 'CMP-TYPE) t)) @@ -165,7 +165,7 @@ (add-to-set-nodes v form)) form) -(defun var-rep-type (var) +(defun var-host-type (var) (case (var-kind var) ((LEXICAL CLOSURE SPECIAL GLOBAL) :object) (t (var-kind var)))) @@ -179,11 +179,11 @@ ;; if the variable can be stored locally, set it var-kind to its type (setf (var-kind var) (if (plusp (var-ref var)) - (lisp-type->rep-type (var-type var)) + (lisp-type->host-type (var-type var)) :OBJECT))))) (defun unboxed (var) - (not (eq (var-rep-type var) :object))) + (not (eq (var-host-type var) :object))) (defun local (var) (and (not (member (var-kind var) '(LEXICAL CLOSURE SPECIAL GLOBAL)))