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.
17 (define-vop (static-function-template)
20 (:variant-vars function)
23 (:temporary (:sc unsigned-reg :offset ebx-offset
24 :from (:eval 0) :to (:eval 2)) ebx)
25 (:temporary (:sc unsigned-reg :offset ecx-offset
26 :from (:eval 0) :to (:eval 2)) ecx))
28 (eval-when (:compile-toplevel :load-toplevel :execute)
30 (defun static-function-template-name (num-args num-results)
31 (intern (format nil "~:@(~R-arg-~R-result-static-function~)"
32 num-args num-results)))
34 (defun moves (dst src)
36 (do ((dst dst (cdr dst))
38 ((or (null dst) (null src)))
39 (moves `(move ,(car dst) ,(car src))))
42 (defun static-function-template-vop (num-args num-results)
43 (assert (and (<= num-args register-arg-count)
44 (<= num-results register-arg-count))
45 (num-args num-results)
46 "Either too many args (~D) or too many results (~D). Max = ~D"
47 num-args num-results register-arg-count)
48 (let ((num-temps (max num-args num-results)))
49 (collect ((temp-names) (temps) (arg-names) (args) (result-names) (results))
50 (dotimes (i num-results)
51 (let ((result-name (intern (format nil "RESULT-~D" i))))
52 (result-names result-name)
53 (results `(,result-name :scs (any-reg descriptor-reg)))))
54 (dotimes (i num-temps)
55 (let ((temp-name (intern (format nil "TEMP-~D" i))))
56 (temp-names temp-name)
57 (temps `(:temporary (:sc descriptor-reg
58 :offset ,(nth i register-arg-offsets)
59 :from ,(if (< i num-args)
62 :to ,(if (< i num-results)
65 ,@(when (< i num-results)
66 `(:target ,(nth i (result-names)))))
69 (let ((arg-name (intern (format nil "ARG-~D" i))))
72 :scs (any-reg descriptor-reg)
73 :target ,(nth i (temp-names))))))
74 `(define-vop (,(static-function-template-name num-args num-results)
75 static-function-template)
78 (:results ,@(results))
79 (:generator ,(+ 50 num-args num-results)
80 ,@(moves (temp-names) (arg-names))
82 ;; If speed not more important than size, duplicate the
83 ;; effect of the ENTER with discrete instructions. Takes
84 ;; 2+1+3+2=8 bytes as opposed to 4+3=7 bytes.
85 (cond ((policy node (>= speed space))
89 ;; Ensure that at least three slots are available; one
90 ;; above, two more needed.
91 (inst sub esp-tn (fixnumize 2))
92 (inst mov ebp-tn ebx))
94 (inst enter (fixnumize 2))
95 ;; The enter instruction pushes EBP and then copies
96 ;; ESP into EBP. We want the new EBP to be the
97 ;; original ESP, so we fix it up afterwards.
98 (inst add ebp-tn (fixnumize 1))))
100 ,(if (zerop num-args)
102 `(inst mov ecx (fixnumize ,num-args)))
104 (note-this-location vop :call-site)
105 ;; Static-function-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 (inst call (make-ea :dword
112 (static-function-offset function))))
113 ,(collect ((bindings) (links))
114 (do ((temp (temp-names) (cdr temp))
115 (name 'values (gensym))
120 (make-tn-ref ,(car temp) nil)))
122 (links `(setf (tn-ref-across ,prev) ,name))))
125 (default-unknown-values
127 ,(if (zerop num-results) nil 'values)
129 ,@(moves (result-names) (temp-names)))))))
131 ) ; eval-when (compile load eval)
133 (macrolet ((frob (num-args num-res)
134 (static-function-template-vop (eval num-args) (eval num-res))))
140 (defmacro define-static-function (name args &key (results '(x)) translate
141 policy cost arg-types result-types)
143 ,(static-function-template-name (length args)
146 (:note ,(format nil "static-function ~@(~S~)" name))
148 `((:translate ,translate)))
150 `((:policy ,policy)))
152 `((:generator-cost ,cost)))
154 `((:arg-types ,@arg-types)))
156 `((:result-types ,@result-types)))))