01: /*
02: * ftruncate.java
03: *
04: * Copyright (C) 2004 Peter Graves
05: * $Id: ftruncate.java,v 1.3 2004/06/05 02:08:28 piso Exp $
06: *
07: * This program is free software; you can redistribute it and/or
08: * modify it under the terms of the GNU General Public License
09: * 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
20: */
21:
22: package org.armedbear.lisp;
23:
24: // ### ftruncate number &optional divisor => quotient, remainder
25: // (defun ftruncate (number &optional (divisor 1))
26: // (multiple-value-bind (tru rem) (truncate number divisor)
27: // (values (float tru) rem)))
28: public final class ftruncate extends Primitive {
29: private ftruncate() {
30: super ("ftruncate", "number &optional divisor");
31: }
32:
33: public LispObject execute(LispObject arg) throws ConditionThrowable {
34: if (arg instanceof LispFloat)
35: return ((LispFloat) arg).ftruncate(Fixnum.ONE);
36: LispObject q = arg.truncate(Fixnum.ONE); // an integer
37: if (q instanceof Fixnum)
38: q = new LispFloat(((Fixnum) q).value);
39: else
40: q = new LispFloat(((Bignum) q).floatValue());
41: LispThread.currentThread()._values[0] = q;
42: return q;
43: }
44:
45: public LispObject execute(LispObject first, LispObject second)
46: throws ConditionThrowable {
47: if (first instanceof LispFloat)
48: return ((LispFloat) first).ftruncate(second);
49: LispObject q = first.truncate(second); // an integer
50: if (q instanceof Fixnum)
51: q = new LispFloat(((Fixnum) q).value);
52: else
53: q = new LispFloat(((Bignum) q).floatValue());
54: LispThread.currentThread()._values[0] = q;
55: return q;
56: }
57:
58: private static final Primitive FTRUNCATE = new ftruncate();
59: }
|