Annotation of rpl/src/instructions_i2.c, revision 1.42
1.1 bertrand 1: /*
2: ================================================================================
1.42 ! bertrand 3: RPL/2 (R) version 4.1.11
1.35 bertrand 4: Copyright (C) 1989-2012 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 '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:
1.19 bertrand 110: if ((*(*s_etat_processus).pointeur_variable_courante)
111: .variable_verrouillee == d_vrai)
1.1 bertrand 112: {
113: (*s_etat_processus).erreur_execution = d_ex_variable_verrouillee;
114: return;
115: }
116:
1.19 bertrand 117: s_objet_argument = (*(*s_etat_processus).pointeur_variable_courante)
118: .objet;
1.1 bertrand 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,
1.19 bertrand 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)
1.1 bertrand 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: {
1.19 bertrand 327: (*(*s_etat_processus).pointeur_variable_courante).objet = NULL;
1.1 bertrand 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: {
1.19 bertrand 341: (*(*s_etat_processus).pointeur_variable_courante).objet =
342: s_objet_resultat;
1.1 bertrand 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:
1.38 bertrand 785: unsigned char *ptr_e;
786: unsigned char *ptr_l;
1.1 bertrand 787: unsigned char *tampon;
1.38 bertrand 788: unsigned char *tampon2;
789:
790: unsigned long i;
1.1 bertrand 791:
792: (*s_etat_processus).erreur_execution = d_ex;
793:
794: if ((*s_etat_processus).affichage_arguments == 'Y')
795: {
796: printf("\n INPUT ");
797:
798: if ((*s_etat_processus).langue == 'F')
799: {
800: printf("(attente d'une entrée)\n\n");
801: }
802: else
803: {
804: printf("(input)\n\n");
805: }
806:
807: printf("-> 1: %s\n", d_CHN);
808:
809: return;
810: }
811: else if ((*s_etat_processus).test_instruction == 'Y')
812: {
813: (*s_etat_processus).nombre_arguments = -1;
814: return;
815: }
816:
817: if (test_cfsf(s_etat_processus, 31) == d_vrai)
818: {
819: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
820: {
821: return;
822: }
823: }
824:
825: if ((s_objet_resultat = allocation(s_etat_processus, CHN)) == NULL)
826: {
827: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
828: return;
829: }
830:
831: flockfile(stdin);
832: (*s_objet_resultat).objet = (void *) readline("");
833: funlockfile(stdin);
834:
835: if ((*s_objet_resultat).objet == NULL)
836: {
837: if (((*s_objet_resultat).objet = malloc(sizeof(unsigned char)))
838: == NULL)
839: {
840: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
841: return;
842: }
843:
844: (*((unsigned char *) (*s_objet_resultat).objet)) =
845: d_code_fin_chaine;
846: }
847:
848: if ((tampon = transliteration(s_etat_processus,
849: (unsigned char *) (*s_objet_resultat).objet,
850: (*s_etat_processus).localisation, d_locale)) == NULL)
851: {
852: return;
853: }
854:
855: free((unsigned char *) (*s_objet_resultat).objet);
1.38 bertrand 856:
857: ptr_l = tampon;
858: i = 0;
859:
860: while((*ptr_l) != d_code_fin_chaine)
861: {
862: if ((*ptr_l) == '\"')
863: {
864: i++;
865: }
866:
867: ptr_l++;
868: }
869:
870: if ((tampon2 = malloc((strlen(tampon) + 1 + i) *
871: sizeof(unsigned char))) == NULL)
872: {
873: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
874: return;
875: }
876:
877: ptr_l = tampon;
878: ptr_e = tampon2;
879:
880: while((*ptr_l) != d_code_fin_chaine)
881: {
882: if ((*ptr_l) == '\"')
883: {
884: (*ptr_e) = '\\';
885: ptr_e++;
886: }
887:
888: (*ptr_e) = (*ptr_l);
889: ptr_e++;
890: ptr_l++;
891: }
892:
893: free(tampon);
894: (*s_objet_resultat).objet = tampon2;
1.1 bertrand 895:
896: add_history((unsigned char *) (*s_objet_resultat).objet);
897: stifle_history(ds_longueur_historique);
898:
899: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
900: s_objet_resultat) == d_erreur)
901: {
902: return;
903: }
904:
905: return;
906: }
907:
908:
909: /*
910: ================================================================================
911: Fonction 'indep'
912: ================================================================================
913: Entrées : pointeur sur une structure struct_processus
914: --------------------------------------------------------------------------------
915: Sorties :
916: --------------------------------------------------------------------------------
917: Effets de bord : néant
918: ================================================================================
919: */
920:
921: void
922: instruction_indep(struct_processus *s_etat_processus)
923: {
924: struct_liste_chainee *l_element_courant;
925:
926: struct_objet *s_objet;
927:
928: (*s_etat_processus).erreur_execution = d_ex;
929:
930: if ((*s_etat_processus).affichage_arguments == 'Y')
931: {
932: printf("\n INDEP ");
933:
934: if ((*s_etat_processus).langue == 'F')
935: {
936: printf("(indication de la variable indépendante)\n\n");
937: }
938: else
939: {
940: printf("(set independant variable)\n\n");
941: }
942:
943: printf(" 1: %s, %s\n", d_NOM, d_LST);
944:
945: return;
946: }
947: else if ((*s_etat_processus).test_instruction == 'Y')
948: {
949: (*s_etat_processus).nombre_arguments = -1;
950: return;
951: }
952:
953: if (test_cfsf(s_etat_processus, 31) == d_vrai)
954: {
955: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
956: {
957: return;
958: }
959: }
960:
961: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
962: &s_objet) == d_erreur)
963: {
964: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
965: return;
966: }
967:
968: if ((*s_objet).type == NOM)
969: {
970: liberation(s_etat_processus, (*s_etat_processus).indep);
971: (*s_etat_processus).indep = s_objet;
972: }
973: else if ((*s_objet).type == LST)
974: {
975: l_element_courant = (struct_liste_chainee *) (*s_objet).objet;
976:
977: if ((*(*l_element_courant).donnee).type != NOM)
978: {
979: liberation(s_etat_processus, s_objet);
980:
981: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
982: return;
983: }
984:
985: (*((struct_nom *) (*(*l_element_courant).donnee).objet)).symbole =
986: d_vrai;
987:
988: l_element_courant = (*l_element_courant).suivant;
989:
990: if (!(((*(*l_element_courant).donnee).type == INT) ||
991: ((*(*l_element_courant).donnee).type == REL) ||
992: ((*(*l_element_courant).donnee).type == NOM) ||
993: ((*(*l_element_courant).donnee).type == ALG) ||
994: ((*(*l_element_courant).donnee).type == RPN)))
995: {
996: liberation(s_etat_processus, s_objet);
997:
998: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
999: return;
1000: }
1001:
1002: l_element_courant = (*l_element_courant).suivant;
1003:
1004: if (!(((*(*l_element_courant).donnee).type == INT) ||
1005: ((*(*l_element_courant).donnee).type == REL) ||
1006: ((*(*l_element_courant).donnee).type == NOM) ||
1007: ((*(*l_element_courant).donnee).type == ALG) ||
1008: ((*(*l_element_courant).donnee).type == RPN)))
1009: {
1010: liberation(s_etat_processus, s_objet);
1011:
1012: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
1013: return;
1014: }
1015:
1016: l_element_courant = (*l_element_courant).suivant;
1017:
1018: if (l_element_courant != NULL)
1019: {
1020: liberation(s_etat_processus, s_objet);
1021:
1022: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
1023: return;
1024: }
1025:
1026: liberation(s_etat_processus, (*s_etat_processus).indep);
1027: (*s_etat_processus).indep = s_objet;
1028: }
1029: else
1030: {
1031: liberation(s_etat_processus, s_objet);
1032:
1033: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1034: return;
1035: }
1036:
1037: return;
1038: }
1039:
1040:
1041: /*
1042: ================================================================================
1043: Fonction 'int'
1044: ================================================================================
1045: Entrées : pointeur sur une struct_processus
1046: --------------------------------------------------------------------------------
1047: Sorties :
1048: --------------------------------------------------------------------------------
1049: Effets de bord : néant
1050: ================================================================================
1051: */
1052:
1053: void
1054: instruction_int(struct_processus *s_etat_processus)
1055: {
1056: logical1 last_valide;
1057:
1058: real8 borne_maximale;
1059: real8 borne_minimale;
1060: real8 precision;
1061:
1062: struct_liste_chainee *l_element_courant;
1063:
1064: struct_objet *s_objet_argument_1;
1065: struct_objet *s_objet_argument_2;
1066: struct_objet *s_objet_argument_3;
1067: struct_objet *s_objet_evalue;
1068:
1069: unsigned char *nom_variable;
1070:
1071: (*s_etat_processus).erreur_execution = d_ex;
1072:
1073: if ((*s_etat_processus).affichage_arguments == 'Y')
1074: {
1075: printf("\n INT ");
1076:
1077: if ((*s_etat_processus).langue == 'F')
1078: {
1.24 bertrand 1079: printf("(intégration)\n\n");
1.1 bertrand 1080: }
1081: else
1082: {
1.24 bertrand 1083: printf("(numerical)\n\n");
1.1 bertrand 1084: }
1085:
1.26 bertrand 1086: printf(" 3: %s, %s, %s, %s, %s\n", d_INT, d_REL,
1087: d_NOM, d_ALG, d_RPN);
1.1 bertrand 1088: printf(" 2: %s\n", d_LST);
1089: printf(" 1: %s, %s\n", d_INT, d_REL);
1090: printf("-> 2: %s, %s\n", d_INT, d_REL);
1.24 bertrand 1091: printf(" 1: %s, %s\n\n", d_INT, d_REL);
1.1 bertrand 1092:
1.26 bertrand 1093: printf(" 2: %s, %s, %s, %s\n", d_INT, d_REL, d_NOM, d_ALG);
1.24 bertrand 1094: printf(" 1: %s\n", d_NOM);
1.30 bertrand 1095: printf("-> 1: %s, %s, %s, %s\n", d_INT, d_REL, d_NOM, d_ALG);
1.1 bertrand 1096: return;
1097: }
1098: else if ((*s_etat_processus).test_instruction == 'Y')
1099: {
1.24 bertrand 1100: (*s_etat_processus).nombre_arguments = -1;
1.1 bertrand 1101: return;
1102: }
1103:
1.24 bertrand 1104: if ((*s_etat_processus).l_base_pile == NULL)
1.1 bertrand 1105: {
1106: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1107: return;
1108: }
1109:
1.24 bertrand 1110: if ((*(*(*s_etat_processus).l_base_pile).donnee).type == NOM)
1.1 bertrand 1111: {
1.24 bertrand 1112: // Intégration symbolique
1113:
1114: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1115: {
1.30 bertrand 1116: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
1.24 bertrand 1117: {
1118: return;
1119: }
1120: }
1121:
1122: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1123: &s_objet_argument_1) == d_erreur)
1124: {
1125: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1126: return;
1127: }
1128:
1129: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1130: &s_objet_argument_2) == d_erreur)
1131: {
1132: liberation(s_etat_processus, s_objet_argument_1);
1133:
1134: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1135: return;
1136: }
1.1 bertrand 1137:
1.24 bertrand 1138: if (((*s_objet_argument_1).type == NOM) &&
1139: (((*s_objet_argument_2).type == NOM) ||
1.26 bertrand 1140: ((*s_objet_argument_2).type == ALG) ||
1141: ((*s_objet_argument_2).type == REL) ||
1142: ((*s_objet_argument_2).type == INT)))
1.24 bertrand 1143: {
1144: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1145: s_objet_argument_2) == d_erreur)
1146: {
1147: return;
1148: }
1.1 bertrand 1149:
1.24 bertrand 1150: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1151: s_objet_argument_1) == d_erreur)
1152: {
1153: return;
1154: }
1.1 bertrand 1155:
1.24 bertrand 1156: interface_cas(s_etat_processus, RPLCAS_INTEGRATION);
1157: }
1158: else
1159: {
1160: liberation(s_etat_processus, s_objet_argument_1);
1161: liberation(s_etat_processus, s_objet_argument_2);
1.1 bertrand 1162:
1.24 bertrand 1163: (*s_etat_processus).erreur_execution =
1164: d_ex_erreur_type_argument;
1165: return;
1166: }
1.1 bertrand 1167: }
1168: else
1169: {
1.24 bertrand 1170: // Intégration numérique
1.1 bertrand 1171:
1.24 bertrand 1172: if ((last_valide = test_cfsf(s_etat_processus, 31)) == d_vrai)
1173: {
1174: if (empilement_pile_last(s_etat_processus, 3) == d_erreur)
1175: {
1176: return;
1177: }
1178: }
1.1 bertrand 1179:
1.24 bertrand 1180: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1181: &s_objet_argument_1) == d_erreur)
1182: {
1183: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1184: return;
1185: }
1.1 bertrand 1186:
1.24 bertrand 1187: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1188: &s_objet_argument_2) == d_erreur)
1.1 bertrand 1189: {
1190: liberation(s_etat_processus, s_objet_argument_1);
1191:
1.24 bertrand 1192: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1.1 bertrand 1193: return;
1194: }
1195:
1.24 bertrand 1196: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1197: &s_objet_argument_3) == d_erreur)
1.1 bertrand 1198: {
1.24 bertrand 1199: liberation(s_etat_processus, s_objet_argument_1);
1200: liberation(s_etat_processus, s_objet_argument_2);
1201:
1202: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1.1 bertrand 1203: return;
1204: }
1205:
1.33 bertrand 1206: if (((*s_objet_argument_3).type != NOM) &&
1207: ((*s_objet_argument_3).type != ALG) &&
1208: ((*s_objet_argument_3).type != RPN) &&
1209: ((*s_objet_argument_3).type != REL) &&
1210: ((*s_objet_argument_3).type != INT))
1.26 bertrand 1211: {
1212: liberation(s_etat_processus, s_objet_argument_1);
1213: liberation(s_etat_processus, s_objet_argument_2);
1214: liberation(s_etat_processus, s_objet_argument_3);
1215:
1216: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1217: return;
1218: }
1219:
1.24 bertrand 1220: if ((*s_objet_argument_1).type == INT)
1.1 bertrand 1221: {
1.24 bertrand 1222: precision = (*((integer8 *) (*s_objet_argument_1).objet));
1.1 bertrand 1223: }
1.24 bertrand 1224: else if ((*s_objet_argument_1).type == REL)
1.1 bertrand 1225: {
1.24 bertrand 1226: precision = (*((real8 *) (*s_objet_argument_1).objet));
1.1 bertrand 1227: }
1228: else
1229: {
1.24 bertrand 1230: liberation(s_etat_processus, s_objet_argument_1);
1231: liberation(s_etat_processus, s_objet_argument_2);
1232: liberation(s_etat_processus, s_objet_argument_3);
1233:
1234: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1235: return;
1236: }
1237:
1238: if ((*s_objet_argument_2).type == LST)
1239: {
1240: l_element_courant = (*s_objet_argument_2).objet;
1241:
1242: if ((*(*l_element_courant).donnee).type != NOM)
1.1 bertrand 1243: {
1244: liberation(s_etat_processus, s_objet_argument_1);
1245: liberation(s_etat_processus, s_objet_argument_2);
1246: liberation(s_etat_processus, s_objet_argument_3);
1247:
1.24 bertrand 1248: (*s_etat_processus).erreur_execution =
1249: d_ex_erreur_type_argument;
1.1 bertrand 1250: return;
1251: }
1252:
1.24 bertrand 1253: if ((nom_variable = malloc((strlen((*((struct_nom *)
1254: (*(*l_element_courant).donnee).objet)).nom)
1255: + 1) * sizeof(unsigned char))) == NULL)
1.1 bertrand 1256: {
1.24 bertrand 1257: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1.1 bertrand 1258: return;
1259: }
1260:
1.24 bertrand 1261: strcpy(nom_variable, (*((struct_nom *) (*(*l_element_courant)
1262: .donnee).objet)).nom);
1263:
1264: l_element_courant = (*l_element_courant).suivant;
1265:
1266: if ((*(*l_element_courant).donnee).type == INT)
1.1 bertrand 1267: {
1268: borne_minimale = (real8) (*((integer8 *)
1.24 bertrand 1269: (*(*l_element_courant).donnee).objet));
1.1 bertrand 1270: }
1.24 bertrand 1271: else if ((*(*l_element_courant).donnee).type == REL)
1.1 bertrand 1272: {
1.24 bertrand 1273: borne_minimale = (*((real8 *) (*(*l_element_courant)
1274: .donnee).objet));
1.1 bertrand 1275: }
1276: else
1277: {
1.24 bertrand 1278: if (evaluation(s_etat_processus, (*l_element_courant).donnee,
1279: 'N') == d_erreur)
1280: {
1281: free(nom_variable);
1282: liberation(s_etat_processus, s_objet_argument_1);
1283: liberation(s_etat_processus, s_objet_argument_2);
1284: liberation(s_etat_processus, s_objet_argument_3);
1.1 bertrand 1285:
1.24 bertrand 1286: return;
1287: }
1.1 bertrand 1288:
1.24 bertrand 1289: if (depilement(s_etat_processus, &((*s_etat_processus)
1290: .l_base_pile), &s_objet_evalue) == d_erreur)
1291: {
1292: free(nom_variable);
1293: liberation(s_etat_processus, s_objet_argument_1);
1294: liberation(s_etat_processus, s_objet_argument_2);
1295: liberation(s_etat_processus, s_objet_argument_3);
1.1 bertrand 1296:
1.24 bertrand 1297: (*s_etat_processus).erreur_execution =
1298: d_ex_manque_argument;
1299: return;
1300: }
1.1 bertrand 1301:
1.24 bertrand 1302: if ((*s_objet_evalue).type == INT)
1303: {
1304: borne_minimale = (real8) (*((integer8 *)
1305: (*s_objet_evalue).objet));
1306: }
1307: else if ((*s_objet_evalue).type == REL)
1308: {
1309: borne_minimale = (*((real8 *) (*s_objet_evalue).objet));
1310: }
1311: else
1312: {
1313: free(nom_variable);
1314:
1315: liberation(s_etat_processus, s_objet_evalue);
1316: liberation(s_etat_processus, s_objet_argument_1);
1317: liberation(s_etat_processus, s_objet_argument_2);
1318: liberation(s_etat_processus, s_objet_argument_3);
1319:
1320: (*s_etat_processus).erreur_execution =
1321: d_ex_erreur_type_argument;
1322: return;
1323: }
1.1 bertrand 1324:
1.24 bertrand 1325: liberation(s_etat_processus, s_objet_evalue);
1.1 bertrand 1326: }
1327:
1.24 bertrand 1328: l_element_courant = (*l_element_courant).suivant;
1.1 bertrand 1329:
1.24 bertrand 1330: if ((*(*l_element_courant).donnee).type == INT)
1.1 bertrand 1331: {
1332: borne_maximale = (real8) (*((integer8 *)
1.24 bertrand 1333: (*(*l_element_courant).donnee).objet));
1.1 bertrand 1334: }
1.24 bertrand 1335: else if ((*(*l_element_courant).donnee).type == REL)
1.1 bertrand 1336: {
1.24 bertrand 1337: borne_maximale = (*((real8 *) (*(*l_element_courant)
1338: .donnee).objet));
1.1 bertrand 1339: }
1340: else
1341: {
1.24 bertrand 1342: if (evaluation(s_etat_processus, (*l_element_courant).donnee,
1343: 'N') == d_erreur)
1344: {
1345: free(nom_variable);
1346: liberation(s_etat_processus, s_objet_argument_1);
1347: liberation(s_etat_processus, s_objet_argument_2);
1348: liberation(s_etat_processus, s_objet_argument_3);
1349:
1350: return;
1351: }
1352:
1353: if (depilement(s_etat_processus, &((*s_etat_processus)
1354: .l_base_pile), &s_objet_evalue) == d_erreur)
1355: {
1356: free(nom_variable);
1357: liberation(s_etat_processus, s_objet_argument_1);
1358: liberation(s_etat_processus, s_objet_argument_2);
1359: liberation(s_etat_processus, s_objet_argument_3);
1360:
1361: (*s_etat_processus).erreur_execution =
1362: d_ex_manque_argument;
1363: return;
1364: }
1365:
1366: if ((*s_objet_evalue).type == INT)
1367: {
1368: borne_maximale = (real8) (*((integer8 *)
1369: (*s_objet_evalue).objet));
1370: }
1371: else if ((*s_objet_evalue).type == REL)
1372: {
1373: borne_maximale = (*((real8 *) (*s_objet_evalue).objet));
1374: }
1375: else
1376: {
1377: free(nom_variable);
1378:
1379: liberation(s_etat_processus, s_objet_evalue);
1380: liberation(s_etat_processus, s_objet_argument_1);
1381: liberation(s_etat_processus, s_objet_argument_2);
1382: liberation(s_etat_processus, s_objet_argument_3);
1383:
1384: (*s_etat_processus).erreur_execution =
1385: d_ex_erreur_type_argument;
1386: return;
1387: }
1.1 bertrand 1388:
1389: liberation(s_etat_processus, s_objet_evalue);
1.24 bertrand 1390: }
1391:
1392: /*
1393: * Le résultat est retourné sur la pile par la routine
1394: */
1.1 bertrand 1395:
1.24 bertrand 1396: if (last_valide == d_vrai)
1397: {
1398: cf(s_etat_processus, 31);
1.1 bertrand 1399: }
1400:
1.24 bertrand 1401: integrale_romberg(s_etat_processus, s_objet_argument_3,
1402: nom_variable, borne_minimale, borne_maximale, precision);
1.1 bertrand 1403:
1.24 bertrand 1404: if (last_valide == d_vrai)
1405: {
1406: sf(s_etat_processus, 31);
1407: }
1.1 bertrand 1408:
1.24 bertrand 1409: free(nom_variable);
1410: }
1411: else
1.1 bertrand 1412: {
1.24 bertrand 1413: liberation(s_etat_processus, s_objet_argument_1);
1414: liberation(s_etat_processus, s_objet_argument_2);
1415: liberation(s_etat_processus, s_objet_argument_3);
1.1 bertrand 1416:
1.24 bertrand 1417: (*s_etat_processus).erreur_execution =
1418: d_ex_erreur_type_argument;
1419: return;
1.1 bertrand 1420: }
1421:
1422: liberation(s_etat_processus, s_objet_argument_1);
1423: liberation(s_etat_processus, s_objet_argument_2);
1424: liberation(s_etat_processus, s_objet_argument_3);
1425: }
1426:
1427: return;
1428: }
1429:
1430:
1431: /*
1432: ================================================================================
1433: Fonction 'incr'
1434: ================================================================================
1435: Entrées :
1436: --------------------------------------------------------------------------------
1437: Sorties :
1438: --------------------------------------------------------------------------------
1439: Effets de bord : néant
1440: ================================================================================
1441: */
1442:
1443: void
1444: instruction_incr(struct_processus *s_etat_processus)
1445: {
1446: logical1 variable_partagee;
1447:
1448: struct_objet *s_copie_argument;
1449: struct_objet *s_objet_argument;
1450:
1451: (*s_etat_processus).erreur_execution = d_ex;
1452:
1453: if ((*s_etat_processus).affichage_arguments == 'Y')
1454: {
1455: printf("\n INCR ");
1456:
1457: if ((*s_etat_processus).langue == 'F')
1458: {
1459: printf("(incrémentation)\n\n");
1460: }
1461: else
1462: {
1463: printf("(incrementation)\n\n");
1464: }
1465:
1466: printf(" 1: %s\n", d_INT);
1467: printf("-> 1: %s\n\n", d_INT);
1468:
1469: printf(" 1: %s\n", d_NOM);
1470:
1471: return;
1472: }
1473: else if ((*s_etat_processus).test_instruction == 'Y')
1474: {
1475: (*s_etat_processus).nombre_arguments = -1;
1476: return;
1477: }
1478:
1479: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1480: {
1481: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1482: {
1483: return;
1484: }
1485: }
1486:
1487: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1488: &s_objet_argument) == d_erreur)
1489: {
1490: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1491: return;
1492: }
1493:
1494: if ((*s_objet_argument).type == INT)
1495: {
1496: if ((s_copie_argument = copie_objet(s_etat_processus,
1497: s_objet_argument, 'O')) == NULL)
1498: {
1499: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1500: return;
1501: }
1502:
1503: liberation(s_etat_processus, s_objet_argument);
1504: s_objet_argument = s_copie_argument;
1505:
1506: (*((integer8 *) (*s_objet_argument).objet))++;
1507:
1508: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1509: s_objet_argument) == d_erreur)
1510: {
1511: return;
1512: }
1513: }
1514: else if ((*s_objet_argument).type == NOM)
1515: {
1516: if (recherche_variable(s_etat_processus, (*((struct_nom *)
1517: (*s_objet_argument).objet)).nom) == d_faux)
1518: {
1519: (*s_etat_processus).erreur_systeme = d_es;
1520: (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
1521:
1522: return;
1523: }
1524:
1525: liberation(s_etat_processus, s_objet_argument);
1526:
1.19 bertrand 1527: if ((*(*s_etat_processus).pointeur_variable_courante)
1.1 bertrand 1528: .variable_verrouillee == d_vrai)
1529: {
1530: (*s_etat_processus).erreur_execution = d_ex_variable_verrouillee;
1531: return;
1532: }
1533:
1.19 bertrand 1534: if ((*(*s_etat_processus).pointeur_variable_courante).objet == NULL)
1.1 bertrand 1535: {
1536: if (pthread_mutex_lock(&((*(*s_etat_processus)
1537: .s_liste_variables_partagees).mutex)) != 0)
1538: {
1539: (*s_etat_processus).erreur_systeme = d_es_processus;
1540: return;
1541: }
1542:
1543: if (recherche_variable_partagee(s_etat_processus,
1.19 bertrand 1544: (*(*s_etat_processus).pointeur_variable_courante).nom,
1545: (*(*s_etat_processus).pointeur_variable_courante)
1546: .variable_partagee, (*(*s_etat_processus)
1547: .pointeur_variable_courante).origine) == d_faux)
1.1 bertrand 1548: {
1549: (*s_etat_processus).erreur_systeme = d_es;
1550: (*s_etat_processus).erreur_execution =
1551: d_ex_variable_non_definie;
1552:
1553: return;
1554: }
1555:
1556: s_objet_argument = (*(*s_etat_processus)
1557: .s_liste_variables_partagees).table
1558: [(*(*s_etat_processus).s_liste_variables_partagees)
1559: .position_variable].objet;
1560: variable_partagee = d_vrai;
1561: }
1562: else
1563: {
1.19 bertrand 1564: s_objet_argument = (*(*s_etat_processus).pointeur_variable_courante)
1565: .objet;
1.1 bertrand 1566: variable_partagee = d_faux;
1567: }
1568:
1569: if ((s_copie_argument = copie_objet(s_etat_processus,
1570: s_objet_argument, 'O')) == NULL)
1571: {
1572: if (variable_partagee == d_vrai)
1573: {
1574: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1575: .s_liste_variables_partagees).mutex)) != 0)
1576: {
1577: (*s_etat_processus).erreur_systeme = d_es_processus;
1578: return;
1579: }
1580: }
1581:
1582: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1583: return;
1584: }
1585:
1586: liberation(s_etat_processus, s_objet_argument);
1587:
1588: if (variable_partagee == d_vrai)
1589: {
1.19 bertrand 1590: (*(*s_etat_processus).pointeur_variable_courante).objet = NULL;
1.1 bertrand 1591: (*(*s_etat_processus)
1592: .s_liste_variables_partagees).table
1593: [(*(*s_etat_processus).s_liste_variables_partagees)
1594: .position_variable].objet = s_copie_argument;
1595: }
1596: else
1597: {
1.19 bertrand 1598: (*(*s_etat_processus).pointeur_variable_courante).objet =
1599: s_copie_argument;
1.1 bertrand 1600: }
1601:
1602: if ((*s_copie_argument).type == INT)
1603: {
1604: (*((integer8 *) (*s_copie_argument).objet))++;
1605:
1606: if (variable_partagee == d_vrai)
1607: {
1608: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1609: .s_liste_variables_partagees).mutex)) != 0)
1610: {
1611: (*s_etat_processus).erreur_systeme = d_es_processus;
1612: return;
1613: }
1614: }
1615: }
1616: else
1617: {
1618: if (variable_partagee == d_vrai)
1619: {
1620: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1621: .s_liste_variables_partagees).mutex)) != 0)
1622: {
1623: (*s_etat_processus).erreur_systeme = d_es_processus;
1624: return;
1625: }
1626: }
1627:
1628: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1629: return;
1630: }
1631: }
1632: else
1633: {
1634: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1635:
1636: liberation(s_etat_processus, s_objet_argument);
1637: return;
1638: }
1639:
1640: return;
1641: }
1642:
1643: // 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