Power-Programmierung/CD1.mdf/pascal/library/dos/math/verylarg/vlncls.pas

Pascal/Delphi Source File | 1993-10-22 | 27.6 KB | 1,102 lines

unit vlncls;     { a class of Very Large Number }

{))))))))))))))))))))))))))))))))))))))}
{}          interface                 {}
{))))))))))))))))))))))))))))))))))))))}


uses  Dos, CRT;

const
   vlSize = 1000;     {essentially no limit }
{ the real working limit is wksize set in Unit Initialization }
   vlmemsize = vlsize*4+4;
type
   pWordArray = ^tWordArray;
   tWordArray = array[1..vlSize] of word;

type pchar4 = array[0..4]of char;

type
  pVryLrgNo = ^tVryLrgNo;
  tVryLrgNo = object
    count : integer;
    max : integer;
    sign : integer;
    tVLN : tWordArray;
    constructor Init( cnt, maxC, sgn : integer; pnew :pWordArray);
{    procedure store( var S : tStream);
    constructor load( var S : tStream);
 }
    procedure SetVal( cnt, sgn : integer; pnew :pWordArray);
    procedure SetSmall(n:integer); { set immediate to 16 bits, signed }
    procedure Clear( n : integer);

    procedure WriteHex;
    procedure WriteDecimal ( mode : integer);

    procedure AddBy(other : pVryLrgNo);
    procedure AddN(n:integer);
    procedure SubBy(other : pVryLrgNo);
    procedure SubN(n:integer);
    procedure TwosComplAbs( cnt : integer );
    procedure Copy( other : pVryLrgNo );   { copy other into self }
    procedure Recount;
    procedure MulBy(other : pVryLrgNo);
    procedure MulN(n:integer);
    procedure DivN(n:integer);
    function  FindnoBinDig : integer;        { how many binary digits }
    procedure BigSHL(cnt  : integer);         {shift left by words }
    procedure MultiSHL(sf_cnt : integer);         {shift left by words }
    procedure Shr1Bit;         {shift right one bit}
    procedure ShL1Bit;         {shift left one bit}
    function  FindDivShift(other : pVryLrgNo) : integer;
                                   {shift in prep for dividing}
    procedure DivBy( dvsr, remnd : pVryLrgNo);
    procedure GetRandom(binCnt  : integer);
    procedure TwoNth(n:integer );
    procedure TenNth(n:integer );
    procedure NthRoot(n:integer );
    procedure NthPower(n:integer );
                                { a random number with n bits }
    end;


{const
  rVryLrgNo: TStreamRec = (
    ObjType: 193;
    VmtLink: Ofs(TypeOf(tVryLrgNo)^);
    Load: @tVryLrgNo.Load;
    Store: @tVryLrgNo.Store);
}

  function MaxOfW(a,b : word) : word;
  function IsGrEqAbs(n1, n2  : pVryLrgNo): boolean;  { true if n1>= n2 }
  function IsEqAbs(n1, n2  : pVryLrgNo): boolean;
      { true if n1= n2 }
  procedure HexWord( w : word; var pS : pchar4);
  procedure SetWkSize(n:integer);
  function  GetWkSize : integer;
  procedure CloseTempRegs;
  procedure OpenTempRegs;
  procedure CallError(s:String);

  var
      dec_10e9 ,       { divisor for Decimal printout}
      decPointShift    {offset for fraction printout }
                   : pVryLrgNo;

{))))))))))))))))))))))))))))))))))))))}
{}           implementation           {}
{))))))))))))))))))))))))))))))))))))))}

  var
   VLNtemp1,     { used in NthRoot,DivN, NthPower }
   VLNtemp2,     { used in NthRoot, writeFraction [divby]}
   VLNtemp3,     { used in NthRoot, writeFraction [divby]}
   VLNoprnd ,    { used in MulN, DivN, AddN, SubN, NthRoot}
   quotn,        { used in Divby }
   tmpDvsr,      { used in DivBy}
   remd,         { used in DivBy}
   accumReg,     { used in MulBy }
   carryReg      { used in MulBy }
            : pVryLrgNo;

   wksize : integer;

      { storage for temporary variable }

