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