1: /*
2: ================================================================================
3: RPL/2 (R) version 4.0.11
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: unsigned char *ligne;
733: unsigned char *ptr_e;
734: unsigned char *ptr_l;
735:
736: unsigned long caracteres_echappement;
737:
738: (*s_etat_processus).erreur_execution = d_ex;
739:
740: if ((*s_etat_processus).affichage_arguments == 'Y')
741: {
742: printf("\n ->STR ");
743:
744: if ((*s_etat_processus).langue == 'F')
745: {
746: printf("(conversion en chaîne)\n\n");
747: }
748: else
749: {
750: printf("(conversion into string of chars)\n\n");
751: }
752:
753: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
754: " %s, %s, %s, %s, %s,\n"
755: " %s, %s, %s, %s, %s,\n"
756: " %s\n",
757: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
758: d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
759: printf("-> 1: %s\n", d_INT);
760:
761: return;
762: }
763: else if ((*s_etat_processus).test_instruction == 'Y')
764: {
765: (*s_etat_processus).nombre_arguments = -1;
766: return;
767: }
768:
769: if (test_cfsf(s_etat_processus, 31) == d_vrai)
770: {
771: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
772: {
773: return;
774: }
775: }
776:
777: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
778: &s_objet_argument) == d_erreur)
779: {
780: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
781: return;
782: }
783:
784: if ((s_objet_resultat = allocation(s_etat_processus, CHN)) == NULL)
785: {
786: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
787: return;
788: }
789:
790: ligne = formateur(s_etat_processus, 0, s_objet_argument);
791: caracteres_echappement = 0;
792:
793: // Reconstitution des caractères d'échappement
794:
795: ptr_l = ligne;
796:
797: while((*ptr_l) != d_code_fin_chaine)
798: {
799: switch(*ptr_l)
800: {
801: case '\"':
802: case '\b':
803: case '\n':
804: case '\t':
805: {
806: caracteres_echappement++;
807: break;
808: }
809: }
810:
811: ptr_l++;
812: }
813:
814: if (((*s_objet_resultat).objet = malloc((strlen(ligne) + 1 +
815: caracteres_echappement) * sizeof(unsigned char))) == NULL)
816: {
817: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
818: return;
819: }
820:
821: ptr_l = ligne;
822: ptr_e = (*s_objet_resultat).objet;
823:
824: while((*ptr_l) != d_code_fin_chaine)
825: {
826: switch(*ptr_l)
827: {
828: case '\"':
829: {
830: (*ptr_e) = '\\';
831: (*(++ptr_e)) = '\"';
832: break;
833: }
834:
835: case '\b':
836: {
837: (*ptr_e) = '\\';
838: (*(++ptr_e)) = 'b';
839: break;
840: }
841:
842: case '\n':
843: {
844: (*ptr_e) = '\\';
845: (*(++ptr_e)) = 'n';
846: break;
847: }
848:
849: case '\t':
850: {
851: (*ptr_e) = '\\';
852: (*(++ptr_e)) = 't';
853: break;
854: }
855:
856: default:
857: {
858: (*ptr_e) = (*ptr_l);
859: break;
860: }
861: }
862:
863: ptr_l++;
864: ptr_e++;
865: }
866:
867: (*ptr_e) = d_code_fin_chaine;
868: free(ligne);
869:
870: liberation(s_etat_processus, s_objet_argument);
871:
872: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
873: s_objet_resultat) == d_erreur)
874: {
875: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
876: return;
877: }
878:
879: return;
880: }
881:
882:
883: /*
884: ================================================================================
885: Fonction 'FFT'
886: ================================================================================
887: Entrées : structure processus
888: --------------------------------------------------------------------------------
889: Sorties :
890: --------------------------------------------------------------------------------
891: Effets de bord : néant
892: ================================================================================
893: */
894:
895: void
896: instruction_fft(struct_processus *s_etat_processus)
897: {
898: integer4 erreur;
899: integer4 inverse;
900: integer4 nombre_colonnes;
901: integer4 nombre_lignes;
902:
903: logical1 presence_longueur_fft;
904:
905: long longueur_fft_signee;
906:
907: struct_complexe16 *matrice_f77;
908:
909: struct_objet *s_objet_argument;
910: struct_objet *s_objet_longueur_fft;
911: struct_objet *s_objet_resultat;
912:
913: unsigned long i;
914: unsigned long j;
915: unsigned long k;
916: unsigned long longueur_fft;
917:
918: (*s_etat_processus).erreur_execution =d_ex;
919:
920: if ((*s_etat_processus).affichage_arguments == 'Y')
921: {
922: printf("\n FFT ");
923:
924: if ((*s_etat_processus).langue == 'F')
925: {
926: printf("(transformée de Fourier rapide)\n\n");
927: }
928: else
929: {
930: printf("(fast Fourier transform)\n\n");
931: }
932:
933: printf(" 1: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
934: printf("-> 1: %s\n\n", d_VCX);
935:
936: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
937: printf("-> 1: %s\n\n", d_MCX);
938:
939: printf(" 2: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
940: printf(" 1: %s\n", d_INT);
941: printf("-> 1: %s\n\n", d_VCX);
942:
943: printf(" 2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
944: printf(" 1: %s\n", d_INT);
945: printf("-> 1: %s\n", d_MCX);
946:
947: return;
948: }
949: else if ((*s_etat_processus).test_instruction == 'Y')
950: {
951: (*s_etat_processus).nombre_arguments = -1;
952: return;
953: }
954:
955: /*
956: * Il est possible d'imposer une longueur de FFT au premier niveau
957: * de la pile.
958: */
959:
960: if ((*s_etat_processus).l_base_pile == NULL)
961: {
962: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
963: return;
964: }
965:
966: if ((*(*(*s_etat_processus).l_base_pile).donnee).type == INT)
967: {
968: presence_longueur_fft = d_vrai;
969:
970: if (test_cfsf(s_etat_processus, 31) == d_vrai)
971: {
972: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
973: {
974: return;
975: }
976: }
977:
978: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
979: &s_objet_longueur_fft) == d_erreur)
980: {
981: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
982: return;
983: }
984:
985: longueur_fft_signee = (*((integer8 *) (*s_objet_longueur_fft).objet));
986:
987: liberation(s_etat_processus, s_objet_longueur_fft);
988:
989: if (longueur_fft_signee <= 0)
990: {
991: (*s_etat_processus).erreur_execution = d_ex_longueur_fft;
992: return;
993: }
994:
995: longueur_fft = longueur_fft_signee;
996: }
997: else
998: {
999: presence_longueur_fft = d_faux;
1000: longueur_fft = 0;
1001:
1002: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1003: {
1004: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1005: {
1006: return;
1007: }
1008: }
1009: }
1010:
1011: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1012: &s_objet_argument) == d_erreur)
1013: {
1014: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1015: return;
1016: }
1017:
1018: /*
1019: --------------------------------------------------------------------------------
1020: Vecteur
1021: --------------------------------------------------------------------------------
1022: */
1023:
1024: if (((*s_objet_argument).type == VIN) ||
1025: ((*s_objet_argument).type == VRL) ||
1026: ((*s_objet_argument).type == VCX))
1027: {
1028: if (presence_longueur_fft == d_faux)
1029: {
1030: longueur_fft = pow(2, (integer4) ceil(log((real8)
1031: (*((struct_vecteur *)
1032: (*s_objet_argument).objet)).taille) / log((real8) 2)));
1033:
1034: if ((longueur_fft / ((real8) (*((struct_vecteur *)
1035: (*s_objet_argument).objet)).taille)) == 2)
1036: {
1037: longueur_fft /= 2;
1038: }
1039: }
1040:
1041: if ((matrice_f77 = malloc(longueur_fft *
1042: sizeof(struct_complexe16))) == NULL)
1043: {
1044: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1045: return;
1046: }
1047:
1048: if ((*s_objet_argument).type == VIN)
1049: {
1050: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet))
1051: .taille; i++)
1052: {
1053: matrice_f77[i].partie_reelle = (real8) ((integer8 *)
1054: (*((struct_vecteur *) (*s_objet_argument).objet))
1055: .tableau)[i];
1056: matrice_f77[i].partie_imaginaire = (real8) 0;
1057: }
1058: }
1059: else if ((*s_objet_argument).type == VRL)
1060: {
1061: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet))
1062: .taille; i++)
1063: {
1064: matrice_f77[i].partie_reelle = ((real8 *)
1065: (*((struct_vecteur *) (*s_objet_argument).objet))
1066: .tableau)[i];
1067: matrice_f77[i].partie_imaginaire = (real8) 0;
1068: }
1069: }
1070: else
1071: {
1072: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet))
1073: .taille; i++)
1074: {
1075: matrice_f77[i].partie_reelle = ((struct_complexe16 *)
1076: (*((struct_vecteur *) (*s_objet_argument).objet))
1077: .tableau)[i].partie_reelle;
1078: matrice_f77[i].partie_imaginaire = ((struct_complexe16 *)
1079: (*((struct_vecteur *) (*s_objet_argument).objet))
1080: .tableau)[i].partie_imaginaire;
1081: }
1082: }
1083:
1084: for(; i < longueur_fft; i++)
1085: {
1086: matrice_f77[i].partie_reelle = (real8) 0;
1087: matrice_f77[i].partie_imaginaire = (real8) 0;
1088: }
1089:
1090: nombre_lignes = 1;
1091: nombre_colonnes = longueur_fft;
1092: inverse = 0;
1093:
1094: dft(matrice_f77, &nombre_lignes, &nombre_colonnes, &inverse, &erreur);
1095:
1096: if (erreur != 0)
1097: {
1098: liberation(s_etat_processus, s_objet_argument);
1099: free(matrice_f77);
1100:
1101: (*s_etat_processus).erreur_execution = d_ex_longueur_fft;
1102: return;
1103: }
1104:
1105: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
1106: == NULL)
1107: {
1108: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1109: return;
1110: }
1111:
1112: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = longueur_fft;
1113: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau = matrice_f77;
1114: }
1115:
1116: /*
1117: --------------------------------------------------------------------------------
1118: Matrice
1119: --------------------------------------------------------------------------------
1120: */
1121:
1122: else if (((*s_objet_argument).type == MIN) ||
1123: ((*s_objet_argument).type == MRL) ||
1124: ((*s_objet_argument).type == MCX))
1125: {
1126: if (presence_longueur_fft == d_faux)
1127: {
1128: longueur_fft = pow(2, (integer4) ceil(log((real8)
1129: (*((struct_matrice *)
1130: (*s_objet_argument).objet)).nombre_colonnes) /
1131: log((real8) 2)));
1132:
1133: if ((longueur_fft / ((real8) (*((struct_matrice *)
1134: (*s_objet_argument).objet)).nombre_colonnes)) == 2)
1135: {
1136: longueur_fft /= 2;
1137: }
1138: }
1139:
1140: if ((matrice_f77 = malloc(longueur_fft *
1141: (*((struct_matrice *) (*s_objet_argument).objet))
1142: .nombre_lignes * sizeof(struct_complexe16))) == NULL)
1143: {
1144: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1145: return;
1146: }
1147:
1148: if ((*s_objet_argument).type == MIN)
1149: {
1150: for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_argument)
1151: .objet)).nombre_colonnes; i++)
1152: {
1153: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument)
1154: .objet)).nombre_lignes; j++)
1155: {
1156: matrice_f77[k].partie_reelle = (real8) ((integer8 **)
1157: (*((struct_matrice *) (*s_objet_argument).objet))
1158: .tableau)[j][i];
1159: matrice_f77[k++].partie_imaginaire = (real8) 0;
1160: }
1161: }
1162:
1163: for(; k < longueur_fft * (*((struct_matrice *) (*s_objet_argument)
1164: .objet)).nombre_lignes; k++)
1165: {
1166: matrice_f77[k].partie_reelle = (real8) 0;
1167: matrice_f77[k].partie_imaginaire = (real8) 0;
1168: }
1169: }
1170: else if ((*s_objet_argument).type == MRL)
1171: {
1172: for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_argument)
1173: .objet)).nombre_colonnes; i++)
1174: {
1175: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument)
1176: .objet)).nombre_lignes; j++)
1177: {
1178: matrice_f77[k].partie_reelle = ((real8 **)
1179: (*((struct_matrice *) (*s_objet_argument).objet))
1180: .tableau)[j][i];
1181: matrice_f77[k++].partie_imaginaire = (real8) 0;
1182: }
1183: }
1184:
1185: for(; k < longueur_fft * (*((struct_matrice *) (*s_objet_argument)
1186: .objet)).nombre_lignes; k++)
1187: {
1188: matrice_f77[k].partie_reelle = (real8) 0;
1189: matrice_f77[k].partie_imaginaire = (real8) 0;
1190: }
1191: }
1192: else
1193: {
1194: for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_argument)
1195: .objet)).nombre_colonnes; i++)
1196: {
1197: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument)
1198: .objet)).nombre_lignes; j++)
1199: {
1200: matrice_f77[k].partie_reelle = ((struct_complexe16 **)
1201: (*((struct_matrice *) (*s_objet_argument).objet))
1202: .tableau)[j][i].partie_reelle;
1203: matrice_f77[k++].partie_imaginaire =
1204: ((struct_complexe16 **) (*((struct_matrice *)
1205: (*s_objet_argument).objet)).tableau)[j][i]
1206: .partie_imaginaire;
1207: }
1208: }
1209:
1210: for(; k < longueur_fft * (*((struct_matrice *) (*s_objet_argument)
1211: .objet)).nombre_lignes; k++)
1212: {
1213: matrice_f77[k].partie_reelle = (real8) 0;
1214: matrice_f77[k].partie_imaginaire = (real8) 0;
1215: }
1216: }
1217:
1218: nombre_lignes = (*((struct_matrice *) (*s_objet_argument).objet))
1219: .nombre_lignes;
1220: nombre_colonnes = longueur_fft;
1221: inverse = 0;
1222:
1223: dft(matrice_f77, &nombre_lignes, &nombre_colonnes, &inverse, &erreur);
1224:
1225: if (erreur != 0)
1226: {
1227: liberation(s_etat_processus, s_objet_argument);
1228: free(matrice_f77);
1229:
1230: (*s_etat_processus).erreur_execution = d_ex_longueur_fft;
1231: return;
1232: }
1233:
1234: if ((s_objet_resultat = allocation(s_etat_processus, MCX))
1235: == NULL)
1236: {
1237: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1238: return;
1239: }
1240:
1241: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
1242: (*((struct_matrice *) (*s_objet_argument).objet))
1243: .nombre_lignes;
1244: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
1245: longueur_fft;
1246:
1247: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1248: malloc((*((struct_matrice *) (*s_objet_resultat).objet))
1249: .nombre_lignes * sizeof(struct_complexe16 *))) == NULL)
1250: {
1251: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1252: return;
1253: }
1254:
1255: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
1256: .nombre_lignes; i++)
1257: {
1258: if ((((struct_complexe16 **) (*((struct_matrice *)
1259: (*s_objet_resultat).objet)).tableau)[i] =
1260: malloc((*((struct_matrice *)
1261: (*s_objet_resultat).objet)).nombre_colonnes *
1262: sizeof(struct_complexe16))) == NULL)
1263: {
1264: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1265: return;
1266: }
1267: }
1268:
1269: for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
1270: .nombre_colonnes; i++)
1271: {
1272: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat).objet))
1273: .nombre_lignes; j++)
1274: {
1275: ((struct_complexe16 **) (*((struct_matrice *)
1276: (*s_objet_resultat).objet)).tableau)[j][i]
1277: .partie_reelle = matrice_f77[k].partie_reelle;
1278: ((struct_complexe16 **) (*((struct_matrice *)
1279: (*s_objet_resultat).objet)).tableau)[j][i]
1280: .partie_imaginaire = matrice_f77[k++].partie_imaginaire;
1281: }
1282: }
1283:
1284: free(matrice_f77);
1285: }
1286:
1287: /*
1288: --------------------------------------------------------------------------------
1289: Calcul de FFT impossible
1290: --------------------------------------------------------------------------------
1291: */
1292:
1293: else
1294: {
1295: liberation(s_etat_processus, s_objet_argument);
1296:
1297: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1298: return;
1299: }
1300:
1301: liberation(s_etat_processus, s_objet_argument);
1302:
1303: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1304: s_objet_resultat) == d_erreur)
1305: {
1306: return;
1307: }
1308:
1309: return;
1310: }
1311:
1312:
1313: /*
1314: ================================================================================
1315: Fonction 'function' (passe en mode d'affichage y=f(x))
1316: ================================================================================
1317: Entrées : structure processus
1318: --------------------------------------------------------------------------------
1319: Sorties :
1320: --------------------------------------------------------------------------------
1321: Effets de bord : néant
1322: ================================================================================
1323: */
1324:
1325: void
1326: instruction_function(struct_processus *s_etat_processus)
1327: {
1328: (*s_etat_processus).erreur_execution = d_ex;
1329:
1330: if ((*s_etat_processus).affichage_arguments == 'Y')
1331: {
1332: printf("\n FUNCTION ");
1333:
1334: if ((*s_etat_processus).langue == 'F')
1335: {
1336: printf("(tracé y=f(x))\n\n");
1337: printf(" Aucun argument\n");
1338: }
1339: else
1340: {
1341: printf("(plot y=f(x))\n\n");
1342: printf(" No argument\n");
1343: }
1344:
1345: return;
1346: }
1347: else if ((*s_etat_processus).test_instruction == 'Y')
1348: {
1349: (*s_etat_processus).nombre_arguments = -1;
1350: return;
1351: }
1352:
1353: strcpy((*s_etat_processus).type_trace_eq, "FONCTION");
1354:
1355: return;
1356: }
1357:
1358: // 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