![]() ![]() | ![]() |
1.1 bertrand 1: /*
2: ================================================================================
1.64 ! bertrand 3: RPL/2 (R) version 4.1.31
1.63 bertrand 4: Copyright (C) 1989-2019 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 's+'
29: ================================================================================
30: Entrées : structure processus
31: --------------------------------------------------------------------------------
32: Sorties :
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: void
39: instruction_s_plus(struct_processus *s_etat_processus)
40: {
41: logical1 creation_variable_sigma;
42:
43: struct_objet *s_copie;
44: struct_objet *s_copie_statistique;
45: struct_objet *s_objet;
46: struct_objet *s_objet_statistique;
47:
48: struct_variable s_variable;
49:
1.42 bertrand 50: integer8 i;
51: integer8 j;
52: integer8 k;
53: integer8 nombre_colonnes;
54: integer8 nombre_lignes;
1.1 bertrand 55:
56: void *tampon;
57:
58: (*s_etat_processus).erreur_execution = d_ex;
59:
60: if ((*s_etat_processus).affichage_arguments == 'Y')
61: {
62: printf("\n S+ ");
63:
64: if ((*s_etat_processus).langue == 'F')
65: {
66: printf("(ajout d'une donnée dans la matrice statistique)\n\n");
67: }
68: else
69: {
70: printf("(add a data value in statistical matrix)\n\n");
71: }
72:
73: printf(" 1: %s, %s, %s, %s, %s, %s\n", d_INT, d_REL, d_VIN, d_VRL,
74: d_MIN, d_MRL);
75:
76: return;
77: }
78: else if ((*s_etat_processus).test_instruction == 'Y')
79: {
80: (*s_etat_processus).nombre_arguments = -1;
81: return;
82: }
83:
84: if (test_cfsf(s_etat_processus, 31) == d_vrai)
85: {
86: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
87: {
88: return;
89: }
90: }
91:
92: /*
93: * Recherche d'une variable globale référencée par SIGMA
94: */
95:
1.19 bertrand 96: if (recherche_variable_globale(s_etat_processus, ds_sdat) == d_faux)
1.1 bertrand 97: {
98: /*
99: * Aucune variable SIGMA, donc il faut la créer en fonction
100: * de l'objet à introduire.
101: */
102:
103: (*s_etat_processus).erreur_systeme = d_es;
104: creation_variable_sigma = d_vrai;
105: nombre_colonnes = 0;
106: }
107: else
108: {
1.19 bertrand 109: creation_variable_sigma = d_faux;
1.1 bertrand 110:
1.19 bertrand 111: if ((*(*s_etat_processus).pointeur_variable_courante)
112: .variable_verrouillee == d_vrai)
113: {
114: (*s_etat_processus).erreur_execution =
115: d_ex_variable_verrouillee;
116: return;
117: }
1.1 bertrand 118:
1.19 bertrand 119: if (((*(*(*s_etat_processus).pointeur_variable_courante).objet)
120: .type != MIN) && ((*(*(*s_etat_processus)
121: .pointeur_variable_courante).objet).type != MRL))
1.1 bertrand 122: {
1.19 bertrand 123: (*s_etat_processus).erreur_execution =
124: d_ex_matrice_statistique_invalide;
125: return;
1.1 bertrand 126: }
127:
1.19 bertrand 128: if ((s_copie_statistique = copie_objet(s_etat_processus,
129: (*(*s_etat_processus).pointeur_variable_courante).objet, 'Q'))
130: == NULL)
1.1 bertrand 131: {
1.19 bertrand 132: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
133: return;
1.1 bertrand 134: }
135:
1.19 bertrand 136: liberation(s_etat_processus, (*(*s_etat_processus)
137: .pointeur_variable_courante).objet);
138: (*(*s_etat_processus).pointeur_variable_courante).objet =
139: s_copie_statistique;
1.1 bertrand 140:
1.19 bertrand 141: nombre_colonnes = (*((struct_matrice *) (*(*(*s_etat_processus)
142: .pointeur_variable_courante).objet).objet)).nombre_colonnes;
1.1 bertrand 143: }
144:
145: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
146: &s_objet) == d_erreur)
147: {
148: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
149: return;
150: }
151:
152: if ((s_copie = copie_objet(s_etat_processus, s_objet, 'O')) == NULL)
153: {
154: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
155: return;
156: }
157:
158: liberation(s_etat_processus, s_objet);
159: s_objet = s_copie;
160:
161: /*
162: * Ajout d'un scalaire
163: */
164:
165: if (((*s_objet).type == INT) ||
166: ((*s_objet).type == REL))
167: {
168: if (creation_variable_sigma == d_vrai)
169: {
170: /*
171: * Création d'une matrice statistique 1*1
172: */
173:
174: if ((s_variable.nom = malloc(6 * sizeof(unsigned char))) == NULL)
175: {
176: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
177: return;
178: }
179:
180: strcpy(s_variable.nom, ds_sdat);
181: s_variable.niveau = 1;
182:
183: if ((*s_objet).type == INT)
184: {
185: if ((s_objet_statistique = allocation(s_etat_processus, MIN))
186: == NULL)
187: {
188: (*s_etat_processus).erreur_systeme =
189: d_es_allocation_memoire;
190: return;
191: }
192:
193: if (((*((struct_matrice *) (*s_objet_statistique).objet))
194: .tableau = malloc(sizeof(integer8 *))) == NULL)
195: {
196: (*s_etat_processus).erreur_systeme =
197: d_es_allocation_memoire;
198: return;
199: }
200:
201: ((integer8 **) (*((struct_matrice *) (*s_objet_statistique)
202: .objet)).tableau)[0] = (integer8 *) (*s_objet).objet;
203: }
204: else
205: {
206: if ((s_objet_statistique = allocation(s_etat_processus, MRL))
207: == NULL)
208: {
209: (*s_etat_processus).erreur_systeme =
210: d_es_allocation_memoire;
211: return;
212: }
213:
214: if (((*((struct_matrice *) (*s_objet_statistique).objet))
215: .tableau = malloc(sizeof(real8 *))) == NULL)
216: {
217: (*s_etat_processus).erreur_systeme =
218: d_es_allocation_memoire;
219: return;
220: }
221:
222: ((real8 **) (*((struct_matrice *) (*s_objet_statistique)
223: .objet)).tableau)[0] = (real8 *) (*s_objet).objet;
224: }
225:
226: (*((struct_matrice *) (*s_objet_statistique).objet))
227: .nombre_colonnes = 1;
228: (*((struct_matrice *) (*s_objet_statistique).objet))
229: .nombre_lignes = 1;
230:
231: free(s_objet);
232: s_objet = NULL;
233:
234: s_variable.objet = s_objet_statistique;
235:
236: if (creation_variable(s_etat_processus, &s_variable, 'V', 'P')
237: == d_erreur)
238: {
239: return;
240: }
241: }
242: else
243: {
244: /*
245: * La variable existe déjà, il faut lui rajouter une ligne.
246: */
247:
248: if (nombre_colonnes != 1)
249: {
250: (*s_etat_processus).erreur_execution =
251: d_ex_dimensions_matrice_statistique;
252:
253: liberation(s_etat_processus, s_objet);
254: return;
255: }
256:
1.19 bertrand 257: s_objet_statistique = (*(*s_etat_processus)
258: .pointeur_variable_courante).objet;
1.1 bertrand 259:
260: if (((*s_objet_statistique).type == MIN) &&
261: ((*s_objet).type == INT))
262: {
263: tampon = (*((struct_matrice *) (*s_objet_statistique).objet))
264: .tableau;
265: (*((struct_matrice *) (*s_objet_statistique).objet))
266: .nombre_lignes++;
267:
268: if (((*((struct_matrice *) (*s_objet_statistique).objet))
1.42 bertrand 269: .tableau = malloc(((size_t) (*((struct_matrice *)
270: (*s_objet_statistique).objet)).nombre_lignes) *
1.1 bertrand 271: sizeof(integer8 *))) == NULL)
272: {
273: (*s_etat_processus).erreur_systeme =
274: d_es_allocation_memoire;
275: return;
276: }
277:
1.19 bertrand 278: for(i = 0; i < ((*((struct_matrice *)
1.1 bertrand 279: (*s_objet_statistique).objet)).nombre_lignes - 1); i++)
280: {
281: ((integer8 **) (*((struct_matrice *) (*s_objet_statistique)
282: .objet)).tableau)[i] = ((integer8 **) tampon)[i];
283: }
284:
285: free(tampon);
286:
287: ((integer8 **) (*((struct_matrice *) (*s_objet_statistique)
288: .objet)).tableau)[i] = (integer8 *) (*s_objet).objet;
289:
290: free(s_objet);
291: s_objet = NULL;
292: }
293: else if (((*s_objet_statistique).type == MRL) &&
294: ((*s_objet).type == REL))
295: {
296: tampon = (*((struct_matrice *) (*s_objet_statistique).objet))
297: .tableau;
298: (*((struct_matrice *) (*s_objet_statistique).objet))
299: .nombre_lignes++;
300:
301: if (((*((struct_matrice *) (*s_objet_statistique).objet))
1.42 bertrand 302: .tableau = malloc(((size_t) (*((struct_matrice *)
303: (*s_objet_statistique).objet)).nombre_lignes) *
1.1 bertrand 304: sizeof(real8 *))) == NULL)
305: {
306: (*s_etat_processus).erreur_systeme =
307: d_es_allocation_memoire;
308: return;
309: }
310:
1.19 bertrand 311: for(i = 0; i < ((*((struct_matrice *)
1.1 bertrand 312: (*s_objet_statistique).objet)).nombre_lignes - 1); i++)
313: {
314: ((real8 **) (*((struct_matrice *) (*s_objet_statistique)
315: .objet)).tableau)[i] = ((real8 **) tampon)[i];
316: }
317:
318: free(tampon);
319:
320: ((real8 **) (*((struct_matrice *) (*s_objet_statistique)
321: .objet)).tableau)[i] = (real8 *) (*s_objet).objet;
322:
323: free(s_objet);
324: s_objet = NULL;
325: }
326: else if (((*s_objet_statistique).type == MRL) &&
327: ((*s_objet).type == INT))
328: {
329: tampon = (*((struct_matrice *) (*s_objet_statistique).objet))
330: .tableau;
331: (*((struct_matrice *) (*s_objet_statistique).objet))
332: .nombre_lignes++;
333:
334: if (((*((struct_matrice *) (*s_objet_statistique).objet))
1.42 bertrand 335: .tableau = malloc(((size_t) (*((struct_matrice *)
336: (*s_objet_statistique).objet)).nombre_lignes) *
1.1 bertrand 337: sizeof(real8 *))) == NULL)
338: {
339: (*s_etat_processus).erreur_systeme =
340: d_es_allocation_memoire;
341: return;
342: }
343:
1.19 bertrand 344: for(i = 0; i < ((*((struct_matrice *)
1.1 bertrand 345: (*s_objet_statistique).objet)).nombre_lignes - 1); i++)
346: {
347: ((real8 **) (*((struct_matrice *) (*s_objet_statistique)
348: .objet)).tableau)[i] = ((real8 **) tampon)[i];
349: }
350:
351: free(tampon);
352:
353: if ((((real8 **) (*((struct_matrice *) (*s_objet_statistique)
354: .objet)).tableau)[i] = malloc(sizeof(real8)))
355: == NULL)
356: {
357: (*s_etat_processus).erreur_systeme =
358: d_es_allocation_memoire;
359: return;
360: }
361:
362: ((real8 **) (*((struct_matrice *) (*s_objet_statistique)
363: .objet)).tableau)[i][0] =
364: (real8) (*((integer8 *) (*s_objet).objet));
365: }
366: else
367: {
368: tampon = (*((struct_matrice *) (*s_objet_statistique).objet))
369: .tableau;
370: (*((struct_matrice *) (*s_objet_statistique).objet))
371: .nombre_lignes++;
372:
373: if (((*((struct_matrice *) (*s_objet_statistique).objet))
1.42 bertrand 374: .tableau = malloc(((size_t) (*((struct_matrice *)
375: (*s_objet_statistique).objet)).nombre_lignes) *
1.1 bertrand 376: sizeof(real8 *))) == NULL)
377: {
378: (*s_etat_processus).erreur_systeme =
379: d_es_allocation_memoire;
380: return;
381: }
382:
1.19 bertrand 383: for(i = 0; i < ((*((struct_matrice *)
1.1 bertrand 384: (*s_objet_statistique).objet)).nombre_lignes - 1); i++)
385: {
386: if ((((real8 **) (*((struct_matrice *)
387: (*s_objet_statistique).objet)).tableau)[i] =
388: malloc(sizeof(real8))) == NULL)
389: {
390: (*s_etat_processus).erreur_systeme =
391: d_es_allocation_memoire;
392: return;
393: }
394:
395: ((real8 **) (*((struct_matrice *) (*s_objet_statistique)
396: .objet)).tableau)[i][0] = (real8)
397: ((integer8 **) tampon)[i][0];
398:
399: free(((integer8 **) tampon)[i]);
400: }
401:
402: if ((((real8 **) (*((struct_matrice *) (*s_objet_statistique)
403: .objet)).tableau)[i] = malloc(sizeof(real8)))
404: == NULL)
405: {
406: (*s_etat_processus).erreur_systeme =
407: d_es_allocation_memoire;
408: return;
409: }
410:
411: ((real8 **) (*((struct_matrice *) (*s_objet_statistique)
412: .objet)).tableau)[i][0] = (*((real8 *)
413: (*s_objet).objet));
414:
415: (*((struct_matrice *) (*s_objet_statistique).objet)).type = 'R';
416: (*s_objet_statistique).type = MRL;
417:
418: free(tampon);
419: }
420: }
421: }
422:
423: /*
424: * Ajout d'un vecteur
425: */
426:
427: else if (((*s_objet).type == VIN) ||
428: ((*s_objet).type == VRL))
429: {
430: if (creation_variable_sigma == d_vrai)
431: {
432: /*
433: * Création d'une matrice statistique 1*NC
434: */
435:
436: if ((s_variable.nom = malloc(6 * sizeof(unsigned char))) == NULL)
437: {
438: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
439: return;
440: }
441:
442: strcpy(s_variable.nom, ds_sdat);
443: s_variable.niveau = 1;
444:
445: if ((*s_objet).type == VIN)
446: {
447: if ((s_objet_statistique = allocation(s_etat_processus, MIN))
448: == NULL)
449: {
450: (*s_etat_processus).erreur_systeme =
451: d_es_allocation_memoire;
452: return;
453: }
454:
455: if (((*((struct_matrice *) (*s_objet_statistique).objet))
456: .tableau = malloc(sizeof(integer8 **))) == NULL)
457: {
458: (*s_etat_processus).erreur_systeme =
459: d_es_allocation_memoire;
460: return;
461: }
462:
463: ((integer8 **) (*((struct_matrice *) (*s_objet_statistique)
464: .objet)).tableau)[0] = (*((struct_vecteur *)
465: (*s_objet).objet)).tableau;
466: }
467: else
468: {
469: if ((s_objet_statistique = allocation(s_etat_processus, MRL))
470: == NULL)
471: {
472: (*s_etat_processus).erreur_systeme =
473: d_es_allocation_memoire;
474: return;
475: }
476:
477: if (((*((struct_matrice *) (*s_objet_statistique).objet))
478: .tableau = malloc(sizeof(real8 **))) == NULL)
479: {
480: (*s_etat_processus).erreur_systeme =
481: d_es_allocation_memoire;
482: return;
483: }
484:
485: ((real8 **) (*((struct_matrice *) (*s_objet_statistique)
486: .objet)).tableau)[0] = (*((struct_vecteur *)
487: (*s_objet).objet)).tableau;
488: }
489:
490: (*((struct_matrice *) (*s_objet_statistique).objet))
491: .nombre_colonnes = (*((struct_vecteur *) (*s_objet).objet))
492: .taille;
493: (*((struct_matrice *) (*s_objet_statistique).objet))
494: .nombre_lignes = 1;
495:
496: free((struct_vecteur *) (*s_objet).objet);
497: free(s_objet);
498: s_objet = NULL;
499:
500: s_variable.objet = s_objet_statistique;
501:
502: if (creation_variable(s_etat_processus, &s_variable, 'V', 'P')
503: == d_erreur)
504: {
505: return;
506: }
507: }
508: else
509: {
510: /*
511: * La variable existe déjà, il faut lui rajouter une ligne.
512: */
513:
514: if (nombre_colonnes != (*((struct_vecteur *) (*s_objet).objet))
515: .taille)
516: {
517: (*s_etat_processus).erreur_execution =
518: d_ex_dimensions_matrice_statistique;
519:
520: liberation(s_etat_processus, s_objet);
521: return;
522: }
523:
1.19 bertrand 524: s_objet_statistique = (*(*s_etat_processus)
525: .pointeur_variable_courante).objet;
1.1 bertrand 526:
527: if (((*s_objet_statistique).type == MIN) &&
528: ((*s_objet).type == VIN))
529: {
530: tampon = (*((struct_matrice *) (*s_objet_statistique).objet))
531: .tableau;
532: (*((struct_matrice *) (*s_objet_statistique).objet))
533: .nombre_lignes++;
534:
535: if (((*((struct_matrice *) (*s_objet_statistique).objet))
1.42 bertrand 536: .tableau = malloc(((size_t) (*((struct_matrice *)
537: (*s_objet_statistique).objet)).nombre_lignes) *
1.1 bertrand 538: sizeof(integer8 *))) == NULL)
539: {
540: (*s_etat_processus).erreur_systeme =
541: d_es_allocation_memoire;
542: return;
543: }
544:
1.19 bertrand 545: for(i = 0; i < ((*((struct_matrice *)
1.1 bertrand 546: (*s_objet_statistique).objet)).nombre_lignes - 1); i++)
547: {
548: ((integer8 **) (*((struct_matrice *) (*s_objet_statistique)
549: .objet)).tableau)[i] = ((integer8 **) tampon)[i];
550: }
551:
552: free(tampon);
553:
554: ((integer8 **) (*((struct_matrice *) (*s_objet_statistique)
555: .objet)).tableau)[i] = (integer8 *)
556: (*((struct_vecteur *) (*s_objet).objet)).tableau;
557:
558: free((struct_vecteur *) (*s_objet).objet);
559: free(s_objet);
560: s_objet = NULL;
561: }
562: else if (((*s_objet_statistique).type == MRL) &&
563: ((*s_objet).type == VRL))
564: {
565: tampon = (*((struct_matrice *) (*s_objet_statistique).objet))
566: .tableau;
567: (*((struct_matrice *) (*s_objet_statistique).objet))
568: .nombre_lignes++;
569:
570: if (((*((struct_matrice *) (*s_objet_statistique).objet))
1.42 bertrand 571: .tableau = malloc(((size_t) (*((struct_matrice *)
572: (*s_objet_statistique).objet)).nombre_lignes) *
1.1 bertrand 573: sizeof(real8 *))) == NULL)
574: {
575: (*s_etat_processus).erreur_systeme =
576: d_es_allocation_memoire;
577: return;
578: }
579:
1.19 bertrand 580: for(i = 0; i < ((*((struct_matrice *)
1.1 bertrand 581: (*s_objet_statistique).objet)).nombre_lignes - 1); i++)
582: {
583: ((real8 **) (*((struct_matrice *) (*s_objet_statistique)
584: .objet)).tableau)[i] = ((real8 **) tampon)[i];
585: }
586:
587: free(tampon);
588:
589: ((real8 **) (*((struct_matrice *) (*s_objet_statistique)
590: .objet)).tableau)[i] = (real8 *)
591: (*((struct_vecteur *) (*s_objet).objet)).tableau;
592:
593: free((struct_vecteur *) (*s_objet).objet);
594: free(s_objet);
595: s_objet = NULL;
596: }
597: else if (((*s_objet_statistique).type == MRL) &&
598: ((*s_objet).type == VIN))
599: {
600: tampon = (*((struct_matrice *) (*s_objet_statistique).objet))
601: .tableau;
602: (*((struct_matrice *) (*s_objet_statistique).objet))
603: .nombre_lignes++;
604:
605: if (((*((struct_matrice *) (*s_objet_statistique).objet))
1.42 bertrand 606: .tableau = malloc(((size_t) (*((struct_matrice *)
607: (*s_objet_statistique).objet)).nombre_lignes) *
1.1 bertrand 608: sizeof(real8 *))) == NULL)
609: {
610: (*s_etat_processus).erreur_systeme =
611: d_es_allocation_memoire;
612: return;
613: }
614:
1.19 bertrand 615: for(i = 0; i < ((*((struct_matrice *)
1.1 bertrand 616: (*s_objet_statistique).objet)).nombre_lignes - 1); i++)
617: {
618: ((real8 **) (*((struct_matrice *) (*s_objet_statistique)
619: .objet)).tableau)[i] = ((real8 **) tampon)[i];
620: }
621:
622: free(tampon);
623:
624: if ((((real8 **) (*((struct_matrice *) (*s_objet_statistique)
1.42 bertrand 625: .objet)).tableau)[i] = malloc(((size_t)
626: nombre_colonnes) * sizeof(real8))) == NULL)
1.1 bertrand 627: {
628: (*s_etat_processus).erreur_systeme =
629: d_es_allocation_memoire;
630: return;
631: }
632:
633: for(j = 0; j < nombre_colonnes; j++)
634: {
635: ((real8 **) (*((struct_matrice *) (*s_objet_statistique)
636: .objet)).tableau)[i][j] =
637: (real8) (((integer8 *) (*((struct_vecteur *)
638: (*s_objet).objet)).tableau)[j]);
639: }
640: }
641: else
642: {
643: tampon = (*((struct_matrice *) (*s_objet_statistique).objet))
644: .tableau;
645: (*((struct_matrice *) (*s_objet_statistique).objet))
646: .nombre_lignes++;
647:
648: if (((*((struct_matrice *) (*s_objet_statistique).objet))
1.42 bertrand 649: .tableau = malloc(((size_t) (*((struct_matrice *)
650: (*s_objet_statistique).objet)).nombre_lignes) *
1.1 bertrand 651: sizeof(real8 *))) == NULL)
652: {
653: (*s_etat_processus).erreur_systeme =
654: d_es_allocation_memoire;
655: return;
656: }
657:
1.19 bertrand 658: for(i = 0; i < ((*((struct_matrice *)
1.1 bertrand 659: (*s_objet_statistique).objet)).nombre_lignes - 1); i++)
660: {
661: if ((((real8 **) (*((struct_matrice *)
662: (*s_objet_statistique).objet)).tableau)[i] =
1.42 bertrand 663: malloc(((size_t) nombre_colonnes) *
664: sizeof(real8))) == NULL)
1.1 bertrand 665: {
666: (*s_etat_processus).erreur_systeme =
667: d_es_allocation_memoire;
668: return;
669: }
670:
671: for(j = 0; j < nombre_colonnes; j++)
672: {
673: ((real8 **) (*((struct_matrice *) (*s_objet_statistique)
674: .objet)).tableau)[i][j] = (real8)
675: ((integer8 **) tampon)[i][j];
676: }
677:
678: free(((integer8 **) tampon)[i]);
679: }
680:
681: free(tampon);
682:
683: ((real8 **) (*((struct_matrice *) (*s_objet_statistique)
684: .objet)).tableau)[i] = (real8 *) (*((struct_vecteur *)
685: (*s_objet).objet)).tableau;
686:
687: free((struct_vecteur *) (*s_objet).objet);
688: free(s_objet);
689: s_objet = NULL;
690:
691: (*((struct_matrice *) (*s_objet_statistique).objet)).type = 'R';
692: (*s_objet_statistique).type = MRL;
693: }
694: }
695: }
696:
697: /*
698: * Ajout d'une matrice
699: */
700:
701: else if (((*s_objet).type == MIN) ||
702: ((*s_objet).type == MRL))
703: {
704: if (creation_variable_sigma == d_vrai)
705: {
706: /*
707: * Création d'une matrice statistique NL*NC
708: */
709:
710: if ((s_variable.nom = malloc(6 * sizeof(unsigned char))) == NULL)
711: {
712: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
713: return;
714: }
715:
716: strcpy(s_variable.nom, ds_sdat);
717: s_variable.niveau = 1;
718:
719: if ((*s_objet).type == MIN)
720: {
721: if ((s_objet_statistique = allocation(s_etat_processus, MIN))
722: == NULL)
723: {
724: (*s_etat_processus).erreur_systeme =
725: d_es_allocation_memoire;
726: return;
727: }
728:
729: (*s_objet_statistique).objet = (*s_objet).objet;
730: }
731: else
732: {
733: if ((s_objet_statistique = allocation(s_etat_processus, MRL))
734: == NULL)
735: {
736: (*s_etat_processus).erreur_systeme =
737: d_es_allocation_memoire;
738: return;
739: }
740:
741: (*s_objet_statistique).objet = (*s_objet).objet;
742: }
743:
744: free(s_objet);
745: s_objet = NULL;
746:
747: s_variable.objet = s_objet_statistique;
748:
749: if (creation_variable(s_etat_processus, &s_variable, 'V', 'P')
750: == d_erreur)
751: {
752: return;
753: }
754: }
755: else
756: {
757: /*
758: * La variable existe déjà, il faut lui rajouter le nombre
759: * de lignes de la matrice passée en argument.
760: */
761:
762: if (nombre_colonnes != (*((struct_matrice *) (*s_objet).objet))
763: .nombre_colonnes)
764: {
765: (*s_etat_processus).erreur_execution =
766: d_ex_dimensions_matrice_statistique;
767:
768: liberation(s_etat_processus, s_objet);
769: return;
770: }
771:
1.19 bertrand 772: s_objet_statistique = (*(*s_etat_processus)
773: .pointeur_variable_courante).objet;
1.1 bertrand 774:
775: nombre_lignes = (*((struct_matrice *) (*s_objet).objet))
776: .nombre_lignes;
777:
778: if (((*s_objet_statistique).type == MIN) &&
779: ((*s_objet).type == MIN))
780: {
781: tampon = (*((struct_matrice *) (*s_objet_statistique).objet))
782: .tableau;
783: (*((struct_matrice *) (*s_objet_statistique).objet))
784: .nombre_lignes += nombre_lignes;
785:
786: if (((*((struct_matrice *) (*s_objet_statistique).objet))
1.42 bertrand 787: .tableau = malloc(((size_t) (*((struct_matrice *)
788: (*s_objet_statistique).objet)).nombre_lignes) *
1.1 bertrand 789: sizeof(integer8 *))) == NULL)
790: {
791: (*s_etat_processus).erreur_systeme =
792: d_es_allocation_memoire;
793: return;
794: }
795:
1.19 bertrand 796: for(i = 0; i < ((*((struct_matrice *)
1.1 bertrand 797: (*s_objet_statistique).objet)).nombre_lignes
798: - nombre_lignes); i++)
799: {
800: ((integer8 **) (*((struct_matrice *) (*s_objet_statistique)
801: .objet)).tableau)[i] = ((integer8 **) tampon)[i];
802: }
803:
804: free(tampon);
805:
1.19 bertrand 806: for(k = 0; i < ((*((struct_matrice *)
1.1 bertrand 807: (*s_objet_statistique).objet)).nombre_lignes); i++, k++)
808: {
809: ((integer8 **) (*((struct_matrice *) (*s_objet_statistique)
810: .objet)).tableau)[i] = ((integer8 **)
811: (*((struct_matrice *) (*s_objet).objet))
812: .tableau)[k];
813: }
814:
815: free((integer8 **) (*((struct_matrice *) (*s_objet).objet))
816: .tableau);
817: free((struct_matrice *) (*s_objet).objet);
818: free(s_objet);
819: s_objet = NULL;
820: }
821: else if (((*s_objet_statistique).type == MRL) &&
822: ((*s_objet).type == MRL))
823: {
824: tampon = (*((struct_matrice *) (*s_objet_statistique).objet))
825: .tableau;
826: (*((struct_matrice *) (*s_objet_statistique).objet))
827: .nombre_lignes += nombre_lignes;
828:
829: if (((*((struct_matrice *) (*s_objet_statistique).objet))
1.42 bertrand 830: .tableau = malloc(((size_t) (*((struct_matrice *)
831: (*s_objet_statistique).objet)).nombre_lignes) *
1.1 bertrand 832: sizeof(real8 *))) == NULL)
833: {
834: (*s_etat_processus).erreur_systeme =
835: d_es_allocation_memoire;
836: return;
837: }
838:
1.19 bertrand 839: for(i = 0; i < ((*((struct_matrice *)
1.1 bertrand 840: (*s_objet_statistique).objet)).nombre_lignes
841: - nombre_lignes); i++)
842: {
843: ((real8 **) (*((struct_matrice *) (*s_objet_statistique)
844: .objet)).tableau)[i] = ((real8 **) tampon)[i];
845: }
846:
847: free(tampon);
848:
1.19 bertrand 849: for(k = 0; i < ((*((struct_matrice *)
1.1 bertrand 850: (*s_objet_statistique).objet)).nombre_lignes); i++, k++)
851: {
852: ((real8 **) (*((struct_matrice *) (*s_objet_statistique)
853: .objet)).tableau)[i] = ((real8 **)
854: (*((struct_matrice *) (*s_objet).objet))
855: .tableau)[k];
856: }
857:
858: free((real8 **) (*((struct_matrice *) (*s_objet).objet))
859: .tableau);
860: free((struct_matrice *) (*s_objet).objet);
861: free(s_objet);
862: s_objet = NULL;
863: }
864: else if (((*s_objet_statistique).type == MRL) &&
865: ((*s_objet).type == MIN))
866: {
867: tampon = (*((struct_matrice *) (*s_objet_statistique).objet))
868: .tableau;
869: (*((struct_matrice *) (*s_objet_statistique).objet))
870: .nombre_lignes += nombre_lignes;
871:
872: if (((*((struct_matrice *) (*s_objet_statistique).objet))
1.42 bertrand 873: .tableau = malloc(((size_t) (*((struct_matrice *)
874: (*s_objet_statistique).objet)).nombre_lignes) *
1.1 bertrand 875: sizeof(real8 *))) == NULL)
876: {
877: (*s_etat_processus).erreur_systeme =
878: d_es_allocation_memoire;
879: return;
880: }
881:
1.19 bertrand 882: for(i = 0; i < ((*((struct_matrice *)
1.1 bertrand 883: (*s_objet_statistique).objet)).nombre_lignes
884: - nombre_lignes); i++)
885: {
886: ((real8 **) (*((struct_matrice *) (*s_objet_statistique)
887: .objet)).tableau)[i] = ((real8 **) tampon)[i];
888: }
889:
890: free(tampon);
891:
1.19 bertrand 892: for(k = 0; i < ((*((struct_matrice *)
1.1 bertrand 893: (*s_objet_statistique).objet)).nombre_lignes); i++, k++)
894: {
895: if ((((real8 **) (*((struct_matrice *)
896: (*s_objet_statistique).objet)).tableau)[i] =
1.42 bertrand 897: malloc(((size_t) nombre_colonnes) *
898: sizeof(real8))) == NULL)
1.1 bertrand 899: {
900: (*s_etat_processus).erreur_systeme =
901: d_es_allocation_memoire;
902: return;
903: }
904:
905: for(j = 0; j < nombre_colonnes; j++)
906: {
907: ((real8 **) (*((struct_matrice *) (*s_objet_statistique)
908: .objet)).tableau)[i][j] =
909: (real8) (((integer8 **) (*((struct_matrice *)
910: (*s_objet).objet)).tableau)[k][j]);
911: }
912: }
913: }
914: else
915: {
916: tampon = (*((struct_matrice *) (*s_objet_statistique).objet))
917: .tableau;
918: (*((struct_matrice *) (*s_objet_statistique).objet))
919: .nombre_lignes += nombre_lignes;
920:
921: if (((*((struct_matrice *) (*s_objet_statistique).objet))
1.42 bertrand 922: .tableau = malloc(((size_t) (*((struct_matrice *)
923: (*s_objet_statistique).objet)).nombre_lignes) *
1.1 bertrand 924: sizeof(real8 *))) == NULL)
925: {
926: (*s_etat_processus).erreur_systeme =
927: d_es_allocation_memoire;
928: return;
929: }
930:
1.19 bertrand 931: for(i = 0; i < ((*((struct_matrice *)
1.1 bertrand 932: (*s_objet_statistique).objet)).nombre_lignes
933: - nombre_lignes); i++)
934: {
935: if ((((real8 **) (*((struct_matrice *)
936: (*s_objet_statistique).objet)).tableau)[i] =
1.42 bertrand 937: malloc(((size_t) nombre_colonnes) * sizeof(real8)))
1.1 bertrand 938: == NULL)
939: {
940: (*s_etat_processus).erreur_systeme =
941: d_es_allocation_memoire;
942: return;
943: }
944:
945: for(j = 0; j < nombre_colonnes; j++)
946: {
947: ((real8 **) (*((struct_matrice *) (*s_objet_statistique)
948: .objet)).tableau)[i][j] = (real8)
949: ((integer8 **) tampon)[i][j];
950: }
951:
952: free(((integer8 **) tampon)[i]);
953: }
954:
955: free(tampon);
956:
1.19 bertrand 957: for(k = 0; i < ((*((struct_matrice *)
1.1 bertrand 958: (*s_objet_statistique).objet)).nombre_lignes); i++, k++)
959: {
960: ((real8 **) (*((struct_matrice *) (*s_objet_statistique)
961: .objet)).tableau)[i] = ((real8 **)
962: (*((struct_matrice *) (*s_objet).objet))
963: .tableau)[k];
964: }
965:
966: free((real8 **) (*((struct_matrice *) (*s_objet).objet))
967: .tableau);
968: free((struct_matrice *) (*s_objet).objet);
969: free(s_objet);
970: s_objet = NULL;
971:
972: (*((struct_matrice *) (*s_objet_statistique).objet)).type = 'R';
973: (*s_objet_statistique).type = MRL;
974: }
975: }
976: }
977:
978: /*
979: * Type incompatible en entrée
980: */
981:
982: else
983: {
984: liberation(s_etat_processus, s_objet);
985:
986: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
987: return;
988: }
989:
990: liberation(s_etat_processus, s_objet);
991:
992: return;
993: }
994:
995:
996: /*
997: ================================================================================
998: Fonction 's-'
999: ================================================================================
1000: Entrées : structure processus
1001: --------------------------------------------------------------------------------
1002: Sorties :
1003: --------------------------------------------------------------------------------
1004: Effets de bord : néant
1005: ================================================================================
1006: */
1007:
1008: void
1009: instruction_s_moins(struct_processus *s_etat_processus)
1010: {
1011: struct_objet *s_copie_statistique;
1012: struct_objet *s_objet;
1013: struct_objet *s_objet_statistique;
1014:
1.42 bertrand 1015: integer8 i;
1016: integer8 nombre_colonnes;
1017: integer8 nombre_lignes;
1.1 bertrand 1018:
1019: void *tampon;
1020:
1021: (*s_etat_processus).erreur_execution = d_ex;
1022:
1023: if ((*s_etat_processus).affichage_arguments == 'Y')
1024: {
1025: printf("\n S- ");
1026:
1027: if ((*s_etat_processus).langue == 'F')
1028: {
1029: printf("(retrait une donnée dans la matrice statistique)\n\n");
1030: }
1031: else
1032: {
1033: printf("(remove a data value from statistical matrix)\n\n");
1034: }
1035:
1036: printf("-> 1: %s, %s, %s, %s\n", d_INT, d_REL, d_VIN, d_VRL);
1037:
1038: return;
1039: }
1040: else if ((*s_etat_processus).test_instruction == 'Y')
1041: {
1042: (*s_etat_processus).nombre_arguments = -1;
1043: return;
1044: }
1045:
1046: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1047: {
1048: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1049: {
1050: return;
1051: }
1052: }
1053:
1054: /*
1055: * Recherche d'une variable globale référencée par SIGMA
1056: */
1057:
1.19 bertrand 1058: if (recherche_variable_globale(s_etat_processus, ds_sdat) == d_faux)
1.1 bertrand 1059: {
1060: /*
1061: * Aucune variable SIGMA
1062: */
1063:
1064: (*s_etat_processus).erreur_systeme = d_es;
1.19 bertrand 1065:
1066: if ((*s_etat_processus).erreur_execution == d_ex)
1067: {
1068: (*s_etat_processus).erreur_execution = d_ex_absence_observations;
1069: }
1070:
1.1 bertrand 1071: return;
1072: }
1073: else
1074: {
1.19 bertrand 1075: if ((*(*s_etat_processus).pointeur_variable_courante)
1076: .variable_verrouillee == d_vrai)
1077: {
1078: (*s_etat_processus).erreur_execution =
1079: d_ex_variable_verrouillee;
1080: return;
1081: }
1.1 bertrand 1082:
1.19 bertrand 1083: if (((*(*(*s_etat_processus).pointeur_variable_courante).objet)
1084: .type != MIN) && ((*(*(*s_etat_processus)
1085: .pointeur_variable_courante).objet).type != MRL))
1.1 bertrand 1086: {
1.19 bertrand 1087: (*s_etat_processus).erreur_execution =
1088: d_ex_matrice_statistique_invalide;
1089: return;
1.1 bertrand 1090: }
1091:
1.19 bertrand 1092: if ((s_copie_statistique = copie_objet(s_etat_processus,
1093: (*(*s_etat_processus).pointeur_variable_courante).objet, 'O'))
1094: == NULL)
1.1 bertrand 1095: {
1.19 bertrand 1096: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1.1 bertrand 1097: return;
1098: }
1099:
1.19 bertrand 1100: liberation(s_etat_processus, (*(*s_etat_processus)
1101: .pointeur_variable_courante).objet);
1102: (*(*s_etat_processus).pointeur_variable_courante).objet =
1103: s_copie_statistique;
1104:
1105: nombre_colonnes = (*((struct_matrice *) (*(*(*s_etat_processus)
1106: .pointeur_variable_courante).objet).objet)).nombre_colonnes;
1107: nombre_lignes = (*((struct_matrice *) (*(*(*s_etat_processus)
1108: .pointeur_variable_courante).objet).objet)).nombre_lignes;
1.1 bertrand 1109: }
1110:
1.19 bertrand 1111: s_objet_statistique = (*(*s_etat_processus).pointeur_variable_courante)
1112: .objet;
1.1 bertrand 1113:
1114: if ((*s_objet_statistique).type == MIN)
1115: {
1116: if (nombre_colonnes == 1)
1117: {
1118: /*
1119: * Formation d'un entier
1120: */
1121:
1122: if ((s_objet = allocation(s_etat_processus, NON)) == NULL)
1123: {
1124: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1125: return;
1126: }
1127:
1128: (*s_objet).type = INT;
1129:
1130: if (nombre_lignes == 1)
1131: {
1132: if (((*s_objet).objet = malloc(sizeof(integer8))) == NULL)
1133: {
1134: (*s_etat_processus).erreur_systeme =
1135: d_es_allocation_memoire;
1136: return;
1137: }
1138:
1139: (*((integer8 *) (*s_objet).objet)) = ((integer8 **)
1140: (*((struct_matrice *) (*s_objet_statistique).objet))
1141: .tableau)[nombre_lignes - 1][0];
1142: }
1143: else
1144: {
1145: (*s_objet).objet = ((integer8 **)
1146: (*((struct_matrice *) (*s_objet_statistique).objet))
1147: .tableau)[nombre_lignes - 1];
1148: }
1149: }
1150: else
1151: {
1152: /*
1153: * Formation d'un vecteur d'entiers
1154: */
1155:
1156: if ((s_objet = allocation(s_etat_processus, NON)) == NULL)
1157: {
1158: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1159: return;
1160: }
1161:
1162: if (((*s_objet).objet = malloc(sizeof(struct_vecteur))) == NULL)
1163: {
1164: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1165: return;
1166: }
1167:
1168: (*s_objet).type = VIN;
1169: (*((struct_vecteur *) (*s_objet).objet)).type = 'I';
1170: (*((struct_vecteur *) (*s_objet).objet)).taille = nombre_colonnes;
1171:
1172: if (nombre_lignes == 1)
1173: {
1174: if (((*((struct_vecteur *) (*s_objet).objet))
1.42 bertrand 1175: .tableau = malloc(((size_t) nombre_colonnes) *
1.1 bertrand 1176: sizeof(integer8))) == NULL)
1177: {
1178: (*s_etat_processus).erreur_systeme =
1179: d_es_allocation_memoire;
1180: return;
1181: }
1182:
1.19 bertrand 1183: for(i = 0; i < nombre_colonnes; i++)
1.1 bertrand 1184: {
1185: ((integer8 *) (*((struct_vecteur *) (*s_objet).objet))
1186: .tableau)[i] = ((integer8 **) (*((struct_matrice *)
1187: (*s_objet_statistique).objet)).tableau)
1188: [nombre_lignes - 1][i];
1189: }
1190: }
1191: else
1192: {
1193: (*((struct_vecteur *) (*s_objet).objet)).tableau =
1194: ((integer8 **) (*((struct_matrice *)
1195: (*s_objet_statistique).objet)).tableau)
1196: [nombre_lignes - 1];
1197: }
1198: }
1199:
1200: if (nombre_lignes == 1)
1201: {
1202: /*
1203: * Destruction de la variable globale SIGMA
1204: */
1205:
1206: if (retrait_variable(s_etat_processus, ds_sdat, 'G') == d_erreur)
1207: {
1208: return;
1209: }
1210: }
1211: else
1212: {
1213: /*
1214: * Elimination de la dernière ligne de la matrice SIGMA
1215: */
1216:
1217: tampon = (*((struct_matrice *) (*s_objet_statistique)
1218: .objet)).tableau;
1219: (*((struct_matrice *) (*s_objet_statistique).objet))
1220: .nombre_lignes--;
1221:
1222: if (((*((struct_matrice *) (*s_objet_statistique)
1.42 bertrand 1223: .objet)).tableau = malloc(((size_t)
1.1 bertrand 1224: (*((struct_matrice *) (*s_objet_statistique).objet))
1.42 bertrand 1225: .nombre_lignes) * sizeof(integer8 *))) == NULL)
1.1 bertrand 1226: {
1227: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1228: return;
1229: }
1230:
1.19 bertrand 1231: for(i = 0; i < (*((struct_matrice *) (*s_objet_statistique)
1.1 bertrand 1232: .objet)).nombre_lignes; i++)
1233: {
1234: ((integer8 **) (*((struct_matrice *) (*s_objet_statistique)
1235: .objet)).tableau)[i] = ((integer8 **) tampon)[i];
1236: }
1237:
1238: free(tampon);
1239: }
1240: }
1241: else if ((*s_objet_statistique).type == MRL)
1242: {
1243: if (nombre_colonnes == 1)
1244: {
1245: /*
1246: * Formation d'un réel
1247: */
1248:
1249: if ((s_objet = allocation(s_etat_processus, NON)) == NULL)
1250: {
1251: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1252: return;
1253: }
1254:
1255: (*s_objet).type = REL;
1256:
1257: if (nombre_lignes == 1)
1258: {
1259: if (((*s_objet).objet = malloc(sizeof(real8)))
1260: == NULL)
1261: {
1262: (*s_etat_processus).erreur_systeme =
1263: d_es_allocation_memoire;
1264: return;
1265: }
1266:
1267: (*((real8 *) (*s_objet).objet)) = ((real8 **)
1268: (*((struct_matrice *) (*s_objet_statistique).objet))
1269: .tableau)[nombre_lignes - 1][0];
1270: }
1271: else
1272: {
1273: (*s_objet).objet = ((real8 **)
1274: (*((struct_matrice *) (*s_objet_statistique).objet))
1275: .tableau)[nombre_lignes - 1];
1276: }
1277: }
1278: else
1279: {
1280: /*
1281: * Formation d'un vecteur de réels
1282: */
1283:
1284: if ((s_objet = allocation(s_etat_processus, NON)) == NULL)
1285: {
1286: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1287: return;
1288: }
1289:
1290: if (((*s_objet).objet = malloc(sizeof(struct_vecteur))) == NULL)
1291: {
1292: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1293: return;
1294: }
1295:
1296: (*s_objet).type = VRL;
1297: (*((struct_vecteur *) (*s_objet).objet)).type = 'R';
1298: (*((struct_vecteur *) (*s_objet).objet)).taille = nombre_colonnes;
1299:
1300: if (nombre_lignes == 1)
1301: {
1302: if (((*((struct_vecteur *) (*s_objet).objet))
1.42 bertrand 1303: .tableau = malloc(((size_t) nombre_colonnes) *
1.1 bertrand 1304: sizeof(real8))) == NULL)
1305: {
1306: (*s_etat_processus).erreur_systeme =
1307: d_es_allocation_memoire;
1308: return;
1309: }
1310:
1.19 bertrand 1311: for(i = 0; i < nombre_colonnes; i++)
1.1 bertrand 1312: {
1313: ((real8 *) (*((struct_vecteur *) (*s_objet).objet))
1314: .tableau)[i] = ((real8 **) (*((struct_matrice *)
1315: (*s_objet_statistique).objet)).tableau)
1316: [nombre_lignes - 1][i];
1317: }
1318: }
1319: else
1320: {
1321: (*((struct_vecteur *) (*s_objet).objet)).tableau =
1322: ((real8 **) (*((struct_matrice *)
1323: (*s_objet_statistique).objet)).tableau)
1324: [nombre_lignes - 1];
1325: }
1326: }
1327:
1328: if (nombre_lignes == 1)
1329: {
1330: /*
1331: * Destruction de la variable globale SIGMA
1332: */
1333:
1334: if (retrait_variable(s_etat_processus, ds_sdat, 'G') == d_erreur)
1335: {
1336: return;
1337: }
1338: }
1339: else
1340: {
1341: /*
1342: * Elimination de la dernière ligne de la matrice SIGMA
1343: */
1344:
1345: tampon = (*((struct_matrice *) (*s_objet_statistique)
1346: .objet)).tableau;
1347: (*((struct_matrice *) (*s_objet_statistique).objet))
1348: .nombre_lignes--;
1349:
1350: if (((*((struct_matrice *) (*s_objet_statistique).objet))
1.42 bertrand 1351: .tableau = malloc(((size_t) (*((struct_matrice *)
1352: (*s_objet_statistique).objet)).nombre_lignes) *
1.1 bertrand 1353: sizeof(real8 *))) == NULL)
1354: {
1355: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1356: return;
1357: }
1358:
1.19 bertrand 1359: for(i = 0; i < (*((struct_matrice *) (*s_objet_statistique)
1.1 bertrand 1360: .objet)).nombre_lignes; i++)
1361: {
1362: ((real8 **) (*((struct_matrice *) (*s_objet_statistique)
1363: .objet)).tableau)[i] = ((real8 **) tampon)[i];
1364: }
1365:
1366: free(tampon);
1367: }
1368: }
1369: else
1370: {
1371: (*s_etat_processus).erreur_execution =
1372: d_ex_matrice_statistique_invalide;
1373: return;
1374: }
1375:
1376: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1377: s_objet) == d_erreur)
1378: {
1379: return;
1380: }
1381:
1382: return;
1383: }
1384:
1385: // vim: ts=4