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 |
} |
} |
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 |
|
|
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); |
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) |
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 |
|
|
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++) |
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++) |
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++) |
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++) |
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); |
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; |
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); |
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; |
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]; |
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; |
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)); |
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); |
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)); |
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; |
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; |
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; |
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; \ |