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 :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))
19 (eval-when (: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 (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)
54 :target ,(nth i (result-names)))))
57 (let ((arg-name (intern (format nil "ARG-~D" i))))
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)
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))
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)
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))
88 (make-tn-ref ,(car temp) nil)))
90 (links `(setf (tn-ref-across ,prev) ,name))))
93 (default-unknown-values vop
94 ,(if (zerop num-results) nil 'values)
95 ,num-results move-temp temp lra-label)))
97 (load-stack-tn cur-nfp nfp-save))
98 ,@(moves (result-names) (temp-names))))))))
105 (collect ((templates (list 'progn)))
106 (dotimes (i register-arg-count)
107 (templates (static-fun-template-vop i 1)))
111 (defmacro define-static-fun (name args &key (results '(x)) translate
112 policy cost arg-types result-types)
114 ,(static-fun-template-name (length args)
117 (:note ,(format nil "static-fun ~@(~S~)" name))
119 `((:translate ,translate)))
121 `((:policy ,policy)))
123 `((:generator-cost ,cost)))
125 `((:arg-types ,@arg-types)))
127 `((:result-types ,@result-types)))))