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

Diff of /gcl/o/num_log.c

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

revision 1.4 by camm, Thu Jun 13 00:00:46 2002 UTC revision 1.5 by camm, Sat Jul 20 07:10:55 2002 UTC
# Line 35  Foundation, 675 Mass Ave, Cambridge, MA Line 35  Foundation, 675 Mass Ave, Cambridge, MA
35    
36    
37  int  int
38  ior_op(i, j)  ior_op(int i, int j)
 int     i, j;  
39  {  {
40          return(i | j);          return(i | j);
41  }  }
42    
43  int  int
44  xor_op(i, j)  xor_op(int i, int j)
 int     i, j;  
45  {  {
46          return(i ^ j);          return(i ^ j);
47  }  }
48    
49  int  int
50  and_op(i, j)  and_op(int i, int j)
 int     i, j;  
51  {  {
52          return(i & j);          return(i & j);
53  }  }
54    
55  int  int
56  eqv_op(i, j)  eqv_op(int i, int j)
 int     i, j;  
57  {  {
58          return(~(i ^ j));          return(~(i ^ j));
59  }  }
60    
61  int  int
62  nand_op(i, j)  nand_op(int i, int j)
 int     i, j;  
63  {  {
64          return(~(i & j));          return(~(i & j));
65  }  }
66    
67  int  int
68  nor_op(i, j)  nor_op(int i, int j)
 int     i, j;  
69  {  {
70          return(~(i | j));          return(~(i | j));
71  }  }
72    
73  int  int
74  andc1_op(i, j)  andc1_op(int i, int j)
 int     i, j;  
75  {  {
76          return((~i) & j);          return((~i) & j);
77  }  }
78    
79  int  int
80  andc2_op(i, j)  andc2_op(int i, int j)
 int     i, j;  
81  {  {
82          return(i & (~j));          return(i & (~j));
83  }  }
84    
85  int  int
86  orc1_op(i, j)  orc1_op(int i, int j)
 int     i, j;  
87  {  {
88          return((~i) | j);          return((~i) | j);
89  }  }
90    
91  int  int
92  orc2_op(i, j)  orc2_op(int i, int j)
 int     i, j;  
93  {  {
94          return(i | (~j));          return(i | (~j));
95  }  }
96    
97  int  int
98  b_clr_op(i, j)  b_clr_op(int i, int j)
 int     i, j;  
99  {  {
100          return(0);          return(0);
101  }  }
102    
103  int  int
104  b_set_op(i, j)  b_set_op(int i, int j)
 int     i, j;  
105  {  {
106          return(-1);          return(-1);
107  }  }
108    
109  int  int
110  b_1_op(i, j)  b_1_op(int i, int j)
 int     i, j;  
111  {  {
112          return(i);          return(i);
113  }  }
114    
115  int  int
116  b_2_op(i, j)  b_2_op(int i, int j)
 int     i, j;  
117  {  {
118          return(j);          return(j);
119  }  }
120    
121  int  int
122  b_c1_op(i, j)  b_c1_op(int i, int j)
 int     i, j;  
123  {  {
124          return(~i);          return(~i);
125  }  }
126    
127  int  int
128  b_c2_op(i, j)  b_c2_op(int i, int j)
 int     i, j;  
129  {  {
130          return(~j);          return(~j);
131  }  }
# Line 169  int (*intLogOps)()[16]= { Line 153  int (*intLogOps)()[16]= {
153    
154    
155  int  int
156  fix_bitp(x, p)  fix_bitp(object x, int p)
 object  x;  
 int     p;  
157  {  {
158          if (p > 30)             /* fix = sign + bit0-30 */          if (p > 30) {           /* fix = sign + bit0-30 */
159                  if (fix(x) < 0)                  if (fix(x) < 0)
160                          return(1);                          return(1);
161                  else                  else
162                          return(0);                          return(0);
163            }
164          return((fix(x) >> p) & 1);          return((fix(x) >> p) & 1);
165  }        }      
166    
167  int  int
168  count_int_bits(x)  count_int_bits(int x)
 int     x;  
