0.7.7.9:
[sbcl.git] / src / compiler / mips / static-fn.lisp
1 (in-package "SB!VM")
2
3
4
5 (define-vop (static-fun-template)
6   (:save-p t)
7   (:policy :safe)
8   (:variant-vars symbol)
9   (:vop-var vop)
10   (:temporary (:scs (non-descriptor-reg)) temp)
11   (:temporary (:scs (descriptor-reg)) move-temp)
12   (:temporary (:sc descriptor-reg :offset lra-offset) lra)
13   (:temporary (:sc interior-reg :offset lip-offset) entry-point)
14   (:temporary (:sc any-reg :offset nargs-offset) nargs)
15   (:temporary (:sc any-reg :offset ocfp-offset) ocfp)
16   (:temporary (:sc control-stack :offset nfp-save-offset) nfp-save))
17
18
19 (eval-when (:compile-toplevel :load-toplevel :execute)
20
21 (defun static-fun-template-name (num-args num-results)
22   (intern (format nil "~:@(~R-arg-~R-result-static-fun~)"
23                   num-args num-results)))
24
25 (defun moves (dst src)
26   (collect ((moves))
27     (do ((dst dst (cdr dst))
28          (src src (cdr src)))
29         ((or (null dst) (null src)))
30       (moves `(move ,(car dst) ,(car src))))
31     (moves)))
32
33 (defun static-fun-template-vop (num-args num-results)
34   (assert (and (<= num-args register-arg-count)
35                (<= num-results register-arg-count))
36           (num-args num-results)
37           "Either too many args (~D) or too many results (~D).  Max = ~D"
38           num-args num-results register-arg-count)
39   (let ((num-temps (max num-args num-results)))
40     (collect ((temp-names) (temps) (arg-names) (args) (result-names) (results))
41       (dotimes (i num-results)
42         (let ((result-name (intern (format nil "RESULT-~D" i))))
43           (result-names result-name)
44           (results `(,result-name :scs (any-reg descriptor-reg)))))
45       (dotimes (i num-temps)
46         (let ((temp-name (intern (format nil "TEMP-~D" i))))
47           (temp-names temp-name)
48           (temps `(:temporary (:sc descriptor-reg
49                                :offset ,(nth i *register-arg-offsets*)
50                                ,@(when (< i num-args)
51                                    `(:from (:argument ,i)))
52                                ,@(when (< i num-results)
53                                    `(:to (:result ,i)
54                                      :target ,(nth i (result-names)))))
55                               ,temp-name))))
56       (dotimes (i num-args)
57         (let ((arg-name (intern (format nil "ARG-~D" i))))
58           (arg-names arg-name)
59           (args `(,arg-name
60                   :scs (any-reg descriptor-reg null zero)
61                   :target ,(nth i (temp-names))))))
62       `(define-vop (,(static-fun-template-name num-args num-results)
63                     static-fun-template)
64          (:args ,@(args))
65          ,@(temps)
66          (:results ,@(results))
67          (:generator ,(+ 50 num-args num-results)
68            (let ((lra-label (gen-label))
69                  (cur-nfp (current-nfp-tn vop)))
70              ,@(moves (temp-names) (arg-names))
71              (inst li nargs (fixnumize ,num-args))
72              (inst lw entry-point null-tn (static-fun-offset symbol))
73              (when cur-nfp
74                (store-stack-tn nfp-save cur-nfp))
75              (inst move ocfp cfp-tn)
76              (inst compute-lra-from-code lra code-tn lra-label temp)
77              (note-this-location vop :call-site)
78              (inst j entry-point)
79              (inst move cfp-tn csp-tn)
80              (emit-return-pc lra-label)
81              ,(collect ((bindings) (links))
82                 (do ((temp (temp-names) (cdr temp))
83                      (name 'values (gensym))
84                      (prev nil name)
85                      (i 0 (1+ i)))
86                     ((= i num-results))
87                   (bindings `(,name
88                               (make-tn-ref ,(car temp) nil)))
89                   (when prev
90                     (links `(setf (tn-ref-across ,prev) ,name))))
91                 `(let ,(bindings)
92                    ,@(links)
93                    (default-unknown-values vop
94                        ,(if (zerop num-results) nil 'values)
95                        ,num-results move-temp temp lra-label)))
96              (when cur-nfp
97                (load-stack-tn cur-nfp nfp-save))
98              ,@(moves (result-names) (temp-names))))))))
99
100
101 ) ; eval-when (compile load eval)
102
103
104 (expand
105  (collect ((templates (list 'progn)))
106    (dotimes (i register-arg-count)
107      (templates (static-fun-template-vop i 1)))
108    (templates)))
109
110
111 (defmacro define-static-fun (name args &key (results '(x)) translate
112                              policy cost arg-types result-types)
113   `(define-vop (,name
114                 ,(static-fun-template-name (length args)
115                                            (length results)))
116      (:variant ',name)
117      (:note ,(format nil "static-fun ~@(~S~)" name))
118      ,@(when translate
119          `((:translate ,translate)))
120      ,@(when policy
121          `((:policy ,policy)))
122      ,@(when cost
123          `((:generator-cost ,cost)))
124      ,@(when arg-types
125          `((:arg-types ,@arg-types)))
126      ,@(when result-types
127          `((:result-types ,@result-types)))))