{)))))))))))))))))))))}
{}  function MaxOfW  {} (a,b : word) : word;
{)))))))))))))))))))))}
  begin
    if a>b then MaxOfW := a else MaxOfW  := b;
  end;



{))))))))))))))))))))))))))))))))))))}
{}  procedure tVryLrgNo.GetRandom   {} (binCnt  : integer);
{))))))))))))))))))))))))))))))))))))}
var
   bitsRemain, i     : integer;
begin
   bitsRemain := binCnt mod 16 ;   {0 to 15}
   Count :=  (binCnt) div 16 ;   {16 bits per word }
   if max<count then
      begin
       callError('Random too big error');
       exit;
      end;
   sign := 1; {positive}
   for i := Count+1 downto 1 do
      tVLN[i] := random(32768) shl 1 + random(2);

   if bitsRemain>0 then      { value is 0 to 15}
     begin
       inc(Count);
       for i := 15 downto bitsRemain do   {reduce MS Byte}
          tVLN[Count] := tVLN[Count] shr 1;
     end;
   if tVLN[Count]=0 then dec(count);
end;


{)))))))))))))))))))))))))))))))))))))}
{}   procedure tVryLrgNo.Recount;    {}
{)))))))))))))))))))))))))))))))))))))}
{test if fewer words are needed }
var i : integer;
begin
   i := count;
   while i > 0 do begin
      if tVLN[i] = 0 then
          dec(count)
      else break;
      dec(i);
      end;
end;

{))))))))))))))))))))))))))))))))}
{}  procedure tVryLrgNo.BigSHL  {}(cnt  : integer);
{))))))))))))))))))))))))))))))))}
  var i: integer;
  begin
  if cnt+count>max then
    begin
    writeln('Shift Left too far, beyond max word size.');
    exit;
    end;
  for i := count  downto 1 do
     tVLN[i+cnt]:= tVLN[i];
  for i := 1 to cnt do
     tVLN[i] := 0;
  count := count + cnt;
  end;

{))))))))))))))))))))))))))))))))))}
{}  procedure tVryLrgNo.MultiSHL  {}(sf_cnt : integer);
{))))))))))))))))))))))))))))))))))} {shift data left n bits}
  var
    i, BigCnt  : integer;
    new,
    wLeft, wRight : word;
  begin
   if (count = 0) or (sf_cnt=0) then exit;
   BigCnt := sf_cnt shr 4;
   sf_cnt := sf_cnt and $F;
   new := 0;

   for i := count downto 1 do
     begin
      wLeft  := (tVLN[i] shl sf_cnt) ;
      wRight :=  tVLN[i] shr (16-sf_cnt);
      tVLN[i+1] := new or wRight;   { combine them  }
      new := wLeft;
     end;
   inc(count); Recount;

   if max<count then
      begin
       callError('shl too big error');
       exit;
      end;

    tVLN[1]:= new;    {lowest term }

   if BigCnt>0 then
     BigShl(BigCnt);

   end;
{)))))))))))))))))))))))))))))))))))))}
{}   procedure  tVryLrgNo.Shr1Bit;   {}
{)))))))))))))))))))))))))))))))))))))}
 var i : integer;
 begin
 if count=0 then exit;  {not an error }
   for i := 1 to count-1 do
     begin
      tVLN[i] := tVLN[i] shr 1;
      if odd(tVLN[i+1]) then inc(tVLN[i],$8000);
     end;
   tVLN[count] := tVLN[count] shr 1;
 end;

{)))))))))))))))))))))))))))))))))))))}
{}   procedure  tVryLrgNo.ShL1Bit;   {}
{)))))))))))))))))))))))))))))))))))))}
 var i : integer;
     tmp : boolean;
 begin
   tmp := (tVLN[count] and $8000 <> 0);

   for i :=  count downto 1 do
     begin
      if (tVLN[i] and $8000 <> 0) then
         inc(tVLN[i+1]);
      tVLN[i] := tVLN[i] shl 1;
     end;
       if tmp then
        begin
         inc(count);
         tVLN[count]:= 1;
        end;
   if max<count then
      begin
       callError('shl too big error');
       exit;
      end;
 end;

