1: /*
2: ================================================================================
3: RPL/2 (R) version 4.0.16
4: Copyright (C) 1989-2010 Dr. BERTRAND Joël
5:
6: This file is part of RPL/2.
7:
8: RPL/2 is free software; you can redistribute it and/or modify it
9: under the terms of the CeCILL V2 License as published by the french
10: CEA, CNRS and INRIA.
11:
12: RPL/2 is distributed in the hope that it will be useful, but WITHOUT
13: ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14: FITNESS FOR A PARTICULAR PURPOSE. See the CeCILL V2 License
15: for more details.
16:
17: You should have received a copy of the CeCILL License
18: along with RPL/2. If not, write to info@cecill.info.
19: ================================================================================
20: */
21:
22:
23: #include "rpl.conv.h"
24:
25:
26: /*
27: ================================================================================
28: Fonction '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 = (*((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 n)]\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: if (strcmp((*s_etat_processus).instruction_courante, "i") == 0)
878: {
879: instruction_i(s_etat_processus);
880: }
881: else
882: {
883: (*s_etat_processus).instruction_valide = 'N';
884: }
885:
886: return;
887: }
888:
889: void
890: instruction_i(struct_processus *s_etat_processus)
891: {
892: struct_objet *s_objet;
893:
894: (*s_etat_processus).erreur_execution = d_ex;
895:
896: if ((*s_etat_processus).affichage_arguments == 'Y')
897: {
898: printf("\n i ");
899:
900: if ((*s_etat_processus).langue == 'F')
901: {
902: printf("(entier de Gauss)\n\n");
903: }
904: else
905: {
906: printf("(Gauss integer)\n\n");
907: }
908:
909: printf("-> 1: %s, %s\n", d_CPL, d_NOM);
910:
911: return;
912: }
913: else if ((*s_etat_processus).test_instruction == 'Y')
914: {
915: (*s_etat_processus).constante_symbolique = 'Y';
916: (*s_etat_processus).nombre_arguments = 3;
917: return;
918: }
919:
920: /* Indicateur 35 armé => évaluation symbolique */
921: if (test_cfsf(s_etat_processus, 35) == d_vrai)
922: {
923: if ((s_objet = allocation(s_etat_processus, NOM)) == NULL)
924: {
925: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
926: return;
927: }
928:
929: if (((*((struct_nom *) (*s_objet).objet)).nom =
930: malloc(2 * sizeof(unsigned char))) == NULL)
931: {
932: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
933: return;
934: }
935:
936: strcpy((*((struct_nom *) (*s_objet).objet)).nom, "i");
937: (*((struct_nom *) (*s_objet).objet)).symbole = d_faux;
938: }
939: else
940: {
941: if ((s_objet = allocation(s_etat_processus, CPL)) == NULL)
942: {
943: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
944: return;
945: }
946:
947: (*((struct_complexe16 *) (*s_objet).objet)).partie_reelle = 0;
948: (*((struct_complexe16 *) (*s_objet).objet)).partie_imaginaire = 1;
949: }
950:
951: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
952: s_objet) == d_erreur)
953: {
954: return;
955: }
956:
957: return;
958: }
959:
960:
961: /*
962: ================================================================================
963: Fonction 'ip'
964: ================================================================================
965: Entrées :
966: --------------------------------------------------------------------------------
967: Sorties :
968: --------------------------------------------------------------------------------
969: Effets de bord : néant
970: ================================================================================
971: */
972:
973: void
974: instruction_ip(struct_processus *s_etat_processus)
975: {
976: struct_liste_chainee *l_element_courant;
977: struct_liste_chainee *l_element_precedent;
978:
979: struct_objet *s_copie_argument;
980: struct_objet *s_objet_argument;
981: struct_objet *s_objet_resultat;
982:
983: (*s_etat_processus).erreur_execution = d_ex;
984:
985: if ((*s_etat_processus).affichage_arguments == 'Y')
986: {
987: printf("\n IP ");
988:
989: if ((*s_etat_processus).langue == 'F')
990: {
991: printf("(partie entière)\n\n");
992: }
993: else
994: {
995: printf("(integer part)\n\n");
996: }
997:
998: printf(" 1: %s, %s\n", d_INT, d_REL);
999: printf("-> 1: %s\n\n", d_INT);
1000:
1001: printf(" 1: %s, %s\n", d_NOM, d_ALG);
1002: printf("-> 1: %s\n\n", d_ALG);
1003:
1004: printf(" 1: %s\n", d_RPN);
1005: printf("-> 1: %s\n", d_RPN);
1006:
1007: return;
1008: }
1009: else if ((*s_etat_processus).test_instruction == 'Y')
1010: {
1011: (*s_etat_processus).nombre_arguments = 1;
1012: return;
1013: }
1014:
1015: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1016: {
1017: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1018: {
1019: return;
1020: }
1021: }
1022:
1023: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1024: &s_objet_argument) == d_erreur)
1025: {
1026: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1027: return;
1028: }
1029:
1030: /*
1031: --------------------------------------------------------------------------------
1032: ip d'un entier
1033: --------------------------------------------------------------------------------
1034: */
1035:
1036: if ((*s_objet_argument).type == INT)
1037: {
1038: s_objet_resultat = s_objet_argument;
1039: s_objet_argument = NULL;
1040: }
1041:
1042: /*
1043: --------------------------------------------------------------------------------
1044: ip d'un réel
1045: --------------------------------------------------------------------------------
1046: */
1047:
1048: else if ((*s_objet_argument).type == REL)
1049: {
1050: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
1051: {
1052: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1053: return;
1054: }
1055:
1056: if ((*((real8 *) (*s_objet_argument).objet)) > 0)
1057: {
1058: (*((integer8 *) (*s_objet_resultat).objet)) =
1059: floor((*((real8 *) (*s_objet_argument).objet)));
1060:
1061: if (!((((*((integer8 *) (*s_objet_resultat).objet)) <=
1062: (*((real8 *) (*s_objet_argument).objet))) &&
1063: (((*((integer8 *) (*s_objet_resultat).objet)) + 1) >
1064: (*((real8 *) (*s_objet_argument).objet))))))
1065: {
1066: free((*s_objet_resultat).objet);
1067:
1068: if (((*s_objet_resultat).objet = malloc(sizeof(real8))) == NULL)
1069: {
1070: (*s_etat_processus).erreur_systeme =
1071: d_es_allocation_memoire;
1072: return;
1073: }
1074:
1075: (*s_objet_resultat).type = REL;
1076: (*((real8 *) (*s_objet_resultat).objet)) =
1077: ceil((*((real8 *) (*s_objet_argument).objet)));
1078: }
1079: }
1080: else
1081: {
1082: (*((integer8 *) (*s_objet_resultat).objet)) =
1083: ceil((*((real8 *) (*s_objet_argument).objet)));
1084:
1085: if (!(((((*((integer8 *) (*s_objet_resultat).objet)) - 1) <
1086: (*((real8 *) (*s_objet_argument).objet))) &&
1087: ((*((integer8 *) (*s_objet_resultat).objet)) >= (*((real8 *)
1088: (*s_objet_argument).objet))))))
1089: {
1090: free((*s_objet_resultat).objet);
1091:
1092: if (((*s_objet_resultat).objet = malloc(sizeof(real8))) == NULL)
1093: {
1094: (*s_etat_processus).erreur_systeme =
1095: d_es_allocation_memoire;
1096: return;
1097: }
1098:
1099: (*s_objet_resultat).type = REL;
1100: (*((real8 *) (*s_objet_resultat).objet)) =
1101: ceil((*((real8 *) (*s_objet_argument).objet)));
1102: }
1103: }
1104: }
1105:
1106: /*
1107: --------------------------------------------------------------------------------
1108: ip d'un nom
1109: --------------------------------------------------------------------------------
1110: */
1111:
1112: else if ((*s_objet_argument).type == NOM)
1113: {
1114: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
1115: {
1116: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1117: return;
1118: }
1119:
1120: if (((*s_objet_resultat).objet =
1121: allocation_maillon(s_etat_processus)) == NULL)
1122: {
1123: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1124: return;
1125: }
1126:
1127: l_element_courant = (*s_objet_resultat).objet;
1128:
1129: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1130: == NULL)
1131: {
1132: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1133: return;
1134: }
1135:
1136: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1137: .nombre_arguments = 0;
1138: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1139: .fonction = instruction_vers_niveau_superieur;
1140:
1141: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1142: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1143: {
1144: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1145: return;
1146: }
1147:
1148: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1149: .nom_fonction, "<<");
1150:
1151: if (((*l_element_courant).suivant =
1152: allocation_maillon(s_etat_processus)) == NULL)
1153: {
1154: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1155: return;
1156: }
1157:
1158: l_element_courant = (*l_element_courant).suivant;
1159: (*l_element_courant).donnee = s_objet_argument;
1160:
1161: if (((*l_element_courant).suivant =
1162: allocation_maillon(s_etat_processus)) == NULL)
1163: {
1164: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1165: return;
1166: }
1167:
1168: l_element_courant = (*l_element_courant).suivant;
1169:
1170: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1171: == NULL)
1172: {
1173: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1174: return;
1175: }
1176:
1177: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1178: .nombre_arguments = 1;
1179: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1180: .fonction = instruction_ip;
1181:
1182: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1183: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1184: {
1185: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1186: return;
1187: }
1188:
1189: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1190: .nom_fonction, "IP");
1191:
1192: if (((*l_element_courant).suivant =
1193: allocation_maillon(s_etat_processus)) == NULL)
1194: {
1195: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1196: return;
1197: }
1198:
1199: l_element_courant = (*l_element_courant).suivant;
1200:
1201: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1202: == NULL)
1203: {
1204: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1205: return;
1206: }
1207:
1208: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1209: .nombre_arguments = 0;
1210: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1211: .fonction = instruction_vers_niveau_inferieur;
1212:
1213: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1214: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1215: {
1216: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1217: return;
1218: }
1219:
1220: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1221: .nom_fonction, ">>");
1222:
1223: (*l_element_courant).suivant = NULL;
1224: s_objet_argument = NULL;
1225: }
1226:
1227: /*
1228: --------------------------------------------------------------------------------
1229: ip d'une expression
1230: --------------------------------------------------------------------------------
1231: */
1232:
1233: else if (((*s_objet_argument).type == ALG) ||
1234: ((*s_objet_argument).type == RPN))
1235: {
1236: if ((s_copie_argument = copie_objet(s_etat_processus,
1237: s_objet_argument, 'N')) == NULL)
1238: {
1239: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1240: return;
1241: }
1242:
1243: l_element_courant = (struct_liste_chainee *)
1244: (*s_copie_argument).objet;
1245: l_element_precedent = l_element_courant;
1246:
1247: while((*l_element_courant).suivant != NULL)
1248: {
1249: l_element_precedent = l_element_courant;
1250: l_element_courant = (*l_element_courant).suivant;
1251: }
1252:
1253: if (((*l_element_precedent).suivant =
1254: allocation_maillon(s_etat_processus)) == NULL)
1255: {
1256: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1257: return;
1258: }
1259:
1260: if (((*(*l_element_precedent).suivant).donnee =
1261: allocation(s_etat_processus, FCT)) == NULL)
1262: {
1263: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1264: return;
1265: }
1266:
1267: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1268: .donnee).objet)).nombre_arguments = 1;
1269: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1270: .donnee).objet)).fonction = instruction_ip;
1271:
1272: if (((*((struct_fonction *) (*(*(*l_element_precedent)
1273: .suivant).donnee).objet)).nom_fonction =
1274: malloc(3 * sizeof(unsigned char))) == NULL)
1275: {
1276: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1277: return;
1278: }
1279:
1280: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
1281: .suivant).donnee).objet)).nom_fonction, "IP");
1282:
1283: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1284:
1285: s_objet_resultat = s_copie_argument;
1286: }
1287:
1288: /*
1289: --------------------------------------------------------------------------------
1290: Fonction ip impossible à réaliser
1291: --------------------------------------------------------------------------------
1292: */
1293:
1294: else
1295: {
1296: liberation(s_etat_processus, s_objet_argument);
1297:
1298: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1299: return;
1300: }
1301:
1302: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1303: s_objet_resultat) == d_erreur)
1304: {
1305: return;
1306: }
1307:
1308: liberation(s_etat_processus, s_objet_argument);
1309:
1310: return;
1311: }
1312:
1313:
1314: /*
1315: ================================================================================
1316: Fonction 'im'
1317: ================================================================================
1318: Entrées : structure processus
1319: --------------------------------------------------------------------------------
1320: Sorties :
1321: --------------------------------------------------------------------------------
1322: Effets de bord : néant
1323: ================================================================================
1324: */
1325:
1326: void
1327: instruction_im(struct_processus *s_etat_processus)
1328: {
1329: struct_liste_chainee *l_element_courant;
1330: struct_liste_chainee *l_element_precedent;
1331:
1332: struct_objet *s_copie_argument;
1333: struct_objet *s_objet_argument;
1334: struct_objet *s_objet_resultat;
1335:
1336: unsigned long i;
1337: unsigned long j;
1338:
1339: (*s_etat_processus).erreur_execution = d_ex;
1340:
1341: if ((*s_etat_processus).affichage_arguments == 'Y')
1342: {
1343: printf("\n IM ");
1344:
1345: if ((*s_etat_processus).langue == 'F')
1346: {
1347: printf("(partie imaginaire)\n\n");
1348: }
1349: else
1350: {
1351: printf("(imaginary part)\n\n");
1352: }
1353:
1354: printf(" 1: %s, %s\n", d_INT, d_REL);
1355: printf("-> 1: %s\n\n", d_INT);
1356:
1357: printf(" 1: %s\n", d_CPL);
1358: printf("-> 1: %s\n\n", d_REL);
1359:
1360: printf(" 1: %s, %s\n", d_VIN, d_VRL);
1361: printf("-> 1: %s\n\n", d_VIN);
1362:
1363: printf(" 1: %s\n", d_VCX);
1364: printf("-> 1: %s\n\n", d_VRL);
1365:
1366: printf(" 1: %s, %s\n", d_MIN, d_MRL);
1367: printf("-> 1: %s\n\n", d_MIN);
1368:
1369: printf(" 1: %s\n", d_MCX);
1370: printf("-> 1: %s\n\n", d_MRL);
1371:
1372: printf(" 1: %s, %s\n", d_NOM, d_ALG);
1373: printf("-> 1: %s\n\n", d_ALG);
1374:
1375: printf(" 1: %s\n", d_RPN);
1376: printf("-> 1: %s\n", d_RPN);
1377:
1378: return;
1379: }
1380: else if ((*s_etat_processus).test_instruction == 'Y')
1381: {
1382: (*s_etat_processus).nombre_arguments = 1;
1383: return;
1384: }
1385:
1386: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1387: {
1388: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1389: {
1390: return;
1391: }
1392: }
1393:
1394: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1395: &s_objet_argument) == d_erreur)
1396: {
1397: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1398: return;
1399: }
1400:
1401: /*
1402: --------------------------------------------------------------------------------
1403: Partie imaginaire d'un entier ou d'un réel
1404: --------------------------------------------------------------------------------
1405: */
1406:
1407: if (((*s_objet_argument).type == INT) ||
1408: ((*s_objet_argument).type == REL))
1409: {
1410: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
1411: {
1412: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1413: return;
1414: }
1415:
1416: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
1417: }
1418:
1419: /*
1420: --------------------------------------------------------------------------------
1421: Partie imaginaire d'un complexe
1422: --------------------------------------------------------------------------------
1423: */
1424:
1425: else if ((*s_objet_argument).type == CPL)
1426: {
1427: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
1428: {
1429: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1430: return;
1431: }
1432:
1433: (*((real8 *) (*s_objet_resultat).objet)) =
1434: (*((struct_complexe16 *) (*s_objet_argument).objet))
1435: .partie_imaginaire;
1436: }
1437:
1438: /*
1439: --------------------------------------------------------------------------------
1440: Partie imaginaire d'un vecteur
1441: --------------------------------------------------------------------------------
1442: */
1443:
1444: else if (((*s_objet_argument).type == VIN) ||
1445: ((*s_objet_argument).type == VRL))
1446: {
1447: if ((s_objet_resultat = allocation(s_etat_processus, VIN)) == NULL)
1448: {
1449: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1450: return;
1451: }
1452:
1453: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1454: malloc((*(((struct_vecteur *) (*s_objet_argument)
1455: .objet))).taille * sizeof(integer8))) == NULL)
1456: {
1457: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1458: return;
1459: }
1460:
1461: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
1462: (*(((struct_vecteur *) (*s_objet_argument).objet))).taille;
1463:
1464: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument).objet)))
1465: .taille; i++)
1466: {
1467: ((integer8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1468: .tableau)[i] = 0;
1469: }
1470: }
1471: else if ((*s_objet_argument).type == VCX)
1472: {
1473: if ((s_objet_resultat = allocation(s_etat_processus, VRL)) == NULL)
1474: {
1475: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1476: return;
1477: }
1478:
1479: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1480: malloc((*(((struct_vecteur *) (*s_objet_argument)
1481: .objet))).taille * sizeof(real8))) == NULL)
1482: {
1483: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1484: return;
1485: }
1486:
1487: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
1488: (*(((struct_vecteur *) (*s_objet_argument).objet))).taille;
1489:
1490: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument).objet)))
1491: .taille; i++)
1492: {
1493: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1494: .tableau)[i] = ((struct_complexe16 *) (*((struct_vecteur *)
1495: (*s_objet_argument).objet)).tableau)[i].partie_imaginaire;
1496: }
1497: }
1498:
1499: /*
1500: --------------------------------------------------------------------------------
1501: Partie imaginaire d'une matrice
1502: --------------------------------------------------------------------------------
1503: */
1504:
1505: else if (((*s_objet_argument).type == MIN) ||
1506: ((*s_objet_argument).type == MRL))
1507: {
1508: if ((s_objet_resultat = allocation(s_etat_processus, MIN)) == NULL)
1509: {
1510: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1511: return;
1512: }
1513:
1514: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1515: malloc((*(((struct_matrice *) (*s_objet_argument)
1516: .objet))).nombre_lignes * sizeof(integer8 *))) == NULL)
1517: {
1518: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1519: return;
1520: }
1521:
1522: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
1523: (*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes;
1524: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
1525: (*((struct_matrice *) (*s_objet_argument).objet))
1526: .nombre_colonnes;
1527:
1528: for(i = 0; i < (*(((struct_matrice *) (*s_objet_argument).objet)))
1529: .nombre_lignes; i++)
1530: {
1531: if ((((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
1532: .objet)).tableau)[i] = malloc(
1533: (*(((struct_matrice *) (*s_objet_argument).objet)))
1534: .nombre_colonnes * sizeof(integer8))) == NULL)
1535: {
1536: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1537: return;
1538: }
1539:
1540: for(j = 0; j < (*(((struct_matrice *) (*s_objet_argument).objet)))
1541: .nombre_colonnes; j++)
1542: {
1543: ((integer8 **) (*((struct_matrice *)
1544: (*s_objet_resultat).objet)).tableau)[i][j] = 0;
1545: }
1546: }
1547: }
1548: else if ((*s_objet_argument).type == MCX)
1549: {
1550: if ((s_objet_resultat = allocation(s_etat_processus, MRL)) == NULL)
1551: {
1552: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1553: return;
1554: }
1555:
1556: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1557: malloc((*(((struct_matrice *) (*s_objet_argument)
1558: .objet))).nombre_lignes * sizeof(real8))) == NULL)
1559: {
1560: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1561: return;
1562: }
1563:
1564: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
1565: (*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes;
1566: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
1567: (*((struct_matrice *) (*s_objet_argument).objet))
1568: .nombre_colonnes;
1569:
1570: for(i = 0; i < (*(((struct_matrice *) (*s_objet_argument).objet)))
1571: .nombre_lignes; i++)
1572: {
1573: if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat)
1574: .objet)).tableau)[i] = malloc(
1575: (*(((struct_matrice *) (*s_objet_argument).objet)))
1576: .nombre_colonnes * sizeof(real8))) == NULL)
1577: {
1578: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1579: return;
1580: }
1581:
1582: for(j = 0; j < (*(((struct_matrice *) (*s_objet_argument).objet)))
1583: .nombre_colonnes; j++)
1584: {
1585: ((real8 **) (*((struct_matrice *) (*s_objet_resultat).objet))
1586: .tableau)[i][j] = ((struct_complexe16 **)
1587: (*((struct_matrice *) (*s_objet_argument).objet))
1588: .tableau)[i][j].partie_imaginaire;
1589: }
1590: }
1591: }
1592:
1593: /*
1594: --------------------------------------------------------------------------------
1595: Partie imaginaire d'un nom
1596: --------------------------------------------------------------------------------
1597: */
1598:
1599: else if ((*s_objet_argument).type == NOM)
1600: {
1601: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
1602: {
1603: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1604: return;
1605: }
1606:
1607: if (((*s_objet_resultat).objet =
1608: allocation_maillon(s_etat_processus)) == NULL)
1609: {
1610: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1611: return;
1612: }
1613:
1614: l_element_courant = (*s_objet_resultat).objet;
1615:
1616: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1617: == NULL)
1618: {
1619: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1620: return;
1621: }
1622:
1623: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1624: .nombre_arguments = 0;
1625: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1626: .fonction = instruction_vers_niveau_superieur;
1627:
1628: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1629: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1630: {
1631: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1632: return;
1633: }
1634:
1635: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1636: .nom_fonction, "<<");
1637:
1638: if (((*l_element_courant).suivant =
1639: allocation_maillon(s_etat_processus)) == NULL)
1640: {
1641: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1642: return;
1643: }
1644:
1645: l_element_courant = (*l_element_courant).suivant;
1646: (*l_element_courant).donnee = s_objet_argument;
1647:
1648: if (((*l_element_courant).suivant =
1649: allocation_maillon(s_etat_processus)) == NULL)
1650: {
1651: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1652: return;
1653: }
1654:
1655: l_element_courant = (*l_element_courant).suivant;
1656:
1657: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1658: == NULL)
1659: {
1660: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1661: return;
1662: }
1663:
1664: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1665: .nombre_arguments = 1;
1666: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1667: .fonction = instruction_im;
1668:
1669: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1670: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1671: {
1672: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1673: return;
1674: }
1675:
1676: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1677: .nom_fonction, "IM");
1678:
1679: if (((*l_element_courant).suivant =
1680: allocation_maillon(s_etat_processus)) == NULL)
1681: {
1682: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1683: return;
1684: }
1685:
1686: l_element_courant = (*l_element_courant).suivant;
1687:
1688: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1689: == NULL)
1690: {
1691: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1692: return;
1693: }
1694:
1695: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1696: .nombre_arguments = 0;
1697: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1698: .fonction = instruction_vers_niveau_inferieur;
1699:
1700: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1701: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1702: {
1703: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1704: return;
1705: }
1706:
1707: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1708: .nom_fonction, ">>");
1709:
1710: (*l_element_courant).suivant = NULL;
1711: s_objet_argument = NULL;
1712: }
1713:
1714: /*
1715: --------------------------------------------------------------------------------
1716: Partie imaginaire d'une expression
1717: --------------------------------------------------------------------------------
1718: */
1719:
1720: else if (((*s_objet_argument).type == ALG) ||
1721: ((*s_objet_argument).type == RPN))
1722: {
1723: if ((s_copie_argument = copie_objet(s_etat_processus,
1724: s_objet_argument, 'N')) == NULL)
1725: {
1726: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1727: return;
1728: }
1729:
1730: l_element_courant = (struct_liste_chainee *)
1731: (*s_copie_argument).objet;
1732: l_element_precedent = l_element_courant;
1733:
1734: while((*l_element_courant).suivant != NULL)
1735: {
1736: l_element_precedent = l_element_courant;
1737: l_element_courant = (*l_element_courant).suivant;
1738: }
1739:
1740: if (((*l_element_precedent).suivant =
1741: allocation_maillon(s_etat_processus)) == NULL)
1742: {
1743: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1744: return;
1745: }
1746:
1747: if (((*(*l_element_precedent).suivant).donnee =
1748: allocation(s_etat_processus, FCT)) == NULL)
1749: {
1750: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1751: return;
1752: }
1753:
1754: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1755: .donnee).objet)).nombre_arguments = 1;
1756: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1757: .donnee).objet)).fonction = instruction_im;
1758:
1759: if (((*((struct_fonction *) (*(*(*l_element_precedent)
1760: .suivant).donnee).objet)).nom_fonction =
1761: malloc(3 * sizeof(unsigned char))) == NULL)
1762: {
1763: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1764: return;
1765: }
1766:
1767: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
1768: .suivant).donnee).objet)).nom_fonction, "IM");
1769:
1770: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1771:
1772: s_objet_resultat = s_copie_argument;
1773: }
1774:
1775: /*
1776: --------------------------------------------------------------------------------
1777: Réalisation impossible de la fonction partie imaginaire
1778: --------------------------------------------------------------------------------
1779: */
1780:
1781: else
1782: {
1783: liberation(s_etat_processus, s_objet_argument);
1784:
1785: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1786: return;
1787: }
1788:
1789: liberation(s_etat_processus, s_objet_argument);
1790:
1791: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1792: s_objet_resultat) == d_erreur)
1793: {
1794: return;
1795: }
1796:
1797: return;
1798: }
1799:
1800: // 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