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