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