0.9.13.30
[sbcl.git] / src / code / cross-modular.lisp
1 ;;;; cross-compile-time-only replacements for modular functions;
2 ;;;; needed for constant-folding
3
4 ;;;; This software is part of the SBCL system. See the README file for
5 ;;;; more information.
6 ;;;;
7 ;;;; This software is derived from the CMU CL system, which was
8 ;;;; written at Carnegie Mellon University and released into the
9 ;;;; public domain. The software is in the public domain and is
10 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
11 ;;;; files for more information.
12
13 (in-package "SB!C")
14
15 (defun mask-signed-field (size integer)
16   (cond ((zerop size)
17          0)
18         ((logbitp (1- size) integer)
19          (dpb integer (byte size 0) -1))
20         (t
21          (ldb (byte size 0) integer))))
22
23 #.
24 (collect ((forms))
25   (flet ((definition (name lambda-list prototype width)
26            `(defun ,name ,lambda-list
27               (ldb (byte ,width 0) (,prototype ,@lambda-list)))))
28     (loop for infos being each hash-value of (modular-class-funs *unsigned-modular-class*) using (hash-key prototype)
29           when (listp infos)
30           do (loop for info in infos
31                    for name = (modular-fun-info-name info)
32                    and width = (modular-fun-info-width info)
33                    and lambda-list = (modular-fun-info-lambda-list info)
34                    do (forms (definition name lambda-list prototype width)))))
35   `(progn ,@(forms)))
36
37 #.
38 (collect ((forms))
39   (flet ((definition (name lambda-list prototype width)
40            `(defun ,name ,lambda-list
41               (mask-signed-field ,width (,prototype ,@lambda-list)))))
42     (loop for infos being each hash-value of (modular-class-funs *signed-modular-class*) using (hash-key prototype)
43           when (listp infos)
44           do (loop for info in infos
45                    for name = (modular-fun-info-name info)
46                    and width = (modular-fun-info-width info)
47                    and lambda-list = (modular-fun-info-lambda-list info)
48                    do (forms (definition name lambda-list prototype width)))))
49   `(progn ,@(forms)))
50
51 #!+#.(cl:if (cl:= sb!vm:n-machine-word-bits 32) '(and) '(or))
52 (defun sb!vm::ash-left-mod32 (integer amount)
53   (ldb (byte 32 0) (ash integer amount)))
54 #!+#.(cl:if (cl:= sb!vm:n-machine-word-bits 64) '(and) '(or))
55 (defun sb!vm::ash-left-mod64 (integer amount)
56   (ldb (byte 64 0) (ash integer amount)))
57 #!+x86
58 (defun sb!vm::ash-left-smod30 (integer amount)
59   (mask-signed-field 30 (ash integer amount)))
60 #!+x86-64
61 (defun sb!vm::ash-left-smod61 (integer amount)
62   (mask-signed-field 61 (ash integer amount)))
63