X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Falpha%2Fstatic-fn.lisp;h=e69de29bb2d1d6434b8b29ae775ad8c2e48c5391;hb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;hp=faf2758381d7d87b4086356b4138a09cc1dbae2e;hpb=79cc569a97e444389350ea3f5b1017374fe16bec;p=sbcl.git

diff --git a/src/compiler/alpha/static-fn.lisp b/src/compiler/alpha/static-fn.lisp
index faf2758..e69de29 100644
--- a/src/compiler/alpha/static-fn.lisp
+++ b/src/compiler/alpha/static-fn.lisp
@@ -1,131 +0,0 @@
-;;;; VOPs and macro magic for calling static functions
-
-;;;; This software is part of the SBCL system. See the README file for
-;;;; more information.
-;;;;
-;;;; This software is derived from the CMU CL system, which was
-;;;; written at Carnegie Mellon University and released into the
-;;;; public domain. The software is in the public domain and is
-;;;; provided with absolutely no warranty. See the COPYING and CREDITS
-;;;; files for more information.
-
-(in-package "SB!VM")
-
-(define-vop (static-fun-template)
-  (:save-p t)
-  (:policy :safe)
-  (:variant-vars symbol)
-  (:vop-var vop)
-  (:temporary (:scs (non-descriptor-reg)) temp)
-  (:temporary (:scs (descriptor-reg)) move-temp)
-  (:temporary (:sc descriptor-reg :offset lra-offset) lra)
-  (:temporary (:sc interior-reg :offset lip-offset) entry-point)
-  (:temporary (:sc any-reg :offset nargs-offset) nargs)
-  (:temporary (:sc any-reg :offset ocfp-offset) ocfp)
-  (:temporary (:sc control-stack :offset nfp-save-offset) nfp-save))
-
-(eval-when  (:compile-toplevel :load-toplevel :execute)
-
-(defun static-fun-template-name (num-args num-results)
-  (intern (format nil "~:@(~R-arg-~R-result-static-fun~)"
-		  num-args num-results)))
-
-(defun moves (src dst)
-  (collect ((moves))
-    (do ((dst dst (cdr dst))
-	 (src src (cdr src)))
-	((or (null dst) (null src)))
-      (moves `(move ,(car src) ,(car dst))))
-    (moves)))
-
-(defun static-fun-template-vop (num-args num-results)
-  (unless (and (<= num-args register-arg-count)
-	       (<= num-results register-arg-count))
-    (error "either too many args (~W) or too many results (~W); max = ~W"
-	   num-args num-results register-arg-count))
-  (let ((num-temps (max num-args num-results)))
-    (collect ((temp-names) (temps) (arg-names) (args) (result-names) (results))
-      (dotimes (i num-results)
-	(let ((result-name (intern (format nil "RESULT-~D" i))))
-	  (result-names result-name)
-	  (results `(,result-name :scs (any-reg descriptor-reg)))))
-      (dotimes (i num-temps)
-	(let ((temp-name (intern (format nil "TEMP-~D" i))))
-	  (temp-names temp-name)
-	  (temps `(:temporary (:sc descriptor-reg
-			       :offset ,(nth i *register-arg-offsets*)
-			       ,@(when (< i num-args)
-				   `(:from (:argument ,i)))
-			       ,@(when (< i num-results)
-				   `(:to (:result ,i)
-				     :target ,(nth i (result-names)))))
-			      ,temp-name))))
-      (dotimes (i num-args)
-	(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
-
-(expand
- (collect ((templates (list 'progn)))
-   (dotimes (i register-arg-count)
-     (templates (static-fun-template-vop i 1)))
-   (templates)))
-
-(defmacro define-static-fun (name args &key (results '(x)) translate
-				       policy cost arg-types result-types)
-  `(define-vop (,name
-		,(static-fun-template-name (length args)
-					   (length results)))
-     (:variant ',name)
-     (:note ,(format nil "static-fun ~@(~S~)" name))
-     ,@(when translate
-	 `((:translate ,translate)))
-     ,@(when policy
-	 `((:policy ,policy)))
-     ,@(when cost
-	 `((:generator-cost ,cost)))
-     ,@(when arg-types
-	 `((:arg-types ,@arg-types)))
-     ,@(when result-types
-	 `((:result-types ,@result-types)))))