Annotation of rpl/src/instructions_p4.c, revision 1.74
1.1 bertrand 1: /*
2: ================================================================================
1.73 bertrand 3: RPL/2 (R) version 4.1.32
1.74 ! 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 'pr1'
29: ================================================================================
30: Entrées :
31: --------------------------------------------------------------------------------
32: Sorties :
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: void
39: instruction_pr1(struct_processus *s_etat_processus)
40: {
41: struct_objet *s_objet;
42:
43: (*s_etat_processus).erreur_execution = d_ex;
44:
45: if ((*s_etat_processus).affichage_arguments == 'Y')
46: {
47: printf("\n PR1 ");
48:
49: if ((*s_etat_processus).langue == 'F')
50: {
51: printf("(impression d'un objet)\n\n");
52: }
53: else
54: {
55: printf("(print object)\n\n");
56: }
57:
58: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
59: " %s, %s, %s, %s, %s,\n"
60: " %s, %s, %s, %s, %s,\n"
61: " %s\n",
62: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
63: d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
64: printf("-> 1: %s, %s, %s, %s, %s, %s,\n"
65: " %s, %s, %s, %s, %s,\n"
66: " %s, %s, %s, %s, %s,\n"
67: " %s\n",
68: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
69: d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
70:
71: return;
72: }
73: else if ((*s_etat_processus).test_instruction == 'Y')
74: {
75: (*s_etat_processus).nombre_arguments = -1;
76: return;
77: }
78:
79: if (test_cfsf(s_etat_processus, 31) == d_vrai)
80: {
81: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
82: {
83: return;
84: }
85: }
86:
87: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
88: &s_objet) == d_erreur)
89: {
90: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
91: return;
92: }
93:
94: formateur_tex(s_etat_processus, s_objet, 'N');
95:
96: /*
97: * La fonction pr1 ne modifie pas la pile
98: */
99:
100: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
101: s_objet) == d_erreur)
102: {
103: return;
104: }
105:
106: return;
107: }
108:
109:
110: /*
111: ================================================================================
112: Fonction 'print'
113: ================================================================================
114: Entrées :
115: --------------------------------------------------------------------------------
116: Sorties :
117: --------------------------------------------------------------------------------
118: Effets de bord : néant
119: ================================================================================
120: */
121:
122: void
123: instruction_print(struct_processus *s_etat_processus)
124: {
125: (*s_etat_processus).erreur_execution = d_ex;
126:
127: if ((*s_etat_processus).affichage_arguments == 'Y')
128: {
129: printf("\n PRINT ");
130:
131: if ((*s_etat_processus).langue == 'F')
132: {
133: printf("(impression puis destruction de la file d'impression)"
134: "\n\n");
135: printf(" Aucun argument\n");
136: }
137: else
138: {
139: printf("(print and purge the printer queue)\n\n");
140: printf(" No argument\n");
141: }
142:
143: return;
144: }
145: else if ((*s_etat_processus).test_instruction == 'Y')
146: {
147: (*s_etat_processus).nombre_arguments = -1;
148: return;
149: }
150:
151: if (test_cfsf(s_etat_processus, 31) == d_vrai)
152: {
153: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
154: {
155: return;
156: }
157: }
158:
159: if ((*s_etat_processus).nom_fichier_impression == NULL)
160: {
161: (*s_etat_processus).erreur_execution = d_ex_queue_impression;
162: return;
163: }
164:
165: # ifdef POSTSCRIPT_SUPPORT
166: impression_tex(s_etat_processus);
167: # else
168: if ((*s_etat_processus).langue == 'F')
169: {
170: printf("+++Attention : Support de TeX non compilé !\n");
171: }
172: else
173: {
174: printf("+++Warning : TeX not available !\n");
175: }
176:
177: fflush(stdout);
178: # endif
179:
180: return;
181: }
182:
183:
184: /*
185: ================================================================================
186: Fonction 'prst'
187: ================================================================================
188: Entrées :
189: --------------------------------------------------------------------------------
190: Sorties :
191: --------------------------------------------------------------------------------
192: Effets de bord : néant
193: ================================================================================
194: */
195:
196: void
197: instruction_prst(struct_processus *s_etat_processus)
198: {
199: (*s_etat_processus).erreur_execution = d_ex;
200:
201: if ((*s_etat_processus).affichage_arguments == 'Y')
202: {
203: printf("\n PRST ");
204:
205: if ((*s_etat_processus).langue == 'F')
206: {
207: printf("(imprime la pile opérationnelle)\n\n");
208: }
209: else
210: {
211: printf("(print stack)\n\n");
212: }
213:
214: printf(" n: %s, %s, %s, %s, %s, %s,\n"
215: " %s, %s, %s, %s, %s,\n"
216: " %s, %s, %s, %s, %s,\n"
217: " %s\n",
218: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
219: d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
220: printf(" ...\n");
221: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
222: " %s, %s, %s, %s, %s,\n"
223: " %s, %s, %s, %s, %s,\n"
224: " %s\n",
225: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
226: d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
227: printf("-> n: %s, %s, %s, %s, %s, %s,\n"
228: " %s, %s, %s, %s, %s,\n"
229: " %s, %s, %s, %s, %s,\n"
230: " %s\n",
231: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
232: d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
233: printf(" ...\n");
234: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
235: " %s, %s, %s, %s, %s,\n"
236: " %s, %s, %s, %s, %s,\n"
237: " %s\n",
238: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
239: d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
240:
241: return;
242: }
243: else if ((*s_etat_processus).test_instruction == 'Y')
244: {
245: (*s_etat_processus).nombre_arguments = -1;
246: return;
247: }
248:
249: if (test_cfsf(s_etat_processus, 31) == d_vrai)
250: {
251: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
252: {
253: return;
254: }
255: }
256:
1.30 bertrand 257: routine_recursive = 2;
1.1 bertrand 258: impression_pile(s_etat_processus, (*s_etat_processus).l_base_pile,
259: 'E', 1);
1.30 bertrand 260: routine_recursive = 0;
1.1 bertrand 261: return;
262: }
263:
264:
265: /*
266: ================================================================================
267: Fonction 'prstc'
268: ================================================================================
269: Entrées :
270: --------------------------------------------------------------------------------
271: Sorties :
272: --------------------------------------------------------------------------------
273: Effets de bord : néant
274: ================================================================================
275: */
276:
277: void
278: instruction_prstc(struct_processus *s_etat_processus)
279: {
280: (*s_etat_processus).erreur_execution = d_ex;
281:
282: if ((*s_etat_processus).affichage_arguments == 'Y')
283: {
284: printf("\n PRSTC ");
285:
286: if ((*s_etat_processus).langue == 'F')
287: {
288: printf("(imprime la pile opérationnelle en mode compact)\n\n");
289: }
290: else
291: {
292: printf("(print stack in compact mode)\n\n");
293: }
294:
295: printf(" n: %s, %s, %s, %s, %s, %s,\n"
296: " %s, %s, %s, %s, %s,\n"
297: " %s, %s, %s, %s, %s,\n"
298: " %s\n",
299: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
300: d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
301: printf(" ...\n");
302: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
303: " %s, %s, %s, %s, %s,\n"
304: " %s, %s, %s, %s, %s,\n"
305: " %s\n",
306: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
307: d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
308: printf("-> n: %s, %s, %s, %s, %s, %s,\n"
309: " %s, %s, %s, %s, %s,\n"
310: " %s, %s, %s, %s, %s,\n"
311: " %s\n",
312: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
313: d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
314: printf(" ...\n");
315: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
316: " %s, %s, %s, %s, %s,\n"
317: " %s, %s, %s, %s, %s,\n"
318: " %s\n",
319: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
320: d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
321:
322: return;
323: }
324: else if ((*s_etat_processus).test_instruction == 'Y')
325: {
326: (*s_etat_processus).nombre_arguments = -1;
327: return;
328: }
329:
330: if (test_cfsf(s_etat_processus, 31) == d_vrai)
331: {
332: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
333: {
334: return;
335: }
336: }
337:
1.30 bertrand 338: routine_recursive = 2;
1.1 bertrand 339: impression_pile(s_etat_processus, (*s_etat_processus).l_base_pile,
340: 'C', 1);
1.30 bertrand 341: routine_recursive = 0;
1.1 bertrand 342: return;
343: }
344:
345:
346: /*
347: ================================================================================
348: Fonction 'prvar'
349: ================================================================================
350: Entrées :
351: --------------------------------------------------------------------------------
352: Sorties :
353: --------------------------------------------------------------------------------
354: Effets de bord : néant
355: ================================================================================
356: */
357:
358: void
359: instruction_prvar(struct_processus *s_etat_processus)
360: {
361: struct_objet *s_objet;
362:
363: (*s_etat_processus).erreur_execution = d_ex;
364:
365: if ((*s_etat_processus).affichage_arguments == 'Y')
366: {
367: printf("\n PRVAR ");
368:
369: if ((*s_etat_processus).langue == 'F')
370: {
371: printf("(imprime le contenu d'une variable)\n\n");
372: }
373: else
374: {
375: printf("(print variable)\n\n");
376: }
377:
378: printf(" 1: %s\n", d_NOM);
379:
380: return;
381: }
382: else if ((*s_etat_processus).test_instruction == 'Y')
383: {
384: (*s_etat_processus).nombre_arguments = -1;
385: return;
386: }
387:
388: if (test_cfsf(s_etat_processus, 31) == d_vrai)
389: {
390: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
391: {
392: return;
393: }
394: }
395:
396: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
397: &s_objet) == d_erreur)
398: {
399: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
400: return;
401: }
402:
403: if ((*s_objet).type != NOM)
404: {
405: liberation(s_etat_processus, s_objet);
406:
407: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
408: return;
409: }
410:
411: if (recherche_variable(s_etat_processus, (*((struct_nom *)
412: (*s_objet).objet)).nom) == d_faux)
413: {
414: (*s_etat_processus).erreur_systeme = d_es;
415: (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
416:
417: liberation(s_etat_processus, s_objet);
418: return;
419: }
420:
1.19 bertrand 421: if ((*(*s_etat_processus).pointeur_variable_courante).objet != NULL)
1.1 bertrand 422: {
1.19 bertrand 423: formateur_tex(s_etat_processus, (*(*s_etat_processus)
424: .pointeur_variable_courante).objet, 'N');
1.1 bertrand 425: }
426: else
427: {
428: if (recherche_variable_partagee(s_etat_processus,
1.19 bertrand 429: (*(*s_etat_processus).pointeur_variable_courante).nom,
430: (*(*s_etat_processus).pointeur_variable_courante)
431: .variable_partagee, (*(*s_etat_processus)
1.41 bertrand 432: .pointeur_variable_courante).origine) == NULL)
1.1 bertrand 433: {
434: (*s_etat_processus).erreur_systeme = d_es;
435: (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
436:
437: liberation(s_etat_processus, s_objet);
438: return;
439: }
440:
441: formateur_tex(s_etat_processus, (*(*s_etat_processus)
1.40 bertrand 442: .pointeur_variable_partagee_courante).objet, 'N');
1.1 bertrand 443:
444: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.40 bertrand 445: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 446: {
447: (*s_etat_processus).erreur_systeme = d_es_processus;
448: return;
449: }
450: }
451:
452: liberation(s_etat_processus, s_objet);
453:
454: return;
455: }
456:
457:
458: /*
459: ================================================================================
460: Fonction 'prusr'
461: ================================================================================
462: Entrées :
463: --------------------------------------------------------------------------------
464: Sorties :
465: --------------------------------------------------------------------------------
466: Effets de bord : néant
467: ================================================================================
468: */
469:
470: void
471: instruction_prusr(struct_processus *s_etat_processus)
472: {
1.47 bertrand 473: integer8 i;
1.48 bertrand 474: integer8 j;
1.47 bertrand 475: integer8 nb_variables;
1.22 bertrand 476:
1.1 bertrand 477: struct_objet s_objet;
478:
1.22 bertrand 479: struct_tableau_variables *tableau;
480:
1.1 bertrand 481: (*s_etat_processus).erreur_execution = d_ex;
482:
483: if ((*s_etat_processus).affichage_arguments == 'Y')
484: {
485: printf("\n PRUSR ");
486:
487: if ((*s_etat_processus).langue == 'F')
488: {
489: printf("(impression de toutes les variables utilisateur)\n\n");
490: printf(" Aucun argument\n");
491: }
492: else
493: {
494: printf("(print all user variables)\n\n");
495: printf(" No argument\n");
496: }
497:
498: return;
499: }
500: else if ((*s_etat_processus).test_instruction == 'Y')
501: {
502: (*s_etat_processus).nombre_arguments = -1;
503: return;
504: }
505:
506: if (test_cfsf(s_etat_processus, 31) == d_vrai)
507: {
508: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
509: {
510: return;
511: }
512: }
513:
1.41 bertrand 514: nb_variables = nombre_variables(s_etat_processus);
1.22 bertrand 515:
1.47 bertrand 516: if ((tableau = malloc(((size_t) nb_variables) *
517: sizeof(struct_tableau_variables))) == NULL)
1.22 bertrand 518: {
1.41 bertrand 519: liberation_mutexes_arbre_variables_partagees(s_etat_processus,
520: (*(*s_etat_processus).s_arbre_variables_partagees));
1.22 bertrand 521: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
522: return;
523: }
524:
1.48 bertrand 525: nb_variables = liste_variables(s_etat_processus, tableau);
1.1 bertrand 526: s_objet.type = CHN;
527:
1.22 bertrand 528: for(i = 0; i < nb_variables; i++)
1.1 bertrand 529: {
1.22 bertrand 530: if ((s_objet.objet = malloc((strlen(tableau[i].nom) + 64)
531: * sizeof(unsigned char))) == NULL)
1.1 bertrand 532: {
1.48 bertrand 533: for(j = i; j < nb_variables; j++)
534: {
535: if (tableau[j].mutex != NULL)
536: {
537: pthread_mutex_unlock(tableau[i].mutex);
538: }
539: }
540:
1.22 bertrand 541: free(tableau);
542:
1.1 bertrand 543: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
544: return;
545: }
546:
1.47 bertrand 547: sprintf((unsigned char *) s_objet.objet, "\\\\noindent %s [%lld]\n",
1.22 bertrand 548: tableau[i].nom, tableau[i].niveau);
1.1 bertrand 549:
1.48 bertrand 550: if (tableau[i].mutex != NULL)
551: {
552: pthread_mutex_unlock(tableau[i].mutex);
553: }
554:
1.1 bertrand 555: formateur_tex(s_etat_processus, &s_objet, 'N');
556: free(s_objet.objet);
557: }
558:
1.22 bertrand 559: free(tableau);
1.1 bertrand 560: return;
561: }
562:
563:
564: /*
565: ================================================================================
566: Fonction 'prmd'
567: ================================================================================
568: Entrées :
569: --------------------------------------------------------------------------------
570: Sorties :
571: --------------------------------------------------------------------------------
572: Effets de bord : néant
573: ================================================================================
574: */
575:
576: void
577: instruction_prmd(struct_processus *s_etat_processus)
578: {
1.47 bertrand 579: long i;
580: long j;
1.1 bertrand 581: long longueur_utile;
582: long longueur_utile_limite;
583:
584: struct_objet s_objet;
585:
586: (*s_etat_processus).erreur_execution = d_ex;
587:
588: if ((*s_etat_processus).affichage_arguments == 'Y')
589: {
590: printf("\n PRMD ");
591:
592: if ((*s_etat_processus).langue == 'F')
593: {
594: printf("(impression de l'état du séquenceur)\n\n");
595: printf(" Aucun argument\n");
596: }
597: else
598: {
599: printf("(print sequencer state)\n\n");
600: printf(" No argument\n");
601: }
602:
603: return;
604: }
605: else if ((*s_etat_processus).test_instruction == 'Y')
606: {
607: (*s_etat_processus).nombre_arguments = -1;
608: return;
609: }
610:
611: if (test_cfsf(s_etat_processus, 31) == d_vrai)
612: {
613: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
614: {
615: return;
616: }
617: }
618:
619: s_objet.type = CHN;
620:
621: if ((s_objet.objet = malloc(128 * sizeof(unsigned char))) == NULL)
622: {
623: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
624: return;
625: }
626:
627: longueur_utile = 0;
628: j = 1;
629:
630: for(i = 53; i <= 56; i++)
631: {
632: longueur_utile += (test_cfsf(s_etat_processus, (unsigned char) i)
633: == d_vrai) ? j : 0;
634: j *= 2;
635: }
636:
637: longueur_utile_limite = 12;
638:
639: if (longueur_utile > longueur_utile_limite)
640: {
641: longueur_utile = longueur_utile_limite;
642: }
643:
644: if ((test_cfsf(s_etat_processus, 49) == d_faux) &&
645: (test_cfsf(s_etat_processus, 50) == d_faux))
646: {
647: if ((*s_etat_processus).langue == 'F')
648: {
649: sprintf((unsigned char *) s_objet.objet,
650: "\\noindent Mode d'affichage numérique: standard\n");
651: }
652: else
653: {
654: sprintf((unsigned char *) s_objet.objet,
655: "\\noindent Numerical mode: standard\n");
656: }
657: }
658: else if ((test_cfsf(s_etat_processus, 49) == d_faux) &&
659: (test_cfsf(s_etat_processus, 50) == d_vrai))
660: {
661: if ((*s_etat_processus).langue == 'F')
662: {
663: sprintf((unsigned char *) s_objet.objet,
664: "\\noindent Mode d'affichage numérique: "
665: "scientifique (%ld)\n", longueur_utile);
666: }
667: else
668: {
669: sprintf((unsigned char *) s_objet.objet,
670: "\\noindent Numerical mode: scientific (%ld)\n",
671: longueur_utile);
672: }
673: }
674: else if ((test_cfsf(s_etat_processus, 49) == d_vrai) &&
675: (test_cfsf(s_etat_processus, 50) == d_faux))
676: {
677: if ((*s_etat_processus).langue == 'F')
678: {
679: sprintf((unsigned char *) s_objet.objet,
680: "\\noindent Mode d'affichage numérique: "
681: "virgule fixe (%ld)\n", longueur_utile);
682: }
683: else
684: {
685: sprintf((unsigned char *) s_objet.objet,
686: "\\noindent Numerical mode: fixed point (%ld)\n", longueur_utile);
687: }
688: }
689: else
690: {
691: if ((*s_etat_processus).langue == 'F')
692: {
693: sprintf((unsigned char *) s_objet.objet,
694: "\\noindent Mode d'affichage numérique: notation ingénieur "
695: "(%ld)\n", longueur_utile);
696: }
697: else
698: {
699: sprintf((unsigned char *) s_objet.objet,
700: "\\noindent Numerical mode: engineer "
701: "(%ld)\n", longueur_utile);
702: }
703: }
704:
705:
706: formateur_tex(s_etat_processus, &s_objet, 'N');
707: free(s_objet.objet);
708:
709: if ((s_objet.objet = malloc(128 * sizeof(unsigned char))) == NULL)
710: {
711: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
712: return;
713: }
714:
715: if ((*s_etat_processus).langue == 'F')
716: {
717: sprintf((unsigned char *) s_objet.objet,
718: "\\noindent \\'Echelle angulaire: %s\n",
719: (test_cfsf(s_etat_processus, 60) == d_faux)
720: ? "degrés" : "radians");
721: }
722: else
723: {
724: sprintf((unsigned char *) s_objet.objet,
725: "\\noindent Angular scale: %s\n",
726: (test_cfsf(s_etat_processus, 60) == d_faux)
727: ? "degrees" : "radians");
728: }
729:
730: formateur_tex(s_etat_processus, &s_objet, 'N');
731: free(s_objet.objet);
732:
733: if ((s_objet.objet = malloc(128 * sizeof(unsigned char))) == NULL)
734: {
735: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
736: return;
737: }
738:
739: if ((test_cfsf(s_etat_processus, 43) == d_faux) &&
740: (test_cfsf(s_etat_processus, 44) == d_faux))
741: {
742: if ((*s_etat_processus).langue == 'F')
743: {
744: sprintf((unsigned char *) s_objet.objet,
745: "\\noindent Base des entiers : décimale\n");
746: }
747: else
748: {
749: sprintf((unsigned char *) s_objet.objet,
750: "\\noindent Integer base: decimal\n");
751: }
752: }
753: else if ((test_cfsf(s_etat_processus, 43) == d_vrai) &&
754: (test_cfsf(s_etat_processus, 44) == d_faux))
755: {
756: if ((*s_etat_processus).langue == 'F')
757: {
758: sprintf((unsigned char *) s_objet.objet,
759: "\\noindent Base des entiers : octale\n");
760: }
761: else
762: {
763: sprintf((unsigned char *) s_objet.objet,
764: "\\noindent Integer base: octal\n");
765: }
766: }
767: else if ((test_cfsf(s_etat_processus, 43) == d_vrai) &&
768: (test_cfsf(s_etat_processus, 44) == d_vrai))
769: {
770: if ((*s_etat_processus).langue == 'F')
771: {
772: sprintf((unsigned char *) s_objet.objet,
773: "\\noindent Base des entiers : hexadécimale\n");
774: }
775: else
776: {
777: sprintf((unsigned char *) s_objet.objet,
778: "\\noindent Integer base: hexadecimal\n");
779: }
780: }
781: else
782: {
783: if ((*s_etat_processus).langue == 'F')
784: {
785: sprintf((unsigned char *) s_objet.objet,
786: "\\noindent Base des entiers : binaire\n");
787: }
788: else
789: {
790: sprintf((unsigned char *) s_objet.objet,
791: "\\noindent Integer base: binary\n");
792: }
793: }
794:
795: formateur_tex(s_etat_processus, &s_objet, 'N');
796: free(s_objet.objet);
797:
798: if ((s_objet.objet = malloc(128 * sizeof(unsigned char))) == NULL)
799: {
800: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
801: return;
802: }
803:
804: if ((*s_etat_processus).langue == 'F')
805: {
806: sprintf((unsigned char *) s_objet.objet,
807: "\\noindent Longueur des entiers : %d bits\n",
808: longueur_entiers_binaires(s_etat_processus));
809: }
810: else
811: {
812: sprintf((unsigned char *) s_objet.objet,
813: "\\noindent Length of integers: %d bits\n",
814: longueur_entiers_binaires(s_etat_processus));
815: }
816:
817: formateur_tex(s_etat_processus, &s_objet, 'N');
818: free(s_objet.objet);
819:
820: if ((s_objet.objet = malloc(128 * sizeof(unsigned char))) == NULL)
821: {
822: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
823: return;
824: }
825:
826: if ((*s_etat_processus).langue == 'F')
827: {
828: sprintf((unsigned char *) s_objet.objet,
829: "\\noindent Séparateur décimal: %s\n",
830: (test_cfsf(s_etat_processus, 48) == d_faux)
831: ? "point" : "virgule");
832: }
833: else
834: {
835: sprintf((unsigned char *) s_objet.objet,
836: "\\noindent Radix: %s\n",
837: (test_cfsf(s_etat_processus, 48) == d_faux)
838: ? "period" : "coma");
839: }
840:
841: formateur_tex(s_etat_processus, &s_objet, 'N');
842: free(s_objet.objet);
843:
844: return;
845: }
846:
847:
848: /*
849: ================================================================================
850: Fonction 'pmin'
851: ================================================================================
852: Entrées :
853: --------------------------------------------------------------------------------
854: Sorties :
855: --------------------------------------------------------------------------------
856: Effets de bord : néant
857: ================================================================================
858: */
859:
860: void
861: instruction_pmin(struct_processus *s_etat_processus)
862: {
863: struct_objet *s_objet;
864:
865: (*s_etat_processus).erreur_execution = d_ex;
866:
867: if ((*s_etat_processus).affichage_arguments == 'Y')
868: {
869: printf("\n PMIN ");
870:
871: if ((*s_etat_processus).langue == 'F')
872: {
873: printf("(minima d'un graphique 2D)\n\n");
874: }
875: else
876: {
877: printf("(2D-graphic minima)\n\n");
878: }
879:
880: printf(" 1: %s\n", d_CPL);
881:
882: return;
883: }
884: else if ((*s_etat_processus).test_instruction == 'Y')
885: {
886: (*s_etat_processus).nombre_arguments = -1;
887: return;
888: }
889:
890: if (test_cfsf(s_etat_processus, 31) == d_vrai)
891: {
892: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
893: {
894: return;
895: }
896: }
897:
898: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
899: &s_objet) == d_erreur)
900: {
901: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
902: return;
903: }
904:
905: if ((*s_objet).type == CPL)
906: {
907: if ((*s_etat_processus).systeme_axes == 0)
908: {
909: (*s_etat_processus).x_min = (*((complex16 *) (*s_objet).objet))
910: .partie_reelle;
911: (*s_etat_processus).y_min = (*((complex16 *) (*s_objet).objet))
912: .partie_imaginaire;
913: }
914: else
915: {
916: (*s_etat_processus).x2_min = (*((complex16 *) (*s_objet).objet))
917: .partie_reelle;
918: (*s_etat_processus).y2_min = (*((complex16 *) (*s_objet).objet))
919: .partie_imaginaire;
920: }
921: }
922: else
923: {
924: liberation(s_etat_processus, s_objet);
925:
926: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
927: return;
928: }
929:
930: liberation(s_etat_processus, s_objet);
931:
932: if (test_cfsf(s_etat_processus, 52) == d_faux)
933: {
934: if ((*s_etat_processus).fichiers_graphiques != NULL)
935: {
936: appel_gnuplot(s_etat_processus, 'N');
937: }
938: }
939:
940: return;
941: }
942:
943:
944: /*
945: ================================================================================
946: Fonction 'pmax'
947: ================================================================================
948: Entrées :
949: --------------------------------------------------------------------------------
950: Sorties :
951: --------------------------------------------------------------------------------
952: Effets de bord : néant
953: ================================================================================
954: */
955:
956: void
957: instruction_pmax(struct_processus *s_etat_processus)
958: {
959: struct_objet *s_objet;
960:
961: (*s_etat_processus).erreur_execution = d_ex;
962:
963: if ((*s_etat_processus).affichage_arguments == 'Y')
964: {
965: printf("\n PMAX ");
966:
967: if ((*s_etat_processus).langue == 'F')
968: {
969: printf("(maxima d'un graphique 2D)\n\n");
970: }
971: else
972: {
973: printf("(2D-graphic maxima)\n\n");
974: }
975:
976: printf(" 1: %s\n", d_CPL);
977:
978: return;
979: }
980: else if ((*s_etat_processus).test_instruction == 'Y')
981: {
982: (*s_etat_processus).nombre_arguments = -1;
983: return;
984: }
985:
986: if (test_cfsf(s_etat_processus, 31) == d_vrai)
987: {
988: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
989: {
990: return;
991: }
992: }
993:
994: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
995: &s_objet) == d_erreur)
996: {
997: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
998: return;
999: }
1000:
1001: if ((*s_objet).type == CPL)
1002: {
1003: if ((*s_etat_processus).systeme_axes == 0)
1004: {
1005: (*s_etat_processus).x_max = (*((complex16 *) (*s_objet).objet))
1006: .partie_reelle;
1007: (*s_etat_processus).y_max = (*((complex16 *) (*s_objet).objet))
1008: .partie_imaginaire;
1009: }
1010: else
1011: {
1012: (*s_etat_processus).x2_max = (*((complex16 *) (*s_objet).objet))
1013: .partie_reelle;
1014: (*s_etat_processus).y2_max = (*((complex16 *) (*s_objet).objet))
1015: .partie_imaginaire;
1016: }
1017: }
1018: else
1019: {
1020: liberation(s_etat_processus, s_objet);
1021:
1022: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1023: return;
1024: }
1025:
1026: liberation(s_etat_processus, s_objet);
1027:
1028: if (test_cfsf(s_etat_processus, 52) == d_faux)
1029: {
1030: if ((*s_etat_processus).fichiers_graphiques != NULL)
1031: {
1032: appel_gnuplot(s_etat_processus, 'N');
1033: }
1034: }
1035:
1036: return;
1037: }
1038:
1039:
1040: /*
1041: ================================================================================
1042: Fonction 'persist'
1043: ================================================================================
1044: Entrées :
1045: --------------------------------------------------------------------------------
1046: Sorties :
1047: --------------------------------------------------------------------------------
1048: Effets de bord : néant
1049: ================================================================================
1050: */
1051:
1052: void
1053: instruction_persist(struct_processus *s_etat_processus)
1054: {
1055: (*s_etat_processus).erreur_execution = d_ex;
1056:
1057: if ((*s_etat_processus).affichage_arguments == 'Y')
1058: {
1059: printf("\n PERSIST ");
1060:
1061: if ((*s_etat_processus).langue == 'F')
1062: {
1063: printf("(détachement d'un graphique)\n\n");
1064: printf(" Aucun argument\n");
1065: }
1066: else
1067: {
1068: printf("(spawn a graphic output)\n\n");
1069: printf(" No argument\n");
1070: }
1071:
1072: return;
1073: }
1074: else if ((*s_etat_processus).test_instruction == 'Y')
1075: {
1076: (*s_etat_processus).nombre_arguments = -1;
1077: return;
1078: }
1079:
1080: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1081: {
1082: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1083: {
1084: return;
1085: }
1086: }
1087:
1088: appel_gnuplot(s_etat_processus, 'E');
1089:
1090: return;
1091: }
1092:
1093:
1094: /*
1095: ================================================================================
1096: Fonction 'polar' (passe en mode d'affichage r=f(t))
1097: ================================================================================
1098: Entrées : structure processus
1099: --------------------------------------------------------------------------------
1100: Sorties :
1101: --------------------------------------------------------------------------------
1102: Effets de bord : néant
1103: ================================================================================
1104: */
1105:
1106: void
1107: instruction_polar(struct_processus *s_etat_processus)
1108: {
1109: (*s_etat_processus).erreur_execution = d_ex;
1110:
1111: if ((*s_etat_processus).affichage_arguments == 'Y')
1112: {
1113: printf("\n POLAR ");
1114:
1115: if ((*s_etat_processus).langue == 'F')
1116: {
1117: printf("(tracé théta=f(r))\n\n");
1118: printf(" Aucun argument\n");
1119: }
1120: else
1121: {
1122: printf("(plot theta=f(r))\n\n");
1123: printf(" No argument\n");
1124: }
1125:
1126: return;
1127: }
1128: else if ((*s_etat_processus).test_instruction == 'Y')
1129: {
1130: (*s_etat_processus).nombre_arguments = -1;
1131: return;
1132: }
1133:
1134: strcpy((*s_etat_processus).type_trace_eq, "POLAIRE");
1135:
1136: return;
1137: }
1138:
1139:
1140: /*
1141: ================================================================================
1142: Fonction 'parametric' (passe en mode d'affichage r=f(t))
1143: ================================================================================
1144: Entrées : structure processus
1145: --------------------------------------------------------------------------------
1146: Sorties :
1147: --------------------------------------------------------------------------------
1148: Effets de bord : néant
1149: ================================================================================
1150: */
1151:
1152: void
1153: instruction_parametric(struct_processus *s_etat_processus)
1154: {
1155: (*s_etat_processus).erreur_execution = d_ex;
1156:
1157: if ((*s_etat_processus).affichage_arguments == 'Y')
1158: {
1159: printf("\n PARAMETRIC ");
1160:
1161: if ((*s_etat_processus).langue == 'F')
1162: {
1163: printf("(tracé (x,y)=f(t)+i*g(t))\n\n");
1164: printf(" Aucun argument\n");
1165: }
1166: else
1167: {
1168: printf("(plot (x,y)=f(t)+i*g(t))\n\n");
1169: printf(" No argument\n");
1170: }
1171:
1172: return;
1173: }
1174: else if ((*s_etat_processus).test_instruction == 'Y')
1175: {
1176: (*s_etat_processus).nombre_arguments = -1;
1177: return;
1178: }
1179:
1180: strcpy((*s_etat_processus).type_trace_eq, "PARAMETRIQUE");
1181:
1182: return;
1183: }
1184:
1185:
1186: /*
1187: ================================================================================
1188: Fonction 'perm'
1189: ================================================================================
1190: Entrées :
1191: --------------------------------------------------------------------------------
1192: Sorties :
1193: --------------------------------------------------------------------------------
1194: Effets de bord : néant
1195: ================================================================================
1196: */
1197:
1198: void
1199: instruction_perm(struct_processus *s_etat_processus)
1200: {
1201: integer8 k;
1202: integer8 n;
1203: integer8 cint_max;
1204:
1205: real8 c;
1206:
1207: struct_objet *s_objet_argument_1;
1208: struct_objet *s_objet_argument_2;
1209: struct_objet *s_objet_resultat;
1210:
1211: unsigned long i;
1212:
1213: (*s_etat_processus).erreur_execution = d_ex;
1214:
1215: if ((*s_etat_processus).affichage_arguments == 'Y')
1216: {
1217: printf("\n PERM ");
1218:
1219: if ((*s_etat_processus).langue == 'F')
1220: {
1221: printf("(permutation)\n\n");
1222: }
1223: else
1224: {
1225: printf("(permutation)\n\n");
1226: }
1227:
1228: printf(" 2: %s\n", d_INT);
1229: printf(" 1: %s\n", d_INT);
1230: printf("-> 1: %s, %s\n", d_INT, d_REL);
1231:
1232: return;
1233: }
1234: else if ((*s_etat_processus).test_instruction == 'Y')
1235: {
1236: (*s_etat_processus).nombre_arguments = 2;
1237: return;
1238: }
1239:
1240: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1241: {
1242: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
1243: {
1244: return;
1245: }
1246: }
1247:
1248: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1249: &s_objet_argument_1) == d_erreur)
1250: {
1251: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1252: return;
1253: }
1254:
1255: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1256: &s_objet_argument_2) == d_erreur)
1257: {
1258: liberation(s_etat_processus, s_objet_argument_1);
1259:
1260: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1261: return;
1262: }
1263:
1264: if (((*s_objet_argument_1).type == INT) &&
1265: ((*s_objet_argument_2).type == INT))
1266: {
1267: n = (*((integer8 *) (*s_objet_argument_2).objet));
1268: k = (*((integer8 *) (*s_objet_argument_1).objet));
1269:
1270: if ((n < 0) || (k < 0) || (k > n))
1271: {
1272: liberation(s_etat_processus, s_objet_argument_1);
1273: liberation(s_etat_processus, s_objet_argument_2);
1274:
1275: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
1276: return;
1277: }
1278:
1279: f90arrangement(&n, &k, &c);
1280:
1281: for(i = 1, cint_max = 1; i < (8 * sizeof(integer8)) - 1; cint_max =
1282: (cint_max << 1) + 1, i++);
1283:
1284: if (c > cint_max)
1285: {
1286: if ((s_objet_resultat = allocation(s_etat_processus, REL))
1287: == NULL)
1288: {
1289: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1290: return;
1291: }
1292:
1293: (*((real8 *) (*s_objet_resultat).objet)) = c;
1294: }
1295: else
1296: {
1297: if ((s_objet_resultat = allocation(s_etat_processus, INT))
1298: == NULL)
1299: {
1300: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1301: return;
1302: }
1303:
1.46 bertrand 1304: if (abs(c - floor(c)) < fabs(ceil(c) - c))
1.1 bertrand 1305: {
1306: (*((integer8 *) (*s_objet_resultat).objet)) =
1307: (integer8) floor(c);
1308: }
1309: else
1310: {
1311: (*((integer8 *) (*s_objet_resultat).objet)) =
1312: 1 + (integer8) floor(c);
1313: }
1314: }
1315: }
1316: else
1317: {
1318: liberation(s_etat_processus, s_objet_argument_1);
1319: liberation(s_etat_processus, s_objet_argument_2);
1320:
1321: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1322: return;
1323: }
1324:
1325: liberation(s_etat_processus, s_objet_argument_1);
1326: liberation(s_etat_processus, s_objet_argument_2);
1327:
1328: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1329: s_objet_resultat) == d_erreur)
1330: {
1331: return;
1332: }
1333:
1334: return;
1335: }
1336:
1337:
1338: /*
1339: ================================================================================
1340: Fonction 'psdev'
1341: ================================================================================
1342: Entrées :
1343: --------------------------------------------------------------------------------
1344: Sorties :
1345: --------------------------------------------------------------------------------
1346: Effets de bord : néant
1347: ================================================================================
1348: */
1349:
1350: void
1351: instruction_psdev(struct_processus *s_etat_processus)
1352: {
1353: struct_objet *s_objet_statistique;
1354: struct_objet *s_objet_resultat;
1355: struct_objet *s_objet_temporaire;
1356:
1.47 bertrand 1357: integer8 nombre_colonnes;
1.1 bertrand 1358:
1359: (*s_etat_processus).erreur_execution = d_ex;
1360:
1361: if ((*s_etat_processus).affichage_arguments == 'Y')
1362: {
1363: printf("\n PSDEV ");
1364:
1365: if ((*s_etat_processus).langue == 'F')
1366: {
1367: printf("(écart-type d'une population)\n\n");
1368: }
1369: else
1370: {
1371: printf("(population standard deviation)\n\n");
1372: }
1373:
1374: printf("-> 1: %s, %s, %s, %s\n", d_INT, d_REL, d_VIN, d_VRL);
1375:
1376: return;
1377: }
1378: else if ((*s_etat_processus).test_instruction == 'Y')
1379: {
1380: (*s_etat_processus).nombre_arguments = -1;
1381: return;
1382: }
1383:
1384: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1385: {
1386: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1387: {
1388: return;
1389: }
1390: }
1391:
1392: /*
1393: * Recherche d'une variable globale référencée par SIGMA
1394: */
1395:
1.19 bertrand 1396: if (recherche_variable_globale(s_etat_processus, ds_sdat) == d_faux)
1.1 bertrand 1397: {
1398: /*
1399: * Aucune variable SIGMA
1400: */
1401:
1402: (*s_etat_processus).erreur_systeme = d_es;
1.19 bertrand 1403:
1404: if ((*s_etat_processus).erreur_execution == d_ex)
1405: {
1406: (*s_etat_processus).erreur_execution = d_ex_absence_observations;
1407: }
1408:
1.1 bertrand 1409: return;
1410: }
1411: else
1412: {
1.19 bertrand 1413: if (((*(*(*s_etat_processus).pointeur_variable_courante).objet)
1414: .type != MIN) && ((*(*(*s_etat_processus)
1415: .pointeur_variable_courante).objet).type != MRL))
1.1 bertrand 1416: {
1.19 bertrand 1417: (*s_etat_processus).erreur_execution =
1418: d_ex_matrice_statistique_invalide;
1.1 bertrand 1419: return;
1420: }
1421:
1.19 bertrand 1422: nombre_colonnes = (*((struct_matrice *) (*(*(*s_etat_processus)
1423: .pointeur_variable_courante).objet).objet)).nombre_colonnes;
1.1 bertrand 1424: }
1425:
1.19 bertrand 1426: s_objet_statistique = (*(*s_etat_processus).pointeur_variable_courante)
1427: .objet;
1.1 bertrand 1428:
1429: if (((*s_objet_statistique).type == MIN) ||
1430: ((*s_objet_statistique).type == MRL))
1431: {
1432: if ((s_objet_resultat = allocation(s_etat_processus, NON)) == NULL)
1433: {
1434: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1435: return;
1436: }
1437:
1438: if (((*s_objet_resultat).objet = ecart_type_statistique(
1.59 bertrand 1439: s_etat_processus,
1.1 bertrand 1440: (struct_matrice *) (*s_objet_statistique).objet, 'P')) == NULL)
1441: {
1442: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1443: return;
1444: }
1445:
1446: if (nombre_colonnes == 1)
1447: {
1448: if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I')
1449: {
1450: (*s_objet_resultat).type = VIN;
1451: s_objet_temporaire = s_objet_resultat;
1452:
1453: if ((s_objet_resultat = allocation(s_etat_processus, INT))
1454: == NULL)
1455: {
1456: (*s_etat_processus).erreur_systeme =
1457: d_es_allocation_memoire;
1458: return;
1459: }
1460:
1461: (*((integer8 *) (*s_objet_resultat).objet)) =
1462: ((integer8 *) (*((struct_vecteur *)
1463: (*s_objet_temporaire).objet)).tableau)[0];
1464:
1465: liberation(s_etat_processus, s_objet_temporaire);
1466: }
1467: else
1468: {
1469: (*s_objet_resultat).type = VRL;
1470: s_objet_temporaire = s_objet_resultat;
1471:
1472: if ((s_objet_resultat = allocation(s_etat_processus, REL))
1473: == NULL)
1474: {
1475: (*s_etat_processus).erreur_systeme =
1476: d_es_allocation_memoire;
1477: return;
1478: }
1479:
1480: (*((real8 *) (*s_objet_resultat).objet)) =
1481: ((real8 *) (*((struct_vecteur *)
1482: (*s_objet_temporaire).objet)).tableau)[0];
1483:
1484: liberation(s_etat_processus, s_objet_temporaire);
1485: }
1486: }
1487: else
1488: {
1489: if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I')
1490: {
1491: (*s_objet_resultat).type = VIN;
1492: }
1493: else
1494: {
1495: (*s_objet_resultat).type = VRL;
1496: }
1497: }
1498:
1499: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1500: s_objet_resultat) == d_erreur)
1501: {
1502: return;
1503: }
1504: }
1505: else
1506: {
1507: (*s_etat_processus).erreur_execution =
1508: d_ex_matrice_statistique_invalide;
1509: return;
1510: }
1511:
1512: return;
1513: }
1514:
1515:
1516: /*
1517: ================================================================================
1518: Fonction 'pvar'
1519: ================================================================================
1520: Entrées :
1521: --------------------------------------------------------------------------------
1522: Sorties :
1523: --------------------------------------------------------------------------------
1524: Effets de bord : néant
1525: ================================================================================
1526: */
1527:
1528: void
1529: instruction_pvar(struct_processus *s_etat_processus)
1530: {
1531: struct_objet *s_objet_statistique;
1532: struct_objet *s_objet_resultat;
1533: struct_objet *s_objet_temporaire;
1534:
1.47 bertrand 1535: integer8 nombre_colonnes;
1.1 bertrand 1536:
1537: (*s_etat_processus).erreur_execution = d_ex;
1538:
1539: if ((*s_etat_processus).affichage_arguments == 'Y')
1540: {
1541: printf("\n PVAR ");
1542:
1543: if ((*s_etat_processus).langue == 'F')
1544: {
1545: printf("(variance d'une population)\n\n");
1546: }
1547: else
1548: {
1549: printf("(population variance)\n\n");
1550: }
1551:
1552: printf("-> 1: %s, %s, %s, %s\n", d_INT, d_REL, d_VIN, d_VRL);
1553:
1554: return;
1555: }
1556: else if ((*s_etat_processus).test_instruction == 'Y')
1557: {
1558: (*s_etat_processus).nombre_arguments = -1;
1559: return;
1560: }
1561:
1562: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1563: {
1564: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1565: {
1566: return;
1567: }
1568: }
1569:
1570: /*
1571: * Recherche d'une variable globale référencée par SIGMA
1572: */
1573:
1.19 bertrand 1574: if (recherche_variable_globale(s_etat_processus, ds_sdat) == d_faux)
1.1 bertrand 1575: {
1576: /*
1577: * Aucune variable SIGMA
1578: */
1579:
1580: (*s_etat_processus).erreur_systeme = d_es;
1.19 bertrand 1581:
1582: if ((*s_etat_processus).erreur_execution == d_ex)
1583: {
1584: (*s_etat_processus).erreur_execution = d_ex_absence_observations;
1585: }
1586:
1.1 bertrand 1587: return;
1588: }
1589: else
1590: {
1.19 bertrand 1591: if (((*(*(*s_etat_processus).pointeur_variable_courante).objet)
1592: .type != MIN) && ((*(*(*s_etat_processus)
1593: .pointeur_variable_courante).objet).type != MRL))
1.1 bertrand 1594: {
1.19 bertrand 1595: (*s_etat_processus).erreur_execution =
1596: d_ex_matrice_statistique_invalide;
1.1 bertrand 1597: return;
1598: }
1599:
1.19 bertrand 1600: nombre_colonnes = (*((struct_matrice *) (*(*(*s_etat_processus)
1601: .pointeur_variable_courante).objet).objet)).nombre_colonnes;
1.1 bertrand 1602: }
1603:
1.19 bertrand 1604: s_objet_statistique = (*(*s_etat_processus).pointeur_variable_courante)
1605: .objet;
1.1 bertrand 1606:
1607: if (((*s_objet_statistique).type == MIN) ||
1608: ((*s_objet_statistique).type == MRL))
1609: {
1610: if ((s_objet_resultat = allocation(s_etat_processus, NON))
1611: == NULL)
1612: {
1613: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1614: return;
1615: }
1616:
1.59 bertrand 1617: if (((*s_objet_resultat).objet = variance_statistique(s_etat_processus,
1618: (struct_matrice *) (*s_objet_statistique).objet, 'P')) == NULL)
1.1 bertrand 1619: {
1620: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1621: return;
1622: }
1623:
1624: if (nombre_colonnes == 1)
1625: {
1626: if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I')
1627: {
1628: (*s_objet_resultat).type = VIN;
1629: s_objet_temporaire = s_objet_resultat;
1630:
1631: if ((s_objet_resultat = allocation(s_etat_processus, INT))
1632: == NULL)
1633: {
1634: (*s_etat_processus).erreur_systeme =
1635: d_es_allocation_memoire;
1636: return;
1637: }
1638:
1639: (*((integer8 *) (*s_objet_resultat).objet)) =
1640: ((integer8 *) (*((struct_vecteur *)
1641: (*s_objet_temporaire).objet)).tableau)[0];
1642:
1643: liberation(s_etat_processus, s_objet_temporaire);
1644: }
1645: else
1646: {
1647: (*s_objet_resultat).type = VRL;
1648: s_objet_temporaire = s_objet_resultat;
1649:
1650: if ((s_objet_resultat = allocation(s_etat_processus, REL))
1651: == NULL)
1652: {
1653: (*s_etat_processus).erreur_systeme =
1654: d_es_allocation_memoire;
1655: return;
1656: }
1657:
1658: (*((real8 *) (*s_objet_resultat).objet)) =
1659: ((real8 *) (*((struct_vecteur *)
1660: (*s_objet_temporaire).objet)).tableau)[0];
1661:
1662: liberation(s_etat_processus, s_objet_temporaire);
1663: }
1664: }
1665: else
1666: {
1667: if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I')
1668: {
1669: (*s_objet_resultat).type = VIN;
1670: }
1671: else
1672: {
1673: (*s_objet_resultat).type = VRL;
1674: }
1675: }
1676:
1677: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1678: s_objet_resultat) == d_erreur)
1679: {
1680: return;
1681: }
1682: }
1683: else
1684: {
1685: (*s_etat_processus).erreur_execution =
1686: d_ex_matrice_statistique_invalide;
1687: return;
1688: }
1689:
1690: return;
1691: }
1692:
1693: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_p4.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src