Annotation of rpl/src/instructions_p1.c, revision 1.10
1.1 bertrand 1: /*
2: ================================================================================
1.10 ! bertrand 3: RPL/2 (R) version 4.0.17
1.1 bertrand 4: Copyright (C) 1989-2010 Dr. BERTRAND Joël
5:
6: This file is part of RPL/2.
7:
8: RPL/2 is free software; you can redistribute it and/or modify it
9: under the terms of the CeCILL V2 License as published by the french
10: CEA, CNRS and INRIA.
11:
12: RPL/2 is distributed in the hope that it will be useful, but WITHOUT
13: ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14: FITNESS FOR A PARTICULAR PURPOSE. See the CeCILL V2 License
15: for more details.
16:
17: You should have received a copy of the CeCILL License
18: along with RPL/2. If not, write to info@cecill.info.
19: ================================================================================
20: */
21:
22:
23: #include "rpl.conv.h"
24:
25:
26: /*
27: ================================================================================
28: Fonction '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: integer4 troncature;
2112:
2113: integer8 tampon;
2114:
2115: logical1 drapeau;
2116:
2117: struct_liste_chainee *l_element_courant;
2118: struct_liste_chainee *l_element_precedent;
2119:
2120: struct_objet *s_copie_argument_1;
2121: struct_objet *s_copie_argument_2;
2122: struct_objet *s_objet_argument_1;
2123: struct_objet *s_objet_argument_2;
2124: struct_objet *s_objet_resultat;
2125:
2126: unsigned long nombre_elements;
2127:
2128: (*s_etat_processus).erreur_execution = d_ex;
2129:
2130: if ((*s_etat_processus).affichage_arguments == 'Y')
2131: {
2132: printf("\n ** [^] ");
2133:
2134: if ((*s_etat_processus).langue == 'F')
2135: {
2136: printf("(puissance)\n\n");
2137: }
2138: else
2139: {
2140: printf("(power)\n\n");
2141: }
2142:
2143: printf(" 2: %s, %s, %s\n", d_INT, d_REL, d_CPL);
2144: printf(" 1: %s, %s, %s\n", d_INT, d_REL, d_CPL);
2145: printf("-> 1: %s, %s, %s\n\n", d_INT, d_REL, d_CPL);
2146:
2147: printf(" 2: %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, %s, %s, %s, %s\n",
2150: d_INT, d_REL, d_CPL, d_NOM, d_ALG, d_RPN);
2151: printf("-> 1: %s, %s\n", d_ALG, d_RPN);
2152:
2153: return;
2154: }
2155: else if ((*s_etat_processus).test_instruction == 'Y')
2156: {
2157: (*s_etat_processus).nombre_arguments = 0;
2158: return;
2159: }
2160:
2161: if (test_cfsf(s_etat_processus, 31) == d_vrai)
2162: {
2163: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
2164: {
2165: return;
2166: }
2167: }
2168:
2169: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2170: &s_objet_argument_1) == d_erreur)
2171: {
2172: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
2173: return;
2174: }
2175:
2176: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2177: &s_objet_argument_2) == d_erreur)
2178: {
2179: liberation(s_etat_processus, s_objet_argument_1);
2180:
2181: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
2182: return;
2183: }
2184:
2185: /*
2186: --------------------------------------------------------------------------------
2187: Puissance de deux entiers
2188: --------------------------------------------------------------------------------
2189: */
2190:
2191: if (((*s_objet_argument_1).type == INT) &&
2192: ((*s_objet_argument_2).type == INT))
2193: {
2194: if ((*((integer8 *) (*s_objet_argument_1).objet)) > 0)
2195: {
2196: /*
2197: * Exposant positif
2198: */
2199:
2200: if (depassement_puissance((integer8 *) (*s_objet_argument_2).objet,
2201: (integer8 *) (*s_objet_argument_1).objet, &tampon) ==
2202: d_absence_erreur)
2203: {
2204: if ((s_objet_resultat = allocation(s_etat_processus, INT))
2205: == NULL)
2206: {
2207: (*s_etat_processus).erreur_systeme =
2208: d_es_allocation_memoire;
2209: return;
2210: }
2211:
2212: (*((integer8 *) (*s_objet_resultat).objet)) = tampon;
2213: }
2214: else
2215: {
2216: if ((s_objet_resultat = allocation(s_etat_processus, REL))
2217: == NULL)
2218: {
2219: (*s_etat_processus).erreur_systeme =
2220: d_es_allocation_memoire;
2221: return;
2222: }
2223:
2224: argument = (real8) (*((integer8 *)
2225: (*s_objet_argument_2).objet));
2226: exposant = (real8) (*((integer8 *)
2227: (*s_objet_argument_1).objet));
2228:
2229: f77puissancerr_(&argument, &exposant,
2230: &((*((real8 *) (*s_objet_resultat).objet))));
2231: }
2232: }
2233: else if ((*((integer8 *) (*s_objet_argument_1).objet)) < 0)
2234: {
2235: /*
2236: * Exposant négatif
2237: */
2238:
2239: if ((s_objet_resultat = allocation(s_etat_processus, REL))
2240: == NULL)
2241: {
2242: (*s_etat_processus).erreur_systeme =
2243: d_es_allocation_memoire;
2244: return;
2245: }
2246:
2247: exposant = (real8) (*((integer8 *) (*s_objet_argument_1).objet));
2248:
2249: f77puissanceir_(&((*((integer8 *) (*s_objet_argument_2).objet))),
2250: &exposant, &((*((real8 *) (*s_objet_resultat).objet))));
2251: }
2252: else
2253: {
2254: /*
2255: * Exposant nul
2256: */
2257:
2258: if ((s_objet_resultat = allocation(s_etat_processus, INT))
2259: == NULL)
2260: {
2261: (*s_etat_processus).erreur_systeme =
2262: d_es_allocation_memoire;
2263: return;
2264: }
2265:
2266: (*((integer8 *) (*s_objet_resultat).objet)) = 1;
2267: }
2268: }
2269:
2270: /*
2271: --------------------------------------------------------------------------------
2272: Puissance d'un entier par un réel
2273: --------------------------------------------------------------------------------
2274: */
2275:
2276: else if (((*s_objet_argument_1).type == REL) &&
2277: ((*s_objet_argument_2).type == INT))
2278: {
2279: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
2280: {
2281: (*s_etat_processus).erreur_systeme =
2282: d_es_allocation_memoire;
2283: return;
2284: }
2285:
2286: f77puissanceir_(&((*((integer8 *) (*s_objet_argument_2).objet))),
2287: &((*((real8 *) (*s_objet_argument_1).objet))),
2288: &((*((real8 *) (*s_objet_resultat).objet))));
2289: }
2290:
2291: /*
2292: --------------------------------------------------------------------------------
2293: Puissance d'un entier par un complexe
2294: --------------------------------------------------------------------------------
2295: */
2296:
2297: else if (((*s_objet_argument_1).type == CPL) &&
2298: ((*s_objet_argument_2).type == INT))
2299: {
2300: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
2301: {
2302: (*s_etat_processus).erreur_systeme =
2303: d_es_allocation_memoire;
2304: return;
2305: }
2306:
2307: f77puissanceic_(&((*((integer8 *) (*s_objet_argument_2).objet))),
2308: &((*((struct_complexe16 *) (*s_objet_argument_1).objet))),
2309: &((*((struct_complexe16 *) (*s_objet_resultat).objet))));
2310: }
2311:
2312: /*
2313: --------------------------------------------------------------------------------
2314: Puissance d'un réel par un entier
2315: --------------------------------------------------------------------------------
2316: */
2317:
2318: else if (((*s_objet_argument_1).type == INT) &&
2319: ((*s_objet_argument_2).type == REL))
2320: {
2321: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
2322: {
2323: (*s_etat_processus).erreur_systeme =
2324: d_es_allocation_memoire;
2325: return;
2326: }
2327:
2328: if (((*((integer8 *) (*s_objet_argument_1).objet)) >>
2329: (8 * sizeof(integer4))) == 0)
2330: {
2331: f77puissanceri_(&((*((real8 *) (*s_objet_argument_2).objet))),
2332: &((*((integer8 *) (*s_objet_argument_1).objet))),
2333: &((*((real8 *) (*s_objet_resultat).objet))), &troncature);
2334:
2335: if (troncature != 0)
2336: {
2337: liberation(s_etat_processus, s_objet_argument_1);
2338: liberation(s_etat_processus, s_objet_argument_2);
2339: liberation(s_etat_processus, s_objet_resultat);
2340:
2341: (*s_etat_processus).exception = d_ep_overflow;
2342: return;
2343: }
2344: }
2345: else
2346: {
2347: exposant = (real8) (*((integer8 *) (*s_objet_argument_1).objet));
2348:
2349: f77puissancerr_(&((*((real8 *) (*s_objet_argument_2).objet))),
2350: &exposant, &((*((real8 *) (*s_objet_resultat).objet))));
2351: }
2352: }
2353:
2354: /*
2355: --------------------------------------------------------------------------------
2356: Puissance d'un réel par un réel
2357: --------------------------------------------------------------------------------
2358: */
2359:
2360: else if (((*s_objet_argument_1).type == REL) &&
2361: ((*s_objet_argument_2).type == REL))
2362: {
2363: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
2364: {
2365: (*s_etat_processus).erreur_systeme =
2366: d_es_allocation_memoire;
2367: return;
2368: }
2369:
2370: f77puissancerr_(&((*((real8 *) (*s_objet_argument_2).objet))),
2371: &((*((real8 *) (*s_objet_argument_1).objet))),
2372: &((*((real8 *) (*s_objet_resultat).objet))));
2373: }
2374:
2375: /*
2376: --------------------------------------------------------------------------------
2377: Puissance d'un réel par un complexe
2378: --------------------------------------------------------------------------------
2379: */
2380:
2381: else if (((*s_objet_argument_1).type == CPL) &&
2382: ((*s_objet_argument_2).type == REL))
2383: {
2384: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
2385: {
2386: (*s_etat_processus).erreur_systeme =
2387: d_es_allocation_memoire;
2388: return;
2389: }
2390:
2391: f77puissancerc_(&((*((real8 *) (*s_objet_argument_2).objet))),
2392: &((*((struct_complexe16 *) (*s_objet_argument_1).objet))),
2393: &((*((struct_complexe16 *) (*s_objet_resultat).objet))));
2394: }
2395:
2396: /*
2397: --------------------------------------------------------------------------------
2398: Puissance d'un complexe par un entier
2399: --------------------------------------------------------------------------------
2400: */
2401:
2402: else if (((*s_objet_argument_1).type == INT) &&
2403: ((*s_objet_argument_2).type == CPL))
2404: {
2405: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
2406: {
2407: (*s_etat_processus).erreur_systeme =
2408: d_es_allocation_memoire;
2409: return;
2410: }
2411:
2412: if (((*((integer8 *) (*s_objet_argument_1).objet)) >>
2413: (8 * sizeof(integer4))) == 0)
2414: {
2415: f77puissanceci_(&((*((struct_complexe16 *) (*s_objet_argument_2)
2416: .objet))), &((*((integer8 *) (*s_objet_argument_1).objet))),
2417: &((*((struct_complexe16 *) (*s_objet_resultat).objet))),
2418: &troncature);
2419:
2420: if (troncature != 0)
2421: {
2422: liberation(s_etat_processus, s_objet_argument_1);
2423: liberation(s_etat_processus, s_objet_argument_2);
2424: liberation(s_etat_processus, s_objet_resultat);
2425:
2426: (*s_etat_processus).exception = d_ep_overflow;
2427: return;
2428: }
2429: }
2430: else
2431: {
2432: exposant = (real8) (*((integer8 *) (*s_objet_argument_1).objet));
2433:
2434: f77puissancecr_(&((*((complex16 *) (*s_objet_argument_2).objet))),
2435: &exposant, &((*((complex16 *) (*s_objet_resultat).objet))));
2436: }
2437: }
2438:
2439: /*
2440: --------------------------------------------------------------------------------
2441: Puissance d'un complexe par un réel
2442: --------------------------------------------------------------------------------
2443: */
2444:
2445: else if (((*s_objet_argument_1).type == REL) &&
2446: ((*s_objet_argument_2).type == CPL))
2447: {
2448: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
2449: {
2450: (*s_etat_processus).erreur_systeme =
2451: d_es_allocation_memoire;
2452: return;
2453: }
2454:
2455: f77puissancecr_(&((*((struct_complexe16 *) (*s_objet_argument_2)
2456: .objet))), &((*((real8 *) (*s_objet_argument_1).objet))),
2457: &((*((struct_complexe16 *) (*s_objet_resultat).objet))));
2458: }
2459:
2460: /*
2461: --------------------------------------------------------------------------------
2462: Puissance d'un complexe par un complexe
2463: --------------------------------------------------------------------------------
2464: */
2465:
2466: else if (((*s_objet_argument_1).type == CPL) &&
2467: ((*s_objet_argument_2).type == CPL))
2468: {
2469: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
2470: {
2471: (*s_etat_processus).erreur_systeme =
2472: d_es_allocation_memoire;
2473: return;
2474: }
2475:
2476: f77puissancecc_(&((*((struct_complexe16 *)
2477: (*s_objet_argument_2).objet))),
2478: &((*((struct_complexe16 *) (*s_objet_argument_1).objet))),
2479: &((*((struct_complexe16 *) (*s_objet_resultat).objet))));
2480: }
2481:
2482: /*
2483: --------------------------------------------------------------------------------
2484: Puissance mettant en oeuvre un nom ou une expression algébrique
2485: --------------------------------------------------------------------------------
2486: */
2487: /*
2488: * Nom ou valeur numérique / Nom ou valeur numérique
2489: */
2490:
2491: else if ((((*s_objet_argument_1).type == NOM) &&
2492: (((*s_objet_argument_2).type == NOM) ||
2493: ((*s_objet_argument_2).type == INT) ||
2494: ((*s_objet_argument_2).type == REL) ||
2495: ((*s_objet_argument_2).type == CPL))) ||
2496: (((*s_objet_argument_2).type == NOM) &&
2497: (((*s_objet_argument_1).type == INT) ||
2498: ((*s_objet_argument_1).type == REL) ||
2499: ((*s_objet_argument_1).type == CPL))))
2500: {
2501: drapeau = d_vrai;
2502:
2503: if ((*s_objet_argument_2).type == NOM)
2504: {
2505: if ((*s_objet_argument_1).type == INT)
2506: {
2507: if ((*((integer8 *) (*s_objet_argument_1).objet)) == 1)
2508: {
2509: drapeau = d_faux;
2510:
2511: s_objet_resultat = s_objet_argument_2;
2512: s_objet_argument_2 = NULL;
2513: }
2514: }
2515: else if ((*s_objet_argument_1).type == REL)
2516: {
2517: if ((*((real8 *) (*s_objet_argument_1).objet)) == 1)
2518: {
2519: drapeau = d_faux;
2520:
2521: s_objet_resultat = s_objet_argument_2;
2522: s_objet_argument_2 = NULL;
2523: }
2524: }
2525: else if ((*s_objet_argument_1).type == CPL)
2526: {
2527: if (((*((complex16 *) (*s_objet_argument_1).objet))
2528: .partie_reelle == 1) && ((*((complex16 *)
2529: (*s_objet_argument_1).objet)).partie_imaginaire == 0))
2530: {
2531: drapeau = d_faux;
2532:
2533: s_objet_resultat = s_objet_argument_2;
2534: s_objet_argument_2 = NULL;
2535: }
2536: }
2537: }
2538:
2539: if (drapeau == d_vrai)
2540: {
2541: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
2542: == NULL)
2543: {
2544: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2545: return;
2546: }
2547:
2548: if (((*s_objet_resultat).objet =
2549: allocation_maillon(s_etat_processus)) == NULL)
2550: {
2551: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2552: return;
2553: }
2554:
2555: l_element_courant = (*s_objet_resultat).objet;
2556:
2557: if (((*l_element_courant).donnee = allocation(s_etat_processus,
2558: FCT)) == NULL)
2559: {
2560: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2561: return;
2562: }
2563:
2564: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2565: .nombre_arguments = 0;
2566: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2567: .fonction = instruction_vers_niveau_superieur;
2568:
2569: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2570: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
2571: {
2572: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2573: return;
2574: }
2575:
2576: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2577: .nom_fonction, "<<");
2578:
2579: if (((*l_element_courant).suivant =
2580: allocation_maillon(s_etat_processus)) == NULL)
2581: {
2582: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2583: return;
2584: }
2585:
2586: l_element_courant = (*l_element_courant).suivant;
2587: (*l_element_courant).donnee = s_objet_argument_2;
2588:
2589: if (((*l_element_courant).suivant =
2590: allocation_maillon(s_etat_processus)) == NULL)
2591: {
2592: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2593: return;
2594: }
2595:
2596: l_element_courant = (*l_element_courant).suivant;
2597: (*l_element_courant).donnee = s_objet_argument_1;
2598:
2599: if (((*l_element_courant).suivant =
2600: allocation_maillon(s_etat_processus)) == NULL)
2601: {
2602: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2603: return;
2604: }
2605:
2606: l_element_courant = (*l_element_courant).suivant;
2607:
2608: if (((*l_element_courant).donnee = allocation(s_etat_processus,
2609: FCT)) == NULL)
2610: {
2611: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2612: return;
2613: }
2614:
2615: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2616: .nombre_arguments = 0;
2617: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2618: .fonction = instruction_puissance;
2619:
2620: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2621: .nom_fonction = malloc(2 * sizeof(unsigned char))) == NULL)
2622: {
2623: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2624: return;
2625: }
2626:
2627: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2628: .nom_fonction, "^");
2629:
2630: if (((*l_element_courant).suivant =
2631: allocation_maillon(s_etat_processus)) == NULL)
2632: {
2633: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2634: return;
2635: }
2636:
2637: l_element_courant = (*l_element_courant).suivant;
2638:
2639: if (((*l_element_courant).donnee = allocation(s_etat_processus,
2640: FCT)) == NULL)
2641: {
2642: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2643: return;
2644: }
2645:
2646: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2647: .nombre_arguments = 0;
2648: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2649: .fonction = instruction_vers_niveau_inferieur;
2650:
2651: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2652: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
2653: {
2654: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2655: return;
2656: }
2657:
2658: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2659: .nom_fonction, ">>");
2660:
2661: (*l_element_courant).suivant = NULL;
2662:
2663: s_objet_argument_1 = NULL;
2664: s_objet_argument_2 = NULL;
2665: }
2666: }
2667:
2668: /*
2669: * Nom ou valeur numérique / Expression
2670: */
2671:
2672: else if ((((*s_objet_argument_1).type == ALG) ||
2673: ((*s_objet_argument_1).type == RPN)) &&
2674: (((*s_objet_argument_2).type == NOM) ||
2675: ((*s_objet_argument_2).type == INT) ||
2676: ((*s_objet_argument_2).type == REL) ||
2677: ((*s_objet_argument_2).type == CPL)))
2678: {
2679: nombre_elements = 0;
2680: l_element_courant = (struct_liste_chainee *)
2681: (*s_objet_argument_1).objet;
2682:
2683: while(l_element_courant != NULL)
2684: {
2685: nombre_elements++;
2686: l_element_courant = (*l_element_courant).suivant;
2687: }
2688:
2689: if (nombre_elements == 2)
2690: {
2691: liberation(s_etat_processus, s_objet_argument_1);
2692: liberation(s_etat_processus, s_objet_argument_2);
2693:
2694: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
2695: return;
2696: }
2697:
2698: if ((s_objet_resultat = copie_objet(s_etat_processus,
2699: s_objet_argument_1, 'N')) == NULL)
2700: {
2701: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2702: return;
2703: }
2704:
2705: l_element_courant = (struct_liste_chainee *)
2706: (*s_objet_resultat).objet;
2707: l_element_precedent = l_element_courant;
2708: l_element_courant = (*l_element_courant).suivant;
2709:
2710: if (((*l_element_precedent).suivant =
2711: allocation_maillon(s_etat_processus)) == NULL)
2712: {
2713: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2714: return;
2715: }
2716:
2717: (*(*l_element_precedent).suivant).donnee = s_objet_argument_2;
2718: (*(*l_element_precedent).suivant).suivant = l_element_courant;
2719:
2720: while((*l_element_courant).suivant != NULL)
2721: {
2722: l_element_precedent = l_element_courant;
2723: l_element_courant = (*l_element_courant).suivant;
2724: }
2725:
2726: if (((*l_element_precedent).suivant =
2727: allocation_maillon(s_etat_processus)) == NULL)
2728: {
2729: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2730: return;
2731: }
2732:
2733: if (((*(*l_element_precedent).suivant).donnee =
2734: allocation(s_etat_processus, FCT)) == NULL)
2735: {
2736: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2737: return;
2738: }
2739:
2740: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
2741: .donnee).objet)).nombre_arguments = 0;
2742: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
2743: .donnee).objet)).fonction = instruction_puissance;
2744:
2745: if (((*((struct_fonction *) (*(*(*l_element_precedent)
2746: .suivant).donnee).objet)).nom_fonction =
2747: malloc(2 * sizeof(unsigned char))) == NULL)
2748: {
2749: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2750: return;
2751: }
2752:
2753: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
2754: .suivant).donnee).objet)).nom_fonction, "^");
2755:
2756: (*(*l_element_precedent).suivant).suivant = l_element_courant;
2757:
2758: s_objet_argument_2 = NULL;
2759: }
2760:
2761: /*
2762: * Expression / Nom ou valeur numérique
2763: */
2764:
2765: else if ((((*s_objet_argument_1).type == NOM) ||
2766: ((*s_objet_argument_1).type == INT) ||
2767: ((*s_objet_argument_1).type == REL) ||
2768: ((*s_objet_argument_1).type == CPL)) &&
2769: (((*s_objet_argument_2).type == ALG) ||
2770: ((*s_objet_argument_2).type == RPN)))
2771: {
2772: drapeau = d_vrai;
2773:
2774: nombre_elements = 0;
2775: l_element_courant = (struct_liste_chainee *)
2776: (*s_objet_argument_2).objet;
2777:
2778: while(l_element_courant != NULL)
2779: {
2780: nombre_elements++;
2781: l_element_courant = (*l_element_courant).suivant;
2782: }
2783:
2784: if (nombre_elements == 2)
2785: {
2786: liberation(s_etat_processus, s_objet_argument_1);
2787: liberation(s_etat_processus, s_objet_argument_2);
2788:
2789: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
2790: return;
2791: }
2792:
2793: if ((*s_objet_argument_1).type == INT)
2794: {
2795: if ((*((integer8 *) (*s_objet_argument_1).objet)) == 1)
2796: {
2797: drapeau = d_faux;
2798:
2799: s_objet_resultat = s_objet_argument_2;
2800: s_objet_argument_2 = NULL;
2801: }
2802: }
2803: else if ((*s_objet_argument_1).type == REL)
2804: {
2805: if ((*((real8 *) (*s_objet_argument_1).objet)) == 1)
2806: {
2807: drapeau = d_faux;
2808:
2809: s_objet_resultat = s_objet_argument_2;
2810: s_objet_argument_2 = NULL;
2811: }
2812: }
2813: else if ((*s_objet_argument_1).type == CPL)
2814: {
2815: if (((*((complex16 *) (*s_objet_argument_1).objet))
2816: .partie_reelle == 1) && ((*((complex16 *)
2817: (*s_objet_argument_1).objet)).partie_imaginaire == 0))
2818: {
2819: drapeau = d_faux;
2820:
2821: s_objet_resultat = s_objet_argument_2;
2822: s_objet_argument_2 = NULL;
2823: }
2824: }
2825:
2826: if (drapeau == d_vrai)
2827: {
2828: if ((s_objet_resultat = copie_objet(s_etat_processus,
2829: s_objet_argument_2, 'N')) == NULL)
2830: {
2831: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2832: return;
2833: }
2834:
2835: l_element_courant = (struct_liste_chainee *)
2836: (*s_objet_resultat).objet;
2837: l_element_precedent = l_element_courant;
2838:
2839: while((*l_element_courant).suivant != NULL)
2840: {
2841: l_element_precedent = l_element_courant;
2842: l_element_courant = (*l_element_courant).suivant;
2843: }
2844:
2845: if (((*l_element_precedent).suivant =
2846: allocation_maillon(s_etat_processus)) == NULL)
2847: {
2848: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2849: return;
2850: }
2851:
2852: (*(*l_element_precedent).suivant).donnee = s_objet_argument_1;
2853: l_element_precedent = (*l_element_precedent).suivant;
2854:
2855: if (((*l_element_precedent).suivant =
2856: allocation_maillon(s_etat_processus)) == NULL)
2857: {
2858: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2859: return;
2860: }
2861:
2862: if (((*(*l_element_precedent).suivant).donnee =
2863: allocation(s_etat_processus, FCT)) == NULL)
2864: {
2865: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2866: return;
2867: }
2868:
2869: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
2870: .donnee).objet)).nombre_arguments = 0;
2871: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
2872: .donnee).objet)).fonction = instruction_puissance;
2873:
2874: if (((*((struct_fonction *) (*(*(*l_element_precedent)
2875: .suivant).donnee).objet)).nom_fonction =
2876: malloc(2 * sizeof(unsigned char))) == NULL)
2877: {
2878: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2879: return;
2880: }
2881:
2882: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
2883: .suivant).donnee).objet)).nom_fonction, "^");
2884:
2885: (*(*l_element_precedent).suivant).suivant = l_element_courant;
2886:
2887: s_objet_argument_1 = NULL;
2888: }
2889: }
2890:
2891: /*
2892: * Expression / Expression
2893: */
2894:
2895: else if ((((*s_objet_argument_1).type == ALG) &&
2896: ((*s_objet_argument_2).type == ALG)) ||
2897: (((*s_objet_argument_1).type == RPN) &&
2898: ((*s_objet_argument_2).type == RPN)))
2899: {
2900: nombre_elements = 0;
2901: l_element_courant = (struct_liste_chainee *)
2902: (*s_objet_argument_1).objet;
2903:
2904: while(l_element_courant != NULL)
2905: {
2906: nombre_elements++;
2907: l_element_courant = (*l_element_courant).suivant;
2908: }
2909:
2910: if (nombre_elements == 2)
2911: {
2912: liberation(s_etat_processus, s_objet_argument_1);
2913: liberation(s_etat_processus, s_objet_argument_2);
2914:
2915: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
2916: return;
2917: }
2918:
2919: nombre_elements = 0;
2920: l_element_courant = (struct_liste_chainee *)
2921: (*s_objet_argument_2).objet;
2922:
2923: while(l_element_courant != NULL)
2924: {
2925: nombre_elements++;
2926: l_element_courant = (*l_element_courant).suivant;
2927: }
2928:
2929: if (nombre_elements == 2)
2930: {
2931: liberation(s_etat_processus, s_objet_argument_1);
2932: liberation(s_etat_processus, s_objet_argument_2);
2933:
2934: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
2935: return;
2936: }
2937:
2938: if ((s_copie_argument_1 = copie_objet(s_etat_processus,
2939: s_objet_argument_1, 'N')) == NULL)
2940: {
2941: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2942: return;
2943: }
2944:
2945: if ((s_copie_argument_2 = copie_objet(s_etat_processus,
2946: s_objet_argument_2, 'N')) == NULL)
2947: {
2948: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2949: return;
2950: }
2951:
2952: l_element_courant = (struct_liste_chainee *)
2953: (*s_copie_argument_1).objet;
2954: (*s_copie_argument_1).objet = (void *) (*((struct_liste_chainee *)
2955: (*s_copie_argument_1).objet)).suivant;
2956:
2957: liberation(s_etat_processus, (*l_element_courant).donnee);
2958: free(l_element_courant);
2959:
2960: l_element_courant = (struct_liste_chainee *)
2961: (*s_copie_argument_2).objet;
2962: l_element_precedent = l_element_courant;
2963: s_objet_resultat = s_copie_argument_2;
2964:
2965: while((*l_element_courant).suivant != NULL)
2966: {
2967: l_element_precedent = l_element_courant;
2968: l_element_courant = (*l_element_courant).suivant;
2969: }
2970:
2971: liberation(s_etat_processus, (*l_element_courant).donnee);
2972: free(l_element_courant);
2973:
2974: (*l_element_precedent).suivant = (struct_liste_chainee *)
2975: (*s_copie_argument_1).objet;
2976: free(s_copie_argument_1);
2977:
2978: l_element_courant = (*l_element_precedent).suivant;
2979: while((*l_element_courant).suivant != NULL)
2980: {
2981: l_element_precedent = l_element_courant;
2982: l_element_courant = (*l_element_courant).suivant;
2983: }
2984:
2985: if (((*l_element_precedent).suivant =
2986: allocation_maillon(s_etat_processus)) == NULL)
2987: {
2988: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2989: return;
2990: }
2991:
2992: (*(*l_element_precedent).suivant).suivant = l_element_courant;
2993: l_element_courant = (*l_element_precedent).suivant;
2994:
2995: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
2996: == NULL)
2997: {
2998: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2999: return;
3000: }
3001:
3002: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3003: .nombre_arguments = 0;
3004: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3005: .fonction = instruction_puissance;
3006:
3007: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3008: .nom_fonction = malloc(2 * sizeof(unsigned char))) == NULL)
3009: {
3010: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3011: return;
3012: }
3013:
3014: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3015: .nom_fonction, "^");
3016: }
3017:
3018: /*
3019: --------------------------------------------------------------------------------
3020: Puissance impossible
3021: --------------------------------------------------------------------------------
3022: */
3023:
3024: else
3025: {
3026: liberation(s_etat_processus, s_objet_argument_1);
3027: liberation(s_etat_processus, s_objet_argument_2);
3028:
3029: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
3030: return;
3031: }
3032:
3033: liberation(s_etat_processus, s_objet_argument_1);
3034: liberation(s_etat_processus, s_objet_argument_2);
3035:
3036: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
3037: s_objet_resultat) == d_erreur)
3038: {
3039: return;
3040: }
3041:
3042: return;
3043: }
3044:
3045:
3046: /*
3047: ================================================================================
3048: Fonction 'purge'
3049: ================================================================================
3050: Entrées : structure processus
3051: -------------------------------------------------------------------------------
3052: Sorties :
3053: --------------------------------------------------------------------------------
3054: Effets de bord : néant
3055: ================================================================================
3056: */
3057:
3058: void
3059: instruction_purge(struct_processus *s_etat_processus)
3060: {
3061: struct_liste_chainee *l_element_courant;
3062:
3063: struct_objet *s_objet;
3064:
3065: (*s_etat_processus).erreur_execution = d_ex;
3066:
3067: if ((*s_etat_processus).affichage_arguments == 'Y')
3068: {
3069: printf("\n PURGE ");
3070:
3071: if ((*s_etat_processus).langue == 'F')
3072: {
3073: printf("(effacement d'une variable globale)\n\n");
3074: }
3075: else
3076: {
3077: printf("(purge a global variable)\n\n");
3078: }
3079:
3080: printf(" 1: %s, %s\n", d_NOM, d_LST);
3081:
3082: return;
3083: }
3084: else if ((*s_etat_processus).test_instruction == 'Y')
3085: {
3086: (*s_etat_processus).nombre_arguments = -1;
3087: return;
3088: }
3089:
3090: if (test_cfsf(s_etat_processus, 31) == d_vrai)
3091: {
3092: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
3093: {
3094: return;
3095: }
3096: }
3097:
3098: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
3099: &s_objet) == d_erreur)
3100: {
3101: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
3102: return;
3103: }
3104:
3105: if ((*s_objet).type == NOM)
3106: {
3107: if (recherche_variable(s_etat_processus, ((*((struct_nom *)
3108: (*s_objet).objet)).nom)) == d_faux)
3109: {
3110: liberation(s_etat_processus, s_objet);
3111:
3112: (*s_etat_processus).erreur_systeme = d_es;
3113: (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
3114: return;
3115: }
3116:
3117: if ((*s_etat_processus).s_liste_variables[(*s_etat_processus)
3118: .position_variable_courante].objet == NULL)
3119: {
3120: liberation(s_etat_processus, s_objet);
3121:
3122: (*s_etat_processus).erreur_execution = d_ex_variable_partagee;
3123: return;
3124: }
3125:
3126: if (retrait_variable(s_etat_processus, (*((struct_nom *)
3127: (*s_objet).objet)).nom, 'G') == d_erreur)
3128: {
3129: return;
3130: }
3131: }
3132: else if ((*s_objet).type == LST)
3133: {
3134: l_element_courant = (struct_liste_chainee *) (*s_objet).objet;
3135:
3136: while(l_element_courant != NULL)
3137: {
3138: if ((*(*l_element_courant).donnee).type != NOM)
3139: {
3140: liberation(s_etat_processus, s_objet);
3141:
3142: (*s_etat_processus).erreur_execution = d_ex_nom_invalide;
3143: return;
3144: }
3145:
3146: if (recherche_variable(s_etat_processus, (*((struct_nom *)
3147: (*(*l_element_courant).donnee).objet)).nom) == d_faux)
3148: {
3149: liberation(s_etat_processus, s_objet);
3150:
3151: (*s_etat_processus).erreur_systeme = d_es;
3152: (*s_etat_processus).erreur_execution =
3153: d_ex_variable_non_definie;
3154: return;
3155: }
3156:
3157: if ((*s_etat_processus).s_liste_variables[(*s_etat_processus)
3158: .position_variable_courante].objet == NULL)
3159: {
3160: liberation(s_etat_processus, s_objet);
3161:
3162: (*s_etat_processus).erreur_execution = d_ex_variable_partagee;
3163: return;
3164: }
3165:
3166: if (retrait_variable(s_etat_processus, (*((struct_nom *)
3167: (*(*l_element_courant).donnee).objet)).nom, 'G')
3168: == d_erreur)
3169: {
3170: return;
3171: }
3172:
3173: l_element_courant = (*l_element_courant).suivant;
3174: }
3175: }
3176: else
3177: {
3178: liberation(s_etat_processus, s_objet);
3179:
3180: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
3181: return;
3182: }
3183:
3184: liberation(s_etat_processus, s_objet);
3185:
3186: return;
3187: }
3188:
3189:
3190: /*
3191: ================================================================================
3192: Fonction 'pi'
3193: ================================================================================
3194: Entrées : pointeur sur une struct_processus
3195: --------------------------------------------------------------------------------
3196: Sorties :
3197: --------------------------------------------------------------------------------
3198: Effets de bord : néant
3199: ================================================================================
3200: */
3201:
3202: void
3203: instruction_pi(struct_processus *s_etat_processus)
3204: {
3205: struct_objet *s_objet;
3206:
3207: (*s_etat_processus).erreur_execution = d_ex;
3208:
3209: if ((*s_etat_processus).affichage_arguments == 'Y')
3210: {
3211: printf("\n PI ");
3212:
3213: if ((*s_etat_processus).langue == 'F')
3214: {
1.3 bertrand 3215: printf("(constante PI)\n\n");
1.1 bertrand 3216: }
3217: else
3218: {
3219: printf("(PI constant)\n\n");
3220: }
3221:
3222: printf("-> 1: %s, %s\n", d_REL, d_NOM);
3223:
3224: return;
3225: }
3226: else if ((*s_etat_processus).test_instruction == 'Y')
3227: {
3228: (*s_etat_processus).constante_symbolique = 'Y';
3229: (*s_etat_processus).nombre_arguments = -1;
3230: return;
3231: }
3232:
3233: /* Indicateur 35 armé => évaluation symbolique */
3234: if (test_cfsf(s_etat_processus, 35) == d_vrai)
3235: {
3236: if ((s_objet = allocation(s_etat_processus, NOM)) == NULL)
3237: {
3238: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3239: return;
3240: }
3241:
3242: if (((*((struct_nom *) (*s_objet).objet)).nom =
3243: malloc(3 * sizeof(unsigned char))) == NULL)
3244: {
3245: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3246: return;
3247: }
3248:
3249: strcpy((*((struct_nom *) (*s_objet).objet)).nom, "PI");
3250: (*((struct_nom *) (*s_objet).objet)).symbole = d_faux;
3251: }
3252: else
3253: {
3254: if ((s_objet = allocation(s_etat_processus, REL)) == NULL)
3255: {
3256: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3257: return;
3258: }
3259:
3260: (*((real8 *) (*s_objet).objet)) = 4 * atan((real8) 1);
3261: }
3262:
3263: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
3264: s_objet) == d_erreur)
3265: {
3266: return;
3267: }
3268:
3269: return;
3270: }
3271:
3272:
3273: /*
3274: ================================================================================
3275: Fonction '%t'
3276: ================================================================================
3277: Entrées :
3278: --------------------------------------------------------------------------------
3279: Sorties :
3280: --------------------------------------------------------------------------------
3281: Effets de bord : néant
3282: ================================================================================
3283: */
3284:
3285: void
3286: instruction_pourcent_t(struct_processus *s_etat_processus)
3287: {
3288: struct_liste_chainee *l_element_courant;
3289: struct_liste_chainee *l_element_precedent;
3290:
3291: struct_objet *s_copie_argument_1;
3292: struct_objet *s_copie_argument_2;
3293: struct_objet *s_objet_argument_1;
3294: struct_objet *s_objet_argument_2;
3295: struct_objet *s_objet_resultat;
3296:
3297: unsigned long nombre_elements;
3298:
3299: (*s_etat_processus).erreur_execution = d_ex;
3300:
3301: if ((*s_etat_processus).affichage_arguments == 'Y')
3302: {
3303: printf("\n %%T ");
3304:
3305: if ((*s_etat_processus).langue == 'F')
3306: {
3307: printf("(pourcentage du total)\n\n");
3308: }
3309: else
3310: {
3311: printf("(percentage wrt total)\n\n");
3312: }
3313:
3314: printf(" 2: %s, %s\n", d_INT, d_REL);
3315: printf(" 1: %s, %s\n", d_INT, d_REL);
3316: printf("-> 1: %s\n\n", d_REL);
3317:
3318: printf(" 2: %s, %s, %s, %s\n", d_NOM, d_ALG, d_INT, d_REL);
3319: printf(" 1: %s, %s, %s, %s\n", d_NOM, d_ALG, d_INT, d_REL);
3320: printf("-> 1: %s\n\n", d_ALG);
3321:
3322: printf(" 2: %s, %s, %s, %s\n", d_RPN, d_NOM, d_INT, d_REL);
3323: printf(" 1: %s, %s, %s, %s\n", d_RPN, d_NOM, d_INT, d_REL);
3324: printf("-> 1: %s\n", d_RPN);
3325:
3326: return;
3327: }
3328: else if ((*s_etat_processus).test_instruction == 'Y')
3329: {
3330: (*s_etat_processus).nombre_arguments = -1;
3331: return;
3332: }
3333:
3334: if (test_cfsf(s_etat_processus, 31) == d_vrai)
3335: {
3336: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
3337: {
3338: return;
3339: }
3340: }
3341:
3342: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
3343: &s_objet_argument_1) == d_erreur)
3344: {
3345: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
3346: return;
3347: }
3348:
3349: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
3350: &s_objet_argument_2) == d_erreur)
3351: {
3352: liberation(s_etat_processus, s_objet_argument_1);
3353:
3354: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
3355: return;
3356: }
3357:
3358: /*
3359: --------------------------------------------------------------------------------
3360: %T portant sur des valeurs numériques
3361: --------------------------------------------------------------------------------
3362: */
3363:
3364: if ((((*s_objet_argument_1).type == INT) ||
3365: ((*s_objet_argument_1).type == REL)) &&
3366: (((*s_objet_argument_2).type == INT) ||
3367: ((*s_objet_argument_2).type == REL)))
3368: {
3369: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
3370: {
3371: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3372: return;
3373: }
3374:
3375: if ((*s_objet_argument_1).type == INT)
3376: {
3377: if ((*s_objet_argument_2).type == INT)
3378: {
3379: (*((real8 *) (*s_objet_resultat).objet)) = 100 *
3380: (((real8) (*((integer8 *) (*s_objet_argument_1)
3381: .objet))) / ((real8) (*((integer8 *)
3382: (*s_objet_argument_2).objet))));
3383: }
3384: else
3385: {
3386: (*((real8 *) (*s_objet_resultat).objet)) = 100 *
3387: (((real8) (*((integer8 *) (*s_objet_argument_1)
3388: .objet))) / (*((real8 *)
3389: (*s_objet_argument_2).objet)));
3390: }
3391: }
3392: else
3393: {
3394: if ((*s_objet_argument_2).type == INT)
3395: {
3396: (*((real8 *) (*s_objet_resultat).objet)) = 100 *
3397: ((*((real8 *) (*s_objet_argument_1)
3398: .objet)) / ((real8) (*((integer8 *)
3399: (*s_objet_argument_2).objet))));
3400: }
3401: else
3402: {
3403: (*((real8 *) (*s_objet_resultat).objet)) = 100 *
3404: ((*((real8 *) (*s_objet_argument_1).objet)) /
3405: (*((real8 *) (*s_objet_argument_2).objet)));
3406: }
3407: }
3408: }
3409:
3410: /*
3411: --------------------------------------------------------------------------------
3412: %T entre des arguments complexes
3413: --------------------------------------------------------------------------------
3414: */
3415:
3416: /*
3417: * Nom ou valeur numérique / Nom ou valeur numérique
3418: */
3419:
3420: else if ((((*s_objet_argument_1).type == NOM) &&
3421: (((*s_objet_argument_2).type == NOM) ||
3422: ((*s_objet_argument_2).type == INT) ||
3423: ((*s_objet_argument_2).type == REL))) ||
3424: (((*s_objet_argument_2).type == NOM) &&
3425: (((*s_objet_argument_1).type == INT) ||
3426: ((*s_objet_argument_1).type == REL))))
3427: {
3428: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
3429: {
3430: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3431: return;
3432: }
3433:
3434: if (((*s_objet_resultat).objet =
3435: allocation_maillon(s_etat_processus)) == NULL)
3436: {
3437: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3438: return;
3439: }
3440:
3441: l_element_courant = (*s_objet_resultat).objet;
3442:
3443: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
3444: == NULL)
3445: {
3446: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3447: return;
3448: }
3449:
3450: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3451: .nombre_arguments = 0;
3452: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3453: .fonction = instruction_vers_niveau_superieur;
3454:
3455: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3456: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
3457: {
3458: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3459: return;
3460: }
3461:
3462: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3463: .nom_fonction, "<<");
3464:
3465: if (((*l_element_courant).suivant =
3466: allocation_maillon(s_etat_processus)) == NULL)
3467: {
3468: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3469: return;
3470: }
3471:
3472: l_element_courant = (*l_element_courant).suivant;
3473: (*l_element_courant).donnee = s_objet_argument_2;
3474:
3475: if (((*l_element_courant).suivant =
3476: allocation_maillon(s_etat_processus)) == NULL)
3477: {
3478: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3479: return;
3480: }
3481:
3482: l_element_courant = (*l_element_courant).suivant;
3483: (*l_element_courant).donnee = s_objet_argument_1;
3484:
3485: if (((*l_element_courant).suivant =
3486: allocation_maillon(s_etat_processus)) == NULL)
3487: {
3488: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3489: return;
3490: }
3491:
3492: l_element_courant = (*l_element_courant).suivant;
3493:
3494: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
3495: == NULL)
3496: {
3497: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3498: return;
3499: }
3500:
3501: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3502: .nombre_arguments = 2;
3503: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3504: .fonction = instruction_pourcent_t;
3505:
3506: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3507: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
3508: {
3509: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3510: return;
3511: }
3512:
3513: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3514: .nom_fonction, "%T");
3515:
3516: if (((*l_element_courant).suivant =
3517: allocation_maillon(s_etat_processus)) == NULL)
3518: {
3519: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3520: return;
3521: }
3522:
3523: l_element_courant = (*l_element_courant).suivant;
3524:
3525: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
3526: == NULL)
3527: {
3528: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3529: return;
3530: }
3531:
3532: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3533: .nombre_arguments = 0;
3534: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3535: .fonction = instruction_vers_niveau_inferieur;
3536:
3537: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3538: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
3539: {
3540: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3541: return;
3542: }
3543:
3544: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3545: .nom_fonction, ">>");
3546:
3547: (*l_element_courant).suivant = NULL;
3548:
3549: s_objet_argument_1 = NULL;
3550: s_objet_argument_2 = NULL;
3551: }
3552:
3553: /*
3554: * Nom ou valeur numérique / Expression
3555: */
3556:
3557: else if (((((*s_objet_argument_1).type == ALG) ||
3558: ((*s_objet_argument_1).type == RPN))) &&
3559: (((*s_objet_argument_2).type == NOM) ||
3560: ((*s_objet_argument_2).type == INT) ||
3561: ((*s_objet_argument_2).type == REL)))
3562: {
3563: nombre_elements = 0;
3564: l_element_courant = (struct_liste_chainee *)
3565: (*s_objet_argument_1).objet;
3566:
3567: while(l_element_courant != NULL)
3568: {
3569: nombre_elements++;
3570: l_element_courant = (*l_element_courant).suivant;
3571: }
3572:
3573: if (nombre_elements == 2)
3574: {
3575: liberation(s_etat_processus, s_objet_argument_1);
3576: liberation(s_etat_processus, s_objet_argument_2);
3577:
3578: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
3579: return;
3580: }
3581:
3582: if ((s_objet_resultat = copie_objet(s_etat_processus,
3583: s_objet_argument_1, 'N')) == NULL)
3584: {
3585: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3586: return;
3587: }
3588:
3589: l_element_courant = (struct_liste_chainee *)
3590: (*s_objet_resultat).objet;
3591: l_element_precedent = l_element_courant;
3592: l_element_courant = (*l_element_courant).suivant;
3593:
3594: if (((*l_element_precedent).suivant =
3595: allocation_maillon(s_etat_processus)) == NULL)
3596: {
3597: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3598: return;
3599: }
3600:
3601: (*(*l_element_precedent).suivant).donnee = s_objet_argument_2;
3602: (*(*l_element_precedent).suivant).suivant = l_element_courant;
3603:
3604: while((*l_element_courant).suivant != NULL)
3605: {
3606: l_element_precedent = l_element_courant;
3607: l_element_courant = (*l_element_courant).suivant;
3608: }
3609:
3610: if (((*l_element_precedent).suivant =
3611: allocation_maillon(s_etat_processus)) == NULL)
3612: {
3613: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3614: return;
3615: }
3616:
3617: if (((*(*l_element_precedent).suivant).donnee =
3618: allocation(s_etat_processus, FCT)) == NULL)
3619: {
3620: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3621: return;
3622: }
3623:
3624: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
3625: .donnee).objet)).nombre_arguments = 2;
3626: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
3627: .donnee).objet)).fonction = instruction_pourcent_t;
3628:
3629: if (((*((struct_fonction *) (*(*(*l_element_precedent)
3630: .suivant).donnee).objet)).nom_fonction =
3631: malloc(3 * sizeof(unsigned char))) == NULL)
3632: {
3633: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3634: return;
3635: }
3636:
3637: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
3638: .suivant).donnee).objet)).nom_fonction, "%T");
3639:
3640: (*(*l_element_precedent).suivant).suivant = l_element_courant;
3641:
3642: s_objet_argument_2 = NULL;
3643: }
3644:
3645: /*
3646: * Expression / Nom ou valeur numérique
3647: */
3648:
3649: else if ((((*s_objet_argument_1).type == NOM) ||
3650: ((*s_objet_argument_1).type == INT) ||
3651: ((*s_objet_argument_1).type == REL)) &&
3652: ((((*s_objet_argument_2).type == ALG) ||
3653: ((*s_objet_argument_2).type == RPN))))
3654: {
3655: nombre_elements = 0;
3656: l_element_courant = (struct_liste_chainee *)
3657: (*s_objet_argument_2).objet;
3658:
3659: while(l_element_courant != NULL)
3660: {
3661: nombre_elements++;
3662: l_element_courant = (*l_element_courant).suivant;
3663: }
3664:
3665: if (nombre_elements == 2)
3666: {
3667: liberation(s_etat_processus, s_objet_argument_1);
3668: liberation(s_etat_processus, s_objet_argument_2);
3669:
3670: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
3671: return;
3672: }
3673:
3674: if ((s_objet_resultat = copie_objet(s_etat_processus,
3675: s_objet_argument_2, 'N')) == NULL)
3676: {
3677: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3678: return;
3679: }
3680:
3681: l_element_courant = (struct_liste_chainee *)
3682: (*s_objet_resultat).objet;
3683: l_element_precedent = l_element_courant;
3684:
3685: while((*l_element_courant).suivant != NULL)
3686: {
3687: l_element_precedent = l_element_courant;
3688: l_element_courant = (*l_element_courant).suivant;
3689: }
3690:
3691: if (((*l_element_precedent).suivant =
3692: allocation_maillon(s_etat_processus)) == NULL)
3693: {
3694: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3695: return;
3696: }
3697:
3698: (*(*l_element_precedent).suivant).donnee = s_objet_argument_1;
3699: l_element_precedent = (*l_element_precedent).suivant;
3700:
3701: if (((*l_element_precedent).suivant =
3702: allocation_maillon(s_etat_processus)) == NULL)
3703: {
3704: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3705: return;
3706: }
3707:
3708: if (((*(*l_element_precedent).suivant).donnee =
3709: allocation(s_etat_processus, FCT)) == NULL)
3710: {
3711: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3712: return;
3713: }
3714:
3715: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
3716: .donnee).objet)).nombre_arguments = 2;
3717: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
3718: .donnee).objet)).fonction = instruction_pourcent_t;
3719:
3720: if (((*((struct_fonction *) (*(*(*l_element_precedent)
3721: .suivant).donnee).objet)).nom_fonction =
3722: malloc(3 * sizeof(unsigned char))) == NULL)
3723: {
3724: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3725: return;
3726: }
3727:
3728: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
3729: .suivant).donnee).objet)).nom_fonction, "%T");
3730:
3731: (*(*l_element_precedent).suivant).suivant = l_element_courant;
3732:
3733: s_objet_argument_1 = NULL;
3734: }
3735:
3736: /*
3737: * Expression / Expression
3738: */
3739:
3740: else if ((((*s_objet_argument_1).type == ALG) &&
3741: ((*s_objet_argument_2).type == ALG)) ||
3742: (((*s_objet_argument_1).type == RPN) &&
3743: ((*s_objet_argument_2).type == RPN)))
3744: {
3745: nombre_elements = 0;
3746: l_element_courant = (struct_liste_chainee *)
3747: (*s_objet_argument_1).objet;
3748:
3749: while(l_element_courant != NULL)
3750: {
3751: nombre_elements++;
3752: l_element_courant = (*l_element_courant).suivant;
3753: }
3754:
3755: if (nombre_elements == 2)
3756: {
3757: liberation(s_etat_processus, s_objet_argument_1);
3758: liberation(s_etat_processus, s_objet_argument_2);
3759:
3760: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
3761: return;
3762: }
3763:
3764: nombre_elements = 0;
3765: l_element_courant = (struct_liste_chainee *)
3766: (*s_objet_argument_2).objet;
3767:
3768: while(l_element_courant != NULL)
3769: {
3770: nombre_elements++;
3771: l_element_courant = (*l_element_courant).suivant;
3772: }
3773:
3774: if (nombre_elements == 2)
3775: {
3776: liberation(s_etat_processus, s_objet_argument_1);
3777: liberation(s_etat_processus, s_objet_argument_2);
3778:
3779: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
3780: return;
3781: }
3782:
3783: if ((s_copie_argument_1 = copie_objet(s_etat_processus,
3784: s_objet_argument_1, 'N')) == NULL)
3785: {
3786: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3787: return;
3788: }
3789:
3790: if ((s_copie_argument_2 = copie_objet(s_etat_processus,
3791: s_objet_argument_2, 'N')) == NULL)
3792: {
3793: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3794: return;
3795: }
3796:
3797: l_element_courant = (struct_liste_chainee *)
3798: (*s_copie_argument_1).objet;
3799: (*s_copie_argument_1).objet = (void *) (*((struct_liste_chainee *)
3800: (*s_copie_argument_1).objet)).suivant;
3801:
3802: liberation(s_etat_processus, (*l_element_courant).donnee);
3803: free(l_element_courant);
3804:
3805: l_element_courant = (struct_liste_chainee *)
3806: (*s_copie_argument_2).objet;
3807: l_element_precedent = l_element_courant;
3808: s_objet_resultat = s_copie_argument_2;
3809:
3810: while((*l_element_courant).suivant != NULL)
3811: {
3812: l_element_precedent = l_element_courant;
3813: l_element_courant = (*l_element_courant).suivant;
3814: }
3815:
3816: liberation(s_etat_processus, (*l_element_courant).donnee);
3817: free(l_element_courant);
3818:
3819: (*l_element_precedent).suivant = (struct_liste_chainee *)
3820: (*s_copie_argument_1).objet;
3821: free(s_copie_argument_1);
3822:
3823: l_element_courant = (*l_element_precedent).suivant;
3824: while((*l_element_courant).suivant != NULL)
3825: {
3826: l_element_precedent = l_element_courant;
3827: l_element_courant = (*l_element_courant).suivant;
3828: }
3829:
3830: if (((*l_element_precedent).suivant =
3831: allocation_maillon(s_etat_processus)) == NULL)
3832: {
3833: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3834: return;
3835: }
3836:
3837: (*(*l_element_precedent).suivant).suivant = l_element_courant;
3838: l_element_courant = (*l_element_precedent).suivant;
3839:
3840: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
3841: == NULL)
3842: {
3843: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3844: return;
3845: }
3846:
3847: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3848: .nombre_arguments = 2;
3849: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3850: .fonction = instruction_pourcent_t;
3851:
3852: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3853: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
3854: {
3855: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3856: return;
3857: }
3858:
3859: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
3860: .nom_fonction, "%T");
3861: }
3862:
3863: /*
3864: --------------------------------------------------------------------------------
3865: Arguments incorrects
3866: --------------------------------------------------------------------------------
3867: */
3868:
3869: else
3870: {
3871: liberation(s_etat_processus, s_objet_argument_1);
3872: liberation(s_etat_processus, s_objet_argument_2);
3873:
3874: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
3875: return;
3876: }
3877:
3878: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
3879: s_objet_resultat) == d_erreur)
3880: {
3881: return;
3882: }
3883:
3884: liberation(s_etat_processus, s_objet_argument_1);
3885: liberation(s_etat_processus, s_objet_argument_2);
3886:
3887: return;
3888: }
3889:
3890: // 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