3 (define-vop (static-fun-template)
8 (:temporary (:scs (non-descriptor-reg)) temp)
9 (:temporary (:scs (descriptor-reg)) move-temp)
10 (:temporary (:sc descriptor-reg :offset lra-offset) lra)
11 (:temporary (:sc interior-reg :offset lip-offset) lip)
12 (:temporary (:sc any-reg :offset nargs-offset) nargs)
13 (:temporary (:sc any-reg :offset ocfp-offset) ocfp)
14 (:temporary (:sc control-stack :offset nfp-save-offset) nfp-save))
16 ;why do we have this ?
17 (eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
19 (defun static-fun-template-name (num-args num-results)
20 (intern (format nil "~:@(~R-arg-~R-result-static-fun~)"
21 num-args num-results)))
23 (defun moves (src dst)
25 (do ((src src (cdr src))
27 ((or (null src) (null dst)))
28 (moves `(move ,(car src) ,(car dst))))
31 (defun static-fun-template-vop (num-args num-results)
32 (unless (and (<= num-args register-arg-count)
33 (<= num-results register-arg-count))
34 (error "either too many args (~W) or too many results (~W); max = ~W"
35 num-args num-results register-arg-count))
36 (let ((num-temps (max num-args num-results)))
37 (collect ((temp-names) (temps) (arg-names) (args) (result-names) (results))
38 (dotimes (i num-results)
39 (let ((result-name (intern (format nil "RESULT-~D" i))))
40 (result-names result-name)
41 (results `(,result-name :scs (any-reg descriptor-reg)))))
42 (dotimes (i num-temps)
43 (let ((temp-name (intern (format nil "TEMP-~D" i))))
44 (temp-names temp-name)
45 (temps `(:temporary (:sc descriptor-reg
46 :offset ,(nth i *register-arg-offsets*)
47 ,@(when (< i num-args)
48 `(:from (:argument ,i)))
49 ,@(when (< i num-results)
51 :target ,(nth i (result-names)))))
54 (let ((arg-name (intern (format nil "ARG-~D" i))))
57 :scs (any-reg descriptor-reg null zero)
58 :target ,(nth i (temp-names))))))
59 `(define-vop (,(static-fun-template-name num-args num-results)
63 (:results ,@(results))
64 (:generator ,(+ 50 num-args num-results)
65 (let ((lra-label (gen-label))
66 (cur-nfp (current-nfp-tn vop)))
67 ,@(moves (arg-names) (temp-names))
68 (inst li (fixnumize ,num-args) nargs)
69 (inst ldw (static-fun-offset symbol) null-tn lip)
71 (store-stack-tn nfp-save cur-nfp))
73 (inst compute-lra-from-code code-tn lra-label temp lra)
74 (note-this-location vop :call-site)
76 (move csp-tn cfp-tn t)
77 (emit-return-pc lra-label)
78 ,(collect ((bindings) (links))
79 (do ((temp (temp-names) (cdr temp))
80 (name 'values (gensym))
85 (make-tn-ref ,(car temp) nil)))
87 (links `(setf (tn-ref-across ,prev) ,name))))
90 (default-unknown-values vop
91 ,(if (zerop num-results) nil 'values)
92 ,num-results move-temp temp lra-label)))
94 (load-stack-tn cur-nfp nfp-save))
95 ,@(moves (temp-names) (result-names))))))))
101 (collect ((templates (list 'progn)))
102 (dotimes (i register-arg-count)
103 (templates (static-fun-template-vop i 1)))
107 (defmacro define-static-fun (name args &key (results '(x)) translate
108 policy cost arg-types result-types)
110 ,(static-fun-template-name (length args)
113 (:note ,(format nil "static-fun ~@(~S~)" name))
115 `((:translate ,translate)))
117 `((:policy ,policy)))
119 `((:generator-cost ,cost)))
121 `((:arg-types ,@arg-types)))
123 `((:result-types ,@result-types)))))