src/compiler/x86/static-fn.lisp

   1 ;;;; the VOPs and macro magic required to call static functions
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   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.
  11
  12 (in-package "SB!VM")
  13
  14 (file-comment
  15  "$Header$")
  16
  17 (define-vop (static-function-template)
  18   (:save-p t)
  19   (:policy :safe)
  20   (:variant-vars function)
  21   (:vop-var vop)
  22   (:node-var node)
  23   (:temporary (:sc unsigned-reg :offset ebx-offset
  24                    :from (:eval 0) :to (:eval 2)) ebx)
  25   (:temporary (:sc unsigned-reg :offset ecx-offset
  26                    :from (:eval 0) :to (:eval 2)) ecx))
  27
  28 (eval-when (:compile-toplevel :load-toplevel :execute)
  29
  30 (defun static-function-template-name (num-args num-results)
  31   (intern (format nil "~:@(~R-arg-~R-result-static-function~)"
  32                   num-args num-results)))
  33
  34 (defun moves (dst src)
  35   (collect ((moves))
  36     (do ((dst dst (cdr dst))
  37          (src src (cdr src)))
  38         ((or (null dst) (null src)))
  39       (moves `(move ,(car dst) ,(car src))))
  40     (moves)))
  41
  42 (defun static-function-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 (~D) or too many results (~D). Max = ~D"
  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                                :from ,(if (< i num-args)
  60                                           `(:argument ,i)
  61                                           '(:eval 1))
  62                                :to ,(if (< i num-results)
  63                                         `(:result ,i)
  64                                         '(:eval 1))
  65                                ,@(when (< i num-results)
  66                                    `(:target ,(nth i (result-names)))))
  67                               ,temp-name))))
  68       (dotimes (i num-args)
  69         (let ((arg-name (intern (format nil "ARG-~D" i))))
  70           (arg-names arg-name)
  71           (args `(,arg-name
  72                   :scs (any-reg descriptor-reg)
  73                   :target ,(nth i (temp-names))))))
  74       `(define-vop (,(static-function-template-name num-args num-results)
  75                     static-function-template)
  76         (:args ,@(args))
  77         ,@(temps)
  78         (:results ,@(results))
  79         (:generator ,(+ 50 num-args num-results)
  80          ,@(moves (temp-names) (arg-names))
  81
  82          ;; If speed not more important than size, duplicate the
  83          ;; effect of the ENTER with discrete instructions. Takes
  84          ;; 2+1+3+2=8 bytes as opposed to 4+3=7 bytes.
  85          (cond ((policy node (>= speed space))
  86                 (inst mov ebx esp-tn)
  87                 ;; Save the old-fp
  88                 (inst push ebp-tn)
  89                 ;; Ensure that at least three slots are available; one
  90                 ;; above, two more needed.
  91                 (inst sub esp-tn (fixnumize 2))
  92                 (inst mov ebp-tn ebx))
  93                (t
  94                 (inst enter (fixnumize 2))
  95                 ;; The enter instruction pushes EBP and then copies
  96                 ;; ESP into EBP. We want the new EBP to be the
  97                 ;; original ESP, so we fix it up afterwards.
  98                 (inst add ebp-tn (fixnumize 1))))
  99
 100          ,(if (zerop num-args)
 101               '(inst xor ecx ecx)
 102               `(inst mov ecx (fixnumize ,num-args)))
 103
 104          (note-this-location vop :call-site)
 105          ;; Static-function-offset gives the offset from the start of
 106          ;; the nil object to the static function fdefn and has the
 107          ;; low tag of 1 added. When the nil symbol value with its
 108          ;; low tag of 3 is added the resulting value points to the
 109          ;; raw address slot of the fdefn (at +4).
 110          (inst call (make-ea :dword
 111                              :disp (+ *nil-value*
 112                                       (static-function-offset function))))
 113          ,(collect ((bindings) (links))
 114                    (do ((temp (temp-names) (cdr temp))
 115                         (name 'values (gensym))
 116                         (prev nil name)
 117                         (i 0 (1+ i)))
 118                        ((= i num-results))
 119                      (bindings `(,name
 120                                  (make-tn-ref ,(car temp) nil)))
 121                      (when prev
 122                        (links `(setf (tn-ref-across ,prev) ,name))))
 123                    `(let ,(bindings)
 124                      ,@(links)
 125                      (default-unknown-values
 126                          vop
 127                          ,(if (zerop num-results) nil 'values)
 128                        ,num-results)))
 129          ,@(moves (result-names) (temp-names)))))))
 130
 131 ) ; eval-when (compile load eval)
 132
 133 (macrolet ((frob (num-args num-res)
 134              (static-function-template-vop (eval num-args) (eval num-res))))
 135   (frob 0 1)
 136   (frob 1 1)
 137   (frob 2 1)
 138   (frob 3 1))
 139
 140 (defmacro define-static-function (name args &key (results '(x)) translate
 141                                        policy cost arg-types result-types)
 142   `(define-vop (,name
 143                 ,(static-function-template-name (length args)
 144                                                 (length results)))
 145      (:variant ',name)
 146      (:note ,(format nil "static-function ~@(~S~)" name))
 147      ,@(when translate
 148          `((:translate ,translate)))
 149      ,@(when policy
 150          `((:policy ,policy)))
 151      ,@(when cost
 152          `((:generator-cost ,cost)))
 153      ,@(when arg-types
 154          `((:arg-types ,@arg-types)))
 155      ,@(when result-types
 156          `((:result-types ,@result-types)))))