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 'pick'
29: ================================================================================
30: Entrées : structure processus
31: --------------------------------------------------------------------------------
32: Sorties :
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: void
39: instruction_pick(struct_processus *s_etat_processus)
40: {
41: struct_liste_chainee *l_liste;
42:
43: struct_objet *s_objet;
44: struct_objet *s_nouvel_objet;
45:
46: integer8 i;
47:
48: (*s_etat_processus).erreur_execution = d_ex;
49:
50: if ((*s_etat_processus).affichage_arguments == 'Y')
51: {
52: printf("\n PICK ");
53:
54: if ((*s_etat_processus).langue == 'F')
55: {
56: printf("(duplication d'un objet)\n\n");
57: }
58: else
59: {
60: printf("(duplication of a object)\n\n");
61: }
62:
63: printf(" n: %s, %s, %s, %s, %s, %s,\n"
64: " %s, %s, %s, %s, %s,\n"
65: " %s, %s, %s, %s, %s,\n"
66: " %s, %s, %s, %s,\n"
67: " %s, %s, %s\n",
68: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
69: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
70: d_SQL, d_SLB, d_PRC, d_MTX, d_REC);
71: printf(" ...\n");
72: printf(" 2: %s, %s, %s, %s, %s, %s,\n"
73: " %s, %s, %s, %s, %s,\n"
74: " %s, %s, %s, %s, %s,\n"
75: " %s, %s, %s, %s,\n"
76: " %s, %s, %s\n",
77: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
78: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
79: d_SQL, d_SLB, d_PRC, d_MTX, d_REC);
80: printf(" 1: %s\n", d_INT);
81: printf("-> n: %s, %s, %s, %s, %s, %s,\n"
82: " %s, %s, %s, %s, %s,\n"
83: " %s, %s, %s, %s, %s,\n"
84: " %s, %s, %s, %s,\n"
85: " %s, %s, %s\n",
86: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
87: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
88: d_SQL, d_SLB, d_PRC, d_MTX, d_REC);
89: printf(" ...\n");
90: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
91: " %s, %s, %s, %s, %s,\n"
92: " %s, %s, %s, %s, %s,\n"
93: " %s, %s, %s, %s,\n"
94: " %s, %s, %s\n",
95: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
96: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
97: d_SQL, d_SLB, d_PRC, d_MTX, d_REC);
98:
99: return;
100: }
101: else if ((*s_etat_processus).test_instruction == 'Y')
102: {
103: (*s_etat_processus).nombre_arguments = -1;
104: return;
105: }
106:
107: if (test_cfsf(s_etat_processus, 31) == d_vrai)
108: {
109: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
110: {
111: return;
112: }
113: }
114:
115: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
116: &s_objet) == d_erreur)
117: {
118: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
119: return;
120: }
121:
122: if ((*s_objet).type != INT)
123: {
124: liberation(s_etat_processus, s_objet);
125:
126: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
127: return;
128: }
129:
130: if ((*((integer8 *) (*s_objet).objet)) <= 0)
131: {
132:
133: /*
134: -- Opération absurde autorisée sur le calculateur HP-28S -----------------------
135: */
136:
137: liberation(s_etat_processus, s_objet);
138:
139: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
140: return;
141: }
142:
143: if ((*((integer8 *) (*s_objet).objet)) > (*s_etat_processus)
144: .hauteur_pile_operationnelle)
145: {
146: liberation(s_etat_processus, s_objet);
147:
148: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
149: return;
150: }
151:
152: l_liste = (*s_etat_processus).l_base_pile;
153:
154: for(i = 1; i < (*((integer8 *) (*s_objet).objet)); i++)
155: {
156: l_liste = (*l_liste).suivant;
157: }
158:
159: s_nouvel_objet = copie_objet(s_etat_processus, (*l_liste).donnee, 'P');
160:
161: if (s_nouvel_objet == NULL)
162: {
163: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
164: return;
165: }
166:
167: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
168: s_nouvel_objet) == d_erreur)
169: {
170: return;
171: }
172:
173: liberation(s_etat_processus, s_objet);
174:
175: return;
176: }
177:
178:
179: /*
180: ================================================================================
181: Fonction '+'
182: ================================================================================
183: Entrées : structure processus
184: --------------------------------------------------------------------------------
185: Sorties :
186: --------------------------------------------------------------------------------
187: Effets de bord : néant
188: ================================================================================
189: */
190:
191: void
192: instruction_plus(struct_processus *s_etat_processus)
193: {
194: integer8 tampon;
195:
196: logical1 depassement;
197: logical1 drapeau;
198:
199: struct_liste_chainee *l_element_courant;
200: struct_liste_chainee *l_element_precedent;
201:
202: struct_objet *s_copie_argument_1;
203: struct_objet *s_copie_argument_2;
204: struct_objet *s_objet_argument_1;
205: struct_objet *s_objet_argument_2;
206: struct_objet *s_objet_resultat;
207:
208: integer8 i;
209: integer8 j;
210: integer8 nombre_elements;
211:
212: (*s_etat_processus).erreur_execution = d_ex;
213:
214: if ((*s_etat_processus).affichage_arguments == 'Y')
215: {
216: printf("\n + ");
217:
218: if ((*s_etat_processus).langue == 'F')
219: {
220: printf("(addition)\n\n");
221: }
222: else
223: {
224: printf("(addition)\n\n");
225: }
226:
227: printf(" 2: %s, %s, %s\n", d_INT, d_REL, d_CPL);
228: printf(" 1: %s, %s, %s\n", d_INT, d_REL, d_CPL);
229: printf("-> 1: %s, %s, %s\n\n", d_INT, d_REL, d_CPL);
230:
231: printf(" 2: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
232: printf(" 1: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
233: printf("-> 1: %s, %s, %s\n\n", d_VIN, d_VRL, d_VCX);
234:
235: printf(" 2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
236: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
237: printf("-> 1: %s, %s, %s\n\n", d_MIN, d_MRL, d_MCX);
238:
239: printf(" 2: %s, %s\n", d_BIN, d_INT);
240: printf(" 1: %s, %s\n", d_BIN, d_INT);
241: printf("-> 1: %s\n\n", d_BIN);
242:
243: printf(" 2: %s\n", d_CHN);
244: printf(" 1: %s\n", d_CHN);
245: printf("-> 1: %s\n\n", d_CHN);
246:
247: printf(" 2: %s\n", d_LST);
248: printf(" 1: %s\n", d_LST);
249: printf("-> 1: %s\n\n", d_LST);
250:
251: printf(" 2: %s, %s, %s, %s, %s, %s\n",
252: d_INT, d_REL, d_CPL, d_NOM, d_ALG, d_RPN);
253: printf(" 1: %s, %s, %s, %s, %s, %s\n",
254: d_INT, d_REL, d_CPL, d_NOM, d_ALG, d_RPN);
255: printf("-> 1: %s, %s\n", d_ALG, d_RPN);
256:
257: return;
258: }
259: else if ((*s_etat_processus).test_instruction == 'Y')
260: {
261: (*s_etat_processus).nombre_arguments = 0;
262: return;
263: }
264:
265: if (test_cfsf(s_etat_processus, 31) == d_vrai)
266: {
267: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
268: {
269: return;
270: }
271: }
272:
273: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
274: &s_objet_argument_1) == d_erreur)
275: {
276: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
277: return;
278: }
279:
280: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
281: &s_objet_argument_2) == d_erreur)
282: {
283: liberation(s_etat_processus, s_objet_argument_1);
284:
285: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
286: return;
287: }
288:
289: /*
290: --------------------------------------------------------------------------------
291: Addition de deux entiers
292: --------------------------------------------------------------------------------
293: */
294:
295: if (((*s_objet_argument_1).type == INT) &&
296: ((*s_objet_argument_2).type == INT))
297: {
298: if (depassement_addition((integer8 *) (*s_objet_argument_1).objet,
299: (integer8 *) (*s_objet_argument_2).objet, &tampon) ==
300: d_absence_erreur)
301: {
302: if ((s_objet_resultat = allocation(s_etat_processus, INT))
303: == NULL)
304: {
305: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
306: return;
307: }
308:
309: (*((integer8 *) (*s_objet_resultat).objet)) = tampon;
310: }
311: else
312: {
313: if ((s_objet_resultat = allocation(s_etat_processus, REL))
314: == NULL)
315: {
316: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
317: return;
318: }
319:
320: (*((real8 *) (*s_objet_resultat).objet)) = ((real8)
321: (*((integer8 *) (*s_objet_argument_1).objet))) + ((real8)
322: (*((integer8 *) (*s_objet_argument_2).objet)));
323: }
324: }
325:
326: /*
327: --------------------------------------------------------------------------------
328: Addition d'un entier et d'un réel
329: --------------------------------------------------------------------------------
330: */
331:
332: else if ((((*s_objet_argument_1).type == INT) &&
333: ((*s_objet_argument_2).type == REL)) ||
334: (((*s_objet_argument_1).type == REL) &&
335: ((*s_objet_argument_2).type == INT)))
336: {
337: if ((s_objet_resultat = allocation(s_etat_processus, REL))
338: == NULL)
339: {
340: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
341: return;
342: }
343:
344: if ((*s_objet_argument_1).type == INT)
345: {
346: (*((real8 *) (*s_objet_resultat).objet)) = ((real8) (*((integer8 *)
347: (*s_objet_argument_1).objet))) + (*((real8 *)
348: (*s_objet_argument_2).objet));
349: }
350: else
351: {
352: (*((real8 *) (*s_objet_resultat).objet)) = (*((real8 *)
353: (*s_objet_argument_1).objet)) + ((real8) (*((integer8 *)
354: (*s_objet_argument_2).objet)));
355: }
356: }
357:
358: /*
359: --------------------------------------------------------------------------------
360: Addition d'un entier et d'un complexe
361: --------------------------------------------------------------------------------
362: */
363:
364: else if ((((*s_objet_argument_1).type == INT) &&
365: ((*s_objet_argument_2).type == CPL)) ||
366: (((*s_objet_argument_1).type == CPL) &&
367: ((*s_objet_argument_2).type == INT)))
368: {
369: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
370: == NULL)
371: {
372: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
373: return;
374: }
375:
376: if ((*s_objet_argument_1).type == INT)
377: {
378: f77additionci_((struct_complexe16 *) (*s_objet_argument_2).objet,
379: (integer8 *) (*s_objet_argument_1).objet,
380: (struct_complexe16 *) (*s_objet_resultat).objet);
381: }
382: else
383: {
384: f77additionci_((struct_complexe16 *) (*s_objet_argument_1).objet,
385: (integer8 *) (*s_objet_argument_2).objet,
386: (struct_complexe16 *) (*s_objet_resultat).objet);
387: }
388: }
389:
390: /*
391: --------------------------------------------------------------------------------
392: Addition de deux réels
393: --------------------------------------------------------------------------------
394: */
395:
396: else if (((*s_objet_argument_1).type == REL) &&
397: ((*s_objet_argument_2).type == REL))
398: {
399: if ((s_objet_resultat = allocation(s_etat_processus, REL))
400: == NULL)
401: {
402: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
403: return;
404: }
405:
406: (*((real8 *) (*s_objet_resultat).objet)) = (*((real8 *)
407: (*s_objet_argument_1).objet)) + (*((real8 *)
408: (*s_objet_argument_2).objet));
409: }
410:
411: /*
412: --------------------------------------------------------------------------------
413: Addition d'un réel et d'un complexe
414: --------------------------------------------------------------------------------
415: */
416:
417: else if ((((*s_objet_argument_1).type == REL) &&
418: ((*s_objet_argument_2).type == CPL)) ||
419: (((*s_objet_argument_1).type == CPL) &&
420: ((*s_objet_argument_2).type == REL)))
421: {
422: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
423: == NULL)
424: {
425: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
426: return;
427: }
428:
429: if ((*s_objet_argument_1).type == REL)
430: {
431: f77additioncr_((struct_complexe16 *) (*s_objet_argument_2).objet,
432: (real8 *) (*s_objet_argument_1).objet,
433: (struct_complexe16 *) (*s_objet_resultat).objet);
434: }
435: else
436: {
437: f77additioncr_((struct_complexe16 *) (*s_objet_argument_1).objet,
438: (real8 *) (*s_objet_argument_2).objet,
439: (struct_complexe16 *) (*s_objet_resultat).objet);
440: }
441: }
442:
443: /*
444: --------------------------------------------------------------------------------
445: Addition de deux complexes
446: --------------------------------------------------------------------------------
447: */
448:
449: else if (((*s_objet_argument_1).type == CPL) &&
450: ((*s_objet_argument_2).type == CPL))
451: {
452: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
453: == NULL)
454: {
455: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
456: return;
457: }
458:
459: f77additioncc_((struct_complexe16 *) (*s_objet_argument_2).objet,
460: (struct_complexe16 *) (*s_objet_argument_1).objet,
461: (struct_complexe16 *) (*s_objet_resultat).objet);
462: }
463:
464: /*
465: --------------------------------------------------------------------------------
466: Addition de deux vecteurs
467: --------------------------------------------------------------------------------
468: */
469: /*
470: * Entier / Entier
471: */
472:
473: else if (((*s_objet_argument_1).type == VIN) &&
474: ((*s_objet_argument_2).type == VIN))
475: {
476: if ((*(((struct_vecteur *) (*s_objet_argument_1).objet))).taille !=
477: (*(((struct_vecteur *) (*s_objet_argument_2).objet))).taille)
478: {
479: liberation(s_etat_processus, s_objet_argument_1);
480: liberation(s_etat_processus, s_objet_argument_2);
481:
482: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
483: return;
484: }
485:
486: if ((s_objet_resultat = allocation(s_etat_processus, VIN))
487: == NULL)
488: {
489: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
490: return;
491: }
492:
493: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
494: (*((struct_vecteur *) (*s_objet_argument_1).objet)).taille;
495:
496: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
497: malloc(((size_t) (*(((struct_vecteur *) (*s_objet_resultat)
498: .objet))).taille) * sizeof(integer8))) == NULL)
499: {
500: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
501: return;
502: }
503:
504: depassement = d_faux;
505:
506: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_resultat)
507: .objet))).taille; i++)
508: {
509: if (depassement_addition(&(((integer8 *) (*((struct_vecteur *)
510: (*s_objet_argument_1).objet)).tableau)[i]), &(((integer8 *)
511: (*((struct_vecteur *) (*s_objet_argument_2).objet)).tableau)
512: [i]), &(((integer8 *) (*((struct_vecteur *)
513: (*s_objet_resultat).objet)).tableau)[i])) == d_erreur)
514: {
515: depassement = d_vrai;
516: }
517: }
518:
519: if (depassement == d_vrai)
520: {
521: free((*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau);
522:
523: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
524: malloc(((size_t) (*(((struct_vecteur *) (*s_objet_resultat)
525: .objet))).taille) * sizeof(real8))) == NULL)
526: {
527: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
528: return;
529: }
530:
531: (*s_objet_resultat).type = VRL;
532: (*((struct_vecteur *) (*s_objet_resultat).objet)).type = 'R';
533:
534: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_resultat)
535: .objet))).taille; i++)
536: {
537: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
538: .tableau)[i] = (real8) (((integer8 *)
539: (*((struct_vecteur *) (*s_objet_argument_1).objet))
540: .tableau)[i]) + (real8) (((integer8 *)
541: (*((struct_vecteur *) (*s_objet_argument_2).objet))
542: .tableau)[i]);
543: }
544: }
545: }
546:
547: /*
548: * Entier / Réel
549: */
550:
551: else if ((((*s_objet_argument_1).type == VIN) &&
552: ((*s_objet_argument_2).type == VRL)) ||
553: (((*s_objet_argument_1).type == VRL) &&
554: ((*s_objet_argument_2).type == VIN)))
555: {
556: if ((*(((struct_vecteur *) (*s_objet_argument_1).objet))).taille !=
557: (*(((struct_vecteur *) (*s_objet_argument_2).objet))).taille)
558: {
559: liberation(s_etat_processus, s_objet_argument_1);
560: liberation(s_etat_processus, s_objet_argument_2);
561:
562: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
563: return;
564: }
565:
566: if ((s_objet_resultat = allocation(s_etat_processus, VRL))
567: == NULL)
568: {
569: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
570: return;
571: }
572:
573: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
574: (*((struct_vecteur *) (*s_objet_argument_1).objet)).taille;
575:
576: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
577: malloc(((size_t) (*(((struct_vecteur *) (*s_objet_resultat)
578: .objet))).taille) * sizeof(real8))) == NULL)
579: {
580: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
581: return;
582: }
583:
584: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_resultat)
585: .objet))).taille; i++)
586: {
587: if ((*s_objet_argument_1).type == VIN)
588: {
589: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
590: .tableau)[i] = ((real8) ((integer8 *)
591: (*((struct_vecteur *)(*s_objet_argument_1).objet))
592: .tableau)[i]) +
593: ((real8 *) (*((struct_vecteur *) (*s_objet_argument_2)
594: .objet)).tableau)[i];
595: }
596: else
597: {
598: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
599: .tableau)[i] = ((real8 *) (*((struct_vecteur *)
600: (*s_objet_argument_1).objet)).tableau)[i] +
601: ((real8) ((integer8 *) (*((struct_vecteur *)
602: (*s_objet_argument_2).objet)).tableau)[i]);
603: }
604: }
605: }
606:
607: /*
608: * Réel / Réel
609: */
610:
611: else if (((*s_objet_argument_1).type == VRL) &&
612: ((*s_objet_argument_2).type == VRL))
613: {
614: if ((*(((struct_vecteur *) (*s_objet_argument_1).objet))).taille !=
615: (*(((struct_vecteur *) (*s_objet_argument_2).objet))).taille)
616: {
617: liberation(s_etat_processus, s_objet_argument_1);
618: liberation(s_etat_processus, s_objet_argument_2);
619:
620: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
621: return;
622: }
623:
624: if ((s_objet_resultat = allocation(s_etat_processus, VRL))
625: == NULL)
626: {
627: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
628: return;
629: }
630:
631: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
632: (*((struct_vecteur *) (*s_objet_argument_1).objet)).taille;
633:
634: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
635: malloc(((size_t) (*(((struct_vecteur *) (*s_objet_resultat)
636: .objet))).taille) * sizeof(real8))) == NULL)
637: {
638: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
639: return;
640: }
641:
642: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_resultat)
643: .objet))).taille; i++)
644: {
645: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
646: .tableau)[i] = ((real8 *) (*((struct_vecteur *)
647: (*s_objet_argument_1).objet)).tableau)[i] +
648: ((real8 *) (*((struct_vecteur *) (*s_objet_argument_2)
649: .objet)).tableau)[i];
650: }
651: }
652:
653: /*
654: * Entier / Complexe
655: */
656:
657: else if ((((*s_objet_argument_1).type == VIN) &&
658: ((*s_objet_argument_2).type == VCX)) ||
659: (((*s_objet_argument_1).type == VCX) &&
660: ((*s_objet_argument_2).type == VIN)))
661: {
662: if ((*(((struct_vecteur *) (*s_objet_argument_1).objet))).taille !=
663: (*(((struct_vecteur *) (*s_objet_argument_2).objet))).taille)
664: {
665: liberation(s_etat_processus, s_objet_argument_1);
666: liberation(s_etat_processus, s_objet_argument_2);
667:
668: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
669: return;
670: }
671:
672: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
673: == NULL)
674: {
675: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
676: return;
677: }
678:
679: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
680: (*((struct_vecteur *) (*s_objet_argument_1).objet)).taille;
681:
682: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
683: malloc(((size_t) (*(((struct_vecteur *) (*s_objet_resultat)
684: .objet))).taille) * sizeof(struct_complexe16))) == NULL)
685: {
686: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
687: return;
688: }
689:
690: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_resultat)
691: .objet))).taille; i++)
692: {
693: if ((*s_objet_argument_1).type == VIN)
694: {
695: f77additionci_(&(((struct_complexe16 *) (*((struct_vecteur *)
696: (*s_objet_argument_2).objet)).tableau)[i]),
697: &(((integer8 *) (*((struct_vecteur *)
698: (*s_objet_argument_1).objet)).tableau)[i]),
699: &(((struct_complexe16 *) (*((struct_vecteur *)
700: (*s_objet_resultat).objet)).tableau)[i]));
701: }
702: else
703: {
704: f77additionci_(&(((struct_complexe16 *) (*((struct_vecteur *)
705: (*s_objet_argument_1).objet)).tableau)[i]),
706: &(((integer8 *) (*((struct_vecteur *)
707: (*s_objet_argument_2).objet)).tableau)[i]),
708: &(((struct_complexe16 *) (*((struct_vecteur *)
709: (*s_objet_resultat).objet)).tableau)[i]));
710: }
711: }
712: }
713:
714: /*
715: * Réel / Complexe
716: */
717:
718: else if ((((*s_objet_argument_1).type == VRL) &&
719: ((*s_objet_argument_2).type == VCX)) ||
720: (((*s_objet_argument_1).type == VCX) &&
721: ((*s_objet_argument_2).type == VRL)))
722: {
723: if ((*(((struct_vecteur *) (*s_objet_argument_1).objet))).taille !=
724: (*(((struct_vecteur *) (*s_objet_argument_2).objet))).taille)
725: {
726: liberation(s_etat_processus, s_objet_argument_1);
727: liberation(s_etat_processus, s_objet_argument_2);
728:
729: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
730: return;
731: }
732:
733: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
734: == NULL)
735: {
736: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
737: return;
738: }
739:
740: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
741: (*((struct_vecteur *) (*s_objet_argument_1).objet)).taille;
742:
743: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
744: malloc(((size_t) (*(((struct_vecteur *) (*s_objet_resultat)
745: .objet))).taille) * sizeof(struct_complexe16))) == NULL)
746: {
747: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
748: return;
749: }
750:
751: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_resultat)
752: .objet))).taille; i++)
753: {
754: if ((*s_objet_argument_1).type == VRL)
755: {
756: f77additioncr_(&(((struct_complexe16 *) (*((struct_vecteur *)
757: (*s_objet_argument_2).objet)).tableau)[i]),
758: &(((real8 *) (*((struct_vecteur *)
759: (*s_objet_argument_1).objet)).tableau)[i]),
760: &(((struct_complexe16 *) (*((struct_vecteur *)
761: (*s_objet_resultat).objet)).tableau)[i]));
762: }
763: else
764: {
765: f77additioncr_(&(((struct_complexe16 *) (*((struct_vecteur *)
766: (*s_objet_argument_1).objet)).tableau)[i]),
767: &(((real8 *) (*((struct_vecteur *)
768: (*s_objet_argument_2).objet)).tableau)[i]),
769: &(((struct_complexe16 *) (*((struct_vecteur *)
770: (*s_objet_resultat).objet)).tableau)[i]));
771: }
772: }
773: }
774:
775: /*
776: * Complexe / Complexe
777: */
778:
779: else if (((*s_objet_argument_1).type == VCX) &&
780: ((*s_objet_argument_2).type == VCX))
781: {
782: if ((*(((struct_vecteur *) (*s_objet_argument_1).objet))).taille !=
783: (*(((struct_vecteur *) (*s_objet_argument_2).objet))).taille)
784: {
785: liberation(s_etat_processus, s_objet_argument_1);
786: liberation(s_etat_processus, s_objet_argument_2);
787:
788: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
789: return;
790: }
791:
792: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
793: == NULL)
794: {
795: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
796: return;
797: }
798:
799: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
800: (*((struct_vecteur *) (*s_objet_argument_1).objet)).taille;
801:
802: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
803: malloc(((size_t) (*(((struct_vecteur *) (*s_objet_resultat)
804: .objet))).taille) * sizeof(struct_complexe16))) == NULL)
805: {
806: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
807: return;
808: }
809:
810: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_resultat)
811: .objet))).taille; i++)
812: {
813: f77additioncc_(&(((struct_complexe16 *) (*((struct_vecteur *)
814: (*s_objet_argument_2).objet)).tableau)[i]),
815: &(((struct_complexe16 *) (*((struct_vecteur *)
816: (*s_objet_argument_1).objet)).tableau)[i]),
817: &(((struct_complexe16 *) (*((struct_vecteur *)
818: (*s_objet_resultat).objet)).tableau)[i]));
819: }
820: }
821:
822: /*
823: --------------------------------------------------------------------------------
824: Addition de deux matrices
825: --------------------------------------------------------------------------------
826: */
827: /*
828: * Entier / Entier
829: */
830:
831: else if (((*s_objet_argument_1).type == MIN) &&
832: ((*s_objet_argument_2).type == MIN))
833: {
834: if (((*(((struct_matrice *) (*s_objet_argument_1).objet)))
835: .nombre_lignes != (*(((struct_matrice *) (*s_objet_argument_2)
836: .objet))).nombre_lignes) || ((*(((struct_matrice *)
837: (*s_objet_argument_1).objet))).nombre_colonnes !=
838: (*(((struct_matrice *) (*s_objet_argument_2).objet)))
839: .nombre_colonnes))
840: {
841: liberation(s_etat_processus, s_objet_argument_1);
842: liberation(s_etat_processus, s_objet_argument_2);
843:
844: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
845: return;
846: }
847:
848: if ((s_objet_resultat = allocation(s_etat_processus, MIN))
849: == NULL)
850: {
851: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
852: return;
853: }
854:
855: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
856: (*((struct_matrice *) (*s_objet_argument_1).objet))
857: .nombre_lignes;
858: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
859: (*((struct_matrice *) (*s_objet_argument_1).objet))
860: .nombre_colonnes;
861:
862: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
863: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
864: .objet))).nombre_lignes) * sizeof(integer8 *))) == NULL)
865: {
866: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
867: return;
868: }
869:
870: depassement = d_faux;
871:
872: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
873: .objet))).nombre_lignes; i++)
874: {
875: if ((((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
876: .objet)).tableau)[i] = malloc(((size_t) (*((
877: (struct_matrice *) (*s_objet_resultat).objet)))
878: .nombre_colonnes) * sizeof(integer8))) == NULL)
879: {
880: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
881: return;
882: }
883:
884: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat).objet)))
885: .nombre_colonnes; j++)
886: {
887: if (depassement_addition(&(((integer8 **) (*((struct_matrice *)
888: (*s_objet_argument_1).objet)).tableau)[i][j]),
889: &(((integer8 **) (*((struct_matrice *)
890: (*s_objet_argument_2).objet)).tableau)[i][j]),
891: &(((integer8 **) (*((struct_matrice *)
892: (*s_objet_resultat).objet)).tableau)[i][j]))
893: == d_erreur)
894: {
895: depassement = d_vrai;
896: }
897: }
898: }
899:
900: if (depassement == d_vrai)
901: {
902: (*s_objet_resultat).type = MRL;
903: (*((struct_matrice *) (*s_objet_resultat).objet)).type = 'R';
904:
905: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
906: .objet))).nombre_lignes; i++)
907: {
908: free(((integer8 **) (*((struct_matrice *)
909: (*s_objet_resultat).objet)).tableau)[i]);
910:
911: if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat)
912: .objet)).tableau)[i] = malloc(((size_t) (*((
913: (struct_matrice *) (*s_objet_resultat).objet)))
914: .nombre_colonnes) * sizeof(real8))) == NULL)
915: {
916: (*s_etat_processus).erreur_systeme =
917: d_es_allocation_memoire;
918: return;
919: }
920:
921: for(j = 0; j < (*(((struct_matrice *)
922: (*s_objet_resultat).objet))).nombre_colonnes; j++)
923: {
924: (((real8 **) (*((struct_matrice *)
925: (*s_objet_resultat).objet)).tableau)[i][j]) =
926: (real8) (((integer8 **) (*((struct_matrice *)
927: (*s_objet_argument_1).objet)).tableau)[i][j]) +
928: (real8) (((integer8 **) (*((struct_matrice *)
929: (*s_objet_argument_2).objet)).tableau)[i][j]);
930: }
931: }
932: }
933: }
934:
935: /*
936: * Entier / Réel
937: */
938:
939: else if ((((*s_objet_argument_1).type == MIN) &&
940: ((*s_objet_argument_2).type == MRL)) ||
941: (((*s_objet_argument_1).type == MRL) &&
942: ((*s_objet_argument_2).type == MIN)))
943: {
944: if (((*(((struct_matrice *) (*s_objet_argument_1).objet)))
945: .nombre_lignes != (*(((struct_matrice *) (*s_objet_argument_2)
946: .objet))).nombre_lignes) || ((*(((struct_matrice *)
947: (*s_objet_argument_1).objet))).nombre_colonnes !=
948: (*(((struct_matrice *) (*s_objet_argument_2).objet)))
949: .nombre_colonnes))
950: {
951: liberation(s_etat_processus, s_objet_argument_1);
952: liberation(s_etat_processus, s_objet_argument_2);
953:
954: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
955: return;
956: }
957:
958: if ((s_objet_resultat = allocation(s_etat_processus, MRL))
959: == NULL)
960: {
961: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
962: return;
963: }
964:
965: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
966: (*((struct_matrice *) (*s_objet_argument_1).objet))
967: .nombre_lignes;
968: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
969: (*((struct_matrice *) (*s_objet_argument_1).objet))
970: .nombre_colonnes;
971:
972: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
973: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
974: .objet))).nombre_lignes) * sizeof(real8 *))) == NULL)
975: {
976: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
977: return;
978: }
979:
980: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
981: .objet))).nombre_lignes; i++)
982: {
983: if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat)
984: .objet)).tableau)[i] = malloc(((size_t) (*((
985: (struct_matrice *) (*s_objet_resultat).objet)))
986: .nombre_colonnes) * sizeof(real8))) == NULL)
987: {
988: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
989: return;
990: }
991:
992: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat).objet)))
993: .nombre_colonnes; j++)
994: {
995: if ((*s_objet_argument_1).type == MIN)
996: {
997: ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
998: .objet)).tableau)[i][j] = ((real8) ((integer8 **)
999: (*((struct_matrice *) (*s_objet_argument_1).objet))
1000: .tableau)[i][j]) + ((real8 **) (*((struct_matrice *)
1001: (*s_objet_argument_2).objet)).tableau)[i][j];
1002: }
1003: else
1004: {
1005: ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
1006: .objet)).tableau)[i][j] = ((real8 **)
1007: (*((struct_matrice *) (*s_objet_argument_1).objet))
1008: .tableau)[i][j] + ((real8) ((integer8 **)
1009: (*((struct_matrice *) (*s_objet_argument_2)
1010: .objet)).tableau)[i][j]);
1011: }
1012: }
1013: }
1014: }
1015:
1016: /*
1017: * Réel / Réel
1018: */
1019:
1020: else if (((*s_objet_argument_1).type == MRL) &&
1021: ((*s_objet_argument_2).type == MRL))
1022: {
1023: if (((*(((struct_matrice *) (*s_objet_argument_1).objet)))
1024: .nombre_lignes != (*(((struct_matrice *) (*s_objet_argument_2)
1025: .objet))).nombre_lignes) || ((*(((struct_matrice *)
1026: (*s_objet_argument_1).objet))).nombre_colonnes !=
1027: (*(((struct_matrice *) (*s_objet_argument_2).objet)))
1028: .nombre_colonnes))
1029: {
1030: liberation(s_etat_processus, s_objet_argument_1);
1031: liberation(s_etat_processus, s_objet_argument_2);
1032:
1033: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1034: return;
1035: }
1036:
1037: if ((s_objet_resultat = allocation(s_etat_processus, MRL))
1038: == NULL)
1039: {
1040: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1041: return;
1042: }
1043:
1044: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
1045: (*((struct_matrice *) (*s_objet_argument_1).objet))
1046: .nombre_lignes;
1047: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
1048: (*((struct_matrice *) (*s_objet_argument_1).objet))
1049: .nombre_colonnes;
1050:
1051: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1052: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
1053: .objet))).nombre_lignes) * sizeof(real8 *))) == NULL)
1054: {
1055: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1056: return;
1057: }
1058:
1059: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
1060: .objet))).nombre_lignes; i++)
1061: {
1062: if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat)
1063: .objet)).tableau)[i] = malloc(((size_t) (*((
1064: (struct_matrice *) (*s_objet_resultat).objet)))
1065: .nombre_colonnes) * sizeof(real8))) == NULL)
1066: {
1067: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1068: return;
1069: }
1070:
1071: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat).objet)))
1072: .nombre_colonnes; j++)
1073: {
1074: ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
1075: .objet)).tableau)[i][j] = ((real8 **)
1076: (*((struct_matrice *) (*s_objet_argument_1).objet))
1077: .tableau)[i][j] + ((real8 **) (*((struct_matrice *)
1078: (*s_objet_argument_2).objet)).tableau)[i][j];
1079: }
1080: }
1081: }
1082:
1083: /*
1084: * Entier / Complexe
1085: */
1086:
1087: else if ((((*s_objet_argument_1).type == MIN) &&
1088: ((*s_objet_argument_2).type == MCX)) ||
1089: (((*s_objet_argument_1).type == MCX) &&
1090: ((*s_objet_argument_2).type == MIN)))
1091: {
1092: if (((*(((struct_matrice *) (*s_objet_argument_1).objet)))
1093: .nombre_lignes != (*(((struct_matrice *) (*s_objet_argument_2)
1094: .objet))).nombre_lignes) || ((*(((struct_matrice *)
1095: (*s_objet_argument_1).objet))).nombre_colonnes !=
1096: (*(((struct_matrice *) (*s_objet_argument_2).objet)))
1097: .nombre_colonnes))
1098: {
1099: liberation(s_etat_processus, s_objet_argument_1);
1100: liberation(s_etat_processus, s_objet_argument_2);
1101:
1102: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1103: return;
1104: }
1105:
1106: if ((s_objet_resultat = allocation(s_etat_processus, MCX))
1107: == NULL)
1108: {
1109: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1110: return;
1111: }
1112:
1113: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
1114: (*((struct_matrice *) (*s_objet_argument_1).objet))
1115: .nombre_lignes;
1116: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
1117: (*((struct_matrice *) (*s_objet_argument_1).objet))
1118: .nombre_colonnes;
1119:
1120: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1121: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
1122: .objet))).nombre_lignes) * sizeof(struct_complexe16 *)))
1123: == NULL)
1124: {
1125: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1126: return;
1127: }
1128:
1129: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
1130: .objet))).nombre_lignes; i++)
1131: {
1132: if ((((struct_complexe16 **) (*((struct_matrice *)
1133: (*s_objet_resultat).objet)).tableau)[i] = malloc(((size_t)
1134: (*(((struct_matrice *) (*s_objet_resultat).objet)))
1135: .nombre_colonnes) * sizeof(struct_complexe16))) == NULL)
1136: {
1137: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1138: return;
1139: }
1140:
1141: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat).objet)))
1142: .nombre_colonnes; j++)
1143: {
1144: if ((*s_objet_argument_1).type == MIN)
1145: {
1146: f77additionci_(&(((struct_complexe16 **)
1147: (*((struct_matrice *)
1148: (*s_objet_argument_2).objet)).tableau)[i][j]),
1149: &(((integer8 **) (*((struct_matrice *)
1150: (*s_objet_argument_1).objet)).tableau)[i][j]),
1151: &(((struct_complexe16 **) (*((struct_matrice *)
1152: (*s_objet_resultat).objet)).tableau)[i][j]));
1153: }
1154: else
1155: {
1156: f77additionci_(&(((struct_complexe16 **)
1157: (*((struct_matrice *)
1158: (*s_objet_argument_1).objet)).tableau)[i][j]),
1159: &(((integer8 **) (*((struct_matrice *)
1160: (*s_objet_argument_2).objet)).tableau)[i][j]),
1161: &(((struct_complexe16 **) (*((struct_matrice *)
1162: (*s_objet_resultat).objet)).tableau)[i][j]));
1163: }
1164: }
1165: }
1166: }
1167:
1168: /*
1169: * Réel / Complexe
1170: */
1171:
1172: else if ((((*s_objet_argument_1).type == MRL) &&
1173: ((*s_objet_argument_2).type == MCX)) ||
1174: (((*s_objet_argument_1).type == MCX) &&
1175: ((*s_objet_argument_2).type == MRL)))
1176: {
1177: if (((*(((struct_matrice *) (*s_objet_argument_1).objet)))
1178: .nombre_lignes != (*(((struct_matrice *) (*s_objet_argument_2)
1179: .objet))).nombre_lignes) || ((*(((struct_matrice *)
1180: (*s_objet_argument_1).objet))).nombre_colonnes !=
1181: (*(((struct_matrice *) (*s_objet_argument_2).objet)))
1182: .nombre_colonnes))
1183: {
1184: liberation(s_etat_processus, s_objet_argument_1);
1185: liberation(s_etat_processus, s_objet_argument_2);
1186:
1187: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1188: return;
1189: }
1190:
1191: if ((s_objet_resultat = allocation(s_etat_processus, MCX))
1192: == NULL)
1193: {
1194: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1195: return;
1196: }
1197:
1198: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
1199: (*((struct_matrice *) (*s_objet_argument_1).objet))
1200: .nombre_lignes;
1201: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
1202: (*((struct_matrice *) (*s_objet_argument_1).objet))
1203: .nombre_colonnes;
1204:
1205: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1206: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
1207: .objet))).nombre_lignes) * sizeof(struct_complexe16 *)))
1208: == NULL)
1209: {
1210: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1211: return;
1212: }
1213:
1214: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
1215: .objet))).nombre_lignes; i++)
1216: {
1217: if ((((struct_complexe16 **) (*((struct_matrice *)
1218: (*s_objet_resultat).objet)).tableau)[i] = malloc(((size_t)
1219: (*(((struct_matrice *) (*s_objet_resultat).objet)))
1220: .nombre_colonnes) * sizeof(struct_complexe16))) == NULL)
1221: {
1222: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1223: return;
1224: }
1225:
1226: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat).objet)))
1227: .nombre_colonnes; j++)
1228: {
1229: if ((*s_objet_argument_1).type == MRL)
1230: {
1231: f77additioncr_(&(((struct_complexe16 **)
1232: (*((struct_matrice *)
1233: (*s_objet_argument_2).objet)).tableau)[i][j]),
1234: &(((real8 **) (*((struct_matrice *)
1235: (*s_objet_argument_1).objet)).tableau)[i][j]),
1236: &(((struct_complexe16 **) (*((struct_matrice *)
1237: (*s_objet_resultat).objet)).tableau)[i][j]));
1238: }
1239: else
1240: {
1241: f77additioncr_(&(((struct_complexe16 **)
1242: (*((struct_matrice *)
1243: (*s_objet_argument_1).objet)).tableau)[i][j]),
1244: &(((real8 **) (*((struct_matrice *)
1245: (*s_objet_argument_2).objet)).tableau)[i][j]),
1246: &(((struct_complexe16 **) (*((struct_matrice *)
1247: (*s_objet_resultat).objet)).tableau)[i][j]));
1248: }
1249: }
1250: }
1251: }
1252:
1253: /*
1254: * Complexe / Complexe
1255: */
1256:
1257: else if (((*s_objet_argument_1).type == MCX) &&
1258: ((*s_objet_argument_2).type == MCX))
1259: {
1260: if (((*(((struct_matrice *) (*s_objet_argument_1).objet)))
1261: .nombre_lignes != (*(((struct_matrice *) (*s_objet_argument_2)
1262: .objet))).nombre_lignes) || ((*(((struct_matrice *)
1263: (*s_objet_argument_1).objet))).nombre_colonnes !=
1264: (*(((struct_matrice *) (*s_objet_argument_2).objet)))
1265: .nombre_colonnes))
1266: {
1267: liberation(s_etat_processus, s_objet_argument_1);
1268: liberation(s_etat_processus, s_objet_argument_2);
1269:
1270: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1271: return;
1272: }
1273:
1274: if ((s_objet_resultat = allocation(s_etat_processus, MCX))
1275: == NULL)
1276: {
1277: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1278: return;
1279: }
1280:
1281: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
1282: (*((struct_matrice *) (*s_objet_argument_1).objet))
1283: .nombre_lignes;
1284: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
1285: (*((struct_matrice *) (*s_objet_argument_1).objet))
1286: .nombre_colonnes;
1287:
1288: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1289: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
1290: .objet))).nombre_lignes) * sizeof(struct_complexe16 *)))
1291: == NULL)
1292: {
1293: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1294: return;
1295: }
1296:
1297: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
1298: .objet))).nombre_lignes; i++)
1299: {
1300: if ((((struct_complexe16 **) (*((struct_matrice *)
1301: (*s_objet_resultat).objet)).tableau)[i] = malloc(((size_t)
1302: (*(((struct_matrice *) (*s_objet_resultat).objet)))
1303: .nombre_colonnes) * sizeof(struct_complexe16))) == NULL)
1304: {
1305: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1306: return;
1307: }
1308:
1309: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat).objet)))
1310: .nombre_colonnes; j++)
1311: {
1312: f77additioncc_(&(((struct_complexe16 **)
1313: (*((struct_matrice *)
1314: (*s_objet_argument_2).objet)).tableau)[i][j]),
1315: &(((struct_complexe16 **) (*((struct_matrice *)
1316: (*s_objet_argument_1).objet)).tableau)[i][j]),
1317: &(((struct_complexe16 **) (*((struct_matrice *)
1318: (*s_objet_resultat).objet)).tableau)[i][j]));
1319: }
1320: }
1321: }
1322:
1323: /*
1324: --------------------------------------------------------------------------------
1325: Addition mettant en oeuvre des binaires
1326: --------------------------------------------------------------------------------
1327: */
1328: /*
1329: * Binaire / Binaire
1330: */
1331:
1332: else if (((*s_objet_argument_1).type == BIN) &&
1333: ((*s_objet_argument_2).type == BIN))
1334: {
1335: if ((s_objet_resultat = allocation(s_etat_processus, BIN))
1336: == NULL)
1337: {
1338: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1339: return;
1340: }
1341:
1342: (*((logical8 *) (*s_objet_resultat).objet)) =
1343: (*((logical8 *) (*s_objet_argument_1).objet))
1344: + (*((logical8 *) (*s_objet_argument_2).objet));
1345: }
1346:
1347: /*
1348: * Binaire / Entier
1349: */
1350:
1351: else if ((((*s_objet_argument_1).type == BIN) &&
1352: ((*s_objet_argument_2).type == INT)) ||
1353: (((*s_objet_argument_1).type == INT) &&
1354: ((*s_objet_argument_2).type == BIN)))
1355: {
1356: if ((s_objet_resultat = allocation(s_etat_processus, BIN))
1357: == NULL)
1358: {
1359: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1360: return;
1361: }
1362:
1363: if ((*s_objet_argument_1).type == BIN)
1364: {
1365: (*((logical8 *) (*s_objet_resultat).objet)) =
1366: (*((logical8 *) (*s_objet_argument_1).objet))
1367: + ((logical8) (*((integer8 *) (*s_objet_argument_2)
1368: .objet)));
1369: }
1370: else
1371: {
1372: (*((logical8 *) (*s_objet_resultat).objet)) =
1373: ((logical8) (*((integer8 *) (*s_objet_argument_1).objet)))
1374: + (*((logical8 *) (*s_objet_argument_2).objet));
1375: }
1376: }
1377:
1378: /*
1379: --------------------------------------------------------------------------------
1380: Addition mettant en oeuvre un nom ou une expression algébrique
1381: --------------------------------------------------------------------------------
1382: */
1383: /*
1384: * Nom ou valeur numérique / Nom ou valeur numérique
1385: */
1386:
1387: else if ((((*s_objet_argument_1).type == NOM) &&
1388: (((*s_objet_argument_2).type == NOM) ||
1389: ((*s_objet_argument_2).type == INT) ||
1390: ((*s_objet_argument_2).type == REL) ||
1391: ((*s_objet_argument_2).type == CPL))) ||
1392: (((*s_objet_argument_2).type == NOM) &&
1393: (((*s_objet_argument_1).type == INT) ||
1394: ((*s_objet_argument_1).type == REL) ||
1395: ((*s_objet_argument_1).type == CPL))))
1396: {
1397: drapeau = d_vrai;
1398:
1399: if ((*s_objet_argument_1).type == NOM)
1400: {
1401: if ((*s_objet_argument_2).type == INT)
1402: {
1403: if ((*((integer8 *) (*s_objet_argument_2).objet)) == 0)
1404: {
1405: drapeau = d_faux;
1406:
1407: s_objet_resultat = s_objet_argument_1;
1408: s_objet_argument_1 = NULL;
1409: }
1410: }
1411: else if ((*s_objet_argument_2).type == REL)
1412: {
1413: if ((*((real8 *) (*s_objet_argument_2).objet)) == 0)
1414: {
1415: drapeau = d_faux;
1416:
1417: s_objet_resultat = s_objet_argument_1;
1418: s_objet_argument_1 = NULL;
1419: }
1420: }
1421: else if ((*s_objet_argument_2).type == CPL)
1422: {
1423: if (((*((complex16 *) (*s_objet_argument_2).objet))
1424: .partie_reelle == 0) && ((*((complex16 *)
1425: (*s_objet_argument_2).objet)).partie_imaginaire == 0))
1426: {
1427: drapeau = d_faux;
1428:
1429: s_objet_resultat = s_objet_argument_1;
1430: s_objet_argument_1 = NULL;
1431: }
1432: }
1433: }
1434: else if ((*s_objet_argument_2).type == NOM)
1435: {
1436: if ((*s_objet_argument_1).type == INT)
1437: {
1438: if ((*((integer8 *) (*s_objet_argument_1).objet)) == 0)
1439: {
1440: drapeau = d_faux;
1441:
1442: s_objet_resultat = s_objet_argument_2;
1443: s_objet_argument_2 = NULL;
1444: }
1445: }
1446: else if ((*s_objet_argument_1).type == REL)
1447: {
1448: if ((*((real8 *) (*s_objet_argument_1).objet)) == 0)
1449: {
1450: drapeau = d_faux;
1451:
1452: s_objet_resultat = s_objet_argument_2;
1453: s_objet_argument_2 = NULL;
1454: }
1455: }
1456: else if ((*s_objet_argument_1).type == CPL)
1457: {
1458: if (((*((complex16 *) (*s_objet_argument_1).objet))
1459: .partie_reelle == 0) && ((*((complex16 *)
1460: (*s_objet_argument_1).objet)).partie_imaginaire == 0))
1461: {
1462: drapeau = d_faux;
1463:
1464: s_objet_resultat = s_objet_argument_2;
1465: s_objet_argument_2 = NULL;
1466: }
1467: }
1468: }
1469:
1470: if (drapeau == d_vrai)
1471: {
1472: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
1473: == NULL)
1474: {
1475: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1476: return;
1477: }
1478:
1479: if (((*s_objet_resultat).objet =
1480: allocation_maillon(s_etat_processus)) == NULL)
1481: {
1482: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1483: return;
1484: }
1485:
1486: l_element_courant = (*s_objet_resultat).objet;
1487:
1488: if (((*l_element_courant).donnee = allocation(s_etat_processus,
1489: FCT)) == NULL)
1490: {
1491: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1492: return;
1493: }
1494:
1495: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1496: .nombre_arguments = 0;
1497: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1498: .fonction = instruction_vers_niveau_superieur;
1499:
1500: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1501: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1502: {
1503: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1504: return;
1505: }
1506:
1507: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1508: .nom_fonction, "<<");
1509:
1510: if (((*l_element_courant).suivant =
1511: allocation_maillon(s_etat_processus)) == NULL)
1512: {
1513: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1514: return;
1515: }
1516:
1517: l_element_courant = (*l_element_courant).suivant;
1518: (*l_element_courant).donnee = s_objet_argument_2;
1519:
1520: if (((*l_element_courant).suivant =
1521: allocation_maillon(s_etat_processus)) == NULL)
1522: {
1523: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1524: return;
1525: }
1526:
1527: l_element_courant = (*l_element_courant).suivant;
1528: (*l_element_courant).donnee = s_objet_argument_1;
1529:
1530: if (((*l_element_courant).suivant =
1531: allocation_maillon(s_etat_processus)) == NULL)
1532: {
1533: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1534: return;
1535: }
1536:
1537: l_element_courant = (*l_element_courant).suivant;
1538:
1539: if (((*l_element_courant).donnee = allocation(s_etat_processus,
1540: FCT)) == NULL)
1541: {
1542: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1543: return;
1544: }
1545:
1546: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1547: .nombre_arguments = 0;
1548: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1549: .fonction = instruction_plus;
1550:
1551: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1552: .nom_fonction = malloc(2 * sizeof(unsigned char))) == NULL)
1553: {
1554: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1555: return;
1556: }
1557:
1558: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1559: .nom_fonction, "+");
1560:
1561: if (((*l_element_courant).suivant =
1562: allocation_maillon(s_etat_processus)) == NULL)
1563: {
1564: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1565: return;
1566: }
1567:
1568: l_element_courant = (*l_element_courant).suivant;
1569:
1570: if (((*l_element_courant).donnee = allocation(s_etat_processus,
1571: FCT)) == NULL)
1572: {
1573: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1574: return;
1575: }
1576:
1577: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1578: .nombre_arguments = 0;
1579: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1580: .fonction = instruction_vers_niveau_inferieur;
1581:
1582: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1583: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1584: {
1585: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1586: return;
1587: }
1588:
1589: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1590: .nom_fonction, ">>");
1591:
1592: (*l_element_courant).suivant = NULL;
1593:
1594: s_objet_argument_1 = NULL;
1595: s_objet_argument_2 = NULL;
1596: }
1597: }
1598:
1599: /*
1600: * Nom ou valeur numérique / Expression
1601: */
1602:
1603: else if ((((*s_objet_argument_1).type == ALG) ||
1604: ((*s_objet_argument_1).type == RPN)) &&
1605: (((*s_objet_argument_2).type == NOM) ||
1606: ((*s_objet_argument_2).type == INT) ||
1607: ((*s_objet_argument_2).type == REL) ||
1608: ((*s_objet_argument_2).type == CPL)))
1609: {
1610: drapeau = d_vrai;
1611:
1612: nombre_elements = 0;
1613: l_element_courant = (struct_liste_chainee *)
1614: (*s_objet_argument_1).objet;
1615:
1616: while(l_element_courant != NULL)
1617: {
1618: nombre_elements++;
1619: l_element_courant = (*l_element_courant).suivant;
1620: }
1621:
1622: if (nombre_elements == 2)
1623: {
1624: liberation(s_etat_processus, s_objet_argument_1);
1625: liberation(s_etat_processus, s_objet_argument_2);
1626:
1627: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
1628: return;
1629: }
1630:
1631: if ((*s_objet_argument_2).type == INT)
1632: {
1633: if ((*((integer8 *) (*s_objet_argument_2).objet)) == 0)
1634: {
1635: drapeau = d_faux;
1636:
1637: s_objet_resultat = s_objet_argument_1;
1638: s_objet_argument_1 = NULL;
1639: }
1640: }
1641: else if ((*s_objet_argument_2).type == REL)
1642: {
1643: if ((*((real8 *) (*s_objet_argument_2).objet)) == 0)
1644: {
1645: drapeau = d_faux;
1646:
1647: s_objet_resultat = s_objet_argument_1;
1648: s_objet_argument_1 = NULL;
1649: }
1650: }
1651: else if ((*s_objet_argument_2).type == CPL)
1652: {
1653: if (((*((complex16 *) (*s_objet_argument_2).objet))
1654: .partie_reelle == 0) && ((*((complex16 *)
1655: (*s_objet_argument_2).objet)).partie_imaginaire == 0))
1656: {
1657: drapeau = d_faux;
1658:
1659: s_objet_resultat = s_objet_argument_1;
1660: s_objet_argument_1 = NULL;
1661: }
1662: }
1663:
1664: if (drapeau == d_vrai)
1665: {
1666: if ((s_objet_resultat = copie_objet(s_etat_processus,
1667: s_objet_argument_1, 'N')) == NULL)
1668: {
1669: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1670: return;
1671: }
1672:
1673: l_element_courant = (struct_liste_chainee *)
1674: (*s_objet_resultat).objet;
1675: l_element_precedent = l_element_courant;
1676: l_element_courant = (*l_element_courant).suivant;
1677:
1678: if (((*l_element_precedent).suivant =
1679: allocation_maillon(s_etat_processus)) == NULL)
1680: {
1681: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1682: return;
1683: }
1684:
1685: (*(*l_element_precedent).suivant).donnee = s_objet_argument_2;
1686: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1687:
1688: while((*l_element_courant).suivant != NULL)
1689: {
1690: l_element_precedent = l_element_courant;
1691: l_element_courant = (*l_element_courant).suivant;
1692: }
1693:
1694: if (((*l_element_precedent).suivant =
1695: allocation_maillon(s_etat_processus)) == NULL)
1696: {
1697: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1698: return;
1699: }
1700:
1701: if (((*(*l_element_precedent).suivant).donnee =
1702: allocation(s_etat_processus, FCT)) == NULL)
1703: {
1704: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1705: return;
1706: }
1707:
1708: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1709: .donnee).objet)).nombre_arguments = 0;
1710: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1711: .donnee).objet)).fonction = instruction_plus;
1712:
1713: if (((*((struct_fonction *) (*(*(*l_element_precedent)
1714: .suivant).donnee).objet)).nom_fonction =
1715: malloc(2 * sizeof(unsigned char))) == NULL)
1716: {
1717: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1718: return;
1719: }
1720:
1721: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
1722: .suivant).donnee).objet)).nom_fonction, "+");
1723:
1724: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1725:
1726: s_objet_argument_2 = NULL;
1727: }
1728: }
1729:
1730: /*
1731: * Expression / Nom ou valeur numérique
1732: */
1733:
1734: else if ((((*s_objet_argument_1).type == NOM) ||
1735: ((*s_objet_argument_1).type == INT) ||
1736: ((*s_objet_argument_1).type == REL) ||
1737: ((*s_objet_argument_1).type == CPL)) &&
1738: (((*s_objet_argument_2).type == ALG) ||
1739: ((*s_objet_argument_2).type == RPN)))
1740: {
1741: drapeau = d_vrai;
1742:
1743: nombre_elements = 0;
1744: l_element_courant = (struct_liste_chainee *)
1745: (*s_objet_argument_2).objet;
1746:
1747: while(l_element_courant != NULL)
1748: {
1749: nombre_elements++;
1750: l_element_courant = (*l_element_courant).suivant;
1751: }
1752:
1753: if (nombre_elements == 2)
1754: {
1755: liberation(s_etat_processus, s_objet_argument_1);
1756: liberation(s_etat_processus, s_objet_argument_2);
1757:
1758: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
1759: return;
1760: }
1761:
1762: if ((*s_objet_argument_1).type == INT)
1763: {
1764: if ((*((integer8 *) (*s_objet_argument_1).objet)) == 0)
1765: {
1766: drapeau = d_faux;
1767:
1768: s_objet_resultat = s_objet_argument_2;
1769: s_objet_argument_2 = NULL;
1770: }
1771: }
1772: else if ((*s_objet_argument_1).type == REL)
1773: {
1774: if ((*((real8 *) (*s_objet_argument_1).objet)) == 0)
1775: {
1776: drapeau = d_faux;
1777:
1778: s_objet_resultat = s_objet_argument_2;
1779: s_objet_argument_2 = NULL;
1780: }
1781: }
1782: else if ((*s_objet_argument_1).type == CPL)
1783: {
1784: if (((*((complex16 *) (*s_objet_argument_1).objet))
1785: .partie_reelle == 0) && ((*((complex16 *)
1786: (*s_objet_argument_1).objet)).partie_imaginaire == 0))
1787: {
1788: drapeau = d_faux;
1789:
1790: s_objet_resultat = s_objet_argument_2;
1791: s_objet_argument_2 = NULL;
1792: }
1793: }
1794:
1795: if (drapeau == d_vrai)
1796: {
1797: if ((s_objet_resultat = copie_objet(s_etat_processus,
1798: s_objet_argument_2, 'N')) == NULL)
1799: {
1800: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1801: return;
1802: }
1803:
1804: l_element_courant = (struct_liste_chainee *)
1805: (*s_objet_resultat).objet;
1806: l_element_precedent = l_element_courant;
1807:
1808: while((*l_element_courant).suivant != NULL)
1809: {
1810: l_element_precedent = l_element_courant;
1811: l_element_courant = (*l_element_courant).suivant;
1812: }
1813:
1814: if (((*l_element_precedent).suivant =
1815: allocation_maillon(s_etat_processus)) == NULL)
1816: {
1817: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1818: return;
1819: }
1820:
1821: (*(*l_element_precedent).suivant).donnee = s_objet_argument_1;
1822: l_element_precedent = (*l_element_precedent).suivant;
1823:
1824: if (((*l_element_precedent).suivant =
1825: allocation_maillon(s_etat_processus)) == NULL)
1826: {
1827: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1828: return;
1829: }
1830:
1831: if (((*(*l_element_precedent).suivant).donnee =
1832: allocation(s_etat_processus, FCT)) == NULL)
1833: {
1834: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1835: return;
1836: }
1837:
1838: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1839: .donnee).objet)).nombre_arguments = 0;
1840: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1841: .donnee).objet)).fonction = instruction_plus;
1842:
1843: if (((*((struct_fonction *) (*(*(*l_element_precedent)
1844: .suivant).donnee).objet)).nom_fonction =
1845: malloc(2 * sizeof(unsigned char))) == NULL)
1846: {
1847: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1848: return;
1849: }
1850:
1851: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
1852: .suivant).donnee).objet)).nom_fonction, "+");
1853:
1854: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1855:
1856: s_objet_argument_1 = NULL;
1857: }
1858: }
1859:
1860: /*
1861: * Expression / Expression
1862: */
1863:
1864: else if ((((*s_objet_argument_1).type == ALG) &&
1865: ((*s_objet_argument_2).type == ALG)) ||
1866: (((*s_objet_argument_1).type == RPN) &&
1867: ((*s_objet_argument_2).type == RPN)))
1868: {
1869: nombre_elements = 0;
1870: l_element_courant = (struct_liste_chainee *)
1871: (*s_objet_argument_1).objet;
1872:
1873: while(l_element_courant != NULL)
1874: {
1875: nombre_elements++;
1876: l_element_courant = (*l_element_courant).suivant;
1877: }
1878:
1879: if (nombre_elements == 2)
1880: {
1881: liberation(s_etat_processus, s_objet_argument_1);
1882: liberation(s_etat_processus, s_objet_argument_2);
1883:
1884: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
1885: return;
1886: }
1887:
1888: nombre_elements = 0;
1889: l_element_courant = (struct_liste_chainee *)
1890: (*s_objet_argument_2).objet;
1891:
1892: while(l_element_courant != NULL)
1893: {
1894: nombre_elements++;
1895: l_element_courant = (*l_element_courant).suivant;
1896: }
1897:
1898: if (nombre_elements == 2)
1899: {
1900: liberation(s_etat_processus, s_objet_argument_1);
1901: liberation(s_etat_processus, s_objet_argument_2);
1902:
1903: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
1904: return;
1905: }
1906:
1907: if ((s_copie_argument_1 = copie_objet(s_etat_processus,
1908: s_objet_argument_1, 'N')) == NULL)
1909: {
1910: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1911: return;
1912: }
1913:
1914: if ((s_copie_argument_2 = copie_objet(s_etat_processus,
1915: s_objet_argument_2, 'N')) == NULL)
1916: {
1917: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1918: return;
1919: }
1920:
1921: l_element_courant = (struct_liste_chainee *)
1922: (*s_copie_argument_1).objet;
1923: (*s_copie_argument_1).objet = (void *) (*((struct_liste_chainee *)
1924: (*s_copie_argument_1).objet)).suivant;
1925:
1926: liberation(s_etat_processus, (*l_element_courant).donnee);
1927: free(l_element_courant);
1928:
1929: l_element_courant = (struct_liste_chainee *)
1930: (*s_copie_argument_2).objet;
1931: l_element_precedent = l_element_courant;
1932: s_objet_resultat = s_copie_argument_2;
1933:
1934: while((*l_element_courant).suivant != NULL)
1935: {
1936: l_element_precedent = l_element_courant;
1937: l_element_courant = (*l_element_courant).suivant;
1938: }
1939:
1940: liberation(s_etat_processus, (*l_element_courant).donnee);
1941: free(l_element_courant);
1942:
1943: (*l_element_precedent).suivant = (struct_liste_chainee *)
1944: (*s_copie_argument_1).objet;
1945: free(s_copie_argument_1);
1946:
1947: l_element_courant = (*l_element_precedent).suivant;
1948: while((*l_element_courant).suivant != NULL)
1949: {
1950: l_element_precedent = l_element_courant;
1951: l_element_courant = (*l_element_courant).suivant;
1952: }
1953:
1954: if (((*l_element_precedent).suivant =
1955: allocation_maillon(s_etat_processus)) == NULL)
1956: {
1957: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1958: return;
1959: }
1960:
1961: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1962: l_element_courant = (*l_element_precedent).suivant;
1963:
1964: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1965: == NULL)
1966: {
1967: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1968: return;
1969: }
1970:
1971: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1972: .nombre_arguments = 0;
1973: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1974: .fonction = instruction_plus;
1975:
1976: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1977: .nom_fonction = malloc(2 * sizeof(unsigned char))) == NULL)
1978: {
1979: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1980: return;
1981: }
1982:
1983: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1984: .nom_fonction, "+");
1985: }
1986:
1987: /*
1988: --------------------------------------------------------------------------------
1989: Concaténation de deux chaînes
1990: --------------------------------------------------------------------------------
1991: */
1992:
1993: else if (((*s_objet_argument_1).type == CHN) &&
1994: ((*s_objet_argument_2).type == CHN))
1995: {
1996: if ((s_objet_resultat = allocation(s_etat_processus, CHN)) == NULL)
1997: {
1998: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1999: return;
2000: }
2001:
2002: if (((*s_objet_resultat).objet =
2003: malloc((strlen((unsigned char *) (*s_objet_argument_2).objet) +
2004: strlen((unsigned char *) (*s_objet_argument_1).objet) + 1)
2005: * sizeof(unsigned char))) == NULL)
2006: {
2007: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2008: return;
2009: }
2010:
2011: sprintf((unsigned char *) (*s_objet_resultat).objet, "%s%s",
2012: (unsigned char *) (*s_objet_argument_2).objet,
2013: (unsigned char *) (*s_objet_argument_1).objet);
2014: }
2015:
2016: /*
2017: -------------------------------------------------------------------------------- Concatenation de deux listes
2018: --------------------------------------------------------------------------------
2019: */
2020:
2021: else if (((*s_objet_argument_1).type == LST) &&
2022: ((*s_objet_argument_2).type == LST))
2023: {
2024: if ((s_copie_argument_1 = copie_objet(s_etat_processus,
2025: s_objet_argument_1, 'N')) == NULL)
2026: {
2027: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2028: return;
2029: }
2030:
2031: if ((s_copie_argument_2 = copie_objet(s_etat_processus,
2032: s_objet_argument_2, 'N')) == NULL)
2033: {
2034: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2035: return;
2036: }
2037:
2038: s_objet_resultat = s_copie_argument_2;
2039: l_element_courant = (struct_liste_chainee *) (*s_objet_resultat).objet;
2040: l_element_precedent = l_element_courant;
2041:
2042: while(l_element_courant != NULL)
2043: {
2044: l_element_precedent = l_element_courant;
2045: l_element_courant = (*l_element_courant).suivant;
2046: }
2047:
2048: if (l_element_precedent != NULL)
2049: {
2050: (*l_element_precedent).suivant = (struct_liste_chainee *)
2051: (*s_copie_argument_1).objet;
2052: }
2053: else
2054: {
2055: liberation(s_etat_processus, s_copie_argument_2);
2056:
2057: if ((s_objet_resultat = allocation(s_etat_processus, LST))
2058: == NULL)
2059: {
2060: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2061: return;
2062: }
2063:
2064: (*s_objet_resultat).objet = (*s_copie_argument_1).objet;
2065: }
2066:
2067: free(s_copie_argument_1);
2068: }
2069:
2070: /*
2071: --------------------------------------------------------------------------------
2072: Addition impossible
2073: --------------------------------------------------------------------------------
2074: */
2075:
2076: else
2077: {
2078: liberation(s_etat_processus, s_objet_argument_1);
2079: liberation(s_etat_processus, s_objet_argument_2);
2080:
2081: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
2082: return;
2083: }
2084:
2085: liberation(s_etat_processus, s_objet_argument_1);
2086: liberation(s_etat_processus, s_objet_argument_2);
2087:
2088: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2089: s_objet_resultat) == d_erreur)
2090: {
2091: return;
2092: }
2093:
2094: return;
2095: }
2096:
2097:
2098: /*
2099: ================================================================================
2100: Fonction '^'
2101: ================================================================================
2102: Entrées : structure processus
2103: --------------------------------------------------------------------------------
2104: Sorties :
2105: --------------------------------------------------------------------------------
2106: Effets de bord : néant
2107: ================================================================================
2108: */
2109:
2110: void
2111: instruction_puissance(struct_processus *s_etat_processus)
2112: {
2113: real8 argument;
2114: real8 exposant;
2115:
2116: integer8 tampon;
2117:
2118: logical1 drapeau;
2119:
2120: struct_liste_chainee *l_element_courant;
2121: struct_liste_chainee *l_element_precedent;
2122:
2123: struct_objet *s_copie_argument_1;
2124: struct_objet *s_copie_argument_2;
2125: struct_objet *s_objet_argument_1;
2126: struct_objet *s_objet_argument_2;
2127: struct_objet *s_objet_resultat;
2128:
2129: integer8 nombre_elements;
2130:
2131: (*s_etat_processus).erreur_execution = d_ex;
2132:
2133: if ((*s_etat_processus).affichage_arguments == 'Y')
2134: {
2135: printf("\n ** [^] ");
2136:
2137: if ((*s_etat_processus).langue == 'F')
2138: {
2139: printf("(puissance)\n\n");
2140: }
2141: else
2142: {
2143: printf("(power)\n\n");
2144: }
2145:
2146: printf(" 2: %s, %s, %s\n", d_INT, d_REL, d_CPL);
2147: printf(" 1: %s, %s, %s\n", d_INT, d_REL, d_CPL);
2148: printf("-> 1: %s, %s, %s\n\n", d_INT, d_REL, d_CPL);
2149:
2150: printf(" 2: %s, %s, %s, %s, %s, %s\n",
2151: d_INT, d_REL, d_CPL, d_NOM, d_ALG, d_RPN);
2152: printf(" 1: %s, %s, %s, %s, %s, %s\n",
2153: d_INT, d_REL, d_CPL, d_NOM, d_ALG, d_RPN);
2154: printf("-> 1: %s, %s\n", d_ALG, d_RPN);
2155:
2156: return;
2157: }
2158: else if ((*s_etat_processus).test_instruction == 'Y')
2159: {
2160: (*s_etat_processus).nombre_arguments = 0;
2161: return;
2162: }
2163:
2164: if (test_cfsf(s_etat_processus, 31) == d_vrai)
2165: {
2166: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
2167: {
2168: return;
2169: }
2170: }
2171:
2172: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2173: &s_objet_argument_1) == d_erreur)
2174: {
2175: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
2176: return;
2177: }
2178:
2179: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2180: &s_objet_argument_2) == d_erreur)
2181: {
2182: liberation(s_etat_processus, s_objet_argument_1);
2183:
2184: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
2185: return;
2186: }
2187:
2188: /*
2189: --------------------------------------------------------------------------------
2190: Puissance de deux entiers
2191: --------------------------------------------------------------------------------
2192: */
2193:
2194: if (((*s_objet_argument_1).type == INT) &&
2195: ((*s_objet_argument_2).type == INT))
2196: {
2197: if ((*((integer8 *) (*s_objet_argument_1).objet)) > 0)
2198: {
2199: /*
2200: * Exposant positif
2201: */
2202:
2203: if (depassement_puissance((integer8 *) (*s_objet_argument_2).objet,
2204: (integer8 *) (*s_objet_argument_1).objet, &tampon) ==
2205: d_absence_erreur)
2206: {
2207: if ((s_objet_resultat = allocation(s_etat_processus, INT))
2208: == NULL)
2209: {
2210: (*s_etat_processus).erreur_systeme =
2211: d_es_allocation_memoire;
2212: return;
2213: }
2214:
2215: (*((integer8 *) (*s_objet_resultat).objet)) = tampon;
2216: }
2217: else
2218: {
2219: if ((s_objet_resultat = allocation(s_etat_processus, REL))
2220: == NULL)
2221: {
2222: (*s_etat_processus).erreur_systeme =
2223: d_es_allocation_memoire;
2224: return;
2225: }
2226:
2227: argument = (real8) (*((integer8 *)
2228: (*s_objet_argument_2).objet));
2229: exposant = (real8) (*((integer8 *)
2230: (*s_objet_argument_1).objet));
2231:
2232: f77puissancerr_(&argument, &exposant,
2233: &((*((real8 *) (*s_objet_resultat).objet))));
2234: }
2235: }
2236: else if ((*((integer8 *) (*s_objet_argument_1).objet)) < 0)
2237: {
2238: /*
2239: * Exposant négatif
2240: */
2241:
2242: if ((s_objet_resultat = allocation(s_etat_processus, REL))
2243: == NULL)
2244: {
2245: (*s_etat_processus).erreur_systeme =
2246: d_es_allocation_memoire;
2247: return;
2248: }
2249:
2250: exposant = (real8) (*((integer8 *) (*s_objet_argument_1).objet));
2251:
2252: f77puissanceir_(&((*((integer8 *) (*s_objet_argument_2).objet))),
2253: &exposant, &((*((real8 *) (*s_objet_resultat).objet))));
2254: }
2255: else
2256: {
2257: /*
2258: * Exposant nul
2259: */
2260:
2261: if ((s_objet_resultat = allocation(s_etat_processus, INT))
2262: == NULL)
2263: {
2264: (*s_etat_processus).erreur_systeme =
2265: d_es_allocation_memoire;
2266: return;
2267: }
2268:
2269: (*((integer8 *) (*s_objet_resultat).objet)) = 1;
2270: }
2271: }
2272:
2273: /*
2274: --------------------------------------------------------------------------------
2275: Puissance d'un entier par un réel
2276: --------------------------------------------------------------------------------
2277: */
2278:
2279: else if (((*s_objet_argument_1).type == REL) &&
2280: ((*s_objet_argument_2).type == INT))
2281: {
2282: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
2283: {
2284: (*s_etat_processus).erreur_systeme =
2285: d_es_allocation_memoire;
2286: return;
2287: }
2288:
2289: f77puissanceir_(&((*((integer8 *) (*s_objet_argument_2).objet))),
2290: &((*((real8 *) (*s_objet_argument_1).objet))),
2291: &((*((real8 *) (*s_objet_resultat).objet))));
2292: }
2293:
2294: /*
2295: --------------------------------------------------------------------------------
2296: Puissance d'un entier par un complexe
2297: --------------------------------------------------------------------------------
2298: */
2299:
2300: else if (((*s_objet_argument_1).type == CPL) &&
2301: ((*s_objet_argument_2).type == INT))
2302: {
2303: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
2304: {
2305: (*s_etat_processus).erreur_systeme =
2306: d_es_allocation_memoire;
2307: return;
2308: }
2309:
2310: f77puissanceic_(&((*((integer8 *) (*s_objet_argument_2).objet))),
2311: &((*((struct_complexe16 *) (*s_objet_argument_1).objet))),
2312: &((*((struct_complexe16 *) (*s_objet_resultat).objet))));
2313: }
2314:
2315: /*
2316: --------------------------------------------------------------------------------
2317: Puissance d'un réel par un entier
2318: --------------------------------------------------------------------------------
2319: */
2320:
2321: else if (((*s_objet_argument_1).type == INT) &&
2322: ((*s_objet_argument_2).type == REL))
2323: {
2324: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
2325: {
2326: (*s_etat_processus).erreur_systeme =
2327: d_es_allocation_memoire;
2328: return;
2329: }
2330:
2331: if (((*((integer8 *) (*s_objet_argument_1).objet)) >>
2332: (8 * sizeof(integer4))) == 0)
2333: {
2334: f77puissanceri_(&((*((real8 *) (*s_objet_argument_2).objet))),
2335: &((*((integer8 *) (*s_objet_argument_1).objet))),
2336: &((*((real8 *) (*s_objet_resultat).objet))));
2337: }
2338: else
2339: {
2340: exposant = (real8) (*((integer8 *) (*s_objet_argument_1).objet));
2341:
2342: f77puissancerr_(&((*((real8 *) (*s_objet_argument_2).objet))),
2343: &exposant, &((*((real8 *) (*s_objet_resultat).objet))));
2344: }
2345: }
2346:
2347: /*
2348: --------------------------------------------------------------------------------
2349: Puissance d'un réel par un réel
2350: --------------------------------------------------------------------------------
2351: */
2352:
2353: else if (((*s_objet_argument_1).type == REL) &&
2354: ((*s_objet_argument_2).type == REL))
2355: {
2356: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
2357: {
2358: (*s_etat_processus).erreur_systeme =
2359: d_es_allocation_memoire;
2360: return;
2361: }
2362:
2363: f77puissancerr_(&((*((real8 *) (*s_objet_argument_2).objet))),
2364: &((*((real8 *) (*s_objet_argument_1).objet))),
2365: &((*((real8 *) (*s_objet_resultat).objet))));
2366: }
2367:
2368: /*
2369: --------------------------------------------------------------------------------
2370: Puissance d'un réel par un complexe
2371: --------------------------------------------------------------------------------
2372: */
2373:
2374: else if (((*s_objet_argument_1).type == CPL) &&
2375: ((*s_objet_argument_2).type == REL))
2376: {
2377: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
2378: {
2379: (*s_etat_processus).erreur_systeme =
2380: d_es_allocation_memoire;
2381: return;
2382: }
2383:
2384: f77puissancerc_(&((*((real8 *) (*s_objet_argument_2).objet))),
2385: &((*((struct_complexe16 *) (*s_objet_argument_1).objet))),
2386: &((*((struct_complexe16 *) (*s_objet_resultat).objet))));
2387: }
2388:
2389: /*
2390: --------------------------------------------------------------------------------
2391: Puissance d'un complexe par un entier
2392: --------------------------------------------------------------------------------
2393: */
2394:
2395: else if (((*s_objet_argument_1).type == INT) &&
2396: ((*s_objet_argument_2).type == CPL))
2397: {
2398: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
2399: {
2400: (*s_etat_processus).erreur_systeme =
2401: d_es_allocation_memoire;
2402: return;
2403: }
2404:
2405: if (((*((integer8 *) (*s_objet_argument_1).objet)) >>
2406: (8 * sizeof(integer4))) == 0)
2407: {
2408: f77puissanceci_(&((*((struct_complexe16 *) (*s_objet_argument_2)
2409: .objet))), &((*((integer8 *) (*s_objet_argument_1).objet))),
2410: &((*((struct_complexe16 *) (*s_objet_resultat).objet))));
2411: }
2412: else
2413: {
2414: exposant = (real8) (*((integer8 *) (*s_objet_argument_1).objet));
2415:
2416: f77puissancecr_(&((*((complex16 *) (*s_objet_argument_2).objet))),
2417: &exposant, &((*((complex16 *) (*s_objet_resultat).objet))));
2418: }
2419: }
2420:
2421: /*
2422: --------------------------------------------------------------------------------
2423: Puissance d'un complexe par un réel
2424: --------------------------------------------------------------------------------
2425: */
2426:
2427: else if (((*s_objet_argument_1).type == REL) &&
2428: ((*s_objet_argument_2).type == CPL))
2429: {
2430: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
2431: {
2432: (*s_etat_processus).erreur_systeme =
2433: d_es_allocation_memoire;
2434: return;
2435: }
2436:
2437: f77puissancecr_(&((*((struct_complexe16 *) (*s_objet_argument_2)
2438: .objet))), &((*((real8 *) (*s_objet_argument_1).objet))),
2439: &((*((struct_complexe16 *) (*s_objet_resultat).objet))));
2440: }
2441:
2442: /*
2443: --------------------------------------------------------------------------------
2444: Puissance d'un complexe par un complexe
2445: --------------------------------------------------------------------------------
2446: */
2447:
2448: else if (((*s_objet_argument_1).type == CPL) &&
2449: ((*s_objet_argument_2).type == CPL))
2450: {
2451: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
2452: {
2453: (*s_etat_processus).erreur_systeme =
2454: d_es_allocation_memoire;
2455: return;
2456: }
2457:
2458: f77puissancecc_(&((*((struct_complexe16 *)
2459: (*s_objet_argument_2).objet))),
2460: &((*((struct_complexe16 *) (*s_objet_argument_1).objet))),
2461: &((*((struct_complexe16 *) (*s_objet_resultat).objet))));
2462: }
2463:
2464: /*
2465: --------------------------------------------------------------------------------
2466: Puissance mettant en oeuvre un nom ou une expression algébrique
2467: --------------------------------------------------------------------------------
2468: */
2469: /*
2470: * Nom ou valeur numérique / Nom ou valeur numérique
2471: */
2472:
2473: else if ((((*s_objet_argument_1).type == NOM) &&
2474: (((*s_objet_argument_2).type == NOM) ||
2475: ((*s_objet_argument_2).type == INT) ||
2476: ((*s_objet_argument_2).type == REL) ||
2477: ((*s_objet_argument_2).type == CPL))) ||
2478: (((*s_objet_argument_2).type == NOM) &&
2479: (((*s_objet_argument_1).type == INT) ||
2480: ((*s_objet_argument_1).type == REL) ||
2481: ((*s_objet_argument_1).type == CPL))))
2482: {
2483: drapeau = d_vrai;
2484:
2485: if ((*s_objet_argument_2).type == NOM)
2486: {
2487: if ((*s_objet_argument_1).type == INT)
2488: {
2489: if ((*((integer8 *) (*s_objet_argument_1).objet)) == 1)
2490: {
2491: drapeau = d_faux;
2492:
2493: s_objet_resultat = s_objet_argument_2;
2494: s_objet_argument_2 = NULL;
2495: }
2496: }
2497: else if ((*s_objet_argument_1).type == REL)
2498: {
2499: if ((*((real8 *) (*s_objet_argument_1).objet)) == 1)
2500: {
2501: drapeau = d_faux;
2502:
2503: s_objet_resultat = s_objet_argument_2;
2504: s_objet_argument_2 = NULL;
2505: }
2506: }
2507: else if ((*s_objet_argument_1).type == CPL)
2508: {
2509: if (((*((complex16 *) (*s_objet_argument_1).objet))
2510: .partie_reelle == 1) && ((*((complex16 *)
2511: (*s_objet_argument_1).objet)).partie_imaginaire == 0))
2512: {
2513: drapeau = d_faux;
2514:
2515: s_objet_resultat = s_objet_argument_2;
2516: s_objet_argument_2 = NULL;
2517: }
2518: }
2519: }
2520:
2521: if (drapeau == d_vrai)
2522: {
2523: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
2524: == NULL)
2525: {
2526: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2527: return;
2528: }
2529:
2530: if (((*s_objet_resultat).objet =
2531: allocation_maillon(s_etat_processus)) == NULL)
2532: {
2533: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2534: return;
2535: }
2536:
2537: l_element_courant = (*s_objet_resultat).objet;
2538:
2539: if (((*l_element_courant).donnee = allocation(s_etat_processus,
2540: FCT)) == NULL)
2541: {
2542: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2543: return;
2544: }
2545:
2546: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2547: .nombre_arguments = 0;
2548: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2549: .fonction = instruction_vers_niveau_superieur;
2550:
2551: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2552: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
2553: {
2554: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2555: return;
2556: }
2557:
2558: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2559: .nom_fonction, "<<");
2560:
2561: if (((*l_element_courant).suivant =
2562: allocation_maillon(s_etat_processus)) == NULL)
2563: {
2564: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2565: return;
2566: }
2567:
2568: l_element_courant = (*l_element_courant).suivant;
2569: (*l_element_courant).donnee = s_objet_argument_2;
2570:
2571: if (((*l_element_courant).suivant =
2572: allocation_maillon(s_etat_processus)) == NULL)
2573: {
2574: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2575: return;
2576: }
2577:
2578: l_element_courant = (*l_element_courant).suivant;
2579: (*l_element_courant).donnee = s_objet_argument_1;
2580:
2581: if (((*l_element_courant).suivant =
2582: allocation_maillon(s_etat_processus)) == NULL)
2583: {
2584: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2585: return;
2586: }
2587:
2588: l_element_courant = (*l_element_courant).suivant;
2589:
2590: if (((*l_element_courant).donnee = allocation(s_etat_processus,
2591: FCT)) == NULL)
2592: {
2593: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2594: return;
2595: }
2596:
2597: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2598: .nombre_arguments = 0;
2599: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2600: .fonction = instruction_puissance;
2601:
2602: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2603: .nom_fonction = malloc(2 * sizeof(unsigned char))) == NULL)
2604: {
2605: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2606: return;
2607: }
2608:
2609: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2610: .nom_fonction, "^");
2611:
2612: if (((*l_element_courant).suivant =
2613: allocation_maillon(s_etat_processus)) == NULL)
2614: {
2615: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2616: return;
2617: }
2618:
2619: l_element_courant = (*l_element_courant).suivant;
2620:
2621: if (((*l_element_courant).donnee = allocation(s_etat_processus,
2622: FCT)) == NULL)
2623: {
2624: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2625: return;
2626: }
2627:
2628: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2629: .nombre_arguments = 0;
2630: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2631: .fonction = instruction_vers_niveau_inferieur;
2632:
2633: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2634: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
2635: {
2636: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2637: return;
2638: }
2639:
2640: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2641: .nom_fonction, ">>");
2642:
2643: (*l_element_courant).suivant = NULL;
2644:
2645: s_objet_argument_1 = NULL;
2646: s_objet_argument_2 = NULL;
2647: }
2648: }
2649:
2650: /*
2651: * Nom ou valeur numérique / Expression
2652: */
2653:
2654: else if ((((*s_objet_argument_1).type == ALG) ||
2655: ((*s_objet_argument_1).type == RPN)) &&
2656: (((*s_objet_argument_2).type == NOM) ||
2657: ((*s_objet_argument_2).type == INT) ||
2658: ((*s_objet_argument_2).type == REL) ||
2659: ((*s_objet_argument_2).type == CPL)))
2660: {
2661: nombre_elements = 0;
2662: l_element_courant = (struct_liste_chainee *)
2663: (*s_objet_argument_1).objet;
2664:
2665: while(l_element_courant != NULL)
2666: {
2667: nombre_elements++;
2668: l_element_courant = (*l_element_courant).suivant;
2669: }
2670:
2671: if (nombre_elements == 2)
2672: {
2673: liberation(s_etat_processus, s_objet_argument_1);
2674: liberation(s_etat_processus, s_objet_argument_2);
2675:
2676: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
2677: return;
2678: }
2679:
2680: if ((s_objet_resultat = copie_objet(s_etat_processus,
2681: s_objet_argument_1, 'N')) == NULL)
2682: {
2683: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2684: return;
2685: }
2686:
2687: l_element_courant = (struct_liste_chainee *)
2688: (*s_objet_resultat).objet;
2689: l_element_precedent = l_element_courant;
2690: l_element_courant = (*l_element_courant).suivant;
2691:
2692: if (((*l_element_precedent).suivant =
2693: allocation_maillon(s_etat_processus)) == NULL)
2694: {
2695: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2696: return;
2697: }
2698:
2699: (*(*l_element_precedent).suivant).donnee = s_objet_argument_2;
2700: (*(*l_element_precedent).suivant).suivant = l_element_courant;
2701:
2702: while((*l_element_courant).suivant != NULL)
2703: {
2704: l_element_precedent = l_element_courant;
2705: l_element_courant = (*l_element_courant).suivant;
2706: }
2707:
2708: if (((*l_element_precedent).suivant =
2709: allocation_maillon(s_etat_processus)) == NULL)
2710: {
2711: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2712: return;
2713: }
2714:
2715: if (((*(*l_element_precedent).suivant).donnee =
2716: allocation(s_etat_processus, FCT)) == NULL)
2717: {
2718: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2719: return;
2720: }
2721:
2722: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
2723: .donnee).objet)).nombre_arguments = 0;
2724: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
2725: .donnee).objet)).fonction = instruction_puissance;
2726:
2727: if (((*((struct_fonction *) (*(*(*l_element_precedent)
2728: .suivant).donnee).objet)).nom_fonction =
2729: malloc(2 * sizeof(unsigned char))) == NULL)
2730: {
2731: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2732: return;
2733: }
2734:
2735: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
2736: .suivant).donnee).objet)).nom_fonction, "^");
2737:
2738: (*(*l_element_precedent).suivant).suivant = l_element_courant;
2739:
2740: s_objet_argument_2 = NULL;
2741: }
2742:
2743: /*
2744: * Expression / Nom ou valeur numérique
2745: */
2746:
2747: else if ((((*s_objet_argument_1).type == NOM) ||
2748: ((*s_objet_argument_1).type == INT) ||
2749: ((*s_objet_argument_1).type == REL) ||
2750: ((*s_objet_argument_1).type == CPL)) &&
2751: (((*s_objet_argument_2).type == ALG) ||
2752: ((*s_objet_argument_2).type == RPN)))
2753: {
2754: drapeau = d_vrai;
2755:
2756: nombre_elements = 0;
2757: l_element_courant = (struct_liste_chainee *)
2758: (*s_objet_argument_2).objet;
2759:
2760: while(l_element_courant != NULL)
2761: {
2762: nombre_elements++;
2763: l_element_courant = (*l_element_courant).suivant;
2764: }
2765:
2766: if (nombre_elements == 2)
2767: {
2768: liberation(s_etat_processus, s_objet_argument_1);
2769: liberation(s_etat_processus, s_objet_argument_2);
2770:
2771: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
2772: return;
2773: }
2774:
2775: if ((*s_objet_argument_1).type == INT)
2776: {
2777: if ((*((integer8 *) (*s_objet_argument_1).objet)) == 1)
2778: {
2779: drapeau = d_faux;
2780:
2781: s_objet_resultat = s_objet_argument_2;
2782: s_objet_argument_2 = NULL;
2783: }
2784: }
2785: else if ((*s_objet_argument_1).type == REL)
2786: {
2787: if ((*((real8 *) (*s_objet_argument_1).objet)) == 1)
2788: {
2789: drapeau = d_faux;
2790:
2791: s_objet_resultat = s_objet_argument_2;
2792: s_objet_argument_2 = NULL;
2793: }
2794: }
2795: else if ((*s_objet_argument_1).type == CPL)
2796: {
2797: if (((*((complex16 *) (*s_objet_argument_1).objet))
2798: .partie_reelle == 1) && ((*((complex16 *)
2799: (*s_objet_argument_1).objet)).partie_imaginaire == 0))
2800: {
2801: drapeau = d_faux;
2802:
2803: s_objet_resultat = s_objet_argument_2;
2804: s_objet_argument_2 = NULL;
2805: }
2806: }
2807:
2808: if (drapeau == d_vrai)
2809: {
2810: if ((s_objet_resultat = copie_objet(s_etat_processus,
2811: s_objet_argument_2, 'N')) == NULL)
2812: {
2813: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2814: return;
2815: }
2816:
2817: l_element_courant = (struct_liste_chainee *)
2818: (*s_objet_resultat).objet;
2819: l_element_precedent = l_element_courant;
2820:
2821: while((*l_element_courant).suivant != NULL)
2822: {
2823: l_element_precedent = l_element_courant;
2824: l_element_courant = (*l_element_courant).suivant;
2825: }
2826:
2827: if (((*l_element_precedent).suivant =
2828: allocation_maillon(s_etat_processus)) == NULL)
2829: {
2830: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2831: return;
2832: }
2833:
2834: (*(*l_element_precedent).suivant).donnee = s_objet_argument_1;
2835: l_element_precedent = (*l_element_precedent).suivant;
2836:
2837: if (((*l_element_precedent).suivant =
2838: allocation_maillon(s_etat_processus)) == NULL)
2839: {
2840: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2841: return;
2842: }
2843:
2844: if (((*(*l_element_precedent).suivant).donnee =
2845: allocation(s_etat_processus, FCT)) == NULL)
2846: {
2847: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2848: return;
2849: }
2850:
2851: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
2852: .donnee).objet)).nombre_arguments = 0;
2853: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
2854: .donnee).objet)).fonction = instruction_puissance;
2855:
2856: if (((*((struct_fonction *) (*(*(*l_element_precedent)
2857: .suivant).donnee).objet)).nom_fonction =
2858: malloc(2 * sizeof(unsigned char))) == NULL)
2859: {
2860: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2861: return;
2862: }
2863:
2864: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
2865: .suivant).donnee).objet)).nom_fonction, "^");
2866:
2867: (*(*l_element_precedent).suivant).suivant = l_element_courant;
2868:
2869: s_objet_argument_1 = NULL;
2870: }
2871: }
2872:
2873: /*
2874: * Expression / Expression
2875: */
2876:
2877: else if ((((*s_objet_argument_1).type == ALG) &&
2878: ((*s_objet_argument_2).type == ALG)) ||
2879: (((*s_objet_argument_1).type == RPN) &&
2880: ((*s_objet_argument_2).type == RPN)))
2881: {
2882: nombre_elements = 0;
2883: l_element_courant = (struct_liste_chainee *)
2884: (*s_objet_argument_1).objet;
2885:
2886: while(l_element_courant != NULL)
2887: {
2888: nombre_elements++;
2889: l_element_courant = (*l_element_courant).suivant;
2890: }
2891:
2892: if (nombre_elements == 2)
2893: {
2894: liberation(s_etat_processus, s_objet_argument_1);
2895: liberation(s_etat_processus, s_objet_argument_2);
2896:
2897: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
2898: return;
2899: }
2900:
2901: nombre_elements = 0;
2902: l_element_courant = (struct_liste_chainee *)
2903: (*s_objet_argument_2).objet;
2904:
2905: while(l_element_courant != NULL)
2906: {
2907: nombre_elements++;
2908: l_element_courant = (*l_element_courant).suivant;
2909: }
2910:
2911: if (nombre_elements == 2)
2912: {
2913: liberation(s_etat_processus, s_objet_argument_1);
2914: liberation(s_etat_processus, s_objet_argument_2);
2915:
2916: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
2917: return;
2918: }
2919:
2920: if ((s_copie_argument_1 = copie_objet(s_etat_processus,
2921: s_objet_argument_1, 'N')) == NULL)
2922: {
2923: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2924: return;
2925: }
2926:
2927: if ((s_copie_argument_2 = copie_objet(s_etat_processus,
2928: s_objet_argument_2, 'N')) == NULL)
2929: {
2930: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2931: return;
2932: }
2933:
2934: l_element_courant = (struct_liste_chainee *)
2935: (*s_copie_argument_1).objet;
2936: (*s_copie_argument_1).objet = (void *) (*((struct_liste_chainee *)
2937: (*s_copie_argument_1).objet)).suivant;
2938:
2939: liberation(s_etat_processus, (*l_element_courant).donnee);
2940: free(l_element_courant);
2941:
2942: l_element_courant = (struct_liste_chainee *)
2943: (*s_copie_argument_2).objet;
2944: l_element_precedent = l_element_courant;
2945: s_objet_resultat = s_copie_argument_2;
2946:
2947: while((*l_element_courant).suivant != NULL)
2948: {
2949: l_element_precedent = l_element_courant;
2950: l_element_courant = (*l_element_courant).suivant;
2951: }
2952:
2953: liberation(s_etat_processus, (*l_element_courant).donnee);
2954: free(l_element_courant);
2955:
2956: (*l_element_precedent).suivant = (struct_liste_chainee *)
2957: (*s_copie_argument_1).objet;
2958: free(s_copie_argument_1);
2959:
2960: l_element_courant = (*l_element_precedent).suivant;
2961: while((*l_element_courant).suivant != NULL)
2962: {
2963: l_element_precedent = l_element_courant;
2964: l_element_courant = (*l_element_courant).suivant;
2965: }
2966:
2967: if (((*l_element_precedent).suivant =
2968: allocation_maillon(s_etat_processus)) == NULL)
2969: {
2970: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2971: return;
2972: }
2973:
2974: (*(*l_element_precedent).suivant).suivant = l_element_courant;
2975: l_element_courant = (*l_element_precedent).suivant;
2976:
2977: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
2978: == NULL)
2979: {
2980: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2981: return;
2982: }
2983:
2984: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2985: .nombre_arguments = 0;
2986: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2987: .fonction = instruction_puissance;
2988:
2989: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2990: .nom_fonction = malloc(2 * sizeof(unsigned char))) == NULL)
2991: {
2992: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2993: return;
2994: }
2995:
2996: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2997: .nom_fonction, "^");
2998: }
2999:
3000: /*
3001: --------------------------------------------------------------------------------
3002: Puissance impossible
3003: --------------------------------------------------------------------------------
3004: */
3005:
3006: else
3007: {
3008: liberation(s_etat_processus, s_objet_argument_1);
3009: liberation(s_etat_processus, s_objet_argument_2);
3010:
3011: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
3012: return;
3013: }
3014:
3015: liberation(s_etat_processus, s_objet_argument_1);
3016: liberation(s_etat_processus, s_objet_argument_2);
3017:
3018: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
3019: s_objet_resultat) == d_erreur)
3020: {
3021: return;
3022: }
3023:
3024: return;
3025: }
3026:
3027:
3028: /*
3029: ================================================================================
3030: Fonction 'purge'
3031: ================================================================================
3032: Entrées : structure processus
3033: -------------------------------------------------------------------------------
3034: Sorties :
3035: --------------------------------------------------------------------------------
3036: Effets de bord : néant
3037: ================================================================================
3038: */
3039:
3040: void
3041: instruction_purge(struct_processus *s_etat_processus)
3042: {
3043: struct_liste_chainee *l_element_courant;
3044:
3045: struct_objet *s_objet;
3046:
3047: (*s_etat_processus).erreur_execution = d_ex;
3048:
3049: if ((*s_etat_processus).affichage_arguments == 'Y')
3050: {
3051: printf("\n PURGE ");
3052:
3053: if ((*s_etat_processus).langue == 'F')
3054: {
3055: printf("(effacement d'une variable globale)\n\n");
3056: }
3057: else
3058: {
3059: printf("(purge a global variable)\n\n");
3060: }
3061:
3062: printf(" 1: %s, %s\n", d_NOM, d_LST);
3063:
3064: return;
3065: }
3066: else if ((*s_etat_processus).test_instruction == 'Y')
3067: {
3068: (*s_etat_processus).nombre_arguments = -1;
3069: return;
3070: }
3071:
3072: if (test_cfsf(s_etat_processus, 31) == d_vrai)
3073: {
3074: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
3075: {
3076: return;
3077: }
3078: }
3079:
3080: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
3081: &s_objet) == d_erreur)
3082: {
3083: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
3084: return;
3085: }
3086:
3087: if ((*s_objet).type == NOM)
3088: {
3089: if (recherche_variable(s_etat_processus, ((*((struct_nom *)
3090: (*s_objet).objet)).nom)) == d_faux)
3091: {
3092: liberation(s_etat_processus, s_objet);
3093:
3094: (*s_etat_processus).erreur_systeme = d_es;
3095: (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
3096: return;
3097: }
3098:
3099: if ((*(*s_etat_processus).pointeur_variable_courante).objet == NULL)
3100: {
3101: liberation(s_etat_processus, s_objet);
3102:
3103: (*s_etat_processus).erreur_execution = d_ex_variable_partagee;
3104: return;
3105: }
3106:
3107: if (retrait_variable(s_etat_processus, (*((struct_nom *)
3108: (*s_objet).objet)).nom, 'G') == d_erreur)
3109: {
3110: return;
3111: }
3112: }
3113: else if ((*s_objet).type == LST)
3114: {
3115: l_element_courant = (struct_liste_chainee *) (*s_objet).objet;
3116:
3117: while(l_element_courant != NULL)
3118: {
3119: if ((*(*l_element_courant).donnee).type != NOM)
3120: {
3121: liberation(s_etat_processus, s_objet);
3122:
3123: (*s_etat_processus).erreur_execution = d_ex_nom_invalide;
3124: return;
3125: }
3126:
3127: if (recherche_variable(s_etat_processus, (*((struct_nom *)
3128: (*(*l_element_courant).donnee).objet)).nom) == d_faux)
3129: {
3130: liberation(s_etat_processus, s_objet);
3131:
3132: (*s_etat_processus).erreur_systeme = d_es;
3133: (*s_etat_processus).erreur_execution =
3134: d_ex_variable_non_definie;
3135: return;
3136: }
3137:
3138: if ((*(*s_etat_processus).pointeur_variable_courante).objet == NULL)
3139: {
3140: liberation(s_etat_processus, s_objet);
3141:
3142: (*s_etat_processus).erreur_execution = d_ex_variable_partagee;
3143: return;
3144: }
3145:
3146: if (retrait_variable(s_etat_processus, (*((struct_nom *)
3147: (*(*l_element_courant).donnee).objet)).nom, 'G')
3148: == d_erreur)
3149: {
3150: return;
3151: }
3152:
3153: l_element_courant = (*l_element_courant).suivant;
3154: }
3155: }
3156: else
3157: {
3158: liberation(s_etat_processus, s_objet);
3159:
3160: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
3161: return;
3162: }
3163:
3164: liberation(s_etat_processus, s_objet);
3165:
3166: return;
3167: }
3168:
3169:
3170: /*
3171: ================================================================================
3172: Fonction 'pi'
3173: ================================================================================
3174: Entrées : pointeur sur une struct_processus
3175: --------------------------------------------------------------------------------
3176: Sorties :
3177: --------------------------------------------------------------------------------
3178: Effets de bord : néant
3179: ================================================================================
3180: */
3181:
3182: void
3183: instruction_pi(struct_processus *s_etat_processus)
3184: {
3185: struct_objet *s_objet;
3186:
3187: (*s_etat_processus).erreur_execution = d_ex;
3188:
3189: if ((*s_etat_processus).affichage_arguments == 'Y')
3190: {
3191: printf("\n PI ");
3192:
3193: if ((*s_etat_processus).langue == 'F')
3194: {
3195: printf("(constante PI)\n\n");
3196: }
3197: else
3198: {
3199: printf("(PI constant)\n\n");
3200: }
3201:
3202: printf("-> 1: %s, %s\n", d_REL, d_NOM);
3203:
3204: return;
3205: }
3206: else if ((*s_etat_processus).test_instruction == 'Y')
3207: {
3208: (*s_etat_processus).constante_symbolique = 'Y';
3209: (*s_etat_processus).nombre_arguments = -1;
3210: return;
3211: }
3212:
3213: /* Indicateur 35 armé => évaluation symbolique */
3214: if (test_cfsf(s_etat_processus, 35) == d_vrai)
3215: {
3216: if ((s_objet = allocation(s_etat_processus, NOM)) == NULL)
3217: {
3218: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3219: return;
3220: }
3221:
3222: if (((*((struct_nom *) (*s_objet).objet)).nom =
3223: malloc(3 * sizeof(unsigned char))) == NULL)
3224: {
3225: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3226: return;
3227: }
3228:
3229: strcpy((*((struct_nom *) (*s_objet).objet)).nom, "PI");
3230: (*((struct_nom *) (*s_objet).objet)).symbole = d_faux;
3231: }
3232: else
3233: {
3234: if ((s_objet = allocation(s_etat_processus, REL)) == NULL)
3235: {
3236: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3237: return;
3238: }
3239:
3240: (*((real8 *) (*s_objet).objet)) = 4 * atan((real8) 1);
3241: }
3242:
3243: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
3244: s_objet) == d_erreur)
3245: {
3246: return;
3247: }
3248:
3249: return;
3250: }
3251:
3252:
3253: /*
3254: ================================================================================
3255: Fonction '%t'
3256: ================================================================================
3257: Entrées :
3258: --------------------------------------------------------------------------------
3259: Sorties :
3260: --------------------------------------------------------------------------------
3261: Effets de bord : néant
3262: ================================================================================
3263: */
3264:
3265: void
3266: instruction_pourcent_t(struct_processus *s_etat_processus)
3267: {
3268: struct_liste_chainee *l_element_courant;
3269: struct_liste_chainee *l_element_precedent;
3270:
3271: struct_objet *s_copie_argument_1;
3272: struct_objet *s_copie_argument_2;
3273: struct_objet *s_objet_argument_1;
3274: struct_objet *s_objet_argument_2;
3275: struct_objet *s_objet_resultat;
3276:
3277: integer8 nombre_elements;
3278:
3279: (*s_etat_processus).erreur_execution = d_ex;
3280:
3281: if ((*s_etat_processus).affichage_arguments == 'Y')
3282: {
3283: printf("\n %%T ");
3284:
3285: if ((*s_etat_processus).langue == 'F')
3286: {
3287: printf("(pourcentage du total)\n\n");
3288: }
3289: else
3290: {
3291: printf("(percentage wrt total)\n\n");
3292: }
3293:
3294: printf(" 2: %s, %s\n", d_INT, d_REL);
3295: printf(" 1: %s, %s\n", d_INT, d_REL);
3296: printf("-> 1: %s\n\n", d_REL);
3297:
3298: printf(" 2: %s, %s, %s, %s\n", d_NOM, d_ALG, d_INT, d_REL);
3299: printf(" 1: %s, %s, %s, %s\n", d_NOM, d_ALG, d_INT, d_REL);
3300: printf("-> 1: %s\n\n", d_ALG);
3301:
3302: printf(" 2: %s, %s, %s, %s\n", d_RPN, d_NOM, d_INT, d_REL);
3303: printf(" 1: %s, %s, %s, %s\n", d_RPN, d_NOM, d_INT, d_REL);
3304: printf("-> 1: %s\n", d_RPN);
3305:
3306: return;
3307: }
3308: else if ((*s_etat_processus).test_instruction == 'Y')
3309: {
3310: (*s_etat_processus).nombre_arguments = -1;
3311: return;
3312: }
3313:
3314: if (test_cfsf(s_etat_processus, 31) == d_vrai)
3315: {
3316: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
3317: {
3318: return;
3319: }
3320: }
3321:
3322: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
3323: &s_objet_argument_1) == d_erreur)
3324: {
3325: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
3326: return;
3327: }
3328:
3329: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
3330: &s_objet_argument_2) == d_erreur)
3331: {
3332: liberation(s_etat_processus, s_objet_argument_1);
3333:
3334: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
3335: return;
3336: }
3337:
3338: /*
3339: --------------------------------------------------------------------------------
3340: %T portant sur des valeurs numériques
3341: --------------------------------------------------------------------------------
3342: */
3343:
3344: if ((((*s_objet_argument_1).type == INT) ||
3345: ((*s_objet_argument_1).type == REL)) &&
3346: (((*s_objet_argument_2).type == INT) ||
3347: ((*s_objet_argument_2).type == REL)))
3348: {
3349: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
3350: {
3351: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3352: return;
3353: }
3354:
3355: if ((*s_objet_argument_1).type == INT)
3356: {
3357: if ((*s_objet_argument_2).type == INT)
3358: {
3359: (*((real8 *) (*s_objet_resultat).objet)) = 100 *
3360: (((real8) (*((integer8 *) (*s_objet_argument_1)
3361: .objet))) / ((real8) (*((integer8 *)
3362: (*s_objet_argument_2).objet))));
3363: }
3364: else
3365: {
3366: (*((real8 *) (*s_objet_resultat).objet)) = 100 *
3367: (((real8) (*((integer8 *) (*s_objet_argument_1)
3368: .objet))) / (*((real8 *)
3369: (*s_objet_argument_2).objet)));
3370: }
3371: }
3372: else
3373: {
3374: if ((*s_objet_argument_2).type == INT)
3375: {
3376: (*((real8 *) (*s_objet_resultat).objet)) = 100 *
3377: ((*((real8 *) (*s_objet_argument_1)
3378: .objet)) / ((real8) (*((integer8 *)
3379: (*s_objet_argument_2).objet))));
3380: }
3381: else
3382: {
3383: (*((real8 *) (*s_objet_resultat).objet)) = 100 *
3384: ((*((real8 *) (*s_objet_argument_1).objet)) /
3385: (*((real8 *) (*s_objet_argument_2).objet)));
3386: }
3387: }
3388: }
3389:
3390: /*
3391: --------------------------------------------------------------------------------
3392: %T entre des arguments complexes
3393: --------------------------------------------------------------------------------
3394: */
3395:
3396: /*
3397: * Nom ou valeur numérique / Nom ou valeur numérique
3398: */
3399:
3400: else if ((((*s_objet_argument_1).type == NOM) &&
3401: (((*s_objet_argument_2).type == NOM) ||
3402: ((*s_objet_argument_2).type == INT) ||
3403: ((*s_objet_argument_2).type == REL))) ||
3404: (((*s_objet_argument_2).type == NOM) &&
3405: (((*s_objet_argument_1).type == INT) ||
3406: ((*s_objet_argument_1).type == REL))))
3407: {
3408: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
3409: {
3410: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3411: return;
3412: }
3413:
3414: if (((*s_objet_resultat).objet =
3415: allocation_maillon(s_etat_processus)) == NULL)
3416: {
3417: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3418: return;
3419: }
3420:
3421: l_element_courant = (*s_objet_resultat).objet;
3422:
3423: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
3424: == NULL)
3425: {
3426: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3427: return;
3428: }
3429:
3430: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3431: .nombre_arguments = 0;
3432: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3433: .fonction = instruction_vers_niveau_superieur;
3434:
3435: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3436: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
3437: {
3438: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3439: return;
3440: }
3441:
3442: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3443: .nom_fonction, "<<");
3444:
3445: if (((*l_element_courant).suivant =
3446: allocation_maillon(s_etat_processus)) == NULL)
3447: {
3448: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3449: return;
3450: }
3451:
3452: l_element_courant = (*l_element_courant).suivant;
3453: (*l_element_courant).donnee = s_objet_argument_2;
3454:
3455: if (((*l_element_courant).suivant =
3456: allocation_maillon(s_etat_processus)) == NULL)
3457: {
3458: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3459: return;
3460: }
3461:
3462: l_element_courant = (*l_element_courant).suivant;
3463: (*l_element_courant).donnee = s_objet_argument_1;
3464:
3465: if (((*l_element_courant).suivant =
3466: allocation_maillon(s_etat_processus)) == NULL)
3467: {
3468: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3469: return;
3470: }
3471:
3472: l_element_courant = (*l_element_courant).suivant;
3473:
3474: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
3475: == NULL)
3476: {
3477: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3478: return;
3479: }
3480:
3481: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3482: .nombre_arguments = 2;
3483: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3484: .fonction = instruction_pourcent_t;
3485:
3486: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3487: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
3488: {
3489: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3490: return;
3491: }
3492:
3493: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3494: .nom_fonction, "%T");
3495:
3496: if (((*l_element_courant).suivant =
3497: allocation_maillon(s_etat_processus)) == NULL)
3498: {
3499: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3500: return;
3501: }
3502:
3503: l_element_courant = (*l_element_courant).suivant;
3504:
3505: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
3506: == NULL)
3507: {
3508: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3509: return;
3510: }
3511:
3512: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3513: .nombre_arguments = 0;
3514: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3515: .fonction = instruction_vers_niveau_inferieur;
3516:
3517: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3518: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
3519: {
3520: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3521: return;
3522: }
3523:
3524: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3525: .nom_fonction, ">>");
3526:
3527: (*l_element_courant).suivant = NULL;
3528:
3529: s_objet_argument_1 = NULL;
3530: s_objet_argument_2 = NULL;
3531: }
3532:
3533: /*
3534: * Nom ou valeur numérique / Expression
3535: */
3536:
3537: else if (((((*s_objet_argument_1).type == ALG) ||
3538: ((*s_objet_argument_1).type == RPN))) &&
3539: (((*s_objet_argument_2).type == NOM) ||
3540: ((*s_objet_argument_2).type == INT) ||
3541: ((*s_objet_argument_2).type == REL)))
3542: {
3543: nombre_elements = 0;
3544: l_element_courant = (struct_liste_chainee *)
3545: (*s_objet_argument_1).objet;
3546:
3547: while(l_element_courant != NULL)
3548: {
3549: nombre_elements++;
3550: l_element_courant = (*l_element_courant).suivant;
3551: }
3552:
3553: if (nombre_elements == 2)
3554: {
3555: liberation(s_etat_processus, s_objet_argument_1);
3556: liberation(s_etat_processus, s_objet_argument_2);
3557:
3558: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
3559: return;
3560: }
3561:
3562: if ((s_objet_resultat = copie_objet(s_etat_processus,
3563: s_objet_argument_1, 'N')) == NULL)
3564: {
3565: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3566: return;
3567: }
3568:
3569: l_element_courant = (struct_liste_chainee *)
3570: (*s_objet_resultat).objet;
3571: l_element_precedent = l_element_courant;
3572: l_element_courant = (*l_element_courant).suivant;
3573:
3574: if (((*l_element_precedent).suivant =
3575: allocation_maillon(s_etat_processus)) == NULL)
3576: {
3577: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3578: return;
3579: }
3580:
3581: (*(*l_element_precedent).suivant).donnee = s_objet_argument_2;
3582: (*(*l_element_precedent).suivant).suivant = l_element_courant;
3583:
3584: while((*l_element_courant).suivant != NULL)
3585: {
3586: l_element_precedent = l_element_courant;
3587: l_element_courant = (*l_element_courant).suivant;
3588: }
3589:
3590: if (((*l_element_precedent).suivant =
3591: allocation_maillon(s_etat_processus)) == NULL)
3592: {
3593: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3594: return;
3595: }
3596:
3597: if (((*(*l_element_precedent).suivant).donnee =
3598: allocation(s_etat_processus, FCT)) == NULL)
3599: {
3600: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3601: return;
3602: }
3603:
3604: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
3605: .donnee).objet)).nombre_arguments = 2;
3606: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
3607: .donnee).objet)).fonction = instruction_pourcent_t;
3608:
3609: if (((*((struct_fonction *) (*(*(*l_element_precedent)
3610: .suivant).donnee).objet)).nom_fonction =
3611: malloc(3 * sizeof(unsigned char))) == NULL)
3612: {
3613: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3614: return;
3615: }
3616:
3617: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
3618: .suivant).donnee).objet)).nom_fonction, "%T");
3619:
3620: (*(*l_element_precedent).suivant).suivant = l_element_courant;
3621:
3622: s_objet_argument_2 = NULL;
3623: }
3624:
3625: /*
3626: * Expression / Nom ou valeur numérique
3627: */
3628:
3629: else if ((((*s_objet_argument_1).type == NOM) ||
3630: ((*s_objet_argument_1).type == INT) ||
3631: ((*s_objet_argument_1).type == REL)) &&
3632: ((((*s_objet_argument_2).type == ALG) ||
3633: ((*s_objet_argument_2).type == RPN))))
3634: {
3635: nombre_elements = 0;
3636: l_element_courant = (struct_liste_chainee *)
3637: (*s_objet_argument_2).objet;
3638:
3639: while(l_element_courant != NULL)
3640: {
3641: nombre_elements++;
3642: l_element_courant = (*l_element_courant).suivant;
3643: }
3644:
3645: if (nombre_elements == 2)
3646: {
3647: liberation(s_etat_processus, s_objet_argument_1);
3648: liberation(s_etat_processus, s_objet_argument_2);
3649:
3650: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
3651: return;
3652: }
3653:
3654: if ((s_objet_resultat = copie_objet(s_etat_processus,
3655: s_objet_argument_2, 'N')) == NULL)
3656: {
3657: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3658: return;
3659: }
3660:
3661: l_element_courant = (struct_liste_chainee *)
3662: (*s_objet_resultat).objet;
3663: l_element_precedent = l_element_courant;
3664:
3665: while((*l_element_courant).suivant != NULL)
3666: {
3667: l_element_precedent = l_element_courant;
3668: l_element_courant = (*l_element_courant).suivant;
3669: }
3670:
3671: if (((*l_element_precedent).suivant =
3672: allocation_maillon(s_etat_processus)) == NULL)
3673: {
3674: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3675: return;
3676: }
3677:
3678: (*(*l_element_precedent).suivant).donnee = s_objet_argument_1;
3679: l_element_precedent = (*l_element_precedent).suivant;
3680:
3681: if (((*l_element_precedent).suivant =
3682: allocation_maillon(s_etat_processus)) == NULL)
3683: {
3684: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3685: return;
3686: }
3687:
3688: if (((*(*l_element_precedent).suivant).donnee =
3689: allocation(s_etat_processus, FCT)) == NULL)
3690: {
3691: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3692: return;
3693: }
3694:
3695: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
3696: .donnee).objet)).nombre_arguments = 2;
3697: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
3698: .donnee).objet)).fonction = instruction_pourcent_t;
3699:
3700: if (((*((struct_fonction *) (*(*(*l_element_precedent)
3701: .suivant).donnee).objet)).nom_fonction =
3702: malloc(3 * sizeof(unsigned char))) == NULL)
3703: {
3704: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3705: return;
3706: }
3707:
3708: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
3709: .suivant).donnee).objet)).nom_fonction, "%T");
3710:
3711: (*(*l_element_precedent).suivant).suivant = l_element_courant;
3712:
3713: s_objet_argument_1 = NULL;
3714: }
3715:
3716: /*
3717: * Expression / Expression
3718: */
3719:
3720: else if ((((*s_objet_argument_1).type == ALG) &&
3721: ((*s_objet_argument_2).type == ALG)) ||
3722: (((*s_objet_argument_1).type == RPN) &&
3723: ((*s_objet_argument_2).type == RPN)))
3724: {
3725: nombre_elements = 0;
3726: l_element_courant = (struct_liste_chainee *)
3727: (*s_objet_argument_1).objet;
3728:
3729: while(l_element_courant != NULL)
3730: {
3731: nombre_elements++;
3732: l_element_courant = (*l_element_courant).suivant;
3733: }
3734:
3735: if (nombre_elements == 2)
3736: {
3737: liberation(s_etat_processus, s_objet_argument_1);
3738: liberation(s_etat_processus, s_objet_argument_2);
3739:
3740: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
3741: return;
3742: }
3743:
3744: nombre_elements = 0;
3745: l_element_courant = (struct_liste_chainee *)
3746: (*s_objet_argument_2).objet;
3747:
3748: while(l_element_courant != NULL)
3749: {
3750: nombre_elements++;
3751: l_element_courant = (*l_element_courant).suivant;
3752: }
3753:
3754: if (nombre_elements == 2)
3755: {
3756: liberation(s_etat_processus, s_objet_argument_1);
3757: liberation(s_etat_processus, s_objet_argument_2);
3758:
3759: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
3760: return;
3761: }
3762:
3763: if ((s_copie_argument_1 = copie_objet(s_etat_processus,
3764: s_objet_argument_1, 'N')) == NULL)
3765: {
3766: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3767: return;
3768: }
3769:
3770: if ((s_copie_argument_2 = copie_objet(s_etat_processus,
3771: s_objet_argument_2, 'N')) == NULL)
3772: {
3773: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3774: return;
3775: }
3776:
3777: l_element_courant = (struct_liste_chainee *)
3778: (*s_copie_argument_1).objet;
3779: (*s_copie_argument_1).objet = (void *) (*((struct_liste_chainee *)
3780: (*s_copie_argument_1).objet)).suivant;
3781:
3782: liberation(s_etat_processus, (*l_element_courant).donnee);
3783: free(l_element_courant);
3784:
3785: l_element_courant = (struct_liste_chainee *)
3786: (*s_copie_argument_2).objet;
3787: l_element_precedent = l_element_courant;
3788: s_objet_resultat = s_copie_argument_2;
3789:
3790: while((*l_element_courant).suivant != NULL)
3791: {
3792: l_element_precedent = l_element_courant;
3793: l_element_courant = (*l_element_courant).suivant;
3794: }
3795:
3796: liberation(s_etat_processus, (*l_element_courant).donnee);
3797: free(l_element_courant);
3798:
3799: (*l_element_precedent).suivant = (struct_liste_chainee *)
3800: (*s_copie_argument_1).objet;
3801: free(s_copie_argument_1);
3802:
3803: l_element_courant = (*l_element_precedent).suivant;
3804: while((*l_element_courant).suivant != NULL)
3805: {
3806: l_element_precedent = l_element_courant;
3807: l_element_courant = (*l_element_courant).suivant;
3808: }
3809:
3810: if (((*l_element_precedent).suivant =
3811: allocation_maillon(s_etat_processus)) == NULL)
3812: {
3813: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3814: return;
3815: }
3816:
3817: (*(*l_element_precedent).suivant).suivant = l_element_courant;
3818: l_element_courant = (*l_element_precedent).suivant;
3819:
3820: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
3821: == NULL)
3822: {
3823: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3824: return;
3825: }
3826:
3827: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3828: .nombre_arguments = 2;
3829: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3830: .fonction = instruction_pourcent_t;
3831:
3832: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3833: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
3834: {
3835: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3836: return;
3837: }
3838:
3839: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3840: .nom_fonction, "%T");
3841: }
3842:
3843: /*
3844: --------------------------------------------------------------------------------
3845: Arguments incorrects
3846: --------------------------------------------------------------------------------
3847: */
3848:
3849: else
3850: {
3851: liberation(s_etat_processus, s_objet_argument_1);
3852: liberation(s_etat_processus, s_objet_argument_2);
3853:
3854: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
3855: return;
3856: }
3857:
3858: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
3859: s_objet_resultat) == d_erreur)
3860: {
3861: return;
3862: }
3863:
3864: liberation(s_etat_processus, s_objet_argument_1);
3865: liberation(s_etat_processus, s_objet_argument_2);
3866:
3867: return;
3868: }
3869:
3870: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_p1.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src