Skip to content
Snippets Groups Projects
Commit a30d1ccc authored by Raymond Toy's avatar Raymond Toy
Browse files

Merge branch 'arm-rtoy-change-make-ea-addstatic-fn' into arm-rtoy-add-static-fn.lisp

parents 83cc8605 61e02856
No related branches found
No related tags found
No related merge requests found
;;; -*- Package: ARM -*-
;;;
;;; **********************************************************************
;;; This code was written as part of the CMU Common Lisp project at
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
"$Header: src/compiler/arm/static-fn.lisp $")
;;;
;;; **********************************************************************
;;;
;;; This file contains the VOPs and macro magic necessary to call static
;;; functions.
;;;
;;;
(in-package "ARM")
(intl:textdomain "cmucl-arm-vm")
(define-vop (static-function-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 (:scs (descriptor-reg)) func)
(:temporary (:sc any-reg :offset nargs-offset) nargs)
(:temporary (:sc any-reg :offset ocfp-offset) old-fp)
(:temporary (:sc control-stack :offset nfp-save-offset) nfp-save))
(eval-when (compile load eval)
(defun static-function-template-name (num-args num-results)
(intern (format nil "~:@(~R-arg-~R-result-static-function~)"
num-args num-results)))
(defun moves (dst src)
(collect ((moves))
(do ((dst dst (cdr dst))
(src src (cdr src)))
((or (null dst) (null src)))
(moves `(move ,(car dst) ,(car src))))
(moves)))
(defun static-function-template-vop (num-args num-results)
(assert (and (<= num-args register-arg-count)
(<= num-results register-arg-count))
(num-args num-results)
(intl:gettext "Either too many args (~D) or too many results (~D). Max = ~D")
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)
: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)
(not-implemented))))))
) ; eval-when (compile load eval)
(macrolet ((frob (num-args num-res)
(static-function-template-vop (eval num-args) (eval num-res))))
(frob 0 1)
(frob 1 1)
(frob 2 1)
(frob 3 1))
(defmacro define-static-function (name args &key (results '(x)) translate
policy cost arg-types result-types)
`(define-vop (,name
,(static-function-template-name (length args)
(length results)))
(:variant ',name)
(:note ,(format nil "static-function ~@(~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)))))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment