lib/Math/BigInt/CalcEmu.pm

   1 package Math::BigInt::CalcEmu;
   2
   3 use 5.005;
   4 use strict;
   5 # use warnings; # dont use warnings for older Perls
   6 use vars qw/$VERSION/;
   7
   8 $VERSION = '0.03';
   9
  10 package Math::BigInt;
  11
  12 # See SYNOPSIS below.
  13
  14 my $CALC_EMU;
  15
  16 BEGIN
  17   {
  18   $CALC_EMU = Math::BigInt->config()->{'lib'};
  19   }
  20
  21 sub __emu_blog
  22   {
  23   my ($self,$x,$base,@r) = @_;
  24
  25   return $x->bnan() if $x->is_zero() || $base->is_zero() || $base->is_one();
  26
  27   my $acmp = $x->bacmp($base);
  28   return $x->bone('+',@r) if $acmp == 0;
  29   return $x->bzero(@r) if $acmp < 0 || $x->is_one();
  30
  31   # blog($x,$base) ** $base + $y = $x
  32
  33   # this trial multiplication is very fast, even for large counts (like for
  34   # 2 ** 1024, since this still requires only 1024 very fast steps
  35   # (multiplication of a large number by a very small number is very fast))
  36   # See Calc for an even faster algorightmn
  37   my $x_org = $x->copy();               # preserve orgx
  38   $x->bzero();                          # keep ref to $x
  39   my $trial = $base->copy();
  40   while ($trial->bacmp($x_org) <= 0)
  41     {
  42     $trial->bmul($base); $x->binc();
  43     }
  44   $x->round(@r);
  45   }
  46
  47 sub __emu_bmodinv
  48   {
  49   my ($self,$x,$y,@r) = @_;
  50
  51   my ($u, $u1) = ($self->bzero(), $self->bone());
  52   my ($a, $b) = ($y->copy(), $x->copy());
  53
  54   # first step need always be done since $num (and thus $b) is never 0
  55   # Note that the loop is aligned so that the check occurs between #2 and #1
  56   # thus saving us one step #2 at the loop end. Typical loop count is 1. Even
  57   # a case with 28 loops still gains about 3% with this layout.
  58   my $q;
  59   ($a, $q, $b) = ($b, $a->bdiv($b));                    # step #1
  60   # Euclid's Algorithm (calculate GCD of ($a,$b) in $a and also calculate
  61   # two values in $u and $u1, we use only $u1 afterwards)
  62   my $sign = 1;                                         # flip-flop
  63   while (!$b->is_zero())                                # found GCD if $b == 0
  64     {
  65     # the original algorithm had:
  66     # ($u, $u1) = ($u1, $u->bsub($u1->copy()->bmul($q))); # step #2
  67     # The following creates exact the same sequence of numbers in $u1,
  68     # except for the sign ($u1 is now always positive). Since formerly
  69     # the sign of $u1 was alternating between '-' and '+', the $sign
  70     # flip-flop will take care of that, so that at the end of the loop
  71     # we have the real sign of $u1. Keeping numbers positive gains us
  72     # speed since badd() is faster than bsub() and makes it possible
  73     # to have the algorithmn in Calc for even more speed.
  74
  75     ($u, $u1) = ($u1, $u->badd($u1->copy()->bmul($q))); # step #2
  76     $sign = - $sign;                                    # flip sign
  77
  78     ($a, $q, $b) = ($b, $a->bdiv($b));                  # step #1 again
  79     }
  80
  81   # If the gcd is not 1, then return NaN! It would be pointless to have
  82   # called bgcd to check this first, because we would then be performing
  83   # the same Euclidean Algorithm *twice* in case the gcd is 1.
  84   return $x->bnan() unless $a->is_one();
  85
  86   $u1->bneg() if $sign != 1;                            # need to flip?
  87
  88   $u1->bmod($y);                                        # calc result
  89   $x->{value} = $u1->{value};                           # and copy over to $x
  90   $x->{sign} = $u1->{sign};                             # to modify in place
  91   $x->round(@r);
  92   }
  93
  94 sub __emu_bmodpow
  95   {
  96   my ($self,$num,$exp,$mod,@r) = @_;
  97
  98   # in the trivial case,
  99   return $num->bzero(@r) if $mod->is_one();
 100   return $num->bone('+',@r) if $num->is_zero() or $num->is_one();
 101
 102   # $num->bmod($mod);           # if $x is large, make it smaller first
 103   my $acc = $num->copy();       # but this is not really faster...
 104
 105   $num->bone(); # keep ref to $num
 106
 107   my $expbin = $exp->as_bin(); $expbin =~ s/^[-]?0b//; # ignore sign and prefix
 108   my $len = CORE::length($expbin);
 109   while (--$len >= 0)
 110     {
 111     $num->bmul($acc)->bmod($mod) if substr($expbin,$len,1) eq '1';
 112     $acc->bmul($acc)->bmod($mod);
 113     }
 114
 115   $num->round(@r);
 116   }
 117
 118 sub __emu_bfac
 119   {
 120   my ($self,$x,@r) = @_;
 121
 122   return $x->bone('+',@r) if $x->is_zero() || $x->is_one();     # 0 or 1 => 1
 123
 124   my $n = $x->copy();
 125   $x->bone();
 126   # seems we need not to temp. clear A/P of $x since the result is the same
 127   my $f = $self->new(2);
 128   while ($f->bacmp($n) < 0)
 129     {
 130     $x->bmul($f); $f->binc();
 131     }
 132   $x->bmul($f,@r);                      # last step and also round result
 133   }
 134
 135 sub __emu_bpow
 136   {
 137   my ($self,$x,$y,@r) = @_;
 138
 139   return $x->bone('+',@r) if $y->is_zero();
 140   return $x->round(@r) if $x->is_one() || $y->is_one();
 141   return $x->round(@r) if $x->is_zero();  # 0**y => 0 (if not y <= 0)
 142
 143   my $pow2 = $self->bone();
 144   my $y_bin = $y->as_bin(); $y_bin =~ s/^0b//;
 145   my $len = CORE::length($y_bin);
 146   while (--$len > 0)
 147     {
 148     $pow2->bmul($x) if substr($y_bin,$len,1) eq '1';    # is odd?
 149     $x->bmul($x);
 150     }
 151   $x->bmul($pow2);
 152   $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
 153   $x;
 154   }
 155
 156 sub __emu_band
 157   {
 158   my ($self,$x,$y,$sx,$sy,@r) = @_;
 159
 160   return $x->bzero(@r) if $y->is_zero() || $x->is_zero();
 161
 162   my $sign = 0;                                 # sign of result
 163   $sign = 1 if $sx == -1 && $sy == -1;
 164
 165   my ($bx,$by);
 166
 167   if ($sx == -1)                                # if x is negative
 168     {
 169     # two's complement: inc and flip all "bits" in $bx
 170     $bx = $x->binc()->as_hex();                 # -1 => 0, -2 => 1, -3 => 2 etc
 171     $bx =~ s/-?0x//;
 172     $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
 173     }
 174   else
 175     {
 176     $bx = $x->as_hex();                         # get binary representation
 177     $bx =~ s/-?0x//;
 178     $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
 179     }
 180   if ($sy == -1)                                # if y is negative
 181     {
 182     # two's complement: inc and flip all "bits" in $by
 183     $by = $y->copy()->binc()->as_hex();         # -1 => 0, -2 => 1, -3 => 2 etc
 184     $by =~ s/-?0x//;
 185     $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
 186     }
 187   else
 188     {
 189     $by = $y->as_hex();                         # get binary representation
 190     $by =~ s/-?0x//;
 191     $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
 192     }
 193   # now we have bit-strings from X and Y, reverse them for padding
 194   $bx = reverse $bx;
 195   $by = reverse $by;
 196
 197   # cut the longer string to the length of the shorter one (the result would
 198   # be 0 due to AND anyway)
 199   my $diff = CORE::length($bx) - CORE::length($by);
 200   if ($diff > 0)
 201     {
 202     $bx = substr($bx,0,CORE::length($by));
 203     }
 204   elsif ($diff < 0)
 205     {
 206     $by = substr($by,0,CORE::length($bx));
 207     }
 208
 209   # and the strings together
 210   my $r = $bx & $by;
 211
 212   # and reverse the result again
 213   $bx = reverse $r;
 214
 215   # one of $x or $y was negative, so need to flip bits in the result
 216   # in both cases (one or two of them negative, or both positive) we need
 217   # to get the characters back.
 218   if ($sign == 1)
 219     {
 220     $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/;
 221     }
 222   else
 223     {
 224     $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/;
 225     }
 226
 227   $bx = '0x' . $bx;
 228   if ($CALC_EMU->can('_from_hex'))
 229     {
 230     $x->{value} = $CALC_EMU->_from_hex( \$bx );
 231     }
 232   else
 233     {
 234     $r = $self->new($bx);
 235     $x->{value} = $r->{value};
 236     }
 237
 238   # calculate sign of result
 239   $x->{sign} = '+';
 240   #$x->{sign} = '-' if $sx == $sy && $sx == -1 && !$x->is_zero();
 241   $x->{sign} = '-' if $sign == 1 && !$x->is_zero();
 242
 243   $x->bdec() if $sign == 1;
 244
 245   $x->round(@r);
 246   }
 247
 248 sub __emu_bior
 249   {
 250   my ($self,$x,$y,$sx,$sy,@r) = @_;
 251
 252   return $x->round(@r) if $y->is_zero();
 253
 254   my $sign = 0;                                 # sign of result
 255   $sign = 1 if ($sx == -1) || ($sy == -1);
 256
 257   my ($bx,$by);
 258
 259   if ($sx == -1)                                # if x is negative
 260     {
 261     # two's complement: inc and flip all "bits" in $bx
 262     $bx = $x->binc()->as_hex();                 # -1 => 0, -2 => 1, -3 => 2 etc
 263     $bx =~ s/-?0x//;
 264     $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
 265     }
 266   else
 267     {
 268     $bx = $x->as_hex();                         # get binary representation
 269     $bx =~ s/-?0x//;
 270     $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
 271     }
 272   if ($sy == -1)                                # if y is negative
 273     {
 274     # two's complement: inc and flip all "bits" in $by
 275     $by = $y->copy()->binc()->as_hex();         # -1 => 0, -2 => 1, -3 => 2 etc
 276     $by =~ s/-?0x//;
 277     $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
 278     }
 279   else
 280     {
 281     $by = $y->as_hex();                         # get binary representation
 282     $by =~ s/-?0x//;
 283     $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
 284     }
 285   # now we have bit-strings from X and Y, reverse them for padding
 286   $bx = reverse $bx;
 287   $by = reverse $by;
 288
 289   # padd the shorter string
 290   my $xx = "\x00"; $xx = "\x0f" if $sx == -1;
 291   my $yy = "\x00"; $yy = "\x0f" if $sy == -1;
 292   my $diff = CORE::length($bx) - CORE::length($by);
 293   if ($diff > 0)
 294     {
 295     $by .= $yy x $diff;
 296     }
 297   elsif ($diff < 0)
 298     {
 299     $bx .= $xx x abs($diff);
 300     }
 301
 302   # or the strings together
 303   my $r = $bx | $by;
 304
 305   # and reverse the result again
 306   $bx = reverse $r;
 307
 308   # one of $x or $y was negative, so need to flip bits in the result
 309   # in both cases (one or two of them negative, or both positive) we need
 310   # to get the characters back.
 311   if ($sign == 1)
 312     {
 313     $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/;
 314     }
 315   else
 316     {
 317     $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/;
 318     }
 319
 320   $bx = '0x' . $bx;
 321   if ($CALC_EMU->can('_from_hex'))
 322     {
 323     $x->{value} = $CALC_EMU->_from_hex( \$bx );
 324     }
 325   else
 326     {
 327     $r = $self->new($bx);
 328     $x->{value} = $r->{value};
 329     }
 330
 331   # if one of X or Y was negative, we need to decrement result
 332   $x->bdec() if $sign == 1;
 333
 334   $x->round(@r);
 335   }
 336
 337 sub __emu_bxor
 338   {
 339   my ($self,$x,$y,$sx,$sy,@r) = @_;
 340
 341   return $x->round(@r) if $y->is_zero();
 342
 343   my $sign = 0;                                 # sign of result
 344   $sign = 1 if $x->{sign} ne $y->{sign};
 345
 346   my ($bx,$by);
 347
 348   if ($sx == -1)                                # if x is negative
 349     {
 350     # two's complement: inc and flip all "bits" in $bx
 351     $bx = $x->binc()->as_hex();                 # -1 => 0, -2 => 1, -3 => 2 etc
 352     $bx =~ s/-?0x//;
 353     $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
 354     }
 355   else
 356     {
 357     $bx = $x->as_hex();                         # get binary representation
 358     $bx =~ s/-?0x//;
 359     $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
 360     }
 361   if ($sy == -1)                                # if y is negative
 362     {
 363     # two's complement: inc and flip all "bits" in $by
 364     $by = $y->copy()->binc()->as_hex();         # -1 => 0, -2 => 1, -3 => 2 etc
 365     $by =~ s/-?0x//;
 366     $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
 367     }
 368   else
 369     {
 370     $by = $y->as_hex();                         # get binary representation
 371     $by =~ s/-?0x//;
 372     $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
 373     }
 374   # now we have bit-strings from X and Y, reverse them for padding
 375   $bx = reverse $bx;
 376   $by = reverse $by;
 377
 378   # padd the shorter string
 379   my $xx = "\x00"; $xx = "\x0f" if $sx == -1;
 380   my $yy = "\x00"; $yy = "\x0f" if $sy == -1;
 381   my $diff = CORE::length($bx) - CORE::length($by);
 382   if ($diff > 0)
 383     {
 384     $by .= $yy x $diff;
 385     }
 386   elsif ($diff < 0)
 387     {
 388     $bx .= $xx x abs($diff);
 389     }
 390
 391   # xor the strings together
 392   my $r = $bx ^ $by;
 393
 394   # and reverse the result again
 395   $bx = reverse $r;
 396
 397   # one of $x or $y was negative, so need to flip bits in the result
 398   # in both cases (one or two of them negative, or both positive) we need
 399   # to get the characters back.
 400   if ($sign == 1)
 401     {
 402     $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/;
 403     }
 404   else
 405     {
 406     $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/;
 407     }
 408
 409   $bx = '0x' . $bx;
 410   if ($CALC_EMU->can('_from_hex'))
 411     {
 412     $x->{value} = $CALC_EMU->_from_hex( \$bx );
 413     }
 414   else
 415     {
 416     $r = $self->new($bx);
 417     $x->{value} = $r->{value};
 418     }
 419
 420   # calculate sign of result
 421   $x->{sign} = '+';
 422   $x->{sign} = '-' if $sx != $sy && !$x->is_zero();
 423
 424   $x->bdec() if $sign == 1;
 425
 426   $x->round(@r);
 427   }
 428
 429 sub __emu_bsqrt
 430   {
 431   my ($self,$x,@r) = @_;
 432
 433   # this is slow:
 434   return $x->round(@r) if $x->is_zero();        # 0,1 => 0,1
 435
 436   return $x->bone('+',@r) if $x < 4;            # 1,2,3 => 1
 437   my $y = $x->copy();
 438   my $l = int($x->length()/2);
 439
 440   $x->bone();                                   # keep ref($x), but modify it
 441   $x->blsft($l,10) if $l != 0;                  # first guess: 1.('0' x (l/2))
 442
 443   my $last = $self->bzero();
 444   my $two = $self->new(2);
 445   my $lastlast = $self->bzero();
 446   #my $lastlast = $x+$two;
 447   while ($last != $x && $lastlast != $x)
 448     {
 449     $lastlast = $last; $last = $x->copy();
 450     $x->badd($y / $x);
 451     $x->bdiv($two);
 452     }
 453   $x->bdec() if $x * $x > $y;                   # overshot?
 454   $x->round(@r);
 455   }
 456
 457 sub __emu_broot
 458   {
 459   my ($self,$x,$y,@r) = @_;
 460
 461   return $x->bsqrt() if $y->bacmp(2) == 0;      # 2 => square root
 462
 463   # since we take at least a cubic root, and only 8 ** 1/3 >= 2 (==2):
 464   return $x->bone('+',@r) if $x < 8;            # $x=2..7 => 1
 465
 466   my $num = $x->numify();
 467
 468   if ($num <= 1000000)
 469     {
 470     $x = $self->new( int ( sprintf ("%.8f", $num ** (1 / $y->numify() ))));
 471     return $x->round(@r);
 472     }
 473
 474   # if $n is a power of two, we can repeatedly take sqrt($X) and find the
 475   # proper result, because sqrt(sqrt($x)) == root($x,4)
 476   # See Calc.pm for more details
 477   my $b = $y->as_bin();
 478   if ($b =~ /0b1(0+)$/)
 479     {
 480     my $count = CORE::length($1);               # 0b100 => len('00') => 2
 481     my $cnt = $count;                           # counter for loop
 482     my $shift = $self->new(6);
 483     $x->blsft($shift);                          # add some zeros (even amount)
 484     while ($cnt-- > 0)
 485       {
 486       # 'inflate' $X by adding more zeros
 487       $x->blsft($shift);
 488       # calculate sqrt($x), $x is now a bit too big, again. In the next
 489       # round we make even bigger, again.
 490       $x->bsqrt($x);
 491       }
 492     # $x is still to big, so truncate result
 493     $x->brsft($shift);
 494     }
 495   else
 496     {
 497     # trial computation by starting with 2,4,6,8,10 etc until we overstep
 498     my $step;
 499     my $trial = $self->new(2);
 500     my $two = $self->new(2);
 501     my $s_128 = $self->new(128);
 502
 503     local undef $Math::BigInt::accuracy;
 504     local undef $Math::BigInt::precision;
 505
 506     # while still to do more than X steps
 507     do
 508       {
 509       $step = $self->new(2);
 510       while ( $trial->copy->bpow($y)->bacmp($x) < 0)
 511         {
 512         $step->bmul($two);
 513         $trial->badd($step);
 514         }
 515
 516       # hit exactly?
 517       if ( $trial->copy->bpow($y)->bacmp($x) == 0)
 518         {
 519         $x->{value} = $trial->{value};  # make copy while preserving ref to $x
 520         return $x->round(@r);
 521         }
 522       # overstepped, so go back on step
 523       $trial->bsub($step);
 524       } while ($step > $s_128);
 525
 526     $step = $two->copy();
 527     while ( $trial->copy->bpow($y)->bacmp($x) < 0)
 528       {
 529       $trial->badd($step);
 530       }
 531
 532     # not hit exactly?
 533     if ( $x->bacmp( $trial->copy()->bpow($y) ) < 0)
 534       {
 535       $trial->bdec();
 536       }
 537     # copy result into $x (preserve ref)
 538     $x->{value} = $trial->{value};
 539     }
 540   $x->round(@r);
 541   }
 542
 543 sub __emu_as_hex
 544   {
 545   my ($self,$x,$s) = @_;
 546
 547   return '0x0' if $x->is_zero();
 548
 549   my $x1 = $x->copy()->babs(); my ($xr,$x10000,$h,$es);
 550   if ($] >= 5.006)
 551     {
 552     $x10000 = $self->new (0x10000); $h = 'h4';
 553     }
 554   else
 555     {
 556     $x10000 = $self->new (0x1000); $h = 'h3';
 557     }
 558   while (!$x1->is_zero())
 559     {
 560     ($x1, $xr) = bdiv($x1,$x10000);
 561     $es .= unpack($h,pack('v',$xr->numify()));
 562     }
 563   $es = reverse $es;
 564   $es =~ s/^[0]+//;             # strip leading zeros
 565   $s . '0x' . $es;
 566   }
 567
 568 sub __emu_as_bin
 569   {
 570   my ($self,$x,$s) = @_;
 571
 572   return '0b0' if $x->is_zero();
 573
 574   my $x1 = $x->copy()->babs(); my ($xr,$x10000,$b,$es);
 575   if ($] >= 5.006)
 576     {
 577     $x10000 = $self->new (0x10000); $b = 'b16';
 578     }
 579   else
 580     {
 581     $x10000 = $self->new (0x1000); $b = 'b12';
 582     }
 583   while (!$x1->is_zero())
 584     {
 585     ($x1, $xr) = bdiv($x1,$x10000);
 586     $es .= unpack($b,pack('v',$xr->numify()));
 587     }
 588   $es = reverse $es;
 589   $es =~ s/^[0]+//;   # strip leading zeros
 590   $s . '0b' . $es;
 591   }
 592
 593 ##############################################################################
 594 ##############################################################################
 595
 596 1;
 597 __END__
 598
 599 =head1 NAME
 600
 601 Math::BigInt::CalcEmu - Emulate low-level math with BigInt code
 602
 603 =head1 SYNOPSIS
 604
 605 Contains routines that emulate low-level math functions in BigInt, e.g.
 606 optional routines the low-level math package does not provide on it's own.
 607
 608 Will be loaded on demand and automatically by BigInt.
 609
 610 Stuff here is really low-priority to optimize,
 611 since it is far better to implement the operation in the low-level math
 612 libary directly, possible even using a call to the native lib.
 613
 614 =head1 DESCRIPTION
 615
 616 =head1 METHODS
 617
 618 =head1 LICENSE
 619
 620 This program is free software; you may redistribute it and/or modify it under
 621 the same terms as Perl itself.
 622
 623 =head1 AUTHORS
 624
 625 (c) Tels http://bloodgate.com 2003 - based on BigInt code by
 626 Tels from 2001-2003.
 627
 628 =head1 SEE ALSO
 629
 630 L<Math::BigInt>, L<Math::BigFloat>, L<Math::BigInt::BitVect>,
 631 L<Math::BigInt::GMP> and L<Math::BigInt::Pari>.
 632
 633 =cut