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