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