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