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.