{)))))))))))))))))))))))))))))))))))))}
{}  function tVryLrgNo.FindDivShift  {} (other : pVryLrgNo) : integer;
{)))))))))))))))))))))))))))))))))))))}
  var
    n : integer;
    wo, ws : longint;
  begin
   {compare MS Word of each }
   {Shl til bigger then shr til smaller}
   wo := other^.tVLN[other^.count];
   ws := tVLN[count];
   n := 0;

   while (wo>ws) do  { avoid overflow }
     begin
      ws := ws shl 1;
      inc(n);
     end;

   while wo<=ws do        {make ws slightly smaller }
     begin
      ws := ws shr 1;
      dec(n);
     end;
   FindDivShift := n+1;
 end;


{))))))))))))))))))))))))))))))))))))}
{}  function tVryLrgNo.FindnoBinDig {}   : integer;
{))))))))))))))))))))))))))))))))))))}
                             { how many binary digits }
var
  tmpc : integer;
  tmpw : word;
begin
  Recount;  { possibly remove zero words from the top }
  tmpw := tVLN[count];
  tmpc := 0;
  while tmpw > 0 do
    begin
    tmpw := tmpw shr 1;
    inc(tmpc);
    end;
  FindnoBinDig := tmpc + (count-1) * 16;
end;

{)))))))))))))))))))))))))))))))))}
{}  procedure tVryLrgNo.Copy     {} ( other : pVryLrgNo );
{)))))))))))))))))))))))))))))))))}

 { copy other into self       }

 var i : integer;
  begin
    if max<other^.count then
      begin
       callError('copy too big error');
       exit;
      end;
    count := other^.count;
    sign  := other^.sign;
    for i := 1 to count do
       tVLN[i] := other^.tVLN[i];

  end;

 {))))))))))))))))))))))))))))))))))))))}
 {}  procedure tVryLrgNo.TwosComplAbs  {}( cnt : integer );
 {))))))))))))))))))))))))))))))))))))))}
 var
    StillZero : boolean;
    i : integer;
 begin
   StillZero := true;
   for i := 1 to cnt do
     if StillZero then
       begin
        if tVLN[i] <>  0 then begin
           tVLN[i] := - tVLN[i];
           StillZero := false;
           end;
       end
       else tVLN[i] := (- tVLN[i] -1);
 end;

{))))))))))))))))))))))))))))))}
{} procedure tVryLrgNo.SetVal {}  ( cnt, sgn : integer;
{))))))))))))))))))))))))))))))}   pnew     : pWordArray);
var
    i : integer;
Begin
   if cnt >0 then
     for i := 1 to cnt do
       tVLN[i] := pnew^[i] ;
   count := cnt;
   sign := sgn;
end;

{)))))))))))))))))))))))))))))))))}
{}   procedure tVryLrgNo.Clear   {}  ( n : integer);
{)))))))))))))))))))))))))))))))))}
var i : integer;
begin
   if max<n then
      begin
       callError('Clear too big error');
       exit;
      end;
   count := 0;
   sign := 1;
   for i := 1 to n do
      tvln[i] := 0;

end;

{))))))))))))))))))))))))))))))}
{} constructor tVryLrgNo.Init {} ( cnt, maxC, sgn :integer;
{))))))))))))))))))))))))))))))}    pnew :pWordArray);

 begin
   max := maxC;
   SetVal( cnt, sgn, pnew );
   end;



{))))))))))))))))))))))))))}
{}   procedure  HexWord   {} ( w : word; var pS : pchar4);
{))))))))))))))))))))))))))}

 const hexlist : array[0..15] of char =
    '0123456789ABCDEF';

 var
   i : integer;
 begin
   for i := 3 downto 0 do begin
     ps[i] := hexlist[w and $F];
     w := w shr 4;
     end;
   ps[4] := #0;
 end;



