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