#!/usr/bin/perl

use POSIX;

srand(42);

sub d2gier
{
  my $number=$_[0];
  my $d1;
  my $d2;
  my $d3;
  my $d4;
  if($number==0)
  {
    return (0,0,0,0);
  }
  my $sign=$number<0;
  my $anumber=abs($number);
  my $ln2 = floor(log($anumber)/log(2));
  for(my $expo = $ln2-1; $expo<=($ln2+1); $expo++)
  {
    my $man1 = floor($anumber*2.0**(28-$expo));
    my $man2 = floor($anumber*2.0**(28-$expo)+0.5);
    print "round\n" if($man1!=$man2);
    my $man=$man2;
    $man = 2**30-$man if($sign);
    $d4 = ($man    )&1023;
    $d3 = ($man>>10)&1023;
    $d2 = ($man>>20)&1023;
    $d1 = $expo;
    $d1 = $d1+1024 if($d1<0);
    print "  number: $number expo: $expo man: $man $d1 $d2 $d3 $d4\n";
    my $t1=$man>>30;
    my $t2=(($d2&512)==512)?1:0;
    my $t3=(($d2&256)==256)?1:0;
    print "  $t1 $t2 $t3\n";
    last if(($man>>30)==0 && $t2 != $t3 && $t2 == $sign);
  }
  print "$number d2: ";
  for(my $i=9; $i>=0; $i--)
  {
    my $bit=(($d2>>$i)&1);
    print "$bit";
  }
  print " $d1 $d2 $d3 $d4\n";
  return ($d1,$d2,$d3,$d4);
}


open GA4,">pow10perlalgol.asc";
open INPUT,">pow10perlinput.asc";
open SLIP,">pow10perlslip.asc";
print SLIP "_f ";

$ndata=100;
$factor=100000000;

$nga4=0;

for($p2=536870912-5; $p2<=536870912+5; $p2++)
{
  $number = floor(rand(10.0)*$factor+0.5)/$factor;
  $number = $p2;
  if($nga4 % 30 == 0)
  {
    if($nga4 == 0)
    {
      print GA4 "_i_f p2 _< 30 _t_h_e_n (_c_a_s_e p2 _o_f (\n";
    }
    else
    {
      $plimit = $nga4+30;
      print GA4 ")) _e_l_s_e _i_f p2 _< $plimit _t_h_e_n (_c_a_s_e p2-$nga4 _o_f (\n";
    }
  }

  @gier = d2gier($number);
  ($d1,$d2,$d3,$d4)=@gier;
  printf INPUT "%.0f, %.0f, %d, %d, %d, %d%s\n", $number, $number,
	 $d1, $d2, $d3, $d4, "";
  printf SLIP "%.1f\n", $number;
  printf GA4 "%.1f", $number;
  $nga4++;
  print GA4 ($nga4%30==0)?"\n":", ";

  $number = -$number;
  @gier = d2gier($number);
  ($d1,$d2,$d3,$d4)=@gier;
  printf INPUT "%.0f, %.0f, %d, %d, %d, %d%s\n", $number, $number,
	 $d1, $d2, $d3, $d4, "";
  printf SLIP "%.1f\n", $number;
  printf GA4 "%.1f", $number;
  $nga4++;
  print GA4 ($nga4%30==0)?"\n":", ";
}
for($p2=-20; $p2<=28; $p2++)
{
  $number = 10**$p2;
  if($nga4 % 30 == 0)
  {
    if($nga4 == 0)
    {
      print GA4 "_i_f p2 _< 30 _t_h_e_n (_c_a_s_e p2 _o_f (\n";
    }
    else
    {
      $plimit = $nga4+30;
      print GA4 ")) _e_l_s_e _i_f p2 _< $plimit _t_h_e_n (_c_a_s_e p2-$nga4 _o_f (\n";
    }
  }


  @gier = d2gier($number);
  ($d1,$d2,$d3,$d4)=@gier;
  printf INPUT "1'%d, 1'%d, %d, %d, %d, %d%s\n", $p2, $p2,
	 $d1, $d2, $d3, $d4, "";
  printf SLIP "1'%d\n", $p2;
  printf GA4 "1'%d", $p2;
  $nga4++;
  print GA4 ($nga4%30==0)?"\n":", ";

  $number = -$number;
  @gier = d2gier($number);
  ($d1,$d2,$d3,$d4)=@gier;
  printf INPUT "-1'%d, -1'%d, %d, %d, %d, %d%s\n", $p2, $p2,
	 $d1, $d2, $d3, $d4, ($p2==28?"#011":"");
  printf SLIP "-1'%d\n", $p2;
  printf GA4 "-1'%d", $p2;
  $nga4++;
  print GA4 ($nga4%30==0)?"\n":", ";
}
close INPUT;
close SLIP;
printf GA4 ")) _e_l_s_e 1234;\n";
close GA4;