[Back to MATH SWAG index]  [Back to Main SWAG index]  [Original]

{
From: Martin Preishuber <martin_p@efn.efn.org>

mycalc.pas that is a unit with mathematical function. the numbers
  are based on 65536, so you can calculate with really
  huge numbers.
rabin.pas it's a demo program for mycalc. you can test large
  number,s whether it is a prime or not

both programs are documented in german, so i guess that documentation
won't help much :-(
}

(* ----------------------------------------------------------------------- *)
(* RabinTest pr�ft, ob eine Zahl eine Primzahl ist                         *)
(* ----------------------------------------------------------------------- *)

{$M 65000, 0, 655360}                          (* Stack auf maximale Gr�áe *)

PROGRAM RabinTest;

USES Crt,                                         (* Ein/Ausgabefunktionen *)
     Extend,                                (* erweiterte I/O - Funktionen *)
     MyCalc;               (* Funktionen f�r das Rechnen mit groáen Zahlen *)

(* ----------------------------------------------------------------------- *)

FUNCTION Expt(zahl : Real; hoch : INTEGER) : Real;
    (* Berechnung des Exponenten einer Realzahl (einfach, weil nur f�r die *)
                                       (* Berechnung von AnzahlTests n�tig *)
VAR i     : INTEGER;                                       (* Z�hlvariable *)
    hilfe : Real;                        (* Hilfsvariable f�r das Ergebnis *)
BEGIN
  IF hoch = 0 THEN                                         (* Hochzahl = 0 *)
    Expt := 1                                           (* => Ergebnis = 1 *)
  ELSE
    BEGIN
      hilfe := 1;                         (* Ergebnis mit 1 initialisieren *)
      FOR i := 1 TO hoch DO hilfe := hilfe * zahl;
                           (* Zahl hoch mal mit sich selbst multiplizieren *)
      Expt := hilfe;                             (* Ergebnis zur�ckliefern *)
    END;
END;

(* ----------------------------------------------------------------------- *)

FUNCTION AnzahlTests(wahrscheinlichkeit : Real) : INTEGER;
        (* ermittelt die Anzahl Tests, welche n�tig sind um die gew�nschte *)
                                        (* Wahrscheinlichkeit zu erreichen *)
VAR anzahl : INTEGER;                          (* Anzahl der n�tigen Tests *)
BEGIN
  anzahl := 0;                              (* Anzahl mit 0 initialisieren *)
  REPEAT
    INC(anzahl);                                    (* Anzahl um 1 erh�hen *)
  UNTIL ((1/(Expt(4,anzahl))) < wahrscheinlichkeit);
                                   (* solange wiederholen, bis W > (1/4)^x *)
  AnzahlTests := anzahl;                       (* Anzahl Tests zur�ckgeben *)
END;

(* ----------------------------------------------------------------------- *)

FUNCTION EvenString(zahl : STRING) : BOOLEAN;
                                        (* pr�ft, on ein String gerade ist *)
BEGIN
  EvenString := NOT Odd(Ord(zahl[Length(zahl)]) - 48);
END;                 (* pr�ft, ob die letzte Stelle des Strings gerade ist *)

(* ----------------------------------------------------------------------- *)

FUNCTION Div5(zahl : STRING) : BOOLEAN;
                           (* pr�ft, ob ein String durch 5 dividierbar ist *)
VAR last : BYTE;                                 (* letzte Stelle von zahl *)
BEGIN
  last := Ord(zahl[Length(zahl)]) - 48;         (* letzte Stelle ermitteln *)
  IF (last = 0) OR (last = 5) THEN     (* Falls letzte Stelle 0 oder 5 ist *)
    Div5 := TRUE                       (* ist die Zahl durch 5 dividierbar *)
  ELSE
    Div5 := FALSE;                                          (* sonst nicht *)
END;                 (* pr�ft, ob die letzte Stelle des Strings gerade ist *)

(* ----------------------------------------------------------------------- *)

FUNCTION Div3(zahl : STRING) : BOOLEAN;
                           (* pr�ft, ob ein String durch 5 dividierbar ist *)
VAR ziffernSumme : WORD;                       (* Ziffernsumme des Strings *)
    laenge       : BYTE;                             (* Laenge des Strings *)
    i            : BYTE;                                   (* Z�hlvariable *)
BEGIN
  ziffernSumme := 0;                        (* Ziffernsumme initialisieren *)
  laenge := Length(zahl);                   (* L�nge des Strings ermitteln *)
  FOR i := 1 TO laenge DO                        (* ZiffernSumme ermitteln *)
    BEGIN
      ziffernSumme := ziffernSumme + (Ord(zahl[i]) - 48);
                                (* aktuelle Zahl zur Ziffernsumme addieren *)
    END;
  IF (ZiffernSumme MOD 3) = 0 THEN         (* Ziffernsumme durch 3 teilbar *)
    Div3 := TRUE                                (* => Zahl durch 3 teilbar *)
  ELSE
    Div3 := FALSE;                 (* sonst ist Zahl nicht durch 3 teilbar *)
END;

(* ----------------------------------------------------------------------- *)
(* Bedingung 1 beim Rabintest: b^vð1 mod p                                 *)

FUNCTION Bedingung1(b, v, p, pMinus1, EINS : CalcStr) : BOOLEAN;
VAR hilfe : CalcStr;                                    (* HilfsCalcString *)
BEGIN
  ExptModCalcStr(b, v, p, hilfe);                   (* b^v mod p berechnen *)

  Write('b^v mod p = '); PrintCalcStr(hilfe);

  IF EqualCalcStr(hilfe, EINS) THEN                  (* Falls Ergebnis = 1 *)
    Bedingung1 := TRUE                              (* Bedingung 1 erf�llt *)
  ELSE
    IF EqualCalcStr(hilfe, pMinus1) THEN
      Bedingung1 := TRUE                    (* Bedingung 2 mit r=0 erf�llt *)
    ELSE
      Bedingung1 := FALSE;          (* sonst ist Bedingung 1 nicht erf�llt *)
END;

(* ----------------------------------------------------------------------- *)
(* Bedingung 2 beim Rabintest: b^(v^(2r)) ð -1 mod p                       *)

FUNCTION Bedingung2(VAR b, v, u, p, pMinus1, EINS : CalcStr) : BOOLEAN;
VAR r      : CalcStr;                       (* zu durchlaufende Hochzahlen *)
    ZWEI   : CalcStr;            (* konstante CalcString-Darstellung f�r 2 *)
    hilfe1 : CalcStr;                                   (* HilfsCalcString *)
    hilfe2 : CalcStr;                                   (* HilfsCalcString *)
BEGIN
  InitCalcStr(r);                                      (* r initialisieren *)
  r.stellen := 1;                 (* r hat 1 Stelle, diese ist zu Beginn 0 *)
  r.zahl[1] := 1;    (* r l�uft von 1 weg, weil Bedingung mit r=0 schon in *)
                                               (* Bedingung 1 gepr�ft wird *)
  WordToCalcStr(2, ZWEI);             (* Zahl zwei in CalcString ermitteln *)
  WHILE LessCalcStr(r, u) DO                              (* solange r < u *)
    BEGIN

      Write('r = '); PrintCalcStr(r);

      ExptCalcStr(ZWEI, r, hilfe1);                       (* 2^r ermitteln *)
      MulCalcStr(hilfe1, v, hilfe2);           (* 2^r mit v multiplizieren *)
      ExptModCalcStr(b, hilfe2, p, hilfe1);    (* b^(v2^r) MOD p berechnen *)

      Write('b^(v2^r) mod p = '); PrintCalcStr(hilfe1);

      IF EqualCalcStr(hilfe1, pMinus1) THEN         (* Falls Ergebnis = -1 *)
        BEGIN
          Bedingung2 := TRUE;                       (* Bedingung 2 erf�llt *)
          EXIT;
        END;
      AddCalcStr(r, EINS, hilfe2);                       (* r um 1 erh�hen *)
      r := hilfe2;                                    (* r wieder zuweisen *)
    END;
  Bedingung2 := FALSE;                       (* 2. Bedingung nicht erf�llt *)
END;

(* ----------------------------------------------------------------------- *)
(* Rabin pr�ft eine Zahl mit Hilfe des RabinTests                          *)

FUNCTION Rabin(primzahl : STRING; anzahl : INTEGER) : BOOLEAN;
VAR p       : CalcStr;                        (* zu untersuchende Primzahl *)
    pMinus1 : CalcStr;                                     (* Primzahl - 1 *)
    EINS    : CalcStr;                            (* konstanter Wert f�r 1 *)
    u       : CalcStr;                         (* p-1 = 2^u*v (v ungerade) *)
    v       : CalcStr;                         (* p-1 = 2^u*v (v ungerade) *)
    b       : CalcStr;                           (* Basis bei Primzahltest *)
    hilfe   : CalcStr;                                  (* HilfsCalcString *)
    i       : BYTE;                                        (* Z�hlvariable *)
BEGIN
  StrToCalcStr(primzahl, p);        (* Primzahl ins 65536-System umwandeln *)
  WordToCalcStr(1, EINS);                   (* CalcStringdarstellung von 1 *)
  SubCalcStr(p, EINS, pMinus1);                     (* vom pMinus1 = p - 1 *)
  InitCalcStr(u);                                      (* u initialisieren *)
  u.stellen := 1;                      (* u besitzt 1 Stellen, diese ist 0 *)
  v := pMinus1;                                     (* v ist zu Beginn p-1 *)
  REPEAT
    AddCalcStr(u, EINS, hilfe);                (* 2^u, Potenz um 1 erh�hen *)
    u := hilfe;                                   (* und wieder u zuweisen *)
    Div2CalcStr(v);                                (* v durch 2 dividieren *)
  UNTIL OddCalcStr(v);                      (* solange, bis v ungerade ist *)

  Write('p = '); PrintCalcStr(p);
  Write('u = '); PrintCalcStr(u);
  Write('v = '); PrintCalcStr(v);

  FOR i := 1 TO anzahl DO                      (* Anzahl Tests durchf�hren *)
    BEGIN
      RandomCalcStr(p, b);                    (* zuf�llige Basis ermitteln *)

      Write('b = '); PrintCalcStr(b);

      IF (Bedingung1(b, v, p, pMinus1, EINS) = FALSE) THEN
                                                    (* 1. Bedingung pr�fen *)
        IF (Bedingung2(b, v, u, p, pMinus1, EINS) = FALSE) THEN
          BEGIN                                     (* 2. Bedingung pr�fen *)
            Rabin := FALSE;
            EXIT;     (* beide Bedingungen nicht erf�llt => keine Primzahl *)
          END;
    END;
  Rabin := TRUE;                                    (* Rabintest bestanden *)
END;

(* ----------------------------------------------------------------------- *)
(* PrimeTest pr�ft, ob Zahl eine Primzahl ist                              *)

FUNCTION PrimeTest(zahl : STRING; anzahlTests : INTEGER; VAR meldung : STRING)
: BOOLEAN;
BEGIN
  IF EvenString(zahl) THEN                 (* Zahl ist durch 2 dividierbar *)
    BEGIN
      PrimeTest := FALSE;                             (* => keine Primzahl *)
      meldung := 'gerade Zahl';                     (* Meldung zur�ckgeben *)
    END
  ELSE
    IF Div5(zahl) THEN               (* Falls Zahl durch 5 dividierbar ist *)
      BEGIN
        PrimeTest := FALSE;                              (* => keine Primzahl
*)
        meldung := 'Zahl durch 5 dividierbar';      (* Meldung zur�ckgeben *)
      END
    ELSE
      IF Div3(zahl) THEN                       (* Zahl durch 3 dividierbar *)
        BEGIN
          PrimeTest := FALSE;                         (* => keine Primzahl *)
          meldung := 'Zahl durch 3 dividierbar';    (* Meldung zur�ckgeben *)
        END
      ELSE
        BEGIN
          IF NOT Rabin(zahl, anzahlTests) THEN  (* Falls Rabintest negativ *)
            BEGIN
              PrimeTest := FALSE;                        (* keine Primzahl *)
              meldung := 'Rabintest';               (* Meldung zur�ckgeben *)
            END
          ELSE
            PrimeTest := TRUE;                  (* sonst ist Zahl Primzahl *)
        END;
END;

(* ----------------------------------------------------------------------- *)
(* Hauptprogramm erledigt die Ein/Ausgabe                                  *)

PROCEDURE Hauptprogramm;                (* Hauptprogramm des Primzahltests *)
VAR anzahl             : INTEGER;              (* Anzahl notwendiger Tests *)
    wahrscheinlichkeit : Real;                 (* Fehlerwahrscheinlichkeit *)
    primzahl           : STRING;                  (* zu untersuchende Zahl *)
    meldung            : STRING;          (* Meldung, warum keine Primzahl *)
    prim               : BOOLEAN;           (* ist sie Primzahl oder nicht *)
BEGIN
  ClrScr;                                            (* Bildschirm l�schen *)
  Frame(27, 1, 53, 3, 1, '', TRUE);                     (* Rahmen ausgeben *)
  WriteXY(29, 2, 'Primzahltest nach Rabin');
  GotoXY(1, 6);
  WriteLn('1. Test: gerade Zahl');                       (* Tests anzeigen *)
  WriteLn('2. Test: Zahl durch 5 dividierbar');
  WriteLn('3. Test: Ziffernsumme durch 3 dividerbar');
  WriteLn('4. Test: RabinTest');
  WriteLn;
  Write('Primzahl (p): '); ReadLn(primzahl);          (* Primzahl eingeben *)
  Write('Fehlerwahrscheinlichkeit: '); ReadLn(wahrscheinlichkeit);
                                      (* Fehlerwahrscheinlichkeit eingeben *)
  anzahl := AnzahlTests(wahrscheinlichkeit);       (* Testanzahl ermitteln *)
  WriteLn;
  WriteLn('Anzahl Tests: ', anzahl);
  WriteLn;
  prim := PrimeTest(primzahl, anzahl, meldung);     (* auf Primzahl testen *)
  Write(primzahl, ' ist ');
  IF NOT prim THEN
    WriteLn('keine Primzahl (',meldung,')')            (* Meldung ausgeben *)
  ELSE
    WriteLn('Primzahl');
END;

(* ----------------------------------------------------------------------- *)

BEGIN
  Hauptprogramm;                                 (* Hauptprogramm aufrufen *)
END.

(* ----------------------------------------------------------------------- *)

(* ----------------------------------------------------------------------- *)
(* MyCalc stellt eine LongInteger-Arithmetik zur Verfuegung                *)
(* ----------------------------------------------------------------------- *)

{$M 65000, 0, 655360}                          (* Stack auf maximale Groesse *)

UNIT MyCalc;

INTERFACE

CONST MAXCALCSTR = 500;                         (* maximal 500 Word-Zahlen *)

TYPE CalcStr = RECORD
                 stellen    : WORD;         (* Anzahl der belegten Stellen *)
                 zahl       : ARRAY[1..MAXCALCSTR] OF WORD;  (* groáe Zahl *)
               END;

PROCEDURE InitCalcStr(VAR calcZahl : CalcStr);
PROCEDURE ReverseCalcStr(VAR ergebnis : CalcStr);
PROCEDURE SwapCalcStr(VAR zahl1, zahl2 : CalcStr);
PROCEDURE PrintCalcStr(VAR calcZahl : CalcStr);
PROCEDURE StrToCalcStr(zeichenkette : STRING; VAR ergebnis : CalcStr);
PROCEDURE WordToCalcStr(zahl : WORD; VAR ergebnis : CalcStr);
PROCEDURE AddCalcStr(VAR zahl1, zahl2 : CalcStr; VAR ergebnis : CalcStr);
PROCEDURE SubCalcStr(VAR zahl1, zahl2 : CalcStr; VAR ergebnis : CalcStr);
PROCEDURE Mul2CalcStr(VAR calcZahl : CalcStr);
PROCEDURE Div2CalcStr(VAR calcZahl : CalcStr);
PROCEDURE MulCalcStr(VAR zahl1, zahl2 : CalcStr; VAR ergebnis : CalcStr);
PROCEDURE ExptCalcStr(VAR basis, exponent: CalcStr; VAR ergebnis : CalcStr);
PROCEDURE RandomCalcStr(VAR calcZahl: CalcStr; VAR ergebnis : CalcStr);
PROCEDURE MulModCalcStr(VAR zahl1, zahl2, modul : CalcStr; VAR ergebnis :
CalcStr);
PROCEDURE ExptModCalcStr(VAR basis, exponent, modul : CalcStr; VAR ergebnis :
CalcStr);

FUNCTION CalcStrLength(VAR calcZahl : CalcStr) : WORD;
FUNCTION CalcStrToStr(VAR calcZahl : CalcStr; VAR ergebnis : STRING) : BOOLEAN;
FUNCTION CalcStrToWord(VAR calcZahl : CalcStr; VAR ergebnis : WORD) : BOOLEAN;
FUNCTION EqualCalcStr(VAR zahl1, zahl2 : CalcStr) : BOOLEAN;
FUNCTION GreaterCalcStr(VAR zahl1, zahl2 : CalcStr) : BOOLEAN;
FUNCTION GreaterEqual(VAR zahl1, zahl2 : CalcStr) : BOOLEAN;
FUNCTION LessCalcStr(VAR zahl1, zahl2 : CalcStr) : BOOLEAN;
FUNCTION LessEqual(VAR zahl1, zahl2 : CalcStr) : BOOLEAN;
FUNCTION EvenCalcStr(VAR calcZahl : CalcStr) : BOOLEAN;
FUNCTION OddCalcStr(VAR calcZahl : CalcStr) : BOOLEAN;
FUNCTION DivCalcStr(VAR zahl1, zahl2 : CalcStr; VAR ergebnis : CalcStr) :
BOOLEAN;
FUNCTION ModCalcStr(VAR zahl1, zahl2 : CalcStr; VAR ergebnis : CalcStr) :
BOOLEAN;

IMPLEMENTATION

USES Crt;                                         (* Ein/Ausgabefunktionen *)

VAR EMPTYCALCSTR : CalcStr;                           (* leerer CalcString *)
    i            : WORD;
                      (* Z�hlvariable zur Initialisierung von EMPTYCALCSTR *)

(* ======================================================================= *)
(* Bitmanipulationen                                                       *)

(* ----------------------------------------------------------------------- *)
(* SetBit setzt das BitNr.te Bit in Zahl                                   *)

FUNCTION SetBit(zahl : WORD; bitNr : BYTE): WORD;
BEGIN
  SetBit := zahl OR (1 SHL bitNr)
               (* BitNr Stellen nach links shiften und mit oder verkn�pfen *)
END;

(* ----------------------------------------------------------------------- *)
(* TestBit pr�ft, ob das BitNr.te Bit in Zahl gesetzt ist                  *)

FUNCTION TestBit(zahl : WORD; bitNr: BYTE): BOOLEAN;
BEGIN
  TestBit := (((zahl SHR bitNr) AND 1) = 1)
             (* Bit ist dann gesetzt, falls an der BitNr. Stelle bei einer *)
                              (* Und-Verkn�pfung wieder 1 das Ergebnis ist *)
END;

(* ======================================================================= *)
(* Hilfsfunktionen f�r Strings                                             *)

(* ----------------------------------------------------------------------- *)
(* TestString pr�ft, ob im String eine g�ltige Zahl enthalten ist          *)

FUNCTION TestString(zeichenkette : STRING) : BOOLEAN;
VAR laenge : BYTE;                               (* L�nge der Zeichenkette *)
    i      : BYTE;                                         (* Z�hlvariable *)
BEGIN
  laenge := Length(zeichenkette);      (* L�nge der Zeichenkette ermitteln *)
  FOR i := 1 TO laenge DO
    IF (NOT (zeichenkette[i] IN ['0'..'9'])) THEN            (* keine Zahl *)
      BEGIN
        TestString := FALSE;                        (* String ist ung�ltig *)
        EXIT;                                        (* Funktion verlassen *)
      END;
  TestString := TRUE;
END;

(* ----------------------------------------------------------------------- *)
(* OddString pr�ft, ob ein String ungerade ist                             *)

FUNCTION OddString(zeichenkette : STRING) : BOOLEAN;
VAR zahl   : BYTE;                          (* Bytedarstellung von Zeichen *)
    dummy  : INTEGER;  (* dient zur �berpr�fung von zeichen bei Umwandlung *)
    last   : CHAR;                      (* letztes Zeichen in zeichenkette *)
    laenge : BYTE;                               (* L�nge der Zeichenkette *)
BEGIN
  laenge := Length(zeichenkette);        (* L�nge muá neu ermittelt werden *)
  last := zeichenkette[laenge];                         (* letztes Zeichen *)
  Val(last, zahl, dummy);             (* letztes Zeichen in zahl umwandeln *)
  oddString := Odd(zahl);                  (* pr�fen, ob zahl ungerade ist *)
END;

(* ----------------------------------------------------------------------- *)
(* StrDiv2 dividiert einen String durch 2                                  *)

FUNCTION StrDiv2(zeichenkette : STRING) : STRING;
VAR hilfe      : STRING;                   (* Hilfsstring f�r das Ergebnis *)
    index      : BYTE;               (* Index f�r Position in zeichenkette *)
    laenge     : BYTE;                           (* L�nge der Zeichenkette *)
    zahl       : BYTE;                          (* zu dividierender Faktor *)
    zeichen    : CHAR;                      (* Zeichendarstellung von Zahl *)
    dummy      : INTEGER;
                       (* dient zur �berpr�fung von zeichen bei Umwandlung *)
    uebertrag  : BOOLEAN;                  (* ist ein �bertrag aufgetreten *)
BEGIN
  hilfe := '';                                     (* hilfe initialisieren *)
  laenge := Length(zeichenkette);                (* L�nge der zeichenkette *)
  IF oddString(zeichenkette) THEN           (* falls die Zahl ungerade ist *)
    DEC(zeichenkette[laenge]);                 (* Zahl um 1 dekrementieren *)
  uebertrag := FALSE;                                     (* kein �bertrag *)
  IF zeichenkette[1] = '1' THEN               (* falls an 1.Stelle ein 1er *)
    BEGIN
      index := 2;                              (* an 2.Stelle weitermachen *)
      zahl := 10;                     (* �bertrag an 1.Stelle => zahl = 10 *)
    END
  ELSE
    BEGIN
      index := 1;                                  (* beginne bei 1.Stelle *)
      zahl := 0;                                            (* => zahl = 0 *)
    END;
  REPEAT
    zahl := zahl + Ord(zeichenkette[index]) - 48;        (* Zahl ermitteln *)
    IF (zahl AND 1) = 1 THEN uebertrag := TRUE;
                                              (* ungerade zahl => �bertrag *)
    zahl := zahl SHR 1;                         (* zahl durch 2 dividieren *)
    zeichen := Chr(zahl + 48);   (* Zahl wieder in ASCII-Zeichen umwandeln *)
    hilfe := hilfe + zeichen;                     (* und an hilfe anh�ngen *)
    INC(index);                                      (* Index um 1 erh�hen *)
    IF uebertrag THEN                                          (* �bertrag *)
      zahl := 10                               (* �bertrag in zahl sichern *)
    ELSE
      zahl := 0;                                         (* sonst zahl = 0 *)
    uebertrag := FALSE;                          (* Annahme: kein �bertrag *)
  UNTIL index > laenge;               (* keine Zeichen mehr zum dividieren *)
  StrDiv2 := hilfe;                             (* Ergebnis steht in Hilfe *)
END;

(* ----------------------------------------------------------------------- *)
(* StrMul2 multipliziert einen String mit 2                                *)

FUNCTION StrMul2(zeichenkette : STRING) : STRING;
VAR laenge     : BYTE;                          (* Laenge der zeichenkette *)
    i          : BYTE;                                     (* Z�hlvariable *)
    hilfe      : STRING;                       (* Hilfsstring f�r Ergebnis *)
    dummyStr   : STRING;           (* dient zur Umwandlung Zahl -> Zeichen *)
    uebertrag  : BOOLEAN;                              (* �bertrag ja/nein *)
    zeichen    : CHAR;                                (* aktuelles Zeichen *)
    zahl       : BYTE;                     (* Byte-Darstellung von zeichen *)
    dummy      : INTEGER;  (* dient zur Pr�fung von zeichen bei Umwandlung *)
BEGIN
  laenge := Length(zeichenkette);                       (* L�nge ermitteln *)
  uebertrag := FALSE;                            (* Annahme: kein �bertrag *)
  hilfe := '';                               (* Hilfsstring initialisieren *)
  FOR i := laenge DOWNTO 1 DO        (* zeichenkette r�ckw�rts durchlaufen *)
    BEGIN
      zeichen := zeichenkette[i];           (* aktuelles Zeichen ermitteln *)
      zahl := Ord(zeichen) - 48;                 (* in eine Zahl umwandeln *)
      zahl := zahl SHL 1;                     (* Zahl mit 2 multiplizieren *)
      IF uebertrag THEN INC(zahl);              (* bei �bertrag 1 addieren *)
      IF (zahl >= 10) THEN                             (* falls Zahl >= 10 *)
        BEGIN
          uebertrag := TRUE;                       (* �bertrag aufgetreten *)
          zahl := zahl - 10;                      (* �bertrag wegschneiden *)
        END
      ELSE
        uebertrag := FALSE;                         (* sonst kein �bertrag *)
      zeichen := Chr(zahl + 48);              (* zahl in Zeichen umwandeln *)
      hilfe := zeichen + hilfe;                   (* und an Hilfe anh�ngen *)
    END;
  IF uebertrag THEN hilfe := '1' + hilfe;
                               (* restlichen �bertrag noch ber�cksichtigen *)
  StrMul2 := hilfe;                                   (* Ergebnis zuweisen *)
END;

(* ======================================================================= *)
(* Operationen auf den Datentyp CalcString                                 *)

(* ----------------------------------------------------------------------- *)
(* InitCalcStr initialisiert einen CalcString:                             *)

PROCEDURE InitCalcStr(VAR calcZahl : CalcStr);
BEGIN
  calcZahl := EMPTYCALCSTR;                     (* leeren CalcStr zuweisen *)
END;

(* ----------------------------------------------------------------------- *)
(* CalcStrLength liefert die L�nge des CalcStrings zur�ck                  *)

FUNCTION CalcStrLength(VAR calcZahl : CalcStr) : WORD;
BEGIN
  CalcStrLength := calcZahl.stellen;   (* L�nge ist in stellen gespeichert *)
END;

(* ----------------------------------------------------------------------- *)
(* ReverseCalcStr dreht einen CalcString um                                *)

PROCEDURE ReverseCalcStr(VAR ergebnis : CalcStr);
VAR laenge : WORD;                         (* Anzahl Stellen im CalcString *)
    i      : WORD;                                         (* Z�hlvariable *)
    anzahl : WORD;                                (* ben�tigte Schrittzahl *)
    hilfe  : WORD;                                     (* Zwischenspeicher *)
BEGIN
  laenge := CalcStrLength(ergebnis);    (* L�nge des CalcStrings ermitteln *)
  anzahl := laenge DIV 2;            (* man ben�tigt nur laenge/2 Schritte *)
  WITH ergebnis DO                                    (* Record abarbeiten *)
    BEGIN
      FOR i := 1 TO anzahl DO
        BEGIN
          hilfe := zahl[i];                              (* i. Zahl merken *)
          zahl[i] := zahl[laenge - (i - 1)];
                        (* i. Zahl wird zur entsprechenden Zahl von hinten *)
          zahl[laenge - (i - 1)] := hilfe;  (* hintere Zahl wird i.te Zahl *)
        END;
    END;
END;

(* ----------------------------------------------------------------------- *)
(* SwapCalcStr vertauscht zwei CalcStrings                                 *)

PROCEDURE SwapCalcStr(VAR zahl1, zahl2 : CalcStr);
VAR hilfe : CalcStr;                       (* HilfsString f�r Vertauschung *)
BEGIN
  hilfe := zahl1;                                (* Hilfe auf Zahl1 setzen *)
  zahl1 := zahl2;                                (* Zahl1 auf Zahl2 setzen *)
  zahl2 := hilfe;                                (* Zahl2 auf Hilfe setzen *)
END;

(* ----------------------------------------------------------------------- *)
(* PrintCalcStr gibt einen CalcString als Vektor auf dem Bildschirm aus    *)

PROCEDURE PrintCalcStr(VAR calcZahl : CalcStr);
VAR i : WORD;                                              (* Z�hlvariable *)
BEGIN
  ReverseCalcStr(calcZahl);               (* calcZahl muá umgedreht werden *)
  WITH calcZahl DO                              (* Recordtyp als Grundlage *)
    BEGIN
      IF stellen > 0 THEN                        (* Zahl darf nicht 0 sein *)
        BEGIN
          Write('(');                              (* positives Vorzeichen *)
          FOR i := 1 TO (stellen - 1) DO        (* alle Stellen abarbeiten *)
            BEGIN
              Write(zahl[i]);                             (* Zahl ausgeben *)
              Write(',');                       (* durch Beistrich trennen *)
            END;
          Write(zahl[stellen]);                    (* letzte Zahl ausgeben *)
          WriteLn(')');                   (* Klammer des Vektors schlieáen *)
        END
      ELSE
        WriteLn('(0)');                                (* sonst 0 ausgeben *)
    END;
  ReverseCalcStr(calcZahl);        (* calcZahl muá wieder umgedreht werden *)
END;

(* ----------------------------------------------------------------------- *)
(* StrToCalcStr wandelt einen String in einen CalcString um                *)

PROCEDURE StrToCalcStr(zeichenkette : STRING; VAR ergebnis : CalcStr);
VAR index  : WORD;                          (* Index im ErgebnisCalcString *)
    bitnr  : BYTE;                        (* Nummer des zu setzenden Bit's *)
    laenge : BYTE;                               (* L�nge der Zeichenkette *)
BEGIN
  ergebnis := EMPTYCALCSTR;               (* ErgebnisString initialisieren *)
  index := 1;                              (* erstes Element im CalcString *)
  ergebnis.stellen := 1;       (* L�nge des CalcStrings wird auf 1 gesetzt *)
  bitnr := 0;                (* zu Beginn wird Bit 0 gesetzt/nicht gesetzt *)
  laenge := Length(zeichenkette);      (* L�nge der Zeichenkette ermitteln *)
  IF TestString(zeichenkette) THEN   (* ist zeichenkette eine g�ltige Zahl *)
    WITH ergebnis DO                               (* Record als Grundlage *)
      BEGIN
        REPEAT
          IF oddString(zeichenkette) THEN   (* ist zeichenkette ungerade ? *)
            zahl[index] := SetBit(zahl[index], bitnr);       (* Bit setzen *)
          zeichenkette := StrDiv2(zeichenkette);       (* Zeichenkette / 2 *)
          IF zeichenkette <> '0' THEN           (* falls noch nicht fertig *)
            BEGIN
              INC(bitnr);                            (* BitNr um 1 erh�hen *)
              IF bitnr >= 16 THEN                 (* falls 1 Word voll ist *)
                BEGIN
                  bitnr := 0;                       (* BitNr wird wieder 0 *)
                  INC(index);          (* ein Element im CalcString weiter *)
                  INC(stellen);  (* L�nge des CalcStrings wird um 1 erh�ht *)
                END;
            END;
        UNTIL zeichenkette = '0';      (* bis zeichenkette auf 0 reduziert *)
      END;
END;

(* ----------------------------------------------------------------------- *)
(* CalcStrToStr wandelt eine CalcString um, falls er sich als String       *)
(* darstellen l�át                                                         *)

FUNCTION CalcStrToStr(VAR calcZahl : CalcStr; VAR ergebnis : STRING) : BOOLEAN;
VAR i      : WORD;                                         (* Z�hlvariable *)
    BitNr  : BYTE;                            (* Nummer des aktuellen Bits *)
    anzahl : WORD;                         (* Anzahl Stellen im CalcString *)
    laenge : BYTE;                            (* L�nge des Ergebnisstrings *)
BEGIN
  IF calcZahl.Stellen > 50 THEN         (* Stringl�nge w�rde �berschritten *)
    CalcStrToStr := FALSE                                (* String�berlauf *)
  ELSE
    BEGIN                                     (* Zahl paát in einen String *)
      ergebnis := '0';                   (* Ergebnisstring ist zu Beginn 0 *)
      anzahl := CalcStrLength(calcZahl);          (* L�nge des CalcStrings *)
      FOR i := anzahl DOWNTO 1 DO
                               (* alle Element des CalcStrings durchlaufen *)
        FOR BitNr := 15 DOWNTO 0 DO                    (* alle Bits pr�fen *)
          BEGIN
            ergebnis := StrMul2(ergebnis);   (* ErgebnisString mit 2 mult. *)
            IF TestBit(calcZahl.zahl[i], BitNr) THEN
                                                  (* Ist das Bit gesetzt ? *)
              BEGIN
                laenge := Length(ergebnis);             (* L�nge ermitteln *)
                INC(ergebnis[laenge]);     (* letztes Zeichen um 1 erh�hen *)
              END;
          END;
      CalcStrToStr := TRUE;                         (* Umwandlung gegl�ckt *)
    END;
END;

(* ----------------------------------------------------------------------- *)
(* WordToCalcStr wandelt eine Wordzahl in einen CalcString um              *)

PROCEDURE WordToCalcStr(zahl : WORD; VAR ergebnis : CalcStr);
BEGIN
  ergebnis := EMPTYCALCSTR;                     (* Ergebnis initialisieren *)
  ergebnis.stellen := 1;                           (* 1 Stelle wird belegt *)
  ergebnis.zahl[1] := zahl;                    (* Zahl in CalcZahl sichern *)
END;

(* ----------------------------------------------------------------------- *)
(* CalcStrToWord wandelt einen CalcString in eine Wordzahl um              *)

FUNCTION CalcStrToWord(VAR calcZahl : CalcStr; VAR ergebnis : WORD) : BOOLEAN;
BEGIN
  IF (calcZahl.Stellen > 1) THEN
            (* Zahl mit mehr als 1 Stelle k�nnen nicht  umgewandelt werden *)
    CalcStrToWord := FALSE                             (* keine Umwandlung *)
  ELSE
    BEGIN
      ergebnis := calcZahl.zahl[1];                (* Ergebnis zur�ckgeben *)
      CalcStrToWord := TRUE;                        (* Umwandlung gegl�ckt *)
    END;
END;

(* ----------------------------------------------------------------------- *)
(* EqualCalcStr pr�ft, ob ein CalcStr1 = CalcStr2                          *)

FUNCTION EqualCalcStr(VAR zahl1, zahl2 : CalcStr) : BOOLEAN;
VAR i : WORD;                                              (* Z�hlvariable *)
BEGIN
  IF (zahl1.stellen <> zahl2.stellen) THEN
    EqualCalcStr := FALSE               (* unterschiedliche Anzahl Stellen *)
  ELSE                                               (* Stellenzahl gleich *)
    BEGIN
      FOR i := 1 TO zahl1.stellen DO            (* alle Stellen abarbeiten *)
        IF zahl1.zahl[i] <> zahl2.zahl[i] THEN       (* Zahlen verschieden *)
          BEGIN
            EqualCalcStr := FALSE;              (* Zahlen sind verschieden *)
            EXIT;                                    (* Schleife verlassen *)
          END;
      EqualCalcStr := TRUE;                          (* Zahlen sind gleich *)
    END;
END;

(* ----------------------------------------------------------------------- *)
(* GreaterCalcStr pr�ft, ob ein CalcStr1 > CalcStr2                        *)

FUNCTION GreaterCalcStr(VAR zahl1, zahl2 : CalcStr) : BOOLEAN;
VAR i     : WORD;                                          (* Z�hlvariable *)
    hilfe : BOOLEAN;                                      (* Hilfsvariable *)
BEGIN
  IF (zahl1.stellen > zahl2.stellen) THEN    (* Zahl1 besitzt mehr Stellen *)
    GreaterCalcStr := TRUE                             (* => Zahl1 > Zahl2 *)
  ELSE
    IF (zahl1.stellen < zahl2.stellen) THEN
                                          (* Zahl1 besitzt weniger Stellen *)
      GreaterCalcStr := FALSE                    (* => Zahl1 nicht > Zahl2 *)
    ELSE                                             (* Stellenzahl gleich *)
      BEGIN
        FOR i := zahl1.stellen DOWNTO 1 DO      (* alle Stellen abarbeiten *)
          IF zahl1.zahl[i] > zahl2.zahl[i] THEN
                             (* i.Stelle von Zahl1 > i.te Stelle von Zahl2 *)
            BEGIN
              GreaterCalcStr := TRUE;                     (* Zahl1 > Zahl2 *)
              EXIT;                                  (* Schleife verlassen *)
            END
          ELSE
            IF zahl1.zahl[i] < zahl2.zahl[i] THEN
                             (* i.Stelle von Zahl1 < i.te Stelle von Zahl2 *)
              BEGIN
                GreaterCalcStr := FALSE;            (* Zahl1 nicht > Zahl2 *)
                EXIT;                                (* Schleife verlassen *)
              END;
        GreaterCalcStr := FALSE;               (* alle Stellen sind gleich *)
      END;
END;

(* ----------------------------------------------------------------------- *)
(* GreaterEqual pr�ft, ob Zahl1 >= Zahl2                                   *)

FUNCTION GreaterEqual(VAR zahl1, zahl2 : CalcStr) : BOOLEAN;
BEGIN
  GreaterEqual := NOT LessCalcStr(zahl1, zahl2);
                 (* Zahl1 >= Zahl2, wenn Zahl1 nicht kleiner als Zahl2 ist *)
END;

(* ----------------------------------------------------------------------- *)
(* LessCalcStr pr�ft, on Zahl1 < Zahl2                                     *)

FUNCTION LessCalcStr(VAR zahl1, zahl2 : CalcStr) : BOOLEAN;
VAR i     : WORD;                                          (* Z�hlvariable *)
    hilfe : BOOLEAN;                                      (* Hilfsvariable *)
BEGIN
  IF (zahl1.stellen < zahl2.stellen) THEN (* Zahl1 besitzt weniger Stellen *)
    LessCalcStr := TRUE                                (* => Zahl1 < Zahl2 *)
  ELSE
    IF (zahl1.stellen > zahl2.stellen) THEN  (* Zahl1 besitzt mehr Stellen *)
      LessCalcStr := FALSE                       (* => Zahl1 nicht < Zahl2 *)
    ELSE                                             (* Stellenzahl gleich *)
      BEGIN
        FOR i := zahl1.stellen DOWNTO 1 DO      (* alle Stellen abarbeiten *)
          IF zahl1.zahl[i] < zahl2.zahl[i] THEN
                             (* i.Stelle von Zahl1 < i.te Stelle von Zahl2 *)
            BEGIN
              LessCalcStr := TRUE;                        (* Zahl1 < Zahl2 *)
              EXIT;                                  (* Schleife verlassen *)
            END
          ELSE
            IF zahl1.zahl[i] > zahl2.zahl[i] THEN
                             (* i.Stelle von Zahl1 > i.te Stelle von Zahl2 *)
              BEGIN
                LessCalcStr := FALSE;               (* Zahl1 nicht < Zahl2 *)
                EXIT;                                (* Schleife verlassen *)
              END;
        LessCalcStr := FALSE;                  (* alle Stellen sind gleich *)
      END;
END;

(* ----------------------------------------------------------------------- *)
(* LessEqual pr�ft, ob Zahl1 <= Zahl2                                      *)

FUNCTION LessEqual(VAR zahl1, zahl2 : CalcStr) : BOOLEAN;
BEGIN
  LessEqual := NOT GreaterCalcStr(zahl1, zahl2);
                  (* Zahl1 <= Zahl2, wenn Zahl1 nicht gr�áer als Zahl2 ist *)
END;

(* ----------------------------------------------------------------------- *)
(* EvenCalcStr pr�ft, ob ein CalcString gerade ist                         *)

FUNCTION EvenCalcStr(VAR calcZahl : CalcStr) : BOOLEAN;
BEGIN
  EvenCalcStr := NOT Odd(calcZahl.zahl[1]);
        (* CalcZahl ist gerade, falls die letzte Stelle nicht ungerade ist *)
END;

(* ----------------------------------------------------------------------- *)
(* OddCalcStr pr�ft, ob ein CalcString ungerade ist                        *)

FUNCTION OddCalcStr(VAR calcZahl : CalcStr) : BOOLEAN;
BEGIN
  OddCalcStr := Odd(calcZahl.zahl[1]);
            (* CalcZahl ist ungerade, falls die letzte Stelle ungerade ist *)
END;

(* ----------------------------------------------------------------------- *)
(* AddCalcStr addiert zwei CalcStrings                                     *)

PROCEDURE AddCalcStr(VAR zahl1, zahl2 : CalcStr; VAR ergebnis : CalcStr);
VAR anzahl    : WORD;                       (* Anzahl Stellen f�r Addition *)
    i         : WORD;                                      (* Z�hlvariable *)
    summe     : LongInt;      (* Hilfsvariable zur Pr�fung eines �bertrags *)
    ueberlauf : BYTE;                   (* �berlauf = 1, kein �berlauf = 0 *)
    addition  : BOOLEAN;        (* k�nnen Zahlen addiert werden oder nicht *)
BEGIN
  {$Q-}                                     (* �berlaufpr�fung ausschalten *)
  ergebnis := EMPTYCALCSTR;                     (* Ergebnis initialisieren *)
  anzahl := zahl1.stellen;                   (* Annahme: Zahl 1 ist gr�áer *)
  IF zahl2.stellen > anzahl THEN          (* Falls doch 2. Zahl gr�áer ist *)
    anzahl := zahl2.stellen;     (* so viele Stellen m�ssen addiert werden *)
  ueberlauf := 0;                               (* zu Beginn kein �berlauf *)
  FOR i := 1 TO anzahl DO                     (* anzahl Stellen abarbeiten *)
    BEGIN
      ergebnis.zahl[i] := zahl1.zahl[i] + zahl2.zahl[i] + ueberlauf;
                 (* ergebnis ist die Summe der beiden Zahlen (kann einfach *)
                 (* addiert werden, weil �berlaufpr�fung ausgeschaltet ist *)
      summe := LongInt(zahl1.zahl[i]) + LongInt(zahl2.zahl[i]) + ueberlauf;
                                                    (* Summe ohne �berlauf *)
      IF (summe > ergebnis.zahl[i]) THEN   (* ist ein �berlauf aufgetreten *)
        ueberlauf := 1                      (* ja -> �berlauf auf 1 setzen *)
      ELSE
        ueberlauf := 0;                          (* nein -> �berlauf ist 0 *)
    END;
  IF (ueberlauf = 1) THEN           (* letzter �berlauf muá gepr�ft werden *)
    BEGIN
      ergebnis.stellen := anzahl + 1;    (* letzter �berlauf belegt 1 Feld *)
      ergebnis.zahl[anzahl + 1] := 1;      (* Zahl 1 steht im letzten Feld *)
    END
  ELSE
    ergebnis.stellen := anzahl;
                              (* gleich viele Stellen wie die l�ngere Zahl *)
  {$Q+}                              (* �berlaufpr�fung wieder einschalten *)
END;

(* ----------------------------------------------------------------------- *)
(* SubCalcStr subtrahiert zahl2 von zahl1                                  *)

PROCEDURE SubCalcStr(VAR zahl1, zahl2 : CalcStr; VAR ergebnis : CalcStr);
VAR swapped   : BOOLEAN;            (* wurden Zahl1 und Zahl2 vertauscht ? *)
    i         : WORD;                                      (* Z�hlvariable *)
    uebertrag : BYTE;                     (* �bertrag: 1, kein �bertrag: 0 *)
BEGIN
  ergebnis := EMPTYCALCSTR;                     (* Ergebnis initialisieren *)
  swapped := FALSE;                      (* Zahlen wurden nicht vertauscht *)
  uebertrag := 0;                                         (* kein �bertrag *)
  IF GreaterCalcStr(zahl2, zahl1) THEN EXIT;              (* Zahl2 > Zahl1 *)
  FOR i := 1 TO zahl1.stellen DO                (* alle Stellen abarbeiten *)
    BEGIN
      IF (zahl1.zahl[i] >= (zahl2.zahl[i] + uebertrag)) THEN
                (* Zahl1[i] >= Zahl2[i] mit Ber�cksichtigung des �bertrags *)
        BEGIN
          ergebnis.zahl[i] := zahl1.zahl[i] - (zahl2.zahl[i] + uebertrag);
                                         (* Differenz der Zahlen ermitteln *)
          uebertrag := 0;                                 (* kein �bertrag *)
        END
      ELSE
        BEGIN
          ergebnis.zahl[i] := LongInt(zahl1.zahl[i] + 65536) - (zahl2.zahl[i] +
uebertrag);
          uebertrag := 1;
        END;
     END;
  ergebnis.stellen := zahl1.stellen;
                                 (* Annahme: gleich viel Stellen wie Zahl1 *)
  WHILE (ergebnis.zahl[ergebnis.stellen] = 0) AND (ergebnis.stellen > 0) DO
    DEC(ergebnis.stellen);               (* richtige Stellenzahl ermitteln *)
END;

(* ----------------------------------------------------------------------- *)
(* Mul2CalcStr multipliziert einen CalcString mit 2                        *)

PROCEDURE Mul2CalcStr(VAR calcZahl : CalcStr);
VAR i : WORD;                                              (* Z�hlvariable *)
BEGIN
  WITH calcZahl DO                                 (* Record als Grundlage *)
    IF ((stellen = 1) AND (zahl[1] = 0)) OR (stellen = 0) THEN
    ELSE                               (* CalcZahl ist 0 => Ergebnis ist 0 *)
      BEGIN                                     (* Sonst ist Ergebnis <> 0 *)
        IF (zahl[stellen] AND 32768) > 0 THEN
          BEGIN                 (* Ist 16.Bit der letzten Stelle gesetzt ? *)
            INC(stellen);                      (* Stellenzahl um 1 erh�hen *)
            zahl[stellen] := 0;                (* und mit 0 initialisieren *)
          END;
        FOR i := (stellen - 1) DOWNTO 1 DO              (* Zahl abarbeiten *)
          BEGIN
            zahl[i + 1] := zahl[i + 1] SHL 1;           (* Zahl[i + 1] * 2 *)
            IF (zahl[i] AND 32768) > 0 THEN INC(zahl[i + 1]);
          END;          (* Bei �berlauf bei Zahl[i] => Zahl[i + 1] erh�hen *)
        zahl[1] := zahl[1] SHL 1;          (* 1. Zahl mit 2 multiplizieren *)
      END;
END;

(* ----------------------------------------------------------------------- *)
(* Div2CalcStr dividiert einen CalcString durch 2                          *)

PROCEDURE Div2CalcStr(VAR calcZahl : CalcStr);
VAR i : WORD;                                              (* Z�hlvariable *)
BEGIN
  WITH calcZahl DO
    IF ((stellen = 1) AND (zahl[1] = 0)) OR (stellen = 0) THEN
    ELSE                               (* calcZahl = 0 => calcZahl * 2 = 0 *)
      BEGIN
        FOR i := 1 TO (stellen - 1) DO                  (* Zahl abarbeiten *)
          BEGIN
            zahl[i] := zahl[i] SHR 1;                     (* Zahl[i] DIV 2 *)
            IF (zahl[i + 1] AND 1) > 0 THEN
                           (* Falls bei Zahl[i + 1] ein Unterlauf auftritt *)
              zahl[i] := zahl[i] OR 32768;    (* Bit 16 bei Zahl[i] setzen *)
          END;
        zahl[stellen] := zahl[stellen] SHR 1;       (* letzte Stelle DIV 2 *)
        IF (zahl[stellen] = 0) THEN DEC(stellen);
                  (* Falls letzte Stelle 0 ist => Stellen um 1 erniedrigen *)
      END;
END;

(* ----------------------------------------------------------------------- *)
(* MulCalcStr multiplizier2 zahl1 mit zahl2                                *)

PROCEDURE MulCalcStr(VAR zahl1, zahl2 : CalcStr; VAR ergebnis : CalcStr);
VAR hilfe       : CalcStr;                              (* HilfsCalcString *)
    hilfe1      : CalcStr;                              (* HilfsCalcString *)
    hilfe2      : CalcStr;                              (* HilfsCalcString *)
    i, j        : WORD;                                   (* Z�hlvariablen *)
    wert        : WORD;               (* Wert von Zahl an der i.ten Stelle *)
BEGIN
  IF LessCalcStr(zahl1, zahl2) THEN                 (* Falls zahl1 < zahl2 *)
    BEGIN
      hilfe1 := zahl1;                     (* Hilfe1 wird Zahl1 zugewiesen *)
      hilfe2 := zahl2;                     (* Hilfe2 wird Zahl2 zugewiesen *)
    END
  ELSE
    BEGIN
      hilfe2 := zahl1;                     (* Hilfe2 wird Zahl1 zugewiesen *)
      hilfe1 := zahl2;                     (* Hilfe1 wird Zahl2 zugewiesen *)
    END;
  ergebnis := EMPTYCALCSTR;                     (* Ergebnis initialisieren *)
  IF ((hilfe1.stellen = 1) AND (hilfe1.zahl[1] = 0)) OR (hilfe1.stellen = 0)
THEN
  ELSE                                       (* Ergebnis=0, weil X * 0 = 0 *)
    BEGIN
      i := 1;                                    (* i mit 1 initialisieren *)
      WHILE (i <= (hilfe1.stellen - 1)) DO           (* Hilfe 1 abarbeiten *)
        BEGIN
          wert := hilfe1.zahl[i];                         (* Wert = i.Zahl *)
          j := 1;                                (* j mit 1 initialisieren *)
          WHILE (j <= 16) DO                       (* alle Bits abarbeiten *)
            BEGIN
              IF (wert AND 1) > 0 THEN              (* Falls 1.Bit gesetzt *)
                BEGIN
                  AddCalcStr(ergebnis, hilfe2, hilfe);
                                           (* Ergebnis und Hilfe2 addieren *)
                  ergebnis := hilfe;              (* Ergebnis aus Addition *)
                END;
              wert := wert SHR 1;                            (* Wert DIV 2 *)
              Mul2CalcStr(hilfe2);                           (* Hilfe2 * 2 *)
              INC(j);                                    (* j um 1 erh�hen *)
            END;
          INC(i);                                        (* i um 1 erh�hen *)
        END;
      wert := hilfe1.zahl[hilfe1.stellen];      (* letzte Stelle behandeln *)
      WHILE wert > 0 DO                  (* Solange noch 1 Bit gesetzt ist *)
        BEGIN
          IF (wert AND 1) > 0 THEN              (* Falls Bit 1 gesetzt ist *)
            BEGIN
              AddCalcStr(ergebnis, hilfe2, hilfe);
                                           (* Ergebnis und Hilfe2 addieren *)
              ergebnis := hilfe;                  (* Ergebnis aus Addition *)
            END;
          wert := wert SHR 1;                                (* Wert DIV 2 *)
          Mul2CalcStr(hilfe2);                               (* Hilfe2 * 2 *)
        END;
    END;
END;

(* ----------------------------------------------------------------------- *)
(* DivCalcStr dividiert einen CalcString durch einen anderen               *)

FUNCTION DivCalcStr(VAR zahl1, zahl2 : CalcStr; VAR ergebnis : CalcStr) :
BOOLEAN;
VAR hilfe       : CalcStr;                              (* HilfsCalcString *)

    hilfe1      : CalcStr;                              (* HilfsCalcString *)
    hilfe2      : CalcStr;                              (* HilfsCalcString *)
    EINS        : CalcStr;                 (* konstanter HilfsString f�r 1 *)
BEGIN
  IF ((zahl2.stellen = 1) AND (zahl2.zahl[1] = 0)) OR (zahl2.stellen = 0) THEN
    DivCalcStr := FALSE                  (* Division durch 0 nicht m�glich *)
  ELSE
    BEGIN
      EINS := EMPTYCALCSTR;                         (* Eins initialisieren *)
      EINS.stellen := 1;                          (* Eins besitzt 1 Stelle *)
      EINS.zahl[1] := 1;                        (* diese wird mit 1 belegt *)
      ergebnis := EMPTYCALCSTR;                 (* Ergebnis initialisieren *)
      hilfe1 := zahl1;                     (* Hilfe1 wird Zahl1 zugewiesen *)
      hilfe2 := zahl2;                     (* Hilfe2 wird Zahl2 zugewiesen *)
      WHILE NOT (GreaterCalcStr(hilfe2, hilfe1)) DO
        Mul2CalcStr(hilfe2);
           (* schiebe hilfe2 solange nach links, bis dividiert werden kann *)
      WHILE NOT (EqualCalcStr(hilfe2, zahl2)) DO       (* Abbruchbedingung *)
        BEGIN
          Mul2CalcStr(ergebnis);          (* Ergebnis mit 2 multiplizieren *)
          Div2CalcStr(hilfe2);                (* Hilfe2 durch 2 dividieren *)
          IF NOT (GreaterCalcStr(hilfe2, hilfe1)) THEN
                                            (* falls hilfe2 nicht > hilfe1 *)
            BEGIN
              SubCalcStr(hilfe1, hilfe2, hilfe);        (* Hilfe1 - Hilfe2 *)
              hilfe1 := hilfe;             (* Hilfe1 wird Hilfe zugewiesen *)
              AddCalcStr(ergebnis, EINS, hilfe);(* zum Ergebnis 1 addieren *)
              ergebnis := hilfe;         (* Ergebnis wird hilfe zugewiesen *)
            END;
        END;
      DivCalcStr := TRUE;                          (* Division erfolgreich *)
    END;
END;

(* ----------------------------------------------------------------------- *)
(* ModCalcStr berechnet den Rest bei Division von Zahl1 durch Zahl2        *)

FUNCTION ModCalcStr(VAR zahl1, zahl2 : CalcStr; VAR ergebnis : CalcStr) :
BOOLEAN;
VAR hilfe       : CalcStr;                              (* HilfsCalcString *)
    hilfe1      : CalcStr;                              (* HilfsCalcString *)
    hilfe2      : CalcStr;                              (* HilfsCalcString *)
    EINS        : CalcStr;                 (* konstanter HilfsString f�r 1 *)
BEGIN
  IF ((zahl2.stellen = 1) AND (zahl2.zahl[1] = 0)) OR (zahl2.stellen = 0) THEN
    ModCalcStr := FALSE                  (* Division durch 0 nicht m�glich *)
  ELSE
    BEGIN
      EINS := EMPTYCALCSTR;                         (* Eins initialisieren *)
      EINS.stellen := 1;                          (* Eins besitzt 1 Stelle *)
      EINS.zahl[1] := 1;                        (* diese wird mit 1 belegt *)
      ergebnis := EMPTYCALCSTR;                 (* Ergebnis initialisieren *)
      IF GreaterCalcStr(zahl2, zahl1) THEN          (* falls Zahl2 > Zahl1 *)
        ergebnis := zahl1                            (* Ergebnis ist Zahl1 *)
      ELSE
        BEGIN
          hilfe1 := zahl1;                 (* Hilfe1 wird Zahl1 zugewiesen *)
          hilfe2 := zahl2;                 (* Hilfe2 wird Zahl2 zugewiesen *)
          WHILE NOT (GreaterCalcStr(hilfe2, hilfe1)) DO
            Mul2CalcStr(hilfe2);
           (* schiebe hilfe2 solange nach links, bis dividiert werden kann *)
          WHILE NOT (EqualCalcStr(hilfe2, zahl2)) DO   (* Abbruchbedingung *)
            BEGIN
              Mul2CalcStr(ergebnis);      (* Ergebnis mit 2 multiplizieren *)
              Div2CalcStr(hilfe2);            (* Hilfe2 durch 2 dividieren *)
              IF NOT (GreaterCalcStr(hilfe2, hilfe1)) THEN
                                            (* falls hilfe2 nicht > hilfe1 *)
                BEGIN
                  SubCalcStr(hilfe1, hilfe2, hilfe);    (* Hilfe1 - Hilfe2 *)
                  hilfe1 := hilfe;         (* Hilfe1 wird Hilfe zugewiesen *)
                  AddCalcStr(ergebnis, EINS, hilfe);
                                                (* zum Ergebnis 1 addieren *)
                  ergebnis := hilfe;     (* Ergebnis wird hilfe zugewiesen *)
                END;
            END;
          ModCalcStr := TRUE;                      (* Division erfolgreich *)
        END;
    END;
END;

(* ----------------------------------------------------------------------- *)
(* ExptCalcStr berechnet Basis^Exponent                                    *)

PROCEDURE ExptCalcStr(VAR basis, exponent: CalcStr; VAR ergebnis : CalcStr);
VAR hilfe  : CalcStr;                                   (* HilfsCalcString *)
    hilfe1 : CalcStr;                                   (* HilfsCalcString *)
    i, j   : WORD;                                        (* Z�hlvariablen *)
    wert   : WORD;              (* Wert des Exponenten an der i.ten Stelle *)
BEGIN
  ergebnis := EMPTYCALCSTR;                     (* Ergebnis initialisieren *)
  ergebnis.stellen := 1;                     (* Ergebnis hat min. 1 Stelle *)
  ergebnis.zahl[1] := 1;                                  (* Ergebnis >= 1 *)
  IF ((exponent.stellen = 1) AND (exponent.zahl[1] = 0)) OR (exponent.stellen =
0) THEN
  ELSE                                     (* Exponent = 0 => Ergebnis = 1 *)
    BEGIN
      hilfe1 := basis;                     (* Hilfe1 wird Basis zugewiesen *)
      i := 1;                                (* i wird mit 1 initialisiert *)
      WHILE (i <= (exponent.stellen - 1)) DO      (* Exponenten abarbeiten *)
        BEGIN
          wert := exponent.zahl[i];          (* i.te Stelle des Exponenten *)
          INC(i);                                        (* i um 1 erh�hen *)
          j := 1;                            (* j wird mit 1 initialisiert *)
          WHILE (j <= 16) DO                       (* alle Bits abarbeiten *)
            BEGIN
              IF (wert AND 1) = 1 THEN         (* falls 1. Bit gesetzt ist *)
                MulCalcStr(ergebnis, hilfe1, ergebnis);
                                     (* Ergebnis mit Hilfe1 multiplizieren *)
              MulCalcStr(hilfe1, hilfe1, hilfe1);     (* Hilfe1 quadrieren *)
              wert := wert SHR 1;                            (* Wert DIV 2 *)
              INC(j);                                 (* 1 Bit weitergehen *)
            END;
        END;
      wert := exponent.zahl[exponent.stellen];  (* letzte Stelle behandeln *)
      WHILE (wert <> 0) DO                   (* solange noch 1 Bit gesetzt *)
        BEGIN
          IF (wert AND 1) = 1 THEN             (* falls 1. Bit gesetzt ist *)
            MulCalcStr(ergebnis, hilfe1, ergebnis);
                                     (* Ergebnis mit Hilfe1 multiplizieren *)
          MulCalcStr(hilfe1, hilfe1, hilfe1);         (* Hilfe1 quadrieren *)
          wert := wert SHR 1;                                (* Wert DIV 2 *)
        END;
    END;
END;

(* ----------------------------------------------------------------------- *)
(* RandomCalcStr liefert eine Zufallszahl < calcZahl                       *)

PROCEDURE RandomCalcStr(VAR calcZahl: CalcStr; VAR ergebnis : CalcStr);
VAR i : WORD;                                              (* Z�hlvariable *)
BEGIN
  ergebnis := EMPTYCALCSTR;                     (* Ergebnis initialisieren *)
  ergebnis.stellen := calcZahl.stellen; (* Annahme: Stellenzahl ist gleich *)
  FOR i := 1 TO (calcZahl.stellen - 1) DO
    ergebnis.zahl[i] := Random(65535);           (* zuf�llige Zahl < 65535 *)
  ergebnis.zahl[ergebnis.stellen] := Random(calcZahl.zahl[calcZahl.stellen]);
                              (* letzte Zahl muá kleiner Ausgangszahl sein *)
  WHILE (ergebnis.zahl[ergebnis.stellen] = 0) AND (ergebnis.stellen > 1) DO
    DEC(ergebnis.stellen);                  (* f�hrende Nullen abschneiden *)
  IF ((ergebnis.stellen = 1) AND (ergebnis.zahl[1] = 0)) OR (ergebnis.stellen =
0) THEN
    BEGIN                                    (* Ergebnis darf nicht 0 sein *)
      ergebnis.stellen := 1;                              (* min. 1 Stelle *)
      ergebnis.zahl[1] := 1;                       (* diese mit 1 besetzen *)
    END;
END;

(* ----------------------------------------------------------------------- *)
(* MulModCalcStr multipliziert ein Zahl modulo modul                       *)

PROCEDURE MulModCalcStr(VAR zahl1, zahl2, modul : CalcStr; VAR ergebnis :
CalcStr);
VAR i, j   : WORD;                                        (* Z�hlvariablen *)
    wert   : WORD;                        (* Wert von Zahl an i.ter Stelle *)
    hilfe  : CalcStr;                                   (* HilfsCalcString *)
    hilfe1 : CalcStr;                                   (* HilfsCalcString *)
    hilfe2 : CalcStr;                                   (* HilfsCalcString *)
BEGIN
  IF LessCalcStr(zahl1, zahl2) THEN                 (* Falls Zahl1 < Zahl2 *)
    BEGIN
      ModCalcStr(zahl1, modul, hilfe1);       (* Divisionsrest Zahl1/Modul *)
      ModCalcStr(zahl2, modul, hilfe2);       (* Divisionsrest Zahl2/Modul *)
    END
  ELSE
    BEGIN
      ModCalcStr(zahl1, modul, hilfe2);       (* Divisionsrest Zahl1/Modul *)
      ModCalcStr(zahl2, modul, hilfe1);       (* Divisionsrest Zahl2/Modul *)
    END;
  ergebnis := EMPTYCALCSTR;           (* ErgebnisCalcString initialisieren *)
  IF ((hilfe1.stellen = 1) AND (hilfe1.zahl[1] = 0)) OR (hilfe1.stellen = 0)
THEN
                                             (* Hilfe1 muá ungleich 0 sein *)
  ELSE
    BEGIN
      i := 1;                                    (* i mit 1 initialisieren *)
      WHILE (i <= (hilfe1.stellen - 1)) DO
                                     (* alle Stellen von Hilfe1 abarbeiten *)
        BEGIN
          wert := hilfe1.zahl[i];              (* aktuellen Wert ermitteln *)
          j := 1;                                (* j mit 1 initialisieren *)
          WHILE (j <= 16) DO                       (* alle Bits abarbeiten *)
            BEGIN
              IF (wert AND 1) > 0 THEN          (* Falls Bit 1 gesetzt ist *)
                BEGIN
                  AddCalcStr(ergebnis, hilfe2, hilfe);
                                           (* Hilfe2 zum Ergebnis addieren *)
                  ergebnis := hilfe;          (* und dem Ergebnis zuweisen *)
                END;
              wert := wert SHR 1;               (* Wert durch 2 dividieren *)
              Mul2CalcStr(hilfe2);          (* Hilfe2 mit 2 multiplizieren *)
              INC(j);                                    (* j um 1 erh�hen *)
            END;
          INC(i);                                        (* i um 1 erh�hen *)
        END;
      wert := hilfe1.zahl[hilfe1.stellen];
                                        (* letzte Zahl gesondert behandeln *)
      WHILE (wert > 0) DO                  (* solange noch ein Bit gesetzt *)
        BEGIN
          IF (wert AND 1) > 0 THEN             (* Falls 1. Bit gesetzt ist *)
            BEGIN
              AddCalcStr(ergebnis, hilfe2, hilfe);
                                           (* Hilfe2 zum Ergebnis addieren *)
              ergebnis := hilfe;              (* und dem Ergebnis zuweisen *)
            END;
          wert := wert SHR 1;                   (* Wert durch 2 dividieren *)
          Mul2CalcStr(hilfe2);              (* Hilfe2 mit 2 multiplizieren *)
        END;
    END;
  hilfe1 := ergebnis;                   (* Hilfe1 wird Ergebnis zugewiesen *)
  ModCalcStr(hilfe1, modul, ergebnis);       (* Divisionsrest hilfe1/Modul *)
END;

(* ----------------------------------------------------------------------- *)
(* ExptModCalcStr berechnet basis^exponent MOD modul                       *)

PROCEDURE ExptModCalcStr(VAR basis, exponent, modul : CalcStr; VAR ergebnis :
CalcStr);
VAR i, j   : WORD;                                        (* Z�hlvariablen *)
    wert   : WORD;                        (* Wert von Zahl an i.ter Stelle *)
    hilfe  : CalcStr;                                   (* HilfsCalcString *)
    hilfe1 : CalcStr;                                   (* HilfsCalcString *)
BEGIN
  ergebnis := EMPTYCALCSTR;                     (* Ergebnis initialisieren *)
  ergebnis.stellen := 1;                 (* Ergebnis besitzt min. 1 Stelle *)
  ergebnis.zahl[1] := 1;                      (* Ergebnis hat mind. Wert 1 *)
  IF ((exponent.stellen = 1) AND (exponent.zahl[1] = 0)) OR (exponent.stellen =
0) THEN
                                            (* Exponent = 0 => Ergebnis = 1*)
  ELSE
    BEGIN
      ModCalcStr(basis, modul, hilfe1);       (* Divisionsrest Basis/Modul *)
      i := 1;                                    (* i mit 1 initialisieren *)
      WHILE (i <= (exponent.stellen - 1)) DO
        BEGIN
          wert := exponent.zahl[i];     (* Wert = i.te Stelle von Exponent *)
          j := 1;                                (* j mit 1 initialisieren *)
          WHILE (j <= 16) DO                       (* alle Bits abarbeiten *)
            BEGIN
              IF (wert AND 1) > 0 THEN          (* Falls Bit 1 gesetzt ist *)
                BEGIN
                  MulModCalcStr(ergebnis, hilfe1, modul, hilfe);
                                            (* Ergebnis * Hilfe1 MOD Modul *)
                  ergebnis := hilfe;          (* und dem Ergebnis zuweisen *)
                END;
              wert := wert SHR 1;               (* Wert durch 2 dividieren *)
              MulModCalcStr(hilfe1, hilfe1, modul, hilfe);
                                                (* Hilfe1*Hilfe1 MOD Modul *)
              hilfe1 := hilfe;               (* und wieder Hilfe1 zuweisen *)
              INC(j);                                    (* j um 1 erh�hen *)
            END;
          INC(i);                                        (* 1 um 1 erh�hen *)
        END;
      wert := exponent.zahl[exponent.stellen];
                                        (* letzte Zahl gesondert behandeln *)
      WHILE (wert > 0) DO                  (* solange noch ein Bit gesetzt *)
        BEGIN
          IF (wert AND 1) > 0 THEN             (* Falls 1. Bit gesetzt ist *)
            BEGIN
              MulModCalcStr(ergebnis, hilfe1, modul, hilfe);
                                              (* Hilfe1*Ergebnis MOD Modul *)
              ergebnis := hilfe;              (* und dem Ergebnis zuweisen *)
            END;
          wert := wert SHR 1;                   (* Wert durch 2 dividieren *)
          MulModCalcStr(hilfe1, hilfe1, modul, hilfe);
                                                (* Hilfe1*Hilfe1 MOD Modul *)
          hilfe1 := hilfe;                   (* und wieder hilfe1 zuweisen *)
        END;
    END;
END;

(* ----------------------------------------------------------------------- *)

BEGIN

  Randomize;                               (* Zufallsgenerator einschalten *)

  (* Initialiseren eines globalen Leerstrings *)
  WITH EMPTYCALCSTR DO                             (* Recordtyp abarbeiten *)
    BEGIN
      stellen := 0;                                         (* L�nge ist 0 *)
      FOR i := 1 TO MAXCALCSTR DO zahl[i] := 0;     (* zahl initialisieren *)
    END;
  (* Ende der Initialisierung *)

END.

[Back to MATH SWAG index]  [Back to Main SWAG index]  [Original]