1: /*
2: ================================================================================
3: RPL/2 (R) version 4.1.6
4: Copyright (C) 1989-2012 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: unsigned long i;
249: unsigned long j;
250: unsigned long 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 (pthread_mutex_lock(&((*(*s_etat_processus)
410: .s_liste_variables_partagees).mutex)) != 0)
411: {
412: (*s_etat_processus).erreur_systeme = d_es_processus;
413: return;
414: }
415:
416: if (recherche_variable_partagee(s_etat_processus,
417: (*(*s_etat_processus).pointeur_variable_courante).nom,
418: (*(*s_etat_processus).pointeur_variable_courante)
419: .variable_partagee, (*(*s_etat_processus)
420: .pointeur_variable_courante).origine) == d_faux)
421: {
422: if (pthread_mutex_unlock(&((*(*s_etat_processus)
423: .s_liste_variables_partagees).mutex)) != 0)
424: {
425: (*s_etat_processus).erreur_systeme = d_es_processus;
426: return;
427: }
428:
429: (*s_etat_processus).erreur_systeme = d_es;
430: (*s_etat_processus).erreur_execution =
431: d_ex_variable_non_definie;
432:
433: liberation(s_etat_processus, s_objet_argument_1);
434: liberation(s_etat_processus, s_objet_argument_2);
435:
436: return;
437: }
438:
439: s_objet_argument_3 = (*(*s_etat_processus)
440: .s_liste_variables_partagees).table[(*(*s_etat_processus)
441: .s_liste_variables_partagees).position_variable].objet;
442: variable_partagee = d_vrai;
443: }
444:
445: if ((s_copie_argument_3 = copie_objet(s_etat_processus,
446: s_objet_argument_3, 'O')) == NULL)
447: {
448: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
449: return;
450: }
451:
452: liberation(s_etat_processus, s_objet_argument_3);
453: s_objet_argument_3 = s_copie_argument_3;
454:
455: (*(*s_etat_processus).pointeur_variable_courante).objet =
456: s_objet_argument_3;
457: }
458: else
459: {
460: presence_nom = d_faux;
461:
462: if ((s_copie_argument_3 = copie_objet(s_etat_processus,
463: s_objet_argument_3, 'O')) == NULL)
464: {
465: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
466: return;
467: }
468:
469: liberation(s_etat_processus, s_objet_argument_3);
470: s_objet_argument_3 = s_copie_argument_3;
471: }
472:
473: if ((*s_objet_argument_1).type == MRL)
474: {
475: if ((*s_objet_argument_3).type == MIN)
476: {
477: // Conversion de la matrice entière en matrice réelle
478:
479: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument_3).objet))
480: .nombre_lignes; i++)
481: {
482: tampon = (*((struct_matrice *) (*s_objet_argument_3).objet))
483: .tableau[i];
484:
485: if (((*((struct_matrice *) (*s_objet_argument_3).objet))
486: .tableau[i] = malloc((*((struct_matrice *)
487: (*s_objet_argument_3).objet)).nombre_colonnes *
488: sizeof(real8))) == NULL)
489: {
490: if (variable_partagee == d_vrai)
491: {
492: if (pthread_mutex_unlock(&((*(*s_etat_processus)
493: .s_liste_variables_partagees).mutex)) != 0)
494: {
495: (*s_etat_processus).erreur_systeme = d_es_processus;
496: return;
497: }
498: }
499:
500: (*s_etat_processus).erreur_systeme =
501: d_es_allocation_memoire;
502: return;
503: }
504:
505: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3)
506: .objet)).nombre_colonnes; j++)
507: {
508: ((real8 **) (*((struct_matrice *) (*s_objet_argument_3)
509: .objet)).tableau)[i][j] = (real8) (((integer8 *)
510: tampon)[j]);
511: }
512:
513: free(tampon);
514: }
515:
516: (*((struct_matrice *) (*s_objet_argument_3).objet)).type = 'R';
517: (*s_objet_argument_3).type = MRL;
518: }
519: }
520: else if ((*s_objet_argument_1).type == MCX)
521: {
522: if ((*s_objet_argument_3).type == MIN)
523: {
524: // Conversion de la matrice entière en matrice complexe
525:
526: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument_3).objet))
527: .nombre_lignes; i++)
528: {
529: tampon = (*((struct_matrice *) (*s_objet_argument_3).objet))
530: .tableau[i];
531:
532: if (((*((struct_matrice *) (*s_objet_argument_3).objet))
533: .tableau[i] = malloc((*((struct_matrice *)
534: (*s_objet_argument_3).objet)).nombre_colonnes *
535: sizeof(complex16))) == NULL)
536: {
537: if (variable_partagee == d_vrai)
538: {
539: if (pthread_mutex_unlock(&((*(*s_etat_processus)
540: .s_liste_variables_partagees).mutex)) != 0)
541: {
542: (*s_etat_processus).erreur_systeme = d_es_processus;
543: return;
544: }
545: }
546:
547: (*s_etat_processus).erreur_systeme =
548: d_es_allocation_memoire;
549: return;
550: }
551:
552: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3)
553: .objet)).nombre_colonnes; j++)
554: {
555: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
556: .objet)).tableau)[i][j].partie_reelle =
557: (real8) (((integer8 *) tampon)[j]);
558: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
559: .objet)).tableau)[i][j].partie_imaginaire = 0;
560: }
561:
562: free(tampon);
563: }
564:
565: (*((struct_matrice *) (*s_objet_argument_3).objet)).type = 'C';
566: (*s_objet_argument_3).type = MCX;
567: }
568: else if ((*s_objet_argument_3).type == MRL)
569: {
570: // Conversion de la matrice réelle en matrice complexe
571:
572: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument_3).objet))
573: .nombre_lignes; i++)
574: {
575: tampon = (*((struct_matrice *) (*s_objet_argument_3).objet))
576: .tableau[i];
577:
578: if (((*((struct_matrice *) (*s_objet_argument_3).objet))
579: .tableau[i] = malloc((*((struct_matrice *)
580: (*s_objet_argument_3).objet)).nombre_colonnes *
581: sizeof(complex16))) == NULL)
582: {
583: if (variable_partagee == d_vrai)
584: {
585: if (pthread_mutex_unlock(&((*(*s_etat_processus)
586: .s_liste_variables_partagees).mutex)) != 0)
587: {
588: (*s_etat_processus).erreur_systeme = d_es_processus;
589: return;
590: }
591: }
592:
593: (*s_etat_processus).erreur_systeme =
594: d_es_allocation_memoire;
595: return;
596: }
597:
598: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3)
599: .objet)).nombre_colonnes; j++)
600: {
601: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
602: .objet)).tableau)[i][j].partie_reelle =
603: ((real8 *) tampon)[j];
604: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
605: .objet)).tableau)[i][j].partie_imaginaire = 0;
606: }
607:
608: free(tampon);
609: }
610:
611: (*((struct_matrice *) (*s_objet_argument_3).objet)).type = 'C';
612: (*s_objet_argument_3).type = MCX;
613: }
614: }
615:
616: if ((*s_objet_argument_3).type == MIN)
617: {
618: if ((*((struct_matrice *) (*s_objet_argument_1).objet)).nombre_lignes
619: != (*((struct_matrice *) (*s_objet_argument_3).objet))
620: .nombre_lignes)
621: {
622: if (variable_partagee == d_vrai)
623: {
624: if (pthread_mutex_unlock(&((*(*s_etat_processus)
625: .s_liste_variables_partagees).mutex)) != 0)
626: {
627: (*s_etat_processus).erreur_systeme = d_es_processus;
628: return;
629: }
630: }
631:
632: liberation(s_etat_processus, s_objet_argument_1);
633: liberation(s_etat_processus, s_objet_argument_2);
634:
635: if (presence_nom == d_faux)
636: {
637: liberation(s_etat_processus, s_objet_argument_3);
638: }
639:
640: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
641: return;
642: }
643:
644: l_element_courant = (struct_liste_chainee *)
645: (*s_objet_argument_2).objet;
646: i = 0;
647:
648: while(l_element_courant != NULL)
649: {
650: position = (*((integer8 *) (*(*l_element_courant).donnee).objet));
651:
652: if ((position < 1) || (position > (integer8) (*((struct_matrice *)
653: (*s_objet_argument_3).objet)).nombre_colonnes))
654: {
655: if (variable_partagee == d_vrai)
656: {
657: if (pthread_mutex_unlock(&((*(*s_etat_processus)
658: .s_liste_variables_partagees).mutex)) != 0)
659: {
660: (*s_etat_processus).erreur_systeme = d_es_processus;
661: return;
662: }
663: }
664:
665: liberation(s_etat_processus, s_objet_argument_1);
666: liberation(s_etat_processus, s_objet_argument_2);
667:
668: if (presence_nom == d_faux)
669: {
670: liberation(s_etat_processus, s_objet_argument_3);
671: }
672:
673: (*s_etat_processus).erreur_execution =
674: d_ex_argument_invalide;
675: return;
676: }
677:
678: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3).objet))
679: .nombre_lignes; j++)
680: {
681: ((integer8 **) (*((struct_matrice *) (*s_objet_argument_3)
682: .objet)).tableau)[j][position - 1] = ((integer8 **)
683: (*((struct_matrice *) (*s_objet_argument_1).objet))
684: .tableau)[j][i];
685: }
686:
687: l_element_courant = (*l_element_courant).suivant;
688: i++;
689: }
690: }
691: else if ((*s_objet_argument_3).type == MRL)
692: {
693: if ((*s_objet_argument_1).type == MIN)
694: {
695: if ((*((struct_matrice *) (*s_objet_argument_1).objet))
696: .nombre_lignes != (*((struct_matrice *)
697: (*s_objet_argument_3).objet)).nombre_lignes)
698: {
699: if (variable_partagee == d_vrai)
700: {
701: if (pthread_mutex_unlock(&((*(*s_etat_processus)
702: .s_liste_variables_partagees).mutex)) != 0)
703: {
704: (*s_etat_processus).erreur_systeme = d_es_processus;
705: return;
706: }
707: }
708:
709: liberation(s_etat_processus, s_objet_argument_1);
710: liberation(s_etat_processus, s_objet_argument_2);
711:
712: if (presence_nom == d_faux)
713: {
714: liberation(s_etat_processus, s_objet_argument_3);
715: }
716:
717: (*s_etat_processus).erreur_execution =
718: d_ex_dimensions_invalides;
719: return;
720: }
721:
722: l_element_courant = (struct_liste_chainee *)
723: (*s_objet_argument_2).objet;
724: i = 0;
725:
726: while(l_element_courant != NULL)
727: {
728: position = (*((integer8 *) (*(*l_element_courant)
729: .donnee).objet));
730:
731: if ((position < 1) || (position > (integer8)
732: (*((struct_matrice *)(*s_objet_argument_3).objet))
733: .nombre_colonnes))
734: {
735: if (variable_partagee == d_vrai)
736: {
737: if (pthread_mutex_unlock(&((*(*s_etat_processus)
738: .s_liste_variables_partagees).mutex)) != 0)
739: {
740: (*s_etat_processus).erreur_systeme = d_es_processus;
741: return;
742: }
743: }
744:
745: liberation(s_etat_processus, s_objet_argument_1);
746: liberation(s_etat_processus, s_objet_argument_2);
747:
748: if (presence_nom == d_faux)
749: {
750: liberation(s_etat_processus, s_objet_argument_3);
751: }
752:
753: (*s_etat_processus).erreur_execution =
754: d_ex_erreur_type_argument;
755: return;
756: }
757:
758: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3)
759: .objet)).nombre_lignes; j++)
760: {
761: ((real8 **) (*((struct_matrice *) (*s_objet_argument_3)
762: .objet)).tableau)[j][position - 1] = (real8)
763: ((integer8 **) (*((struct_matrice *)
764: (*s_objet_argument_1).objet)).tableau)[j][i];
765: }
766:
767: l_element_courant = (*l_element_courant).suivant;
768: i++;
769: }
770: }
771: else // Matrice réelle
772: {
773: if ((*((struct_matrice *) (*s_objet_argument_1).objet))
774: .nombre_lignes != (*((struct_matrice *)
775: (*s_objet_argument_3).objet)).nombre_lignes)
776: {
777: if (variable_partagee == d_vrai)
778: {
779: if (pthread_mutex_unlock(&((*(*s_etat_processus)
780: .s_liste_variables_partagees).mutex)) != 0)
781: {
782: (*s_etat_processus).erreur_systeme = d_es_processus;
783: return;
784: }
785: }
786:
787: liberation(s_etat_processus, s_objet_argument_1);
788: liberation(s_etat_processus, s_objet_argument_2);
789:
790: if (presence_nom == d_faux)
791: {
792: liberation(s_etat_processus, s_objet_argument_3);
793: }
794:
795: (*s_etat_processus).erreur_execution =
796: d_ex_dimensions_invalides;
797: return;
798: }
799:
800: l_element_courant = (struct_liste_chainee *)
801: (*s_objet_argument_2).objet;
802: i = 0;
803:
804: while(l_element_courant != NULL)
805: {
806: position = (*((integer8 *) (*(*l_element_courant)
807: .donnee).objet));
808:
809: if ((position < 1) || (position > (integer8)
810: (*((struct_matrice *) (*s_objet_argument_3).objet))
811: .nombre_colonnes))
812: {
813: if (variable_partagee == d_vrai)
814: {
815: if (pthread_mutex_unlock(&((*(*s_etat_processus)
816: .s_liste_variables_partagees).mutex)) != 0)
817: {
818: (*s_etat_processus).erreur_systeme = d_es_processus;
819: return;
820: }
821: }
822:
823: liberation(s_etat_processus, s_objet_argument_1);
824: liberation(s_etat_processus, s_objet_argument_2);
825:
826: if (presence_nom == d_faux)
827: {
828: liberation(s_etat_processus, s_objet_argument_3);
829: }
830:
831: (*s_etat_processus).erreur_execution =
832: d_ex_argument_invalide;
833: return;
834: }
835:
836: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3)
837: .objet)).nombre_lignes; j++)
838: {
839: ((real8 **) (*((struct_matrice *) (*s_objet_argument_3)
840: .objet)).tableau)[j][position - 1] =
841: ((real8 **) (*((struct_matrice *)
842: (*s_objet_argument_1).objet)).tableau)[j][i];
843: }
844:
845: l_element_courant = (*l_element_courant).suivant;
846: i++;
847: }
848: }
849: }
850: else if ((*s_objet_argument_3).type == MCX)
851: {
852: if ((*s_objet_argument_1).type == MIN)
853: {
854: if ((*((struct_matrice *) (*s_objet_argument_1).objet))
855: .nombre_lignes != (*((struct_matrice *)
856: (*s_objet_argument_3).objet)).nombre_lignes)
857: {
858: if (variable_partagee == d_vrai)
859: {
860: if (pthread_mutex_unlock(&((*(*s_etat_processus)
861: .s_liste_variables_partagees).mutex)) != 0)
862: {
863: (*s_etat_processus).erreur_systeme = d_es_processus;
864: return;
865: }
866: }
867:
868: liberation(s_etat_processus, s_objet_argument_1);
869: liberation(s_etat_processus, s_objet_argument_2);
870:
871: if (presence_nom == d_faux)
872: {
873: liberation(s_etat_processus, s_objet_argument_3);
874: }
875:
876: (*s_etat_processus).erreur_execution =
877: d_ex_dimensions_invalides;
878: return;
879: }
880:
881: l_element_courant = (struct_liste_chainee *)
882: (*s_objet_argument_2).objet;
883: i = 0;
884:
885: while(l_element_courant != NULL)
886: {
887: position = (*((integer8 *) (*(*l_element_courant)
888: .donnee).objet));
889:
890: if ((position < 1) || (position > (integer8)
891: (*((struct_matrice *) (*s_objet_argument_3).objet))
892: .nombre_colonnes))
893: {
894: if (variable_partagee == d_vrai)
895: {
896: if (pthread_mutex_unlock(&((*(*s_etat_processus)
897: .s_liste_variables_partagees).mutex)) != 0)
898: {
899: (*s_etat_processus).erreur_systeme = d_es_processus;
900: return;
901: }
902: }
903:
904: liberation(s_etat_processus, s_objet_argument_1);
905: liberation(s_etat_processus, s_objet_argument_2);
906:
907: if (presence_nom == d_faux)
908: {
909: liberation(s_etat_processus, s_objet_argument_3);
910: }
911:
912: (*s_etat_processus).erreur_execution =
913: d_ex_argument_invalide;
914: return;
915: }
916:
917: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3)
918: .objet)).nombre_lignes; j++)
919: {
920: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
921: .objet)).tableau)[j][position - 1].partie_reelle =
922: (real8) ((integer8 **) (*((struct_matrice *)
923: (*s_objet_argument_1).objet)).tableau)[j][i];
924: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
925: .objet)).tableau)[j][position - 1]
926: .partie_imaginaire = 0;
927: }
928:
929: l_element_courant = (*l_element_courant).suivant;
930: i++;
931: }
932: }
933: else if ((*s_objet_argument_1).type == MRL)
934: {
935: if ((*((struct_matrice *) (*s_objet_argument_1).objet))
936: .nombre_lignes != (*((struct_matrice *)
937: (*s_objet_argument_3).objet)).nombre_lignes)
938: {
939: if (variable_partagee == d_vrai)
940: {
941: if (pthread_mutex_unlock(&((*(*s_etat_processus)
942: .s_liste_variables_partagees).mutex)) != 0)
943: {
944: (*s_etat_processus).erreur_systeme = d_es_processus;
945: return;
946: }
947: }
948:
949: liberation(s_etat_processus, s_objet_argument_1);
950: liberation(s_etat_processus, s_objet_argument_2);
951:
952: if (presence_nom == d_faux)
953: {
954: liberation(s_etat_processus, s_objet_argument_3);
955: }
956:
957: (*s_etat_processus).erreur_execution =
958: d_ex_dimensions_invalides;
959: return;
960: }
961:
962: l_element_courant = (struct_liste_chainee *)
963: (*s_objet_argument_2).objet;
964: i = 0;
965:
966: while(l_element_courant != NULL)
967: {
968: position = (*((integer8 *) (*(*l_element_courant)
969: .donnee).objet));
970:
971: if ((position < 1) || (position > (integer8)
972: (*((struct_matrice *) (*s_objet_argument_3).objet))
973: .nombre_colonnes))
974: {
975: if (variable_partagee == d_vrai)
976: {
977: if (pthread_mutex_unlock(&((*(*s_etat_processus)
978: .s_liste_variables_partagees).mutex)) != 0)
979: {
980: (*s_etat_processus).erreur_systeme = d_es_processus;
981: return;
982: }
983: }
984:
985: liberation(s_etat_processus, s_objet_argument_1);
986: liberation(s_etat_processus, s_objet_argument_2);
987:
988: if (presence_nom == d_faux)
989: {
990: liberation(s_etat_processus, s_objet_argument_3);
991: }
992:
993: (*s_etat_processus).erreur_execution =
994: d_ex_argument_invalide;
995: return;
996: }
997:
998: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3)
999: .objet)).nombre_lignes; j++)
1000: {
1001: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
1002: .objet)).tableau)[j][position - 1].partie_reelle =
1003: ((real8 **) (*((struct_matrice *)
1004: (*s_objet_argument_1).objet)).tableau)[j][i];
1005: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
1006: .objet)).tableau)[j][position - 1]
1007: .partie_imaginaire = 0;
1008: }
1009:
1010: l_element_courant = (*l_element_courant).suivant;
1011: i++;
1012: }
1013: }
1014: else // Matrice complexe
1015: {
1016: if ((*((struct_matrice *) (*s_objet_argument_1).objet))
1017: .nombre_lignes != (*((struct_matrice *)
1018: (*s_objet_argument_3).objet)).nombre_lignes)
1019: {
1020: if (variable_partagee == d_vrai)
1021: {
1022: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1023: .s_liste_variables_partagees).mutex)) != 0)
1024: {
1025: (*s_etat_processus).erreur_systeme = d_es_processus;
1026: return;
1027: }
1028: }
1029:
1030: liberation(s_etat_processus, s_objet_argument_1);
1031: liberation(s_etat_processus, s_objet_argument_2);
1032:
1033: if (presence_nom == d_faux)
1034: {
1035: liberation(s_etat_processus, s_objet_argument_3);
1036: }
1037:
1038: (*s_etat_processus).erreur_execution =
1039: d_ex_dimensions_invalides;
1040: return;
1041: }
1042:
1043: l_element_courant = (struct_liste_chainee *)
1044: (*s_objet_argument_2).objet;
1045: i = 0;
1046:
1047: while(l_element_courant != NULL)
1048: {
1049: position = (*((integer8 *) (*(*l_element_courant)
1050: .donnee).objet));
1051:
1052: if ((position < 1) || (position > (integer8)
1053: (*((struct_matrice *) (*s_objet_argument_3).objet))
1054: .nombre_colonnes))
1055: {
1056: if (variable_partagee == d_vrai)
1057: {
1058: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1059: .s_liste_variables_partagees).mutex)) != 0)
1060: {
1061: (*s_etat_processus).erreur_systeme = d_es_processus;
1062: return;
1063: }
1064: }
1065:
1066: liberation(s_etat_processus, s_objet_argument_1);
1067: liberation(s_etat_processus, s_objet_argument_2);
1068:
1069: if (presence_nom == d_faux)
1070: {
1071: liberation(s_etat_processus, s_objet_argument_3);
1072: }
1073:
1074: (*s_etat_processus).erreur_execution =
1075: d_ex_argument_invalide;
1076: return;
1077: }
1078:
1079: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3)
1080: .objet)).nombre_lignes; j++)
1081: {
1082: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
1083: .objet)).tableau)[j][position - 1].partie_reelle =
1084: ((complex16 **) (*((struct_matrice *)
1085: (*s_objet_argument_1).objet)).tableau)[j][i]
1086: .partie_reelle;
1087: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
1088: .objet)).tableau)[j][position - 1]
1089: .partie_imaginaire = ((complex16 **)
1090: (*((struct_matrice *) (*s_objet_argument_1).objet))
1091: .tableau)[j][i].partie_imaginaire;
1092: }
1093:
1094: l_element_courant = (*l_element_courant).suivant;
1095: i++;
1096: }
1097: }
1098: }
1099: else
1100: {
1101: if (variable_partagee == d_vrai)
1102: {
1103: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1104: .s_liste_variables_partagees).mutex)) != 0)
1105: {
1106: (*s_etat_processus).erreur_systeme = d_es_processus;
1107: return;
1108: }
1109: }
1110:
1111: liberation(s_etat_processus, s_objet_argument_1);
1112: liberation(s_etat_processus, s_objet_argument_2);
1113:
1114: if (presence_nom == d_faux)
1115: {
1116: liberation(s_etat_processus, s_objet_argument_3);
1117: }
1118:
1119: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1120: return;
1121: }
1122:
1123: if (presence_nom == d_faux)
1124: {
1125: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1126: s_objet_argument_3) == d_erreur)
1127: {
1128: return;
1129: }
1130: }
1131: else if (variable_partagee == d_vrai)
1132: {
1133: (*(*s_etat_processus).s_liste_variables_partagees).table
1134: [(*(*s_etat_processus).s_liste_variables_partagees)
1135: .position_variable].objet = s_objet_argument_3;
1136:
1137: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1138: .s_liste_variables_partagees).mutex)) != 0)
1139: {
1140: (*s_etat_processus).erreur_systeme = d_es_processus;
1141: return;
1142: }
1143: }
1144:
1145: liberation(s_etat_processus, s_objet_argument_1);
1146: liberation(s_etat_processus, s_objet_argument_2);
1147:
1148: return;
1149: }
1150:
1151:
1152: /*
1153: ================================================================================
1154: Fonction 'putr'
1155: ================================================================================
1156: Entrées :
1157: --------------------------------------------------------------------------------
1158: Sorties :
1159: --------------------------------------------------------------------------------
1160: Effets de bord : néant
1161: ================================================================================
1162: */
1163:
1164: void
1165: instruction_putr(struct_processus *s_etat_processus)
1166: {
1167: integer8 position;
1168:
1169: logical1 presence_nom;
1170: logical1 variable_partagee;
1171:
1172: struct_liste_chainee *l_element_courant;
1173:
1174: struct_objet *s_copie_argument_3;
1175: struct_objet *s_objet_argument_1;
1176: struct_objet *s_objet_argument_2;
1177: struct_objet *s_objet_argument_3;
1178:
1179: unsigned long i;
1180: unsigned long j;
1181: unsigned long nombre_elements;
1182:
1183: void *tampon;
1184:
1185: (*s_etat_processus).erreur_execution = d_ex;
1186:
1187: if ((*s_etat_processus).affichage_arguments == 'Y')
1188: {
1189: printf("\n PUTR ");
1190:
1191: if ((*s_etat_processus).langue == 'F')
1192: {
1193: printf("(change une ligne)\n\n");
1194: }
1195: else
1196: {
1197: printf("(change row)\n\n");
1198: }
1199:
1200: printf(" 3: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
1201: printf(" 2: %s\n", d_LST);
1202: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
1203: printf("-> 1: %s, %s, %s\n\n", d_MIN, d_MRL, d_MCX);
1204:
1205: printf(" 3: %s\n", d_NOM);
1206: printf(" 2: %s\n", d_LST);
1207: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
1208:
1209: return;
1210: }
1211: else if ((*s_etat_processus).test_instruction == 'Y')
1212: {
1213: (*s_etat_processus).nombre_arguments = -1;
1214: return;
1215: }
1216:
1217: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1218: {
1219: if (empilement_pile_last(s_etat_processus, 3) == d_erreur)
1220: {
1221: return;
1222: }
1223: }
1224:
1225: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1226: &s_objet_argument_1) == d_erreur)
1227: {
1228: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1229: return;
1230: }
1231:
1232: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1233: &s_objet_argument_2) == d_erreur)
1234: {
1235: liberation(s_etat_processus, s_objet_argument_1);
1236:
1237: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1238: return;
1239: }
1240:
1241: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1242: &s_objet_argument_3) == d_erreur)
1243: {
1244: liberation(s_etat_processus, s_objet_argument_1);
1245: liberation(s_etat_processus, s_objet_argument_2);
1246:
1247: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1248: return;
1249: }
1250:
1251: if (((*s_objet_argument_1).type != MIN) &&
1252: ((*s_objet_argument_1).type != MRL) &&
1253: ((*s_objet_argument_1).type != MCX))
1254: {
1255: liberation(s_etat_processus, s_objet_argument_1);
1256: liberation(s_etat_processus, s_objet_argument_2);
1257: liberation(s_etat_processus, s_objet_argument_3);
1258:
1259: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1260: return;
1261: }
1262:
1263: if ((*s_objet_argument_2).type != LST)
1264: {
1265: liberation(s_etat_processus, s_objet_argument_1);
1266: liberation(s_etat_processus, s_objet_argument_2);
1267: liberation(s_etat_processus, s_objet_argument_3);
1268:
1269: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1270: return;
1271: }
1272:
1273: nombre_elements = 0;
1274: l_element_courant = (struct_liste_chainee *) (*s_objet_argument_2).objet;
1275:
1276: while(l_element_courant != NULL)
1277: {
1278: if ((*(*l_element_courant).donnee).type != INT)
1279: {
1280: liberation(s_etat_processus, s_objet_argument_1);
1281: liberation(s_etat_processus, s_objet_argument_2);
1282: liberation(s_etat_processus, s_objet_argument_3);
1283:
1284: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1285: return;
1286: }
1287:
1288: nombre_elements++;
1289: l_element_courant = (*l_element_courant).suivant;
1290: }
1291:
1292: if ((nombre_elements == 0) || (nombre_elements != (*((struct_matrice *)
1293: (*s_objet_argument_1).objet)).nombre_lignes))
1294: {
1295: liberation(s_etat_processus, s_objet_argument_1);
1296: liberation(s_etat_processus, s_objet_argument_2);
1297: liberation(s_etat_processus, s_objet_argument_3);
1298:
1299: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1300: return;
1301: }
1302:
1303: variable_partagee = d_faux;
1304:
1305: if ((*s_objet_argument_3).type == NOM)
1306: {
1307: presence_nom = d_vrai;
1308:
1309: if (recherche_variable(s_etat_processus, (*((struct_nom *)
1310: (*s_objet_argument_3).objet)).nom) == d_faux)
1311: {
1312: (*s_etat_processus).erreur_systeme = d_es;
1313: (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
1314:
1315: liberation(s_etat_processus, s_objet_argument_1);
1316: liberation(s_etat_processus, s_objet_argument_2);
1317: liberation(s_etat_processus, s_objet_argument_3);
1318:
1319: return;
1320: }
1321:
1322: if ((*(*s_etat_processus).pointeur_variable_courante)
1323: .variable_verrouillee == d_vrai)
1324: {
1325: (*s_etat_processus).erreur_execution = d_ex_variable_verrouillee;
1326:
1327: liberation(s_etat_processus, s_objet_argument_1);
1328: liberation(s_etat_processus, s_objet_argument_2);
1329: liberation(s_etat_processus, s_objet_argument_3);
1330:
1331: return;
1332: }
1333:
1334: liberation(s_etat_processus, s_objet_argument_3);
1335: s_objet_argument_3 = (*(*s_etat_processus).pointeur_variable_courante)
1336: .objet;
1337:
1338: if (s_objet_argument_3 == NULL)
1339: {
1340: if (pthread_mutex_lock(&((*(*s_etat_processus)
1341: .s_liste_variables_partagees).mutex)) != 0)
1342: {
1343: (*s_etat_processus).erreur_systeme = d_es_processus;
1344: return;
1345: }
1346:
1347: if (recherche_variable_partagee(s_etat_processus,
1348: (*(*s_etat_processus).pointeur_variable_courante).nom,
1349: (*(*s_etat_processus).pointeur_variable_courante)
1350: .variable_partagee, (*(*s_etat_processus)
1351: .pointeur_variable_courante).origine) == d_faux)
1352: {
1353: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1354: .s_liste_variables_partagees).mutex)) != 0)
1355: {
1356: (*s_etat_processus).erreur_systeme = d_es_processus;
1357: return;
1358: }
1359:
1360: (*s_etat_processus).erreur_systeme = d_es;
1361: (*s_etat_processus).erreur_execution =
1362: d_ex_variable_non_definie;
1363:
1364: liberation(s_etat_processus, s_objet_argument_1);
1365: liberation(s_etat_processus, s_objet_argument_2);
1366:
1367: return;
1368: }
1369:
1370: s_objet_argument_3 = (*(*s_etat_processus)
1371: .s_liste_variables_partagees).table[(*(*s_etat_processus)
1372: .s_liste_variables_partagees).position_variable].objet;
1373: variable_partagee = d_vrai;
1374: }
1375:
1376: if ((s_copie_argument_3 = copie_objet(s_etat_processus,
1377: s_objet_argument_3, 'Q')) == NULL)
1378: {
1379: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1380: return;
1381: }
1382:
1383: liberation(s_etat_processus, s_objet_argument_3);
1384: s_objet_argument_3 = s_copie_argument_3;
1385:
1386: (*(*s_etat_processus).pointeur_variable_courante).objet =
1387: s_objet_argument_3;
1388: }
1389: else
1390: {
1391: presence_nom = d_faux;
1392:
1393: if ((s_copie_argument_3 = copie_objet(s_etat_processus,
1394: s_objet_argument_3, 'Q')) == NULL)
1395: {
1396: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1397: return;
1398: }
1399:
1400: liberation(s_etat_processus, s_objet_argument_3);
1401: s_objet_argument_3 = s_copie_argument_3;
1402: }
1403:
1404: if ((*s_objet_argument_1).type == MRL)
1405: {
1406: if ((*s_objet_argument_3).type == MIN)
1407: {
1408: // Conversion de la matrice entière en matrice réelle
1409:
1410: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument_3).objet))
1411: .nombre_lignes; i++)
1412: {
1413: tampon = (*((struct_matrice *) (*s_objet_argument_3).objet))
1414: .tableau[i];
1415:
1416: if (((*((struct_matrice *) (*s_objet_argument_3).objet))
1417: .tableau[i] = malloc((*((struct_matrice *)
1418: (*s_objet_argument_3).objet)).nombre_colonnes *
1419: sizeof(real8))) == NULL)
1420: {
1421: if (variable_partagee == d_vrai)
1422: {
1423: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1424: .s_liste_variables_partagees).mutex)) != 0)
1425: {
1426: (*s_etat_processus).erreur_systeme = d_es_processus;
1427: return;
1428: }
1429: }
1430:
1431: (*s_etat_processus).erreur_systeme =
1432: d_es_allocation_memoire;
1433: return;
1434: }
1435:
1436: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3)
1437: .objet)).nombre_colonnes; j++)
1438: {
1439: ((real8 **) (*((struct_matrice *) (*s_objet_argument_3)
1440: .objet)).tableau)[i][j] = (real8) (((integer8 *)
1441: tampon)[j]);
1442: }
1443:
1444: free(tampon);
1445: }
1446:
1447: (*((struct_matrice *) (*s_objet_argument_3).objet)).type = 'R';
1448: (*s_objet_argument_3).type = MRL;
1449: }
1450: }
1451: else if ((*s_objet_argument_1).type == MCX)
1452: {
1453: if ((*s_objet_argument_3).type == MIN)
1454: {
1455: // Conversion de la matrice entière en matrice complexe
1456:
1457: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument_3).objet))
1458: .nombre_lignes; i++)
1459: {
1460: tampon = (*((struct_matrice *) (*s_objet_argument_3).objet))
1461: .tableau[i];
1462:
1463: if (((*((struct_matrice *) (*s_objet_argument_3).objet))
1464: .tableau[i] = malloc((*((struct_matrice *)
1465: (*s_objet_argument_3).objet)).nombre_colonnes *
1466: sizeof(complex16))) == NULL)
1467: {
1468: if (variable_partagee == d_vrai)
1469: {
1470: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1471: .s_liste_variables_partagees).mutex)) != 0)
1472: {
1473: (*s_etat_processus).erreur_systeme = d_es_processus;
1474: return;
1475: }
1476: }
1477:
1478: (*s_etat_processus).erreur_systeme =
1479: d_es_allocation_memoire;
1480: return;
1481: }
1482:
1483: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3)
1484: .objet)).nombre_colonnes; j++)
1485: {
1486: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
1487: .objet)).tableau)[i][j].partie_reelle =
1488: (real8) (((integer8 *) tampon)[j]);
1489: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
1490: .objet)).tableau)[i][j].partie_imaginaire = 0;
1491: }
1492:
1493: free(tampon);
1494: }
1495:
1496: (*((struct_matrice *) (*s_objet_argument_3).objet)).type = 'C';
1497: (*s_objet_argument_3).type = MCX;
1498: }
1499: else if ((*s_objet_argument_3).type == MRL)
1500: {
1501: // Conversion de la matrice réelle en matrice complexe
1502:
1503: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument_3).objet))
1504: .nombre_lignes; i++)
1505: {
1506: tampon = (*((struct_matrice *) (*s_objet_argument_3).objet))
1507: .tableau[i];
1508:
1509: if (((*((struct_matrice *) (*s_objet_argument_3).objet))
1510: .tableau[i] = malloc((*((struct_matrice *)
1511: (*s_objet_argument_3).objet)).nombre_colonnes *
1512: sizeof(complex16))) == NULL)
1513: {
1514: if (variable_partagee == d_vrai)
1515: {
1516: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1517: .s_liste_variables_partagees).mutex)) != 0)
1518: {
1519: (*s_etat_processus).erreur_systeme = d_es_processus;
1520: return;
1521: }
1522: }
1523:
1524: (*s_etat_processus).erreur_systeme =
1525: d_es_allocation_memoire;
1526: return;
1527: }
1528:
1529: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3)
1530: .objet)).nombre_colonnes; j++)
1531: {
1532: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
1533: .objet)).tableau)[i][j].partie_reelle =
1534: ((real8 *) tampon)[j];
1535: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
1536: .objet)).tableau)[i][j].partie_imaginaire = 0;
1537: }
1538:
1539: free(tampon);
1540: }
1541:
1542: (*((struct_matrice *) (*s_objet_argument_3).objet)).type = 'C';
1543: (*s_objet_argument_3).type = MCX;
1544: }
1545: }
1546:
1547: if ((*s_objet_argument_3).type == MIN)
1548: {
1549: if ((*((struct_matrice *) (*s_objet_argument_1).objet)).nombre_colonnes
1550: != (*((struct_matrice *) (*s_objet_argument_3).objet))
1551: .nombre_colonnes)
1552: {
1553: if (variable_partagee == d_vrai)
1554: {
1555: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1556: .s_liste_variables_partagees).mutex)) != 0)
1557: {
1558: (*s_etat_processus).erreur_systeme = d_es_processus;
1559: return;
1560: }
1561: }
1562:
1563: liberation(s_etat_processus, s_objet_argument_1);
1564: liberation(s_etat_processus, s_objet_argument_2);
1565:
1566: if (presence_nom == d_faux)
1567: {
1568: liberation(s_etat_processus, s_objet_argument_3);
1569: }
1570:
1571: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1572: return;
1573: }
1574:
1575: l_element_courant = (struct_liste_chainee *)
1576: (*s_objet_argument_2).objet;
1577: i = 0;
1578:
1579: while(l_element_courant != NULL)
1580: {
1581: position = (*((integer8 *) (*(*l_element_courant).donnee).objet));
1582:
1583: if ((position < 1) || (position > (integer8) (*((struct_matrice *)
1584: (*s_objet_argument_3).objet)).nombre_lignes))
1585: {
1586: if (variable_partagee == d_vrai)
1587: {
1588: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1589: .s_liste_variables_partagees).mutex)) != 0)
1590: {
1591: (*s_etat_processus).erreur_systeme = d_es_processus;
1592: return;
1593: }
1594: }
1595:
1596: liberation(s_etat_processus, s_objet_argument_1);
1597: liberation(s_etat_processus, s_objet_argument_2);
1598:
1599: if (presence_nom == d_faux)
1600: {
1601: liberation(s_etat_processus, s_objet_argument_3);
1602: }
1603:
1604: (*s_etat_processus).erreur_execution =
1605: d_ex_argument_invalide;
1606: return;
1607: }
1608:
1609: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3).objet))
1610: .nombre_colonnes; j++)
1611: {
1612: ((integer8 **) (*((struct_matrice *) (*s_objet_argument_3)
1613: .objet)).tableau)[position - 1][j] = ((integer8 **)
1614: (*((struct_matrice *) (*s_objet_argument_1).objet))
1615: .tableau)[i][j];
1616: }
1617:
1618: l_element_courant = (*l_element_courant).suivant;
1619: i++;
1620: }
1621: }
1622: else if ((*s_objet_argument_3).type == MRL)
1623: {
1624: if ((*s_objet_argument_1).type == MIN)
1625: {
1626: if ((*((struct_matrice *) (*s_objet_argument_1).objet))
1627: .nombre_colonnes != (*((struct_matrice *)
1628: (*s_objet_argument_3).objet)).nombre_colonnes)
1629: {
1630: if (variable_partagee == d_vrai)
1631: {
1632: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1633: .s_liste_variables_partagees).mutex)) != 0)
1634: {
1635: (*s_etat_processus).erreur_systeme = d_es_processus;
1636: return;
1637: }
1638: }
1639:
1640: liberation(s_etat_processus, s_objet_argument_1);
1641: liberation(s_etat_processus, s_objet_argument_2);
1642:
1643: if (presence_nom == d_faux)
1644: {
1645: liberation(s_etat_processus, s_objet_argument_3);
1646: }
1647:
1648: (*s_etat_processus).erreur_execution =
1649: d_ex_dimensions_invalides;
1650: return;
1651: }
1652:
1653: l_element_courant = (struct_liste_chainee *)
1654: (*s_objet_argument_2).objet;
1655: i = 0;
1656:
1657: while(l_element_courant != NULL)
1658: {
1659: position = (*((integer8 *) (*(*l_element_courant)
1660: .donnee).objet));
1661:
1662: if ((position < 1) || (position > (integer8)
1663: (*((struct_matrice *) (*s_objet_argument_3).objet))
1664: .nombre_lignes))
1665: {
1666: if (variable_partagee == d_vrai)
1667: {
1668: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1669: .s_liste_variables_partagees).mutex)) != 0)
1670: {
1671: (*s_etat_processus).erreur_systeme = d_es_processus;
1672: return;
1673: }
1674: }
1675:
1676: liberation(s_etat_processus, s_objet_argument_1);
1677: liberation(s_etat_processus, s_objet_argument_2);
1678:
1679: if (presence_nom == d_faux)
1680: {
1681: liberation(s_etat_processus, s_objet_argument_3);
1682: }
1683:
1684: (*s_etat_processus).erreur_execution =
1685: d_ex_argument_invalide;
1686: return;
1687: }
1688:
1689: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3)
1690: .objet)).nombre_colonnes; j++)
1691: {
1692: ((real8 **) (*((struct_matrice *) (*s_objet_argument_3)
1693: .objet)).tableau)[position - 1][j] = (real8)
1694: ((integer8 **) (*((struct_matrice *)
1695: (*s_objet_argument_1).objet)).tableau)[i][j];
1696: }
1697:
1698: l_element_courant = (*l_element_courant).suivant;
1699: i++;
1700: }
1701: }
1702: else // Matrice réelle
1703: {
1704: if ((*((struct_matrice *) (*s_objet_argument_1).objet))
1705: .nombre_colonnes != (*((struct_matrice *)
1706: (*s_objet_argument_3).objet)).nombre_colonnes)
1707: {
1708: if (variable_partagee == d_vrai)
1709: {
1710: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1711: .s_liste_variables_partagees).mutex)) != 0)
1712: {
1713: (*s_etat_processus).erreur_systeme = d_es_processus;
1714: return;
1715: }
1716: }
1717:
1718: liberation(s_etat_processus, s_objet_argument_1);
1719: liberation(s_etat_processus, s_objet_argument_2);
1720:
1721: if (presence_nom == d_faux)
1722: {
1723: liberation(s_etat_processus, s_objet_argument_3);
1724: }
1725:
1726: (*s_etat_processus).erreur_execution =
1727: d_ex_dimensions_invalides;
1728: return;
1729: }
1730:
1731: l_element_courant = (struct_liste_chainee *)
1732: (*s_objet_argument_2).objet;
1733: i = 0;
1734:
1735: while(l_element_courant != NULL)
1736: {
1737: position = (*((integer8 *) (*(*l_element_courant)
1738: .donnee).objet));
1739:
1740: if ((position < 1) || (position > (integer8)
1741: (*((struct_matrice *) (*s_objet_argument_3).objet))
1742: .nombre_lignes))
1743: {
1744: if (variable_partagee == d_vrai)
1745: {
1746: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1747: .s_liste_variables_partagees).mutex)) != 0)
1748: {
1749: (*s_etat_processus).erreur_systeme = d_es_processus;
1750: return;
1751: }
1752: }
1753:
1754: liberation(s_etat_processus, s_objet_argument_1);
1755: liberation(s_etat_processus, s_objet_argument_2);
1756:
1757: if (presence_nom == d_faux)
1758: {
1759: liberation(s_etat_processus, s_objet_argument_3);
1760: }
1761:
1762: (*s_etat_processus).erreur_execution =
1763: d_ex_argument_invalide;
1764: return;
1765: }
1766:
1767: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3)
1768: .objet)).nombre_colonnes; j++)
1769: {
1770: ((real8 **) (*((struct_matrice *) (*s_objet_argument_3)
1771: .objet)).tableau)[position - 1][j] =
1772: ((real8 **) (*((struct_matrice *)
1773: (*s_objet_argument_1).objet)).tableau)[i][j];
1774: }
1775:
1776: l_element_courant = (*l_element_courant).suivant;
1777: i++;
1778: }
1779: }
1780: }
1781: else if ((*s_objet_argument_3).type == MCX)
1782: {
1783: if ((*s_objet_argument_1).type == MIN)
1784: {
1785: if ((*((struct_matrice *) (*s_objet_argument_1).objet))
1786: .nombre_colonnes != (*((struct_matrice *)
1787: (*s_objet_argument_3).objet)).nombre_colonnes)
1788: {
1789: if (variable_partagee == d_vrai)
1790: {
1791: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1792: .s_liste_variables_partagees).mutex)) != 0)
1793: {
1794: (*s_etat_processus).erreur_systeme = d_es_processus;
1795: return;
1796: }
1797: }
1798:
1799: liberation(s_etat_processus, s_objet_argument_1);
1800: liberation(s_etat_processus, s_objet_argument_2);
1801:
1802: if (presence_nom == d_faux)
1803: {
1804: liberation(s_etat_processus, s_objet_argument_3);
1805: }
1806:
1807: (*s_etat_processus).erreur_execution =
1808: d_ex_dimensions_invalides;
1809: return;
1810: }
1811:
1812: l_element_courant = (struct_liste_chainee *)
1813: (*s_objet_argument_2).objet;
1814: i = 0;
1815:
1816: while(l_element_courant != NULL)
1817: {
1818: position = (*((integer8 *) (*(*l_element_courant)
1819: .donnee).objet));
1820:
1821: if ((position < 1) || (position > (integer8)
1822: (*((struct_matrice *) (*s_objet_argument_3).objet))
1823: .nombre_lignes))
1824: {
1825: if (variable_partagee == d_vrai)
1826: {
1827: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1828: .s_liste_variables_partagees).mutex)) != 0)
1829: {
1830: (*s_etat_processus).erreur_systeme = d_es_processus;
1831: return;
1832: }
1833: }
1834:
1835: liberation(s_etat_processus, s_objet_argument_1);
1836: liberation(s_etat_processus, s_objet_argument_2);
1837:
1838: if (presence_nom == d_faux)
1839: {
1840: liberation(s_etat_processus, s_objet_argument_3);
1841: }
1842:
1843: (*s_etat_processus).erreur_execution =
1844: d_ex_argument_invalide;
1845: return;
1846: }
1847:
1848: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3)
1849: .objet)).nombre_colonnes; j++)
1850: {
1851: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
1852: .objet)).tableau)[position - 1][j].partie_reelle =
1853: (real8) ((integer8 **) (*((struct_matrice *)
1854: (*s_objet_argument_1).objet)).tableau)[i][j];
1855: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
1856: .objet)).tableau)[position - 1][j]
1857: .partie_imaginaire = 0;
1858: }
1859:
1860: l_element_courant = (*l_element_courant).suivant;
1861: i++;
1862: }
1863: }
1864: else if ((*s_objet_argument_1).type == MRL)
1865: {
1866: if ((*((struct_matrice *) (*s_objet_argument_1).objet))
1867: .nombre_colonnes != (*((struct_matrice *)
1868: (*s_objet_argument_3).objet)).nombre_colonnes)
1869: {
1870: if (variable_partagee == d_vrai)
1871: {
1872: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1873: .s_liste_variables_partagees).mutex)) != 0)
1874: {
1875: (*s_etat_processus).erreur_systeme = d_es_processus;
1876: return;
1877: }
1878: }
1879:
1880: liberation(s_etat_processus, s_objet_argument_1);
1881: liberation(s_etat_processus, s_objet_argument_2);
1882:
1883: if (presence_nom == d_faux)
1884: {
1885: liberation(s_etat_processus, s_objet_argument_3);
1886: }
1887:
1888: (*s_etat_processus).erreur_execution =
1889: d_ex_dimensions_invalides;
1890: return;
1891: }
1892:
1893: l_element_courant = (struct_liste_chainee *)
1894: (*s_objet_argument_2).objet;
1895: i = 0;
1896:
1897: while(l_element_courant != NULL)
1898: {
1899: position = (*((integer8 *) (*(*l_element_courant)
1900: .donnee).objet));
1901:
1902: if ((position < 1) || (position > (integer8)
1903: (*((struct_matrice *) (*s_objet_argument_3).objet))
1904: .nombre_lignes))
1905: {
1906: if (variable_partagee == d_vrai)
1907: {
1908: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1909: .s_liste_variables_partagees).mutex)) != 0)
1910: {
1911: (*s_etat_processus).erreur_systeme = d_es_processus;
1912: return;
1913: }
1914: }
1915:
1916: liberation(s_etat_processus, s_objet_argument_1);
1917: liberation(s_etat_processus, s_objet_argument_2);
1918:
1919: if (presence_nom == d_faux)
1920: {
1921: liberation(s_etat_processus, s_objet_argument_3);
1922: }
1923:
1924: (*s_etat_processus).erreur_execution =
1925: d_ex_argument_invalide;
1926: return;
1927: }
1928:
1929: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3)
1930: .objet)).nombre_colonnes; j++)
1931: {
1932: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
1933: .objet)).tableau)[position - 1][j].partie_reelle =
1934: ((real8 **) (*((struct_matrice *)
1935: (*s_objet_argument_1).objet)).tableau)[i][j];
1936: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
1937: .objet)).tableau)[position - 1][j]
1938: .partie_imaginaire = 0;
1939: }
1940:
1941: l_element_courant = (*l_element_courant).suivant;
1942: i++;
1943: }
1944: }
1945: else // Matrice complexe
1946: {
1947: if ((*((struct_matrice *) (*s_objet_argument_1).objet))
1948: .nombre_colonnes != (*((struct_matrice *)
1949: (*s_objet_argument_3).objet)).nombre_colonnes)
1950: {
1951: if (variable_partagee == d_vrai)
1952: {
1953: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1954: .s_liste_variables_partagees).mutex)) != 0)
1955: {
1956: (*s_etat_processus).erreur_systeme = d_es_processus;
1957: return;
1958: }
1959: }
1960:
1961: liberation(s_etat_processus, s_objet_argument_1);
1962: liberation(s_etat_processus, s_objet_argument_2);
1963:
1964: if (presence_nom == d_faux)
1965: {
1966: liberation(s_etat_processus, s_objet_argument_3);
1967: }
1968:
1969: (*s_etat_processus).erreur_execution =
1970: d_ex_dimensions_invalides;
1971: return;
1972: }
1973:
1974: l_element_courant = (struct_liste_chainee *)
1975: (*s_objet_argument_2).objet;
1976: i = 0;
1977:
1978: while(l_element_courant != NULL)
1979: {
1980: position = (*((integer8 *) (*(*l_element_courant)
1981: .donnee).objet));
1982:
1983: if ((position < 1) || (position > (integer8)
1984: (*((struct_matrice *) (*s_objet_argument_3).objet))
1985: .nombre_lignes))
1986: {
1987: if (variable_partagee == d_vrai)
1988: {
1989: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1990: .s_liste_variables_partagees).mutex)) != 0)
1991: {
1992: (*s_etat_processus).erreur_systeme = d_es_processus;
1993: return;
1994: }
1995: }
1996:
1997: liberation(s_etat_processus, s_objet_argument_1);
1998: liberation(s_etat_processus, s_objet_argument_2);
1999:
2000: if (presence_nom == d_faux)
2001: {
2002: liberation(s_etat_processus, s_objet_argument_3);
2003: }
2004:
2005: (*s_etat_processus).erreur_execution =
2006: d_ex_argument_invalide;
2007: return;
2008: }
2009:
2010: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_3)
2011: .objet)).nombre_colonnes; j++)
2012: {
2013: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
2014: .objet)).tableau)[position - 1][j].partie_reelle =
2015: ((complex16 **) (*((struct_matrice *)
2016: (*s_objet_argument_1).objet)).tableau)[i][j]
2017: .partie_reelle;
2018: ((complex16 **) (*((struct_matrice *) (*s_objet_argument_3)
2019: .objet)).tableau)[position - 1][j]
2020: .partie_imaginaire = ((complex16 **)
2021: (*((struct_matrice *) (*s_objet_argument_1).objet))
2022: .tableau)[i][j].partie_imaginaire;
2023: }
2024:
2025: l_element_courant = (*l_element_courant).suivant;
2026: i++;
2027: }
2028: }
2029: }
2030: else
2031: {
2032: if (variable_partagee == d_vrai)
2033: {
2034: if (pthread_mutex_unlock(&((*(*s_etat_processus)
2035: .s_liste_variables_partagees).mutex)) != 0)
2036: {
2037: (*s_etat_processus).erreur_systeme = d_es_processus;
2038: return;
2039: }
2040: }
2041:
2042: liberation(s_etat_processus, s_objet_argument_1);
2043: liberation(s_etat_processus, s_objet_argument_2);
2044:
2045: if (presence_nom == d_faux)
2046: {
2047: liberation(s_etat_processus, s_objet_argument_3);
2048: }
2049:
2050: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
2051: return;
2052: }
2053:
2054: if (presence_nom == d_faux)
2055: {
2056: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2057: s_objet_argument_3) == d_erreur)
2058: {
2059: return;
2060: }
2061: }
2062: else if (variable_partagee == d_vrai)
2063: {
2064: (*(*s_etat_processus).s_liste_variables_partagees).table
2065: [(*(*s_etat_processus).s_liste_variables_partagees)
2066: .position_variable].objet = s_objet_argument_3;
2067:
2068: if (pthread_mutex_unlock(&((*(*s_etat_processus)
2069: .s_liste_variables_partagees).mutex)) != 0)
2070: {
2071: (*s_etat_processus).erreur_systeme = d_es_processus;
2072: return;
2073: }
2074: }
2075:
2076: liberation(s_etat_processus, s_objet_argument_1);
2077: liberation(s_etat_processus, s_objet_argument_2);
2078:
2079: return;
2080: }
2081:
2082: // 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