view src/objects-impl.h @ 4678:b5e1d4f6b66f

Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp. lisp/ChangeLog addition: 2009-08-11 Aidan Kehoe <kehoea@parhasard.net> * cl-extra.el (ceiling*, floor*, round*, truncate*): Implement these in terms of the C functions; mark them as obsolete. (mod*, rem*): Use #'nth-value with the C functions, not #'nth with the CL emulation functions. man/ChangeLog addition: 2009-08-11 Aidan Kehoe <kehoea@parhasard.net> * lispref/numbers.texi (Bigfloat Basics): Correct this documentation (ignoring for the moment that it breaks off in mid-sentence). tests/ChangeLog addition: 2009-08-11 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el: Test the new Common Lisp-compatible rounding functions available in C. (generate-rounding-output): Provide a function useful for generating the data for the rounding functions tests. src/ChangeLog addition: 2009-08-11 Aidan Kehoe <kehoea@parhasard.net> * floatfns.c (ROUNDING_CONVERT, CONVERT_WITH_NUMBER_TYPES) (CONVERT_WITHOUT_NUMBER_TYPES, MAYBE_TWO_ARGS_BIGNUM) (MAYBE_ONE_ARG_BIGNUM, MAYBE_TWO_ARGS_RATIO) (MAYBE_ONE_ARG_RATIO, MAYBE_TWO_ARGS_BIGFLOAT) (MAYBE_ONE_ARG_BIGFLOAT, MAYBE_EFF, MAYBE_CHAR_OR_MARKER): New macros, used in the implementation of the rounding functions. (ceiling_two_fixnum, ceiling_two_bignum, ceiling_two_ratio) (ceiling_two_bigfloat, ceiling_one_ratio, ceiling_one_bigfloat) (ceiling_two_float, ceiling_one_float, ceiling_one_mundane_arg) (floor_two_fixnum, floor_two_bignum, floor_two_ratio) (floor_two_bigfloat, floor_one_ratio, floor_one_bigfloat) (floor_two_float, floor_one_mundane_arg, round_two_fixnum) (round_two_bignum_1, round_two_bignum, round_two_ratio) (round_one_bigfloat_1, round_two_bigfloat, round_one_ratio) (round_one_bigfloat, round_two_float, round_one_float) (round_one_mundane_arg, truncate_two_fixnum) (truncate_two_bignum, truncate_two_ratio, truncate_two_bigfloat) (truncate_one_ratio, truncate_one_bigfloat, truncate_two_float) (truncate_one_float, truncate_one_mundane_arg): New functions, used in the implementation of the rounding functions. (Fceiling, Ffloor, Fround, Ftruncate, Ffceiling, Fffloor) (Ffround, Fftruncate): Revise to fully support Common Lisp conventions. This means: -- All functions have optional DIVISOR arguments -- All functions return multiple values; see #'values -- All functions do their arithmetic with the correct number types according to the contamination rules. -- #'round and #'fround always round towards the even number in ambiguous cases. * doprnt.c (emacs_doprnt_1): * number.c (internal_coerce_number): Call Ftruncate with two arguments, not one. * floatfns.c (Ffloat): Correct this, if NUMBER is a bignum. * lisp.h: Declare Ftruncate as taking two arguments. * number.c: Provide scratch_ratio2, init it appropriately. * number.h: Make scratch_ratio2 available. * number.h (BIGFLOAT_ARITH_RETURN): * number.h (BIGFLOAT_ARITH_RETURN1): Correct these functions.
author Aidan Kehoe <kehoea@parhasard.net>
date Tue, 11 Aug 2009 17:59:23 +0100
parents ad2f4ae9895b
children 5502045ec510 d1247f3cc363
line wrap: on
line source

/* Generic object functions -- header implementation.
   Copyright (C) 1995 Board of Trustees, University of Illinois.
   Copyright (C) 1995, 1996, 2002 Ben Wing.

This file is part of XEmacs.

XEmacs is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
Free Software Foundation; either version 2, or (at your option) any
later version.

XEmacs is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
for more details.

You should have received a copy of the GNU General Public License
along with XEmacs; see the file COPYING.  If not, write to
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */

/* Synched up with: Not in FSF. */

#ifndef INCLUDED_objects_impl_h_
#define INCLUDED_objects_impl_h_

#include "specifier.h"
#include "objects.h"

/*****************************************************************************
 *                        Color Specifier Object                             *
 *****************************************************************************/

struct color_specifier
{
  Lisp_Object face;		/* face this is attached to, or nil */
  Lisp_Object face_property;	/* property of that face */
};

#define COLOR_SPECIFIER_DATA(g) SPECIFIER_TYPE_DATA (g, color)
#define COLOR_SPECIFIER_FACE(g) (COLOR_SPECIFIER_DATA (g)->face)
#define COLOR_SPECIFIER_FACE_PROPERTY(g) \
  (COLOR_SPECIFIER_DATA (g)->face_property)

DECLARE_SPECIFIER_TYPE (color);
#define XCOLOR_SPECIFIER(x) XSPECIFIER_TYPE (x, color)
#define COLOR_SPECIFIERP(x) SPECIFIER_TYPEP (x, color)
#define CHECK_COLOR_SPECIFIER(x) CHECK_SPECIFIER_TYPE (x, color)
#define CONCHECK_COLOR_SPECIFIER(x) CONCHECK_SPECIFIER_TYPE (x, color)

/*****************************************************************************
 *                         Font Specifier Object                             *
 *****************************************************************************/

