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
)
19 (:temporary
(:sc unsigned-reg
:offset ecx-offset
20 :from
(:eval
0) :to
(:eval
2)) ecx
))
22 (eval-when (#-sb-xc
:compile-toplevel
:load-toplevel
:execute
)
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
)))
28 (defun moves (dst src
)
30 (do ((dst dst
(cdr dst
))
32 ((or (null dst
) (null src
)))
33 (moves `(move ,(car dst
) ,(car src
))))
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"))
45 :disp
(frame-byte-offset (+ sp-
>fp-offset -
3 ocfp-save-offset
))
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
)
60 :to
,(if (< i num-results
)
63 ,@(when (< i num-results
)
64 `(:target
,(nth i
(result-names)))))
67 (let ((arg-name (intern (format nil
"ARG-~D" i
))))
70 :scs
(any-reg descriptor-reg
)
71 :target
,(nth i
(temp-names))))))
72 `(define-vop (,(static-fun-template-name num-args num-results
)
76 (:results
,@(results))
78 (:generator
,(+ 50 num-args num-results
)
79 ,@(moves (temp-names) (arg-names))
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
))
89 ;; Dummy for return address.
91 (inst enter
,(fixnumize 1))))
95 `(inst mov ecx
,(fixnumize num-args
)))
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
113 (static-fun-offset function
))))
114 ,(collect ((bindings) (links))
115 (do ((temp (temp-names) (cdr temp
))
116 (name 'values
(gensym))
121 (make-tn-ref ,(car temp
) nil
)))
123 (links `(setf (tn-ref-across ,prev
) ,name
))))
126 (default-unknown-values
128 ,(if (zerop num-results
) nil
'values
)
131 ,@(moves (result-names) (temp-names)))))))
135 (macrolet ((frob (num-args num-res
)
136 (static-fun-template-vop (eval num-args
) (eval num-res
))))
142 (defmacro define-static-fun
(name args
&key
(results '(x)) translate
143 policy cost arg-types result-types
)
145 ,(static-fun-template-name (length args
)
148 (:note
,(format nil
"static-fun ~@(~S~)" name
))
150 `((:translate
,translate
)))
152 `((:policy
,policy
)))
154 `((:generator-cost
,cost
)))
156 `((:arg-types
,@arg-types
)))
158 `((:result-types
,@result-types
)))))