169  {  {
170          int     i, count;          int     i, count;
171    
# Line 193  int    x; Line 175  int    x;
175  }  }
176    
177  int  int
178  count_bits(x)  count_bits(object x)
 object  x;  
179  {  {
180          int     i, count, sign;          int i, count=0;
181    
182          if (type_of(x) == t_fixnum) {          if (type_of(x) == t_fixnum) {
183                  i = fix(x);                  i = fix(x);
# Line 220  object x; Line 201  object x;
201    
202    
203  object  object
204  shift_integer(x, w)  shift_integer(object x, int w)
 object  x;  
 int     w;  
205  {  {
206    if (type_of(x) == t_fixnum)    if (type_of(x) == t_fixnum)
207      { if (w <= 0)      { if (w <= 0)
# Line 237  int    w; Line 216  int    w;
216        MPOP(return,shifti,MP(x),w);        MPOP(return,shifti,MP(x),w);
217      }      }
218    FEwrong_type_argument(sLinteger, x);    FEwrong_type_argument(sLinteger, x);
219      return(Cnil);
220  }  }
221                    
222    
223  int  int
224  int_bit_length(i)  int_bit_length(int i)
 int     i;  
225  {  {
226          int     count, j;          int     count, j;
227    
# Line 254  int    i; Line 233  int    i;
233    
234    
235    
236  Llogior()  void
237    Llogior(void)
238  {  {
239          object  x;          object  x;
240          int     narg, i;          int     narg, i;
241          int     ior_op();          int     ior_op(int i, int j);
242    
243          narg = vs_top - vs_base;          narg = vs_top - vs_base;
244          for (i = 0; i < narg; i++)          for (i = 0; i < narg; i++)
# Line 275  Llogior() Line 255  Llogior()
255          vs_push(x);          vs_push(x);
256  }  }
257    
258  Llogxor()  void
259    Llogxor(void)
260  {  {
261          object  x;          object  x;
262          int     narg, i;          int     narg, i;
263          int     xor_op();          int     xor_op(int i, int j);
264    
265          narg = vs_top - vs_base;          narg = vs_top - vs_base;
266          for (i = 0; i < narg; i++)          for (i = 0; i < narg; i++)
# Line 295  Llogxor() Line 276  Llogxor()
276          vs_push(x);          vs_push(x);
277  }  }
278    
279  Llogand()  void
280    Llogand(void)
281  {  {
282          object  x;          object  x;
283          int     narg, i;          int     narg, i;
284          int     and_op();          int     and_op(int i, int j);
285    
286          narg = vs_top - vs_base;          narg = vs_top - vs_base;
287          for (i = 0; i < narg; i++)          for (i = 0; i < narg; i++)
# Line 315  Llogand() Line 297  Llogand()
297          vs_push(x);          vs_push(x);
298  }  }
299    
300  Llogeqv()  void
301    Llogeqv(void)
302  {  {
303          object  x;          object  x;
304          int     narg, i;          int     narg, i;
305          int     eqv_op();          int     eqv_op(int i, int j);
306    
307          narg = vs_top - vs_base;          narg = vs_top - vs_base;
308          for (i = 0; i < narg; i++)          for (i = 0; i < narg; i++)
# Line 335  Llogeqv() Line 318  Llogeqv()
318          vs_push(x);          vs_push(x);
319  }  }
320    
321  Lboole()  void
322    Lboole(void)
323  {  {
324          object  x;          object  x;
325          object  o, r;          object  o;
326          int     (*op)();          int     (*op)()=NULL;
327          void    (*mp_op)() = (void *) 0;          void    (*mp_op)() = (void *) 0;
328    
329          check_arg(3);          check_arg(3);
# Line 376  Lboole() Line 360  Lboole()
360          vs_push(x);          vs_push(x);
361  }  }
362    
363  Llogbitp()  void
364    Llogbitp(void)
365  {  {
366          object  x, p;          object  x, p;
367          int     i;          int     i;
# Line 416  Llogbitp() Line 401  Llogbitp()
401                  vs_push(Cnil);                  vs_push(Cnil);
402  }  }
403    
404  Lash()  void
405    Lash(void)
406  {  {
407          object  r, x, y;          object  r=Cnil, x, y;
408          int     w, sign_x;          int     w, sign_x;
409    
410          check_arg(2);          check_arg(2);
# Line 465  BYE: Line 451  BYE:
451          vs_push(r);          vs_push(r);
452  }  }
453    
454  Llogcount()  void
455    Llogcount(void)
456  {  {
457          object  x;          object  x;
458          int     i;          int     i;
# Line 478  Llogcount() Line 465  Llogcount()
465          vs_push(make_fixnum(i));          vs_push(make_fixnum(i));
466  }  }
467    
468  Linteger_length()  void
469    Linteger_length(void)
470  {  {
471          object  x;          object  x;
472          int     count, cell, i;          int count=0, i;
473    
474          check_arg(1);          check_arg(1);
475          x = vs_base[0];          x = vs_base[0];
# Line 499  Linteger_length() Line 487  Linteger_length()
487    
488  #define W_SIZE (8*sizeof(int))  #define W_SIZE (8*sizeof(int))
489  object  object
490  bitand(a,b,c)  bitand(object a, object b, object c)
      object a,b,c;  
491  { int d= a->bv.bv_fillp;  { int d= a->bv.bv_fillp;
492    int *ap,*bp,*cp;    int *ap,*bp,*cp;
493    d=(d+W_SIZE-1)/W_SIZE;    d=(d+W_SIZE-1)/W_SIZE;
# Line 514  bitand(a,b,c) Line 501  bitand(a,b,c)
501  }  }
502    
503  object  object
504  bitior(a,b,c)  bitior(object a, object b, object c)
      object a,b,c;  
505  { int *ap,*cp,*bp, d= a->bv.bv_fillp;  { int *ap,*cp,*bp, d= a->bv.bv_fillp;
506    d=(d+W_SIZE-1)/W_SIZE;    d=(d+W_SIZE-1)/W_SIZE;
507     ap= (int *)((a->bv.bv_self));     ap= (int *)((a->bv.bv_self));
# Line 530  bitior(a,b,c) Line 516  bitior(a,b,c)
516  /* Note in order to be equal we assume that the part above the  /* Note in order to be equal we assume that the part above the
517     fill pointer is 0 up to the next word */     fill pointer is 0 up to the next word */
518    
519  bvequal(a,b)  int
520       object a,b;  bvequal(object a, object b)
521  { int *ap,*bp, d= a->bv.bv_fillp;  { int *ap,*bp, d= a->bv.bv_fillp;
522    d=(d+W_SIZE-1)/W_SIZE;    d=(d+W_SIZE-1)/W_SIZE;
523   ap= (int *)(a->bv.bv_self);   ap= (int *)(a->bv.bv_self);
# Line 544  bvequal(a,b) Line 530  bvequal(a,b)
530    
531        
532    
533    void
534  init_num_log()  init_num_log(void)
535  {  {
536          int siLbit_array_op();  /*      int siLbit_array_op(void); */
537    
538          make_constant("BOOLE-CLR", make_fixnum(BOOLCLR));          make_constant("BOOLE-CLR", make_fixnum(BOOLCLR));
539          make_constant("BOOLE-SET", make_fixnum(BOOLSET));          make_constant("BOOLE-SET", make_fixnum(BOOLSET));
# Line 580  init_num_log() Line 566  init_num_log()
566          make_si_function("BIT-ARRAY-OP", siLbit_array_op);          make_si_function("BIT-ARRAY-OP", siLbit_array_op);
567  }  }
568    
569    void
570  siLbit_array_op()  siLbit_array_op(void)
571  {  {
572          int i, j, n, d;          int i, j, n, d;
573          object  o, x, y, r, r0;          object  o, x, y, r, r0=Cnil;
574          int (*op)();          int (*op)()=NULL;
575          bool replace = FALSE;          bool replace = FALSE;
576          int xi, yi, ri;          int xi, yi, ri;
577          char *xp, *yp, *rp;          char *xp, *yp, *rp;
# Line 615  siLbit_array_op() Line 601  siLbit_array_op()
601                          if (r->bv.bv_dim != d)                          if (r->bv.bv_dim != d)
602                                  goto ERROR;                                  goto ERROR;
603                          i = (r->bv.bv_self - xp)*8 + (BV_OFFSET(r) - xo);                          i = (r->bv.bv_self - xp)*8 + (BV_OFFSET(r) - xo);
604                          if (i > 0 && i < d || i < 0 && -i < d) {                          if ((i > 0 && i < d) || (i < 0 && -i < d)) {
605                                  r0 = r;                                  r0 = r;
606                                  r = Cnil;                                  r = Cnil;
607                                  replace = TRUE;                                  replace = TRUE;
608                                  goto L1;                                  goto L1;
609                          }                          }
610                          i = (r->bv.bv_self - yp)*8 + (BV_OFFSET(r) - yo);                          i = (r->bv.bv_self - yp)*8 + (BV_OFFSET(r) - yo);
611                          if (i > 0 && i < d || i < 0 && -i < d) {                          if ((i > 0 && i < d) || (i < 0 && -i < d)) {
612                                  r0 = r;                                  r0 = r;
613                                  r = Cnil;                                  r = Cnil;
614                                  replace = TRUE;                                  replace = TRUE;
# Line 673  siLbit_array_op() Line 659  siLbit_array_op()
659                                  if (r->a.a_dims[i] != x->a.a_dims[i])                                  if (r->a.a_dims[i] != x->a.a_dims[i])
660                                          goto ERROR;                                          goto ERROR;
661                          i = (r->bv.bv_self - xp)*8 + (BV_OFFSET(r) - xo);                          i = (r->bv.bv_self - xp)*8 + (BV_OFFSET(r) - xo);
662                          if (i > 0 && i < d || i < 0 && -i < d) {                          if ((i > 0 && i < d) || (i < 0 && -i < d)) {
663                                  r0 = r;                                  r0 = r;
664                                  r = Cnil;                                  r = Cnil;
665                                  replace = TRUE;                                  replace = TRUE;
666                                  goto L2;                                  goto L2;
667                          }                          }
668                          i = (r->bv.bv_self - yp)*8 + (BV_OFFSET(r) - yo);                          i = (r->bv.bv_self - yp)*8 + (BV_OFFSET(r) - yo);
669                          if (i > 0 && i < d || i < 0 && -i < d) {                          if ((i > 0 && i < d) || (i < 0 && -i < d)) {
670                                  r0 = r;                                  r0 = r;
671                                  r = Cnil;                                  r = Cnil;
672                                  replace = TRUE;                                  replace = TRUE;
# Line 724  siLbit_array_op() Line 710  siLbit_array_op()
710          }          }
711    
712  #define set_high(place, nbits, value) \  #define set_high(place, nbits, value) \
713          ((place)=((place)&~(-0400>>(nbits))|(value)&(-0400>>(nbits))))          ((place)=(((place)&~(-0400>>(nbits)))|((value)&(-0400>>(nbits)))))
714    
715  #define set_low(place, nbits, value) \  #define set_low(place, nbits, value) \
716          ((place)=((place)&(-0400>>(8-(nbits)))|(value)&~(-0400>>(8-(nbits)))))          ((place)=(((place)&(-0400>>(8-(nbits))))|((value)&~(-0400>>(8-(nbits))))))
717    
718  #define extract_byte(integer, pointer, index, offset) \  #define extract_byte(integer, pointer, index, offset) \
719          (integer) = (pointer)[(index)+1] & 0377; \          (integer) = (pointer)[(index)+1] & 0377; \

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5

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