This is cmac.c in view mode; [Download] [Up]
#ifndef FIRSTWORD
#include "include.h"
#endif
#include "mp.h"
#include "arith.h"
#include "num_include.h"
/* I believe the instructions used here are ok for 68010.. */
#ifdef MC68K
#define MC68020
#endif
object fixnum_times();
/*
#define MASK 0x7fffffff
object number_times();
object fixnum_times();
object cmod();
object shift_integer();
object bignum2();
object make_si_special();
object make_si_function();
*/
static
object *modulus;
#define FIXNUMP(x) (type_of(x)==t_fixnum)
/* Note: the modulus is guaranteed > 0 */
#define FIX_MOD(X,MOD) {register int MOD_2; \
if (X > (MOD_2=(MOD >>1))) X=X-MOD; else \
if (X < -MOD_2) X=X+MOD;}
#define MYmake_fixnum(doto,x) \
{register int CMPt1; \
doto \
((((CMPt1=(x))+1024)&-2048)==0?small_fixnum(CMPt1):make_fixnum(CMPt1));}
void siLcmod();
void siLcplus();
void siLctimes();
void siLcdifference();
object ctimes(),cplus(),cdifference(),cmod();
init_cmac()
{
/* add_symbol("ctimes",&ctimes,"cplus",&cplus,"cdifference",&cdifference,"cmod",
&cmod, 0); */
modulus = (&((make_si_special("MODULUS",Cnil))->s.s_dbind));
make_si_function("CMOD",siLcmod);
make_si_function("CPLUS",siLcplus);
make_si_function("CTIMES",siLctimes);
make_si_function("CDIFFERENCE",siLcdifference);
}
/* if hi < 0 this is taken to be the two's complement expression of
a bignum */
object
signed_bignum2(hi,lo)
int hi,lo;
{
GEN w;
object result;
long u[4];
u[0] = 0x01010004;
u[1] = 0x01010004;
u[2] = 0;
u[3] = 0;
if (hi < 0)
{ setsigne(u,-1);
if (lo > 0) /* no borrow */
{ lo = -lo;
hi = -hi;}
else {hi -= 1;
hi = -hi;}
}
else
if (hi > 0)
{setsigne(u,1);
}
else /*hi==0 */
{ setsigne(u,1);
setlgef(u,3);
MP_LOW(u,3) = lo;
result = make_integer(u);
setlgef(u,4);
return result;}
/* its length 4 */
MP_START_LOW(w,u,4);
MP_NEXT_UP(w) = lo;
MP_NEXT_UP(w) = hi;
return(make_integer(u));
}
#ifdef MC68020
int
dblrem(m,n,mod)
int m,n,mod;
{ asm("movl a6@(8),d1");
asm("mulsl a6@(12),d0:d1");
asm("divsl a6@(16),d0:d1");
}
/* like fixnum_times multiply to ints to get a t_fixnum or t_bignum ,
but utilize the ordinary mulsl for the common small case
The uncommon larger case could be handled here to but probably not worth it.
*/
object
ftimes(m,n)
int m,n;
{register object res;
asm("movl a6@(8),d0");
asm("mulsl a6@(12),d0");
asm("bvs ftimes_overflow");
asm("movl d0,a6@(8)");
MYmake_fixnum(res=,*&m);
asm("bra ftimes_end");
asm("ftimes_overflow:");
res=fixnum_times(m,n);
asm("ftimes_end:");
return res;}
/* add two fixnums: First add m and n, then if there is an overflow condition
branch to construct bignum. Otherwise set res = the result,
and then act on it. The use of *&m is to inhibit compilers from making
the arg m a register, so that we would not know where it was. */
object
fplus(m,n)
int m,n;
{object res;
asm("movl a6@(0x8),d0");
asm("addl a6@(0xc),d0");
asm("bvs fplus_overflow_case");
asm("movl d0,a6@(0x8)");
asm("jra fplus_rest");
asm ("fplus_overflow_case:");
asm("movl d0,a6@(0x8)");
res=signed_bignum2(n,m);
asm ("jra fplus_end");
asm("fplus_rest:");
MYmake_fixnum(res=,*&m);
asm("fplus_end:");
return res;
}
/* subtract two fixnums:
First m - n, then if there is an overflow condition
branch to construct bignum. Otherwise set res = the result,
and then act on it. The use of *&m is to inhibit compilers from making
the arg m a register, so that we would not know where it was. */
object
fminus(m,n)
int m,n;
{object res;
asm("movl a6@(0x8),d0");
asm("subl a6@(0xc),d0");
asm("bvs fminus_overflow_case");
asm("movl d0,a6@(0x8)");
asm("jra fminus_rest");
asm ("fminus_overflow_case:");
asm("movl d0,a6@(0x8)");
res=signed_bignum2(n,m);
asm ("jra fminus_end");
asm("fminus_rest:");
MYmake_fixnum(res=,*&m);
asm("fminus_end:");
return res;
}
#define our_minus(a,b) ((FIXNUMP(a)&&FIXNUMP(b))?fminus(fix(a),fix(b)): \
number_minus(a,b))
#define our_plus(a,b) ((FIXNUMP(a)&&FIXNUMP(b))?fplus(fix(a),fix(b)): \
number_plus(a,b))
#define our_times(a,b) ((FIXNUMP(a)&&FIXNUMP(b))?ftimes(fix(a),fix(b)): \
number_times(a,b))
#else
/* other cpu's should get optimization here
Also I have not fully tested the code in the non 68k case.
*/
#define our_minus(a,b) number_minus(a,b)
#define our_plus(a,b) number_plus(a,b)
#define our_times(a,b) number_times(a,b)
int
dblrem(a,b,mod)
int a,b,mod;
{int h,l,sign;
if (a<0)
{a= -a; sign= (b<0)? (b= -b,1) :-1;}
else { sign= (b<0) ? (b= -b,-1) : 1;}
l = mulul(a,b,h);
b = divul(l,mod,h);
/* extended_mul(a,b,0,&h,&l);
extended_div(mod,h,l,&a,&b);
*/
return ((sign<0) ? -h :h);}
#endif
object
cmod(x)
object x;
{register object mod = *modulus;
if (mod==Cnil) return(x);
else
if((type_of(mod)==t_fixnum && type_of(x)==t_fixnum))
{register int xx,mm;
mm=fix(mod);
if (mm==2) {xx= (fix(x) & 1); return(small_fixnum(xx));}
xx=(fix(x)%mm);
FIX_MOD(xx,mm);
MYmake_fixnum(return,xx);
}
else
{object qp,rp,mod2;
int compare;
integer_quotient_remainder_1(x,mod,&qp,&rp);
mod2=shift_integer(mod,-1);
compare = number_compare(rp,small_fixnum(0));
if (compare >= 0)
{compare=number_compare(rp,mod2);
if (compare > 0) rp=number_minus(rp,mod);}
else
if (number_compare(number_negate(mod2), rp) > 0)
{rp = number_plus(rp,mod);}
return rp;}}
object
ctimes(a,b)
object a,b;
{object mod = *modulus;
if (FIXNUMP(mod))
{register int res, m ;
res=dblrem(fix(a),fix(b),m=fix(mod));
FIX_MOD(res,m);
MYmake_fixnum(return,res);}
else if (mod==Cnil)
{ return(our_times(a,b));}
return cmod(number_times(a,b));}
object
cdifference(a,b)
object a,b;
{object mod = *modulus;
if (FIXNUMP(mod))
{register int res,m;
res=((fix(a)-fix(b))%(m=fix(mod)));
FIX_MOD(res,m);
MYmake_fixnum(return,res);}
else if (mod==Cnil)
return (our_minus(a,b));
else return(cmod(number_minus(a,b)));}
object
cplus(a,b)
object a,b;
{object mod = *modulus;
if (FIXNUMP(mod))
{register int res,m;
res=((fix(a)+fix(b))%(m=fix(mod)));
FIX_MOD(res,m);
MYmake_fixnum(return,res);}
else
if (mod==Cnil)
return (our_plus(a,b));
else
return(cmod(number_plus(a,b)));}
void
siLcmod()
{check_arg(1);
vs_base[0]=cmod(vs_base[0]);
}
void
siLcplus()
{register object *base;
base=vs_base;
check_arg(2);
base[0]=cplus(base[0],base[1]);
vs_top=base+1;
}
void
siLctimes()
{register object *base;
base=vs_base;
check_arg(2);
base[0]=ctimes(base[0],base[1]);
vs_top=base+1;
}
void
siLcdifference()
{register object *base;
base=vs_base;
check_arg(2);
base[0]=cdifference(base[0],base[1]);
vs_top=base+1;
}
object
memq(a,b)
register object a,b;
{while (1)
{if ((a==b->c.c_car)||b==Cnil) return b;
b=b->c.c_cdr;}}
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.