← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to o/cmac.c

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
o/cmac.c
 
1
#define NEED_MP_H
 
2
#ifndef FIRSTWORD
 
3
#include "include.h"
 
4
#endif
 
5
 
 
6
/*  #include "arith.h"   */
 
7
 
 
8
 
 
9
 
 
10
/* I believe the instructions used here are ok for 68010.. */
 
11
 
 
12
#ifdef MC68K
 
13
#define MC68020
 
14
#endif
 
15
  
 
16
/* static for gnuwin95 the save routine is not saving statics... */
 
17
 
 
18
object *gclModulus;
 
19
#define FIXNUMP(x) (type_of(x)==t_fixnum)
 
20
 
 
21
/* Note: the gclModulus is guaranteed > 0 */
 
22
 
 
23
#define FIX_MOD(X,MOD) {register int MOD_2; \
 
24
                             if (X > (MOD_2=(MOD >>1))) X=X-MOD; else \
 
25
                               if (X < -MOD_2)  X=X+MOD;}
 
26
 
 
27
 
 
28
 
 
29
/*  #define MYmake_fixnum(doto,x) \ */
 
30
/*    {register int CMPt1; \ */
 
31
/*     doto \ */
 
32
/*     ((((CMPt1=(x))+1024)&-2048)==0?small_fixnum(CMPt1):make_fixnum(CMPt1));} */
 
33
 
 
34
 
 
35
 
 
36
object ctimes(object a, object b),cplus(object a, object b),cdifference(object a, object b),cmod(object x);
 
37
          
 
38
object make_integer(__mpz_struct *u);  
 
39
          
 
40
#define our_minus(a,b) ((FIXNUMP(a)&&FIXNUMP(b))?fixnum_sub(fix(a),fix(b)): \
 
41
                        number_minus(a,b))
 
42
#define our_plus(a,b) ((FIXNUMP(a)&&FIXNUMP(b))?fixnum_add(fix(a),fix(b)): \
 
43
                        number_plus(a,b))
 
44
#define our_times(a,b) number_times(a,b)
 
45
 
 
46
/* fix (and check) this on 64 bit machines, where long is the long long */
 
47
#ifdef HAVE_LONG_LONG
 
48
static int
 
49
dblrem(int a, int b, int mod)
 
50
{
 
51
  return  (int)(((long long int)a*(long long int)b)%(long long int) mod);
 
52
}
 
53
#else
 
54
 
 
55
static int
 
56
dblrem(a,b,mod)
 
57
int a,b,mod;
 
58
{int h,sign;
 
59
 if (a<0) 
 
60
   {a= -a; sign= (b<0)? (b= -b,1) :-1;}
 
61
 else { sign= (b<0) ? (b= -b,-1) : 1;}
 
62
 { mp_limb_t ar[2],q[2],aa;
 
63
 aa = a;
 
64
  ar[1]=mpn_mul_1(ar,&aa,1,b);
 
65
  h = mpn_divrem_1(q,0,ar,2,mod);
 
66
 return ((sign<0) ? -h :h);
 
67
 }
 
68
}
 
69
#endif
 
70
 
 
71
object    
 
72
cmod(object x)
 
73
{register object mod = *gclModulus;
 
74
 if (mod==Cnil) return(x);
 
75
else
 
76
 if((type_of(mod)==t_fixnum && type_of(x)==t_fixnum))
 
77
    {register int xx,mm;
 
78
     mm=fix(mod);
 
79
     if (mm==2) {xx= (fix(x) & 1); return(small_fixnum(xx));}
 
80
     xx=(fix(x)%mm);
 
81
     FIX_MOD(xx,mm);
 
82
     MYmake_fixnum(return,xx);
 
83
   }
 
84
 else
 
85
   {object qp,rp,mod2;
 
86
    int compare;
 
87
    integer_quotient_remainder_1(x,mod,&qp,&rp);
 
88
    mod2=shift_integer(mod,-1);
 
89
    compare = number_compare(rp,small_fixnum(0));
 
90
    if (compare >= 0)
 
91
      {compare=number_compare(rp,mod2);
 
92
       if (compare > 0) rp=number_minus(rp,mod);}
 
93
    else
 
94
      if (number_compare(number_negate(mod2), rp) > 0)
 
95
        {rp = number_plus(rp,mod);}
 
96
    return rp;}}
 
