/[gcl]/gcl/o/num_rand.c
ViewVC logotype

Diff of /gcl/o/num_rand.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.6 by camm, Sat Nov 27 22:19:35 2004 UTC revision 1.7 by camm, Fri Jun 10 15:36:06 2005 UTC
# Line 33  Foundation, 675 Mass Ave, Cambridge, MA Line 33  Foundation, 675 Mass Ave, Cambridge, MA
33  #endif  #endif
34    
35  static object  static object
36  rando(object x, object rs)  rando(object x, object rs) {
 {  
         enum type tx;  
         object z;  
         double d;  
           
         tx = type_of(x);  
         if (number_compare(x, small_fixnum(0)) != 1)  
                 FEwrong_type_argument(TSpositive_number, x);  
         /*FIXME 64*/  
         d = (double)(rs->rnd.rnd_value>>1) / (4294967296.0/2.0);  
         d = number_to_double(x) * d;  
         if (tx == t_fixnum) {  
                 z = make_fixnum((fixnum)d);  
                 return(z);  
         } else if (tx == t_bignum) {  
                 z = double_to_integer(d);  
                 return(z);  
         } else if (tx == t_shortfloat) {  
                 z = alloc_object(t_shortfloat);  
                 sf(z) = (float)d;  
                 return(z);  
         } else if (tx == t_longfloat) {  
                 z = alloc_object(t_longfloat);  
                 lf(z) = d;  
                 return(z);  
         } else {  
                 FEerror("~S is not an integer nor a floating-point number.",  
                         1, x);  
                 return(Cnil);  
         }  
 }  
37    
38  static object    enum type tx;
39  make_random_state(object rs)    object base,out,z;
40  {    fixnum fbase;
41          object z;    double d;
42  #ifdef AOSVS    
43      tx = type_of(x);
44      if (number_compare(x, small_fixnum(0)) != 1)
45        FEwrong_type_argument(TSpositive_number, x);
46      
47      if (tx==t_bignum) {
48        out=new_bignum();
49        base=x;
50        fbase=-1;
51      } else {
52        out=big_fixnum1;
53        fbase=tx==t_fixnum ? fix(x) : MOST_POSITIVE_FIX;
54        mpz_set_si(MP(big_fixnum2),fbase);
55        base=big_fixnum2;
56      }
57      
58      mpz_urandomm(MP(out),&rs->rnd.rnd_state,MP(base));
59      
60      switch (tx) {
61        
62      case t_fixnum:
63        return make_fixnum(mpz_get_si(MP(out)));
64      case t_bignum:
65        return normalize_big(out);
66      case t_shortfloat: case t_longfloat:
67        d=mpz_get_d(MP(out));
68        d/=(double)fbase;
69        z=alloc_object(tx);
70        if (tx==t_shortfloat) sf(z)=sf(x)*d; else lf(z)=lf(x)*d;
71        return z;
72      default:
73        FEerror("~S is not an integer nor a floating-point number.", 1, x);
74        return(Cnil);
75      }
76    }
77    
 #endif  
78    
         if (rs == Cnil) {  
                 z = alloc_object(t_random);  
                 z->rnd.rnd_value = symbol_value(Vrandom_state)->rnd.rnd_value;  
                 return(z);  
         } else if (rs == Ct) {  
                 z = alloc_object(t_random);  
79  #ifdef UNIX  #ifdef UNIX
80                  z->rnd.rnd_value = time(0);  #define RS_DEF_INIT time(0)
81    #else
82    #define RS_DEF_INIT 0
83  #endif  #endif
 #ifdef AOSVS  
   
84    
85    
86    static object
87    make_random_state(object rs) {
88    
89  #endif    object z;
90                  return(z);    
91          } else if (type_of(rs) != t_random) {    if (rs==Cnil)
92                  FEwrong_type_argument(sLrandom_state, rs);      rs=symbol_value(Vrandom_state);
93                  return(Cnil);    
94          } else {    if (rs!=Ct && type_of(rs) != t_random) {
95                  z =alloc_object(t_random);      FEwrong_type_argument(sLrandom_state, rs);
96                  z->rnd.rnd_value = rs->rnd.rnd_value;      return(Cnil);
97                  return(z);    }
98          }    
99  }    z = alloc_object(t_random);
100      bzero(&z->rnd.rnd_state,sizeof(z->rnd.rnd_state));
101      gmp_randinit_default(&z->rnd.rnd_state);
102      
103      if (rs == Ct)
104        gmp_randseed_ui(&z->rnd.rnd_state,RS_DEF_INIT);
105      else
106        gmp_randseed(&z->rnd.rnd_state,rs->rnd.rnd_state._mp_seed);
107      
108      return(z);
109    
 static void  
 advance_random_state(object rs)  
 {  
         rs->rnd.rnd_value  
         = rs->rnd.rnd_value  
         + (rs->rnd.rnd_value<<2)  
         + (rs->rnd.rnd_value<<17)  
         + (rs->rnd.rnd_value<<27);  
110  }  }
111    
112    
# Line 121  LFD(Lrandom)(void) Line 120  LFD(Lrandom)(void)
120                  vs_push(symbol_value(Vrandom_state));                  vs_push(symbol_value(Vrandom_state));
121          check_arg(2);          check_arg(2);
122          check_type_random_state(&vs_base[1]);          check_type_random_state(&vs_base[1]);
         advance_random_state(vs_base[1]);  
123          x = rando(vs_base[0], vs_base[1]);          x = rando(vs_base[0], vs_base[1]);
124          vs_top = vs_base;          vs_top = vs_base;
125          vs_push(x);          vs_push(x);

Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26