home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / !runtime / largeint.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-18  |  6.4 KB  |  253 lines  |  [TEXT/R*ch]
  1. /* largeint.c -- preliminary */
  2.  
  3. #include <gmp.h>
  4. #include "mlvalues.h"
  5. #include "fail.h"
  6. #include "alloc.h"
  7.  
  8. /* Arbitrary-precision integers: interface to the GNU
  9.    Multiple-Precision Library GMP.
  10.  
  11.    The type LargeInt.int of arbitrary-precision integers is an
  12.    abstract type; really an MP_INT structure.  This will contain a
  13.    pointer to a limb array.  The limb array cannot be in camlrunm's
  14.    heap space because the gc cannot understand the MP_INT structure
  15.    (it would be confused by the untagged integer fields).
  16.  
  17.    This raises the question how to deallocate the limb structure when
  18.    it is no longer reachable.  One possibility is to use finalized
  19.    objects, calling the mpz_clear function explicitly whenever an
  20.    MP_INT value is about to be garbage-collected by the camlrunm
  21.    runtime.
  22.  
  23.    An largeint should be a finalized object: a pair, 
  24.  
  25.               header with Final_tag
  26.           0: finalization function largeint_clear
  27.           1: pointer to MP_INT struct
  28.  
  29.    whose component 0 is a pointer to the finalizing function
  30.    largeint_clear, and whose component 1 is a pointer to an MP_INT
  31.    struct.  The finalization function should apply mpz_clear to the
  32.    second component of the pair:
  33. */
  34.  
  35. #define Large_val(x) (MP_INT*)(Field(x, 1))
  36.  
  37. void largeint_finalize(obj)
  38.      value obj;
  39. { MP_INT *mpint;
  40.  
  41.   mpint = Large_val(obj);
  42.   mpz_clear(mpint);
  43.   free(mpint);
  44. }
  45.  
  46. /* When the largeint becomes unreachable from the ML process, it will
  47.    be garbage-collected, largeint_finalize() will be called on the
  48.    pointer to the MP_INT struct to deallocate the limbs, and finally
  49.    free() will be called to deallocate the mpint struct itself.  The
  50.    camlrunm gc then frees the pair representing the largeint.
  51.  
  52.    Creation of a largeint should call malloc() to allocate an MP_INT
  53.    struct pointed to by mpint, make a finalized pair (largeint_finalize,
  54.    mpint) as described above, and call mpz_init (or similar) on mpint:
  55. */
  56.  
  57. value largeint_alloc()
  58. { MP_INT *mpint;
  59.   value res;
  60.  
  61.   mpint = (MP_INT*)(malloc(sizeof(MP_INT)));
  62.   res = alloc_final(2, &largeint_finalize, 1, 1000);
  63.   Field(res, 1) = (long)mpint;
  64.   
  65.   return res;
  66. }
  67.  
  68. void largeint_clear(obj)            /* ML */
  69.      value obj;
  70. { MP_INT *mpint;
  71.  
  72.   largeint_finalize(obj);
  73.   /* This should not be deallocated by the gc also, hence make it
  74.    * abstract: */
  75.   Tag_val(obj) = Abstract_tag;
  76. }
  77.  
  78. value largeint_make(null)            /* ML */
  79.      value null;
  80. { value li;
  81.   
  82.   li = largeint_alloc();
  83.   mpz_init(Large_val(li));
  84.   return li;
  85. }
  86.  
  87. value largeint_make_si(src)            /* ML */
  88.      value src;
  89. { value li;
  90.   
  91.   li = largeint_alloc();
  92.   mpz_init_set_si(Large_val(li), Long_val(src));
  93.   return li;
  94. }
  95.  
  96. value largeint_set(dest, src)        /* ML */
  97.      value dest, src;
  98. { mpz_set(Large_val(dest), Large_val(src)); 
  99.   return Val_unit;
  100. }
  101.  
  102. value largeint_set_si(dest, src)        /* ML */
  103.      value dest, src;
  104. { mpz_set_si(Large_val(dest), Long_val(src)); 
  105.   return Val_unit;
  106. }
  107.  
  108. value largeint_to_si(src)            /* ML */
  109.      value src;
  110. { signed long int tmp;
  111.   value res;
  112.  
  113.   tmp = mpz_get_si(Large_val(src)); 
  114.   res = Val_long(tmp);
  115.   if (Long_val(res) != tmp)
  116.     { mlraise(Atom(SMLEXN_OVF)); }
  117.   return res;
  118. }
  119.  
  120. value largeint_neg(dest, src)        /* ML */
  121.      value dest, src;
  122. { mpz_neg(Large_val(dest), Large_val(src)); 
  123.   return Val_unit;
  124. }
  125.  
  126. value largeint_add(dest, li1, li2)        /* ML */
  127.      value dest, li1, li2;
  128. { mpz_add(Large_val(dest), Large_val(li1), Large_val(li2)); 
  129.   return Val_unit;
  130. }
  131.  
  132. value largeint_sub(dest, li1, li2)        /* ML */
  133.      value dest, li1, li2;
  134. { mpz_sub(Large_val(dest), Large_val(li1), Large_val(li2)); 
  135.   return Val_unit;
  136. }
  137.  
  138. value largeint_mul(dest, li1, li2)        /* ML */
  139.      value dest, li1, li2;
  140. { mpz_mul(Large_val(dest), Large_val(li1), Large_val(li2)); 
  141.   return Val_unit;
  142. }
  143.  
  144. value largeint_mdiv(dest, li1, li2)        /* ML */
  145.      value dest, li1, li2;
  146. { mpz_mdiv(Large_val(dest), Large_val(li1), Large_val(li2)); 
  147.   return Val_unit;
  148. }
  149.  
  150. value largeint_mmod(dest, li1, li2)        /* ML */
  151.      value dest, li1, li2;
  152. { mpz_mmod(Large_val(dest), Large_val(li1), Large_val(li2)); 
  153.   return Val_unit;
  154. }
  155.  
  156. value largeint_div(dest, li1, li2)        /* ML */
  157.      value dest, li1, li2;
  158. { mpz_div(Large_val(dest), Large_val(li1), Large_val(li2)); 
  159.   return Val_unit;
  160. }
  161.  
  162. value largeint_mod(dest, li1, li2)        /* ML */
  163.      value dest, li1, li2;
  164. { mpz_mod(Large_val(dest), Large_val(li1), Large_val(li2)); 
  165.   return Val_unit;
  166. }
  167.  
  168. value largeint_divmod(quotdest, remdest, li1, li2)        /* ML */
  169.      value quotdest, remdest, li1, li2;
  170. { mpz_divmod(Large_val(quotdest), Large_val(remdest), 
  171.          Large_val(li1), Large_val(li2)); 
  172.   return Val_unit;
  173. }
  174.  
  175. value largeint_mdivmod(quotdest, remdest, li1, li2)        /* ML */
  176.      value quotdest, remdest, li1, li2;
  177. { mpz_mdivmod(Large_val(quotdest), Large_val(remdest), 
  178.           Large_val(li1), Large_val(li2)); 
  179.   return Val_unit;
  180. }
  181.  
  182. value largeint_cmp(li1, li2)            /* ML */
  183.      value li1, li2;
  184. { long res = mpz_cmp(Large_val(li1), Large_val(li2));
  185.   if (res < 0) 
  186.     return Val_long(-1); 
  187.   else if (res > 0) 
  188.     return Val_long(1); 
  189.   else 
  190.     return Val_long(0);
  191. }
  192.  
  193. value largeint_cmp_si(li, si)        /* ML */
  194.      value li, si;
  195. { long res = mpz_cmp_si(Large_val(li), Long_val(si));
  196.   if (res < 0)      
  197.     return Val_long(-1);
  198.   else if (res > 0) 
  199.     return Val_long(1); 
  200.   else 
  201.     return Val_long(0);
  202. }
  203.  
  204. value largeint_sizeinbase(li, base)        /* ML */
  205.      value li, base;
  206. { return (Val_long(mpz_sizeinbase(Large_val(li), Long_val(base)))); }
  207.  
  208. /* The mpz_set_str function below is pretty absurd:
  209.  * "- 123"    -> ~123
  210.  * " -123"   fails
  211.  * "- 12 3"  -> ~123
  212.  * "+123"    fails
  213.  */
  214.  
  215. value largeint_set_str(dest, str, base)    /* ML */
  216.      value dest, str, base;
  217. { long res, changesign;
  218.   changesign = (Byte(str, 0) == '~');
  219.   if (changesign) { Byte(str, 0) = '-'; }
  220.   res = mpz_set_str(Large_val(dest), String_val(str), Long_val(base));
  221.   if (changesign) { Byte(str, 0) = '~'; }
  222.   if (0 == res)
  223.     { return Val_unit; }
  224.   else
  225.     { failwith("Illformed number string"); }
  226. }
  227.  
  228. value largeint_get_str(src, base)        /* ML */
  229.      value src, base;
  230. { value res;
  231.   long len;
  232.   char *buffer;
  233.  
  234.   len = 3 + mpz_sizeinbase(Large_val(src), Long_val(base));
  235.   buffer = (char*)(malloc(len));
  236.   mpz_get_str(buffer, Long_val(base), Large_val(src));  
  237.   res = copy_string(buffer);
  238.   free(buffer);
  239.  
  240.   /* Use the SML sign character: */
  241.   if (Byte(res, 0) == '-')
  242.     { Byte(res, 0) = '~'; }
  243.   
  244.   return res;
  245. }
  246.  
  247. value largeint_pow_ui(dest, li, ui)        /* ML */
  248.      value dest, li, ui;
  249. { mpz_pow_ui(Large_val(dest), Large_val(li), Long_val(ui)); 
  250.      return Val_unit;
  251. }
  252.  
  253.