1;;;; the VOPs and macro magic required to call static functions 2 3;;;; This software is part of the SBCL system. See the README file for 4;;;; more information. 5;;;; 6;;;; This software is derived from the CMU CL system, which was 7;;;; written at Carnegie Mellon University and released into the 8;;;; public domain. The software is in the public domain and is 9;;;; provided with absolutely no warranty. See the COPYING and CREDITS 10;;;; files for more information. 11 12(in-package "SB!VM") 13 14(define-vop (static-fun-template) 15 (:save-p t) 16 (:policy :safe) 17 (:variant-vars function) 18 (:vop-var vop) 19 (:temporary (:sc unsigned-reg :offset ecx-offset 20 :from (:eval 0) :to (:eval 2)) ecx)) 21 22(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute) 23 24(defun static-fun-template-name (num-args num-results) 25 (intern (format nil "~:@(~R-arg-~R-result-static-fun~)" 26 num-args num-results))) 27 28(defun moves (dst src) 29 (collect ((moves)) 30 (do ((dst dst (cdr dst)) 31 (src src (cdr src))) 32 ((or (null dst) (null src))) 33 (moves `(move ,(car dst) ,(car src)))) 34 (moves))) 35 36(defun static-fun-template-vop (num-args num-results) 37 (unless (and (<= num-args register-arg-count) 38 (<= num-results register-arg-count)) 39 (error "either too many args (~W) or too many results (~W); max = ~W" 40 num-args num-results register-arg-count)) 41 (let ((num-temps (max num-args num-results)) 42 (node (sb!xc:gensym "NODE")) 43 (new-ebp-ea 44 '(make-ea :dword 45 :disp (frame-byte-offset (+ sp->fp-offset -3 ocfp-save-offset)) 46 :base esp-tn))) 47 (collect ((temp-names) (temps) (arg-names) (args) (result-names) (results)) 48 (dotimes (i num-results) 49 (let ((result-name (intern (format nil "RESULT-~D" i)))) 50 (result-names result-name) 51 (results `(,result-name :scs (any-reg descriptor-reg))))) 52 (dotimes (i num-temps) 53 (let ((temp-name (intern (format nil "TEMP-~D" i)))) 54 (temp-names temp-name) 55 (temps `(:temporary (:sc descriptor-reg 56 :offset ,(nth i *register-arg-offsets*) 57 :from ,(if (< i num-args) 58 `(:argument ,i) 59 '(:eval 1)) 60 :to ,(if (< i num-results) 61 `(:result ,i) 62 '(:eval 1)) 63 ,@(when (< i num-results) 64 `(:target ,(nth i (result-names))))) 65 ,temp-name)))) 66 (dotimes (i num-args) 67 (let ((arg-name (intern (format nil "ARG-~D" i)))) 68 (arg-names arg-name) 69 (args `(,arg-name 70 :scs (any-reg descriptor-reg) 71 :target ,(nth i (temp-names)))))) 72 `(define-vop (,(static-fun-template-name num-args num-results) 73 static-fun-template) 74 (:args ,@(args)) 75 ,@(temps) 76 (:results ,@(results)) 77 (:node-var ,node) 78 (:generator ,(+ 50 num-args num-results) 79 ,@(moves (temp-names) (arg-names)) 80 81 ;; If speed is at least as important as size, duplicate the 82 ;; effect of the ENTER with discrete instructions. Takes 83 ;; 3+4+4=11 bytes as opposed to 1+4=5 bytes. 84 (cond ((policy ,node (>= speed space)) 85 (inst sub esp-tn ,(fixnumize 3)) 86 (inst mov ,new-ebp-ea ebp-tn) 87 (inst lea ebp-tn ,new-ebp-ea)) 88 (t 89 ;; Dummy for return address. 90 (inst push ebp-tn) 91 (inst enter ,(fixnumize 1)))) 92 93 ,(if (zerop num-args) 94 '(inst xor ecx ecx) 95 `(inst mov ecx ,(fixnumize num-args))) 96 97 (note-this-location vop :call-site) 98 ;; Old CMU CL comment: 99 ;; STATIC-FUN-OFFSET gives the offset from the start of 100 ;; the NIL object to the static function FDEFN and has the 101 ;; low tag of 1 added. When the NIL symbol value with its 102 ;; low tag of 3 is added the resulting value points to the 103 ;; raw address slot of the fdefn (at +4). 104 ;; FIXME: Since the fork from CMU CL, we've swapped 105 ;; FUN-POINTER-LOWTAG and INSTANCE-POINTER-LOWTAG, so the 106 ;; text above is no longer right. Mysteriously, things still 107 ;; work. It would be good to explain why. (Is this code no 108 ;; longer executed? Does it not depend on the 109 ;; 1+3=4=fdefn_raw_address_offset relationship above? 110 ;; Is something else going on?) 111 (inst call (make-ea :dword 112 :disp (+ nil-value 113 (static-fun-offset function)))) 114 ,(collect ((bindings) (links)) 115 (do ((temp (temp-names) (cdr temp)) 116 (name 'values (gensym)) 117 (prev nil name) 118 (i 0 (1+ i))) 119 ((= i num-results)) 120 (bindings `(,name 121 (make-tn-ref ,(car temp) nil))) 122 (when prev 123 (links `(setf (tn-ref-across ,prev) ,name)))) 124 `(let ,(bindings) 125 ,@(links) 126 (default-unknown-values 127 vop 128 ,(if (zerop num-results) nil 'values) 129 ,num-results 130 ,node))) 131 ,@(moves (result-names) (temp-names))))))) 132 133) ; EVAL-WHEN 134 135(macrolet ((frob (num-args num-res) 136 (static-fun-template-vop (eval num-args) (eval num-res)))) 137 (frob 0 1) 138 (frob 1 1) 139 (frob 2 1) 140 (frob 3 1)) 141 142(defmacro define-static-fun (name args &key (results '(x)) translate 143 policy cost arg-types result-types) 144 `(define-vop (,name 145 ,(static-fun-template-name (length args) 146 (length results))) 147 (:variant ',name) 148 (:note ,(format nil "static-fun ~@(~S~)" name)) 149 ,@(when translate 150 `((:translate ,translate))) 151 ,@(when policy 152 `((:policy ,policy))) 153 ,@(when cost 154 `((:generator-cost ,cost))) 155 ,@(when arg-types 156 `((:arg-types ,@arg-types))) 157 ,@(when result-types 158 `((:result-types ,@result-types))))) 159