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