Back to index

plt-scheme  4.2.1
fmod.c
Go to the documentation of this file.
00001 /*
00002   Extension that defines fmod, modulo on floating-point numbers.
00003   The extension is equivalent to Scheme source of them form:
00004     (define (fmod a b) ...)
00005 */
00006 
00007 #include "escheme.h"
00008 #include <math.h>
00009 
00010 /**************************************************/
00011 
00012 /* Every C implementation of a Scheme function takes argc and an array
00013    of Scheme_Object* values for argv, and returns a Scheme_Object*: */
00014 static Scheme_Object *sch_fmod(int argc, Scheme_Object **argv)
00015 {
00016   /* Because we'll use scheme_make_prim_w_arity, MzScheme will
00017      have already checked that we're getting the right number of
00018      arguments. */
00019   Scheme_Object *a = argv[0], *b = argv[1];
00020   double v;
00021 
00022   /* Make sure we got real numbers, and complain if not: */
00023   if (!SCHEME_REALP(a))
00024     scheme_wrong_type("fmod", "real number", 0, argc, argv);
00025   /*                       1st arg wrong ----^ */
00026   if (!SCHEME_REALP(b))
00027     scheme_wrong_type("fmod", "real number", 1, argc, argv);
00028   /*                       2nd arg wrong ----^ */
00029 
00030   /* Convert the Scheme numbers to double-precision floating point
00031      numbers, and compute fmod: */
00032   v = fmod(scheme_real_to_double(a),
00033           scheme_real_to_double(b));
00034 
00035   /* Return the result, packaging it as a Scheme value: */
00036   return scheme_make_double(v);
00037 }
00038 
00039 /**************************************************/
00040 
00041 Scheme_Object *scheme_reload(Scheme_Env *env)
00042 {
00043   Scheme_Object *proc;
00044 
00045   /* The MZ_GC... lines are for for 3m, because env is live across an
00046      allocating call. They're not needed for plain old (conservatively
00047      collected) Mzscheme. See makeadder3m.c for more info. */
00048   MZ_GC_DECL_REG(1);
00049   MZ_GC_VAR_IN_REG(0, env);
00050   MZ_GC_REG();
00051 
00052   /* Package the C implementation of fmod into a Scheme procedure
00053      value: */
00054   proc = scheme_make_prim_w_arity(sch_fmod, "fmod", 2, 2);
00055   /*               Requires at least two args ------^  ^ */
00056   /*                  Accepts no more than two args ---| */
00057 
00058   /* Define `fmod' as a global :*/
00059   scheme_add_global("fmod", proc, env);
00060 
00061   MZ_GC_UNREG();
00062 
00063   return scheme_void;
00064 }
00065 
00066 Scheme_Object *scheme_initialize(Scheme_Env *env)
00067 {
00068   /* First load is same as every load: */
00069   return scheme_reload(env);
00070 }
00071 
00072 Scheme_Object *scheme_module_name()
00073 {
00074   /* This extension doesn't define a module: */
00075   return scheme_false;
00076 }