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