struct font_specifier
{
  Lisp_Object face;		/* face this is attached to, or nil */
  Lisp_Object face_property;	/* property of that face */
};

#define FONT_SPECIFIER_DATA(g) SPECIFIER_TYPE_DATA (g, font)
#define FONT_SPECIFIER_FACE(g) (FONT_SPECIFIER_DATA (g)->face)
#define FONT_SPECIFIER_FACE_PROPERTY(g) \
  (FONT_SPECIFIER_DATA (g)->face_property)

DECLARE_SPECIFIER_TYPE (font);
#define XFONT_SPECIFIER(x) XSPECIFIER_TYPE (x, font)
#define FONT_SPECIFIERP(x) SPECIFIER_TYPEP (x, font)
#define CHECK_FONT_SPECIFIER(x) CHECK_SPECIFIER_TYPE (x, font)
#define CONCHECK_FONT_SPECIFIER(x) CONCHECK_SPECIFIER_TYPE (x, font)

/*****************************************************************************
 *                       Face Boolean Specifier Object                       *
 *****************************************************************************/

struct face_boolean_specifier
{
  Lisp_Object face;		/* face this is attached to, or nil */
  Lisp_Object face_property;	/* property of that face */
};

#define FACE_BOOLEAN_SPECIFIER_DATA(g) SPECIFIER_TYPE_DATA (g, face_boolean)
#define FACE_BOOLEAN_SPECIFIER_FACE(g) (FACE_BOOLEAN_SPECIFIER_DATA (g)->face)
#define FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY(g) \
  (FACE_BOOLEAN_SPECIFIER_DATA (g)->face_property)

DECLARE_SPECIFIER_TYPE (face_boolean);
extern Lisp_Object Qface_boolean;
#define XFACE_BOOLEAN_SPECIFIER(x) XSPECIFIER_TYPE (x, face_boolean)
#define FACE_BOOLEAN_SPECIFIERP(x) SPECIFIER_TYPEP (x, face_boolean)
#define CHECK_FACE_BOOLEAN_SPECIFIER(x) \
  CHECK_SPECIFIER_TYPE (x, face_boolean)
#define CONCHECK_FACE_BOOLEAN_SPECIFIER(x) \
  CONCHECK_SPECIFIER_TYPE (x, face_boolean)

/****************************************************************************
 *                           Color Instance Object                          *
 ****************************************************************************/

struct Lisp_Color_Instance
{
  struct LCRECORD_HEADER header;
  Lisp_Object name;
  Lisp_Object device;

  /* See comment in struct console about console variants. */
  enum console_variant color_instance_type;

  /* console-type-specific data */
  void *data;
};

#define COLOR_INSTANCE_NAME(c)   ((c)->name)
#define COLOR_INSTANCE_DEVICE(c) ((c)->device)

/****************************************************************************
 *                            Font Instance Object                          *
 ****************************************************************************/

struct Lisp_Font_Instance
{
  struct LCRECORD_HEADER header;
  Lisp_Object name; /* the instantiator used to create the font instance */
  Lisp_Object truename; /* used by the device-specific methods; we need to
			   call them to get the truename (#### in reality,
			   they all probably just store the truename here
			   if they know it, and nil otherwise; we should
			   check this and enforce it as a general policy
			   X and GTK do this, except that when they don't
			   know they return NAME and don't update TRUENAME.
			   MS Windows initializes TRUENAME when the font is
			   initialized.  TTY doesn't do truename.) */
  Lisp_Object device;
  Lisp_Object charset;  /* Mule charset, or whatever */

  /* See comment in struct console about console variants. */
  enum console_variant font_instance_type;

  unsigned short ascent;	/* extracted from `font', or made up */
  unsigned short descent;
  unsigned short width;
  unsigned short height;
  int proportional_p;

  /* console-type-specific data */
  void *data;
};

#define FONT_INSTANCE_NAME(f)	 ((f)->name)
#define FONT_INSTANCE_TRUENAME(f) ((f)->truename)
#define FONT_INSTANCE_CHARSET(f) ((f)->charset)
#define FONT_INSTANCE_DEVICE(f)	 ((f)->device)
#define FONT_INSTANCE_ASCENT(f)	 ((f)->ascent)
#define FONT_INSTANCE_DESCENT(f) ((f)->descent)
#define FONT_INSTANCE_WIDTH(f)	 ((f)->width)
#define FONT_INSTANCE_HEIGHT(f)	 ((f)->height)

#define XFONT_INSTANCE_NAME(f)	   FONT_INSTANCE_NAME (XFONT_INSTANCE (f))
#define XFONT_INSTANCE_TRUENAME(f) FONT_INSTANCE_TRUENAME (XFONT_INSTANCE (f))
#define XFONT_INSTANCE_CHARSET(f)  FONT_INSTANCE_CHARSET (XFONT_INSTANCE (f))
#define XFONT_INSTANCE_DEVICE(f)   FONT_INSTANCE_DEVICE (XFONT_INSTANCE (f))
#define XFONT_INSTANCE_ASCENT(f)   FONT_INSTANCE_ASCENT (XFONT_INSTANCE (f))
#define XFONT_INSTANCE_DESCENT(f)  FONT_INSTANCE_DESCENT (XFONT_INSTANCE (f))
#define XFONT_INSTANCE_WIDTH(f)	   FONT_INSTANCE_WIDTH (XFONT_INSTANCE (f))
#define XFONT_INSTANCE_HEIGHT(f)   FONT_INSTANCE_HEIGHT (XFONT_INSTANCE (f))

#endif /* INCLUDED_objects_impl_h_ */