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