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