HugeUtil(大数)支持单元

unit HugeUtil;

interface

const HugeMax = $8000-16;

type Huge = record
len : word;
dat : array[1..HugeMax] of word;
end;
HugePtr = ^Huge;

procedure AddHuge (var Answer, Add : Huge);
procedure MulHuge (var A : Huge; Mul : integer; var Answer : Huge);
procedure DivHuge (var A : Huge; Del : integer; var Answer : Huge;
var Remainder : integer);
procedure SubHuge (var Answer, Sub : Huge);
procedure ZeroHuge (var L : Huge; Size : word);
procedure CopyHuge (var Fra,Til : Huge);
procedure GetHuge (var P : HugePtr; Size : word);
procedure WriteHuge(var L : Huge; Size: word);

implementation

procedure AddHuge; assembler; asm
cld
push ds
lds di,Answer
les si,Add
seges lodsw
mov cx,ax
clc
@l1:
seges lodsw
adc [si-2],ax
loop @l1
jnb @done
@l2:
add word [si],1
inc si
inc si
jc @l2
@done:
mov si,di
lodsw
shl ax,1
add si,ax
lodsw
or ax,ax
je @d2
inc word [di]
@d2:
pop ds
end;

procedure MulHuge; assembler; asm
cld
push ds
lds si,A
mov bx,Mul
les di,Answer
mov cx,[si]
mov dx,si
inc di
inc di
clc
@l1:
mov ax,[di]
pushf
mul bx
popf
adc ax,si
stosw
mov si,dx
loop @l1
adc si,0
mov es:[di],si
lds di,A
mov di,[di]
mov ax,[di+2]
or ax,ax
je @l2
inc di
inc di
@l2:
lds si,Answer
mov [si],di
pop ds
end;

procedure DivHuge; assembler; asm
std
push ds
lds si,A
mov bx,Del
les di,Answer
mov cx,[si]
mov di,cx
add di,cx
xor dx,dx
@l1:
mov ax,[di]
div bx
stosw
loop @l1
lds si,Remainder
mov [si],dx
lds si,A
mov ax,[si]
lds di,Answer
mov [di],ax
mov si,[di]
shl si,1
@d3:
lodsw
or ax,ax
jne @d2
dec word [di]
jne @d3
inc word [di]
@d2:
pop ds
end;

procedure SubHuge; assembler; asm
cld
push ds
lds di,Answer
les si,Sub
seges lodsw
mov cx,ax
clc
@l1:
seges lodsw
sbb [si-2],ax
loop @l1
jnb @done
@l2:
sub word [si],1
inc si
inc si
jc @l2
@done:
mov si,[di]
shl si,1
std
@d3:
lodsw
or ax,ax
jne @d2
dec word [di]
jne @d3
inc word [di]
@d2:
pop ds
end;

procedure WriteHuge;
var L1, L2, I, R, R1, X : integer;
begin
with L do begin
L1 := Len;
L2 := L1 - 1;
I := 1;
write(dat[L1],'.');
X := 0;
for I := 1 to Size div 4 do begin
Dat[L1] := 0;
Len := L2;
MulHuge(L,10000,L);
R := dat[L1];
R1 := R div 100;
R := R mod 100;
write(chr(R1 div 10+48), chr(R1 mod 10+48),
chr(R div 10+48), chr(R mod 10+48));
inc(X);
write(' ');
if X > 14 then begin
writeln; write(' ');
X := 0
end
end
end;
writeln
end; { WriteHuge }

procedure ZeroHuge;
begin
fillchar(L.Dat, Size * 2, #0);
L.Len := Size
end;

procedure CopyHuge;
begin
move(Fra, Til, Fra.Len * 2 + 2)
end;

procedure GetHuge;
var D : ^byte;
Tries,
Bytes : word;
begin
Bytes := 2 * (Size + 1);
Tries:=0;
repeat
getmem(P,Bytes);

{ To make it possible to use maximally large arrays, and to increase
the speed of the computations, all records of type Huge MUST start
at a segment boundary! }

if ofs(P^) = 0 then begin
ZeroHuge(P^,Size);
exit
end;
inc(Tries);
freemem(P,Bytes);
new(D)
until Tries>10; { if not done yet, it's not likely we ever will be }
writeln('Couldn''t get memory for array');
halt(1)
end; { GetHuge }

end.