1: /*
2: ================================================================================
3: RPL/2 (R) version 4.1.10
4: Copyright (C) 1989-2012 Dr. BERTRAND Joël
5:
6: This file is part of RPL/2.
7:
8: RPL/2 is free software; you can redistribute it and/or modify it
9: under the terms of the CeCILL V2 License as published by the french
10: CEA, CNRS and INRIA.
11:
12: RPL/2 is distributed in the hope that it will be useful, but WITHOUT
13: ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14: FITNESS FOR A PARTICULAR PURPOSE. See the CeCILL V2 License
15: for more details.
16:
17: You should have received a copy of the CeCILL License
18: along with RPL/2. If not, write to info@cecill.info.
19: ================================================================================
20: */
21:
22:
23: #include "rpl-conv.h"
24:
25:
26: /*
27: ================================================================================
28: Traitement des dépassements sur les additions entières
29: ================================================================================
30: Entrée :
31: - les deux opérandes signées
32: --------------------------------------------------------------------------------
33: Sortie :
34: - drapeau d'erreur
35: --------------------------------------------------------------------------------
36: Effets de bord : néant
37: ================================================================================
38: */
39:
40: logical1
41: depassement_addition(integer8 *a, integer8 *b, integer8 *resultat)
42: {
43: int decalage;
44:
45: unsigned_integer8 ua;
46: unsigned_integer8 ub;
47: unsigned_integer8 unite;
48: unsigned_integer8 ur;
49:
50: decalage = (sizeof(unsigned_integer8) * 8) - 1;
51:
52: if ((((*a) <= 0) && ((*b) >= 0)) ||
53: (((*a) >= 0) && ((*b) <= 0)))
54: {
55: (*resultat) = (*a) + (*b);
56: return(d_absence_erreur);
57: }
58: else
59: {
60: ua = abs((*a));
61: ub = abs((*b));
62: ur = ua + ub;
63: unite = 1;
64:
65: if ((ur >= ua) && (ur <= ((unite << decalage) - 1)))
66: {
67: (*resultat) = (*a) + (*b);
68: return(d_absence_erreur);
69: }
70: else
71: {
72: (*resultat) = 0;
73: return(d_erreur);
74: }
75: }
76: }
77:
78:
79: /*
80: ================================================================================
81: Traitement des dépassements sur les multiplications entières
82: ================================================================================
83: Entrée :
84: - les deux opérandes signées
85: --------------------------------------------------------------------------------
86: Sortie :
87: - drapeau d'erreur
88: --------------------------------------------------------------------------------
89: Effets de bord : néant
90: ================================================================================
91: */
92:
93: logical1
94: depassement_multiplication(integer8 *a, integer8 *b, integer8 *resultat)
95: {
96: int decalage;
97:
98: unsigned_integer8 limite;
99: unsigned_integer8 lsba;
100: unsigned_integer8 lsbb;
101: unsigned_integer8 lsbr;
102: unsigned_integer8 msba;
103: unsigned_integer8 msbb;
104: unsigned_integer8 msbr;
105: unsigned_integer8 produit_croise;
106: unsigned_integer8 ua;
107: unsigned_integer8 ub;
108: unsigned_integer8 unite;
109:
110: decalage = sizeof(unsigned_integer4) * 8;
111: unite = 1;
112:
113: ua = abs((*a));
114: ub = abs((*b));
115:
116: lsba = (ua << decalage) >> decalage;
117: lsbb = (ub << decalage) >> decalage;
118: msba = ua >> decalage;
119: msbb = ub >> decalage;
120:
121: if ((msba != 0) && (msbb != 0))
122: {
123: (*resultat) = 0;
124: return(d_erreur);
125: }
126: else
127: {
128: produit_croise = (limite = (msba * lsbb)) + (msbb * lsba);
129:
130: /*
131: * Traitement du débordement sur produit_croisé
132: */
133:
134: if (produit_croise < limite)
135: {
136: msbr = (msba * msbb) + (produit_croise >> decalage) +
137: (unite << (decalage + 1));
138: }
139: else
140: {
141: msbr = (msba * msbb) + (produit_croise >> decalage);
142: }
143:
144: if (msbr != 0)
145: {
146: (*resultat) = 0;
147: return(d_erreur);
148: }
149: else
150: {
151: lsbr = (limite = (lsba * lsbb)) + (produit_croise << decalage);
152:
153: if ((lsbr >= limite) && (lsbr <= ((unite << ((2 * decalage) - 1))
154: - 1)))
155: {
156: (*resultat) = (*a) * (*b);
157: return(d_absence_erreur);
158: }
159: else
160: {
161: (*resultat) = 0;
162: return(d_erreur);
163: }
164: }
165: }
166: }
167:
168:
169: /*
170: ================================================================================
171: Traitement des dépassements sur les puissances entières a ** b
172: ================================================================================
173: Entrée :
174: - a signé, b non signé.
175: --------------------------------------------------------------------------------
176: Sortie :
177: - drapeau d'erreur
178: --------------------------------------------------------------------------------
179: Effets de bord : néant
180: ================================================================================
181: */
182:
183: logical1
184: depassement_puissance(integer8 *a, integer8 *b, integer8 *resultat)
185: {
186: int decalage;
187:
188: integer8 i;
189:
190: logical1 depassement;
191:
192: unsigned_integer8 r;
193: unsigned_integer8 unite;
194:
195: if ((*b) < 0)
196: {
197: (*resultat) = 0;
198: return(d_erreur);
199: }
200:
201: if ((r = abs(*a)) <= 1)
202: {
203: if ((*a) == 0)
204: {
205: (*resultat) = 0;
206: }
207: else
208: {
209: if ((*a) > 0)
210: {
211: (*resultat) = 1;
212: }
213: else
214: {
215: (*resultat) = (((*b) % 2) == 0) ? 1 : -1;
216: }
217: }
218:
219: return(d_absence_erreur);
220: }
221:
222: depassement = d_faux;
223:
224: for(i = 0; i < (*b); i++)
225: {
226: if (depassement_multiplication(&r, a, &r) == d_erreur)
227: {
228: depassement = d_vrai;
229: break;
230: }
231: }
232:
233: if (depassement == d_vrai)
234: {
235: (*resultat) = 0;
236: return(d_erreur);
237: }
238: else
239: {
240: decalage = (sizeof(unsigned_integer8) * 8) - 1;
241: unite = 1;
242:
243: if (r <= ((unite << decalage) - 1))
244: {
245: f77puissanceii_(a, b, resultat);
246: return(d_absence_erreur);
247: }
248: else
249: {
250: (*resultat) = 0;
251: return(d_erreur);
252: }
253: }
254: }
255:
256: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>