1 ;;;; VOPs and macro magic for calling static functions
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
14 (define-vop (static-fun-template)
17 (:variant-vars symbol)
19 (:temporary (:scs (non-descriptor-reg)) temp)
20 (:temporary (:scs (descriptor-reg)) move-temp)
21 (:temporary (:sc descriptor-reg :offset lra-offset) lra)
22 (:temporary (:scs (descriptor-reg)) func)
23 (:temporary (:sc any-reg :offset nargs-offset) nargs)
24 (:temporary (:sc any-reg :offset ocfp-offset) old-fp)
25 (:temporary (:sc control-stack :offset nfp-save-offset) nfp-save))
28 (eval-when (:compile-toplevel :load-toplevel :execute)
30 (defun static-fun-template-name (num-args num-results)
31 (intern (format nil "~:@(~R-arg-~R-result-static-fun~)"
32 num-args num-results)))
34 (defun moves (dst src)
36 (do ((dst dst (cdr dst))
38 ((or (null dst) (null src)))
39 (moves `(move ,(car dst) ,(car src))))
42 (defun static-fun-template-vop (num-args num-results)
43 (assert (and (<= num-args register-arg-count)
44 (<= num-results register-arg-count))
45 (num-args num-results)
46 "Either too many args (~W) or too many results (~W). Max = ~W"
47 num-args num-results register-arg-count)
48 (let ((num-temps (max num-args num-results)))
49 (collect ((temp-names) (temps) (arg-names) (args) (result-names) (results))
50 (dotimes (i num-results)
51 (let ((result-name (intern (format nil "RESULT-~D" i))))
52 (result-names result-name)
53 (results `(,result-name :scs (any-reg descriptor-reg)))))
54 (dotimes (i num-temps)
55 (let ((temp-name (intern (format nil "TEMP-~D" i))))
56 (temp-names temp-name)
57 (temps `(:temporary (:sc descriptor-reg
58 :offset ,(nth i *register-arg-offsets*)
59 ,@(when (< i num-args)
60 `(:from (:argument ,i)))
61 ,@(when (< i num-results)
63 :target ,(nth i (result-names)))))
66 (let ((arg-name (intern (format nil "ARG-~D" i))))
69 :scs (any-reg descriptor-reg)
70 :target ,(nth i (temp-names))))))
71 `(define-vop (,(static-fun-template-name num-args num-results)
75 (:results ,@(results))
76 (:generator ,(+ 50 num-args num-results)
77 (let ((lra-label (gen-label))
78 (cur-nfp (current-nfp-tn vop)))
79 ,@(moves (temp-names) (arg-names))
80 (inst ld func null-tn (static-fun-offset symbol))
81 (inst li nargs (fixnumize ,num-args))
83 (store-stack-tn nfp-save cur-nfp))
84 (inst move old-fp cfp-tn)
85 (inst move cfp-tn csp-tn)
86 (inst compute-lra-from-code lra code-tn lra-label temp)
87 (note-this-location vop :call-site)
88 (inst j func (- (ash simple-fun-code-offset word-shift)
90 (inst move code-tn func)
91 (emit-return-pc lra-label)
92 ,(collect ((bindings) (links))
93 (do ((temp (temp-names) (cdr temp))
94 (name 'values (gensym))
99 (make-tn-ref ,(car temp) nil)))
101 (links `(setf (tn-ref-across ,prev) ,name))))
104 (default-unknown-values vop
105 ,(if (zerop num-results) nil 'values)
106 ,num-results move-temp temp lra-label)))
108 (load-stack-tn cur-nfp nfp-save))
109 ,@(moves (result-names) (temp-names))))))))
115 ;;; FIXME! This looks like a candidate for a dotimes to
116 ;;; register-arg-count.
117 (macrolet ((frob (num-args num-res)
118 (static-fun-template-vop (eval num-args) (eval num-res))))
126 (defmacro define-static-fun (name args &key (results '(x)) translate
127 policy cost arg-types result-types)
129 ,(static-fun-template-name (length args)
132 (:note ,(format nil "static-fun ~@(~S~)" name))
134 `((:translate ,translate)))
136 `((:policy ,policy)))
138 `((:generator-cost ,cost)))
140 `((:arg-types ,@arg-types)))
142 `((:result-types ,@result-types)))))