home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / modula2 / library / fst / modula3 / bigcardi.mod < prev    next >
Text File  |  1993-07-28  |  5KB  |  165 lines
  1. IMPLEMENTATION MODULE bigcardinal;
  2.  
  3. (* Ludewig S. 167, Bearbeitung von großen zahlen
  4.    bigcardinal stellt einen ADT fuer grosse natuerliche Zahlen bereit
  5.    Bei Überlauf wird als Ergebnis die größtmöglich Zahl
  6.    geliefert, ausserdem die Meldung "Überlauf" ausgegben *)
  7.  
  8. FROM IO      IMPORT WrLn,WrCard,WrStr;
  9. FROM InOut   IMPORT Write;
  10. FROM Storage IMPORT ALLOCATE,DEALLOCATE,Available;
  11.  
  12. CONST MaxLng=100;  (* 10^MaxLng muß ausreichen für Tyfp CARDINAL *)
  13. TYPE Digit=[0..9];
  14.      StoreNo=ARRAY[1..MaxLng] OF Digit;
  15.      BigNo=POINTER TO StoreNo;
  16.  
  17.  
  18. PROCEDURE Create(VAR Zahl:BigNo);
  19.   BEGIN
  20.     IF Available(SIZE(BigNo)) THEN
  21.       ALLOCATE(Zahl,SIZE(StoreNo))
  22.     ELSE
  23.       WrStr('Kein Speicherplatz mehr zum creieren !!');
  24.     END  (* IF *)
  25.   END Create;
  26.  
  27. PROCEDURE InitNo(VAR Zahl:BigNo);
  28. (* intern, Zahl auf null sezuen *)
  29.   VAR Index:CARDINAL;
  30.   BEGIN
  31.     FOR Index:= 1 TO MaxLng DO Zahl^[Index]:=0 END;
  32.   END InitNo;
  33.  
  34. PROCEDURE Put9(VAR Zahl:BigNo);
  35. (* intern, Zahl auf Hoechste darstellbare Zahl setzen *)
  36.   VAR Index:CARDINAL;
  37.   BEGIN
  38.     FOR Index:= 1 TO MaxLng DO
  39.       Zahl^[Index]:=9
  40.     END;   (* FOR *)
  41.   END Put9;
  42.  
  43. PROCEDURE CopyNo(No1:BigNo;VAR No2:BigNo);
  44. (* intern, Wert von No1 nach No2 kopieren *)
  45.   BEGIN
  46.     No2^:=No1^
  47.   END CopyNo;
  48.  
  49. PROCEDURE Out (Zahl:BigNo);
  50. (* ausgabe der Zahl *)
  51.   CONST Blank=' ';
  52.   VAR Index:CARDINAL;
  53.       FuehrendeNull:BOOLEAN;
  54.   BEGIN
  55.     FuehrendeNull:=TRUE;   (* noch keine Ziffer ausgegeben *)
  56.     FOR Index:=1 TO MaxLng DO    (* Zahl in Dreiergruppen ausgeben *)
  57.       IF FuehrendeNull AND (Zahl^[Index]=0)
  58.                        AND (Index < MaxLng) THEN
  59.         Write(Blank)   (* fuehrende Nullen unterdruecken *)
  60.       ELSE
  61.         WrCard(Zahl^[Index],1);
  62.         FuehrendeNull:=FALSE;
  63.       END;  (* IF *)
  64.       IF((MaxLng-Index) MOD 3)=0 THEN  (* Dreiergruppen bilden *)
  65.         Write(Blank)
  66.       END;  (* IF *)
  67.     END;  (* FOR *)
  68.     WrLn;
  69.   END Out;
  70.  
  71. PROCEDURE Times10(Zahl1:BigNo;VAR Zahl2:BigNo);
  72. (* Zahl2 erhaelt den zehnfachen Wert von Zahl1 *)
  73.   VAR Index:CARDINAL;
  74.   BEGIN
  75.     IF Zahl1^[1]#0 THEN
  76.       WrStr('*** Times10 Ueberlauf ***');
  77.       WrLn;
  78.       Put9(Zahl2);
  79.     ELSE
  80.       FOR Index:=2 TO MaxLng DO
  81.         Zahl2^[Index-1]:=Zahl1^[Index];
  82.       END;   (* FOR *)
  83.       Zahl2^[MaxLng]:=0;
  84.     END;   (* IF *)
  85.   END Times10;
  86.  
  87. PROCEDURE Enter(VAR Zahl:BigNo;Wert:CARDINAL);
  88.   VAR Index:CARDINAL;
  89.   BEGIN
  90.     InitNo(Zahl);   (* Damit ist die Zahl auf 0 initialisiert *)
  91.     Index:=MaxLng;
  92.     WHILE Wert>0 DO   (* Zahl konverieren, beginnend mit der niedrigsten
  93.                          Ziffer *)
  94.       Zahl^[Index]:=Wert MOD 10;
  95.       Wert:=Wert DIV 10;
  96.       DEC(Index);
  97.     END;  (* WHILE *)
  98.   END Enter;
  99.  
  100. PROCEDURE Add(S1,S2:BigNo; VAR Summe:BigNo);
  101.   VAR Index,Zwischensumme(* Summe zweier Ziffern *):CARDINAL;
  102.   BEGIN
  103.     Zwischensumme:=0;
  104.     Index:=MaxLng;
  105.     WHILE (Index>0) DO (* Ziffernweise von rechts nach links add. *)
  106.       Zwischensumme:=S1^[Index] + S2^[Index] + Zwischensumme DIV 10;
  107.                                               (* Übertrag *)
  108.       Summe^[Index]:=Zwischensumme MOD 10;
  109.       DEC(Index);
  110.     END;   (* WHILE *)
  111.     IF Zwischensumme>9 THEN  (* Überlauf in der höchsten Ziffer *)
  112.       Put9(Summe);
  113.       WrStr('*** Add Überlauf ***');
  114.       WrLn;
  115.     END;   (* IF *)
  116.   END Add;
  117.  
  118. PROCEDURE Mul(F1,F2:BigNo;VAR Produkt:BigNo);
  119.   VAR Index:CARDINAL;
  120.       Prod:BigNo;   (* Zwischenspeicher fuer das Ergebnis *)
  121.   BEGIN
  122.     ALLOCATE(Prod,SIZE(StoreNo));
  123.     InitNo(Prod);
  124.     Index:=1;       (* 1. Ziffer undgleich 0 suchen *)
  125.     WHILE (Index<=MaxLng) AND (F2^[Index]=0) DO
  126.       INC(Index)
  127.     END;  (* WHILE *)
  128.     WHILE Index<=MaxLng DO
  129.       Times10(Prod,Prod);    (* Dezimal-Shift um eine Stelle *)
  130.       WHILE F2^[Index]>0 DO   (* Multipl. durch wiederh. Add. *)
  131.         Add(F1,Prod,Prod);
  132.         DEC(F2^[Index]);
  133.       END;  (* WHILE *)
  134.       INC(Index);
  135.     END;   (* WHILE *)
  136.     IF Produkt#NIL THEN DEALLOCATE(Produkt,SIZE(StoreNo)) END;
  137.     Produkt:=Prod;
  138.   END Mul;
  139.  
  140. PROCEDURE Power(Base:BigNo;Exp:CARDINAL;VAR isPower:BigNo);
  141.   VAR BaseCopy:BigNo;
  142.   BEGIN
  143.     ALLOCATE(BaseCopy ,SIZE(StoreNo));
  144.     CopyNo(Base,BaseCopy);    (* Entkopplung Parameter/Relultat *)
  145.     Enter(isPower,1);
  146.     WHILE Exp>0 DO   (* Potenzieren durch wiederh. Multiplizieren *)
  147.       Mul(BaseCopy,isPower,isPower);
  148.       DEC(Exp);
  149.     END;   (* WHILE *)
  150.     DEALLOCATE(BaseCopy,SIZE(StoreNo));
  151.   END Power;
  152.  
  153. PROCEDURE Tausch(VAR T1,T2:BigNo);
  154.   VAR hilf:BigNo;
  155.   BEGIN
  156.     ALLOCATE(hilf,SIZE(BigNo));
  157.     hilf^:=T1^;
  158.     T1^:=T2^;
  159.     T2^:=hilf^;
  160.     DEALLOCATE(hilf,SIZE(BigNo));
  161.   END Tausch;
  162.  
  163. END bigcardinal.
  164.  
  165.