5 (define-vop (static-fun-template)
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
) 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
))
19 (eval-when (#-sb-xc
:compile-toplevel
:load-toplevel
:execute
)
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
)))
25 (defun moves (dst src
)
27 (do ((dst dst
(cdr dst
))
29 ((or (null dst
) (null src
)))
30 (moves `(move ,(car dst
) ,(car src
))))
33 (defun static-fun-template-vop (num-args num-results
)
34 (unless (and (<= num-args register-arg-count
)
35 (<= num-results register-arg-count
))
36 (error "either too many args (~W) or too many results (~W); max = ~W"
37 num-args num-results register-arg-count
))
38 (let ((num-temps (max num-args num-results
)))
39 (collect ((temp-names) (temps) (arg-names) (args) (result-names) (results))
40 (dotimes (i num-results
)
41 (let ((result-name (intern (format nil
"RESULT-~D" i
))))
42 (result-names result-name
)
43 (results `(,result-name
:scs
(any-reg descriptor-reg
)))))
44 (dotimes (i num-temps
)
45 (let ((temp-name (intern (format nil
"TEMP-~D" i
))))
46 (temp-names temp-name
)
47 (temps `(:temporary
(:sc descriptor-reg
48 :offset
,(nth i
*register-arg-offsets
*)
49 ,@(when (< i num-args
)
50 `(:from
(:argument
,i
)))
51 ,@(when (< i num-results
)
53 :target
,(nth i
(result-names)))))
56 (let ((arg-name (intern (format nil
"ARG-~D" i
))))
59 :scs
(any-reg descriptor-reg null zero
)
60 :target
,(nth i
(temp-names))))))
61 `(define-vop (,(static-fun-template-name num-args num-results
)
65 (:results
,@(results))
66 (:generator
,(+ 50 num-args num-results
)
67 (let ((lra-label (gen-label))
68 (cur-nfp (current-nfp-tn vop
)))
69 ,@(moves (temp-names) (arg-names))
70 (inst li nargs
(fixnumize ,num-args
))
71 (inst lw entry-point null-tn
(static-fun-offset symbol
))
73 (store-stack-tn nfp-save cur-nfp
))
75 (inst compute-lra-from-code lra code-tn lra-label temp
)
76 (note-this-location vop
:call-site
)
78 (move cfp-tn csp-tn t
)
79 (emit-return-pc lra-label
)
80 ,(collect ((bindings) (links))
81 (do ((temp (temp-names) (cdr temp
))
82 (name 'values
(gensym))
87 (make-tn-ref ,(car temp
) nil
)))
89 (links `(setf (tn-ref-across ,prev
) ,name
))))
92 (default-unknown-values vop
93 ,(if (zerop num-results
) nil
'values
)
94 ,num-results move-temp temp lra-label
)))
96 (load-stack-tn cur-nfp nfp-save
))
97 ,@(moves (result-names) (temp-names))))))))
104 (collect ((templates (list 'progn
)))
105 (dotimes (i register-arg-count
)
106 (templates (static-fun-template-vop i
1)))
110 (defmacro define-static-fun
(name args
&key
(results '(x)) translate
111 policy cost arg-types result-types
)
113 ,(static-fun-template-name (length args
)
116 (:note
,(format nil
"static-fun ~@(~S~)" name
))
118 `((:translate
,translate
)))
120 `((:policy
,policy
)))
122 `((:generator-cost
,cost
)))
124 `((:arg-types
,@arg-types
)))
126 `((:result-types
,@result-types
)))))