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