1 ;;;; cross-compile-time-only replacements for BOOLE machinery.
3 ;;;; This software is part of the SBCL system. See the README file for
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.
14 (eval-when (:compile-toplevel
:load-toplevel
:execute
)
15 (defconstant sb
!xc
:boole-clr
0)
16 (defconstant sb
!xc
:boole-set
1)
17 (defconstant sb
!xc
:boole-1
2)
18 (defconstant sb
!xc
:boole-2
3)
19 (defconstant sb
!xc
:boole-c1
4)
20 (defconstant sb
!xc
:boole-c2
5)
21 (defconstant sb
!xc
:boole-and
6)
22 (defconstant sb
!xc
:boole-ior
7)
23 (defconstant sb
!xc
:boole-xor
8)
24 (defconstant sb
!xc
:boole-eqv
9)
25 (defconstant sb
!xc
:boole-nand
10)
26 (defconstant sb
!xc
:boole-nor
11)
27 (defconstant sb
!xc
:boole-andc1
12)
28 (defconstant sb
!xc
:boole-andc2
13)
29 (defconstant sb
!xc
:boole-orc1
14)
30 (defconstant sb
!xc
:boole-orc2
15))
32 (defun sb!xc
:boole
(boole num1 num2
)
33 (cl:boole
(uncross-boole boole
) num1 num2
))
35 (defun uncross-boole (boole)
37 (#.sb
!xc
:boole-clr cl
:boole-clr
)
38 (#.sb
!xc
:boole-set cl
:boole-set
)
39 (#.sb
!xc
:boole-1 cl
:boole-1
)
40 (#.sb
!xc
:boole-2 cl
:boole-2
)
41 (#.sb
!xc
:boole-c1 cl
:boole-c1
)
42 (#.sb
!xc
:boole-c2 cl
:boole-c2
)
43 (#.sb
!xc
:boole-and cl
:boole-and
)
44 (#.sb
!xc
:boole-ior cl
:boole-ior
)
45 (#.sb
!xc
:boole-xor cl
:boole-xor
)
46 (#.sb
!xc
:boole-eqv cl
:boole-eqv
)
47 (#.sb
!xc
:boole-nand cl
:boole-nand
)
48 (#.sb
!xc
:boole-nor cl
:boole-nor
)
49 (#.sb
!xc
:boole-andc1 cl
:boole-andc1
)
50 (#.sb
!xc
:boole-andc2 cl
:boole-andc2
)
51 (#.sb
!xc
:boole-orc1 cl
:boole-orc1
)
52 (#.sb
!xc
:boole-orc2 cl
:boole-orc2
)))