{))))))))))))))))))))))))))))))))))}
{}  procedure tVryLrgNo.WriteHex; {}
{))))))))))))))))))))))))))))))))))}
 var i : integer;
     pn : pchar4;
 begin
   if sign>0 then write('[+] ') else write('[-] ');
   if count=0 then
     write('--0--')
   else
     for i := count downto 1 do begin
        HexWord( tVLN[i] , pn );
        if i mod 12 = 0 then
          Writeln(pn+' ')
        else
          Write(pn+' ');
        end;
 end;



 {))))))))))))))))))))))))))))))))))))))}
 {}  procedure tVryLrgNo.WriteDecimal  {} ( mode : integer);
 {))))))))))))))))))))))))))))))))))))))}

 { mode = 0 , normal = MSB first }
 { mode = 1 ,          LSB first }
 { mode = 2 , just top two terms }

 var
    tmp : pVryLrgNo;
    tempLI : longint;
    saveBillions : array[1..100{vlsize}] of longint;
    inx, i : integer;
 begin
 tmp := accumReg ; { an unused scratch register }
 inx := 1;
 tmp^.copy(@self);
 write('VLN= ');
 if tmp^.count=0 then
    begin
     write('  -000- ');
     exit;
    end;
 while (tmp^.Count > 0) do
    begin
      tmp^.DivBy(dec_10e9, remd );     { divide by 10 exp 9 }
      case remd^.count of
        2: begin
            tempLI := remd^.tvln[2];
            tempLI := tempLI shl 16 + remd^.tvln[1];
           end;
        1:  tempLI := remd^.tvln[1];
        0:  tempLI := 0;
      end;
      case mode of
         0:   begin
                 saveBillions[inx] := tempLI ;
                 write('+');
              end;
         1:    begin
                  write(templi,'[',inx*9-9,']  ');
                  if (inx mod 4=0) then
                     begin
                      writeln;
                      write(' --- ');
                     end;
                 end;
         2:   begin
                write('+');
                if (tmp^.Count <3)
                   then
                       write(templi,'[',inx*9-9,']  ');
              end;
         end;
      inc(inx);
    end;
    if mode=0 then
       for i := inx-1 downto 1 do
          begin
            if (i mod 4=(inx-1) mod 4) then
               begin
                writeln;
                write(' --- ');
               end;
             write(saveBillions[i],'[',i*9-9,']  ');
          end;


 end;


 {)))))))))))))))))))))))))}
 {}    function IsEqAbs   {}(n1, n2  : pVryLrgNo): boolean;
 {)))))))))))))))))))))))))}
  var
    i , j , k : integer;
    IGA : boolean;
  begin
    IsEqAbs := true;    {assume true}
    n1^.Recount; n2^.Recount;
    if n1^.count <> n2^.count then
      begin
        IsEqAbs := false;
        exit;
      end;
    for i := n1^.count downto 1 do;
       if n1^.tVLN[i] <> n2^.tVLN[i] then
          begin
            IsEqAbs := false;
            exit;
          end;
  end;

 {)))))))))))))))))))))))))))}
 {}    function IsGrEqAbs   {}(n1, n2  : pVryLrgNo): boolean;
 {)))))))))))))))))))))))))))}

  { is n1 >= n2 ,ignore sign, assume both positive}
  var
    k : integer;
    IGA : boolean;
  begin
    n1^.Recount; n2^.Recount;
    IsGrEqAbs := not (n1^.count < n2^.count);  { first apprx. }

    if n1^.count = n2^.count  then    {almost the same }
          { same number of terms}
        for k := n1^.count  downto 1 do
           begin
            if (n1^.tVLN[k] < n2^.tVLN[k]) then
               begin
                IsGrEqAbs := false;
                break;
               end;
            if (n1^.tVLN[k] > n2^.tVLN[k]) then
               break;
           end;
  end;

 {)))))))))))))))))))))))))))))))}
 {}   procedure AddWordArrays   {}( t1, t2 : pWordArray;
 {)))))))))))))))))))))))))))))))}
                 var c1, c2 : integer);  { t2 + t1 --> t2 }
                 {input word arrays and counts }
 var
    i , carry, realcount,
    msbs_pre : integer;
begin
   carry := 0;
   realcount := MaxOfW(c1,c2);

   for i := c1 +1 to realcount do
       t1^[i] := 0;  {we want to add all terms, clear higher }
   for i := c2 +1 to realcount do
       t2^[i] := 0;


   if c1 > 0 then   { at least adder > 0 }
         for i := 1 to realcount do begin
           msbs_pre := (t1^[i] and $8000 ) shr 1
               + (t2^[i] and $8000 );
           t2^[i] := t2^[i] + t1^[i] + carry;

         case msbs_pre shr 1 of
             $6000 : carry := 1;
             0     : carry := 0;
             else if (t2^[i] and $8000 = 0) then
                 carry := 1
                 else carry := 0;
             end;
         end;
  c2 := realcount;
  if carry<>0 then begin {after all ordinary terms added}
    i := realcount +1;
    t2^[i] := 1;
    c2 := i;
    end;
 end;




