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