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