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 'inv'
29: ================================================================================
30: Entrées : pointeur sur une struct_processus
31: --------------------------------------------------------------------------------
32: Sorties :
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: void
39: instruction_inv(struct_processus *s_etat_processus)
40: {
41: real8 dividende_reel;
42: real8 diviseur_reel;
43:
44: struct_liste_chainee *l_element_courant;
45: struct_liste_chainee *l_element_precedent;
46:
47: struct_objet *s_copie_argument;
48: struct_objet *s_objet_argument;
49: struct_objet *s_objet_resultat;
50:
51: (*s_etat_processus).erreur_execution = d_ex;
52:
53: if ((*s_etat_processus).affichage_arguments == 'Y')
54: {
55: printf("\n INV ");
56:
57: if ((*s_etat_processus).langue == 'F')
58: {
59: printf("(inversion)\n\n");
60: }
61: else
62: {
63: printf("(inversion)\n\n");
64: }
65:
66: printf(" 1: %s, %s\n", d_INT, d_REL);
67: printf("-> 1: %s\n\n", d_REL);
68:
69: printf(" 1: %s\n", d_CPL);
70: printf("-> 1: %s\n\n", d_CPL);
71:
72: printf(" 1: %s, %s\n", d_MIN, d_MRL);
73: printf("-> 1: %s\n\n", d_MRL);
74:
75: printf(" 1: %s\n", d_MCX);
76: printf("-> 1: %s\n\n", d_MCX);
77:
78: printf(" 1: %s, %s\n", d_NOM, d_ALG);
79: printf("-> 1: %s\n\n", d_ALG);
80:
81: printf(" 1: %s\n", d_RPN);
82: printf("-> 1: %s\n", d_RPN);
83:
84: return;
85: }
86: else if ((*s_etat_processus).test_instruction == 'Y')
87: {
88: (*s_etat_processus).nombre_arguments = 1;
89: return;
90: }
91:
92: if (test_cfsf(s_etat_processus, 31) == d_vrai)
93: {
94: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
95: {
96: return;
97: }
98: }
99:
100: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
101: &s_objet_argument) == d_erreur)
102: {
103: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
104: return;
105: }
106:
107: /*
108: --------------------------------------------------------------------------------
109: Inversion donnant un résultat réel
110: --------------------------------------------------------------------------------
111: */
112:
113: if (((*s_objet_argument).type == INT) ||
114: ((*s_objet_argument).type == REL))
115: {
116: if ((s_objet_resultat = allocation(s_etat_processus, REL))
117: == NULL)
118: {
119: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
120: return;
121: }
122:
123: if ((*s_objet_argument).type == INT)
124: {
125: diviseur_reel = (real8) (*((integer8 *) (*s_objet_argument).objet));
126: }
127: else
128: {
129: diviseur_reel = (*((real8 *) (*s_objet_argument).objet));
130: }
131:
132: if ((diviseur_reel == 0) && (test_cfsf(s_etat_processus, 59) == d_vrai))
133: {
134: liberation(s_etat_processus, s_objet_argument);
135: free(s_objet_resultat);
136:
137: (*s_etat_processus).exception = d_ep_division_par_zero;
138: return;
139: }
140:
141: (*((real8 *) (*s_objet_resultat).objet)) = ((real8) 1) /
142: diviseur_reel;
143: }
144:
145: /*
146: --------------------------------------------------------------------------------
147: Inversion donnant un résultat complexe
148: --------------------------------------------------------------------------------
149: */
150:
151: else if ((*s_objet_argument).type == CPL)
152: {
153: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
154: == NULL)
155: {
156: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
157: return;
158: }
159:
160: dividende_reel = 1;
161:
162: f77divisionrc_(÷nde_reel, &((*((struct_complexe16 *)
163: (*s_objet_argument).objet))), &((*((struct_complexe16 *)
164: (*s_objet_resultat).objet))));
165: }
166:
167: /*
168: --------------------------------------------------------------------------------
169: Inversion donnant comme résultat une matrice réelle
170: --------------------------------------------------------------------------------
171: */
172:
173: else if (((*s_objet_argument).type == MIN) ||
174: ((*s_objet_argument).type == MRL))
175: {
176: if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes !=
177: (*((struct_matrice *) (*s_objet_argument).objet))
178: .nombre_colonnes)
179: {
180: liberation(s_etat_processus, s_objet_argument);
181:
182: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
183: return;
184: }
185:
186: if ((s_objet_resultat = copie_objet(s_etat_processus, s_objet_argument,
187: 'Q')) == NULL)
188: {
189: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
190: return;
191: }
192:
193: inversion_matrice(s_etat_processus,
194: (struct_matrice *) (*s_objet_resultat).objet);
195: (*s_objet_resultat).type = MRL;
196:
197: if (((*s_etat_processus).exception != d_ep) ||
198: ((*s_etat_processus).erreur_execution != d_ex))
199: {
200: liberation(s_etat_processus, s_objet_argument);
201: liberation(s_etat_processus, s_objet_resultat);
202: return;
203: }
204:
205: if ((*s_etat_processus).erreur_systeme != d_es)
206: {
207: return;
208: }
209: }
210:
211: /*
212: --------------------------------------------------------------------------------
213: Inversion donnant comme résultat une matrice complexe
214: --------------------------------------------------------------------------------
215: */
216:
217: else if ((*s_objet_argument).type == MCX)
218: {
219: if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes !=
220: (*((struct_matrice *) (*s_objet_argument).objet))
221: .nombre_colonnes)
222: {
223: liberation(s_etat_processus, s_objet_argument);
224:
225: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
226: return;
227: }
228:
229: if ((s_objet_resultat = copie_objet(s_etat_processus, s_objet_argument,
230: 'Q')) == NULL)
231: {
232: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
233: return;
234: }
235:
236: inversion_matrice(s_etat_processus,
237: (struct_matrice *) (*s_objet_resultat).objet);
238:
239: if (((*s_etat_processus).exception != d_ep) ||
240: ((*s_etat_processus).erreur_execution != d_ex))
241: {
242: liberation(s_etat_processus, s_objet_argument);
243: liberation(s_etat_processus, s_objet_resultat);
244: return;
245: }
246:
247: if ((*s_etat_processus).erreur_systeme != d_es)
248: {
249: return;
250: }
251: }
252:
253: /*
254: --------------------------------------------------------------------------------
255: Inversion d'un nom
256: --------------------------------------------------------------------------------
257: */
258:
259: else if ((*s_objet_argument).type == NOM)
260: {
261: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
262: {
263: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
264: return;
265: }
266:
267: if (((*s_objet_resultat).objet =
268: allocation_maillon(s_etat_processus)) == NULL)
269: {
270: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
271: return;
272: }
273:
274: l_element_courant = (*s_objet_resultat).objet;
275:
276: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
277: == NULL)
278: {
279: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
280: return;
281: }
282:
283: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
284: .nombre_arguments = 0;
285: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
286: .fonction = instruction_vers_niveau_superieur;
287:
288: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
289: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
290: {
291: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
292: return;
293: }
294:
295: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
296: .nom_fonction, "<<");
297:
298: if (((*l_element_courant).suivant =
299: allocation_maillon(s_etat_processus)) == NULL)
300: {
301: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
302: return;
303: }
304:
305: l_element_courant = (*l_element_courant).suivant;
306: (*l_element_courant).donnee = s_objet_argument;
307:
308: if (((*l_element_courant).suivant =
309: allocation_maillon(s_etat_processus)) == NULL)
310: {
311: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
312: return;
313: }
314:
315: l_element_courant = (*l_element_courant).suivant;
316:
317: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
318: == NULL)
319: {
320: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
321: return;
322: }
323:
324: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
325: .nombre_arguments = 1;
326: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
327: .fonction = instruction_inv;
328:
329: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
330: .nom_fonction = malloc(4 * sizeof(unsigned char))) == NULL)
331: {
332: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
333: return;
334: }
335:
336: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
337: .nom_fonction, "INV");
338:
339: if (((*l_element_courant).suivant =
340: allocation_maillon(s_etat_processus)) == NULL)
341: {
342: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
343: return;
344: }
345:
346: l_element_courant = (*l_element_courant).suivant;
347:
348: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
349: == NULL)
350: {
351: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
352: return;
353: }
354:
355: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
356: .nombre_arguments = 0;
357: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
358: .fonction = instruction_vers_niveau_inferieur;
359:
360: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
361: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
362: {
363: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
364: return;
365: }
366:
367: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
368: .nom_fonction, ">>");
369:
370: (*l_element_courant).suivant = NULL;
371: s_objet_argument = NULL;
372: }
373:
374: /*
375: --------------------------------------------------------------------------------
376: Inversion d'une expression
377: --------------------------------------------------------------------------------
378: */
379:
380: else if (((*s_objet_argument).type == ALG) ||
381: ((*s_objet_argument).type == RPN))
382: {
383: if ((s_copie_argument = copie_objet(s_etat_processus,
384: s_objet_argument, 'N')) == NULL)
385: {
386: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
387: return;
388: }
389:
390: l_element_courant = (struct_liste_chainee *)
391: (*s_copie_argument).objet;
392: l_element_precedent = l_element_courant;
393:
394: while((*l_element_courant).suivant != NULL)
395: {
396: l_element_precedent = l_element_courant;
397: l_element_courant = (*l_element_courant).suivant;
398: }
399:
400: if (((*l_element_precedent).suivant =
401: allocation_maillon(s_etat_processus)) == NULL)
402: {
403: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
404: return;
405: }
406:
407: if (((*(*l_element_precedent).suivant).donnee =
408: allocation(s_etat_processus, FCT)) == NULL)
409: {
410: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
411: return;
412: }
413:
414: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
415: .donnee).objet)).nombre_arguments = 1;
416: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
417: .donnee).objet)).fonction = instruction_inv;
418:
419: if (((*((struct_fonction *) (*(*(*l_element_precedent)
420: .suivant).donnee).objet)).nom_fonction =
421: malloc(4 * sizeof(unsigned char))) == NULL)
422: {
423: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
424: return;
425: }
426:
427: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
428: .suivant).donnee).objet)).nom_fonction, "INV");
429:
430: (*(*l_element_precedent).suivant).suivant = l_element_courant;
431:
432: s_objet_resultat = s_copie_argument;
433: }
434:
435: /*
436: --------------------------------------------------------------------------------
437: Inversion impossible
438: --------------------------------------------------------------------------------
439: */
440:
441: else
442: {
443: liberation(s_etat_processus, s_objet_argument);
444:
445: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
446: return;
447: }
448:
449: liberation(s_etat_processus, s_objet_argument);
450:
451: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
452: s_objet_resultat) == d_erreur)
453: {
454: return;
455: }
456:
457: return;
458: }
459:
460:
461: /*
462: ================================================================================
463: Fonction 'if'
464: ================================================================================
465: Entrées : pointeur sur une struct_processus
466: --------------------------------------------------------------------------------
467: Sorties :
468: --------------------------------------------------------------------------------
469: Effets de bord : néant
470: ================================================================================
471: */
472:
473: void
474: instruction_if(struct_processus *s_etat_processus)
475: {
476: (*s_etat_processus).erreur_execution = d_ex;
477:
478: if ((*s_etat_processus).affichage_arguments == 'Y')
479: {
480: printf("\n IF ");
481:
482: if ((*s_etat_processus).langue == 'F')
483: {
484: printf("(structure de contrôle)\n\n");
485: printf(" Utilisation :\n\n");
486: }
487: else
488: {
489: printf("(control statement)\n\n");
490: printf(" Usage:\n\n");
491: }
492:
493: printf(" IF\n");
494: printf(" (expression test 1)\n");
495: printf(" THEN\n");
496: printf(" (expression 1)\n");
497: printf(" [ELSEIF\n");
498: printf(" (expression test 2)\n");
499: printf(" THEN\n");
500: printf(" (expression 2)]\n");
501: printf(" ...\n");
502: printf(" [ELSE\n");
503: printf(" (expression n)]\n");
504: printf(" END\n");
505:
506: return;
507: }
508: else if ((*s_etat_processus).test_instruction == 'Y')
509: {
510: (*s_etat_processus).nombre_arguments = -1;
511: return;
512: }
513:
514: empilement_pile_systeme(s_etat_processus);
515:
516: if ((*s_etat_processus).erreur_systeme != d_es)
517: {
518: return;
519: }
520:
521: (*(*s_etat_processus).l_base_pile_systeme).type_cloture = 'I';
522: (*(*s_etat_processus).l_base_pile_systeme).clause = 'I';
523:
524: return;
525: }
526:
527:
528: /*
529: ================================================================================
530: Fonction 'iferr'
531: ================================================================================
532: Entrées : pointeur sur une struct_processus
533: --------------------------------------------------------------------------------
534: Sorties :
535: --------------------------------------------------------------------------------
536: Effets de bord : néant
537: ================================================================================
538: */
539:
540: void
541: instruction_iferr(struct_processus *s_etat_processus)
542: {
543: (*s_etat_processus).erreur_execution = d_ex;
544:
545: if ((*s_etat_processus).affichage_arguments == 'Y')
546: {
547: printf("\n IFERR ");
548:
549: if ((*s_etat_processus).langue == 'F')
550: {
551: printf("(structure de contrôle)\n\n");
552: printf(" Utilisation :\n\n");
553: }
554: else
555: {
556: printf("(control statement)\n\n");
557: printf(" Usage:\n\n");
558: }
559:
560: printf(" IFERR\n");
561: printf(" (expression test 1)\n");
562: printf(" THEN\n");
563: printf(" (expression 1)\n");
564: printf(" [ELSE\n");
565: printf(" (expression 2)]\n");
566: printf(" END\n");
567:
568: return;
569: }
570: else if ((*s_etat_processus).test_instruction == 'Y')
571: {
572: (*s_etat_processus).nombre_arguments = -1;
573: return;
574: }
575:
576: empilement_pile_systeme(s_etat_processus);
577:
578: if ((*s_etat_processus).erreur_systeme != d_es)
579: {
580: return;
581: }
582:
583: (*(*s_etat_processus).l_base_pile_systeme).type_cloture = 'J';
584: (*(*s_etat_processus).l_base_pile_systeme).clause = 'R';
585: (*(*s_etat_processus).l_base_pile_systeme).arret_si_exception =
586: (*s_etat_processus).arret_si_exception;
587: (*s_etat_processus).arret_si_exception = d_faux;
588:
589: return;
590: }
591:
592:
593: /*
594: ================================================================================
595: Fonction 'ift'
596: ================================================================================
597: Entrées : pointeur sur une struct_processus
598: --------------------------------------------------------------------------------
599: Sorties :
600: --------------------------------------------------------------------------------
601: Effets de bord : néant
602: ================================================================================
603: */
604:
605: void
606: instruction_ift(struct_processus *s_etat_processus)
607: {
608: struct_objet *s_objet_1;
609: struct_objet *s_objet_2;
610:
611: logical1 condition;
612:
613: (*s_etat_processus).erreur_execution = d_ex;
614:
615: if ((*s_etat_processus).affichage_arguments == 'Y')
616: {
617: printf("\n IFT ");
618:
619: if ((*s_etat_processus).langue == 'F')
620: {
621: printf("(structure IF/THEN/END simplifiée)\n\n");
622: }
623: else
624: {
625: printf("(simplified IF/THEN/END structure)\n\n");
626: }
627:
628: printf(" 2: %s, %s\n", d_INT, d_REL);
629: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
630: " %s, %s, %s, %s, %s,\n"
631: " %s, %s, %s, %s, %s,\n"
632: " %s\n",
633: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
634: d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
635:
636: return;
637: }
638: else if ((*s_etat_processus).test_instruction == 'Y')
639: {
640: (*s_etat_processus).nombre_arguments = 2;
641: return;
642: }
643:
644: if (test_cfsf(s_etat_processus, 31) == d_vrai)
645: {
646: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
647: {
648: return;
649: }
650: }
651:
652: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
653: &s_objet_1) == d_erreur)
654: {
655: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
656: return;
657: }
658:
659: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
660: &s_objet_2) == d_erreur)
661: {
662: liberation(s_etat_processus, s_objet_1);
663:
664: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
665: return;
666: }
667:
668: if (((*s_objet_2).type == INT) || ((*s_objet_2).type == REL))
669: {
670: if ((*s_objet_2).type == INT)
671: {
672: condition = ((*((integer8 *) (*s_objet_2).objet)) == 0)
673: ? d_faux : d_vrai;
674: }
675: else
676: {
677: condition = ((*((real8 *) (*s_objet_2).objet)) == 0)
678: ? d_faux : d_vrai;
679: }
680:
681: if (condition == d_vrai)
682: {
683: if (evaluation(s_etat_processus, s_objet_1,
684: (test_cfsf(s_etat_processus, 35) == d_vrai) ? 'E' : 'N')
685: == d_erreur)
686: {
687: liberation(s_etat_processus, s_objet_1);
688: liberation(s_etat_processus, s_objet_2);
689: return;
690: }
691: }
692: else
693: {
694: liberation(s_etat_processus, s_objet_1);
695: }
696:
697: liberation(s_etat_processus, s_objet_2);
698: }
699: else
700: {
701: liberation(s_etat_processus, s_objet_1);
702: liberation(s_etat_processus, s_objet_2);
703:
704: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
705: return;
706: }
707:
708: return;
709: }
710:
711:
712: /*
713: ================================================================================
714: Fonction 'ifte'
715: ================================================================================
716: Entrées : pointeur sur une struct_processus
717: --------------------------------------------------------------------------------
718: Sorties :
719: --------------------------------------------------------------------------------
720: Effets de bord : néant
721: ================================================================================
722: */
723:
724: void
725: instruction_ifte(struct_processus *s_etat_processus)
726: {
727: struct_objet *s_objet_1;
728: struct_objet *s_objet_2;
729: struct_objet *s_objet_3;
730:
731: logical1 condition;
732:
733: (*s_etat_processus).erreur_execution = d_ex;
734:
735: if ((*s_etat_processus).affichage_arguments == 'Y')
736: {
737: printf("\n IFTE ");
738:
739: if ((*s_etat_processus).langue == 'F')
740: {
741: printf("(structure IF/THEN/ELSE/END simplifiée)\n\n");
742: }
743: else
744: {
745: printf("(simplified IF/THEN/ELSE/END structure)\n\n");
746: }
747:
748: printf(" 3: %s, %s\n", d_INT, d_REL);
749: printf(" 2: %s, %s, %s, %s, %s, %s,\n"
750: " %s, %s, %s, %s, %s,\n"
751: " %s, %s, %s, %s, %s,\n"
752: " %s\n",
753: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
754: d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
755: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
756: " %s, %s, %s, %s, %s,\n"
757: " %s, %s, %s, %s, %s,\n"
758: " %s\n",
759: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
760: d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
761:
762: return;
763: }
764: else if ((*s_etat_processus).test_instruction == 'Y')
765: {
766: (*s_etat_processus).nombre_arguments = 3;
767: return;
768: }
769:
770: if (test_cfsf(s_etat_processus, 31) == d_vrai)
771: {
772: if (empilement_pile_last(s_etat_processus, 3) == d_erreur)
773: {
774: return;
775: }
776: }
777:
778: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
779: &s_objet_1) == d_erreur)
780: {
781: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
782: return;
783: }
784:
785: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
786: &s_objet_2) == d_erreur)
787: {
788: liberation(s_etat_processus, s_objet_1);
789:
790: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
791: return;
792: }
793:
794: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
795: &s_objet_3) == d_erreur)
796: {
797: liberation(s_etat_processus, s_objet_1);
798: liberation(s_etat_processus, s_objet_2);
799:
800: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
801: return;
802: }
803:
804: if (((*s_objet_3).type == INT) || ((*s_objet_3).type == REL))
805: {
806: if ((*s_objet_3).type == INT)
807: {
808: condition = ((*((integer8 *) (*s_objet_3).objet)) == 0)
809: ? d_faux : d_vrai;
810: }
811: else
812: {
813: condition = ((*((real8 *) (*s_objet_3).objet)) == 0)
814: ? d_faux : d_vrai;
815: }
816:
817: if (condition == d_vrai)
818: {
819: if (evaluation(s_etat_processus, s_objet_2,
820: (test_cfsf(s_etat_processus, 35) == d_vrai) ? 'E' : 'N')
821: == d_erreur)
822: {
823: liberation(s_etat_processus, s_objet_1);
824: liberation(s_etat_processus, s_objet_2);
825: liberation(s_etat_processus, s_objet_3);
826: return;
827: }
828:
829: liberation(s_etat_processus, s_objet_1);
830: }
831: else
832: {
833: if (evaluation(s_etat_processus, s_objet_1,
834: (test_cfsf(s_etat_processus, 35) == d_vrai) ? 'E' : 'N')
835: == d_erreur)
836: {
837: liberation(s_etat_processus, s_objet_1);
838: liberation(s_etat_processus, s_objet_2);
839: liberation(s_etat_processus, s_objet_3);
840: return;
841: }
842:
843: liberation(s_etat_processus, s_objet_2);
844: }
845:
846: liberation(s_etat_processus, s_objet_3);
847: }
848: else
849: {
850: liberation(s_etat_processus, s_objet_1);
851: liberation(s_etat_processus, s_objet_2);
852: liberation(s_etat_processus, s_objet_3);
853:
854: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
855: return;
856: }
857:
858: return;
859: }
860:
861:
862: /*
863: ================================================================================
864: Fonction 'i'
865: ================================================================================
866: Entrées : pointeur sur une struct_processus
867: --------------------------------------------------------------------------------
868: Sorties :
869: --------------------------------------------------------------------------------
870: Effets de bord : néant
871: ================================================================================
872: */
873:
874: void
875: instruction_sensible_i(struct_processus *s_etat_processus)
876: {
877: (*s_etat_processus).instruction_sensible = 'Y';
878:
879: if (strcmp((*s_etat_processus).instruction_courante, "i") == 0)
880: {
881: instruction_i(s_etat_processus);
882: }
883: else
884: {
885: (*s_etat_processus).instruction_valide = 'N';
886: }
887:
888: return;
889: }
890:
891: void
892: instruction_i(struct_processus *s_etat_processus)
893: {
894: struct_objet *s_objet;
895:
896: (*s_etat_processus).erreur_execution = d_ex;
897:
898: if ((*s_etat_processus).affichage_arguments == 'Y')
899: {
900: printf("\n i ");
901:
902: if ((*s_etat_processus).langue == 'F')
903: {
904: printf("(entier de Gauss)\n\n");
905: }
906: else
907: {
908: printf("(Gauss integer)\n\n");
909: }
910:
911: printf("-> 1: %s, %s\n", d_CPL, d_NOM);
912:
913: return;
914: }
915: else if ((*s_etat_processus).test_instruction == 'Y')
916: {
917: (*s_etat_processus).constante_symbolique = 'Y';
918: (*s_etat_processus).nombre_arguments = 3;
919: return;
920: }
921:
922: /* Indicateur 35 armé => évaluation symbolique */
923: if (test_cfsf(s_etat_processus, 35) == d_vrai)
924: {
925: if ((s_objet = allocation(s_etat_processus, NOM)) == NULL)
926: {
927: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
928: return;
929: }
930:
931: if (((*((struct_nom *) (*s_objet).objet)).nom =
932: malloc(2 * sizeof(unsigned char))) == NULL)
933: {
934: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
935: return;
936: }
937:
938: strcpy((*((struct_nom *) (*s_objet).objet)).nom, "i");
939: (*((struct_nom *) (*s_objet).objet)).symbole = d_faux;
940: }
941: else
942: {
943: if ((s_objet = allocation(s_etat_processus, CPL)) == NULL)
944: {
945: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
946: return;
947: }
948:
949: (*((struct_complexe16 *) (*s_objet).objet)).partie_reelle = 0;
950: (*((struct_complexe16 *) (*s_objet).objet)).partie_imaginaire = 1;
951: }
952:
953: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
954: s_objet) == d_erreur)
955: {
956: return;
957: }
958:
959: return;
960: }
961:
962:
963: /*
964: ================================================================================
965: Fonction 'ip'
966: ================================================================================
967: Entrées :
968: --------------------------------------------------------------------------------
969: Sorties :
970: --------------------------------------------------------------------------------
971: Effets de bord : néant
972: ================================================================================
973: */
974:
975: void
976: instruction_ip(struct_processus *s_etat_processus)
977: {
978: struct_liste_chainee *l_element_courant;
979: struct_liste_chainee *l_element_precedent;
980:
981: struct_objet *s_copie_argument;
982: struct_objet *s_objet_argument;
983: struct_objet *s_objet_resultat;
984:
985: (*s_etat_processus).erreur_execution = d_ex;
986:
987: if ((*s_etat_processus).affichage_arguments == 'Y')
988: {
989: printf("\n IP ");
990:
991: if ((*s_etat_processus).langue == 'F')
992: {
993: printf("(partie entière)\n\n");
994: }
995: else
996: {
997: printf("(integer part)\n\n");
998: }
999:
1000: printf(" 1: %s, %s\n", d_INT, d_REL);
1001: printf("-> 1: %s\n\n", d_INT);
1002:
1003: printf(" 1: %s, %s\n", d_NOM, d_ALG);
1004: printf("-> 1: %s\n\n", d_ALG);
1005:
1006: printf(" 1: %s\n", d_RPN);
1007: printf("-> 1: %s\n", d_RPN);
1008:
1009: return;
1010: }
1011: else if ((*s_etat_processus).test_instruction == 'Y')
1012: {
1013: (*s_etat_processus).nombre_arguments = 1;
1014: return;
1015: }
1016:
1017: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1018: {
1019: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1020: {
1021: return;
1022: }
1023: }
1024:
1025: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1026: &s_objet_argument) == d_erreur)
1027: {
1028: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1029: return;
1030: }
1031:
1032: /*
1033: --------------------------------------------------------------------------------
1034: ip d'un entier
1035: --------------------------------------------------------------------------------
1036: */
1037:
1038: if ((*s_objet_argument).type == INT)
1039: {
1040: s_objet_resultat = s_objet_argument;
1041: s_objet_argument = NULL;
1042: }
1043:
1044: /*
1045: --------------------------------------------------------------------------------
1046: ip d'un réel
1047: --------------------------------------------------------------------------------
1048: */
1049:
1050: else if ((*s_objet_argument).type == REL)
1051: {
1052: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
1053: {
1054: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1055: return;
1056: }
1057:
1058: if ((*((real8 *) (*s_objet_argument).objet)) > 0)
1059: {
1060: (*((integer8 *) (*s_objet_resultat).objet)) = (integer8)
1061: floor((*((real8 *) (*s_objet_argument).objet)));
1062:
1063: if (!((((*((integer8 *) (*s_objet_resultat).objet)) <=
1064: (*((real8 *) (*s_objet_argument).objet))) &&
1065: (((*((integer8 *) (*s_objet_resultat).objet)) + 1) >
1066: (*((real8 *) (*s_objet_argument).objet))))))
1067: {
1068: free((*s_objet_resultat).objet);
1069:
1070: if (((*s_objet_resultat).objet = malloc(sizeof(real8))) == NULL)
1071: {
1072: (*s_etat_processus).erreur_systeme =
1073: d_es_allocation_memoire;
1074: return;
1075: }
1076:
1077: (*s_objet_resultat).type = REL;
1078: (*((real8 *) (*s_objet_resultat).objet)) =
1079: ceil((*((real8 *) (*s_objet_argument).objet)));
1080: }
1081: }
1082: else
1083: {
1084: (*((integer8 *) (*s_objet_resultat).objet)) = (integer8)
1085: ceil((*((real8 *) (*s_objet_argument).objet)));
1086:
1087: if (!(((((*((integer8 *) (*s_objet_resultat).objet)) - 1) <
1088: (*((real8 *) (*s_objet_argument).objet))) &&
1089: ((*((integer8 *) (*s_objet_resultat).objet)) >= (*((real8 *)
1090: (*s_objet_argument).objet))))))
1091: {
1092: free((*s_objet_resultat).objet);
1093:
1094: if (((*s_objet_resultat).objet = malloc(sizeof(real8))) == NULL)
1095: {
1096: (*s_etat_processus).erreur_systeme =
1097: d_es_allocation_memoire;
1098: return;
1099: }
1100:
1101: (*s_objet_resultat).type = REL;
1102: (*((real8 *) (*s_objet_resultat).objet)) =
1103: ceil((*((real8 *) (*s_objet_argument).objet)));
1104: }
1105: }
1106: }
1107:
1108: /*
1109: --------------------------------------------------------------------------------
1110: ip d'un nom
1111: --------------------------------------------------------------------------------
1112: */
1113:
1114: else if ((*s_objet_argument).type == NOM)
1115: {
1116: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
1117: {
1118: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1119: return;
1120: }
1121:
1122: if (((*s_objet_resultat).objet =
1123: allocation_maillon(s_etat_processus)) == NULL)
1124: {
1125: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1126: return;
1127: }
1128:
1129: l_element_courant = (*s_objet_resultat).objet;
1130:
1131: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1132: == NULL)
1133: {
1134: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1135: return;
1136: }
1137:
1138: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1139: .nombre_arguments = 0;
1140: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1141: .fonction = instruction_vers_niveau_superieur;
1142:
1143: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1144: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1145: {
1146: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1147: return;
1148: }
1149:
1150: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1151: .nom_fonction, "<<");
1152:
1153: if (((*l_element_courant).suivant =
1154: allocation_maillon(s_etat_processus)) == NULL)
1155: {
1156: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1157: return;
1158: }
1159:
1160: l_element_courant = (*l_element_courant).suivant;
1161: (*l_element_courant).donnee = s_objet_argument;
1162:
1163: if (((*l_element_courant).suivant =
1164: allocation_maillon(s_etat_processus)) == NULL)
1165: {
1166: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1167: return;
1168: }
1169:
1170: l_element_courant = (*l_element_courant).suivant;
1171:
1172: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1173: == NULL)
1174: {
1175: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1176: return;
1177: }
1178:
1179: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1180: .nombre_arguments = 1;
1181: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1182: .fonction = instruction_ip;
1183:
1184: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1185: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1186: {
1187: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1188: return;
1189: }
1190:
1191: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1192: .nom_fonction, "IP");
1193:
1194: if (((*l_element_courant).suivant =
1195: allocation_maillon(s_etat_processus)) == NULL)
1196: {
1197: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1198: return;
1199: }
1200:
1201: l_element_courant = (*l_element_courant).suivant;
1202:
1203: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1204: == NULL)
1205: {
1206: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1207: return;
1208: }
1209:
1210: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1211: .nombre_arguments = 0;
1212: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1213: .fonction = instruction_vers_niveau_inferieur;
1214:
1215: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1216: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1217: {
1218: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1219: return;
1220: }
1221:
1222: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1223: .nom_fonction, ">>");
1224:
1225: (*l_element_courant).suivant = NULL;
1226: s_objet_argument = NULL;
1227: }
1228:
1229: /*
1230: --------------------------------------------------------------------------------
1231: ip d'une expression
1232: --------------------------------------------------------------------------------
1233: */
1234:
1235: else if (((*s_objet_argument).type == ALG) ||
1236: ((*s_objet_argument).type == RPN))
1237: {
1238: if ((s_copie_argument = copie_objet(s_etat_processus,
1239: s_objet_argument, 'N')) == NULL)
1240: {
1241: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1242: return;
1243: }
1244:
1245: l_element_courant = (struct_liste_chainee *)
1246: (*s_copie_argument).objet;
1247: l_element_precedent = l_element_courant;
1248:
1249: while((*l_element_courant).suivant != NULL)
1250: {
1251: l_element_precedent = l_element_courant;
1252: l_element_courant = (*l_element_courant).suivant;
1253: }
1254:
1255: if (((*l_element_precedent).suivant =
1256: allocation_maillon(s_etat_processus)) == NULL)
1257: {
1258: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1259: return;
1260: }
1261:
1262: if (((*(*l_element_precedent).suivant).donnee =
1263: allocation(s_etat_processus, FCT)) == NULL)
1264: {
1265: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1266: return;
1267: }
1268:
1269: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1270: .donnee).objet)).nombre_arguments = 1;
1271: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1272: .donnee).objet)).fonction = instruction_ip;
1273:
1274: if (((*((struct_fonction *) (*(*(*l_element_precedent)
1275: .suivant).donnee).objet)).nom_fonction =
1276: malloc(3 * sizeof(unsigned char))) == NULL)
1277: {
1278: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1279: return;
1280: }
1281:
1282: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
1283: .suivant).donnee).objet)).nom_fonction, "IP");
1284:
1285: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1286:
1287: s_objet_resultat = s_copie_argument;
1288: }
1289:
1290: /*
1291: --------------------------------------------------------------------------------
1292: Fonction ip impossible à réaliser
1293: --------------------------------------------------------------------------------
1294: */
1295:
1296: else
1297: {
1298: liberation(s_etat_processus, s_objet_argument);
1299:
1300: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1301: return;
1302: }
1303:
1304: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1305: s_objet_resultat) == d_erreur)
1306: {
1307: return;
1308: }
1309:
1310: liberation(s_etat_processus, s_objet_argument);
1311:
1312: return;
1313: }
1314:
1315:
1316: /*
1317: ================================================================================
1318: Fonction 'im'
1319: ================================================================================
1320: Entrées : structure processus
1321: --------------------------------------------------------------------------------
1322: Sorties :
1323: --------------------------------------------------------------------------------
1324: Effets de bord : néant
1325: ================================================================================
1326: */
1327:
1328: void
1329: instruction_im(struct_processus *s_etat_processus)
1330: {
1331: struct_liste_chainee *l_element_courant;
1332: struct_liste_chainee *l_element_precedent;
1333:
1334: struct_objet *s_copie_argument;
1335: struct_objet *s_objet_argument;
1336: struct_objet *s_objet_resultat;
1337:
1338: integer8 i;
1339: integer8 j;
1340:
1341: (*s_etat_processus).erreur_execution = d_ex;
1342:
1343: if ((*s_etat_processus).affichage_arguments == 'Y')
1344: {
1345: printf("\n IM ");
1346:
1347: if ((*s_etat_processus).langue == 'F')
1348: {
1349: printf("(partie imaginaire)\n\n");
1350: }
1351: else
1352: {
1353: printf("(imaginary part)\n\n");
1354: }
1355:
1356: printf(" 1: %s, %s\n", d_INT, d_REL);
1357: printf("-> 1: %s\n\n", d_INT);
1358:
1359: printf(" 1: %s\n", d_CPL);
1360: printf("-> 1: %s\n\n", d_REL);
1361:
1362: printf(" 1: %s, %s\n", d_VIN, d_VRL);
1363: printf("-> 1: %s\n\n", d_VIN);
1364:
1365: printf(" 1: %s\n", d_VCX);
1366: printf("-> 1: %s\n\n", d_VRL);
1367:
1368: printf(" 1: %s, %s\n", d_MIN, d_MRL);
1369: printf("-> 1: %s\n\n", d_MIN);
1370:
1371: printf(" 1: %s\n", d_MCX);
1372: printf("-> 1: %s\n\n", d_MRL);
1373:
1374: printf(" 1: %s, %s\n", d_NOM, d_ALG);
1375: printf("-> 1: %s\n\n", d_ALG);
1376:
1377: printf(" 1: %s\n", d_RPN);
1378: printf("-> 1: %s\n", d_RPN);
1379:
1380: return;
1381: }
1382: else if ((*s_etat_processus).test_instruction == 'Y')
1383: {
1384: (*s_etat_processus).nombre_arguments = 1;
1385: return;
1386: }
1387:
1388: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1389: {
1390: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1391: {
1392: return;
1393: }
1394: }
1395:
1396: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1397: &s_objet_argument) == d_erreur)
1398: {
1399: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1400: return;
1401: }
1402:
1403: /*
1404: --------------------------------------------------------------------------------
1405: Partie imaginaire d'un entier ou d'un réel
1406: --------------------------------------------------------------------------------
1407: */
1408:
1409: if (((*s_objet_argument).type == INT) ||
1410: ((*s_objet_argument).type == REL))
1411: {
1412: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
1413: {
1414: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1415: return;
1416: }
1417:
1418: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
1419: }
1420:
1421: /*
1422: --------------------------------------------------------------------------------
1423: Partie imaginaire d'un complexe
1424: --------------------------------------------------------------------------------
1425: */
1426:
1427: else if ((*s_objet_argument).type == CPL)
1428: {
1429: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
1430: {
1431: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1432: return;
1433: }
1434:
1435: (*((real8 *) (*s_objet_resultat).objet)) =
1436: (*((struct_complexe16 *) (*s_objet_argument).objet))
1437: .partie_imaginaire;
1438: }
1439:
1440: /*
1441: --------------------------------------------------------------------------------
1442: Partie imaginaire d'un vecteur
1443: --------------------------------------------------------------------------------
1444: */
1445:
1446: else if (((*s_objet_argument).type == VIN) ||
1447: ((*s_objet_argument).type == VRL))
1448: {
1449: if ((s_objet_resultat = allocation(s_etat_processus, VIN)) == NULL)
1450: {
1451: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1452: return;
1453: }
1454:
1455: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1456: malloc(((size_t) (*(((struct_vecteur *) (*s_objet_argument)
1457: .objet))).taille) * sizeof(integer8))) == NULL)
1458: {
1459: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1460: return;
1461: }
1462:
1463: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
1464: (*(((struct_vecteur *) (*s_objet_argument).objet))).taille;
1465:
1466: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument).objet)))
1467: .taille; i++)
1468: {
1469: ((integer8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1470: .tableau)[i] = 0;
1471: }
1472: }
1473: else if ((*s_objet_argument).type == VCX)
1474: {
1475: if ((s_objet_resultat = allocation(s_etat_processus, VRL)) == NULL)
1476: {
1477: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1478: return;
1479: }
1480:
1481: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1482: malloc(((size_t) (*(((struct_vecteur *) (*s_objet_argument)
1483: .objet))).taille) * sizeof(real8))) == NULL)
1484: {
1485: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1486: return;
1487: }
1488:
1489: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
1490: (*(((struct_vecteur *) (*s_objet_argument).objet))).taille;
1491:
1492: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument).objet)))
1493: .taille; i++)
1494: {
1495: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1496: .tableau)[i] = ((struct_complexe16 *) (*((struct_vecteur *)
1497: (*s_objet_argument).objet)).tableau)[i].partie_imaginaire;
1498: }
1499: }
1500:
1501: /*
1502: --------------------------------------------------------------------------------
1503: Partie imaginaire d'une matrice
1504: --------------------------------------------------------------------------------
1505: */
1506:
1507: else if (((*s_objet_argument).type == MIN) ||
1508: ((*s_objet_argument).type == MRL))
1509: {
1510: if ((s_objet_resultat = allocation(s_etat_processus, MIN)) == NULL)
1511: {
1512: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1513: return;
1514: }
1515:
1516: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1517: malloc(((size_t) (*(((struct_matrice *) (*s_objet_argument)
1518: .objet))).nombre_lignes) * sizeof(integer8 *))) == NULL)
1519: {
1520: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1521: return;
1522: }
1523:
1524: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
1525: (*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes;
1526: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
1527: (*((struct_matrice *) (*s_objet_argument).objet))
1528: .nombre_colonnes;
1529:
1530: for(i = 0; i < (*(((struct_matrice *) (*s_objet_argument).objet)))
1531: .nombre_lignes; i++)
1532: {
1533: if ((((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
1534: .objet)).tableau)[i] = malloc(((size_t)
1535: (*(((struct_matrice *) (*s_objet_argument).objet)))
1536: .nombre_colonnes) * sizeof(integer8))) == NULL)
1537: {
1538: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1539: return;
1540: }
1541:
1542: for(j = 0; j < (*(((struct_matrice *) (*s_objet_argument).objet)))
1543: .nombre_colonnes; j++)
1544: {
1545: ((integer8 **) (*((struct_matrice *)
1546: (*s_objet_resultat).objet)).tableau)[i][j] = 0;
1547: }
1548: }
1549: }
1550: else if ((*s_objet_argument).type == MCX)
1551: {
1552: if ((s_objet_resultat = allocation(s_etat_processus, MRL)) == NULL)
1553: {
1554: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1555: return;
1556: }
1557:
1558: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1559: malloc(((size_t) (*(((struct_matrice *) (*s_objet_argument)
1560: .objet))).nombre_lignes) * sizeof(real8))) == NULL)
1561: {
1562: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1563: return;
1564: }
1565:
1566: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
1567: (*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes;
1568: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
1569: (*((struct_matrice *) (*s_objet_argument).objet))
1570: .nombre_colonnes;
1571:
1572: for(i = 0; i < (*(((struct_matrice *) (*s_objet_argument).objet)))
1573: .nombre_lignes; i++)
1574: {
1575: if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat)
1576: .objet)).tableau)[i] = malloc(((size_t)
1577: (*(((struct_matrice *) (*s_objet_argument).objet)))
1578: .nombre_colonnes) * sizeof(real8))) == NULL)
1579: {
1580: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1581: return;
1582: }
1583:
1584: for(j = 0; j < (*(((struct_matrice *) (*s_objet_argument).objet)))
1585: .nombre_colonnes; j++)
1586: {
1587: ((real8 **) (*((struct_matrice *) (*s_objet_resultat).objet))
1588: .tableau)[i][j] = ((struct_complexe16 **)
1589: (*((struct_matrice *) (*s_objet_argument).objet))
1590: .tableau)[i][j].partie_imaginaire;
1591: }
1592: }
1593: }
1594:
1595: /*
1596: --------------------------------------------------------------------------------
1597: Partie imaginaire d'un nom
1598: --------------------------------------------------------------------------------
1599: */
1600:
1601: else if ((*s_objet_argument).type == NOM)
1602: {
1603: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
1604: {
1605: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1606: return;
1607: }
1608:
1609: if (((*s_objet_resultat).objet =
1610: allocation_maillon(s_etat_processus)) == NULL)
1611: {
1612: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1613: return;
1614: }
1615:
1616: l_element_courant = (*s_objet_resultat).objet;
1617:
1618: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1619: == NULL)
1620: {
1621: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1622: return;
1623: }
1624:
1625: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1626: .nombre_arguments = 0;
1627: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1628: .fonction = instruction_vers_niveau_superieur;
1629:
1630: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1631: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1632: {
1633: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1634: return;
1635: }
1636:
1637: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1638: .nom_fonction, "<<");
1639:
1640: if (((*l_element_courant).suivant =
1641: allocation_maillon(s_etat_processus)) == NULL)
1642: {
1643: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1644: return;
1645: }
1646:
1647: l_element_courant = (*l_element_courant).suivant;
1648: (*l_element_courant).donnee = s_objet_argument;
1649:
1650: if (((*l_element_courant).suivant =
1651: allocation_maillon(s_etat_processus)) == NULL)
1652: {
1653: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1654: return;
1655: }
1656:
1657: l_element_courant = (*l_element_courant).suivant;
1658:
1659: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1660: == NULL)
1661: {
1662: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1663: return;
1664: }
1665:
1666: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1667: .nombre_arguments = 1;
1668: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1669: .fonction = instruction_im;
1670:
1671: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1672: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1673: {
1674: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1675: return;
1676: }
1677:
1678: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1679: .nom_fonction, "IM");
1680:
1681: if (((*l_element_courant).suivant =
1682: allocation_maillon(s_etat_processus)) == NULL)
1683: {
1684: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1685: return;
1686: }
1687:
1688: l_element_courant = (*l_element_courant).suivant;
1689:
1690: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1691: == NULL)
1692: {
1693: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1694: return;
1695: }
1696:
1697: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1698: .nombre_arguments = 0;
1699: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1700: .fonction = instruction_vers_niveau_inferieur;
1701:
1702: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1703: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1704: {
1705: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1706: return;
1707: }
1708:
1709: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1710: .nom_fonction, ">>");
1711:
1712: (*l_element_courant).suivant = NULL;
1713: s_objet_argument = NULL;
1714: }
1715:
1716: /*
1717: --------------------------------------------------------------------------------
1718: Partie imaginaire d'une expression
1719: --------------------------------------------------------------------------------
1720: */
1721:
1722: else if (((*s_objet_argument).type == ALG) ||
1723: ((*s_objet_argument).type == RPN))
1724: {
1725: if ((s_copie_argument = copie_objet(s_etat_processus,
1726: s_objet_argument, 'N')) == NULL)
1727: {
1728: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1729: return;
1730: }
1731:
1732: l_element_courant = (struct_liste_chainee *)
1733: (*s_copie_argument).objet;
1734: l_element_precedent = l_element_courant;
1735:
1736: while((*l_element_courant).suivant != NULL)
1737: {
1738: l_element_precedent = l_element_courant;
1739: l_element_courant = (*l_element_courant).suivant;
1740: }
1741:
1742: if (((*l_element_precedent).suivant =
1743: allocation_maillon(s_etat_processus)) == NULL)
1744: {
1745: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1746: return;
1747: }
1748:
1749: if (((*(*l_element_precedent).suivant).donnee =
1750: allocation(s_etat_processus, FCT)) == NULL)
1751: {
1752: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1753: return;
1754: }
1755:
1756: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1757: .donnee).objet)).nombre_arguments = 1;
1758: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1759: .donnee).objet)).fonction = instruction_im;
1760:
1761: if (((*((struct_fonction *) (*(*(*l_element_precedent)
1762: .suivant).donnee).objet)).nom_fonction =
1763: malloc(3 * sizeof(unsigned char))) == NULL)
1764: {
1765: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1766: return;
1767: }
1768:
1769: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
1770: .suivant).donnee).objet)).nom_fonction, "IM");
1771:
1772: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1773:
1774: s_objet_resultat = s_copie_argument;
1775: }
1776:
1777: /*
1778: --------------------------------------------------------------------------------
1779: Réalisation impossible de la fonction partie imaginaire
1780: --------------------------------------------------------------------------------
1781: */
1782:
1783: else
1784: {
1785: liberation(s_etat_processus, s_objet_argument);
1786:
1787: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1788: return;
1789: }
1790:
1791: liberation(s_etat_processus, s_objet_argument);
1792:
1793: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1794: s_objet_resultat) == d_erreur)
1795: {
1796: return;
1797: }
1798:
1799: return;
1800: }
1801:
1802: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_i1.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src