1 ;;;; the VOPs and macro magic required to call static functions
3 ;;;; This software is part of the SBCL system. See the README file for
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.
14 (define-vop (static-fun-template)
17 (:variant-vars function
)
20 (:temporary
(:sc unsigned-reg
:offset ebx-offset
21 :from
(:eval
0) :to
(:eval
2)) ebx
)
22 (:temporary
(:sc unsigned-reg
:offset ecx-offset
23 :from
(:eval
0) :to
(:eval
2)) ecx
))
25 (eval-when (#-sb-xc
:compile-toplevel
:load-toplevel
:execute
)
27 (defun static-fun-template-name (num-args num-results
)
28 (intern (format nil
"~:@(~R-arg-~R-result-static-fun~)"
29 num-args num-results
)))
31 (defun moves (dst src
)
33 (do ((dst dst
(cdr dst
))
35 ((or (null dst
) (null src
)))
36 (moves `(move ,(car dst
) ,(car src
))))
39 (defun static-fun-template-vop (num-args num-results
)
40 (unless (and (<= num-args register-arg-count
)
41 (<= num-results register-arg-count
))
42 (error "either too many args (~W) or too many results (~W); max = ~W"
43 num-args num-results register-arg-count
))
44 (let ((num-temps (max num-args num-results
)))
45 (collect ((temp-names) (temps) (arg-names) (args) (result-names) (results))
46 (dotimes (i num-results
)
47 (let ((result-name (intern (format nil
"RESULT-~D" i
))))
48 (result-names result-name
)
49 (results `(,result-name
:scs
(any-reg descriptor-reg
)))))
50 (dotimes (i num-temps
)
51 (let ((temp-name (intern (format nil
"TEMP-~D" i
))))
52 (temp-names temp-name
)
53 (temps `(:temporary
(:sc descriptor-reg
54 :offset
,(nth i
*register-arg-offsets
*)
55 :from
,(if (< i num-args
)
58 :to
,(if (< i num-results
)
61 ,@(when (< i num-results
)
62 `(:target
,(nth i
(result-names)))))
65 (let ((arg-name (intern (format nil
"ARG-~D" i
))))
68 :scs
(any-reg descriptor-reg
)
69 :target
,(nth i
(temp-names))))))
70 `(define-vop (,(static-fun-template-name num-args num-results
)
74 (:temporary
(:sc unsigned-reg
) call-target
)
75 (:results
,@(results))
76 (:generator
,(+ 50 num-args num-results
)
77 ,@(moves (temp-names) (arg-names))
79 ;; If speed not more important than size, duplicate the
80 ;; effect of the ENTER with discrete instructions. Takes
81 ;; 2+1+3+2=8 bytes as opposed to 4+3=7 bytes.
82 (cond ((policy node
(>= speed space
))
86 ;; Ensure that at least three slots are available; one
87 ;; above, two more needed.
88 (inst sub rsp-tn
(fixnumize 2))
89 (inst mov rbp-tn ebx
))
91 (inst enter
(fixnumize 2))
92 ;; The enter instruction pushes EBP and then copies
93 ;; ESP into EBP. We want the new EBP to be the
94 ;; original ESP, so we fix it up afterwards.
95 (inst add rbp-tn
(fixnumize 1))))
99 `(inst mov ecx
(fixnumize ,num-args
)))
101 (note-this-location vop
:call-site
)
102 ;; Old CMU CL comment:
103 ;; STATIC-FUN-OFFSET gives the offset from the start of
104 ;; the NIL object to the static function FDEFN and has the
105 ;; low tag of 1 added. When the NIL symbol value with its
106 ;; low tag of 3 is added the resulting value points to the
107 ;; raw address slot of the fdefn (at +4).
108 ;; FIXME: Since the fork from CMU CL, we've swapped
109 ;; FUN-POINTER-LOWTAG and INSTANCE-POINTER-LOWTAG, so the
110 ;; text above is no longer right. Mysteriously, things still
111 ;; work. It would be good to explain why. (Is this code no
112 ;; longer executed? Does it not depend on the
113 ;; 1+3=4=fdefn_raw_address_offset relationship above?
114 ;; Is something else going on?)
116 ;; Need to load the target address into a register, since
117 ;; immediate call arguments are just a 32-bit displacement,
118 ;; which obviously can't work with >4G spaces.
119 (inst mov call-target
121 :disp
(+ nil-value
(static-fun-offset function
))))
122 (inst call call-target
)
123 ,(collect ((bindings) (links))
124 (do ((temp (temp-names) (cdr temp
))
125 (name 'values
(gensym))
130 (make-tn-ref ,(car temp
) nil
)))
132 (links `(setf (tn-ref-across ,prev
) ,name
))))
135 (default-unknown-values
137 ,(if (zerop num-results
) nil
'values
)
139 ,@(moves (result-names) (temp-names)))))))
143 (macrolet ((frob (num-args num-res
)
144 (static-fun-template-vop (eval num-args
) (eval num-res
))))
150 (defmacro define-static-fun
(name args
&key
(results '(x)) translate
151 policy cost arg-types result-types
)
153 ,(static-fun-template-name (length args
)
156 (:note
,(format nil
"static-fun ~@(~S~)" name
))
158 `((:translate
,translate
)))
160 `((:policy
,policy
)))
162 `((:generator-cost
,cost
)))
164 `((:arg-types
,@arg-types
)))
166 `((:result-types
,@result-types
)))))