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