Annotation of rpl/src/instructions_p4.c, revision 1.30
1.1 bertrand 1: /*
2: ================================================================================
1.29 bertrand 3: RPL/2 (R) version 4.1.3
1.15 bertrand 4: Copyright (C) 1989-2011 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 (pthread_mutex_lock(&((*(*s_etat_processus)
429: .s_liste_variables_partagees).mutex)) != 0)
430: {
431: (*s_etat_processus).erreur_systeme = d_es_processus;
432: return;
433: }
434:
435: if (recherche_variable_partagee(s_etat_processus,
1.19 bertrand 436: (*(*s_etat_processus).pointeur_variable_courante).nom,
437: (*(*s_etat_processus).pointeur_variable_courante)
438: .variable_partagee, (*(*s_etat_processus)
439: .pointeur_variable_courante).origine) == d_faux)
1.1 bertrand 440: {
441: if (pthread_mutex_unlock(&((*(*s_etat_processus)
442: .s_liste_variables_partagees).mutex)) != 0)
443: {
444: (*s_etat_processus).erreur_systeme = d_es_processus;
445: return;
446: }
447:
448: (*s_etat_processus).erreur_systeme = d_es;
449: (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
450:
451: liberation(s_etat_processus, s_objet);
452: return;
453: }
454:
455: formateur_tex(s_etat_processus, (*(*s_etat_processus)
456: .s_liste_variables_partagees).table
457: [(*(*s_etat_processus).s_liste_variables_partagees)
458: .position_variable].objet, 'N');
459:
460: if (pthread_mutex_unlock(&((*(*s_etat_processus)
461: .s_liste_variables_partagees).mutex)) != 0)
462: {
463: (*s_etat_processus).erreur_systeme = d_es_processus;
464: return;
465: }
466: }
467:
468: liberation(s_etat_processus, s_objet);
469:
470: return;
471: }
472:
473:
474: /*
475: ================================================================================
476: Fonction 'prusr'
477: ================================================================================
478: Entrées :
479: --------------------------------------------------------------------------------
480: Sorties :
481: --------------------------------------------------------------------------------
482: Effets de bord : néant
483: ================================================================================
484: */
485:
486: void
487: instruction_prusr(struct_processus *s_etat_processus)
488: {
1.22 bertrand 489: int i;
490: int nb_variables;
491:
1.1 bertrand 492: struct_objet s_objet;
493:
1.22 bertrand 494: struct_tableau_variables *tableau;
495:
1.1 bertrand 496: (*s_etat_processus).erreur_execution = d_ex;
497:
498: if ((*s_etat_processus).affichage_arguments == 'Y')
499: {
500: printf("\n PRUSR ");
501:
502: if ((*s_etat_processus).langue == 'F')
503: {
504: printf("(impression de toutes les variables utilisateur)\n\n");
505: printf(" Aucun argument\n");
506: }
507: else
508: {
509: printf("(print all user variables)\n\n");
510: printf(" No argument\n");
511: }
512:
513: return;
514: }
515: else if ((*s_etat_processus).test_instruction == 'Y')
516: {
517: (*s_etat_processus).nombre_arguments = -1;
518: return;
519: }
520:
521: if (test_cfsf(s_etat_processus, 31) == d_vrai)
522: {
523: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
524: {
525: return;
526: }
527: }
528:
1.22 bertrand 529: nb_variables = nombre_variables(s_etat_processus,
530: (*s_etat_processus).s_arbre_variables);
531:
532: if ((tableau = malloc(nb_variables * sizeof(struct_tableau_variables)))
533: == NULL)
534: {
535: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
536: return;
537: }
538:
539: liste_variables(s_etat_processus, tableau, 0,
540: (*s_etat_processus).s_arbre_variables);
541:
1.1 bertrand 542: s_objet.type = CHN;
543:
1.22 bertrand 544: for(i = 0; i < nb_variables; i++)
1.1 bertrand 545: {
1.22 bertrand 546: if ((s_objet.objet = malloc((strlen(tableau[i].nom) + 64)
547: * sizeof(unsigned char))) == NULL)
1.1 bertrand 548: {
1.22 bertrand 549: free(tableau);
550:
1.1 bertrand 551: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
552: return;
553: }
554:
1.22 bertrand 555: sprintf((unsigned char *) s_objet.objet, "\\\\noindent %s [%lu]\n",
556: tableau[i].nom, tableau[i].niveau);
1.1 bertrand 557:
558: formateur_tex(s_etat_processus, &s_objet, 'N');
559: free(s_objet.objet);
560: }
561:
1.22 bertrand 562: free(tableau);
1.1 bertrand 563: return;
564: }
565:
566:
567: /*
568: ================================================================================
569: Fonction 'prmd'
570: ================================================================================
571: Entrées :
572: --------------------------------------------------------------------------------
573: Sorties :
574: --------------------------------------------------------------------------------
575: Effets de bord : néant
576: ================================================================================
577: */
578:
579: void
580: instruction_prmd(struct_processus *s_etat_processus)
581: {
582: long longueur_utile;
583: long longueur_utile_limite;
584:
585: struct_objet s_objet;
586:
587: unsigned long i;
588: unsigned long j;
589:
590: (*s_etat_processus).erreur_execution = d_ex;
591:
592: if ((*s_etat_processus).affichage_arguments == 'Y')
593: {
594: printf("\n PRMD ");
595:
596: if ((*s_etat_processus).langue == 'F')
597: {
598: printf("(impression de l'état du séquenceur)\n\n");
599: printf(" Aucun argument\n");
600: }
601: else
602: {
603: printf("(print sequencer state)\n\n");
604: printf(" No argument\n");
605: }
606:
607: return;
608: }
609: else if ((*s_etat_processus).test_instruction == 'Y')
610: {
611: (*s_etat_processus).nombre_arguments = -1;
612: return;
613: }
614:
615: if (test_cfsf(s_etat_processus, 31) == d_vrai)
616: {
617: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
618: {
619: return;
620: }
621: }
622:
623: s_objet.type = CHN;
624:
625: if ((s_objet.objet = malloc(128 * sizeof(unsigned char))) == NULL)
626: {
627: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
628: return;
629: }
630:
631: longueur_utile = 0;
632: j = 1;
633:
634: for(i = 53; i <= 56; i++)
635: {
636: longueur_utile += (test_cfsf(s_etat_processus, (unsigned char) i)
637: == d_vrai) ? j : 0;
638: j *= 2;
639: }
640:
641: longueur_utile_limite = 12;
642:
643: if (longueur_utile > longueur_utile_limite)
644: {
645: longueur_utile = longueur_utile_limite;
646: }
647:
648: if ((test_cfsf(s_etat_processus, 49) == d_faux) &&
649: (test_cfsf(s_etat_processus, 50) == d_faux))
650: {
651: if ((*s_etat_processus).langue == 'F')
652: {
653: sprintf((unsigned char *) s_objet.objet,
654: "\\noindent Mode d'affichage numérique: standard\n");
655: }
656: else
657: {
658: sprintf((unsigned char *) s_objet.objet,
659: "\\noindent Numerical mode: standard\n");
660: }
661: }
662: else if ((test_cfsf(s_etat_processus, 49) == d_faux) &&
663: (test_cfsf(s_etat_processus, 50) == d_vrai))
664: {
665: if ((*s_etat_processus).langue == 'F')
666: {
667: sprintf((unsigned char *) s_objet.objet,
668: "\\noindent Mode d'affichage numérique: "
669: "scientifique (%ld)\n", longueur_utile);
670: }
671: else
672: {
673: sprintf((unsigned char *) s_objet.objet,
674: "\\noindent Numerical mode: scientific (%ld)\n",
675: longueur_utile);
676: }
677: }
678: else if ((test_cfsf(s_etat_processus, 49) == d_vrai) &&
679: (test_cfsf(s_etat_processus, 50) == d_faux))
680: {
681: if ((*s_etat_processus).langue == 'F')
682: {
683: sprintf((unsigned char *) s_objet.objet,
684: "\\noindent Mode d'affichage numérique: "
685: "virgule fixe (%ld)\n", longueur_utile);
686: }
687: else
688: {
689: sprintf((unsigned char *) s_objet.objet,
690: "\\noindent Numerical mode: fixed point (%ld)\n", longueur_utile);
691: }
692: }
693: else
694: {
695: if ((*s_etat_processus).langue == 'F')
696: {
697: sprintf((unsigned char *) s_objet.objet,
698: "\\noindent Mode d'affichage numérique: notation ingénieur "
699: "(%ld)\n", longueur_utile);
700: }
701: else
702: {
703: sprintf((unsigned char *) s_objet.objet,
704: "\\noindent Numerical mode: engineer "
705: "(%ld)\n", longueur_utile);
706: }
707: }
708:
709:
710: formateur_tex(s_etat_processus, &s_objet, 'N');
711: free(s_objet.objet);
712:
713: if ((s_objet.objet = malloc(128 * sizeof(unsigned char))) == NULL)
714: {
715: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
716: return;
717: }
718:
719: if ((*s_etat_processus).langue == 'F')
720: {
721: sprintf((unsigned char *) s_objet.objet,
722: "\\noindent \\'Echelle angulaire: %s\n",
723: (test_cfsf(s_etat_processus, 60) == d_faux)
724: ? "degrés" : "radians");
725: }
726: else
727: {
728: sprintf((unsigned char *) s_objet.objet,
729: "\\noindent Angular scale: %s\n",
730: (test_cfsf(s_etat_processus, 60) == d_faux)
731: ? "degrees" : "radians");
732: }
733:
734: formateur_tex(s_etat_processus, &s_objet, 'N');
735: free(s_objet.objet);
736:
737: if ((s_objet.objet = malloc(128 * sizeof(unsigned char))) == NULL)
738: {
739: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
740: return;
741: }
742:
743: if ((test_cfsf(s_etat_processus, 43) == d_faux) &&
744: (test_cfsf(s_etat_processus, 44) == d_faux))
745: {
746: if ((*s_etat_processus).langue == 'F')
747: {
748: sprintf((unsigned char *) s_objet.objet,
749: "\\noindent Base des entiers : décimale\n");
750: }
751: else
752: {
753: sprintf((unsigned char *) s_objet.objet,
754: "\\noindent Integer base: decimal\n");
755: }
756: }
757: else if ((test_cfsf(s_etat_processus, 43) == d_vrai) &&
758: (test_cfsf(s_etat_processus, 44) == d_faux))
759: {
760: if ((*s_etat_processus).langue == 'F')
761: {
762: sprintf((unsigned char *) s_objet.objet,
763: "\\noindent Base des entiers : octale\n");
764: }
765: else
766: {
767: sprintf((unsigned char *) s_objet.objet,
768: "\\noindent Integer base: octal\n");
769: }
770: }
771: else if ((test_cfsf(s_etat_processus, 43) == d_vrai) &&
772: (test_cfsf(s_etat_processus, 44) == d_vrai))
773: {
774: if ((*s_etat_processus).langue == 'F')
775: {
776: sprintf((unsigned char *) s_objet.objet,
777: "\\noindent Base des entiers : hexadécimale\n");
778: }
779: else
780: {
781: sprintf((unsigned char *) s_objet.objet,
782: "\\noindent Integer base: hexadecimal\n");
783: }
784: }
785: else
786: {
787: if ((*s_etat_processus).langue == 'F')
788: {
789: sprintf((unsigned char *) s_objet.objet,
790: "\\noindent Base des entiers : binaire\n");
791: }
792: else
793: {
794: sprintf((unsigned char *) s_objet.objet,
795: "\\noindent Integer base: binary\n");
796: }
797: }
798:
799: formateur_tex(s_etat_processus, &s_objet, 'N');
800: free(s_objet.objet);
801:
802: if ((s_objet.objet = malloc(128 * sizeof(unsigned char))) == NULL)
803: {
804: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
805: return;
806: }
807:
808: if ((*s_etat_processus).langue == 'F')
809: {
810: sprintf((unsigned char *) s_objet.objet,
811: "\\noindent Longueur des entiers : %d bits\n",
812: longueur_entiers_binaires(s_etat_processus));
813: }
814: else
815: {
816: sprintf((unsigned char *) s_objet.objet,
817: "\\noindent Length of integers: %d bits\n",
818: longueur_entiers_binaires(s_etat_processus));
819: }
820:
821: formateur_tex(s_etat_processus, &s_objet, 'N');
822: free(s_objet.objet);
823:
824: if ((s_objet.objet = malloc(128 * sizeof(unsigned char))) == NULL)
825: {
826: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
827: return;
828: }
829:
830: if ((*s_etat_processus).langue == 'F')
831: {
832: sprintf((unsigned char *) s_objet.objet,
833: "\\noindent Séparateur décimal: %s\n",
834: (test_cfsf(s_etat_processus, 48) == d_faux)
835: ? "point" : "virgule");
836: }
837: else
838: {
839: sprintf((unsigned char *) s_objet.objet,
840: "\\noindent Radix: %s\n",
841: (test_cfsf(s_etat_processus, 48) == d_faux)
842: ? "period" : "coma");
843: }
844:
845: formateur_tex(s_etat_processus, &s_objet, 'N');
846: free(s_objet.objet);
847:
848: return;
849: }
850:
851:
852: /*
853: ================================================================================
854: Fonction 'pmin'
855: ================================================================================
856: Entrées :
857: --------------------------------------------------------------------------------
858: Sorties :
859: --------------------------------------------------------------------------------
860: Effets de bord : néant
861: ================================================================================
862: */
863:
864: void
865: instruction_pmin(struct_processus *s_etat_processus)
866: {
867: struct_objet *s_objet;
868:
869: (*s_etat_processus).erreur_execution = d_ex;
870:
871: if ((*s_etat_processus).affichage_arguments == 'Y')
872: {
873: printf("\n PMIN ");
874:
875: if ((*s_etat_processus).langue == 'F')
876: {
877: printf("(minima d'un graphique 2D)\n\n");
878: }
879: else
880: {
881: printf("(2D-graphic minima)\n\n");
882: }
883:
884: printf(" 1: %s\n", d_CPL);
885:
886: return;
887: }
888: else if ((*s_etat_processus).test_instruction == 'Y')
889: {
890: (*s_etat_processus).nombre_arguments = -1;
891: return;
892: }
893:
894: if (test_cfsf(s_etat_processus, 31) == d_vrai)
895: {
896: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
897: {
898: return;
899: }
900: }
901:
902: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
903: &s_objet) == d_erreur)
904: {
905: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
906: return;
907: }
908:
909: if ((*s_objet).type == CPL)
910: {
911: if ((*s_etat_processus).systeme_axes == 0)
912: {
913: (*s_etat_processus).x_min = (*((complex16 *) (*s_objet).objet))
914: .partie_reelle;
915: (*s_etat_processus).y_min = (*((complex16 *) (*s_objet).objet))
916: .partie_imaginaire;
917: }
918: else
919: {
920: (*s_etat_processus).x2_min = (*((complex16 *) (*s_objet).objet))
921: .partie_reelle;
922: (*s_etat_processus).y2_min = (*((complex16 *) (*s_objet).objet))
923: .partie_imaginaire;
924: }
925: }
926: else
927: {
928: liberation(s_etat_processus, s_objet);
929:
930: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
931: return;
932: }
933:
934: liberation(s_etat_processus, s_objet);
935:
936: if (test_cfsf(s_etat_processus, 52) == d_faux)
937: {
938: if ((*s_etat_processus).fichiers_graphiques != NULL)
939: {
940: appel_gnuplot(s_etat_processus, 'N');
941: }
942: }
943:
944: return;
945: }
946:
947:
948: /*
949: ================================================================================
950: Fonction 'pmax'
951: ================================================================================
952: Entrées :
953: --------------------------------------------------------------------------------
954: Sorties :
955: --------------------------------------------------------------------------------
956: Effets de bord : néant
957: ================================================================================
958: */
959:
960: void
961: instruction_pmax(struct_processus *s_etat_processus)
962: {
963: struct_objet *s_objet;
964:
965: (*s_etat_processus).erreur_execution = d_ex;
966:
967: if ((*s_etat_processus).affichage_arguments == 'Y')
968: {
969: printf("\n PMAX ");
970:
971: if ((*s_etat_processus).langue == 'F')
972: {
973: printf("(maxima d'un graphique 2D)\n\n");
974: }
975: else
976: {
977: printf("(2D-graphic maxima)\n\n");
978: }
979:
980: printf(" 1: %s\n", d_CPL);
981:
982: return;
983: }
984: else if ((*s_etat_processus).test_instruction == 'Y')
985: {
986: (*s_etat_processus).nombre_arguments = -1;
987: return;
988: }
989:
990: if (test_cfsf(s_etat_processus, 31) == d_vrai)
991: {
992: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
993: {
994: return;
995: }
996: }
997:
998: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
999: &s_objet) == d_erreur)
1000: {
1001: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1002: return;
1003: }
1004:
1005: if ((*s_objet).type == CPL)
1006: {
1007: if ((*s_etat_processus).systeme_axes == 0)
1008: {
1009: (*s_etat_processus).x_max = (*((complex16 *) (*s_objet).objet))
1010: .partie_reelle;
1011: (*s_etat_processus).y_max = (*((complex16 *) (*s_objet).objet))
1012: .partie_imaginaire;
1013: }
1014: else
1015: {
1016: (*s_etat_processus).x2_max = (*((complex16 *) (*s_objet).objet))
1017: .partie_reelle;
1018: (*s_etat_processus).y2_max = (*((complex16 *) (*s_objet).objet))
1019: .partie_imaginaire;
1020: }
1021: }
1022: else
1023: {
1024: liberation(s_etat_processus, s_objet);
1025:
1026: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1027: return;
1028: }
1029:
1030: liberation(s_etat_processus, s_objet);
1031:
1032: if (test_cfsf(s_etat_processus, 52) == d_faux)
1033: {
1034: if ((*s_etat_processus).fichiers_graphiques != NULL)
1035: {
1036: appel_gnuplot(s_etat_processus, 'N');
1037: }
1038: }
1039:
1040: return;
1041: }
1042:
1043:
1044: /*
1045: ================================================================================
1046: Fonction 'persist'
1047: ================================================================================
1048: Entrées :
1049: --------------------------------------------------------------------------------
1050: Sorties :
1051: --------------------------------------------------------------------------------
1052: Effets de bord : néant
1053: ================================================================================
1054: */
1055:
1056: void
1057: instruction_persist(struct_processus *s_etat_processus)
1058: {
1059: (*s_etat_processus).erreur_execution = d_ex;
1060:
1061: if ((*s_etat_processus).affichage_arguments == 'Y')
1062: {
1063: printf("\n PERSIST ");
1064:
1065: if ((*s_etat_processus).langue == 'F')
1066: {
1067: printf("(détachement d'un graphique)\n\n");
1068: printf(" Aucun argument\n");
1069: }
1070: else
1071: {
1072: printf("(spawn a graphic output)\n\n");
1073: printf(" No argument\n");
1074: }
1075:
1076: return;
1077: }
1078: else if ((*s_etat_processus).test_instruction == 'Y')
1079: {
1080: (*s_etat_processus).nombre_arguments = -1;
1081: return;
1082: }
1083:
1084: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1085: {
1086: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1087: {
1088: return;
1089: }
1090: }
1091:
1092: appel_gnuplot(s_etat_processus, 'E');
1093:
1094: return;
1095: }
1096:
1097:
1098: /*
1099: ================================================================================
1100: Fonction 'polar' (passe en mode d'affichage r=f(t))
1101: ================================================================================
1102: Entrées : structure processus
1103: --------------------------------------------------------------------------------
1104: Sorties :
1105: --------------------------------------------------------------------------------
1106: Effets de bord : néant
1107: ================================================================================
1108: */
1109:
1110: void
1111: instruction_polar(struct_processus *s_etat_processus)
1112: {
1113: (*s_etat_processus).erreur_execution = d_ex;
1114:
1115: if ((*s_etat_processus).affichage_arguments == 'Y')
1116: {
1117: printf("\n POLAR ");
1118:
1119: if ((*s_etat_processus).langue == 'F')
1120: {
1121: printf("(tracé théta=f(r))\n\n");
1122: printf(" Aucun argument\n");
1123: }
1124: else
1125: {
1126: printf("(plot theta=f(r))\n\n");
1127: printf(" No argument\n");
1128: }
1129:
1130: return;
1131: }
1132: else if ((*s_etat_processus).test_instruction == 'Y')
1133: {
1134: (*s_etat_processus).nombre_arguments = -1;
1135: return;
1136: }
1137:
1138: strcpy((*s_etat_processus).type_trace_eq, "POLAIRE");
1139:
1140: return;
1141: }
1142:
1143:
1144: /*
1145: ================================================================================
1146: Fonction 'parametric' (passe en mode d'affichage r=f(t))
1147: ================================================================================
1148: Entrées : structure processus
1149: --------------------------------------------------------------------------------
1150: Sorties :
1151: --------------------------------------------------------------------------------
1152: Effets de bord : néant
1153: ================================================================================
1154: */
1155:
1156: void
1157: instruction_parametric(struct_processus *s_etat_processus)
1158: {
1159: (*s_etat_processus).erreur_execution = d_ex;
1160:
1161: if ((*s_etat_processus).affichage_arguments == 'Y')
1162: {
1163: printf("\n PARAMETRIC ");
1164:
1165: if ((*s_etat_processus).langue == 'F')
1166: {
1167: printf("(tracé (x,y)=f(t)+i*g(t))\n\n");
1168: printf(" Aucun argument\n");
1169: }
1170: else
1171: {
1172: printf("(plot (x,y)=f(t)+i*g(t))\n\n");
1173: printf(" No argument\n");
1174: }
1175:
1176: return;
1177: }
1178: else if ((*s_etat_processus).test_instruction == 'Y')
1179: {
1180: (*s_etat_processus).nombre_arguments = -1;
1181: return;
1182: }
1183:
1184: strcpy((*s_etat_processus).type_trace_eq, "PARAMETRIQUE");
1185:
1186: return;
1187: }
1188:
1189:
1190: /*
1191: ================================================================================
1192: Fonction 'perm'
1193: ================================================================================
1194: Entrées :
1195: --------------------------------------------------------------------------------
1196: Sorties :
1197: --------------------------------------------------------------------------------
1198: Effets de bord : néant
1199: ================================================================================
1200: */
1201:
1202: void
1203: instruction_perm(struct_processus *s_etat_processus)
1204: {
1205: integer8 k;
1206: integer8 n;
1207: integer8 cint_max;
1208:
1209: real8 c;
1210:
1211: struct_objet *s_objet_argument_1;
1212: struct_objet *s_objet_argument_2;
1213: struct_objet *s_objet_resultat;
1214:
1215: unsigned long i;
1216:
1217: (*s_etat_processus).erreur_execution = d_ex;
1218:
1219: if ((*s_etat_processus).affichage_arguments == 'Y')
1220: {
1221: printf("\n PERM ");
1222:
1223: if ((*s_etat_processus).langue == 'F')
1224: {
1225: printf("(permutation)\n\n");
1226: }
1227: else
1228: {
1229: printf("(permutation)\n\n");
1230: }
1231:
1232: printf(" 2: %s\n", d_INT);
1233: printf(" 1: %s\n", d_INT);
1234: printf("-> 1: %s, %s\n", d_INT, d_REL);
1235:
1236: return;
1237: }
1238: else if ((*s_etat_processus).test_instruction == 'Y')
1239: {
1240: (*s_etat_processus).nombre_arguments = 2;
1241: return;
1242: }
1243:
1244: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1245: {
1246: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
1247: {
1248: return;
1249: }
1250: }
1251:
1252: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1253: &s_objet_argument_1) == d_erreur)
1254: {
1255: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1256: return;
1257: }
1258:
1259: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1260: &s_objet_argument_2) == d_erreur)
1261: {
1262: liberation(s_etat_processus, s_objet_argument_1);
1263:
1264: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1265: return;
1266: }
1267:
1268: if (((*s_objet_argument_1).type == INT) &&
1269: ((*s_objet_argument_2).type == INT))
1270: {
1271: n = (*((integer8 *) (*s_objet_argument_2).objet));
1272: k = (*((integer8 *) (*s_objet_argument_1).objet));
1273:
1274: if ((n < 0) || (k < 0) || (k > n))
1275: {
1276: liberation(s_etat_processus, s_objet_argument_1);
1277: liberation(s_etat_processus, s_objet_argument_2);
1278:
1279: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
1280: return;
1281: }
1282:
1283: f90arrangement(&n, &k, &c);
1284:
1285: for(i = 1, cint_max = 1; i < (8 * sizeof(integer8)) - 1; cint_max =
1286: (cint_max << 1) + 1, i++);
1287:
1288: if (c > cint_max)
1289: {
1290: if ((s_objet_resultat = allocation(s_etat_processus, REL))
1291: == NULL)
1292: {
1293: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1294: return;
1295: }
1296:
1297: (*((real8 *) (*s_objet_resultat).objet)) = c;
1298: }
1299: else
1300: {
1301: if ((s_objet_resultat = allocation(s_etat_processus, INT))
1302: == NULL)
1303: {
1304: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1305: return;
1306: }
1307:
1308: if (fabs(c - floor(c)) < fabs(ceil(c) - c))
1309: {
1310: (*((integer8 *) (*s_objet_resultat).objet)) =
1311: (integer8) floor(c);
1312: }
1313: else
1314: {
1315: (*((integer8 *) (*s_objet_resultat).objet)) =
1316: 1 + (integer8) floor(c);
1317: }
1318: }
1319: }
1320: else
1321: {
1322: liberation(s_etat_processus, s_objet_argument_1);
1323: liberation(s_etat_processus, s_objet_argument_2);
1324:
1325: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1326: return;
1327: }
1328:
1329: liberation(s_etat_processus, s_objet_argument_1);
1330: liberation(s_etat_processus, s_objet_argument_2);
1331:
1332: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1333: s_objet_resultat) == d_erreur)
1334: {
1335: return;
1336: }
1337:
1338: return;
1339: }
1340:
1341:
1342: /*
1343: ================================================================================
1344: Fonction 'psdev'
1345: ================================================================================
1346: Entrées :
1347: --------------------------------------------------------------------------------
1348: Sorties :
1349: --------------------------------------------------------------------------------
1350: Effets de bord : néant
1351: ================================================================================
1352: */
1353:
1354: void
1355: instruction_psdev(struct_processus *s_etat_processus)
1356: {
1357: struct_objet *s_objet_statistique;
1358: struct_objet *s_objet_resultat;
1359: struct_objet *s_objet_temporaire;
1360:
1361: unsigned long nombre_colonnes;
1362:
1363: (*s_etat_processus).erreur_execution = d_ex;
1364:
1365: if ((*s_etat_processus).affichage_arguments == 'Y')
1366: {
1367: printf("\n PSDEV ");
1368:
1369: if ((*s_etat_processus).langue == 'F')
1370: {
1371: printf("(écart-type d'une population)\n\n");
1372: }
1373: else
1374: {
1375: printf("(population standard deviation)\n\n");
1376: }
1377:
1378: printf("-> 1: %s, %s, %s, %s\n", d_INT, d_REL, d_VIN, d_VRL);
1379:
1380: return;
1381: }
1382: else if ((*s_etat_processus).test_instruction == 'Y')
1383: {
1384: (*s_etat_processus).nombre_arguments = -1;
1385: return;
1386: }
1387:
1388: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1389: {
1390: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1391: {
1392: return;
1393: }
1394: }
1395:
1396: /*
1397: * Recherche d'une variable globale référencée par SIGMA
1398: */
1399:
1.19 bertrand 1400: if (recherche_variable_globale(s_etat_processus, ds_sdat) == d_faux)
1.1 bertrand 1401: {
1402: /*
1403: * Aucune variable SIGMA
1404: */
1405:
1406: (*s_etat_processus).erreur_systeme = d_es;
1.19 bertrand 1407:
1408: if ((*s_etat_processus).erreur_execution == d_ex)
1409: {
1410: (*s_etat_processus).erreur_execution = d_ex_absence_observations;
1411: }
1412:
1.1 bertrand 1413: return;
1414: }
1415: else
1416: {
1.19 bertrand 1417: if (((*(*(*s_etat_processus).pointeur_variable_courante).objet)
1418: .type != MIN) && ((*(*(*s_etat_processus)
1419: .pointeur_variable_courante).objet).type != MRL))
1.1 bertrand 1420: {
1.19 bertrand 1421: (*s_etat_processus).erreur_execution =
1422: d_ex_matrice_statistique_invalide;
1.1 bertrand 1423: return;
1424: }
1425:
1.19 bertrand 1426: nombre_colonnes = (*((struct_matrice *) (*(*(*s_etat_processus)
1427: .pointeur_variable_courante).objet).objet)).nombre_colonnes;
1.1 bertrand 1428: }
1429:
1.19 bertrand 1430: s_objet_statistique = (*(*s_etat_processus).pointeur_variable_courante)
1431: .objet;
1.1 bertrand 1432:
1433: if (((*s_objet_statistique).type == MIN) ||
1434: ((*s_objet_statistique).type == MRL))
1435: {
1436: if ((s_objet_resultat = allocation(s_etat_processus, NON)) == NULL)
1437: {
1438: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1439: return;
1440: }
1441:
1442: if (((*s_objet_resultat).objet = ecart_type_statistique(
1443: (struct_matrice *) (*s_objet_statistique).objet, 'P')) == NULL)
1444: {
1445: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1446: return;
1447: }
1448:
1449: if (nombre_colonnes == 1)
1450: {
1451: if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I')
1452: {
1453: (*s_objet_resultat).type = VIN;
1454: s_objet_temporaire = s_objet_resultat;
1455:
1456: if ((s_objet_resultat = allocation(s_etat_processus, INT))
1457: == NULL)
1458: {
1459: (*s_etat_processus).erreur_systeme =
1460: d_es_allocation_memoire;
1461: return;
1462: }
1463:
1464: (*((integer8 *) (*s_objet_resultat).objet)) =
1465: ((integer8 *) (*((struct_vecteur *)
1466: (*s_objet_temporaire).objet)).tableau)[0];
1467:
1468: liberation(s_etat_processus, s_objet_temporaire);
1469: }
1470: else
1471: {
1472: (*s_objet_resultat).type = VRL;
1473: s_objet_temporaire = s_objet_resultat;
1474:
1475: if ((s_objet_resultat = allocation(s_etat_processus, REL))
1476: == NULL)
1477: {
1478: (*s_etat_processus).erreur_systeme =
1479: d_es_allocation_memoire;
1480: return;
1481: }
1482:
1483: (*((real8 *) (*s_objet_resultat).objet)) =
1484: ((real8 *) (*((struct_vecteur *)
1485: (*s_objet_temporaire).objet)).tableau)[0];
1486:
1487: liberation(s_etat_processus, s_objet_temporaire);
1488: }
1489: }
1490: else
1491: {
1492: if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I')
1493: {
1494: (*s_objet_resultat).type = VIN;
1495: }
1496: else
1497: {
1498: (*s_objet_resultat).type = VRL;
1499: }
1500: }
1501:
1502: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1503: s_objet_resultat) == d_erreur)
1504: {
1505: return;
1506: }
1507: }
1508: else
1509: {
1510: (*s_etat_processus).erreur_execution =
1511: d_ex_matrice_statistique_invalide;
1512: return;
1513: }
1514:
1515: return;
1516: }
1517:
1518:
1519: /*
1520: ================================================================================
1521: Fonction 'pvar'
1522: ================================================================================
1523: Entrées :
1524: --------------------------------------------------------------------------------
1525: Sorties :
1526: --------------------------------------------------------------------------------
1527: Effets de bord : néant
1528: ================================================================================
1529: */
1530:
1531: void
1532: instruction_pvar(struct_processus *s_etat_processus)
1533: {
1534: struct_objet *s_objet_statistique;
1535: struct_objet *s_objet_resultat;
1536: struct_objet *s_objet_temporaire;
1537:
1538: unsigned long nombre_colonnes;
1539:
1540: (*s_etat_processus).erreur_execution = d_ex;
1541:
1542: if ((*s_etat_processus).affichage_arguments == 'Y')
1543: {
1544: printf("\n PVAR ");
1545:
1546: if ((*s_etat_processus).langue == 'F')
1547: {
1548: printf("(variance d'une population)\n\n");
1549: }
1550: else
1551: {
1552: printf("(population variance)\n\n");
1553: }
1554:
1555: printf("-> 1: %s, %s, %s, %s\n", d_INT, d_REL, d_VIN, d_VRL);
1556:
1557: return;
1558: }
1559: else if ((*s_etat_processus).test_instruction == 'Y')
1560: {
1561: (*s_etat_processus).nombre_arguments = -1;
1562: return;
1563: }
1564:
1565: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1566: {
1567: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1568: {
1569: return;
1570: }
1571: }
1572:
1573: /*
1574: * Recherche d'une variable globale référencée par SIGMA
1575: */
1576:
1.19 bertrand 1577: if (recherche_variable_globale(s_etat_processus, ds_sdat) == d_faux)
1.1 bertrand 1578: {
1579: /*
1580: * Aucune variable SIGMA
1581: */
1582:
1583: (*s_etat_processus).erreur_systeme = d_es;
1.19 bertrand 1584:
1585: if ((*s_etat_processus).erreur_execution == d_ex)
1586: {
1587: (*s_etat_processus).erreur_execution = d_ex_absence_observations;
1588: }
1589:
1.1 bertrand 1590: return;
1591: }
1592: else
1593: {
1.19 bertrand 1594: if (((*(*(*s_etat_processus).pointeur_variable_courante).objet)
1595: .type != MIN) && ((*(*(*s_etat_processus)
1596: .pointeur_variable_courante).objet).type != MRL))
1.1 bertrand 1597: {
1.19 bertrand 1598: (*s_etat_processus).erreur_execution =
1599: d_ex_matrice_statistique_invalide;
1.1 bertrand 1600: return;
1601: }
1602:
1.19 bertrand 1603: nombre_colonnes = (*((struct_matrice *) (*(*(*s_etat_processus)
1604: .pointeur_variable_courante).objet).objet)).nombre_colonnes;
1.1 bertrand 1605: }
1606:
1.19 bertrand 1607: s_objet_statistique = (*(*s_etat_processus).pointeur_variable_courante)
1608: .objet;
1.1 bertrand 1609:
1610: if (((*s_objet_statistique).type == MIN) ||
1611: ((*s_objet_statistique).type == MRL))
1612: {
1613: if ((s_objet_resultat = allocation(s_etat_processus, NON))
1614: == NULL)
1615: {
1616: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1617: return;
1618: }
1619:
1620: if (((*s_objet_resultat).objet = variance_statistique((struct_matrice *)
1621: (*s_objet_statistique).objet, 'P')) == NULL)
1622: {
1623: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1624: return;
1625: }
1626:
1627: if (nombre_colonnes == 1)
1628: {
1629: if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I')
1630: {
1631: (*s_objet_resultat).type = VIN;
1632: s_objet_temporaire = s_objet_resultat;
1633:
1634: if ((s_objet_resultat = allocation(s_etat_processus, INT))
1635: == NULL)
1636: {
1637: (*s_etat_processus).erreur_systeme =
1638: d_es_allocation_memoire;
1639: return;
1640: }
1641:
1642: (*((integer8 *) (*s_objet_resultat).objet)) =
1643: ((integer8 *) (*((struct_vecteur *)
1644: (*s_objet_temporaire).objet)).tableau)[0];
1645:
1646: liberation(s_etat_processus, s_objet_temporaire);
1647: }
1648: else
1649: {
1650: (*s_objet_resultat).type = VRL;
1651: s_objet_temporaire = s_objet_resultat;
1652:
1653: if ((s_objet_resultat = allocation(s_etat_processus, REL))
1654: == NULL)
1655: {
1656: (*s_etat_processus).erreur_systeme =
1657: d_es_allocation_memoire;
1658: return;
1659: }
1660:
1661: (*((real8 *) (*s_objet_resultat).objet)) =
1662: ((real8 *) (*((struct_vecteur *)
1663: (*s_objet_temporaire).objet)).tableau)[0];
1664:
1665: liberation(s_etat_processus, s_objet_temporaire);
1666: }
1667: }
1668: else
1669: {
1670: if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I')
1671: {
1672: (*s_objet_resultat).type = VIN;
1673: }
1674: else
1675: {
1676: (*s_objet_resultat).type = VRL;
1677: }
1678: }
1679:
1680: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1681: s_objet_resultat) == d_erreur)
1682: {
1683: return;
1684: }
1685: }
1686: else
1687: {
1688: (*s_etat_processus).erreur_execution =
1689: d_ex_matrice_statistique_invalide;
1690: return;
1691: }
1692:
1693: return;
1694: }
1695:
1696: // 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