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