1: /*
2: ================================================================================
3: RPL/2 (R) version 4.1.10
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 'getc'
29: ================================================================================
30: Entrées : pointeur sur une structure struct_processus
31: --------------------------------------------------------------------------------
32: Sorties :
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: void
39: instruction_getc(struct_processus *s_etat_processus)
40: {
41: logical1 presence_variable;
42: logical1 variable_partagee;
43:
44: struct_liste_chainee *l_element_courant;
45:
46: struct_objet *s_objet_argument_1;
47: struct_objet *s_objet_argument_2;
48: struct_objet *s_objet_resultat;
49:
50: unsigned long i;
51: unsigned long j;
52: unsigned long colonne;
53: unsigned long nombre_colonnes;
54:
55: (*s_etat_processus).erreur_execution = d_ex;
56:
57: if ((*s_etat_processus).affichage_arguments == 'Y')
58: {
59: printf("\n GETC ");
60:
61: if ((*s_etat_processus).langue == 'F')
62: {
63: printf("(prend une colonne)\n\n");
64: }
65: else
66: {
67: printf("(get column)\n\n");
68: }
69:
70: printf(" 2: %s, %s, %s, %s\n", d_MIN, d_MRL, d_MCX, d_NOM);
71: printf(" 1: %s\n", d_LST);
72: printf("-> 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
73:
74: return;
75: }
76: else if ((*s_etat_processus).test_instruction == 'Y')
77: {
78: (*s_etat_processus).nombre_arguments = -1;
79: return;
80: }
81:
82: if (test_cfsf(s_etat_processus, 31) == d_vrai)
83: {
84: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
85: {
86: return;
87: }
88: }
89:
90: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
91: &s_objet_argument_1) == d_erreur)
92: {
93: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
94: return;
95: }
96:
97: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
98: &s_objet_argument_2) == d_erreur)
99: {
100: liberation(s_etat_processus, s_objet_argument_1);
101:
102: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
103: return;
104: }
105:
106: if ((*s_objet_argument_2).type == NOM)
107: {
108: if (recherche_variable(s_etat_processus, (*((struct_nom *)
109: (*s_objet_argument_2).objet)).nom) == d_faux)
110: {
111: liberation(s_etat_processus, s_objet_argument_1);
112: liberation(s_etat_processus, s_objet_argument_2);
113:
114: (*s_etat_processus).erreur_systeme = d_es;
115: (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
116:
117: return;
118: }
119:
120: liberation(s_etat_processus, s_objet_argument_2);
121:
122: s_objet_argument_2 = (*(*s_etat_processus).pointeur_variable_courante)
123: .objet;
124: presence_variable = d_vrai;
125:
126: if (s_objet_argument_2 == NULL)
127: {
128: // Variable partagée
129:
130: if (pthread_mutex_lock(&((*(*s_etat_processus)
131: .s_liste_variables_partagees).mutex)) != 0)
132: {
133: (*s_etat_processus).erreur_systeme = d_es_processus;
134: return;
135: }
136:
137: if (recherche_variable_partagee(s_etat_processus,
138: (*(*s_etat_processus).pointeur_variable_courante).nom,
139: (*(*s_etat_processus).pointeur_variable_courante)
140: .variable_partagee, (*(*s_etat_processus)
141: .pointeur_variable_courante).origine) == d_faux)
142: {
143: if (pthread_mutex_unlock(&((*(*s_etat_processus)
144: .s_liste_variables_partagees).mutex)) != 0)
145: {
146: (*s_etat_processus).erreur_systeme = d_es_processus;
147: return;
148: }
149:
150: liberation(s_etat_processus, s_objet_argument_1);
151:
152: (*s_etat_processus).erreur_systeme = d_es;
153: (*s_etat_processus).erreur_execution =
154: d_ex_variable_non_definie;
155:
156: return;
157: }
158:
159: s_objet_argument_2 = (*(*s_etat_processus)
160: .s_liste_variables_partagees).table
161: [(*(*s_etat_processus).s_liste_variables_partagees)
162: .position_variable].objet;
163: variable_partagee = d_vrai;
164: }
165: else
166: {
167: variable_partagee = d_faux;
168: }
169: }
170: else
171: {
172: presence_variable = d_faux;
173: variable_partagee = d_faux;
174: }
175:
176: if (((*s_objet_argument_2).type == MIN) ||
177: ((*s_objet_argument_2).type == MRL) ||
178: ((*s_objet_argument_2).type == MCX))
179: {
180: if ((*s_objet_argument_1).type == LST)
181: {
182: l_element_courant = (struct_liste_chainee *)
183: (*s_objet_argument_1).objet;
184: nombre_colonnes = 0;
185:
186: while(l_element_courant != NULL)
187: {
188: if ((*(*l_element_courant).donnee).type != INT)
189: {
190: liberation(s_etat_processus, s_objet_argument_1);
191:
192: if (variable_partagee == d_vrai)
193: {
194: if (pthread_mutex_unlock(&((*(*s_etat_processus)
195: .s_liste_variables_partagees).mutex)) != 0)
196: {
197: (*s_etat_processus).erreur_systeme = d_es_processus;
198: return;
199: }
200: }
201:
202: if (presence_variable == d_faux)
203: {
204: liberation(s_etat_processus, s_objet_argument_2);
205: }
206:
207: (*s_etat_processus).erreur_execution =
208: d_ex_erreur_type_argument;
209: return;
210: }
211:
212: if (((*((integer8 *) (*(*l_element_courant).donnee).objet))
213: <= 0) || ((*((integer8 *) (*(*l_element_courant).donnee)
214: .objet)) > (integer8) (*((struct_matrice *)
215: (*s_objet_argument_2).objet)).nombre_colonnes))
216: {
217: liberation(s_etat_processus, s_objet_argument_1);
218:
219: if (variable_partagee == d_vrai)
220: {
221: if (pthread_mutex_unlock(&((*(*s_etat_processus)
222: .s_liste_variables_partagees).mutex)) != 0)
223: {
224: (*s_etat_processus).erreur_systeme = d_es_processus;
225: return;
226: }
227: }
228:
229: if (presence_variable == d_faux)
230: {
231: liberation(s_etat_processus, s_objet_argument_2);
232: }
233:
234: (*s_etat_processus).erreur_execution =
235: d_ex_argument_invalide;
236: return;
237: }
238:
239: nombre_colonnes++;
240: l_element_courant = (*l_element_courant).suivant;
241: }
242:
243: if (nombre_colonnes == 0)
244: {
245: liberation(s_etat_processus, s_objet_argument_1);
246:
247: if (variable_partagee == d_vrai)
248: {
249: if (pthread_mutex_unlock(&((*(*s_etat_processus)
250: .s_liste_variables_partagees).mutex)) != 0)
251: {
252: (*s_etat_processus).erreur_systeme = d_es_processus;
253: return;
254: }
255: }
256:
257: if (presence_variable == d_faux)
258: {
259: liberation(s_etat_processus, s_objet_argument_2);
260: }
261:
262: (*s_etat_processus).erreur_execution =
263: d_ex_erreur_type_argument;
264: return;
265: }
266:
267: if ((s_objet_resultat = allocation(s_etat_processus,
268: (*s_objet_argument_2).type)) == NULL)
269: {
270: if (variable_partagee == d_vrai)
271: {
272: if (pthread_mutex_unlock(&((*(*s_etat_processus)
273: .s_liste_variables_partagees).mutex)) != 0)
274: {
275: (*s_etat_processus).erreur_systeme = d_es_processus;
276: return;
277: }
278: }
279:
280: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
281: return;
282: }
283:
284: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
285: nombre_colonnes;
286: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
287: (*((struct_matrice *) (*s_objet_argument_2).objet))
288: .nombre_lignes;
289:
290: switch((*((struct_matrice *) (*s_objet_resultat).objet)).type)
291: {
292: case 'I' :
293: {
294: (*s_objet_resultat).type = MIN;
295:
296: if (((*((struct_matrice *) (*s_objet_resultat).objet))
297: .tableau = malloc((*((struct_matrice *)
298: (*s_objet_resultat).objet)).nombre_lignes *
299: sizeof(integer8 *))) == NULL)
300: {
301: if (variable_partagee == d_vrai)
302: {
303: if (pthread_mutex_unlock(&((*(*s_etat_processus)
304: .s_liste_variables_partagees).mutex)) != 0)
305: {
306: (*s_etat_processus).erreur_systeme =
307: d_es_processus;
308: return;
309: }
310: }
311:
312: (*s_etat_processus).erreur_systeme =
313: d_es_allocation_memoire;
314: return;
315: }
316:
317: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat)
318: .objet)).nombre_lignes; i++)
319: {
320: if (((*((struct_matrice *) (*s_objet_resultat).objet))
321: .tableau[i] = malloc(nombre_colonnes *
322: sizeof(integer8))) == NULL)
323: {
324: if (variable_partagee == d_vrai)
325: {
326: if (pthread_mutex_unlock(&((*(*s_etat_processus)
327: .s_liste_variables_partagees).mutex))
328: != 0)
329: {
330: (*s_etat_processus).erreur_systeme =
331: d_es_processus;
332: return;
333: }
334: }
335:
336: (*s_etat_processus).erreur_systeme =
337: d_es_allocation_memoire;
338: return;
339: }
340:
341: }
342:
343: l_element_courant = (struct_liste_chainee *)
344: (*s_objet_argument_1).objet;
345: j = 0;
346:
347: while(l_element_courant != NULL)
348: {
349: colonne = (*((integer8 *) (*(*l_element_courant).donnee)
350: .objet)) - 1;
351:
352: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat)
353: .objet)).nombre_lignes; i++)
354: {
355: ((integer8 **) (*((struct_matrice *)
356: (*s_objet_resultat).objet)).tableau)[i][j] =
357: ((integer8 **) (*((struct_matrice *)
358: (*s_objet_argument_2).objet))
359: .tableau)[i][colonne];
360: }
361:
362: l_element_courant = (*l_element_courant).suivant;
363: j++;
364: }
365:
366: break;
367: }
368:
369: case 'R' :
370: {
371: (*s_objet_resultat).type = MRL;
372:
373: if (((*((struct_matrice *) (*s_objet_resultat).objet))
374: .tableau = malloc((*((struct_matrice *)
375: (*s_objet_resultat).objet)).nombre_lignes *
376: sizeof(real8 *))) == NULL)
377: {
378: if (variable_partagee == d_vrai)
379: {
380: if (pthread_mutex_unlock(&((*(*s_etat_processus)
381: .s_liste_variables_partagees).mutex)) != 0)
382: {
383: (*s_etat_processus).erreur_systeme =
384: d_es_processus;
385: return;
386: }
387: }
388:
389: (*s_etat_processus).erreur_systeme =
390: d_es_allocation_memoire;
391: return;
392: }
393:
394: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat)
395: .objet)).nombre_lignes; i++)
396: {
397: if (((*((struct_matrice *) (*s_objet_resultat).objet))
398: .tableau[i] = malloc(nombre_colonnes *
399: sizeof(real8))) == NULL)
400: {
401: if (variable_partagee == d_vrai)
402: {
403: if (pthread_mutex_unlock(&((*(*s_etat_processus)
404: .s_liste_variables_partagees).mutex))
405: != 0)
406: {
407: (*s_etat_processus).erreur_systeme =
408: d_es_processus;
409: return;
410: }
411: }
412:
413: (*s_etat_processus).erreur_systeme =
414: d_es_allocation_memoire;
415: return;
416: }
417:
418: }
419:
420: l_element_courant = (struct_liste_chainee *)
421: (*s_objet_argument_1).objet;
422: j = 0;
423:
424: while(l_element_courant != NULL)
425: {
426: colonne = (*((integer8 *) (*(*l_element_courant).donnee)
427: .objet)) - 1;
428:
429: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat)
430: .objet)).nombre_lignes; i++)
431: {
432: ((real8 **) (*((struct_matrice *)
433: (*s_objet_resultat).objet)).tableau)[i][j] =
434: ((real8 **) (*((struct_matrice *)
435: (*s_objet_argument_2).objet))
436: .tableau)[i][colonne];
437: }
438:
439: l_element_courant = (*l_element_courant).suivant;
440: j++;
441: }
442:
443: break;
444: }
445:
446: case 'C' :
447: {
448: (*s_objet_resultat).type = MCX;
449:
450: if (((*((struct_matrice *) (*s_objet_resultat).objet))
451: .tableau = malloc((*((struct_matrice *)
452: (*s_objet_resultat).objet)).nombre_lignes *
453: sizeof(complex16 *))) == NULL)
454: {
455: if (variable_partagee == d_vrai)
456: {
457: if (pthread_mutex_unlock(&((*(*s_etat_processus)
458: .s_liste_variables_partagees).mutex)) != 0)
459: {
460: (*s_etat_processus).erreur_systeme =
461: d_es_processus;
462: return;
463: }
464: }
465:
466: (*s_etat_processus).erreur_systeme =
467: d_es_allocation_memoire;
468: return;
469: }
470:
471: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat)
472: .objet)).nombre_lignes; i++)
473: {
474: if (((*((struct_matrice *) (*s_objet_resultat).objet))
475: .tableau[i] = malloc(nombre_colonnes *
476: sizeof(complex16))) == NULL)
477: {
478: if (variable_partagee == d_vrai)
479: {
480: if (pthread_mutex_unlock(&((*(*s_etat_processus)
481: .s_liste_variables_partagees).mutex))
482: != 0)
483: {
484: (*s_etat_processus).erreur_systeme =
485: d_es_processus;
486: return;
487: }
488: }
489:
490: (*s_etat_processus).erreur_systeme =
491: d_es_allocation_memoire;
492: return;
493: }
494:
495: }
496:
497: l_element_courant = (struct_liste_chainee *)
498: (*s_objet_argument_1).objet;
499: j = 0;
500:
501: while(l_element_courant != NULL)
502: {
503: colonne = (*((integer8 *) (*(*l_element_courant).donnee)
504: .objet)) - 1;
505:
506: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat)
507: .objet)).nombre_lignes; i++)
508: {
509: ((complex16 **) (*((struct_matrice *)
510: (*s_objet_resultat).objet)).tableau)[i][j]
511: .partie_reelle =
512: ((complex16 **) (*((struct_matrice *)
513: (*s_objet_argument_2).objet))
514: .tableau)[i][colonne].partie_reelle;
515: ((complex16 **) (*((struct_matrice *)
516: (*s_objet_resultat).objet)).tableau)[i][j]
517: .partie_imaginaire =
518: ((complex16 **) (*((struct_matrice *)
519: (*s_objet_argument_2).objet))
520: .tableau)[i][colonne].partie_imaginaire;
521: }
522:
523: l_element_courant = (*l_element_courant).suivant;
524: j++;
525: }
526:
527: break;
528: }
529: }
530: }
531: else
532: {
533: liberation(s_etat_processus, s_objet_argument_1);
534:
535: if (variable_partagee == d_vrai)
536: {
537: if (pthread_mutex_unlock(&((*(*s_etat_processus)
538: .s_liste_variables_partagees).mutex)) != 0)
539: {
540: (*s_etat_processus).erreur_systeme =
541: d_es_processus;
542: return;
543: }
544: }
545:
546: if (presence_variable == d_faux)
547: {
548: liberation(s_etat_processus, s_objet_argument_2);
549: }
550:
551: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
552: return;
553: }
554: }
555: else
556: {
557: liberation(s_etat_processus, s_objet_argument_1);
558:
559: if (variable_partagee == d_vrai)
560: {
561: if (pthread_mutex_unlock(&((*(*s_etat_processus)
562: .s_liste_variables_partagees).mutex)) != 0)
563: {
564: (*s_etat_processus).erreur_systeme =
565: d_es_processus;
566: return;
567: }
568: }
569:
570: if (presence_variable == d_faux)
571: {
572: liberation(s_etat_processus, s_objet_argument_2);
573: }
574:
575: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
576: return;
577: }
578:
579: liberation(s_etat_processus, s_objet_argument_1);
580:
581: if (variable_partagee == d_vrai)
582: {
583: if (pthread_mutex_unlock(&((*(*s_etat_processus)
584: .s_liste_variables_partagees).mutex)) != 0)
585: {
586: (*s_etat_processus).erreur_systeme =
587: d_es_processus;
588: return;
589: }
590: }
591:
592: if (presence_variable == d_faux)
593: {
594: liberation(s_etat_processus, s_objet_argument_2);
595: }
596:
597: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
598: s_objet_resultat) == d_erreur)
599: {
600: return;
601: }
602:
603: return;
604: }
605:
606:
607: /*
608: ================================================================================
609: Fonction 'getr'
610: ================================================================================
611: Entrées : pointeur sur une structure struct_processus
612: --------------------------------------------------------------------------------
613: Sorties :
614: --------------------------------------------------------------------------------
615: Effets de bord : néant
616: ================================================================================
617: */
618:
619: void
620: instruction_getr(struct_processus *s_etat_processus)
621: {
622: logical1 presence_variable;
623: logical1 variable_partagee;
624:
625: struct_liste_chainee *l_element_courant;
626:
627: struct_objet *s_objet_argument_1;
628: struct_objet *s_objet_argument_2;
629: struct_objet *s_objet_resultat;
630:
631: unsigned long i;
632: unsigned long j;
633: unsigned long ligne;
634: unsigned long nombre_lignes;
635:
636: (*s_etat_processus).erreur_execution = d_ex;
637:
638: if ((*s_etat_processus).affichage_arguments == 'Y')
639: {
640: printf("\n GETR ");
641:
642: if ((*s_etat_processus).langue == 'F')
643: {
644: printf("(prend une ligne)\n\n");
645: }
646: else
647: {
648: printf("(get row)\n\n");
649: }
650:
651: printf(" 2: %s, %s, %s, %s\n", d_MIN, d_MRL, d_MCX, d_NOM);
652: printf(" 1: %s\n", d_LST);
653: printf("-> 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
654:
655: return;
656: }
657: else if ((*s_etat_processus).test_instruction == 'Y')
658: {
659: (*s_etat_processus).nombre_arguments = -1;
660: return;
661: }
662:
663: if (test_cfsf(s_etat_processus, 31) == d_vrai)
664: {
665: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
666: {
667: return;
668: }
669: }
670:
671: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
672: &s_objet_argument_1) == d_erreur)
673: {
674: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
675: return;
676: }
677:
678: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
679: &s_objet_argument_2) == d_erreur)
680: {
681: liberation(s_etat_processus, s_objet_argument_1);
682:
683: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
684: return;
685: }
686:
687: if ((*s_objet_argument_2).type == NOM)
688: {
689: if (recherche_variable(s_etat_processus, (*((struct_nom *)
690: (*s_objet_argument_2).objet)).nom) == d_faux)
691: {
692: (*s_etat_processus).erreur_systeme = d_es;
693: (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
694:
695: return;
696: }
697:
698: liberation(s_etat_processus, s_objet_argument_2);
699:
700: s_objet_argument_2 = (*(*s_etat_processus).pointeur_variable_courante)
701: .objet;
702: presence_variable = d_vrai;
703:
704: if (s_objet_argument_2 == NULL)
705: {
706: // Variable partagée
707:
708: if (pthread_mutex_lock(&((*(*s_etat_processus)
709: .s_liste_variables_partagees).mutex)) != 0)
710: {
711: (*s_etat_processus).erreur_systeme = d_es_processus;
712: return;
713: }
714:
715: if (recherche_variable_partagee(s_etat_processus,
716: (*(*s_etat_processus).pointeur_variable_courante).nom,
717: (*(*s_etat_processus).pointeur_variable_courante)
718: .variable_partagee, (*(*s_etat_processus)
719: .pointeur_variable_courante).origine) == d_faux)
720: {
721: if (pthread_mutex_unlock(&((*(*s_etat_processus)
722: .s_liste_variables_partagees).mutex)) != 0)
723: {
724: (*s_etat_processus).erreur_systeme = d_es_processus;
725: return;
726: }
727:
728: liberation(s_etat_processus, s_objet_argument_1);
729:
730: (*s_etat_processus).erreur_systeme = d_es;
731: (*s_etat_processus).erreur_execution =
732: d_ex_variable_non_definie;
733:
734: return;
735: }
736:
737: s_objet_argument_2 = (*(*s_etat_processus)
738: .s_liste_variables_partagees).table
739: [(*(*s_etat_processus).s_liste_variables_partagees)
740: .position_variable].objet;
741: variable_partagee = d_vrai;
742: }
743: else
744: {
745: variable_partagee = d_faux;
746: }
747: }
748: else
749: {
750: presence_variable = d_faux;
751: variable_partagee = d_faux;
752: }
753:
754: if (((*s_objet_argument_2).type == MIN) ||
755: ((*s_objet_argument_2).type == MRL) ||
756: ((*s_objet_argument_2).type == MCX))
757: {
758: if ((*s_objet_argument_1).type == LST)
759: {
760: l_element_courant = (struct_liste_chainee *)
761: (*s_objet_argument_1).objet;
762: nombre_lignes = 0;
763:
764: while(l_element_courant != NULL)
765: {
766: if ((*(*l_element_courant).donnee).type != INT)
767: {
768: liberation(s_etat_processus, s_objet_argument_1);
769:
770: if (variable_partagee == d_vrai)
771: {
772: if (pthread_mutex_unlock(&((*(*s_etat_processus)
773: .s_liste_variables_partagees).mutex)) != 0)
774: {
775: (*s_etat_processus).erreur_systeme =
776: d_es_processus;
777: return;
778: }
779: }
780:
781: if (presence_variable == d_faux)
782: {
783: liberation(s_etat_processus, s_objet_argument_2);
784: }
785:
786: (*s_etat_processus).erreur_execution =
787: d_ex_erreur_type_argument;
788: return;
789: }
790:
791: if (((*((integer8 *) (*(*l_element_courant).donnee).objet))
792: <= 0) || ((*((integer8 *) (*(*l_element_courant).donnee)
793: .objet)) > (integer8) (*((struct_matrice *)
794: (*s_objet_argument_2).objet)).nombre_lignes))
795: {
796: liberation(s_etat_processus, s_objet_argument_1);
797:
798: if (variable_partagee == d_vrai)
799: {
800: if (pthread_mutex_unlock(&((*(*s_etat_processus)
801: .s_liste_variables_partagees).mutex)) != 0)
802: {
803: (*s_etat_processus).erreur_systeme =
804: d_es_processus;
805: return;
806: }
807: }
808:
809: if (presence_variable == d_faux)
810: {
811: liberation(s_etat_processus, s_objet_argument_2);
812: }
813:
814: (*s_etat_processus).erreur_execution =
815: d_ex_argument_invalide;
816: return;
817: }
818:
819: nombre_lignes++;
820: l_element_courant = (*l_element_courant).suivant;
821: }
822:
823: if (nombre_lignes == 0)
824: {
825: liberation(s_etat_processus, s_objet_argument_1);
826:
827: if (variable_partagee == d_vrai)
828: {
829: if (pthread_mutex_unlock(&((*(*s_etat_processus)
830: .s_liste_variables_partagees).mutex)) != 0)
831: {
832: (*s_etat_processus).erreur_systeme =
833: d_es_processus;
834: return;
835: }
836: }
837:
838: if (presence_variable == d_faux)
839: {
840: liberation(s_etat_processus, s_objet_argument_2);
841: }
842:
843: (*s_etat_processus).erreur_execution =
844: d_ex_erreur_type_argument;
845: return;
846: }
847:
848: if ((s_objet_resultat = allocation(s_etat_processus,
849: (*s_objet_argument_2).type)) == NULL)
850: {
851: if (variable_partagee == d_vrai)
852: {
853: if (pthread_mutex_unlock(&((*(*s_etat_processus)
854: .s_liste_variables_partagees).mutex)) != 0)
855: {
856: (*s_etat_processus).erreur_systeme =
857: d_es_processus;
858: return;
859: }
860: }
861:
862: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
863: return;
864: }
865:
866: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
867: nombre_lignes;
868: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
869: (*((struct_matrice *) (*s_objet_argument_2).objet))
870: .nombre_colonnes;
871:
872: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
873: malloc(nombre_lignes * sizeof(void *))) == NULL)
874: {
875: if (variable_partagee == d_vrai)
876: {
877: if (pthread_mutex_unlock(&((*(*s_etat_processus)
878: .s_liste_variables_partagees).mutex)) != 0)
879: {
880: (*s_etat_processus).erreur_systeme =
881: d_es_processus;
882: return;
883: }
884: }
885:
886: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
887: return;
888: }
889:
890: switch((*((struct_matrice *) (*s_objet_resultat).objet)).type)
891: {
892: case 'I' :
893: {
894: (*s_objet_resultat).type = MIN;
895:
896: l_element_courant = (struct_liste_chainee *)
897: (*s_objet_argument_1).objet;
898: i = 0;
899:
900: while(l_element_courant != NULL)
901: {
902: ligne = (*((integer8 *) (*(*l_element_courant).donnee)
903: .objet)) - 1;
904:
905: if (((*((struct_matrice *) (*s_objet_resultat).objet))
906: .tableau[i] = malloc((*((struct_matrice *)
907: (*s_objet_resultat).objet)).nombre_colonnes *
908: sizeof(integer8))) == NULL)
909: {
910: if (variable_partagee == d_vrai)
911: {
912: if (pthread_mutex_unlock(&((*(*s_etat_processus)
913: .s_liste_variables_partagees).mutex))
914: != 0)
915: {
916: (*s_etat_processus).erreur_systeme =
917: d_es_processus;
918: return;
919: }
920: }
921:
922: (*s_etat_processus).erreur_systeme =
923: d_es_allocation_memoire;
924: return;
925: }
926:
927: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat)
928: .objet)).nombre_colonnes; j++)
929: {
930: ((integer8 **) (*((struct_matrice *)
931: (*s_objet_resultat).objet)).tableau)[i][j] =
932: ((integer8 **) (*((struct_matrice *)
933: (*s_objet_argument_2).objet))
934: .tableau)[ligne][j];
935: }
936:
937: l_element_courant = (*l_element_courant).suivant;
938: i++;
939: }
940:
941: break;
942: }
943:
944: case 'R' :
945: {
946: (*s_objet_resultat).type = MRL;
947:
948: l_element_courant = (struct_liste_chainee *)
949: (*s_objet_argument_1).objet;
950: i = 0;
951:
952: while(l_element_courant != NULL)
953: {
954: ligne = (*((integer8 *) (*(*l_element_courant).donnee)
955: .objet)) - 1;
956:
957: if (((*((struct_matrice *) (*s_objet_resultat).objet))
958: .tableau[i] = malloc((*((struct_matrice *)
959: (*s_objet_resultat).objet)).nombre_colonnes *
960: sizeof(real8))) == NULL)
961: {
962: if (variable_partagee == d_vrai)
963: {
964: if (pthread_mutex_unlock(&((*(*s_etat_processus)
965: .s_liste_variables_partagees).mutex))
966: != 0)
967: {
968: (*s_etat_processus).erreur_systeme =
969: d_es_processus;
970: return;
971: }
972: }
973:
974: (*s_etat_processus).erreur_systeme =
975: d_es_allocation_memoire;
976: return;
977: }
978:
979: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat)
980: .objet)).nombre_colonnes; j++)
981: {
982: ((real8 **) (*((struct_matrice *)
983: (*s_objet_resultat).objet)).tableau)[i][j] =
984: ((real8 **) (*((struct_matrice *)
985: (*s_objet_argument_2).objet))
986: .tableau)[ligne][j];
987: }
988:
989: l_element_courant = (*l_element_courant).suivant;
990: i++;
991: }
992:
993: break;
994: }
995:
996: case 'C' :
997: {
998: (*s_objet_resultat).type = MCX;
999:
1000: l_element_courant = (struct_liste_chainee *)
1001: (*s_objet_argument_1).objet;
1002: i = 0;
1003:
1004: while(l_element_courant != NULL)
1005: {
1006: ligne = (*((integer8 *) (*(*l_element_courant).donnee)
1007: .objet)) - 1;
1008:
1009: if (((*((struct_matrice *) (*s_objet_resultat).objet))
1010: .tableau[i] = malloc((*((struct_matrice *)
1011: (*s_objet_resultat).objet)).nombre_colonnes *
1012: sizeof(complex16))) == NULL)
1013: {
1014: if (variable_partagee == d_vrai)
1015: {
1016: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1017: .s_liste_variables_partagees).mutex))
1018: != 0)
1019: {
1020: (*s_etat_processus).erreur_systeme =
1021: d_es_processus;
1022: return;
1023: }
1024: }
1025:
1026: (*s_etat_processus).erreur_systeme =
1027: d_es_allocation_memoire;
1028: return;
1029: }
1030:
1031: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat)
1032: .objet)).nombre_colonnes; j++)
1033: {
1034: ((complex16 **) (*((struct_matrice *)
1035: (*s_objet_resultat).objet)).tableau)[i][j]
1036: .partie_reelle =
1037: ((complex16 **) (*((struct_matrice *)
1038: (*s_objet_argument_2).objet))
1039: .tableau)[ligne][j].partie_reelle;
1040: ((complex16 **) (*((struct_matrice *)
1041: (*s_objet_resultat).objet)).tableau)[i][j]
1042: .partie_imaginaire =
1043: ((complex16 **) (*((struct_matrice *)
1044: (*s_objet_argument_2).objet))
1045: .tableau)[ligne][j].partie_imaginaire;
1046: }
1047:
1048: l_element_courant = (*l_element_courant).suivant;
1049: i++;
1050: }
1051:
1052: break;
1053: }
1054: }
1055: }
1056: else
1057: {
1058: liberation(s_etat_processus, s_objet_argument_1);
1059:
1060: if (variable_partagee == d_vrai)
1061: {
1062: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1063: .s_liste_variables_partagees).mutex))
1064: != 0)
1065: {
1066: (*s_etat_processus).erreur_systeme =
1067: d_es_processus;
1068: return;
1069: }
1070: }
1071:
1072: if (presence_variable == d_faux)
1073: {
1074: liberation(s_etat_processus, s_objet_argument_2);
1075: }
1076:
1077: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1078: return;
1079: }
1080: }
1081: else
1082: {
1083: liberation(s_etat_processus, s_objet_argument_1);
1084:
1085: if (variable_partagee == d_vrai)
1086: {
1087: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1088: .s_liste_variables_partagees).mutex))
1089: != 0)
1090: {
1091: (*s_etat_processus).erreur_systeme =
1092: d_es_processus;
1093: return;
1094: }
1095: }
1096:
1097: if (presence_variable == d_faux)
1098: {
1099: liberation(s_etat_processus, s_objet_argument_2);
1100: }
1101:
1102: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1103: return;
1104: }
1105:
1106: liberation(s_etat_processus, s_objet_argument_1);
1107:
1108: if (variable_partagee == d_vrai)
1109: {
1110: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1111: .s_liste_variables_partagees).mutex))
1112: != 0)
1113: {
1114: (*s_etat_processus).erreur_systeme =
1115: d_es_processus;
1116: return;
1117: }
1118: }
1119:
1120: if (presence_variable == d_faux)
1121: {
1122: liberation(s_etat_processus, s_objet_argument_2);
1123: }
1124:
1125: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1126: s_objet_resultat) == d_erreur)
1127: {
1128: return;
1129: }
1130:
1131: return;
1132: }
1133:
1134:
1135: /*
1136: ================================================================================
1137: Fonction 'gamma'
1138: ================================================================================
1139: Entrées : pointeur sur une structure struct_processus
1140: --------------------------------------------------------------------------------
1141: Sorties :
1142: --------------------------------------------------------------------------------
1143: Effets de bord : néant
1144: ================================================================================
1145: */
1146:
1147: void
1148: instruction_gamma(struct_processus *s_etat_processus)
1149: {
1150: double argument_imaginaire;
1151: double argument_reel;
1152:
1153: gsl_sf_result argument;
1154: gsl_sf_result ln_module;
1155: gsl_sf_result resultat;
1156:
1157: int statut;
1158:
1159: struct_liste_chainee *l_element_courant;
1160: struct_liste_chainee *l_element_precedent;
1161:
1162: struct_objet *s_copie_argument;
1163: struct_objet *s_objet_argument;
1164: struct_objet *s_objet_resultat;
1165:
1166: (*s_etat_processus).erreur_execution = d_ex;
1167:
1168: if ((*s_etat_processus).affichage_arguments == 'Y')
1169: {
1170: printf("\n GAMMA ");
1171:
1172: if ((*s_etat_processus).langue == 'F')
1173: {
1174: printf("(fonction gamma)\n\n");
1175: }
1176: else
1177: {
1178: printf("(gamma function)\n\n");
1179: }
1180:
1181: printf(" 1: %s, %s\n", d_INT, d_REL);
1182: printf("-> 1: %s\n\n", d_REL);
1183:
1184: printf(" 1: %s\n", d_CPL);
1185: printf("-> 1: %s\n\n", d_CPL);
1186:
1187: printf(" 1: %s, %s\n", d_NOM, d_ALG);
1188: printf("-> 1: %s\n\n", d_ALG);
1189:
1190: printf(" 1: %s\n", d_RPN);
1191: printf("-> 1: %s\n", d_RPN);
1192:
1193: return;
1194: }
1195: else if ((*s_etat_processus).test_instruction == 'Y')
1196: {
1197: (*s_etat_processus).nombre_arguments = 1;
1198: return;
1199: }
1200:
1201: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1202: {
1203: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1204: {
1205: return;
1206: }
1207: }
1208:
1209: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1210: &s_objet_argument) == d_erreur)
1211: {
1212: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1213: return;
1214: }
1215:
1216: statut = GSL_SUCCESS;
1217:
1218: /*
1219: --------------------------------------------------------------------------------
1220: Entier ou réel
1221: --------------------------------------------------------------------------------
1222: */
1223:
1224: if (((*s_objet_argument).type == INT) ||
1225: ((*s_objet_argument).type == REL))
1226: {
1227: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
1228: {
1229: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1230: return;
1231: }
1232:
1233: if ((*s_objet_argument).type == INT)
1234: {
1235: argument_reel = (*((integer8 *) (*s_objet_argument).objet));
1236: }
1237: else
1238: {
1239: argument_reel = (*((real8 *) (*s_objet_argument).objet));
1240: }
1241:
1242: statut = gsl_sf_gamma_e(argument_reel, &resultat);
1243:
1244: (*((real8 *) (*s_objet_resultat).objet)) = resultat.val;
1245: }
1246:
1247: /*
1248: --------------------------------------------------------------------------------
1249: Complexe
1250: --------------------------------------------------------------------------------
1251: */
1252:
1253: else if ((*s_objet_argument).type == CPL)
1254: {
1255: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
1256: {
1257: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1258: return;
1259: }
1260:
1261: argument_reel = (*((complex16 *) (*s_objet_argument).objet))
1262: .partie_reelle;
1263: argument_imaginaire = (*((complex16 *) (*s_objet_argument).objet))
1264: .partie_imaginaire;
1265:
1266: statut = gsl_sf_lngamma_complex_e(argument_reel, argument_imaginaire,
1267: &ln_module, &argument);
1268:
1269: (*((complex16 *) (*s_objet_resultat).objet)).partie_reelle =
1270: exp(ln_module.val) * cos(argument.val);
1271: (*((complex16 *) (*s_objet_resultat).objet)).partie_imaginaire =
1272: exp(ln_module.val) * sin(argument.val);
1273: }
1274:
1275: /*
1276: --------------------------------------------------------------------------------
1277: Nom
1278: --------------------------------------------------------------------------------
1279: */
1280:
1281: else if ((*s_objet_argument).type == NOM)
1282: {
1283: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
1284: {
1285: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1286: return;
1287: }
1288:
1289: if (((*s_objet_resultat).objet =
1290: allocation_maillon(s_etat_processus)) == NULL)
1291: {
1292: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1293: return;
1294: }
1295:
1296: l_element_courant = (*s_objet_resultat).objet;
1297:
1298: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1299: == NULL)
1300: {
1301: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1302: return;
1303: }
1304:
1305: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1306: .nombre_arguments = 0;
1307: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1308: .fonction = instruction_vers_niveau_superieur;
1309:
1310: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1311: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1312: {
1313: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1314: return;
1315: }
1316:
1317: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1318: .nom_fonction, "<<");
1319:
1320: if (((*l_element_courant).suivant =
1321: allocation_maillon(s_etat_processus)) == NULL)
1322: {
1323: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1324: return;
1325: }
1326:
1327: l_element_courant = (*l_element_courant).suivant;
1328: (*l_element_courant).donnee = s_objet_argument;
1329:
1330: if (((*l_element_courant).suivant =
1331: allocation_maillon(s_etat_processus)) == NULL)
1332: {
1333: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1334: return;
1335: }
1336:
1337: l_element_courant = (*l_element_courant).suivant;
1338:
1339: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1340: == NULL)
1341: {
1342: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1343: return;
1344: }
1345:
1346: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1347: .nombre_arguments = 1;
1348: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1349: .fonction = instruction_gamma;
1350:
1351: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1352: .nom_fonction = malloc(6 * sizeof(unsigned char))) == NULL)
1353: {
1354: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1355: return;
1356: }
1357:
1358: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1359: .nom_fonction, "GAMMA");
1360:
1361: if (((*l_element_courant).suivant =
1362: allocation_maillon(s_etat_processus)) == NULL)
1363: {
1364: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1365: return;
1366: }
1367:
1368: l_element_courant = (*l_element_courant).suivant;
1369:
1370: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1371: == NULL)
1372: {
1373: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1374: return;
1375: }
1376:
1377: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1378: .nombre_arguments = 0;
1379: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1380: .fonction = instruction_vers_niveau_inferieur;
1381:
1382: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1383: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1384: {
1385: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1386: return;
1387: }
1388:
1389: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1390: .nom_fonction, ">>");
1391:
1392: (*l_element_courant).suivant = NULL;
1393: s_objet_argument = NULL;
1394: }
1395:
1396: /*
1397: --------------------------------------------------------------------------------
1398: Expression
1399: --------------------------------------------------------------------------------
1400: */
1401:
1402: else if (((*s_objet_argument).type == ALG) ||
1403: ((*s_objet_argument).type == RPN))
1404: {
1405: if ((s_copie_argument = copie_objet(s_etat_processus,
1406: s_objet_argument, 'N')) == NULL)
1407: {
1408: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1409: return;
1410: }
1411:
1412: l_element_courant = (struct_liste_chainee *)
1413: (*s_copie_argument).objet;
1414: l_element_precedent = l_element_courant;
1415:
1416: while((*l_element_courant).suivant != NULL)
1417: {
1418: l_element_precedent = l_element_courant;
1419: l_element_courant = (*l_element_courant).suivant;
1420: }
1421:
1422: if (((*l_element_precedent).suivant =
1423: allocation_maillon(s_etat_processus)) == NULL)
1424: {
1425: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1426: return;
1427: }
1428:
1429: if (((*(*l_element_precedent).suivant).donnee =
1430: allocation(s_etat_processus, FCT)) == NULL)
1431: {
1432: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1433: return;
1434: }
1435:
1436: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1437: .donnee).objet)).nombre_arguments = 1;
1438: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1439: .donnee).objet)).fonction = instruction_gamma;
1440:
1441: if (((*((struct_fonction *) (*(*(*l_element_precedent)
1442: .suivant).donnee).objet)).nom_fonction =
1443: malloc(6 * sizeof(unsigned char))) == NULL)
1444: {
1445: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1446: return;
1447: }
1448:
1449: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
1450: .suivant).donnee).objet)).nom_fonction, "GAMMA");
1451:
1452: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1453:
1454: s_objet_resultat = s_copie_argument;
1455: }
1456:
1457: /*
1458: --------------------------------------------------------------------------------
1459: Argument absurde
1460: --------------------------------------------------------------------------------
1461: */
1462:
1463: else
1464: {
1465: liberation(s_etat_processus, s_objet_argument);
1466:
1467: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1468: return;
1469: }
1470:
1471: if (statut != GSL_SUCCESS)
1472: {
1473: traitement_asynchrone_exceptions_gsl(s_etat_processus);
1474: liberation(s_etat_processus, s_objet_resultat);
1475: }
1476: else
1477: {
1478: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1479: s_objet_resultat) == d_erreur)
1480: {
1481: return;
1482: }
1483: }
1484:
1485: liberation(s_etat_processus, s_objet_argument);
1486:
1487: return;
1488: }
1489:
1490: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_g4.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src