1: /*
2: ================================================================================
3: RPL/2 (R) version 4.1.10
4: Copyright (C) 1989-2012 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 'cycle'
29: ================================================================================
30: Entrées : structure processus
31: --------------------------------------------------------------------------------
32: Sorties :
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: void
39: instruction_cycle(struct_processus *s_etat_processus)
40: {
41: logical1 drapeau_presence_fin_boucle;
42: logical1 erreur;
43: logical1 presence_boucle;
44:
45: struct_liste_pile_systeme *l_element_pile_systeme;
46:
47: unsigned char *instruction_majuscule;
48: unsigned char *tampon;
49:
50: unsigned long niveau;
51:
52: void (*fonction)();
53:
54: (*s_etat_processus).erreur_execution = d_ex;
55:
56: if ((*s_etat_processus).affichage_arguments == 'Y')
57: {
58: printf("\n CYCLE ");
59:
60: if ((*s_etat_processus).langue == 'F')
61: {
62: printf("(structure de contrôle)\n\n");
63: printf(" Utilisation :\n\n");
64: }
65: else
66: {
67: printf("(control statement)\n\n");
68: printf(" Usage:\n\n");
69: }
70:
71: printf(" FOR (variable)\n");
72: printf(" ...\n");
73: printf(" CYCLE\n");
74: printf(" ...\n");
75: printf(" NEXT/STEP\n\n");
76:
77: printf(" FORALL (variable)\n");
78: printf(" ...\n");
79: printf(" CYCLE\n");
80: printf(" ...\n");
81: printf(" NEXT\n\n");
82:
83: printf(" START\n");
84: printf(" ...\n");
85: printf(" CYCLE\n");
86: printf(" ...\n");
87: printf(" NEXT/STEP\n");
88:
89: return;
90: }
91: else if ((*s_etat_processus).test_instruction == 'Y')
92: {
93: (*s_etat_processus).nombre_arguments = -1;
94: return;
95: }
96:
97: /*
98: * Test de la présence de l'instruction CYCLE dans une boucle définie
99: */
100:
101: l_element_pile_systeme = (*s_etat_processus).l_base_pile_systeme;
102: presence_boucle = d_faux;
103:
104: while((l_element_pile_systeme != NULL) && (presence_boucle == d_faux))
105: {
106: if (((*l_element_pile_systeme).type_cloture == 'S') ||
107: ((*l_element_pile_systeme).type_cloture == 'F') ||
108: ((*l_element_pile_systeme).type_cloture == 'A'))
109: {
110: presence_boucle = d_vrai;
111: }
112:
113: l_element_pile_systeme = (*l_element_pile_systeme).suivant;
114: }
115:
116: if (presence_boucle == d_faux)
117: {
118: (*s_etat_processus).erreur_execution = d_ex_cycle_hors_boucle;
119: return;
120: }
121:
122: if ((*s_etat_processus).mode_execution_programme == 'Y')
123: {
124: drapeau_presence_fin_boucle = d_vrai;
125: tampon = (*s_etat_processus).instruction_courante;
126: niveau = 1;
127:
128: instruction_majuscule = conversion_majuscule("");
129:
130: while(!(((strcmp(instruction_majuscule, "NEXT") == 0) ||
131: (strcmp(instruction_majuscule, "STEP") == 0)) && (niveau == 0)))
132: {
133: free(instruction_majuscule);
134:
135: erreur = recherche_instruction_suivante(s_etat_processus);
136:
137: if (erreur == d_erreur)
138: {
139: return;
140: }
141:
142: instruction_majuscule = conversion_majuscule(
143: (*s_etat_processus).instruction_courante);
144:
145: if (instruction_majuscule == NULL)
146: {
147: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
148: return;
149: }
150:
151: /*
152: * Traitement de la pile système par les
153: * différentes instructions.
154: */
155:
156: if ((strcmp(instruction_majuscule, "IF") == 0) ||
157: (strcmp(instruction_majuscule, "IFERR") == 0) ||
158: (strcmp(instruction_majuscule, "DO") == 0) ||
159: (strcmp(instruction_majuscule, "WHILE") == 0) ||
160: (strcmp(instruction_majuscule, "FOR") == 0) ||
161: (strcmp(instruction_majuscule, "START") == 0) ||
162: (strcmp(instruction_majuscule, "SELECT") == 0)
163: || (strcmp(instruction_majuscule, "CRITICAL") == 0)
164: || (strcmp(instruction_majuscule, "CASE") == 0)
165: || (strcmp(instruction_majuscule, "<<") == 0))
166: {
167: if (strcmp(instruction_majuscule, "<<") == 0)
168: {
169: analyse(s_etat_processus, NULL);
170: }
171: else
172: {
173: if ((strcmp(instruction_majuscule, "FOR") == 0) ||
174: (strcmp(instruction_majuscule, "START") == 0))
175: {
176: niveau++;
177: }
178:
179: empilement_pile_systeme(s_etat_processus);
180:
181: if ((*s_etat_processus).erreur_systeme != d_es)
182: {
183: return;
184: }
185: }
186: }
187: else if ((strcmp(instruction_majuscule, "END") == 0) ||
188: (strcmp(instruction_majuscule, "NEXT") == 0) ||
189: (strcmp(instruction_majuscule, "STEP") == 0) ||
190: (strcmp(instruction_majuscule, ">>") == 0))
191: {
192: if (strcmp(instruction_majuscule, ">>") == 0)
193: {
194: analyse(s_etat_processus, NULL);
195:
196: if ((*s_etat_processus).retour_routine_evaluation
197: == 'Y')
198: {
199: drapeau_presence_fin_boucle = d_faux;
200: free((*s_etat_processus).instruction_courante);
201:
202: break;
203: }
204: }
205: else
206: {
207: if ((strcmp(instruction_majuscule, "NEXT") == 0) ||
208: (strcmp(instruction_majuscule, "STEP") == 0))
209: {
210: niveau--;
211:
212: if (niveau != 0)
213: {
214: depilement_pile_systeme(s_etat_processus);
215: }
216: }
217: else
218: {
219: if ((*s_etat_processus).l_base_pile_systeme == NULL)
220: {
221: (*s_etat_processus).erreur_systeme =
222: d_es_processus;
223: return;
224: }
225:
226: if ((*(*s_etat_processus).l_base_pile_systeme)
227: .type_cloture == 'Q')
228: {
229: if (pthread_mutex_unlock(
230: &mutex_sections_critiques) != 0)
231: {
232: (*s_etat_processus).erreur_systeme =
233: d_es_processus;
234: return;
235: }
236:
237: (*s_etat_processus).sections_critiques--;
238: }
239:
240: depilement_pile_systeme(s_etat_processus);
241: }
242:
243: if ((*s_etat_processus).erreur_systeme != d_es)
244: {
245: return;
246: }
247: }
248: }
249:
250: free((*s_etat_processus).instruction_courante);
251: }
252:
253: free(instruction_majuscule);
254: (*s_etat_processus).instruction_courante = tampon;
255:
256: if (drapeau_presence_fin_boucle == d_faux)
257: {
258: (*s_etat_processus).traitement_cycle_exit = 'C';
259: }
260: else
261: {
262: (*s_etat_processus).traitement_cycle_exit = 'N';
263: (*s_etat_processus).position_courante -= 5;
264: }
265: }
266: else
267: {
268: /* CYCLE apparaissant dans l'évaluation d'une expression */
269:
270: drapeau_presence_fin_boucle = d_faux;
271: instruction_majuscule = NULL;
272: niveau = 1;
273:
274: while((*s_etat_processus).expression_courante != NULL)
275: {
276: while((*(*(*s_etat_processus).expression_courante).donnee)
277: .type != FCT)
278: {
279: if ((*s_etat_processus).expression_courante == NULL)
280: {
281: (*s_etat_processus).erreur_execution =
282: d_ex_erreur_traitement_boucle;
283: return;
284: }
285:
286: (*s_etat_processus).expression_courante = (*(*s_etat_processus)
287: .expression_courante).suivant;
288: }
289:
290: BUG((*(*(*s_etat_processus).expression_courante).donnee).type
291: != FCT, printf("Not a function\n"));
292:
293: fonction = (*((struct_fonction *) (*(*(*s_etat_processus)
294: .expression_courante).donnee).objet)).fonction;
295:
296: if ((fonction == instruction_if) ||
297: (fonction == instruction_iferr) ||
298: (fonction == instruction_do) ||
299: (fonction == instruction_while) ||
300: (fonction == instruction_for) ||
301: (fonction == instruction_start) ||
302: (fonction == instruction_select) ||
303: (fonction == instruction_case) ||
304: (fonction == instruction_critical) ||
305: (fonction == instruction_vers_niveau_superieur))
306: {
307: if (fonction == instruction_vers_niveau_superieur)
308: {
309: analyse(s_etat_processus,
310: instruction_vers_niveau_superieur);
311: }
312: else
313: {
314: if ((fonction == instruction_for) ||
315: (fonction == instruction_start))
316: {
317: niveau++;
318: }
319:
320: empilement_pile_systeme(s_etat_processus);
321:
322: if ((*s_etat_processus).erreur_systeme != d_es)
323: {
324: return;
325: }
326: }
327: }
328: else if ((fonction == instruction_end) ||
329: (fonction == instruction_next) ||
330: (fonction == instruction_step) ||
331: (fonction == instruction_vers_niveau_inferieur))
332: {
333: if (fonction == instruction_vers_niveau_inferieur)
334: {
335: analyse(s_etat_processus,
336: instruction_vers_niveau_inferieur);
337: }
338: else
339: {
340: if ((fonction == instruction_next) ||
341: (fonction == instruction_step))
342: {
343: niveau--;
344:
345: if (niveau != 0)
346: {
347: depilement_pile_systeme(s_etat_processus);
348: }
349: else
350: {
351: drapeau_presence_fin_boucle = d_vrai;
352: break;
353: }
354: }
355: else
356: {
357: if ((*s_etat_processus).l_base_pile_systeme == NULL)
358: {
359: (*s_etat_processus).erreur_systeme =
360: d_es_processus;
361: return;
362: }
363:
364: if ((*(*s_etat_processus).l_base_pile_systeme)
365: .type_cloture == 'Q')
366: {
367: if (pthread_mutex_unlock(&mutex_sections_critiques)
368: != 0)
369: {
370: (*s_etat_processus).erreur_systeme =
371: d_es_processus;
372: return;
373: }
374:
375: (*s_etat_processus).sections_critiques--;
376: }
377:
378: depilement_pile_systeme(s_etat_processus);
379: }
380:
381: if ((*s_etat_processus).erreur_systeme != d_es)
382: {
383: return;
384: }
385: }
386: }
387:
388: (*s_etat_processus).expression_courante = (*(*s_etat_processus)
389: .expression_courante).suivant;
390: }
391:
392: if (drapeau_presence_fin_boucle == d_faux)
393: {
394: (*s_etat_processus).traitement_cycle_exit = 'C';
395: }
396: else
397: {
398: (*s_etat_processus).traitement_cycle_exit = 'N';
399:
400: if (fonction == instruction_next)
401: {
402: instruction_next(s_etat_processus);
403: }
404: else
405: {
406: instruction_step(s_etat_processus);
407: }
408: }
409: }
410:
411: return;
412: }
413:
414:
415: /*
416: ================================================================================
417: Fonction 'con'
418: ================================================================================
419: Entrées : structure processus
420: --------------------------------------------------------------------------------
421: Sorties :
422: --------------------------------------------------------------------------------
423: Effets de bord : néant
424: ================================================================================
425: */
426:
427: void
428: instruction_con(struct_processus *s_etat_processus)
429: {
430: struct_liste_chainee *l_element_courant;
431:
432: struct_objet *s_objet_1;
433: struct_objet *s_objet_2;
434: struct_objet *s_objet_resultat;
435:
436: logical1 argument_nom;
437:
438: unsigned long i;
439: unsigned long j;
440: unsigned long nombre_colonnes;
441: unsigned long nombre_dimensions;
442: unsigned long nombre_lignes;
443:
444: (*s_etat_processus).erreur_execution = d_ex;
445:
446: if ((*s_etat_processus).affichage_arguments == 'Y')
447: {
448: printf("\n CON ");
449:
450: if ((*s_etat_processus).langue == 'F')
451: {
452: printf("(matrice constante)\n\n");
453: }
454: else
455: {
456: printf("(constant matrix)\n\n");
457: }
458:
459: printf(" 2: %s, %s, %s, %s\n",
460: d_LST, d_VIN, d_VRL, d_VCX);
461: printf(" 1: %s\n", d_INT);
462: printf("-> 1: %s\n\n", d_VIN);
463:
464: printf(" 2: %s, %s, %s, %s\n",
465: d_LST, d_VIN, d_VRL, d_VCX);
466: printf(" 1: %s\n", d_REL);
467: printf("-> 1: %s\n\n", d_VRL);
468:
469: printf(" 2: %s, %s, %s, %s\n",
470: d_LST, d_VIN, d_VRL, d_VCX);
471: printf(" 1: %s\n", d_CPL);
472: printf("-> 1: %s\n\n", d_VCX);
473:
474: printf(" 2: %s, %s, %s, %s\n",
475: d_LST, d_MIN, d_MRL, d_MCX);
476: printf(" 1: %s\n", d_INT);
477: printf("-> 1: %s\n\n", d_MIN);
478:
479: printf(" 2: %s, %s, %s, %s\n",
480: d_LST, d_MIN, d_MRL, d_MCX);
481: printf(" 1: %s\n", d_REL);
482: printf("-> 1: %s\n\n", d_MRL);
483:
484: printf(" 2: %s, %s, %s, %s\n",
485: d_LST, d_MIN, d_MRL, d_MCX);
486: printf(" 1: %s\n", d_CPL);
487: printf("-> 1: %s\n\n", d_MCX);
488:
489: printf(" 2: %s\n", d_NOM);
490: printf(" 1: %s, %s, %s\n", d_INT, d_REL, d_CPL);
491: return;
492: }
493: else if ((*s_etat_processus).test_instruction == 'Y')
494: {
495: (*s_etat_processus).nombre_arguments = -1;
496: return;
497: }
498:
499: if (test_cfsf(s_etat_processus, 31) == d_vrai)
500: {
501: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
502: {
503: return;
504: }
505: }
506:
507: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
508: &s_objet_1) == d_erreur)
509: {
510: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
511: return;
512: }
513:
514: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
515: &s_objet_2) == d_erreur)
516: {
517: liberation(s_etat_processus, s_objet_1);
518:
519: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
520: return;
521: }
522:
523: if ((*s_objet_2).type == NOM)
524: {
525: argument_nom = d_vrai;
526:
527: if (recherche_variable(s_etat_processus, (*((struct_nom *)
528: (*s_objet_2).objet)).nom) == d_faux)
529: {
530: (*s_etat_processus).erreur_systeme = d_es;
531: (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
532:
533: liberation(s_etat_processus, s_objet_1);
534: liberation(s_etat_processus, s_objet_2);
535:
536: return;
537: }
538:
539: liberation(s_etat_processus, s_objet_2);
540:
541: if ((*(*s_etat_processus).pointeur_variable_courante)
542: .variable_verrouillee == d_vrai)
543: {
544: liberation(s_etat_processus, s_objet_1);
545:
546: (*s_etat_processus).erreur_execution = d_ex_variable_verrouillee;
547: return;
548: }
549:
550: if ((*(*s_etat_processus).pointeur_variable_courante).objet == NULL)
551: {
552: // Variable partagée
553:
554: if (pthread_mutex_lock(&((*(*s_etat_processus)
555: .s_liste_variables_partagees).mutex)) != 0)
556: {
557: (*s_etat_processus).erreur_systeme = d_es_processus;
558: return;
559: }
560:
561: if (recherche_variable_partagee(s_etat_processus,
562: (*(*s_etat_processus).pointeur_variable_courante).nom,
563: (*(*s_etat_processus).pointeur_variable_courante)
564: .variable_partagee, (*(*s_etat_processus)
565: .pointeur_variable_courante).origine)
566: == d_faux)
567: {
568: (*s_etat_processus).erreur_systeme = d_es;
569: (*s_etat_processus).erreur_execution =
570: d_ex_variable_non_definie;
571:
572: if (pthread_mutex_unlock(&((*(*s_etat_processus)
573: .s_liste_variables_partagees).mutex)) != 0)
574: {
575: (*s_etat_processus).erreur_systeme = d_es_processus;
576: return;
577: }
578:
579: liberation(s_etat_processus, s_objet_1);
580: liberation(s_etat_processus, s_objet_2);
581:
582: return;
583: }
584:
585: s_objet_2 = (*(*s_etat_processus).s_liste_variables_partagees)
586: .table[(*(*s_etat_processus).s_liste_variables_partagees)
587: .position_variable].objet;
588:
589: if (pthread_mutex_unlock(&((*(*s_etat_processus)
590: .s_liste_variables_partagees).mutex)) != 0)
591: {
592: (*s_etat_processus).erreur_systeme = d_es_processus;
593: return;
594: }
595: }
596: else
597: {
598: // Variable privée
599:
600: s_objet_2 = (*(*s_etat_processus).pointeur_variable_courante).objet;
601: }
602: }
603: else
604: {
605: argument_nom = d_faux;
606: }
607:
608: /*
609: --------------------------------------------------------------------------------
610: Tableau créé à partir d'une spécification de dimension
611: --------------------------------------------------------------------------------
612: */
613:
614: if ((*s_objet_2).type == LST)
615: {
616: l_element_courant = (*s_objet_2).objet;
617: nombre_dimensions = 0;
618:
619: while(l_element_courant != NULL)
620: {
621: nombre_dimensions++;
622: l_element_courant = (*l_element_courant).suivant;
623: }
624:
625: if ((nombre_dimensions != 1) && (nombre_dimensions != 2))
626: {
627: liberation(s_etat_processus, s_objet_1);
628:
629: if (argument_nom == d_faux)
630: {
631: liberation(s_etat_processus, s_objet_2);
632: }
633:
634: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
635: return;
636: }
637:
638: nombre_colonnes = 0;
639: nombre_lignes = 0;
640:
641: l_element_courant = (*s_objet_2).objet;
642:
643: while(l_element_courant != NULL)
644: {
645: if ((*(*l_element_courant).donnee).type != INT)
646: {
647: liberation(s_etat_processus, s_objet_1);
648:
649: if (argument_nom == d_faux)
650: {
651: liberation(s_etat_processus, s_objet_2);
652: }
653:
654: (*s_etat_processus).erreur_execution =
655: d_ex_erreur_type_argument;
656: return;
657: }
658:
659: if ((*((integer8 *) (*(*l_element_courant).donnee).objet)) <= 0)
660: {
661: liberation(s_etat_processus, s_objet_1);
662:
663: if (argument_nom == d_faux)
664: {
665: liberation(s_etat_processus, s_objet_2);
666: }
667:
668: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
669: return;
670: }
671:
672: if (nombre_lignes == 0)
673: {
674: nombre_lignes = (*((integer8 *)
675: (*(*l_element_courant).donnee).objet));
676: }
677: else
678: {
679: nombre_colonnes = (*((integer8 *)
680: (*(*l_element_courant).donnee).objet));
681: }
682:
683: l_element_courant = (*l_element_courant).suivant;
684: }
685: }
686:
687: /*
688: --------------------------------------------------------------------------------
689: Tableau créé à partir des dimensions d'un autre tableau
690: --------------------------------------------------------------------------------
691: */
692:
693: else if (((*s_objet_2).type == VIN) ||
694: ((*s_objet_2).type == VRL) ||
695: ((*s_objet_2).type == VCX))
696: {
697: nombre_dimensions = 1;
698: nombre_lignes = (*((struct_vecteur *) (*s_objet_2).objet)).taille;
699: nombre_colonnes = 0;
700: }
701: else if (((*s_objet_2).type == MIN) ||
702: ((*s_objet_2).type == MRL) ||
703: ((*s_objet_2).type == MCX))
704: {
705: nombre_dimensions = 2;
706: nombre_lignes = (*((struct_matrice *) (*s_objet_2).objet))
707: .nombre_lignes;
708: nombre_colonnes = (*((struct_matrice *) (*s_objet_2).objet))
709: .nombre_colonnes;
710: }
711:
712: /*
713: --------------------------------------------------------------------------------
714: Spécifications incorrectes
715: --------------------------------------------------------------------------------
716: */
717:
718: else
719: {
720: if (argument_nom == d_faux)
721: {
722: liberation(s_etat_processus, s_objet_2);
723: }
724:
725: liberation(s_etat_processus, s_objet_1);
726:
727: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
728: return;
729: }
730:
731: /*
732: --------------------------------------------------------------------------------
733: Création effective du tableau
734: --------------------------------------------------------------------------------
735: */
736:
737: if (((*s_objet_1).type != INT) &&
738: ((*s_objet_1).type != REL) &&
739: ((*s_objet_1).type != CPL))
740: {
741: if (argument_nom == d_faux)
742: {
743: liberation(s_etat_processus, s_objet_2);
744: }
745:
746: liberation(s_etat_processus, s_objet_1);
747:
748: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
749: return;
750: }
751:
752: if (nombre_dimensions == 1)
753: {
754: /*
755: * Vecteur
756: */
757:
758: if ((*s_objet_1).type == INT)
759: {
760: if ((s_objet_resultat = allocation(s_etat_processus, VIN))
761: == NULL)
762: {
763: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
764: return;
765: }
766:
767: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
768: nombre_lignes;
769:
770: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
771: malloc(nombre_lignes * sizeof(integer8))) == NULL)
772: {
773: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
774: return;
775: }
776:
777: for(i = 0; i < nombre_lignes; i++)
778: {
779: ((integer8 *) (*((struct_vecteur *) (*s_objet_resultat)
780: .objet)).tableau)[i] = (*((integer8 *)
781: (*s_objet_1).objet));
782: }
783: }
784: else if ((*s_objet_1).type == REL)
785: {
786: if ((s_objet_resultat = allocation(s_etat_processus, VRL))
787: == NULL)
788: {
789: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
790: return;
791: }
792:
793: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
794: nombre_lignes;
795:
796: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
797: malloc(nombre_lignes * sizeof(real8))) == NULL)
798: {
799: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
800: return;
801: }
802:
803: for(i = 0; i < nombre_lignes; i++)
804: {
805: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat)
806: .objet)).tableau)[i] = (*((real8 *)
807: (*s_objet_1).objet));
808: }
809: }
810: else
811: {
812: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
813: == NULL)
814: {
815: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
816: return;
817: }
818:
819: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
820: nombre_lignes;
821:
822: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
823: malloc(nombre_lignes * sizeof(struct_complexe16))) == NULL)
824: {
825: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
826: return;
827: }
828:
829: for(i = 0; i < nombre_lignes; i++)
830: {
831: ((struct_complexe16 *) (*((struct_vecteur *) (*s_objet_resultat)
832: .objet)).tableau)[i].partie_reelle =
833: (*((struct_complexe16 *)
834: (*s_objet_1).objet)).partie_reelle;
835: ((struct_complexe16 *) (*((struct_vecteur *) (*s_objet_resultat)
836: .objet)).tableau)[i].partie_imaginaire =
837: (*((struct_complexe16 *)
838: (*s_objet_1).objet)).partie_imaginaire;
839: }
840: }
841: }
842: else
843: {
844: /*
845: * Matrice
846: */
847:
848: if ((*s_objet_1).type == INT)
849: {
850: if ((s_objet_resultat = allocation(s_etat_processus, MIN))
851: == NULL)
852: {
853: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
854: return;
855: }
856:
857: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
858: nombre_lignes;
859: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
860: nombre_colonnes;
861:
862: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
863: malloc(nombre_lignes * sizeof(integer8 *))) == NULL)
864: {
865: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
866: return;
867: }
868:
869: for(i = 0; i < nombre_lignes; i++)
870: {
871: if ((((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
872: .objet)).tableau)[i] = malloc(
873: nombre_colonnes * sizeof(integer8))) == NULL)
874: {
875: (*s_etat_processus).erreur_systeme =
876: d_es_allocation_memoire;
877: return;
878: }
879:
880: for(j = 0; j < nombre_colonnes; j++)
881: {
882: ((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
883: .objet)).tableau)[i][j] = (*((integer8 *)
884: (*s_objet_1).objet));
885: }
886: }
887: }
888: else if ((*s_objet_1).type == REL)
889: {
890: if ((s_objet_resultat = allocation(s_etat_processus, MRL))
891: == NULL)
892: {
893: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
894: return;
895: }
896:
897: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
898: nombre_lignes;
899: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
900: nombre_colonnes;
901:
902: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
903: malloc(nombre_lignes * sizeof(real8 *))) == NULL)
904: {
905: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
906: return;
907: }
908:
909: for(i = 0; i < nombre_lignes; i++)
910: {
911: if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat)
912: .objet)).tableau)[i] = malloc(
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 < nombre_colonnes; j++)
921: {
922: ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
923: .objet)).tableau)[i][j] = (*((real8 *)
924: (*s_objet_1).objet));
925: }
926: }
927: }
928: else
929: {
930: if ((s_objet_resultat = allocation(s_etat_processus, MCX))
931: == NULL)
932: {
933: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
934: return;
935: }
936:
937: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
938: nombre_lignes;
939: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
940: nombre_colonnes;
941:
942: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
943: malloc(nombre_lignes * sizeof(struct_complexe16 *)))
944: == NULL)
945: {
946: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
947: return;
948: }
949:
950: for(i = 0; i < nombre_lignes; i++)
951: {
952: if ((((struct_complexe16 **) (*((struct_matrice *)
953: (*s_objet_resultat).objet)).tableau)[i] =
954: malloc(nombre_colonnes *
955: sizeof(struct_complexe16))) == NULL)
956: {
957: (*s_etat_processus).erreur_systeme =
958: d_es_allocation_memoire;
959: return;
960: }
961:
962: for(j = 0; j < nombre_colonnes; j++)
963: {
964: ((struct_complexe16 **) (*((struct_matrice *)
965: (*s_objet_resultat).objet)).tableau)[i][j]
966: .partie_reelle = (*((struct_complexe16 *)
967: (*s_objet_1).objet)).partie_reelle;
968: ((struct_complexe16 **) (*((struct_matrice *)
969: (*s_objet_resultat).objet)).tableau)[i][j]
970: .partie_imaginaire = (*((struct_complexe16 *)
971: (*s_objet_1).objet)).partie_imaginaire;
972: }
973: }
974: }
975: }
976:
977: liberation(s_etat_processus, s_objet_1);
978: liberation(s_etat_processus, s_objet_2);
979:
980: if (argument_nom == d_faux)
981: {
982: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
983: s_objet_resultat) == d_erreur)
984: {
985: return;
986: }
987: }
988: else
989: {
990: (*(*s_etat_processus).pointeur_variable_courante).objet =
991: s_objet_resultat;
992: }
993:
994: return;
995: }
996:
997:
998: /*
999: ================================================================================
1000: Fonction 'cross'
1001: ================================================================================
1002: Entrées : structure processus
1003: --------------------------------------------------------------------------------
1004: Sorties :
1005: --------------------------------------------------------------------------------
1006: Effets de bord : néant
1007: ================================================================================
1008: */
1009:
1010: void
1011: instruction_cross(struct_processus *s_etat_processus)
1012: {
1013: integer8 tampon_1;
1014: integer8 tampon_2;
1015:
1016: logical1 depassement;
1017:
1018: struct_complexe16 registre_a;
1019: struct_complexe16 registre_b;
1020:
1021: struct_objet *s_objet_argument_1;
1022: struct_objet *s_objet_argument_2;
1023: struct_objet *s_objet_resultat;
1024:
1025: (*s_etat_processus).erreur_execution = d_ex;
1026:
1027: if ((*s_etat_processus).affichage_arguments == 'Y')
1028: {
1029: printf("\n CROSS ");
1030:
1031: if ((*s_etat_processus).langue == 'F')
1032: {
1033: printf("(produit vectoriel)\n\n");
1034: }
1035: else
1036: {
1037: printf("(product of vectors)\n\n");
1038: }
1039:
1040: printf(" 2: %s, %s\n", d_VIN, d_VRL);
1041: printf(" 1: %s, %s\n", d_VIN, d_VRL);
1042: printf("-> 1: %s, %s\n\n", d_VIN, d_VRL);
1043:
1044: printf(" 2: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
1045: printf(" 1: %s\n", d_VCX);
1046: printf("-> 1: %s\n\n", d_VCX);
1047:
1048: printf(" 2: %s\n", d_VCX);
1049: printf(" 1: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
1050: printf("-> 1: %s\n", d_VCX);
1051:
1052: return;
1053: }
1054: else if ((*s_etat_processus).test_instruction == 'Y')
1055: {
1056: (*s_etat_processus).nombre_arguments = -1;
1057: return;
1058: }
1059:
1060: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1061: {
1062: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
1063: {
1064: return;
1065: }
1066: }
1067:
1068: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1069: &s_objet_argument_1) == d_erreur)
1070: {
1071: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1072: return;
1073: }
1074:
1075: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1076: &s_objet_argument_2) == d_erreur)
1077: {
1078: liberation(s_etat_processus, s_objet_argument_1);
1079:
1080: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1081: return;
1082: }
1083:
1084: /*
1085: --------------------------------------------------------------------------------
1086: Résultat entier
1087: --------------------------------------------------------------------------------
1088: */
1089:
1090: if (((*s_objet_argument_1).type == VIN) &&
1091: ((*s_objet_argument_2).type == VIN))
1092: {
1093: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1094: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1095: != 3))
1096: {
1097: liberation(s_etat_processus, s_objet_argument_1);
1098: liberation(s_etat_processus, s_objet_argument_2);
1099:
1100: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1101: return;
1102: }
1103:
1104: if ((s_objet_resultat = allocation(s_etat_processus, VIN))
1105: == NULL)
1106: {
1107: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1108: return;
1109: }
1110:
1111: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1112:
1113: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1114: malloc(3 * sizeof(integer8))) == NULL)
1115: {
1116: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1117: return;
1118: }
1119:
1120: depassement = depassement_multiplication(&(((integer8 *)
1121: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1122: .tableau)[1]), &(((integer8 *) (*((struct_vecteur *)
1123: (*s_objet_argument_1).objet)).tableau)[2]), &(tampon_1));
1124:
1125: depassement |= depassement_multiplication(&(((integer8 *)
1126: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1127: .tableau)[2]), &(((integer8 *) (*((struct_vecteur *)
1128: (*s_objet_argument_1).objet)).tableau)[1]), &(tampon_2));
1129:
1130: tampon_2 = -tampon_2;
1131:
1132: depassement |= depassement_addition(&(tampon_1), &(tampon_2),
1133: &(((integer8 *) (*((struct_vecteur *) (*s_objet_resultat)
1134: .objet)).tableau)[0]));
1135:
1136: depassement |= depassement_multiplication(&(((integer8 *)
1137: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1138: .tableau)[2]), &(((integer8 *) (*((struct_vecteur *)
1139: (*s_objet_argument_1).objet)).tableau)[0]), &(tampon_1));
1140:
1141: depassement |= depassement_multiplication(&(((integer8 *)
1142: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1143: .tableau)[0]), &(((integer8 *) (*((struct_vecteur *)
1144: (*s_objet_argument_1).objet)).tableau)[2]), &(tampon_2));
1145:
1146: tampon_2 = -tampon_2;
1147:
1148: depassement |= depassement_addition(&(tampon_1), &(tampon_2),
1149: &(((integer8 *) (*((struct_vecteur *) (*s_objet_resultat)
1150: .objet)).tableau)[1]));
1151:
1152: depassement |= depassement_multiplication(&(((integer8 *)
1153: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1154: .tableau)[0]), &(((integer8 *) (*((struct_vecteur *)
1155: (*s_objet_argument_1).objet)).tableau)[1]), &(tampon_1));
1156:
1157: depassement |= depassement_multiplication(&(((integer8 *)
1158: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1159: .tableau)[1]), &(((integer8 *) (*((struct_vecteur *)
1160: (*s_objet_argument_1).objet)).tableau)[0]), &(tampon_2));
1161:
1162: tampon_2 = -tampon_2;
1163:
1164: depassement |= depassement_addition(&(tampon_1), &(tampon_2),
1165: &(((integer8 *) (*((struct_vecteur *) (*s_objet_resultat)
1166: .objet)).tableau)[2]));
1167:
1168: if (depassement != d_absence_erreur)
1169: {
1170: (*s_objet_resultat).type = VRL;
1171: (*((struct_vecteur *) (*s_objet_resultat).objet)).type = 'R';
1172: free((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau);
1173:
1174: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1175: malloc(3 * sizeof(real8))) == NULL)
1176: {
1177: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1178: return;
1179: }
1180:
1181: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1182: .tableau)[0] = ((real8) ((integer8 *) (*((struct_vecteur *)
1183: (*s_objet_argument_2).objet)).tableau)[1] * (real8)
1184: ((integer8 *) (*((struct_vecteur *) (*s_objet_argument_1)
1185: .objet)).tableau)[2]) - ((real8) ((integer8 *)
1186: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1187: .tableau)[2] * (real8) ((integer8 *) (*((struct_vecteur *)
1188: (*s_objet_argument_1).objet)).tableau)[1]);
1189: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1190: .tableau)[1] = ((real8) ((integer8 *) (*((struct_vecteur *)
1191: (*s_objet_argument_2).objet)).tableau)[2] * (real8)
1192: ((integer8 *) (*((struct_vecteur *) (*s_objet_argument_1)
1193: .objet)).tableau)[0]) - ((real8) ((integer8 *)
1194: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1195: .tableau)[0] * (real8) ((integer8 *) (*((struct_vecteur *)
1196: (*s_objet_argument_1).objet)).tableau)[2]);
1197: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1198: .tableau)[2] = ((real8) ((integer8 *) (*((struct_vecteur *)
1199: (*s_objet_argument_2).objet)).tableau)[0] * (real8)
1200: ((integer8 *) (*((struct_vecteur *) (*s_objet_argument_1)
1201: .objet)).tableau)[1]) - ((real8) ((integer8 *)
1202: (*((struct_vecteur *) (*s_objet_argument_2)
1203: .objet)).tableau)[1] * (real8) ((integer8 *)
1204: (*((struct_vecteur *) (*s_objet_argument_1).objet))
1205: .tableau)[0]);
1206: }
1207: }
1208:
1209: /*
1210: --------------------------------------------------------------------------------
1211: Résultat réel
1212: --------------------------------------------------------------------------------
1213: */
1214:
1215: else if (((*s_objet_argument_1).type == VRL) &&
1216: ((*s_objet_argument_2).type == VIN))
1217: {
1218: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1219: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1220: != 3))
1221: {
1222: liberation(s_etat_processus, s_objet_argument_1);
1223: liberation(s_etat_processus, s_objet_argument_2);
1224:
1225: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1226: return;
1227: }
1228:
1229: if ((s_objet_resultat = allocation(s_etat_processus, VRL))
1230: == NULL)
1231: {
1232: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1233: return;
1234: }
1235:
1236: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1237:
1238: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1239: malloc(3 * sizeof(real8))) == NULL)
1240: {
1241: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1242: return;
1243: }
1244:
1245: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1246: .tableau)[0] = (((integer8 *) (*((struct_vecteur *)
1247: (*s_objet_argument_2).objet)).tableau)[1] * ((real8 *)
1248: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[2])
1249: - (((integer8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1250: .objet)).tableau)[2] * ((real8 *) (*((struct_vecteur *)
1251: (*s_objet_argument_1).objet)).tableau)[1]);
1252: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1253: .tableau)[1] = (((integer8 *) (*((struct_vecteur *)
1254: (*s_objet_argument_2).objet)).tableau)[2] * ((real8 *)
1255: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[0])
1256: - (((integer8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1257: .objet)).tableau)[0] * ((real8 *) (*((struct_vecteur *)
1258: (*s_objet_argument_1).objet)).tableau)[2]);
1259: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1260: .tableau)[2] = (((integer8 *) (*((struct_vecteur *)
1261: (*s_objet_argument_2).objet)).tableau)[0] * ((real8 *)
1262: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[1])
1263: - (((integer8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1264: .objet)).tableau)[1] * ((real8 *) (*((struct_vecteur *)
1265: (*s_objet_argument_1).objet)).tableau)[0]);
1266: }
1267: else if (((*s_objet_argument_1).type == VIN) &&
1268: ((*s_objet_argument_2).type == VRL))
1269: {
1270: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1271: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1272: != 3))
1273: {
1274: liberation(s_etat_processus, s_objet_argument_1);
1275: liberation(s_etat_processus, s_objet_argument_2);
1276:
1277: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1278: return;
1279: }
1280:
1281: if ((s_objet_resultat = allocation(s_etat_processus, VRL))
1282: == NULL)
1283: {
1284: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1285: return;
1286: }
1287:
1288: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1289:
1290: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1291: malloc(3 * sizeof(real8))) == NULL)
1292: {
1293: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1294: return;
1295: }
1296:
1297: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1298: .tableau)[0] = (((real8 *) (*((struct_vecteur *)
1299: (*s_objet_argument_2).objet)).tableau)[1] * ((integer8 *)
1300: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[2])
1301: - (((real8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1302: .objet)).tableau)[2] * ((integer8 *) (*((struct_vecteur *)
1303: (*s_objet_argument_1).objet)).tableau)[1]);
1304: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1305: .tableau)[1] = (((real8 *) (*((struct_vecteur *)
1306: (*s_objet_argument_2).objet)).tableau)[2] * ((integer8 *)
1307: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[0])
1308: - (((real8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1309: .objet)).tableau)[0] * ((integer8 *) (*((struct_vecteur *)
1310: (*s_objet_argument_1).objet)).tableau)[2]);
1311: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1312: .tableau)[2] = (((real8 *) (*((struct_vecteur *)
1313: (*s_objet_argument_2).objet)).tableau)[0] * ((integer8 *)
1314: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[1])
1315: - (((real8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1316: .objet)).tableau)[1] * ((integer8 *) (*((struct_vecteur *)
1317: (*s_objet_argument_1).objet)).tableau)[0]);
1318: }
1319: else if (((*s_objet_argument_1).type == VRL) &&
1320: ((*s_objet_argument_2).type == VRL))
1321: {
1322: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1323: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1324: != 3))
1325: {
1326: liberation(s_etat_processus, s_objet_argument_1);
1327: liberation(s_etat_processus, s_objet_argument_2);
1328:
1329: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1330: return;
1331: }
1332:
1333: if ((s_objet_resultat = allocation(s_etat_processus, VRL))
1334: == NULL)
1335: {
1336: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1337: return;
1338: }
1339:
1340: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1341:
1342: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1343: malloc(3 * sizeof(real8))) == NULL)
1344: {
1345: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1346: return;
1347: }
1348:
1349: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1350: .tableau)[0] = (((real8 *) (*((struct_vecteur *)
1351: (*s_objet_argument_2).objet)).tableau)[1] * ((real8 *)
1352: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[2])
1353: - (((real8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1354: .objet)).tableau)[2] * ((real8 *) (*((struct_vecteur *)
1355: (*s_objet_argument_1).objet)).tableau)[1]);
1356: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1357: .tableau)[1] = (((real8 *) (*((struct_vecteur *)
1358: (*s_objet_argument_2).objet)).tableau)[2] * ((real8 *)
1359: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[0])
1360: - (((real8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1361: .objet)).tableau)[0] * ((real8 *) (*((struct_vecteur *)
1362: (*s_objet_argument_1).objet)).tableau)[2]);
1363: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1364: .tableau)[2] = (((real8 *) (*((struct_vecteur *)
1365: (*s_objet_argument_2).objet)).tableau)[0] * ((real8 *)
1366: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[1])
1367: - (((real8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1368: .objet)).tableau)[1] * ((real8 *) (*((struct_vecteur *)
1369: (*s_objet_argument_1).objet)).tableau)[0]);
1370: }
1371:
1372: /*
1373: --------------------------------------------------------------------------------
1374: Résultat complexe
1375: --------------------------------------------------------------------------------
1376: */
1377:
1378: else if (((*s_objet_argument_1).type == VIN) &&
1379: ((*s_objet_argument_2).type == VCX))
1380: {
1381: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1382: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1383: != 3))
1384: {
1385: liberation(s_etat_processus, s_objet_argument_1);
1386: liberation(s_etat_processus, s_objet_argument_2);
1387:
1388: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1389: return;
1390: }
1391:
1392: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
1393: == NULL)
1394: {
1395: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1396: return;
1397: }
1398:
1399: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1400:
1401: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1402: malloc(3 * sizeof(struct_complexe16))) == NULL)
1403: {
1404: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1405: return;
1406: }
1407:
1408: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1409: (*s_objet_argument_2).objet)).tableau)[1]),
1410: &(((integer8 *) (*((struct_vecteur *)
1411: (*s_objet_argument_1).objet)).tableau)[2]), ®istre_a);
1412: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1413: (*s_objet_argument_2).objet)).tableau)[2]),
1414: &(((integer8 *) (*((struct_vecteur *)
1415: (*s_objet_argument_1).objet)).tableau)[1]), ®istre_b);
1416: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1417: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[0]));
1418:
1419: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1420: (*s_objet_argument_2).objet)).tableau)[2]),
1421: &(((integer8 *) (*((struct_vecteur *)
1422: (*s_objet_argument_1).objet)).tableau)[0]), ®istre_a);
1423: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1424: (*s_objet_argument_2).objet)).tableau)[0]),
1425: &(((integer8 *) (*((struct_vecteur *)
1426: (*s_objet_argument_1).objet)).tableau)[2]), ®istre_b);
1427: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1428: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[1]));
1429:
1430: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1431: (*s_objet_argument_2).objet)).tableau)[0]),
1432: &(((integer8 *) (*((struct_vecteur *)
1433: (*s_objet_argument_1).objet)).tableau)[1]), ®istre_a);
1434: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1435: (*s_objet_argument_2).objet)).tableau)[1]),
1436: &(((integer8 *) (*((struct_vecteur *)
1437: (*s_objet_argument_1).objet)).tableau)[0]), ®istre_b);
1438: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1439: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[2]));
1440: }
1441: else if (((*s_objet_argument_1).type == VRL) &&
1442: ((*s_objet_argument_2).type == VCX))
1443: {
1444: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1445: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1446: != 3))
1447: {
1448: liberation(s_etat_processus, s_objet_argument_1);
1449: liberation(s_etat_processus, s_objet_argument_2);
1450:
1451: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1452: return;
1453: }
1454:
1455: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
1456: == NULL)
1457: {
1458: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1459: return;
1460: }
1461:
1462: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1463:
1464: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1465: malloc(3 * sizeof(struct_complexe16))) == NULL)
1466: {
1467: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1468: return;
1469: }
1470:
1471: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1472: (*s_objet_argument_2).objet)).tableau)[1]),
1473: &(((real8 *) (*((struct_vecteur *)
1474: (*s_objet_argument_1).objet)).tableau)[2]), ®istre_a);
1475: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1476: (*s_objet_argument_2).objet)).tableau)[2]),
1477: &(((real8 *) (*((struct_vecteur *)
1478: (*s_objet_argument_1).objet)).tableau)[1]), ®istre_b);
1479: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1480: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[0]));
1481:
1482: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1483: (*s_objet_argument_2).objet)).tableau)[2]),
1484: &(((real8 *) (*((struct_vecteur *)
1485: (*s_objet_argument_1).objet)).tableau)[0]), ®istre_a);
1486: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1487: (*s_objet_argument_2).objet)).tableau)[0]),
1488: &(((real8 *) (*((struct_vecteur *)
1489: (*s_objet_argument_1).objet)).tableau)[2]), ®istre_b);
1490: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1491: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[1]));
1492:
1493: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1494: (*s_objet_argument_2).objet)).tableau)[0]),
1495: &(((real8 *) (*((struct_vecteur *)
1496: (*s_objet_argument_1).objet)).tableau)[1]), ®istre_a);
1497: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1498: (*s_objet_argument_2).objet)).tableau)[1]),
1499: &(((real8 *) (*((struct_vecteur *)
1500: (*s_objet_argument_1).objet)).tableau)[0]), ®istre_b);
1501: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1502: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[2]));
1503: }
1504: else if (((*s_objet_argument_1).type == VCX) &&
1505: ((*s_objet_argument_2).type == VCX))
1506: {
1507: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1508: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1509: != 3))
1510: {
1511: liberation(s_etat_processus, s_objet_argument_1);
1512: liberation(s_etat_processus, s_objet_argument_2);
1513:
1514: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1515: return;
1516: }
1517:
1518: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
1519: == NULL)
1520: {
1521: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1522: return;
1523: }
1524:
1525: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1526:
1527: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1528: malloc(3 * sizeof(struct_complexe16))) == NULL)
1529: {
1530: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1531: return;
1532: }
1533:
1534: f77multiplicationcc_((&((struct_complexe16 *) (*((struct_vecteur *)
1535: (*s_objet_argument_2).objet)).tableau)[1]),
1536: &(((struct_complexe16 *) (*((struct_vecteur *)
1537: (*s_objet_argument_1).objet)).tableau)[2]), ®istre_a);
1538: f77multiplicationcc_((&((struct_complexe16 *) (*((struct_vecteur *)
1539: (*s_objet_argument_2).objet)).tableau)[2]),
1540: &(((struct_complexe16 *) (*((struct_vecteur *)
1541: (*s_objet_argument_1).objet)).tableau)[1]), ®istre_b);
1542: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1543: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[0]));
1544:
1545: f77multiplicationcc_((&((struct_complexe16 *) (*((struct_vecteur *)
1546: (*s_objet_argument_2).objet)).tableau)[2]),
1547: &(((struct_complexe16 *) (*((struct_vecteur *)
1548: (*s_objet_argument_1).objet)).tableau)[0]), ®istre_a);
1549: f77multiplicationcc_((&((struct_complexe16 *) (*((struct_vecteur *)
1550: (*s_objet_argument_2).objet)).tableau)[0]),
1551: &(((struct_complexe16 *) (*((struct_vecteur *)
1552: (*s_objet_argument_1).objet)).tableau)[2]), ®istre_b);
1553: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1554: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[1]));
1555:
1556: f77multiplicationcc_((&((struct_complexe16 *) (*((struct_vecteur *)
1557: (*s_objet_argument_2).objet)).tableau)[0]),
1558: &(((struct_complexe16 *) (*((struct_vecteur *)
1559: (*s_objet_argument_1).objet)).tableau)[1]), ®istre_a);
1560: f77multiplicationcc_((&((struct_complexe16 *) (*((struct_vecteur *)
1561: (*s_objet_argument_2).objet)).tableau)[1]),
1562: &(((struct_complexe16 *) (*((struct_vecteur *)
1563: (*s_objet_argument_1).objet)).tableau)[0]), ®istre_b);
1564: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1565: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[2]));
1566: }
1567: else if (((*s_objet_argument_2).type == VRL) &&
1568: ((*s_objet_argument_1).type == VCX))
1569: {
1570: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1571: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1572: != 3))
1573: {
1574: liberation(s_etat_processus, s_objet_argument_1);
1575: liberation(s_etat_processus, s_objet_argument_2);
1576:
1577: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1578: return;
1579: }
1580:
1581: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
1582: == NULL)
1583: {
1584: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1585: return;
1586: }
1587:
1588: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1589:
1590: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1591: malloc(3 * sizeof(struct_complexe16))) == NULL)
1592: {
1593: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1594: return;
1595: }
1596:
1597: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1598: (*s_objet_argument_1).objet)).tableau)[1]),
1599: &(((real8 *) (*((struct_vecteur *)
1600: (*s_objet_argument_2).objet)).tableau)[2]), ®istre_b);
1601: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1602: (*s_objet_argument_1).objet)).tableau)[2]),
1603: &(((real8 *) (*((struct_vecteur *)
1604: (*s_objet_argument_2).objet)).tableau)[1]), ®istre_a);
1605: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1606: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[0]));
1607:
1608: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1609: (*s_objet_argument_1).objet)).tableau)[2]),
1610: &(((real8 *) (*((struct_vecteur *)
1611: (*s_objet_argument_2).objet)).tableau)[0]), ®istre_b);
1612: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1613: (*s_objet_argument_1).objet)).tableau)[0]),
1614: &(((real8 *) (*((struct_vecteur *)
1615: (*s_objet_argument_2).objet)).tableau)[2]), ®istre_a);
1616: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1617: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[1]));
1618:
1619: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1620: (*s_objet_argument_1).objet)).tableau)[0]),
1621: &(((real8 *) (*((struct_vecteur *)
1622: (*s_objet_argument_2).objet)).tableau)[1]), ®istre_b);
1623: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1624: (*s_objet_argument_1).objet)).tableau)[1]),
1625: &(((real8 *) (*((struct_vecteur *)
1626: (*s_objet_argument_2).objet)).tableau)[0]), ®istre_a);
1627: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1628: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[2]));
1629: }
1630: else if (((*s_objet_argument_2).type == VIN) &&
1631: ((*s_objet_argument_1).type == VCX))
1632: {
1633: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1634: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1635: != 3))
1636: {
1637: liberation(s_etat_processus, s_objet_argument_1);
1638: liberation(s_etat_processus, s_objet_argument_2);
1639:
1640: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1641: return;
1642: }
1643:
1644: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
1645: == NULL)
1646: {
1647: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1648: return;
1649: }
1650:
1651: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1652:
1653: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1654: malloc(3 * sizeof(struct_complexe16))) == NULL)
1655: {
1656: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1657: return;
1658: }
1659:
1660: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1661: (*s_objet_argument_1).objet)).tableau)[1]),
1662: &(((integer8 *) (*((struct_vecteur *)
1663: (*s_objet_argument_2).objet)).tableau)[2]), ®istre_b);
1664: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1665: (*s_objet_argument_1).objet)).tableau)[2]),
1666: &(((integer8 *) (*((struct_vecteur *)
1667: (*s_objet_argument_2).objet)).tableau)[1]), ®istre_a);
1668: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1669: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[0]));
1670:
1671: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1672: (*s_objet_argument_1).objet)).tableau)[2]),
1673: &(((integer8 *) (*((struct_vecteur *)
1674: (*s_objet_argument_2).objet)).tableau)[0]), ®istre_b);
1675: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1676: (*s_objet_argument_1).objet)).tableau)[0]),
1677: &(((integer8 *) (*((struct_vecteur *)
1678: (*s_objet_argument_2).objet)).tableau)[2]), ®istre_a);
1679: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1680: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[1]));
1681:
1682: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1683: (*s_objet_argument_1).objet)).tableau)[0]),
1684: &(((integer8 *) (*((struct_vecteur *)
1685: (*s_objet_argument_2).objet)).tableau)[1]), ®istre_b);
1686: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1687: (*s_objet_argument_1).objet)).tableau)[1]),
1688: &(((integer8 *) (*((struct_vecteur *)
1689: (*s_objet_argument_2).objet)).tableau)[0]), ®istre_a);
1690: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1691: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[2]));
1692: }
1693:
1694: /*
1695: --------------------------------------------------------------------------------
1696: Types incompatibles avec la fonction CROSS
1697: --------------------------------------------------------------------------------
1698: */
1699:
1700: else
1701: {
1702: liberation(s_etat_processus, s_objet_argument_1);
1703: liberation(s_etat_processus, s_objet_argument_2);
1704:
1705: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1706: return;
1707: }
1708:
1709: liberation(s_etat_processus, s_objet_argument_1);
1710: liberation(s_etat_processus, s_objet_argument_2);
1711:
1712: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1713: s_objet_resultat) == d_erreur)
1714: {
1715: return;
1716: }
1717:
1718: return;
1719: }
1720:
1721: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_c2.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src