1: /*
2: ================================================================================
3: RPL/2 (R) version 4.1.36
4: Copyright (C) 1989-2025 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 'clear'
29: ================================================================================
30: Entrées : structure processus
31: --------------------------------------------------------------------------------
32: Sorties :
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: void
39: instruction_clear(struct_processus *s_etat_processus)
40: {
41: struct_liste_chainee *l_element_courant;
42: struct_liste_chainee *l_element_suivant;
43:
44: (*s_etat_processus).erreur_execution = d_ex;
45:
46: if ((*s_etat_processus).affichage_arguments == 'Y')
47: {
48: printf("\n CLEAR ");
49:
50: if ((*s_etat_processus).langue == 'F')
51: {
52: printf("(efface la pile)\n\n");
53: printf(" Aucun argument\n");
54: }
55: else
56: {
57: printf("(clear stack)\n\n");
58: printf(" No argument\n");
59: }
60:
61: return;
62: }
63: else if ((*s_etat_processus).test_instruction == 'Y')
64: {
65: (*s_etat_processus).nombre_arguments = -1;
66: return;
67: }
68:
69: if (test_cfsf(s_etat_processus, 31) == d_vrai)
70: {
71: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
72: {
73: return;
74: }
75: }
76:
77: l_element_courant = (*s_etat_processus).l_base_pile;
78: while(l_element_courant != NULL)
79: {
80: liberation(s_etat_processus, (*l_element_courant).donnee);
81: l_element_suivant = (*l_element_courant).suivant;
82:
83: // On ne libère le maillon de la chaîne. On le sauvegarde
84: // arbitrairement dans le tampon.
85:
86: (*l_element_courant).donnee = NULL;
87: (*l_element_courant).suivant = (*s_etat_processus).pile_tampon;
88: (*s_etat_processus).pile_tampon = l_element_courant;
89: (*s_etat_processus).taille_pile_tampon++;
90:
91: l_element_courant = l_element_suivant;
92: }
93:
94: (*s_etat_processus).l_base_pile = NULL;
95: (*s_etat_processus).hauteur_pile_operationnelle = 0;
96:
97: return;
98: }
99:
100:
101: /*
102: ================================================================================
103: Fonction 'cllcd' (efface la sortie graphique)
104: ================================================================================
105: Entrées : structure processus
106: --------------------------------------------------------------------------------
107: Sorties :
108: --------------------------------------------------------------------------------
109: Effets de bord : néant
110: ================================================================================
111: */
112:
113: void
114: instruction_cllcd(struct_processus *s_etat_processus)
115: {
116: struct_fichier_graphique *l_element_precedent;
117:
118: struct_marque *marque;
119: struct_marque *prochaine_marque;
120:
121: (*s_etat_processus).erreur_execution = d_ex;
122:
123: if ((*s_etat_processus).affichage_arguments == 'Y')
124: {
125: printf("\n CLLCD ");
126:
127: if ((*s_etat_processus).langue == 'F')
128: {
129: printf("(efface la file graphique)\n\n");
130: printf(" Aucun argument\n");
131: }
132: else
133: {
134: printf("(erase the graphical queue)\n\n");
135: printf(" No argument\n");
136: }
137:
138: return;
139: }
140: else if ((*s_etat_processus).test_instruction == 'Y')
141: {
142: (*s_etat_processus).nombre_arguments = -1;
143: return;
144: }
145:
146: if (test_cfsf(s_etat_processus, 31) == d_vrai)
147: {
148: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
149: {
150: return;
151: }
152: }
153:
154: while((*s_etat_processus).fichiers_graphiques != NULL)
155: {
156: if (destruction_fichier((*(*s_etat_processus).fichiers_graphiques).nom)
157: == d_erreur)
158: {
159: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
160: return;
161: }
162:
163: free((*(*s_etat_processus).fichiers_graphiques).nom);
164:
165: if ((*(*s_etat_processus).fichiers_graphiques).legende != NULL)
166: {
167: free((*(*s_etat_processus).fichiers_graphiques).legende);
168: }
169:
170: l_element_precedent = (*s_etat_processus).fichiers_graphiques;
171: (*s_etat_processus).fichiers_graphiques =
172: (*(*s_etat_processus).fichiers_graphiques).suivant;
173:
174: free(l_element_precedent);
175: }
176:
177: if ((*s_etat_processus).entree_standard != NULL)
178: {
179: if (fprintf((*s_etat_processus).entree_standard, "quit\n") < 0)
180: {
181: (*s_etat_processus).erreur_systeme = d_es_processus;
182: return;
183: }
184:
185: if (fflush((*s_etat_processus).entree_standard) != 0)
186: {
187: (*s_etat_processus).erreur_systeme = d_es_processus;
188: return;
189: }
190:
191: if (pclose((*s_etat_processus).entree_standard) == -1)
192: {
193: (*s_etat_processus).erreur_systeme = d_es_processus;
194: return;
195: }
196:
197: (*s_etat_processus).entree_standard = NULL;
198: }
199:
200: free((*s_etat_processus).titre);
201: free((*s_etat_processus).legende);
202: free((*s_etat_processus).label_x);
203: free((*s_etat_processus).label_y);
204: free((*s_etat_processus).label_z);
205:
206: (*s_etat_processus).titre = malloc(sizeof(unsigned char));
207: (*s_etat_processus).label_x = malloc(sizeof(unsigned char));
208: (*s_etat_processus).label_y = malloc(sizeof(unsigned char));
209: (*s_etat_processus).label_z = malloc(sizeof(unsigned char));
210: (*s_etat_processus).legende = malloc(sizeof(unsigned char));
211:
212: if (((*s_etat_processus).titre == NULL) ||
213: ((*s_etat_processus).legende == NULL) ||
214: ((*s_etat_processus).label_x == NULL) ||
215: ((*s_etat_processus).label_y == NULL) ||
216: ((*s_etat_processus).label_z == NULL))
217: {
218: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
219: return;
220: }
221:
222: (*s_etat_processus).titre[0] = d_code_fin_chaine;
223: (*s_etat_processus).label_x[0] = d_code_fin_chaine;
224: (*s_etat_processus).label_y[0] = d_code_fin_chaine;
225: (*s_etat_processus).label_z[0] = d_code_fin_chaine;
226: (*s_etat_processus).legende[0] = d_code_fin_chaine;
227:
228: marque = (*s_etat_processus).s_marques;
229:
230: while(marque != NULL)
231: {
232: free((*marque).position);
233: free((*marque).label);
234: prochaine_marque = (*marque).suivant;
235: free(marque);
236: marque = prochaine_marque;
237: }
238:
239: (*s_etat_processus).s_marques = NULL;
240:
241: return;
242: }
243:
244:
245: /*
246: ================================================================================
247: Fonction 'cf'
248: ================================================================================
249: Entrées : structure processus
250: --------------------------------------------------------------------------------
251: Sorties :
252: --------------------------------------------------------------------------------
253: Effets de bord : néant
254: ================================================================================
255: */
256:
257: void
258: instruction_cf(struct_processus *s_etat_processus)
259: {
260: struct_objet *s_objet;
261:
262: (*s_etat_processus).erreur_execution = d_ex;
263:
264: if ((*s_etat_processus).affichage_arguments == 'Y')
265: {
266: printf("\n CF ");
267:
268: if ((*s_etat_processus).langue == 'F')
269: {
270: printf("(efface un indicateur binaire)\n\n");
271: }
272: else
273: {
274: printf("(clear flag)\n\n");
275: }
276:
277: printf(" 1: 1 <= %s <= 64\n", d_INT);
278:
279: return;
280: }
281: else if ((*s_etat_processus).test_instruction == 'Y')
282: {
283: (*s_etat_processus).nombre_arguments = -1;
284: return;
285: }
286:
287: if (test_cfsf(s_etat_processus, 31) == d_vrai)
288: {
289: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
290: {
291: return;
292: }
293: }
294:
295: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
296: &s_objet) == d_erreur)
297: {
298: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
299: return;
300: }
301:
302: if ((*s_objet).type == INT)
303: {
304: if (((*((integer8 *) (*s_objet).objet)) < 1) || ((*((integer8 *)
305: (*s_objet).objet)) > 64))
306: {
307: liberation(s_etat_processus, s_objet);
308:
309: (*s_etat_processus).erreur_execution = d_ex_drapeau_inexistant;
310: return;
311: }
312:
313: cf(s_etat_processus, (unsigned char) (*((integer8 *)
314: (*s_objet).objet)));
315: }
316: else
317: {
318: liberation(s_etat_processus, s_objet);
319:
320: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
321: return;
322: }
323:
324: liberation(s_etat_processus, s_objet);
325:
326: return;
327: }
328:
329:
330: /*
331: ================================================================================
332: Fonction 'ceil'
333: ================================================================================
334: Entrées :
335: --------------------------------------------------------------------------------
336: Sorties :
337: --------------------------------------------------------------------------------
338: Effets de bord : néant
339: ================================================================================
340: */
341:
342: void
343: instruction_ceil(struct_processus *s_etat_processus)
344: {
345: struct_liste_chainee *l_element_courant;
346: struct_liste_chainee *l_element_precedent;
347:
348: struct_objet *s_copie_argument;
349: struct_objet *s_objet_argument;
350: struct_objet *s_objet_resultat;
351:
352: (*s_etat_processus).erreur_execution = d_ex;
353:
354: if ((*s_etat_processus).affichage_arguments == 'Y')
355: {
356: printf("\n CEIL ");
357:
358: if ((*s_etat_processus).langue == 'F')
359: {
360: printf("(entier supérieur)\n\n");
361: }
362: else
363: {
364: printf("(ceil)\n\n");
365: }
366:
367: printf(" 1: %s\n", d_INT);
368: printf("-> 1: %s\n\n", d_INT);
369:
370: printf(" 1: %s\n", d_REL);
371: printf("-> 1: %s\n\n", d_REL);
372:
373: printf(" 1: %s, %s\n", d_NOM, d_ALG);
374: printf("-> 1: %s\n\n", d_ALG);
375:
376: printf(" 1: %s\n", d_RPN);
377: printf("-> 1: %s\n", d_RPN);
378:
379: return;
380: }
381: else if ((*s_etat_processus).test_instruction == 'Y')
382: {
383: (*s_etat_processus).nombre_arguments = 1;
384: return;
385: }
386:
387: if (test_cfsf(s_etat_processus, 31) == d_vrai)
388: {
389: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
390: {
391: return;
392: }
393: }
394:
395: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
396: &s_objet_argument) == d_erreur)
397: {
398: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
399: return;
400: }
401:
402: /*
403: --------------------------------------------------------------------------------
404: Plafond d'un entier
405: --------------------------------------------------------------------------------
406: */
407:
408: if ((*s_objet_argument).type == INT)
409: {
410: s_objet_resultat = s_objet_argument;
411: s_objet_argument = NULL;
412: }
413:
414: /*
415: --------------------------------------------------------------------------------
416: Plafond d'un réel
417: --------------------------------------------------------------------------------
418: */
419:
420: else if ((*s_objet_argument).type == REL)
421: {
422: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
423: {
424: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
425: return;
426: }
427:
428: (*((integer8 *) (*s_objet_resultat).objet)) = (integer8)
429: ceil((*((real8 *) (*s_objet_argument).objet)));
430:
431: if (!(((((*((integer8 *) (*s_objet_resultat).objet)) - 1) <
432: (*((real8 *) (*s_objet_argument).objet))) && ((*((integer8 *)
433: (*s_objet_resultat).objet)) > (*((real8 *) (*s_objet_argument)
434: .objet))))))
435: {
436: free((*s_objet_resultat).objet);
437:
438: if (((*s_objet_resultat).objet = malloc(sizeof(real8))) == NULL)
439: {
440: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
441: return;
442: }
443:
444: (*s_objet_resultat).type = REL;
445: (*((real8 *) (*s_objet_resultat).objet)) =
446: ceil((*((real8 *) (*s_objet_argument).objet)));
447: }
448: }
449:
450: /*
451: --------------------------------------------------------------------------------
452: Plafond d'un nom
453: --------------------------------------------------------------------------------
454: */
455:
456: else if ((*s_objet_argument).type == NOM)
457: {
458: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
459: {
460: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
461: return;
462: }
463:
464: if (((*s_objet_resultat).objet =
465: allocation_maillon(s_etat_processus)) == NULL)
466: {
467: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
468: return;
469: }
470:
471: l_element_courant = (*s_objet_resultat).objet;
472:
473: if (((*l_element_courant).donnee =
474: allocation(s_etat_processus, FCT)) == NULL)
475: {
476: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
477: return;
478: }
479:
480: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
481: .nombre_arguments = 0;
482: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
483: .fonction = instruction_vers_niveau_superieur;
484:
485: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
486: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
487: {
488: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
489: return;
490: }
491:
492: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
493: .nom_fonction, "<<");
494:
495: if (((*l_element_courant).suivant =
496: allocation_maillon(s_etat_processus)) == NULL)
497: {
498: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
499: return;
500: }
501:
502: l_element_courant = (*l_element_courant).suivant;
503: (*l_element_courant).donnee = s_objet_argument;
504:
505: if (((*l_element_courant).suivant =
506: allocation_maillon(s_etat_processus)) == NULL)
507: {
508: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
509: return;
510: }
511:
512: l_element_courant = (*l_element_courant).suivant;
513:
514: if (((*l_element_courant).donnee =
515: allocation(s_etat_processus, FCT)) == NULL)
516: {
517: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
518: return;
519: }
520:
521: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
522: .nombre_arguments = 1;
523: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
524: .fonction = instruction_ceil;
525:
526: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
527: .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
528: {
529: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
530: return;
531: }
532:
533: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
534: .nom_fonction, "CEIL");
535:
536: if (((*l_element_courant).suivant =
537: allocation_maillon(s_etat_processus)) == NULL)
538: {
539: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
540: return;
541: }
542:
543: l_element_courant = (*l_element_courant).suivant;
544:
545: if (((*l_element_courant).donnee =
546: allocation(s_etat_processus, FCT)) == NULL)
547: {
548: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
549: return;
550: }
551:
552: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
553: .nombre_arguments = 0;
554: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
555: .fonction = instruction_vers_niveau_inferieur;
556:
557: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
558: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
559: {
560: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
561: return;
562: }
563:
564: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
565: .nom_fonction, ">>");
566:
567: (*l_element_courant).suivant = NULL;
568: s_objet_argument = NULL;
569: }
570:
571: /*
572: --------------------------------------------------------------------------------
573: Plafond d'une expression
574: --------------------------------------------------------------------------------
575: */
576:
577: else if (((*s_objet_argument).type == ALG) ||
578: ((*s_objet_argument).type == RPN))
579: {
580: if ((s_copie_argument = copie_objet(s_etat_processus,
581: s_objet_argument, 'N')) == NULL)
582: {
583: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
584: return;
585: }
586:
587: l_element_courant = (struct_liste_chainee *)
588: (*s_copie_argument).objet;
589: l_element_precedent = l_element_courant;
590:
591: while((*l_element_courant).suivant != NULL)
592: {
593: l_element_precedent = l_element_courant;
594: l_element_courant = (*l_element_courant).suivant;
595: }
596:
597: if (((*l_element_precedent).suivant =
598: allocation_maillon(s_etat_processus)) == NULL)
599: {
600: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
601: return;
602: }
603:
604: if (((*(*l_element_precedent).suivant).donnee =
605: allocation(s_etat_processus, FCT)) == NULL)
606: {
607: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
608: return;
609: }
610:
611: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
612: .donnee).objet)).nombre_arguments = 1;
613: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
614: .donnee).objet)).fonction = instruction_ceil;
615:
616: if (((*((struct_fonction *) (*(*(*l_element_precedent)
617: .suivant).donnee).objet)).nom_fonction =
618: malloc(5 * sizeof(unsigned char))) == NULL)
619: {
620: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
621: return;
622: }
623:
624: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
625: .suivant).donnee).objet)).nom_fonction, "CEIL");
626:
627: (*(*l_element_precedent).suivant).suivant = l_element_courant;
628:
629: s_objet_resultat = s_copie_argument;
630: }
631:
632: /*
633: --------------------------------------------------------------------------------
634: Fonction ceil impossible à réaliser
635: --------------------------------------------------------------------------------
636: */
637:
638: else
639: {
640: liberation(s_etat_processus, s_objet_argument);
641:
642: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
643: return;
644: }
645:
646: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
647: s_objet_resultat) == d_erreur)
648: {
649: return;
650: }
651:
652: liberation(s_etat_processus, s_objet_argument);
653:
654: return;
655: }
656:
657:
658: /*
659: ================================================================================
660: Fonction 'case'
661: ================================================================================
662: Entrées :
663: --------------------------------------------------------------------------------
664: Sorties :
665: --------------------------------------------------------------------------------
666: Effets de bord : néant
667: ================================================================================
668: */
669:
670: void
671: instruction_case(struct_processus *s_etat_processus)
672: {
673: struct_liste_pile_systeme *l_element_courant;
674:
675: struct_objet *s_objet;
676:
677: (*s_etat_processus).erreur_execution = d_ex;
678:
679: if ((*s_etat_processus).affichage_arguments == 'Y')
680: {
681: printf("\n CASE ");
682:
683: if ((*s_etat_processus).langue == 'F')
684: {
685: printf("(structure de contrôle)\n\n");
686: printf(" Utilisation :\n\n");
687: }
688: else
689: {
690: printf("(control statement)\n\n");
691: printf(" Usage:\n\n");
692: }
693:
694: printf(" SELECT (expression test)\n");
695: printf(" CASE (clause 1) THEN (expression 1) END\n");
696: printf(" CASE (clause 2) THEN (expression 2) END\n");
697: printf(" ...\n");
698: printf(" CASE (clause n) THEN (expression n) END\n");
699: printf(" DEFAULT\n");
700: printf(" (expression)\n");
701: printf(" END\n\n");
702:
703: printf(" SELECT (expression test)\n");
704: printf(" CASE (clause 1) THEN (expression 1) END\n");
705: printf(" (expression)\n");
706: printf(" CASE (clause 2) THEN (expression 2) END\n");
707: printf(" END\n");
708:
709: return;
710: }
711: else if ((*s_etat_processus).test_instruction == 'Y')
712: {
713: (*s_etat_processus).nombre_arguments = -1;
714: return;
715: }
716:
717: l_element_courant = (*s_etat_processus).l_base_pile_systeme;
718:
719: while(l_element_courant != NULL)
720: {
721: if (((*l_element_courant).clause == 'S') ||
722: ((*l_element_courant).clause == 'C') ||
723: ((*l_element_courant).clause == 'K'))
724: {
725: break;
726: }
727:
728: l_element_courant = (*l_element_courant).suivant;
729: }
730:
731: if (l_element_courant == NULL)
732: {
733: (*s_etat_processus).erreur_systeme = d_es_pile_vide;
734: return;
735: }
736:
737: if ((*l_element_courant).clause == 'S')
738: {
739: /*
740: * Première apparition de l'instruction CASE dans la structure de test.
741: */
742:
743: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
744: &s_objet) == d_erreur)
745: {
746: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
747: return;
748: }
749:
750: (*l_element_courant).objet_de_test = s_objet;
751: (*l_element_courant).clause = 'K';
752: }
753:
754: if ((s_objet = copie_objet(s_etat_processus,
755: (*l_element_courant).objet_de_test, 'P')) == NULL)
756: {
757: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
758: return;
759: }
760:
761: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
762: s_objet) == d_erreur)
763: {
764: return;
765: }
766:
767: /*
768: * Empilement sur la pile système ne servant qu'à la bonne exécution
769: * des reprises sur erreur
770: */
771:
772: empilement_pile_systeme(s_etat_processus);
773:
774: if ((*s_etat_processus).erreur_systeme != d_es)
775: {
776: return;
777: }
778:
779: (*(*s_etat_processus).l_base_pile_systeme).clause =
780: (*l_element_courant).clause;
781: (*(*s_etat_processus).l_base_pile_systeme).type_cloture = 'K';
782: return;
783: }
784:
785:
786: /*
787: ================================================================================
788: Fonction 'c->r'
789: ================================================================================
790: Entrées : structure processus
791: --------------------------------------------------------------------------------
792: Sorties :
793: --------------------------------------------------------------------------------
794: Effets de bord : néant
795: ================================================================================
796: */
797:
798: void
799: instruction_c_vers_r(struct_processus *s_etat_processus)
800: {
801: struct_objet *s_objet_argument;
802: struct_objet *s_objet_resultat_1;
803: struct_objet *s_objet_resultat_2;
804:
805: integer8 i;
806: integer8 j;
807:
808: (*s_etat_processus).erreur_execution = d_ex;
809:
810: if ((*s_etat_processus).affichage_arguments == 'Y')
811: {
812: printf("\n C->R ");
813:
814: if ((*s_etat_processus).langue == 'F')
815: {
816: printf("(complexe vers réel)\n\n");
817: }
818: else
819: {
820: printf("(complex to real)\n\n");
821: }
822:
823: printf(" 1: %s\n", d_CPL);
824: printf("-> 2: %s\n", d_REL);
825: printf(" 1: %s\n\n", d_REL);
826:
827: printf(" 1: %s\n", d_VCX);
828: printf("-> 2: %s\n", d_VRL);
829: printf(" 1: %s\n\n", d_VRL);
830:
831: printf(" 1: %s\n", d_MCX);
832: printf("-> 2: %s\n", d_MRL);
833: printf(" 1: %s\n", d_MRL);
834:
835: return;
836: }
837: else if ((*s_etat_processus).test_instruction == 'Y')
838: {
839: (*s_etat_processus).nombre_arguments = -1;
840: return;
841: }
842:
843: if (test_cfsf(s_etat_processus, 31) == d_vrai)
844: {
845: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
846: {
847: return;
848: }
849: }
850:
851: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
852: &s_objet_argument) == d_erreur)
853: {
854: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
855: return;
856: }
857:
858: /*
859: --------------------------------------------------------------------------------
860: Eclatement d'un complexe
861: --------------------------------------------------------------------------------
862: */
863:
864: if ((*s_objet_argument).type == CPL)
865: {
866: if ((s_objet_resultat_1 = allocation(s_etat_processus, REL))
867: == NULL)
868: {
869: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
870: return;
871: }
872:
873: if ((s_objet_resultat_2 = allocation(s_etat_processus, REL))
874: == NULL)
875: {
876: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
877: return;
878: }
879:
880: (*((real8 *) (*s_objet_resultat_1).objet)) =
881: (*((struct_complexe16 *) (*s_objet_argument).objet))
882: .partie_imaginaire;
883:
884: (*((real8 *) (*s_objet_resultat_2).objet)) =
885: (*((struct_complexe16 *) (*s_objet_argument).objet))
886: .partie_reelle;
887: }
888:
889: /*
890: --------------------------------------------------------------------------------
891: Eclatement d'un vecteur
892: --------------------------------------------------------------------------------
893: */
894:
895: else if ((*s_objet_argument).type == VCX)
896: {
897: if ((s_objet_resultat_1 = allocation(s_etat_processus, VRL))
898: == NULL)
899: {
900: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
901: return;
902: }
903:
904: if ((s_objet_resultat_2 = allocation(s_etat_processus, VRL))
905: == NULL)
906: {
907: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
908: return;
909: }
910:
911: if (((*((struct_vecteur *) (*s_objet_resultat_1).objet)).tableau =
912: malloc(((size_t) (*(((struct_vecteur *) (*s_objet_argument)
913: .objet))).taille) * sizeof(real8))) == NULL)
914: {
915: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
916: return;
917: }
918:
919: if (((*((struct_vecteur *) (*s_objet_resultat_2).objet)).tableau =
920: malloc(((size_t) (*(((struct_vecteur *) (*s_objet_argument)
921: .objet))).taille) * sizeof(real8))) == NULL)
922: {
923: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
924: return;
925: }
926:
927: (*((struct_vecteur *) (*s_objet_resultat_1).objet)).taille =
928: (*(((struct_vecteur *) (*s_objet_argument).objet))).taille;
929: (*((struct_vecteur *) (*s_objet_resultat_2).objet)).taille =
930: (*(((struct_vecteur *) (*s_objet_argument).objet))).taille;
931:
932: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument).objet)))
933: .taille; i++)
934: {
935: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat_1).objet))
936: .tableau)[i] = ((struct_complexe16 *) (*((struct_vecteur *)
937: (*s_objet_argument).objet)).tableau)[i].partie_imaginaire;
938:
939: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat_2).objet))
940: .tableau)[i] = ((struct_complexe16 *) (*((struct_vecteur *)
941: (*s_objet_argument).objet)).tableau)[i].partie_reelle;
942: }
943: }
944:
945: /*
946: --------------------------------------------------------------------------------
947: Eclatement d'une matrice
948: --------------------------------------------------------------------------------
949: */
950:
951: else if ((*s_objet_argument).type == MCX)
952: {
953: if ((s_objet_resultat_1 = allocation(s_etat_processus, MRL))
954: == NULL)
955: {
956: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
957: return;
958: }
959:
960: if ((s_objet_resultat_2 = allocation(s_etat_processus, MRL))
961: == NULL)
962: {
963: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
964: return;
965: }
966:
967: if (((*((struct_matrice *) (*s_objet_resultat_1).objet)).tableau =
968: malloc(((size_t) (*(((struct_matrice *) (*s_objet_argument)
969: .objet))).nombre_lignes) * sizeof(real8 *))) == NULL)
970: {
971: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
972: return;
973: }
974:
975: if (((*((struct_matrice *) (*s_objet_resultat_2).objet)).tableau =
976: malloc(((size_t) (*(((struct_matrice *) (*s_objet_argument)
977: .objet))).nombre_lignes) * sizeof(real8 *))) == NULL)
978: {
979: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
980: return;
981: }
982:
983: (*((struct_matrice *) (*s_objet_resultat_1).objet)).nombre_lignes =
984: (*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes;
985: (*((struct_matrice *) (*s_objet_resultat_2).objet)).nombre_lignes =
986: (*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes;
987: (*((struct_matrice *) (*s_objet_resultat_1).objet)).nombre_colonnes =
988: (*((struct_matrice *) (*s_objet_argument).objet))
989: .nombre_colonnes;
990: (*((struct_matrice *) (*s_objet_resultat_2).objet)).nombre_colonnes =
991: (*((struct_matrice *) (*s_objet_argument).objet))
992: .nombre_colonnes;
993:
994: for(i = 0; i < (*(((struct_matrice *) (*s_objet_argument).objet)))
995: .nombre_lignes; i++)
996: {
997: if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat_1)
998: .objet)).tableau)[i] = malloc(((size_t)
999: (*(((struct_matrice *) (*s_objet_argument).objet)))
1000: .nombre_colonnes) * sizeof(real8))) == NULL)
1001: {
1002: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1003: return;
1004: }
1005:
1006: if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat_2)
1007: .objet)).tableau)[i] = malloc(((size_t)
1008: (*(((struct_matrice *) (*s_objet_argument).objet)))
1009: .nombre_colonnes) * sizeof(real8))) == NULL)
1010: {
1011: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1012: return;
1013: }
1014:
1015: for(j = 0; j < (*(((struct_matrice *) (*s_objet_argument).objet)))
1016: .nombre_colonnes; j++)
1017: {
1018: ((real8 **) (*((struct_matrice *) (*s_objet_resultat_1).objet))
1019: .tableau)[i][j] = ((struct_complexe16 **)
1020: (*((struct_matrice *) (*s_objet_argument).objet))
1021: .tableau)[i][j].partie_imaginaire;
1022:
1023: ((real8 **) (*((struct_matrice *) (*s_objet_resultat_2).objet))
1024: .tableau)[i][j] = ((struct_complexe16 **)
1025: (*((struct_matrice *) (*s_objet_argument).objet))
1026: .tableau)[i][j].partie_reelle;
1027: }
1028: }
1029: }
1030:
1031: /*
1032: --------------------------------------------------------------------------------
1033: Eclatement impossible
1034: --------------------------------------------------------------------------------
1035: */
1036:
1037: else
1038: {
1039: liberation(s_etat_processus, s_objet_argument);
1040:
1041: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1042: return;
1043: }
1044:
1045: liberation(s_etat_processus, s_objet_argument);
1046:
1047: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1048: s_objet_resultat_2) == d_erreur)
1049: {
1050: return;
1051: }
1052:
1053: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1054: s_objet_resultat_1) == d_erreur)
1055: {
1056: return;
1057: }
1058:
1059: return;
1060: }
1061:
1062:
1063: /*
1064: ================================================================================
1065: Fonction 'conj'
1066: ================================================================================
1067: Entrées :
1068: --------------------------------------------------------------------------------
1069: Sorties :
1070: --------------------------------------------------------------------------------
1071: Effets de bord : néant
1072: ================================================================================
1073: */
1074:
1075: void
1076: instruction_conj(struct_processus *s_etat_processus)
1077: {
1078: struct_liste_chainee *l_element_courant;
1079: struct_liste_chainee *l_element_precedent;
1080:
1081: struct_objet *s_copie_argument;
1082: struct_objet *s_objet_argument;
1083: struct_objet *s_objet_resultat;
1084:
1085: integer8 i;
1086: integer8 j;
1087:
1088: (*s_etat_processus).erreur_execution = d_ex;
1089:
1090: if ((*s_etat_processus).affichage_arguments == 'Y')
1091: {
1092: printf("\n CONJ ");
1093:
1094: if ((*s_etat_processus).langue == 'F')
1095: {
1096: printf("(conjugaison)\n\n");
1097: }
1098: else
1099: {
1100: printf("(conjugated)\n\n");
1101: }
1102:
1103: printf(" 1: %s\n", d_INT);
1104: printf("-> 1: %s\n\n", d_INT);
1105:
1106: printf(" 1: %s\n", d_REL);
1107: printf("-> 1: %s\n\n", d_REL);
1108:
1109: printf(" 1: %s\n", d_CPL);
1110: printf("-> 1: %s\n\n", d_CPL);
1111:
1112: printf(" 1: %s\n", d_VIN);
1113: printf("-> 1: %s\n\n", d_VIN);
1114:
1115: printf(" 1: %s\n", d_VRL);
1116: printf("-> 1: %s\n\n", d_VRL);
1117:
1118: printf(" 1: %s\n", d_VCX);
1119: printf("-> 1: %s\n\n", d_VCX);
1120:
1121: printf(" 1: %s\n", d_MIN);
1122: printf("-> 1: %s\n\n", d_MIN);
1123:
1124: printf(" 1: %s\n", d_MRL);
1125: printf("-> 1: %s\n\n", d_MRL);
1126:
1127: printf(" 1: %s\n", d_MCX);
1128: printf("-> 1: %s\n\n", d_MCX);
1129:
1130: printf(" 1: %s, %s\n", d_NOM, d_ALG);
1131: printf("-> 1: %s\n\n", d_ALG);
1132:
1133: printf(" 1: %s\n", d_RPN);
1134: printf("-> 1: %s\n", d_RPN);
1135:
1136: return;
1137: }
1138: else if ((*s_etat_processus).test_instruction == 'Y')
1139: {
1140: (*s_etat_processus).nombre_arguments = 1;
1141: return;
1142: }
1143:
1144: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1145: {
1146: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1147: {
1148: return;
1149: }
1150: }
1151:
1152: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1153: &s_objet_argument) == d_erreur)
1154: {
1155: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1156: return;
1157: }
1158:
1159: /*
1160: --------------------------------------------------------------------------------
1161: Conjugué d'un entier ou d'un réel
1162: --------------------------------------------------------------------------------
1163: */
1164:
1165: if (((*s_objet_argument).type == INT) ||
1166: ((*s_objet_argument).type == REL))
1167: {
1168: s_objet_resultat = s_objet_argument;
1169: s_objet_argument = NULL;
1170: }
1171:
1172: /*
1173: --------------------------------------------------------------------------------
1174: Conjugué d'un complexe
1175: --------------------------------------------------------------------------------
1176: */
1177:
1178: else if ((*s_objet_argument).type == CPL)
1179: {
1180: (*((struct_complexe16 *) (*s_objet_argument).objet)).partie_reelle =
1181: (*((struct_complexe16 *) (*s_objet_argument).objet))
1182: .partie_reelle;
1183: (*((struct_complexe16 *) (*s_objet_argument).objet)).partie_imaginaire =
1184: -(*((struct_complexe16 *) (*s_objet_argument).objet))
1185: .partie_imaginaire;
1186:
1187: s_objet_resultat = s_objet_argument;
1188: s_objet_argument = NULL;
1189: }
1190:
1191: /*
1192: --------------------------------------------------------------------------------
1193: Conjugué d'un vecteur d'entiers ou de réels
1194: --------------------------------------------------------------------------------
1195: */
1196:
1197: else if (((*s_objet_argument).type == VIN) ||
1198: ((*s_objet_argument).type == VRL))
1199: {
1200: s_objet_resultat = s_objet_argument;
1201: s_objet_argument = NULL;
1202: }
1203:
1204: /*
1205: --------------------------------------------------------------------------------
1206: Conjugué d'un vecteur de complexes
1207: --------------------------------------------------------------------------------
1208: */
1209:
1210: else if ((*s_objet_argument).type == VCX)
1211: {
1212: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument).objet)))
1213: .taille; i++)
1214: {
1215: ((struct_complexe16 *) (*(((struct_vecteur *) (*s_objet_argument)
1216: .objet))).tableau)[i].partie_reelle =
1217: ((struct_complexe16 *) (*(((struct_vecteur *)
1218: (*s_objet_argument).objet))).tableau)[i].partie_reelle;
1219: ((struct_complexe16 *) (*(((struct_vecteur *) (*s_objet_argument)
1220: .objet))).tableau)[i].partie_imaginaire =
1221: -((struct_complexe16 *) (*(((struct_vecteur *)
1222: (*s_objet_argument).objet))).tableau)[i].partie_imaginaire;
1223: }
1224:
1225: s_objet_resultat = s_objet_argument;
1226: s_objet_argument = NULL;
1227: }
1228:
1229: /*
1230: --------------------------------------------------------------------------------
1231: Conjuguée d'une matrice d'entiers ou de réels
1232: --------------------------------------------------------------------------------
1233: */
1234:
1235: else if (((*s_objet_argument).type == MIN) ||
1236: ((*s_objet_argument).type == MRL))
1237: {
1238: s_objet_resultat = s_objet_argument;
1239: s_objet_argument = NULL;
1240: }
1241:
1242: /*
1243: --------------------------------------------------------------------------------
1244: Conjuguée d'une matrice de complexes
1245: --------------------------------------------------------------------------------
1246: */
1247:
1248: else if ((*s_objet_argument).type == MCX)
1249: {
1250: for(i = 0; i < (*(((struct_matrice *) (*s_objet_argument).objet)))
1251: .nombre_lignes; i++)
1252: {
1253: for(j = 0; j < (*(((struct_matrice *) (*s_objet_argument).objet)))
1254: .nombre_colonnes; j++)
1255: {
1256: ((struct_complexe16 **) (*(((struct_matrice *)
1257: (*s_objet_argument).objet))).tableau)[i][j]
1258: .partie_reelle = ((struct_complexe16 **)
1259: (*(((struct_matrice *) (*s_objet_argument).objet)))
1260: .tableau)[i][j].partie_reelle;
1261: ((struct_complexe16 **) (*(((struct_matrice *)
1262: (*s_objet_argument).objet))).tableau)[i][j]
1263: .partie_imaginaire = -((struct_complexe16 **)
1264: (*(((struct_matrice *) (*s_objet_argument).objet)))
1265: .tableau)[i][j].partie_imaginaire;
1266: }
1267: }
1268:
1269: s_objet_resultat = s_objet_argument;
1270: s_objet_argument = NULL;
1271: }
1272:
1273: /*
1274: --------------------------------------------------------------------------------
1275: Conjugué d'un nom
1276: --------------------------------------------------------------------------------
1277: */
1278:
1279: else if ((*s_objet_argument).type == NOM)
1280: {
1281: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
1282: == NULL)
1283: {
1284: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1285: return;
1286: }
1287:
1288: if (((*s_objet_resultat).objet =
1289: allocation_maillon(s_etat_processus)) == NULL)
1290: {
1291: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1292: return;
1293: }
1294:
1295: l_element_courant = (*s_objet_resultat).objet;
1296:
1297: if (((*l_element_courant).donnee =
1298: allocation(s_etat_processus, FCT)) == NULL)
1299: {
1300: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1301: return;
1302: }
1303:
1304: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1305: .nombre_arguments = 0;
1306: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1307: .fonction = instruction_vers_niveau_superieur;
1308:
1309: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1310: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1311: {
1312: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1313: return;
1314: }
1315:
1316: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1317: .nom_fonction, "<<");
1318:
1319: if (((*l_element_courant).suivant =
1320: allocation_maillon(s_etat_processus)) == NULL)
1321: {
1322: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1323: return;
1324: }
1325:
1326: l_element_courant = (*l_element_courant).suivant;
1327: (*l_element_courant).donnee = s_objet_argument;
1328:
1329: if (((*l_element_courant).suivant =
1330: allocation_maillon(s_etat_processus)) == NULL)
1331: {
1332: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1333: return;
1334: }
1335:
1336: l_element_courant = (*l_element_courant).suivant;
1337:
1338: if (((*l_element_courant).donnee =
1339: allocation(s_etat_processus, FCT)) == NULL)
1340: {
1341: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1342: return;
1343: }
1344:
1345: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1346: .nombre_arguments = 1;
1347: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1348: .fonction = instruction_conj;
1349:
1350: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1351: .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
1352: {
1353: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1354: return;
1355: }
1356:
1357: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1358: .nom_fonction, "CONJ");
1359:
1360: if (((*l_element_courant).suivant =
1361: allocation_maillon(s_etat_processus)) == NULL)
1362: {
1363: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1364: return;
1365: }
1366:
1367: l_element_courant = (*l_element_courant).suivant;
1368:
1369: if (((*l_element_courant).donnee =
1370: allocation(s_etat_processus, FCT)) == NULL)
1371: {
1372: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1373: return;
1374: }
1375:
1376: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1377: .nombre_arguments = 0;
1378: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1379: .fonction = instruction_vers_niveau_inferieur;
1380:
1381: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1382: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1383: {
1384: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1385: return;
1386: }
1387:
1388: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1389: .nom_fonction, ">>");
1390:
1391: (*l_element_courant).suivant = NULL;
1392: s_objet_argument = NULL;
1393: }
1394:
1395: /*
1396: --------------------------------------------------------------------------------
1397: Conjuguée d'une expression
1398: --------------------------------------------------------------------------------
1399: */
1400:
1401: else if (((*s_objet_argument).type == ALG) ||
1402: ((*s_objet_argument).type == RPN))
1403: {
1404: if ((s_copie_argument = copie_objet(s_etat_processus,
1405: s_objet_argument, 'N')) == NULL)
1406: {
1407: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1408: return;
1409: }
1410:
1411: l_element_courant = (struct_liste_chainee *)
1412: (*s_copie_argument).objet;
1413: l_element_precedent = l_element_courant;
1414:
1415: while((*l_element_courant).suivant != NULL)
1416: {
1417: l_element_precedent = l_element_courant;
1418: l_element_courant = (*l_element_courant).suivant;
1419: }
1420:
1421: if (((*l_element_precedent).suivant =
1422: allocation_maillon(s_etat_processus)) == NULL)
1423: {
1424: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1425: return;
1426: }
1427:
1428: if (((*(*l_element_precedent).suivant).donnee =
1429: allocation(s_etat_processus, FCT)) == NULL)
1430: {
1431: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1432: return;
1433: }
1434:
1435: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1436: .donnee).objet)).nombre_arguments = 1;
1437: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1438: .donnee).objet)).fonction = instruction_conj;
1439:
1440: if (((*((struct_fonction *) (*(*(*l_element_precedent)
1441: .suivant).donnee).objet)).nom_fonction =
1442: malloc(5 * sizeof(unsigned char))) == NULL)
1443: {
1444: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1445: return;
1446: }
1447:
1448: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
1449: .suivant).donnee).objet)).nom_fonction, "CONJ");
1450:
1451: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1452:
1453: s_objet_resultat = s_copie_argument;
1454: }
1455:
1456: /*
1457: --------------------------------------------------------------------------------
1458: Conjugaison impossible
1459: --------------------------------------------------------------------------------
1460: */
1461:
1462: else
1463: {
1464: liberation(s_etat_processus, s_objet_argument);
1465:
1466: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1467: return;
1468: }
1469:
1470: liberation(s_etat_processus, s_objet_argument);
1471:
1472: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1473: s_objet_resultat) == d_erreur)
1474: {
1475: return;
1476: }
1477:
1478: return;
1479: }
1480:
1481:
1482: /*
1483: ================================================================================
1484: Fonction 'cos'
1485: ================================================================================
1486: Entrées : pointeur sur une structure struct_processus
1487: --------------------------------------------------------------------------------
1488: Sorties :
1489: --------------------------------------------------------------------------------
1490: Effets de bord : néant
1491: ================================================================================
1492: */
1493:
1494: void
1495: instruction_cos(struct_processus *s_etat_processus)
1496: {
1497: real8 angle;
1498:
1499: struct_liste_chainee *l_element_courant;
1500: struct_liste_chainee *l_element_precedent;
1501:
1502: struct_objet *s_copie_argument;
1503: struct_objet *s_objet_argument;
1504: struct_objet *s_objet_resultat;
1505:
1506: (*s_etat_processus).erreur_execution = d_ex;
1507:
1508: if ((*s_etat_processus).affichage_arguments == 'Y')
1509: {
1510: printf("\n COS ");
1511:
1512: if ((*s_etat_processus).langue == 'F')
1513: {
1514: printf("(cosinus)\n\n");
1515: }
1516: else
1517: {
1518: printf("(cosine)\n\n");
1519: }
1520:
1521: printf(" 1: %s, %s\n", d_INT, d_REL);
1522: printf("-> 1: %s\n\n", d_REL);
1523:
1524: printf(" 1: %s\n", d_CPL);
1525: printf("-> 1: %s\n\n", d_CPL);
1526:
1527: printf(" 1: %s, %s\n", d_NOM, d_ALG);
1528: printf("-> 1: %s\n\n", d_ALG);
1529:
1530: printf(" 1: %s\n", d_RPN);
1531: printf("-> 1: %s\n", d_RPN);
1532:
1533: return;
1534: }
1535: else if ((*s_etat_processus).test_instruction == 'Y')
1536: {
1537: (*s_etat_processus).nombre_arguments = 1;
1538: return;
1539: }
1540:
1541: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1542: {
1543: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1544: {
1545: return;
1546: }
1547: }
1548:
1549: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1550: &s_objet_argument) == d_erreur)
1551: {
1552: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1553: return;
1554: }
1555:
1556: /*
1557: --------------------------------------------------------------------------------
1558: Cosinus d'un entier ou d'un réel
1559: --------------------------------------------------------------------------------
1560: */
1561:
1562: if (((*s_objet_argument).type == INT) ||
1563: ((*s_objet_argument).type == REL))
1564: {
1565: if ((s_objet_resultat = allocation(s_etat_processus, REL))
1566: == NULL)
1567: {
1568: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1569: return;
1570: }
1571:
1572: if ((*s_objet_argument).type == INT)
1573: {
1574: angle = (real8) (*((integer8 *) (*s_objet_argument).objet));
1575: }
1576: else
1577: {
1578: angle = (*((real8 *) (*s_objet_argument).objet));
1579: }
1580:
1581: if (test_cfsf(s_etat_processus, 60) == d_faux)
1582: {
1583: conversion_degres_vers_radians(&angle);
1584: }
1585:
1586: (*((real8 *) (*s_objet_resultat).objet)) = cos(angle);
1587: }
1588:
1589: /*
1590: --------------------------------------------------------------------------------
1591: Cosinus d'un complexe
1592: --------------------------------------------------------------------------------
1593: */
1594:
1595: else if ((*s_objet_argument).type == CPL)
1596: {
1597: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
1598: == NULL)
1599: {
1600: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1601: return;
1602: }
1603:
1604: f77cos_((struct_complexe16 *) (*s_objet_argument).objet,
1605: (struct_complexe16 *) (*s_objet_resultat).objet);
1606: }
1607:
1608: /*
1609: --------------------------------------------------------------------------------
1610: Cosinus d'un nom
1611: --------------------------------------------------------------------------------
1612: */
1613:
1614: else if ((*s_objet_argument).type == NOM)
1615: {
1616: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
1617: == NULL)
1618: {
1619: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1620: return;
1621: }
1622:
1623: if (((*s_objet_resultat).objet =
1624: allocation_maillon(s_etat_processus)) == NULL)
1625: {
1626: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1627: return;
1628: }
1629:
1630: l_element_courant = (*s_objet_resultat).objet;
1631:
1632: if (((*l_element_courant).donnee =
1633: allocation(s_etat_processus, FCT)) == NULL)
1634: {
1635: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1636: return;
1637: }
1638:
1639: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1640: .nombre_arguments = 0;
1641: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1642: .fonction = instruction_vers_niveau_superieur;
1643:
1644: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1645: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1646: {
1647: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1648: return;
1649: }
1650:
1651: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1652: .nom_fonction, "<<");
1653:
1654: if (((*l_element_courant).suivant =
1655: allocation_maillon(s_etat_processus)) == NULL)
1656: {
1657: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1658: return;
1659: }
1660:
1661: l_element_courant = (*l_element_courant).suivant;
1662: (*l_element_courant).donnee = s_objet_argument;
1663:
1664: if (((*l_element_courant).suivant =
1665: allocation_maillon(s_etat_processus)) == NULL)
1666: {
1667: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1668: return;
1669: }
1670:
1671: l_element_courant = (*l_element_courant).suivant;
1672:
1673: if (((*l_element_courant).donnee =
1674: allocation(s_etat_processus, FCT)) == NULL)
1675: {
1676: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1677: return;
1678: }
1679:
1680: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1681: .nombre_arguments = 1;
1682: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1683: .fonction = instruction_cos;
1684:
1685: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1686: .nom_fonction = malloc(4 * sizeof(unsigned char))) == NULL)
1687: {
1688: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1689: return;
1690: }
1691:
1692: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1693: .nom_fonction, "COS");
1694:
1695: if (((*l_element_courant).suivant =
1696: allocation_maillon(s_etat_processus)) == NULL)
1697: {
1698: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1699: return;
1700: }
1701:
1702: l_element_courant = (*l_element_courant).suivant;
1703:
1704: if (((*l_element_courant).donnee =
1705: allocation(s_etat_processus, FCT)) == NULL)
1706: {
1707: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1708: return;
1709: }
1710:
1711: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1712: .nombre_arguments = 0;
1713: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1714: .fonction = instruction_vers_niveau_inferieur;
1715:
1716: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1717: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1718: {
1719: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1720: return;
1721: }
1722:
1723: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1724: .nom_fonction, ">>");
1725:
1726: (*l_element_courant).suivant = NULL;
1727: s_objet_argument = NULL;
1728: }
1729:
1730: /*
1731: --------------------------------------------------------------------------------
1732: Cosinus d'une expression
1733: --------------------------------------------------------------------------------
1734: */
1735:
1736: else if (((*s_objet_argument).type == ALG) ||
1737: ((*s_objet_argument).type == RPN))
1738: {
1739: if ((s_copie_argument = copie_objet(s_etat_processus,
1740: s_objet_argument, 'N')) == NULL)
1741: {
1742: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1743: return;
1744: }
1745:
1746: l_element_courant = (struct_liste_chainee *)
1747: (*s_copie_argument).objet;
1748: l_element_precedent = l_element_courant;
1749:
1750: while((*l_element_courant).suivant != NULL)
1751: {
1752: l_element_precedent = l_element_courant;
1753: l_element_courant = (*l_element_courant).suivant;
1754: }
1755:
1756: if (((*l_element_precedent).suivant =
1757: allocation_maillon(s_etat_processus)) == NULL)
1758: {
1759: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1760: return;
1761: }
1762:
1763: if (((*(*l_element_precedent).suivant).donnee =
1764: allocation(s_etat_processus, FCT)) == NULL)
1765: {
1766: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1767: return;
1768: }
1769:
1770: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1771: .donnee).objet)).nombre_arguments = 1;
1772: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1773: .donnee).objet)).fonction = instruction_cos;
1774:
1775: if (((*((struct_fonction *) (*(*(*l_element_precedent)
1776: .suivant).donnee).objet)).nom_fonction =
1777: malloc(4 * sizeof(unsigned char))) == NULL)
1778: {
1779: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1780: return;
1781: }
1782:
1783: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
1784: .suivant).donnee).objet)).nom_fonction, "COS");
1785:
1786: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1787:
1788: s_objet_resultat = s_copie_argument;
1789: }
1790:
1791: /*
1792: --------------------------------------------------------------------------------
1793: Réalisation impossible de la fonction cosinus
1794: --------------------------------------------------------------------------------
1795: */
1796:
1797: else
1798: {
1799: liberation(s_etat_processus, s_objet_argument);
1800:
1801: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1802: return;
1803: }
1804:
1805: liberation(s_etat_processus, s_objet_argument);
1806:
1807: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1808: s_objet_resultat) == d_erreur)
1809: {
1810: return;
1811: }
1812:
1813: return;
1814: }
1815:
1816:
1817: /*
1818: ================================================================================
1819: Fonction 'cosh'
1820: ================================================================================
1821: Entrées : pointeur sur une structure struct_processus
1822: --------------------------------------------------------------------------------
1823: Sorties :
1824: --------------------------------------------------------------------------------
1825: Effets de bord : néant
1826: ================================================================================
1827: */
1828:
1829: void
1830: instruction_cosh(struct_processus *s_etat_processus)
1831: {
1832: real8 argument;
1833:
1834: struct_liste_chainee *l_element_courant;
1835: struct_liste_chainee *l_element_precedent;
1836:
1837: struct_objet *s_copie_argument;
1838: struct_objet *s_objet_argument;
1839: struct_objet *s_objet_resultat;
1840:
1841: (*s_etat_processus).erreur_execution = d_ex;
1842:
1843: if ((*s_etat_processus).affichage_arguments == 'Y')
1844: {
1845: printf("\n COSH ");
1846:
1847: if ((*s_etat_processus).langue == 'F')
1848: {
1849: printf("(cosinus hyperbolique)\n\n");
1850: }
1851: else
1852: {
1853: printf("(hyperbolic cosine)\n\n");
1854: }
1855:
1856: printf(" 1: %s, %s\n", d_INT, d_REL);
1857: printf("-> 1: %s\n\n", d_INT);
1858:
1859: printf(" 1: %s\n", d_CPL);
1860: printf("-> 1: %s\n\n", d_CPL);
1861:
1862: printf(" 1: %s, %s\n", d_NOM, d_ALG);
1863: printf("-> 1: %s\n\n", d_ALG);
1864:
1865: printf(" 1: %s\n", d_RPN);
1866: printf("-> 1: %s\n", d_RPN);
1867:
1868: return;
1869: }
1870: else if ((*s_etat_processus).test_instruction == 'Y')
1871: {
1872: (*s_etat_processus).nombre_arguments = 1;
1873: return;
1874: }
1875:
1876: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1877: {
1878: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1879: {
1880: return;
1881: }
1882: }
1883:
1884: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1885: &s_objet_argument) == d_erreur)
1886: {
1887: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1888: return;
1889: }
1890:
1891: /*
1892: --------------------------------------------------------------------------------
1893: Cosinus hyperbolique d'un entier ou d'un réel
1894: --------------------------------------------------------------------------------
1895: */
1896:
1897: if (((*s_objet_argument).type == INT) ||
1898: ((*s_objet_argument).type == REL))
1899: {
1900: if ((s_objet_resultat = allocation(s_etat_processus, REL))
1901: == NULL)
1902: {
1903: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1904: return;
1905: }
1906:
1907: if ((*s_objet_argument).type == INT)
1908: {
1909: argument = (real8) (*((integer8 *) (*s_objet_argument).objet));
1910: }
1911: else
1912: {
1913: argument = (*((real8 *) (*s_objet_argument).objet));
1914: }
1915:
1916: (*((real8 *) (*s_objet_resultat).objet)) = cosh(argument);
1917: }
1918:
1919: /*
1920: --------------------------------------------------------------------------------
1921: Cosinus hyperbolique d'un complexe
1922: --------------------------------------------------------------------------------
1923: */
1924:
1925: else if ((*s_objet_argument).type == CPL)
1926: {
1927: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
1928: == NULL)
1929: {
1930: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1931: return;
1932: }
1933:
1934: f77cosh_((struct_complexe16 *) (*s_objet_argument).objet,
1935: (struct_complexe16 *) (*s_objet_resultat).objet);
1936: }
1937:
1938: /*
1939: --------------------------------------------------------------------------------
1940: Cosinus hyperbolique d'un nom
1941: --------------------------------------------------------------------------------
1942: */
1943:
1944: else if ((*s_objet_argument).type == NOM)
1945: {
1946: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
1947: == NULL)
1948: {
1949: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1950: return;
1951: }
1952:
1953: if (((*s_objet_resultat).objet =
1954: allocation_maillon(s_etat_processus)) == NULL)
1955: {
1956: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1957: return;
1958: }
1959:
1960: l_element_courant = (*s_objet_resultat).objet;
1961:
1962: if (((*l_element_courant).donnee =
1963: allocation(s_etat_processus, FCT)) == NULL)
1964: {
1965: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1966: return;
1967: }
1968:
1969: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1970: .nombre_arguments = 0;
1971: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1972: .fonction = instruction_vers_niveau_superieur;
1973:
1974: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1975: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1976: {
1977: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1978: return;
1979: }
1980:
1981: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1982: .nom_fonction, "<<");
1983:
1984: if (((*l_element_courant).suivant =
1985: allocation_maillon(s_etat_processus)) == NULL)
1986: {
1987: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1988: return;
1989: }
1990:
1991: l_element_courant = (*l_element_courant).suivant;
1992: (*l_element_courant).donnee = s_objet_argument;
1993:
1994: if (((*l_element_courant).suivant =
1995: allocation_maillon(s_etat_processus)) == NULL)
1996: {
1997: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1998: return;
1999: }
2000:
2001: l_element_courant = (*l_element_courant).suivant;
2002:
2003: if (((*l_element_courant).donnee =
2004: allocation(s_etat_processus, FCT)) == NULL)
2005: {
2006: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2007: return;
2008: }
2009:
2010: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2011: .nombre_arguments = 1;
2012: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2013: .fonction = instruction_cosh;
2014:
2015: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2016: .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
2017: {
2018: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2019: return;
2020: }
2021:
2022: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2023: .nom_fonction, "COSH");
2024:
2025: if (((*l_element_courant).suivant =
2026: allocation_maillon(s_etat_processus)) == NULL)
2027: {
2028: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2029: return;
2030: }
2031:
2032: l_element_courant = (*l_element_courant).suivant;
2033:
2034: if (((*l_element_courant).donnee =
2035: allocation(s_etat_processus, FCT)) == NULL)
2036: {
2037: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2038: return;
2039: }
2040:
2041: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2042: .nombre_arguments = 0;
2043: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2044: .fonction = instruction_vers_niveau_inferieur;
2045:
2046: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2047: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
2048: {
2049: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2050: return;
2051: }
2052:
2053: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2054: .nom_fonction, ">>");
2055:
2056: (*l_element_courant).suivant = NULL;
2057: s_objet_argument = NULL;
2058: }
2059:
2060: /*
2061: --------------------------------------------------------------------------------
2062: Cosinus hyperbolique d'une expression
2063: --------------------------------------------------------------------------------
2064: */
2065:
2066: else if (((*s_objet_argument).type == ALG) ||
2067: ((*s_objet_argument).type == RPN))
2068: {
2069: if ((s_copie_argument = copie_objet(s_etat_processus,
2070: s_objet_argument, 'N')) == NULL)
2071: {
2072: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2073: return;
2074: }
2075:
2076: l_element_courant = (struct_liste_chainee *)
2077: (*s_copie_argument).objet;
2078: l_element_precedent = l_element_courant;
2079:
2080: while((*l_element_courant).suivant != NULL)
2081: {
2082: l_element_precedent = l_element_courant;
2083: l_element_courant = (*l_element_courant).suivant;
2084: }
2085:
2086: if (((*l_element_precedent).suivant =
2087: allocation_maillon(s_etat_processus)) == NULL)
2088: {
2089: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2090: return;
2091: }
2092:
2093: if (((*(*l_element_precedent).suivant).donnee =
2094: allocation(s_etat_processus, FCT)) == NULL)
2095: {
2096: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2097: return;
2098: }
2099:
2100: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
2101: .donnee).objet)).nombre_arguments = 1;
2102: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
2103: .donnee).objet)).fonction = instruction_cosh;
2104:
2105: if (((*((struct_fonction *) (*(*(*l_element_precedent)
2106: .suivant).donnee).objet)).nom_fonction =
2107: malloc(5 * sizeof(unsigned char))) == NULL)
2108: {
2109: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2110: return;
2111: }
2112:
2113: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
2114: .suivant).donnee).objet)).nom_fonction, "COSH");
2115:
2116: (*(*l_element_precedent).suivant).suivant = l_element_courant;
2117:
2118: s_objet_resultat = s_copie_argument;
2119: }
2120:
2121: /*
2122: --------------------------------------------------------------------------------
2123: Réalisation impossible de la fonction cosinus hyperbolique
2124: --------------------------------------------------------------------------------
2125: */
2126:
2127: else
2128: {
2129: liberation(s_etat_processus, s_objet_argument);
2130:
2131: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
2132: return;
2133: }
2134:
2135: liberation(s_etat_processus, s_objet_argument);
2136:
2137: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2138: s_objet_resultat) == d_erreur)
2139: {
2140: return;
2141: }
2142:
2143: return;
2144: }
2145:
2146: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_c1.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src