Annotation of rpl/src/instructions_f2.c, revision 1.50
1.1 bertrand 1: /*
2: ================================================================================
1.50 ! bertrand 3: RPL/2 (R) version 4.1.18
1.49 bertrand 4: Copyright (C) 1989-2014 Dr. BERTRAND Joël
1.1 bertrand 5:
6: This file is part of RPL/2.
7:
8: RPL/2 is free software; you can redistribute it and/or modify it
9: under the terms of the CeCILL V2 License as published by the french
10: CEA, CNRS and INRIA.
11:
12: RPL/2 is distributed in the hope that it will be useful, but WITHOUT
13: ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14: FITNESS FOR A PARTICULAR PURPOSE. See the CeCILL V2 License
15: for more details.
16:
17: You should have received a copy of the CeCILL License
18: along with RPL/2. If not, write to info@cecill.info.
19: ================================================================================
20: */
21:
22:
1.13 bertrand 23: #include "rpl-conv.h"
1.1 bertrand 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:
1.43 bertrand 167: integer8 i;
168: integer8 j;
169: integer8 nombre_colonnes;
170: integer8 nombre_lignes;
171: integer8 nombre_dimensions;
172: integer8 nombre_termes;
1.1 bertrand 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 =
1.43 bertrand 346: malloc(((size_t) nombre_lignes) * sizeof(integer8)))
347: == NULL)
1.1 bertrand 348: {
349: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
350: return;
351: }
352: }
353: else if (type == VRL)
354: {
355: if ((s_objet = allocation(s_etat_processus, VRL)) == NULL)
356: {
357: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
358: return;
359: }
360:
361: if (((*((struct_vecteur *) (*s_objet).objet)).tableau =
1.43 bertrand 362: malloc(((size_t) nombre_lignes) * sizeof(real8))) == NULL)
1.1 bertrand 363: {
364: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
365: return;
366: }
367: }
368: else
369: {
370: if ((s_objet = allocation(s_etat_processus, VCX)) == NULL)
371: {
372: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
373: return;
374: }
375:
376: if (((*((struct_vecteur *) (*s_objet).objet)).tableau =
1.43 bertrand 377: malloc(((size_t) nombre_lignes) *
378: sizeof(struct_complexe16))) == NULL)
1.1 bertrand 379: {
380: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
381: return;
382: }
383: }
384:
385: (*((struct_vecteur *) (*s_objet).objet)).taille = nombre_lignes;
386:
387: for(i = 0; i < nombre_lignes; i++)
388: {
389: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
390: &s_objet_elementaire) == d_erreur)
391: {
392: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
393: return;
394: }
395:
396: if ((*((struct_vecteur *) (*s_objet).objet)).type == 'I')
397: {
398: ((integer8 *) (*((struct_vecteur *) (*s_objet).objet))
399: .tableau)[nombre_lignes - (i + 1)] = (*((integer8 *)
400: (*s_objet_elementaire).objet));
401: }
402: else if ((*((struct_vecteur *) (*s_objet).objet)).type == 'R')
403: {
404: if ((*s_objet_elementaire).type == INT)
405: {
406: ((real8 *) (*((struct_vecteur *) (*s_objet).objet))
407: .tableau)[nombre_lignes - (i + 1)] =
408: (real8) (*((integer8 *)
409: (*s_objet_elementaire).objet));
410: }
411: else
412: {
413: ((real8 *) (*((struct_vecteur *) (*s_objet).objet))
414: .tableau)[nombre_lignes - (i + 1)] = (*((real8 *)
415: (*s_objet_elementaire).objet));
416: }
417: }
418: else
419: {
420: if ((*s_objet_elementaire).type == INT)
421: {
422: ((struct_complexe16 *) (*((struct_vecteur *)
423: (*s_objet).objet)).tableau)
424: [nombre_lignes - (i + 1)].partie_reelle =
425: (real8) (*((integer8 *)
426: (*s_objet_elementaire).objet));
427: ((struct_complexe16 *) (*((struct_vecteur *)
428: (*s_objet).objet)).tableau)
429: [nombre_lignes - (i + 1)].partie_imaginaire = 0;
430: }
431: else if ((*s_objet_elementaire).type == REL)
432: {
433: ((struct_complexe16 *) (*((struct_vecteur *)
434: (*s_objet).objet)).tableau)
435: [nombre_lignes - (i + 1)].partie_reelle =
436: (*((real8 *) (*s_objet_elementaire).objet));
437: ((struct_complexe16 *) (*((struct_vecteur *)
438: (*s_objet).objet)).tableau)
439: [nombre_lignes - (i + 1)].partie_imaginaire = 0;
440: }
441: else
442: {
443: ((struct_complexe16 *) (*((struct_vecteur *)
444: (*s_objet).objet)).tableau)
445: [nombre_lignes - (i + 1)].partie_reelle =
446: (*((struct_complexe16 *)
447: (*s_objet_elementaire).objet)).partie_reelle;
448: ((struct_complexe16 *) (*((struct_vecteur *)
449: (*s_objet).objet)).tableau)
450: [nombre_lignes - (i + 1)].partie_imaginaire =
451: (*((struct_complexe16 *)
452: (*s_objet_elementaire).objet)).partie_imaginaire;
453: }
454: }
455:
456: liberation(s_etat_processus, s_objet_elementaire);
457: }
458: }
459:
460: /*
461: --------------------------------------------------------------------------------
462: Traitement des matrices
463: --------------------------------------------------------------------------------
464: */
465:
466: else
467: {
468: if (type == MIN)
469: {
470: if ((s_objet = allocation(s_etat_processus, MIN))
471: == NULL)
472: {
473: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
474: return;
475: }
476:
477: if (((*((struct_matrice *) (*s_objet).objet)).tableau =
1.43 bertrand 478: malloc(((size_t) nombre_lignes) * sizeof(integer8 *)))
479: == NULL)
1.1 bertrand 480: {
481: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
482: return;
483: }
484: }
485: else if (type == MRL)
486: {
487: if ((s_objet = allocation(s_etat_processus, MRL))
488: == NULL)
489: {
490: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
491: return;
492: }
493:
494: if (((*((struct_matrice *) (*s_objet).objet)).tableau =
1.43 bertrand 495: malloc(((size_t) nombre_lignes) * sizeof(real8 *))) == NULL)
1.1 bertrand 496: {
497: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
498: return;
499: }
500: }
501: else
502: {
503: if ((s_objet = allocation(s_etat_processus, MCX))
504: == NULL)
505: {
506: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
507: return;
508: }
509:
510: if (((*((struct_matrice *) (*s_objet).objet)).tableau =
1.43 bertrand 511: malloc(((size_t) nombre_lignes) *
512: sizeof(struct_complexe16 *))) == NULL)
1.1 bertrand 513: {
514: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
515: return;
516: }
517: }
518:
519: (*((struct_matrice *) (*s_objet).objet)).nombre_lignes = nombre_lignes;
520: (*((struct_matrice *) (*s_objet).objet)).nombre_colonnes =
521: nombre_colonnes;
522:
523: for(i = 0; i < nombre_lignes; i++)
524: {
525: if ((*((struct_matrice *) (*s_objet).objet)).type == 'I')
526: {
527: if ((((integer8 **) (*((struct_matrice *)
528: (*s_objet).objet)).tableau)[nombre_lignes - (i + 1)]
1.43 bertrand 529: = malloc(((size_t) nombre_colonnes) *
530: sizeof(integer8))) == NULL)
1.1 bertrand 531: {
532: (*s_etat_processus).erreur_systeme =
533: d_es_allocation_memoire;
534: return;
535: }
536: }
537: else if ((*((struct_matrice *) (*s_objet).objet)).type == 'R')
538: {
539: if ((((real8 **) (*((struct_matrice *)
540: (*s_objet).objet)).tableau)[nombre_lignes - (i + 1)]
1.43 bertrand 541: = malloc(((size_t) nombre_colonnes) * sizeof(real8)))
542: == NULL)
1.1 bertrand 543: {
544: (*s_etat_processus).erreur_systeme =
545: d_es_allocation_memoire;
546: return;
547: }
548: }
549: else
550: {
551: if ((((struct_complexe16 **) (*((struct_matrice *)
552: (*s_objet).objet)).tableau)[nombre_lignes - (i + 1)]
1.43 bertrand 553: = malloc(((size_t) nombre_colonnes)
554: * sizeof(struct_complexe16))) == NULL)
1.1 bertrand 555: {
556: (*s_etat_processus).erreur_systeme =
557: d_es_allocation_memoire;
558: return;
559: }
560: }
561:
562: for(j = 0; j < nombre_colonnes; j++)
563: {
564: if (depilement(s_etat_processus, &((*s_etat_processus)
565: .l_base_pile), &s_objet_elementaire) == d_erreur)
566: {
567: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
568: return;
569: }
570:
571: if ((*((struct_matrice *) (*s_objet).objet)).type == 'I')
572: {
573: ((integer8 **) (*((struct_matrice *) (*s_objet).objet))
574: .tableau)[nombre_lignes - (i + 1)]
575: [nombre_colonnes - (j + 1)] = (*((integer8 *)
576: (*s_objet_elementaire).objet));
577: }
578: else if ((*((struct_matrice *) (*s_objet).objet)).type == 'R')
579: {
580: if ((*s_objet_elementaire).type == INT)
581: {
582: ((real8 **) (*((struct_matrice *) (*s_objet).objet))
583: .tableau)[nombre_lignes - (i + 1)]
584: [nombre_colonnes - (j + 1)] =
585: (real8) (*((integer8 *)
586: (*s_objet_elementaire).objet));
587: }
588: else
589: {
590: ((real8 **) (*((struct_matrice *) (*s_objet).objet))
591: .tableau)[nombre_lignes - (i + 1)]
592: [nombre_colonnes - (j + 1)] = (*((real8 *)
593: (*s_objet_elementaire).objet));
594: }
595: }
596: else
597: {
598: if ((*s_objet_elementaire).type == INT)
599: {
600: ((struct_complexe16 **) (*((struct_matrice *)
601: (*s_objet).objet)).tableau)
602: [nombre_lignes - (i + 1)]
603: [nombre_colonnes - (j + 1)].partie_reelle =
604: (real8) (*((integer8 *)
605: (*s_objet_elementaire).objet));
606: ((struct_complexe16 **) (*((struct_matrice *)
607: (*s_objet).objet)).tableau)
608: [nombre_lignes - (i + 1)]
609: [nombre_colonnes - (j + 1)]
610: .partie_imaginaire = 0;
611: }
612: else if ((*s_objet_elementaire).type == REL)
613: {
614: ((struct_complexe16 **) (*((struct_matrice *)
615: (*s_objet).objet)).tableau)
616: [nombre_lignes - (i + 1)]
617: [nombre_colonnes - (j + 1)].partie_reelle =
618: (*((real8 *) (*s_objet_elementaire).objet));
619: ((struct_complexe16 **) (*((struct_matrice *)
620: (*s_objet).objet)).tableau)
621: [nombre_lignes - (i + 1)]
622: [nombre_colonnes - (j + 1)]
623: .partie_imaginaire = 0;
624: }
625: else
626: {
627: ((struct_complexe16 **) (*((struct_matrice *)
628: (*s_objet).objet)).tableau)
629: [nombre_lignes - (i + 1)]
630: [nombre_colonnes - (j + 1)].partie_reelle =
631: (*((struct_complexe16 *)
632: (*s_objet_elementaire).objet)).partie_reelle;
633: ((struct_complexe16 **) (*((struct_matrice *)
634: (*s_objet).objet)).tableau)
635: [nombre_lignes - (i + 1)]
636: [nombre_colonnes - (j + 1)].partie_imaginaire =
637: (*((struct_complexe16 *)
638: (*s_objet_elementaire).objet))
639: .partie_imaginaire;
640: }
641: }
642:
643: liberation(s_etat_processus, s_objet_elementaire);
644: }
645: }
646: }
647:
648: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
649: s_objet) == d_erreur)
650: {
651: return;
652: }
653:
654: return;
655: }
656:
657:
658: /*
659: ================================================================================
660: Fonction 'false'
661: ================================================================================
662: Entrées : structure processus
663: --------------------------------------------------------------------------------
664: Sorties :
665: --------------------------------------------------------------------------------
666: Effets de bord : néant
667: ================================================================================
668: */
669:
670: void
671: instruction_false(struct_processus *s_etat_processus)
672: {
673: struct_objet *s_objet;
674:
675: (*s_etat_processus).erreur_execution = d_ex;
676:
677: if ((*s_etat_processus).affichage_arguments == 'Y')
678: {
679: printf("\n FALSE ");
680:
681: if ((*s_etat_processus).langue == 'F')
682: {
683: printf("(valeur fausse)\n\n");
684: }
685: else
686: {
687: printf("(false value)\n\n");
688: }
689:
690: printf("-> 1: %s\n", d_INT);
691:
692: return;
693: }
694: else if ((*s_etat_processus).test_instruction == 'Y')
695: {
696: (*s_etat_processus).nombre_arguments = -1;
697: return;
698: }
699:
700: if ((s_objet = allocation(s_etat_processus, INT)) == NULL)
701: {
702: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
703: return;
704: }
705:
706: (*((integer8 *) (*s_objet).objet)) = 0;
707:
708: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
709: s_objet) == d_erreur)
710: {
711: return;
712: }
713:
714: return;
715: }
716:
717:
718: /*
719: ================================================================================
720: Fonction '->STR'
721: ================================================================================
722: Entrées : structure processus
723: --------------------------------------------------------------------------------
724: Sorties :
725: --------------------------------------------------------------------------------
726: Effets de bord : néant
727: ================================================================================
728: */
729:
730: void
731: instruction_fleche_str(struct_processus *s_etat_processus)
732: {
733: struct_objet *s_objet_argument;
734: struct_objet *s_objet_resultat;
735:
1.4 bertrand 736: unsigned char *ligne;
737: unsigned char *ptr_e;
738: unsigned char *ptr_l;
739:
1.43 bertrand 740: integer8 caracteres_echappement;
1.4 bertrand 741:
1.1 bertrand 742: (*s_etat_processus).erreur_execution = d_ex;
743:
744: if ((*s_etat_processus).affichage_arguments == 'Y')
745: {
746: printf("\n ->STR ");
747:
748: if ((*s_etat_processus).langue == 'F')
749: {
750: printf("(conversion en chaîne)\n\n");
751: }
752: else
753: {
754: printf("(conversion into string of chars)\n\n");
755: }
756:
757: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
758: " %s, %s, %s, %s, %s,\n"
759: " %s, %s, %s, %s, %s,\n"
760: " %s\n",
761: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
762: d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
763: printf("-> 1: %s\n", d_INT);
764:
765: return;
766: }
767: else if ((*s_etat_processus).test_instruction == 'Y')
768: {
769: (*s_etat_processus).nombre_arguments = -1;
770: return;
771: }
772:
773: if (test_cfsf(s_etat_processus, 31) == d_vrai)
774: {
775: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
776: {
777: return;
778: }
779: }
780:
781: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
782: &s_objet_argument) == d_erreur)
783: {
784: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
785: return;
786: }
787:
788: if ((s_objet_resultat = allocation(s_etat_processus, CHN)) == NULL)
789: {
790: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
791: return;
792: }
793:
1.4 bertrand 794: ligne = formateur(s_etat_processus, 0, s_objet_argument);
795: caracteres_echappement = 0;
796:
797: // Reconstitution des caractères d'échappement
1.1 bertrand 798:
1.4 bertrand 799: ptr_l = ligne;
800:
801: while((*ptr_l) != d_code_fin_chaine)
802: {
803: switch(*ptr_l)
804: {
805: case '\"':
806: case '\b':
807: case '\n':
808: case '\t':
1.5 bertrand 809: case '\\':
1.4 bertrand 810: {
811: caracteres_echappement++;
812: break;
813: }
814: }
815:
816: ptr_l++;
817: }
818:
819: if (((*s_objet_resultat).objet = malloc((strlen(ligne) + 1 +
1.43 bertrand 820: ((size_t) caracteres_echappement)) * sizeof(unsigned char)))
821: == NULL)
1.1 bertrand 822: {
823: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
824: return;
825: }
826:
1.4 bertrand 827: ptr_l = ligne;
828: ptr_e = (*s_objet_resultat).objet;
829:
830: while((*ptr_l) != d_code_fin_chaine)
831: {
832: switch(*ptr_l)
833: {
1.5 bertrand 834: case '\\':
835: {
836: (*ptr_e) = '\\';
837: (*(++ptr_e)) = '\\';
838: break;
839: }
840:
1.4 bertrand 841: case '\"':
842: {
843: (*ptr_e) = '\\';
844: (*(++ptr_e)) = '\"';
845: break;
846: }
847:
848: case '\b':
849: {
850: (*ptr_e) = '\\';
851: (*(++ptr_e)) = 'b';
852: break;
853: }
854:
855: case '\n':
856: {
857: (*ptr_e) = '\\';
858: (*(++ptr_e)) = 'n';
859: break;
860: }
861:
862: case '\t':
863: {
864: (*ptr_e) = '\\';
865: (*(++ptr_e)) = 't';
866: break;
867: }
868:
869: default:
870: {
871: (*ptr_e) = (*ptr_l);
872: break;
873: }
874: }
875:
876: ptr_l++;
877: ptr_e++;
878: }
879:
880: (*ptr_e) = d_code_fin_chaine;
881: free(ligne);
882:
1.1 bertrand 883: liberation(s_etat_processus, s_objet_argument);
884:
885: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
886: s_objet_resultat) == d_erreur)
887: {
888: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
889: return;
890: }
891:
892: return;
893: }
894:
895:
896: /*
897: ================================================================================
898: Fonction 'FFT'
899: ================================================================================
900: Entrées : structure processus
901: --------------------------------------------------------------------------------
902: Sorties :
903: --------------------------------------------------------------------------------
904: Effets de bord : néant
905: ================================================================================
906: */
907:
908: void
909: instruction_fft(struct_processus *s_etat_processus)
910: {
911: integer4 erreur;
912: integer4 inverse;
913: integer4 nombre_colonnes;
914: integer4 nombre_lignes;
915:
1.44 bertrand 916: integer8 longueur_fft_signee;
917:
1.1 bertrand 918: logical1 presence_longueur_fft;
919:
920: struct_complexe16 *matrice_f77;
921:
922: struct_objet *s_objet_argument;
923: struct_objet *s_objet_longueur_fft;
924: struct_objet *s_objet_resultat;
925:
1.43 bertrand 926: integer8 i;
927: integer8 j;
928: integer8 k;
929: integer8 longueur_fft;
1.1 bertrand 930:
931: (*s_etat_processus).erreur_execution =d_ex;
932:
933: if ((*s_etat_processus).affichage_arguments == 'Y')
934: {
935: printf("\n FFT ");
936:
937: if ((*s_etat_processus).langue == 'F')
938: {
939: printf("(transformée de Fourier rapide)\n\n");
940: }
941: else
942: {
943: printf("(fast Fourier transform)\n\n");
944: }
945:
946: printf(" 1: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
947: printf("-> 1: %s\n\n", d_VCX);
948:
949: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
950: printf("-> 1: %s\n\n", d_MCX);
951:
952: printf(" 2: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
953: printf(" 1: %s\n", d_INT);
954: printf("-> 1: %s\n\n", d_VCX);
955:
956: printf(" 2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
957: printf(" 1: %s\n", d_INT);
958: printf("-> 1: %s\n", d_MCX);
959:
960: return;
961: }
962: else if ((*s_etat_processus).test_instruction == 'Y')
963: {
964: (*s_etat_processus).nombre_arguments = -1;
965: return;
966: }
967:
968: /*
969: * Il est possible d'imposer une longueur de FFT au premier niveau
970: * de la pile.
971: */
972:
973: if ((*s_etat_processus).l_base_pile == NULL)
974: {
975: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
976: return;
977: }
978:
979: if ((*(*(*s_etat_processus).l_base_pile).donnee).type == INT)
980: {
981: presence_longueur_fft = d_vrai;
982:
983: if (test_cfsf(s_etat_processus, 31) == d_vrai)
984: {
985: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
986: {
987: return;
988: }
989: }
990:
991: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
992: &s_objet_longueur_fft) == d_erreur)
993: {
994: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
995: return;
996: }
997:
998: longueur_fft_signee = (*((integer8 *) (*s_objet_longueur_fft).objet));
999:
1000: liberation(s_etat_processus, s_objet_longueur_fft);
1001:
1002: if (longueur_fft_signee <= 0)
1003: {
1004: (*s_etat_processus).erreur_execution = d_ex_longueur_fft;
1005: return;
1006: }
1007:
1008: longueur_fft = longueur_fft_signee;
1009: }
1010: else
1011: {
1012: presence_longueur_fft = d_faux;
1013: longueur_fft = 0;
1014:
1015: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1016: {
1017: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1018: {
1019: return;
1020: }
1021: }
1022: }
1023:
1024: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1025: &s_objet_argument) == d_erreur)
1026: {
1027: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1028: return;
1029: }
1030:
1031: /*
1032: --------------------------------------------------------------------------------
1033: Vecteur
1034: --------------------------------------------------------------------------------
1035: */
1036:
1037: if (((*s_objet_argument).type == VIN) ||
1038: ((*s_objet_argument).type == VRL) ||
1039: ((*s_objet_argument).type == VCX))
1040: {
1041: if (presence_longueur_fft == d_faux)
1042: {
1.43 bertrand 1043: longueur_fft = (integer8) pow(2, ceil(log((real8)
1.1 bertrand 1044: (*((struct_vecteur *)
1045: (*s_objet_argument).objet)).taille) / log((real8) 2)));
1046:
1.43 bertrand 1047: if ((((real8) longueur_fft) / ((real8) (*((struct_vecteur *)
1.1 bertrand 1048: (*s_objet_argument).objet)).taille)) == 2)
1049: {
1050: longueur_fft /= 2;
1051: }
1052: }
1053:
1.43 bertrand 1054: if ((matrice_f77 = malloc(((size_t) longueur_fft) *
1.1 bertrand 1055: sizeof(struct_complexe16))) == NULL)
1056: {
1057: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1058: return;
1059: }
1060:
1061: if ((*s_objet_argument).type == VIN)
1062: {
1063: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet))
1064: .taille; i++)
1065: {
1066: matrice_f77[i].partie_reelle = (real8) ((integer8 *)
1067: (*((struct_vecteur *) (*s_objet_argument).objet))
1068: .tableau)[i];
1069: matrice_f77[i].partie_imaginaire = (real8) 0;
1070: }
1071: }
1072: else if ((*s_objet_argument).type == VRL)
1073: {
1074: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet))
1075: .taille; i++)
1076: {
1077: matrice_f77[i].partie_reelle = ((real8 *)
1078: (*((struct_vecteur *) (*s_objet_argument).objet))
1079: .tableau)[i];
1080: matrice_f77[i].partie_imaginaire = (real8) 0;
1081: }
1082: }
1083: else
1084: {
1085: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet))
1086: .taille; i++)
1087: {
1088: matrice_f77[i].partie_reelle = ((struct_complexe16 *)
1089: (*((struct_vecteur *) (*s_objet_argument).objet))
1090: .tableau)[i].partie_reelle;
1091: matrice_f77[i].partie_imaginaire = ((struct_complexe16 *)
1092: (*((struct_vecteur *) (*s_objet_argument).objet))
1093: .tableau)[i].partie_imaginaire;
1094: }
1095: }
1096:
1097: for(; i < longueur_fft; i++)
1098: {
1099: matrice_f77[i].partie_reelle = (real8) 0;
1100: matrice_f77[i].partie_imaginaire = (real8) 0;
1101: }
1102:
1103: nombre_lignes = 1;
1.43 bertrand 1104: nombre_colonnes = (integer4) longueur_fft;
1.1 bertrand 1105: inverse = 0;
1106:
1107: dft(matrice_f77, &nombre_lignes, &nombre_colonnes, &inverse, &erreur);
1108:
1109: if (erreur != 0)
1110: {
1111: liberation(s_etat_processus, s_objet_argument);
1112: free(matrice_f77);
1113:
1114: (*s_etat_processus).erreur_execution = d_ex_longueur_fft;
1115: return;
1116: }
1117:
1118: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
1119: == NULL)
1120: {
1121: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1122: return;
1123: }
1124:
1125: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = longueur_fft;
1126: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau = matrice_f77;
1127: }
1128:
1129: /*
1130: --------------------------------------------------------------------------------
1131: Matrice
1132: --------------------------------------------------------------------------------
1133: */
1134:
1135: else if (((*s_objet_argument).type == MIN) ||
1136: ((*s_objet_argument).type == MRL) ||
1137: ((*s_objet_argument).type == MCX))
1138: {
1139: if (presence_longueur_fft == d_faux)
1140: {
1.43 bertrand 1141: longueur_fft = (integer8) pow(2, ceil(log((real8)
1.1 bertrand 1142: (*((struct_matrice *)
1143: (*s_objet_argument).objet)).nombre_colonnes) /
1144: log((real8) 2)));
1145:
1.43 bertrand 1146: if ((((real8) longueur_fft) / ((real8) (*((struct_matrice *)
1.1 bertrand 1147: (*s_objet_argument).objet)).nombre_colonnes)) == 2)
1148: {
1149: longueur_fft /= 2;
1150: }
1151: }
1152:
1.43 bertrand 1153: if ((matrice_f77 = malloc(((size_t) longueur_fft) * ((size_t)
1.1 bertrand 1154: (*((struct_matrice *) (*s_objet_argument).objet))
1.43 bertrand 1155: .nombre_lignes) * sizeof(struct_complexe16))) == NULL)
1.1 bertrand 1156: {
1157: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1158: return;
1159: }
1160:
1161: if ((*s_objet_argument).type == MIN)
1162: {
1163: for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_argument)
1164: .objet)).nombre_colonnes; i++)
1165: {
1166: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument)
1167: .objet)).nombre_lignes; j++)
1168: {
1169: matrice_f77[k].partie_reelle = (real8) ((integer8 **)
1170: (*((struct_matrice *) (*s_objet_argument).objet))
1171: .tableau)[j][i];
1172: matrice_f77[k++].partie_imaginaire = (real8) 0;
1173: }
1174: }
1175:
1176: for(; k < longueur_fft * (*((struct_matrice *) (*s_objet_argument)
1177: .objet)).nombre_lignes; k++)
1178: {
1179: matrice_f77[k].partie_reelle = (real8) 0;
1180: matrice_f77[k].partie_imaginaire = (real8) 0;
1181: }
1182: }
1183: else if ((*s_objet_argument).type == MRL)
1184: {
1185: for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_argument)
1186: .objet)).nombre_colonnes; i++)
1187: {
1188: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument)
1189: .objet)).nombre_lignes; j++)
1190: {
1191: matrice_f77[k].partie_reelle = ((real8 **)
1192: (*((struct_matrice *) (*s_objet_argument).objet))
1193: .tableau)[j][i];
1194: matrice_f77[k++].partie_imaginaire = (real8) 0;
1195: }
1196: }
1197:
1198: for(; k < longueur_fft * (*((struct_matrice *) (*s_objet_argument)
1199: .objet)).nombre_lignes; k++)
1200: {
1201: matrice_f77[k].partie_reelle = (real8) 0;
1202: matrice_f77[k].partie_imaginaire = (real8) 0;
1203: }
1204: }
1205: else
1206: {
1207: for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_argument)
1208: .objet)).nombre_colonnes; i++)
1209: {
1210: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument)
1211: .objet)).nombre_lignes; j++)
1212: {
1213: matrice_f77[k].partie_reelle = ((struct_complexe16 **)
1214: (*((struct_matrice *) (*s_objet_argument).objet))
1215: .tableau)[j][i].partie_reelle;
1216: matrice_f77[k++].partie_imaginaire =
1217: ((struct_complexe16 **) (*((struct_matrice *)
1218: (*s_objet_argument).objet)).tableau)[j][i]
1219: .partie_imaginaire;
1220: }
1221: }
1222:
1223: for(; k < longueur_fft * (*((struct_matrice *) (*s_objet_argument)
1224: .objet)).nombre_lignes; k++)
1225: {
1226: matrice_f77[k].partie_reelle = (real8) 0;
1227: matrice_f77[k].partie_imaginaire = (real8) 0;
1228: }
1229: }
1230:
1.43 bertrand 1231: nombre_lignes = (integer4) (*((struct_matrice *)
1232: (*s_objet_argument).objet)).nombre_lignes;
1233: nombre_colonnes = (integer4) longueur_fft;
1.1 bertrand 1234: inverse = 0;
1235:
1236: dft(matrice_f77, &nombre_lignes, &nombre_colonnes, &inverse, &erreur);
1237:
1238: if (erreur != 0)
1239: {
1240: liberation(s_etat_processus, s_objet_argument);
1241: free(matrice_f77);
1242:
1243: (*s_etat_processus).erreur_execution = d_ex_longueur_fft;
1244: return;
1245: }
1246:
1247: if ((s_objet_resultat = allocation(s_etat_processus, MCX))
1248: == NULL)
1249: {
1250: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1251: return;
1252: }
1253:
1254: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
1255: (*((struct_matrice *) (*s_objet_argument).objet))
1256: .nombre_lignes;
1257: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
1258: longueur_fft;
1259:
1260: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1.43 bertrand 1261: malloc(((size_t) (*((struct_matrice *)
1262: (*s_objet_resultat).objet)).nombre_lignes)
1263: * sizeof(struct_complexe16 *))) == NULL)
1.1 bertrand 1264: {
1265: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1266: return;
1267: }
1268:
1269: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
1270: .nombre_lignes; i++)
1271: {
1272: if ((((struct_complexe16 **) (*((struct_matrice *)
1273: (*s_objet_resultat).objet)).tableau)[i] =
1.43 bertrand 1274: malloc(((size_t) (*((struct_matrice *)
1275: (*s_objet_resultat).objet)).nombre_colonnes) *
1.1 bertrand 1276: sizeof(struct_complexe16))) == NULL)
1277: {
1278: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1279: return;
1280: }
1281: }
1282:
1283: for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
1284: .nombre_colonnes; i++)
1285: {
1286: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat).objet))
1287: .nombre_lignes; j++)
1288: {
1289: ((struct_complexe16 **) (*((struct_matrice *)
1290: (*s_objet_resultat).objet)).tableau)[j][i]
1291: .partie_reelle = matrice_f77[k].partie_reelle;
1292: ((struct_complexe16 **) (*((struct_matrice *)
1293: (*s_objet_resultat).objet)).tableau)[j][i]
1294: .partie_imaginaire = matrice_f77[k++].partie_imaginaire;
1295: }
1296: }
1297:
1298: free(matrice_f77);
1299: }
1300:
1301: /*
1302: --------------------------------------------------------------------------------
1303: Calcul de FFT impossible
1304: --------------------------------------------------------------------------------
1305: */
1306:
1307: else
1308: {
1309: liberation(s_etat_processus, s_objet_argument);
1310:
1311: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1312: return;
1313: }
1314:
1315: liberation(s_etat_processus, s_objet_argument);
1316:
1317: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1318: s_objet_resultat) == d_erreur)
1319: {
1320: return;
1321: }
1322:
1323: return;
1324: }
1325:
1326:
1327: /*
1328: ================================================================================
1329: Fonction 'function' (passe en mode d'affichage y=f(x))
1330: ================================================================================
1331: Entrées : structure processus
1332: --------------------------------------------------------------------------------
1333: Sorties :
1334: --------------------------------------------------------------------------------
1335: Effets de bord : néant
1336: ================================================================================
1337: */
1338:
1339: void
1340: instruction_function(struct_processus *s_etat_processus)
1341: {
1342: (*s_etat_processus).erreur_execution = d_ex;
1343:
1344: if ((*s_etat_processus).affichage_arguments == 'Y')
1345: {
1346: printf("\n FUNCTION ");
1347:
1348: if ((*s_etat_processus).langue == 'F')
1349: {
1350: printf("(tracé y=f(x))\n\n");
1351: printf(" Aucun argument\n");
1352: }
1353: else
1354: {
1355: printf("(plot y=f(x))\n\n");
1356: printf(" No argument\n");
1357: }
1358:
1359: return;
1360: }
1361: else if ((*s_etat_processus).test_instruction == 'Y')
1362: {
1363: (*s_etat_processus).nombre_arguments = -1;
1364: return;
1365: }
1366:
1367: strcpy((*s_etat_processus).type_trace_eq, "FONCTION");
1368:
1369: return;
1370: }
1371:
1372: // 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