src/compiler/fun-info-funs.lisp

   1 ;;;; functions which have a build order dependency on FUN-INFO
   2 ;;;; (because ANSI allows xc host structure slot setters to be
   3 ;;;; implemented as SETF expanders instead of SETF functions, so we
   4 ;;;; can't safely forward-reference them) and so have to be defined
   5 ;;;; physically late instead of in a more logical place
   6
   7 (in-package "SB!C")
   8
   9 (defun %def-reffer (name offset lowtag)
  10   (let ((fun-info (fun-info-or-lose name)))
  11     (setf (fun-info-ir2-convert fun-info)
  12           (lambda (node block)
  13             (ir2-convert-reffer node block name offset lowtag))))
  14   name)
  15
  16 (defun %def-setter (name offset lowtag)
  17   (let ((fun-info (fun-info-or-lose name)))
  18     (setf (fun-info-ir2-convert fun-info)
  19           (if (listp name)
  20               (lambda (node block)
  21                 (ir2-convert-setfer node block name offset lowtag))
  22               (lambda (node block)
  23                 (ir2-convert-setter node block name offset lowtag)))))
  24   name)
  25
  26 (defun %def-alloc (name words variable-length-p header lowtag inits)
  27   (let ((info (fun-info-or-lose name)))
  28     (setf (fun-info-ir2-convert info)
  29           (if variable-length-p
  30               (lambda (node block)
  31                 (ir2-convert-variable-allocation node block name words header
  32                                                  lowtag inits))
  33               (lambda (node block)
  34                 (ir2-convert-fixed-allocation node block name words header
  35                                               lowtag inits)))))
  36   name)
  37
  38 (defun %def-casser (name offset lowtag)
  39   (let ((fun-info (fun-info-or-lose name)))
  40     (setf (fun-info-ir2-convert fun-info)
  41           (lambda (node block)
  42             (ir2-convert-casser node block name offset lowtag)))))