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