![[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|
Return to instructions_g4.c CVS log | Up to [local] / rpl / src |
1.1 bertrand 1: /*
2: ================================================================================
1.67 bertrand 3: RPL/2 (R) version 4.1.32
1.68 ! bertrand 4: Copyright (C) 1989-2020 Dr. BERTRAND Joël
1.1 bertrand 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:
1.11 bertrand 23: #include "rpl-conv.h"
1.1 bertrand 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:
1.44 bertrand 50: integer8 i;
51: integer8 j;
52: integer8 colonne;
53: integer8 nombre_colonnes;
1.1 bertrand 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:
1.19 bertrand 122: s_objet_argument_2 = (*(*s_etat_processus).pointeur_variable_courante)
123: .objet;
1.1 bertrand 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,
1.19 bertrand 131: (*(*s_etat_processus).pointeur_variable_courante).nom,
132: (*(*s_etat_processus).pointeur_variable_courante)
133: .variable_partagee, (*(*s_etat_processus)
1.39 bertrand 134: .pointeur_variable_courante).origine) == NULL)
1.1 bertrand 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)
1.38 bertrand 146: .pointeur_variable_partagee_courante).objet;
1.1 bertrand 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)
1.38 bertrand 179: .pointeur_variable_partagee_courante).mutex))
180: != 0)
1.1 bertrand 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)
1.38 bertrand 207: .pointeur_variable_partagee_courante).mutex))
208: != 0)
1.1 bertrand 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)
1.38 bertrand 236: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 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)
1.38 bertrand 259: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 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))
1.44 bertrand 283: .tableau = malloc(((size_t) (*((struct_matrice *)
284: (*s_objet_resultat).objet)).nombre_lignes) *
1.1 bertrand 285: sizeof(integer8 *))) == NULL)
286: {
287: if (variable_partagee == d_vrai)
288: {
289: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 290: .pointeur_variable_partagee_courante)
291: .mutex)) != 0)
1.1 bertrand 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))
1.44 bertrand 308: .tableau[i] = malloc(((size_t) nombre_colonnes)
309: * sizeof(integer8))) == NULL)
1.1 bertrand 310: {
311: if (variable_partagee == d_vrai)
312: {
313: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 314: .pointeur_variable_partagee_courante)
315: .mutex)) != 0)
1.1 bertrand 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))
1.44 bertrand 361: .tableau = malloc(((size_t) (*((struct_matrice *)
362: (*s_objet_resultat).objet)).nombre_lignes) *
1.1 bertrand 363: sizeof(real8 *))) == NULL)
364: {
365: if (variable_partagee == d_vrai)
366: {
367: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 368: .pointeur_variable_partagee_courante)
369: .mutex)) != 0)
1.1 bertrand 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))
1.44 bertrand 386: .tableau[i] = malloc(((size_t) nombre_colonnes)
387: * sizeof(real8))) == NULL)
1.1 bertrand 388: {
389: if (variable_partagee == d_vrai)
390: {
391: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 392: .pointeur_variable_partagee_courante)
393: .mutex)) != 0)
1.1 bertrand 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))
1.44 bertrand 439: .tableau = malloc(((size_t) (*((struct_matrice *)
440: (*s_objet_resultat).objet)).nombre_lignes) *
1.1 bertrand 441: sizeof(complex16 *))) == NULL)
442: {
443: if (variable_partagee == d_vrai)
444: {
445: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 446: .pointeur_variable_partagee_courante)
447: .mutex)) != 0)
1.1 bertrand 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))
1.44 bertrand 464: .tableau[i] = malloc(((size_t) nombre_colonnes)
465: * sizeof(complex16))) == NULL)
1.1 bertrand 466: {
467: if (variable_partagee == d_vrai)
468: {
469: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 470: .pointeur_variable_partagee_courante)
471: .mutex)) != 0)
1.1 bertrand 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)
1.38 bertrand 527: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 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)
1.38 bertrand 551: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 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)
1.38 bertrand 573: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 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:
1.44 bertrand 620: integer8 i;
621: integer8 j;
622: integer8 ligne;
623: integer8 nombre_lignes;
1.1 bertrand 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:
1.19 bertrand 689: s_objet_argument_2 = (*(*s_etat_processus).pointeur_variable_courante)
690: .objet;
1.1 bertrand 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,
1.19 bertrand 698: (*(*s_etat_processus).pointeur_variable_courante).nom,
699: (*(*s_etat_processus).pointeur_variable_courante)
700: .variable_partagee, (*(*s_etat_processus)
1.39 bertrand 701: .pointeur_variable_courante).origine) == NULL)
1.1 bertrand 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)
1.38 bertrand 713: .pointeur_variable_partagee_courante).objet;
1.1 bertrand 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)
1.38 bertrand 746: .pointeur_variable_partagee_courante).mutex))
747: != 0)
1.1 bertrand 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)
1.38 bertrand 775: .pointeur_variable_partagee_courante).mutex))
776: != 0)
1.1 bertrand 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)
1.38 bertrand 805: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 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)
1.38 bertrand 829: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 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 =
1.44 bertrand 848: malloc(((size_t) nombre_lignes) * sizeof(void *))) == NULL)
1.1 bertrand 849: {
850: if (variable_partagee == d_vrai)
851: {
852: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 853: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 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))
1.44 bertrand 881: .tableau[i] = malloc(((size_t)
882: (*((struct_matrice *)
883: (*s_objet_resultat).objet)).nombre_colonnes) *
1.1 bertrand 884: sizeof(integer8))) == NULL)
885: {
886: if (variable_partagee == d_vrai)
887: {
888: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 889: .pointeur_variable_partagee_courante)
890: .mutex)) != 0)
1.1 bertrand 891: {
892: (*s_etat_processus).erreur_systeme =
893: d_es_processus;
894: return;
895: }
896: }
897:
898: (*s_etat_processus).erreur_systeme =
899: d_es_allocation_memoire;
900: return;
901: }
902:
903: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat)
904: .objet)).nombre_colonnes; j++)
905: {
906: ((integer8 **) (*((struct_matrice *)
907: (*s_objet_resultat).objet)).tableau)[i][j] =
908: ((integer8 **) (*((struct_matrice *)
909: (*s_objet_argument_2).objet))
910: .tableau)[ligne][j];
911: }
912:
913: l_element_courant = (*l_element_courant).suivant;
914: i++;
915: }
916:
917: break;
918: }
919:
920: case 'R' :
921: {
922: (*s_objet_resultat).type = MRL;
923:
924: l_element_courant = (struct_liste_chainee *)
925: (*s_objet_argument_1).objet;
926: i = 0;
927:
928: while(l_element_courant != NULL)
929: {
930: ligne = (*((integer8 *) (*(*l_element_courant).donnee)
931: .objet)) - 1;
932:
933: if (((*((struct_matrice *) (*s_objet_resultat).objet))
1.44 bertrand 934: .tableau[i] = malloc(((size_t)
935: (*((struct_matrice *)
936: (*s_objet_resultat).objet)).nombre_colonnes) *
1.1 bertrand 937: sizeof(real8))) == NULL)
938: {
939: if (variable_partagee == d_vrai)
940: {
941: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 942: .pointeur_variable_partagee_courante)
943: .mutex)) != 0)
1.1 bertrand 944: {
945: (*s_etat_processus).erreur_systeme =
946: d_es_processus;
947: return;
948: }
949: }
950:
951: (*s_etat_processus).erreur_systeme =
952: d_es_allocation_memoire;
953: return;
954: }
955:
956: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat)
957: .objet)).nombre_colonnes; j++)
958: {
959: ((real8 **) (*((struct_matrice *)
960: (*s_objet_resultat).objet)).tableau)[i][j] =
961: ((real8 **) (*((struct_matrice *)
962: (*s_objet_argument_2).objet))
963: .tableau)[ligne][j];
964: }
965:
966: l_element_courant = (*l_element_courant).suivant;
967: i++;
968: }
969:
970: break;
971: }
972:
973: case 'C' :
974: {
975: (*s_objet_resultat).type = MCX;
976:
977: l_element_courant = (struct_liste_chainee *)
978: (*s_objet_argument_1).objet;
979: i = 0;
980:
981: while(l_element_courant != NULL)
982: {
983: ligne = (*((integer8 *) (*(*l_element_courant).donnee)
984: .objet)) - 1;
985:
986: if (((*((struct_matrice *) (*s_objet_resultat).objet))
1.44 bertrand 987: .tableau[i] = malloc(((size_t)
988: (*((struct_matrice *)
989: (*s_objet_resultat).objet)).nombre_colonnes) *
1.1 bertrand 990: sizeof(complex16))) == NULL)
991: {
992: if (variable_partagee == d_vrai)
993: {
994: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 995: .pointeur_variable_partagee_courante)
996: .mutex)) != 0)
1.1 bertrand 997: {
998: (*s_etat_processus).erreur_systeme =
999: d_es_processus;
1000: return;
1001: }
1002: }
1003:
1004: (*s_etat_processus).erreur_systeme =
1005: d_es_allocation_memoire;
1006: return;
1007: }
1008:
1009: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat)
1010: .objet)).nombre_colonnes; j++)
1011: {
1012: ((complex16 **) (*((struct_matrice *)
1013: (*s_objet_resultat).objet)).tableau)[i][j]
1014: .partie_reelle =
1015: ((complex16 **) (*((struct_matrice *)
1016: (*s_objet_argument_2).objet))
1017: .tableau)[ligne][j].partie_reelle;
1018: ((complex16 **) (*((struct_matrice *)
1019: (*s_objet_resultat).objet)).tableau)[i][j]
1020: .partie_imaginaire =
1021: ((complex16 **) (*((struct_matrice *)
1022: (*s_objet_argument_2).objet))
1023: .tableau)[ligne][j].partie_imaginaire;
1024: }
1025:
1026: l_element_courant = (*l_element_courant).suivant;
1027: i++;
1028: }
1029:
1030: break;
1031: }
1032: }
1033: }
1034: else
1035: {
1036: liberation(s_etat_processus, s_objet_argument_1);
1037:
1038: if (variable_partagee == d_vrai)
1039: {
1040: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 1041: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 1042: {
1043: (*s_etat_processus).erreur_systeme =
1044: d_es_processus;
1045: return;
1046: }
1047: }
1048:
1049: if (presence_variable == d_faux)
1050: {
1051: liberation(s_etat_processus, s_objet_argument_2);
1052: }
1053:
1054: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1055: return;
1056: }
1057: }
1058: else
1059: {
1060: liberation(s_etat_processus, s_objet_argument_1);
1061:
1062: if (variable_partagee == d_vrai)
1063: {
1064: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 1065: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 1066: {
1067: (*s_etat_processus).erreur_systeme =
1068: d_es_processus;
1069: return;
1070: }
1071: }
1072:
1073: if (presence_variable == d_faux)
1074: {
1075: liberation(s_etat_processus, s_objet_argument_2);
1076: }
1077:
1078: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1079: return;
1080: }
1081:
1082: liberation(s_etat_processus, s_objet_argument_1);
1083:
1084: if (variable_partagee == d_vrai)
1085: {
1086: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 1087: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 1088: {
1089: (*s_etat_processus).erreur_systeme =
1090: d_es_processus;
1091: return;
1092: }
1093: }
1094:
1095: if (presence_variable == d_faux)
1096: {
1097: liberation(s_etat_processus, s_objet_argument_2);
1098: }
1099:
1100: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1101: s_objet_resultat) == d_erreur)
1102: {
1103: return;
1104: }
1105:
1106: return;
1107: }
1108:
1109:
1110: /*
1111: ================================================================================
1112: Fonction 'gamma'
1113: ================================================================================
1114: Entrées : pointeur sur une structure struct_processus
1115: --------------------------------------------------------------------------------
1116: Sorties :
1117: --------------------------------------------------------------------------------
1118: Effets de bord : néant
1119: ================================================================================
1120: */
1121:
1122: void
1123: instruction_gamma(struct_processus *s_etat_processus)
1124: {
1125: double argument_imaginaire;
1126: double argument_reel;
1127:
1128: gsl_sf_result argument;
1129: gsl_sf_result ln_module;
1130: gsl_sf_result resultat;
1131:
1132: int statut;
1133:
1134: struct_liste_chainee *l_element_courant;
1135: struct_liste_chainee *l_element_precedent;
1136:
1137: struct_objet *s_copie_argument;
1138: struct_objet *s_objet_argument;
1139: struct_objet *s_objet_resultat;
1140:
1141: (*s_etat_processus).erreur_execution = d_ex;
1142:
1143: if ((*s_etat_processus).affichage_arguments == 'Y')
1144: {
1145: printf("\n GAMMA ");
1146:
1147: if ((*s_etat_processus).langue == 'F')
1148: {
1149: printf("(fonction gamma)\n\n");
1150: }
1151: else
1152: {
1153: printf("(gamma function)\n\n");
1154: }
1155:
1156: printf(" 1: %s, %s\n", d_INT, d_REL);
1157: printf("-> 1: %s\n\n", d_REL);
1158:
1159: printf(" 1: %s\n", d_CPL);
1160: printf("-> 1: %s\n\n", d_CPL);
1161:
1162: printf(" 1: %s, %s\n", d_NOM, d_ALG);
1163: printf("-> 1: %s\n\n", d_ALG);
1164:
1165: printf(" 1: %s\n", d_RPN);
1166: printf("-> 1: %s\n", d_RPN);
1167:
1168: return;
1169: }
1170: else if ((*s_etat_processus).test_instruction == 'Y')
1171: {
1172: (*s_etat_processus).nombre_arguments = 1;
1173: return;
1174: }
1175:
1176: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1177: {
1178: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1179: {
1180: return;
1181: }
1182: }
1183:
1184: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1185: &s_objet_argument) == d_erreur)
1186: {
1187: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1188: return;
1189: }
1190:
1191: statut = GSL_SUCCESS;
1192:
1193: /*
1194: --------------------------------------------------------------------------------
1195: Entier ou réel
1196: --------------------------------------------------------------------------------
1197: */
1198:
1199: if (((*s_objet_argument).type == INT) ||
1200: ((*s_objet_argument).type == REL))
1201: {
1202: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
1203: {
1204: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1205: return;
1206: }
1207:
1208: if ((*s_objet_argument).type == INT)
1209: {
1.44 bertrand 1210: argument_reel = (real8) (*((integer8 *) (*s_objet_argument).objet));
1.1 bertrand 1211: }
1212: else
1213: {
1214: argument_reel = (*((real8 *) (*s_objet_argument).objet));
1215: }
1216:
1217: statut = gsl_sf_gamma_e(argument_reel, &resultat);
1218:
1219: (*((real8 *) (*s_objet_resultat).objet)) = resultat.val;
1220: }
1221:
1222: /*
1223: --------------------------------------------------------------------------------
1224: Complexe
1225: --------------------------------------------------------------------------------
1226: */
1227:
1228: else if ((*s_objet_argument).type == CPL)
1229: {
1230: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
1231: {
1232: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1233: return;
1234: }
1235:
1236: argument_reel = (*((complex16 *) (*s_objet_argument).objet))
1237: .partie_reelle;
1238: argument_imaginaire = (*((complex16 *) (*s_objet_argument).objet))
1239: .partie_imaginaire;
1240:
1241: statut = gsl_sf_lngamma_complex_e(argument_reel, argument_imaginaire,
1242: &ln_module, &argument);
1243:
1244: (*((complex16 *) (*s_objet_resultat).objet)).partie_reelle =
1245: exp(ln_module.val) * cos(argument.val);
1246: (*((complex16 *) (*s_objet_resultat).objet)).partie_imaginaire =
1247: exp(ln_module.val) * sin(argument.val);
1248: }
1249:
1250: /*
1251: --------------------------------------------------------------------------------
1252: Nom
1253: --------------------------------------------------------------------------------
1254: */
1255:
1256: else if ((*s_objet_argument).type == NOM)
1257: {
1258: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
1259: {
1260: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1261: return;
1262: }
1263:
1264: if (((*s_objet_resultat).objet =
1265: allocation_maillon(s_etat_processus)) == NULL)
1266: {
1267: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1268: return;
1269: }
1270:
1271: l_element_courant = (*s_objet_resultat).objet;
1272:
1273: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1274: == NULL)
1275: {
1276: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1277: return;
1278: }
1279:
1280: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1281: .nombre_arguments = 0;
1282: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1283: .fonction = instruction_vers_niveau_superieur;
1284:
1285: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1286: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1287: {
1288: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1289: return;
1290: }
1291:
1292: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1293: .nom_fonction, "<<");
1294:
1295: if (((*l_element_courant).suivant =
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 = (*l_element_courant).suivant;
1303: (*l_element_courant).donnee = s_objet_argument;
1304:
1305: if (((*l_element_courant).suivant =
1306: allocation_maillon(s_etat_processus)) == NULL)
1307: {
1308: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1309: return;
1310: }
1311:
1312: l_element_courant = (*l_element_courant).suivant;
1313:
1314: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1315: == NULL)
1316: {
1317: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1318: return;
1319: }
1320:
1321: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1322: .nombre_arguments = 1;
1323: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1324: .fonction = instruction_gamma;
1325:
1326: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1327: .nom_fonction = malloc(6 * sizeof(unsigned char))) == NULL)
1328: {
1329: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1330: return;
1331: }
1332:
1333: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1334: .nom_fonction, "GAMMA");
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 = 0;
1354: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1355: .fonction = instruction_vers_niveau_inferieur;
1356:
1357: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1358: .nom_fonction = malloc(3 * 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, ">>");
1366:
1367: (*l_element_courant).suivant = NULL;
1368: s_objet_argument = NULL;
1369: }
1370:
1371: /*
1372: --------------------------------------------------------------------------------
1373: Expression
1374: --------------------------------------------------------------------------------
1375: */
1376:
1377: else if (((*s_objet_argument).type == ALG) ||
1378: ((*s_objet_argument).type == RPN))
1379: {
1380: if ((s_copie_argument = copie_objet(s_etat_processus,
1381: s_objet_argument, 'N')) == NULL)
1382: {
1383: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1384: return;
1385: }
1386:
1387: l_element_courant = (struct_liste_chainee *)
1388: (*s_copie_argument).objet;
1389: l_element_precedent = l_element_courant;
1390:
1391: while((*l_element_courant).suivant != NULL)
1392: {
1393: l_element_precedent = l_element_courant;
1394: l_element_courant = (*l_element_courant).suivant;
1395: }
1396:
1397: if (((*l_element_precedent).suivant =
1398: allocation_maillon(s_etat_processus)) == NULL)
1399: {
1400: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1401: return;
1402: }
1403:
1404: if (((*(*l_element_precedent).suivant).donnee =
1405: allocation(s_etat_processus, FCT)) == NULL)
1406: {
1407: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1408: return;
1409: }
1410:
1411: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1412: .donnee).objet)).nombre_arguments = 1;
1413: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1414: .donnee).objet)).fonction = instruction_gamma;
1415:
1416: if (((*((struct_fonction *) (*(*(*l_element_precedent)
1417: .suivant).donnee).objet)).nom_fonction =
1418: malloc(6 * sizeof(unsigned char))) == NULL)
1419: {
1420: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1421: return;
1422: }
1423:
1424: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
1425: .suivant).donnee).objet)).nom_fonction, "GAMMA");
1426:
1427: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1428:
1429: s_objet_resultat = s_copie_argument;
1430: }
1431:
1432: /*
1433: --------------------------------------------------------------------------------
1434: Argument absurde
1435: --------------------------------------------------------------------------------
1436: */
1437:
1438: else
1439: {
1440: liberation(s_etat_processus, s_objet_argument);
1441:
1442: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1443: return;
1444: }
1445:
1446: if (statut != GSL_SUCCESS)
1447: {
1448: traitement_asynchrone_exceptions_gsl(s_etat_processus);
1449: liberation(s_etat_processus, s_objet_resultat);
1450: }
1451: else
1452: {
1453: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1454: s_objet_resultat) == d_erreur)
1455: {
1456: return;
1457: }
1458: }
1459:
1460: liberation(s_etat_processus, s_objet_argument);
1461:
1462: return;
1463: }
1464:
1465: // vim: ts=4