This is big.c in view mode; [Download] [Up]
Changes file for /usr/local/src/kcl/c/big.c
Created on Mon Mar 25 12:45:02 1991
Usage \n@s[Original text\n@s|Replacement Text\n@s]
See the file rascal.ics.utexas.edu:/usr2/ftp/merge.c
for a program to merge change files. Anything not between
"\n@s[" and "\n@s]" is a simply a comment.
This file was constructed using emacs and merge.el
Enhancements Copyright (c) W. Schelter All rights reserved.
by (Bill Schelter) wfs@carl.ma.utexas.edu
****Change:(orig (1 5 c))
@s[/*
(c) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved.
Copying of this file is authorized to users who have executed the true and
proper "License Agreement for Kyoto Common LISP" with SIGLISP.
@s,*/
@s| /* Copyright William F. Schelter 1991
Bignum routines.
@s]
****Change:(orig (7 8 d))
@s[
/*
big.c
@s|
@s]
****Change:(orig (10 11 c))
@s[
bignum routines
*/
@s|
num_arith.c: add_int_big
num_arith.c: big_minus
num_arith.c: big_plus
num_arith.c: big_quotient_remainder
num_arith.c: big_sign
num_arith.c: big_times
num_arith.c: complement_big
num_arith.c: copy_big
num_arith.c: div_int_big
num_arith.c: mul_int_big
num_arith.c: normalize_big
num_arith.c: normalize_big_to_object
num_arith.c: stretch_big
num_arith.c: sub_int_big
num_comp.c: big_compare
num_comp.c: big_sign
num_log.c: big_sign
num_log.c: copy_to_big
num_log.c: normalize_big
num_log.c: normalize_big_to_object
num_log.c: stretch_big
num_pred.c: big_sign
number.c: big_to_double
predicate.c: big_compare
typespec.c: big_sign
print.d: big_minus
print.d: big_sign
print.d: big_zerop
print.d: copy_big
print.d: div_int_big
read.d: add_int_big
read.d: big_to_double
read.d: complement_big
read.d: mul_int_big
read.d: normalize_big
read.d: normalize_big_to_object
@s]
****Change:(orig (13 14 c))
@s[#include "include.h"
#include "num_include.h"
@s| */
@s]
****Change:(orig (16 27 d))
@s[struct bignum *
stretch_big(x, i)
struct bignum *x;
int i;
@s, x->big_cdr = NULL;
return(x);
}
@s|
@s]
****Change:(orig (29 47 d))
@s[struct bignum *
copy_big(x)
struct bignum *x;
{
@s, vs_reset;
return(y0);
}
@s|
@s]
****Change:(orig (49 53 c))
@s[struct bignum *
copy_to_big(x)
object x;
{
@s, struct bignum *y;
@s|#define remainder akclremainder
#include "include.h"
#include "mp.h"
@s]
****Change:(orig (55 64 d))
@s[ if (type_of(x) == t_fixnum) {
y = (struct bignum *)alloc_object(t_bignum);
y->big_car = fix(x);
y->big_cdr = NULL;
@s, FEerror("integer expected",0);
return(y);
}
@s|
@s]
****Change:(orig (66 78 d))
@s[/*
Big_zerop(x) answers if bignum x is zero or not.
X may be any bignum.
*/
@s, else if ((x = x->big_cdr) == NULL)
return(1);
}
@s|
@s]
****Change:(orig (80 94 d))
@s[/*
Big_sign(x) returns
something < -1 if x < -1
-1 if x = -1
@s, bool zero;
bool minus1;
@s|
@s]
****Change:(orig (96 124 c))
@s[ l = x;
zero = minus1 = TRUE;
for (;;) {
if (l->big_cdr == NULL) {
@s, minus1 = FALSE;
l = l->big_cdr;
}
}
@s|#define BCOPY_BODY(x,y) \
do { int *ucop = (int *)(x); \
int *vcop = (int *) (y); \
{int j = lgef(ucop); \
while(--j >= 0) \
{ *vcop++ = *ucop++;}}}while (0)
@s]
****Change:(orig (126 131 c))
@s[/*
int
big_sign(x)
struct bignum *x;
@s,{
int i;
@s|bcopy_body(x,y)
GEN x,y;
{BCOPY_BODY(x,y);}
@s]
****Change:(orig (133 142 d))
@s[ if (x->big_cdr == NULL)
return(x->big_car);
i = big_sign(x->big_cdr);
if (i == 0)
@s, return(x->big_car | ~MASK);
return(i);
}
*/
@s|
@s]
****Change:(orig (144 156 d))
@s[/*
Big_compare(x, y) returns
-1 if x < y
0 if x = y
@s, int i;
int comparison;
@s|
@s]
****Change:(orig (158 158 d))
@s[
comparison = 0;
@s|
@s]
****Change:(orig (160 217 c))
@s[LOOP:
if (x->big_cdr == NULL)
if (y->big_cdr == NULL)
if (x->big_car < y->big_car)
@s, y = y->big_cdr;
goto LOOP;
}
}
@s|/* coerce a pari GEN to a bignum or fixnum */
@s]
****Change:(orig (219 224 c))
@s[/*
int
big_compare(x, y)
struct bignum *x, *y;
@s,{
int i;
@s|object
make_integer(u)
GEN u;
{ int l = lgef(u);
if (l > (MP_CODE_WORDS+1) ||
( l == (MP_CODE_WORDS+1) &&
(MP_ONLY_WORD(u) & (1<<31)) != 0
&& (MP_ONLY_WORD(u) == ( 1<<31) ? signe(u) > 0 : 1)))
{ object ans = alloc_object(t_bignum);
GEN w;
ans->big.big_length = lgef(u);
/* this protects u against gc */
ans->big.big_self = u;
w = (GEN)alloc_relblock(lgef(u)*sizeof(int));
u = ans->big.big_self ;
ans->big.big_self = w;
BCOPY_BODY(u , ans->big.big_self);
return ans;
}
else
if (signe(u) > 0) return make_fixnum(MP_ONLY_WORD(u));
else
if (signe(u) < 0) return make_fixnum(-MP_ONLY_WORD(u));
else
return(small_fixnum(0));
}
@s]
****Change:(orig (226 281 d))
@s[ if (x->big_cdr == NULL)
if (y->big_cdr == NULL)
if (x->big_car < y->big_car)
return(-1);
@s, else
return(i);
}
*/
@s|
@s]
****Change:(orig (283 291 c))
@s[/*
Complement_big(x) destructively takes
the complement of bignum x.
X may be any bignum.
@s,struct bignum *x;
{
/* vs_mark;
@s|object
make_bignum(u)
GEN u;
{ object ans = alloc_object(t_bignum);
GEN w;
ans->big.big_length = lg(u);
/* save u */
ans->big.big_self = u;
w = (GEN)alloc_relblock(lg(u)*sizeof(int));
/* restore u */
u = ans->big.big_self ;
ans->big.big_self = w;
BCOPY_BODY(u , ans->big.big_self);
return ans;
}
@s]
****Change:(orig (293 307 c))
@s[ vs_push((object)x); */
while (x->big_cdr != NULL) {
if (x->big_car != 0) {
x->big_car = (-(x->big_car)) & MASK;
@s,/* vs_reset; */
return;
@s|big_zerop(x)
object x;
{ return (signe(MP(x))== 0);}
@s]
****Change:(orig (309 319 c))
@s[ONE:
for (;;) {
x = x->big_cdr;
if (x->big_cdr == NULL)
@s,/* vs_reset; */
return;
}
@s|big_compare(x, y)
object x,y;
{return cmpii(MP(x),MP(y));}
@s]
****Change:(orig (321 325 c))
@s[/*
big_minus(x) returns the complement of bignum x.
X may be any bignum.
*/
@s,struct bignum *
@s|object
@s]
****Change:(orig (327 363 c))
@s[struct bignum *x;
{
struct bignum *y0, *y;
vs_mark;
@s, y->big_car = ~(x->big_car);
vs_reset;
return(y0);
@s| object x;
{ object y;
setsigne(MP(x),-(signe(MP(x))));
y = make_integer(MP(x));
setsigne(MP(x),-(signe(MP(x))));
return y;
@s]
****Change:(orig (366 371 c))
@s[/*
Add_int_big(i, x) destructively adds non-negative int i
to bignum x.
I should be non-negative.
@s, X may be any bignum.
*/
@s|gcopy_to_big(res,x)
GEN res;
object x;
{int l = (x)->big.big_length;
int lgres = lg(res);
if (l< lgres)
{
big_register_1->big.big_length = lgres;
big_register_1->big.big_self = res;
(x)->big.big_self = (GEN) alloc_relblock(lgres*sizeof(int));
(x)->big.big_length = lgres;
res = big_register_1->big.big_self ;
}
BCOPY_BODY(res,(x)->big.big_self);
if (l>lgres)
{ setlg((x)->big.big_self, l);}
}
@s]
****Change:(orig (374 374 c))
@s[int i;
struct bignum *x;
@s|int i;
object x;
@s]
****Change:(orig (376 401 c))
@s[/* vs_mark;
vs_push((object)x); */
while (x->big_cdr != NULL) {
@s,/* vs_reset; */
return;
@s| MPOP_DEST(x,addsi,i,MP(x));
@s]
****Change:(orig (404 409 c))
@s[/*
Sub_int_big(i, x) destructively subtracts non-negative int i
from bignum x.
I should be non-negative.
@s, X may be any bignum.
*/
@s|
@s]
****Change:(orig (412 439 c))
@s[struct bignum *x;
{
/* vs_mark;
@s,/* vs_reset; */
return;
@s|object x;
{ MPOP_DEST(x,subsi,i,MP(x));
@s]
****Change:(orig (442 447 d))
@s[/*
Mul_int_big(i, x) destructively multiplies non-negative bignum x
by non-negative int i.
I should be non-negative.
@s, X should be non-negative.
*/
@s|
@s]
****Change:(orig (450 453 c))
@s[struct bignum *x;
{
int h;
/* vs_mark;
@s|object x;
{ MPOP_DEST(x,mulsi,i,MP(x));
}
@s]
****Change:(orig (455 468 d))
@s[ vs_push((object)x); */
h = 0;
for (;;) {
extended_mul(i, x->big_car, h, &h, &(x->big_car));
@s,/* vs_reset; */
return;
}
@s|
@s]
****Change:(orig (472 472 c))
@s[ X will hold the remainder of the division.
@s| X will hold the quotient from the division.
@s]
****Change:(orig (477 477 c))
@s[ X should be non-negative.
*/
int
@s| X should be non-negative.
*/
@s]
****Change:(orig (480 493 c))
@s[struct bignum *x;
{
int r;
@s, extended_div(i, r, x->big_car, &(x->big_car), &r);
return(r);
@s|object x;
{ save_avma;
GEN res = divis(MP(x),i);
gcopy_to_big(res,x);
restore_avma;
return hiremainder;
@s]
****Change:(orig (496 500 c))
@s[/*
Big_plus(x, y) returns the sum of bignum x and bignum y.
X and y may be any bignum.
*/
@s,struct bignum *
@s|
object
@s]
****Change:(orig (502 506 c))
@s[struct bignum *x, *y;
{
struct bignum *z0, *z;
int c;
@s, vs_mark;
@s|object x,y;
{ MPOP(return,addii,MP(x),MP(y));
}
@s]
****Change:(orig (508 534 c))
@s[/* vs_push((object)x);
vs_push((object)y); */
z0 = z = (struct bignum *)alloc_object(t_bignum);
z->big_car = 0;
@s, z = stretch_big(z, 0);
}
@s|object
big_times(x, y)
object x,y;
{ MPOP(return,mulii,MP(x),MP(y));
}
@s]
****Change:(orig (536 544 d))
@s[BOTH_END:
if (x->big_car>=0 && y->big_car>=0 && z->big_car<0) {
z->big_car &= MASK;
stretch_big(z, 1);
@s, vs_reset;
return(z0);
@s|
@s]
****Change:(orig (546 572 d))
@s[X_END:
if (x->big_car >= 0)
c = 1;
else
@s, vs_reset;
return(z0);
}
}
@s|
@s]
****Change:(orig (574 600 c))
@s[Y_END:
if (y->big_car >= 0)
c = 1;
else
@s, vs_reset;
return(z0);
}
}
@s|big_quotient_remainder(x0, y0, qp, rp)
object x0,y0,*qp,*rp;
{
GEN res,quot;
save_avma;
res = dvmdii(MP(x0),MP(y0),");
*qp = make_integer(res);
*rp = make_integer(quot);
restore_avma;
return;
@s]
****Change:(orig (603 610 c))
@s[/*
Big_times(x0, y0) returns the product
of non-negative bignum x0 and non-negative bignum y0.
X0 and y0 should be non-negative.
@s,struct bignum *x0, *y0;
@s|
double
big_to_double(x)
object x;
@s]
****Change:(orig (612 615 c))
@s[ struct bignum *x, *y;
struct bignum *z0, *z1, *z;
int i, h, l;
vs_mark;
@s| double d, e;
GEN u = MP(x);
unsigned int *w;
int l;
e = 4.294967296e9;
@s]
****Change:(orig (617 623 c))
@s[/* vs_push((object)x0);
vs_push((object)y0); */
y = y0;
z1 = z0 = (struct bignum *)alloc_object(t_bignum);
@s, z0->big_cdr = NULL;
vs_push((object)z0);
@s| l = lgef(u);
MP_START_HIGH(w,(unsigned int *) u,l);
l = l - MP_CODE_WORDS;
@s]
****Change:(orig (625 629 c))
@s[LOOP1:
i = y->big_car;
z = z1;
x = x0;
@s, h = 0;
@s| if (l == 0) return 0.0;
@s]
****Change:(orig (631 668 c))
@s[LOOP:
extended_mul(i, x->big_car, h, &h, &l);
z->big_car += l;
if (z->big_car < 0) {
@s, z = z->big_cdr;
goto LOOP;
}
@s| d = (double) MP_NEXT_DOWN(w);
while (--l > 0)
{d = e*d + (double)(MP_NEXT_DOWN(w));}
if (signe(u)>0) return d;
else return -d;
}
@s]
****Change:(orig (670 679 c))
@s[/*
Sub_int_big_big(i, x, y) destructively subtracts i*x from y.
I should be a non-negative int.
X should be a normalized non-negative bignum.
@s,int i;
struct bignum *x, *y;
@s|object
normalize_big_to_object(x)
object x;
{ return make_integer(MP(x));}
object copy_big(x)
object x;
@s]
****Change:(orig (681 681 c))
@s[{
int h, l;
@s|{
if (type_of(x)==t_bignum)
return make_bignum(MP(x));
else FEerror("bignum expected",0);
@s]
****Change:(orig (683 705 d))
@s[ h = 0;
for (;;) {
extended_mul(i, x->big_car, h, &h, &l);
y->big_car -= l;
@s, x = x->big_cdr;
y = y->big_cdr;
}
@s|
@s]
****Change:(orig (708 721 d))
@s[/*
Get_standardizing_factor_and_normalize(x)
returns the standardizing factor of x.
As a side-effect, x will be normalized.
@s,struct bignum *x;
{
int i, j;
@s|
@s]
****Change:(orig (723 740 c))
@s[ if (x->big_cdr == NULL) {
if (x->big_car == 0)
return(-1);
for (i = 1, j = x->big_car; (j *= 2) >= 0; i *= 2)
@s, return(i);
}
return(i);
}
@s|object
copy_to_big(x)
object x;
{object y;
@s]
****Change:(orig (742 785 c))
@s[/*
Div_big_big(x0, y0) divides y0 by x0
and destructively places the remainder in y0.
X0 should be a normalized positive bignum,
@s, q = y->big_car/x->big_car - 2;
if (q <= 0)
q = 0;
@s| if (type_of(x) == t_fixnum) {
save_avma;
y = make_bignum(stoi(fix(x)));
restore_avma;
} else if (type_of(x) == t_bignum)
y = copy_big(x);
@s]
****Change:(orig (787 793 c))
@s[ sub_int_big_big(q, x0, y0);
while (big_compare(x0, y0) <= 0) {
q++;
sub_int_big_big(1, x0, y0);
@s, }
return(q);
}
@s| FEerror("integer expected",0);
return(y);
}
@s]
****Change:(orig (795 799 c))
@s[int
big_length(x)
struct bignum *x;
{
@s, int i;
@s|/* return the power of x */
GEN
powerii(x,y)
GEN x, y;
{ GEN ans = gun;
if (signe(y) < 0) FEerror("bad");
while (lgef(y) > 2){
if (MP_LOW(y,lgef(y)) & 1)
{ ans = mulii(ans,x);}
x = mulii(x,x);
y = shifti(y,-1);}
return ans;
}
@s]
****Change:(orig (801 804 c))
@s[ for (i = 1; x->big_cdr != NULL; i++, x = x->big_cdr)
;
return(i);
}
@s|object integ_temp;
@s]
****Change:(orig (806 811 d))
@s[struct bignum *
big_quotient_remainder_auxiliary(x, y, i)
struct bignum *x, *y;
int i;
@s, struct bignum *q, *qq;
@s|
@s]
****Change:(orig (813 833 c))
@s[ if (i < 0)
return(NULL);
if (i == 0) {
i = div_big_big(y, x);
@s, qq->big_cdr = q;
return(qq);
@s|replace_copy1(x,y)
GEN y,x;
{ int j = lgef(x);
if (y && j <= lg(y))
{ x++; y++;
while (--j >0)
{*y++ = *x++;}
return 0;}
END:
return j*2*sizeof(GEN);
@s]
****Change:(orig (836 848 c))
@s[/*
Big_quotient_remainder(x0, y0, qp, rp)
sets the quotient and the remainder of the division of x0 by y0
to *qp and *rp respectively.
@s, int i, l, m;
vs_mark;
@s|/* doubles the length ! */
GEN
replace_copy2(x,y)
GEN y,x;
{GEN yp = y;
int k,j = lgef(x);
k = j;
while (--j >=0)
{*yp++ = *x++;}
y[0] = INT_FLAG + k*2;
return y;}
@s]
****Change:(orig (850 869 c))
@s[/* vs_push((object)x0);
vs_push((object)y0); */
x = copy_big(x0);
vs_push((object)x);
@s, div_int_big(i, y);
*rp = x;
vs_reset;
@s|#define STOI(x,y) do{ \
if (x ==0) { y[1]=2;} \
else if((x)>0) {y[1]=0x1000003;y[2]=x;} \
else{y[1]=0xff000003;y[2]= -x;}}while (0)
/* actually y == 0 is not supposed to happen !*/
obj_replace_copy1(x,y)
object x;
GEN y;
{ int j ;
GEN xp;
{ if (type_of(x) == t_bignum)
{ j = lgef(MP(x));
if (y && j <= lg(y))
{ xp=MP(x);
xp++; y++;
while (--j >0)
{*y++ = *xp++;}
return 0;}}
else
{ if (y==0) return 3*2*sizeof(GEN) ;
STOI(fix(x),y); return 0;}}
END:
return j*2*sizeof(GEN);
@s]
****Change:(orig (872 875 c))
@s[normalize_big(x)
struct bignum *x;
{
struct bignum *l, *m, *n;
@s|/* doubles the length ! */
GEN
obj_replace_copy2(x,y)
object x;
GEN y;
{GEN yp = y;
GEN xp;
int k,j;
if (type_of(x) == t_bignum)
{ j = lgef(MP(x));
k = j;
xp = MP(x);
while (--j >=0)
{*yp++ = *xp++;}
y[0] = INT_FLAG + k*2;}
else {STOI(fix(x),yp); y[0] = INT_FLAG+3*2;}
return y;}
@s]
****Change:(orig (877 907 d))
@s[ l = NULL;
m = x;
for (;;) {
n = m->big_cdr;
@s, break;
l = m;
m = n;
}
}
@s|
@s]
****Change:(orig (909 923 c))
@s[/*
normalize_big(x)
struct bignum *x;
{
@s, x->big_cdr = NULL;
}
}
@s|GEN
otoi(x)
object x;
{if (type_of(x)==t_fixnum) return stoi(fix(x));
if (type_of(x)==t_bignum)
return (MP(x));
FEwrong_type_argument(Sinteger,x);
return 0;
@s]
****Change:(orig (925 925 d))
@s[}
*/
@s|}
@s]
****Change:(orig (928 935 c))
@s[normalize_big_to_object(x)
struct bignum *x;
{
normalize_big(x);
@s, else
return((object)x);
@s|alloc_bignum_static(len)
int len;
{ object ans = alloc_object(t_bignum);
GEN w;
ans->big.big_length = len;
ans->big.big_self = 0;
w = (GEN)AR_ALLOC(alloc_contblock,len,unsigned long);
ans->big.big_self = w;
w[0] = INT_FLAG + len;
return ans;
}
GEN
setq_io(x,all,val)
GEN x;
object val;
object *all;
{int n= obj_replace_copy1(val,x);
if (n)
{ *all = alloc_bignum_static(n/sizeof(int));
return obj_replace_copy2(val,MP(*all));
}
else return x;}
GEN
setq_ii(x,all,val)
GEN x;
GEN val;
object *all;
{int n= replace_copy1(val,x);
if (n)
{ *all = alloc_bignum_static(n/sizeof(int));
return replace_copy2(val,MP(*all));
}
else return x;}
void
isetq_fix(var,s)
GEN var;
int s;
{/* if (var==0) FEerror("unitialized integer var"); */
STOI(s,var);
@s]
****Change:(orig (938 942 c))
@s[double
big_to_double(x)
struct bignum *x;
{
@s, double d, e;
@s|GEN
icopy_bignum(a,y)
object a;
GEN y;
{ int *ucop = (int *)MP(a);
int *vcop = (int *) (y);
int j = lgef(ucop);
{while(--j >= 0)
{ *vcop++ = *ucop++;}
setlg(y,a->big.big_length);
return y;}}
@s]
****Change:(orig (944 949 c))
@s[ for (d = 0.0, e = 1.0; x->big_cdr != NULL; x = x->big_cdr) {
d += e * (double)(x->big_car);
e *= 2.147483648e9;
}
@s, d += e * (double)(x->big_car);
return(d);
@s|GEN
icopy_fixnum(a,y)
object a;
GEN y;
{ int x= fix(a);
if(!x) return gzero;
y[0]=INT_FLAG+3;
if(x>0) {y[1]=0x1000003;y[2]=x;}
else{y[1]=0xff000003;y[2]= -x;}
return y;
@s]
****Change:(orig (950 950 a))
@s[}
@s|}
@s]
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.