src/code/unportable-float.lisp

   1 ;;;; nonportable floating point things, useful in LOAD-TIME-VALUE
   2 ;;;; forms for referring to floating point objects that will exist on
   3 ;;;; the SBCL target but may not when running under an ordinary ANSI
   4 ;;;; Common Lisp implementation.
   5
   6 ;;;; This software is part of the SBCL system. See the README file for
   7 ;;;; more information.
   8 ;;;;
   9 ;;;; This software is derived from the CMU CL system, which was
  10 ;;;; written at Carnegie Mellon University and released into the
  11 ;;;; public domain. The software is in the public domain and is
  12 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  13 ;;;; files for more information.
  14
  15 (in-package "SB!IMPL")
  16
  17 (defun make-unportable-float (name)
  18   (flet ((opaque-identity (x) x))
  19     ;; KLUDGE: "DO NOT CONSTANT FOLD, EVIL COMPILER!"
  20     (declare (notinline opaque-identity make-single-float make-double-float))
  21     (ecase name
  22       (:single-float-negative-zero (make-single-float
  23                                     (opaque-identity #x-80000000)))
  24       (:double-float-negative-zero (make-double-float
  25                                     (opaque-identity #x-80000000)
  26                                     (opaque-identity #x00000000)))
  27       #!+long-float
  28       (:long-float-negative-zero (error "write LONG-FLOAT creation form")))))