4 (define-vop (static-fun-template)
9 (:temporary (:scs (non-descriptor-reg)) temp)
10 (:temporary (:scs (descriptor-reg)) move-temp)
11 (:temporary (:sc descriptor-reg :offset lra-offset) lra)
12 (:temporary (:scs (interior-reg)) lip)
13 (:temporary (:sc any-reg :offset nargs-offset) nargs)
14 (:temporary (:sc any-reg :offset ocfp-offset) old-fp)
15 (:temporary (:sc control-stack :offset nfp-save-offset) nfp-save))
18 (eval-when (:compile-toplevel :load-toplevel :execute)
20 (defun static-fun-template-name (num-args num-results)
21 (intern (format nil "~:@(~R-arg-~R-result-static-fun~)"
22 num-args num-results)))
25 (defun moves (src dst)
27 (do ((src src (cdr src))
29 ((or (null src) (null dst)))
30 (moves `(move ,(car src) ,(car dst))))
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)
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 (arg-names) (temp-names))
71 (inst li (fixnumize ,num-args) nargs)
72 (inst ldw (static-fun-offset symbol) null-tn lip)
74 (store-stack-tn nfp-save cur-nfp))
75 (inst move cfp-tn old-fp)
76 (inst compute-lra-from-code code-tn lra-label temp lra)
77 (note-this-location vop :call-site)
79 (inst move csp-tn cfp-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 (temp-names) (result-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)))))