src/code/cross-boole.lisp

   1 ;;;; cross-compile-time-only replacements for BOOLE machinery.
   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!INT")
  13
  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))
  31
  32 (defun sb!xc:boole (boole num1 num2)
  33   (cl:boole (uncross-boole boole) num1 num2))
  34
  35 (defun uncross-boole (boole)
  36   (case 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)))