97
 
 
98
 
 
99
#define MOST_POSITIVE_FIX (((unsigned int) (~0) ) /2)
 
100
#define SMALL_MODULUS_P(mod) (FIXNUMP(mod) && (fix(mod) < (MOST_POSITIVE_FIX)/2))
 
101
object
 
102
ctimes(object a, object b)
 
103
{object mod = *gclModulus;
 
104
 if (FIXNUMP(mod))
 
105
     {register int res, m ;
 
106
      res=dblrem(fix(a),fix(b),m=fix(mod));
 
107
      FIX_MOD(res,m);
 
108
      MYmake_fixnum(return,res);}
 
109
else if (mod==Cnil)
 
110
  { return(our_times(a,b));}
 
111
 return cmod(number_times(a,b));}
 
112
 
 
113
 
 
114
object
 
115
cdifference(object a, object b)
 
116
{object mod = *gclModulus;
 
117
 if (SMALL_MODULUS_P(mod))
 
118
   {register int res,m;
 
119
    res=((fix(a)-fix(b))%(m=fix(mod)));
 
120
    FIX_MOD(res,m);
 
121
    MYmake_fixnum(return,res);}
 
122
 else if (mod==Cnil)
 
123
     return (our_minus(a,b));
 
124
 else return(cmod(number_minus(a,b)));}
 
125
 
 
126
object
 
127
cplus(object a, object b)
 
128
{object mod = *gclModulus;
 
129
 if (SMALL_MODULUS_P(mod))
 
130
   {register int res,m;
 
131
    res=((fix(a)+fix(b))%(m=fix(mod)));
 
132
    FIX_MOD(res,m);
 
133
    MYmake_fixnum(return,res);}
 
134
 else
 
135
   if (mod==Cnil)
 
136
     return (our_plus(a,b));
 
137
 else
 
138
   return(cmod(number_plus(a,b)));}
 
139
 
 
140
 
 
141
DEFUNO_NEW("CMOD",object,fScmod,SI
 
142
   ,1,1,NONE,OO,OO,OO,OO,void,siLcmod,(object num),"")
 
143
 
 
144
{/* 1 args */
 
145
 num=cmod(num);
 
146
 RETURN1(num);
 
147
}
 
148
 
 
149
 
 
150
DEFUNO_NEW("CPLUS",object,fScplus,SI
 
151
   ,2,2,NONE,OO,OO,OO,OO,void,siLcplus,(object x0,object x1),"")
 
152
 
 
153
{ /* 2 args */
 
154
 x0 = cplus(x0,x1);
 
155
 RETURN1( x0 );
 
156
}
 
157
 
 
158
 
 
159
DEFUNO_NEW("CTIMES",object,fSctimes,SI
 
160
   ,2,2,NONE,OO,OO,OO,OO,void,siLctimes,(object x0,object x1),"")
 
161
 
 
162
{
 
163
 /* 2 args */
 
164
 x0=ctimes(x0,x1);
 
165
 RETURN1(x0);
 
166
}
 
167
 
 
168
 
 
169
DEFUNO_NEW("CDIFFERENCE",object,fScdifference,SI
 
170
   ,2,2,NONE,OO,OO,OO,OO,void,siLcdifference,(object x0,object x1),"")
 
171
 
 
172
{ /* 2 args */
 
173
 x0=cdifference(x0,x1);
 
174
 RETURN1(x0);
 
175
}
 
176
 
 
177
/* static object  */
 
178
/* memq(register object a, register object b) */
 
179
/* {while (1) */
 
180
/*     {if ((a==b->c.c_car)||b==Cnil) return b; */
 
181
/*     b=b->c.c_cdr;}} */
 
182
 
 
183
 
 
184
void     
 
185
gcl_init_cmac(void)
 
186
{
 
187
/* add_symbol("ctimes",&ctimes,"cplus",&cplus,"cdifference",&cdifference,"cmod",
 
188
 &cmod, 0); */
 
189
gclModulus = (&((make_si_special("MODULUS",Cnil))->s.s_dbind));
 
190
make_si_function("CMOD",siLcmod);
 
191
make_si_function("CPLUS",siLcplus);
 
192
make_si_function("CTIMES",siLctimes);
 
193
make_si_function("CDIFFERENCE",siLcdifference);
 
194
 
 
195
}