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