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