p!.pas

一个计算圆周率的自编程序（带原码）。可以计算40000位以内的圆周率。经过充分优化

program TEST98;
{$M 2000,0,2000}
{$R-,S-,N+,E+}
uses crt;
var
	I,j,Iz:word;
	T0,T1:LongInt;
	A,B:array[0..10000] of Integer;
	Oa,Ob:word;
	L,N:Word;
	G:Integer;
	T,H,Tt,X:Word;
	Q:Boolean;
	F:Text;
	St:String[8];
	Ch:Char;
	Time:LongInt absolute $40:$6c;

label
	Start;

procedure SubPro;
	label
		LL1,LL2,LL3,LL4,LL5,LL6,Done;
	begin
		q:=False;
		B[0]:=1; for i:=1 to N do B[i]:=0;
		TT:=T*T; H:=T; X:=1;
		Iz:=0;
		T1:=Time;
		repeat
			while (b[Iz]=0) and (Iz<=N) do inc(Iz);
			if Iz>N then goto Done;
			Oa:=ofs(a[Iz]); Ob:=ofs(b[Iz]);
			L:=N+1-Iz;

			asm
				Push Bp
				mov bx,10000
				Mov Bp,1

				mov si,Ob; mov cx,L
				mov dx,0
			LL1:
				mov ax,dx; mul bx; add ax,[si]; adc dx,0
				div H
				mov [si],ax; inc si; inc	si;
				loop ll1

				mov si,Ob; mov di,Oa; mov cx,L
				mov	dx,0
				CMP G,0; Jl  LL2

			LL3:    {G>0}
				mov ax,dx; mul bx; add ax,[si]; adc dx,0
				div X
				add	ax,[di]; cmp ax,bx; jl LL4  { signed integer }
				add [di-2],bp; sub ax,bx
            LL4:
				mov	[di],ax
				inc	si;	inc	si;	inc di;	inc di
				loop ll3
				Jmp LL5

			LL2:    {G<0}
				mov ax,dx; mul bx; add ax,[si]; adc dx,0
				div X
				neg ax;	add	ax,[di]; jns LL6
				sub [di-2],bp; add ax,bx
			LL6:
				mov	[di],ax
				inc	si;	inc	si;	inc di;	inc di
				loop ll2

			ll5:
				pop	bp
			end;

			H:=TT; Inc(X); Inc(x); G:=-G;
			if Time-T1>9 then
			begin
				gotoxy(5,whereY);
				Write('Accu:',Iz shl 2:5,' Item:',X div 2:5, ' Time:',(Time-T0)*0.05494:8:2);
				t1:=Time;
				if keypressed then if readkey=#27 then begin Q:=True; exit; end;
			end;
		Until False;
Done:
		dec(x,2); Dec(Iz);
		gotoxy(5,whereY);
		Writeln('Accu:',Iz shl 2:5,' Item:',(X+1) div 2:5, ' Time:',(Time-T0)*0.05494:8:2);
		L:=0;
		for i:=N downto 1 do
		begin
			if A[i]<0 then begin dec(a[i-1]); inc(a[i],10000); end;
			H:=word(a[i])*4+L;
			L:=H div 10000;
			a[i]:=H-L*10000;
		end;
		a[0]:=L;
	end;



begin
start:
	Clrscr;
	repeat
		TextColor(3);
		repeat
			Write('N [4..40000]='); readln(n);
			IF n<4 THEN Exit;
		UNTIL n<=40000;
		N:=(N+3) div 4;
		clrscr;
		Gotoxy(1,2);
		Writeln('Pi=',Pi:20:18);

		TextCOlor(2); Writeln('   Press <Esc> to abort!');
		T0:=Time;
		TextCOlor(10);

		FOR i:=0 TO N do A[i]:=0;

		T:=5; 	g:= 1; SubPro;	if Q then goto Start;
		T:=239; g:=-1; SubPro;	if Q then goto Start;

		TextCOlor(7);
		Writeln('Time passed: ',(Time-T0)*0.05494:8:2, ' Secs');

		Writeln('Saving result to Pi.LST ...');
		assign(F,'Pi.lst');
		rewrite(F);
		Write(F,'pi= ',a[0],'.');
		j:=(25-(N MOD 25))*4; if j=100 then j:=0;
		if j<6 then writeln(f) else j:=j-6;
		if j>0 then Write(F,' ':J);
		FOR i:=1 TO N do
		begin
			Str(A[i],St);
			St:=copy('0000',1,4-Length(St))+St;
			Write(F,st);
			if (n-i) mod 25=0 then writeln(f);
		End;
		writeln(f);
		close (F);

		Write('pi= ',a[0],'.');
		j:=(20-(N MOD 20))*4+1; if j=81 then j:=1;
		if j<7 then writeln;
		Gotoxy(J, wherey);

		FOR i:=1 TO N do
		begin
			Str(A[i],St);
			St:=copy('0000',1,4-Length(St))+St;
			Write(st);
			IF wherey=22 THEN
			begin
				Repeat UNTIL Keypressed;
				if readkey=#0 then Ch:=readkey;
				clrscr;
			end;
		End;
		writeln;
	until false;
END.