Annotation of rpl/src/instructions_p4.c, revision 1.16.2.3
1.1 bertrand 1: /*
2: ================================================================================
1.16.2.3! bertrand 3: RPL/2 (R) version 4.0.24
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:
257: impression_pile(s_etat_processus, (*s_etat_processus).l_base_pile,
258: 'E', 1);
259: return;
260: }
261:
262:
263: /*
264: ================================================================================
265: Fonction 'prstc'
266: ================================================================================
267: Entrées :
268: --------------------------------------------------------------------------------
269: Sorties :
270: --------------------------------------------------------------------------------
271: Effets de bord : néant
272: ================================================================================
273: */
274:
275: void
276: instruction_prstc(struct_processus *s_etat_processus)
277: {
278: (*s_etat_processus).erreur_execution = d_ex;
279:
280: if ((*s_etat_processus).affichage_arguments == 'Y')
281: {
282: printf("\n PRSTC ");
283:
284: if ((*s_etat_processus).langue == 'F')
285: {
286: printf("(imprime la pile opérationnelle en mode compact)\n\n");
287: }
288: else
289: {
290: printf("(print stack in compact mode)\n\n");
291: }
292:
293: printf(" n: %s, %s, %s, %s, %s, %s,\n"
294: " %s, %s, %s, %s, %s,\n"
295: " %s, %s, %s, %s, %s,\n"
296: " %s\n",
297: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
298: d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
299: printf(" ...\n");
300: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
301: " %s, %s, %s, %s, %s,\n"
302: " %s, %s, %s, %s, %s,\n"
303: " %s\n",
304: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
305: d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
306: printf("-> n: %s, %s, %s, %s, %s, %s,\n"
307: " %s, %s, %s, %s, %s,\n"
308: " %s, %s, %s, %s, %s,\n"
309: " %s\n",
310: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
311: d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
312: printf(" ...\n");
313: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
314: " %s, %s, %s, %s, %s,\n"
315: " %s, %s, %s, %s, %s,\n"
316: " %s\n",
317: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
318: d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
319:
320: return;
321: }
322: else if ((*s_etat_processus).test_instruction == 'Y')
323: {
324: (*s_etat_processus).nombre_arguments = -1;
325: return;
326: }
327:
328: if (test_cfsf(s_etat_processus, 31) == d_vrai)
329: {
330: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
331: {
332: return;
333: }
334: }
335:
336: impression_pile(s_etat_processus, (*s_etat_processus).l_base_pile,
337: 'C', 1);
338: return;
339: }
340:
341:
342: /*
343: ================================================================================
344: Fonction 'prvar'
345: ================================================================================
346: Entrées :
347: --------------------------------------------------------------------------------
348: Sorties :
349: --------------------------------------------------------------------------------
350: Effets de bord : néant
351: ================================================================================
352: */
353:
354: void
355: instruction_prvar(struct_processus *s_etat_processus)
356: {
357: struct_objet *s_objet;
358:
359: (*s_etat_processus).erreur_execution = d_ex;
360:
361: if ((*s_etat_processus).affichage_arguments == 'Y')
362: {
363: printf("\n PRVAR ");
364:
365: if ((*s_etat_processus).langue == 'F')
366: {
367: printf("(imprime le contenu d'une variable)\n\n");
368: }
369: else
370: {
371: printf("(print variable)\n\n");
372: }
373:
374: printf(" 1: %s\n", d_NOM);
375:
376: return;
377: }
378: else if ((*s_etat_processus).test_instruction == 'Y')
379: {
380: (*s_etat_processus).nombre_arguments = -1;
381: return;
382: }
383:
384: if (test_cfsf(s_etat_processus, 31) == d_vrai)
385: {
386: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
387: {
388: return;
389: }
390: }
391:
392: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
393: &s_objet) == d_erreur)
394: {
395: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
396: return;
397: }
398:
399: if ((*s_objet).type != NOM)
400: {
401: liberation(s_etat_processus, s_objet);
402:
403: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
404: return;
405: }
406:
407: if (recherche_variable(s_etat_processus, (*((struct_nom *)
408: (*s_objet).objet)).nom) == d_faux)
409: {
410: (*s_etat_processus).erreur_systeme = d_es;
411: (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
412:
413: liberation(s_etat_processus, s_objet);
414: return;
415: }
416:
417: if ((*s_etat_processus).s_liste_variables[(*s_etat_processus)
418: .position_variable_courante].objet != NULL)
419: {
420: formateur_tex(s_etat_processus, (*s_etat_processus).s_liste_variables
421: [(*s_etat_processus).position_variable_courante].objet, 'N');
422: }
423: else
424: {
425: if (pthread_mutex_lock(&((*(*s_etat_processus)
426: .s_liste_variables_partagees).mutex)) != 0)
427: {
428: (*s_etat_processus).erreur_systeme = d_es_processus;
429: return;
430: }
431:
432: if (recherche_variable_partagee(s_etat_processus,
433: (*s_etat_processus).s_liste_variables
434: [(*s_etat_processus).position_variable_courante].nom,
435: (*s_etat_processus).s_liste_variables
436: [(*s_etat_processus).position_variable_courante]
437: .variable_partagee, (*s_etat_processus).s_liste_variables
438: [(*s_etat_processus).position_variable_courante].origine)
439: == d_faux)
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: {
489: struct_objet s_objet;
490:
491: unsigned long i;
492:
493: (*s_etat_processus).erreur_execution = d_ex;
494:
495: if ((*s_etat_processus).affichage_arguments == 'Y')
496: {
497: printf("\n PRUSR ");
498:
499: if ((*s_etat_processus).langue == 'F')
500: {
501: printf("(impression de toutes les variables utilisateur)\n\n");
502: printf(" Aucun argument\n");
503: }
504: else
505: {
506: printf("(print all user variables)\n\n");
507: printf(" No argument\n");
508: }
509:
510: return;
511: }
512: else if ((*s_etat_processus).test_instruction == 'Y')
513: {
514: (*s_etat_processus).nombre_arguments = -1;
515: return;
516: }
517:
518: if (test_cfsf(s_etat_processus, 31) == d_vrai)
519: {
520: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
521: {
522: return;
523: }
524: }
525:
526: s_objet.type = CHN;
527:
528: for(i = 0; i < (*s_etat_processus).nombre_variables; i++)
529: {
530: if ((s_objet.objet = malloc((strlen((*s_etat_processus)
531: .s_liste_variables[i].nom) + 64) * sizeof(unsigned char)))
532: == NULL)
533: {
534: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
535: return;
536: }
537:
538: sprintf((unsigned char *) s_objet.objet, "\\noindent %s [%lu]\n",
539: (*s_etat_processus).s_liste_variables[i].nom,
540: (*s_etat_processus).s_liste_variables[i].niveau);
541:
542: formateur_tex(s_etat_processus, &s_objet, 'N');
543: free(s_objet.objet);
544: }
545:
546: return;
547: }
548:
549:
550: /*
551: ================================================================================
552: Fonction 'prmd'
553: ================================================================================
554: Entrées :
555: --------------------------------------------------------------------------------
556: Sorties :
557: --------------------------------------------------------------------------------
558: Effets de bord : néant
559: ================================================================================
560: */
561:
562: void
563: instruction_prmd(struct_processus *s_etat_processus)
564: {
565: long longueur_utile;
566: long longueur_utile_limite;
567:
568: struct_objet s_objet;
569:
570: unsigned long i;
571: unsigned long j;
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:
1291: if (fabs(c - floor(c)) < fabs(ceil(c) - c))
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: logical1 presence_variable;
1341:
1342: long i;
1343:
1344: struct_objet *s_objet_statistique;
1345: struct_objet *s_objet_resultat;
1346: struct_objet *s_objet_temporaire;
1347:
1348: unsigned long nombre_colonnes;
1349:
1350: (*s_etat_processus).erreur_execution = d_ex;
1351:
1352: if ((*s_etat_processus).affichage_arguments == 'Y')
1353: {
1354: printf("\n PSDEV ");
1355:
1356: if ((*s_etat_processus).langue == 'F')
1357: {
1358: printf("(écart-type d'une population)\n\n");
1359: }
1360: else
1361: {
1362: printf("(population standard deviation)\n\n");
1363: }
1364:
1365: printf("-> 1: %s, %s, %s, %s\n", d_INT, d_REL, d_VIN, d_VRL);
1366:
1367: return;
1368: }
1369: else if ((*s_etat_processus).test_instruction == 'Y')
1370: {
1371: (*s_etat_processus).nombre_arguments = -1;
1372: return;
1373: }
1374:
1375: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1376: {
1377: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1378: {
1379: return;
1380: }
1381: }
1382:
1383: /*
1384: * Recherche d'une variable globale référencée par SIGMA
1385: */
1386:
1387: if (recherche_variable(s_etat_processus, ds_sdat) == d_faux)
1388: {
1389: /*
1390: * Aucune variable SIGMA
1391: */
1392:
1393: (*s_etat_processus).erreur_systeme = d_es;
1394: (*s_etat_processus).erreur_execution = d_ex_absence_observations;
1395: return;
1396: }
1397: else
1398: {
1399: /*
1400: * Il existe une variable locale SIGMA. Reste à vérifier l'existence
1401: * d'une variable SIGMA globale...
1402: */
1403:
1404: i = (*s_etat_processus).position_variable_courante;
1405: presence_variable = d_faux;
1406:
1407: while(i >= 0)
1408: {
1409: if ((strcmp((*s_etat_processus).s_liste_variables[i].nom,
1410: ds_sdat) == 0) && ((*s_etat_processus)
1411: .s_liste_variables[i].niveau == 1))
1412: {
1413: presence_variable = d_vrai;
1414: break;
1415: }
1416:
1417: i--;
1418: }
1419:
1420: if (presence_variable == d_faux)
1421: {
1422: (*s_etat_processus).erreur_execution = d_ex_absence_observations;
1423: return;
1424: }
1425: else
1426: {
1427: (*s_etat_processus).position_variable_courante = i;
1428:
1429: if (((*s_etat_processus).s_liste_variables[i]).objet == NULL)
1430: {
1431: (*s_etat_processus).erreur_execution =
1432: d_ex_variable_partagee;
1433: return;
1434: }
1435:
1436: if (((*((*s_etat_processus).s_liste_variables
1437: [(*s_etat_processus).position_variable_courante].objet))
1438: .type != MIN) && ((*((*s_etat_processus)
1439: .s_liste_variables[(*s_etat_processus)
1440: .position_variable_courante].objet)).type != MRL))
1441: {
1442: (*s_etat_processus).erreur_execution =
1443: d_ex_matrice_statistique_invalide;
1444: return;
1445: }
1446:
1447: nombre_colonnes = (*((struct_matrice *) (*((*s_etat_processus)
1448: .s_liste_variables[(*s_etat_processus)
1449: .position_variable_courante].objet)).objet))
1450: .nombre_colonnes;
1451: }
1452: }
1453:
1454: s_objet_statistique = ((*s_etat_processus).s_liste_variables
1455: [(*s_etat_processus).position_variable_courante]).objet;
1456:
1457: if (((*s_objet_statistique).type == MIN) ||
1458: ((*s_objet_statistique).type == MRL))
1459: {
1460: if ((s_objet_resultat = allocation(s_etat_processus, NON)) == NULL)
1461: {
1462: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1463: return;
1464: }
1465:
1466: if (((*s_objet_resultat).objet = ecart_type_statistique(
1467: (struct_matrice *) (*s_objet_statistique).objet, 'P')) == NULL)
1468: {
1469: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1470: return;
1471: }
1472:
1473: if (nombre_colonnes == 1)
1474: {
1475: if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I')
1476: {
1477: (*s_objet_resultat).type = VIN;
1478: s_objet_temporaire = s_objet_resultat;
1479:
1480: if ((s_objet_resultat = allocation(s_etat_processus, INT))
1481: == NULL)
1482: {
1483: (*s_etat_processus).erreur_systeme =
1484: d_es_allocation_memoire;
1485: return;
1486: }
1487:
1488: (*((integer8 *) (*s_objet_resultat).objet)) =
1489: ((integer8 *) (*((struct_vecteur *)
1490: (*s_objet_temporaire).objet)).tableau)[0];
1491:
1492: liberation(s_etat_processus, s_objet_temporaire);
1493: }
1494: else
1495: {
1496: (*s_objet_resultat).type = VRL;
1497: s_objet_temporaire = s_objet_resultat;
1498:
1499: if ((s_objet_resultat = allocation(s_etat_processus, REL))
1500: == NULL)
1501: {
1502: (*s_etat_processus).erreur_systeme =
1503: d_es_allocation_memoire;
1504: return;
1505: }
1506:
1507: (*((real8 *) (*s_objet_resultat).objet)) =
1508: ((real8 *) (*((struct_vecteur *)
1509: (*s_objet_temporaire).objet)).tableau)[0];
1510:
1511: liberation(s_etat_processus, s_objet_temporaire);
1512: }
1513: }
1514: else
1515: {
1516: if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I')
1517: {
1518: (*s_objet_resultat).type = VIN;
1519: }
1520: else
1521: {
1522: (*s_objet_resultat).type = VRL;
1523: }
1524: }
1525:
1526: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1527: s_objet_resultat) == d_erreur)
1528: {
1529: return;
1530: }
1531: }
1532: else
1533: {
1534: (*s_etat_processus).erreur_execution =
1535: d_ex_matrice_statistique_invalide;
1536: return;
1537: }
1538:
1539: return;
1540: }
1541:
1542:
1543: /*
1544: ================================================================================
1545: Fonction 'pvar'
1546: ================================================================================
1547: Entrées :
1548: --------------------------------------------------------------------------------
1549: Sorties :
1550: --------------------------------------------------------------------------------
1551: Effets de bord : néant
1552: ================================================================================
1553: */
1554:
1555: void
1556: instruction_pvar(struct_processus *s_etat_processus)
1557: {
1558: logical1 presence_variable;
1559:
1560: long i;
1561:
1562: struct_objet *s_objet_statistique;
1563: struct_objet *s_objet_resultat;
1564: struct_objet *s_objet_temporaire;
1565:
1566: unsigned long nombre_colonnes;
1567:
1568: (*s_etat_processus).erreur_execution = d_ex;
1569:
1570: if ((*s_etat_processus).affichage_arguments == 'Y')
1571: {
1572: printf("\n PVAR ");
1573:
1574: if ((*s_etat_processus).langue == 'F')
1575: {
1576: printf("(variance d'une population)\n\n");
1577: }
1578: else
1579: {
1580: printf("(population variance)\n\n");
1581: }
1582:
1583: printf("-> 1: %s, %s, %s, %s\n", d_INT, d_REL, d_VIN, d_VRL);
1584:
1585: return;
1586: }
1587: else if ((*s_etat_processus).test_instruction == 'Y')
1588: {
1589: (*s_etat_processus).nombre_arguments = -1;
1590: return;
1591: }
1592:
1593: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1594: {
1595: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1596: {
1597: return;
1598: }
1599: }
1600:
1601: /*
1602: * Recherche d'une variable globale référencée par SIGMA
1603: */
1604:
1605: if (recherche_variable(s_etat_processus, ds_sdat) == d_faux)
1606: {
1607: /*
1608: * Aucune variable SIGMA
1609: */
1610:
1611: (*s_etat_processus).erreur_systeme = d_es;
1612: (*s_etat_processus).erreur_execution = d_ex_absence_observations;
1613: return;
1614: }
1615: else
1616: {
1617: /*
1618: * Il existe une variable locale SIGMA. Reste à vérifier l'existence
1619: * d'une variable SIGMA globale...
1620: */
1621:
1622: i = (*s_etat_processus).position_variable_courante;
1623: presence_variable = d_faux;
1624:
1625: while(i >= 0)
1626: {
1627: if ((strcmp((*s_etat_processus).s_liste_variables[i].nom,
1628: ds_sdat) == 0) && ((*s_etat_processus)
1629: .s_liste_variables[i].niveau == 1))
1630: {
1631: presence_variable = d_vrai;
1632: break;
1633: }
1634:
1635: i--;
1636: }
1637:
1638: if (presence_variable == d_faux)
1639: {
1640: (*s_etat_processus).erreur_execution = d_ex_absence_observations;
1641: return;
1642: }
1643: else
1644: {
1645: (*s_etat_processus).position_variable_courante = i;
1646:
1647: if (((*s_etat_processus).s_liste_variables[i]).objet == NULL)
1648: {
1649: (*s_etat_processus).erreur_execution =
1650: d_ex_variable_partagee;
1651: return;
1652: }
1653:
1654: if (((*((*s_etat_processus).s_liste_variables
1655: [(*s_etat_processus).position_variable_courante].objet))
1656: .type != MIN) && ((*((*s_etat_processus)
1657: .s_liste_variables[(*s_etat_processus)
1658: .position_variable_courante].objet)).type != MRL))
1659: {
1660: (*s_etat_processus).erreur_execution =
1661: d_ex_matrice_statistique_invalide;
1662: return;
1663: }
1664:
1665: nombre_colonnes = (*((struct_matrice *) (*((*s_etat_processus)
1666: .s_liste_variables[(*s_etat_processus)
1667: .position_variable_courante].objet)).objet))
1668: .nombre_colonnes;
1669: }
1670: }
1671:
1672: s_objet_statistique = ((*s_etat_processus).s_liste_variables
1673: [(*s_etat_processus).position_variable_courante]).objet;
1674:
1675: if (((*s_objet_statistique).type == MIN) ||
1676: ((*s_objet_statistique).type == MRL))
1677: {
1678: if ((s_objet_resultat = allocation(s_etat_processus, NON))
1679: == NULL)
1680: {
1681: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1682: return;
1683: }
1684:
1685: if (((*s_objet_resultat).objet = variance_statistique((struct_matrice *)
1686: (*s_objet_statistique).objet, 'P')) == NULL)
1687: {
1688: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1689: return;
1690: }
1691:
1692: if (nombre_colonnes == 1)
1693: {
1694: if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I')
1695: {
1696: (*s_objet_resultat).type = VIN;
1697: s_objet_temporaire = s_objet_resultat;
1698:
1699: if ((s_objet_resultat = allocation(s_etat_processus, INT))
1700: == NULL)
1701: {
1702: (*s_etat_processus).erreur_systeme =
1703: d_es_allocation_memoire;
1704: return;
1705: }
1706:
1707: (*((integer8 *) (*s_objet_resultat).objet)) =
1708: ((integer8 *) (*((struct_vecteur *)
1709: (*s_objet_temporaire).objet)).tableau)[0];
1710:
1711: liberation(s_etat_processus, s_objet_temporaire);
1712: }
1713: else
1714: {
1715: (*s_objet_resultat).type = VRL;
1716: s_objet_temporaire = s_objet_resultat;
1717:
1718: if ((s_objet_resultat = allocation(s_etat_processus, REL))
1719: == NULL)
1720: {
1721: (*s_etat_processus).erreur_systeme =
1722: d_es_allocation_memoire;
1723: return;
1724: }
1725:
1726: (*((real8 *) (*s_objet_resultat).objet)) =
1727: ((real8 *) (*((struct_vecteur *)
1728: (*s_objet_temporaire).objet)).tableau)[0];
1729:
1730: liberation(s_etat_processus, s_objet_temporaire);
1731: }
1732: }
1733: else
1734: {
1735: if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I')
1736: {
1737: (*s_objet_resultat).type = VIN;
1738: }
1739: else
1740: {
1741: (*s_objet_resultat).type = VRL;
1742: }
1743: }
1744:
1745: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1746: s_objet_resultat) == d_erreur)
1747: {
1748: return;
1749: }
1750: }
1751: else
1752: {
1753: (*s_etat_processus).erreur_execution =
1754: d_ex_matrice_statistique_invalide;
1755: return;
1756: }
1757:
1758: return;
1759: }
1760:
1761: // 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