1 /* 2 * DoubleFloat.java 3 * 4 * Copyright (C) 2003-2007 Peter Graves 5 * $Id$ 6 * 7 * This program is free software; you can redistribute it and/or 8 * modify it under the terms of the GNU General Public License 9 * as published by the Free Software Foundation; either version 2 10 * of the License, or (at your option) any later version. 11 * 12 * This program is distributed in the hope that it will be useful, 13 * but WITHOUT ANY WARRANTY; without even the implied warranty of 14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 * GNU General Public License for more details. 16 * 17 * You should have received a copy of the GNU General Public License 18 * along with this program; if not, write to the Free Software 19 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. 20 * 21 * As a special exception, the copyright holders of this library give you 22 * permission to link this library with independent modules to produce an 23 * executable, regardless of the license terms of these independent 24 * modules, and to copy and distribute the resulting executable under 25 * terms of your choice, provided that you also meet, for each linked 26 * independent module, the terms and conditions of the license of that 27 * module. An independent module is a module which is not derived from 28 * or based on this library. If you modify this library, you may extend 29 * this exception to your version of the library, but you are not 30 * obligated to do so. If you do not wish to do so, delete this 31 * exception statement from your version. 32 */ 33 34 package org.armedbear.lisp; 35 36 import static org.armedbear.lisp.Lisp.*; 37 38 import java.math.BigInteger; 39 40 public final class DoubleFloat extends LispObject 41 { 42 public static final DoubleFloat ZERO = new DoubleFloat(0); 43 public static final DoubleFloat MINUS_ZERO = new DoubleFloat(-0.0d); 44 public static final DoubleFloat ONE = new DoubleFloat(1); 45 public static final DoubleFloat MINUS_ONE = new DoubleFloat(-1); 46 47 public static final DoubleFloat DOUBLE_FLOAT_POSITIVE_INFINITY = 48 new DoubleFloat(Double.POSITIVE_INFINITY); 49 50 public static final DoubleFloat DOUBLE_FLOAT_NEGATIVE_INFINITY = 51 new DoubleFloat(Double.NEGATIVE_INFINITY); 52 53 static { 54 Symbol.DOUBLE_FLOAT_POSITIVE_INFINITY.initializeConstant(DOUBLE_FLOAT_POSITIVE_INFINITY); 55 Symbol.DOUBLE_FLOAT_NEGATIVE_INFINITY.initializeConstant(DOUBLE_FLOAT_NEGATIVE_INFINITY); 56 } 57 getInstance(double d)58 public static DoubleFloat getInstance(double d) { 59 if (d == 0) { 60 long bits = Double.doubleToRawLongBits(d); 61 if (bits < 0) 62 return MINUS_ZERO; 63 else 64 return ZERO; 65 } 66 else if (d == 1) 67 return ONE; 68 else if (d == -1) 69 return MINUS_ONE; 70 else 71 return new DoubleFloat(d); 72 } 73 74 public final double value; 75 DoubleFloat(double value)76 public DoubleFloat(double value) 77 { 78 this.value = value; 79 } 80 81 @Override typeOf()82 public LispObject typeOf() 83 { 84 return Symbol.DOUBLE_FLOAT; 85 } 86 87 @Override classOf()88 public LispObject classOf() 89 { 90 return BuiltInClass.DOUBLE_FLOAT; 91 } 92 93 @Override typep(LispObject typeSpecifier)94 public LispObject typep(LispObject typeSpecifier) 95 { 96 if (typeSpecifier == Symbol.FLOAT) 97 return T; 98 if (typeSpecifier == Symbol.REAL) 99 return T; 100 if (typeSpecifier == Symbol.NUMBER) 101 return T; 102 if (typeSpecifier == Symbol.DOUBLE_FLOAT) 103 return T; 104 if (typeSpecifier == Symbol.LONG_FLOAT) 105 return T; 106 if (typeSpecifier == BuiltInClass.FLOAT) 107 return T; 108 if (typeSpecifier == BuiltInClass.DOUBLE_FLOAT) 109 return T; 110 return super.typep(typeSpecifier); 111 } 112 113 @Override numberp()114 public boolean numberp() 115 { 116 return true; 117 } 118 119 @Override realp()120 public boolean realp() 121 { 122 return true; 123 } 124 125 @Override eql(LispObject obj)126 public boolean eql(LispObject obj) 127 { 128 if (this == obj) 129 return true; 130 if (obj instanceof DoubleFloat) { 131 if (value == 0) { 132 // "If an implementation supports positive and negative zeros 133 // as distinct values, then (EQL 0.0 -0.0) returns false." 134 double d = ((DoubleFloat)obj).value; 135 long bits = Double.doubleToRawLongBits(d); 136 return bits == Double.doubleToRawLongBits(value); 137 } 138 if (value == ((DoubleFloat)obj).value) 139 return true; 140 } 141 return false; 142 } 143 144 @Override equal(LispObject obj)145 public boolean equal(LispObject obj) 146 { 147 if (this == obj) 148 return true; 149 if (obj instanceof DoubleFloat) { 150 if (value == 0) { 151 // same as EQL 152 double d = ((DoubleFloat)obj).value; 153 long bits = Double.doubleToRawLongBits(d); 154 return bits == Double.doubleToRawLongBits(value); 155 } 156 if (value == ((DoubleFloat)obj).value) 157 return true; 158 } 159 return false; 160 } 161 162 @Override equalp(int n)163 public boolean equalp(int n) 164 { 165 // "If two numbers are the same under =." 166 return value == n; 167 } 168 169 @Override equalp(LispObject obj)170 public boolean equalp(LispObject obj) 171 { 172 if (obj != null && obj.numberp()) 173 return isEqualTo(obj); 174 return false; 175 } 176 177 @Override ABS()178 public LispObject ABS() 179 { 180 if (value > 0) 181 return this; 182 if (value == 0) // 0.0 or -0.0 183 return ZERO; 184 return new DoubleFloat(- value); 185 } 186 187 @Override plusp()188 public boolean plusp() 189 { 190 return value > 0; 191 } 192 193 @Override minusp()194 public boolean minusp() 195 { 196 return value < 0; 197 } 198 199 @Override zerop()200 public boolean zerop() 201 { 202 return value == 0; 203 } 204 205 @Override floatp()206 public boolean floatp() 207 { 208 return true; 209 } 210 getValue(LispObject obj)211 public static double getValue(LispObject obj) 212 { 213 if (obj instanceof DoubleFloat) 214 return ((DoubleFloat)obj).value; 215 type_error(obj, Symbol.FLOAT); 216 // Not reached. 217 return 0; 218 } 219 getValue()220 public final double getValue() 221 { 222 return value; 223 } 224 225 @Override doubleValue()226 public double doubleValue() { 227 return value; 228 } 229 230 @Override javaInstance()231 public Object javaInstance() 232 { 233 return Double.valueOf(value); 234 } 235 236 @Override javaInstance(Class c)237 public Object javaInstance(Class c) 238 { 239 if (c == Float.class || c == float.class) 240 return Float.valueOf((float)value); 241 return javaInstance(); 242 } 243 244 @Override incr()245 public final LispObject incr() 246 { 247 return new DoubleFloat(value + 1); 248 } 249 250 @Override decr()251 public final LispObject decr() 252 { 253 return new DoubleFloat(value - 1); 254 } 255 256 @Override negate()257 public LispObject negate() 258 { 259 if (value == 0) { 260 long bits = Double.doubleToRawLongBits(value); 261 return (bits < 0) ? ZERO : MINUS_ZERO; 262 } 263 return new DoubleFloat(-value); 264 } 265 266 @Override add(LispObject obj)267 public LispObject add(LispObject obj) 268 { 269 if (obj instanceof Fixnum) 270 return new DoubleFloat(value + ((Fixnum)obj).value); 271 if (obj instanceof SingleFloat) 272 return new DoubleFloat(value + ((SingleFloat)obj).value); 273 if (obj instanceof DoubleFloat) 274 return new DoubleFloat(value + ((DoubleFloat)obj).value); 275 if (obj instanceof Bignum) 276 return new DoubleFloat(value + ((Bignum)obj).doubleValue()); 277 if (obj instanceof Ratio) 278 return new DoubleFloat(value + ((Ratio)obj).doubleValue()); 279 if (obj instanceof Complex) { 280 Complex c = (Complex) obj; 281 return Complex.getInstance(add(c.getRealPart()), c.getImaginaryPart()); 282 } 283 return type_error(obj, Symbol.NUMBER); 284 } 285 286 @Override subtract(LispObject obj)287 public LispObject subtract(LispObject obj) 288 { 289 if (obj instanceof Fixnum) 290 return new DoubleFloat(value - ((Fixnum)obj).value); 291 if (obj instanceof SingleFloat) 292 return new DoubleFloat(value - ((SingleFloat)obj).value); 293 if (obj instanceof DoubleFloat) 294 return new DoubleFloat(value - ((DoubleFloat)obj).value); 295 if (obj instanceof Bignum) 296 return new DoubleFloat(value - ((Bignum)obj).doubleValue()); 297 if (obj instanceof Ratio) 298 return new DoubleFloat(value - ((Ratio)obj).doubleValue()); 299 if (obj instanceof Complex) { 300 Complex c = (Complex) obj; 301 return Complex.getInstance(subtract(c.getRealPart()), 302 ZERO.subtract(c.getImaginaryPart())); 303 } 304 return type_error(obj, Symbol.NUMBER); 305 } 306 307 @Override multiplyBy(LispObject obj)308 public LispObject multiplyBy(LispObject obj) 309 { 310 if (obj instanceof Fixnum) 311 return new DoubleFloat(value * ((Fixnum)obj).value); 312 if (obj instanceof SingleFloat) 313 return new DoubleFloat(value * ((SingleFloat)obj).value); 314 if (obj instanceof DoubleFloat) 315 return new DoubleFloat(value * ((DoubleFloat)obj).value); 316 if (obj instanceof Bignum) 317 return new DoubleFloat(value * ((Bignum)obj).doubleValue()); 318 if (obj instanceof Ratio) 319 return new DoubleFloat(value * ((Ratio)obj).doubleValue()); 320 if (obj instanceof Complex) { 321 Complex c = (Complex) obj; 322 return Complex.getInstance(multiplyBy(c.getRealPart()), 323 multiplyBy(c.getImaginaryPart())); 324 } 325 return type_error(obj, Symbol.NUMBER); 326 } 327 328 @Override divideBy(LispObject obj)329 public LispObject divideBy(LispObject obj) 330 { 331 if (obj instanceof Fixnum) 332 return new DoubleFloat(value / ((Fixnum)obj).value); 333 if (obj instanceof SingleFloat) 334 return new DoubleFloat(value / ((SingleFloat)obj).value); 335 if (obj instanceof DoubleFloat) 336 return new DoubleFloat(value / ((DoubleFloat)obj).value); 337 if (obj instanceof Bignum) 338 return new DoubleFloat(value / ((Bignum)obj).doubleValue()); 339 if (obj instanceof Ratio) 340 return new DoubleFloat(value / ((Ratio)obj).doubleValue()); 341 if (obj instanceof Complex) { 342 Complex c = (Complex) obj; 343 LispObject re = c.getRealPart(); 344 LispObject im = c.getImaginaryPart(); 345 LispObject denom = re.multiplyBy(re).add(im.multiplyBy(im)); 346 LispObject resX = multiplyBy(re).divideBy(denom); 347 LispObject resY = 348 multiplyBy(Fixnum.MINUS_ONE).multiplyBy(im).divideBy(denom); 349 return Complex.getInstance(resX, resY); 350 } 351 return type_error(obj, Symbol.NUMBER); 352 } 353 354 @Override isEqualTo(LispObject obj)355 public boolean isEqualTo(LispObject obj) 356 { 357 if (obj instanceof Fixnum) 358 return value == ((Fixnum)obj).value; 359 if (obj instanceof SingleFloat) 360 return value == ((SingleFloat)obj).value; 361 if (obj instanceof DoubleFloat) 362 return value == ((DoubleFloat)obj).value; 363 if (obj instanceof Bignum) 364 return rational().isEqualTo(obj); 365 if (obj instanceof Ratio) 366 return rational().isEqualTo(obj); 367 if (obj instanceof Complex) 368 return obj.isEqualTo(this); 369 type_error(obj, Symbol.NUMBER); 370 // Not reached. 371 return false; 372 } 373 374 @Override isNotEqualTo(LispObject obj)375 public boolean isNotEqualTo(LispObject obj) 376 { 377 return !isEqualTo(obj); 378 } 379 380 @Override isLessThan(LispObject obj)381 public boolean isLessThan(LispObject obj) 382 { 383 if (obj instanceof Fixnum) 384 return value < ((Fixnum)obj).value; 385 if (obj instanceof SingleFloat) 386 return value < ((SingleFloat)obj).value; 387 if (obj instanceof DoubleFloat) 388 return value < ((DoubleFloat)obj).value; 389 if (obj instanceof Bignum) 390 return rational().isLessThan(obj); 391 if (obj instanceof Ratio) 392 return rational().isLessThan(obj); 393 type_error(obj, Symbol.REAL); 394 // Not reached. 395 return false; 396 } 397 398 @Override isGreaterThan(LispObject obj)399 public boolean isGreaterThan(LispObject obj) 400 { 401 if (obj instanceof Fixnum) 402 return value > ((Fixnum)obj).value; 403 if (obj instanceof SingleFloat) 404 return value > ((SingleFloat)obj).value; 405 if (obj instanceof DoubleFloat) 406 return value > ((DoubleFloat)obj).value; 407 if (obj instanceof Bignum) 408 return rational().isGreaterThan(obj); 409 if (obj instanceof Ratio) 410 return rational().isGreaterThan(obj); 411 type_error(obj, Symbol.REAL); 412 // Not reached. 413 return false; 414 } 415 416 @Override isLessThanOrEqualTo(LispObject obj)417 public boolean isLessThanOrEqualTo(LispObject obj) 418 { 419 if (obj instanceof Fixnum) 420 return value <= ((Fixnum)obj).value; 421 if (obj instanceof SingleFloat) 422 return value <= ((SingleFloat)obj).value; 423 if (obj instanceof DoubleFloat) 424 return value <= ((DoubleFloat)obj).value; 425 if (obj instanceof Bignum) 426 return rational().isLessThanOrEqualTo(obj); 427 if (obj instanceof Ratio) 428 return rational().isLessThanOrEqualTo(obj); 429 type_error(obj, Symbol.REAL); 430 // Not reached. 431 return false; 432 } 433 434 @Override isGreaterThanOrEqualTo(LispObject obj)435 public boolean isGreaterThanOrEqualTo(LispObject obj) 436 { 437 if (obj instanceof Fixnum) 438 return value >= ((Fixnum)obj).value; 439 if (obj instanceof SingleFloat) 440 return value >= ((SingleFloat)obj).value; 441 if (obj instanceof DoubleFloat) 442 return value >= ((DoubleFloat)obj).value; 443 if (obj instanceof Bignum) 444 return rational().isGreaterThanOrEqualTo(obj); 445 if (obj instanceof Ratio) 446 return rational().isGreaterThanOrEqualTo(obj); 447 type_error(obj, Symbol.REAL); 448 // Not reached. 449 return false; 450 } 451 452 @Override truncate(LispObject obj)453 public LispObject truncate(LispObject obj) 454 { 455 // "When rationals and floats are combined by a numerical function, 456 // the rational is first converted to a float of the same format." 457 // 12.1.4.1 458 if (obj instanceof Fixnum) { 459 return truncate(new DoubleFloat(((Fixnum)obj).value)); 460 } 461 if (obj instanceof Bignum) { 462 return truncate(new DoubleFloat(((Bignum)obj).doubleValue())); 463 } 464 if (obj instanceof Ratio) { 465 return truncate(new DoubleFloat(((Ratio)obj).doubleValue())); 466 } 467 if (obj instanceof SingleFloat) { 468 final LispThread thread = LispThread.currentThread(); 469 double divisor = ((SingleFloat)obj).value; 470 double quotient = value / divisor; 471 if (value != 0) 472 MathFunctions.OverUnderFlowCheck(quotient); 473 if (quotient >= Integer.MIN_VALUE && quotient <= Integer.MAX_VALUE) { 474 int q = (int) quotient; 475 return thread.setValues(Fixnum.getInstance(q), 476 new DoubleFloat(value - q * divisor)); 477 } 478 // We need to convert the quotient to a bignum. 479 long bits = Double.doubleToRawLongBits((double)quotient); 480 int s = ((bits >> 63) == 0) ? 1 : -1; 481 int e = (int) ((bits >> 52) & 0x7ffL); 482 long m; 483 if (e == 0) 484 m = (bits & 0xfffffffffffffL) << 1; 485 else 486 m = (bits & 0xfffffffffffffL) | 0x10000000000000L; 487 LispObject significand = number(m); 488 Fixnum exponent = Fixnum.getInstance(e - 1075); 489 Fixnum sign = Fixnum.getInstance(s); 490 LispObject result = significand; 491 result = 492 result.multiplyBy(MathFunctions.EXPT.execute(Fixnum.TWO, exponent)); 493 result = result.multiplyBy(sign); 494 // Calculate remainder. 495 LispObject product = result.multiplyBy(obj); 496 LispObject remainder = subtract(product); 497 return thread.setValues(result, remainder); 498 } 499 if (obj instanceof DoubleFloat) { 500 // Debug.trace("value = " + value); 501 final LispThread thread = LispThread.currentThread(); 502 double divisor = ((DoubleFloat)obj).value; 503 // Debug.trace("divisor = " + divisor); 504 double quotient = value / divisor; 505 if (value != 0) 506 MathFunctions.OverUnderFlowCheck(quotient); 507 // Debug.trace("quotient = " + quotient); 508 if (quotient >= Integer.MIN_VALUE && quotient <= Integer.MAX_VALUE) { 509 int q = (int) quotient; 510 return thread.setValues(Fixnum.getInstance(q), 511 new DoubleFloat(value - q * divisor)); 512 } 513 // We need to convert the quotient to a bignum. 514 long bits = Double.doubleToRawLongBits((double)quotient); 515 int s = ((bits >> 63) == 0) ? 1 : -1; 516 int e = (int) ((bits >> 52) & 0x7ffL); 517 long m; 518 if (e == 0) 519 m = (bits & 0xfffffffffffffL) << 1; 520 else 521 m = (bits & 0xfffffffffffffL) | 0x10000000000000L; 522 LispObject significand = number(m); 523 // Debug.trace("significand = " + significand.printObject()); 524 Fixnum exponent = Fixnum.getInstance(e - 1075); 525 // Debug.trace("exponent = " + exponent.printObject()); 526 Fixnum sign = Fixnum.getInstance(s); 527 // Debug.trace("sign = " + sign.printObject()); 528 LispObject result = significand; 529 // Debug.trace("result = " + result.printObject()); 530 result = 531 result.multiplyBy(MathFunctions.EXPT.execute(Fixnum.TWO, exponent)); 532 // Debug.trace("result = " + result.printObject()); 533 534 535 result = result.truncate(Fixnum.ONE); 536 LispObject remainder = coerceToFloat(thread._values[1]); 537 538 result = result.multiplyBy(sign); 539 // Debug.trace("result = " + result.printObject()); 540 // // Calculate remainder. 541 // LispObject product = result.multiplyBy(obj); 542 // Debug.trace("product = " + product.printObject()); 543 // LispObject remainder = subtract(product); 544 return thread.setValues(result, remainder); 545 } 546 return type_error(obj, Symbol.REAL); 547 } 548 549 @Override hashCode()550 public int hashCode() 551 { 552 long bits = Double.doubleToLongBits(value); 553 return (int) (bits ^ (bits >>> 32)); 554 } 555 556 @Override psxhash()557 public int psxhash() 558 { 559 if ((value % 1) == 0) 560 return (((int)value) & 0x7fffffff); 561 else 562 return (hashCode() & 0x7fffffff); 563 } 564 565 @Override printObject()566 public String printObject() 567 { 568 if (value == Double.POSITIVE_INFINITY) { 569 StringBuilder sb = new StringBuilder("#."); 570 sb.append(Symbol.DOUBLE_FLOAT_POSITIVE_INFINITY.printObject()); 571 return sb.toString(); 572 } 573 if (value == Double.NEGATIVE_INFINITY) { 574 StringBuilder sb = new StringBuilder("#."); 575 sb.append(Symbol.DOUBLE_FLOAT_NEGATIVE_INFINITY.printObject()); 576 return sb.toString(); 577 } 578 579 LispThread thread = LispThread.currentThread(); 580 boolean printReadably = Symbol.PRINT_READABLY.symbolValue(thread) != NIL; 581 582 if (value != value) { 583 if (printReadably) 584 return "#.(CL:PROGN \"Comment: create a NaN.\" (CL:/ 0.0d0 0.0d0))"; 585 else 586 return unreadableString("DOUBLE-FLOAT NaN", false); 587 } 588 String s1 = String.valueOf(value); 589 if (printReadably || 590 !memq(Symbol.READ_DEFAULT_FLOAT_FORMAT.symbolValue(thread), 591 list(Symbol.DOUBLE_FLOAT, Symbol.LONG_FLOAT))) 592 { 593 if (s1.indexOf('E') >= 0) 594 return s1.replace('E', 'd'); 595 else 596 return s1.concat("d0"); 597 } else 598 return s1; 599 } 600 rational()601 public LispObject rational() 602 { 603 final long bits = Double.doubleToRawLongBits(value); 604 int sign = ((bits >> 63) == 0) ? 1 : -1; 605 int storedExponent = (int) ((bits >> 52) & 0x7ffL); 606 long mantissa; 607 if (storedExponent == 0) 608 mantissa = (bits & 0xfffffffffffffL) << 1; 609 else 610 mantissa = (bits & 0xfffffffffffffL) | 0x10000000000000L; 611 if (mantissa == 0) 612 return Fixnum.ZERO; 613 if (sign < 0) 614 mantissa = -mantissa; 615 // Subtract bias. 616 final int exponent = storedExponent - 1023; 617 BigInteger numerator, denominator; 618 if (exponent < 0) { 619 numerator = BigInteger.valueOf(mantissa); 620 denominator = BigInteger.valueOf(1).shiftLeft(52 - exponent); 621 } else { 622 numerator = BigInteger.valueOf(mantissa).shiftLeft(exponent); 623 denominator = BigInteger.valueOf(0x10000000000000L); // (ash 1 52) 624 } 625 return number(numerator, denominator); 626 } 627 coerceToFloat(LispObject obj)628 public static DoubleFloat coerceToFloat(LispObject obj) 629 { 630 if (obj instanceof DoubleFloat) 631 return (DoubleFloat) obj; 632 if (obj instanceof Fixnum) 633 return new DoubleFloat(((Fixnum)obj).value); 634 if (obj instanceof Bignum) 635 return new DoubleFloat(((Bignum)obj).doubleValue()); 636 if (obj instanceof SingleFloat) 637 return new DoubleFloat(((SingleFloat)obj).value); 638 if (obj instanceof Ratio) 639 return new DoubleFloat(((Ratio)obj).doubleValue()); 640 error(new TypeError("The value " + obj.princToString() + 641 " cannot be converted to type DOUBLE-FLOAT.")); 642 // Not reached. 643 return null; 644 } 645 } 646