Annotation of rpl/src/instructions_m1.c, revision 1.63
1.1 bertrand 1: /*
2: ================================================================================
1.63 ! bertrand 3: RPL/2 (R) version 4.1.30
1.62 bertrand 4: Copyright (C) 1989-2018 Dr. BERTRAND Joël
1.1 bertrand 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:
1.11 bertrand 23: #include "rpl-conv.h"
1.1 bertrand 24:
25:
26: /*
27: ================================================================================
28: Fonction '-'
29: ================================================================================
30: Entrées : structure processus
31: --------------------------------------------------------------------------------
32: Sorties :
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: void
39: instruction_moins(struct_processus *s_etat_processus)
40: {
41: integer8 tampon;
42:
43: logical1 depassement;
44: logical1 drapeau;
45: logical1 drapeau_neg;
46:
47: struct_liste_chainee *l_element_courant;
48: struct_liste_chainee *l_element_precedent;
49:
50: struct_objet *s_copie_argument_1;
51: struct_objet *s_copie_argument_2;
52: struct_objet *s_objet_argument_1;
53: struct_objet *s_objet_argument_2;
54: struct_objet *s_objet_resultat;
55:
1.43 bertrand 56: integer8 i;
57: integer8 j;
58: integer8 nombre_elements;
1.1 bertrand 59:
60: (*s_etat_processus).erreur_execution = d_ex;
61:
62: if ((*s_etat_processus).affichage_arguments == 'Y')
63: {
64: printf("\n - ");
65:
66: if ((*s_etat_processus).langue == 'F')
67: {
68: printf("(soustraction)\n\n");
69: }
70: else
71: {
72: printf("(substraction)\n\n");
73: }
74:
75: printf(" 2: %s, %s, %s\n", d_INT, d_REL, d_CPL);
76: printf(" 1: %s, %s, %s\n", d_INT, d_REL, d_CPL);
77: printf("-> 1: %s, %s, %s\n\n", d_INT, d_REL, d_CPL);
78:
79: printf(" 2: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
80: printf(" 1: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
81: printf("-> 1: %s, %s, %s\n\n", d_VIN, d_VRL, d_VCX);
82:
83: printf(" 2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
84: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
85: printf("-> 1: %s, %s, %s\n\n", d_MIN, d_MRL, d_MCX);
86:
87: printf(" 2: %s, %s\n", d_BIN, d_INT);
88: printf(" 1: %s, %s\n", d_BIN, d_INT);
89: printf("-> 1: %s\n\n", d_BIN);
90:
91: printf(" 2: %s, %s, %s, %s, %s, %s\n",
92: d_INT, d_REL, d_CPL, d_NOM, d_ALG, d_RPN);
93: printf(" 1: %s, %s, %s, %s, %s, %s\n",
94: d_INT, d_REL, d_CPL, d_NOM, d_ALG, d_RPN);
95: printf("-> 1: %s, %s\n", d_ALG, d_RPN);
96:
97: return;
98: }
99: else if ((*s_etat_processus).test_instruction == 'Y')
100: {
101: (*s_etat_processus).nombre_arguments = 0;
102: return;
103: }
104:
105: if (test_cfsf(s_etat_processus, 31) == d_vrai)
106: {
107: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
108: {
109: return;
110: }
111: }
112:
113: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
114: &s_objet_argument_1) == d_erreur)
115: {
116: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
117: return;
118: }
119:
120: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
121: &s_objet_argument_2) == d_erreur)
122: {
123: liberation(s_etat_processus, s_objet_argument_1);
124:
125: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
126: return;
127: }
128:
129: /*
130: --------------------------------------------------------------------------------
131: Soustraction de deux entiers
132: --------------------------------------------------------------------------------
133: */
134:
135: if (((*s_objet_argument_1).type == INT) &&
136: ((*s_objet_argument_2).type == INT))
137: {
1.42 bertrand 138: if (depassement_soustraction((integer8 *) (*s_objet_argument_2).objet,
139: (integer8 *) (*s_objet_argument_1).objet, &tampon) ==
1.1 bertrand 140: d_absence_erreur)
141: {
142: if ((s_objet_resultat = allocation(s_etat_processus, INT))
143: == NULL)
144: {
145: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
146: return;
147: }
148:
149: (*((integer8 *) (*s_objet_resultat).objet)) = tampon;
150: }
151: else
152: {
153: if ((s_objet_resultat = allocation(s_etat_processus, REL))
154: == NULL)
155: {
156: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
157: return;
158: }
159:
160: (*((real8 *) (*s_objet_resultat).objet)) = ((real8)
1.42 bertrand 161: (*((integer8 *) (*s_objet_argument_2).objet)))
162: - ((real8) (*((integer8 *) (*s_objet_argument_1).objet)));
1.1 bertrand 163: }
164: }
165:
166: /*
167: --------------------------------------------------------------------------------
168: Soustraction d'un entier et d'un réel
169: --------------------------------------------------------------------------------
170: */
171:
172: else if ((((*s_objet_argument_1).type == INT) &&
173: ((*s_objet_argument_2).type == REL)) ||
174: (((*s_objet_argument_1).type == REL) &&
175: ((*s_objet_argument_2).type == INT)))
176: {
177: if ((s_objet_resultat = allocation(s_etat_processus, REL))
178: == NULL)
179: {
180: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
181: return;
182: }
183:
184: if ((*s_objet_argument_1).type == INT)
185: {
186: (*((real8 *) (*s_objet_resultat).objet)) = (*((real8 *)
1.43 bertrand 187: (*s_objet_argument_2).objet)) - ((real8) (*((integer8 *)
188: (*s_objet_argument_1).objet)));
1.1 bertrand 189: }
190: else
191: {
1.43 bertrand 192: (*((real8 *) (*s_objet_resultat).objet)) = ((real8) (*((integer8 *)
193: (*s_objet_argument_2).objet))) - (*((real8 *)
1.1 bertrand 194: (*s_objet_argument_1).objet));
195: }
196: }
197:
198: /*
199: --------------------------------------------------------------------------------
200: Soustraction d'un entier et d'un complexe
201: --------------------------------------------------------------------------------
202: */
203:
204: else if ((((*s_objet_argument_1).type == INT) &&
205: ((*s_objet_argument_2).type == CPL)) ||
206: (((*s_objet_argument_1).type == CPL) &&
207: ((*s_objet_argument_2).type == INT)))
208: {
209: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
210: == NULL)
211: {
212: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
213: return;
214: }
215:
216: if ((*s_objet_argument_1).type == INT)
217: {
218: f77soustractionci_((struct_complexe16 *) (*s_objet_argument_2)
219: .objet, (integer8 *) (*s_objet_argument_1).objet,
220: (struct_complexe16 *) (*s_objet_resultat).objet);
221: }
222: else
223: {
224: f77soustractionic_((integer8 *) (*s_objet_argument_2).objet,
225: (struct_complexe16 *) (*s_objet_argument_1).objet,
226: (struct_complexe16 *) (*s_objet_resultat).objet);
227: }
228: }
229:
230: /*
231: --------------------------------------------------------------------------------
232: Soustraction de deux réels
233: --------------------------------------------------------------------------------
234: */
235:
236: else if (((*s_objet_argument_1).type == REL) &&
237: ((*s_objet_argument_2).type == REL))
238: {
239: if ((s_objet_resultat = allocation(s_etat_processus, REL))
240: == NULL)
241: {
242: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
243: return;
244: }
245:
246: (*((real8 *) (*s_objet_resultat).objet)) = (*((real8 *)
247: (*s_objet_argument_2).objet)) - (*((real8 *)
248: (*s_objet_argument_1).objet));
249: }
250:
251: /*
252: --------------------------------------------------------------------------------
253: Soustraction d'un réel et d'un complexe
254: --------------------------------------------------------------------------------
255: */
256:
257: else if ((((*s_objet_argument_1).type == REL) &&
258: ((*s_objet_argument_2).type == CPL)) ||
259: (((*s_objet_argument_1).type == CPL) &&
260: ((*s_objet_argument_2).type == REL)))
261: {
262: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
263: == NULL)
264: {
265: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
266: return;
267: }
268:
269: if ((*s_objet_argument_1).type == REL)
270: {
271: f77soustractioncr_((struct_complexe16 *)
272: (*s_objet_argument_2).objet,
273: (real8 *) (*s_objet_argument_1).objet,
274: (struct_complexe16 *) (*s_objet_resultat).objet);
275: }
276: else
277: {
278: f77soustractionrc_((real8 *) (*s_objet_argument_2).objet,
279: (struct_complexe16 *) (*s_objet_argument_1).objet,
280: (struct_complexe16 *) (*s_objet_resultat).objet);
281: }
282: }
283:
284: /*
285: --------------------------------------------------------------------------------
286: Soustraction de deux complexes
287: --------------------------------------------------------------------------------
288: */
289:
290: else if (((*s_objet_argument_1).type == CPL) &&
291: ((*s_objet_argument_2).type == CPL))
292: {
293: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
294: == NULL)
295: {
296: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
297: return;
298: }
299:
300: f77soustractioncc_((struct_complexe16 *) (*s_objet_argument_2).objet,
301: (struct_complexe16 *) (*s_objet_argument_1).objet,
302: (struct_complexe16 *) (*s_objet_resultat).objet);
303: }
304:
305: /*
306: --------------------------------------------------------------------------------
307: Soustraction de deux vecteurs
308: --------------------------------------------------------------------------------
309: */
310: /*
311: * Entier / Entier
312: */
313:
314: else if (((*s_objet_argument_1).type == VIN) &&
315: ((*s_objet_argument_2).type == VIN))
316: {
317: if ((s_objet_resultat = allocation(s_etat_processus, VIN))
318: == NULL)
319: {
320: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
321: return;
322: }
323:
324: if ((*(((struct_vecteur *) (*s_objet_argument_1).objet))).taille !=
325: (*(((struct_vecteur *) (*s_objet_argument_2).objet))).taille)
326: {
327: liberation(s_etat_processus, s_objet_argument_1);
328: liberation(s_etat_processus, s_objet_argument_2);
329: liberation(s_etat_processus, s_objet_resultat);
330:
331: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
332: return;
333: }
334:
335: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
336: (*((struct_vecteur *) (*s_objet_argument_1).objet)).taille;
337:
338: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 339: malloc(((size_t) (*(((struct_vecteur *) (*s_objet_resultat)
340: .objet))).taille) * sizeof(integer8))) == NULL)
1.1 bertrand 341: {
342: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
343: return;
344: }
345:
346: depassement = d_faux;
347:
348: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_resultat)
349: .objet))).taille; i++)
350: {
1.42 bertrand 351: if (depassement_soustraction(&(((integer8 *) (*((struct_vecteur *)
352: (*s_objet_argument_2).objet)).tableau)[i]),
353: &(((integer8 *) (*((struct_vecteur *) (*s_objet_argument_1)
354: .objet)).tableau)[i]),
1.1 bertrand 355: &(((integer8 *) (*((struct_vecteur *)
356: (*s_objet_resultat).objet)).tableau)[i])) == d_erreur)
357: {
358: depassement = d_vrai;
359: }
360: }
361:
362: if (depassement == d_vrai)
363: {
364: free((*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau);
365:
366: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 367: malloc(((size_t) (*(((struct_vecteur *) (*s_objet_resultat)
368: .objet))).taille) * sizeof(real8))) == NULL)
1.1 bertrand 369: {
370: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
371: return;
372: }
373:
374: (*s_objet_resultat).type = VRL;
375: (*((struct_vecteur *) (*s_objet_resultat).objet)).type = 'R';
376:
377: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_resultat)
378: .objet))).taille; i++)
379: {
380: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
381: .tableau)[i] = (real8) (((integer8 *)
382: (*((struct_vecteur *) (*s_objet_argument_2).objet))
383: .tableau)[i]) - (real8) (((integer8 *)
384: (*((struct_vecteur *) (*s_objet_argument_1)
385: .objet)).tableau)[i]);
386: }
387: }
388: }
389:
390: /*
391: * Entier / Réel
392: */
393:
394: else if ((((*s_objet_argument_1).type == VIN) &&
395: ((*s_objet_argument_2).type == VRL)) ||
396: (((*s_objet_argument_1).type == VRL) &&
397: ((*s_objet_argument_2).type == VIN)))
398: {
399: if ((s_objet_resultat = allocation(s_etat_processus, VRL))
400: == NULL)
401: {
402: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
403: return;
404: }
405:
406: if ((*(((struct_vecteur *) (*s_objet_argument_1).objet))).taille !=
407: (*(((struct_vecteur *) (*s_objet_argument_2).objet))).taille)
408: {
409: liberation(s_etat_processus, s_objet_argument_1);
410: liberation(s_etat_processus, s_objet_argument_2);
411: liberation(s_etat_processus, s_objet_resultat);
412:
413: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
414: return;
415: }
416:
417: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
418: (*((struct_vecteur *) (*s_objet_argument_1).objet)).taille;
419:
420: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 421: malloc(((size_t) (*(((struct_vecteur *) (*s_objet_resultat)
422: .objet))).taille) * sizeof(real8))) == NULL)
1.1 bertrand 423: {
424: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
425: return;
426: }
427:
428: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_resultat)
429: .objet))).taille; i++)
430: {
431: if ((*s_objet_argument_1).type == VIN)
432: {
433: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
434: .tableau)[i] = ((real8 *) (*((struct_vecteur *)
435: (*s_objet_argument_2).objet)).tableau)[i]
1.43 bertrand 436: - ((real8) ((integer8 *) (*((struct_vecteur *)
437: (*s_objet_argument_1).objet)).tableau)[i]);
1.1 bertrand 438: }
439: else
440: {
441: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1.43 bertrand 442: .tableau)[i] = ((real8) ((integer8 *)
443: (*((struct_vecteur *) (*s_objet_argument_2).objet))
444: .tableau)[i]) - ((real8 *) (*((struct_vecteur *)
1.1 bertrand 445: (*s_objet_argument_1).objet)).tableau)[i];
446: }
447: }
448: }
449:
450: /*
451: * Réel / Réel
452: */
453:
454: else if (((*s_objet_argument_1).type == VRL) &&
455: ((*s_objet_argument_2).type == VRL))
456: {
457: if ((s_objet_resultat = allocation(s_etat_processus, VRL))
458: == NULL)
459: {
460: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
461: return;
462: }
463:
464: if ((*(((struct_vecteur *) (*s_objet_argument_1).objet))).taille !=
465: (*(((struct_vecteur *) (*s_objet_argument_2).objet))).taille)
466: {
467: liberation(s_etat_processus, s_objet_argument_1);
468: liberation(s_etat_processus, s_objet_argument_2);
469: liberation(s_etat_processus, s_objet_resultat);
470:
471: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
472: return;
473: }
474:
475: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
476: (*((struct_vecteur *) (*s_objet_argument_1).objet)).taille;
477:
478: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 479: malloc(((size_t) (*(((struct_vecteur *) (*s_objet_resultat)
480: .objet))).taille) * sizeof(real8))) == NULL)
1.1 bertrand 481: {
482: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
483: return;
484: }
485:
486: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_resultat)
487: .objet))).taille; i++)
488: {
489: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
490: .tableau)[i] = ((real8 *) (*((struct_vecteur *)
491: (*s_objet_argument_2).objet)).tableau)[i] -
492: ((real8 *) (*((struct_vecteur *) (*s_objet_argument_1)
493: .objet)).tableau)[i];
494: }
495: }
496:
497: /*
498: * Entier / Complexe
499: */
500:
501: else if ((((*s_objet_argument_1).type == VIN) &&
502: ((*s_objet_argument_2).type == VCX)) ||
503: (((*s_objet_argument_1).type == VCX) &&
504: ((*s_objet_argument_2).type == VIN)))
505: {
506: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
507: == NULL)
508: {
509: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
510: return;
511: }
512:
513: if ((*(((struct_vecteur *) (*s_objet_argument_1).objet))).taille !=
514: (*(((struct_vecteur *) (*s_objet_argument_2).objet))).taille)
515: {
516: liberation(s_etat_processus, s_objet_argument_1);
517: liberation(s_etat_processus, s_objet_argument_2);
518: liberation(s_etat_processus, s_objet_resultat);
519:
520: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
521: return;
522: }
523:
524: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
525: (*((struct_vecteur *) (*s_objet_argument_1).objet)).taille;
526:
527: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 528: malloc(((size_t) (*(((struct_vecteur *) (*s_objet_resultat)
529: .objet))).taille) * sizeof(struct_complexe16))) == NULL)
1.1 bertrand 530: {
531: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
532: return;
533: }
534:
535: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_resultat)
536: .objet))).taille; i++)
537: {
538: if ((*s_objet_argument_1).type == VIN)
539: {
540: f77soustractionci_(&(((struct_complexe16 *)
541: (*((struct_vecteur *)
542: (*s_objet_argument_2).objet)).tableau)[i]),
543: &(((integer8 *) (*((struct_vecteur *)
544: (*s_objet_argument_1).objet)).tableau)[i]),
545: &(((struct_complexe16 *) (*((struct_vecteur *)
546: (*s_objet_resultat).objet)).tableau)[i]));
547: }
548: else
549: {
550: f77soustractionic_(&(((integer8 *) (*((struct_vecteur *)
551: (*s_objet_argument_2).objet)).tableau)[i]),
552: &(((struct_complexe16 *) (*((struct_vecteur *)
553: (*s_objet_argument_1).objet)).tableau)[i]),
554: &(((struct_complexe16 *) (*((struct_vecteur *)
555: (*s_objet_resultat).objet)).tableau)[i]));
556: }
557: }
558: }
559:
560: /*
561: * Réel / Complexe
562: */
563:
564: else if ((((*s_objet_argument_1).type == VRL) &&
565: ((*s_objet_argument_2).type == VCX)) ||
566: (((*s_objet_argument_1).type == VCX) &&
567: ((*s_objet_argument_2).type == VRL)))
568: {
569: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
570: == NULL)
571: {
572: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
573: return;
574: }
575:
576: if ((*(((struct_vecteur *) (*s_objet_argument_1).objet))).taille !=
577: (*(((struct_vecteur *) (*s_objet_argument_2).objet))).taille)
578: {
579: liberation(s_etat_processus, s_objet_argument_1);
580: liberation(s_etat_processus, s_objet_argument_2);
581: liberation(s_etat_processus, s_objet_resultat);
582:
583: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
584: return;
585: }
586:
587: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
588: (*((struct_vecteur *) (*s_objet_argument_1).objet)).taille;
589:
590: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 591: malloc(((size_t) (*(((struct_vecteur *) (*s_objet_resultat)
592: .objet))).taille) * sizeof(struct_complexe16))) == NULL)
1.1 bertrand 593: {
594: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
595: return;
596: }
597:
598: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_resultat)
599: .objet))).taille; i++)
600: {
601: if ((*s_objet_argument_1).type == VRL)
602: {
603: f77soustractioncr_(&(((struct_complexe16 *)
604: (*((struct_vecteur *)
605: (*s_objet_argument_2).objet)).tableau)[i]),
606: &(((real8 *) (*((struct_vecteur *)
607: (*s_objet_argument_1).objet)).tableau)[i]),
608: &(((struct_complexe16 *) (*((struct_vecteur *)
609: (*s_objet_resultat).objet)).tableau)[i]));
610: }
611: else
612: {
613: f77soustractionrc_(&(((real8 *) (*((struct_vecteur *)
614: (*s_objet_argument_2).objet)).tableau)[i]),
615: &(((struct_complexe16 *) (*((struct_vecteur *)
616: (*s_objet_argument_1).objet)).tableau)[i]),
617: &(((struct_complexe16 *) (*((struct_vecteur *)
618: (*s_objet_resultat).objet)).tableau)[i]));
619: }
620: }
621: }
622:
623: /*
624: * Complexe / Complexe
625: */
626:
627: else if (((*s_objet_argument_1).type == VCX) &&
628: ((*s_objet_argument_2).type == VCX))
629: {
630: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
631: == NULL)
632: {
633: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
634: return;
635: }
636:
637: if ((*(((struct_vecteur *) (*s_objet_argument_1).objet))).taille !=
638: (*(((struct_vecteur *) (*s_objet_argument_2).objet))).taille)
639: {
640: liberation(s_etat_processus, s_objet_argument_1);
641: liberation(s_etat_processus, s_objet_argument_2);
642: liberation(s_etat_processus, s_objet_resultat);
643:
644: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
645: return;
646: }
647:
648: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
649: (*((struct_vecteur *) (*s_objet_argument_1).objet)).taille;
650:
651: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 652: malloc(((size_t) (*(((struct_vecteur *) (*s_objet_resultat)
653: .objet))).taille) * sizeof(struct_complexe16))) == NULL)
1.1 bertrand 654: {
655: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
656: return;
657: }
658:
659: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_resultat)
660: .objet))).taille; i++)
661: {
662: f77soustractioncc_(&(((struct_complexe16 *) (*((struct_vecteur *)
663: (*s_objet_argument_2).objet)).tableau)[i]),
664: &(((struct_complexe16 *) (*((struct_vecteur *)
665: (*s_objet_argument_1).objet)).tableau)[i]),
666: &(((struct_complexe16 *) (*((struct_vecteur *)
667: (*s_objet_resultat).objet)).tableau)[i]));
668: }
669: }
670:
671: /*
672: --------------------------------------------------------------------------------
673: Soustraction de deux matrices
674: --------------------------------------------------------------------------------
675: */
676: /*
677: * Entier / Entier
678: */
679:
680: else if (((*s_objet_argument_1).type == MIN) &&
681: ((*s_objet_argument_2).type == MIN))
682: {
683: if ((s_objet_resultat = allocation(s_etat_processus, MIN))
684: == NULL)
685: {
686: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
687: return;
688: }
689:
690: if (((*(((struct_matrice *) (*s_objet_argument_1).objet)))
691: .nombre_lignes != (*(((struct_matrice *) (*s_objet_argument_2)
692: .objet))).nombre_lignes) || ((*(((struct_matrice *)
693: (*s_objet_argument_1).objet))).nombre_colonnes !=
694: (*(((struct_matrice *) (*s_objet_argument_2).objet)))
695: .nombre_colonnes))
696: {
697: liberation(s_etat_processus, s_objet_argument_1);
698: liberation(s_etat_processus, s_objet_argument_2);
699: liberation(s_etat_processus, s_objet_resultat);
700:
701: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
702: return;
703: }
704:
705: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
706: (*((struct_matrice *) (*s_objet_argument_1).objet))
707: .nombre_lignes;
708: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
709: (*((struct_matrice *) (*s_objet_argument_1).objet))
710: .nombre_colonnes;
711:
712: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 713: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
714: .objet))).nombre_lignes) * sizeof(integer8 *))) == NULL)
1.1 bertrand 715: {
716: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
717: return;
718: }
719:
720: depassement = d_faux;
721:
722: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
723: .objet))).nombre_lignes; i++)
724: {
725: if ((((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
1.43 bertrand 726: .objet)).tableau)[i] = malloc(((size_t) (*((
1.1 bertrand 727: (struct_matrice *) (*s_objet_resultat).objet)))
1.43 bertrand 728: .nombre_colonnes) * sizeof(integer8))) == NULL)
1.1 bertrand 729: {
730: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
731: return;
732: }
733:
734: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat).objet)))
735: .nombre_colonnes; j++)
736: {
1.42 bertrand 737: if (depassement_soustraction(&(((integer8 **)
738: (*((struct_matrice *) (*s_objet_argument_2).objet))
739: .tableau)[i][j]), &(((integer8 **) (*((struct_matrice *)
740: (*s_objet_argument_1).objet)).tableau)[i][j]),
1.1 bertrand 741: &(((integer8 **) (*((struct_matrice *)
742: (*s_objet_resultat).objet)).tableau)[i][j]))
743: == d_erreur)
744: {
745: depassement = d_vrai;
746: }
747: }
748: }
749:
750: if (depassement == d_vrai)
751: {
752: (*s_objet_resultat).type = MRL;
753: (*((struct_matrice *) (*s_objet_resultat).objet)).type = 'R';
754:
755: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
756: .objet))).nombre_lignes; i++)
757: {
758: free(((integer8 **) (*((struct_matrice *)
759: (*s_objet_resultat).objet)).tableau)[i]);
760:
761: if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat)
1.43 bertrand 762: .objet)).tableau)[i] = malloc(((size_t) (*((
1.1 bertrand 763: (struct_matrice *) (*s_objet_resultat).objet)))
1.43 bertrand 764: .nombre_colonnes) * sizeof(real8))) == NULL)
1.1 bertrand 765: {
766: (*s_etat_processus).erreur_systeme =
767: d_es_allocation_memoire;
768: return;
769: }
770:
771: for(j = 0; j < (*(((struct_matrice *)
772: (*s_objet_resultat).objet))).nombre_colonnes; j++)
773: {
774: ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
775: .objet)).tableau)[i][j] = ((real8) ((integer8 **)
776: (*((struct_matrice *) (*s_objet_argument_2).objet))
777: .tableau)[i][j]) - ((real8) ((integer8 **)
778: (*((struct_matrice *) (*s_objet_argument_1).objet))
779: .tableau)[i][j]);
780: }
781: }
782: }
783: }
784:
785: /*
786: * Entier / Réel
787: */
788:
789: else if ((((*s_objet_argument_1).type == MIN) &&
790: ((*s_objet_argument_2).type == MRL)) ||
791: (((*s_objet_argument_1).type == MRL) &&
792: ((*s_objet_argument_2).type == MIN)))
793: {
794: if ((s_objet_resultat = allocation(s_etat_processus, MRL))
795: == NULL)
796: {
797: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
798: return;
799: }
800:
801: if (((*(((struct_matrice *) (*s_objet_argument_1).objet)))
802: .nombre_lignes != (*(((struct_matrice *) (*s_objet_argument_2)
803: .objet))).nombre_lignes) || ((*(((struct_matrice *)
804: (*s_objet_argument_1).objet))).nombre_colonnes !=
805: (*(((struct_matrice *) (*s_objet_argument_2).objet)))
806: .nombre_colonnes))
807: {
808: liberation(s_etat_processus, s_objet_argument_1);
809: liberation(s_etat_processus, s_objet_argument_2);
810: liberation(s_etat_processus, s_objet_resultat);
811:
812: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
813: return;
814: }
815:
816: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
817: (*((struct_matrice *) (*s_objet_argument_1).objet))
818: .nombre_lignes;
819: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
820: (*((struct_matrice *) (*s_objet_argument_1).objet))
821: .nombre_colonnes;
822:
823: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 824: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
825: .objet))).nombre_lignes) * sizeof(real8 *))) == NULL)
1.1 bertrand 826: {
827: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
828: return;
829: }
830:
831: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
832: .objet))).nombre_lignes; i++)
833: {
834: if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat)
1.43 bertrand 835: .objet)).tableau)[i] = malloc(((size_t) (*((
1.1 bertrand 836: (struct_matrice *) (*s_objet_resultat).objet)))
1.43 bertrand 837: .nombre_colonnes) * sizeof(real8))) == NULL)
1.1 bertrand 838: {
839: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
840: return;
841: }
842:
843: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat).objet)))
844: .nombre_colonnes; j++)
845: {
846: if ((*s_objet_argument_1).type == MIN)
847: {
848: ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
849: .objet)).tableau)[i][j] = ((real8 **)
850: (*((struct_matrice *) (*s_objet_argument_2).objet))
1.43 bertrand 851: .tableau)[i][j] - ((real8) ((integer8 **)
1.1 bertrand 852: (*((struct_matrice *) (*s_objet_argument_1).objet))
1.43 bertrand 853: .tableau)[i][j]);
1.1 bertrand 854: }
855: else
856: {
857: ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
1.43 bertrand 858: .objet)).tableau)[i][j] = ((real8) ((integer8 **)
1.1 bertrand 859: (*((struct_matrice *) (*s_objet_argument_2)
1.43 bertrand 860: .objet)).tableau)[i][j]) - ((real8 **)
1.1 bertrand 861: (*((struct_matrice *) (*s_objet_argument_1).objet))
862: .tableau)[i][j];
863: }
864: }
865: }
866: }
867:
868: /*
869: * Réel / Réel
870: */
871:
872: else if (((*s_objet_argument_1).type == MRL) &&
873: ((*s_objet_argument_2).type == MRL))
874: {
875: if ((s_objet_resultat = allocation(s_etat_processus, MRL))
876: == NULL)
877: {
878: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
879: return;
880: }
881:
882: if (((*(((struct_matrice *) (*s_objet_argument_1).objet)))
883: .nombre_lignes != (*(((struct_matrice *) (*s_objet_argument_2)
884: .objet))).nombre_lignes) || ((*(((struct_matrice *)
885: (*s_objet_argument_1).objet))).nombre_colonnes !=
886: (*(((struct_matrice *) (*s_objet_argument_2).objet)))
887: .nombre_colonnes))
888: {
889: liberation(s_etat_processus, s_objet_argument_1);
890: liberation(s_etat_processus, s_objet_argument_2);
891: liberation(s_etat_processus, s_objet_resultat);
892:
893: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
894: return;
895: }
896:
897: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
898: (*((struct_matrice *) (*s_objet_argument_1).objet))
899: .nombre_lignes;
900: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
901: (*((struct_matrice *) (*s_objet_argument_1).objet))
902: .nombre_colonnes;
903:
904: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 905: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
906: .objet))).nombre_lignes) * sizeof(real8 *))) == NULL)
1.1 bertrand 907: {
908: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
909: return;
910: }
911:
912: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
913: .objet))).nombre_lignes; i++)
914: {
915: if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat)
1.43 bertrand 916: .objet)).tableau)[i] = malloc(((size_t) (*((
1.1 bertrand 917: (struct_matrice *) (*s_objet_resultat).objet)))
1.43 bertrand 918: .nombre_colonnes) * sizeof(real8))) == NULL)
1.1 bertrand 919: {
920: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
921: return;
922: }
923:
924: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat).objet)))
925: .nombre_colonnes; j++)
926: {
927: ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
928: .objet)).tableau)[i][j] = ((real8 **)
929: (*((struct_matrice *) (*s_objet_argument_2).objet))
930: .tableau)[i][j] - ((real8 **) (*((struct_matrice *)
931: (*s_objet_argument_1).objet)).tableau)[i][j];
932: }
933: }
934: }
935:
936: /*
937: * Entier / Complexe
938: */
939:
940: else if ((((*s_objet_argument_1).type == MIN) &&
941: ((*s_objet_argument_2).type == MCX)) ||
942: (((*s_objet_argument_1).type == MCX) &&
943: ((*s_objet_argument_2).type == MIN)))
944: {
945: if ((s_objet_resultat = allocation(s_etat_processus, MCX))
946: == NULL)
947: {
948: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
949: return;
950: }
951:
952: if (((*(((struct_matrice *) (*s_objet_argument_1).objet)))
953: .nombre_lignes != (*(((struct_matrice *) (*s_objet_argument_2)
954: .objet))).nombre_lignes) || ((*(((struct_matrice *)
955: (*s_objet_argument_1).objet))).nombre_colonnes !=
956: (*(((struct_matrice *) (*s_objet_argument_2).objet)))
957: .nombre_colonnes))
958: {
959: liberation(s_etat_processus, s_objet_argument_1);
960: liberation(s_etat_processus, s_objet_argument_2);
961: liberation(s_etat_processus, s_objet_resultat);
962:
963: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
964: return;
965: }
966:
967: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
968: (*((struct_matrice *) (*s_objet_argument_1).objet))
969: .nombre_lignes;
970: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
971: (*((struct_matrice *) (*s_objet_argument_1).objet))
972: .nombre_colonnes;
973:
974: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 975: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
976: .objet))).nombre_lignes) * sizeof(struct_complexe16 *)))
977: == NULL)
1.1 bertrand 978: {
979: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
980: return;
981: }
982:
983: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
984: .objet))).nombre_lignes; i++)
985: {
986: if ((((struct_complexe16 **) (*((struct_matrice *)
1.43 bertrand 987: (*s_objet_resultat).objet)).tableau)[i] = malloc(
988: ((size_t) (*(((struct_matrice *) (*s_objet_resultat)
989: .objet))).nombre_colonnes) * sizeof(struct_complexe16)))
990: == NULL)
1.1 bertrand 991: {
992: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
993: return;
994: }
995:
996: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat).objet)))
997: .nombre_colonnes; j++)
998: {
999: if ((*s_objet_argument_1).type == MIN)
1000: {
1001: f77soustractionci_(&(((struct_complexe16 **)
1002: (*((struct_matrice *)
1003: (*s_objet_argument_2).objet)).tableau)[i][j]),
1004: &(((integer8 **) (*((struct_matrice *)
1005: (*s_objet_argument_1).objet)).tableau)[i][j]),
1006: &(((struct_complexe16 **) (*((struct_matrice *)
1007: (*s_objet_resultat).objet)).tableau)[i][j]));
1008: }
1009: else
1010: {
1011: f77soustractionic_(&(((integer8 **) (*((struct_matrice *)
1012: (*s_objet_argument_2).objet)).tableau)[i][j]),
1013: &(((struct_complexe16 **) (*((struct_matrice *)
1014: (*s_objet_argument_1).objet)).tableau)[i][j]),
1015: &(((struct_complexe16 **) (*((struct_matrice *)
1016: (*s_objet_resultat).objet)).tableau)[i][j]));
1017: }
1018: }
1019: }
1020: }
1021:
1022: /*
1023: * Réel / Complexe
1024: */
1025:
1026: else if ((((*s_objet_argument_1).type == MRL) &&
1027: ((*s_objet_argument_2).type == MCX)) ||
1028: (((*s_objet_argument_1).type == MCX) &&
1029: ((*s_objet_argument_2).type == MRL)))
1030: {
1031: if ((s_objet_resultat = allocation(s_etat_processus, MCX))
1032: == NULL)
1033: {
1034: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1035: return;
1036: }
1037:
1038: if (((*(((struct_matrice *) (*s_objet_argument_1).objet)))
1039: .nombre_lignes != (*(((struct_matrice *) (*s_objet_argument_2)
1040: .objet))).nombre_lignes) || ((*(((struct_matrice *)
1041: (*s_objet_argument_1).objet))).nombre_colonnes !=
1042: (*(((struct_matrice *) (*s_objet_argument_2).objet)))
1043: .nombre_colonnes))
1044: {
1045: liberation(s_etat_processus, s_objet_argument_1);
1046: liberation(s_etat_processus, s_objet_argument_2);
1047: liberation(s_etat_processus, s_objet_resultat);
1048:
1049: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1050: return;
1051: }
1052:
1053: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
1054: (*((struct_matrice *) (*s_objet_argument_1).objet))
1055: .nombre_lignes;
1056: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
1057: (*((struct_matrice *) (*s_objet_argument_1).objet))
1058: .nombre_colonnes;
1059:
1060: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 1061: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
1062: .objet))).nombre_lignes) * sizeof(struct_complexe16 *)))
1063: == NULL)
1.1 bertrand 1064: {
1065: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1066: return;
1067: }
1068:
1069: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
1070: .objet))).nombre_lignes; i++)
1071: {
1072: if ((((struct_complexe16 **) (*((struct_matrice *)
1.43 bertrand 1073: (*s_objet_resultat).objet)).tableau)[i] = malloc(((size_t)
1074: (*(((struct_matrice *) (*s_objet_resultat).objet)))
1075: .nombre_colonnes) * sizeof(struct_complexe16))) == NULL)
1.1 bertrand 1076: {
1077: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1078: return;
1079: }
1080:
1081: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat).objet)))
1082: .nombre_colonnes; j++)
1083: {
1084: if ((*s_objet_argument_1).type == MRL)
1085: {
1086: f77soustractioncr_(&(((struct_complexe16 **)
1087: (*((struct_matrice *)
1088: (*s_objet_argument_2).objet)).tableau)[i][j]),
1089: &(((real8 **) (*((struct_matrice *)
1090: (*s_objet_argument_1).objet)).tableau)[i][j]),
1091: &(((struct_complexe16 **) (*((struct_matrice *)
1092: (*s_objet_resultat).objet)).tableau)[i][j]));
1093: }
1094: else
1095: {
1096: f77soustractionrc_(&(((real8 **) (*((struct_matrice *)
1097: (*s_objet_argument_2).objet)).tableau)[i][j]),
1098: &(((struct_complexe16 **) (*((struct_matrice *)
1099: (*s_objet_argument_1).objet)).tableau)[i][j]),
1100: &(((struct_complexe16 **) (*((struct_matrice *)
1101: (*s_objet_resultat).objet)).tableau)[i][j]));
1102: }
1103: }
1104: }
1105: }
1106:
1107: /*
1108: * Complexe / Complexe
1109: */
1110:
1111: else if (((*s_objet_argument_1).type == MCX) &&
1112: ((*s_objet_argument_2).type == MCX))
1113: {
1114: if ((s_objet_resultat = allocation(s_etat_processus, MCX))
1115: == NULL)
1116: {
1117: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1118: return;
1119: }
1120:
1121: if (((*(((struct_matrice *) (*s_objet_argument_1).objet)))
1122: .nombre_lignes != (*(((struct_matrice *) (*s_objet_argument_2)
1123: .objet))).nombre_lignes) || ((*(((struct_matrice *)
1124: (*s_objet_argument_1).objet))).nombre_colonnes !=
1125: (*(((struct_matrice *) (*s_objet_argument_2).objet)))
1126: .nombre_colonnes))
1127: {
1128: liberation(s_etat_processus, s_objet_argument_1);
1129: liberation(s_etat_processus, s_objet_argument_2);
1130: liberation(s_etat_processus, s_objet_resultat);
1131:
1132: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1133: return;
1134: }
1135:
1136: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
1137: (*((struct_matrice *) (*s_objet_argument_1).objet))
1138: .nombre_lignes;
1139: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
1140: (*((struct_matrice *) (*s_objet_argument_1).objet))
1141: .nombre_colonnes;
1142:
1143: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 1144: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
1145: .objet))).nombre_lignes) * sizeof(struct_complexe16 *)))
1146: == NULL)
1.1 bertrand 1147: {
1148: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1149: return;
1150: }
1151:
1152: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
1153: .objet))).nombre_lignes; i++)
1154: {
1155: if ((((struct_complexe16 **) (*((struct_matrice *)
1.43 bertrand 1156: (*s_objet_resultat).objet)).tableau)[i] = malloc(((size_t)
1157: (*(((struct_matrice *) (*s_objet_resultat).objet)))
1158: .nombre_colonnes) * sizeof(struct_complexe16))) == NULL)
1.1 bertrand 1159: {
1160: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1161: return;
1162: }
1163:
1164: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat).objet)))
1165: .nombre_colonnes; j++)
1166: {
1167: f77soustractioncc_(&(((struct_complexe16 **)
1168: (*((struct_matrice *)
1169: (*s_objet_argument_2).objet)).tableau)[i][j]),
1170: &(((struct_complexe16 **) (*((struct_matrice *)
1171: (*s_objet_argument_1).objet)).tableau)[i][j]),
1172: &(((struct_complexe16 **) (*((struct_matrice *)
1173: (*s_objet_resultat).objet)).tableau)[i][j]));
1174: }
1175: }
1176: }
1177:
1178: /*
1179: --------------------------------------------------------------------------------
1180: Soustraction mettant en oeuvre des binaires
1181: --------------------------------------------------------------------------------
1182: */
1183: /*
1184: * Binaire / Binaire
1185: */
1186:
1187: else if (((*s_objet_argument_1).type == BIN) &&
1188: ((*s_objet_argument_2).type == BIN))
1189: {
1190: if ((s_objet_resultat = allocation(s_etat_processus, BIN))
1191: == NULL)
1192: {
1193: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1194: return;
1195: }
1196:
1197: (*((logical8 *) (*s_objet_resultat).objet)) =
1198: (*((logical8 *) (*s_objet_argument_2).objet))
1199: - (*((logical8 *) (*s_objet_argument_1).objet));
1200: }
1201:
1202: /*
1203: * Binaire / Entier
1204: */
1205:
1206: else if ((((*s_objet_argument_1).type == BIN) &&
1207: ((*s_objet_argument_2).type == INT)) ||
1208: (((*s_objet_argument_1).type == INT) &&
1209: ((*s_objet_argument_2).type == BIN)))
1210: {
1211: if ((s_objet_resultat = allocation(s_etat_processus, BIN))
1212: == NULL)
1213: {
1214: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1215: return;
1216: }
1217:
1218: if ((*s_objet_argument_1).type == BIN)
1219: {
1220: (*((logical8 *) (*s_objet_resultat).objet)) =
1.43 bertrand 1221: ((logical8) (*((integer8 *) (*s_objet_argument_2).objet)))
1.1 bertrand 1222: - (*((logical8 *) (*s_objet_argument_1).objet));
1223: }
1224: else
1225: {
1226: (*((logical8 *) (*s_objet_resultat).objet)) =
1227: (*((logical8 *) (*s_objet_argument_2).objet))
1.43 bertrand 1228: - ((logical8) (*((integer8 *) (*s_objet_argument_1)
1229: .objet)));
1.1 bertrand 1230: }
1231: }
1232:
1233: /*
1234: --------------------------------------------------------------------------------
1235: Soustraction mettant en oeuvre un nom ou une expression algébrique
1236: --------------------------------------------------------------------------------
1237: */
1238: /*
1239: * Nom ou valeur numérique / Nom ou valeur numérique
1240: */
1241:
1242: else if ((((*s_objet_argument_1).type == NOM) &&
1243: (((*s_objet_argument_2).type == NOM) ||
1244: ((*s_objet_argument_2).type == INT) ||
1245: ((*s_objet_argument_2).type == REL) ||
1246: ((*s_objet_argument_2).type == CPL))) ||
1247: (((*s_objet_argument_2).type == NOM) &&
1248: (((*s_objet_argument_1).type == INT) ||
1249: ((*s_objet_argument_1).type == REL) ||
1250: ((*s_objet_argument_1).type == CPL))))
1251: {
1252: drapeau = d_vrai;
1253: drapeau_neg = d_faux;
1254:
1255: if ((*s_objet_argument_2).type == NOM)
1256: {
1257: if ((*s_objet_argument_1).type == INT)
1258: {
1259: if ((*((integer8 *) (*s_objet_argument_1).objet)) == 0)
1260: {
1261: drapeau = d_faux;
1262:
1263: s_objet_resultat = s_objet_argument_2;
1264: s_objet_argument_2 = NULL;
1265: }
1266: }
1267: else if ((*s_objet_argument_1).type == REL)
1268: {
1269: if ((*((real8 *) (*s_objet_argument_1).objet)) == 0)
1270: {
1271: drapeau = d_faux;
1272:
1273: s_objet_resultat = s_objet_argument_2;
1274: s_objet_argument_2 = NULL;
1275: }
1276: }
1277: else if ((*s_objet_argument_1).type == CPL)
1278: {
1279: if (((*((complex16 *) (*s_objet_argument_1).objet))
1280: .partie_reelle == 0) && ((*((complex16 *)
1281: (*s_objet_argument_1).objet)).partie_imaginaire == 0))
1282: {
1283: drapeau = d_faux;
1284:
1285: s_objet_resultat = s_objet_argument_2;
1286: s_objet_argument_2 = NULL;
1287: }
1288: }
1289: }
1290: else if ((*s_objet_argument_1).type == NOM)
1291: {
1292: if ((*s_objet_argument_2).type == INT)
1293: {
1294: if ((*((integer8 *) (*s_objet_argument_2).objet)) == 0)
1295: {
1296: drapeau_neg = d_vrai;
1297: }
1298: }
1299: else if ((*s_objet_argument_2).type == REL)
1300: {
1301: if ((*((real8 *) (*s_objet_argument_2).objet)) == 0)
1302: {
1303: drapeau_neg = d_vrai;
1304: }
1305: }
1306: else if ((*s_objet_argument_2).type == CPL)
1307: {
1308: if (((*((complex16 *) (*s_objet_argument_2).objet))
1309: .partie_reelle == 0) && ((*((complex16 *)
1310: (*s_objet_argument_2).objet)).partie_imaginaire == 0))
1311: {
1312: drapeau_neg = d_vrai;
1313: }
1314: }
1315: }
1316:
1317: if (drapeau == d_vrai)
1318: {
1319: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
1320: == NULL)
1321: {
1322: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1323: return;
1324: }
1325:
1326: if (((*s_objet_resultat).objet =
1327: allocation_maillon(s_etat_processus)) == NULL)
1328: {
1329: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1330: return;
1331: }
1332:
1333: l_element_courant = (*s_objet_resultat).objet;
1334:
1335: if (((*l_element_courant).donnee = allocation(s_etat_processus,
1336: FCT)) == NULL)
1337: {
1338: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1339: return;
1340: }
1341:
1342: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1343: .nombre_arguments = 0;
1344: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1345: .fonction = instruction_vers_niveau_superieur;
1346:
1347: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1348: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1349: {
1350: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1351: return;
1352: }
1353:
1354: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1355: .nom_fonction, "<<");
1356:
1357: if (drapeau_neg == d_faux)
1358: {
1359: if (((*l_element_courant).suivant =
1360: allocation_maillon(s_etat_processus)) == NULL)
1361: {
1362: (*s_etat_processus).erreur_systeme =
1363: d_es_allocation_memoire;
1364: return;
1365: }
1366:
1367: l_element_courant = (*l_element_courant).suivant;
1368: (*l_element_courant).donnee = s_objet_argument_2;
1369: }
1370: else
1371: {
1372: liberation(s_etat_processus, s_objet_argument_2);
1373: }
1374:
1375: if (((*l_element_courant).suivant =
1376: allocation_maillon(s_etat_processus)) == NULL)
1377: {
1378: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1379: return;
1380: }
1381:
1382: l_element_courant = (*l_element_courant).suivant;
1383: (*l_element_courant).donnee = s_objet_argument_1;
1384:
1385: if (((*l_element_courant).suivant =
1386: allocation_maillon(s_etat_processus)) == NULL)
1387: {
1388: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1389: return;
1390: }
1391:
1392: l_element_courant = (*l_element_courant).suivant;
1393:
1394: if (((*l_element_courant).donnee = allocation(s_etat_processus,
1395: FCT)) == NULL)
1396: {
1397: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1398: return;
1399: }
1400:
1401: if (drapeau_neg == d_faux)
1402: {
1403: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1404: .nombre_arguments = 0;
1405: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1406: .fonction = instruction_moins;
1407:
1408: if (((*((struct_fonction *) (*(*l_element_courant)
1409: .donnee).objet)).nom_fonction =
1410: malloc(2 * sizeof(unsigned char))) == NULL)
1411: {
1412: (*s_etat_processus).erreur_systeme =
1413: d_es_allocation_memoire;
1414: return;
1415: }
1416:
1417: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee)
1418: .objet)).nom_fonction, "-");
1419: }
1420: else
1421: {
1422: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1423: .nombre_arguments = 1;
1424: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1425: .fonction = instruction_neg;
1426:
1427: if (((*((struct_fonction *) (*(*l_element_courant)
1428: .donnee).objet)).nom_fonction =
1429: malloc(4 * sizeof(unsigned char))) == NULL)
1430: {
1431: (*s_etat_processus).erreur_systeme =
1432: d_es_allocation_memoire;
1433: return;
1434: }
1435:
1436: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee)
1437: .objet)).nom_fonction, "NEG");
1438: }
1439:
1440: if (((*l_element_courant).suivant =
1441: allocation_maillon(s_etat_processus)) == NULL)
1442: {
1443: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1444: return;
1445: }
1446:
1447: l_element_courant = (*l_element_courant).suivant;
1448:
1449: if (((*l_element_courant).donnee = allocation(s_etat_processus,
1450: FCT)) == NULL)
1451: {
1452: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1453: return;
1454: }
1455:
1456: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1457: .nombre_arguments = 0;
1458: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1459: .fonction = instruction_vers_niveau_inferieur;
1460:
1461: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1462: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1463: {
1464: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1465: return;
1466: }
1467:
1468: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1469: .nom_fonction, ">>");
1470:
1471: (*l_element_courant).suivant = NULL;
1472:
1473: s_objet_argument_1 = NULL;
1474: s_objet_argument_2 = NULL;
1475: }
1476: }
1477:
1478: /*
1479: * Nom ou valeur numérique / Expression
1480: */
1481:
1482: else if ((((*s_objet_argument_1).type == ALG) ||
1483: ((*s_objet_argument_1).type == RPN)) &&
1484: (((*s_objet_argument_2).type == NOM) ||
1485: ((*s_objet_argument_2).type == INT) ||
1486: ((*s_objet_argument_2).type == REL) ||
1487: ((*s_objet_argument_2).type == CPL)))
1488: {
1489: drapeau_neg = d_faux;
1490:
1491: nombre_elements = 0;
1492: l_element_courant = (struct_liste_chainee *)
1493: (*s_objet_argument_1).objet;
1494:
1495: while(l_element_courant != NULL)
1496: {
1497: nombre_elements++;
1498: l_element_courant = (*l_element_courant).suivant;
1499: }
1500:
1501: if (nombre_elements == 2)
1502: {
1503: liberation(s_etat_processus, s_objet_argument_1);
1504: liberation(s_etat_processus, s_objet_argument_2);
1505:
1506: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
1507: return;
1508: }
1509:
1510: if ((*s_objet_argument_2).type == INT)
1511: {
1512: if ((*((integer8 *) (*s_objet_argument_2).objet)) == 0)
1513: {
1514: drapeau_neg = d_vrai;
1515: }
1516: }
1517: else if ((*s_objet_argument_2).type == REL)
1518: {
1519: if ((*((real8 *) (*s_objet_argument_2).objet)) == 0)
1520: {
1521: drapeau_neg = d_vrai;
1522: }
1523: }
1524: else if ((*s_objet_argument_2).type == CPL)
1525: {
1526: if (((*((complex16 *) (*s_objet_argument_2).objet))
1527: .partie_reelle == 0) && ((*((complex16 *)
1528: (*s_objet_argument_2).objet)).partie_imaginaire == 0))
1529: {
1530: drapeau_neg = d_vrai;
1531: }
1532: }
1533:
1534: if ((s_objet_resultat = copie_objet(s_etat_processus,
1535: s_objet_argument_1, 'N')) == NULL)
1536: {
1537: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1538: return;
1539: }
1540:
1541: l_element_courant = (struct_liste_chainee *)
1542: (*s_objet_resultat).objet;
1543: l_element_precedent = l_element_courant;
1544: l_element_courant = (*l_element_courant).suivant;
1545:
1546: if (drapeau_neg == d_faux)
1547: {
1548: if (((*l_element_precedent).suivant =
1549: allocation_maillon(s_etat_processus)) == NULL)
1550: {
1551: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1552: return;
1553: }
1554:
1555: (*(*l_element_precedent).suivant).donnee = s_objet_argument_2;
1556: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1557: }
1558: else
1559: {
1560: liberation(s_etat_processus, s_objet_argument_2);
1561: }
1562:
1563: while((*l_element_courant).suivant != NULL)
1564: {
1565: l_element_precedent = l_element_courant;
1566: l_element_courant = (*l_element_courant).suivant;
1567: }
1568:
1569: if (((*l_element_precedent).suivant =
1570: allocation_maillon(s_etat_processus)) == NULL)
1571: {
1572: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1573: return;
1574: }
1575:
1576: if (((*(*l_element_precedent).suivant).donnee =
1577: allocation(s_etat_processus, FCT)) == NULL)
1578: {
1579: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1580: return;
1581: }
1582:
1583: if (drapeau_neg == d_faux)
1584: {
1585: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1586: .donnee).objet)).nombre_arguments = 0;
1587: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1588: .donnee).objet)).fonction = instruction_moins;
1589:
1590: if (((*((struct_fonction *) (*(*(*l_element_precedent)
1591: .suivant).donnee).objet)).nom_fonction =
1592: malloc(2 * sizeof(unsigned char))) == NULL)
1593: {
1594: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1595: return;
1596: }
1597:
1598: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
1599: .suivant).donnee).objet)).nom_fonction, "-");
1600: }
1601: else
1602: {
1603: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1604: .donnee).objet)).nombre_arguments = 1;
1605: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1606: .donnee).objet)).fonction = instruction_neg;
1607:
1608: if (((*((struct_fonction *) (*(*(*l_element_precedent)
1609: .suivant).donnee).objet)).nom_fonction =
1610: malloc(4 * sizeof(unsigned char))) == NULL)
1611: {
1612: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1613: return;
1614: }
1615:
1616: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
1617: .suivant).donnee).objet)).nom_fonction, "NEG");
1618: }
1619:
1620: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1621:
1622: s_objet_argument_2 = NULL;
1623: }
1624:
1625: /*
1626: * Expression / Nom ou valeur numérique
1627: */
1628:
1629: else if ((((*s_objet_argument_1).type == NOM) ||
1630: ((*s_objet_argument_1).type == INT) ||
1631: ((*s_objet_argument_1).type == REL) ||
1632: ((*s_objet_argument_1).type == CPL)) &&
1633: (((*s_objet_argument_2).type == ALG) ||
1634: ((*s_objet_argument_2).type == RPN)))
1635: {
1636: drapeau = d_vrai;
1637:
1638: nombre_elements = 0;
1639: l_element_courant = (struct_liste_chainee *)
1640: (*s_objet_argument_2).objet;
1641:
1642: while(l_element_courant != NULL)
1643: {
1644: nombre_elements++;
1645: l_element_courant = (*l_element_courant).suivant;
1646: }
1647:
1648: if (nombre_elements == 2)
1649: {
1650: liberation(s_etat_processus, s_objet_argument_1);
1651: liberation(s_etat_processus, s_objet_argument_2);
1652:
1653: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
1654: return;
1655: }
1656:
1657: if ((*s_objet_argument_1).type == INT)
1658: {
1659: if ((*((integer8 *) (*s_objet_argument_1).objet)) == 0)
1660: {
1661: drapeau = d_faux;
1662:
1663: s_objet_resultat = s_objet_argument_2;
1664: s_objet_argument_2 = NULL;
1665: }
1666: }
1667: else if ((*s_objet_argument_1).type == REL)
1668: {
1669: if ((*((real8 *) (*s_objet_argument_1).objet)) == 0)
1670: {
1671: drapeau = d_faux;
1672:
1673: s_objet_resultat = s_objet_argument_2;
1674: s_objet_argument_2 = NULL;
1675: }
1676: }
1677: else if ((*s_objet_argument_1).type == CPL)
1678: {
1679: if (((*((complex16 *) (*s_objet_argument_1).objet))
1680: .partie_reelle == 0) && ((*((complex16 *)
1681: (*s_objet_argument_1).objet)).partie_imaginaire == 0))
1682: {
1683: drapeau = d_faux;
1684:
1685: s_objet_resultat = s_objet_argument_2;
1686: s_objet_argument_2 = NULL;
1687: }
1688: }
1689:
1690: if (drapeau == d_vrai)
1691: {
1692: if ((s_objet_resultat = copie_objet(s_etat_processus,
1693: s_objet_argument_2, 'N')) == NULL)
1694: {
1695: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1696: return;
1697: }
1698:
1699: l_element_courant = (struct_liste_chainee *)
1700: (*s_objet_resultat).objet;
1701: l_element_precedent = l_element_courant;
1702:
1703: while((*l_element_courant).suivant != NULL)
1704: {
1705: l_element_precedent = l_element_courant;
1706: l_element_courant = (*l_element_courant).suivant;
1707: }
1708:
1709: if (((*l_element_precedent).suivant =
1710: allocation_maillon(s_etat_processus)) == NULL)
1711: {
1712: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1713: return;
1714: }
1715:
1716: (*(*l_element_precedent).suivant).donnee = s_objet_argument_1;
1717: l_element_precedent = (*l_element_precedent).suivant;
1718:
1719: if (((*l_element_precedent).suivant =
1720: allocation_maillon(s_etat_processus)) == NULL)
1721: {
1722: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1723: return;
1724: }
1725:
1726: if (((*(*l_element_precedent).suivant).donnee =
1727: allocation(s_etat_processus, FCT)) == NULL)
1728: {
1729: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1730: return;
1731: }
1732:
1733: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1734: .donnee).objet)).nombre_arguments = 0;
1735: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1736: .donnee).objet)).fonction = instruction_moins;
1737:
1738: if (((*((struct_fonction *) (*(*(*l_element_precedent)
1739: .suivant).donnee).objet)).nom_fonction =
1740: malloc(2 * sizeof(unsigned char))) == NULL)
1741: {
1742: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1743: return;
1744: }
1745:
1746: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
1747: .suivant).donnee).objet)).nom_fonction, "-");
1748:
1749: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1750:
1751: s_objet_argument_1 = NULL;
1752: }
1753: }
1754:
1755: /*
1756: * Expression / Expression
1757: */
1758:
1759: else if ((((*s_objet_argument_1).type == ALG) &&
1760: ((*s_objet_argument_2).type == ALG)) ||
1761: (((*s_objet_argument_1).type == RPN) &&
1762: ((*s_objet_argument_2).type == RPN)))
1763: {
1764: nombre_elements = 0;
1765: l_element_courant = (struct_liste_chainee *)
1766: (*s_objet_argument_1).objet;
1767:
1768: while(l_element_courant != NULL)
1769: {
1770: nombre_elements++;
1771: l_element_courant = (*l_element_courant).suivant;
1772: }
1773:
1774: if (nombre_elements == 2)
1775: {
1776: liberation(s_etat_processus, s_objet_argument_1);
1777: liberation(s_etat_processus, s_objet_argument_2);
1778:
1779: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
1780: return;
1781: }
1782:
1783: nombre_elements = 0;
1784: l_element_courant = (struct_liste_chainee *)
1785: (*s_objet_argument_2).objet;
1786:
1787: while(l_element_courant != NULL)
1788: {
1789: nombre_elements++;
1790: l_element_courant = (*l_element_courant).suivant;
1791: }
1792:
1793: if (nombre_elements == 2)
1794: {
1795: liberation(s_etat_processus, s_objet_argument_1);
1796: liberation(s_etat_processus, s_objet_argument_2);
1797:
1798: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
1799: return;
1800: }
1801:
1802: if ((s_copie_argument_1 = copie_objet(s_etat_processus,
1803: s_objet_argument_1, 'N')) == NULL)
1804: {
1805: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1806: return;
1807: }
1808:
1809: if ((s_copie_argument_2 = copie_objet(s_etat_processus,
1810: s_objet_argument_2, 'N')) == NULL)
1811: {
1812: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1813: return;
1814: }
1815:
1816: l_element_courant = (struct_liste_chainee *)
1817: (*s_copie_argument_1).objet;
1818: (*s_copie_argument_1).objet = (void *) (*((struct_liste_chainee *)
1819: (*s_copie_argument_1).objet)).suivant;
1820:
1821: liberation(s_etat_processus, (*l_element_courant).donnee);
1822: free(l_element_courant);
1823:
1824: l_element_courant = (struct_liste_chainee *)
1825: (*s_copie_argument_2).objet;
1826: l_element_precedent = l_element_courant;
1827: s_objet_resultat = s_copie_argument_2;
1828:
1829: while((*l_element_courant).suivant != NULL)
1830: {
1831: l_element_precedent = l_element_courant;
1832: l_element_courant = (*l_element_courant).suivant;
1833: }
1834:
1835: liberation(s_etat_processus, (*l_element_courant).donnee);
1836: free(l_element_courant);
1837:
1838: (*l_element_precedent).suivant = (struct_liste_chainee *)
1839: (*s_copie_argument_1).objet;
1840: free(s_copie_argument_1);
1841:
1842: l_element_courant = (*l_element_precedent).suivant;
1843: while((*l_element_courant).suivant != NULL)
1844: {
1845: l_element_precedent = l_element_courant;
1846: l_element_courant = (*l_element_courant).suivant;
1847: }
1848:
1849: if (((*l_element_precedent).suivant =
1850: allocation_maillon(s_etat_processus)) == NULL)
1851: {
1852: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1853: return;
1854: }
1855:
1856: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1857: l_element_courant = (*l_element_precedent).suivant;
1858:
1859: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1860: == NULL)
1861: {
1862: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1863: return;
1864: }
1865:
1866: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1867: .nombre_arguments = 0;
1868: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1869: .fonction = instruction_moins;
1870:
1871: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1872: .nom_fonction = malloc(2 * sizeof(unsigned char))) == NULL)
1873: {
1874: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1875: return;
1876: }
1877:
1878: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1879: .nom_fonction, "-");
1880: }
1881:
1882: /*
1883: --------------------------------------------------------------------------------
1884: Soustraction impossible
1885: --------------------------------------------------------------------------------
1886: */
1887:
1888: else
1889: {
1890: liberation(s_etat_processus, s_objet_argument_1);
1891: liberation(s_etat_processus, s_objet_argument_2);
1892:
1893: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1894: return;
1895: }
1896:
1897: liberation(s_etat_processus, s_objet_argument_1);
1898: liberation(s_etat_processus, s_objet_argument_2);
1899:
1900: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1901: s_objet_resultat) == d_erreur)
1902: {
1903: return;
1904: }
1905:
1906: return;
1907: }
1908:
1909:
1910: /*
1911: ================================================================================
1912: Fonction '*'
1913: ================================================================================
1914: Entrées : structure processus
1915: --------------------------------------------------------------------------------
1916: Sorties :
1917: --------------------------------------------------------------------------------
1918: Effets de bord : néant
1919: ================================================================================
1920: */
1921:
1922: void
1923: instruction_multiplication(struct_processus *s_etat_processus)
1924: {
1925: integer8 cumul;
1926: integer8 tampon;
1927:
1928: logical1 depassement;
1929: logical1 drapeau;
1930: logical1 erreur_memoire;
1931:
1932: struct_liste_chainee *l_element_courant;
1933: struct_liste_chainee *l_element_precedent;
1934:
1935: struct_objet *s_copie_argument_1;
1936: struct_objet *s_copie_argument_2;
1937: struct_objet *s_objet_argument_1;
1938: struct_objet *s_objet_argument_2;
1939: struct_objet *s_objet_resultat;
1940:
1.43 bertrand 1941: integer8 i;
1942: integer8 j;
1943: integer8 k;
1944: integer8 nombre_elements;
1.1 bertrand 1945:
1946: void *accumulateur;
1947:
1948: (*s_etat_processus).erreur_execution = d_ex;
1949:
1950: if ((*s_etat_processus).affichage_arguments == 'Y')
1951: {
1952: printf("\n * ");
1953:
1954: if ((*s_etat_processus).langue == 'F')
1955: {
1956: printf("(multiplication)\n\n");
1957: }
1958: else
1959: {
1960: printf("(multiplication)\n\n");
1961: }
1962:
1963: printf(" 2: %s, %s, %s\n", d_INT, d_REL, d_CPL);
1964: printf(" 1: %s, %s, %s\n", d_INT, d_REL, d_CPL);
1965: printf("-> 1: %s, %s, %s\n\n", d_INT, d_REL, d_CPL);
1966:
1967: printf(" 2: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
1968: printf(" 1: %s, %s, %s\n", d_INT, d_REL, d_CPL);
1969: printf("-> 1: %s, %s, %s\n\n", d_VIN, d_VRL, d_VCX);
1970:
1971: printf(" 2: %s, %s, %s\n", d_INT, d_REL, d_CPL);
1972: printf(" 1: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
1973: printf("-> 1: %s, %s, %s\n\n", d_VIN, d_VRL, d_VCX);
1974:
1975: printf(" 2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
1976: printf(" 1: %s, %s, %s\n", d_INT, d_REL, d_CPL);
1977: printf("-> 1: %s, %s, %s\n\n", d_MIN, d_MRL, d_MCX);
1978:
1979: printf(" 2: %s, %s, %s\n", d_INT, d_REL, d_CPL);
1980: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
1981: printf("-> 1: %s, %s, %s\n\n", d_MIN, d_MRL, d_MCX);
1982:
1983: printf(" 2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
1984: printf(" 1: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
1985: printf("-> 1: %s, %s, %s\n\n", d_VIN, d_VRL, d_VCX);
1986:
1987: printf(" 2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
1988: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
1989: printf("-> 1: %s, %s, %s\n\n", d_MIN, d_MRL, d_MCX);
1990:
1991: printf(" 2: %s, %s\n", d_BIN, d_INT);
1992: printf(" 1: %s, %s\n", d_BIN, d_INT);
1993: printf("-> 1: %s\n\n", d_BIN);
1994:
1995: printf(" 2: %s, %s, %s, %s, %s, %s\n",
1996: d_INT, d_REL, d_CPL, d_NOM, d_ALG, d_RPN);
1997: printf(" 1: %s, %s, %s, %s, %s, %s\n",
1998: d_INT, d_REL, d_CPL, d_NOM, d_ALG, d_RPN);
1999: printf("-> 1: %s, %s\n", d_ALG, d_RPN);
2000:
2001: return;
2002: }
2003: else if ((*s_etat_processus).test_instruction == 'Y')
2004: {
2005: (*s_etat_processus).nombre_arguments = 0;
2006: return;
2007: }
2008:
2009: if (test_cfsf(s_etat_processus, 31) == d_vrai)
2010: {
2011: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
2012: {
2013: return;
2014: }
2015: }
2016:
2017: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2018: &s_objet_argument_1) == d_erreur)
2019: {
2020: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
2021: return;
2022: }
2023:
2024: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2025: &s_objet_argument_2) == d_erreur)
2026: {
2027: liberation(s_etat_processus, s_objet_argument_1);
2028:
2029: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
2030: return;
2031: }
2032:
2033: /*
2034: --------------------------------------------------------------------------------
2035: Multiplication de deux entiers
2036: --------------------------------------------------------------------------------
2037: */
2038:
2039: if (((*s_objet_argument_1).type == INT) &&
2040: ((*s_objet_argument_2).type == INT))
2041: {
2042: if (depassement_multiplication((integer8 *) (*s_objet_argument_1)
2043: .objet, (integer8 *) (*s_objet_argument_2).objet, &tampon) ==
2044: d_absence_erreur)
2045: {
2046: if ((s_objet_resultat = allocation(s_etat_processus, INT))
2047: == NULL)
2048: {
2049: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2050: return;
2051: }
2052:
2053: (*((integer8 *) (*s_objet_resultat).objet)) = tampon;
2054: }
2055: else
2056: {
2057: if ((s_objet_resultat = allocation(s_etat_processus, REL))
2058: == NULL)
2059: {
2060: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2061: return;
2062: }
2063:
2064: (*((real8 *) (*s_objet_resultat).objet)) = ((real8) (*((integer8 *)
2065: (*s_objet_argument_2).objet))) * ((real8) (*((integer8 *)
2066: (*s_objet_argument_1).objet)));
2067: }
2068: }
2069:
2070: /*
2071: --------------------------------------------------------------------------------
2072: Multiplication d'un entier et d'un réel
2073: --------------------------------------------------------------------------------
2074: */
2075:
2076: else if ((((*s_objet_argument_1).type == INT) &&
2077: ((*s_objet_argument_2).type == REL)) ||
2078: (((*s_objet_argument_1).type == REL) &&
2079: ((*s_objet_argument_2).type == INT)))
2080: {
2081: if ((s_objet_resultat = allocation(s_etat_processus, REL))
2082: == NULL)
2083: {
2084: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2085: return;
2086: }
2087:
2088: if ((*s_objet_argument_1).type == INT)
2089: {
2090: (*((real8 *) (*s_objet_resultat).objet)) = (*((real8 *)
1.43 bertrand 2091: (*s_objet_argument_2).objet)) * ((real8) (*((integer8 *)
2092: (*s_objet_argument_1).objet)));
1.1 bertrand 2093: }
2094: else
2095: {
1.43 bertrand 2096: (*((real8 *) (*s_objet_resultat).objet)) = ((real8) (*((integer8 *)
2097: (*s_objet_argument_2).objet))) * (*((real8 *)
1.1 bertrand 2098: (*s_objet_argument_1).objet));
2099: }
2100: }
2101:
2102: /*
2103: --------------------------------------------------------------------------------
2104: Multiplication d'un entier et d'un complexe
2105: --------------------------------------------------------------------------------
2106: */
2107:
2108: else if ((((*s_objet_argument_1).type == INT) &&
2109: ((*s_objet_argument_2).type == CPL)) ||
2110: (((*s_objet_argument_1).type == CPL) &&
2111: ((*s_objet_argument_2).type == INT)))
2112: {
2113: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
2114: == NULL)
2115: {
2116: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2117: return;
2118: }
2119:
2120: if ((*s_objet_argument_1).type == INT)
2121: {
2122: f77multiplicationci_((struct_complexe16 *) (*s_objet_argument_2)
2123: .objet, (integer8 *) (*s_objet_argument_1).objet,
2124: (struct_complexe16 *) (*s_objet_resultat).objet);
2125: }
2126: else
2127: {
2128: f77multiplicationci_((struct_complexe16 *) (*s_objet_argument_1)
2129: .objet, (integer8 *) (*s_objet_argument_2).objet,
2130: (struct_complexe16 *) (*s_objet_resultat).objet);
2131: }
2132: }
2133:
2134: /*
2135: --------------------------------------------------------------------------------
2136: Multiplication de deux réels
2137: --------------------------------------------------------------------------------
2138: */
2139:
2140: else if (((*s_objet_argument_1).type == REL) &&
2141: ((*s_objet_argument_2).type == REL))
2142: {
2143: if ((s_objet_resultat = allocation(s_etat_processus, REL))
2144: == NULL)
2145: {
2146: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2147: return;
2148: }
2149:
2150: (*((real8 *) (*s_objet_resultat).objet)) = (*((real8 *)
2151: (*s_objet_argument_2).objet)) * (*((real8 *)
2152: (*s_objet_argument_1).objet));
2153: }
2154:
2155: /*
2156: --------------------------------------------------------------------------------
2157: Multiplication d'un réel et d'un complexe
2158: --------------------------------------------------------------------------------
2159: */
2160:
2161: else if ((((*s_objet_argument_1).type == REL) &&
2162: ((*s_objet_argument_2).type == CPL)) ||
2163: (((*s_objet_argument_1).type == CPL) &&
2164: ((*s_objet_argument_2).type == REL)))
2165: {
2166: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
2167: == NULL)
2168: {
2169: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2170: return;
2171: }
2172:
2173: if ((*s_objet_argument_1).type == REL)
2174: {
2175: f77multiplicationcr_((struct_complexe16 *)
2176: (*s_objet_argument_2).objet,
2177: (real8 *) (*s_objet_argument_1).objet,
2178: (struct_complexe16 *) (*s_objet_resultat).objet);
2179: }
2180: else
2181: {
2182: f77multiplicationcr_((struct_complexe16 *) (*s_objet_argument_1)
2183: .objet, (real8 *) (*s_objet_argument_2).objet,
2184: (struct_complexe16 *) (*s_objet_resultat).objet);
2185: }
2186: }
2187:
2188: /*
2189: --------------------------------------------------------------------------------
2190: Multiplication de deux complexes
2191: --------------------------------------------------------------------------------
2192: */
2193:
2194: else if (((*s_objet_argument_1).type == CPL) &&
2195: ((*s_objet_argument_2).type == CPL))
2196: {
2197: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
2198: == NULL)
2199: {
2200: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2201: return;
2202: }
2203:
2204: f77multiplicationcc_((struct_complexe16 *) (*s_objet_argument_2).objet,
2205: (struct_complexe16 *) (*s_objet_argument_1).objet,
2206: (struct_complexe16 *) (*s_objet_resultat).objet);
2207: }
2208:
2209: /*
2210: --------------------------------------------------------------------------------
2211: Multiplication d'un vecteur par un scalaire
2212: --------------------------------------------------------------------------------
2213: */
2214: /*
2215: * Vecteur d'entiers / Entier
2216: */
2217:
2218: else if ((((*s_objet_argument_1).type == VIN) &&
2219: ((*s_objet_argument_2).type == INT)) ||
2220: (((*s_objet_argument_1).type == INT) &&
2221: ((*s_objet_argument_2).type == VIN)))
2222: {
2223: if ((s_objet_resultat = allocation(s_etat_processus, VIN))
2224: == NULL)
2225: {
2226: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2227: return;
2228: }
2229:
2230: if ((*s_objet_argument_1).type == VIN)
2231: {
2232: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
2233: (*((struct_vecteur *) (*s_objet_argument_1).objet)).taille;
2234: }
2235: else
2236: {
2237: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
2238: (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille;
2239: }
2240:
2241: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 2242: malloc(((size_t) (*(((struct_vecteur *) (*s_objet_resultat)
2243: .objet))).taille) * sizeof(integer8))) == NULL)
1.1 bertrand 2244: {
2245: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2246: return;
2247: }
2248:
2249: depassement = d_faux;
2250:
2251: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_resultat)
2252: .objet))).taille; i++)
2253: {
2254: if ((*s_objet_argument_1).type == VIN)
2255: {
2256: if (depassement_multiplication((integer8 *)
2257: (*s_objet_argument_2).objet, &(((integer8 *)
2258: (*((struct_vecteur *) (*s_objet_argument_1).objet))
2259: .tableau)[i]), &(((integer8 *) (*((struct_vecteur *)
2260: (*s_objet_resultat).objet)).tableau)[i])) == d_erreur)
2261: {
2262: depassement = d_vrai;
2263: }
2264: }
2265: else
2266: {
2267: if (depassement_multiplication((integer8 *)
2268: (*s_objet_argument_1).objet, &(((integer8 *)
2269: (*((struct_vecteur *) (*s_objet_argument_2).objet))
2270: .tableau)[i]), &(((integer8 *) (*((struct_vecteur *)
2271: (*s_objet_resultat).objet)).tableau)[i])) == d_erreur)
2272: {
2273: depassement = d_vrai;
2274: }
2275: }
2276: }
2277:
2278: if (depassement == d_vrai)
2279: {
2280: (*s_objet_resultat).type = VRL;
2281: (*((struct_vecteur *) (*s_objet_resultat).objet)).type = 'R';
2282:
2283: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 2284: malloc(((size_t) (*(((struct_vecteur *) (*s_objet_resultat)
2285: .objet))).taille) * sizeof(real8))) == NULL)
1.1 bertrand 2286: {
2287: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2288: return;
2289: }
2290:
2291: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_resultat)
2292: .objet))).taille; i++)
2293: {
2294: if ((*s_objet_argument_1).type == VIN)
2295: {
2296: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
2297: .tableau)[i] = ((real8) (*((integer8 *)
2298: (*s_objet_argument_2).objet))) * ((real8)
2299: ((integer8 *) (*((struct_vecteur *)
2300: (*s_objet_argument_1).objet)).tableau)[i]);
2301: }
2302: else
2303: {
2304: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
2305: .tableau)[i] = ((real8) (*((integer8 *)
2306: (*s_objet_argument_1).objet))) * ((real8)
2307: ((integer8 *) (*((struct_vecteur *)
2308: (*s_objet_argument_2).objet)).tableau)[i]);
2309: }
2310: }
2311: }
2312: }
2313:
2314: /*
2315: * Vecteur de réels / Entier
2316: */
2317:
2318: else if ((((*s_objet_argument_1).type == VRL) &&
2319: ((*s_objet_argument_2).type == INT)) ||
2320: (((*s_objet_argument_1).type == INT) &&
2321: ((*s_objet_argument_2).type == VRL)))
2322: {
2323: if ((s_objet_resultat = allocation(s_etat_processus, VRL))
2324: == NULL)
2325: {
2326: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2327: return;
2328: }
2329:
2330: if ((*s_objet_argument_1).type == VRL)
2331: {
2332: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
2333: (*((struct_vecteur *) (*s_objet_argument_1).objet)).taille;
2334: }
2335: else
2336: {
2337: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
2338: (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille;
2339: }
2340:
2341: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 2342: malloc(((size_t) (*(((struct_vecteur *) (*s_objet_resultat)
2343: .objet))).taille) * sizeof(real8))) == NULL)
1.1 bertrand 2344: {
2345: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2346: return;
2347: }
2348:
2349: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_resultat)
2350: .objet))).taille; i++)
2351: {
2352: if ((*s_objet_argument_1).type == VRL)
2353: {
2354: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1.43 bertrand 2355: .tableau)[i] = ((real8) (*((integer8 *)
2356: (*s_objet_argument_2).objet))) * ((real8 *)
2357: (*((struct_vecteur *) (*s_objet_argument_1).objet))
2358: .tableau)[i];
1.1 bertrand 2359: }
2360: else
2361: {
2362: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1.43 bertrand 2363: .tableau)[i] = ((real8) (*((integer8 *)
2364: (*s_objet_argument_1).objet))) * ((real8 *)
2365: (*((struct_vecteur *) (*s_objet_argument_2).objet))
2366: .tableau)[i];
1.1 bertrand 2367: }
2368: }
2369: }
2370:
2371: /*
2372: * Vecteur de complexes / Entier
2373: */
2374:
2375: else if ((((*s_objet_argument_1).type == VCX) &&
2376: ((*s_objet_argument_2).type == INT)) ||
2377: (((*s_objet_argument_1).type == INT) &&
2378: ((*s_objet_argument_2).type == VCX)))
2379: {
2380: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
2381: == NULL)
2382: {
2383: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2384: return;
2385: }
2386:
2387: if ((*s_objet_argument_1).type == VCX)
2388: {
2389: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
2390: (*((struct_vecteur *) (*s_objet_argument_1).objet)).taille;
2391: }
2392: else
2393: {
2394: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
2395: (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille;
2396: }
2397:
2398: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 2399: malloc(((size_t) (*(((struct_vecteur *) (*s_objet_resultat)
2400: .objet))).taille) * sizeof(struct_complexe16))) == NULL)
1.1 bertrand 2401: {
2402: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2403: return;
2404: }
2405:
2406: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_resultat)
2407: .objet))).taille; i++)
2408: {
2409: if ((*s_objet_argument_1).type == VCX)
2410: {
2411: f77multiplicationci_(&(((struct_complexe16 *)
2412: (*((struct_vecteur *)
2413: (*s_objet_argument_1).objet)).tableau)[i]),
2414: &((*((integer8 *) (*s_objet_argument_2).objet))),
2415: &(((struct_complexe16 *) (*((struct_vecteur *)
2416: (*s_objet_resultat).objet)).tableau)[i]));
2417: }
2418: else
2419: {
2420: f77multiplicationci_(&(((struct_complexe16 *)
2421: (*((struct_vecteur *)
2422: (*s_objet_argument_2).objet)).tableau)[i]),
2423: &((*((integer8 *) (*s_objet_argument_1).objet))),
2424: &(((struct_complexe16 *) (*((struct_vecteur *)
2425: (*s_objet_resultat).objet)).tableau)[i]));
2426: }
2427: }
2428: }
2429:
2430: /*
2431: * Vecteur d'entiers / Réel
2432: */
2433:
2434: else if ((((*s_objet_argument_1).type == VIN) &&
2435: ((*s_objet_argument_2).type == REL)) ||
2436: (((*s_objet_argument_1).type == REL) &&
2437: ((*s_objet_argument_2).type == VIN)))
2438: {
2439: if ((s_objet_resultat = allocation(s_etat_processus, VRL))
2440: == NULL)
2441: {
2442: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2443: return;
2444: }
2445:
2446: if ((*s_objet_argument_1).type == VIN)
2447: {
2448: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
2449: (*((struct_vecteur *) (*s_objet_argument_1).objet)).taille;
2450: }
2451: else
2452: {
2453: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
2454: (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille;
2455: }
2456:
2457: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 2458: malloc(((size_t) (*(((struct_vecteur *) (*s_objet_resultat)
2459: .objet))).taille) * sizeof(real8))) == NULL)
1.1 bertrand 2460: {
2461: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2462: return;
2463: }
2464:
2465: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_resultat)
2466: .objet))).taille; i++)
2467: {
2468: if ((*s_objet_argument_1).type == VIN)
2469: {
2470: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
2471: .tableau)[i] = (*((real8 *) (*s_objet_argument_2)
1.43 bertrand 2472: .objet)) * ((real8) ((integer8 *) (*((struct_vecteur *)
2473: (*s_objet_argument_1).objet)).tableau)[i]);
1.1 bertrand 2474: }
2475: else
2476: {
2477: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
2478: .tableau)[i] = (*((real8 *) (*s_objet_argument_1)
1.43 bertrand 2479: .objet)) * ((real8) ((integer8 *) (*((struct_vecteur *)
2480: (*s_objet_argument_2).objet)).tableau)[i]);
1.1 bertrand 2481: }
2482: }
2483: }
2484:
2485: /*
2486: * Vecteur de réels / Réel
2487: */
2488:
2489: else if ((((*s_objet_argument_1).type == VRL) &&
2490: ((*s_objet_argument_2).type == REL)) ||
2491: (((*s_objet_argument_1).type == REL) &&
2492: ((*s_objet_argument_2).type == VRL)))
2493: {
2494: if ((s_objet_resultat = allocation(s_etat_processus, VRL))
2495: == NULL)
2496: {
2497: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2498: return;
2499: }
2500:
2501: if ((*s_objet_argument_1).type == VRL)
2502: {
2503: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
2504: (*((struct_vecteur *) (*s_objet_argument_1).objet)).taille;
2505: }
2506: else
2507: {
2508: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
2509: (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille;
2510: }
2511:
2512: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 2513: malloc(((size_t) (*(((struct_vecteur *) (*s_objet_resultat)
2514: .objet))).taille) * sizeof(real8))) == NULL)
1.1 bertrand 2515: {
2516: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2517: return;
2518: }
2519:
2520: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_resultat)
2521: .objet))).taille; i++)
2522: {
2523: if ((*s_objet_argument_1).type == VRL)
2524: {
2525: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
2526: .tableau)[i] = (*((real8 *) (*s_objet_argument_2)
2527: .objet)) * ((real8 *) (*((struct_vecteur *)
2528: (*s_objet_argument_1).objet)).tableau)[i];
2529: }
2530: else
2531: {
2532: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
2533: .tableau)[i] = (*((real8 *) (*s_objet_argument_1)
2534: .objet)) * ((real8 *) (*((struct_vecteur *)
2535: (*s_objet_argument_2).objet)).tableau)[i];
2536: }
2537: }
2538: }
2539:
2540: /*
2541: * Vecteur de complexes / Réel
2542: */
2543:
2544: else if ((((*s_objet_argument_1).type == VCX) &&
2545: ((*s_objet_argument_2).type == REL)) ||
2546: (((*s_objet_argument_1).type == REL) &&
2547: ((*s_objet_argument_2).type == VCX)))
2548: {
2549: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
2550: == NULL)
2551: {
2552: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2553: return;
2554: }
2555:
2556: if ((*s_objet_argument_1).type == VCX)
2557: {
2558: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
2559: (*((struct_vecteur *) (*s_objet_argument_1).objet)).taille;
2560: }
2561: else
2562: {
2563: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
2564: (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille;
2565: }
2566:
2567: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 2568: malloc(((size_t) (*(((struct_vecteur *) (*s_objet_resultat)
2569: .objet))).taille) * sizeof(struct_complexe16))) == NULL)
1.1 bertrand 2570: {
2571: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2572: return;
2573: }
2574:
2575: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_resultat)
2576: .objet))).taille; i++)
2577: {
2578: if ((*s_objet_argument_1).type == VCX)
2579: {
2580: f77multiplicationcr_(&(((struct_complexe16 *)
2581: (*((struct_vecteur *)
2582: (*s_objet_argument_1).objet)).tableau)[i]),
2583: &((*((real8 *) (*s_objet_argument_2).objet))),
2584: &(((struct_complexe16 *) (*((struct_vecteur *)
2585: (*s_objet_resultat).objet)).tableau)[i]));
2586: }
2587: else
2588: {
2589: f77multiplicationcr_(&(((struct_complexe16 *)
2590: (*((struct_vecteur *)
2591: (*s_objet_argument_2).objet)).tableau)[i]),
2592: &((*((real8 *) (*s_objet_argument_1).objet))),
2593: &(((struct_complexe16 *) (*((struct_vecteur *)
2594: (*s_objet_resultat).objet)).tableau)[i]));
2595: }
2596: }
2597: }
2598:
2599: /*
2600: * Vecteur d'entiers / Complexe
2601: */
2602:
2603: else if ((((*s_objet_argument_1).type == VIN) &&
2604: ((*s_objet_argument_2).type == CPL)) ||
2605: (((*s_objet_argument_1).type == CPL) &&
2606: ((*s_objet_argument_2).type == VIN)))
2607: {
2608: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
2609: == NULL)
2610: {
2611: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2612: return;
2613: }
2614:
2615: if ((*s_objet_argument_1).type == VIN)
2616: {
2617: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
2618: (*((struct_vecteur *) (*s_objet_argument_1).objet)).taille;
2619: }
2620: else
2621: {
2622: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
2623: (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille;
2624: }
2625:
2626: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 2627: malloc(((size_t) (*(((struct_vecteur *) (*s_objet_resultat)
2628: .objet))).taille) * sizeof(struct_complexe16))) == NULL)
1.1 bertrand 2629: {
2630: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2631: return;
2632: }
2633:
2634: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_resultat)
2635: .objet))).taille; i++)
2636: {
2637: if ((*s_objet_argument_1).type == VIN)
2638: {
2639: f77multiplicationci_(&((*((struct_complexe16 *)
2640: (*s_objet_argument_2).objet))),
2641: &(((integer8 *) (*((struct_vecteur *)
2642: (*s_objet_argument_1).objet)).tableau)[i]),
2643: &(((struct_complexe16 *) (*((struct_vecteur *)
2644: (*s_objet_resultat).objet)).tableau)[i]));
2645: }
2646: else
2647: {
2648: f77multiplicationci_(&((*((struct_complexe16 *)
2649: (*s_objet_argument_1).objet))),
2650: &(((integer8 *) (*((struct_vecteur *)
2651: (*s_objet_argument_2).objet)).tableau)[i]),
2652: &(((struct_complexe16 *) (*((struct_vecteur *)
2653: (*s_objet_resultat).objet)).tableau)[i]));
2654: }
2655: }
2656: }
2657:
2658: /*
2659: * Vecteur de réels / Complexe
2660: */
2661:
2662: else if ((((*s_objet_argument_1).type == VRL) &&
2663: ((*s_objet_argument_2).type == CPL)) ||
2664: (((*s_objet_argument_1).type == CPL) &&
2665: ((*s_objet_argument_2).type == VRL)))
2666: {
2667: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
2668: == NULL)
2669: {
2670: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2671: return;
2672: }
2673:
2674: if ((*s_objet_argument_1).type == VRL)
2675: {
2676: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
2677: (*((struct_vecteur *) (*s_objet_argument_1).objet)).taille;
2678: }
2679: else
2680: {
2681: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
2682: (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille;
2683: }
2684:
2685: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 2686: malloc(((size_t) (*(((struct_vecteur *) (*s_objet_resultat)
2687: .objet))).taille) * sizeof(struct_complexe16))) == NULL)
1.1 bertrand 2688: {
2689: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2690: return;
2691: }
2692:
2693: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_resultat)
2694: .objet))).taille; i++)
2695: {
2696: if ((*s_objet_argument_1).type == VRL)
2697: {
2698: f77multiplicationcr_(&((*((struct_complexe16 *)
2699: (*s_objet_argument_2).objet))),
2700: &(((real8 *) (*((struct_vecteur *)
2701: (*s_objet_argument_1).objet)).tableau)[i]),
2702: &(((struct_complexe16 *) (*((struct_vecteur *)
2703: (*s_objet_resultat).objet)).tableau)[i]));
2704: }
2705: else
2706: {
2707: f77multiplicationcr_(&((*((struct_complexe16 *)
2708: (*s_objet_argument_1).objet))),
2709: &(((real8 *) (*((struct_vecteur *)
2710: (*s_objet_argument_2).objet)).tableau)[i]),
2711: &(((struct_complexe16 *) (*((struct_vecteur *)
2712: (*s_objet_resultat).objet)).tableau)[i]));
2713: }
2714: }
2715: }
2716:
2717: /*
2718: * Vecteur de complexes / Complexe
2719: */
2720:
2721: else if ((((*s_objet_argument_1).type == VCX) &&
2722: ((*s_objet_argument_2).type == CPL)) ||
2723: (((*s_objet_argument_1).type == CPL) &&
2724: ((*s_objet_argument_2).type == VCX)))
2725: {
2726: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
2727: == NULL)
2728: {
2729: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2730: return;
2731: }
2732:
2733: if ((*s_objet_argument_1).type == VCX)
2734: {
2735: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
2736: (*((struct_vecteur *) (*s_objet_argument_1).objet)).taille;
2737: }
2738: else
2739: {
2740: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
2741: (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille;
2742: }
2743:
2744: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 2745: malloc(((size_t) (*(((struct_vecteur *) (*s_objet_resultat)
2746: .objet))).taille) * sizeof(struct_complexe16))) == NULL)
1.1 bertrand 2747: {
2748: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2749: return;
2750: }
2751:
2752: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_resultat)
2753: .objet))).taille; i++)
2754: {
2755: if ((*s_objet_argument_1).type == VCX)
2756: {
2757: f77multiplicationcc_(&(((struct_complexe16 *)
2758: (*((struct_vecteur *)
2759: (*s_objet_argument_1).objet)).tableau)[i]),
2760: &((*((struct_complexe16 *)
2761: (*s_objet_argument_2).objet))),
2762: &(((struct_complexe16 *) (*((struct_vecteur *)
2763: (*s_objet_resultat).objet)).tableau)[i]));
2764: }
2765: else
2766: {
2767: f77multiplicationcc_(&(((struct_complexe16 *)
2768: (*((struct_vecteur *)
2769: (*s_objet_argument_2).objet)).tableau)[i]),
2770: &((*((struct_complexe16 *)
2771: (*s_objet_argument_1).objet))),
2772: &(((struct_complexe16 *) (*((struct_vecteur *)
2773: (*s_objet_resultat).objet)).tableau)[i]));
2774: }
2775: }
2776: }
2777:
2778: /*
2779: --------------------------------------------------------------------------------
2780: Multiplication d'une matrice par un scalaire
2781: --------------------------------------------------------------------------------
2782: */
2783: /*
2784: * Matrice d'entiers / Entier
2785: */
2786:
2787: else if ((((*s_objet_argument_1).type == MIN) &&
2788: ((*s_objet_argument_2).type == INT)) ||
2789: (((*s_objet_argument_1).type == INT) &&
2790: ((*s_objet_argument_2).type == MIN)))
2791: {
2792: if ((s_objet_resultat = allocation(s_etat_processus, MIN))
2793: == NULL)
2794: {
2795: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2796: return;
2797: }
2798:
2799: if ((*s_objet_argument_1).type == MIN)
2800: {
2801: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
2802: (*((struct_matrice *) (*s_objet_argument_1).objet))
2803: .nombre_lignes;
2804: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
2805: (*((struct_matrice *) (*s_objet_argument_1).objet))
2806: .nombre_colonnes;
2807: }
2808: else
2809: {
2810: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
2811: (*((struct_matrice *) (*s_objet_argument_2).objet))
2812: .nombre_lignes;
2813: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
2814: (*((struct_matrice *) (*s_objet_argument_2).objet))
2815: .nombre_colonnes;
2816: }
2817:
2818: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 2819: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
2820: .objet))).nombre_lignes) * sizeof(integer8 *))) == NULL)
1.1 bertrand 2821: {
2822: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2823: return;
2824: }
2825:
2826: depassement = d_faux;
2827:
2828: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
2829: .objet))).nombre_lignes; i++)
2830: {
2831: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau[i] =
1.43 bertrand 2832: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
2833: .objet))).nombre_colonnes) * sizeof(integer8))) == NULL)
1.1 bertrand 2834: {
2835: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2836: return;
2837: }
2838:
2839: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
2840: .objet))).nombre_colonnes; j++)
2841: {
2842: if ((*s_objet_argument_1).type == MIN)
2843: {
2844: if (depassement_multiplication((integer8 *)
2845: (*s_objet_argument_2).objet, &(((integer8 **)
2846: (*((struct_matrice *) (*s_objet_argument_1).objet))
2847: .tableau)[i][j]), &(((integer8 **)
2848: (*((struct_matrice *) (*s_objet_resultat).objet))
2849: .tableau)[i][j])) == d_erreur)
2850: {
2851: depassement = d_vrai;
2852: }
2853: }
2854: else
2855: {
2856: if (depassement_multiplication((integer8 *)
2857: (*s_objet_argument_1).objet, &(((integer8 **)
2858: (*((struct_matrice *) (*s_objet_argument_2).objet))
2859: .tableau)[i][j]), &(((integer8 **)
2860: (*((struct_matrice *) (*s_objet_resultat).objet))
2861: .tableau)[i][j])) == d_erreur)
2862: {
2863: depassement = d_vrai;
2864: }
2865: }
2866: }
2867: }
2868:
2869: if (depassement == d_vrai)
2870: {
2871: (*s_objet_resultat).type = MRL;
2872: (*((struct_matrice *) (*s_objet_resultat).objet)).type = 'R';
2873:
2874: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
2875: .objet))).nombre_lignes; i++)
2876: {
2877: free(((integer8 **) (*((struct_matrice *)
2878: (*s_objet_resultat).objet)).tableau)[i]);
2879:
2880: if (((*((struct_matrice *) (*s_objet_resultat).objet))
1.43 bertrand 2881: .tableau[i] = malloc(((size_t) (*(((struct_matrice *)
2882: (*s_objet_resultat).objet))).nombre_colonnes) *
1.1 bertrand 2883: sizeof(real8))) == NULL)
2884: {
2885: (*s_etat_processus).erreur_systeme =
2886: d_es_allocation_memoire;
2887: return;
2888: }
2889:
2890: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
2891: .objet))).nombre_colonnes; j++)
2892: {
2893: if ((*s_objet_argument_1).type == MIN)
2894: {
2895: ((real8 **) (*((struct_matrice *)
2896: (*s_objet_resultat).objet)).tableau)[i][j] =
2897: ((real8) (*((integer8 *) (*s_objet_argument_2)
2898: .objet))) * ((real8) ((integer8 **)
2899: (*((struct_matrice *) (*s_objet_argument_1).objet))
2900: .tableau)[i][j]);
2901: }
2902: else
2903: {
2904: ((real8 **) (*((struct_matrice *)
2905: (*s_objet_resultat).objet)).tableau)[i][j] =
2906: ((real8) (*((integer8 *) (*s_objet_argument_1)
2907: .objet))) * ((real8) ((integer8 **)
2908: (*((struct_matrice *) (*s_objet_argument_2).objet))
2909: .tableau)[i][j]);
2910: }
2911: }
2912: }
2913: }
2914: }
2915:
2916: /*
2917: * Matrice de réels / Entier
2918: */
2919:
2920: else if ((((*s_objet_argument_1).type == MRL) &&
2921: ((*s_objet_argument_2).type == INT)) ||
2922: (((*s_objet_argument_1).type == INT) &&
2923: ((*s_objet_argument_2).type == MRL)))
2924: {
2925: if ((s_objet_resultat = allocation(s_etat_processus, MRL))
2926: == NULL)
2927: {
2928: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2929: return;
2930: }
2931:
2932: if ((*s_objet_argument_1).type == MRL)
2933: {
2934: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
2935: (*((struct_matrice *) (*s_objet_argument_1).objet))
2936: .nombre_lignes;
2937: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
2938: (*((struct_matrice *) (*s_objet_argument_1).objet))
2939: .nombre_colonnes;
2940: }
2941: else
2942: {
2943: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
2944: (*((struct_matrice *) (*s_objet_argument_2).objet))
2945: .nombre_lignes;
2946: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
2947: (*((struct_matrice *) (*s_objet_argument_2).objet))
2948: .nombre_colonnes;
2949: }
2950:
2951: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 2952: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
2953: .objet))).nombre_lignes) * sizeof(real8 *))) == NULL)
1.1 bertrand 2954: {
2955: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2956: return;
2957: }
2958:
2959: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
2960: .objet))).nombre_lignes; i++)
2961: {
2962: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau[i] =
1.43 bertrand 2963: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
2964: .objet))).nombre_colonnes) * sizeof(real8))) == NULL)
1.1 bertrand 2965: {
2966: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2967: return;
2968: }
2969:
2970: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
2971: .objet))).nombre_colonnes; j++)
2972: {
2973: if ((*s_objet_argument_1).type == MRL)
2974: {
2975: ((real8 **) (*((struct_matrice *)
2976: (*s_objet_resultat).objet)).tableau)[i][j] =
1.43 bertrand 2977: ((real8) (*((integer8 *) (*s_objet_argument_2)
2978: .objet))) * ((real8 **) (*((struct_matrice *)
1.1 bertrand 2979: (*s_objet_argument_1).objet)).tableau)[i][j];
2980: }
2981: else
2982: {
2983: ((real8 **) (*((struct_matrice *)
2984: (*s_objet_resultat).objet)).tableau)[i][j] =
1.43 bertrand 2985: ((real8) (*((integer8 *) (*s_objet_argument_1)
2986: .objet))) * ((real8 **) (*((struct_matrice *)
1.1 bertrand 2987: (*s_objet_argument_2).objet)).tableau)[i][j];
2988: }
2989: }
2990: }
2991: }
2992:
2993: /*
2994: * Matrice de complexes / Entier
2995: */
2996:
2997: else if ((((*s_objet_argument_1).type == MCX) &&
2998: ((*s_objet_argument_2).type == INT)) ||
2999: (((*s_objet_argument_1).type == INT) &&
3000: ((*s_objet_argument_2).type == MCX)))
3001: {
3002: if ((s_objet_resultat = allocation(s_etat_processus, MCX))
3003: == NULL)
3004: {
3005: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3006: return;
3007: }
3008:
3009: if ((*s_objet_argument_1).type == MCX)
3010: {
3011: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
3012: (*((struct_matrice *) (*s_objet_argument_1).objet))
3013: .nombre_lignes;
3014: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
3015: (*((struct_matrice *) (*s_objet_argument_1).objet))
3016: .nombre_colonnes;
3017: }
3018: else
3019: {
3020: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
3021: (*((struct_matrice *) (*s_objet_argument_2).objet))
3022: .nombre_lignes;
3023: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
3024: (*((struct_matrice *) (*s_objet_argument_2).objet))
3025: .nombre_colonnes;
3026: }
3027:
3028: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 3029: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
3030: .objet))).nombre_lignes) * sizeof(struct_complexe16 *)))
3031: == NULL)
1.1 bertrand 3032: {
3033: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3034: return;
3035: }
3036:
3037: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
3038: .objet))).nombre_lignes; i++)
3039: {
3040: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau[i] =
1.43 bertrand 3041: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
3042: .objet))).nombre_colonnes) * sizeof(struct_complexe16)))
1.1 bertrand 3043: == NULL)
3044: {
3045: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3046: return;
3047: }
3048:
3049: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
3050: .objet))).nombre_colonnes; j++)
3051: {
3052: if ((*s_objet_argument_1).type == MCX)
3053: {
3054: f77multiplicationci_(&(((struct_complexe16 **)
3055: (*((struct_matrice *) (*s_objet_argument_1).objet))
3056: .tableau)[i][j]), &((*((integer8 *)
3057: (*s_objet_argument_2).objet))),
3058: &(((struct_complexe16 **) (*((struct_matrice *)
3059: (*s_objet_resultat).objet)).tableau)[i][j]));
3060: }
3061: else
3062: {
3063: f77multiplicationci_(&(((struct_complexe16 **)
3064: (*((struct_matrice *) (*s_objet_argument_2).objet))
3065: .tableau)[i][j]), &((*((integer8 *)
3066: (*s_objet_argument_1).objet))),
3067: &(((struct_complexe16 **) (*((struct_matrice *)
3068: (*s_objet_resultat).objet)).tableau)[i][j]));
3069: }
3070: }
3071: }
3072: }
3073:
3074: /*
3075: * Matrice d'entiers / Réel
3076: */
3077:
3078: else if ((((*s_objet_argument_1).type == MIN) &&
3079: ((*s_objet_argument_2).type == REL)) ||
3080: (((*s_objet_argument_1).type == REL) &&
3081: ((*s_objet_argument_2).type == MIN)))
3082: {
3083: if ((s_objet_resultat = allocation(s_etat_processus, MRL))
3084: == NULL)
3085: {
3086: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3087: return;
3088: }
3089:
3090: if ((*s_objet_argument_1).type == MIN)
3091: {
3092: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
3093: (*((struct_matrice *) (*s_objet_argument_1).objet))
3094: .nombre_lignes;
3095: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
3096: (*((struct_matrice *) (*s_objet_argument_1).objet))
3097: .nombre_colonnes;
3098: }
3099: else
3100: {
3101: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
3102: (*((struct_matrice *) (*s_objet_argument_2).objet))
3103: .nombre_lignes;
3104: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
3105: (*((struct_matrice *) (*s_objet_argument_2).objet))
3106: .nombre_colonnes;
3107: }
3108:
3109: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 3110: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
3111: .objet))).nombre_lignes) * sizeof(real8 *))) == NULL)
1.1 bertrand 3112: {
3113: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3114: return;
3115: }
3116:
3117: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
3118: .objet))).nombre_lignes; i++)
3119: {
3120: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau[i] =
1.43 bertrand 3121: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
3122: .objet))).nombre_colonnes) * sizeof(real8))) == NULL)
1.1 bertrand 3123: {
3124: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3125: return;
3126: }
3127:
3128: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
3129: .objet))).nombre_colonnes; j++)
3130: {
3131: if ((*s_objet_argument_1).type == MIN)
3132: {
3133: ((real8 **) (*((struct_matrice *)
3134: (*s_objet_resultat).objet)).tableau)[i][j] =
3135: (*((real8 *) (*s_objet_argument_2)
1.43 bertrand 3136: .objet)) * ((real8) ((integer8 **) (*((struct_matrice *)
3137: (*s_objet_argument_1).objet)).tableau)[i][j]);
1.1 bertrand 3138: }
3139: else
3140: {
3141: ((real8 **) (*((struct_matrice *)
3142: (*s_objet_resultat).objet)).tableau)[i][j] =
3143: (*((real8 *) (*s_objet_argument_1)
1.43 bertrand 3144: .objet)) * ((real8) ((integer8 **) (*((struct_matrice *)
3145: (*s_objet_argument_2).objet)).tableau)[i][j]);
1.1 bertrand 3146: }
3147: }
3148: }
3149: }
3150:
3151: /*
3152: * Matrice de réels / Réel
3153: */
3154:
3155: else if ((((*s_objet_argument_1).type == MRL) &&
3156: ((*s_objet_argument_2).type == REL)) ||
3157: (((*s_objet_argument_1).type == REL) &&
3158: ((*s_objet_argument_2).type == MRL)))
3159: {
3160: if ((s_objet_resultat = allocation(s_etat_processus, MRL))
3161: == NULL)
3162: {
3163: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3164: return;
3165: }
3166:
3167: if ((*s_objet_argument_1).type == MRL)
3168: {
3169: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
3170: (*((struct_matrice *) (*s_objet_argument_1).objet))
3171: .nombre_lignes;
3172: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
3173: (*((struct_matrice *) (*s_objet_argument_1).objet))
3174: .nombre_colonnes;
3175: }
3176: else
3177: {
3178: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
3179: (*((struct_matrice *) (*s_objet_argument_2).objet))
3180: .nombre_lignes;
3181: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
3182: (*((struct_matrice *) (*s_objet_argument_2).objet))
3183: .nombre_colonnes;
3184: }
3185:
3186: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 3187: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
3188: .objet))).nombre_lignes) * sizeof(real8 *))) == NULL)
1.1 bertrand 3189: {
3190: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3191: return;
3192: }
3193:
3194: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
3195: .objet))).nombre_lignes; i++)
3196: {
3197: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau[i] =
1.43 bertrand 3198: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
3199: .objet))).nombre_colonnes) * sizeof(real8))) == NULL)
1.1 bertrand 3200: {
3201: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3202: return;
3203: }
3204:
3205: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
3206: .objet))).nombre_colonnes; j++)
3207: {
3208: if ((*s_objet_argument_1).type == MRL)
3209: {
3210: ((real8 **) (*((struct_matrice *)
3211: (*s_objet_resultat).objet)).tableau)[i][j] =
3212: (*((real8 *) (*s_objet_argument_2)
3213: .objet)) * ((real8 **) (*((struct_matrice *)
3214: (*s_objet_argument_1).objet)).tableau)[i][j];
3215: }
3216: else
3217: {
3218: ((real8 **) (*((struct_matrice *)
3219: (*s_objet_resultat).objet)).tableau)[i][j] =
3220: (*((real8 *) (*s_objet_argument_1)
3221: .objet)) * ((real8 **) (*((struct_matrice *)
3222: (*s_objet_argument_2).objet)).tableau)[i][j];
3223: }
3224: }
3225: }
3226: }
3227:
3228: /*
3229: * Matrice de complexes / Réel
3230: */
3231:
3232: else if ((((*s_objet_argument_1).type == MCX) &&
3233: ((*s_objet_argument_2).type == REL)) ||
3234: (((*s_objet_argument_1).type == REL) &&
3235: ((*s_objet_argument_2).type == MCX)))
3236: {
3237: if ((s_objet_resultat = allocation(s_etat_processus, MCX))
3238: == NULL)
3239: {
3240: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3241: return;
3242: }
3243:
3244: if ((*s_objet_argument_1).type == MCX)
3245: {
3246: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
3247: (*((struct_matrice *) (*s_objet_argument_1).objet))
3248: .nombre_lignes;
3249: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
3250: (*((struct_matrice *) (*s_objet_argument_1).objet))
3251: .nombre_colonnes;
3252: }
3253: else
3254: {
3255: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
3256: (*((struct_matrice *) (*s_objet_argument_2).objet))
3257: .nombre_lignes;
3258: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
3259: (*((struct_matrice *) (*s_objet_argument_2).objet))
3260: .nombre_colonnes;
3261: }
3262:
3263: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 3264: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
3265: .objet))).nombre_lignes) * sizeof(struct_complexe16 *)))
3266: == NULL)
1.1 bertrand 3267: {
3268: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3269: return;
3270: }
3271:
3272: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
3273: .objet))).nombre_lignes; i++)
3274: {
3275: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau[i] =
1.43 bertrand 3276: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
3277: .objet))).nombre_colonnes) * sizeof(struct_complexe16)))
1.1 bertrand 3278: == NULL)
3279: {
3280: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3281: return;
3282: }
3283:
3284: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
3285: .objet))).nombre_colonnes; j++)
3286: {
3287: if ((*s_objet_argument_1).type == MCX)
3288: {
3289: f77multiplicationcr_(&(((struct_complexe16 **)
3290: (*((struct_matrice *) (*s_objet_argument_1).objet))
3291: .tableau)[i][j]), &((*((real8 *)
3292: (*s_objet_argument_2).objet))),
3293: &(((struct_complexe16 **) (*((struct_matrice *)
3294: (*s_objet_resultat).objet)).tableau)[i][j]));
3295: }
3296: else
3297: {
3298: f77multiplicationcr_(&(((struct_complexe16 **)
3299: (*((struct_matrice *) (*s_objet_argument_2).objet))
3300: .tableau)[i][j]), &((*((real8 *)
3301: (*s_objet_argument_1).objet))),
3302: &(((struct_complexe16 **) (*((struct_matrice *)
3303: (*s_objet_resultat).objet)).tableau)[i][j]));
3304: }
3305: }
3306: }
3307: }
3308:
3309: /*
3310: * Matrice d'entiers / Complexe
3311: */
3312:
3313: else if ((((*s_objet_argument_1).type == MIN) &&
3314: ((*s_objet_argument_2).type == CPL)) ||
3315: (((*s_objet_argument_1).type == CPL) &&
3316: ((*s_objet_argument_2).type == MIN)))
3317: {
3318: if ((s_objet_resultat = allocation(s_etat_processus, MCX))
3319: == NULL)
3320: {
3321: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3322: return;
3323: }
3324:
3325: if ((*s_objet_argument_1).type == MIN)
3326: {
3327: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
3328: (*((struct_matrice *) (*s_objet_argument_1).objet))
3329: .nombre_lignes;
3330: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
3331: (*((struct_matrice *) (*s_objet_argument_1).objet))
3332: .nombre_colonnes;
3333: }
3334: else
3335: {
3336: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
3337: (*((struct_matrice *) (*s_objet_argument_2).objet))
3338: .nombre_lignes;
3339: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
3340: (*((struct_matrice *) (*s_objet_argument_2).objet))
3341: .nombre_colonnes;
3342: }
3343:
3344: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 3345: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
3346: .objet))).nombre_lignes) * sizeof(struct_complexe16 *)))
3347: == NULL)
1.1 bertrand 3348: {
3349: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3350: return;
3351: }
3352:
3353: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
3354: .objet))).nombre_lignes; i++)
3355: {
3356: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau[i] =
1.43 bertrand 3357: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
3358: .objet))).nombre_colonnes) * sizeof(struct_complexe16)))
1.1 bertrand 3359: == NULL)
3360: {
3361: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3362: return;
3363: }
3364:
3365: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
3366: .objet))).nombre_colonnes; j++)
3367: {
3368: if ((*s_objet_argument_1).type == MIN)
3369: {
3370: f77multiplicationci_(&((*((struct_complexe16 *)
3371: (*s_objet_argument_2).objet))),
3372: &(((integer8 **) (*((struct_matrice *)
3373: (*s_objet_argument_1).objet)).tableau)[i][j]),
3374: &(((struct_complexe16 **) (*((struct_matrice *)
3375: (*s_objet_resultat).objet)).tableau)[i][j]));
3376: }
3377: else
3378: {
3379: f77multiplicationci_(&((*((struct_complexe16 *)
3380: (*s_objet_argument_1).objet))),
3381: &(((integer8 **) (*((struct_matrice *)
3382: (*s_objet_argument_2).objet)).tableau)[i][j]),
3383: &(((struct_complexe16 **) (*((struct_matrice *)
3384: (*s_objet_resultat).objet)).tableau)[i][j]));
3385: }
3386: }
3387: }
3388: }
3389:
3390: /*
3391: * Matrice de réels / Complexe
3392: */
3393:
3394: else if ((((*s_objet_argument_1).type == MRL) &&
3395: ((*s_objet_argument_2).type == CPL)) ||
3396: (((*s_objet_argument_1).type == CPL) &&
3397: ((*s_objet_argument_2).type == MRL)))
3398: {
3399: if ((s_objet_resultat = allocation(s_etat_processus, MCX))
3400: == NULL)
3401: {
3402: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3403: return;
3404: }
3405:
3406: if ((*s_objet_argument_1).type == MRL)
3407: {
3408: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
3409: (*((struct_matrice *) (*s_objet_argument_1).objet))
3410: .nombre_lignes;
3411: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
3412: (*((struct_matrice *) (*s_objet_argument_1).objet))
3413: .nombre_colonnes;
3414: }
3415: else
3416: {
3417: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
3418: (*((struct_matrice *) (*s_objet_argument_2).objet))
3419: .nombre_lignes;
3420: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
3421: (*((struct_matrice *) (*s_objet_argument_2).objet))
3422: .nombre_colonnes;
3423: }
3424:
3425: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 3426: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
3427: .objet))).nombre_lignes) * sizeof(struct_complexe16 *)))
3428: == NULL)
1.1 bertrand 3429: {
3430: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3431: return;
3432: }
3433:
3434: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
3435: .objet))).nombre_lignes; i++)
3436: {
3437: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau[i] =
1.43 bertrand 3438: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
3439: .objet))).nombre_colonnes) * sizeof(struct_complexe16)))
1.1 bertrand 3440: == NULL)
3441: {
3442: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3443: return;
3444: }
3445:
3446: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
3447: .objet))).nombre_colonnes; j++)
3448: {
3449: if ((*s_objet_argument_1).type == MRL)
3450: {
3451: f77multiplicationcr_(&((*((struct_complexe16 *)
3452: (*s_objet_argument_2).objet))),
3453: &(((real8 **) (*((struct_matrice *)
3454: (*s_objet_argument_1).objet)).tableau)[i][j]),
3455: &(((struct_complexe16 **) (*((struct_matrice *)
3456: (*s_objet_resultat).objet)).tableau)[i][j]));
3457: }
3458: else
3459: {
3460: f77multiplicationcr_(&((*((struct_complexe16 *)
3461: (*s_objet_argument_1).objet))),
3462: &(((real8 **) (*((struct_matrice *)
3463: (*s_objet_argument_2).objet)).tableau)[i][j]),
3464: &(((struct_complexe16 **) (*((struct_matrice *)
3465: (*s_objet_resultat).objet)).tableau)[i][j]));
3466: }
3467: }
3468: }
3469: }
3470:
3471: /*
3472: * Matrice de complexes / Complexe
3473: */
3474:
3475: else if ((((*s_objet_argument_1).type == MCX) &&
3476: ((*s_objet_argument_2).type == CPL)) ||
3477: (((*s_objet_argument_1).type == CPL) &&
3478: ((*s_objet_argument_2).type == MCX)))
3479: {
3480: if ((s_objet_resultat = allocation(s_etat_processus, MCX))
3481: == NULL)
3482: {
3483: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3484: return;
3485: }
3486:
3487: if ((*s_objet_argument_1).type == MCX)
3488: {
3489: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
3490: (*((struct_matrice *) (*s_objet_argument_1).objet))
3491: .nombre_lignes;
3492: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
3493: (*((struct_matrice *) (*s_objet_argument_1).objet))
3494: .nombre_colonnes;
3495: }
3496: else
3497: {
3498: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
3499: (*((struct_matrice *) (*s_objet_argument_2).objet))
3500: .nombre_lignes;
3501: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
3502: (*((struct_matrice *) (*s_objet_argument_2).objet))
3503: .nombre_colonnes;
3504: }
3505:
3506: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 3507: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
3508: .objet))).nombre_lignes) * sizeof(struct_complexe16 *)))
3509: == NULL)
1.1 bertrand 3510: {
3511: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3512: return;
3513: }
3514:
3515: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
3516: .objet))).nombre_lignes; i++)
3517: {
3518: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau[i] =
1.43 bertrand 3519: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
3520: .objet))).nombre_colonnes) * sizeof(struct_complexe16)))
1.1 bertrand 3521: == NULL)
3522: {
3523: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3524: return;
3525: }
3526:
3527: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
3528: .objet))).nombre_colonnes; j++)
3529: {
3530: if ((*s_objet_argument_1).type == MCX)
3531: {
3532: f77multiplicationcc_(&((*((struct_complexe16 *)
3533: (*s_objet_argument_2).objet))),
3534: &(((struct_complexe16 **) (*((struct_matrice *)
3535: (*s_objet_argument_1).objet)).tableau)[i][j]),
3536: &(((struct_complexe16 **) (*((struct_matrice *)
3537: (*s_objet_resultat).objet)).tableau)[i][j]));
3538: }
3539: else
3540: {
3541: f77multiplicationcc_(&((*((struct_complexe16 *)
3542: (*s_objet_argument_1).objet))),
3543: &(((struct_complexe16 **) (*((struct_matrice *)
3544: (*s_objet_argument_2).objet)).tableau)[i][j]),
3545: &(((struct_complexe16 **) (*((struct_matrice *)
3546: (*s_objet_resultat).objet)).tableau)[i][j]));
3547: }
3548: }
3549: }
3550: }
3551:
3552: /*
3553: --------------------------------------------------------------------------------
3554: Multiplication d'une matrice par un vecteur (résultat : vecteur)
3555: --------------------------------------------------------------------------------
3556: */
3557: /*
3558: * Matrice d'entiers / Vecteur d'entiers
3559: */
3560:
3561: else if (((*s_objet_argument_2).type == MIN) &&
3562: ((*s_objet_argument_1).type == VIN))
3563: {
3564: if ((s_objet_resultat = allocation(s_etat_processus, VIN))
3565: == NULL)
3566: {
3567: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3568: return;
3569: }
3570:
3571: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
3572: (*(((struct_matrice *) (*s_objet_argument_2)
3573: .objet))).nombre_lignes;
3574:
3575: if ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille !=
3576: (*((struct_matrice *) (*s_objet_argument_2).objet))
3577: .nombre_colonnes)
3578: {
3579: liberation(s_etat_processus, s_objet_argument_1);
3580: liberation(s_etat_processus, s_objet_argument_2);
3581: liberation(s_etat_processus, s_objet_resultat);
3582:
3583: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
3584: return;
3585: }
3586:
3587: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 3588: malloc(((size_t) (*(((struct_matrice *) (*s_objet_argument_2)
3589: .objet))).nombre_lignes) * sizeof(integer8))) == NULL)
1.1 bertrand 3590: {
3591: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3592: return;
3593: }
3594:
3595: depassement = d_faux;
3596:
3597: for(i = 0; i < (*(((struct_matrice *) (*s_objet_argument_2)
3598: .objet))).nombre_lignes; i++)
3599: {
3600: ((integer8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
3601: .tableau)[i] = 0;
3602:
3603: for(k = 0; k < (*(((struct_matrice *) (*s_objet_argument_2)
3604: .objet))).nombre_colonnes; k++)
3605: {
3606: if (depassement_multiplication(&(((integer8 **)
3607: (*((struct_matrice *) (*s_objet_argument_2).objet))
3608: .tableau)[i][k]), &(((integer8 *) (*((struct_vecteur *)
3609: (*s_objet_argument_1).objet)).tableau)[k]), &tampon)
3610: == d_erreur)
3611: {
3612: depassement = d_vrai;
3613: }
3614:
3615: if (depassement_addition(&(((integer8 *) (*((struct_vecteur *)
3616: (*s_objet_resultat).objet)).tableau)[i]), &tampon,
3617: &cumul) == d_erreur)
3618: {
3619: depassement = d_vrai;
3620: }
3621:
3622: ((integer8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
3623: .tableau)[i] = cumul;
3624: }
3625: }
3626:
3627: if (depassement == d_vrai)
3628: {
3629: (*s_objet_resultat).type = VRL;
3630: (*((struct_vecteur *) (*s_objet_resultat).objet)).type = 'R';
3631:
3632: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 3633: malloc(((size_t) (*(((struct_matrice *)
3634: (*s_objet_argument_2).objet))).nombre_lignes) *
3635: sizeof(real8))) == NULL)
1.1 bertrand 3636: {
3637: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3638: return;
3639: }
3640:
3641: for(i = 0; i < (*(((struct_matrice *) (*s_objet_argument_2)
3642: .objet))).nombre_lignes; i++)
3643: {
3644: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
3645: .tableau)[i] = 0;
3646:
3647: for(k = 0; k < (*(((struct_matrice *) (*s_objet_argument_2)
3648: .objet))).nombre_colonnes; k++)
3649: {
3650: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
3651: .tableau)[i] = ((real8) ((integer8 *)
3652: (*((struct_vecteur *) (*s_objet_resultat).objet))
3653: .tableau)[i]) + ((real8) (((integer8 **)
3654: (*((struct_matrice *) (*s_objet_argument_2).objet))
3655: .tableau)[i][k]) * ((real8) ((integer8 *)
3656: (*((struct_vecteur *) (*s_objet_argument_1).objet))
3657: .tableau)[k]));
3658: }
3659: }
3660: }
3661: }
3662:
3663: /*
3664: * Matrice d'entiers / Vecteur de réels
3665: */
3666:
3667: else if (((*s_objet_argument_2).type == MIN) &&
3668: ((*s_objet_argument_1).type == VRL))
3669: {
3670: if ((s_objet_resultat = allocation(s_etat_processus, VRL))
3671: == NULL)
3672: {
3673: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3674: return;
3675: }
3676:
3677: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
3678: (*(((struct_matrice *) (*s_objet_argument_2)
3679: .objet))).nombre_lignes;
3680:
3681: if ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille !=
3682: (*((struct_matrice *) (*s_objet_argument_2).objet))
3683: .nombre_colonnes)
3684: {
3685: liberation(s_etat_processus, s_objet_argument_1);
3686: liberation(s_etat_processus, s_objet_argument_2);
3687: liberation(s_etat_processus, s_objet_resultat);
3688:
3689: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
3690: return;
3691: }
3692:
3693: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 3694: malloc(((size_t) (*(((struct_matrice *) (*s_objet_argument_2)
3695: .objet))).nombre_lignes) * sizeof(real8))) == NULL)
1.1 bertrand 3696: {
3697: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3698: return;
3699: }
3700:
1.43 bertrand 3701: if ((accumulateur = malloc(((size_t) (*(((struct_matrice *)
3702: (*s_objet_argument_2).objet))).nombre_colonnes) *
1.1 bertrand 3703: sizeof(real8))) == NULL)
3704: {
3705: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3706: return;
3707: }
3708:
3709: for(i = 0; i < (*(((struct_matrice *) (*s_objet_argument_2)
3710: .objet))).nombre_lignes; i++)
3711: {
3712: for(k = 0; k < (*(((struct_matrice *) (*s_objet_argument_2)
3713: .objet))).nombre_colonnes; k++)
3714: {
1.43 bertrand 3715: ((real8 *) accumulateur)[k] = ((real8) ((integer8 **)
1.1 bertrand 3716: (*((struct_matrice *) (*s_objet_argument_2).objet))
1.43 bertrand 3717: .tableau)[i][k]) * ((real8 *) (*((struct_vecteur *)
3718: (*s_objet_argument_1).objet)).tableau)[k];
1.1 bertrand 3719: }
3720:
3721: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
3722: .tableau)[i] = sommation_vecteur_reel(accumulateur,
3723: &((*(((struct_matrice *) (*s_objet_argument_2).objet)))
3724: .nombre_colonnes), &erreur_memoire);
3725:
3726: if (erreur_memoire == d_vrai)
3727: {
3728: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3729: return;
3730: }
3731: }
3732:
3733: free(accumulateur);
3734: }
3735:
3736: /*
3737: * Matrice d'entiers / Vecteur de complexes
3738: */
3739:
3740: else if (((*s_objet_argument_2).type == MIN) &&
3741: ((*s_objet_argument_1).type == VCX))
3742: {
3743: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
3744: == NULL)
3745: {
3746: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3747: return;
3748: }
3749:
3750: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
3751: (*(((struct_matrice *) (*s_objet_argument_2)
3752: .objet))).nombre_lignes;
3753:
3754: if ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille !=
3755: (*((struct_matrice *) (*s_objet_argument_2).objet))
3756: .nombre_colonnes)
3757: {
3758: liberation(s_etat_processus, s_objet_argument_1);
3759: liberation(s_etat_processus, s_objet_argument_2);
3760: liberation(s_etat_processus, s_objet_resultat);
3761:
3762: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
3763: return;
3764: }
3765:
3766: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 3767: malloc(((size_t) (*(((struct_matrice *) (*s_objet_argument_2)
3768: .objet))).nombre_lignes) * sizeof(struct_complexe16))) == NULL)
1.1 bertrand 3769: {
3770: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3771: return;
3772: }
3773:
1.43 bertrand 3774: if ((accumulateur = malloc(((size_t) (*(((struct_matrice *)
3775: (*s_objet_argument_2).objet))).nombre_colonnes) *
1.1 bertrand 3776: sizeof(complex16))) == NULL)
3777: {
3778: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3779: return;
3780: }
3781:
3782: for(i = 0; i < (*(((struct_matrice *) (*s_objet_argument_2)
3783: .objet))).nombre_lignes; i++)
3784: {
3785: for(k = 0; k < (*(((struct_matrice *) (*s_objet_argument_2)
3786: .objet))).nombre_colonnes; k++)
3787: {
3788: f77multiplicationci_(&(((struct_complexe16 *)
3789: (*((struct_vecteur *) (*s_objet_argument_1).objet))
3790: .tableau)[k]), &(((integer8 **) (*((struct_matrice *)
3791: (*s_objet_argument_2).objet)).tableau)[i][k]),
3792: &(((complex16 *) accumulateur)[k]));
3793: }
3794:
3795: ((complex16 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
3796: .tableau)[i] = sommation_vecteur_complexe(accumulateur,
3797: &((*(((struct_matrice *) (*s_objet_argument_2).objet)))
3798: .nombre_colonnes), &erreur_memoire);
3799:
3800: if (erreur_memoire == d_vrai)
3801: {
3802: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3803: return;
3804: }
3805: }
3806:
3807: free(accumulateur);
3808: }
3809:
3810: /*
3811: * Matrice de réels / Vecteur d'entiers
3812: */
3813:
3814: else if (((*s_objet_argument_2).type == MRL) &&
3815: ((*s_objet_argument_1).type == VIN))
3816: {
3817: if ((s_objet_resultat = allocation(s_etat_processus, VRL))
3818: == NULL)
3819: {
3820: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3821: return;
3822: }
3823:
3824: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
3825: (*(((struct_matrice *) (*s_objet_argument_2)
3826: .objet))).nombre_lignes;
3827:
3828: if ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille !=
3829: (*((struct_matrice *) (*s_objet_argument_2).objet))
3830: .nombre_colonnes)
3831: {
3832: liberation(s_etat_processus, s_objet_argument_1);
3833: liberation(s_etat_processus, s_objet_argument_2);
3834: liberation(s_etat_processus, s_objet_resultat);
3835:
3836: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
3837: return;
3838: }
3839:
3840: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 3841: malloc(((size_t) (*(((struct_matrice *) (*s_objet_argument_2)
3842: .objet))).nombre_lignes) * sizeof(real8))) == NULL)
1.1 bertrand 3843: {
3844: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3845: return;
3846: }
3847:
1.43 bertrand 3848: if ((accumulateur = malloc(((size_t) (*(((struct_matrice *)
3849: (*s_objet_argument_2).objet))).nombre_colonnes) *
1.1 bertrand 3850: sizeof(real8))) == NULL)
3851: {
3852: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3853: return;
3854: }
3855:
3856: for(i = 0; i < (*(((struct_matrice *) (*s_objet_argument_2)
3857: .objet))).nombre_lignes; i++)
3858: {
3859: for(k = 0; k < (*(((struct_matrice *) (*s_objet_argument_2)
3860: .objet))).nombre_colonnes; k++)
3861: {
1.43 bertrand 3862: ((real8 *) accumulateur)[k] = ((real8 **) (*((struct_matrice *)
1.1 bertrand 3863: (*s_objet_argument_2).objet)).tableau)[i][k] *
1.43 bertrand 3864: ((real8) ((integer8 *) (*((struct_vecteur *)
1.1 bertrand 3865: (*s_objet_argument_1).objet)).tableau)[k]);
3866: }
3867:
3868: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
3869: .tableau)[i] = sommation_vecteur_reel(accumulateur,
3870: &((*(((struct_matrice *) (*s_objet_argument_2).objet)))
3871: .nombre_colonnes), &erreur_memoire);
3872:
3873: if (erreur_memoire == d_vrai)
3874: {
3875: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3876: return;
3877: }
3878: }
3879:
3880: free(accumulateur);
3881: }
3882:
3883: /*
3884: * Matrice de réels / Vecteur de réels
3885: */
3886:
3887: else if (((*s_objet_argument_2).type == MRL) &&
3888: ((*s_objet_argument_1).type == VRL))
3889: {
3890: if ((s_objet_resultat = allocation(s_etat_processus, VRL))
3891: == NULL)
3892: {
3893: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3894: return;
3895: }
3896:
3897: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
3898: (*(((struct_matrice *) (*s_objet_argument_2)
3899: .objet))).nombre_lignes;
3900:
3901: if ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille !=
3902: (*((struct_matrice *) (*s_objet_argument_2).objet))
3903: .nombre_colonnes)
3904: {
3905: liberation(s_etat_processus, s_objet_argument_1);
3906: liberation(s_etat_processus, s_objet_argument_2);
3907: liberation(s_etat_processus, s_objet_resultat);
3908:
3909: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
3910: return;
3911: }
3912:
3913: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 3914: malloc(((size_t) (*(((struct_matrice *) (*s_objet_argument_2)
3915: .objet))).nombre_lignes) * sizeof(real8))) == NULL)
1.1 bertrand 3916: {
3917: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3918: return;
3919: }
3920:
1.43 bertrand 3921: if ((accumulateur = malloc(((size_t) (*(((struct_matrice *)
3922: (*s_objet_argument_2).objet))).nombre_colonnes) *
1.1 bertrand 3923: sizeof(real8))) == NULL)
3924: {
3925: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3926: return;
3927: }
3928:
3929: for(i = 0; i < (*(((struct_matrice *) (*s_objet_argument_2)
3930: .objet))).nombre_lignes; i++)
3931: {
3932: for(k = 0; k < (*(((struct_matrice *) (*s_objet_argument_2)
3933: .objet))).nombre_colonnes; k++)
3934: {
3935: ((real8 *) accumulateur)[k] = (((real8 **) (*((struct_matrice *)
3936: (*s_objet_argument_2).objet)).tableau)[i][k] *
3937: ((real8 *) (*((struct_vecteur *)
3938: (*s_objet_argument_1).objet)).tableau)[k]);
3939: }
3940:
3941: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
3942: .tableau)[i] = sommation_vecteur_reel(accumulateur,
3943: &((*(((struct_matrice *) (*s_objet_argument_2).objet)))
3944: .nombre_colonnes), &erreur_memoire);
3945:
3946: if (erreur_memoire == d_vrai)
3947: {
3948: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3949: return;
3950: }
3951: }
3952:
3953: free(accumulateur);
3954: }
3955:
3956: /*
3957: * Matrice de réels / Vecteur de complexes
3958: */
3959:
3960: else if (((*s_objet_argument_2).type == MRL) &&
3961: ((*s_objet_argument_1).type == VCX))
3962: {
3963: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
3964: == NULL)
3965: {
3966: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3967: return;
3968: }
3969:
3970: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
3971: (*(((struct_matrice *) (*s_objet_argument_2)
3972: .objet))).nombre_lignes;
3973:
3974: if ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille !=
3975: (*((struct_matrice *) (*s_objet_argument_2).objet))
3976: .nombre_colonnes)
3977: {
3978: liberation(s_etat_processus, s_objet_argument_1);
3979: liberation(s_etat_processus, s_objet_argument_2);
3980: liberation(s_etat_processus, s_objet_resultat);
3981:
3982: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
3983: return;
3984: }
3985:
3986: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 3987: malloc(((size_t) (*(((struct_matrice *) (*s_objet_argument_2)
3988: .objet))).nombre_lignes) * sizeof(struct_complexe16))) == NULL)
1.1 bertrand 3989: {
3990: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3991: return;
3992: }
3993:
1.43 bertrand 3994: if ((accumulateur = malloc(((size_t) (*(((struct_matrice *)
3995: (*s_objet_argument_2).objet))).nombre_colonnes) *
1.1 bertrand 3996: sizeof(complex16))) == NULL)
3997: {
3998: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3999: return;
4000: }
4001:
4002: for(i = 0; i < (*(((struct_matrice *) (*s_objet_argument_2)
4003: .objet))).nombre_lignes; i++)
4004: {
4005: for(k = 0; k < (*(((struct_matrice *) (*s_objet_argument_2)
4006: .objet))).nombre_colonnes; k++)
4007: {
4008: f77multiplicationcr_(&(((struct_complexe16 *)
4009: (*((struct_vecteur *) (*s_objet_argument_1).objet))
4010: .tableau)[k]), &(((real8 **) (*((struct_matrice *)
4011: (*s_objet_argument_2).objet)).tableau)[i][k]),
4012: &(((complex16 *) accumulateur)[k]));
4013: }
4014:
4015: ((struct_complexe16 *) (*((struct_vecteur *) (*s_objet_resultat)
4016: .objet)).tableau)[i] = sommation_vecteur_complexe(
4017: accumulateur, &((*(((struct_matrice *) (*s_objet_argument_2)
4018: .objet))).nombre_colonnes), &erreur_memoire);
4019:
4020: if (erreur_memoire == d_vrai)
4021: {
4022: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4023: return;
4024: }
4025: }
4026:
4027: free(accumulateur);
4028: }
4029:
4030: /*
4031: * Matrice de complexes / Vecteur d'entiers
4032: */
4033:
4034: else if (((*s_objet_argument_2).type == MCX) &&
4035: ((*s_objet_argument_1).type == VIN))
4036: {
4037: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
4038: == NULL)
4039: {
4040: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4041: return;
4042: }
4043:
4044: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
4045: (*(((struct_matrice *) (*s_objet_argument_2)
4046: .objet))).nombre_lignes;
4047:
4048: if ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille !=
4049: (*((struct_matrice *) (*s_objet_argument_2).objet))
4050: .nombre_colonnes)
4051: {
4052: liberation(s_etat_processus, s_objet_argument_1);
4053: liberation(s_etat_processus, s_objet_argument_2);
4054: liberation(s_etat_processus, s_objet_resultat);
4055:
4056: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
4057: return;
4058: }
4059:
4060: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 4061: malloc(((size_t) (*(((struct_matrice *) (*s_objet_argument_2)
4062: .objet))).nombre_lignes) * sizeof(struct_complexe16))) == NULL)
1.1 bertrand 4063: {
4064: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4065: return;
4066: }
4067:
1.43 bertrand 4068: if ((accumulateur = malloc(((size_t) (*(((struct_matrice *)
4069: (*s_objet_argument_2).objet))).nombre_colonnes) *
1.1 bertrand 4070: sizeof(complex16))) == NULL)
4071: {
4072: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4073: return;
4074: }
4075:
4076: for(i = 0; i < (*(((struct_matrice *) (*s_objet_argument_2)
4077: .objet))).nombre_lignes; i++)
4078: {
4079: for(k = 0; k < (*(((struct_matrice *) (*s_objet_argument_2)
4080: .objet))).nombre_colonnes; k++)
4081: {
4082: f77multiplicationci_(&(((struct_complexe16 **)
4083: (*((struct_matrice *) (*s_objet_argument_2).objet))
4084: .tableau)[i][k]), &(((integer8 *)
4085: (*((struct_vecteur *) (*s_objet_argument_1).objet))
4086: .tableau)[k]), &(((complex16 *) accumulateur)[k]));
4087: }
4088:
4089: ((struct_complexe16 *) (*((struct_vecteur *) (*s_objet_resultat)
4090: .objet)).tableau)[i] = sommation_vecteur_complexe(
4091: accumulateur, &((*(((struct_matrice *) (*s_objet_argument_2)
4092: .objet))).nombre_colonnes), &erreur_memoire);
4093:
4094: if (erreur_memoire == d_vrai)
4095: {
4096: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4097: return;
4098: }
4099: }
4100:
4101: free(accumulateur);
4102: }
4103:
4104: /*
4105: * Matrice de complexes / Vecteur de réels
4106: */
4107:
4108: else if (((*s_objet_argument_2).type == MCX) &&
4109: ((*s_objet_argument_1).type == VRL))
4110: {
4111: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
4112: == NULL)
4113: {
4114: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4115: return;
4116: }
4117:
4118: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
4119: (*(((struct_matrice *) (*s_objet_argument_2)
4120: .objet))).nombre_lignes;
4121:
4122: if ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille !=
4123: (*((struct_matrice *) (*s_objet_argument_2).objet))
4124: .nombre_colonnes)
4125: {
4126: liberation(s_etat_processus, s_objet_argument_1);
4127: liberation(s_etat_processus, s_objet_argument_2);
4128: liberation(s_etat_processus, s_objet_resultat);
4129:
4130: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
4131: return;
4132: }
4133:
4134: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 4135: malloc(((size_t) (*(((struct_matrice *) (*s_objet_argument_2)
4136: .objet))).nombre_lignes) * sizeof(struct_complexe16))) == NULL)
1.1 bertrand 4137: {
4138: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4139: return;
4140: }
4141:
1.43 bertrand 4142: if ((accumulateur = malloc(((size_t) (*(((struct_matrice *)
4143: (*s_objet_argument_2).objet))).nombre_colonnes) *
1.1 bertrand 4144: sizeof(complex16))) == NULL)
4145: {
4146: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4147: return;
4148: }
4149:
4150: for(i = 0; i < (*(((struct_matrice *) (*s_objet_argument_2)
4151: .objet))).nombre_lignes; i++)
4152: {
4153: for(k = 0; k < (*(((struct_matrice *) (*s_objet_argument_2)
4154: .objet))).nombre_colonnes; k++)
4155: {
4156: f77multiplicationcr_(&(((struct_complexe16 **)
4157: (*((struct_matrice *) (*s_objet_argument_2).objet))
4158: .tableau)[i][k]), &(((real8 *)
4159: (*((struct_vecteur *) (*s_objet_argument_1).objet))
4160: .tableau)[k]), &(((complex16 *) accumulateur)[k]));
4161: }
4162:
4163: ((struct_complexe16 *) (*((struct_vecteur *) (*s_objet_resultat)
4164: .objet)).tableau)[i] = sommation_vecteur_complexe(
4165: accumulateur, &((*(((struct_matrice *) (*s_objet_argument_2)
4166: .objet))).nombre_colonnes), &erreur_memoire);
4167:
4168: if (erreur_memoire == d_vrai)
4169: {
4170: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4171: return;
4172: }
4173: }
4174:
4175: free(accumulateur);
4176: }
4177:
4178: /*
4179: * Matrice de complexes / Vecteur de complexes
4180: */
4181:
4182: else if (((*s_objet_argument_2).type == MCX) &&
4183: ((*s_objet_argument_1).type == VCX))
4184: {
4185: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
4186: == NULL)
4187: {
4188: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4189: return;
4190: }
4191:
4192: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
4193: (*(((struct_matrice *) (*s_objet_argument_2)
4194: .objet))).nombre_lignes;
4195:
4196: if ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille !=
4197: (*((struct_matrice *) (*s_objet_argument_2).objet))
4198: .nombre_colonnes)
4199: {
4200: liberation(s_etat_processus, s_objet_argument_1);
4201: liberation(s_etat_processus, s_objet_argument_2);
4202: liberation(s_etat_processus, s_objet_resultat);
4203:
4204: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
4205: return;
4206: }
4207:
4208: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 4209: malloc(((size_t) (*(((struct_matrice *) (*s_objet_argument_2)
4210: .objet))).nombre_lignes) * sizeof(struct_complexe16))) == NULL)
1.1 bertrand 4211: {
4212: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4213: return;
4214: }
4215:
1.43 bertrand 4216: if ((accumulateur = malloc(((size_t) (*(((struct_matrice *)
4217: (*s_objet_argument_2).objet))).nombre_colonnes) *
1.1 bertrand 4218: sizeof(complex16))) == NULL)
4219: {
4220: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4221: return;
4222: }
4223:
4224: for(i = 0; i < (*(((struct_matrice *) (*s_objet_argument_2)
4225: .objet))).nombre_lignes; i++)
4226: {
4227: for(k = 0; k < (*(((struct_matrice *) (*s_objet_argument_2)
4228: .objet))).nombre_colonnes; k++)
4229: {
4230: f77multiplicationcc_(&(((struct_complexe16 **)
4231: (*((struct_matrice *) (*s_objet_argument_2).objet))
4232: .tableau)[i][k]), &(((struct_complexe16 *)
4233: (*((struct_vecteur *) (*s_objet_argument_1).objet))
4234: .tableau)[k]), &(((complex16 *) accumulateur)[k]));
4235: }
4236:
4237: ((struct_complexe16 *) (*((struct_vecteur *) (*s_objet_resultat)
4238: .objet)).tableau)[i] = sommation_vecteur_complexe(
4239: accumulateur, &((*(((struct_matrice *) (*s_objet_argument_2)
4240: .objet))).nombre_colonnes), &erreur_memoire);
4241:
4242: if (erreur_memoire == d_vrai)
4243: {
4244: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4245: return;
4246: }
4247: }
4248:
4249: free(accumulateur);
4250: }
4251:
4252: /*
4253: --------------------------------------------------------------------------------
4254: Multiplication d'une matrice par une autre matrice
4255: --------------------------------------------------------------------------------
4256: */
4257: /*
4258: * Matrice d'entiers / Matrice d'entiers
4259: */
4260:
4261: else if (((*s_objet_argument_2).type == MIN) &&
4262: ((*s_objet_argument_1).type == MIN))
4263: {
4264: if ((*((struct_matrice *) (*s_objet_argument_1).objet)).nombre_lignes !=
4265: (*((struct_matrice *) (*s_objet_argument_2).objet))
4266: .nombre_colonnes)
4267: {
4268: liberation(s_etat_processus, s_objet_argument_1);
4269: liberation(s_etat_processus, s_objet_argument_2);
4270:
4271: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
4272: return;
4273: }
4274:
4275: if ((s_objet_resultat = allocation(s_etat_processus, MIN))
4276: == NULL)
4277: {
4278: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4279: return;
4280: }
4281:
4282: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
4283: (*(((struct_matrice *) (*s_objet_argument_2)
4284: .objet))).nombre_lignes;
4285: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
4286: (*(((struct_matrice *) (*s_objet_argument_1)
4287: .objet))).nombre_colonnes;
4288:
4289: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 4290: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
4291: .objet))).nombre_lignes) * sizeof(integer8 *))) == NULL)
1.1 bertrand 4292: {
4293: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4294: return;
4295: }
4296:
4297: depassement = d_faux;
4298:
4299: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
4300: .objet))).nombre_lignes; i++)
4301: {
4302: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau[i] =
1.43 bertrand 4303: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
4304: .objet))).nombre_colonnes) * sizeof(integer8))) == NULL)
1.1 bertrand 4305: {
4306: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4307: return;
4308: }
4309:
4310: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
4311: .objet))).nombre_colonnes; j++)
4312: {
4313: ((integer8 **) (*((struct_matrice *)
4314: (*s_objet_resultat).objet)).tableau)[i][j] = 0;
4315:
4316: for(k = 0; k < (*(((struct_matrice *) (*s_objet_argument_2)
4317: .objet))).nombre_colonnes; k++)
4318: {
4319: if (depassement_multiplication(&(((integer8 **)
4320: (*((struct_matrice *) (*s_objet_argument_2).objet))
4321: .tableau)[i][k]), &(((integer8 **)
4322: (*((struct_matrice *) (*s_objet_argument_1).objet))
4323: .tableau)[k][j]), &tampon) == d_erreur)
4324: {
4325: depassement = d_vrai;
4326: }
4327:
4328: if (depassement_addition(&(((integer8 **)
4329: (*((struct_matrice *) (*s_objet_resultat).objet))
4330: .tableau)[i][j]), &tampon, &cumul) == d_erreur)
4331: {
4332: depassement = d_vrai;
4333: }
4334:
4335: ((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
4336: .objet)).tableau)[i][j] = cumul;
4337: }
4338: }
4339: }
4340:
4341: if (depassement == d_vrai)
4342: {
4343: (*s_objet_resultat).type = MRL;
4344: (*((struct_matrice *) (*s_objet_resultat).objet)).type = 'R';
4345:
1.43 bertrand 4346: if ((accumulateur = malloc(((size_t) (*(((struct_matrice *)
4347: (*s_objet_argument_2).objet))).nombre_colonnes) *
1.1 bertrand 4348: sizeof(real8))) == NULL)
4349: {
4350: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4351: return;
4352: }
4353:
4354: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
4355: .objet))).nombre_lignes; i++)
4356: {
4357: free(((integer8 **) (*((struct_matrice *)
4358: (*s_objet_resultat).objet)).tableau)[i]);
4359:
4360: if (((*((struct_matrice *) (*s_objet_resultat).objet))
1.43 bertrand 4361: .tableau[i] = malloc(((size_t) (*(((struct_matrice *)
4362: (*s_objet_resultat).objet))).nombre_colonnes) *
1.1 bertrand 4363: sizeof(real8))) == NULL)
4364: {
4365: (*s_etat_processus).erreur_systeme =
4366: d_es_allocation_memoire;
4367: return;
4368: }
4369:
4370: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
4371: .objet))).nombre_colonnes; j++)
4372: {
4373: ((real8 **) (*((struct_matrice *)
4374: (*s_objet_resultat).objet)).tableau)[i][j] = 0;
4375:
4376: for(k = 0; k < (*(((struct_matrice *) (*s_objet_argument_2)
4377: .objet))).nombre_colonnes; k++)
4378: {
4379: ((real8 *) accumulateur)[k] = ((real8)
4380: (((integer8 **) (*((struct_matrice *)
4381: (*s_objet_argument_2).objet)).tableau)[i][k]) *
4382: ((real8) ((integer8 **) (*((struct_matrice *)
4383: (*s_objet_argument_1).objet)).tableau)[k][j]));
4384: }
4385:
4386: ((real8 **) (*((struct_matrice *)
4387: (*s_objet_resultat).objet)).tableau)[i][j] =
4388: sommation_vecteur_reel(accumulateur,
4389: &((*(((struct_matrice *) (*s_objet_argument_2)
4390: .objet))).nombre_colonnes), &erreur_memoire);
4391:
4392: if (erreur_memoire == d_vrai)
4393: {
4394: (*s_etat_processus).erreur_systeme =
4395: d_es_allocation_memoire;
4396: return;
4397: }
4398: }
4399: }
4400:
4401: free(accumulateur);
4402: }
4403: }
4404:
4405: /*
4406: * Matrice d'entiers / Matrice de réels
4407: */
4408:
4409: else if ((((*s_objet_argument_2).type == MIN) &&
4410: ((*s_objet_argument_1).type == MRL)) ||
4411: (((*s_objet_argument_2).type == MRL) &&
4412: ((*s_objet_argument_1).type == MIN)))
4413: {
4414: if ((*((struct_matrice *) (*s_objet_argument_1).objet)).nombre_lignes !=
4415: (*((struct_matrice *) (*s_objet_argument_2).objet))
4416: .nombre_colonnes)
4417: {
4418: liberation(s_etat_processus, s_objet_argument_1);
4419: liberation(s_etat_processus, s_objet_argument_2);
4420:
4421: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
4422: return;
4423: }
4424:
4425: if ((s_objet_resultat = allocation(s_etat_processus, MRL))
4426: == NULL)
4427: {
4428: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4429: return;
4430: }
4431:
4432: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
4433: (*(((struct_matrice *) (*s_objet_argument_2)
4434: .objet))).nombre_lignes;
4435: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
4436: (*(((struct_matrice *) (*s_objet_argument_1)
4437: .objet))).nombre_colonnes;
4438:
4439: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 4440: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
4441: .objet))).nombre_lignes) * sizeof(real8 *))) == NULL)
1.1 bertrand 4442: {
4443: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4444: return;
4445: }
4446:
1.43 bertrand 4447: if ((accumulateur = malloc(((size_t) (*(((struct_matrice *)
4448: (*s_objet_argument_2).objet))).nombre_colonnes) *
1.1 bertrand 4449: sizeof(real8))) == NULL)
4450: {
4451: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4452: return;
4453: }
4454:
4455: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
4456: .objet))).nombre_lignes; i++)
4457: {
4458: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau[i] =
1.43 bertrand 4459: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
4460: .objet))).nombre_colonnes) * sizeof(real8))) == NULL)
1.1 bertrand 4461: {
4462: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4463: return;
4464: }
4465:
4466: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
4467: .objet))).nombre_colonnes; j++)
4468: {
4469: for(k = 0; k < (*(((struct_matrice *) (*s_objet_argument_2)
4470: .objet))).nombre_colonnes; k++)
4471: {
4472: if ((*s_objet_argument_1).type == MRL)
4473: {
4474: ((real8 *) accumulateur)[k] =
1.43 bertrand 4475: ((real8) ((integer8 **) (*((struct_matrice *)
4476: (*s_objet_argument_2).objet)).tableau)[i][k]) *
1.1 bertrand 4477: ((real8 **) (*((struct_matrice *)
1.43 bertrand 4478: (*s_objet_argument_1).objet)).tableau)[k][j];
1.1 bertrand 4479: }
4480: else
4481: {
4482: ((real8 *) accumulateur)[k] =
1.43 bertrand 4483: ((real8 **) (*((struct_matrice *)
1.1 bertrand 4484: (*s_objet_argument_2).objet)).tableau)[i][k] *
1.43 bertrand 4485: ((real8) ((integer8 **) (*((struct_matrice *)
1.1 bertrand 4486: (*s_objet_argument_1).objet)).tableau)[k][j]);
4487: }
4488: }
4489:
4490: ((real8 **) (*((struct_matrice *)
4491: (*s_objet_resultat).objet)).tableau)[i][j] =
4492: sommation_vecteur_reel(accumulateur,
4493: &((*(((struct_matrice *) (*s_objet_argument_2).objet)))
4494: .nombre_colonnes), &erreur_memoire);
4495:
4496: if (erreur_memoire == d_vrai)
4497: {
4498: (*s_etat_processus).erreur_systeme =
4499: d_es_allocation_memoire;
4500: return;
4501: }
4502: }
4503: }
4504:
4505: free(accumulateur);
4506: }
4507:
4508: /*
4509: * Matrice d'entiers / Matrice de complexes
4510: */
4511:
4512: else if ((((*s_objet_argument_2).type == MIN) &&
4513: ((*s_objet_argument_1).type == MCX)) ||
4514: (((*s_objet_argument_2).type == MCX) &&
4515: ((*s_objet_argument_1).type == MIN)))
4516: {
4517: if ((*((struct_matrice *) (*s_objet_argument_1).objet)).nombre_lignes !=
4518: (*((struct_matrice *) (*s_objet_argument_2).objet))
4519: .nombre_colonnes)
4520: {
4521: liberation(s_etat_processus, s_objet_argument_1);
4522: liberation(s_etat_processus, s_objet_argument_2);
4523:
4524: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
4525: return;
4526: }
4527:
4528: if ((s_objet_resultat = allocation(s_etat_processus, MCX))
4529: == NULL)
4530: {
4531: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4532: return;
4533: }
4534:
4535: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
4536: (*(((struct_matrice *) (*s_objet_argument_2)
4537: .objet))).nombre_lignes;
4538: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
4539: (*(((struct_matrice *) (*s_objet_argument_1)
4540: .objet))).nombre_colonnes;
4541:
4542: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 4543: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
4544: .objet))).nombre_lignes) * sizeof(struct_complexe16 *)))
4545: == NULL)
1.1 bertrand 4546: {
4547: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4548: return;
4549: }
4550:
1.43 bertrand 4551: if ((accumulateur = malloc(((size_t) (*(((struct_matrice *)
4552: (*s_objet_argument_2).objet))).nombre_colonnes) *
1.1 bertrand 4553: sizeof(complex16))) == NULL)
4554: {
4555: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4556: return;
4557: }
4558:
4559: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
4560: .objet))).nombre_lignes; i++)
4561: {
4562: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau[i] =
1.43 bertrand 4563: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
4564: .objet))).nombre_colonnes) * sizeof(struct_complexe16)))
1.1 bertrand 4565: == NULL)
4566: {
4567: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4568: return;
4569: }
4570:
4571: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
4572: .objet))).nombre_colonnes; j++)
4573: {
4574: for(k = 0; k < (*(((struct_matrice *) (*s_objet_argument_2)
4575: .objet))).nombre_colonnes; k++)
4576: {
4577: if ((*s_objet_argument_1).type == MCX)
4578: {
4579: f77multiplicationci_(&(((struct_complexe16 **)
4580: (*((struct_matrice *)(*s_objet_argument_1)
4581: .objet)).tableau)[k][j]), &(((integer8 **)
4582: (*((struct_matrice *) (*s_objet_argument_2)
4583: .objet)).tableau)[i][k]), &(((complex16 *)
4584: accumulateur)[k]));
4585: }
4586: else
4587: {
4588: f77multiplicationci_(&(((struct_complexe16 **)
4589: (*((struct_matrice *)(*s_objet_argument_2)
4590: .objet)).tableau)[i][k]), &(((integer8 **)
4591: (*((struct_matrice *) (*s_objet_argument_1)
4592: .objet)).tableau)[k][j]), &(((complex16 *)
4593: accumulateur)[k]));
4594: }
4595: }
4596:
4597: ((struct_complexe16 **) (*((struct_matrice *)
4598: (*s_objet_resultat).objet)).tableau)[i][j] =
4599: sommation_vecteur_complexe(accumulateur,
4600: &((*(((struct_matrice *) (*s_objet_argument_2).objet)))
4601: .nombre_colonnes), &erreur_memoire);
4602:
4603: if (erreur_memoire == d_vrai)
4604: {
4605: (*s_etat_processus).erreur_systeme =
4606: d_es_allocation_memoire;
4607: return;
4608: }
4609: }
4610: }
4611:
4612: free(accumulateur);
4613: }
4614:
4615: /*
4616: * Matrice de réels / Matrice de réels
4617: */
4618:
4619: else if (((*s_objet_argument_2).type == MRL) &&
4620: ((*s_objet_argument_1).type == MRL))
4621: {
4622: if ((*((struct_matrice *) (*s_objet_argument_1).objet)).nombre_lignes !=
4623: (*((struct_matrice *) (*s_objet_argument_2).objet))
4624: .nombre_colonnes)
4625: {
4626: liberation(s_etat_processus, s_objet_argument_1);
4627: liberation(s_etat_processus, s_objet_argument_2);
4628:
4629: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
4630: return;
4631: }
4632:
4633: if ((s_objet_resultat = allocation(s_etat_processus, MRL))
4634: == NULL)
4635: {
4636: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4637: return;
4638: }
4639:
4640: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
4641: (*(((struct_matrice *) (*s_objet_argument_2)
4642: .objet))).nombre_lignes;
4643: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
4644: (*(((struct_matrice *) (*s_objet_argument_1)
4645: .objet))).nombre_colonnes;
4646:
4647: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 4648: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
4649: .objet))).nombre_lignes) * sizeof(real8 *))) == NULL)
1.1 bertrand 4650: {
4651: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4652: return;
4653: }
4654:
1.43 bertrand 4655: if ((accumulateur = malloc(((size_t) (*(((struct_matrice *)
4656: (*s_objet_argument_2).objet))).nombre_colonnes) *
1.1 bertrand 4657: sizeof(real8))) == NULL)
4658: {
4659: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4660: return;
4661: }
4662:
4663: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
4664: .objet))).nombre_lignes; i++)
4665: {
4666: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau[i] =
1.43 bertrand 4667: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
4668: .objet))).nombre_colonnes) * sizeof(real8))) == NULL)
1.1 bertrand 4669: {
4670: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4671: return;
4672: }
4673:
4674: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
4675: .objet))).nombre_colonnes; j++)
4676: {
4677: for(k = 0; k < (*(((struct_matrice *) (*s_objet_argument_2)
4678: .objet))).nombre_colonnes; k++)
4679: {
4680: ((real8 *) accumulateur)[k] =
4681: (((real8 **) (*((struct_matrice *)
4682: (*s_objet_argument_2).objet)).tableau)[i][k] *
4683: ((real8 **) (*((struct_matrice *)
4684: (*s_objet_argument_1).objet)).tableau)[k][j]);
4685: }
4686:
4687: ((real8 **) (*((struct_matrice *)
4688: (*s_objet_resultat).objet)).tableau)[i][j] =
4689: sommation_vecteur_reel(accumulateur,
4690: &((*(((struct_matrice *) (*s_objet_argument_2).objet)))
4691: .nombre_colonnes), &erreur_memoire);
4692:
4693: if (erreur_memoire == d_vrai)
4694: {
4695: (*s_etat_processus).erreur_systeme =
4696: d_es_allocation_memoire;
4697: return;
4698: }
4699: }
4700: }
4701:
4702: free(accumulateur);
4703: }
4704:
4705: /*
4706: * Matrice de réels / Matrice de complexes
4707: */
4708:
4709: else if ((((*s_objet_argument_2).type == MRL) &&
4710: ((*s_objet_argument_1).type == MCX)) ||
4711: (((*s_objet_argument_2).type == MCX) &&
4712: ((*s_objet_argument_1).type == MRL)))
4713: {
4714: if ((*((struct_matrice *) (*s_objet_argument_1).objet)).nombre_lignes !=
4715: (*((struct_matrice *) (*s_objet_argument_2).objet))
4716: .nombre_colonnes)
4717: {
4718: liberation(s_etat_processus, s_objet_argument_1);
4719: liberation(s_etat_processus, s_objet_argument_2);
4720:
4721: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
4722: return;
4723: }
4724:
4725: if ((s_objet_resultat = allocation(s_etat_processus, MCX))
4726: == NULL)
4727: {
4728: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4729: return;
4730: }
4731:
4732: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
4733: (*(((struct_matrice *) (*s_objet_argument_2)
4734: .objet))).nombre_lignes;
4735: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
4736: (*(((struct_matrice *) (*s_objet_argument_1)
4737: .objet))).nombre_colonnes;
4738:
4739: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 4740: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
4741: .objet))).nombre_lignes) * sizeof(struct_complexe16 *)))
4742: == NULL)
1.1 bertrand 4743: {
4744: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4745: return;
4746: }
4747:
1.43 bertrand 4748: if ((accumulateur = malloc(((size_t) (*(((struct_matrice *)
4749: (*s_objet_argument_2).objet))).nombre_colonnes) *
1.1 bertrand 4750: sizeof(complex16))) == NULL)
4751: {
4752: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4753: return;
4754: }
4755:
4756: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
4757: .objet))).nombre_lignes; i++)
4758: {
4759: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau[i] =
1.43 bertrand 4760: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
4761: .objet))).nombre_colonnes) * sizeof(struct_complexe16)))
1.1 bertrand 4762: == NULL)
4763: {
4764: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4765: return;
4766: }
4767:
4768: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
4769: .objet))).nombre_colonnes; j++)
4770: {
4771: for(k = 0; k < (*(((struct_matrice *) (*s_objet_argument_2)
4772: .objet))).nombre_colonnes; k++)
4773: {
4774: if ((*s_objet_argument_1).type == MCX)
4775: {
4776: f77multiplicationcr_(&(((struct_complexe16 **)
4777: (*((struct_matrice *)(*s_objet_argument_1)
4778: .objet)).tableau)[k][j]), &(((real8 **)
4779: (*((struct_matrice *) (*s_objet_argument_2)
4780: .objet)).tableau)[i][k]), &(((complex16 *)
4781: accumulateur)[k]));
4782: }
4783: else
4784: {
4785: f77multiplicationcr_(&(((struct_complexe16 **)
4786: (*((struct_matrice *)(*s_objet_argument_2)
4787: .objet)).tableau)[i][k]), &(((real8 **)
4788: (*((struct_matrice *) (*s_objet_argument_1)
4789: .objet)).tableau)[k][j]), &(((complex16 *)
4790: accumulateur)[k]));
4791: }
4792: }
4793:
4794: ((struct_complexe16 **) (*((struct_matrice *)
4795: (*s_objet_resultat).objet)).tableau)[i][j] =
4796: sommation_vecteur_complexe(accumulateur,
4797: &((*(((struct_matrice *) (*s_objet_argument_2).objet)))
4798: .nombre_colonnes), &erreur_memoire);
4799:
4800: if (erreur_memoire == d_vrai)
4801: {
4802: (*s_etat_processus).erreur_systeme =
4803: d_es_allocation_memoire;
4804: return;
4805: }
4806: }
4807: }
4808:
4809: free(accumulateur);
4810: }
4811:
4812: /*
4813: * Matrice de complexes / Matrice de complexes
4814: */
4815:
4816: else if (((*s_objet_argument_2).type == MCX) &&
4817: ((*s_objet_argument_1).type == MCX))
4818: {
4819: if ((*((struct_matrice *) (*s_objet_argument_1).objet)).nombre_lignes !=
4820: (*((struct_matrice *) (*s_objet_argument_2).objet))
4821: .nombre_colonnes)
4822: {
4823: liberation(s_etat_processus, s_objet_argument_1);
4824: liberation(s_etat_processus, s_objet_argument_2);
4825:
4826: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
4827: return;
4828: }
4829:
4830: if ((s_objet_resultat = allocation(s_etat_processus, MCX))
4831: == NULL)
4832: {
4833: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4834: return;
4835: }
4836:
4837: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
4838: (*(((struct_matrice *) (*s_objet_argument_2)
4839: .objet))).nombre_lignes;
4840: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
4841: (*(((struct_matrice *) (*s_objet_argument_1)
4842: .objet))).nombre_colonnes;
4843:
4844: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 4845: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
4846: .objet))).nombre_lignes) * sizeof(struct_complexe16 *)))
4847: == NULL)
1.1 bertrand 4848: {
4849: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4850: return;
4851: }
4852:
1.43 bertrand 4853: if ((accumulateur = malloc(((size_t) (*(((struct_matrice *)
4854: (*s_objet_argument_2).objet))).nombre_colonnes) *
1.1 bertrand 4855: sizeof(complex16))) == NULL)
4856: {
4857: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4858: return;
4859: }
4860:
4861: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
4862: .objet))).nombre_lignes; i++)
4863: {
4864: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau[i] =
1.43 bertrand 4865: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
4866: .objet))).nombre_colonnes) * sizeof(struct_complexe16)))
1.1 bertrand 4867: == NULL)
4868: {
4869: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4870: return;
4871: }
4872:
4873: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
4874: .objet))).nombre_colonnes; j++)
4875: {
4876: ((struct_complexe16 **) (*((struct_matrice *)
4877: (*s_objet_resultat).objet)).tableau)[i][j]
4878: .partie_reelle = 0;
4879: ((struct_complexe16 **) (*((struct_matrice *)
4880: (*s_objet_resultat).objet)).tableau)[i][j]
4881: .partie_imaginaire = 0;
4882:
4883: for(k = 0; k < (*(((struct_matrice *) (*s_objet_argument_2)
4884: .objet))).nombre_colonnes; k++)
4885: {
4886: f77multiplicationcc_(&(((struct_complexe16 **)
4887: (*((struct_matrice *)(*s_objet_argument_1)
4888: .objet)).tableau)[k][j]), &(((struct_complexe16 **)
4889: (*((struct_matrice *) (*s_objet_argument_2)
4890: .objet)).tableau)[i][k]), &(((complex16 *)
4891: accumulateur)[k]));
4892: }
4893:
4894: ((struct_complexe16 **) (*((struct_matrice *)
4895: (*s_objet_resultat).objet)).tableau)[i][j] =
4896: sommation_vecteur_complexe(accumulateur,
4897: &((*(((struct_matrice *) (*s_objet_argument_2).objet)))
4898: .nombre_colonnes), &erreur_memoire);
4899:
4900: if (erreur_memoire == d_vrai)
4901: {
4902: (*s_etat_processus).erreur_systeme =
4903: d_es_allocation_memoire;
4904: return;
4905: }
4906: }
4907: }
4908:
4909: free(accumulateur);
4910: }
4911:
4912: /*
4913: --------------------------------------------------------------------------------
4914: Multiplication mettant en oeuvre des binaires
4915: --------------------------------------------------------------------------------
4916: */
4917: /*
4918: * Binaire / Binaire
4919: */
4920:
4921: else if (((*s_objet_argument_1).type == BIN) &&
4922: ((*s_objet_argument_2).type == BIN))
4923: {
4924: if ((s_objet_resultat = allocation(s_etat_processus, BIN))
4925: == NULL)
4926: {
4927: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4928: return;
4929: }
4930:
4931: (*((logical8 *) (*s_objet_resultat).objet)) =
4932: (*((logical8 *) (*s_objet_argument_2).objet))
4933: * (*((logical8 *) (*s_objet_argument_1).objet));
4934: }
4935:
4936: /*
4937: * Binaire / Entier
4938: */
4939:
4940: else if ((((*s_objet_argument_1).type == BIN) &&
4941: ((*s_objet_argument_2).type == INT)) ||
4942: (((*s_objet_argument_1).type == INT) &&
4943: ((*s_objet_argument_2).type == BIN)))
4944: {
4945: if ((s_objet_resultat = allocation(s_etat_processus, BIN))
4946: == NULL)
4947: {
4948: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4949: return;
4950: }
4951:
4952: if ((*s_objet_argument_1).type == BIN)
4953: {
4954: (*((logical8 *) (*s_objet_resultat).objet)) =
1.43 bertrand 4955: ((logical8) (*((integer8 *) (*s_objet_argument_2).objet)))
1.1 bertrand 4956: * (*((logical8 *) (*s_objet_argument_1).objet));
4957: }
4958: else
4959: {
4960: (*((logical8 *) (*s_objet_resultat).objet)) =
4961: (*((logical8 *) (*s_objet_argument_2).objet))
1.43 bertrand 4962: * ((logical8) (*((integer8 *) (*s_objet_argument_1)
4963: .objet)));
1.1 bertrand 4964: }
4965: }
4966:
4967: /*
4968: --------------------------------------------------------------------------------
4969: Multiplication mettant en oeuvre un nom ou une expression algébrique
4970: --------------------------------------------------------------------------------
4971: */
4972: /*
4973: * Nom ou valeur numérique / Nom ou valeur numérique
4974: */
4975:
4976: else if ((((*s_objet_argument_1).type == NOM) &&
4977: (((*s_objet_argument_2).type == NOM) ||
4978: ((*s_objet_argument_2).type == INT) ||
4979: ((*s_objet_argument_2).type == REL) ||
4980: ((*s_objet_argument_2).type == CPL))) ||
4981: (((*s_objet_argument_2).type == NOM) &&
4982: (((*s_objet_argument_1).type == INT) ||
4983: ((*s_objet_argument_1).type == REL) ||
4984: ((*s_objet_argument_1).type == CPL))))
4985: {
4986: drapeau = d_vrai;
4987:
4988: if ((*s_objet_argument_1).type == NOM)
4989: {
4990: if ((*s_objet_argument_2).type == INT)
4991: {
4992: if ((*((integer8 *) (*s_objet_argument_2).objet)) == 0)
4993: {
4994: drapeau = d_faux;
4995:
4996: if ((s_objet_resultat = allocation(s_etat_processus,
4997: INT)) == NULL)
4998: {
4999: (*s_etat_processus).erreur_systeme =
5000: d_es_allocation_memoire;
5001: return;
5002: }
5003:
5004: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
5005: }
5006: else if ((*((integer8 *) (*s_objet_argument_2).objet)) == 1)
5007: {
5008: drapeau = d_faux;
5009:
5010: s_objet_resultat = s_objet_argument_1;
5011: s_objet_argument_1 = NULL;
5012: }
5013: }
5014: else if ((*s_objet_argument_2).type == REL)
5015: {
5016: if ((*((integer8 *) (*s_objet_argument_2).objet)) == 0)
5017: {
5018: drapeau = d_faux;
5019:
5020: if ((s_objet_resultat = allocation(s_etat_processus,
5021: REL)) == NULL)
5022: {
5023: (*s_etat_processus).erreur_systeme =
5024: d_es_allocation_memoire;
5025: return;
5026: }
5027:
5028: (*((real8 *) (*s_objet_resultat).objet)) = 0;
5029: }
5030: else if ((*((real8 *) (*s_objet_argument_2).objet)) == 1)
5031: {
5032: drapeau = d_faux;
5033:
5034: s_objet_resultat = s_objet_argument_1;
5035: s_objet_argument_1 = NULL;
5036: }
5037: }
5038: else if ((*s_objet_argument_2).type == CPL)
5039: {
5040: if (((*((complex16 *) (*s_objet_argument_2).objet))
5041: .partie_reelle == 0) && ((*((complex16 *)
5042: (*s_objet_argument_2).objet)).partie_imaginaire == 0))
5043: {
5044: drapeau = d_faux;
5045:
5046: if ((s_objet_resultat = allocation(s_etat_processus,
5047: CPL)) == NULL)
5048: {
5049: (*s_etat_processus).erreur_systeme =
5050: d_es_allocation_memoire;
5051: return;
5052: }
5053:
5054: (*((complex16 *) (*s_objet_resultat).objet))
5055: .partie_reelle = 0;
5056: (*((complex16 *) (*s_objet_resultat).objet))
5057: .partie_imaginaire = 0;
5058: }
5059: else if (((*((complex16 *) (*s_objet_argument_2).objet))
5060: .partie_reelle == 1) && ((*((complex16 *)
5061: (*s_objet_argument_2).objet)).partie_imaginaire == 0))
5062: {
5063: drapeau = d_faux;
5064:
5065: s_objet_resultat = s_objet_argument_1;
5066: s_objet_argument_1 = NULL;
5067: }
5068: }
5069: }
5070: else if ((*s_objet_argument_2).type == NOM)
5071: {
5072: if ((*s_objet_argument_1).type == INT)
5073: {
5074: if ((*((integer8 *) (*s_objet_argument_1).objet)) == 0)
5075: {
5076: drapeau = d_faux;
5077:
5078: if ((s_objet_resultat = allocation(s_etat_processus,
5079: INT)) == NULL)
5080: {
5081: (*s_etat_processus).erreur_systeme =
5082: d_es_allocation_memoire;
5083: return;
5084: }
5085:
5086: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
5087: }
5088: else if ((*((integer8 *) (*s_objet_argument_1).objet)) == 1)
5089: {
5090: drapeau = d_faux;
5091:
5092: s_objet_resultat = s_objet_argument_2;
5093: s_objet_argument_2 = NULL;
5094: }
5095: }
5096: else if ((*s_objet_argument_1).type == REL)
5097: {
5098: if ((*((integer8 *) (*s_objet_argument_1).objet)) == 0)
5099: {
5100: drapeau = d_faux;
5101:
5102: if ((s_objet_resultat = allocation(s_etat_processus,
5103: REL)) == NULL)
5104: {
5105: (*s_etat_processus).erreur_systeme =
5106: d_es_allocation_memoire;
5107: return;
5108: }
5109:
5110: (*((real8 *) (*s_objet_resultat).objet)) = 0;
5111: }
5112: else if ((*((real8 *) (*s_objet_argument_1).objet)) == 1)
5113: {
5114: drapeau = d_faux;
5115:
5116: s_objet_resultat = s_objet_argument_2;
5117: s_objet_argument_2 = NULL;
5118: }
5119: }
5120: else if ((*s_objet_argument_1).type == CPL)
5121: {
5122: if (((*((complex16 *) (*s_objet_argument_1).objet))
5123: .partie_reelle == 0) && ((*((complex16 *)
5124: (*s_objet_argument_1).objet)).partie_imaginaire == 0))
5125: {
5126: drapeau = d_faux;
5127:
5128: if ((s_objet_resultat = allocation(s_etat_processus,
5129: CPL)) == NULL)
5130: {
5131: (*s_etat_processus).erreur_systeme =
5132: d_es_allocation_memoire;
5133: return;
5134: }
5135:
5136: (*((complex16 *) (*s_objet_resultat).objet))
5137: .partie_reelle = 0;
5138: (*((complex16 *) (*s_objet_resultat).objet))
5139: .partie_imaginaire = 0;
5140: }
5141: else if (((*((complex16 *) (*s_objet_argument_1).objet))
5142: .partie_reelle == 1) && ((*((complex16 *)
5143: (*s_objet_argument_1).objet)).partie_imaginaire == 0))
5144: {
5145: drapeau = d_faux;
5146:
5147: s_objet_resultat = s_objet_argument_2;
5148: s_objet_argument_2 = NULL;
5149: }
5150: }
5151: }
5152:
5153: if (drapeau == d_vrai)
5154: {
5155: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
5156: == NULL)
5157: {
5158: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5159: return;
5160: }
5161:
5162: if (((*s_objet_resultat).objet =
5163: allocation_maillon(s_etat_processus)) == NULL)
5164: {
5165: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5166: return;
5167: }
5168:
5169: l_element_courant = (*s_objet_resultat).objet;
5170:
5171: if (((*l_element_courant).donnee = allocation(s_etat_processus,
5172: FCT)) == NULL)
5173: {
5174: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5175: return;
5176: }
5177:
5178: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
5179: .nombre_arguments = 0;
5180: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
5181: .fonction = instruction_vers_niveau_superieur;
5182:
5183: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
5184: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
5185: {
5186: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5187: return;
5188: }
5189:
5190: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
5191: .nom_fonction, "<<");
5192:
5193: if (((*l_element_courant).suivant =
5194: allocation_maillon(s_etat_processus)) == NULL)
5195: {
5196: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5197: return;
5198: }
5199:
5200: l_element_courant = (*l_element_courant).suivant;
5201: (*l_element_courant).donnee = s_objet_argument_2;
5202:
5203: if (((*l_element_courant).suivant =
5204: allocation_maillon(s_etat_processus)) == NULL)
5205: {
5206: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5207: return;
5208: }
5209:
5210: l_element_courant = (*l_element_courant).suivant;
5211: (*l_element_courant).donnee = s_objet_argument_1;
5212:
5213: if (((*l_element_courant).suivant =
5214: allocation_maillon(s_etat_processus)) == NULL)
5215: {
5216: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5217: return;
5218: }
5219:
5220: l_element_courant = (*l_element_courant).suivant;
5221:
5222: if (((*l_element_courant).donnee = allocation(s_etat_processus,
5223: FCT)) == NULL)
5224: {
5225: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5226: return;
5227: }
5228:
5229: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
5230: .nombre_arguments = 0;
5231: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
5232: .fonction = instruction_multiplication;
5233:
5234: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
5235: .nom_fonction = malloc(2 * sizeof(unsigned char))) == NULL)
5236: {
5237: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5238: return;
5239: }
5240:
5241: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
5242: .nom_fonction, "*");
5243:
5244: if (((*l_element_courant).suivant =
5245: allocation_maillon(s_etat_processus)) == NULL)
5246: {
5247: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5248: return;
5249: }
5250:
5251: l_element_courant = (*l_element_courant).suivant;
5252:
5253: if (((*l_element_courant).donnee =
5254: allocation(s_etat_processus, FCT)) == NULL)
5255: {
5256: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5257: return;
5258: }
5259:
5260: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
5261: .nombre_arguments = 0;
5262: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
5263: .fonction = instruction_vers_niveau_inferieur;
5264:
5265: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
5266: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
5267: {
5268: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5269: return;
5270: }
5271:
5272: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
5273: .nom_fonction, ">>");
5274:
5275: (*l_element_courant).suivant = NULL;
5276:
5277: s_objet_argument_1 = NULL;
5278: s_objet_argument_2 = NULL;
5279: }
5280: }
5281:
5282: /*
5283: * Nom ou valeur numérique / Expression
5284: */
5285:
5286: else if ((((*s_objet_argument_1).type == ALG) ||
5287: ((*s_objet_argument_1).type == RPN)) &&
5288: (((*s_objet_argument_2).type == NOM) ||
5289: ((*s_objet_argument_2).type == INT) ||
5290: ((*s_objet_argument_2).type == REL) ||
5291: ((*s_objet_argument_2).type == CPL)))
5292: {
5293: drapeau = d_vrai;
5294:
5295: nombre_elements = 0;
5296: l_element_courant = (struct_liste_chainee *)
5297: (*s_objet_argument_1).objet;
5298:
5299: while(l_element_courant != NULL)
5300: {
5301: nombre_elements++;
5302: l_element_courant = (*l_element_courant).suivant;
5303: }
5304:
5305: if (nombre_elements == 2)
5306: {
5307: liberation(s_etat_processus, s_objet_argument_1);
5308: liberation(s_etat_processus, s_objet_argument_2);
5309:
5310: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
5311: return;
5312: }
5313:
5314: if ((*s_objet_argument_2).type == INT)
5315: {
5316: if ((*((integer8 *) (*s_objet_argument_2).objet)) == 0)
5317: {
5318: drapeau = d_faux;
5319:
5320: if ((s_objet_resultat = allocation(s_etat_processus, INT))
5321: == NULL)
5322: {
5323: (*s_etat_processus).erreur_systeme =
5324: d_es_allocation_memoire;
5325: return;
5326: }
5327:
5328: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
5329: }
5330: else if ((*((integer8 *) (*s_objet_argument_2).objet)) == 1)
5331: {
5332: drapeau = d_faux;
5333:
5334: s_objet_resultat = s_objet_argument_1;
5335: s_objet_argument_1 = NULL;
5336: }
5337: }
5338: else if ((*s_objet_argument_2).type == REL)
5339: {
5340: if ((*((integer8 *) (*s_objet_argument_2).objet)) == 0)
5341: {
5342: drapeau = d_faux;
5343:
5344: if ((s_objet_resultat = allocation(s_etat_processus, REL))
5345: == NULL)
5346: {
5347: (*s_etat_processus).erreur_systeme =
5348: d_es_allocation_memoire;
5349: return;
5350: }
5351:
5352: (*((real8 *) (*s_objet_resultat).objet)) = 0;
5353: }
5354: else if ((*((real8 *) (*s_objet_argument_2).objet)) == 1)
5355: {
5356: drapeau = d_faux;
5357:
5358: s_objet_resultat = s_objet_argument_1;
5359: s_objet_argument_1 = NULL;
5360: }
5361: }
5362: else if ((*s_objet_argument_2).type == CPL)
5363: {
5364: if (((*((complex16 *) (*s_objet_argument_2).objet))
5365: .partie_reelle == 0) && ((*((complex16 *)
5366: (*s_objet_argument_2).objet)).partie_imaginaire == 0))
5367: {
5368: drapeau = d_faux;
5369:
5370: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
5371: == NULL)
5372: {
5373: (*s_etat_processus).erreur_systeme =
5374: d_es_allocation_memoire;
5375: return;
5376: }
5377:
5378: (*((complex16 *) (*s_objet_resultat).objet))
5379: .partie_reelle = 0;
5380: (*((complex16 *) (*s_objet_resultat).objet))
5381: .partie_imaginaire = 0;
5382: }
5383: else if (((*((complex16 *) (*s_objet_argument_2).objet))
5384: .partie_reelle == 1) && ((*((complex16 *)
5385: (*s_objet_argument_2).objet)).partie_imaginaire == 0))
5386: {
5387: drapeau = d_faux;
5388:
5389: s_objet_resultat = s_objet_argument_1;
5390: s_objet_argument_1 = NULL;
5391: }
5392: }
5393:
5394: if (drapeau == d_vrai)
5395: {
5396: if ((s_objet_resultat = copie_objet(s_etat_processus,
5397: s_objet_argument_1, 'N')) == NULL)
5398: {
5399: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5400: return;
5401: }
5402:
5403: l_element_courant = (struct_liste_chainee *)
5404: (*s_objet_resultat).objet;
5405: l_element_precedent = l_element_courant;
5406: l_element_courant = (*l_element_courant).suivant;
5407:
5408: if (((*l_element_precedent).suivant =
5409: allocation_maillon(s_etat_processus)) == NULL)
5410: {
5411: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5412: return;
5413: }
5414:
5415: (*(*l_element_precedent).suivant).donnee = s_objet_argument_2;
5416: (*(*l_element_precedent).suivant).suivant = l_element_courant;
5417:
5418: while((*l_element_courant).suivant != NULL)
5419: {
5420: l_element_precedent = l_element_courant;
5421: l_element_courant = (*l_element_courant).suivant;
5422: }
5423:
5424: if (((*l_element_precedent).suivant =
5425: allocation_maillon(s_etat_processus)) == NULL)
5426: {
5427: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5428: return;
5429: }
5430:
5431: if (((*(*l_element_precedent).suivant).donnee =
5432: allocation(s_etat_processus, FCT)) == NULL)
5433: {
5434: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5435: return;
5436: }
5437:
5438: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
5439: .donnee).objet)).nombre_arguments = 0;
5440: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
5441: .donnee).objet)).fonction = instruction_multiplication;
5442:
5443: if (((*((struct_fonction *) (*(*(*l_element_precedent)
5444: .suivant).donnee).objet)).nom_fonction =
5445: malloc(2 * sizeof(unsigned char))) == NULL)
5446: {
5447: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5448: return;
5449: }
5450:
5451: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
5452: .suivant).donnee).objet)).nom_fonction, "*");
5453:
5454: (*(*l_element_precedent).suivant).suivant = l_element_courant;
5455:
5456: s_objet_argument_2 = NULL;
5457: }
5458: }
5459:
5460: /*
5461: * Expression / Nom ou valeur numérique
5462: */
5463:
5464: else if ((((*s_objet_argument_1).type == NOM) ||
5465: ((*s_objet_argument_1).type == INT) ||
5466: ((*s_objet_argument_1).type == REL) ||
5467: ((*s_objet_argument_1).type == CPL)) &&
5468: (((*s_objet_argument_2).type == ALG)||
5469: ((*s_objet_argument_2).type == RPN)))
5470: {
5471: drapeau = d_vrai;
5472:
5473: nombre_elements = 0;
5474: l_element_courant = (struct_liste_chainee *)
5475: (*s_objet_argument_2).objet;
5476:
5477: while(l_element_courant != NULL)
5478: {
5479: nombre_elements++;
5480: l_element_courant = (*l_element_courant).suivant;
5481: }
5482:
5483: if (nombre_elements == 2)
5484: {
5485: liberation(s_etat_processus, s_objet_argument_1);
5486: liberation(s_etat_processus, s_objet_argument_2);
5487:
5488: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
5489: return;
5490: }
5491:
5492: if ((*s_objet_argument_1).type == INT)
5493: {
5494: if ((*((integer8 *) (*s_objet_argument_1).objet)) == 0)
5495: {
5496: drapeau = d_faux;
5497:
5498: if ((s_objet_resultat = allocation(s_etat_processus, INT))
5499: == NULL)
5500: {
5501: (*s_etat_processus).erreur_systeme =
5502: d_es_allocation_memoire;
5503: return;
5504: }
5505:
5506: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
5507: }
5508: else if ((*((integer8 *) (*s_objet_argument_1).objet)) == 1)
5509: {
5510: drapeau = d_faux;
5511:
5512: s_objet_resultat = s_objet_argument_2;
5513: s_objet_argument_2 = NULL;
5514: }
5515: }
5516: else if ((*s_objet_argument_1).type == REL)
5517: {
5518: if ((*((integer8 *) (*s_objet_argument_1).objet)) == 0)
5519: {
5520: drapeau = d_faux;
5521:
5522: if ((s_objet_resultat = allocation(s_etat_processus, REL))
5523: == NULL)
5524: {
5525: (*s_etat_processus).erreur_systeme =
5526: d_es_allocation_memoire;
5527: return;
5528: }
5529:
5530: (*((real8 *) (*s_objet_resultat).objet)) = 0;
5531: }
5532: else if ((*((real8 *) (*s_objet_argument_1).objet)) == 1)
5533: {
5534: drapeau = d_faux;
5535:
5536: s_objet_resultat = s_objet_argument_2;
5537: s_objet_argument_2 = NULL;
5538: }
5539: }
5540: else if ((*s_objet_argument_1).type == CPL)
5541: {
5542: if (((*((complex16 *) (*s_objet_argument_1).objet))
5543: .partie_reelle == 0) && ((*((complex16 *)
5544: (*s_objet_argument_1).objet)).partie_imaginaire == 0))
5545: {
5546: drapeau = d_faux;
5547:
5548: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
5549: == NULL)
5550: {
5551: (*s_etat_processus).erreur_systeme =
5552: d_es_allocation_memoire;
5553: return;
5554: }
5555:
5556: (*((complex16 *) (*s_objet_resultat).objet))
5557: .partie_reelle = 0;
5558: (*((complex16 *) (*s_objet_resultat).objet))
5559: .partie_imaginaire = 0;
5560: }
5561: else if (((*((complex16 *) (*s_objet_argument_1).objet))
5562: .partie_reelle == 1) && ((*((complex16 *)
5563: (*s_objet_argument_1).objet)).partie_imaginaire == 0))
5564: {
5565: drapeau = d_faux;
5566:
5567: s_objet_resultat = s_objet_argument_2;
5568: s_objet_argument_2 = NULL;
5569: }
5570: }
5571:
5572: if (drapeau == d_vrai)
5573: {
5574: if ((s_objet_resultat = copie_objet(s_etat_processus,
5575: s_objet_argument_2, 'N')) == NULL)
5576: {
5577: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5578: return;
5579: }
5580:
5581: l_element_courant = (struct_liste_chainee *)
5582: (*s_objet_resultat).objet;
5583: l_element_precedent = l_element_courant;
5584:
5585: while((*l_element_courant).suivant != NULL)
5586: {
5587: l_element_precedent = l_element_courant;
5588: l_element_courant = (*l_element_courant).suivant;
5589: }
5590:
5591: if (((*l_element_precedent).suivant =
5592: allocation_maillon(s_etat_processus)) == NULL)
5593: {
5594: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5595: return;
5596: }
5597:
5598: (*(*l_element_precedent).suivant).donnee = s_objet_argument_1;
5599: l_element_precedent = (*l_element_precedent).suivant;
5600:
5601: if (((*l_element_precedent).suivant =
5602: allocation_maillon(s_etat_processus)) == NULL)
5603: {
5604: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5605: return;
5606: }
5607:
5608: if (((*(*l_element_precedent).suivant).donnee =
5609: allocation(s_etat_processus, FCT)) == NULL)
5610: {
5611: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5612: return;
5613: }
5614:
5615: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
5616: .donnee).objet)).nombre_arguments = 0;
5617: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
5618: .donnee).objet)).fonction = instruction_multiplication;
5619:
5620: if (((*((struct_fonction *) (*(*(*l_element_precedent)
5621: .suivant).donnee).objet)).nom_fonction =
5622: malloc(2 * sizeof(unsigned char))) == NULL)
5623: {
5624: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5625: return;
5626: }
5627:
5628: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
5629: .suivant).donnee).objet)).nom_fonction, "*");
5630:
5631: (*(*l_element_precedent).suivant).suivant = l_element_courant;
5632:
5633: s_objet_argument_1 = NULL;
5634: }
5635: }
5636:
5637: /*
5638: * Expression / Expression
5639: */
5640:
5641: else if ((((*s_objet_argument_1).type == ALG) &&
5642: ((*s_objet_argument_2).type == ALG)) ||
5643: (((*s_objet_argument_1).type == RPN) &&
5644: ((*s_objet_argument_2).type == RPN)))
5645: {
5646: nombre_elements = 0;
5647: l_element_courant = (struct_liste_chainee *)
5648: (*s_objet_argument_1).objet;
5649:
5650: while(l_element_courant != NULL)
5651: {
5652: nombre_elements++;
5653: l_element_courant = (*l_element_courant).suivant;
5654: }
5655:
5656: if (nombre_elements == 2)
5657: {
5658: liberation(s_etat_processus, s_objet_argument_1);
5659: liberation(s_etat_processus, s_objet_argument_2);
5660:
5661: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
5662: return;
5663: }
5664:
5665: nombre_elements = 0;
5666: l_element_courant = (struct_liste_chainee *)
5667: (*s_objet_argument_2).objet;
5668:
5669: while(l_element_courant != NULL)
5670: {
5671: nombre_elements++;
5672: l_element_courant = (*l_element_courant).suivant;
5673: }
5674:
5675: if (nombre_elements == 2)
5676: {
5677: liberation(s_etat_processus, s_objet_argument_1);
5678: liberation(s_etat_processus, s_objet_argument_2);
5679:
5680: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
5681: return;
5682: }
5683:
5684: if ((s_copie_argument_1 = copie_objet(s_etat_processus,
5685: s_objet_argument_1, 'N')) == NULL)
5686: {
5687: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5688: return;
5689: }
5690:
5691: if ((s_copie_argument_2 = copie_objet(s_etat_processus,
5692: s_objet_argument_2, 'N')) == NULL)
5693: {
5694: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5695: return;
5696: }
5697:
5698: l_element_courant = (struct_liste_chainee *)
5699: (*s_copie_argument_1).objet;
5700: (*s_copie_argument_1).objet = (void *) (*((struct_liste_chainee *)
5701: (*s_copie_argument_1).objet)).suivant;
5702:
5703: liberation(s_etat_processus, (*l_element_courant).donnee);
5704: free(l_element_courant);
5705:
5706: l_element_courant = (struct_liste_chainee *)
5707: (*s_copie_argument_2).objet;
5708: l_element_precedent = l_element_courant;
5709: s_objet_resultat = s_copie_argument_2;
5710:
5711: while((*l_element_courant).suivant != NULL)
5712: {
5713: l_element_precedent = l_element_courant;
5714: l_element_courant = (*l_element_courant).suivant;
5715: }
5716:
5717: liberation(s_etat_processus, (*l_element_courant).donnee);
5718: free(l_element_courant);
5719:
5720: (*l_element_precedent).suivant = (struct_liste_chainee *)
5721: (*s_copie_argument_1).objet;
5722: free(s_copie_argument_1);
5723:
5724: l_element_courant = (*l_element_precedent).suivant;
5725: while((*l_element_courant).suivant != NULL)
5726: {
5727: l_element_precedent = l_element_courant;
5728: l_element_courant = (*l_element_courant).suivant;
5729: }
5730:
5731: if (((*l_element_precedent).suivant =
5732: allocation_maillon(s_etat_processus)) == NULL)
5733: {
5734: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5735: return;
5736: }
5737:
5738: (*(*l_element_precedent).suivant).suivant = l_element_courant;
5739: l_element_courant = (*l_element_precedent).suivant;
5740:
5741: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
5742: == NULL)
5743: {
5744: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5745: return;
5746: }
5747:
5748: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
5749: .nombre_arguments = 0;
5750: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
5751: .fonction = instruction_multiplication;
5752:
5753: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
5754: .nom_fonction = malloc(2 * sizeof(unsigned char))) == NULL)
5755: {
5756: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5757: return;
5758: }
5759:
5760: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
5761: .nom_fonction, "*");
5762: }
5763:
5764: /*
5765: --------------------------------------------------------------------------------
5766: Multiplication impossible
5767: --------------------------------------------------------------------------------
5768: */
5769:
5770: else
5771: {
5772: liberation(s_etat_processus, s_objet_argument_1);
5773: liberation(s_etat_processus, s_objet_argument_2);
5774:
5775: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
5776: return;
5777: }
5778:
5779: liberation(s_etat_processus, s_objet_argument_1);
5780: liberation(s_etat_processus, s_objet_argument_2);
5781:
5782: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
5783: s_objet_resultat) == d_erreur)
5784: {
5785: return;
5786: }
5787:
5788: return;
5789: }
5790:
5791:
5792: /*
5793: ================================================================================
5794: Fonction 'mant'
5795: ================================================================================
5796: Entrées :
5797: --------------------------------------------------------------------------------
5798: Sorties :
5799: --------------------------------------------------------------------------------
5800: Effets de bord : néant
5801: ================================================================================
5802: */
5803:
5804: void
5805: instruction_mant(struct_processus *s_etat_processus)
5806: {
5807: real8 base_reelle;
5808: real8 reduction_reelle;
5809:
5810: integer8 base_entiere;
5811: integer8 exposant;
5812: integer8 reduction_entiere;
5813:
5814: struct_liste_chainee *l_element_courant;
5815: struct_liste_chainee *l_element_precedent;
5816:
5817: struct_objet *s_copie_argument;
5818: struct_objet *s_objet_argument;
5819: struct_objet *s_objet_resultat;
5820:
5821: (*s_etat_processus).erreur_execution = d_ex;
5822:
5823: if ((*s_etat_processus).affichage_arguments == 'Y')
5824: {
5825: printf("\n MANT ");
5826:
5827: if ((*s_etat_processus).langue == 'F')
5828: {
5829: printf("(mantisse)\n\n");
5830: }
5831: else
5832: {
5833: printf("(mantissa)\n\n");
5834: }
5835:
5836: printf(" 1: %s, %s\n", d_INT, d_REL);
5837: printf("-> 1: %s\n\n", d_REL);
5838:
5839: printf(" 1: %s, %s\n", d_NOM, d_ALG);
5840: printf("-> 1: %s\n\n", d_ALG);
5841:
5842: printf(" 1: %s\n", d_RPN);
5843: printf("-> 1: %s\n", d_RPN);
5844:
5845: return;
5846: }
5847: else if ((*s_etat_processus).test_instruction == 'Y')
5848: {
5849: (*s_etat_processus).nombre_arguments = 1;
5850: return;
5851: }
5852:
5853: if (test_cfsf(s_etat_processus, 31) == d_vrai)
5854: {
5855: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
5856: {
5857: return;
5858: }
5859: }
5860:
5861: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
5862: &s_objet_argument) == d_erreur)
5863: {
5864: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
5865: return;
5866: }
5867:
5868: /*
5869: --------------------------------------------------------------------------------
5870: Mantisse d'un entier
5871: --------------------------------------------------------------------------------
5872: */
5873:
5874: if ((*s_objet_argument).type == INT)
5875: {
5876: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
5877: {
5878: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5879: return;
5880: }
5881:
1.43 bertrand 5882: exposant = (integer8) floor(log10((real8) (*((integer8 *)
1.1 bertrand 5883: (*s_objet_argument).objet))));
5884:
5885: base_entiere = 10;
5886: f77puissanceii_(&base_entiere, &exposant, &reduction_entiere);
5887:
5888: (*((real8 *) (*s_objet_resultat).objet)) = ((real8)
5889: (*((integer8 *) (*s_objet_argument).objet))) /
1.43 bertrand 5890: ((real8) reduction_entiere);
1.1 bertrand 5891: }
5892:
5893: /*
5894: --------------------------------------------------------------------------------
5895: Mantisse d'un réel
5896: --------------------------------------------------------------------------------
5897: */
5898:
5899: else if ((*s_objet_argument).type == REL)
5900: {
5901: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
5902: {
5903: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5904: return;
5905: }
5906:
5907: exposant = (integer8) floor(log10((*((real8 *)
5908: (*s_objet_argument).objet))));
5909:
5910: base_reelle = 10;
1.37 bertrand 5911: f77puissanceri_(&base_reelle, &exposant, &reduction_reelle);
1.1 bertrand 5912:
5913: (*((real8 *) (*s_objet_resultat).objet)) =
5914: (*((real8 *) (*s_objet_argument).objet)) / reduction_reelle;
5915: }
5916:
5917: /*
5918: --------------------------------------------------------------------------------
5919: Mantisse d'un nom
5920: --------------------------------------------------------------------------------
5921: */
5922:
5923: else if ((*s_objet_argument).type == NOM)
5924: {
5925: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
5926: {
5927: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5928: return;
5929: }
5930:
5931: if (((*s_objet_resultat).objet =
5932: allocation_maillon(s_etat_processus)) == NULL)
5933: {
5934: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5935: return;
5936: }
5937:
5938: l_element_courant = (*s_objet_resultat).objet;
5939:
5940: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
5941: == NULL)
5942: {
5943: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5944: return;
5945: }
5946:
5947: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
5948: .nombre_arguments = 0;
5949: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
5950: .fonction = instruction_vers_niveau_superieur;
5951:
5952: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
5953: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
5954: {
5955: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5956: return;
5957: }
5958:
5959: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
5960: .nom_fonction, "<<");
5961:
5962: if (((*l_element_courant).suivant =
5963: allocation_maillon(s_etat_processus)) == NULL)
5964: {
5965: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5966: return;
5967: }
5968:
5969: l_element_courant = (*l_element_courant).suivant;
5970: (*l_element_courant).donnee = s_objet_argument;
5971:
5972: if (((*l_element_courant).suivant =
5973: allocation_maillon(s_etat_processus)) == NULL)
5974: {
5975: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5976: return;
5977: }
5978:
5979: l_element_courant = (*l_element_courant).suivant;
5980:
5981: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
5982: == NULL)
5983: {
5984: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5985: return;
5986: }
5987:
5988: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
5989: .nombre_arguments = 1;
5990: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
5991: .fonction = instruction_mant;
5992:
5993: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
5994: .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
5995: {
5996: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5997: return;
5998: }
5999:
6000: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
6001: .nom_fonction, "MANT");
6002:
6003: if (((*l_element_courant).suivant =
6004: allocation_maillon(s_etat_processus)) == NULL)
6005: {
6006: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
6007: return;
6008: }
6009:
6010: l_element_courant = (*l_element_courant).suivant;
6011:
6012: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
6013: == NULL)
6014: {
6015: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
6016: return;
6017: }
6018:
6019: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
6020: .nombre_arguments = 0;
6021: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
6022: .fonction = instruction_vers_niveau_inferieur;
6023:
6024: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
6025: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
6026: {
6027: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
6028: return;
6029: }
6030:
6031: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
6032: .nom_fonction, ">>");
6033:
6034: (*l_element_courant).suivant = NULL;
6035: s_objet_argument = NULL;
6036: }
6037:
6038: /*
6039: --------------------------------------------------------------------------------
6040: Mantisse d'une expression
6041: --------------------------------------------------------------------------------
6042: */
6043:
6044: else if (((*s_objet_argument).type == ALG) ||
6045: ((*s_objet_argument).type == RPN))
6046: {
6047: if ((s_copie_argument = copie_objet(s_etat_processus,
6048: s_objet_argument, 'N')) == NULL)
6049: {
6050: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
6051: return;
6052: }
6053:
6054: l_element_courant = (struct_liste_chainee *)
6055: (*s_copie_argument).objet;
6056: l_element_precedent = l_element_courant;
6057:
6058: while((*l_element_courant).suivant != NULL)
6059: {
6060: l_element_precedent = l_element_courant;
6061: l_element_courant = (*l_element_courant).suivant;
6062: }
6063:
6064: if (((*l_element_precedent).suivant =
6065: allocation_maillon(s_etat_processus)) == NULL)
6066: {
6067: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
6068: return;
6069: }
6070:
6071: if (((*(*l_element_precedent).suivant).donnee =
6072: allocation(s_etat_processus, FCT)) == NULL)
6073: {
6074: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
6075: return;
6076: }
6077:
6078: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
6079: .donnee).objet)).nombre_arguments = 1;
6080: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
6081: .donnee).objet)).fonction = instruction_mant;
6082:
6083: if (((*((struct_fonction *) (*(*(*l_element_precedent)
6084: .suivant).donnee).objet)).nom_fonction =
6085: malloc(5 * sizeof(unsigned char))) == NULL)
6086: {
6087: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
6088: return;
6089: }
6090:
6091: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
6092: .suivant).donnee).objet)).nom_fonction, "MANT");
6093:
6094: (*(*l_element_precedent).suivant).suivant = l_element_courant;
6095:
6096: s_objet_resultat = s_copie_argument;
6097: }
6098:
6099: /*
6100: --------------------------------------------------------------------------------
6101: Fonction mantisse impossible à réaliser
6102: --------------------------------------------------------------------------------
6103: */
6104:
6105: else
6106: {
6107: liberation(s_etat_processus, s_objet_argument);
6108:
6109: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
6110: return;
6111: }
6112:
6113: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
6114: s_objet_resultat) == d_erreur)
6115: {
6116: return;
6117: }
6118:
6119: liberation(s_etat_processus, s_objet_argument);
6120:
6121: return;
6122: }
6123:
6124:
6125: /*
6126: ================================================================================
6127: Fonction 'mod'
6128: ================================================================================
6129: Entrées :
6130: --------------------------------------------------------------------------------
6131: Sorties :
6132: --------------------------------------------------------------------------------
6133: Effets de bord : néant
6134: ================================================================================
6135: */
6136:
6137: void
6138: instruction_mod(struct_processus *s_etat_processus)
6139: {
6140: struct_liste_chainee *l_element_courant;
6141: struct_liste_chainee *l_element_precedent;
6142:
6143: struct_objet *s_copie_argument_1;
6144: struct_objet *s_copie_argument_2;
6145: struct_objet *s_objet_argument_1;
6146: struct_objet *s_objet_argument_2;
6147: struct_objet *s_objet_resultat;
6148:
1.43 bertrand 6149: integer8 i;
6150: integer8 j;
6151: integer8 nombre_elements;
1.1 bertrand 6152:
6153: (*s_etat_processus).erreur_execution = d_ex;
6154:
6155: if ((*s_etat_processus).affichage_arguments == 'Y')
6156: {
6157: printf("\n MOD ");
6158:
6159: if ((*s_etat_processus).langue == 'F')
6160: {
6161: printf("(modulo)\n\n");
6162: }
6163: else
6164: {
6165: printf("(modulo)\n\n");
6166: }
6167:
6168: printf(" 2: %s, %s\n", d_INT, d_REL);
6169: printf(" 1: %s, %s\n", d_INT, d_REL);
6170: printf("-> 1: %s, %s\n\n", d_INT, d_REL);
6171:
6172: printf(" 2: %s, %s, %s, %s, %s, %s\n",
6173: d_INT, d_REL, d_CPL, d_NOM, d_ALG, d_RPN);
6174: printf(" 1: %s, %s, %s, %s, %s, %s\n",
6175: d_INT, d_REL, d_CPL, d_NOM, d_ALG, d_RPN);
6176: printf("-> 1: %s, %s\n", d_ALG, d_RPN);
6177:
6178: return;
6179: }
6180: else if ((*s_etat_processus).test_instruction == 'Y')
6181: {
6182: (*s_etat_processus).nombre_arguments = 2;
6183: return;
6184: }
6185:
6186: if (test_cfsf(s_etat_processus, 31) == d_vrai)
6187: {
6188: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
6189: {
6190: return;
6191: }
6192: }
6193:
6194: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
6195: &s_objet_argument_1) == d_erreur)
6196: {
6197: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
6198: return;
6199: }
6200:
6201: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
6202: &s_objet_argument_2) == d_erreur)
6203: {
6204: liberation(s_etat_processus, s_objet_argument_1);
6205:
6206: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
6207: return;
6208: }
6209:
6210: /*
6211: --------------------------------------------------------------------------------
6212: MOD portant sur des valeurs numériques
6213: --------------------------------------------------------------------------------
6214: */
6215:
6216: if ((((*s_objet_argument_1).type == INT) ||
6217: ((*s_objet_argument_1).type == REL)) &&
6218: (((*s_objet_argument_2).type == INT) ||
6219: ((*s_objet_argument_2).type == REL)))
6220: {
6221: if ((*s_objet_argument_1).type == INT)
6222: {
6223: if ((*s_objet_argument_2).type == INT)
6224: {
6225: if ((s_objet_resultat = allocation(s_etat_processus, INT))
6226: == NULL)
6227: {
6228: (*s_etat_processus).erreur_systeme =
6229: d_es_allocation_memoire;
6230: return;
6231: }
6232:
6233: (*((integer8 *) (*s_objet_resultat).objet)) =
6234: (*((integer8 *) (*s_objet_argument_2).objet)) -
6235: ((*((integer8 *) (*s_objet_argument_1).objet)) *
1.43 bertrand 6236: ((integer8) floor(((real8) (*((integer8 *)
6237: (*s_objet_argument_2).objet))) / ((real8)
6238: (*((integer8 *) (*s_objet_argument_1).objet))))));
1.1 bertrand 6239: }
6240: else
6241: {
6242: if ((s_objet_resultat = allocation(s_etat_processus, REL))
6243: == NULL)
6244: {
6245: (*s_etat_processus).erreur_systeme =
6246: d_es_allocation_memoire;
6247: return;
6248: }
6249:
6250: (*((real8 *) (*s_objet_resultat).objet)) =
6251: (*((real8 *) (*s_objet_argument_2).objet)) -
1.43 bertrand 6252: ((real8) (*((integer8 *) (*s_objet_argument_1).objet)) *
1.1 bertrand 6253: floor((*((real8 *) (*s_objet_argument_2)
6254: .objet)) / ((real8) (*((integer8 *)
6255: (*s_objet_argument_1).objet)))));
6256: }
6257: }
6258: else
6259: {
6260: if ((*s_objet_argument_2).type == INT)
6261: {
6262: if ((s_objet_resultat = allocation(s_etat_processus, REL))
6263: == NULL)
6264: {
6265: (*s_etat_processus).erreur_systeme =
6266: d_es_allocation_memoire;
6267: return;
6268: }
6269:
1.43 bertrand 6270: (*((real8 *) (*s_objet_resultat).objet)) = ((real8)
6271: (*((integer8 *) (*s_objet_argument_2).objet))) -
1.1 bertrand 6272: ((*((real8 *) (*s_objet_argument_1).objet)) *
6273: floor(((real8) (*((integer8 *) (*s_objet_argument_2)
6274: .objet))) / (*((real8 *)
6275: (*s_objet_argument_1).objet))));
6276: }
6277: else
6278: {
6279: if ((s_objet_resultat = allocation(s_etat_processus, REL))
6280: == NULL)
6281: {
6282: (*s_etat_processus).erreur_systeme =
6283: d_es_allocation_memoire;
6284: return;
6285: }
6286:
6287: (*((real8 *) (*s_objet_resultat).objet)) =
6288: (*((real8 *) (*s_objet_argument_2).objet)) -
6289: ((*((real8 *) (*s_objet_argument_1).objet)) *
6290: floor((*((real8 *) (*s_objet_argument_2)
6291: .objet)) / (*((real8 *)
6292: (*s_objet_argument_1).objet))));
6293: }
6294: }
6295: }
6296:
6297: /*
6298: --------------------------------------------------------------------------------
6299: MOD portant sur des vecteurs
6300: --------------------------------------------------------------------------------
6301: */
6302:
6303: else if ((((*s_objet_argument_1).type == INT) ||
6304: ((*s_objet_argument_1).type == REL)) &&
6305: (((*s_objet_argument_2).type == VIN) ||
6306: ((*s_objet_argument_2).type == VRL)))
6307: {
6308: if ((*s_objet_argument_1).type == INT)
6309: {
6310: if ((*s_objet_argument_2).type == VIN)
6311: {
6312: if ((s_objet_resultat = allocation(s_etat_processus, VIN))
6313: == NULL)
6314: {
6315: (*s_etat_processus).erreur_systeme =
6316: d_es_allocation_memoire;
6317: return;
6318: }
6319:
6320: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
6321: (*((struct_vecteur *) (*s_objet_argument_2).objet))
6322: .taille;
6323:
6324: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 6325: malloc(((size_t) (*((struct_vecteur *)
6326: (*s_objet_resultat).objet)).taille) * sizeof(integer8)))
6327: == NULL)
1.1 bertrand 6328: {
6329: (*s_etat_processus).erreur_systeme =
6330: d_es_allocation_memoire;
6331: return;
6332: }
6333:
6334: for(i = 0; i < (*((struct_vecteur *) (*s_objet_resultat).objet))
6335: .taille; i++)
6336: {
6337: ((integer8 *) (*((struct_vecteur *) (*s_objet_resultat)
6338: .objet)).tableau)[i] = ((integer8 *)
6339: (*((struct_vecteur *) (*s_objet_argument_2).objet))
6340: .tableau)[i] - ((*((integer8 *)
1.43 bertrand 6341: (*s_objet_argument_1).objet)) * ((integer8)
6342: floor(((real8) ((integer8 *) (*((struct_vecteur *)
1.1 bertrand 6343: (*s_objet_argument_2).objet)).tableau)[i]) /
6344: ((real8) (*((integer8 *) (*s_objet_argument_1)
1.43 bertrand 6345: .objet))))));
1.1 bertrand 6346: }
6347: }
6348: else
6349: {
6350: if ((s_objet_resultat = allocation(s_etat_processus, VRL))
6351: == NULL)
6352: {
6353: (*s_etat_processus).erreur_systeme =
6354: d_es_allocation_memoire;
6355: return;
6356: }
6357:
6358: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
6359: (*((struct_vecteur *) (*s_objet_argument_2).objet))
6360: .taille;
6361:
6362: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 6363: malloc(((size_t) (*((struct_vecteur *)
6364: (*s_objet_resultat).objet)).taille) * sizeof(real8)))
6365: == NULL)
1.1 bertrand 6366: {
6367: (*s_etat_processus).erreur_systeme =
6368: d_es_allocation_memoire;
6369: return;
6370: }
6371:
6372: for(i = 0; i < (*((struct_vecteur *) (*s_objet_resultat).objet))
6373: .taille; i++)
6374: {
6375: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat)
6376: .objet)).tableau)[i] = ((real8 *)
6377: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1.43 bertrand 6378: .tableau)[i] - ((real8) (*((integer8 *)
1.1 bertrand 6379: (*s_objet_argument_1).objet)) * floor(
6380: ((real8 *) (*((struct_vecteur *)
6381: (*s_objet_argument_2).objet)).tableau)[i] /
6382: ((real8) (*((integer8 *) (*s_objet_argument_1)
6383: .objet)))));
6384: }
6385: }
6386: }
6387: else
6388: {
6389: if ((*s_objet_argument_2).type == VIN)
6390: {
6391: if ((s_objet_resultat = allocation(s_etat_processus, VRL))
6392: == NULL)
6393: {
6394: (*s_etat_processus).erreur_systeme =
6395: d_es_allocation_memoire;
6396: return;
6397: }
6398:
6399: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
6400: (*((struct_vecteur *) (*s_objet_argument_2).objet))
6401: .taille;
6402:
6403: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 6404: malloc(((size_t) (*((struct_vecteur *)
6405: (*s_objet_resultat).objet)).taille) * sizeof(real8)))
6406: == NULL)
1.1 bertrand 6407: {
6408: (*s_etat_processus).erreur_systeme =
6409: d_es_allocation_memoire;
6410: return;
6411: }
6412:
6413: for(i = 0; i < (*((struct_vecteur *) (*s_objet_resultat).objet))
6414: .taille; i++)
6415: {
6416: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat)
1.43 bertrand 6417: .objet)).tableau)[i] = ((real8) ((integer8 *)
1.1 bertrand 6418: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1.43 bertrand 6419: .tableau)[i]) - ((*((real8 *)
1.1 bertrand 6420: (*s_objet_argument_1).objet)) * floor(((real8)
6421: ((integer8 *) (*((struct_vecteur *)
6422: (*s_objet_argument_2).objet)).tableau)[i]) /
6423: (*((real8 *) (*s_objet_argument_1)
6424: .objet))));
6425: }
6426: }
6427: else
6428: {
6429: if ((s_objet_resultat = allocation(s_etat_processus, VRL))
6430: == NULL)
6431: {
6432: (*s_etat_processus).erreur_systeme =
6433: d_es_allocation_memoire;
6434: return;
6435: }
6436:
6437: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
6438: (*((struct_vecteur *) (*s_objet_argument_2).objet))
6439: .taille;
6440:
6441: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 6442: malloc(((size_t) (*((struct_vecteur *)
6443: (*s_objet_resultat).objet)).taille) * sizeof(real8)))
6444: == NULL)
1.1 bertrand 6445: {
6446: (*s_etat_processus).erreur_systeme =
6447: d_es_allocation_memoire;
6448: return;
6449: }
6450:
6451: for(i = 0; i < (*((struct_vecteur *) (*s_objet_resultat).objet))
6452: .taille; i++)
6453: {
6454: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat)
6455: .objet)).tableau)[i] = ((real8 *)
6456: (*((struct_vecteur *) (*s_objet_argument_2).objet))
6457: .tableau)[i] - ((*((real8 *)
6458: (*s_objet_argument_1).objet)) * floor(
6459: ((real8 *) (*((struct_vecteur *)
6460: (*s_objet_argument_2).objet)).tableau)[i] /
6461: (*((real8 *) (*s_objet_argument_1)
6462: .objet))));
6463: }
6464: }
6465: }
6466: }
6467:
6468: /*
6469: --------------------------------------------------------------------------------
6470: MOD portant sur des matrices
6471: --------------------------------------------------------------------------------
6472: */
6473:
6474: else if ((((*s_objet_argument_1).type == INT) ||
6475: ((*s_objet_argument_1).type == REL)) &&
6476: (((*s_objet_argument_2).type == MIN) ||
6477: ((*s_objet_argument_2).type == MRL)))
6478: {
6479: if ((*s_objet_argument_1).type == INT)
6480: {
6481: if ((*s_objet_argument_2).type == MIN)
6482: {
6483: if ((s_objet_resultat = allocation(s_etat_processus, MIN))
6484: == NULL)
6485: {
6486: (*s_etat_processus).erreur_systeme =
6487: d_es_allocation_memoire;
6488: return;
6489: }
6490:
6491: (*((struct_matrice *) (*s_objet_resultat).objet))
6492: .nombre_lignes = (*((struct_matrice *)
6493: (*s_objet_argument_2).objet)).nombre_lignes;
6494: (*((struct_matrice *) (*s_objet_resultat).objet))
6495: .nombre_colonnes = (*((struct_matrice *)
6496: (*s_objet_argument_2).objet)).nombre_colonnes;
6497:
6498: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 6499: malloc(((size_t) (*((struct_matrice *)
6500: (*s_objet_resultat).objet)).nombre_lignes) *
6501: sizeof(integer8 *))) == NULL)
1.1 bertrand 6502: {
6503: (*s_etat_processus).erreur_systeme =
6504: d_es_allocation_memoire;
6505: return;
6506: }
6507:
6508: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
6509: .nombre_lignes; i++)
6510: {
6511: if ((((integer8 **) (*((struct_matrice *)
6512: (*s_objet_resultat).objet)).tableau)[i] =
1.43 bertrand 6513: malloc(((size_t) (*((struct_matrice *)
6514: (*s_objet_resultat).objet)).nombre_colonnes)
6515: * sizeof(integer8))) == NULL)
1.1 bertrand 6516: {
6517: (*s_etat_processus).erreur_systeme =
6518: d_es_allocation_memoire;
6519: return;
6520: }
6521:
6522: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat)
6523: .objet)).nombre_colonnes; j++)
6524: {
6525: ((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
6526: .objet)).tableau)[i][j] = ((integer8 **)
6527: (*((struct_matrice *) (*s_objet_argument_2)
6528: .objet)).tableau)[i][j] - ((*((integer8 *)
1.43 bertrand 6529: (*s_objet_argument_1).objet)) *
6530: ((integer8) floor(((real8)
1.1 bertrand 6531: ((integer8 **) (*((struct_matrice *)
6532: (*s_objet_argument_2).objet)).tableau)[i][j]) /
6533: ((real8) (*((integer8 *) (*s_objet_argument_1)
1.43 bertrand 6534: .objet))))));
1.1 bertrand 6535: }
6536: }
6537: }
6538: else
6539: {
6540: if ((s_objet_resultat = allocation(s_etat_processus, MRL))
6541: == NULL)
6542: {
6543: (*s_etat_processus).erreur_systeme =
6544: d_es_allocation_memoire;
6545: return;
6546: }
6547:
6548: (*((struct_matrice *) (*s_objet_resultat).objet))
6549: .nombre_lignes = (*((struct_matrice *)
6550: (*s_objet_argument_2).objet)).nombre_lignes;
6551: (*((struct_matrice *) (*s_objet_resultat).objet))
6552: .nombre_colonnes = (*((struct_matrice *)
6553: (*s_objet_argument_2).objet)).nombre_colonnes;
6554:
6555: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 6556: malloc(((size_t) (*((struct_matrice *)
6557: (*s_objet_resultat).objet)).nombre_lignes) *
6558: sizeof(real8 *))) == NULL)
1.1 bertrand 6559: {
6560: (*s_etat_processus).erreur_systeme =
6561: d_es_allocation_memoire;
6562: return;
6563: }
6564:
6565: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
6566: .nombre_lignes; i++)
6567: {
6568: if ((((real8 **) (*((struct_matrice *)
6569: (*s_objet_resultat).objet)).tableau)[i] =
1.43 bertrand 6570: malloc(((size_t) (*((struct_matrice *)
6571: (*s_objet_resultat).objet)).nombre_colonnes) *
6572: sizeof(real8))) == NULL)
1.1 bertrand 6573: {
6574: (*s_etat_processus).erreur_systeme =
6575: d_es_allocation_memoire;
6576: return;
6577: }
6578:
6579: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat)
6580: .objet)).nombre_colonnes; j++)
6581: {
6582: ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
6583: .objet)).tableau)[i][j] = ((real8 **)
6584: (*((struct_matrice *) (*s_objet_argument_2)
1.43 bertrand 6585: .objet)).tableau)[i][j] -
6586: ((real8) (*((integer8 *)
1.1 bertrand 6587: (*s_objet_argument_1).objet)) * floor(
6588: ((real8 **) (*((struct_matrice *)
6589: (*s_objet_argument_2).objet)).tableau)[i][j] /
6590: ((real8) (*((integer8 *) (*s_objet_argument_1)
6591: .objet)))));
6592: }
6593: }
6594: }
6595: }
6596: else
6597: {
6598: if ((*s_objet_argument_2).type == MIN)
6599: {
6600: if ((s_objet_resultat = allocation(s_etat_processus, MRL))
6601: == NULL)
6602: {
6603: (*s_etat_processus).erreur_systeme =
6604: d_es_allocation_memoire;
6605: return;
6606: }
6607:
6608: (*((struct_matrice *) (*s_objet_resultat).objet))
6609: .nombre_lignes = (*((struct_matrice *)
6610: (*s_objet_argument_2).objet)).nombre_lignes;
6611: (*((struct_matrice *) (*s_objet_resultat).objet))
6612: .nombre_colonnes = (*((struct_matrice *)
6613: (*s_objet_argument_2).objet)).nombre_colonnes;
6614:
6615: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 6616: malloc(((size_t) (*((struct_matrice *)
6617: (*s_objet_resultat).objet)).nombre_lignes) *
6618: sizeof(real8 *))) == NULL)
1.1 bertrand 6619: {
6620: (*s_etat_processus).erreur_systeme =
6621: d_es_allocation_memoire;
6622: return;
6623: }
6624:
6625: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
6626: .nombre_lignes; i++)
6627: {
6628: if ((((real8 **) (*((struct_matrice *)
6629: (*s_objet_resultat).objet)).tableau)[i] =
1.43 bertrand 6630: malloc(((size_t) (*((struct_matrice *)
6631: (*s_objet_resultat).objet)).nombre_colonnes)
6632: * sizeof(real8))) == NULL)
1.1 bertrand 6633: {
6634: (*s_etat_processus).erreur_systeme =
6635: d_es_allocation_memoire;
6636: return;
6637: }
6638:
6639: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat)
6640: .objet)).nombre_colonnes; j++)
6641: {
6642: ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
1.43 bertrand 6643: .objet)).tableau)[i][j] = ((real8)
6644: ((integer8 **) (*((struct_matrice *)
6645: (*s_objet_argument_2).objet)).tableau)[i][j])
6646: - ((*((real8 *) (*s_objet_argument_1).objet)) *
6647: floor(((real8) ((integer8 **)
1.1 bertrand 6648: (*((struct_matrice *) (*s_objet_argument_2)
1.43 bertrand 6649: .objet)).tableau)[i][j]) / (*((real8 *)
6650: (*s_objet_argument_1).objet))));
1.1 bertrand 6651: }
6652: }
6653: }
6654: else
6655: {
6656: if ((s_objet_resultat = allocation(s_etat_processus, MRL))
6657: == NULL)
6658: {
6659: (*s_etat_processus).erreur_systeme =
6660: d_es_allocation_memoire;
6661: return;
6662: }
6663:
6664: (*((struct_matrice *) (*s_objet_resultat).objet))
6665: .nombre_lignes = (*((struct_matrice *)
6666: (*s_objet_argument_2).objet)).nombre_lignes;
6667: (*((struct_matrice *) (*s_objet_resultat).objet))
6668: .nombre_colonnes = (*((struct_matrice *)
6669: (*s_objet_argument_2).objet)).nombre_colonnes;
6670:
6671: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 6672: malloc(((size_t) (*((struct_matrice *)
6673: (*s_objet_resultat).objet)).nombre_lignes) *
6674: sizeof(real8 *))) == NULL)
1.1 bertrand 6675: {
6676: (*s_etat_processus).erreur_systeme =
6677: d_es_allocation_memoire;
6678: return;
6679: }
6680:
6681: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
6682: .nombre_lignes; i++)
6683: {
6684: if ((((real8 **) (*((struct_matrice *)
6685: (*s_objet_resultat).objet)).tableau)[i] =
1.43 bertrand 6686: malloc(((size_t) (*((struct_matrice *)
6687: (*s_objet_resultat).objet)).nombre_colonnes) *
6688: sizeof(real8))) == NULL)
1.1 bertrand 6689: {
6690: (*s_etat_processus).erreur_systeme =
6691: d_es_allocation_memoire;
6692: return;
6693: }
6694:
6695: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat)
6696: .objet)).nombre_colonnes; j++)
6697: {
6698: ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
6699: .objet)).tableau)[i][j] = ((real8 **)
6700: (*((struct_matrice *) (*s_objet_argument_2)
6701: .objet)).tableau)[i][j] - ((*((real8 *)
6702: (*s_objet_argument_1).objet)) * floor(
6703: ((real8 **) (*((struct_matrice *)
6704: (*s_objet_argument_2).objet)).tableau)[i][j] /
6705: (*((real8 *) (*s_objet_argument_1)
6706: .objet))));
6707: }
6708: }
6709: }
6710: }
6711: }
6712:
6713: /*
6714: --------------------------------------------------------------------------------
6715: MOD entre des arguments complexes
6716: --------------------------------------------------------------------------------
6717: */
6718:
6719: /*
6720: * Nom ou valeur numérique / Nom ou valeur numérique
6721: */
6722:
6723: else if ((((*s_objet_argument_1).type == NOM) &&
6724: (((*s_objet_argument_2).type == NOM) ||
6725: ((*s_objet_argument_2).type == INT) ||
6726: ((*s_objet_argument_2).type == REL))) ||
6727: (((*s_objet_argument_2).type == NOM) &&
6728: (((*s_objet_argument_1).type == INT) ||
6729: ((*s_objet_argument_1).type == REL))))
6730: {
6731: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
6732: {
6733: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
6734: return;
6735: }
6736:
6737: if (((*s_objet_resultat).objet =
6738: allocation_maillon(s_etat_processus)) == NULL)
6739: {
6740: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
6741: return;
6742: }
6743:
6744: l_element_courant = (*s_objet_resultat).objet;
6745:
6746: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
6747: == NULL)
6748: {
6749: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
6750: return;
6751: }
6752:
6753: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
6754: .nombre_arguments = 0;
6755: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
6756: .fonction = instruction_vers_niveau_superieur;
6757:
6758: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
6759: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
6760: {
6761: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
6762: return;
6763: }
6764:
6765: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
6766: .nom_fonction, "<<");
6767:
6768: if (((*l_element_courant).suivant =
6769: allocation_maillon(s_etat_processus)) == NULL)
6770: {
6771: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
6772: return;
6773: }
6774:
6775: l_element_courant = (*l_element_courant).suivant;
6776: (*l_element_courant).donnee = s_objet_argument_2;
6777:
6778: if (((*l_element_courant).suivant =
6779: allocation_maillon(s_etat_processus)) == NULL)
6780: {
6781: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
6782: return;
6783: }
6784:
6785: l_element_courant = (*l_element_courant).suivant;
6786: (*l_element_courant).donnee = s_objet_argument_1;
6787:
6788: if (((*l_element_courant).suivant =
6789: allocation_maillon(s_etat_processus)) == NULL)
6790: {
6791: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
6792: return;
6793: }
6794:
6795: l_element_courant = (*l_element_courant).suivant;
6796:
6797: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
6798: == NULL)
6799: {
6800: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
6801: return;
6802: }
6803:
6804: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
6805: .nombre_arguments = 2;
6806: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
6807: .fonction = instruction_mod;
6808:
6809: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
6810: .nom_fonction = malloc(4 * sizeof(unsigned char))) == NULL)
6811: {
6812: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
6813: return;
6814: }
6815:
6816: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
6817: .nom_fonction, "MOD");
6818:
6819: if (((*l_element_courant).suivant =
6820: allocation_maillon(s_etat_processus)) == NULL)
6821: {
6822: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
6823: return;
6824: }
6825:
6826: l_element_courant = (*l_element_courant).suivant;
6827:
6828: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
6829: == NULL)
6830: {
6831: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
6832: return;
6833: }
6834:
6835: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
6836: .nombre_arguments = 0;
6837: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
6838: .fonction = instruction_vers_niveau_inferieur;
6839:
6840: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
6841: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
6842: {
6843: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
6844: return;
6845: }
6846:
6847: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
6848: .nom_fonction, ">>");
6849:
6850: (*l_element_courant).suivant = NULL;
6851:
6852: s_objet_argument_1 = NULL;
6853: s_objet_argument_2 = NULL;
6854: }
6855:
6856: /*
6857: * Nom ou valeur numérique / Expression
6858: */
6859:
6860: else if (((((*s_objet_argument_1).type == ALG) ||
6861: ((*s_objet_argument_1).type == RPN))) &&
6862: (((*s_objet_argument_2).type == NOM) ||
6863: ((*s_objet_argument_2).type == INT) ||
6864: ((*s_objet_argument_2).type == REL)))
6865: {
6866: nombre_elements = 0;
6867: l_element_courant = (struct_liste_chainee *)
6868: (*s_objet_argument_1).objet;
6869:
6870: while(l_element_courant != NULL)
6871: {
6872: nombre_elements++;
6873: l_element_courant = (*l_element_courant).suivant;
6874: }
6875:
6876: if (nombre_elements == 2)
6877: {
6878: liberation(s_etat_processus, s_objet_argument_1);
6879: liberation(s_etat_processus, s_objet_argument_2);
6880:
6881: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
6882: return;
6883: }
6884:
6885: if ((s_objet_resultat = copie_objet(s_etat_processus,
6886: s_objet_argument_1, 'N')) == NULL)
6887: {
6888: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
6889: return;
6890: }
6891:
6892: l_element_courant = (struct_liste_chainee *)
6893: (*s_objet_resultat).objet;
6894: l_element_precedent = l_element_courant;
6895: l_element_courant = (*l_element_courant).suivant;
6896:
6897: if (((*l_element_precedent).suivant =
6898: allocation_maillon(s_etat_processus)) == NULL)
6899: {
6900: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
6901: return;
6902: }
6903:
6904: (*(*l_element_precedent).suivant).donnee = s_objet_argument_2;
6905: (*(*l_element_precedent).suivant).suivant = l_element_courant;
6906:
6907: while((*l_element_courant).suivant != NULL)
6908: {
6909: l_element_precedent = l_element_courant;
6910: l_element_courant = (*l_element_courant).suivant;
6911: }
6912:
6913: if (((*l_element_precedent).suivant =
6914: allocation_maillon(s_etat_processus)) == NULL)
6915: {
6916: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
6917: return;
6918: }
6919:
6920: if (((*(*l_element_precedent).suivant).donnee =
6921: allocation(s_etat_processus, FCT)) == NULL)
6922: {
6923: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
6924: return;
6925: }
6926:
6927: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
6928: .donnee).objet)).nombre_arguments = 2;
6929: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
6930: .donnee).objet)).fonction = instruction_mod;
6931:
6932: if (((*((struct_fonction *) (*(*(*l_element_precedent)
6933: .suivant).donnee).objet)).nom_fonction =
6934: malloc(4 * sizeof(unsigned char))) == NULL)
6935: {
6936: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
6937: return;
6938: }
6939:
6940: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
6941: .suivant).donnee).objet)).nom_fonction, "MOD");
6942:
6943: (*(*l_element_precedent).suivant).suivant = l_element_courant;
6944:
6945: s_objet_argument_2 = NULL;
6946: }
6947:
6948: /*
6949: * Expression / Nom ou valeur numérique
6950: */
6951:
6952: else if ((((*s_objet_argument_1).type == NOM) ||
6953: ((*s_objet_argument_1).type == INT) ||
6954: ((*s_objet_argument_1).type == REL)) &&
6955: ((((*s_objet_argument_2).type == ALG) ||
6956: ((*s_objet_argument_2).type == RPN))))
6957: {
6958: nombre_elements = 0;
6959: l_element_courant = (struct_liste_chainee *)
6960: (*s_objet_argument_2).objet;
6961:
6962: while(l_element_courant != NULL)
6963: {
6964: nombre_elements++;
6965: l_element_courant = (*l_element_courant).suivant;
6966: }
6967:
6968: if (nombre_elements == 2)
6969: {
6970: liberation(s_etat_processus, s_objet_argument_1);
6971: liberation(s_etat_processus, s_objet_argument_2);
6972:
6973: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
6974: return;
6975: }
6976:
6977: if ((s_objet_resultat = copie_objet(s_etat_processus,
6978: s_objet_argument_2, 'N')) == NULL)
6979: {
6980: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
6981: return;
6982: }
6983:
6984: l_element_courant = (struct_liste_chainee *)
6985: (*s_objet_resultat).objet;
6986: l_element_precedent = l_element_courant;
6987:
6988: while((*l_element_courant).suivant != NULL)
6989: {
6990: l_element_precedent = l_element_courant;
6991: l_element_courant = (*l_element_courant).suivant;
6992: }
6993:
6994: if (((*l_element_precedent).suivant =
6995: allocation_maillon(s_etat_processus)) == NULL)
6996: {
6997: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
6998: return;
6999: }
7000:
7001: (*(*l_element_precedent).suivant).donnee = s_objet_argument_1;
7002: l_element_precedent = (*l_element_precedent).suivant;
7003:
7004: if (((*l_element_precedent).suivant =
7005: allocation_maillon(s_etat_processus)) == NULL)
7006: {
7007: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
7008: return;
7009: }
7010:
7011: if (((*(*l_element_precedent).suivant).donnee =
7012: allocation(s_etat_processus, FCT)) == NULL)
7013: {
7014: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
7015: return;
7016: }
7017:
7018: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
7019: .donnee).objet)).nombre_arguments = 2;
7020: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
7021: .donnee).objet)).fonction = instruction_mod;
7022:
7023: if (((*((struct_fonction *) (*(*(*l_element_precedent)
7024: .suivant).donnee).objet)).nom_fonction =
7025: malloc(4 * sizeof(unsigned char))) == NULL)
7026: {
7027: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
7028: return;
7029: }
7030:
7031: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
7032: .suivant).donnee).objet)).nom_fonction, "MOD");
7033:
7034: (*(*l_element_precedent).suivant).suivant = l_element_courant;
7035:
7036: s_objet_argument_1 = NULL;
7037: }
7038:
7039: /*
7040: * Expression / Expression
7041: */
7042:
7043: else if ((((*s_objet_argument_1).type == ALG) &&
7044: ((*s_objet_argument_2).type == ALG)) ||
7045: (((*s_objet_argument_1).type == RPN) &&
7046: ((*s_objet_argument_2).type == RPN)))
7047: {
7048: nombre_elements = 0;
7049: l_element_courant = (struct_liste_chainee *)
7050: (*s_objet_argument_1).objet;
7051:
7052: while(l_element_courant != NULL)
7053: {
7054: nombre_elements++;
7055: l_element_courant = (*l_element_courant).suivant;
7056: }
7057:
7058: if (nombre_elements == 2)
7059: {
7060: liberation(s_etat_processus, s_objet_argument_1);
7061: liberation(s_etat_processus, s_objet_argument_2);
7062:
7063: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
7064: return;
7065: }
7066:
7067: nombre_elements = 0;
7068: l_element_courant = (struct_liste_chainee *)
7069: (*s_objet_argument_2).objet;
7070:
7071: while(l_element_courant != NULL)
7072: {
7073: nombre_elements++;
7074: l_element_courant = (*l_element_courant).suivant;
7075: }
7076:
7077: if (nombre_elements == 2)
7078: {
7079: liberation(s_etat_processus, s_objet_argument_1);
7080: liberation(s_etat_processus, s_objet_argument_2);
7081:
7082: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
7083: return;
7084: }
7085:
7086: if ((s_copie_argument_1 = copie_objet(s_etat_processus,
7087: s_objet_argument_1, 'N')) == NULL)
7088: {
7089: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
7090: return;
7091: }
7092:
7093: if ((s_copie_argument_2 = copie_objet(s_etat_processus,
7094: s_objet_argument_2, 'N')) == NULL)
7095: {
7096: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
7097: return;
7098: }
7099:
7100: l_element_courant = (struct_liste_chainee *)
7101: (*s_copie_argument_1).objet;
7102: (*s_copie_argument_1).objet = (void *) (*((struct_liste_chainee *)
7103: (*s_copie_argument_1).objet)).suivant;
7104:
7105: liberation(s_etat_processus, (*l_element_courant).donnee);
7106: free(l_element_courant);
7107:
7108: l_element_courant = (struct_liste_chainee *)
7109: (*s_copie_argument_2).objet;
7110: l_element_precedent = l_element_courant;
7111: s_objet_resultat = s_copie_argument_2;
7112:
7113: while((*l_element_courant).suivant != NULL)
7114: {
7115: l_element_precedent = l_element_courant;
7116: l_element_courant = (*l_element_courant).suivant;
7117: }
7118:
7119: liberation(s_etat_processus, (*l_element_courant).donnee);
7120: free(l_element_courant);
7121:
7122: (*l_element_precedent).suivant = (struct_liste_chainee *)
7123: (*s_copie_argument_1).objet;
7124: free(s_copie_argument_1);
7125:
7126: l_element_courant = (*l_element_precedent).suivant;
7127: while((*l_element_courant).suivant != NULL)
7128: {
7129: l_element_precedent = l_element_courant;
7130: l_element_courant = (*l_element_courant).suivant;
7131: }
7132:
7133: if (((*l_element_precedent).suivant =
7134: allocation_maillon(s_etat_processus)) == NULL)
7135: {
7136: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
7137: return;
7138: }
7139:
7140: (*(*l_element_precedent).suivant).suivant = l_element_courant;
7141: l_element_courant = (*l_element_precedent).suivant;
7142:
7143: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
7144: == NULL)
7145: {
7146: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
7147: return;
7148: }
7149:
7150: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
7151: .nombre_arguments = 2;
7152: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
7153: .fonction = instruction_mod;
7154:
7155: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
7156: .nom_fonction = malloc(4 * sizeof(unsigned char))) == NULL)
7157: {
7158: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
7159: return;
7160: }
7161:
7162: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
7163: .nom_fonction, "MOD");
7164: }
7165:
7166: /*
7167: --------------------------------------------------------------------------------
7168: Arguments incorrects
7169: --------------------------------------------------------------------------------
7170: */
7171:
7172: else
7173: {
7174: liberation(s_etat_processus, s_objet_argument_1);
7175: liberation(s_etat_processus, s_objet_argument_2);
7176:
7177: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
7178: return;
7179: }
7180:
7181: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
7182: s_objet_resultat) == d_erreur)
7183: {
7184: return;
7185: }
7186:
7187: liberation(s_etat_processus, s_objet_argument_1);
7188: liberation(s_etat_processus, s_objet_argument_2);
7189:
7190: return;
7191: }
7192:
7193: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_m1.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src