[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 prft, 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 fr das Rechnen mit groáen Zahlen *)
(* ----------------------------------------------------------------------- *)
FUNCTION Expt(zahl : Real; hoch : INTEGER) : Real;
(* Berechnung des Exponenten einer Realzahl (einfach, weil nur fr die *)
(* Berechnung von AnzahlTests n”tig *)
VAR i : INTEGER; (* Z„hlvariable *)
hilfe : Real; (* Hilfsvariable fr 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 zurckliefern *)
END;
END;
(* ----------------------------------------------------------------------- *)
FUNCTION AnzahlTests(wahrscheinlichkeit : Real) : INTEGER;
(* ermittelt die Anzahl Tests, welche n”tig sind um die gewnschte *)
(* 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 zurckgeben *)
END;
(* ----------------------------------------------------------------------- *)
FUNCTION EvenString(zahl : STRING) : BOOLEAN;
(* prft, on ein String gerade ist *)
BEGIN
EvenString := NOT Odd(Ord(zahl[Length(zahl)]) - 48);
END; (* prft, ob die letzte Stelle des Strings gerade ist *)
(* ----------------------------------------------------------------------- *)
FUNCTION Div5(zahl : STRING) : BOOLEAN;
(* prft, 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; (* prft, ob die letzte Stelle des Strings gerade ist *)
(* ----------------------------------------------------------------------- *)
FUNCTION Div3(zahl : STRING) : BOOLEAN;
(* prft, 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 erfllt *)
ELSE
IF EqualCalcStr(hilfe, pMinus1) THEN
Bedingung1 := TRUE (* Bedingung 2 mit r=0 erfllt *)
ELSE
Bedingung1 := FALSE; (* sonst ist Bedingung 1 nicht erfllt *)
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 fr 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 geprft 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 erfllt *)
EXIT;
END;
AddCalcStr(r, EINS, hilfe2); (* r um 1 erh”hen *)
r := hilfe2; (* r wieder zuweisen *)
END;
Bedingung2 := FALSE; (* 2. Bedingung nicht erfllt *)
END;
(* ----------------------------------------------------------------------- *)
(* Rabin prft 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 fr 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 durchfhren *)
BEGIN
RandomCalcStr(p, b); (* zuf„llige Basis ermitteln *)
Write('b = '); PrintCalcStr(b);
IF (Bedingung1(b, v, p, pMinus1, EINS) = FALSE) THEN
(* 1. Bedingung prfen *)
IF (Bedingung2(b, v, u, p, pMinus1, EINS) = FALSE) THEN
BEGIN (* 2. Bedingung prfen *)
Rabin := FALSE;
EXIT; (* beide Bedingungen nicht erfllt => keine Primzahl *)
END;
END;
Rabin := TRUE; (* Rabintest bestanden *)
END;
(* ----------------------------------------------------------------------- *)
(* PrimeTest prft, 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 zurckgeben *)
END
ELSE
IF Div5(zahl) THEN (* Falls Zahl durch 5 dividierbar ist *)
BEGIN
PrimeTest := FALSE; (* => keine Primzahl
*)
meldung := 'Zahl durch 5 dividierbar'; (* Meldung zurckgeben *)
END
ELSE
IF Div3(zahl) THEN (* Zahl durch 3 dividierbar *)
BEGIN
PrimeTest := FALSE; (* => keine Primzahl *)
meldung := 'Zahl durch 3 dividierbar'; (* Meldung zurckgeben *)
END
ELSE
BEGIN
IF NOT Rabin(zahl, anzahlTests) THEN (* Falls Rabintest negativ *)
BEGIN
PrimeTest := FALSE; (* keine Primzahl *)
meldung := 'Rabintest'; (* Meldung zurckgeben *)
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 verknpfen *)
END;
(* ----------------------------------------------------------------------- *)
(* TestBit prft, 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-Verknpfung wieder 1 das Ergebnis ist *)
END;
(* ======================================================================= *)
(* Hilfsfunktionen fr Strings *)
(* ----------------------------------------------------------------------- *)
(* TestString prft, ob im String eine gltige 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 ungltig *)
EXIT; (* Funktion verlassen *)
END;
TestString := TRUE;
END;
(* ----------------------------------------------------------------------- *)
(* OddString prft, ob ein String ungerade ist *)
FUNCTION OddString(zeichenkette : STRING) : BOOLEAN;
VAR zahl : BYTE; (* Bytedarstellung von Zeichen *)
dummy : INTEGER; (* dient zur šberprfung 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); (* prfen, ob zahl ungerade ist *)
END;
(* ----------------------------------------------------------------------- *)
(* StrDiv2 dividiert einen String durch 2 *)
FUNCTION StrDiv2(zeichenkette : STRING) : STRING;
VAR hilfe : STRING; (* Hilfsstring fr das Ergebnis *)
index : BYTE; (* Index fr Position in zeichenkette *)
laenge : BYTE; (* L„nge der Zeichenkette *)
zahl : BYTE; (* zu dividierender Faktor *)
zeichen : CHAR; (* Zeichendarstellung von Zahl *)
dummy : INTEGER;
(* dient zur šberprfung 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 fr 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 Prfung 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 rckw„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 bercksichtigen *)
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 zurck *)
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 fr 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 gltige 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 wrde berschritten *)
CalcStrToStr := FALSE (* Stringberlauf *)
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 prfen *)
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 geglckt *)
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 zurckgeben *)
CalcStrToWord := TRUE; (* Umwandlung geglckt *)
END;
END;
(* ----------------------------------------------------------------------- *)
(* EqualCalcStr prft, 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 prft, 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 prft, 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 prft, 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 prft, 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 prft, 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 prft, 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 fr Addition *)
i : WORD; (* Z„hlvariable *)
summe : LongInt; (* Hilfsvariable zur Prfung eines šbertrags *)
ueberlauf : BYTE; (* šberlauf = 1, kein šberlauf = 0 *)
addition : BOOLEAN; (* k”nnen Zahlen addiert werden oder nicht *)
BEGIN
{$Q-} (* šberlaufprfung 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 mssen 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 šberlaufprfung 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á geprft 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+} (* šberlaufprfung 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 Bercksichtigung 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 fr 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 fr 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); (* fhrende 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]