1.0.29.28: optimize (EXPT -1 INTEGER)
[sbcl.git] / 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 allocation-style header lowtag inits)
27   (let ((info (fun-info-or-lose name)))
28     (setf (fun-info-ir2-convert info)
29           (ecase allocation-style
30             (:var-alloc
31              (lambda (node block)
32                 (ir2-convert-variable-allocation node block name words header
33                                                  lowtag inits)))
34             (:fixed-alloc
35              (lambda (node block)
36                (ir2-convert-fixed-allocation node block name words header
37                                              lowtag inits)))
38             (:structure-alloc
39              (lambda (node block)
40                (ir2-convert-structure-allocation node block name words header
41                                                  lowtag inits))))))
42   name)
43
44 (defun %def-casser (name offset lowtag)
45   (let ((fun-info (fun-info-or-lose name)))
46     (setf (fun-info-ir2-convert fun-info)
47           (lambda (node block)
48             (ir2-convert-casser node block name offset lowtag)))))