1: /*
2: ================================================================================
3: RPL/2 (R) version 4.1.12
4: Copyright (C) 1989-2012 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: ((unsigned char *) (*s_objet_resultat).objet)[2] =
676: d_code_fin_chaine;
677: }
678: else if ((*((integer8 *) (*s_objet_argument).objet)) == '"')
679: {
680: if (((*s_objet_resultat).objet = malloc(3 *
681: sizeof(unsigned char))) == NULL)
682: {
683: (*s_etat_processus).erreur_systeme =
684: d_es_allocation_memoire;
685: return;
686: }
687:
688: ((unsigned char *) (*s_objet_resultat).objet)[0] = '\\';
689: ((unsigned char *) (*s_objet_resultat).objet)[1] = '"';
690: ((unsigned char *) (*s_objet_resultat).objet)[2] =
691: d_code_fin_chaine;
692: }
693: else
694: {
695: if (((*s_objet_resultat).objet = malloc(2 *
696: sizeof(unsigned char))) == NULL)
697: {
698: (*s_etat_processus).erreur_systeme =
699: d_es_allocation_memoire;
700: return;
701: }
702:
703: ((unsigned char *) (*s_objet_resultat).objet)[0] =
704: (*((integer8 *) (*s_objet_argument).objet));
705: ((unsigned char *) (*s_objet_resultat).objet)[1] =
706: d_code_fin_chaine;
707: }
708: }
709: else
710: {
711: if ((s_objet_resultat = allocation(s_etat_processus, CHN)) == NULL)
712: {
713: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
714: return;
715: }
716:
717: if (((*s_objet_resultat).objet = malloc(5 * sizeof(unsigned char)))
718: == NULL)
719: {
720: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
721: return;
722: }
723:
724: sprintf((unsigned char *) (*s_objet_resultat).objet, "\\x%02X",
725: (unsigned char) (*((integer8 *)
726: (*s_objet_argument).objet)));
727: }
728: }
729:
730: /*
731: --------------------------------------------------------------------------------
732: Type invalide
733: --------------------------------------------------------------------------------
734: */
735:
736: else
737: {
738: liberation(s_etat_processus, s_objet_argument);
739:
740: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
741: return;
742: }
743:
744: liberation(s_etat_processus, s_objet_argument);
745:
746: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
747: s_objet_resultat) == d_erreur)
748: {
749: return;
750: }
751:
752: return;
753: }
754:
755:
756: /*
757: ================================================================================
758: Fonction 'cr'
759: ================================================================================
760: Entrées : structure processus
761: --------------------------------------------------------------------------------
762: Sorties :
763: --------------------------------------------------------------------------------
764: Effets de bord : néant
765: ================================================================================
766: */
767:
768: void
769: instruction_cr(struct_processus *s_etat_processus)
770: {
771: struct_objet s_objet;
772:
773: unsigned char commande[] = "\\\\par";
774:
775: (*s_etat_processus).erreur_execution = d_ex;
776:
777: if ((*s_etat_processus).affichage_arguments == 'Y')
778: {
779: printf("\n CR ");
780:
781: if ((*s_etat_processus).langue == 'F')
782: {
783: printf("(retour à la ligne dans la sortie imprimée)\n\n");
784: printf(" Aucun argument\n");
785: }
786: else
787: {
788: printf("(carriage return in the printer output)\n\n");
789: printf(" No argument\n");
790: }
791:
792: return;
793: }
794: else if ((*s_etat_processus).test_instruction == 'Y')
795: {
796: (*s_etat_processus).nombre_arguments = -1;
797: return;
798: }
799:
800: if (test_cfsf(s_etat_processus, 31) == d_vrai)
801: {
802: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
803: {
804: return;
805: }
806: }
807:
808: s_objet.objet = commande;
809: s_objet.type = CHN;
810:
811: formateur_tex(s_etat_processus, &s_objet, 'N');
812: return;
813: }
814:
815:
816: /*
817: ================================================================================
818: Fonction 'centr'
819: ================================================================================
820: Entrées : pointeur sur une structure struct_processus
821: --------------------------------------------------------------------------------
822: Sorties :
823: --------------------------------------------------------------------------------
824: Effets de bord : néant
825: ================================================================================
826: */
827:
828: void
829: instruction_centr(struct_processus *s_etat_processus)
830: {
831: real8 x_max;
832: real8 x_min;
833: real8 y_max;
834: real8 y_min;
835:
836: struct_objet *s_objet_argument;
837:
838: (*s_etat_processus).erreur_execution = d_ex;
839:
840:
841: if ((*s_etat_processus).affichage_arguments == 'Y')
842: {
843: printf("\n CENTR ");
844:
845: if ((*s_etat_processus).langue == 'F')
846: {
847: printf("(centre des graphiques)\n\n");
848: }
849: else
850: {
851: printf("(center of the graphics)\n\n");
852: }
853:
854: printf(" 1: %s\n", d_CPL);
855:
856: return;
857: }
858: else if ((*s_etat_processus).test_instruction == 'Y')
859: {
860: (*s_etat_processus).nombre_arguments = -1;
861: return;
862: }
863:
864: if (test_cfsf(s_etat_processus, 31) == d_vrai)
865: {
866: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
867: {
868: return;
869: }
870: }
871:
872: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
873: &s_objet_argument) == d_erreur)
874: {
875: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
876: return;
877: }
878:
879: if ((*s_objet_argument).type == CPL)
880: {
881: if ((*s_etat_processus).systeme_axes == 0)
882: {
883: x_min = (*s_etat_processus).x_min;
884: x_max = (*s_etat_processus).x_max;
885:
886: y_min = (*s_etat_processus).y_min;
887: y_max = (*s_etat_processus).y_max;
888:
889: (*s_etat_processus).x_min = (*((complex16 *)
890: (*s_objet_argument).objet))
891: .partie_reelle - ((x_max - x_min) / ((double) 2));
892: (*s_etat_processus).x_max = (*((complex16 *)
893: (*s_objet_argument).objet))
894: .partie_reelle + ((x_max - x_min) / ((double) 2));
895:
896: (*s_etat_processus).y_min = (*((complex16 *)
897: (*s_objet_argument).objet))
898: .partie_imaginaire - ((y_max - y_min) / ((double) 2));
899: (*s_etat_processus).y_max = (*((complex16 *)
900: (*s_objet_argument).objet))
901: .partie_imaginaire + ((y_max - y_min) / ((double) 2));
902: }
903: else
904: {
905: x_min = (*s_etat_processus).x2_min;
906: x_max = (*s_etat_processus).x2_max;
907:
908: y_min = (*s_etat_processus).y2_min;
909: y_max = (*s_etat_processus).y2_max;
910:
911: (*s_etat_processus).x2_min = (*((complex16 *)
912: (*s_objet_argument).objet))
913: .partie_reelle - ((x_max - x_min) / ((double) 2));
914: (*s_etat_processus).x2_max = (*((complex16 *)
915: (*s_objet_argument).objet))
916: .partie_reelle + ((x_max - x_min) / ((double) 2));
917:
918: (*s_etat_processus).y2_min = (*((complex16 *)
919: (*s_objet_argument).objet))
920: .partie_imaginaire - ((y_max - y_min) / ((double) 2));
921: (*s_etat_processus).y2_max = (*((complex16 *)
922: (*s_objet_argument).objet))
923: .partie_imaginaire + ((y_max - y_min) / ((double) 2));
924: }
925: }
926: else
927: {
928: liberation(s_etat_processus, s_objet_argument);
929:
930: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
931: return;
932: }
933:
934: liberation(s_etat_processus, s_objet_argument);
935:
936: if (test_cfsf(s_etat_processus, 52) == d_faux)
937: {
938: if ((*s_etat_processus).fichiers_graphiques != NULL)
939: {
940: appel_gnuplot(s_etat_processus, 'N');
941: }
942: }
943:
944: return;
945: }
946:
947:
948: /*
949: ================================================================================
950: Fonction 'cls'
951: ================================================================================
952: Entrées : pointeur sur une structure struct_processus
953: --------------------------------------------------------------------------------
954: Sorties :
955: --------------------------------------------------------------------------------
956: Effets de bord : néant
957: ================================================================================
958: */
959:
960: void
961: instruction_cls(struct_processus *s_etat_processus)
962: {
963: (*s_etat_processus).erreur_execution = d_ex;
964:
965: if ((*s_etat_processus).affichage_arguments == 'Y')
966: {
967: printf("\n CLS ");
968:
969: if ((*s_etat_processus).langue == 'F')
970: {
971: printf("(effacement de la matrice statistique)\n\n");
972: printf(" Aucun argument\n");
973: }
974: else
975: {
976: printf("(purge of the statistical matrix)\n\n");
977: printf(" No argument\n");
978: }
979:
980: return;
981: }
982: else if ((*s_etat_processus).test_instruction == 'Y')
983: {
984: (*s_etat_processus).nombre_arguments = -1;
985: return;
986: }
987:
988: if (test_cfsf(s_etat_processus, 31) == d_vrai)
989: {
990: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
991: {
992: return;
993: }
994: }
995:
996: if (retrait_variable(s_etat_processus, ds_sdat, 'G') == d_erreur)
997: {
998: (*s_etat_processus).erreur_systeme = d_es;
999: return;
1000: }
1001:
1002: return;
1003: }
1004:
1005:
1006: /*
1007: ================================================================================
1008: Fonction 'comb'
1009: ================================================================================
1010: Entrées : structure processus
1011: --------------------------------------------------------------------------------
1012: Sorties :
1013: --------------------------------------------------------------------------------
1014: Effets de bord : néant
1015: ================================================================================
1016: */
1017:
1018: void
1019: instruction_comb(struct_processus *s_etat_processus)
1020: {
1021: integer8 k;
1022: integer8 n;
1023: integer8 cint_max;
1024:
1025: real8 c;
1026:
1027: struct_objet *s_objet_argument_1;
1028: struct_objet *s_objet_argument_2;
1029: struct_objet *s_objet_resultat;
1030:
1031: unsigned long i;
1032:
1033: (*s_etat_processus).erreur_execution = d_ex;
1034:
1035: if ((*s_etat_processus).affichage_arguments == 'Y')
1036: {
1037: printf("\n COMB ");
1038:
1039: if ((*s_etat_processus).langue == 'F')
1040: {
1041: printf("(combinaison)\n\n");
1042: }
1043: else
1044: {
1045: printf("(combinaison)\n\n");
1046: }
1047:
1048: printf(" 1: %s\n", d_INT);
1049: printf("-> 1: %s, %s\n", d_INT, d_REL);
1050:
1051: return;
1052: }
1053: else if ((*s_etat_processus).test_instruction == 'Y')
1054: {
1055: (*s_etat_processus).nombre_arguments = 2;
1056: return;
1057: }
1058:
1059: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1060: {
1061: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
1062: {
1063: return;
1064: }
1065: }
1066:
1067: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1068: &s_objet_argument_1) == d_erreur)
1069: {
1070: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1071: return;
1072: }
1073:
1074: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1075: &s_objet_argument_2) == d_erreur)
1076: {
1077: liberation(s_etat_processus, s_objet_argument_1);
1078:
1079: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1080: return;
1081: }
1082:
1083: if (((*s_objet_argument_1).type == INT) &&
1084: ((*s_objet_argument_2).type == INT))
1085: {
1086: n = (*((integer8 *) (*s_objet_argument_2).objet));
1087: k = (*((integer8 *) (*s_objet_argument_1).objet));
1088:
1089: if ((n < 0) || (k < 0) || (k > n))
1090: {
1091: liberation(s_etat_processus, s_objet_argument_1);
1092: liberation(s_etat_processus, s_objet_argument_2);
1093:
1094: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
1095: return;
1096: }
1097:
1098: f90combinaison(&n, &k, &c);
1099:
1100: for(i = 1, cint_max = 1; i < (8 * sizeof(integer8)) - 1; cint_max =
1101: (cint_max << 1) + 1, i++);
1102:
1103: if (c > cint_max)
1104: {
1105: if ((s_objet_resultat = allocation(s_etat_processus, REL))
1106: == NULL)
1107: {
1108: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1109: return;
1110: }
1111:
1112: (*((real8 *) (*s_objet_resultat).objet)) = c;
1113: }
1114: else
1115: {
1116: if ((s_objet_resultat = allocation(s_etat_processus, INT))
1117: == NULL)
1118: {
1119: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1120: return;
1121: }
1122:
1123: if (fabs(c - floor(c)) < fabs(ceil(c) - c))
1124: {
1125: (*((integer8 *) (*s_objet_resultat).objet)) =
1126: (integer8) floor(c);
1127: }
1128: else
1129: {
1130: (*((integer8 *) (*s_objet_resultat).objet)) =
1131: 1 + (integer8) floor(c);
1132: }
1133: }
1134: }
1135: else
1136: {
1137: liberation(s_etat_processus, s_objet_argument_1);
1138: liberation(s_etat_processus, s_objet_argument_2);
1139:
1140: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1141: return;
1142: }
1143:
1144: liberation(s_etat_processus, s_objet_argument_1);
1145: liberation(s_etat_processus, s_objet_argument_2);
1146:
1147: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1148: s_objet_resultat) == d_erreur)
1149: {
1150: return;
1151: }
1152:
1153: return;
1154: }
1155:
1156:
1157: /*
1158: ================================================================================
1159: Fonction 'cols'
1160: ================================================================================
1161: Entrées : pointeur sur une structure struct_processus
1162: --------------------------------------------------------------------------------
1163: Sorties :
1164: --------------------------------------------------------------------------------
1165: Effets de bord : néant
1166: ================================================================================
1167: */
1168:
1169: void
1170: instruction_cols(struct_processus *s_etat_processus)
1171: {
1172: struct_objet *s_objet_argument_1;
1173: struct_objet *s_objet_argument_2;
1174:
1175: (*s_etat_processus).erreur_execution = d_ex;
1176:
1177: if ((*s_etat_processus).affichage_arguments == 'Y')
1178: {
1179: printf("\n COLS ");
1180:
1181: if ((*s_etat_processus).langue == 'F')
1182: {
1183: printf("(définition des colonnes X et Y de la matrice "
1184: "statistique)\n\n");
1185: }
1186: else
1187: {
1188: printf("(definition of X and Y columns in statistical matrix)\n\n");
1189: }
1190:
1191: printf(" 2: %s\n", d_INT);
1192: printf(" 1: %s\n", d_INT);
1193:
1194: return;
1195: }
1196: else if ((*s_etat_processus).test_instruction == 'Y')
1197: {
1198: (*s_etat_processus).nombre_arguments = -1;
1199: return;
1200: }
1201:
1202: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1203: {
1204: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
1205: {
1206: return;
1207: }
1208: }
1209:
1210: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1211: &s_objet_argument_1) == d_erreur)
1212: {
1213: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1214: return;
1215: }
1216:
1217: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1218: &s_objet_argument_2) == d_erreur)
1219: {
1220: liberation(s_etat_processus, s_objet_argument_1);
1221:
1222: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1223: return;
1224: }
1225:
1226: if (((*s_objet_argument_1).type == INT) &&
1227: ((*s_objet_argument_2).type == INT))
1228: {
1229: if (((*((integer8 *) (*s_objet_argument_1).objet)) <= 0) ||
1230: ((*((integer8 *) (*s_objet_argument_2).objet)) <= 0))
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_argument_invalide;
1236: return;
1237: }
1238:
1239: (*s_etat_processus).colonne_statistique_1 =
1240: (*((integer8 *) (*s_objet_argument_2).objet));
1241: (*s_etat_processus).colonne_statistique_2 =
1242: (*((integer8 *) (*s_objet_argument_1).objet));
1243: }
1244: else
1245: {
1246: liberation(s_etat_processus, s_objet_argument_1);
1247: liberation(s_etat_processus, s_objet_argument_2);
1248:
1249: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1250: return;
1251: }
1252:
1253: liberation(s_etat_processus, s_objet_argument_1);
1254: liberation(s_etat_processus, s_objet_argument_2);
1255:
1256: return;
1257: }
1258:
1259: // 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