- (let ((arg-name (intern (format nil "ARG-~D" i))))
- (arg-names arg-name)
- (args `(,arg-name
- :scs (any-reg descriptor-reg null zero)
- :target ,(nth i (temp-names))))))
- `(define-vop (,(static-function-template-name num-args num-results)
- static-function-template)
- (:args ,@(args))
- ,@(temps)
- (:results ,@(results))
- (:generator ,(+ 50 num-args num-results)
- (let ((lra-label (gen-label))
- (cur-nfp (current-nfp-tn vop)))
- ,@(moves (arg-names) (temp-names))
- (inst li (fixnumize ,num-args) nargs)
- (inst ldl entry-point (static-function-offset symbol) null-tn)
- (when cur-nfp
- (store-stack-tn nfp-save cur-nfp))
- (inst move cfp-tn ocfp)
- (inst compute-lra-from-code lra code-tn lra-label temp)
- (note-this-location vop :call-site)
- (inst move csp-tn cfp-tn)
- (inst jsr zero-tn entry-point)
- (emit-return-pc lra-label)
- ,(collect ((bindings) (links))
- (do ((temp (temp-names) (cdr temp))
- (name 'values (gensym))
- (prev nil name)
- (i 0 (1+ i)))
- ((= i num-results))
- (bindings `(,name
- (make-tn-ref ,(car temp) nil)))
- (when prev
- (links `(setf (tn-ref-across ,prev) ,name))))
- `(let ,(bindings)
- ,@(links)
- (default-unknown-values vop
- ,(if (zerop num-results) nil 'values)
- ,num-results move-temp temp lra-label)))
- (when cur-nfp
- (maybe-load-stack-nfp-tn cur-nfp nfp-save temp))
- ,@(moves (temp-names) (result-names))))))))
-
-
-) ; eval-when (compile load eval)
-
+ (let ((arg-name (intern (format nil "ARG-~D" i))))
+ (arg-names arg-name)
+ (args `(,arg-name
+ :scs (any-reg descriptor-reg null zero)
+ :target ,(nth i (temp-names))))))
+ `(define-vop (,(static-fun-template-name num-args num-results)
+ static-fun-template)
+ (:args ,@(args))
+ ,@(temps)
+ (:results ,@(results))
+ (:generator ,(+ 50 num-args num-results)
+ (let ((lra-label (gen-label))
+ (cur-nfp (current-nfp-tn vop)))
+ ,@(moves (arg-names) (temp-names))
+ (inst li (fixnumize ,num-args) nargs)
+ (inst ldl entry-point (static-fun-offset symbol) null-tn)
+ (when cur-nfp
+ (store-stack-tn nfp-save cur-nfp))
+ (inst move cfp-tn ocfp)
+ (inst compute-lra-from-code lra code-tn lra-label temp)
+ (note-this-location vop :call-site)
+ (inst move csp-tn cfp-tn)
+ (inst jsr zero-tn entry-point)
+ (emit-return-pc lra-label)
+ ,(collect ((bindings) (links))
+ (do ((temp (temp-names) (cdr temp))
+ (name 'values (gensym))
+ (prev nil name)
+ (i 0 (1+ i)))
+ ((= i num-results))
+ (bindings `(,name
+ (make-tn-ref ,(car temp) nil)))
+ (when prev
+ (links `(setf (tn-ref-across ,prev) ,name))))
+ `(let ,(bindings)
+ ,@(links)
+ (default-unknown-values vop
+ ,(if (zerop num-results) nil 'values)
+ ,num-results move-temp temp lra-label)))
+ (when cur-nfp
+ (maybe-load-stack-nfp-tn cur-nfp nfp-save temp))
+ ,@(moves (temp-names) (result-names))))))))
+
+) ; EVAL-WHEN