1: /*
2: ================================================================================
3: RPL/2 (R) version 4.1.4
4: Copyright (C) 1989-2011 Dr. BERTRAND Joël
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:
23: #include "rpl-conv.h"
24:
25:
26: /*
27: ================================================================================
28: Fonction 'clmf'
29: ================================================================================
30: Entrées : structure processus
31: --------------------------------------------------------------------------------
32: Sorties :
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: void
39: instruction_clmf(struct_processus *s_etat_processus)
40: {
41: (*s_etat_processus).erreur_execution = d_ex;
42:
43: if ((*s_etat_processus).affichage_arguments == 'Y')
44: {
45: printf("\n CLMF ");
46:
47: if ((*s_etat_processus).langue == 'F')
48: {
49: printf("(affiche la pile opérationnelle)\n\n");
50: printf(" Aucun argument\n");
51: }
52: else
53: {
54: printf("(print stack)\n\n");
55: printf(" No argument\n");
56: }
57:
58: return;
59: }
60: else if ((*s_etat_processus).test_instruction == 'Y')
61: {
62: (*s_etat_processus).nombre_arguments = -1;
63: return;
64: }
65:
66: affichage_pile(s_etat_processus, (*s_etat_processus).l_base_pile, 1);
67:
68: return;
69: }
70:
71:
72: /*
73: ================================================================================
74: Fonction 'cont'
75: ================================================================================
76: Entrées :
77: --------------------------------------------------------------------------------
78: Sorties :
79: --------------------------------------------------------------------------------
80: Effets de bord : néant
81: ================================================================================
82: */
83:
84: void
85: instruction_cont(struct_processus *s_etat_processus)
86: {
87: (*s_etat_processus).erreur_execution = d_ex;
88:
89: if ((*s_etat_processus).affichage_arguments == 'Y')
90: {
91: printf("\n CONT ");
92:
93: if ((*s_etat_processus).langue == 'F')
94: {
95: printf("(continue un programme arrêté par HALT)\n\n");
96: printf(" Aucun argument\n");
97: }
98: else
99: {
100: printf("(continue a program stopped by HALT)\n\n");
101: printf(" No argument\n");
102: }
103:
104: return;
105: }
106: else if ((*s_etat_processus).test_instruction == 'Y')
107: {
108: (*s_etat_processus).nombre_arguments = -1;
109: return;
110: }
111:
112: (*s_etat_processus).debug_programme = d_faux;
113: (*s_etat_processus).execution_pas_suivant = d_vrai;
114:
115: return;
116: }
117:
118:
119: /*
120: ================================================================================
121: Fonction 'cnrm'
122: ================================================================================
123: Entrées : pointeur sur une structure struct_processus
124: --------------------------------------------------------------------------------
125: Sorties :
126: --------------------------------------------------------------------------------
127: Effets de bord : néant
128: ================================================================================
129: */
130:
131: void
132: instruction_cnrm(struct_processus *s_etat_processus)
133: {
134: integer8 cumul_entier;
135: integer8 entier_courant;
136: integer8 tampon;
137:
138: logical1 depassement;
139: logical1 erreur_memoire;
140:
141: real8 cumul_reel;
142:
143: struct_objet *s_objet_argument;
144: struct_objet *s_objet_resultat;
145:
146: unsigned long i;
147: unsigned long j;
148:
149: void *accumulateur;
150:
151: (*s_etat_processus).erreur_execution = d_ex;
152:
153: if ((*s_etat_processus).affichage_arguments == 'Y')
154: {
155: printf("\n CNRM ");
156:
157: if ((*s_etat_processus).langue == 'F')
158: {
159: printf("(norme de colonne)\n\n");
160: }
161: else
162: {
163: printf("(column norm)\n\n");
164: }
165:
166: printf(" 1: %s, %s\n", d_VIN, d_MIN);
167: printf("-> 1: %s, %s\n\n", d_INT, d_REL);
168:
169: printf(" 1: %s, %s, %s, %s\n", d_VRL, d_VCX, d_MRL, d_MCX);
170: printf("-> 1: %s\n", d_REL);
171:
172: return;
173: }
174: else if ((*s_etat_processus).test_instruction == 'Y')
175: {
176: (*s_etat_processus).nombre_arguments = -1;
177: return;
178: }
179:
180: if (test_cfsf(s_etat_processus, 31) == d_vrai)
181: {
182: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
183: {
184: return;
185: }
186: }
187:
188: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
189: &s_objet_argument) == d_erreur)
190: {
191: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
192: return;
193: }
194:
195: /*
196: --------------------------------------------------------------------------------
197: Traitement des vecteurs
198: --------------------------------------------------------------------------------
199: */
200:
201: if ((*s_objet_argument).type == VIN)
202: {
203: cumul_entier = 0;
204: depassement = d_faux;
205:
206: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet)).taille;
207: i++)
208: {
209: entier_courant = abs(((integer8 *) (*((struct_vecteur *)
210: (*s_objet_argument).objet)).tableau)[i]);
211:
212: if (depassement_addition(&cumul_entier, &entier_courant,
213: &tampon) == d_erreur)
214: {
215: depassement = d_vrai;
216: break;
217: }
218:
219: cumul_entier = tampon;
220: }
221:
222: if (depassement == d_faux)
223: {
224: if ((s_objet_resultat = allocation(s_etat_processus, INT))
225: == NULL)
226: {
227: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
228: return;
229: }
230:
231: (*((integer8 *) (*s_objet_resultat).objet)) = cumul_entier;
232: }
233: else
234: {
235: cumul_reel = 0;
236:
237: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet))
238: .taille; i++)
239: {
240: cumul_reel += (real8) abs(((integer8 *) (*((struct_vecteur *)
241: (*s_objet_argument).objet)).tableau)[i]);
242: }
243:
244: if ((s_objet_resultat = allocation(s_etat_processus, REL))
245: == NULL)
246: {
247: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
248: return;
249: }
250:
251: (*((real8 *) (*s_objet_resultat).objet)) = cumul_reel;
252: }
253: }
254: else if ((*s_objet_argument).type == VRL)
255: {
256: if ((s_objet_resultat = allocation(s_etat_processus, REL))
257: == NULL)
258: {
259: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
260: return;
261: }
262:
263: if ((accumulateur = malloc((*((struct_vecteur *)
264: (*s_objet_argument).objet)).taille * sizeof(real8))) == NULL)
265: {
266: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
267: return;
268: }
269:
270: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet)).taille;
271: i++)
272: {
273: ((real8 *) accumulateur)[i] =
274: fabs(((real8 *) (*((struct_vecteur *)
275: (*s_objet_argument).objet)).tableau)[i]);
276: }
277:
278: (*((real8 *) (*s_objet_resultat).objet)) = sommation_vecteur_reel(
279: accumulateur, &((*((struct_vecteur *) (*s_objet_argument)
280: .objet)).taille), &erreur_memoire);
281:
282: if (erreur_memoire == d_vrai)
283: {
284: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
285: return;
286: }
287:
288: free(accumulateur);
289: }
290: else if ((*s_objet_argument).type == VCX)
291: {
292: if ((s_objet_resultat = allocation(s_etat_processus, REL))
293: == NULL)
294: {
295: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
296: return;
297: }
298:
299: if ((accumulateur = malloc((*((struct_vecteur *)
300: (*s_objet_argument).objet)).taille * sizeof(real8))) == NULL)
301: {
302: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
303: return;
304: }
305:
306: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet)).taille;
307: i++)
308: {
309: f77absc_(&(((struct_complexe16 *) (*((struct_vecteur *)
310: (*s_objet_argument).objet)).tableau)[i]),
311: &(((real8 *) accumulateur)[i]));
312: }
313:
314: (*((real8 *) (*s_objet_resultat).objet)) = sommation_vecteur_reel(
315: accumulateur, &((*((struct_vecteur *) (*s_objet_argument)
316: .objet)).taille), &erreur_memoire);
317:
318: if (erreur_memoire == d_vrai)
319: {
320: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
321: return;
322: }
323:
324: free(accumulateur);
325: }
326:
327: /*
328: --------------------------------------------------------------------------------
329: Traitement des matrices
330: --------------------------------------------------------------------------------
331: */
332:
333: else if ((*s_objet_argument).type == MIN)
334: {
335: if ((s_objet_resultat = allocation(s_etat_processus, INT))
336: == NULL)
337: {
338: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
339: return;
340: }
341:
342: depassement = d_faux;
343: cumul_entier = 0;
344:
345: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument).objet))
346: .nombre_lignes; i++)
347: {
348: entier_courant = abs(((integer8 **)
349: (*((struct_matrice *) (*s_objet_argument).objet))
350: .tableau)[i][0]);
351:
352: if (depassement_addition(&cumul_entier, &entier_courant,
353: &tampon) == d_erreur)
354: {
355: depassement = d_vrai;
356: break;
357: }
358:
359: cumul_entier = tampon;
360: }
361:
362: if (depassement == d_faux)
363: {
364: (*((integer8 *) (*s_objet_resultat).objet)) = cumul_entier;
365:
366: for(j = 1; j < (*((struct_matrice *) (*s_objet_argument).objet))
367: .nombre_colonnes; j++)
368: {
369: cumul_entier = 0;
370:
371: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument).objet))
372: .nombre_lignes; i++)
373: {
374: entier_courant = abs(((integer8 **) (*((struct_matrice *)
375: (*s_objet_argument).objet)).tableau)[i][j]);
376:
377: if (depassement_addition(&cumul_entier, &entier_courant,
378: &tampon) == d_erreur)
379: {
380: depassement = d_vrai;
381: break;
382: }
383:
384: cumul_entier = tampon;
385: }
386:
387: if (depassement == d_vrai)
388: {
389: break;
390: }
391:
392: if (cumul_entier > (*((integer8 *) (*s_objet_resultat).objet)))
393: {
394: (*((integer8 *) (*s_objet_resultat).objet)) = cumul_entier;
395: }
396: }
397: }
398:
399: if (depassement == d_vrai)
400: {
401: /*
402: * Dépassement : il faut refaire le calcul en real*8...
403: */
404:
405: free((*s_objet_resultat).objet);
406: (*s_objet_resultat).type = REL;
407:
408: if (((*s_objet_resultat).objet = malloc(sizeof(real8))) == NULL)
409: {
410: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
411: return;
412: }
413:
414: if ((accumulateur = malloc((*((struct_matrice *)
415: (*s_objet_argument).objet)).nombre_lignes * sizeof(real8)))
416: == NULL)
417: {
418: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
419: return;
420: }
421:
422: (*((real8 *) (*s_objet_resultat).objet)) = 0;
423:
424: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument).objet))
425: .nombre_colonnes; j++)
426: {
427: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument).objet))
428: .nombre_lignes; i++)
429: {
430: ((real8 *) accumulateur)[i] = fabs((real8) ((integer8 **)
431: (*((struct_matrice *)
432: (*s_objet_argument).objet)).tableau)[i][j]);
433: }
434:
435: cumul_reel = sommation_vecteur_reel(accumulateur,
436: &((*((struct_matrice *) (*s_objet_argument).objet))
437: .nombre_lignes), &erreur_memoire);
438:
439: if (erreur_memoire == d_vrai)
440: {
441: (*s_etat_processus).erreur_systeme =
442: d_es_allocation_memoire;
443: return;
444: }
445:
446: if (cumul_reel > (*((real8 *) (*s_objet_resultat).objet)))
447: {
448: (*((real8 *) (*s_objet_resultat).objet)) = cumul_reel;
449: }
450: }
451:
452: free(accumulateur);
453: }
454: }
455: else if ((*s_objet_argument).type == MRL)
456: {
457: if ((s_objet_resultat = allocation(s_etat_processus, REL))
458: == NULL)
459: {
460: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
461: return;
462: }
463:
464: if ((accumulateur = malloc((*((struct_matrice *)
465: (*s_objet_argument).objet)).nombre_lignes * sizeof(real8)))
466: == NULL)
467: {
468: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
469: return;
470: }
471:
472: (*((real8 *) (*s_objet_resultat).objet)) = 0;
473:
474: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument).objet))
475: .nombre_colonnes; j++)
476: {
477: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument).objet))
478: .nombre_lignes; i++)
479: {
480: ((real8 *) accumulateur)[i] = fabs(((real8 **)
481: (*((struct_matrice *)
482: (*s_objet_argument).objet)).tableau)[i][j]);
483: }
484:
485: cumul_reel = sommation_vecteur_reel(accumulateur,
486: &((*((struct_matrice *) (*s_objet_argument).objet))
487: .nombre_lignes), &erreur_memoire);
488:
489: if (erreur_memoire == d_vrai)
490: {
491: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
492: return;
493: }
494:
495: if (cumul_reel > (*((real8 *) (*s_objet_resultat).objet)))
496: {
497: (*((real8 *) (*s_objet_resultat).objet)) = cumul_reel;
498: }
499: }
500:
501: free(accumulateur);
502: }
503: else if ((*s_objet_argument).type == MCX)
504: {
505: if ((s_objet_resultat = allocation(s_etat_processus, REL))
506: == NULL)
507: {
508: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
509: return;
510: }
511:
512: if ((accumulateur = malloc((*((struct_matrice *)
513: (*s_objet_argument).objet)).nombre_lignes * sizeof(real8)))
514: == NULL)
515: {
516: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
517: return;
518: }
519:
520: (*((real8 *) (*s_objet_resultat).objet)) = 0;
521:
522: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument).objet))
523: .nombre_colonnes; j++)
524: {
525: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument).objet))
526: .nombre_lignes; i++)
527: {
528: f77absc_(&(((struct_complexe16 **) (*((struct_matrice *)
529: (*s_objet_argument).objet)).tableau)[i][j]),
530: &(((real8 *) accumulateur)[i]));
531: }
532:
533: cumul_reel = sommation_vecteur_reel(accumulateur,
534: &((*((struct_matrice *) (*s_objet_argument).objet))
535: .nombre_lignes), &erreur_memoire);
536:
537: if (erreur_memoire == d_vrai)
538: {
539: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
540: return;
541: }
542:
543: if (cumul_reel > (*((real8 *) (*s_objet_resultat).objet)))
544: {
545: (*((real8 *) (*s_objet_resultat).objet)) = cumul_reel;
546: }
547: }
548:
549: free(accumulateur);
550: }
551:
552: /*
553: --------------------------------------------------------------------------------
554: Traitement impossible du fait du type de l'argument
555: --------------------------------------------------------------------------------
556: */
557:
558: else
559: {
560: liberation(s_etat_processus, s_objet_argument);
561:
562: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
563: return;
564: }
565:
566: liberation(s_etat_processus, s_objet_argument);
567:
568: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
569: s_objet_resultat) == d_erreur)
570: {
571: return;
572: }
573:
574: return;
575: }
576:
577:
578: /*
579: ================================================================================
580: Fonction 'chr'
581: ================================================================================
582: Entrées : structure processus
583: --------------------------------------------------------------------------------
584: Sorties :
585: --------------------------------------------------------------------------------
586: Effets de bord : néant
587: ================================================================================
588: */
589:
590: void
591: instruction_chr(struct_processus *s_etat_processus)
592: {
593: struct_objet *s_objet_argument;
594: struct_objet *s_objet_resultat;
595:
596: (*s_etat_processus).erreur_execution = d_ex;
597:
598: if ((*s_etat_processus).affichage_arguments == 'Y')
599: {
600: printf("\n CHR ");
601:
602: if ((*s_etat_processus).langue == 'F')
603: {
604: printf("(conversion d'un entier en caractère)\n\n");
605: }
606: else
607: {
608: printf("(integer to character conversion)\n\n");
609: }
610:
611: printf(" 1: %s\n", d_INT);
612: printf("-> 1: %s\n", d_CHN);
613:
614: return;
615: }
616: else if ((*s_etat_processus).test_instruction == 'Y')
617: {
618: (*s_etat_processus).nombre_arguments = -1;
619: return;
620: }
621:
622: if (test_cfsf(s_etat_processus, 31) == d_vrai)
623: {
624: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
625: {
626: return;
627: }
628: }
629:
630: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
631: &s_objet_argument) == d_erreur)
632: {
633: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
634: return;
635: }
636:
637: /*
638: --------------------------------------------------------------------------------
639: Entier
640: --------------------------------------------------------------------------------
641: */
642:
643: if ((*s_objet_argument).type == INT)
644: {
645: if ((*((integer8 *) (*s_objet_argument).objet)) !=
646: (unsigned char) (*((integer8 *) (*s_objet_argument).objet)))
647: {
648: liberation(s_etat_processus, s_objet_argument);
649:
650: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
651: return;
652: }
653:
654: if (isprint((unsigned char) (*((integer8 *) (*s_objet_argument).objet)))
655: != 0)
656: {
657: if ((s_objet_resultat = allocation(s_etat_processus, CHN)) == NULL)
658: {
659: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
660: return;
661: }
662:
663: if ((*((integer8 *) (*s_objet_argument).objet)) == '\\')
664: {
665: if (((*s_objet_resultat).objet = malloc(3 *
666: sizeof(unsigned char))) == NULL)
667: {
668: (*s_etat_processus).erreur_systeme =
669: d_es_allocation_memoire;
670: return;
671: }
672:
673: ((unsigned char *) (*s_objet_resultat).objet)[0] = '\\';
674: ((unsigned char *) (*s_objet_resultat).objet)[1] = '\\';
675: (*((integer8 *) (*s_objet_argument).objet));
676: ((unsigned char *) (*s_objet_resultat).objet)[2] =
677: d_code_fin_chaine;
678: }
679: else
680: {
681: if (((*s_objet_resultat).objet = malloc(2 *
682: sizeof(unsigned char))) == NULL)
683: {
684: (*s_etat_processus).erreur_systeme =
685: d_es_allocation_memoire;
686: return;
687: }
688:
689: ((unsigned char *) (*s_objet_resultat).objet)[0] =
690: (*((integer8 *) (*s_objet_argument).objet));
691: ((unsigned char *) (*s_objet_resultat).objet)[1] =
692: d_code_fin_chaine;
693: }
694: }
695: else
696: {
697: if ((s_objet_resultat = allocation(s_etat_processus, CHN)) == NULL)
698: {
699: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
700: return;
701: }
702:
703: if (((*s_objet_resultat).objet = malloc(5 * sizeof(unsigned char)))
704: == NULL)
705: {
706: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
707: return;
708: }
709:
710: sprintf((unsigned char *) (*s_objet_resultat).objet, "\\x%02X",
711: (unsigned char) (*((integer8 *)
712: (*s_objet_argument).objet)));
713: }
714: }
715:
716: /*
717: --------------------------------------------------------------------------------
718: Type invalide
719: --------------------------------------------------------------------------------
720: */
721:
722: else
723: {
724: liberation(s_etat_processus, s_objet_argument);
725:
726: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
727: return;
728: }
729:
730: liberation(s_etat_processus, s_objet_argument);
731:
732: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
733: s_objet_resultat) == d_erreur)
734: {
735: return;
736: }
737:
738: return;
739: }
740:
741:
742: /*
743: ================================================================================
744: Fonction 'cr'
745: ================================================================================
746: Entrées : structure processus
747: --------------------------------------------------------------------------------
748: Sorties :
749: --------------------------------------------------------------------------------
750: Effets de bord : néant
751: ================================================================================
752: */
753:
754: void
755: instruction_cr(struct_processus *s_etat_processus)
756: {
757: struct_objet s_objet;
758:
759: unsigned char commande[] = "\\\\par";
760:
761: (*s_etat_processus).erreur_execution = d_ex;
762:
763: if ((*s_etat_processus).affichage_arguments == 'Y')
764: {
765: printf("\n CR ");
766:
767: if ((*s_etat_processus).langue == 'F')
768: {
769: printf("(retour à la ligne dans la sortie imprimée)\n\n");
770: printf(" Aucun argument\n");
771: }
772: else
773: {
774: printf("(carriage return in the printer output)\n\n");
775: printf(" No argument\n");
776: }
777:
778: return;
779: }
780: else if ((*s_etat_processus).test_instruction == 'Y')
781: {
782: (*s_etat_processus).nombre_arguments = -1;
783: return;
784: }
785:
786: if (test_cfsf(s_etat_processus, 31) == d_vrai)
787: {
788: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
789: {
790: return;
791: }
792: }
793:
794: s_objet.objet = commande;
795: s_objet.type = CHN;
796:
797: formateur_tex(s_etat_processus, &s_objet, 'N');
798: return;
799: }
800:
801:
802: /*
803: ================================================================================
804: Fonction 'centr'
805: ================================================================================
806: Entrées : pointeur sur une structure struct_processus
807: --------------------------------------------------------------------------------
808: Sorties :
809: --------------------------------------------------------------------------------
810: Effets de bord : néant
811: ================================================================================
812: */
813:
814: void
815: instruction_centr(struct_processus *s_etat_processus)
816: {
817: real8 x_max;
818: real8 x_min;
819: real8 y_max;
820: real8 y_min;
821:
822: struct_objet *s_objet_argument;
823:
824: (*s_etat_processus).erreur_execution = d_ex;
825:
826:
827: if ((*s_etat_processus).affichage_arguments == 'Y')
828: {
829: printf("\n CENTR ");
830:
831: if ((*s_etat_processus).langue == 'F')
832: {
833: printf("(centre des graphiques)\n\n");
834: }
835: else
836: {
837: printf("(center of the graphics)\n\n");
838: }
839:
840: printf(" 1: %s\n", d_CPL);
841:
842: return;
843: }
844: else if ((*s_etat_processus).test_instruction == 'Y')
845: {
846: (*s_etat_processus).nombre_arguments = -1;
847: return;
848: }
849:
850: if (test_cfsf(s_etat_processus, 31) == d_vrai)
851: {
852: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
853: {
854: return;
855: }
856: }
857:
858: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
859: &s_objet_argument) == d_erreur)
860: {
861: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
862: return;
863: }
864:
865: if ((*s_objet_argument).type == CPL)
866: {
867: if ((*s_etat_processus).systeme_axes == 0)
868: {
869: x_min = (*s_etat_processus).x_min;
870: x_max = (*s_etat_processus).x_max;
871:
872: y_min = (*s_etat_processus).y_min;
873: y_max = (*s_etat_processus).y_max;
874:
875: (*s_etat_processus).x_min = (*((complex16 *)
876: (*s_objet_argument).objet))
877: .partie_reelle - ((x_max - x_min) / ((double) 2));
878: (*s_etat_processus).x_max = (*((complex16 *)
879: (*s_objet_argument).objet))
880: .partie_reelle + ((x_max - x_min) / ((double) 2));
881:
882: (*s_etat_processus).y_min = (*((complex16 *)
883: (*s_objet_argument).objet))
884: .partie_imaginaire - ((y_max - y_min) / ((double) 2));
885: (*s_etat_processus).y_max = (*((complex16 *)
886: (*s_objet_argument).objet))
887: .partie_imaginaire + ((y_max - y_min) / ((double) 2));
888: }
889: else
890: {
891: x_min = (*s_etat_processus).x2_min;
892: x_max = (*s_etat_processus).x2_max;
893:
894: y_min = (*s_etat_processus).y2_min;
895: y_max = (*s_etat_processus).y2_max;
896:
897: (*s_etat_processus).x2_min = (*((complex16 *)
898: (*s_objet_argument).objet))
899: .partie_reelle - ((x_max - x_min) / ((double) 2));
900: (*s_etat_processus).x2_max = (*((complex16 *)
901: (*s_objet_argument).objet))
902: .partie_reelle + ((x_max - x_min) / ((double) 2));
903:
904: (*s_etat_processus).y2_min = (*((complex16 *)
905: (*s_objet_argument).objet))
906: .partie_imaginaire - ((y_max - y_min) / ((double) 2));
907: (*s_etat_processus).y2_max = (*((complex16 *)
908: (*s_objet_argument).objet))
909: .partie_imaginaire + ((y_max - y_min) / ((double) 2));
910: }
911: }
912: else
913: {
914: liberation(s_etat_processus, s_objet_argument);
915:
916: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
917: return;
918: }
919:
920: liberation(s_etat_processus, s_objet_argument);
921:
922: if (test_cfsf(s_etat_processus, 52) == d_faux)
923: {
924: if ((*s_etat_processus).fichiers_graphiques != NULL)
925: {
926: appel_gnuplot(s_etat_processus, 'N');
927: }
928: }
929:
930: return;
931: }
932:
933:
934: /*
935: ================================================================================
936: Fonction 'cls'
937: ================================================================================
938: Entrées : pointeur sur une structure struct_processus
939: --------------------------------------------------------------------------------
940: Sorties :
941: --------------------------------------------------------------------------------
942: Effets de bord : néant
943: ================================================================================
944: */
945:
946: void
947: instruction_cls(struct_processus *s_etat_processus)
948: {
949: (*s_etat_processus).erreur_execution = d_ex;
950:
951: if ((*s_etat_processus).affichage_arguments == 'Y')
952: {
953: printf("\n CLS ");
954:
955: if ((*s_etat_processus).langue == 'F')
956: {
957: printf("(effacement de la matrice statistique)\n\n");
958: printf(" Aucun argument\n");
959: }
960: else
961: {
962: printf("(purge of the statistical matrix)\n\n");
963: printf(" No argument\n");
964: }
965:
966: return;
967: }
968: else if ((*s_etat_processus).test_instruction == 'Y')
969: {
970: (*s_etat_processus).nombre_arguments = -1;
971: return;
972: }
973:
974: if (test_cfsf(s_etat_processus, 31) == d_vrai)
975: {
976: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
977: {
978: return;
979: }
980: }
981:
982: if (retrait_variable(s_etat_processus, ds_sdat, 'G') == d_erreur)
983: {
984: (*s_etat_processus).erreur_systeme = d_es;
985: return;
986: }
987:
988: return;
989: }
990:
991:
992: /*
993: ================================================================================
994: Fonction 'comb'
995: ================================================================================
996: Entrées : structure processus
997: --------------------------------------------------------------------------------
998: Sorties :
999: --------------------------------------------------------------------------------
1000: Effets de bord : néant
1001: ================================================================================
1002: */
1003:
1004: void
1005: instruction_comb(struct_processus *s_etat_processus)
1006: {
1007: integer8 k;
1008: integer8 n;
1009: integer8 cint_max;
1010:
1011: real8 c;
1012:
1013: struct_objet *s_objet_argument_1;
1014: struct_objet *s_objet_argument_2;
1015: struct_objet *s_objet_resultat;
1016:
1017: unsigned long i;
1018:
1019: (*s_etat_processus).erreur_execution = d_ex;
1020:
1021: if ((*s_etat_processus).affichage_arguments == 'Y')
1022: {
1023: printf("\n COMB ");
1024:
1025: if ((*s_etat_processus).langue == 'F')
1026: {
1027: printf("(combinaison)\n\n");
1028: }
1029: else
1030: {
1031: printf("(combinaison)\n\n");
1032: }
1033:
1034: printf(" 1: %s\n", d_INT);
1035: printf("-> 1: %s, %s\n", d_INT, d_REL);
1036:
1037: return;
1038: }
1039: else if ((*s_etat_processus).test_instruction == 'Y')
1040: {
1041: (*s_etat_processus).nombre_arguments = 2;
1042: return;
1043: }
1044:
1045: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1046: {
1047: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
1048: {
1049: return;
1050: }
1051: }
1052:
1053: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1054: &s_objet_argument_1) == d_erreur)
1055: {
1056: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1057: return;
1058: }
1059:
1060: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1061: &s_objet_argument_2) == d_erreur)
1062: {
1063: liberation(s_etat_processus, s_objet_argument_1);
1064:
1065: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1066: return;
1067: }
1068:
1069: if (((*s_objet_argument_1).type == INT) &&
1070: ((*s_objet_argument_2).type == INT))
1071: {
1072: n = (*((integer8 *) (*s_objet_argument_2).objet));
1073: k = (*((integer8 *) (*s_objet_argument_1).objet));
1074:
1075: if ((n < 0) || (k < 0) || (k > n))
1076: {
1077: liberation(s_etat_processus, s_objet_argument_1);
1078: liberation(s_etat_processus, s_objet_argument_2);
1079:
1080: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
1081: return;
1082: }
1083:
1084: f90combinaison(&n, &k, &c);
1085:
1086: for(i = 1, cint_max = 1; i < (8 * sizeof(integer8)) - 1; cint_max =
1087: (cint_max << 1) + 1, i++);
1088:
1089: if (c > cint_max)
1090: {
1091: if ((s_objet_resultat = allocation(s_etat_processus, REL))
1092: == NULL)
1093: {
1094: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1095: return;
1096: }
1097:
1098: (*((real8 *) (*s_objet_resultat).objet)) = c;
1099: }
1100: else
1101: {
1102: if ((s_objet_resultat = allocation(s_etat_processus, INT))
1103: == NULL)
1104: {
1105: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1106: return;
1107: }
1108:
1109: if (fabs(c - floor(c)) < fabs(ceil(c) - c))
1110: {
1111: (*((integer8 *) (*s_objet_resultat).objet)) =
1112: (integer8) floor(c);
1113: }
1114: else
1115: {
1116: (*((integer8 *) (*s_objet_resultat).objet)) =
1117: 1 + (integer8) floor(c);
1118: }
1119: }
1120: }
1121: else
1122: {
1123: liberation(s_etat_processus, s_objet_argument_1);
1124: liberation(s_etat_processus, s_objet_argument_2);
1125:
1126: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1127: return;
1128: }
1129:
1130: liberation(s_etat_processus, s_objet_argument_1);
1131: liberation(s_etat_processus, s_objet_argument_2);
1132:
1133: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1134: s_objet_resultat) == d_erreur)
1135: {
1136: return;
1137: }
1138:
1139: return;
1140: }
1141:
1142:
1143: /*
1144: ================================================================================
1145: Fonction 'cols'
1146: ================================================================================
1147: Entrées : pointeur sur une structure struct_processus
1148: --------------------------------------------------------------------------------
1149: Sorties :
1150: --------------------------------------------------------------------------------
1151: Effets de bord : néant
1152: ================================================================================
1153: */
1154:
1155: void
1156: instruction_cols(struct_processus *s_etat_processus)
1157: {
1158: struct_objet *s_objet_argument_1;
1159: struct_objet *s_objet_argument_2;
1160:
1161: (*s_etat_processus).erreur_execution = d_ex;
1162:
1163: if ((*s_etat_processus).affichage_arguments == 'Y')
1164: {
1165: printf("\n COLS ");
1166:
1167: if ((*s_etat_processus).langue == 'F')
1168: {
1169: printf("(définition des colonnes X et Y de la matrice "
1170: "statistique)\n\n");
1171: }
1172: else
1173: {
1174: printf("(definition of X and Y columns in statistical matrix)\n\n");
1175: }
1176:
1177: printf(" 2: %s\n", d_INT);
1178: printf(" 1: %s\n", d_INT);
1179:
1180: return;
1181: }
1182: else if ((*s_etat_processus).test_instruction == 'Y')
1183: {
1184: (*s_etat_processus).nombre_arguments = -1;
1185: return;
1186: }
1187:
1188: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1189: {
1190: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
1191: {
1192: return;
1193: }
1194: }
1195:
1196: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1197: &s_objet_argument_1) == d_erreur)
1198: {
1199: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1200: return;
1201: }
1202:
1203: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1204: &s_objet_argument_2) == d_erreur)
1205: {
1206: liberation(s_etat_processus, s_objet_argument_1);
1207:
1208: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1209: return;
1210: }
1211:
1212: if (((*s_objet_argument_1).type == INT) &&
1213: ((*s_objet_argument_2).type == INT))
1214: {
1215: if (((*((integer8 *) (*s_objet_argument_1).objet)) <= 0) ||
1216: ((*((integer8 *) (*s_objet_argument_2).objet)) <= 0))
1217: {
1218: liberation(s_etat_processus, s_objet_argument_1);
1219: liberation(s_etat_processus, s_objet_argument_2);
1220:
1221: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
1222: return;
1223: }
1224:
1225: (*s_etat_processus).colonne_statistique_1 =
1226: (*((integer8 *) (*s_objet_argument_2).objet));
1227: (*s_etat_processus).colonne_statistique_2 =
1228: (*((integer8 *) (*s_objet_argument_1).objet));
1229: }
1230: else
1231: {
1232: liberation(s_etat_processus, s_objet_argument_1);
1233: liberation(s_etat_processus, s_objet_argument_2);
1234:
1235: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1236: return;
1237: }
1238:
1239: liberation(s_etat_processus, s_objet_argument_1);
1240: liberation(s_etat_processus, s_objet_argument_2);
1241:
1242: return;
1243: }
1244:
1245: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_c3.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src