Back to index

plt-scheme  4.2.1
mzlonglong.c
Go to the documentation of this file.
00001 
00002 #include "escheme.h"
00003 
00004 static Scheme_Object *llsize(int argc, Scheme_Object **argv)
00005 {
00006   return scheme_make_integer(sizeof(mzlonglong));
00007 }
00008 
00009 static Scheme_Object *toll(int argc, Scheme_Object **argv)
00010 {
00011   mzlonglong l;
00012 
00013   if (scheme_get_long_long_val(argv[0], &l))
00014     return scheme_make_sized_byte_string((char *)&l, sizeof(mzlonglong), 1);
00015   else
00016     return scheme_false;
00017 }
00018 
00019 static Scheme_Object *toull(int argc, Scheme_Object **argv)
00020 {
00021   umzlonglong l;
00022 
00023   if (scheme_get_unsigned_long_long_val(argv[0], &l))
00024     return scheme_make_sized_byte_string((char *)&l, sizeof(umzlonglong), 1);
00025   else
00026     return scheme_false;
00027 }
00028 
00029 static Scheme_Object *fromll(int argc, Scheme_Object **argv)
00030 {
00031   mzlonglong l;
00032 
00033   if (!SCHEME_BYTE_STRINGP(argv[0])
00034       || (SCHEME_BYTE_STRTAG_VAL(argv[0]) != sizeof(mzlonglong)))
00035     scheme_wrong_type("long-long-bytes->integer", 
00036                     "byte string of mzlonglong size",
00037                     0, argc, argv);
00038 
00039 
00040   l = *(mzlonglong *)SCHEME_BYTE_STR_VAL(argv[0]);
00041 
00042   return scheme_make_integer_value_from_long_long(l);
00043 }
00044 
00045 static Scheme_Object *fromull(int argc, Scheme_Object **argv)
00046 {
00047   umzlonglong l;
00048 
00049   if (!SCHEME_BYTE_STRINGP(argv[0])
00050       || (SCHEME_BYTE_STRTAG_VAL(argv[0]) != sizeof(umzlonglong)))
00051     scheme_wrong_type("unsigned-long-long-bytes->integer", 
00052                     "byte string of mzlonglong size",
00053                     0, argc, argv);
00054 
00055 
00056   l = *(umzlonglong *)SCHEME_BYTE_STR_VAL(argv[0]);
00057 
00058   return scheme_make_integer_value_from_unsigned_long_long(l);
00059 }
00060 
00061 
00062 
00063 Scheme_Object *scheme_reload(Scheme_Env *env)
00064 {
00065   scheme_add_global("long-long-size", 
00066                   scheme_make_prim_w_arity(llsize, "long-long-size", 0, 0),
00067                   env);
00068 
00069   scheme_add_global("integer->long-long-bytes", 
00070                   scheme_make_prim_w_arity(toll, "integer->long-long-bytes", 1, 1),
00071                   env);
00072   scheme_add_global("integer->unsigned-long-long-bytes", 
00073                   scheme_make_prim_w_arity(toull, "integer->unsigned-long-long-bytes", 1, 1),
00074                   env);
00075 
00076   scheme_add_global("long-long-bytes->integer", 
00077                   scheme_make_prim_w_arity(fromll, "long-long-bytes->integer", 1, 1),
00078                   env);
00079   scheme_add_global("unsigned-long-long-bytes->integer", 
00080                   scheme_make_prim_w_arity(fromull, "unsigned-long-long-bytes->integer", 1, 1),
00081                   env);
00082 
00083   return scheme_void;
00084 }
00085 
00086 Scheme_Object *scheme_initialize(Scheme_Env *env)
00087 {
00088   /* First load is same as every load: */
00089   return scheme_reload(env);
00090 }
00091 
00092 Scheme_Object *scheme_module_name()
00093 {
00094   /* This extension doesn't define a module: */
00095   return scheme_false;
00096 }