Old stuff/ecole_etude_fac_de_pau/licence_2/calculatrice/backup2/operations.pl
(Deskargatu)
#!/usr/bin/perl -w
#
#
# This file is part of "CalBinaire".
#
# Calbinaire is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License.
#
# Calbinaire is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Foobar; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
###############################################################################/
sub sous($$)
{
my $ia = shift;
my $ib = shift;
my ($as,$bs,$ae,$be,$am,$bm); # a_signe a_exposant a_mantisse ...
$ia =~ /(\d)(\d{8})(\d{23})/ && do { ($as,$ae,$am) = ($1,$2,$3); }; # decoupage des variables recues
$ib =~ /(\d)(\d{8})(\d{23})/ && do { ($bs,$be,$bm) = ($1,$2,$3); };
if ($as == 0 && $bs == 1) # si soustraction dissimulee ...
{
$bs = 0;
return add($ia,$bs.$be.$bm);
}
if ($as == 1 && $bs == 0) # si soustraction dissimulee ...
{
$as = 0;
return add($ib,$as.$ae.$am);
}
$am = "1"."$am"; # ajout du 1 implicite
$bm = "1"."$bm"; # ajout du 1 implicite
$base_exp = $ae>$be ? $ae : $be;
$ae = bin2int($ae);
$be = bin2int($be);
print "Difference d'exposants : $ae et $be\n";
print "AM :$am\nBM :$bm\n\n";
while ($ae < $be ) # conversion de la mantisse de am et bm pour avoir le meme exposant ...
{
$am = decal_gauche($am);
$be--;
}
while ($be < $ae )
{
$bm = decal_gauche($bm);
$ae--;
}
print "Au final : \n\tAM : $am \n\tBM : $bm \n";
$rm = soustraction($am,$bm);
($base_exp,$rm) = mantisse2($base_exp,$rm);
$retour = "0".$base_exp.$rm;
print "RETOUR FINAL : $retour\n";
return $retour;
}
sub add($$)
{
my $ia = shift;
my $ib = shift;
my ($as,$bs,$ae,$be,$am,$bm); # a_signe a_exposant a_mantisse ...
$ia =~ /(\d)(\d{8})(\d{23})/ && do { ($as,$ae,$am) = ($1,$2,$3); }; # decoupage des variables recues
$ib =~ /(\d)(\d{8})(\d{23})/ && do { ($bs,$be,$bm) = ($1,$2,$3); };
if ($as == 0 && $bs == 1) # si soustraction dissimulee ...
{
$bs = 0;
return sous($ia,$bs.$be.$bm);
}
if ($as == 1 && $bs == 0) # si soustraction dissimulee ...
{
$as = 0;
return sous($ib,$as.$ae.$am);
}
$am = "1"."$am"; # ajout du 1 implicite
$bm = "1"."$bm"; # ajout du 1 implicite
$base_exp = $ae>$be ? $ae : $be;
$ae = bin2int($ae);
$be = bin2int($be);
# print "Difference d'exposants : $ae et $be\n";
# print "AM :$am\nBM :$bm\n\n";
while ($ae < $be ) # conversion de la mantisse de am et bm pour avoir le meme exposant ...
{
$am = decal_gauche($am);
$be--;
}
while ($be < $ae )
{
$bm = decal_gauche($bm);
$ae--;
}
# print "Au final : \n\tAM : $am \n\tBM : $bm \n";
$rm = addition($am,$bm);
($base_exp,$rm) = mantisse($base_exp,$rm);
$retour = "0".$base_exp.$rm;
# print "RETOUR FINAL : $retour\n";
return $retour;
}
sub decal_gauche($)
{
my $decalage = shift;
@decalage = split //,$decalage;
@decalage = (0,@decalage);
pop(@decalage);
return join("",@decalage);
}
sub mantisse($$)
{
my $base = shift;
my $rm = shift;
my $count;
print "RECU $base et $rm\n";
my @tempo = split // , $rm;
print "Long init ".scalar @tempo."\n";
while (scalar @tempo > 24)
{
$count++;
print "BASE ++ $base : ";
my @base= reverse split//,$base;
$base[0]++;
$i=0;
while($base[$i]>1) { $base[$i]-=2; $i++; $base[$i]++; }
$base = reverse join("",@base);
print "$base \n";
shift(@tempo);
$rm = join("",@tempo);
print "Longueur de ".scalar @tempo." : $rm !\n";
}
if ($tempo[0] == 1)
{
print "On vire le 1 implicite \n"; #shift(@tempo); $rm = join("",@tempo);
}
else { print "$tempo[0] != 1 !!\n"; }
#shift(@tempo);
#$rm = join("",@tempo);
print "RETOUR $base et $rm\n";
return ($base,$rm);
}
sub mantisse2($$)
{
my $base = shift;
my $rm = shift;
my $count;
print "RECU $base et $rm\n";
my @tempo = split // , $rm;
print "Long init ".scalar @tempo."\n";
while (scalar @tempo > 24)
{
$count++;
print "BASE ++ $base : ";
my @base= reverse split//,$base;
$base[0]++;
$i=0;
while($base[$i]>1) { $base[$i]-=2; $i++; $base[$i]++; }
$base = reverse join("",@base);
print "$base \n";
shift(@tempo);
$rm = join("",@tempo);
print "Longueur de ".scalar @tempo." : $rm !\n";
}
$compteur=0;
while ($tempo[0] != 1 and $compteur<24)
{
print "Variation ...\n";
$compteur++;
shift(@tempo);
@tempo=(@tempo,0);
my @base= reverse split//,$base;
$base[0]--;
$i=0;
while($base[$i]<0) { $base[$i]+=2; $i++; $base[$i]--; }
$base = reverse join("",@base);
}
if ($tempo[0] eq 1 ) { shift(@tempo); @tempo=(@tempo,0); }
else { $base = "0"x8; }
$rm = join("",@tempo);
print "RETOUR $base et $rm\n";
return ($base,$rm);
}
sub addition($$) # addition bit a bit , sans signe, $mantisse et tout le tralala ...
{
my $numa = shift;
my $numb = shift;
# print "PRET A ADDITIONER $numa et $numb\n";
my @p = reverse split //,$numa; # premier
my @d = reverse split //,$numb; # deuxieme
while (scalar @p < scalar @d) { push(@d,0); }
while (scalar @d < scalar @p) { push(@p,0); }
$retenue = 0;
for(0.. scalar @p-1)
{
$p[$_] += $d[$_] + $retenue;
$retenue =0;
if ($p[$_] > 1) { $p[$_] -= 2; $retenue =1; }
}
if ($retenue ==1) { $p[scalar @p] = 1; }
$numa = reverse join("",@p);
$numb = reverse join("",@d);
# print "PRET A ADDITIONER $numa et $numb\n";
return $numa;
}
sub soustraction($$) # sous bit a bit , sans signe, $mantisse et tout le tralala ...
{
my $numa = shift;
my $numb = shift;
print "PRET A soustraire $numa et $numb\n";
my @p = reverse split //,$numa; # premier
my @d = reverse split //,$numb; # deuxieme
while (scalar @p < scalar @d) { push(@d,0); }
while (scalar @d < scalar @p) { push(@p,0); }
$retenue = 0;
for(0.. scalar @p-1)
{
$p[$_] = $p[$_] - $d[$_] + $retenue;
$retenue =0;
if ($p[$_] < 0) { $p[$_] += 2; $retenue =-1; }
}
if ($retenue ==-1) { $p[scalar @p] = 1; }
$numa = reverse join("",@p);
$numb = reverse join("",@d);
print "Resultat de l adition : $numa\n";
return $numa;
}
sub bin2int($)
{
my $num = shift;
# print "RECU $num\n";
my @num = reverse (split // ,$num);
$var = 0;
for (0..$#num)
{
$var += $num[$_]*(2**$_);
}
return $var;
}
sub int2bin($)
{
&clear;
my $num = shift;;
my @arr;
undef($virgule);
if ($num =~ /\.(\d+)$/) { $virgule = "0.".$1; }
else {$virgule = "0"; }
$signe = $num >= 0 ? 0 : 1;
if ($signe) { $num*=-1; }
my @bin;
while ($num > 1)
{
push(@bin,($num%2));
$num=int($num/2);
}
push(@bin,$num);
my $puissance = (scalar @bin)-1;
@bin = reverse @bin;
my @virg;
for ($puissance .. 22)
{
$virgule = $virgule * 2;
if ($virgule >= 1) { $virgule -=1; @virg = ("1",@virg); }
else { @virg=("0",@virg); }
}
@bin = (@bin,reverse @virg);
shift(@bin);
my $exp=127+$puissance;
my $i="";
for (1..7)
{
$i=($exp % 2)."$i";
$exp=int($exp/2);
}
$i=$exp."$i";
$retour =$signe.$i.join("",@bin);
# print "Signe $signe\n";
# print "Expossant : $exp = $i \n";
# print "Mantisse ".join("",@bin)."\n";
return $retour;
}
return 1; # fin appel de operations.pl sans problemes ...
Tfe