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