1: /*
2: ================================================================================
3: RPL/2 (R) version 4.0.9
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 '->HMS'
29: ================================================================================
30: Entrées : structure processus
31: --------------------------------------------------------------------------------
32: Sorties :
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: void
39: instruction_fleche_hms(struct_processus *s_etat_processus)
40: {
41: struct_objet *s_copie;
42: struct_objet *s_objet;
43:
44: (*s_etat_processus).erreur_execution = d_ex;
45:
46: if ((*s_etat_processus).affichage_arguments == 'Y')
47: {
48: printf("\n ->HMS ");
49:
50: if ((*s_etat_processus).langue == 'F')
51: {
52: printf("(conversion sexadécimale)\n\n");
53: }
54: else
55: {
56: printf("(conversion to hours minutes seconds)\n\n");
57: }
58:
59: printf(" 1: %s\n", d_INT);
60: printf("-> 1: %s\n\n", d_INT);
61:
62: printf(" 1: %s\n", d_REL);
63: printf("-> 1: %s\n", d_REL);
64:
65: return;
66: }
67: else if ((*s_etat_processus).test_instruction == 'Y')
68: {
69: (*s_etat_processus).nombre_arguments = -1;
70: return;
71: }
72:
73: if (test_cfsf(s_etat_processus, 31) == d_vrai)
74: {
75: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
76: {
77: return;
78: }
79: }
80:
81: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
82: &s_objet) == d_erreur)
83: {
84: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
85: return;
86: }
87:
88: /*
89: --------------------------------------------------------------------------------
90: Argument entier
91: --------------------------------------------------------------------------------
92: */
93:
94: if ((*s_objet).type == INT)
95: {
96: /*
97: * On ne fait rien...
98: */
99: }
100:
101: /*
102: --------------------------------------------------------------------------------
103: Argument réel
104: --------------------------------------------------------------------------------
105: */
106:
107: else if ((*s_objet).type == REL)
108: {
109: if ((s_copie = copie_objet(s_etat_processus, s_objet, 'O')) == NULL)
110: {
111: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
112: return;
113: }
114:
115: liberation(s_etat_processus, s_objet);
116: s_objet = s_copie;
117:
118: conversion_decimal_vers_hms((real8 *) (*s_objet).objet);
119: }
120:
121: /*
122: --------------------------------------------------------------------------------
123: Argument invalide
124: --------------------------------------------------------------------------------
125: */
126:
127: else
128: {
129: liberation(s_etat_processus, s_objet);
130:
131: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
132: return;
133: }
134:
135: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
136: s_objet) == d_erreur)
137: {
138: return;
139: }
140:
141: return;
142: }
143:
144:
145: /*
146: ================================================================================
147: Fonction '->ARRAY'
148: ================================================================================
149: Entrées : structure processus
150: --------------------------------------------------------------------------------
151: Sorties :
152: --------------------------------------------------------------------------------
153: Effets de bord : néant
154: ================================================================================
155: */
156:
157: void
158: instruction_fleche_array(struct_processus *s_etat_processus)
159: {
160: enum t_type type;
161:
162: struct_liste_chainee *l_element_courant;
163:
164: struct_objet *s_objet;
165: struct_objet *s_objet_elementaire;
166:
167: unsigned long i;
168: unsigned long j;
169: unsigned long nombre_colonnes;
170: unsigned long nombre_lignes;
171: unsigned long nombre_dimensions;
172: unsigned long nombre_termes;
173:
174: (*s_etat_processus).erreur_execution = d_ex;
175:
176: if ((*s_etat_processus).affichage_arguments == 'Y')
177: {
178: printf("\n ->ARRAY [->ARRY] ");
179:
180: if ((*s_etat_processus).langue == 'F')
181: {
182: printf("(création d'un vecteur ou d'une matrice)\n\n");
183: }
184: else
185: {
186: printf("(create vector or matrix)\n\n");
187: }
188:
189: printf(" n: %s, %s, %s\n", d_INT, d_REL, d_CPL);
190: printf(" ...\n");
191: printf(" 2: %s, %s, %s\n", d_INT, d_REL, d_CPL);
192: printf(" 1: %s\n", d_LST);
193: printf("-> 1: %s, %s, %s,\n"
194: " %s, %s, %s\n", d_VIN, d_VRL, d_VCX,
195: d_MIN, d_MRL, d_MCX);
196:
197: return;
198: }
199: else if ((*s_etat_processus).test_instruction == 'Y')
200: {
201: (*s_etat_processus).nombre_arguments = -1;
202: return;
203: }
204:
205: if (test_cfsf(s_etat_processus, 31) == d_vrai)
206: {
207: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
208: {
209: return;
210: }
211: }
212:
213: if ((*s_etat_processus).hauteur_pile_operationnelle == 0)
214: {
215: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
216: return;
217: }
218:
219: if ((*(*(*s_etat_processus).l_base_pile).donnee).type != LST)
220: {
221: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
222: return;
223: }
224:
225: l_element_courant = (*(*(*s_etat_processus).l_base_pile).donnee).objet;
226: nombre_dimensions = 0;
227:
228: while(l_element_courant != NULL)
229: {
230: nombre_dimensions++;
231: l_element_courant = (*l_element_courant).suivant;
232: }
233:
234: if (nombre_dimensions > 2)
235: {
236: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
237: return;
238: }
239:
240: l_element_courant = (*(*(*s_etat_processus).l_base_pile).donnee).objet;
241: nombre_termes = 1;
242:
243: nombre_lignes = 0;
244: nombre_colonnes = 0;
245:
246: while(l_element_courant != NULL)
247: {
248: if ((*(*l_element_courant).donnee).type != INT)
249: {
250: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
251: return;
252: }
253:
254: if ((*((integer8 *) (*(*l_element_courant).donnee).objet)) <= 0)
255: {
256: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
257: return;
258: }
259:
260: if (nombre_lignes == 0)
261: {
262: nombre_lignes = (*((integer8 *) (*(*l_element_courant)
263: .donnee).objet));
264: }
265: else
266: {
267: nombre_colonnes = (*((integer8 *) (*(*l_element_courant)
268: .donnee).objet));
269: }
270:
271: nombre_termes *= (*((integer8 *) (*(*l_element_courant)
272: .donnee).objet));
273: l_element_courant = (*l_element_courant).suivant;
274: }
275:
276: if (test_cfsf(s_etat_processus, 31) == d_vrai)
277: {
278: if (empilement_pile_last(s_etat_processus, nombre_termes + 1) ==
279: d_erreur)
280: {
281: return;
282: }
283: }
284:
285: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
286: &s_objet) == d_erreur)
287: {
288: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
289: return;
290: }
291:
292: liberation(s_etat_processus, s_objet);
293:
294: if ((*s_etat_processus).hauteur_pile_operationnelle < nombre_termes)
295: {
296: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
297: return;
298: }
299:
300: type = (nombre_dimensions == 1) ? VIN : MIN;
301:
302: l_element_courant = (*s_etat_processus).l_base_pile;
303:
304: for(i = 0; i < nombre_termes; i++)
305: {
306: if ((*(*l_element_courant).donnee).type == INT)
307: {
308: /*
309: * Rien à faire...
310: */
311: }
312: else if ((*(*l_element_courant).donnee).type == REL)
313: {
314: type = (nombre_dimensions == 1) ? VRL : MRL;
315: }
316: else if ((*(*l_element_courant).donnee).type == CPL)
317: {
318: type = (nombre_dimensions == 1) ? VCX : MCX;
319: }
320: else
321: {
322: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
323: return;
324: }
325:
326: l_element_courant = (*l_element_courant).suivant;
327: }
328:
329: /*
330: --------------------------------------------------------------------------------
331: Traitement des vecteurs
332: --------------------------------------------------------------------------------
333: */
334:
335: if (nombre_dimensions == 1)
336: {
337: if (type == VIN)
338: {
339: if ((s_objet = allocation(s_etat_processus, VIN)) == NULL)
340: {
341: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
342: return;
343: }
344:
345: if (((*((struct_vecteur *) (*s_objet).objet)).tableau =
346: malloc(nombre_lignes * sizeof(integer8))) == NULL)
347: {
348: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
349: return;
350: }
351: }
352: else if (type == VRL)
353: {
354: if ((s_objet = allocation(s_etat_processus, VRL)) == NULL)
355: {
356: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
357: return;
358: }
359:
360: if (((*((struct_vecteur *) (*s_objet).objet)).tableau =
361: malloc(nombre_lignes * sizeof(real8))) == NULL)
362: {
363: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
364: return;
365: }
366: }
367: else
368: {
369: if ((s_objet = allocation(s_etat_processus, VCX)) == NULL)
370: {
371: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
372: return;
373: }
374:
375: if (((*((struct_vecteur *) (*s_objet).objet)).tableau =
376: malloc(nombre_lignes * sizeof(struct_complexe16)))
377: == NULL)
378: {
379: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
380: return;
381: }
382: }
383:
384: (*((struct_vecteur *) (*s_objet).objet)).taille = nombre_lignes;
385:
386: for(i = 0; i < nombre_lignes; i++)
387: {
388: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
389: &s_objet_elementaire) == d_erreur)
390: {
391: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
392: return;
393: }
394:
395: if ((*((struct_vecteur *) (*s_objet).objet)).type == 'I')
396: {
397: ((integer8 *) (*((struct_vecteur *) (*s_objet).objet))
398: .tableau)[nombre_lignes - (i + 1)] = (*((integer8 *)
399: (*s_objet_elementaire).objet));
400: }
401: else if ((*((struct_vecteur *) (*s_objet).objet)).type == 'R')
402: {
403: if ((*s_objet_elementaire).type == INT)
404: {
405: ((real8 *) (*((struct_vecteur *) (*s_objet).objet))
406: .tableau)[nombre_lignes - (i + 1)] =
407: (real8) (*((integer8 *)
408: (*s_objet_elementaire).objet));
409: }
410: else
411: {
412: ((real8 *) (*((struct_vecteur *) (*s_objet).objet))
413: .tableau)[nombre_lignes - (i + 1)] = (*((real8 *)
414: (*s_objet_elementaire).objet));
415: }
416: }
417: else
418: {
419: if ((*s_objet_elementaire).type == INT)
420: {
421: ((struct_complexe16 *) (*((struct_vecteur *)
422: (*s_objet).objet)).tableau)
423: [nombre_lignes - (i + 1)].partie_reelle =
424: (real8) (*((integer8 *)
425: (*s_objet_elementaire).objet));
426: ((struct_complexe16 *) (*((struct_vecteur *)
427: (*s_objet).objet)).tableau)
428: [nombre_lignes - (i + 1)].partie_imaginaire = 0;
429: }
430: else if ((*s_objet_elementaire).type == REL)
431: {
432: ((struct_complexe16 *) (*((struct_vecteur *)
433: (*s_objet).objet)).tableau)
434: [nombre_lignes - (i + 1)].partie_reelle =
435: (*((real8 *) (*s_objet_elementaire).objet));
436: ((struct_complexe16 *) (*((struct_vecteur *)
437: (*s_objet).objet)).tableau)
438: [nombre_lignes - (i + 1)].partie_imaginaire = 0;
439: }
440: else
441: {
442: ((struct_complexe16 *) (*((struct_vecteur *)
443: (*s_objet).objet)).tableau)
444: [nombre_lignes - (i + 1)].partie_reelle =
445: (*((struct_complexe16 *)
446: (*s_objet_elementaire).objet)).partie_reelle;
447: ((struct_complexe16 *) (*((struct_vecteur *)
448: (*s_objet).objet)).tableau)
449: [nombre_lignes - (i + 1)].partie_imaginaire =
450: (*((struct_complexe16 *)
451: (*s_objet_elementaire).objet)).partie_imaginaire;
452: }
453: }
454:
455: liberation(s_etat_processus, s_objet_elementaire);
456: }
457: }
458:
459: /*
460: --------------------------------------------------------------------------------
461: Traitement des matrices
462: --------------------------------------------------------------------------------
463: */
464:
465: else
466: {
467: if (type == MIN)
468: {
469: if ((s_objet = allocation(s_etat_processus, MIN))
470: == NULL)
471: {
472: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
473: return;
474: }
475:
476: if (((*((struct_matrice *) (*s_objet).objet)).tableau =
477: malloc(nombre_lignes * sizeof(integer8 *))) == NULL)
478: {
479: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
480: return;
481: }
482: }
483: else if (type == MRL)
484: {
485: if ((s_objet = allocation(s_etat_processus, MRL))
486: == NULL)
487: {
488: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
489: return;
490: }
491:
492: if (((*((struct_matrice *) (*s_objet).objet)).tableau =
493: malloc(nombre_lignes * sizeof(real8 *))) == NULL)
494: {
495: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
496: return;
497: }
498: }
499: else
500: {
501: if ((s_objet = allocation(s_etat_processus, MCX))
502: == NULL)
503: {
504: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
505: return;
506: }
507:
508: if (((*((struct_matrice *) (*s_objet).objet)).tableau =
509: malloc(nombre_lignes * sizeof(struct_complexe16 *)))
510: == NULL)
511: {
512: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
513: return;
514: }
515: }
516:
517: (*((struct_matrice *) (*s_objet).objet)).nombre_lignes = nombre_lignes;
518: (*((struct_matrice *) (*s_objet).objet)).nombre_colonnes =
519: nombre_colonnes;
520:
521: for(i = 0; i < nombre_lignes; i++)
522: {
523: if ((*((struct_matrice *) (*s_objet).objet)).type == 'I')
524: {
525: if ((((integer8 **) (*((struct_matrice *)
526: (*s_objet).objet)).tableau)[nombre_lignes - (i + 1)]
527: = malloc(nombre_colonnes * sizeof(integer8))) == NULL)
528: {
529: (*s_etat_processus).erreur_systeme =
530: d_es_allocation_memoire;
531: return;
532: }
533: }
534: else if ((*((struct_matrice *) (*s_objet).objet)).type == 'R')
535: {
536: if ((((real8 **) (*((struct_matrice *)
537: (*s_objet).objet)).tableau)[nombre_lignes - (i + 1)]
538: = malloc(nombre_colonnes * sizeof(real8))) == NULL)
539: {
540: (*s_etat_processus).erreur_systeme =
541: d_es_allocation_memoire;
542: return;
543: }
544: }
545: else
546: {
547: if ((((struct_complexe16 **) (*((struct_matrice *)
548: (*s_objet).objet)).tableau)[nombre_lignes - (i + 1)]
549: = malloc(nombre_colonnes * sizeof(struct_complexe16)))
550: == NULL)
551: {
552: (*s_etat_processus).erreur_systeme =
553: d_es_allocation_memoire;
554: return;
555: }
556: }
557:
558: for(j = 0; j < nombre_colonnes; j++)
559: {
560: if (depilement(s_etat_processus, &((*s_etat_processus)
561: .l_base_pile), &s_objet_elementaire) == d_erreur)
562: {
563: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
564: return;
565: }
566:
567: if ((*((struct_matrice *) (*s_objet).objet)).type == 'I')
568: {
569: ((integer8 **) (*((struct_matrice *) (*s_objet).objet))
570: .tableau)[nombre_lignes - (i + 1)]
571: [nombre_colonnes - (j + 1)] = (*((integer8 *)
572: (*s_objet_elementaire).objet));
573: }
574: else if ((*((struct_matrice *) (*s_objet).objet)).type == 'R')
575: {
576: if ((*s_objet_elementaire).type == INT)
577: {
578: ((real8 **) (*((struct_matrice *) (*s_objet).objet))
579: .tableau)[nombre_lignes - (i + 1)]
580: [nombre_colonnes - (j + 1)] =
581: (real8) (*((integer8 *)
582: (*s_objet_elementaire).objet));
583: }
584: else
585: {
586: ((real8 **) (*((struct_matrice *) (*s_objet).objet))
587: .tableau)[nombre_lignes - (i + 1)]
588: [nombre_colonnes - (j + 1)] = (*((real8 *)
589: (*s_objet_elementaire).objet));
590: }
591: }
592: else
593: {
594: if ((*s_objet_elementaire).type == INT)
595: {
596: ((struct_complexe16 **) (*((struct_matrice *)
597: (*s_objet).objet)).tableau)
598: [nombre_lignes - (i + 1)]
599: [nombre_colonnes - (j + 1)].partie_reelle =
600: (real8) (*((integer8 *)
601: (*s_objet_elementaire).objet));
602: ((struct_complexe16 **) (*((struct_matrice *)
603: (*s_objet).objet)).tableau)
604: [nombre_lignes - (i + 1)]
605: [nombre_colonnes - (j + 1)]
606: .partie_imaginaire = 0;
607: }
608: else if ((*s_objet_elementaire).type == REL)
609: {
610: ((struct_complexe16 **) (*((struct_matrice *)
611: (*s_objet).objet)).tableau)
612: [nombre_lignes - (i + 1)]
613: [nombre_colonnes - (j + 1)].partie_reelle =
614: (*((real8 *) (*s_objet_elementaire).objet));
615: ((struct_complexe16 **) (*((struct_matrice *)
616: (*s_objet).objet)).tableau)
617: [nombre_lignes - (i + 1)]
618: [nombre_colonnes - (j + 1)]
619: .partie_imaginaire = 0;
620: }
621: else
622: {
623: ((struct_complexe16 **) (*((struct_matrice *)
624: (*s_objet).objet)).tableau)
625: [nombre_lignes - (i + 1)]
626: [nombre_colonnes - (j + 1)].partie_reelle =
627: (*((struct_complexe16 *)
628: (*s_objet_elementaire).objet)).partie_reelle;
629: ((struct_complexe16 **) (*((struct_matrice *)
630: (*s_objet).objet)).tableau)
631: [nombre_lignes - (i + 1)]
632: [nombre_colonnes - (j + 1)].partie_imaginaire =
633: (*((struct_complexe16 *)
634: (*s_objet_elementaire).objet))
635: .partie_imaginaire;
636: }
637: }
638:
639: liberation(s_etat_processus, s_objet_elementaire);
640: }
641: }
642: }
643:
644: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
645: s_objet) == d_erreur)
646: {
647: return;
648: }
649:
650: return;
651: }
652:
653:
654: /*
655: ================================================================================
656: Fonction 'false'
657: ================================================================================
658: Entrées : structure processus
659: --------------------------------------------------------------------------------
660: Sorties :
661: --------------------------------------------------------------------------------
662: Effets de bord : néant
663: ================================================================================
664: */
665:
666: void
667: instruction_false(struct_processus *s_etat_processus)
668: {
669: struct_objet *s_objet;
670:
671: (*s_etat_processus).erreur_execution = d_ex;
672:
673: if ((*s_etat_processus).affichage_arguments == 'Y')
674: {
675: printf("\n FALSE ");
676:
677: if ((*s_etat_processus).langue == 'F')
678: {
679: printf("(valeur fausse)\n\n");
680: }
681: else
682: {
683: printf("(false value)\n\n");
684: }
685:
686: printf("-> 1: %s\n", d_INT);
687:
688: return;
689: }
690: else if ((*s_etat_processus).test_instruction == 'Y')
691: {
692: (*s_etat_processus).nombre_arguments = -1;
693: return;
694: }
695:
696: if ((s_objet = allocation(s_etat_processus, INT)) == NULL)
697: {
698: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
699: return;
700: }
701:
702: (*((integer8 *) (*s_objet).objet)) = 0;
703:
704: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
705: s_objet) == d_erreur)
706: {
707: return;
708: }
709:
710: return;
711: }
712:
713:
714: /*
715: ================================================================================
716: Fonction '->STR'
717: ================================================================================
718: Entrées : structure processus
719: --------------------------------------------------------------------------------
720: Sorties :
721: --------------------------------------------------------------------------------
722: Effets de bord : néant
723: ================================================================================
724: */
725:
726: void
727: instruction_fleche_str(struct_processus *s_etat_processus)
728: {
729: struct_objet *s_objet_argument;
730: struct_objet *s_objet_resultat;
731:
732: (*s_etat_processus).erreur_execution = d_ex;
733:
734: if ((*s_etat_processus).affichage_arguments == 'Y')
735: {
736: printf("\n ->STR ");
737:
738: if ((*s_etat_processus).langue == 'F')
739: {
740: printf("(conversion en chaîne)\n\n");
741: }
742: else
743: {
744: printf("(conversion into string of chars)\n\n");
745: }
746:
747: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
748: " %s, %s, %s, %s, %s,\n"
749: " %s, %s, %s, %s, %s,\n"
750: " %s\n",
751: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
752: d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
753: printf("-> 1: %s\n", d_INT);
754:
755: return;
756: }
757: else if ((*s_etat_processus).test_instruction == 'Y')
758: {
759: (*s_etat_processus).nombre_arguments = -1;
760: return;
761: }
762:
763: if (test_cfsf(s_etat_processus, 31) == d_vrai)
764: {
765: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
766: {
767: return;
768: }
769: }
770:
771: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
772: &s_objet_argument) == d_erreur)
773: {
774: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
775: return;
776: }
777:
778: if ((s_objet_resultat = allocation(s_etat_processus, CHN)) == NULL)
779: {
780: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
781: return;
782: }
783:
784: (*s_objet_resultat).objet = (void *) formateur(s_etat_processus, 0,
785: s_objet_argument);
786:
787: if ((*s_objet_resultat).objet == NULL)
788: {
789: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
790: return;
791: }
792:
793: liberation(s_etat_processus, s_objet_argument);
794:
795: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
796: s_objet_resultat) == d_erreur)
797: {
798: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
799: return;
800: }
801:
802: return;
803: }
804:
805:
806: /*
807: ================================================================================
808: Fonction 'FFT'
809: ================================================================================
810: Entrées : structure processus
811: --------------------------------------------------------------------------------
812: Sorties :
813: --------------------------------------------------------------------------------
814: Effets de bord : néant
815: ================================================================================
816: */
817:
818: void
819: instruction_fft(struct_processus *s_etat_processus)
820: {
821: integer4 erreur;
822: integer4 inverse;
823: integer4 nombre_colonnes;
824: integer4 nombre_lignes;
825:
826: logical1 presence_longueur_fft;
827:
828: long longueur_fft_signee;
829:
830: struct_complexe16 *matrice_f77;
831:
832: struct_objet *s_objet_argument;
833: struct_objet *s_objet_longueur_fft;
834: struct_objet *s_objet_resultat;
835:
836: unsigned long i;
837: unsigned long j;
838: unsigned long k;
839: unsigned long longueur_fft;
840:
841: (*s_etat_processus).erreur_execution =d_ex;
842:
843: if ((*s_etat_processus).affichage_arguments == 'Y')
844: {
845: printf("\n FFT ");
846:
847: if ((*s_etat_processus).langue == 'F')
848: {
849: printf("(transformée de Fourier rapide)\n\n");
850: }
851: else
852: {
853: printf("(fast Fourier transform)\n\n");
854: }
855:
856: printf(" 1: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
857: printf("-> 1: %s\n\n", d_VCX);
858:
859: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
860: printf("-> 1: %s\n\n", d_MCX);
861:
862: printf(" 2: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
863: printf(" 1: %s\n", d_INT);
864: printf("-> 1: %s\n\n", d_VCX);
865:
866: printf(" 2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
867: printf(" 1: %s\n", d_INT);
868: printf("-> 1: %s\n", d_MCX);
869:
870: return;
871: }
872: else if ((*s_etat_processus).test_instruction == 'Y')
873: {
874: (*s_etat_processus).nombre_arguments = -1;
875: return;
876: }
877:
878: /*
879: * Il est possible d'imposer une longueur de FFT au premier niveau
880: * de la pile.
881: */
882:
883: if ((*s_etat_processus).l_base_pile == NULL)
884: {
885: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
886: return;
887: }
888:
889: if ((*(*(*s_etat_processus).l_base_pile).donnee).type == INT)
890: {
891: presence_longueur_fft = d_vrai;
892:
893: if (test_cfsf(s_etat_processus, 31) == d_vrai)
894: {
895: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
896: {
897: return;
898: }
899: }
900:
901: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
902: &s_objet_longueur_fft) == d_erreur)
903: {
904: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
905: return;
906: }
907:
908: longueur_fft_signee = (*((integer8 *) (*s_objet_longueur_fft).objet));
909:
910: liberation(s_etat_processus, s_objet_longueur_fft);
911:
912: if (longueur_fft_signee <= 0)
913: {
914: (*s_etat_processus).erreur_execution = d_ex_longueur_fft;
915: return;
916: }
917:
918: longueur_fft = longueur_fft_signee;
919: }
920: else
921: {
922: presence_longueur_fft = d_faux;
923: longueur_fft = 0;
924:
925: if (test_cfsf(s_etat_processus, 31) == d_vrai)
926: {
927: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
928: {
929: return;
930: }
931: }
932: }
933:
934: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
935: &s_objet_argument) == d_erreur)
936: {
937: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
938: return;
939: }
940:
941: /*
942: --------------------------------------------------------------------------------
943: Vecteur
944: --------------------------------------------------------------------------------
945: */
946:
947: if (((*s_objet_argument).type == VIN) ||
948: ((*s_objet_argument).type == VRL) ||
949: ((*s_objet_argument).type == VCX))
950: {
951: if (presence_longueur_fft == d_faux)
952: {
953: longueur_fft = pow(2, (integer4) ceil(log((real8)
954: (*((struct_vecteur *)
955: (*s_objet_argument).objet)).taille) / log((real8) 2)));
956:
957: if ((longueur_fft / ((real8) (*((struct_vecteur *)
958: (*s_objet_argument).objet)).taille)) == 2)
959: {
960: longueur_fft /= 2;
961: }
962: }
963:
964: if ((matrice_f77 = malloc(longueur_fft *
965: sizeof(struct_complexe16))) == NULL)
966: {
967: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
968: return;
969: }
970:
971: if ((*s_objet_argument).type == VIN)
972: {
973: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet))
974: .taille; i++)
975: {
976: matrice_f77[i].partie_reelle = (real8) ((integer8 *)
977: (*((struct_vecteur *) (*s_objet_argument).objet))
978: .tableau)[i];
979: matrice_f77[i].partie_imaginaire = (real8) 0;
980: }
981: }
982: else if ((*s_objet_argument).type == VRL)
983: {
984: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet))
985: .taille; i++)
986: {
987: matrice_f77[i].partie_reelle = ((real8 *)
988: (*((struct_vecteur *) (*s_objet_argument).objet))
989: .tableau)[i];
990: matrice_f77[i].partie_imaginaire = (real8) 0;
991: }
992: }
993: else
994: {
995: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet))
996: .taille; i++)
997: {
998: matrice_f77[i].partie_reelle = ((struct_complexe16 *)
999: (*((struct_vecteur *) (*s_objet_argument).objet))
1000: .tableau)[i].partie_reelle;
1001: matrice_f77[i].partie_imaginaire = ((struct_complexe16 *)
1002: (*((struct_vecteur *) (*s_objet_argument).objet))
1003: .tableau)[i].partie_imaginaire;
1004: }
1005: }
1006:
1007: for(; i < longueur_fft; i++)
1008: {
1009: matrice_f77[i].partie_reelle = (real8) 0;
1010: matrice_f77[i].partie_imaginaire = (real8) 0;
1011: }
1012:
1013: nombre_lignes = 1;
1014: nombre_colonnes = longueur_fft;
1015: inverse = 0;
1016:
1017: dft(matrice_f77, &nombre_lignes, &nombre_colonnes, &inverse, &erreur);
1018:
1019: if (erreur != 0)
1020: {
1021: liberation(s_etat_processus, s_objet_argument);
1022: free(matrice_f77);
1023:
1024: (*s_etat_processus).erreur_execution = d_ex_longueur_fft;
1025: return;
1026: }
1027:
1028: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
1029: == NULL)
1030: {
1031: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1032: return;
1033: }
1034:
1035: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = longueur_fft;
1036: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau = matrice_f77;
1037: }
1038:
1039: /*
1040: --------------------------------------------------------------------------------
1041: Matrice
1042: --------------------------------------------------------------------------------
1043: */
1044:
1045: else if (((*s_objet_argument).type == MIN) ||
1046: ((*s_objet_argument).type == MRL) ||
1047: ((*s_objet_argument).type == MCX))
1048: {
1049: if (presence_longueur_fft == d_faux)
1050: {
1051: longueur_fft = pow(2, (integer4) ceil(log((real8)
1052: (*((struct_matrice *)
1053: (*s_objet_argument).objet)).nombre_colonnes) /
1054: log((real8) 2)));
1055:
1056: if ((longueur_fft / ((real8) (*((struct_matrice *)
1057: (*s_objet_argument).objet)).nombre_colonnes)) == 2)
1058: {
1059: longueur_fft /= 2;
1060: }
1061: }
1062:
1063: if ((matrice_f77 = malloc(longueur_fft *
1064: (*((struct_matrice *) (*s_objet_argument).objet))
1065: .nombre_lignes * sizeof(struct_complexe16))) == NULL)
1066: {
1067: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1068: return;
1069: }
1070:
1071: if ((*s_objet_argument).type == MIN)
1072: {
1073: for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_argument)
1074: .objet)).nombre_colonnes; i++)
1075: {
1076: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument)
1077: .objet)).nombre_lignes; j++)
1078: {
1079: matrice_f77[k].partie_reelle = (real8) ((integer8 **)
1080: (*((struct_matrice *) (*s_objet_argument).objet))
1081: .tableau)[j][i];
1082: matrice_f77[k++].partie_imaginaire = (real8) 0;
1083: }
1084: }
1085:
1086: for(; k < longueur_fft * (*((struct_matrice *) (*s_objet_argument)
1087: .objet)).nombre_lignes; k++)
1088: {
1089: matrice_f77[k].partie_reelle = (real8) 0;
1090: matrice_f77[k].partie_imaginaire = (real8) 0;
1091: }
1092: }
1093: else if ((*s_objet_argument).type == MRL)
1094: {
1095: for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_argument)
1096: .objet)).nombre_colonnes; i++)
1097: {
1098: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument)
1099: .objet)).nombre_lignes; j++)
1100: {
1101: matrice_f77[k].partie_reelle = ((real8 **)
1102: (*((struct_matrice *) (*s_objet_argument).objet))
1103: .tableau)[j][i];
1104: matrice_f77[k++].partie_imaginaire = (real8) 0;
1105: }
1106: }
1107:
1108: for(; k < longueur_fft * (*((struct_matrice *) (*s_objet_argument)
1109: .objet)).nombre_lignes; k++)
1110: {
1111: matrice_f77[k].partie_reelle = (real8) 0;
1112: matrice_f77[k].partie_imaginaire = (real8) 0;
1113: }
1114: }
1115: else
1116: {
1117: for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_argument)
1118: .objet)).nombre_colonnes; i++)
1119: {
1120: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument)
1121: .objet)).nombre_lignes; j++)
1122: {
1123: matrice_f77[k].partie_reelle = ((struct_complexe16 **)
1124: (*((struct_matrice *) (*s_objet_argument).objet))
1125: .tableau)[j][i].partie_reelle;
1126: matrice_f77[k++].partie_imaginaire =
1127: ((struct_complexe16 **) (*((struct_matrice *)
1128: (*s_objet_argument).objet)).tableau)[j][i]
1129: .partie_imaginaire;
1130: }
1131: }
1132:
1133: for(; k < longueur_fft * (*((struct_matrice *) (*s_objet_argument)
1134: .objet)).nombre_lignes; k++)
1135: {
1136: matrice_f77[k].partie_reelle = (real8) 0;
1137: matrice_f77[k].partie_imaginaire = (real8) 0;
1138: }
1139: }
1140:
1141: nombre_lignes = (*((struct_matrice *) (*s_objet_argument).objet))
1142: .nombre_lignes;
1143: nombre_colonnes = longueur_fft;
1144: inverse = 0;
1145:
1146: dft(matrice_f77, &nombre_lignes, &nombre_colonnes, &inverse, &erreur);
1147:
1148: if (erreur != 0)
1149: {
1150: liberation(s_etat_processus, s_objet_argument);
1151: free(matrice_f77);
1152:
1153: (*s_etat_processus).erreur_execution = d_ex_longueur_fft;
1154: return;
1155: }
1156:
1157: if ((s_objet_resultat = allocation(s_etat_processus, MCX))
1158: == NULL)
1159: {
1160: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1161: return;
1162: }
1163:
1164: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
1165: (*((struct_matrice *) (*s_objet_argument).objet))
1166: .nombre_lignes;
1167: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
1168: longueur_fft;
1169:
1170: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1171: malloc((*((struct_matrice *) (*s_objet_resultat).objet))
1172: .nombre_lignes * sizeof(struct_complexe16 *))) == NULL)
1173: {
1174: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1175: return;
1176: }
1177:
1178: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
1179: .nombre_lignes; i++)
1180: {
1181: if ((((struct_complexe16 **) (*((struct_matrice *)
1182: (*s_objet_resultat).objet)).tableau)[i] =
1183: malloc((*((struct_matrice *)
1184: (*s_objet_resultat).objet)).nombre_colonnes *
1185: sizeof(struct_complexe16))) == NULL)
1186: {
1187: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1188: return;
1189: }
1190: }
1191:
1192: for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
1193: .nombre_colonnes; i++)
1194: {
1195: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat).objet))
1196: .nombre_lignes; j++)
1197: {
1198: ((struct_complexe16 **) (*((struct_matrice *)
1199: (*s_objet_resultat).objet)).tableau)[j][i]
1200: .partie_reelle = matrice_f77[k].partie_reelle;
1201: ((struct_complexe16 **) (*((struct_matrice *)
1202: (*s_objet_resultat).objet)).tableau)[j][i]
1203: .partie_imaginaire = matrice_f77[k++].partie_imaginaire;
1204: }
1205: }
1206:
1207: free(matrice_f77);
1208: }
1209:
1210: /*
1211: --------------------------------------------------------------------------------
1212: Calcul de FFT impossible
1213: --------------------------------------------------------------------------------
1214: */
1215:
1216: else
1217: {
1218: liberation(s_etat_processus, s_objet_argument);
1219:
1220: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1221: return;
1222: }
1223:
1224: liberation(s_etat_processus, s_objet_argument);
1225:
1226: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1227: s_objet_resultat) == d_erreur)
1228: {
1229: return;
1230: }
1231:
1232: return;
1233: }
1234:
1235:
1236: /*
1237: ================================================================================
1238: Fonction 'function' (passe en mode d'affichage y=f(x))
1239: ================================================================================
1240: Entrées : structure processus
1241: --------------------------------------------------------------------------------
1242: Sorties :
1243: --------------------------------------------------------------------------------
1244: Effets de bord : néant
1245: ================================================================================
1246: */
1247:
1248: void
1249: instruction_function(struct_processus *s_etat_processus)
1250: {
1251: (*s_etat_processus).erreur_execution = d_ex;
1252:
1253: if ((*s_etat_processus).affichage_arguments == 'Y')
1254: {
1255: printf("\n FUNCTION ");
1256:
1257: if ((*s_etat_processus).langue == 'F')
1258: {
1259: printf("(tracé y=f(x))\n\n");
1260: printf(" Aucun argument\n");
1261: }
1262: else
1263: {
1264: printf("(plot y=f(x))\n\n");
1265: printf(" No argument\n");
1266: }
1267:
1268: return;
1269: }
1270: else if ((*s_etat_processus).test_instruction == 'Y')
1271: {
1272: (*s_etat_processus).nombre_arguments = -1;
1273: return;
1274: }
1275:
1276: strcpy((*s_etat_processus).type_trace_eq, "FONCTION");
1277:
1278: return;
1279: }
1280:
1281: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_f2.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src