1;;;; the VOPs and macro magic required to call static functions
2
3;;;; This software is part of the SBCL system. See the README file for
4;;;; more information.
5;;;;
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.
11
12(in-package "SB!VM")
13
14(define-vop (static-fun-template)
15  (:save-p t)
16  (:policy :safe)
17  (:variant-vars function)
18  (:vop-var vop)
19  (:temporary (:sc unsigned-reg :offset ecx-offset
20                   :from (:eval 0) :to (:eval 2)) ecx))
21
22(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
23
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)))
27
28(defun moves (dst src)
29  (collect ((moves))
30    (do ((dst dst (cdr dst))
31         (src src (cdr src)))
32        ((or (null dst) (null src)))
33      (moves `(move ,(car dst) ,(car src))))
34    (moves)))
35
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"))
43        (new-ebp-ea
44         '(make-ea :dword
45           :disp (frame-byte-offset (+ sp->fp-offset -3 ocfp-save-offset))
46           :base esp-tn)))
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)
58                                          `(:argument ,i)
59                                          '(:eval 1))
60                               :to ,(if (< i num-results)
61                                        `(:result ,i)
62                                        '(:eval 1))
63                               ,@(when (< i num-results)
64                                   `(:target ,(nth i (result-names)))))
65                              ,temp-name))))
66      (dotimes (i num-args)
67        (let ((arg-name (intern (format nil "ARG-~D" i))))
68          (arg-names arg-name)
69          (args `(,arg-name
70                  :scs (any-reg descriptor-reg)
71                  :target ,(nth i (temp-names))))))
72      `(define-vop (,(static-fun-template-name num-args num-results)
73                    static-fun-template)
74        (:args ,@(args))
75        ,@(temps)
76        (:results ,@(results))
77        (:node-var ,node)
78        (:generator ,(+ 50 num-args num-results)
79         ,@(moves (temp-names) (arg-names))
80
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))
88               (t
89                ;; Dummy for return address.
90                (inst push ebp-tn)
91                (inst enter ,(fixnumize 1))))
92
93         ,(if (zerop num-args)
94              '(inst xor ecx ecx)
95              `(inst mov ecx ,(fixnumize num-args)))
96
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
112                             :disp (+ nil-value
113                                      (static-fun-offset function))))
114         ,(collect ((bindings) (links))
115                   (do ((temp (temp-names) (cdr temp))
116                        (name 'values (gensym))
117                        (prev nil name)
118                        (i 0 (1+ i)))
119                       ((= i num-results))
120                     (bindings `(,name
121                                 (make-tn-ref ,(car temp) nil)))
122                     (when prev
123                       (links `(setf (tn-ref-across ,prev) ,name))))
124                   `(let ,(bindings)
125                     ,@(links)
126                     (default-unknown-values
127                         vop
128                         ,(if (zerop num-results) nil 'values)
129                       ,num-results
130                       ,node)))
131         ,@(moves (result-names) (temp-names)))))))
132
133) ; EVAL-WHEN
134
135(macrolet ((frob (num-args num-res)
136             (static-fun-template-vop (eval num-args) (eval num-res))))
137  (frob 0 1)
138  (frob 1 1)
139  (frob 2 1)
140  (frob 3 1))
141
142(defmacro define-static-fun (name args &key (results '(x)) translate
143                                  policy cost arg-types result-types)
144  `(define-vop (,name
145                ,(static-fun-template-name (length args)
146                                           (length results)))
147     (:variant ',name)
148     (:note ,(format nil "static-fun ~@(~S~)" name))
149     ,@(when translate
150         `((:translate ,translate)))
151     ,@(when policy
152         `((:policy ,policy)))
153     ,@(when cost
154         `((:generator-cost ,cost)))
155     ,@(when arg-types
156         `((:arg-types ,@arg-types)))
157     ,@(when result-types
158         `((:result-types ,@result-types)))))
159