1: /*
2: ================================================================================
3: RPL/2 (R) version 4.1.13
4: Copyright (C) 1989-2013 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 ou soustractions 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: if ((*a) == 0)
44: {
45: (*resultat) = (*b);
46: return(d_absence_erreur);
47: }
48: else if ((*b) == 0)
49: {
50: (*resultat) = (*a);
51: return(d_absence_erreur);
52: }
53: else if ((((*b) > 0) && ((*a) > (INT64_MAX - (*b)))) ||
54: (((*b) < 0) && ((*a) < (INT64_MIN - (*b)))))
55: {
56: (*resultat) = 0;
57: return(d_erreur);
58: }
59: else
60: {
61: (*resultat) = (*a) + (*b);
62: return(d_absence_erreur);
63: }
64: }
65:
66: logical1
67: depassement_soustraction(integer8 *a, integer8 *b, integer8 *resultat)
68: {
69: if ((*a) == 0)
70: {
71: if ((*a) == INT64_MIN)
72: {
73: (*resultat) = 0;
74: return(d_erreur);
75: }
76: else
77: {
78: (*resultat) = -(*b);
79: return(d_absence_erreur);
80: }
81: }
82: else if ((*b) == 0)
83: {
84: (*resultat) = (*a);
85: return(d_absence_erreur);
86: }
87: else if ((((*b) > 0) && ((*a) < (INT64_MIN + (*b)))) ||
88: (((*b) < 0) && ((*a) > (INT64_MAX + (*b)))))
89: {
90: (*resultat) = 0;
91: return(d_erreur);
92: }
93: else
94: {
95: (*resultat) = (*a) - (*b);
96: return(d_absence_erreur);
97: }
98: }
99:
100:
101: /*
102: ================================================================================
103: Traitement des dépassements sur les multiplications entières
104: ================================================================================
105: Entrée :
106: - les deux opérandes signées
107: --------------------------------------------------------------------------------
108: Sortie :
109: - drapeau d'erreur
110: --------------------------------------------------------------------------------
111: Effets de bord : néant
112: ================================================================================
113: */
114:
115: logical1
116: depassement_multiplication(integer8 *a, integer8 *b, integer8 *resultat)
117: {
118: if ((*a) == 0)
119: {
120: (*resultat) = 0;
121: return(d_absence_erreur);
122: }
123: else if ((*b) == 0)
124: {
125: (*resultat) = 0;
126: return(d_absence_erreur);
127: }
128: else if ((*a) > 0)
129: {
130: if ((*b) > 0)
131: {
132: if ((*a) > (INT64_MAX / (*b)))
133: {
134: (*resultat) = 0;
135: return(d_erreur);
136: }
137: }
138: else
139: {
140: if ((*b) < (INT64_MIN / (*a)))
141: {
142: (*resultat) = 0;
143: return(d_erreur);
144: }
145: }
146: }
147: else // (*a) < 0
148: {
149: if ((*b) > 0)
150: {
151: if ((*a) < (INT64_MIN / (*b)))
152: {
153: (*resultat) = 0;
154: return(d_erreur);
155: }
156: }
157: else
158: {
159: if (((*a) != 0) && ((*b) < (INT64_MAX / (*a))))
160: {
161: (*resultat) = 0;
162: return(d_erreur);
163: }
164: }
165: }
166:
167: (*resultat) = (*a) * (*b);
168: return(d_absence_erreur);
169: }
170:
171:
172: /*
173: ================================================================================
174: Traitement des dépassements sur les puissances entières a ** b
175: ================================================================================
176: Entrée :
177: - a signé, b non signé.
178: --------------------------------------------------------------------------------
179: Sortie :
180: - drapeau d'erreur
181: --------------------------------------------------------------------------------
182: Effets de bord : néant
183: ================================================================================
184: */
185:
186: logical1
187: depassement_puissance(integer8 *a, integer8 *b, integer8 *resultat)
188: {
189: int decalage;
190:
191: integer8 i;
192:
193: logical1 depassement;
194:
195: unsigned_integer8 r;
196: unsigned_integer8 unite;
197:
198: if ((*b) < 0)
199: {
200: (*resultat) = 0;
201: return(d_erreur);
202: }
203:
204: if ((-1 <= (*a)) && ((*a) <= 1))
205: {
206: r = abs((*a));
207:
208: if ((*a) == 0)
209: {
210: (*resultat) = 0;
211: }
212: else
213: {
214: if ((*a) > 0)
215: {
216: (*resultat) = 1;
217: }
218: else
219: {
220: (*resultat) = (((*b) % 2) == 0) ? 1 : -1;
221: }
222: }
223:
224: return(d_absence_erreur);
225: }
226:
227: depassement = d_faux;
228:
229: for(i = 0; i < (*b); i++)
230: {
231: if (depassement_multiplication(&r, a, &r) == d_erreur)
232: {
233: depassement = d_vrai;
234: break;
235: }
236: }
237:
238: if (depassement == d_vrai)
239: {
240: (*resultat) = 0;
241: return(d_erreur);
242: }
243: else
244: {
245: decalage = (sizeof(unsigned_integer8) * 8) - 1;
246: unite = 1;
247:
248: if (r <= ((unite << decalage) - 1))
249: {
250: f77puissanceii_(a, b, resultat);
251: return(d_absence_erreur);
252: }
253: else
254: {
255: (*resultat) = 0;
256: return(d_erreur);
257: }
258: }
259: }
260:
261: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>