Newsgroup: it.comp.lang.pascal
Titolo: UltraNum

Ciao a tutti.
Ho risolto il problema segnalato da
Michele nella gestione del riporto durante
la moltiplicazione. Mi ero dimenticato di
azzerare una variabile all'interno del ciclo.
Riposto il programma corretto. Non ho
avuto il tempo materiale per apportare
ulteriori modifiche.
Ci sono invece novita' riguarda gli
altri progetti paralleli?
Ciao, Carmelo.
______________________________
{ This source is to be distributed under the terms
of the GPL - Gnu Public License.
Copyright (C) 2001 Carmelo Spiccia.
This program 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, or (at your option) any
later version.
This program 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 can find a copy of this license at
http://www.gnu.org/licenses/gpl.txt
 }
Program UltraNum;
  Uses Crt;
  Var A,B: String;
  Function RemZero(A: String): String;
    Var Sign: String[1];
    Begin
      If A='' Then A:='0';
      If A[1] In ['+','-'] Then
        Begin
          Sign:=A[1];
          Delete(A,1,1);
        End
                           Else Sign:='';
      While Length(A)>1 Do
        If A[1]='0' Then Delete(A,1,1) Else Break;
      A:=Sign+A;
      If A='-0' Then A:='0';
      RemZero:=A;
    End;
  Function EQ(A,B: String): Boolean;
    Begin
      EQ:=(RemZero(A)=RemZero(B));
    End;
  Function NE(A,B: String): Boolean;
    Begin
      NE:=(RemZero(A)<>RemZero(B));
    End;
  Function GT(A,B: String): Boolean;
    Var I,K: Integer;
        NegSignA,NegSignB,Res: Boolean;
    Begin
      NegSignA:=(A[1]='-');
      NegSignB:=(B[1]='-');
      If NegSignA Xor NegSignB Then
        Res:=NegSignB
                               Else
        Begin
          If A[1] In ['+','-'] Then Delete(A,1,1);
          If B[1] In ['+','-'] Then Delete(B,1,1);
          While Length(A)<>Length(B) Do
            If Length(A)>Length(B) Then Insert('0',B,1) Else Insert('0',A,1);
          Res:=False; I:=1;
          While (A[I]=B[I]) And (I<Length(A)) Do I:=I+1;
          If A[I]>B[I] Then Res:=True;
          If NegSignA Then Res:=Not Res;
        End;
      GT:=Res;
    End;
  Function LT(A,B: String): Boolean;
    Begin
      LT:=(Not GT(A,B)) And NE(A,B);
    End;
  Function GE(A,B: String): Boolean;
    Begin
      GE:=EQ(A,B) Or GT(A,B);
    End;
  Function LE(A,B: String): Boolean;
    Begin
      LE:=Not GT(A,B);
    End;
  Function NLT(A,B: String): Boolean;
    Begin
      NLT:=EQ(A,B) Or GT(A,B);
    End;
  Function NGT(A,B: String): Boolean;
    Begin
      NGT:=Not GT(A,B);
    End;
  Function NAbs(A: String): String;
    Begin
      If A[1] In ['+','-'] Then Delete(A,1,1);
      NAbs:=RemZero(A);
    End;
  Function Opp(A: String): String;
    Begin
      If A[1]='-' Then Delete(A,1,1)
                  Else
        If A[1]='+' Then A[1]:='-' Else A:='-'+A;
      Opp:=A;
    End;
  Function Add(A,B: String): String;
    Var I,K,Riporto: Integer;
        Sub,NegSignA,NegSignB,TmpBool: Boolean;
        TmpSt: String;
    Begin
      Riporto:=0;
      NegSignA:=(A[1]='-');
      NegSignB:=(B[1]='-');
      Sub:=(NegSignA Xor NegSignB);
      If A[1] In ['+','-'] Then Delete(A,1,1);
      If B[1] In ['+','-'] Then Delete(B,1,1);
      While Length(A)<>Length(B) Do
        If Length(A)>Length(B) Then Insert('0',B,1) Else Insert('0',A,1);
      If Sub And GT(B,A) Then
        Begin
          TmpSt:=A; A:=B; B:=TmpSt;
          TmpBool:=NegSignA; NegSignA:=NegSignB; NegSignB:=TmpBool;
        End;
      For I:=Length(A) DownTo 1 Do
        Begin
          If Sub Then K:=Ord(A[I])-Ord(B[I])+Riporto
                 Else K:=Ord(A[I])+Ord(B[I])-96+Riporto;
          If Sub And (K<0) Then
            Begin
              K:=K+10;
              Riporto:=-1;
            End
                           Else
            If K>=10 Then Riporto:=K Div 10 Else Riporto:=0;
          A[I]:=Chr((K Mod 10)+48);
        End;
      If Riporto>0 Then A:=Chr(Riporto+48)+A;
      If NegSignA Then A:='-'+A;
      Add:=RemZero(A);
    End;
  Function Sub(A,B: String): String;
    Begin
      Sub:=Add(A,Opp(B));
    End;
  Function Mul(A,B: String): String;
    Var Res,TmpSt: String;
        I,I2,K,Riporto: Integer;
        NegRes,NegSignA,NegSignB: Boolean;
    Begin
      Res:='0'; Riporto:=0;
      NegSignA:=(A[1]='-');
      NegSignB:=(B[1]='-');
      NegRes:=(NegSignA Xor NegSignB);
      If A[1] In ['+','-'] Then Delete(A,1,1);
      If B[1] In ['+','-'] Then Delete(B,1,1);
      For I:=Length(B) DownTo 1 Do
        Begin
          TmpSt:=A; Riporto:=0;
          For I2:=Length(A) DownTo 1 Do
            Begin
              K:=(Ord(B[I])-48)*(Ord(A[I2])-48)+Riporto;
              If K>9 Then
                Begin
                  Riporto:=K Div 10;
                  K:=K Mod 10;
                End
                     Else Riporto:=0;
              TmpSt[I2]:=Chr(K+48);
            End;
          If Riporto>0 Then TmpSt:=Chr(Riporto+48)+TmpSt;
          For I2:=1 To Length(B)-I Do TmpSt:=TmpSt+'0';
          Res:=Add(Res,TmpSt);
        End;
      If NegRes Then Res:='-'+Res;
      Mul:=RemZero(Res);
    End;
  Function DivR(A,B: String): String;
    Begin
    End;
  Function DivI(A,B: String): String;
    Begin
    End;
  Function NMod(A,B: String): String;
    Begin
    End;
  Function NTrunc(A: String): String;
    Begin
      A:=RemZero(A);
      If A[1]='.' Then NTrunc:='0'
                  Else NTrunc:=Copy(A,1,Pos('.',A)-1);
      NTrunc:=A;
    End;
  Function NRound(A: String): String;
    Var I: Integer;
    Begin
      A:=RemZero(A);
      I:=Pos('.',A);
      If I>0 Then
        Begin
          If I=1 Then
            Begin
              A:='0'+A;
              I:=2;
            End;
          If A[I+1]<'5' Then A:=Copy(A,1,I-1)
                        Else
            If A[1]='-' Then A:=Add(Copy(A,1,I-1),'-1')
                        Else A:=Add(Copy(A,1,I-1),'1');
        End;
      NRound:=A;
    End;
  Begin
    Clrscr;
    Write('A = '); Readln(A);
    Write('B = '); Readln(B);
    Writeln('A * B = ',Mul(A,B));
    Readln;
  End.

Ho trovato sullo SWAG una unit per la gestione dei BCD (Binary Coded
Decimal) a lunghezza dinamica, credo possa essere interessante. Non la
posto qui perche' e' lunga (c'e' anche la documentazione), ma se vuoi
fammi un fischio che te la spedisco in posta (vale anche per gli altri
che stanno sviluppando progetti analoghi, Drednaugh e Michele
Povigna).
Omega e' omega e basta.

spedisci spedisci !! grazie :-)
--
Dreadnaut
(Life would be easier if I had the source code)