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 (t ;(policy node (>= speed space))
84 ;; Dummy for return address
88 ;; Ensure that at least three slots are available; one
89 ;; above, two more needed.
90 (inst sub rsp-tn (fixnumize 1))
91 (inst mov rbp-tn ebx))
93 (inst enter (fixnumize 2))
94 ;; The enter instruction pushes EBP and then copies
95 ;; ESP into EBP. We want the new EBP to be the
96 ;; original ESP, so we fix it up afterwards.
97 (inst add rbp-tn (fixnumize 1))))
101 `(inst mov ecx (fixnumize ,num-args)))
103 (note-this-location vop :call-site)
104 ;; Old CMU CL comment:
105 ;; STATIC-FUN-OFFSET gives the offset from the start of
106 ;; the NIL object to the static function FDEFN and has the
107 ;; low tag of 1 added. When the NIL symbol value with its
108 ;; low tag of 3 is added the resulting value points to the
109 ;; raw address slot of the fdefn (at +4).
110 ;; FIXME: Since the fork from CMU CL, we've swapped
111 ;; FUN-POINTER-LOWTAG and INSTANCE-POINTER-LOWTAG, so the
112 ;; text above is no longer right. Mysteriously, things still
113 ;; work. It would be good to explain why. (Is this code no
114 ;; longer executed? Does it not depend on the
115 ;; 1+3=4=fdefn_raw_address_offset relationship above?
116 ;; Is something else going on?)
118 ;; Need to load the target address into a register, since
119 ;; immediate call arguments are just a 32-bit displacement,
120 ;; which obviously can't work with >4G spaces.
121 (inst mov call-target
123 :disp (+ nil-value (static-fun-offset function))))
124 (inst call call-target)
125 ,(collect ((bindings) (links))
126 (do ((temp (temp-names) (cdr temp))
127 (name 'values (gensym))
132 (make-tn-ref ,(car temp) nil)))
134 (links `(setf (tn-ref-across ,prev) ,name))))
137 (default-unknown-values
139 ,(if (zerop num-results) nil 'values)
141 ,@(moves (result-names) (temp-names)))))))
145 (macrolet ((frob (num-args num-res)
146 (static-fun-template-vop (eval num-args) (eval num-res))))
152 (defmacro define-static-fun (name args &key (results '(x)) translate
153 policy cost arg-types result-types)
155 ,(static-fun-template-name (length args)
158 (:note ,(format nil "static-fun ~@(~S~)" name))
160 `((:translate ,translate)))
162 `((:policy ,policy)))
164 `((:generator-cost ,cost)))
166 `((:arg-types ,@arg-types)))
168 `((:result-types ,@result-types)))))