IMPLEMENTATION MODULE SUPINT; FROM MYINOUT IMPORT WriteString, WriteLn, WriteCard, Write, Read, OK, EOL, EOF, ReadLn,GetInput; FROM FileIO IMPORT UngetWord, StdIn,FILE; FROM Storage IMPORT ALLOCATE, DEALLOCATE; FROM SYSTEM IMPORT ADDRESS; FROM NUM IMPORT Lg, LCToLR, Trunc; FROM Strings IMPORT Length; (* Etant donne l'absence de "SET OF CHAR" dans SOLARIS (MCS), on utilise les *) (* fonctions CharSet, DefineCharSet et InCharSet definies dans MYSTR *) (* Le Type CharSet est egale a "SET OF CHAR" , comme precedemment sur SUN *) FROM MYSTR IMPORT CharSet, DefineCharSet, InCharSet; TYPE ToIONode = POINTER TO IONode; IONode = RECORD (* Sert a memoriser des digits lors *) io : CARDINAL; (* des procedures d'entrees/sorties *) Next : ToIONode END; VAR Separators : CharSet; ErrorNumber : CARDINAL; Index : CARDINAL; (* Compteur de boucle *) Adresse : ADDRESS; (* Variable de travail *) Tampon : SuperInteger; (* Variable Tampon *) FreeIONodes : ToIONode; (* Pile de IONodes libres *) (* Pointe a NIL si vide *) FreeSuperIntegers : SuperInteger; (* Pile de RECORDS libres pour les *) (* grands entiers. Si vide, = NIL. *) FreeVectors : ARRAY [0..HighPower] OF Vector; (* Tableau de piles de vecteurs libres*) (* pour les chiffres. FreeVectors [i] *) (* pointe sur la pile de vecteurs de *) (* taille 2 ** i. Si vide, = NIL. *) Input : FILE; (******************************************************************************) PROCEDURE Create ( VAR A : SuperInteger; k : CARDINAL (* Puissance de 2 correspondant au *) ); (* nombre de digits *) BEGIN IF FreeSuperIntegers # NIL THEN (* Reserve espace du superinteger *) A := FreeSuperIntegers; Adresse := A^.Digit; FreeSuperIntegers := Adresse ELSE NEW ( A ) END; IF k < LowPower THEN k := LowPower END; WITH A^ DO IF k <= HighPower THEN (* Longueur de vecteur valide *) IF FreeVectors [k] # NIL THEN (* Prend espace sur la pile libre *) Digit := FreeVectors [k]; Adresse := ADDRESS (Digit^ [0]); FreeVectors [k] := Adresse ELSE (* Demande espace au systeme *) ALLOCATE ( Adresse, TwoExp [k] * 4 ); Digit := Adresse END; Power := k; Negative := FALSE; (* initialise le superinteger a 0 *) SigPos := 0; Digit^ [0] := 0 ELSE (* Longueur de vecteur invalide *) WriteLn; WriteString ('ERROR SuperInteger too long'); WriteLn; HALT END END END Create; (******************************************************************************) PROCEDURE Delete (VAR A : SuperInteger); BEGIN WITH A^ DO (* Met le vecteur sur la pile libre *) IF FreeVectors [Power] # NIL THEN (* La pile est non vide *) Adresse := FreeVectors [Power]; Digit^ [0] := LONGINT (Adresse); FreeVectors [Power] := Digit ELSE (* La pile est vide *) FreeVectors [Power] := Digit; Adresse := NIL; Digit^ [0] := LONGINT (Adresse) END; IF FreeSuperIntegers # NIL THEN (* Met le superinteger sur la pile *) Adresse := FreeSuperIntegers; (* libre *) Digit := Adresse; FreeSuperIntegers := A ELSE FreeSuperIntegers := A; Digit := NIL END END; END Delete; (******************************************************************************) PROCEDURE IncreaseLen ( A : SuperInteger ); (* Procedure non disponible a l'usager. Reserve un espace memoire assez *) (* grand pour contenir un nombre de longueur SigPos *) BEGIN WITH A^ DO (* Met le block sur la pile libre *) IF FreeVectors [Power] # NIL THEN (* La pile est non vide *) Adresse := FreeVectors [Power]; Digit^ [0] := LONGINT (Adresse); FreeVectors [Power] := Digit ELSE (* La Pile est vide *) FreeVectors [Power] := Digit; Adresse := NIL; Digit^ [0] := LONGINT (Adresse) END; (* Calcule la longueur necessaire *) WHILE TwoExp [Power] <= SigPos DO INC ( Power ) END; IF Power <= HighPower THEN (* Longueur de vecteur valide *) (* Prend sur la pile libre *) IF FreeVectors [Power] # NIL THEN Digit := FreeVectors [Power]; Adresse := ADDRESS (Digit^ [0]); FreeVectors [Power] := Adresse ELSE (* Demande au systeme *) ALLOCATE ( Adresse, TwoExp [Power] * 4 ); Digit := Adresse END ELSE (* Longueur de vecteur invalide *) WriteLn; WriteString ('ERROR SuperInteger too long'); WriteLn; HALT END END END IncreaseLen; (******************************************************************************) PROCEDURE ReleaseStack; VAR Curseur : Vector; BEGIN FOR Index := LowPower TO HighPower DO WHILE FreeVectors [Index] # NIL DO Curseur := FreeVectors [Index]; Adresse := ADDRESS (Curseur^ [0]); FreeVectors [Index] := Adresse; DEALLOCATE ( Curseur, TwoExp [Index] * 4 ) END END END ReleaseStack; (******************************************************************************) (* + ajmal 18-12-96 *) (* Procedure renamed from InsideCalculR to InsideCalculR_StringToSup because another one had same name; so both renamed *) PROCEDURE InsideCalculR_StringToSup ( VAR AA : ARRAY OF LONGINT; InputBase : LONGINT; A : SuperInteger; CurIONode, TailIOStack : ToIONode ); (* Transforme les digits, qui sont sur une pile en base InputBase, *) (* en un SuperInteger A. *) VAR k, t : LONGINT; BEGIN WITH A^ DO AA [0] := 0; WHILE CurIONode # TailIOStack DO k := LONGINT ( CurIONode^.io ); FOR Index := 0 TO SigPos DO t := InputBase * AA [Index] + k; k := t DIV Base; AA [Index] := t - k * Base END; IF k # 0 THEN INC ( SigPos ); AA [SigPos] := k; END; CurIONode := CurIONode^.Next END; IF AA [SigPos] = 0 THEN Negative := FALSE END END; END InsideCalculR_StringToSup; PROCEDURE StringToSup (S : ARRAY OF CHAR; A : SuperInteger; B : CARDINAL); VAR TailIOStack, (* Fin de pile des digits d'entree *) CurIONode : ToIONode; (* Digit d'entree courant *) IODigit : CHAR; (* Caractere saisi dans le fichier *) i, NbIODigits : CARDINAL; (* nombre de digits saisis *) (* deplacee a l'exterieur ajmal 18 Dec 1996 PROCEDURE InsideCalculR ( VAR AA : ARRAY OF LONGINT; InputBase : LONGINT ); * Transforme les digits, qui sont sur une pile en base InputBase, * * en un SuperInteger A. * VAR k, t : LONGINT; BEGIN WITH A^ DO AA [0] := 0; WHILE CurIONode # TailIOStack DO k := LONGINT ( CurIONode^.io ); FOR Index := 0 TO SigPos DO t := InputBase * AA [Index] + k; k := t DIV Base; AA [Index] := t - k * Base END; IF k # 0 THEN INC ( SigPos ); AA [SigPos] := k; END; CurIONode := CurIONode^.Next END; IF AA [SigPos] = 0 THEN Negative := FALSE END END; END InsideCalculR; end ajmal *) BEGIN IF (B < 2) OR (B > 16) THEN (* Base d'entree invalide *) WriteLn; WriteString ('ERROR StringToSup, Radix should be between 2 and 16'); WriteLn; HALT END; NbIODigits := 0; i := 0; IF FreeIONodes = NIL THEN NEW ( FreeIONodes ); FreeIONodes^.Next := NIL END; TailIOStack := FreeIONodes; CurIONode := FreeIONodes; IODigit := S[i]; WHILE ( (IODigit = ' ') AND (i< Length(S) )) DO i:= i+1; IODigit := S[i]; END; IF (i < Length(S)) THEN IF IODigit = '-' THEN A^.Negative := TRUE; i := i+1; IODigit:= S[i]; ELSE A^.Negative := FALSE; IF IODigit = '+' THEN i := i+1; IODigit:= S[i]; END END; END; (* On entre les digits sur la pile en verifiant la validite. *) WHILE (i < Length(S)) DO IF IODigit = '~' THEN ReadLn; ELSE (* Transforme de code ascii a cardinal*) WITH CurIONode^ DO CASE IODigit OF '0'..'9' : io := ORD (IODigit) - 48 | 'A'..'F' : io := ORD (IODigit) - 55 | 'a'..'f' : io := ORD (IODigit) - 87 ELSE io := B END; IF io < B THEN (* Le digit est valide *) INC (NbIODigits); IF Next = NIL THEN NEW (Next); Next^.Next := NIL END; CurIONode := Next; TailIOStack := CurIONode ELSE (* Le digit est invalide *) WriteLn; WriteString ('ERROR StringToSup, Invalid digit. ORD (Digit) = '); WriteCard (ORD (IODigit), 3); WriteLn; HALT END END; END; i := i+1; IODigit := S[i]; END; CurIONode := FreeIONodes; WITH A^ DO (* Reserve l'espace memoire *) SigPos := 1 + TRUNC (LFLOAT (NbIODigits) * Lg (LFLOAT (B))) DIV Exposant; IF TwoExp [Power] <= SigPos THEN IncreaseLen (A) END; SigPos := 0; (* * ajmal 18-12-96 *) (* InsideCalculR (Digit^, VAL (LONGINT, B)); *) InsideCalculR_StringToSup (Digit^, VAL (LONGINT, B), A, CurIONode, TailIOStack); IF Digit^[SigPos] = 0 THEN Negative := FALSE END; (* ajout de JT pour eviter -zero *) END END StringToSup; (******************************************************************************) (* + ajmal 18-12-96 *) (* Procedure renamed from InsideCalculR to InsideCalculR_ReadSup because another one had same name; so both renamed *) PROCEDURE InsideCalculR_ReadSup ( VAR AA : ARRAY OF LONGINT; InputBase : LONGINT; A : SuperInteger; CurIONode, TailIOStack : ToIONode ); (* Transforme les digits, qui sont sur une pile en base InputBase, *) (* en un SuperInteger A. *) VAR k, t : LONGINT; BEGIN WITH A^ DO AA [0] := 0; WHILE CurIONode # TailIOStack DO k := LONGINT ( CurIONode^.io ); FOR Index := 0 TO SigPos DO t := InputBase * AA [Index] + k; k := t DIV Base; AA [Index] := t - k * Base END; IF k # 0 THEN INC ( SigPos ); AA [SigPos] := k; END; CurIONode := CurIONode^.Next END; IF AA [SigPos] = 0 THEN Negative := FALSE END END; END InsideCalculR_ReadSup; PROCEDURE ReadSup ( A : SuperInteger; B : CARDINAL ); VAR TailIOStack, (* Fin de pile des digits d'entree *) CurIONode : ToIONode; (* Digit d'entree courant *) IODigit : CHAR; (* Caractere saisi dans le fichier *) NbIODigits : CARDINAL; (* nombre de digits saisis *) (* deplacee a l'exterieur ajmal 18 Dec 1996 *) PROCEDURE InsideCalculR ( VAR AA : ARRAY OF LONGINT; InputBase : LONGINT ); (* Transforme les digits, qui sont sur une pile en base InputBase, *) (* en un SuperInteger A. *) VAR k, t : LONGINT; BEGIN WITH A^ DO AA [0] := 0; WHILE CurIONode # TailIOStack DO k := LONGINT ( CurIONode^.io ); FOR Index := 0 TO SigPos DO t := InputBase * AA [Index] + k; k := t DIV Base; AA [Index] := t - k * Base END; IF k # 0 THEN INC ( SigPos ); AA [SigPos] := k; END; CurIONode := CurIONode^.Next END; IF AA [SigPos] = 0 THEN Negative := FALSE END END; END InsideCalculR; (*end ajmal *) BEGIN IF (B < 2) OR (B > 16) THEN (* Base d'entree invalide *) WriteLn; WriteString ('ERROR ReadSup, Radix should be between 2 and 16'); WriteLn; HALT END; NbIODigits := 0; IF FreeIONodes = NIL THEN NEW ( FreeIONodes ); FreeIONodes^.Next := NIL END; TailIOStack := FreeIONodes; CurIONode := FreeIONodes; GetInput(Input); REPEAT (* Enleve les espaces et Eol du debut *) Read (IODigit); IF EOL () THEN WriteLn; WriteString ("ERROR SUPINT.ReadSup: no digit before EOL"); WriteLn; HALT END; UNTIL ((NOT OK) OR (NOT (InCharSet (IODigit, Separators)))); IF (NOT OK) AND (NOT EOL()) AND (NOT EOF()) THEN (* IO.WrLn; IO.WrStr ('ERROR ReadSup: RdChar not OK.'); IO.WrLn; HALT *) IODigit := ' ' ELSIF IODigit = '-' THEN (* Verifie le signe, + est facultatif *) A^.Negative := TRUE; Read (IODigit); ELSE A^.Negative := FALSE; IF IODigit = '+' THEN Read (IODigit) END END; (* On entre les digits sur la pile en verifiant la validite. *) WHILE (NOT (InCharSet (IODigit, Separators)) AND (NOT EOL()) AND (NOT EOF())) DO IF IODigit = '~' THEN ReadLn; (* Lire le EOL. *) ELSE (* Transforme de code ascii a cardinal*) WITH CurIONode^ DO CASE IODigit OF '0'..'9' : io := ORD (IODigit) - 48 | 'A'..'F' : io := ORD (IODigit) - 55 | 'a'..'f' : io := ORD (IODigit) - 87 ELSE io := B END; IF io < B THEN (* Le digit est valide *) INC (NbIODigits); IF Next = NIL THEN NEW (Next); Next^.Next := NIL END; CurIONode := Next; TailIOStack := CurIONode ELSE (* Le digit est invalide *) WriteLn; WriteString ('ERROR ReadSup, Invalid digit. ORD (Digit) = '); WriteCard (ORD (IODigit), 3); WriteLn; HALT END END END; Read (IODigit); END; IF NbIODigits > 0 THEN UngetWord (Input, IODigit) END; (* pour ne pas lire le caractere suivant le *) (* SuperInteger, comme toutes les autres *) (* procedures de lecture de mylib *) CurIONode := FreeIONodes; WITH A^ DO (* Reserve l'espace memoire *) SigPos := 1 + TRUNC (LFLOAT (NbIODigits) * Lg (LFLOAT (B))) DIV Exposant; IF TwoExp [Power] <= SigPos THEN IncreaseLen (A) END; SigPos := 0; (* * ajmal 18-12-96 *) (* InsideCalculR (Digit^, VAL (LONGINT, B)); *) InsideCalculR_ReadSup (Digit^, VAL (LONGINT, B), A, CurIONode, TailIOStack); IF Digit^[SigPos] = 0 THEN Negative := FALSE END; (* ajout de JT pour eviter -zero *) END END ReadSup; (*****************************************************************************) VAR CurIONodeW, (* Digit de sortie courant *) HeadIOStackW, (* Tete de pile des digits de sortie *) TailIOStackW : ToIONode; (* Fin de pile des digits de sortie *) PROCEDURE InsideCalculW ( VAR AA, AX : ARRAY OF LONGINT; OutputBase : LONGINT ); (* Transforme le superinteger A dans la base OutputBase et met les *) (* digits sur une pile. *) VAR r, K : LONGINT; BEGIN WITH Tampon^ DO r := 0; FOR Index := SigPos TO 0 BY -1 DO K := r * Base + AA [Index]; AX [Index] := K DIV OutputBase; r := K - AX [Index] * OutputBase END; IF ( AX [SigPos] = 0 ) AND ( SigPos # 0 ) THEN DEC ( SigPos ) END; IF FreeIONodes # NIL THEN CurIONodeW := FreeIONodes; FreeIONodes := CurIONodeW^.Next ELSE NEW ( CurIONodeW ) END; CurIONodeW^.io := VAL (CARDINAL, r); CurIONodeW^.Next := NIL; HeadIOStackW := CurIONodeW; TailIOStackW := CurIONodeW; WHILE AX [SigPos] # 0 DO r := 0; FOR Index := SigPos TO 0 BY -1 DO K := r * Base + AX [Index]; AX [Index] := K DIV OutputBase; r := K - AX [Index] * OutputBase END; IF ( AX [SigPos] = 0 ) AND ( SigPos # 0 ) THEN DEC ( SigPos ) END; IF FreeIONodes # NIL THEN CurIONodeW := FreeIONodes; FreeIONodes := CurIONodeW^.Next ELSE NEW ( CurIONodeW ) END; CurIONodeW^.io := VAL (CARDINAL, r); CurIONodeW^.Next := HeadIOStackW; HeadIOStackW := CurIONodeW END END END InsideCalculW; PROCEDURE WriteSup ( A : SuperInteger; B : CARDINAL; D : CARDINAL ); VAR NbDigitsLine : CARDINAL; (* Compte le nombre de digits sur la *) (* ligne en sortie courante *) BEGIN IF (B < 2) OR (B > 16) THEN WriteLn; WriteString ('ERROR WriteSup, Radix should be between 2 and 16'); WriteLn; HALT END; WITH Tampon^ DO SigPos := A^.SigPos; IF TwoExp [Power] <= SigPos THEN IncreaseLen (Tampon) END; InsideCalculW (A^.Digit^, Digit^, VAL (LONGINT, B)); END; NbDigitsLine := 0; IF A^.Negative THEN INC (NbDigitsLine); WriteString ('-') END; WHILE CurIONodeW # NIL DO (* Imprime les digits de la pile. *) IF NbDigitsLine = D THEN (* Ligne pleine. *) WriteString ('~'); WriteLn; NbDigitsLine := 0 ELSE IF CurIONodeW^.io < 10 THEN WriteCard (CurIONodeW^.io, 1) ELSE Write (CHR (55 + CurIONodeW^.io)) END; INC (NbDigitsLine); CurIONodeW := CurIONodeW^.Next END END; TailIOStackW^.Next := FreeIONodes; (* Prochain digit sur la pile *) FreeIONodes := HeadIOStackW END WriteSup; PROCEDURE WriteSupSci ( A : SuperInteger; B : CARDINAL; n : CARDINAL ); VAR TotalDigits, (* Nombre total de chiffres, pour *) (* l'exposant en notation scientifi. *) NbDigitsSci : CARDINAL; (* Compte le nombre de digits signi- *) (* ficatifs en notation scientifique *) (* (mantisse) *) BEGIN IF (B < 2) OR (B > 16) THEN WriteLn; WriteString ('ERROR WriteSup, Radix should be between 2 and 16'); WriteLn; HALT END; Write('.'); TotalDigits := 0; NbDigitsSci := 0; WITH Tampon^ DO SigPos := A^.SigPos; IF TwoExp [Power] <= SigPos THEN IncreaseLen (Tampon) END; InsideCalculW (A^.Digit^, Digit^, VAL (LONGINT, B)); END; IF A^.Negative THEN WriteString ('-') END; WHILE CurIONodeW # NIL DO (* Imprime les digits de la pile. *) IF NbDigitsSci < n THEN IF CurIONodeW^.io < 10 THEN WriteCard (CurIONodeW^.io, 1) ELSE Write (CHR (55 + CurIONodeW^.io)) END; INC (NbDigitsSci); END; INC(TotalDigits); CurIONodeW := CurIONodeW^.Next END; WHILE NbDigitsSci < n DO Write('0'); INC(NbDigitsSci); END; Write('E'); WriteCard (TotalDigits, VAL(CARDINAL,Trunc((Lg(LCToLR(TotalDigits))/Lg(10.0)) + 1.0))); TailIOStackW^.Next := FreeIONodes; (* Prochain digit sur la pile *) FreeIONodes := HeadIOStackW END WriteSupSci; (*****************************************************************************) PROCEDURE CopyBlock ( VAR AA, AB : ARRAY OF LONGINT; Pos : CARDINAL; k : INTEGER ); (* Procedure non disponible a l'usager. Place dans AB les chiffres de AA. *) (* Les chiffres de AB iront de 0 a Pos. *) (* Si k >= 0, ces chiffres sont decales a gauche de k *) (* positions et les k chiffres de droite seront des 0. Si k < 0, ils *) (* sont decales a droite de -k positions et les -k chiffres de droite sont*) (* perdus. NOTE : il se peut que AA = AB. *) VAR k1, I : CARDINAL; BEGIN IF k = 0 THEN FOR I := 0 TO Pos DO AB [I] := AA [I] END ELSE IF k > 0 THEN (* Decalage a gauche de k positions. *) k1 := CARDINAL (k); FOR I := Pos TO k1 BY -1 DO AB [I] := AA [I - k1] END; FOR I := 0 TO k1 - 1 DO AB [I] := 0 END ELSE (* k < 0 *) (* Decalage a droite de -k positions. *) k1 := CARDINAL ( -k ); FOR I := 0 TO Pos DO AB [I] := AA [I + k1] END END END END CopyBlock; (*****************************************************************************) PROCEDURE Affect (A, B : SuperInteger); BEGIN WITH B^ DO Negative := A^.Negative; SigPos := A^.SigPos; IF TwoExp [Power] <= SigPos THEN IncreaseLen (B) END; CopyBlock (A^.Digit^, Digit^, SigPos, 0) END END Affect; (*****************************************************************************) PROCEDURE Exchange (VAR A, B : SuperInteger); VAR Tamp : ADDRESS; BEGIN Tamp := A; A := B; B := Tamp END Exchange; (*****************************************************************************) PROCEDURE NumDigits ( A : SuperInteger ) : CARDINAL; BEGIN RETURN A^.SigPos + 1 END NumDigits; (*****************************************************************************) PROCEDURE NumBits ( A : SuperInteger ) : LONGCARD; VAR I, K : CARDINAL; BEGIN WITH A^ DO I := 1; K := VAL (CARDINAL, Digit^[SigPos]); WHILE TwoExp [I] <= K DO INC (I) END; (* On a (2 ** (i-1) <= K < 2 ** i) ou (K = 0 et I = 1). *) RETURN (VAL (LONGCARD, Exposant) * VAL (LONGCARD, SigPos) + VAL (LONGCARD, I)); END END NumBits; (******************************************************************************) BEGIN (* CONST Separators = TAB, LF, CR, end-of-file, space *) DefineCharSet ('[9], [10], [13], [26], ( )', Separators, ErrorNumber); FreeIONodes := NIL; (* Initialise les piles et la table *) FreeSuperIntegers := NIL; (* de conversion Power ==> 2**Power *) TwoExp [0] := 1; FreeVectors [0] := NIL; FOR Index := 1 TO HighPower DO TwoExp [Index] := 2 * TwoExp [Index - 1]; FreeVectors [Index] := NIL END; LongBase := VAL (LONGINT, Base); Create (Tampon , 6); (* Initialise le tampon *) END SUPINT.