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 'array->'
29: ================================================================================
30: Entrées : pointeur sur une structure struct_processus
31: --------------------------------------------------------------------------------
32: Sorties :
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: void
39: instruction_array_fleche(struct_processus *s_etat_processus)
40: {
41: integer8 i;
42: integer8 j;
43:
44: struct_liste_chainee *l_element_courant;
45:
46: struct_objet *s_objet_source;
47: struct_objet *s_objet_elementaire;
48:
49: (*s_etat_processus).erreur_execution = d_ex;
50:
51: if ((*s_etat_processus).affichage_arguments == 'Y')
52: {
53: printf("\n ARRAY-> [ARRY->] ");
54:
55: if ((*s_etat_processus).langue == 'F')
56: {
57: printf("(éclatement de vecteur ou de matrice)\n\n");
58: }
59: else
60: {
61: printf("(vector or matrix split)\n\n");
62: }
63:
64: printf(" 1: %s\n", d_VIN);
65: printf("-> n: %s\n", d_INT);
66: printf(" ...\n");
67: printf(" 1: %s\n\n", d_INT);
68:
69: printf(" 1: %s\n", d_VRL);
70: printf("-> n: %s\n", d_REL);
71: printf(" ...\n");
72: printf(" 1: %s\n\n", d_REL);
73:
74: printf(" 1: %s\n", d_VCX);
75: printf("-> n: %s\n", d_CPL);
76: printf(" ...\n");
77: printf(" 1: %s\n\n", d_CPL);
78:
79: printf(" 1: %s\n", d_MIN);
80: printf("-> nm: %s\n", d_INT);
81: printf(" ...\n");
82: printf(" 1: %s\n\n", d_INT);
83:
84: printf(" 1: %s\n", d_MRL);
85: printf("-> nm: %s\n", d_REL);
86: printf(" ...\n");
87: printf(" 1: %s\n\n", d_REL);
88:
89: printf(" 1: %s\n", d_MCX);
90: printf("-> nm: %s\n", d_CPL);
91: printf(" ...\n");
92: printf(" 1: %s\n", d_CPL);
93:
94: return;
95: }
96: else if ((*s_etat_processus).test_instruction == 'Y')
97: {
98: (*s_etat_processus).nombre_arguments = -1;
99: return;
100: }
101:
102: if (test_cfsf(s_etat_processus, 31) == d_vrai)
103: {
104: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
105: {
106: return;
107: }
108: }
109:
110: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
111: &s_objet_source) == d_erreur)
112: {
113: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
114: return;
115: }
116:
117: /*
118: --------------------------------------------------------------------------------
119: Cas des vecteurs
120: --------------------------------------------------------------------------------
121: */
122:
123: if ((*s_objet_source).type == VIN)
124: {
125: /*
126: * Traitement d'un vecteur d'entiers
127: */
128:
129: for(i = 0; i < (*((struct_vecteur *) (*s_objet_source).objet)).taille;
130: i++)
131: {
132: if ((s_objet_elementaire = allocation(s_etat_processus, INT))
133: == NULL)
134: {
135: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
136: return;
137: }
138:
139: (*((integer8 *) (*s_objet_elementaire).objet)) =
140: ((integer8 *) (*((struct_vecteur *)
141: (*s_objet_source).objet)).tableau)[i];
142:
143: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
144: s_objet_elementaire) == d_erreur)
145: {
146: return;
147: }
148: }
149:
150: if ((s_objet_elementaire = allocation(s_etat_processus, LST))
151: == NULL)
152: {
153: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
154: return;
155: }
156:
157: if (((*s_objet_elementaire).objet =
158: allocation_maillon(s_etat_processus)) == NULL)
159: {
160: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
161: return;
162: }
163:
164: l_element_courant = (struct_liste_chainee *)
165: (*s_objet_elementaire).objet;
166:
167: (*l_element_courant).suivant = NULL;
168:
169: if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
170: == NULL)
171: {
172: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
173: return;
174: }
175:
176: (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
177: (*((struct_vecteur *) (*s_objet_source).objet)).taille;
178:
179: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
180: s_objet_elementaire) == d_erreur)
181: {
182: return;
183: }
184: }
185: else if ((*s_objet_source).type == VRL)
186: {
187: /*
188: * Traitement d'un vecteur de réels
189: */
190:
191: for(i = 0; i < (*((struct_vecteur *) (*s_objet_source).objet)).taille;
192: i++)
193: {
194: if ((s_objet_elementaire = allocation(s_etat_processus, REL))
195: == NULL)
196: {
197: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
198: return;
199: }
200:
201: (*((real8 *) (*s_objet_elementaire).objet)) =
202: ((real8 *) (*((struct_vecteur *)
203: (*s_objet_source).objet)).tableau)[i];
204:
205: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
206: s_objet_elementaire) == d_erreur)
207: {
208: return;
209: }
210: }
211:
212: if ((s_objet_elementaire = allocation(s_etat_processus, LST))
213: == NULL)
214: {
215: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
216: return;
217: }
218:
219: if (((*s_objet_elementaire).objet =
220: allocation_maillon(s_etat_processus)) == NULL)
221: {
222: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
223: return;
224: }
225:
226: l_element_courant = (struct_liste_chainee *)
227: (*s_objet_elementaire).objet;
228:
229: (*l_element_courant).suivant = NULL;
230:
231: if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
232: == NULL)
233: {
234: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
235: return;
236: }
237:
238: (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
239: (*((struct_vecteur *) (*s_objet_source).objet)).taille;
240:
241: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
242: s_objet_elementaire) == d_erreur)
243: {
244: return;
245: }
246: }
247: else if ((*s_objet_source).type == VCX)
248: {
249: /*
250: * Traitement d'un vecteur de complexes
251: */
252:
253: for(i = 0; i < (*((struct_vecteur *) (*s_objet_source).objet)).taille;
254: i++)
255: {
256: if ((s_objet_elementaire = allocation(s_etat_processus, CPL))
257: == NULL)
258: {
259: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
260: return;
261: }
262:
263: (*((struct_complexe16 *) (*s_objet_elementaire).objet))
264: .partie_reelle = ((struct_complexe16 *)
265: (*((struct_vecteur *) (*s_objet_source).objet)).tableau)[i]
266: .partie_reelle;
267: (*((struct_complexe16 *) (*s_objet_elementaire).objet))
268: .partie_imaginaire = ((struct_complexe16 *)
269: (*((struct_vecteur *) (*s_objet_source).objet)).tableau)[i]
270: .partie_imaginaire;
271:
272: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
273: s_objet_elementaire) == d_erreur)
274: {
275: return;
276: }
277: }
278:
279: if ((s_objet_elementaire = allocation(s_etat_processus, LST))
280: == NULL)
281: {
282: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
283: return;
284: }
285:
286: if (((*s_objet_elementaire).objet =
287: allocation_maillon(s_etat_processus)) == NULL)
288: {
289: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
290: return;
291: }
292:
293: l_element_courant = (struct_liste_chainee *)
294: (*s_objet_elementaire).objet;
295:
296: (*l_element_courant).suivant = NULL;
297:
298: if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
299: == NULL)
300: {
301: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
302: return;
303: }
304:
305: (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
306: (*((struct_vecteur *) (*s_objet_source).objet)).taille;
307:
308: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
309: s_objet_elementaire) == d_erreur)
310: {
311: return;
312: }
313: }
314:
315: /*
316: --------------------------------------------------------------------------------
317: Cas des matrices
318: --------------------------------------------------------------------------------
319: */
320:
321: else if ((*s_objet_source).type == MIN)
322: {
323: /*
324: * Traitement d'une matrice d'entiers
325: */
326:
327: for(i = 0; i < (*((struct_matrice *) (*s_objet_source).objet))
328: .nombre_lignes; i++)
329: {
330: for(j = 0; j < (*((struct_matrice *) (*s_objet_source).objet))
331: .nombre_colonnes; j++)
332: {
333: if ((s_objet_elementaire = allocation(s_etat_processus, INT))
334: == NULL)
335: {
336: (*s_etat_processus).erreur_systeme =
337: d_es_allocation_memoire;
338: return;
339: }
340:
341: (*((integer8 *) (*s_objet_elementaire).objet)) =
342: ((integer8 **) (*((struct_matrice *)
343: (*s_objet_source).objet)).tableau)[i][j];
344:
345: if (empilement(s_etat_processus, &((*s_etat_processus)
346: .l_base_pile), s_objet_elementaire) == d_erreur)
347: {
348: return;
349: }
350: }
351: }
352:
353: if ((s_objet_elementaire = allocation(s_etat_processus, LST))
354: == NULL)
355: {
356: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
357: return;
358: }
359:
360: if (((*s_objet_elementaire).objet =
361: allocation_maillon(s_etat_processus)) == NULL)
362: {
363: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
364: return;
365: }
366:
367: l_element_courant = (struct_liste_chainee *)
368: (*s_objet_elementaire).objet;
369:
370: if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
371: == NULL)
372: {
373: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
374: return;
375: }
376:
377: (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
378: (*((struct_matrice *) (*s_objet_source).objet))
379: .nombre_lignes;
380:
381: if (((*l_element_courant).suivant =
382: allocation_maillon(s_etat_processus)) == NULL)
383: {
384: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
385: return;
386: }
387:
388: l_element_courant = (*l_element_courant).suivant;
389: (*l_element_courant).suivant = NULL;
390:
391: if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
392: == NULL)
393: {
394: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
395: return;
396: }
397:
398: (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
399: (*((struct_matrice *) (*s_objet_source).objet))
400: .nombre_colonnes;
401:
402: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
403: s_objet_elementaire) == d_erreur)
404: {
405: return;
406: }
407: }
408: else if ((*s_objet_source).type == MRL)
409: {
410: /*
411: * Traitement d'une matrice de réels
412: */
413:
414: for(i = 0; i < (*((struct_matrice *) (*s_objet_source).objet))
415: .nombre_lignes; i++)
416: {
417: for(j = 0; j < (*((struct_matrice *) (*s_objet_source).objet))
418: .nombre_colonnes; j++)
419: {
420: if ((s_objet_elementaire = allocation(s_etat_processus, REL))
421: == NULL)
422: {
423: (*s_etat_processus).erreur_systeme =
424: d_es_allocation_memoire;
425: return;
426: }
427:
428: (*((real8 *) (*s_objet_elementaire).objet)) =
429: ((real8 **) (*((struct_matrice *)
430: (*s_objet_source).objet)).tableau)[i][j];
431:
432: if (empilement(s_etat_processus, &((*s_etat_processus)
433: .l_base_pile), s_objet_elementaire) == d_erreur)
434: {
435: return;
436: }
437: }
438: }
439:
440: if ((s_objet_elementaire = allocation(s_etat_processus, LST))
441: == NULL)
442: {
443: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
444: return;
445: }
446:
447: if (((*s_objet_elementaire).objet =
448: allocation_maillon(s_etat_processus)) == NULL)
449: {
450: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
451: return;
452: }
453:
454: l_element_courant = (struct_liste_chainee *)
455: (*s_objet_elementaire).objet;
456:
457: if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
458: == NULL)
459: {
460: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
461: return;
462: }
463:
464: (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
465: (*((struct_matrice *) (*s_objet_source).objet))
466: .nombre_lignes;
467:
468: if (((*l_element_courant).suivant =
469: allocation_maillon(s_etat_processus)) == NULL)
470: {
471: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
472: return;
473: }
474:
475: l_element_courant = (*l_element_courant).suivant;
476: (*l_element_courant).suivant = NULL;
477:
478: if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
479: == NULL)
480: {
481: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
482: return;
483: }
484:
485: (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
486: (*((struct_matrice *) (*s_objet_source).objet))
487: .nombre_colonnes;
488:
489: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
490: s_objet_elementaire) == d_erreur)
491: {
492: return;
493: }
494: }
495: else if ((*s_objet_source).type == MCX)
496: {
497: /*
498: * Traitement d'une matrice de complexes
499: */
500:
501: for(i = 0; i < (*((struct_matrice *) (*s_objet_source).objet))
502: .nombre_lignes; i++)
503: {
504: for(j = 0; j < (*((struct_matrice *) (*s_objet_source).objet))
505: .nombre_colonnes; j++)
506: {
507: if ((s_objet_elementaire = allocation(s_etat_processus, CPL))
508: == NULL)
509: {
510: (*s_etat_processus).erreur_systeme =
511: d_es_allocation_memoire;
512: return;
513: }
514:
515: (*((struct_complexe16 *) (*s_objet_elementaire).objet))
516: .partie_reelle = ((struct_complexe16 **)
517: (*((struct_matrice *) (*s_objet_source).objet))
518: .tableau)[i][j].partie_reelle;
519: (*((struct_complexe16 *) (*s_objet_elementaire).objet))
520: .partie_imaginaire = ((struct_complexe16 **)
521: (*((struct_matrice *) (*s_objet_source).objet))
522: .tableau)[i][j].partie_imaginaire;
523:
524: if (empilement(s_etat_processus, &((*s_etat_processus)
525: .l_base_pile), s_objet_elementaire) == d_erreur)
526: {
527: return;
528: }
529: }
530: }
531:
532: if ((s_objet_elementaire = allocation(s_etat_processus, LST))
533: == NULL)
534: {
535: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
536: return;
537: }
538:
539: if (((*s_objet_elementaire).objet =
540: allocation_maillon(s_etat_processus)) == NULL)
541: {
542: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
543: return;
544: }
545:
546: l_element_courant = (struct_liste_chainee *)
547: (*s_objet_elementaire).objet;
548:
549: if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
550: == NULL)
551: {
552: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
553: return;
554: }
555:
556: (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
557: (*((struct_matrice *) (*s_objet_source).objet))
558: .nombre_lignes;
559:
560: if (((*l_element_courant).suivant =
561: allocation_maillon(s_etat_processus)) == NULL)
562: {
563: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
564: return;
565: }
566:
567: l_element_courant = (*l_element_courant).suivant;
568: (*l_element_courant).suivant = NULL;
569:
570: if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
571: == NULL)
572: {
573: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
574: return;
575: }
576:
577: (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
578: (*((struct_matrice *) (*s_objet_source).objet))
579: .nombre_colonnes;
580:
581: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
582: s_objet_elementaire) == d_erreur)
583: {
584: return;
585: }
586: }
587:
588: /*
589: --------------------------------------------------------------------------------
590: Réalisation impossible de la fonction ARRAY->
591: --------------------------------------------------------------------------------
592: */
593:
594: else
595: {
596: liberation(s_etat_processus, s_objet_source);
597:
598: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
599: return;
600: }
601:
602: liberation(s_etat_processus, s_objet_source);
603:
604: return;
605: }
606:
607:
608: /*
609: ================================================================================
610: Fonction 'alog'
611: ================================================================================
612: Entrées : pointeur sur une struct_processus
613: --------------------------------------------------------------------------------
614: Sorties :
615: --------------------------------------------------------------------------------
616: Effets de bord : néant
617: ================================================================================
618: */
619:
620: void
621: instruction_alog(struct_processus *s_etat_processus)
622: {
623: integer8 base;
624: integer8 tampon;
625:
626: struct_liste_chainee *l_element_courant;
627: struct_liste_chainee *l_element_precedent;
628:
629: struct_objet *s_copie_argument;
630: struct_objet *s_objet_argument;
631: struct_objet *s_objet_resultat;
632:
633: (*s_etat_processus).erreur_execution = d_ex;
634:
635: if ((*s_etat_processus).affichage_arguments == 'Y')
636: {
637: printf("\n ALOG ");
638:
639: if ((*s_etat_processus).langue == 'F')
640: {
641: printf("(antilogarithme base 10)\n\n");
642: }
643: else
644: {
645: printf("(10-based antilogarithm)\n\n");
646: }
647:
648: printf(" 1: %s\n", d_INT);
649: printf("-> 1: %s, %s\n\n", d_INT, d_REL);
650:
651: printf(" 1: %s\n", d_REL);
652: printf("-> 1: %s\n", d_REL);
653:
654: printf(" 1: %s\n", d_CPL);
655: printf("-> 1: %s\n", d_CPL);
656:
657: printf(" 1: %s, %s\n", d_NOM, d_ALG);
658: printf("-> 1: %s\n\n", d_ALG);
659:
660: printf(" 1: %s\n", d_RPN);
661: printf("-> 1: %s\n", d_RPN);
662:
663: return;
664: }
665: else if ((*s_etat_processus).test_instruction == 'Y')
666: {
667: (*s_etat_processus).nombre_arguments = 1;
668: return;
669: }
670:
671: if (test_cfsf(s_etat_processus, 31) == d_vrai)
672: {
673: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
674: {
675: return;
676: }
677: }
678:
679: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
680: &s_objet_argument) == d_erreur)
681: {
682: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
683: return;
684: }
685:
686: /*
687: --------------------------------------------------------------------------------
688: Alog d'un entier
689: --------------------------------------------------------------------------------
690: */
691:
692: if ((*s_objet_argument).type == INT)
693: {
694: base = 10;
695:
696: if (depassement_puissance(&base, (integer8 *) (*s_objet_argument).objet,
697: &tampon) == d_absence_erreur)
698: {
699: if ((s_objet_resultat = allocation(s_etat_processus, INT))
700: == NULL)
701: {
702: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
703: return;
704: }
705:
706: (*((integer8 *) (*s_objet_resultat).objet)) = tampon;
707: }
708: else
709: {
710: if ((s_objet_resultat = allocation(s_etat_processus, REL))
711: == NULL)
712: {
713: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
714: return;
715: }
716:
717: (*((real8 *) (*s_objet_resultat).objet)) =
718: pow((real8) 10, (real8) (*((integer8 *)
719: (*s_objet_argument).objet)));
720: }
721: }
722:
723: /*
724: --------------------------------------------------------------------------------
725: Alog d'un réel
726: --------------------------------------------------------------------------------
727: */
728:
729: else if ((*s_objet_argument).type == REL)
730: {
731: if ((s_objet_resultat = allocation(s_etat_processus, REL))
732: == NULL)
733: {
734: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
735: return;
736: }
737:
738: (*((real8 *) (*s_objet_resultat).objet)) =
739: pow((real8) 10, ((*((real8 *) (*s_objet_argument).objet))));
740: }
741:
742: /*
743: --------------------------------------------------------------------------------
744: Alog d'un complexe
745: --------------------------------------------------------------------------------
746: */
747:
748: else if ((*s_objet_argument).type == CPL)
749: {
750: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
751: == NULL)
752: {
753: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
754: return;
755: }
756:
757: f77alogc_(&((*((struct_complexe16 *) (*s_objet_argument).objet))),
758: (struct_complexe16 *) (*s_objet_resultat).objet);
759: }
760:
761: /*
762: --------------------------------------------------------------------------------
763: Alog d'un nom
764: --------------------------------------------------------------------------------
765: */
766:
767: else if ((*s_objet_argument).type == NOM)
768: {
769: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
770: == NULL)
771: {
772: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
773: return;
774: }
775:
776: if (((*s_objet_resultat).objet =
777: allocation_maillon(s_etat_processus)) == NULL)
778: {
779: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
780: return;
781: }
782:
783: l_element_courant = (*s_objet_resultat).objet;
784:
785: if (((*l_element_courant).donnee =
786: allocation(s_etat_processus, FCT)) == NULL)
787: {
788: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
789: return;
790: }
791:
792: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
793: .nombre_arguments = 0;
794: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
795: .fonction = instruction_alog;
796:
797: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
798: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
799: {
800: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
801: return;
802: }
803:
804: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
805: .nom_fonction, "<<");
806:
807: if (((*l_element_courant).suivant =
808: allocation_maillon(s_etat_processus)) == NULL)
809: {
810: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
811: return;
812: }
813:
814: l_element_courant = (*l_element_courant).suivant;
815: (*l_element_courant).donnee = s_objet_argument;
816:
817: if (((*l_element_courant).suivant =
818: allocation_maillon(s_etat_processus)) == NULL)
819: {
820: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
821: return;
822: }
823:
824: l_element_courant = (*l_element_courant).suivant;
825:
826: if (((*l_element_courant).donnee =
827: allocation(s_etat_processus, FCT)) == NULL)
828: {
829: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
830: return;
831: }
832:
833: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
834: .nombre_arguments = 1;
835: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
836: .fonction = instruction_alog;
837:
838: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
839: .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
840: {
841: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
842: return;
843: }
844:
845: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
846: .nom_fonction, "ALOG");
847:
848: if (((*l_element_courant).suivant =
849: allocation_maillon(s_etat_processus)) == NULL)
850: {
851: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
852: return;
853: }
854:
855: l_element_courant = (*l_element_courant).suivant;
856:
857: if (((*l_element_courant).donnee =
858: allocation(s_etat_processus, FCT)) == NULL)
859: {
860: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
861: return;
862: }
863:
864: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
865: .nombre_arguments = 0;
866: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
867: .fonction = instruction_vers_niveau_inferieur;
868:
869: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
870: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
871: {
872: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
873: return;
874: }
875:
876: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
877: .nom_fonction, ">>");
878:
879: (*l_element_courant).suivant = NULL;
880: s_objet_argument = NULL;
881: }
882:
883: /*
884: --------------------------------------------------------------------------------
885: Alog d'une expression
886: --------------------------------------------------------------------------------
887: */
888:
889: else if (((*s_objet_argument).type == ALG) ||
890: ((*s_objet_argument).type == RPN))
891: {
892: if ((s_copie_argument = copie_objet(s_etat_processus,
893: s_objet_argument, 'N')) == NULL)
894: {
895: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
896: return;
897: }
898:
899: l_element_courant = (struct_liste_chainee *)
900: (*s_copie_argument).objet;
901: l_element_precedent = l_element_courant;
902:
903: while((*l_element_courant).suivant != NULL)
904: {
905: l_element_precedent = l_element_courant;
906: l_element_courant = (*l_element_courant).suivant;
907: }
908:
909: if (((*l_element_precedent).suivant =
910: allocation_maillon(s_etat_processus)) == NULL)
911: {
912: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
913: return;
914: }
915:
916: if (((*(*l_element_precedent).suivant).donnee =
917: allocation(s_etat_processus, FCT)) == NULL)
918: {
919: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
920: return;
921: }
922:
923: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
924: .donnee).objet)).nombre_arguments = 1;
925: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
926: .donnee).objet)).fonction = instruction_alog;
927:
928: if (((*((struct_fonction *) (*(*(*l_element_precedent)
929: .suivant).donnee).objet)).nom_fonction =
930: malloc(5 * sizeof(unsigned char))) == NULL)
931: {
932: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
933: return;
934: }
935:
936: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
937: .suivant).donnee).objet)).nom_fonction, "ALOG");
938:
939: (*(*l_element_precedent).suivant).suivant = l_element_courant;
940:
941: s_objet_resultat = s_copie_argument;
942: }
943:
944: /*
945: --------------------------------------------------------------------------------
946: Fonction alog impossible à réaliser
947: --------------------------------------------------------------------------------
948: */
949:
950: else
951: {
952: liberation(s_etat_processus, s_objet_argument);
953:
954: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
955: return;
956: }
957:
958: liberation(s_etat_processus, s_objet_argument);
959:
960: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
961: s_objet_resultat) == d_erreur)
962: {
963: return;
964: }
965:
966: return;
967: }
968:
969: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_a3.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src