{(((((((((((((((((((((((((((((((}
{}    procedure AddAbsolute    {}  (n2, n1  : pVryLrgNo);
{(((((((((((((((((((((((((((((((}

    { n1+n2 --> n2}
    {ignore sign, assume both positive}
  var
    i ,ovfl_det,  carry, realcount : integer;
 begin
   carry := 0;
   realcount := MaxOfW(n1^.count,n2^.count);

   for i := n1^.count +1 to realcount do
       n1^.tVLN[i] := 0;  {we want to add all terms }
   for i := n2^.count +1 to realcount do
       n2^.tVLN[i] := 0;


   if n1^.count > 0 then   { at least adder > 0 }
         for i := 1 to realcount do begin
           ovfl_det := (n2^.tVLN[i] and $8000 ) shr 1
                    + (n1^.tVLN[i] and $8000 );
           n2^.tVLN[i] := n2^.tVLN[i] + n1^.tVLN[i] + carry;

           case ovfl_det shr 1 of
              0     : carry := 0;
              $6000 : carry := 1
              else
                if (n2^.tVLN[i] and $8000 = 0) then
                   carry := 1
                else carry := 0;
              end
         end;
  n2^.count := realcount;

  if carry<>0 then begin {after all ordinary terms added}
    i := realcount +1;
    n2^.tVLN[i] := 1;
    n2^.count := i;
    end;

  if n2^.count>n2^.max then
      begin
       callError('Add Abs too big error');
       exit;
      end;
 end;


{(((((((((((((((((((((((((((((((}
{}    procedure SubAbsolute    {}  (n2, n1  : pVryLrgNo);
{(((((((((((((((((((((((((((((((}

    { n2-n1 --> n2}
    {ignore sign, assume both positive, n2>=n1}
    { assume n2 >= n1 >= 0}
  var
    i , borrow, realcount,
     ovfl_det : integer;
 begin
   borrow := 0;
   realcount := MaxOfW(n1^.count,n2^.count);

   for i := n1^.count +1 to realcount do
       n1^.tVLN[i] := 0;  {we want to sub all terms }
   for i := n2^.count +1 to realcount do
       n2^.tVLN[i] := 0;


   if n1^.count > 0 then   { if something in subt' }
         for i := 1 to realcount do begin
           ovfl_det := (n1^.tVLN[i] and $8000 ) shr 1
                    + (n2^.tVLN[i] and $8000 );
           n2^.tVLN[i] := n2^.tVLN[i] - n1^.tVLN[i] - borrow;

           case ovfl_det shr 1 of
              $4000 : borrow := 0;
              $2000 : borrow := 1
              else
                if (n2^.tVLN[i] and $8000 = 0) then
                   borrow := 0
                else borrow := 1;
              end
         end;

   n2^.recount;
   if n2^.count>n2^.max then
      begin
       callError('Sub Abs too big error');
       exit;
      end;

 end;

 {(((((((((((((((((((((((((((((((}
 {}  procedure tVryLrgNo.addBy  {}(other : pVryLrgNo);
 {(((((((((((((((((((((((((((((((}
 var  i : integer;
 begin
   if  ((sign +other^.sign) <> 0) then
     { does second term reinforce first term}
      AddAbsolute( @self, other)  { me := me + other }
   else if IsGrEqAbs(@self, other) then begin
     { does first term dominate }
        SubAbsolute( @self, other);
        Recount;
        end
   else begin
     SubAbsolute( @self, other);
     TwosComplAbs(other^.count);  {how many terms neeeded}
     sign := - sign;
     Recount;
     end;
 end;

 {(((((((((((((((((((((((((((((((}
 {}  procedure tVryLrgNo.subBy  {} (other : pVryLrgNo);
 {(((((((((((((((((((((((((((((((}
 var  i : integer;
 begin
   if  ((sign +other^.sign) = 0) then
     { does second term reinforce first term}
      AddAbsolute( @self, other)  { me := me - other }
   else if IsGrEqAbs(@self, other) then  begin
     { does first term dominate }
       SubAbsolute( @self, other);
       Recount;
       end
   else begin
     SubAbsolute( @self, other);
     TwosComplAbs(other^.count);  {how many terms neeeded}
     sign := - sign;
     Recount;
     end;
 end;


{(((((((((((((((((((((((((((((((}
{}  procedure tVryLrgNo.mulBy  {}(other : pVryLrgNo);
{(((((((((((((((((((((((((((((((}
 var
     long1, long2 : longint;
     tempAccum  : longint;
     i1, i2,
     c0, s0 : integer;
     shifter, ovfl_det : integer;
     answer_sign : integer;

 begin
   answer_sign := sign * other^.sign;
{    sign := 1;
    other^.sign := 1;
 }
   for i1 := 1 to wksize do
     begin
     accumReg^.tVLN[i1] := 0;
     carryReg^.tVLN[i1] := 0;
     end; { clear acumulators}

   if (count + other^.count > max )  then
     begin
     writeln('multiply result - too big error');
     exit;
     end;

   for i1 := 1 to other^.count do
       {this 'other' term by each of the self terms}
       for i2 := 1 to count do begin
          long1 := longint(tVLN[i2]) *
                   longint(other^.tVLN[i1]);

          shifter := i1+i2 ;     { pick destination position }
          tempAccum := accumReg^.tVLN[shifter];

          ovfl_det := ((tempAccum and $8000 ) shr 15)
               + ((long1 shr 16) and $8000 ) shr 14;
          tempAccum := tempAccum shl 16 +
                 accumReg^.tVLN[shifter-1] ;

          inc(tempAccum, long1);    { add in this terms}

          accumReg^.tVLN[shifter-1] :=  tempAccum and $FFFF;
          accumReg^.tVLN[shifter]   :=  (tempAccum shr 16) and $FFFF;

    if (ovfl_det = 3)  or
                 ( (ovfl_det<>0) and
                 (tempAccum and $80000000 = 0))
      then
         inc(carryReg^.tVLN[shifter+1]);

   end;
   count := count + other^.count;
   c0 := count;
   sign := answer_sign;

   AddWordArrays( @carryReg^.tVLN[1],
                  @accumReg^.tVLN[1], c0, count );
   SetVal( count, sign, @accumReg^.tVLN[1]);
             { put answer away }
   Recount;

 end;


{(((((((((((((((((((((((((((((((}
{}  procedure tVryLrgNo.divBy  {} ( dvsr,
{(((((((((((((((((((((((((((((((}   remnd : pVryLrgNo);

  var i,    SAdj,
      BShf, emptyBits,
      sizeOfQ : integer;
      dcnt : integer;
      answer_sign : integer;

 begin
    tmpDvsr^.copy(dvsr);
    answer_sign := sign * dvsr^.sign;
    sign := 1;
    tmpDvsr^.sign := 1;       { work with positive values }

    dcnt := tmpDvsr^.count;
    quotn^.Clear(Count);
    remnd^.clear(Count);
    BShf := count - dcnt;

    if (BShf<0 ) or
         ((BShf=0) and
               (dvsr^.tVLN[dcnt]>=tVLN[dcnt])  ) then
          begin                {divisor >= dividend }
            remnd^.copy(@self);
            remnd^.recount;
            Count := 0;
            exit;
            end;

    SAdj :=  tmpDvsr^.FindDivShift(@self);   {returns -15 to +15}
            {number of bits to shift divisor}
    if SAdj<0 then
      begin
      SAdj := 16 + SAdj;
      dec(BShf);    { dvsr starts  smaller then dividend }
      end;

    tmpDvsr^.BigShl(BShf);    {shift divisor into position}
    tmpDvsr^.MultiSHL(SAdj);

    emptybits := BShf * 16 + SAdj;
        {zeros at bottom of divisor}
    sizeOfQ := 0;
    tmpDvsr^.Recount;

    while emptybits >= 0 do
      begin
       quotn^.ShL1Bit;
       while IsGrEqAbs(@self,tmpDvsr) do
           { make sure that we have to shift}
         begin  {subtract again }
          subBy(tmpDvsr);
          inc(quotn^.tVLN[1],1); {put a bit into the answer }
         end;
       quotn^.count := (sizeOfQ+16) div 16;
       dec(emptybits);
       if emptybits>=0 then
          tmpDvsr^.Shr1Bit;
       tmpDvsr^.Recount;
       inc(sizeOfQ);
      end;

      Recount;
      remnd^.copy(@self);
      quotn^.sign := answer_sign;
      remnd^.sign := answer_sign;
      quotn^.Recount;
      copy(quotn);
end;

{------------------------------------------------------}
{     common  routines, higher than basic service      }
{------------------------------------------------------}


{(((((((((((((((((((((((((((((())((}
{}  procedure tVryLrgNo.SetSmall  {} (n:integer );
{((((((((((((((((((((((((((((((((((}
begin
   count := 1;
   sign := 1;
   if n<0 then begin
     sign := -1;
     n:= -n;
     end;
   tvln[1] := n;
end;

{((((((((((((((((((((((((((((((((}
{}  procedure tVryLrgNo.MulN   {} (n:integer );
{((((((((((((((((((((((((((((((((}

begin
    VLNoprnd^.SetSmall(n);
    MulBy(VLNoprnd);
end;

{((((((((((((((((((((((((((((((((}
{}  procedure tVryLrgNo.AddN    {} (n:integer );
{((((((((((((((((((((((((((((((((}
begin
    VLNoprnd^.SetSmall(n);
    AddBy(VLNoprnd);
end;

{((((((((((((((((((((((((((((((((}
{}  procedure tVryLrgNo.SubN    {} (n:integer );
{((((((((((((((((((((((((((((((((}
begin
    VLNoprnd^.SetSmall(n);
    SubBy(VLNoprnd);
end;

{((((((((((((((((((((((((((((((((}
{}  procedure tVryLrgNo.DivN    {} (n:integer );
{((((((((((((((((((((((((((((((((}
begin
    VLNoprnd^.SetSmall(n);
    DivBy(VLNoprnd, VLNtemp1);
end;


{((((((((((((((((((((((((((((((((}
{}  procedure tVryLrgNo.TwoNth  {} (n:integer );
{((((((((((((((((((((((((((((((((}
var
 i : integer;
begin
 count := n shr 4 +1;
 n := n mod 16;      {up to 15 additional bits}
 if count > max then
    begin
     writeln('Two Big in TwoNth');
     exit;
    end;
  for i := 1 to count-1 do
     tvln[i] := 0;
  tvln[count] := 1 shl n;
  sign := 1;
end;

{((((((((((((((((((((((((((((((((}
{}  procedure tVryLrgNo.TenNth  {} (n:integer );
{((((((((((((((((((((((((((((((((}
var
 i : integer;
begin
  SetSmall(10);  { + 10 }
  if n<= 0 then
     SetSmall(1)
  else
     begin
        if n>1 then  NthPower(n);
     end;
end;

{((((((((((((((((((((((((((((((((((}
{}  procedure tVryLrgNo.NthPower  {}(n:integer );
{((((((((((((((((((((((((((((((((((}
var
 i : integer;
begin
 VLNtemp1^.Copy(@self);
 for i := 1 to n-1 do
   MulBy(VLNtemp1);
end;

{(((((((((((((((((((((((((((((((((}
{}  procedure tVryLrgNo.NthRoot  {} (n:integer );
{(((((((((((((((((((((((((((((((((}

{ Newtons algorithm }
var i,j,loopCount: integer;
                                sg: integer;
begin
 if n<2 then
    begin
     writeln('Illegal Root parameter');
     exit;
    end;
 i := FindnoBinDig;
 i:= i  div n;
 if i=0 then i:= 1;

 VLNtemp1^.TwoNth(i); {establish first guess}
{ write('Orig Guess  ');  VLNtemp1.WriteHex;  writeln;}
 loopCount:= 0;
 repeat
     write('.');
     inc(loopcount);
     VLNtemp2^.Copy(VLNtemp1);   { a copy of the guess }
     VLNtemp2^.NthPower(n);           { Guess^Nth power = close to orig number}
     VLNtemp3^.copy(@self);           { copy of the original }
     VLNtemp3^.SubBy(VLNtemp2);          {Missed by this much}
     sg := VLNtemp3^.sign;

     VLNtemp2^.Copy(VLNtemp1);     {original guess again }
     for j := 1 to n-2 do
         VLNtemp2^.MulBy(VLNtemp1); { becomes guess^(n-1)  }
     VLNtemp2^.MulN(n);             { n times guess}
     VLNtemp3^.DivBy(VLNtemp2, VLNoprnd);     {delta guess}

     VLNtemp2^.Copy(VLNtemp1);     {original guess again }
     VLNtemp2^.ShR1Bit;             { set 1/4 of original guess }
     VLNtemp2^.ShR1Bit;
     if IsGrEqAbs(VLNtemp3 ,VLNtemp2 ) then
         VLNtemp3^.Copy(VLNtemp2)  ;              { limit the delta }

{     write('           Delta= '); VLNtemp3.WriteHex; writeln;}
     VLNtemp1^.AddBy(VLNtemp3);
{     write('Guess= '); VLNtemp1.WriteHex; writeln;}
     VLNtemp2^.Copy(VLNtemp1);

 until ((VLNtemp3^.Count<=1) and
       (VLNtemp3^.tVLN[1]=0)) or (loopcount>=50) ;

 { writeln('loopcount  ',loopcount);}
 Copy(VLNtemp1);               { return answer   }
{ writeln('error sign = ',sg);}
 if sg<0 then subN(1);    {adjust lsb according to just missed trend}
end;

procedure SetWkSize ( n:integer);
begin
   wksize := n;
end;

function GetWkSize : integer;
begin
   GetWkSize := wksize;
end;


procedure CallError(S:String);
begin
  writeln(S);
  halt;
end;

procedure OpenTempRegs;
var memSz : integer;
begin
   memSz := wksize*2+6;
   getmem(VLNtemp1,memsz);
   getmem(VLNtemp2,memsz);
   getmem(VLNtemp3,memsz);
   getmem(VLNoprnd,memsz);
   getmem(quotn,   memsz);
   getmem(remd,    memsz);
   getmem(tmpDvsr, memsz);
   getmem(accumReg,memsz);
   getmem(carryReg,memsz);

   VLNtemp1^.Init(0,wksize,1,nil);
   VLNtemp2^.Init(0,wksize,1,nil);
   VLNtemp3^.Init(0,wksize,1,nil);
   VLNoprnd^.Init(0,wksize,1,nil);
   quotn^.Init(0,wksize,1,nil);
   remd^.Init(0,wksize,1,nil);
   tmpDvsr^.Init(0,wksize,1,nil);
   accumReg^.Init(0,wksize,1,nil);
   CarryReg^.Init(0,wksize,1,nil);
end;

procedure CloseTempRegs;
var memsz : integer;
begin
   memSz := wksize*2+6;
   freemem(VLNtemp1,memsz);
   freemem(VLNtemp2,memsz);
   freemem(VLNtemp3,memsz);
   freemem(VLNoprnd,memsz);
   freemem(quotn,   memsz);
   freemem(remd,    memsz);
   freemem(accumReg,memsz);
   freemem(carryReg,memsz);

   freemem(dec_10e9, 10);
   freemem(decPointShift, 22);
end;


{            Unit initialization                        }
begin

   getmem(dec_10e9, 10);    { 2 * (words + sign + count + max) }
   getmem(decPointShift, 22);

   writeln('Unit Init Now!');
   with dec_10e9^ do
      begin
       count := 2;
       max := 2;
       sign := 1;
       tvln[1] := $CA00;        { = 1 * 10^9 }
       tvln[2] := $3B9A;
      end;

   with decPointShift^ do
      begin
       count := 8;
       max := 8;
       sign := 1;
    tVLN[1] := $0;
    tVLN[2] := $0;
    tVLN[3] := $9f10;  { 10 ^ 36 gives 36 decimal precision}
    tVLN[4] := $b34b;
    tVLN[5] := $715;
    tVLN[6] := $7bc9;
    tVLN[7] := $97ce;
    tVLN[8] := $c0;
      end;

    wksize := 100;

end.