1: /*
2: ================================================================================
3: RPL/2 (R) version 4.1.36
4: Copyright (C) 1989-2025 Dr. BERTRAND Joël
5:
6: This file is part of RPL/2.
7:
8: RPL/2 is free software; you can redistribute it and/or modify it
9: under the terms of the CeCILL V2 License as published by the french
10: CEA, CNRS and INRIA.
11:
12: RPL/2 is distributed in the hope that it will be useful, but WITHOUT
13: ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14: FITNESS FOR A PARTICULAR PURPOSE. See the CeCILL V2 License
15: for more details.
16:
17: You should have received a copy of the CeCILL License
18: along with RPL/2. If not, write to info@cecill.info.
19: ================================================================================
20: */
21:
22:
23: #include "rpl-conv.h"
24:
25:
26: /*
27: ================================================================================
28: Fonction 'pcov'
29: ================================================================================
30: Entrées :
31: --------------------------------------------------------------------------------
32: Sorties :
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: void
39: instruction_pcov(struct_processus *s_etat_processus)
40: {
41: integer8 nombre_colonnes;
42:
43: logical1 erreur;
44:
45: struct_objet *s_objet_statistique;
46: struct_objet *s_objet_resultat;
47:
48: (*s_etat_processus).erreur_execution = d_ex;
49:
50: if ((*s_etat_processus).affichage_arguments == 'Y')
51: {
52: printf("\n PCOV ");
53:
54: if ((*s_etat_processus).langue == 'F')
55: {
56: printf("(covariance d'une population)\n\n");
57: }
58: else
59: {
60: printf("(population covariance)\n\n");
61: }
62:
63: printf("-> 1: %s\n", d_REL);
64:
65: return;
66: }
67: else if ((*s_etat_processus).test_instruction == 'Y')
68: {
69: (*s_etat_processus).nombre_arguments = -1;
70: return;
71: }
72:
73: if (test_cfsf(s_etat_processus, 31) == d_vrai)
74: {
75: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
76: {
77: return;
78: }
79: }
80:
81: /*
82: * Recherche d'une variable globale référencée par SIGMA
83: */
84:
85: if (recherche_variable_globale(s_etat_processus, ds_sdat) == d_faux)
86: {
87: /*
88: * Aucune variable SIGMA
89: */
90:
91: (*s_etat_processus).erreur_systeme = d_es;
92:
93: if ((*s_etat_processus).erreur_execution == d_ex)
94: {
95: (*s_etat_processus).erreur_execution = d_ex_absence_observations;
96: }
97:
98: return;
99: }
100: else
101: {
102: if (((*(*(*s_etat_processus).pointeur_variable_courante).objet)
103: .type != MIN) && ((*(*(*s_etat_processus)
104: .pointeur_variable_courante).objet).type != MRL))
105: {
106: (*s_etat_processus).erreur_execution =
107: d_ex_matrice_statistique_invalide;
108: return;
109: }
110:
111: nombre_colonnes = (*((struct_matrice *) (*(*(*s_etat_processus)
112: .pointeur_variable_courante).objet).objet)).nombre_colonnes;
113: }
114:
115: s_objet_statistique = (*(*s_etat_processus).pointeur_variable_courante)
116: .objet;
117:
118: if (((*s_objet_statistique).type == MIN) ||
119: ((*s_objet_statistique).type == MRL))
120: {
121: if (((*s_etat_processus).colonne_statistique_1 < 1) ||
122: ((*s_etat_processus).colonne_statistique_2 < 1) ||
123: ((*s_etat_processus).colonne_statistique_1 > nombre_colonnes) ||
124: ((*s_etat_processus).colonne_statistique_2 > nombre_colonnes))
125: {
126: (*s_etat_processus).erreur_execution =
127: d_ex_observations_inexistantes;
128: return;
129: }
130:
131: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
132: {
133: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
134: return;
135: }
136:
137: (*((real8 *) (*s_objet_resultat).objet)) = covariance_statistique(
138: (struct_matrice *) (*s_objet_statistique).objet,
139: (*s_etat_processus).colonne_statistique_1,
140: (*s_etat_processus).colonne_statistique_2, 'N', &erreur);
141:
142: if (erreur == d_erreur)
143: {
144: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
145: return;
146: }
147: }
148: else
149: {
150: (*s_etat_processus).erreur_execution =
151: d_ex_matrice_statistique_invalide;
152: return;
153: }
154:
155: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
156: s_objet_resultat) == d_erreur)
157: {
158: return;
159: }
160:
161: return;
162: }
163:
164:
165: /*
166: ================================================================================
167: Fonction 'prlcd'
168: ================================================================================
169: Entrées :
170: --------------------------------------------------------------------------------
171: Sorties :
172: --------------------------------------------------------------------------------
173: Effets de bord : néant
174: ================================================================================
175: */
176:
177: void
178: instruction_prlcd(struct_processus *s_etat_processus)
179: {
180: (*s_etat_processus).erreur_execution = d_ex;
181:
182: if ((*s_etat_processus).affichage_arguments == 'Y')
183: {
184: printf("\n PRLCD ");
185:
186: if ((*s_etat_processus).langue == 'F')
187: {
188: printf("(impression puis destruction de la file graphique)\n\n");
189: printf(" Aucun argument\n");
190: }
191: else
192: {
193: printf("(print and purge the graphical queue)\n\n");
194: printf(" No argument\n");
195: }
196:
197: return;
198: }
199: else if ((*s_etat_processus).test_instruction == 'Y')
200: {
201: (*s_etat_processus).nombre_arguments = -1;
202: return;
203: }
204:
205: if (test_cfsf(s_etat_processus, 31) == d_vrai)
206: {
207: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
208: {
209: return;
210: }
211: }
212:
213: appel_gnuplot(s_etat_processus, 'I');
214:
215: (*s_etat_processus).exception = d_ep;
216:
217: return;
218: }
219:
220:
221: /*
222: ================================================================================
223: Fonction 'putc'
224: ================================================================================
225: Entrées :
226: --------------------------------------------------------------------------------
227: Sorties :
228: --------------------------------------------------------------------------------
229: Effets de bord : néant
230: ================================================================================
231: */
232:
233: void
234: instruction_putc(struct_processus *s_etat_processus)
235: {
236: integer8 position;
237:
238: logical1 presence_nom;
239: logical1 variable_partagee;
240:
241: struct_liste_chainee *l_element_courant;
242:
243: struct_objet *s_copie_argument_3;
244: struct_objet *s_objet_argument_1;
245: struct_objet *s_objet_argument_2;
246: struct_objet *s_objet_argument_3;
247:
248: integer8 i;
249: integer8 j;
250: integer8 nombre_elements;
251:
252: void *tampon;
253:
254: (*s_etat_processus).erreur_execution = d_ex;
255:
256: if ((*s_etat_processus).affichage_arguments == 'Y')
257: {
258: printf("\n PUTC ");
259:
260: if ((*s_etat_processus).langue == 'F')
261: {
262: printf("(change une colonne)\n\n");
263: }
264: else
265: {
266: printf("(change column)\n\n");
267: }
268:
269: printf(" 3: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
270: printf(" 2: %s\n", d_LST);
271: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
272: printf("-> 1: %s, %s, %s\n\n", d_MIN, d_MRL, d_MCX);
273:
274: printf(" 3: %s\n", d_NOM);
275: printf(" 2: %s\n", d_LST);
276: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
277:
278: return;
279: }
280: else if ((*s_etat_processus).test_instruction == 'Y')
281: {
282: (*s_etat_processus).nombre_arguments = -1;
283: return;
284: }
285:
286: if (test_cfsf(s_etat_processus, 31) == d_vrai)
287: {
288: if (empilement_pile_last(s_etat_processus, 3) == d_erreur)
289: {
290: return;
291: }
292: }
293:
294: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
295: &s_objet_argument_1) == d_erreur)
296: {
297: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
298: return;
299: }
300:
301: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
302: &s_objet_argument_2) == d_erreur)
303: {
304: liberation(s_etat_processus, s_objet_argument_1);
305:
306: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
307: return;
308: }
309:
310: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
311: &s_objet_argument_3) == d_erreur)
312: {
313: liberation(s_etat_processus, s_objet_argument_1);
314: liberation(s_etat_processus, s_objet_argument_2);
315:
316: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
317: return;
318: }
319:
320: if (((*s_objet_argument_1).type != MIN) &&
321: ((*s_objet_argument_1).type != MRL) &&
322: ((*s_objet_argument_1).type != MCX))
323: {
324: liberation(s_etat_processus, s_objet_argument_1);
325: liberation(s_etat_processus, s_objet_argument_2);
326: liberation(s_etat_processus, s_objet_argument_3);
327:
328: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
329: return;
330: }
331:
332: if ((*s_objet_argument_2).type != LST)
333: {
334: liberation(s_etat_processus, s_objet_argument_1);
335: liberation(s_etat_processus, s_objet_argument_2);
336: liberation(s_etat_processus, s_objet_argument_3);
337:
338: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
339: return;
340: }
341:
342: nombre_elements = 0;
343: l_element_courant = (struct_liste_chainee *) (*s_objet_argument_2).objet;
344:
345: while(l_element_courant != NULL)
346: {
347: if ((*(*l_element_courant).donnee).type != INT)
348: {
349: liberation(s_etat_processus, s_objet_argument_1);
350: liberation(s_etat_processus, s_objet_argument_2);
351: liberation(s_etat_processus, s_objet_argument_3);
352:
353: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
354: return;
355: }
356:
357: nombre_elements++;
358: l_element_courant = (*l_element_courant).suivant;
359: }
360:
361: if ((nombre_elements == 0) || (nombre_elements != (*((struct_matrice *)
362: (*s_objet_argument_1).objet)).nombre_colonnes))
363: {
364: liberation(s_etat_processus, s_objet_argument_1);
365: liberation(s_etat_processus, s_objet_argument_2);
366: liberation(s_etat_processus, s_objet_argument_3);
367:
368: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
369: return;
370: }
371:
372: variable_partagee = d_faux;
373:
374: if ((*s_objet_argument_3).type == NOM)
375: {
376: presence_nom = d_vrai;
377:
378: if (recherche_variable(s_etat_processus, (*((struct_nom *)
379: (*s_objet_argument_3).objet)).nom) == d_faux)
380: {
381: (*s_etat_processus).erreur_systeme = d_es;
382: (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
383:
384: liberation(s_etat_processus, s_objet_argument_1);
385: liberation(s_etat_processus, s_objet_argument_2);
386: liberation(s_etat_processus, s_objet_argument_3);
387:
388: return;
389: }
390:
391: if ((*(*s_etat_processus).pointeur_variable_courante)
392: .variable_verrouillee == d_vrai)
393: {
394: (*s_etat_processus).erreur_execution = d_ex_variable_verrouillee;
395:
396: liberation(s_etat_processus, s_objet_argument_1);
397: liberation(s_etat_processus, s_objet_argument_2);
398: liberation(s_etat_processus, s_objet_argument_3);
399:
400: return;
401: }
402:
403: liberation(s_etat_processus, s_objet_argument_3);
404: s_objet_argument_3 = (*(*s_etat_processus).pointeur_variable_courante)
405: .objet;
406:
407: if (s_objet_argument_3 == NULL)
408: {
409: if (recherche_variable_partagee(s_etat_processus,
410: (*(*s_etat_processus).pointeur_variable_courante).nom,
411: (*(*s_etat_processus).pointeur_variable_courante)
412: .variable_partagee, (*(*s_etat_processus)
413: .pointeur_variable_courante).origine) == NULL)
414: {
415: (*s_etat_processus).erreur_systeme = d_es;
416: (*s_etat_processus).erreur_execution =
417: d_ex_variable_non_definie;
418:
419: liberation(s_etat_processus, s_objet_argument_1);
420: liberation(s_etat_processus, s_objet_argument_2);
421:
422: return;
423: }
424:
425: s_objet_argument_3 = (*(*s_etat_processus)
426: .pointeur_variable_partagee_courante).objet;
427: variable_partagee = d_vrai;
428: }
429:
430: if ((s_copie_argument_3 = copie_objet(s_etat_processus,
431: s_objet_argument_3, 'O')) == NULL)
432: {
433: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
434: return;
435: }
436:
437: liberation(s_etat_processus, s_objet_argument_3);
438: s_objet_argument_3 = s_copie_argument_3;
439:
440: (*(*s_etat_processus).pointeur_variable_courante).objet =
441: s_objet_argument_3;
442: }
443: else
444: {
445: presence_nom = d_faux;
446:
447: if ((s_copie_argument_3 = copie_objet(s_etat_processus,
448: s_objet_argument_3, 'O')) == NULL)
449: {
450: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
451: return;
452: }
453:
454: liberation(s_etat_processus, s_objet_argument_3);
455: s_objet_argument_3 = s_copie_argument_3;
456: }
457:
458: if ((*s_objet_argument_1).type == MRL)
459: {
460: if ((*s_objet_argument_3).type == MIN)
461: {
462: // Conversion de la matrice entière en matrice réelle
463:
464: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument_3).objet))
465: .nombre_lignes; i++)
466: {
467: tampon = (*((struct_matrice *) (*s_objet_argument_3).objet))
468: .tableau[i];
469:
470: if (((*((struct_matrice *) (*s_objet_argument_3).objet))
471: .tableau[i] = malloc(((size_t) (*((struct_matrice *)
472: (*s_objet_argument_3).objet)).nombre_colonnes) *
473: sizeof(real8))) == NULL)
474: {
475: if (variable_partagee == d_vrai)
476: {
477: if (pthread_mutex_unlock(&((*(*s_etat_processus)
478: .pointeur_variable_partagee_courante).mutex))
479: != 0)
480: {
481: (*s_etat_processus).erreur_systeme = d_es_processus;
482: return;
483: }
484: }
485:
486: (*s_etat_processus).erreur_systeme =
487: d_es_allocation_memoire;
488: return;
489: }
490:
491: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3)
492: .objet)).nombre_colonnes; j++)
493: {
494: ((real8 **) (*((struct_matrice *) (*s_objet_argument_3)
495: .objet)).tableau)[i][j] = (real8) (((integer8 *)
496: tampon)[j]);
497: }
498:
499: free(tampon);
500: }
501:
502: (*((struct_matrice *) (*s_objet_argument_3).objet)).type = 'R';
503: (*s_objet_argument_3).type = MRL;
504: }
505: }
506: else if ((*s_objet_argument_1).type == MCX)
507: {
508: if ((*s_objet_argument_3).type == MIN)
509: {
510: // Conversion de la matrice entière en matrice complexe
511:
512: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument_3).objet))
513: .nombre_lignes; i++)
514: {
515: tampon = (*((struct_matrice *) (*s_objet_argument_3).objet))
516: .tableau[i];
517:
518: if (((*((struct_matrice *) (*s_objet_argument_3).objet))
519: .tableau[i] = malloc(((size_t) (*((struct_matrice *)
520: (*s_objet_argument_3).objet)).nombre_colonnes) *
521: sizeof(complex16))) == NULL)
522: {
523: if (variable_partagee == d_vrai)
524: {
525: if (pthread_mutex_unlock(&((*(*s_etat_processus)
526: .pointeur_variable_partagee_courante).mutex))
527: != 0)
528: {
529: (*s_etat_processus).erreur_systeme = d_es_processus;
530: return;
531: }
532: }
533:
534: (*s_etat_processus).erreur_systeme =
535: d_es_allocation_memoire;
536: return;
537: }
538:
539: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3)
540: .objet)).nombre_colonnes; j++)
541: {
542: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
543: .objet)).tableau)[i][j].partie_reelle =
544: (real8) (((integer8 *) tampon)[j]);
545: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
546: .objet)).tableau)[i][j].partie_imaginaire = 0;
547: }
548:
549: free(tampon);
550: }
551:
552: (*((struct_matrice *) (*s_objet_argument_3).objet)).type = 'C';
553: (*s_objet_argument_3).type = MCX;
554: }
555: else if ((*s_objet_argument_3).type == MRL)
556: {
557: // Conversion de la matrice réelle en matrice complexe
558:
559: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument_3).objet))
560: .nombre_lignes; i++)
561: {
562: tampon = (*((struct_matrice *) (*s_objet_argument_3).objet))
563: .tableau[i];
564:
565: if (((*((struct_matrice *) (*s_objet_argument_3).objet))
566: .tableau[i] = malloc(((size_t) (*((struct_matrice *)
567: (*s_objet_argument_3).objet)).nombre_colonnes) *
568: sizeof(complex16))) == NULL)
569: {
570: if (variable_partagee == d_vrai)
571: {
572: if (pthread_mutex_unlock(&((*(*s_etat_processus)
573: .pointeur_variable_partagee_courante).mutex))
574: != 0)
575: {
576: (*s_etat_processus).erreur_systeme = d_es_processus;
577: return;
578: }
579: }
580:
581: (*s_etat_processus).erreur_systeme =
582: d_es_allocation_memoire;
583: return;
584: }
585:
586: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3)
587: .objet)).nombre_colonnes; j++)
588: {
589: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
590: .objet)).tableau)[i][j].partie_reelle =
591: ((real8 *) tampon)[j];
592: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
593: .objet)).tableau)[i][j].partie_imaginaire = 0;
594: }
595:
596: free(tampon);
597: }
598:
599: (*((struct_matrice *) (*s_objet_argument_3).objet)).type = 'C';
600: (*s_objet_argument_3).type = MCX;
601: }
602: }
603:
604: if ((*s_objet_argument_3).type == MIN)
605: {
606: if ((*((struct_matrice *) (*s_objet_argument_1).objet)).nombre_lignes
607: != (*((struct_matrice *) (*s_objet_argument_3).objet))
608: .nombre_lignes)
609: {
610: if (variable_partagee == d_vrai)
611: {
612: if (pthread_mutex_unlock(&((*(*s_etat_processus)
613: .pointeur_variable_partagee_courante).mutex)) != 0)
614: {
615: (*s_etat_processus).erreur_systeme = d_es_processus;
616: return;
617: }
618: }
619:
620: liberation(s_etat_processus, s_objet_argument_1);
621: liberation(s_etat_processus, s_objet_argument_2);
622:
623: if (presence_nom == d_faux)
624: {
625: liberation(s_etat_processus, s_objet_argument_3);
626: }
627:
628: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
629: return;
630: }
631:
632: l_element_courant = (struct_liste_chainee *)
633: (*s_objet_argument_2).objet;
634: i = 0;
635:
636: while(l_element_courant != NULL)
637: {
638: position = (*((integer8 *) (*(*l_element_courant).donnee).objet));
639:
640: if ((position < 1) || (position > (integer8) (*((struct_matrice *)
641: (*s_objet_argument_3).objet)).nombre_colonnes))
642: {
643: if (variable_partagee == d_vrai)
644: {
645: if (pthread_mutex_unlock(&((*(*s_etat_processus)
646: .pointeur_variable_partagee_courante).mutex)) != 0)
647: {
648: (*s_etat_processus).erreur_systeme = d_es_processus;
649: return;
650: }
651: }
652:
653: liberation(s_etat_processus, s_objet_argument_1);
654: liberation(s_etat_processus, s_objet_argument_2);
655:
656: if (presence_nom == d_faux)
657: {
658: liberation(s_etat_processus, s_objet_argument_3);
659: }
660:
661: (*s_etat_processus).erreur_execution =
662: d_ex_argument_invalide;
663: return;
664: }
665:
666: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3).objet))
667: .nombre_lignes; j++)
668: {
669: ((integer8 **) (*((struct_matrice *) (*s_objet_argument_3)
670: .objet)).tableau)[j][position - 1] = ((integer8 **)
671: (*((struct_matrice *) (*s_objet_argument_1).objet))
672: .tableau)[j][i];
673: }
674:
675: l_element_courant = (*l_element_courant).suivant;
676: i++;
677: }
678: }
679: else if ((*s_objet_argument_3).type == MRL)
680: {
681: if ((*s_objet_argument_1).type == MIN)
682: {
683: if ((*((struct_matrice *) (*s_objet_argument_1).objet))
684: .nombre_lignes != (*((struct_matrice *)
685: (*s_objet_argument_3).objet)).nombre_lignes)
686: {
687: if (variable_partagee == d_vrai)
688: {
689: if (pthread_mutex_unlock(&((*(*s_etat_processus)
690: .pointeur_variable_partagee_courante).mutex)) != 0)
691: {
692: (*s_etat_processus).erreur_systeme = d_es_processus;
693: return;
694: }
695: }
696:
697: liberation(s_etat_processus, s_objet_argument_1);
698: liberation(s_etat_processus, s_objet_argument_2);
699:
700: if (presence_nom == d_faux)
701: {
702: liberation(s_etat_processus, s_objet_argument_3);
703: }
704:
705: (*s_etat_processus).erreur_execution =
706: d_ex_dimensions_invalides;
707: return;
708: }
709:
710: l_element_courant = (struct_liste_chainee *)
711: (*s_objet_argument_2).objet;
712: i = 0;
713:
714: while(l_element_courant != NULL)
715: {
716: position = (*((integer8 *) (*(*l_element_courant)
717: .donnee).objet));
718:
719: if ((position < 1) || (position > (integer8)
720: (*((struct_matrice *)(*s_objet_argument_3).objet))
721: .nombre_colonnes))
722: {
723: if (variable_partagee == d_vrai)
724: {
725: if (pthread_mutex_unlock(&((*(*s_etat_processus)
726: .pointeur_variable_partagee_courante).mutex))
727: != 0)
728: {
729: (*s_etat_processus).erreur_systeme = d_es_processus;
730: return;
731: }
732: }
733:
734: liberation(s_etat_processus, s_objet_argument_1);
735: liberation(s_etat_processus, s_objet_argument_2);
736:
737: if (presence_nom == d_faux)
738: {
739: liberation(s_etat_processus, s_objet_argument_3);
740: }
741:
742: (*s_etat_processus).erreur_execution =
743: d_ex_erreur_type_argument;
744: return;
745: }
746:
747: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3)
748: .objet)).nombre_lignes; j++)
749: {
750: ((real8 **) (*((struct_matrice *) (*s_objet_argument_3)
751: .objet)).tableau)[j][position - 1] = (real8)
752: ((integer8 **) (*((struct_matrice *)
753: (*s_objet_argument_1).objet)).tableau)[j][i];
754: }
755:
756: l_element_courant = (*l_element_courant).suivant;
757: i++;
758: }
759: }
760: else // Matrice réelle
761: {
762: if ((*((struct_matrice *) (*s_objet_argument_1).objet))
763: .nombre_lignes != (*((struct_matrice *)
764: (*s_objet_argument_3).objet)).nombre_lignes)
765: {
766: if (variable_partagee == d_vrai)
767: {
768: if (pthread_mutex_unlock(&((*(*s_etat_processus)
769: .pointeur_variable_partagee_courante).mutex)) != 0)
770: {
771: (*s_etat_processus).erreur_systeme = d_es_processus;
772: return;
773: }
774: }
775:
776: liberation(s_etat_processus, s_objet_argument_1);
777: liberation(s_etat_processus, s_objet_argument_2);
778:
779: if (presence_nom == d_faux)
780: {
781: liberation(s_etat_processus, s_objet_argument_3);
782: }
783:
784: (*s_etat_processus).erreur_execution =
785: d_ex_dimensions_invalides;
786: return;
787: }
788:
789: l_element_courant = (struct_liste_chainee *)
790: (*s_objet_argument_2).objet;
791: i = 0;
792:
793: while(l_element_courant != NULL)
794: {
795: position = (*((integer8 *) (*(*l_element_courant)
796: .donnee).objet));
797:
798: if ((position < 1) || (position > (integer8)
799: (*((struct_matrice *) (*s_objet_argument_3).objet))
800: .nombre_colonnes))
801: {
802: if (variable_partagee == d_vrai)
803: {
804: if (pthread_mutex_unlock(&((*(*s_etat_processus)
805: .pointeur_variable_partagee_courante).mutex))
806: != 0)
807: {
808: (*s_etat_processus).erreur_systeme = d_es_processus;
809: return;
810: }
811: }
812:
813: liberation(s_etat_processus, s_objet_argument_1);
814: liberation(s_etat_processus, s_objet_argument_2);
815:
816: if (presence_nom == d_faux)
817: {
818: liberation(s_etat_processus, s_objet_argument_3);
819: }
820:
821: (*s_etat_processus).erreur_execution =
822: d_ex_argument_invalide;
823: return;
824: }
825:
826: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3)
827: .objet)).nombre_lignes; j++)
828: {
829: ((real8 **) (*((struct_matrice *) (*s_objet_argument_3)
830: .objet)).tableau)[j][position - 1] =
831: ((real8 **) (*((struct_matrice *)
832: (*s_objet_argument_1).objet)).tableau)[j][i];
833: }
834:
835: l_element_courant = (*l_element_courant).suivant;
836: i++;
837: }
838: }
839: }
840: else if ((*s_objet_argument_3).type == MCX)
841: {
842: if ((*s_objet_argument_1).type == MIN)
843: {
844: if ((*((struct_matrice *) (*s_objet_argument_1).objet))
845: .nombre_lignes != (*((struct_matrice *)
846: (*s_objet_argument_3).objet)).nombre_lignes)
847: {
848: if (variable_partagee == d_vrai)
849: {
850: if (pthread_mutex_unlock(&((*(*s_etat_processus)
851: .pointeur_variable_partagee_courante).mutex)) != 0)
852: {
853: (*s_etat_processus).erreur_systeme = d_es_processus;
854: return;
855: }
856: }
857:
858: liberation(s_etat_processus, s_objet_argument_1);
859: liberation(s_etat_processus, s_objet_argument_2);
860:
861: if (presence_nom == d_faux)
862: {
863: liberation(s_etat_processus, s_objet_argument_3);
864: }
865:
866: (*s_etat_processus).erreur_execution =
867: d_ex_dimensions_invalides;
868: return;
869: }
870:
871: l_element_courant = (struct_liste_chainee *)
872: (*s_objet_argument_2).objet;
873: i = 0;
874:
875: while(l_element_courant != NULL)
876: {
877: position = (*((integer8 *) (*(*l_element_courant)
878: .donnee).objet));
879:
880: if ((position < 1) || (position > (integer8)
881: (*((struct_matrice *) (*s_objet_argument_3).objet))
882: .nombre_colonnes))
883: {
884: if (variable_partagee == d_vrai)
885: {
886: if (pthread_mutex_unlock(&((*(*s_etat_processus)
887: .pointeur_variable_partagee_courante).mutex))
888: != 0)
889: {
890: (*s_etat_processus).erreur_systeme = d_es_processus;
891: return;
892: }
893: }
894:
895: liberation(s_etat_processus, s_objet_argument_1);
896: liberation(s_etat_processus, s_objet_argument_2);
897:
898: if (presence_nom == d_faux)
899: {
900: liberation(s_etat_processus, s_objet_argument_3);
901: }
902:
903: (*s_etat_processus).erreur_execution =
904: d_ex_argument_invalide;
905: return;
906: }
907:
908: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3)
909: .objet)).nombre_lignes; j++)
910: {
911: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
912: .objet)).tableau)[j][position - 1].partie_reelle =
913: (real8) ((integer8 **) (*((struct_matrice *)
914: (*s_objet_argument_1).objet)).tableau)[j][i];
915: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
916: .objet)).tableau)[j][position - 1]
917: .partie_imaginaire = 0;
918: }
919:
920: l_element_courant = (*l_element_courant).suivant;
921: i++;
922: }
923: }
924: else if ((*s_objet_argument_1).type == MRL)
925: {
926: if ((*((struct_matrice *) (*s_objet_argument_1).objet))
927: .nombre_lignes != (*((struct_matrice *)
928: (*s_objet_argument_3).objet)).nombre_lignes)
929: {
930: if (variable_partagee == d_vrai)
931: {
932: if (pthread_mutex_unlock(&((*(*s_etat_processus)
933: .pointeur_variable_partagee_courante).mutex)) != 0)
934: {
935: (*s_etat_processus).erreur_systeme = d_es_processus;
936: return;
937: }
938: }
939:
940: liberation(s_etat_processus, s_objet_argument_1);
941: liberation(s_etat_processus, s_objet_argument_2);
942:
943: if (presence_nom == d_faux)
944: {
945: liberation(s_etat_processus, s_objet_argument_3);
946: }
947:
948: (*s_etat_processus).erreur_execution =
949: d_ex_dimensions_invalides;
950: return;
951: }
952:
953: l_element_courant = (struct_liste_chainee *)
954: (*s_objet_argument_2).objet;
955: i = 0;
956:
957: while(l_element_courant != NULL)
958: {
959: position = (*((integer8 *) (*(*l_element_courant)
960: .donnee).objet));
961:
962: if ((position < 1) || (position > (integer8)
963: (*((struct_matrice *) (*s_objet_argument_3).objet))
964: .nombre_colonnes))
965: {
966: if (variable_partagee == d_vrai)
967: {
968: if (pthread_mutex_unlock(&((*(*s_etat_processus)
969: .pointeur_variable_partagee_courante).mutex))
970: != 0)
971: {
972: (*s_etat_processus).erreur_systeme = d_es_processus;
973: return;
974: }
975: }
976:
977: liberation(s_etat_processus, s_objet_argument_1);
978: liberation(s_etat_processus, s_objet_argument_2);
979:
980: if (presence_nom == d_faux)
981: {
982: liberation(s_etat_processus, s_objet_argument_3);
983: }
984:
985: (*s_etat_processus).erreur_execution =
986: d_ex_argument_invalide;
987: return;
988: }
989:
990: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3)
991: .objet)).nombre_lignes; j++)
992: {
993: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
994: .objet)).tableau)[j][position - 1].partie_reelle =
995: ((real8 **) (*((struct_matrice *)
996: (*s_objet_argument_1).objet)).tableau)[j][i];
997: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
998: .objet)).tableau)[j][position - 1]
999: .partie_imaginaire = 0;
1000: }
1001:
1002: l_element_courant = (*l_element_courant).suivant;
1003: i++;
1004: }
1005: }
1006: else // Matrice complexe
1007: {
1008: if ((*((struct_matrice *) (*s_objet_argument_1).objet))
1009: .nombre_lignes != (*((struct_matrice *)
1010: (*s_objet_argument_3).objet)).nombre_lignes)
1011: {
1012: if (variable_partagee == d_vrai)
1013: {
1014: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1015: .pointeur_variable_partagee_courante).mutex)) != 0)
1016: {
1017: (*s_etat_processus).erreur_systeme = d_es_processus;
1018: return;
1019: }
1020: }
1021:
1022: liberation(s_etat_processus, s_objet_argument_1);
1023: liberation(s_etat_processus, s_objet_argument_2);
1024:
1025: if (presence_nom == d_faux)
1026: {
1027: liberation(s_etat_processus, s_objet_argument_3);
1028: }
1029:
1030: (*s_etat_processus).erreur_execution =
1031: d_ex_dimensions_invalides;
1032: return;
1033: }
1034:
1035: l_element_courant = (struct_liste_chainee *)
1036: (*s_objet_argument_2).objet;
1037: i = 0;
1038:
1039: while(l_element_courant != NULL)
1040: {
1041: position = (*((integer8 *) (*(*l_element_courant)
1042: .donnee).objet));
1043:
1044: if ((position < 1) || (position > (integer8)
1045: (*((struct_matrice *) (*s_objet_argument_3).objet))
1046: .nombre_colonnes))
1047: {
1048: if (variable_partagee == d_vrai)
1049: {
1050: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1051: .pointeur_variable_partagee_courante).mutex))
1052: != 0)
1053: {
1054: (*s_etat_processus).erreur_systeme = d_es_processus;
1055: return;
1056: }
1057: }
1058:
1059: liberation(s_etat_processus, s_objet_argument_1);
1060: liberation(s_etat_processus, s_objet_argument_2);
1061:
1062: if (presence_nom == d_faux)
1063: {
1064: liberation(s_etat_processus, s_objet_argument_3);
1065: }
1066:
1067: (*s_etat_processus).erreur_execution =
1068: d_ex_argument_invalide;
1069: return;
1070: }
1071:
1072: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3)
1073: .objet)).nombre_lignes; j++)
1074: {
1075: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
1076: .objet)).tableau)[j][position - 1].partie_reelle =
1077: ((complex16 **) (*((struct_matrice *)
1078: (*s_objet_argument_1).objet)).tableau)[j][i]
1079: .partie_reelle;
1080: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
1081: .objet)).tableau)[j][position - 1]
1082: .partie_imaginaire = ((complex16 **)
1083: (*((struct_matrice *) (*s_objet_argument_1).objet))
1084: .tableau)[j][i].partie_imaginaire;
1085: }
1086:
1087: l_element_courant = (*l_element_courant).suivant;
1088: i++;
1089: }
1090: }
1091: }
1092: else
1093: {
1094: if (variable_partagee == d_vrai)
1095: {
1096: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1097: .pointeur_variable_partagee_courante).mutex)) != 0)
1098: {
1099: (*s_etat_processus).erreur_systeme = d_es_processus;
1100: return;
1101: }
1102: }
1103:
1104: liberation(s_etat_processus, s_objet_argument_1);
1105: liberation(s_etat_processus, s_objet_argument_2);
1106:
1107: if (presence_nom == d_faux)
1108: {
1109: liberation(s_etat_processus, s_objet_argument_3);
1110: }
1111:
1112: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1113: return;
1114: }
1115:
1116: if (presence_nom == d_faux)
1117: {
1118: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1119: s_objet_argument_3) == d_erreur)
1120: {
1121: return;
1122: }
1123: }
1124: else if (variable_partagee == d_vrai)
1125: {
1126: (*(*s_etat_processus).pointeur_variable_partagee_courante)
1127: .objet = s_objet_argument_3;
1128:
1129: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1130: .pointeur_variable_partagee_courante).mutex)) != 0)
1131: {
1132: (*s_etat_processus).erreur_systeme = d_es_processus;
1133: return;
1134: }
1135: }
1136:
1137: liberation(s_etat_processus, s_objet_argument_1);
1138: liberation(s_etat_processus, s_objet_argument_2);
1139:
1140: return;
1141: }
1142:
1143:
1144: /*
1145: ================================================================================
1146: Fonction 'putr'
1147: ================================================================================
1148: Entrées :
1149: --------------------------------------------------------------------------------
1150: Sorties :
1151: --------------------------------------------------------------------------------
1152: Effets de bord : néant
1153: ================================================================================
1154: */
1155:
1156: void
1157: instruction_putr(struct_processus *s_etat_processus)
1158: {
1159: integer8 position;
1160:
1161: logical1 presence_nom;
1162: logical1 variable_partagee;
1163:
1164: struct_liste_chainee *l_element_courant;
1165:
1166: struct_objet *s_copie_argument_3;
1167: struct_objet *s_objet_argument_1;
1168: struct_objet *s_objet_argument_2;
1169: struct_objet *s_objet_argument_3;
1170:
1171: integer8 i;
1172: integer8 j;
1173: integer8 nombre_elements;
1174:
1175: void *tampon;
1176:
1177: (*s_etat_processus).erreur_execution = d_ex;
1178:
1179: if ((*s_etat_processus).affichage_arguments == 'Y')
1180: {
1181: printf("\n PUTR ");
1182:
1183: if ((*s_etat_processus).langue == 'F')
1184: {
1185: printf("(change une ligne)\n\n");
1186: }
1187: else
1188: {
1189: printf("(change row)\n\n");
1190: }
1191:
1192: printf(" 3: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
1193: printf(" 2: %s\n", d_LST);
1194: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
1195: printf("-> 1: %s, %s, %s\n\n", d_MIN, d_MRL, d_MCX);
1196:
1197: printf(" 3: %s\n", d_NOM);
1198: printf(" 2: %s\n", d_LST);
1199: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
1200:
1201: return;
1202: }
1203: else if ((*s_etat_processus).test_instruction == 'Y')
1204: {
1205: (*s_etat_processus).nombre_arguments = -1;
1206: return;
1207: }
1208:
1209: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1210: {
1211: if (empilement_pile_last(s_etat_processus, 3) == d_erreur)
1212: {
1213: return;
1214: }
1215: }
1216:
1217: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1218: &s_objet_argument_1) == d_erreur)
1219: {
1220: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1221: return;
1222: }
1223:
1224: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1225: &s_objet_argument_2) == d_erreur)
1226: {
1227: liberation(s_etat_processus, s_objet_argument_1);
1228:
1229: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1230: return;
1231: }
1232:
1233: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1234: &s_objet_argument_3) == d_erreur)
1235: {
1236: liberation(s_etat_processus, s_objet_argument_1);
1237: liberation(s_etat_processus, s_objet_argument_2);
1238:
1239: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1240: return;
1241: }
1242:
1243: if (((*s_objet_argument_1).type != MIN) &&
1244: ((*s_objet_argument_1).type != MRL) &&
1245: ((*s_objet_argument_1).type != MCX))
1246: {
1247: liberation(s_etat_processus, s_objet_argument_1);
1248: liberation(s_etat_processus, s_objet_argument_2);
1249: liberation(s_etat_processus, s_objet_argument_3);
1250:
1251: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1252: return;
1253: }
1254:
1255: if ((*s_objet_argument_2).type != LST)
1256: {
1257: liberation(s_etat_processus, s_objet_argument_1);
1258: liberation(s_etat_processus, s_objet_argument_2);
1259: liberation(s_etat_processus, s_objet_argument_3);
1260:
1261: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1262: return;
1263: }
1264:
1265: nombre_elements = 0;
1266: l_element_courant = (struct_liste_chainee *) (*s_objet_argument_2).objet;
1267:
1268: while(l_element_courant != NULL)
1269: {
1270: if ((*(*l_element_courant).donnee).type != INT)
1271: {
1272: liberation(s_etat_processus, s_objet_argument_1);
1273: liberation(s_etat_processus, s_objet_argument_2);
1274: liberation(s_etat_processus, s_objet_argument_3);
1275:
1276: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1277: return;
1278: }
1279:
1280: nombre_elements++;
1281: l_element_courant = (*l_element_courant).suivant;
1282: }
1283:
1284: if ((nombre_elements == 0) || (nombre_elements != (*((struct_matrice *)
1285: (*s_objet_argument_1).objet)).nombre_lignes))
1286: {
1287: liberation(s_etat_processus, s_objet_argument_1);
1288: liberation(s_etat_processus, s_objet_argument_2);
1289: liberation(s_etat_processus, s_objet_argument_3);
1290:
1291: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1292: return;
1293: }
1294:
1295: variable_partagee = d_faux;
1296:
1297: if ((*s_objet_argument_3).type == NOM)
1298: {
1299: presence_nom = d_vrai;
1300:
1301: if (recherche_variable(s_etat_processus, (*((struct_nom *)
1302: (*s_objet_argument_3).objet)).nom) == d_faux)
1303: {
1304: (*s_etat_processus).erreur_systeme = d_es;
1305: (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
1306:
1307: liberation(s_etat_processus, s_objet_argument_1);
1308: liberation(s_etat_processus, s_objet_argument_2);
1309: liberation(s_etat_processus, s_objet_argument_3);
1310:
1311: return;
1312: }
1313:
1314: if ((*(*s_etat_processus).pointeur_variable_courante)
1315: .variable_verrouillee == d_vrai)
1316: {
1317: (*s_etat_processus).erreur_execution = d_ex_variable_verrouillee;
1318:
1319: liberation(s_etat_processus, s_objet_argument_1);
1320: liberation(s_etat_processus, s_objet_argument_2);
1321: liberation(s_etat_processus, s_objet_argument_3);
1322:
1323: return;
1324: }
1325:
1326: liberation(s_etat_processus, s_objet_argument_3);
1327: s_objet_argument_3 = (*(*s_etat_processus).pointeur_variable_courante)
1328: .objet;
1329:
1330: if (s_objet_argument_3 == NULL)
1331: {
1332: if (recherche_variable_partagee(s_etat_processus,
1333: (*(*s_etat_processus).pointeur_variable_courante).nom,
1334: (*(*s_etat_processus).pointeur_variable_courante)
1335: .variable_partagee, (*(*s_etat_processus)
1336: .pointeur_variable_courante).origine) == NULL)
1337: {
1338: (*s_etat_processus).erreur_systeme = d_es;
1339: (*s_etat_processus).erreur_execution =
1340: d_ex_variable_non_definie;
1341:
1342: liberation(s_etat_processus, s_objet_argument_1);
1343: liberation(s_etat_processus, s_objet_argument_2);
1344:
1345: return;
1346: }
1347:
1348: s_objet_argument_3 = (*(*s_etat_processus)
1349: .pointeur_variable_partagee_courante).objet;
1350: variable_partagee = d_vrai;
1351: }
1352:
1353: if ((s_copie_argument_3 = copie_objet(s_etat_processus,
1354: s_objet_argument_3, 'Q')) == NULL)
1355: {
1356: if (variable_partagee == d_vrai)
1357: {
1358: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1359: .pointeur_variable_partagee_courante).mutex)) != 0)
1360: {
1361: (*s_etat_processus).erreur_systeme = d_es_processus;
1362: return;
1363: }
1364: }
1365:
1366: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1367: return;
1368: }
1369:
1370: liberation(s_etat_processus, s_objet_argument_3);
1371: s_objet_argument_3 = s_copie_argument_3;
1372:
1373: (*(*s_etat_processus).pointeur_variable_courante).objet =
1374: s_objet_argument_3;
1375: }
1376: else
1377: {
1378: presence_nom = d_faux;
1379:
1380: if ((s_copie_argument_3 = copie_objet(s_etat_processus,
1381: s_objet_argument_3, 'Q')) == NULL)
1382: {
1383: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1384: return;
1385: }
1386:
1387: liberation(s_etat_processus, s_objet_argument_3);
1388: s_objet_argument_3 = s_copie_argument_3;
1389: }
1390:
1391: if ((*s_objet_argument_1).type == MRL)
1392: {
1393: if ((*s_objet_argument_3).type == MIN)
1394: {
1395: // Conversion de la matrice entière en matrice réelle
1396:
1397: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument_3).objet))
1398: .nombre_lignes; i++)
1399: {
1400: tampon = (*((struct_matrice *) (*s_objet_argument_3).objet))
1401: .tableau[i];
1402:
1403: if (((*((struct_matrice *) (*s_objet_argument_3).objet))
1404: .tableau[i] = malloc(((size_t) (*((struct_matrice *)
1405: (*s_objet_argument_3).objet)).nombre_colonnes) *
1406: sizeof(real8))) == NULL)
1407: {
1408: if (variable_partagee == d_vrai)
1409: {
1410: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1411: .pointeur_variable_partagee_courante).mutex))
1412: != 0)
1413: {
1414: (*s_etat_processus).erreur_systeme = d_es_processus;
1415: return;
1416: }
1417: }
1418:
1419: (*s_etat_processus).erreur_systeme =
1420: d_es_allocation_memoire;
1421: return;
1422: }
1423:
1424: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3)
1425: .objet)).nombre_colonnes; j++)
1426: {
1427: ((real8 **) (*((struct_matrice *) (*s_objet_argument_3)
1428: .objet)).tableau)[i][j] = (real8) (((integer8 *)
1429: tampon)[j]);
1430: }
1431:
1432: free(tampon);
1433: }
1434:
1435: (*((struct_matrice *) (*s_objet_argument_3).objet)).type = 'R';
1436: (*s_objet_argument_3).type = MRL;
1437: }
1438: }
1439: else if ((*s_objet_argument_1).type == MCX)
1440: {
1441: if ((*s_objet_argument_3).type == MIN)
1442: {
1443: // Conversion de la matrice entière en matrice complexe
1444:
1445: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument_3).objet))
1446: .nombre_lignes; i++)
1447: {
1448: tampon = (*((struct_matrice *) (*s_objet_argument_3).objet))
1449: .tableau[i];
1450:
1451: if (((*((struct_matrice *) (*s_objet_argument_3).objet))
1452: .tableau[i] = malloc(((size_t) (*((struct_matrice *)
1453: (*s_objet_argument_3).objet)).nombre_colonnes) *
1454: sizeof(complex16))) == NULL)
1455: {
1456: if (variable_partagee == d_vrai)
1457: {
1458: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1459: .pointeur_variable_partagee_courante).mutex))
1460: != 0)
1461: {
1462: (*s_etat_processus).erreur_systeme = d_es_processus;
1463: return;
1464: }
1465: }
1466:
1467: (*s_etat_processus).erreur_systeme =
1468: d_es_allocation_memoire;
1469: return;
1470: }
1471:
1472: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3)
1473: .objet)).nombre_colonnes; j++)
1474: {
1475: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
1476: .objet)).tableau)[i][j].partie_reelle =
1477: (real8) (((integer8 *) tampon)[j]);
1478: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
1479: .objet)).tableau)[i][j].partie_imaginaire = 0;
1480: }
1481:
1482: free(tampon);
1483: }
1484:
1485: (*((struct_matrice *) (*s_objet_argument_3).objet)).type = 'C';
1486: (*s_objet_argument_3).type = MCX;
1487: }
1488: else if ((*s_objet_argument_3).type == MRL)
1489: {
1490: // Conversion de la matrice réelle en matrice complexe
1491:
1492: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument_3).objet))
1493: .nombre_lignes; i++)
1494: {
1495: tampon = (*((struct_matrice *) (*s_objet_argument_3).objet))
1496: .tableau[i];
1497:
1498: if (((*((struct_matrice *) (*s_objet_argument_3).objet))
1499: .tableau[i] = malloc(((size_t) (*((struct_matrice *)
1500: (*s_objet_argument_3).objet)).nombre_colonnes) *
1501: sizeof(complex16))) == NULL)
1502: {
1503: if (variable_partagee == d_vrai)
1504: {
1505: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1506: .pointeur_variable_partagee_courante).mutex))
1507: != 0)
1508: {
1509: (*s_etat_processus).erreur_systeme = d_es_processus;
1510: return;
1511: }
1512: }
1513:
1514: (*s_etat_processus).erreur_systeme =
1515: d_es_allocation_memoire;
1516: return;
1517: }
1518:
1519: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3)
1520: .objet)).nombre_colonnes; j++)
1521: {
1522: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
1523: .objet)).tableau)[i][j].partie_reelle =
1524: ((real8 *) tampon)[j];
1525: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
1526: .objet)).tableau)[i][j].partie_imaginaire = 0;
1527: }
1528:
1529: free(tampon);
1530: }
1531:
1532: (*((struct_matrice *) (*s_objet_argument_3).objet)).type = 'C';
1533: (*s_objet_argument_3).type = MCX;
1534: }
1535: }
1536:
1537: if ((*s_objet_argument_3).type == MIN)
1538: {
1539: if ((*((struct_matrice *) (*s_objet_argument_1).objet)).nombre_colonnes
1540: != (*((struct_matrice *) (*s_objet_argument_3).objet))
1541: .nombre_colonnes)
1542: {
1543: if (variable_partagee == d_vrai)
1544: {
1545: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1546: .pointeur_variable_partagee_courante).mutex)) != 0)
1547: {
1548: (*s_etat_processus).erreur_systeme = d_es_processus;
1549: return;
1550: }
1551: }
1552:
1553: liberation(s_etat_processus, s_objet_argument_1);
1554: liberation(s_etat_processus, s_objet_argument_2);
1555:
1556: if (presence_nom == d_faux)
1557: {
1558: liberation(s_etat_processus, s_objet_argument_3);
1559: }
1560:
1561: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1562: return;
1563: }
1564:
1565: l_element_courant = (struct_liste_chainee *)
1566: (*s_objet_argument_2).objet;
1567: i = 0;
1568:
1569: while(l_element_courant != NULL)
1570: {
1571: position = (*((integer8 *) (*(*l_element_courant).donnee).objet));
1572:
1573: if ((position < 1) || (position > (integer8) (*((struct_matrice *)
1574: (*s_objet_argument_3).objet)).nombre_lignes))
1575: {
1576: if (variable_partagee == d_vrai)
1577: {
1578: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1579: .pointeur_variable_partagee_courante).mutex)) != 0)
1580: {
1581: (*s_etat_processus).erreur_systeme = d_es_processus;
1582: return;
1583: }
1584: }
1585:
1586: liberation(s_etat_processus, s_objet_argument_1);
1587: liberation(s_etat_processus, s_objet_argument_2);
1588:
1589: if (presence_nom == d_faux)
1590: {
1591: liberation(s_etat_processus, s_objet_argument_3);
1592: }
1593:
1594: (*s_etat_processus).erreur_execution =
1595: d_ex_argument_invalide;
1596: return;
1597: }
1598:
1599: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3).objet))
1600: .nombre_colonnes; j++)
1601: {
1602: ((integer8 **) (*((struct_matrice *) (*s_objet_argument_3)
1603: .objet)).tableau)[position - 1][j] = ((integer8 **)
1604: (*((struct_matrice *) (*s_objet_argument_1).objet))
1605: .tableau)[i][j];
1606: }
1607:
1608: l_element_courant = (*l_element_courant).suivant;
1609: i++;
1610: }
1611: }
1612: else if ((*s_objet_argument_3).type == MRL)
1613: {
1614: if ((*s_objet_argument_1).type == MIN)
1615: {
1616: if ((*((struct_matrice *) (*s_objet_argument_1).objet))
1617: .nombre_colonnes != (*((struct_matrice *)
1618: (*s_objet_argument_3).objet)).nombre_colonnes)
1619: {
1620: if (variable_partagee == d_vrai)
1621: {
1622: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1623: .pointeur_variable_partagee_courante).mutex)) != 0)
1624: {
1625: (*s_etat_processus).erreur_systeme = d_es_processus;
1626: return;
1627: }
1628: }
1629:
1630: liberation(s_etat_processus, s_objet_argument_1);
1631: liberation(s_etat_processus, s_objet_argument_2);
1632:
1633: if (presence_nom == d_faux)
1634: {
1635: liberation(s_etat_processus, s_objet_argument_3);
1636: }
1637:
1638: (*s_etat_processus).erreur_execution =
1639: d_ex_dimensions_invalides;
1640: return;
1641: }
1642:
1643: l_element_courant = (struct_liste_chainee *)
1644: (*s_objet_argument_2).objet;
1645: i = 0;
1646:
1647: while(l_element_courant != NULL)
1648: {
1649: position = (*((integer8 *) (*(*l_element_courant)
1650: .donnee).objet));
1651:
1652: if ((position < 1) || (position > (integer8)
1653: (*((struct_matrice *) (*s_objet_argument_3).objet))
1654: .nombre_lignes))
1655: {
1656: if (variable_partagee == d_vrai)
1657: {
1658: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1659: .pointeur_variable_partagee_courante).mutex))
1660: != 0)
1661: {
1662: (*s_etat_processus).erreur_systeme = d_es_processus;
1663: return;
1664: }
1665: }
1666:
1667: liberation(s_etat_processus, s_objet_argument_1);
1668: liberation(s_etat_processus, s_objet_argument_2);
1669:
1670: if (presence_nom == d_faux)
1671: {
1672: liberation(s_etat_processus, s_objet_argument_3);
1673: }
1674:
1675: (*s_etat_processus).erreur_execution =
1676: d_ex_argument_invalide;
1677: return;
1678: }
1679:
1680: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3)
1681: .objet)).nombre_colonnes; j++)
1682: {
1683: ((real8 **) (*((struct_matrice *) (*s_objet_argument_3)
1684: .objet)).tableau)[position - 1][j] = (real8)
1685: ((integer8 **) (*((struct_matrice *)
1686: (*s_objet_argument_1).objet)).tableau)[i][j];
1687: }
1688:
1689: l_element_courant = (*l_element_courant).suivant;
1690: i++;
1691: }
1692: }
1693: else // Matrice réelle
1694: {
1695: if ((*((struct_matrice *) (*s_objet_argument_1).objet))
1696: .nombre_colonnes != (*((struct_matrice *)
1697: (*s_objet_argument_3).objet)).nombre_colonnes)
1698: {
1699: if (variable_partagee == d_vrai)
1700: {
1701: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1702: .pointeur_variable_partagee_courante).mutex)) != 0)
1703: {
1704: (*s_etat_processus).erreur_systeme = d_es_processus;
1705: return;
1706: }
1707: }
1708:
1709: liberation(s_etat_processus, s_objet_argument_1);
1710: liberation(s_etat_processus, s_objet_argument_2);
1711:
1712: if (presence_nom == d_faux)
1713: {
1714: liberation(s_etat_processus, s_objet_argument_3);
1715: }
1716:
1717: (*s_etat_processus).erreur_execution =
1718: d_ex_dimensions_invalides;
1719: return;
1720: }
1721:
1722: l_element_courant = (struct_liste_chainee *)
1723: (*s_objet_argument_2).objet;
1724: i = 0;
1725:
1726: while(l_element_courant != NULL)
1727: {
1728: position = (*((integer8 *) (*(*l_element_courant)
1729: .donnee).objet));
1730:
1731: if ((position < 1) || (position > (integer8)
1732: (*((struct_matrice *) (*s_objet_argument_3).objet))
1733: .nombre_lignes))
1734: {
1735: if (variable_partagee == d_vrai)
1736: {
1737: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1738: .pointeur_variable_partagee_courante).mutex))
1739: != 0)
1740: {
1741: (*s_etat_processus).erreur_systeme = d_es_processus;
1742: return;
1743: }
1744: }
1745:
1746: liberation(s_etat_processus, s_objet_argument_1);
1747: liberation(s_etat_processus, s_objet_argument_2);
1748:
1749: if (presence_nom == d_faux)
1750: {
1751: liberation(s_etat_processus, s_objet_argument_3);
1752: }
1753:
1754: (*s_etat_processus).erreur_execution =
1755: d_ex_argument_invalide;
1756: return;
1757: }
1758:
1759: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3)
1760: .objet)).nombre_colonnes; j++)
1761: {
1762: ((real8 **) (*((struct_matrice *) (*s_objet_argument_3)
1763: .objet)).tableau)[position - 1][j] =
1764: ((real8 **) (*((struct_matrice *)
1765: (*s_objet_argument_1).objet)).tableau)[i][j];
1766: }
1767:
1768: l_element_courant = (*l_element_courant).suivant;
1769: i++;
1770: }
1771: }
1772: }
1773: else if ((*s_objet_argument_3).type == MCX)
1774: {
1775: if ((*s_objet_argument_1).type == MIN)
1776: {
1777: if ((*((struct_matrice *) (*s_objet_argument_1).objet))
1778: .nombre_colonnes != (*((struct_matrice *)
1779: (*s_objet_argument_3).objet)).nombre_colonnes)
1780: {
1781: if (variable_partagee == d_vrai)
1782: {
1783: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1784: .pointeur_variable_partagee_courante).mutex)) != 0)
1785: {
1786: (*s_etat_processus).erreur_systeme = d_es_processus;
1787: return;
1788: }
1789: }
1790:
1791: liberation(s_etat_processus, s_objet_argument_1);
1792: liberation(s_etat_processus, s_objet_argument_2);
1793:
1794: if (presence_nom == d_faux)
1795: {
1796: liberation(s_etat_processus, s_objet_argument_3);
1797: }
1798:
1799: (*s_etat_processus).erreur_execution =
1800: d_ex_dimensions_invalides;
1801: return;
1802: }
1803:
1804: l_element_courant = (struct_liste_chainee *)
1805: (*s_objet_argument_2).objet;
1806: i = 0;
1807:
1808: while(l_element_courant != NULL)
1809: {
1810: position = (*((integer8 *) (*(*l_element_courant)
1811: .donnee).objet));
1812:
1813: if ((position < 1) || (position > (integer8)
1814: (*((struct_matrice *) (*s_objet_argument_3).objet))
1815: .nombre_lignes))
1816: {
1817: if (variable_partagee == d_vrai)
1818: {
1819: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1820: .pointeur_variable_partagee_courante).mutex))
1821: != 0)
1822: {
1823: (*s_etat_processus).erreur_systeme = d_es_processus;
1824: return;
1825: }
1826: }
1827:
1828: liberation(s_etat_processus, s_objet_argument_1);
1829: liberation(s_etat_processus, s_objet_argument_2);
1830:
1831: if (presence_nom == d_faux)
1832: {
1833: liberation(s_etat_processus, s_objet_argument_3);
1834: }
1835:
1836: (*s_etat_processus).erreur_execution =
1837: d_ex_argument_invalide;
1838: return;
1839: }
1840:
1841: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3)
1842: .objet)).nombre_colonnes; j++)
1843: {
1844: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
1845: .objet)).tableau)[position - 1][j].partie_reelle =
1846: (real8) ((integer8 **) (*((struct_matrice *)
1847: (*s_objet_argument_1).objet)).tableau)[i][j];
1848: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
1849: .objet)).tableau)[position - 1][j]
1850: .partie_imaginaire = 0;
1851: }
1852:
1853: l_element_courant = (*l_element_courant).suivant;
1854: i++;
1855: }
1856: }
1857: else if ((*s_objet_argument_1).type == MRL)
1858: {
1859: if ((*((struct_matrice *) (*s_objet_argument_1).objet))
1860: .nombre_colonnes != (*((struct_matrice *)
1861: (*s_objet_argument_3).objet)).nombre_colonnes)
1862: {
1863: if (variable_partagee == d_vrai)
1864: {
1865: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1866: .pointeur_variable_partagee_courante).mutex)) != 0)
1867: {
1868: (*s_etat_processus).erreur_systeme = d_es_processus;
1869: return;
1870: }
1871: }
1872:
1873: liberation(s_etat_processus, s_objet_argument_1);
1874: liberation(s_etat_processus, s_objet_argument_2);
1875:
1876: if (presence_nom == d_faux)
1877: {
1878: liberation(s_etat_processus, s_objet_argument_3);
1879: }
1880:
1881: (*s_etat_processus).erreur_execution =
1882: d_ex_dimensions_invalides;
1883: return;
1884: }
1885:
1886: l_element_courant = (struct_liste_chainee *)
1887: (*s_objet_argument_2).objet;
1888: i = 0;
1889:
1890: while(l_element_courant != NULL)
1891: {
1892: position = (*((integer8 *) (*(*l_element_courant)
1893: .donnee).objet));
1894:
1895: if ((position < 1) || (position > (integer8)
1896: (*((struct_matrice *) (*s_objet_argument_3).objet))
1897: .nombre_lignes))
1898: {
1899: if (variable_partagee == d_vrai)
1900: {
1901: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1902: .pointeur_variable_partagee_courante).mutex))
1903: != 0)
1904: {
1905: (*s_etat_processus).erreur_systeme = d_es_processus;
1906: return;
1907: }
1908: }
1909:
1910: liberation(s_etat_processus, s_objet_argument_1);
1911: liberation(s_etat_processus, s_objet_argument_2);
1912:
1913: if (presence_nom == d_faux)
1914: {
1915: liberation(s_etat_processus, s_objet_argument_3);
1916: }
1917:
1918: (*s_etat_processus).erreur_execution =
1919: d_ex_argument_invalide;
1920: return;
1921: }
1922:
1923: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3)
1924: .objet)).nombre_colonnes; j++)
1925: {
1926: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
1927: .objet)).tableau)[position - 1][j].partie_reelle =
1928: ((real8 **) (*((struct_matrice *)
1929: (*s_objet_argument_1).objet)).tableau)[i][j];
1930: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
1931: .objet)).tableau)[position - 1][j]
1932: .partie_imaginaire = 0;
1933: }
1934:
1935: l_element_courant = (*l_element_courant).suivant;
1936: i++;
1937: }
1938: }
1939: else // Matrice complexe
1940: {
1941: if ((*((struct_matrice *) (*s_objet_argument_1).objet))
1942: .nombre_colonnes != (*((struct_matrice *)
1943: (*s_objet_argument_3).objet)).nombre_colonnes)
1944: {
1945: if (variable_partagee == d_vrai)
1946: {
1947: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1948: .pointeur_variable_partagee_courante).mutex)) != 0)
1949: {
1950: (*s_etat_processus).erreur_systeme = d_es_processus;
1951: return;
1952: }
1953: }
1954:
1955: liberation(s_etat_processus, s_objet_argument_1);
1956: liberation(s_etat_processus, s_objet_argument_2);
1957:
1958: if (presence_nom == d_faux)
1959: {
1960: liberation(s_etat_processus, s_objet_argument_3);
1961: }
1962:
1963: (*s_etat_processus).erreur_execution =
1964: d_ex_dimensions_invalides;
1965: return;
1966: }
1967:
1968: l_element_courant = (struct_liste_chainee *)
1969: (*s_objet_argument_2).objet;
1970: i = 0;
1971:
1972: while(l_element_courant != NULL)
1973: {
1974: position = (*((integer8 *) (*(*l_element_courant)
1975: .donnee).objet));
1976:
1977: if ((position < 1) || (position > (integer8)
1978: (*((struct_matrice *) (*s_objet_argument_3).objet))
1979: .nombre_lignes))
1980: {
1981: if (variable_partagee == d_vrai)
1982: {
1983: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1984: .pointeur_variable_partagee_courante).mutex))
1985: != 0)
1986: {
1987: (*s_etat_processus).erreur_systeme = d_es_processus;
1988: return;
1989: }
1990: }
1991:
1992: liberation(s_etat_processus, s_objet_argument_1);
1993: liberation(s_etat_processus, s_objet_argument_2);
1994:
1995: if (presence_nom == d_faux)
1996: {
1997: liberation(s_etat_processus, s_objet_argument_3);
1998: }
1999:
2000: (*s_etat_processus).erreur_execution =
2001: d_ex_argument_invalide;
2002: return;
2003: }
2004:
2005: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3)
2006: .objet)).nombre_colonnes; j++)
2007: {
2008: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
2009: .objet)).tableau)[position - 1][j].partie_reelle =
2010: ((complex16 **) (*((struct_matrice *)
2011: (*s_objet_argument_1).objet)).tableau)[i][j]
2012: .partie_reelle;
2013: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
2014: .objet)).tableau)[position - 1][j]
2015: .partie_imaginaire = ((complex16 **)
2016: (*((struct_matrice *) (*s_objet_argument_1).objet))
2017: .tableau)[i][j].partie_imaginaire;
2018: }
2019:
2020: l_element_courant = (*l_element_courant).suivant;
2021: i++;
2022: }
2023: }
2024: }
2025: else
2026: {
2027: if (variable_partagee == d_vrai)
2028: {
2029: if (pthread_mutex_unlock(&((*(*s_etat_processus)
2030: .pointeur_variable_partagee_courante).mutex)) != 0)
2031: {
2032: (*s_etat_processus).erreur_systeme = d_es_processus;
2033: return;
2034: }
2035: }
2036:
2037: liberation(s_etat_processus, s_objet_argument_1);
2038: liberation(s_etat_processus, s_objet_argument_2);
2039:
2040: if (presence_nom == d_faux)
2041: {
2042: liberation(s_etat_processus, s_objet_argument_3);
2043: }
2044:
2045: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
2046: return;
2047: }
2048:
2049: if (presence_nom == d_faux)
2050: {
2051: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2052: s_objet_argument_3) == d_erreur)
2053: {
2054: return;
2055: }
2056: }
2057: else if (variable_partagee == d_vrai)
2058: {
2059: (*(*s_etat_processus).pointeur_variable_partagee_courante).objet
2060: = s_objet_argument_3;
2061:
2062: if (pthread_mutex_unlock(&((*(*s_etat_processus)
2063: .pointeur_variable_partagee_courante).mutex)) != 0)
2064: {
2065: (*s_etat_processus).erreur_systeme = d_es_processus;
2066: return;
2067: }
2068: }
2069:
2070: liberation(s_etat_processus, s_objet_argument_1);
2071: liberation(s_etat_processus, s_objet_argument_2);
2072:
2073: return;
2074: }
2075:
2076: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_p5.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src