X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fstatic-fn.lisp;h=ba7a40e21c32e6ed06832d49aca6a294abad32ad;hb=e9984509712529c60d1158d44207d6abf11dccce;hp=2989928c374e762dc0450ad697ca4e2d90924336;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git diff --git a/src/compiler/x86/static-fn.lisp b/src/compiler/x86/static-fn.lisp index 2989928..ba7a40e 100644 --- a/src/compiler/x86/static-fn.lisp +++ b/src/compiler/x86/static-fn.lisp @@ -11,146 +11,148 @@ (in-package "SB!VM") -(file-comment - "$Header$") - -(define-vop (static-function-template) +(define-vop (static-fun-template) (:save-p t) (:policy :safe) (:variant-vars function) (:vop-var vop) - (:node-var node) - (:temporary (:sc unsigned-reg :offset ebx-offset - :from (:eval 0) :to (:eval 2)) ebx) (:temporary (:sc unsigned-reg :offset ecx-offset - :from (:eval 0) :to (:eval 2)) ecx)) + :from (:eval 0) :to (:eval 2)) ecx)) -(eval-when (:compile-toplevel :load-toplevel :execute) +(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute) -(defun static-function-template-name (num-args num-results) - (intern (format nil "~:@(~R-arg-~R-result-static-function~)" - num-args num-results))) +(defun static-fun-template-name (num-args num-results) + (intern (format nil "~:@(~R-arg-~R-result-static-fun~)" + num-args num-results))) (defun moves (dst src) (collect ((moves)) (do ((dst dst (cdr dst)) - (src src (cdr src))) - ((or (null dst) (null src))) + (src src (cdr src))) + ((or (null dst) (null src))) (moves `(move ,(car dst) ,(car src)))) (moves))) -(defun static-function-template-vop (num-args num-results) - (assert (and (<= num-args register-arg-count) - (<= num-results register-arg-count)) - (num-args num-results) - "Either too many args (~D) or too many results (~D). Max = ~D" - num-args num-results register-arg-count) - (let ((num-temps (max num-args num-results))) +(defun static-fun-template-vop (num-args num-results) + (unless (and (<= num-args register-arg-count) + (<= num-results register-arg-count)) + (error "either too many args (~W) or too many results (~W); max = ~W" + num-args num-results register-arg-count)) + (let ((num-temps (max num-args num-results)) + (node (sb!xc:gensym "NODE")) + (new-ebp-ea + '(make-ea :dword + :disp (frame-byte-offset (+ sp->fp-offset -3 ocfp-save-offset)) + :base esp-tn))) (collect ((temp-names) (temps) (arg-names) (args) (result-names) (results)) (dotimes (i num-results) - (let ((result-name (intern (format nil "RESULT-~D" i)))) - (result-names result-name) - (results `(,result-name :scs (any-reg descriptor-reg))))) + (let ((result-name (intern (format nil "RESULT-~D" i)))) + (result-names result-name) + (results `(,result-name :scs (any-reg descriptor-reg))))) (dotimes (i num-temps) - (let ((temp-name (intern (format nil "TEMP-~D" i)))) - (temp-names temp-name) - (temps `(:temporary (:sc descriptor-reg - :offset ,(nth i register-arg-offsets) - :from ,(if (< i num-args) - `(:argument ,i) - '(:eval 1)) - :to ,(if (< i num-results) - `(:result ,i) - '(:eval 1)) - ,@(when (< i num-results) - `(:target ,(nth i (result-names))))) - ,temp-name)))) + (let ((temp-name (intern (format nil "TEMP-~D" i)))) + (temp-names temp-name) + (temps `(:temporary (:sc descriptor-reg + :offset ,(nth i *register-arg-offsets*) + :from ,(if (< i num-args) + `(:argument ,i) + '(:eval 1)) + :to ,(if (< i num-results) + `(:result ,i) + '(:eval 1)) + ,@(when (< i num-results) + `(:target ,(nth i (result-names))))) + ,temp-name)))) (dotimes (i num-args) - (let ((arg-name (intern (format nil "ARG-~D" i)))) - (arg-names arg-name) - (args `(,arg-name - :scs (any-reg descriptor-reg) - :target ,(nth i (temp-names)))))) - `(define-vop (,(static-function-template-name num-args num-results) - static-function-template) - (:args ,@(args)) - ,@(temps) - (:results ,@(results)) - (:generator ,(+ 50 num-args num-results) - ,@(moves (temp-names) (arg-names)) + (let ((arg-name (intern (format nil "ARG-~D" i)))) + (arg-names arg-name) + (args `(,arg-name + :scs (any-reg descriptor-reg) + :target ,(nth i (temp-names)))))) + `(define-vop (,(static-fun-template-name num-args num-results) + static-fun-template) + (:args ,@(args)) + ,@(temps) + (:results ,@(results)) + (:node-var ,node) + (:generator ,(+ 50 num-args num-results) + ,@(moves (temp-names) (arg-names)) - ;; If speed not more important than size, duplicate the - ;; effect of the ENTER with discrete instructions. Takes - ;; 2+1+3+2=8 bytes as opposed to 4+3=7 bytes. - (cond ((policy node (>= speed space)) - (inst mov ebx esp-tn) - ;; Save the old-fp - (inst push ebp-tn) - ;; Ensure that at least three slots are available; one - ;; above, two more needed. - (inst sub esp-tn (fixnumize 2)) - (inst mov ebp-tn ebx)) - (t - (inst enter (fixnumize 2)) - ;; The enter instruction pushes EBP and then copies - ;; ESP into EBP. We want the new EBP to be the - ;; original ESP, so we fix it up afterwards. - (inst add ebp-tn (fixnumize 1)))) + ;; If speed is at least as important as size, duplicate the + ;; effect of the ENTER with discrete instructions. Takes + ;; 3+4+4=11 bytes as opposed to 1+4=5 bytes. + (cond ((policy ,node (>= speed space)) + (inst sub esp-tn ,(fixnumize 3)) + (inst mov ,new-ebp-ea ebp-tn) + (inst lea ebp-tn ,new-ebp-ea)) + (t + ;; Dummy for return address. + (inst push ebp-tn) + (inst enter ,(fixnumize 1)))) - ,(if (zerop num-args) - '(inst xor ecx ecx) - `(inst mov ecx (fixnumize ,num-args))) + ,(if (zerop num-args) + '(inst xor ecx ecx) + `(inst mov ecx ,(fixnumize num-args))) - (note-this-location vop :call-site) - ;; Static-function-offset gives the offset from the start of - ;; the nil object to the static function fdefn and has the - ;; low tag of 1 added. When the nil symbol value with its - ;; low tag of 3 is added the resulting value points to the - ;; raw address slot of the fdefn (at +4). - (inst call (make-ea :dword - :disp (+ *nil-value* - (static-function-offset function)))) - ,(collect ((bindings) (links)) - (do ((temp (temp-names) (cdr temp)) - (name 'values (gensym)) - (prev nil name) - (i 0 (1+ i))) - ((= i num-results)) - (bindings `(,name - (make-tn-ref ,(car temp) nil))) - (when prev - (links `(setf (tn-ref-across ,prev) ,name)))) - `(let ,(bindings) - ,@(links) - (default-unknown-values - vop - ,(if (zerop num-results) nil 'values) - ,num-results))) - ,@(moves (result-names) (temp-names))))))) + (note-this-location vop :call-site) + ;; Old CMU CL comment: + ;; STATIC-FUN-OFFSET gives the offset from the start of + ;; the NIL object to the static function FDEFN and has the + ;; low tag of 1 added. When the NIL symbol value with its + ;; low tag of 3 is added the resulting value points to the + ;; raw address slot of the fdefn (at +4). + ;; FIXME: Since the fork from CMU CL, we've swapped + ;; FUN-POINTER-LOWTAG and INSTANCE-POINTER-LOWTAG, so the + ;; text above is no longer right. Mysteriously, things still + ;; work. It would be good to explain why. (Is this code no + ;; longer executed? Does it not depend on the + ;; 1+3=4=fdefn_raw_address_offset relationship above? + ;; Is something else going on?) + (inst call (make-ea :dword + :disp (+ nil-value + (static-fun-offset function)))) + ,(collect ((bindings) (links)) + (do ((temp (temp-names) (cdr temp)) + (name 'values (gensym)) + (prev nil name) + (i 0 (1+ i))) + ((= i num-results)) + (bindings `(,name + (make-tn-ref ,(car temp) nil))) + (when prev + (links `(setf (tn-ref-across ,prev) ,name)))) + `(let ,(bindings) + ,@(links) + (default-unknown-values + vop + ,(if (zerop num-results) nil 'values) + ,num-results + ,node))) + ,@(moves (result-names) (temp-names))))))) -) ; eval-when (compile load eval) +) ; EVAL-WHEN (macrolet ((frob (num-args num-res) - (static-function-template-vop (eval num-args) (eval num-res)))) + (static-fun-template-vop (eval num-args) (eval num-res)))) (frob 0 1) (frob 1 1) (frob 2 1) (frob 3 1)) -(defmacro define-static-function (name args &key (results '(x)) translate - policy cost arg-types result-types) +(defmacro define-static-fun (name args &key (results '(x)) translate + policy cost arg-types result-types) `(define-vop (,name - ,(static-function-template-name (length args) - (length results))) + ,(static-fun-template-name (length args) + (length results))) (:variant ',name) - (:note ,(format nil "static-function ~@(~S~)" name)) + (:note ,(format nil "static-fun ~@(~S~)" name)) ,@(when translate - `((:translate ,translate))) + `((:translate ,translate))) ,@(when policy - `((:policy ,policy))) + `((:policy ,policy))) ,@(when cost - `((:generator-cost ,cost))) + `((:generator-cost ,cost))) ,@(when arg-types - `((:arg-types ,@arg-types))) + `((:arg-types ,@arg-types))) ,@(when result-types - `((:result-types ,@result-types))))) + `((:result-types ,@result-types)))))