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, "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:
441: unsigned long i;
442: unsigned long j;
443: unsigned long nombre_colonnes;
444: unsigned long nombre_dimensions;
445: unsigned long nombre_lignes;
446:
447: (*s_etat_processus).erreur_execution = d_ex;
448:
449: if ((*s_etat_processus).affichage_arguments == 'Y')
450: {
451: printf("\n CON ");
452:
453: if ((*s_etat_processus).langue == 'F')
454: {
455: printf("(matrice constante)\n\n");
456: }
457: else
458: {
459: printf("(constant matrix)\n\n");
460: }
461:
462: printf(" 2: %s, %s, %s, %s\n",
463: d_LST, d_VIN, d_VRL, d_VCX);
464: printf(" 1: %s\n", d_INT);
465: printf("-> 1: %s\n\n", d_VIN);
466:
467: printf(" 2: %s, %s, %s, %s\n",
468: d_LST, d_VIN, d_VRL, d_VCX);
469: printf(" 1: %s\n", d_REL);
470: printf("-> 1: %s\n\n", d_VRL);
471:
472: printf(" 2: %s, %s, %s, %s\n",
473: d_LST, d_VIN, d_VRL, d_VCX);
474: printf(" 1: %s\n", d_CPL);
475: printf("-> 1: %s\n\n", d_VCX);
476:
477: printf(" 2: %s, %s, %s, %s\n",
478: d_LST, d_MIN, d_MRL, d_MCX);
479: printf(" 1: %s\n", d_INT);
480: printf("-> 1: %s\n\n", d_MIN);
481:
482: printf(" 2: %s, %s, %s, %s\n",
483: d_LST, d_MIN, d_MRL, d_MCX);
484: printf(" 1: %s\n", d_REL);
485: printf("-> 1: %s\n\n", d_MRL);
486:
487: printf(" 2: %s, %s, %s, %s\n",
488: d_LST, d_MIN, d_MRL, d_MCX);
489: printf(" 1: %s\n", d_CPL);
490: printf("-> 1: %s\n\n", d_MCX);
491:
492: printf(" 2: %s\n", d_NOM);
493: printf(" 1: %s, %s, %s\n", d_INT, d_REL, d_CPL);
494: return;
495: }
496: else if ((*s_etat_processus).test_instruction == 'Y')
497: {
498: (*s_etat_processus).nombre_arguments = -1;
499: return;
500: }
501:
502: if (test_cfsf(s_etat_processus, 31) == d_vrai)
503: {
504: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
505: {
506: return;
507: }
508: }
509:
510: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
511: &s_objet_1) == d_erreur)
512: {
513: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
514: return;
515: }
516:
517: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
518: &s_objet_2) == d_erreur)
519: {
520: liberation(s_etat_processus, s_objet_1);
521:
522: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
523: return;
524: }
525:
526: if ((*s_objet_2).type == NOM)
527: {
528: argument_nom = d_vrai;
529:
530: if (recherche_variable(s_etat_processus, (*((struct_nom *)
531: (*s_objet_2).objet)).nom) == d_faux)
532: {
533: (*s_etat_processus).erreur_systeme = d_es;
534: (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
535:
536: liberation(s_etat_processus, s_objet_1);
537: liberation(s_etat_processus, s_objet_2);
538:
539: return;
540: }
541:
542: liberation(s_etat_processus, s_objet_2);
543:
544: if ((*(*s_etat_processus).pointeur_variable_courante)
545: .variable_verrouillee == d_vrai)
546: {
547: liberation(s_etat_processus, s_objet_1);
548:
549: (*s_etat_processus).erreur_execution = d_ex_variable_verrouillee;
550: return;
551: }
552:
553: if ((*(*s_etat_processus).pointeur_variable_courante).objet == NULL)
554: {
555: // Variable partagée
556:
557: if (pthread_mutex_lock(&((*(*s_etat_processus)
558: .s_liste_variables_partagees).mutex)) != 0)
559: {
560: (*s_etat_processus).erreur_systeme = d_es_processus;
561: return;
562: }
563:
564: if (recherche_variable_partagee(s_etat_processus,
565: (*(*s_etat_processus).pointeur_variable_courante).nom,
566: (*(*s_etat_processus).pointeur_variable_courante)
567: .variable_partagee, (*(*s_etat_processus)
568: .pointeur_variable_courante).origine)
569: == d_faux)
570: {
571: (*s_etat_processus).erreur_systeme = d_es;
572: (*s_etat_processus).erreur_execution =
573: d_ex_variable_non_definie;
574:
575: if (pthread_mutex_unlock(&((*(*s_etat_processus)
576: .s_liste_variables_partagees).mutex)) != 0)
577: {
578: (*s_etat_processus).erreur_systeme = d_es_processus;
579: return;
580: }
581:
582: liberation(s_etat_processus, s_objet_1);
583: liberation(s_etat_processus, s_objet_2);
584:
585: return;
586: }
587:
588: s_objet_2 = (*(*s_etat_processus).s_liste_variables_partagees)
589: .table[(*(*s_etat_processus).s_liste_variables_partagees)
590: .position_variable].objet;
591:
592: if (pthread_mutex_unlock(&((*(*s_etat_processus)
593: .s_liste_variables_partagees).mutex)) != 0)
594: {
595: (*s_etat_processus).erreur_systeme = d_es_processus;
596: return;
597: }
598: }
599: else
600: {
601: // Variable privée
602:
603: s_objet_2 = (*(*s_etat_processus).pointeur_variable_courante).objet;
604: }
605: }
606: else
607: {
608: argument_nom = d_faux;
609: }
610:
611: /*
612: --------------------------------------------------------------------------------
613: Tableau créé à partir d'une spécification de dimension
614: --------------------------------------------------------------------------------
615: */
616:
617: if ((*s_objet_2).type == LST)
618: {
619: l_element_courant = (*s_objet_2).objet;
620: nombre_dimensions = 0;
621:
622: while(l_element_courant != NULL)
623: {
624: nombre_dimensions++;
625: l_element_courant = (*l_element_courant).suivant;
626: }
627:
628: if ((nombre_dimensions != 1) && (nombre_dimensions != 2))
629: {
630: liberation(s_etat_processus, s_objet_1);
631:
632: if (argument_nom == d_faux)
633: {
634: liberation(s_etat_processus, s_objet_2);
635: }
636:
637: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
638: return;
639: }
640:
641: nombre_colonnes = 0;
642: nombre_lignes = 0;
643:
644: l_element_courant = (*s_objet_2).objet;
645:
646: while(l_element_courant != NULL)
647: {
648: if ((*(*l_element_courant).donnee).type != INT)
649: {
650: liberation(s_etat_processus, s_objet_1);
651:
652: if (argument_nom == d_faux)
653: {
654: liberation(s_etat_processus, s_objet_2);
655: }
656:
657: (*s_etat_processus).erreur_execution =
658: d_ex_erreur_type_argument;
659: return;
660: }
661:
662: if ((*((integer8 *) (*(*l_element_courant).donnee).objet)) <= 0)
663: {
664: liberation(s_etat_processus, s_objet_1);
665:
666: if (argument_nom == d_faux)
667: {
668: liberation(s_etat_processus, s_objet_2);
669: }
670:
671: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
672: return;
673: }
674:
675: if (nombre_lignes == 0)
676: {
677: nombre_lignes = (*((integer8 *)
678: (*(*l_element_courant).donnee).objet));
679: }
680: else
681: {
682: nombre_colonnes = (*((integer8 *)
683: (*(*l_element_courant).donnee).objet));
684: }
685:
686: l_element_courant = (*l_element_courant).suivant;
687: }
688: }
689:
690: /*
691: --------------------------------------------------------------------------------
692: Tableau créé à partir des dimensions d'un autre tableau
693: --------------------------------------------------------------------------------
694: */
695:
696: else if (((*s_objet_2).type == VIN) ||
697: ((*s_objet_2).type == VRL) ||
698: ((*s_objet_2).type == VCX))
699: {
700: nombre_dimensions = 1;
701: nombre_lignes = (*((struct_vecteur *) (*s_objet_2).objet)).taille;
702: nombre_colonnes = 0;
703: }
704: else if (((*s_objet_2).type == MIN) ||
705: ((*s_objet_2).type == MRL) ||
706: ((*s_objet_2).type == MCX))
707: {
708: nombre_dimensions = 2;
709: nombre_lignes = (*((struct_matrice *) (*s_objet_2).objet))
710: .nombre_lignes;
711: nombre_colonnes = (*((struct_matrice *) (*s_objet_2).objet))
712: .nombre_colonnes;
713: }
714:
715: /*
716: --------------------------------------------------------------------------------
717: Spécifications incorrectes
718: --------------------------------------------------------------------------------
719: */
720:
721: else
722: {
723: if (argument_nom == d_faux)
724: {
725: liberation(s_etat_processus, s_objet_2);
726: }
727:
728: liberation(s_etat_processus, s_objet_1);
729:
730: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
731: return;
732: }
733:
734: /*
735: --------------------------------------------------------------------------------
736: Création effective du tableau
737: --------------------------------------------------------------------------------
738: */
739:
740: if (((*s_objet_1).type != INT) &&
741: ((*s_objet_1).type != REL) &&
742: ((*s_objet_1).type != CPL))
743: {
744: if (argument_nom == d_faux)
745: {
746: liberation(s_etat_processus, s_objet_2);
747: }
748:
749: liberation(s_etat_processus, s_objet_1);
750:
751: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
752: return;
753: }
754:
755: if (nombre_dimensions == 1)
756: {
757: /*
758: * Vecteur
759: */
760:
761: if ((*s_objet_1).type == INT)
762: {
763: if ((s_objet_resultat = allocation(s_etat_processus, VIN))
764: == NULL)
765: {
766: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
767: return;
768: }
769:
770: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
771: nombre_lignes;
772:
773: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
774: malloc(nombre_lignes * sizeof(integer8))) == NULL)
775: {
776: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
777: return;
778: }
779:
780: for(i = 0; i < nombre_lignes; i++)
781: {
782: ((integer8 *) (*((struct_vecteur *) (*s_objet_resultat)
783: .objet)).tableau)[i] = (*((integer8 *)
784: (*s_objet_1).objet));
785: }
786: }
787: else if ((*s_objet_1).type == REL)
788: {
789: if ((s_objet_resultat = allocation(s_etat_processus, VRL))
790: == NULL)
791: {
792: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
793: return;
794: }
795:
796: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
797: nombre_lignes;
798:
799: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
800: malloc(nombre_lignes * sizeof(real8))) == NULL)
801: {
802: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
803: return;
804: }
805:
806: for(i = 0; i < nombre_lignes; i++)
807: {
808: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat)
809: .objet)).tableau)[i] = (*((real8 *)
810: (*s_objet_1).objet));
811: }
812: }
813: else
814: {
815: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
816: == NULL)
817: {
818: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
819: return;
820: }
821:
822: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
823: nombre_lignes;
824:
825: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
826: malloc(nombre_lignes * sizeof(struct_complexe16))) == NULL)
827: {
828: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
829: return;
830: }
831:
832: for(i = 0; i < nombre_lignes; i++)
833: {
834: ((struct_complexe16 *) (*((struct_vecteur *) (*s_objet_resultat)
835: .objet)).tableau)[i].partie_reelle =
836: (*((struct_complexe16 *)
837: (*s_objet_1).objet)).partie_reelle;
838: ((struct_complexe16 *) (*((struct_vecteur *) (*s_objet_resultat)
839: .objet)).tableau)[i].partie_imaginaire =
840: (*((struct_complexe16 *)
841: (*s_objet_1).objet)).partie_imaginaire;
842: }
843: }
844: }
845: else
846: {
847: /*
848: * Matrice
849: */
850:
851: if ((*s_objet_1).type == INT)
852: {
853: if ((s_objet_resultat = allocation(s_etat_processus, MIN))
854: == NULL)
855: {
856: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
857: return;
858: }
859:
860: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
861: nombre_lignes;
862: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
863: nombre_colonnes;
864:
865: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
866: malloc(nombre_lignes * sizeof(integer8 *))) == NULL)
867: {
868: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
869: return;
870: }
871:
872: for(i = 0; i < nombre_lignes; i++)
873: {
874: if ((((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
875: .objet)).tableau)[i] = malloc(
876: nombre_colonnes * sizeof(integer8))) == NULL)
877: {
878: (*s_etat_processus).erreur_systeme =
879: d_es_allocation_memoire;
880: return;
881: }
882:
883: for(j = 0; j < nombre_colonnes; j++)
884: {
885: ((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
886: .objet)).tableau)[i][j] = (*((integer8 *)
887: (*s_objet_1).objet));
888: }
889: }
890: }
891: else if ((*s_objet_1).type == REL)
892: {
893: if ((s_objet_resultat = allocation(s_etat_processus, MRL))
894: == NULL)
895: {
896: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
897: return;
898: }
899:
900: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
901: nombre_lignes;
902: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
903: nombre_colonnes;
904:
905: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
906: malloc(nombre_lignes * sizeof(real8 *))) == NULL)
907: {
908: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
909: return;
910: }
911:
912: for(i = 0; i < nombre_lignes; i++)
913: {
914: if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat)
915: .objet)).tableau)[i] = malloc(
916: nombre_colonnes * sizeof(real8))) == NULL)
917: {
918: (*s_etat_processus).erreur_systeme =
919: d_es_allocation_memoire;
920: return;
921: }
922:
923: for(j = 0; j < nombre_colonnes; j++)
924: {
925: ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
926: .objet)).tableau)[i][j] = (*((real8 *)
927: (*s_objet_1).objet));
928: }
929: }
930: }
931: else
932: {
933: if ((s_objet_resultat = allocation(s_etat_processus, MCX))
934: == NULL)
935: {
936: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
937: return;
938: }
939:
940: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
941: nombre_lignes;
942: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
943: nombre_colonnes;
944:
945: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
946: malloc(nombre_lignes * sizeof(struct_complexe16 *)))
947: == NULL)
948: {
949: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
950: return;
951: }
952:
953: for(i = 0; i < nombre_lignes; i++)
954: {
955: if ((((struct_complexe16 **) (*((struct_matrice *)
956: (*s_objet_resultat).objet)).tableau)[i] =
957: malloc(nombre_colonnes *
958: sizeof(struct_complexe16))) == NULL)
959: {
960: (*s_etat_processus).erreur_systeme =
961: d_es_allocation_memoire;
962: return;
963: }
964:
965: for(j = 0; j < nombre_colonnes; j++)
966: {
967: ((struct_complexe16 **) (*((struct_matrice *)
968: (*s_objet_resultat).objet)).tableau)[i][j]
969: .partie_reelle = (*((struct_complexe16 *)
970: (*s_objet_1).objet)).partie_reelle;
971: ((struct_complexe16 **) (*((struct_matrice *)
972: (*s_objet_resultat).objet)).tableau)[i][j]
973: .partie_imaginaire = (*((struct_complexe16 *)
974: (*s_objet_1).objet)).partie_imaginaire;
975: }
976: }
977: }
978: }
979:
980: liberation(s_etat_processus, s_objet_1);
981: liberation(s_etat_processus, s_objet_2);
982:
983: if (argument_nom == d_faux)
984: {
985: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
986: s_objet_resultat) == d_erreur)
987: {
988: return;
989: }
990: }
991: else
992: {
993: (*(*s_etat_processus).pointeur_variable_courante).objet =
994: s_objet_resultat;
995: }
996:
997: return;
998: }
999:
1000:
1001: /*
1002: ================================================================================
1003: Fonction 'cross'
1004: ================================================================================
1005: Entrées : structure processus
1006: --------------------------------------------------------------------------------
1007: Sorties :
1008: --------------------------------------------------------------------------------
1009: Effets de bord : néant
1010: ================================================================================
1011: */
1012:
1013: void
1014: instruction_cross(struct_processus *s_etat_processus)
1015: {
1016: integer8 tampon_1;
1017: integer8 tampon_2;
1018:
1019: logical1 depassement;
1020:
1021: struct_complexe16 registre_a;
1022: struct_complexe16 registre_b;
1023:
1024: struct_objet *s_objet_argument_1;
1025: struct_objet *s_objet_argument_2;
1026: struct_objet *s_objet_resultat;
1027:
1028: (*s_etat_processus).erreur_execution = d_ex;
1029:
1030: if ((*s_etat_processus).affichage_arguments == 'Y')
1031: {
1032: printf("\n CROSS ");
1033:
1034: if ((*s_etat_processus).langue == 'F')
1035: {
1036: printf("(produit vectoriel)\n\n");
1037: }
1038: else
1039: {
1040: printf("(product of vectors)\n\n");
1041: }
1042:
1043: printf(" 2: %s, %s\n", d_VIN, d_VRL);
1044: printf(" 1: %s, %s\n", d_VIN, d_VRL);
1045: printf("-> 1: %s, %s\n\n", d_VIN, d_VRL);
1046:
1047: printf(" 2: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
1048: printf(" 1: %s\n", d_VCX);
1049: printf("-> 1: %s\n\n", d_VCX);
1050:
1051: printf(" 2: %s\n", d_VCX);
1052: printf(" 1: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
1053: printf("-> 1: %s\n", d_VCX);
1054:
1055: return;
1056: }
1057: else if ((*s_etat_processus).test_instruction == 'Y')
1058: {
1059: (*s_etat_processus).nombre_arguments = -1;
1060: return;
1061: }
1062:
1063: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1064: {
1065: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
1066: {
1067: return;
1068: }
1069: }
1070:
1071: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1072: &s_objet_argument_1) == d_erreur)
1073: {
1074: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1075: return;
1076: }
1077:
1078: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1079: &s_objet_argument_2) == d_erreur)
1080: {
1081: liberation(s_etat_processus, s_objet_argument_1);
1082:
1083: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1084: return;
1085: }
1086:
1087: /*
1088: --------------------------------------------------------------------------------
1089: Résultat entier
1090: --------------------------------------------------------------------------------
1091: */
1092:
1093: if (((*s_objet_argument_1).type == VIN) &&
1094: ((*s_objet_argument_2).type == VIN))
1095: {
1096: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1097: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1098: != 3))
1099: {
1100: liberation(s_etat_processus, s_objet_argument_1);
1101: liberation(s_etat_processus, s_objet_argument_2);
1102:
1103: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1104: return;
1105: }
1106:
1107: if ((s_objet_resultat = allocation(s_etat_processus, VIN))
1108: == NULL)
1109: {
1110: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1111: return;
1112: }
1113:
1114: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1115:
1116: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1117: malloc(3 * sizeof(integer8))) == NULL)
1118: {
1119: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1120: return;
1121: }
1122:
1123: depassement = depassement_multiplication(&(((integer8 *)
1124: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1125: .tableau)[1]), &(((integer8 *) (*((struct_vecteur *)
1126: (*s_objet_argument_1).objet)).tableau)[2]), &(tampon_1));
1127:
1128: depassement |= depassement_multiplication(&(((integer8 *)
1129: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1130: .tableau)[2]), &(((integer8 *) (*((struct_vecteur *)
1131: (*s_objet_argument_1).objet)).tableau)[1]), &(tampon_2));
1132:
1133: tampon_2 = -tampon_2;
1134:
1135: depassement |= depassement_addition(&(tampon_1), &(tampon_2),
1136: &(((integer8 *) (*((struct_vecteur *) (*s_objet_resultat)
1137: .objet)).tableau)[0]));
1138:
1139: depassement |= depassement_multiplication(&(((integer8 *)
1140: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1141: .tableau)[2]), &(((integer8 *) (*((struct_vecteur *)
1142: (*s_objet_argument_1).objet)).tableau)[0]), &(tampon_1));
1143:
1144: depassement |= depassement_multiplication(&(((integer8 *)
1145: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1146: .tableau)[0]), &(((integer8 *) (*((struct_vecteur *)
1147: (*s_objet_argument_1).objet)).tableau)[2]), &(tampon_2));
1148:
1149: tampon_2 = -tampon_2;
1150:
1151: depassement |= depassement_addition(&(tampon_1), &(tampon_2),
1152: &(((integer8 *) (*((struct_vecteur *) (*s_objet_resultat)
1153: .objet)).tableau)[1]));
1154:
1155: depassement |= depassement_multiplication(&(((integer8 *)
1156: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1157: .tableau)[0]), &(((integer8 *) (*((struct_vecteur *)
1158: (*s_objet_argument_1).objet)).tableau)[1]), &(tampon_1));
1159:
1160: depassement |= depassement_multiplication(&(((integer8 *)
1161: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1162: .tableau)[1]), &(((integer8 *) (*((struct_vecteur *)
1163: (*s_objet_argument_1).objet)).tableau)[0]), &(tampon_2));
1164:
1165: tampon_2 = -tampon_2;
1166:
1167: depassement |= depassement_addition(&(tampon_1), &(tampon_2),
1168: &(((integer8 *) (*((struct_vecteur *) (*s_objet_resultat)
1169: .objet)).tableau)[2]));
1170:
1171: if (depassement != d_absence_erreur)
1172: {
1173: (*s_objet_resultat).type = VRL;
1174: (*((struct_vecteur *) (*s_objet_resultat).objet)).type = 'R';
1175: free((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau);
1176:
1177: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1178: malloc(3 * sizeof(real8))) == NULL)
1179: {
1180: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1181: return;
1182: }
1183:
1184: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1185: .tableau)[0] = ((real8) ((integer8 *) (*((struct_vecteur *)
1186: (*s_objet_argument_2).objet)).tableau)[1] * (real8)
1187: ((integer8 *) (*((struct_vecteur *) (*s_objet_argument_1)
1188: .objet)).tableau)[2]) - ((real8) ((integer8 *)
1189: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1190: .tableau)[2] * (real8) ((integer8 *) (*((struct_vecteur *)
1191: (*s_objet_argument_1).objet)).tableau)[1]);
1192: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1193: .tableau)[1] = ((real8) ((integer8 *) (*((struct_vecteur *)
1194: (*s_objet_argument_2).objet)).tableau)[2] * (real8)
1195: ((integer8 *) (*((struct_vecteur *) (*s_objet_argument_1)
1196: .objet)).tableau)[0]) - ((real8) ((integer8 *)
1197: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1198: .tableau)[0] * (real8) ((integer8 *) (*((struct_vecteur *)
1199: (*s_objet_argument_1).objet)).tableau)[2]);
1200: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1201: .tableau)[2] = ((real8) ((integer8 *) (*((struct_vecteur *)
1202: (*s_objet_argument_2).objet)).tableau)[0] * (real8)
1203: ((integer8 *) (*((struct_vecteur *) (*s_objet_argument_1)
1204: .objet)).tableau)[1]) - ((real8) ((integer8 *)
1205: (*((struct_vecteur *) (*s_objet_argument_2)
1206: .objet)).tableau)[1] * (real8) ((integer8 *)
1207: (*((struct_vecteur *) (*s_objet_argument_1).objet))
1208: .tableau)[0]);
1209: }
1210: }
1211:
1212: /*
1213: --------------------------------------------------------------------------------
1214: Résultat réel
1215: --------------------------------------------------------------------------------
1216: */
1217:
1218: else if (((*s_objet_argument_1).type == VRL) &&
1219: ((*s_objet_argument_2).type == VIN))
1220: {
1221: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1222: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1223: != 3))
1224: {
1225: liberation(s_etat_processus, s_objet_argument_1);
1226: liberation(s_etat_processus, s_objet_argument_2);
1227:
1228: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1229: return;
1230: }
1231:
1232: if ((s_objet_resultat = allocation(s_etat_processus, VRL))
1233: == NULL)
1234: {
1235: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1236: return;
1237: }
1238:
1239: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1240:
1241: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1242: malloc(3 * sizeof(real8))) == NULL)
1243: {
1244: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1245: return;
1246: }
1247:
1248: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1249: .tableau)[0] = (((integer8 *) (*((struct_vecteur *)
1250: (*s_objet_argument_2).objet)).tableau)[1] * ((real8 *)
1251: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[2])
1252: - (((integer8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1253: .objet)).tableau)[2] * ((real8 *) (*((struct_vecteur *)
1254: (*s_objet_argument_1).objet)).tableau)[1]);
1255: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1256: .tableau)[1] = (((integer8 *) (*((struct_vecteur *)
1257: (*s_objet_argument_2).objet)).tableau)[2] * ((real8 *)
1258: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[0])
1259: - (((integer8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1260: .objet)).tableau)[0] * ((real8 *) (*((struct_vecteur *)
1261: (*s_objet_argument_1).objet)).tableau)[2]);
1262: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1263: .tableau)[2] = (((integer8 *) (*((struct_vecteur *)
1264: (*s_objet_argument_2).objet)).tableau)[0] * ((real8 *)
1265: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[1])
1266: - (((integer8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1267: .objet)).tableau)[1] * ((real8 *) (*((struct_vecteur *)
1268: (*s_objet_argument_1).objet)).tableau)[0]);
1269: }
1270: else if (((*s_objet_argument_1).type == VIN) &&
1271: ((*s_objet_argument_2).type == VRL))
1272: {
1273: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1274: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1275: != 3))
1276: {
1277: liberation(s_etat_processus, s_objet_argument_1);
1278: liberation(s_etat_processus, s_objet_argument_2);
1279:
1280: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1281: return;
1282: }
1283:
1284: if ((s_objet_resultat = allocation(s_etat_processus, VRL))
1285: == NULL)
1286: {
1287: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1288: return;
1289: }
1290:
1291: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1292:
1293: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1294: malloc(3 * sizeof(real8))) == NULL)
1295: {
1296: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1297: return;
1298: }
1299:
1300: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1301: .tableau)[0] = (((real8 *) (*((struct_vecteur *)
1302: (*s_objet_argument_2).objet)).tableau)[1] * ((integer8 *)
1303: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[2])
1304: - (((real8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1305: .objet)).tableau)[2] * ((integer8 *) (*((struct_vecteur *)
1306: (*s_objet_argument_1).objet)).tableau)[1]);
1307: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1308: .tableau)[1] = (((real8 *) (*((struct_vecteur *)
1309: (*s_objet_argument_2).objet)).tableau)[2] * ((integer8 *)
1310: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[0])
1311: - (((real8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1312: .objet)).tableau)[0] * ((integer8 *) (*((struct_vecteur *)
1313: (*s_objet_argument_1).objet)).tableau)[2]);
1314: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1315: .tableau)[2] = (((real8 *) (*((struct_vecteur *)
1316: (*s_objet_argument_2).objet)).tableau)[0] * ((integer8 *)
1317: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[1])
1318: - (((real8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1319: .objet)).tableau)[1] * ((integer8 *) (*((struct_vecteur *)
1320: (*s_objet_argument_1).objet)).tableau)[0]);
1321: }
1322: else if (((*s_objet_argument_1).type == VRL) &&
1323: ((*s_objet_argument_2).type == VRL))
1324: {
1325: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1326: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1327: != 3))
1328: {
1329: liberation(s_etat_processus, s_objet_argument_1);
1330: liberation(s_etat_processus, s_objet_argument_2);
1331:
1332: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1333: return;
1334: }
1335:
1336: if ((s_objet_resultat = allocation(s_etat_processus, VRL))
1337: == NULL)
1338: {
1339: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1340: return;
1341: }
1342:
1343: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1344:
1345: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1346: malloc(3 * sizeof(real8))) == NULL)
1347: {
1348: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1349: return;
1350: }
1351:
1352: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1353: .tableau)[0] = (((real8 *) (*((struct_vecteur *)
1354: (*s_objet_argument_2).objet)).tableau)[1] * ((real8 *)
1355: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[2])
1356: - (((real8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1357: .objet)).tableau)[2] * ((real8 *) (*((struct_vecteur *)
1358: (*s_objet_argument_1).objet)).tableau)[1]);
1359: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1360: .tableau)[1] = (((real8 *) (*((struct_vecteur *)
1361: (*s_objet_argument_2).objet)).tableau)[2] * ((real8 *)
1362: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[0])
1363: - (((real8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1364: .objet)).tableau)[0] * ((real8 *) (*((struct_vecteur *)
1365: (*s_objet_argument_1).objet)).tableau)[2]);
1366: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1367: .tableau)[2] = (((real8 *) (*((struct_vecteur *)
1368: (*s_objet_argument_2).objet)).tableau)[0] * ((real8 *)
1369: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[1])
1370: - (((real8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1371: .objet)).tableau)[1] * ((real8 *) (*((struct_vecteur *)
1372: (*s_objet_argument_1).objet)).tableau)[0]);
1373: }
1374:
1375: /*
1376: --------------------------------------------------------------------------------
1377: Résultat complexe
1378: --------------------------------------------------------------------------------
1379: */
1380:
1381: else if (((*s_objet_argument_1).type == VIN) &&
1382: ((*s_objet_argument_2).type == VCX))
1383: {
1384: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1385: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1386: != 3))
1387: {
1388: liberation(s_etat_processus, s_objet_argument_1);
1389: liberation(s_etat_processus, s_objet_argument_2);
1390:
1391: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1392: return;
1393: }
1394:
1395: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
1396: == NULL)
1397: {
1398: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1399: return;
1400: }
1401:
1402: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1403:
1404: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1405: malloc(3 * sizeof(struct_complexe16))) == NULL)
1406: {
1407: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1408: return;
1409: }
1410:
1411: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1412: (*s_objet_argument_2).objet)).tableau)[1]),
1413: &(((integer8 *) (*((struct_vecteur *)
1414: (*s_objet_argument_1).objet)).tableau)[2]), ®istre_a);
1415: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1416: (*s_objet_argument_2).objet)).tableau)[2]),
1417: &(((integer8 *) (*((struct_vecteur *)
1418: (*s_objet_argument_1).objet)).tableau)[1]), ®istre_b);
1419: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1420: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[0]));
1421:
1422: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1423: (*s_objet_argument_2).objet)).tableau)[2]),
1424: &(((integer8 *) (*((struct_vecteur *)
1425: (*s_objet_argument_1).objet)).tableau)[0]), ®istre_a);
1426: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1427: (*s_objet_argument_2).objet)).tableau)[0]),
1428: &(((integer8 *) (*((struct_vecteur *)
1429: (*s_objet_argument_1).objet)).tableau)[2]), ®istre_b);
1430: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1431: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[1]));
1432:
1433: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1434: (*s_objet_argument_2).objet)).tableau)[0]),
1435: &(((integer8 *) (*((struct_vecteur *)
1436: (*s_objet_argument_1).objet)).tableau)[1]), ®istre_a);
1437: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1438: (*s_objet_argument_2).objet)).tableau)[1]),
1439: &(((integer8 *) (*((struct_vecteur *)
1440: (*s_objet_argument_1).objet)).tableau)[0]), ®istre_b);
1441: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1442: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[2]));
1443: }
1444: else if (((*s_objet_argument_1).type == VRL) &&
1445: ((*s_objet_argument_2).type == VCX))
1446: {
1447: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1448: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1449: != 3))
1450: {
1451: liberation(s_etat_processus, s_objet_argument_1);
1452: liberation(s_etat_processus, s_objet_argument_2);
1453:
1454: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1455: return;
1456: }
1457:
1458: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
1459: == NULL)
1460: {
1461: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1462: return;
1463: }
1464:
1465: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1466:
1467: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1468: malloc(3 * sizeof(struct_complexe16))) == NULL)
1469: {
1470: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1471: return;
1472: }
1473:
1474: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1475: (*s_objet_argument_2).objet)).tableau)[1]),
1476: &(((real8 *) (*((struct_vecteur *)
1477: (*s_objet_argument_1).objet)).tableau)[2]), ®istre_a);
1478: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1479: (*s_objet_argument_2).objet)).tableau)[2]),
1480: &(((real8 *) (*((struct_vecteur *)
1481: (*s_objet_argument_1).objet)).tableau)[1]), ®istre_b);
1482: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1483: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[0]));
1484:
1485: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1486: (*s_objet_argument_2).objet)).tableau)[2]),
1487: &(((real8 *) (*((struct_vecteur *)
1488: (*s_objet_argument_1).objet)).tableau)[0]), ®istre_a);
1489: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1490: (*s_objet_argument_2).objet)).tableau)[0]),
1491: &(((real8 *) (*((struct_vecteur *)
1492: (*s_objet_argument_1).objet)).tableau)[2]), ®istre_b);
1493: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1494: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[1]));
1495:
1496: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1497: (*s_objet_argument_2).objet)).tableau)[0]),
1498: &(((real8 *) (*((struct_vecteur *)
1499: (*s_objet_argument_1).objet)).tableau)[1]), ®istre_a);
1500: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1501: (*s_objet_argument_2).objet)).tableau)[1]),
1502: &(((real8 *) (*((struct_vecteur *)
1503: (*s_objet_argument_1).objet)).tableau)[0]), ®istre_b);
1504: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1505: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[2]));
1506: }
1507: else if (((*s_objet_argument_1).type == VCX) &&
1508: ((*s_objet_argument_2).type == VCX))
1509: {
1510: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1511: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1512: != 3))
1513: {
1514: liberation(s_etat_processus, s_objet_argument_1);
1515: liberation(s_etat_processus, s_objet_argument_2);
1516:
1517: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1518: return;
1519: }
1520:
1521: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
1522: == NULL)
1523: {
1524: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1525: return;
1526: }
1527:
1528: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1529:
1530: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1531: malloc(3 * sizeof(struct_complexe16))) == NULL)
1532: {
1533: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1534: return;
1535: }
1536:
1537: f77multiplicationcc_((&((struct_complexe16 *) (*((struct_vecteur *)
1538: (*s_objet_argument_2).objet)).tableau)[1]),
1539: &(((struct_complexe16 *) (*((struct_vecteur *)
1540: (*s_objet_argument_1).objet)).tableau)[2]), ®istre_a);
1541: f77multiplicationcc_((&((struct_complexe16 *) (*((struct_vecteur *)
1542: (*s_objet_argument_2).objet)).tableau)[2]),
1543: &(((struct_complexe16 *) (*((struct_vecteur *)
1544: (*s_objet_argument_1).objet)).tableau)[1]), ®istre_b);
1545: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1546: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[0]));
1547:
1548: f77multiplicationcc_((&((struct_complexe16 *) (*((struct_vecteur *)
1549: (*s_objet_argument_2).objet)).tableau)[2]),
1550: &(((struct_complexe16 *) (*((struct_vecteur *)
1551: (*s_objet_argument_1).objet)).tableau)[0]), ®istre_a);
1552: f77multiplicationcc_((&((struct_complexe16 *) (*((struct_vecteur *)
1553: (*s_objet_argument_2).objet)).tableau)[0]),
1554: &(((struct_complexe16 *) (*((struct_vecteur *)
1555: (*s_objet_argument_1).objet)).tableau)[2]), ®istre_b);
1556: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1557: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[1]));
1558:
1559: f77multiplicationcc_((&((struct_complexe16 *) (*((struct_vecteur *)
1560: (*s_objet_argument_2).objet)).tableau)[0]),
1561: &(((struct_complexe16 *) (*((struct_vecteur *)
1562: (*s_objet_argument_1).objet)).tableau)[1]), ®istre_a);
1563: f77multiplicationcc_((&((struct_complexe16 *) (*((struct_vecteur *)
1564: (*s_objet_argument_2).objet)).tableau)[1]),
1565: &(((struct_complexe16 *) (*((struct_vecteur *)
1566: (*s_objet_argument_1).objet)).tableau)[0]), ®istre_b);
1567: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1568: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[2]));
1569: }
1570: else if (((*s_objet_argument_2).type == VRL) &&
1571: ((*s_objet_argument_1).type == VCX))
1572: {
1573: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1574: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1575: != 3))
1576: {
1577: liberation(s_etat_processus, s_objet_argument_1);
1578: liberation(s_etat_processus, s_objet_argument_2);
1579:
1580: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1581: return;
1582: }
1583:
1584: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
1585: == NULL)
1586: {
1587: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1588: return;
1589: }
1590:
1591: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1592:
1593: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1594: malloc(3 * sizeof(struct_complexe16))) == NULL)
1595: {
1596: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1597: return;
1598: }
1599:
1600: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1601: (*s_objet_argument_1).objet)).tableau)[1]),
1602: &(((real8 *) (*((struct_vecteur *)
1603: (*s_objet_argument_2).objet)).tableau)[2]), ®istre_b);
1604: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1605: (*s_objet_argument_1).objet)).tableau)[2]),
1606: &(((real8 *) (*((struct_vecteur *)
1607: (*s_objet_argument_2).objet)).tableau)[1]), ®istre_a);
1608: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1609: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[0]));
1610:
1611: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1612: (*s_objet_argument_1).objet)).tableau)[2]),
1613: &(((real8 *) (*((struct_vecteur *)
1614: (*s_objet_argument_2).objet)).tableau)[0]), ®istre_b);
1615: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1616: (*s_objet_argument_1).objet)).tableau)[0]),
1617: &(((real8 *) (*((struct_vecteur *)
1618: (*s_objet_argument_2).objet)).tableau)[2]), ®istre_a);
1619: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1620: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[1]));
1621:
1622: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1623: (*s_objet_argument_1).objet)).tableau)[0]),
1624: &(((real8 *) (*((struct_vecteur *)
1625: (*s_objet_argument_2).objet)).tableau)[1]), ®istre_b);
1626: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1627: (*s_objet_argument_1).objet)).tableau)[1]),
1628: &(((real8 *) (*((struct_vecteur *)
1629: (*s_objet_argument_2).objet)).tableau)[0]), ®istre_a);
1630: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1631: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[2]));
1632: }
1633: else if (((*s_objet_argument_2).type == VIN) &&
1634: ((*s_objet_argument_1).type == VCX))
1635: {
1636: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1637: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1638: != 3))
1639: {
1640: liberation(s_etat_processus, s_objet_argument_1);
1641: liberation(s_etat_processus, s_objet_argument_2);
1642:
1643: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1644: return;
1645: }
1646:
1647: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
1648: == NULL)
1649: {
1650: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1651: return;
1652: }
1653:
1654: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1655:
1656: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1657: malloc(3 * sizeof(struct_complexe16))) == NULL)
1658: {
1659: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1660: return;
1661: }
1662:
1663: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1664: (*s_objet_argument_1).objet)).tableau)[1]),
1665: &(((integer8 *) (*((struct_vecteur *)
1666: (*s_objet_argument_2).objet)).tableau)[2]), ®istre_b);
1667: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1668: (*s_objet_argument_1).objet)).tableau)[2]),
1669: &(((integer8 *) (*((struct_vecteur *)
1670: (*s_objet_argument_2).objet)).tableau)[1]), ®istre_a);
1671: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1672: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[0]));
1673:
1674: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1675: (*s_objet_argument_1).objet)).tableau)[2]),
1676: &(((integer8 *) (*((struct_vecteur *)
1677: (*s_objet_argument_2).objet)).tableau)[0]), ®istre_b);
1678: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1679: (*s_objet_argument_1).objet)).tableau)[0]),
1680: &(((integer8 *) (*((struct_vecteur *)
1681: (*s_objet_argument_2).objet)).tableau)[2]), ®istre_a);
1682: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1683: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[1]));
1684:
1685: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1686: (*s_objet_argument_1).objet)).tableau)[0]),
1687: &(((integer8 *) (*((struct_vecteur *)
1688: (*s_objet_argument_2).objet)).tableau)[1]), ®istre_b);
1689: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1690: (*s_objet_argument_1).objet)).tableau)[1]),
1691: &(((integer8 *) (*((struct_vecteur *)
1692: (*s_objet_argument_2).objet)).tableau)[0]), ®istre_a);
1693: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1694: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[2]));
1695: }
1696:
1697: /*
1698: --------------------------------------------------------------------------------
1699: Types incompatibles avec la fonction CROSS
1700: --------------------------------------------------------------------------------
1701: */
1702:
1703: else
1704: {
1705: liberation(s_etat_processus, s_objet_argument_1);
1706: liberation(s_etat_processus, s_objet_argument_2);
1707:
1708: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1709: return;
1710: }
1711:
1712: liberation(s_etat_processus, s_objet_argument_1);
1713: liberation(s_etat_processus, s_objet_argument_2);
1714:
1715: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1716: s_objet_resultat) == d_erreur)
1717: {
1718: return;
1719: }
1720:
1721: return;
1722: }
1723:
1724: // 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