Artifact bcca00578484d127278cca3a944a56d402ecb5c5e0a18eeecc2aa8c224d3213c:

• File psl-1983/3-1/tests/nbtest.red — part of check-in [eb17ceb7f6] at 2020-04-21 19:40:01 on branch master — Add Reduce 3.0 to the historical section of the archive, and some more
  files relating to version sof PSL from the early 1980s. Thanks are due to
  Paul McJones and Nelson Beebe for these, as well as to all the original
  authors.

  git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 1529) [annotate] [blame] [check-ins using] [more...]

% NBTEST.RED - Test Bignum Numeric transition points
% 	       And other numeric tests
% M. L. Griss, 6 Feb 1983

procedure fact N;
 Begin scalar m;
	m:=1;
	while n>0 do <<m:=m*n; n:=n-1>>;
	return m;
 End;

on syslisp;

syslsp procedure Ifact N;
 Begin scalar m;
	m:=1;
	while n>0 do <<m:=m*n; n:=n-1>>;
	return m;
 End;

syslsp procedure ftest(n,m);
 for i:=1:n do fact m;

syslsp procedure Iftest(n,m);
 for i:=1:n do ifact m;

off syslisp;

procedure Ntest0;
  Begin scalar n;
	N:=36;
	pos:=mkvect n; 
	neg:=mkvect n;
        pos[0]:=1; neg[0]:=-1;
        for i:=1:N do <<pos[i]:=2*pos[i-1];
                         neg[i]:=(-pos[i])>>;
end;

procedure show0 n;
<<show(n,pos,'ntype0);
  show(n,neg,'ntype0)>>;

procedure Ntest1;
  Begin scalar n;
	N:=40;
	newpos:=mkvect n; 
	newneg:=mkvect n;
        newpos[0]:=1; newneg[0]:=-1;
        for i:=1:n do <<newpos[i]:=2*newpos[i-1];
                        newneg[i]:=(-newpos[i])>>;
end;

procedure show1 n;
<<show(n,newpos,'ntype1);
  show(n,newneg,'ntype1)>>;

on syslisp;

procedure NType0 x;
 case tag x of
	posint: 'POSINT;
	negint: 'negint;
	fixn: 'FIXN;
	bign: 'BIGN;
	fltn: 'fltn;
	default: 'NIL;
 end;

procedure NType1 x;
 if Betap x and x>=0 then 'POSBETA
  else if Betap x and x<0 then 'NEGBETA
  else  case tag x of
	posint: 'POSINT;
	negint: 'negint;
	fixn: 'FIXN;
	bign: 'BIGN;
	fltn: 'fltn;
	default: 'NIL;
 end;

off syslisp;

procedure show(N,v,pred);
 for i:=0:N do
   printf("%p%t%p%t%p%t%p%n",i,5,apply(pred,list(v[i])),20,v[i],40,float v[i]);

end;