cgit.sxemacs.org Git - sxemacs/blob - modules/ase/ase-resclass.h

   1 /*** ase-resclass.h -- Residue Class Rings for SXEmacs
   2  *
   3  * Copyright (C) 2006 - 2008 Sebastian Freundt
   4  *
   5  * Author:  Sebastian Freundt <hroptatyr@sxemacs.org>
   6  *
   7  * This file is part of SXEmacs.
   8  *
   9  * Redistribution and use in source and binary forms, with or without
  10  * modification, are permitted provided that the following conditions
  11  * are met:
  12  *
  13  * 1. Redistributions of source code must retain the above copyright
  14  *    notice, this list of conditions and the following disclaimer.
  15  *
  16  * 2. Redistributions in binary form must reproduce the above copyright
  17  *    notice, this list of conditions and the following disclaimer in the
  18  *    documentation and/or other materials provided with the distribution.
  19  *
  20  * 3. Neither the name of the author nor the names of any contributors
  21  *    may be used to endorse or promote products derived from this
  22  *    software without specific prior written permission.
  23  *
  24  * THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
  25  * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  26  * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  27  * DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  28  * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  29  * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  30  * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
  31  * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  32  * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
  33  * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
  34  * IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  35  *
  36  ***/
  37
  38 /* Synched up with: Not in FSF. */
  39
  40 #ifndef INCLUDED_ase_resclass_h_
  41 #define INCLUDED_ase_resclass_h_ 1
  42
  43 #ifdef UNO
  44 /* Uno complains about several inline functions that include conditions with
  45    assignments and side effects if we don't do this */
  46 #undef __GNUC__
  47 #endif
  48
  49 #include "ase.h"
  50 #ifdef HAVE_MPZ
  51 #include "gmp.h"
  52 #endif
  53
  54 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
  55 typedef bigz resc_rng;
  56 typedef bigz resc_elm;
  57 #else
  58 typedef EMACS_INT resc_rng;
  59 typedef EMACS_INT resc_elm;
  60 #endif
  61
  62 extern Lisp_Object Qase_resc_rng, Qase_resc_rng_p;
  63 extern Lisp_Object Qase_resc_elm, Qase_resc_elm_p;
  64
  65 extern void LTX_PUBINIT(ase_resclass)(void);
  66 extern void LTX_PUBREINIT(ase_resclass)(void);
  67 extern void LTX_PUBDEINIT(ase_resclass)(void);
  68
  69 typedef struct ase_resc_rng_s *ase_resc_rng_t;
  70 typedef struct ase_resc_elm_s *ase_resc_elm_t;
  71
  72 \f
  73 struct ase_resc_rng_s {
  74         int smallp;
  75         resc_rng ring;
  76         EMACS_INT small_ring;
  77 };
  78
  79 struct ase_resc_elm_s {
  80         int smallp;
  81         resc_elm data;
  82         EMACS_INT small_data;
  83         Lisp_Object ring;
  84 };
  85
  86 \f
  87 #define ASE_RESC_RNG_P(_i)                                      \
  88         (DYNACATP(_i) && EQ(XDYNACAT_TYPE(_i), Qase_resc_rng))
  89 #define CHECK_ASE_RESC_RNG(x)                                           \
  90         do {                                                            \
  91                 if (!ASE_RESC_RNG_P(x))                                 \
  92                         dead_wrong_type_argument(Qase_resc_rng_p, x);   \
  93         } while (0)
  94 #define CONCHECK_ASE_RESC_RNG(x)                                        \
  95         do {                                                            \
  96                 if (!ASE_RESC_RNG_P(x))                                 \
  97                         x = wrong_type_argument(Qase_resc_rng_p, x);    \
  98         } while (0)
  99 #define XSETASE_RESC_RNG(_res, _rng)    (_res) = _ase_wrap_resc_rng((_rng))
 100 #define XASE_RESC_RNG(_x)               ((ase_resc_rng_t)get_dynacat(_x))
 101
 102 #define ASE_RESC_ELM_P(_i)                                      \
 103         (DYNACATP(_i) && EQ(XDYNACAT_TYPE(_i), Qase_resc_elm))
 104 #define CHECK_ASE_RESC_ELM(x)                                           \
 105         do {                                                            \
 106                 if (!ASE_RESC_ELM_P(x))                                 \
 107                         dead_wrong_type_argument(Qase_resc_elm_p, x);   \
 108         } while (0)
 109 #define CONCHECK_ASE_RESC_ELM(x)                                        \
 110         do {                                                            \
 111                 if (!ASE_RESC_ELM_P(x))                                 \
 112                         x = wrong_type_argument(Qase_resc_elm_p, x);    \
 113         } while (0)
 114 extern Lisp_Object _ase_wrap_resc_elm(ase_resc_elm_t);
 115 #define XSETASE_RESC_ELM(_res, _elm)    (_res) = _ase_wrap_resc_elm((_elm))
 116 #define XASE_RESC_ELM(_x)               ((ase_resc_elm_t)get_dynacat(_x))
 117
 118 #define ase_resc_rng_smallp(_r)         ((_r)->smallp)
 119 #define ase_resc_rng_ring(_r)           ((_r)->ring)
 120 #define ase_resc_rng_sring(_r)          ((_r)->small_ring)
 121 #define XASE_RESC_RNG_RING(_r)          ase_resc_rng_ring(XASE_RESC_RNG(_r))
 122 #define XASE_RESC_RNG_SRING(_r)         ase_resc_rng_sring(XASE_RESC_RNG(_r))
 123 #define XASE_RESC_RNG_SMALLP(_r)        ase_resc_rng_smallp(XASE_RESC_RNG(_r))
 124
 125 #define ase_resc_elm_smallp(_e)         ((_e)->smallp)
 126 #define ase_resc_elm_sdata(_e)          ((_e)->small_data)
 127 #define ase_resc_elm_data(_e)           ((_e)->data)
 128 #define ase_resc_elm_ring(_e)           ((_e)->ring)
 129 #define XASE_RESC_ELM_DATA(_e)          ase_resc_elm_data(XASE_RESC_ELM(_e))
 130 #define XASE_RESC_ELM_SDATA(_e)         ase_resc_elm_sdata(XASE_RESC_ELM(_e))
 131 #define XASE_RESC_ELM_RING(_e)          ase_resc_elm_ring(XASE_RESC_ELM(_e))
 132 #define XASE_RESC_ELM_SMALLP(_e)        ase_resc_elm_smallp(XASE_RESC_ELM(_e))
 133
 134
 135 /***** basic functions *****/
 136 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
 137 #define resc_rng_init(r)                bigz_init(r)
 138 #define resc_rng_fini(r)                bigz_fini(r)
 139 #define resc_elm_init(e)                bigz_init(e)
 140 #define resc_elm_fini(e)                bigz_fini(e)
 141 #define resc_rng_set_string(_to, _cp)   bigz_set_string(_to, _cp, 0)
 142 #define resc_elm_set_string(_to, _cp)   bigz_set_string(_to, _cp, 0)
 143 #define resc_rng_set_eint(_r, _m)       bigz_set_long(_r, _m)
 144 #define resc_rng_set_bigz(_r, _m)       bigz_set(_r, _m)
 145 #define resc_elm_set_eint(_r, _m)       bigz_set_long(_r, _m)
 146 #define resc_elm_set_bigz(_r, _m)       bigz_set(_r, _m)
 147 #else
 148 #define resc_rng_init(r)
 149 #define resc_rng_fini(r)
 150 #define resc_elm_init(e)
 151 #define resc_elm_fini(e)
 152 #define resc_rng_set_string(_to, _cp)   _to = strtol(_cp, NULL, 10)
 153 #define resc_elm_set_string(_to, _cp)   _to = strtol(_cp, NULL, 10)
 154 #define resc_rng_set_eint(_r, _m)       _r = _m
 155 #define resc_rng_set_bigz(_r, _m)
 156 #define resc_elm_set_eint(_r, _m)       _r = _m
 157 #define resc_elm_set_bigz(_r, _m)
 158 #endif
 159
 160 /***** conversions *****/
 161 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
 162 #define resc_rng_to_string(_p, _n, _r)  mpz_get_str(_p, 10, _r)
 163 #define resc_elm_to_string(_p, _n, _e)  mpz_get_str(_p, 10, _e)
 164 #else
 165 #define resc_rng_to_string(_p, _n, _r)  do { int sz = snprintf(_p, _n, "%ld", _r); assert(sz>=0 && sz<_n); } while(0)
 166 #define resc_elm_to_string(_p, _n, _e)  do { int sz = snprintf(_p, _n, "%ld", _e); assert(sz>=0 && sz<_n); } while(0)
 167 #endif
 168
 169
 170 extern Lisp_Object read_resclass_string(char*);
 171 extern Lisp_Object read_resclassring_string(char*);
 172 extern Lisp_Object internal_coerce_to_RESC_ELM_T(Lisp_Object, Lisp_Object);
 173
 174 extern Lisp_Object ase_make_resc_rng(Lisp_Object);
 175 extern void _ase_resc_rng_prnt(ase_resc_rng_t, Lisp_Object);
 176 extern void _ase_resc_elm_prnt(ase_resc_elm_t, Lisp_Object);
 177
 178 extern ase_resc_rng_t _ase_make_resc_rng(Lisp_Object);
 179 extern Lisp_Object ase_make_resc_rng(Lisp_Object);
 180 extern ase_resc_elm_t _ase_make_resc_elm(Lisp_Object, Lisp_Object);
 181 extern Lisp_Object ase_make_resc_elm(Lisp_Object, Lisp_Object);
 182
 183
 184 #endif /* INCLUDED_ase_resclass_h_ */