Annotation of rpl/src/instructions_m3.c, revision 1.67
1.1 bertrand 1: /*
2: ================================================================================
1.66 bertrand 3: RPL/2 (R) version 4.1.32
1.67 ! bertrand 4: Copyright (C) 1989-2020 Dr. BERTRAND Joël
1.1 bertrand 5:
6: This file is part of RPL/2.
7:
8: RPL/2 is free software; you can redistribute it and/or modify it
9: under the terms of the CeCILL V2 License as published by the french
10: CEA, CNRS and INRIA.
11:
12: RPL/2 is distributed in the hope that it will be useful, but WITHOUT
13: ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14: FITNESS FOR A PARTICULAR PURPOSE. See the CeCILL V2 License
15: for more details.
16:
17: You should have received a copy of the CeCILL License
18: along with RPL/2. If not, write to info@cecill.info.
19: ================================================================================
20: */
21:
22:
1.11 bertrand 23: #include "rpl-conv.h"
1.1 bertrand 24:
25:
26: /*
27: ================================================================================
28: Fonction 'mean'
29: ================================================================================
30: Entrées : pointeur sur une structure struct_processus
31: --------------------------------------------------------------------------------
32: Sorties :
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: void
39: instruction_mean(struct_processus *s_etat_processus)
40: {
41: struct_objet *s_objet_statistique;
42: struct_objet *s_objet_resultat;
43: struct_objet *s_objet_temporaire;
44:
1.42 bertrand 45: integer8 nombre_colonnes;
1.1 bertrand 46:
47: (*s_etat_processus).erreur_execution = d_ex;
48:
49: if ((*s_etat_processus).affichage_arguments == 'Y')
50: {
51: printf("\n MEAN ");
52:
53: if ((*s_etat_processus).langue == 'F')
54: {
55: printf("(moyenne)\n\n");
56: }
57: else
58: {
59: printf("(mean)\n\n");
60: }
61:
62: printf("-> 1: %s, %s, %s, %s\n", d_INT, d_REL, d_VIN, d_VRL);
63:
64: return;
65: }
66: else if ((*s_etat_processus).test_instruction == 'Y')
67: {
68: (*s_etat_processus).nombre_arguments = -1;
69: return;
70: }
71:
72: if (test_cfsf(s_etat_processus, 31) == d_vrai)
73: {
74: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
75: {
76: return;
77: }
78: }
79:
80: /*
81: * Recherche d'une variable globale référencée par SIGMA
82: */
83:
1.19 bertrand 84: if (recherche_variable_globale(s_etat_processus, ds_sdat) == d_faux)
1.1 bertrand 85: {
86: /*
87: * Aucune variable SIGMA
88: */
89:
90: (*s_etat_processus).erreur_systeme = d_es;
1.19 bertrand 91:
92: if ((*s_etat_processus).erreur_execution == d_ex)
93: {
94: (*s_etat_processus).erreur_execution = d_ex_absence_observations;
95: }
96:
1.1 bertrand 97: return;
98: }
99: else
100: {
1.19 bertrand 101: if (((*(*(*s_etat_processus).pointeur_variable_courante).objet)
102: .type != MIN) && ((*(*(*s_etat_processus)
103: .pointeur_variable_courante).objet).type != MRL))
1.1 bertrand 104: {
1.19 bertrand 105: (*s_etat_processus).erreur_execution =
106: d_ex_matrice_statistique_invalide;
1.1 bertrand 107: return;
108: }
109:
1.19 bertrand 110: nombre_colonnes = (*((struct_matrice *) (*(*(*s_etat_processus)
111: .pointeur_variable_courante).objet).objet)).nombre_colonnes;
1.1 bertrand 112: }
113:
1.19 bertrand 114: s_objet_statistique = (*(*s_etat_processus).pointeur_variable_courante)
115: .objet;
1.1 bertrand 116:
117: if (((*s_objet_statistique).type == MIN) ||
118: ((*s_objet_statistique).type == MRL))
119: {
120: if ((s_objet_resultat = allocation(s_etat_processus, NON)) == NULL)
121: {
122: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
123: return;
124: }
125:
1.52 bertrand 126: if (((*s_objet_resultat).objet = moyenne_statistique(s_etat_processus,
127: (struct_matrice *) (*s_objet_statistique).objet)) == NULL)
1.1 bertrand 128: {
129: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
130: return;
131: }
132:
133: if (nombre_colonnes == 1)
134: {
135: if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I')
136: {
137: (*s_objet_resultat).type = VIN;
138: s_objet_temporaire = s_objet_resultat;
139:
140: if ((s_objet_resultat = allocation(s_etat_processus, INT))
141: == NULL)
142: {
143: (*s_etat_processus).erreur_systeme =
144: d_es_allocation_memoire;
145: return;
146: }
147:
148: (*((integer8 *) (*s_objet_resultat).objet)) =
149: ((integer8 *) (*((struct_vecteur *)
150: (*s_objet_temporaire).objet)).tableau)[0];
151:
152: liberation(s_etat_processus, s_objet_temporaire);
153: }
154: else
155: {
156: (*s_objet_resultat).type = VRL;
157: s_objet_temporaire = s_objet_resultat;
158:
159: if ((s_objet_resultat = allocation(s_etat_processus, REL))
160: == NULL)
161: {
162: (*s_etat_processus).erreur_systeme =
163: d_es_allocation_memoire;
164: return;
165: }
166:
167: (*((real8 *) (*s_objet_resultat).objet)) =
168: ((real8 *) (*((struct_vecteur *)
169: (*s_objet_temporaire).objet)).tableau)[0];
170:
171: liberation(s_etat_processus, s_objet_temporaire);
172: }
173: }
174: else
175: {
176: if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I')
177: {
178: (*s_objet_resultat).type = VIN;
179: }
180: else
181: {
182: (*s_objet_resultat).type = VRL;
183: }
184: }
185:
186: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
187: s_objet_resultat) == d_erreur)
188: {
189: return;
190: }
191: }
192: else
193: {
194: (*s_etat_processus).erreur_execution =
195: d_ex_matrice_statistique_invalide;
196: return;
197: }
198:
199: return;
200: }
201:
202:
203: /*
204: ================================================================================
205: Fonction 'mins'
206: ================================================================================
207: Entrées : pointeur sur une structure struct_processus
208: --------------------------------------------------------------------------------
209: Sorties :
210: --------------------------------------------------------------------------------
211: Effets de bord : néant
212: ================================================================================
213: */
214:
215: void
216: instruction_mins(struct_processus *s_etat_processus)
217: {
218: long i;
219: long j;
220:
221: struct_objet *s_objet_statistique;
222: struct_objet *s_objet_resultat;
223:
1.42 bertrand 224: integer8 nombre_colonnes;
1.1 bertrand 225:
226: (*s_etat_processus).erreur_execution = d_ex;
227:
228: if ((*s_etat_processus).affichage_arguments == 'Y')
229: {
230: printf("\n MINS ");
231:
232: if ((*s_etat_processus).langue == 'F')
233: {
234: printf("(minimum de la matrice statistique)\n\n");
235: }
236: else
237: {
238: printf("(statistical matrix minimum)\n\n");
239: }
240:
241: printf("-> 1: %s, %s, %s, %s\n", d_INT, d_REL, d_VIN, d_VRL);
242:
243: return;
244: }
245: else if ((*s_etat_processus).test_instruction == 'Y')
246: {
247: (*s_etat_processus).nombre_arguments = -1;
248: return;
249: }
250:
251: if (test_cfsf(s_etat_processus, 31) == d_vrai)
252: {
253: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
254: {
255: return;
256: }
257: }
258:
259: /*
260: * Recherche d'une variable globale référencée par SIGMA
261: */
262:
1.19 bertrand 263: if (recherche_variable_globale(s_etat_processus, ds_sdat) == d_faux)
1.1 bertrand 264: {
265: /*
266: * Aucune variable SIGMA
267: */
268:
269: (*s_etat_processus).erreur_systeme = d_es;
1.19 bertrand 270:
271: if ((*s_etat_processus).erreur_execution == d_ex)
272: {
273: (*s_etat_processus).erreur_execution = d_ex_absence_observations;
274: }
275:
1.1 bertrand 276: return;
277: }
278: else
279: {
1.19 bertrand 280: if (((*(*(*s_etat_processus).pointeur_variable_courante).objet)
281: .type != MIN) && ((*(*(*s_etat_processus)
282: .pointeur_variable_courante).objet).type != MRL))
1.1 bertrand 283: {
1.19 bertrand 284: (*s_etat_processus).erreur_execution =
285: d_ex_matrice_statistique_invalide;
1.1 bertrand 286: return;
287: }
288:
1.19 bertrand 289: nombre_colonnes = (*((struct_matrice *) (*(*(*s_etat_processus)
290: .pointeur_variable_courante).objet).objet)).nombre_colonnes;
1.1 bertrand 291: }
292:
1.19 bertrand 293: s_objet_statistique = (*(*s_etat_processus).pointeur_variable_courante)
294: .objet;
1.1 bertrand 295:
296: if (nombre_colonnes == 1)
297: {
298: if ((*s_objet_statistique).type == MRL)
299: {
300: if ((s_objet_resultat = allocation(s_etat_processus, REL))
301: == NULL)
302: {
303: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
304: return;
305: }
306:
307: (*((real8 *) (*s_objet_resultat).objet)) = ((real8 **)
308: (*((struct_matrice *) (*s_objet_statistique).objet))
309: .tableau)[0][0];
310:
1.42 bertrand 311: for(i = 1; i < (*((struct_matrice *) (*s_objet_statistique)
1.1 bertrand 312: .objet)).nombre_lignes; i++)
313: {
314: if ((*((real8 *) (*s_objet_resultat).objet)) > ((real8 **)
315: (*((struct_matrice *) (*s_objet_statistique).objet))
316: .tableau)[i][0])
317: {
318: (*((real8 *) (*s_objet_resultat).objet)) = ((real8 **)
319: (*((struct_matrice *) (*s_objet_statistique).objet))
320: .tableau)[i][0];
321: }
322: }
323: }
324: else
325: {
326: if ((s_objet_resultat = allocation(s_etat_processus, INT))
327: == NULL)
328: {
329: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
330: return;
331: }
332:
333: (*((integer8 *) (*s_objet_resultat).objet)) = ((integer8 **)
334: (*((struct_matrice *) (*s_objet_statistique).objet))
335: .tableau)[0][0];
336:
1.42 bertrand 337: for(i = 1; i < (*((struct_matrice *) (*s_objet_statistique)
1.1 bertrand 338: .objet)).nombre_lignes; i++)
339: {
340: if ((*((integer8 *) (*s_objet_resultat).objet)) > ((integer8 **)
341: (*((struct_matrice *) (*s_objet_statistique).objet))
342: .tableau)[i][0])
343: {
344: (*((integer8 *) (*s_objet_resultat).objet)) = ((integer8 **)
345: (*((struct_matrice *) (*s_objet_statistique).objet))
346: .tableau)[i][0];
347: }
348: }
349: }
350: }
351: else
352: {
353: if ((*s_objet_statistique).type == MRL)
354: {
355: if ((s_objet_resultat = allocation(s_etat_processus, VRL))
356: == NULL)
357: {
358: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
359: return;
360: }
361:
362: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
363: nombre_colonnes;
364:
365: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.42 bertrand 366: malloc(((size_t) nombre_colonnes) * sizeof(real8))) == NULL)
1.1 bertrand 367: {
368: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
369: return;
370: }
371:
1.42 bertrand 372: for(j = 0; j < nombre_colonnes; j++)
1.1 bertrand 373: {
374: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
375: .tableau)[j] = ((real8 **) (*((struct_matrice *)
376: (*s_objet_statistique).objet)).tableau)[0][j];
377:
1.42 bertrand 378: for(i = 1; i < (*((struct_matrice *)
1.1 bertrand 379: (*s_objet_statistique).objet)).nombre_lignes; i++)
380: {
381: if (((real8 *) (*((struct_vecteur *) (*s_objet_resultat)
382: .objet)).tableau)[j] > ((real8 **)
383: (*((struct_matrice *) (*s_objet_statistique).objet))
384: .tableau)[i][j])
385: {
386: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat)
387: .objet)).tableau)[j] = ((real8 **)
388: (*((struct_matrice *) (*s_objet_statistique)
389: .objet)).tableau)[i][j];
390: }
391: }
392: }
393: }
394: else
395: {
396: if ((s_objet_resultat = allocation(s_etat_processus, VIN))
397: == NULL)
398: {
399: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
400: return;
401: }
402:
403: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
404: nombre_colonnes;
405:
406: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.42 bertrand 407: malloc(((size_t) nombre_colonnes) * sizeof(integer8)))
408: == NULL)
1.1 bertrand 409: {
410: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
411: return;
412: }
413:
1.42 bertrand 414: for(j = 0; j < nombre_colonnes; j++)
1.1 bertrand 415: {
416: ((integer8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
417: .tableau)[j] = ((integer8 **) (*((struct_matrice *)
418: (*s_objet_statistique).objet)).tableau)[0][j];
419:
1.42 bertrand 420: for(i = 1; i < (*((struct_matrice *)
1.1 bertrand 421: (*s_objet_statistique).objet)).nombre_lignes; i++)
422: {
423: if (((integer8 *) (*((struct_vecteur *) (*s_objet_resultat)
424: .objet)).tableau)[j] > ((integer8 **)
425: (*((struct_matrice *) (*s_objet_statistique).objet))
426: .tableau)[i][j])
427: {
428: ((integer8 *) (*((struct_vecteur *) (*s_objet_resultat)
429: .objet)).tableau)[j] = ((integer8 **)
430: (*((struct_matrice *) (*s_objet_statistique)
431: .objet)).tableau)[i][j];
432: }
433: }
434: }
435: }
436: }
437:
438: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
439: s_objet_resultat) == d_erreur)
440: {
441: return;
442: }
443:
444: return;
445: }
446:
447:
448: /*
449: ================================================================================
450: Fonction 'maxs'
451: ================================================================================
452: Entrées : pointeur sur une structure struct_processus
453: --------------------------------------------------------------------------------
454: Sorties :
455: --------------------------------------------------------------------------------
456: Effets de bord : néant
457: ================================================================================
458: */
459:
460: void
461: instruction_maxs(struct_processus *s_etat_processus)
462: {
463: long i;
464: long j;
465:
466: struct_objet *s_objet_statistique;
467: struct_objet *s_objet_resultat;
468:
1.42 bertrand 469: integer8 nombre_colonnes;
1.1 bertrand 470:
471: (*s_etat_processus).erreur_execution = d_ex;
472:
473: if ((*s_etat_processus).affichage_arguments == 'Y')
474: {
475: printf("\n MAXS ");
476:
477: if ((*s_etat_processus).langue == 'F')
478: {
479: printf("(maximum de la matrice statistique)\n\n");
480: }
481: else
482: {
483: printf("(statistical matrix maximum)\n\n");
484: }
485:
486: printf("-> 1: %s, %s, %s, %s\n", d_INT, d_REL, d_VIN, d_VRL);
487:
488: return;
489: }
490: else if ((*s_etat_processus).test_instruction == 'Y')
491: {
492: (*s_etat_processus).nombre_arguments = -1;
493: return;
494: }
495:
496: if (test_cfsf(s_etat_processus, 31) == d_vrai)
497: {
498: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
499: {
500: return;
501: }
502: }
503:
504: /*
505: * Recherche d'une variable globale référencée par SIGMA
506: */
507:
1.19 bertrand 508: if (recherche_variable_globale(s_etat_processus, ds_sdat) == d_faux)
1.1 bertrand 509: {
510: /*
511: * Aucune variable SIGMA
512: */
513:
514: (*s_etat_processus).erreur_systeme = d_es;
1.19 bertrand 515:
516: if ((*s_etat_processus).erreur_execution == d_ex)
517: {
518: (*s_etat_processus).erreur_execution = d_ex_absence_observations;
519: }
520:
1.1 bertrand 521: return;
522: }
523: else
524: {
1.19 bertrand 525: if (((*(*(*s_etat_processus).pointeur_variable_courante).objet)
526: .type != MIN) && ((*(*(*s_etat_processus)
527: .pointeur_variable_courante).objet).type != MRL))
1.1 bertrand 528: {
1.19 bertrand 529: (*s_etat_processus).erreur_execution =
530: d_ex_matrice_statistique_invalide;
1.1 bertrand 531: return;
532: }
533:
1.19 bertrand 534: nombre_colonnes = (*((struct_matrice *) (*(*(*s_etat_processus)
535: .pointeur_variable_courante).objet).objet)).nombre_colonnes;
1.1 bertrand 536: }
537:
1.19 bertrand 538: s_objet_statistique = (*(*s_etat_processus).pointeur_variable_courante)
539: .objet;
1.1 bertrand 540:
541: if (nombre_colonnes == 1)
542: {
543: if ((*s_objet_statistique).type == MRL)
544: {
545: if ((s_objet_resultat = allocation(s_etat_processus, REL))
546: == NULL)
547: {
548: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
549: return;
550: }
551:
552: (*((real8 *) (*s_objet_resultat).objet)) = ((real8 **)
553: (*((struct_matrice *) (*s_objet_statistique).objet))
554: .tableau)[0][0];
555:
1.42 bertrand 556: for(i = 1; i < (*((struct_matrice *) (*s_objet_statistique)
1.1 bertrand 557: .objet)).nombre_lignes; i++)
558: {
559: if ((*((real8 *) (*s_objet_resultat).objet)) < ((real8 **)
560: (*((struct_matrice *) (*s_objet_statistique).objet))
561: .tableau)[i][0])
562: {
563: (*((real8 *) (*s_objet_resultat).objet)) = ((real8 **)
564: (*((struct_matrice *) (*s_objet_statistique).objet))
565: .tableau)[i][0];
566: }
567: }
568: }
569: else
570: {
571: if ((s_objet_resultat = allocation(s_etat_processus, INT))
572: == NULL)
573: {
574: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
575: return;
576: }
577:
578: (*((integer8 *) (*s_objet_resultat).objet)) = ((integer8 **)
579: (*((struct_matrice *) (*s_objet_statistique).objet))
580: .tableau)[0][0];
581:
1.42 bertrand 582: for(i = 1; i < (*((struct_matrice *) (*s_objet_statistique)
1.1 bertrand 583: .objet)).nombre_lignes; i++)
584: {
585: if ((*((integer8 *) (*s_objet_resultat).objet)) < ((integer8 **)
586: (*((struct_matrice *) (*s_objet_statistique).objet))
587: .tableau)[i][0])
588: {
589: (*((integer8 *) (*s_objet_resultat).objet)) = ((integer8 **)
590: (*((struct_matrice *) (*s_objet_statistique).objet))
591: .tableau)[i][0];
592: }
593: }
594: }
595: }
596: else
597: {
598: if ((*s_objet_statistique).type == MRL)
599: {
600: if ((s_objet_resultat = allocation(s_etat_processus, VRL))
601: == NULL)
602: {
603: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
604: return;
605: }
606:
607: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
608: nombre_colonnes;
609:
610: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.42 bertrand 611: malloc(((size_t) nombre_colonnes) * sizeof(real8))) == NULL)
1.1 bertrand 612: {
613: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
614: return;
615: }
616:
1.42 bertrand 617: for(j = 0; j < nombre_colonnes; j++)
1.1 bertrand 618: {
619: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
620: .tableau)[j] = ((real8 **) (*((struct_matrice *)
621: (*s_objet_statistique).objet)).tableau)[0][j];
622:
1.42 bertrand 623: for(i = 1; i < (*((struct_matrice *)
1.1 bertrand 624: (*s_objet_statistique).objet)).nombre_lignes; i++)
625: {
626: if (((real8 *) (*((struct_vecteur *) (*s_objet_resultat)
627: .objet)).tableau)[j] < ((real8 **)
628: (*((struct_matrice *) (*s_objet_statistique).objet))
629: .tableau)[i][j])
630: {
631: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat)
632: .objet)).tableau)[j] = ((real8 **)
633: (*((struct_matrice *) (*s_objet_statistique)
634: .objet)).tableau)[i][j];
635: }
636: }
637: }
638: }
639: else
640: {
641: if ((s_objet_resultat = allocation(s_etat_processus, VIN))
642: == NULL)
643: {
644: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
645: return;
646: }
647:
648: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
649: nombre_colonnes;
650:
651: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.42 bertrand 652: malloc(((size_t) nombre_colonnes) * sizeof(integer8)))
653: == NULL)
1.1 bertrand 654: {
655: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
656: return;
657: }
658:
1.42 bertrand 659: for(j = 0; j < nombre_colonnes; j++)
1.1 bertrand 660: {
661: ((integer8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
662: .tableau)[j] = ((integer8 **) (*((struct_matrice *)
663: (*s_objet_statistique).objet)).tableau)[0][j];
664:
1.42 bertrand 665: for(i = 1; i < (*((struct_matrice *)
1.1 bertrand 666: (*s_objet_statistique).objet)).nombre_lignes; i++)
667: {
668: if (((integer8 *) (*((struct_vecteur *) (*s_objet_resultat)
669: .objet)).tableau)[j] < ((integer8 **)
670: (*((struct_matrice *) (*s_objet_statistique).objet))
671: .tableau)[i][j])
672: {
673: ((integer8 *) (*((struct_vecteur *) (*s_objet_resultat)
674: .objet)).tableau)[j] = ((integer8 **)
675: (*((struct_matrice *) (*s_objet_statistique)
676: .objet)).tableau)[i][j];
677: }
678: }
679: }
680: }
681: }
682:
683: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
684: s_objet_resultat) == d_erreur)
685: {
686: return;
687: }
688:
689: return;
690: }
691:
692: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_m3.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src