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