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