src/vm_number.c

   1 /* Copyright (C) 2000 Free Software Foundation, Inc.
   2  *
   3  * This program is free software; you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation; either version 2, or (at your option)
   6  * any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this software; see the file COPYING.  If not, write to
  15  * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  16  * Boston, MA 02111-1307 USA
  17  *
  18  * As a special exception, the Free Software Foundation gives permission
  19  * for additional uses of the text contained in its release of GUILE.
  20  *
  21  * The exception is that, if you link the GUILE library with other files
  22  * to produce an executable, this does not by itself cause the
  23  * resulting executable to be covered by the GNU General Public License.
  24  * Your use of that executable is in no way restricted on account of
  25  * linking the GUILE library code into it.
  26  *
  27  * This exception does not however invalidate any other reasons why
  28  * the executable file might be covered by the GNU General Public License.
  29  *
  30  * This exception applies only to the code released by the
  31  * Free Software Foundation under the name GUILE.  If you copy
  32  * code from other Free Software Foundation releases into a copy of
  33  * GUILE, as the General Public License permits, the exception does
  34  * not apply to the code that you add in this way.  To avoid misleading
  35  * anyone as to the status of such modified files, you must delete
  36  * this exception notice from them.
  37  *
  38  * If you write modifications of your own for GUILE, it is your choice
  39  * whether to permit this exception to apply to your modifications.
  40  * If you do not wish that, delete this exception notice.  */
  41
  42 /* This file is included in vm_engine.c */
  43
  44 \f
  45 /*
  46  * Predicates
  47  */
  48
  49 #undef PRED
  50 #define PRED(ctest,stest)                       \
  51 {                                               \
  52   ARGS1 (a1);                                   \
  53   if (SCM_INUMP (a1))                           \
  54     RETURN (SCM_BOOL (ctest));                  \
  55   RETURN (stest (a1));                          \
  56 }
  57
  58 VM_DEFINE_FUNCTION (zero, "zero?", 1)
  59 {
  60   PRED (SCM_INUM (a1) == 0, scm_zero_p);
  61 }
  62
  63 \f
  64 /*
  65  * Relational tests
  66  */
  67
  68 #undef REL
  69 #define REL(crel,srel)                                          \
  70 {                                                               \
  71   ARGS2 (a1, a2);                                               \
  72   if (SCM_INUMP (a1) && SCM_INUMP (a2))                         \
  73     RETURN (SCM_BOOL (SCM_INUM (a1) crel SCM_INUM (a2)));       \
  74   RETURN (srel (a1, a2));                                       \
  75 }
  76
  77 VM_DEFINE_FUNCTION (ee, "ee?", 2)
  78 {
  79   REL (==, scm_num_eq_p);
  80 }
  81
  82 VM_DEFINE_FUNCTION (lt, "lt?", 2)
  83 {
  84   REL (<, scm_less_p);
  85 }
  86
  87 VM_DEFINE_FUNCTION (le, "le?", 2)
  88 {
  89   REL (<=, scm_leq_p);
  90 }
  91
  92 VM_DEFINE_FUNCTION (gt, "gt?", 2)
  93 {
  94   REL (>, scm_gr_p);
  95 }
  96
  97 VM_DEFINE_FUNCTION (ge, "ge?", 2)
  98 {
  99   REL (>=, scm_geq_p);
 100 }
 101
 102 \f
 103 /*
 104  * Functions
 105  */
 106
 107 #undef FUNC1
 108 #define FUNC1(CEXP,SEXP)                        \
 109 {                                               \
 110   ARGS1 (a1);                                   \
 111   if (SCM_INUMP (a1))                           \
 112     {                                           \
 113       int n = CEXP;                             \
 114       if (SCM_FIXABLE (n))                      \
 115         RETURN (SCM_MAKINUM (n));               \
 116     }                                           \
 117   RETURN (SEXP);                                \
 118 }
 119
 120 #undef FUNC2
 121 #define FUNC2(CFUNC,SFUNC)                              \
 122 {                                                       \
 123   ARGS2 (a1, a2);                                       \
 124   if (SCM_INUMP (a1) && SCM_INUMP (a2))                 \
 125     {                                                   \
 126       int n = SCM_INUM (a1) CFUNC SCM_INUM (a2);        \
 127       if (SCM_FIXABLE (n))                              \
 128         RETURN (SCM_MAKINUM (n));                       \
 129     }                                                   \
 130   RETURN (SFUNC (a1, a2));                              \
 131 }
 132
 133 VM_DEFINE_FUNCTION (neg, "neg", 1)
 134 {
 135   FUNC1 (- SCM_INUM (a1), scm_difference (a1, SCM_UNDEFINED));
 136 }
 137
 138 VM_DEFINE_FUNCTION (inc, "inc", 1)
 139 {
 140   FUNC1 (SCM_INUM (a1) + 1, scm_sum (a1, SCM_MAKINUM (1)));
 141 }
 142
 143 VM_DEFINE_FUNCTION (dec, "dec", 1)
 144 {
 145   FUNC1 (SCM_INUM (a1) - 1, scm_difference (a1, SCM_MAKINUM (1)));
 146 }
 147
 148 VM_DEFINE_FUNCTION (add, "add", 2)
 149 {
 150   FUNC2 (+, scm_sum);
 151 }
 152
 153 VM_DEFINE_FUNCTION (sub, "sub", 2)
 154 {
 155   FUNC2 (-, scm_difference);
 156 }
 157
 158 VM_DEFINE_FUNCTION (remainder, "remainder", 2)
 159 {
 160   ARGS2 (a1, a2);
 161   RETURN (scm_remainder (a1, a2));
 162 }
 163
 164 /*
 165   Local Variables:
 166   c-file-style: "gnu"
 167   End:
 168 */