1: /*
2: ================================================================================
3: RPL/2 (R) version 4.0.21
4: Copyright (C) 1989-2011 Dr. BERTRAND Joël
5:
6: This file is part of RPL/2.
7:
8: RPL/2 is free software; you can redistribute it and/or modify it
9: under the terms of the CeCILL V2 License as published by the french
10: CEA, CNRS and INRIA.
11:
12: RPL/2 is distributed in the hope that it will be useful, but WITHOUT
13: ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14: FITNESS FOR A PARTICULAR PURPOSE. See the CeCILL V2 License
15: for more details.
16:
17: You should have received a copy of the CeCILL License
18: along with RPL/2. If not, write to info@cecill.info.
19: ================================================================================
20: */
21:
22:
23: #include "rpl-conv.h"
24:
25:
26: /*
27: ================================================================================
28: Fonction '->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: case '\\':
806: {
807: caracteres_echappement++;
808: break;
809: }
810: }
811:
812: ptr_l++;
813: }
814:
815: if (((*s_objet_resultat).objet = malloc((strlen(ligne) + 1 +
816: caracteres_echappement) * sizeof(unsigned char))) == NULL)
817: {
818: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
819: return;
820: }
821:
822: ptr_l = ligne;
823: ptr_e = (*s_objet_resultat).objet;
824:
825: while((*ptr_l) != d_code_fin_chaine)
826: {
827: switch(*ptr_l)
828: {
829: case '\\':
830: {
831: (*ptr_e) = '\\';
832: (*(++ptr_e)) = '\\';
833: break;
834: }
835:
836: case '\"':
837: {
838: (*ptr_e) = '\\';
839: (*(++ptr_e)) = '\"';
840: break;
841: }
842:
843: case '\b':
844: {
845: (*ptr_e) = '\\';
846: (*(++ptr_e)) = 'b';
847: break;
848: }
849:
850: case '\n':
851: {
852: (*ptr_e) = '\\';
853: (*(++ptr_e)) = 'n';
854: break;
855: }
856:
857: case '\t':
858: {
859: (*ptr_e) = '\\';
860: (*(++ptr_e)) = 't';
861: break;
862: }
863:
864: default:
865: {
866: (*ptr_e) = (*ptr_l);
867: break;
868: }
869: }
870:
871: ptr_l++;
872: ptr_e++;
873: }
874:
875: (*ptr_e) = d_code_fin_chaine;
876: free(ligne);
877:
878: liberation(s_etat_processus, s_objet_argument);
879:
880: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
881: s_objet_resultat) == d_erreur)
882: {
883: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
884: return;
885: }
886:
887: return;
888: }
889:
890:
891: /*
892: ================================================================================
893: Fonction 'FFT'
894: ================================================================================
895: Entrées : structure processus
896: --------------------------------------------------------------------------------
897: Sorties :
898: --------------------------------------------------------------------------------
899: Effets de bord : néant
900: ================================================================================
901: */
902:
903: void
904: instruction_fft(struct_processus *s_etat_processus)
905: {
906: integer4 erreur;
907: integer4 inverse;
908: integer4 nombre_colonnes;
909: integer4 nombre_lignes;
910:
911: logical1 presence_longueur_fft;
912:
913: long longueur_fft_signee;
914:
915: struct_complexe16 *matrice_f77;
916:
917: struct_objet *s_objet_argument;
918: struct_objet *s_objet_longueur_fft;
919: struct_objet *s_objet_resultat;
920:
921: unsigned long i;
922: unsigned long j;
923: unsigned long k;
924: unsigned long longueur_fft;
925:
926: (*s_etat_processus).erreur_execution =d_ex;
927:
928: if ((*s_etat_processus).affichage_arguments == 'Y')
929: {
930: printf("\n FFT ");
931:
932: if ((*s_etat_processus).langue == 'F')
933: {
934: printf("(transformée de Fourier rapide)\n\n");
935: }
936: else
937: {
938: printf("(fast Fourier transform)\n\n");
939: }
940:
941: printf(" 1: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
942: printf("-> 1: %s\n\n", d_VCX);
943:
944: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
945: printf("-> 1: %s\n\n", d_MCX);
946:
947: printf(" 2: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
948: printf(" 1: %s\n", d_INT);
949: printf("-> 1: %s\n\n", d_VCX);
950:
951: printf(" 2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
952: printf(" 1: %s\n", d_INT);
953: printf("-> 1: %s\n", d_MCX);
954:
955: return;
956: }
957: else if ((*s_etat_processus).test_instruction == 'Y')
958: {
959: (*s_etat_processus).nombre_arguments = -1;
960: return;
961: }
962:
963: /*
964: * Il est possible d'imposer une longueur de FFT au premier niveau
965: * de la pile.
966: */
967:
968: if ((*s_etat_processus).l_base_pile == NULL)
969: {
970: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
971: return;
972: }
973:
974: if ((*(*(*s_etat_processus).l_base_pile).donnee).type == INT)
975: {
976: presence_longueur_fft = d_vrai;
977:
978: if (test_cfsf(s_etat_processus, 31) == d_vrai)
979: {
980: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
981: {
982: return;
983: }
984: }
985:
986: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
987: &s_objet_longueur_fft) == d_erreur)
988: {
989: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
990: return;
991: }
992:
993: longueur_fft_signee = (*((integer8 *) (*s_objet_longueur_fft).objet));
994:
995: liberation(s_etat_processus, s_objet_longueur_fft);
996:
997: if (longueur_fft_signee <= 0)
998: {
999: (*s_etat_processus).erreur_execution = d_ex_longueur_fft;
1000: return;
1001: }
1002:
1003: longueur_fft = longueur_fft_signee;
1004: }
1005: else
1006: {
1007: presence_longueur_fft = d_faux;
1008: longueur_fft = 0;
1009:
1010: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1011: {
1012: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1013: {
1014: return;
1015: }
1016: }
1017: }
1018:
1019: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1020: &s_objet_argument) == d_erreur)
1021: {
1022: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1023: return;
1024: }
1025:
1026: /*
1027: --------------------------------------------------------------------------------
1028: Vecteur
1029: --------------------------------------------------------------------------------
1030: */
1031:
1032: if (((*s_objet_argument).type == VIN) ||
1033: ((*s_objet_argument).type == VRL) ||
1034: ((*s_objet_argument).type == VCX))
1035: {
1036: if (presence_longueur_fft == d_faux)
1037: {
1038: longueur_fft = pow(2, (integer4) ceil(log((real8)
1039: (*((struct_vecteur *)
1040: (*s_objet_argument).objet)).taille) / log((real8) 2)));
1041:
1042: if ((longueur_fft / ((real8) (*((struct_vecteur *)
1043: (*s_objet_argument).objet)).taille)) == 2)
1044: {
1045: longueur_fft /= 2;
1046: }
1047: }
1048:
1049: if ((matrice_f77 = malloc(longueur_fft *
1050: sizeof(struct_complexe16))) == NULL)
1051: {
1052: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1053: return;
1054: }
1055:
1056: if ((*s_objet_argument).type == VIN)
1057: {
1058: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet))
1059: .taille; i++)
1060: {
1061: matrice_f77[i].partie_reelle = (real8) ((integer8 *)
1062: (*((struct_vecteur *) (*s_objet_argument).objet))
1063: .tableau)[i];
1064: matrice_f77[i].partie_imaginaire = (real8) 0;
1065: }
1066: }
1067: else if ((*s_objet_argument).type == VRL)
1068: {
1069: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet))
1070: .taille; i++)
1071: {
1072: matrice_f77[i].partie_reelle = ((real8 *)
1073: (*((struct_vecteur *) (*s_objet_argument).objet))
1074: .tableau)[i];
1075: matrice_f77[i].partie_imaginaire = (real8) 0;
1076: }
1077: }
1078: else
1079: {
1080: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet))
1081: .taille; i++)
1082: {
1083: matrice_f77[i].partie_reelle = ((struct_complexe16 *)
1084: (*((struct_vecteur *) (*s_objet_argument).objet))
1085: .tableau)[i].partie_reelle;
1086: matrice_f77[i].partie_imaginaire = ((struct_complexe16 *)
1087: (*((struct_vecteur *) (*s_objet_argument).objet))
1088: .tableau)[i].partie_imaginaire;
1089: }
1090: }
1091:
1092: for(; i < longueur_fft; i++)
1093: {
1094: matrice_f77[i].partie_reelle = (real8) 0;
1095: matrice_f77[i].partie_imaginaire = (real8) 0;
1096: }
1097:
1098: nombre_lignes = 1;
1099: nombre_colonnes = longueur_fft;
1100: inverse = 0;
1101:
1102: dft(matrice_f77, &nombre_lignes, &nombre_colonnes, &inverse, &erreur);
1103:
1104: if (erreur != 0)
1105: {
1106: liberation(s_etat_processus, s_objet_argument);
1107: free(matrice_f77);
1108:
1109: (*s_etat_processus).erreur_execution = d_ex_longueur_fft;
1110: return;
1111: }
1112:
1113: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
1114: == NULL)
1115: {
1116: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1117: return;
1118: }
1119:
1120: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = longueur_fft;
1121: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau = matrice_f77;
1122: }
1123:
1124: /*
1125: --------------------------------------------------------------------------------
1126: Matrice
1127: --------------------------------------------------------------------------------
1128: */
1129:
1130: else if (((*s_objet_argument).type == MIN) ||
1131: ((*s_objet_argument).type == MRL) ||
1132: ((*s_objet_argument).type == MCX))
1133: {
1134: if (presence_longueur_fft == d_faux)
1135: {
1136: longueur_fft = pow(2, (integer4) ceil(log((real8)
1137: (*((struct_matrice *)
1138: (*s_objet_argument).objet)).nombre_colonnes) /
1139: log((real8) 2)));
1140:
1141: if ((longueur_fft / ((real8) (*((struct_matrice *)
1142: (*s_objet_argument).objet)).nombre_colonnes)) == 2)
1143: {
1144: longueur_fft /= 2;
1145: }
1146: }
1147:
1148: if ((matrice_f77 = malloc(longueur_fft *
1149: (*((struct_matrice *) (*s_objet_argument).objet))
1150: .nombre_lignes * sizeof(struct_complexe16))) == NULL)
1151: {
1152: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1153: return;
1154: }
1155:
1156: if ((*s_objet_argument).type == MIN)
1157: {
1158: for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_argument)
1159: .objet)).nombre_colonnes; i++)
1160: {
1161: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument)
1162: .objet)).nombre_lignes; j++)
1163: {
1164: matrice_f77[k].partie_reelle = (real8) ((integer8 **)
1165: (*((struct_matrice *) (*s_objet_argument).objet))
1166: .tableau)[j][i];
1167: matrice_f77[k++].partie_imaginaire = (real8) 0;
1168: }
1169: }
1170:
1171: for(; k < longueur_fft * (*((struct_matrice *) (*s_objet_argument)
1172: .objet)).nombre_lignes; k++)
1173: {
1174: matrice_f77[k].partie_reelle = (real8) 0;
1175: matrice_f77[k].partie_imaginaire = (real8) 0;
1176: }
1177: }
1178: else if ((*s_objet_argument).type == MRL)
1179: {
1180: for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_argument)
1181: .objet)).nombre_colonnes; i++)
1182: {
1183: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument)
1184: .objet)).nombre_lignes; j++)
1185: {
1186: matrice_f77[k].partie_reelle = ((real8 **)
1187: (*((struct_matrice *) (*s_objet_argument).objet))
1188: .tableau)[j][i];
1189: matrice_f77[k++].partie_imaginaire = (real8) 0;
1190: }
1191: }
1192:
1193: for(; k < longueur_fft * (*((struct_matrice *) (*s_objet_argument)
1194: .objet)).nombre_lignes; k++)
1195: {
1196: matrice_f77[k].partie_reelle = (real8) 0;
1197: matrice_f77[k].partie_imaginaire = (real8) 0;
1198: }
1199: }
1200: else
1201: {
1202: for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_argument)
1203: .objet)).nombre_colonnes; i++)
1204: {
1205: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument)
1206: .objet)).nombre_lignes; j++)
1207: {
1208: matrice_f77[k].partie_reelle = ((struct_complexe16 **)
1209: (*((struct_matrice *) (*s_objet_argument).objet))
1210: .tableau)[j][i].partie_reelle;
1211: matrice_f77[k++].partie_imaginaire =
1212: ((struct_complexe16 **) (*((struct_matrice *)
1213: (*s_objet_argument).objet)).tableau)[j][i]
1214: .partie_imaginaire;
1215: }
1216: }
1217:
1218: for(; k < longueur_fft * (*((struct_matrice *) (*s_objet_argument)
1219: .objet)).nombre_lignes; k++)
1220: {
1221: matrice_f77[k].partie_reelle = (real8) 0;
1222: matrice_f77[k].partie_imaginaire = (real8) 0;
1223: }
1224: }
1225:
1226: nombre_lignes = (*((struct_matrice *) (*s_objet_argument).objet))
1227: .nombre_lignes;
1228: nombre_colonnes = longueur_fft;
1229: inverse = 0;
1230:
1231: dft(matrice_f77, &nombre_lignes, &nombre_colonnes, &inverse, &erreur);
1232:
1233: if (erreur != 0)
1234: {
1235: liberation(s_etat_processus, s_objet_argument);
1236: free(matrice_f77);
1237:
1238: (*s_etat_processus).erreur_execution = d_ex_longueur_fft;
1239: return;
1240: }
1241:
1242: if ((s_objet_resultat = allocation(s_etat_processus, MCX))
1243: == NULL)
1244: {
1245: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1246: return;
1247: }
1248:
1249: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
1250: (*((struct_matrice *) (*s_objet_argument).objet))
1251: .nombre_lignes;
1252: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
1253: longueur_fft;
1254:
1255: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1256: malloc((*((struct_matrice *) (*s_objet_resultat).objet))
1257: .nombre_lignes * sizeof(struct_complexe16 *))) == NULL)
1258: {
1259: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1260: return;
1261: }
1262:
1263: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
1264: .nombre_lignes; i++)
1265: {
1266: if ((((struct_complexe16 **) (*((struct_matrice *)
1267: (*s_objet_resultat).objet)).tableau)[i] =
1268: malloc((*((struct_matrice *)
1269: (*s_objet_resultat).objet)).nombre_colonnes *
1270: sizeof(struct_complexe16))) == NULL)
1271: {
1272: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1273: return;
1274: }
1275: }
1276:
1277: for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
1278: .nombre_colonnes; i++)
1279: {
1280: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat).objet))
1281: .nombre_lignes; j++)
1282: {
1283: ((struct_complexe16 **) (*((struct_matrice *)
1284: (*s_objet_resultat).objet)).tableau)[j][i]
1285: .partie_reelle = matrice_f77[k].partie_reelle;
1286: ((struct_complexe16 **) (*((struct_matrice *)
1287: (*s_objet_resultat).objet)).tableau)[j][i]
1288: .partie_imaginaire = matrice_f77[k++].partie_imaginaire;
1289: }
1290: }
1291:
1292: free(matrice_f77);
1293: }
1294:
1295: /*
1296: --------------------------------------------------------------------------------
1297: Calcul de FFT impossible
1298: --------------------------------------------------------------------------------
1299: */
1300:
1301: else
1302: {
1303: liberation(s_etat_processus, s_objet_argument);
1304:
1305: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1306: return;
1307: }
1308:
1309: liberation(s_etat_processus, s_objet_argument);
1310:
1311: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1312: s_objet_resultat) == d_erreur)
1313: {
1314: return;
1315: }
1316:
1317: return;
1318: }
1319:
1320:
1321: /*
1322: ================================================================================
1323: Fonction 'function' (passe en mode d'affichage y=f(x))
1324: ================================================================================
1325: Entrées : structure processus
1326: --------------------------------------------------------------------------------
1327: Sorties :
1328: --------------------------------------------------------------------------------
1329: Effets de bord : néant
1330: ================================================================================
1331: */
1332:
1333: void
1334: instruction_function(struct_processus *s_etat_processus)
1335: {
1336: (*s_etat_processus).erreur_execution = d_ex;
1337:
1338: if ((*s_etat_processus).affichage_arguments == 'Y')
1339: {
1340: printf("\n FUNCTION ");
1341:
1342: if ((*s_etat_processus).langue == 'F')
1343: {
1344: printf("(tracé y=f(x))\n\n");
1345: printf(" Aucun argument\n");
1346: }
1347: else
1348: {
1349: printf("(plot y=f(x))\n\n");
1350: printf(" No argument\n");
1351: }
1352:
1353: return;
1354: }
1355: else if ((*s_etat_processus).test_instruction == 'Y')
1356: {
1357: (*s_etat_processus).nombre_arguments = -1;
1358: return;
1359: }
1360:
1361: strcpy((*s_etat_processus).type_trace_eq, "FONCTION");
1362:
1363: return;
1364: }
1365:
1366: // 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