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-function-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 (:compile-toplevel :load-toplevel :execute)
27 (defun static-function-template-name (num-args num-results)
28 (intern (format nil "~:@(~R-arg-~R-result-static-function~)"
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-function-template-vop (num-args num-results)
40 (assert (and (<= num-args register-arg-count)
41 (<= num-results register-arg-count))
42 (num-args num-results)
43 "Either too many args (~D) or too many results (~D). Max = ~D"
44 num-args num-results register-arg-count)
45 (let ((num-temps (max num-args num-results)))
46 (collect ((temp-names) (temps) (arg-names) (args) (result-names) (results))
47 (dotimes (i num-results)
48 (let ((result-name (intern (format nil "RESULT-~D" i))))
49 (result-names result-name)
50 (results `(,result-name :scs (any-reg descriptor-reg)))))
51 (dotimes (i num-temps)
52 (let ((temp-name (intern (format nil "TEMP-~D" i))))
53 (temp-names temp-name)
54 (temps `(:temporary (:sc descriptor-reg
55 :offset ,(nth i register-arg-offsets)
56 :from ,(if (< i num-args)
59 :to ,(if (< i num-results)
62 ,@(when (< i num-results)
63 `(:target ,(nth i (result-names)))))
66 (let ((arg-name (intern (format nil "ARG-~D" i))))
69 :scs (any-reg descriptor-reg)
70 :target ,(nth i (temp-names))))))
71 `(define-vop (,(static-function-template-name num-args num-results)
72 static-function-template)
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 esp-tn (fixnumize 2))
89 (inst mov ebp-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 ebp-tn (fixnumize 1))))
99 `(inst mov ecx (fixnumize ,num-args)))
101 (note-this-location vop :call-site)
102 ;; Static-function-offset gives the offset from the start of
103 ;; the nil object to the static function fdefn and has the
104 ;; low tag of 1 added. When the nil symbol value with its
105 ;; low tag of 3 is added the resulting value points to the
106 ;; raw address slot of the fdefn (at +4).
107 (inst call (make-ea :dword
109 (static-function-offset function))))
110 ,(collect ((bindings) (links))
111 (do ((temp (temp-names) (cdr temp))
112 (name 'values (gensym))
117 (make-tn-ref ,(car temp) nil)))
119 (links `(setf (tn-ref-across ,prev) ,name))))
122 (default-unknown-values
124 ,(if (zerop num-results) nil 'values)
126 ,@(moves (result-names) (temp-names)))))))
128 ) ; eval-when (compile load eval)
130 (macrolet ((frob (num-args num-res)
131 (static-function-template-vop (eval num-args) (eval num-res))))
137 (defmacro define-static-function (name args &key (results '(x)) translate
138 policy cost arg-types result-types)
140 ,(static-function-template-name (length args)
143 (:note ,(format nil "static-function ~@(~S~)" name))
145 `((:translate ,translate)))
147 `((:policy ,policy)))
149 `((:generator-cost ,cost)))
151 `((:arg-types ,@arg-types)))
153 `((:result-types ,@result-types)))))