home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / devel / lisp / kcl_tar.z / kcl_tar / c / num_rand.c < prev    next >
Encoding:
C/C++ Source or Header  |  1987-06-04  |  2.5 KB  |  144 lines
  1. /*
  2. (c) Copyright Taiichi Yuasa and Masami Hagiya, 1984.  All rights reserved.
  3. Copying of this file is authorized to users who have executed the true and
  4. proper "License Agreement for Kyoto Common LISP" with SIGLISP.
  5. */
  6.  
  7. /*
  8.     Random numbers
  9. */
  10.  
  11. #include "include.h"
  12. #include "num_include.h"
  13.  
  14. #ifdef AOSVS
  15.  
  16. #endif
  17.  
  18. object
  19. rando(x, rs)
  20. object x, rs;
  21. {
  22.     enum type tx;
  23.     object z;
  24.     double d;
  25.     
  26.     tx = type_of(x);
  27.     if (number_compare(x, small_fixnum(0)) != 1)
  28.         FEwrong_type_argument(TSnon_negative_integer, x);
  29.     d = (double)(rs->rnd.rnd_value>>1) / (4294967296.0/2.0);
  30.     d = number_to_double(x) * d;
  31.     if (tx == t_fixnum) {
  32.         z = make_fixnum((int)d);
  33.         return(z);
  34.     } else if (tx == t_bignum) {
  35.         z = double_to_integer(d);
  36.         return(z);
  37.     } else if (tx == t_shortfloat) {
  38.         z = alloc_object(t_shortfloat);
  39.         sf(z) = (float)d;
  40.         return(z);
  41.     } else if (tx == t_longfloat) {
  42.         z = alloc_object(t_longfloat);
  43.         lf(z) = d;
  44.         return(z);
  45.     } else
  46.         FEerror("~S is not an integer nor a floating-point number.",
  47.             1, x);
  48. }
  49.  
  50. object
  51. make_random_state(rs)
  52. object rs;
  53. {
  54.         object z;
  55. #ifdef AOSVS
  56.  
  57. #endif
  58.  
  59.     if (rs == Cnil) {
  60.         z = alloc_object(t_random);
  61.         z->rnd.rnd_value = symbol_value(Vrandom_state)->rnd.rnd_value;
  62.         return(z);
  63.     } else if (rs == Ct) {
  64.         z = alloc_object(t_random);
  65. #ifdef UNIX
  66.         z->rnd.rnd_value = time(0);
  67. #endif
  68. #ifdef AOSVS
  69.  
  70.  
  71.  
  72.  
  73. #endif
  74.         return(z);
  75.     } else if (type_of(rs) != t_random)
  76.            FEwrong_type_argument(Srandom_state, rs);
  77.     else {
  78.         z =alloc_object(t_random);
  79.         z->rnd.rnd_value = rs->rnd.rnd_value;
  80.         return(z);
  81.     }
  82. }
  83.  
  84. advance_random_state(rs)
  85. object rs;
  86. {
  87.     rs->rnd.rnd_value
  88.     = rs->rnd.rnd_value
  89.     + (rs->rnd.rnd_value<<2)
  90.     + (rs->rnd.rnd_value<<17)
  91.     + (rs->rnd.rnd_value<<27);
  92. }
  93.  
  94.  
  95. Lrandom()
  96. {
  97.     int j;
  98.         object x;
  99.     object rs;
  100.     
  101.     j = vs_top - vs_base;
  102.     if (j == 1)
  103.         vs_push(symbol_value(Vrandom_state));
  104.     check_arg(2);
  105.     check_type_random_state(&vs_base[1]);
  106.     advance_random_state(vs_base[1]);
  107.     x = rando(vs_base[0], vs_base[1]);
  108.     vs_top = vs_base;
  109.     vs_push(x);
  110. }
  111.  
  112. Lmake_random_state()
  113. {
  114.     int j;
  115.     object x;
  116.  
  117.     j = vs_top - vs_base;
  118.     if (j == 0)
  119.         vs_push(Cnil);
  120.     check_arg(1);
  121.     x = make_random_state(vs_head);
  122.     vs_top = vs_base;
  123.     vs_push(x);
  124. }
  125.  
  126. Lrandom_state_p()
  127. {
  128.     check_arg(1);
  129.     if (type_of(vs_pop) == t_random)
  130.         vs_push(Ct);
  131.     else
  132.         vs_push(Cnil);
  133. }
  134.  
  135. init_num_rand()
  136. {
  137.         Vrandom_state = make_special("*RANDOM-STATE*",
  138.                      make_random_state(Ct));
  139.  
  140.     make_function("RANDOM", Lrandom);
  141.     make_function("MAKE-RANDOM-STATE", Lmake_random_state);
  142.     make_function("RANDOM-STATE-P", Lrandom_state_p);
  143. }
  144.