Annotation of rpl/src/instructions_c2.c, revision 1.43
1.1 bertrand 1: /*
2: ================================================================================
1.40 bertrand 3: RPL/2 (R) version 4.1.11
1.31 bertrand 4: Copyright (C) 1989-2012 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:
1193: tampon_2 = -tampon_2;
1194:
1195: depassement |= depassement_addition(&(tampon_1), &(tampon_2),
1196: &(((integer8 *) (*((struct_vecteur *) (*s_objet_resultat)
1197: .objet)).tableau)[0]));
1198:
1199: depassement |= depassement_multiplication(&(((integer8 *)
1200: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1201: .tableau)[2]), &(((integer8 *) (*((struct_vecteur *)
1202: (*s_objet_argument_1).objet)).tableau)[0]), &(tampon_1));
1203:
1204: depassement |= depassement_multiplication(&(((integer8 *)
1205: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1206: .tableau)[0]), &(((integer8 *) (*((struct_vecteur *)
1207: (*s_objet_argument_1).objet)).tableau)[2]), &(tampon_2));
1208:
1209: tampon_2 = -tampon_2;
1210:
1211: depassement |= depassement_addition(&(tampon_1), &(tampon_2),
1212: &(((integer8 *) (*((struct_vecteur *) (*s_objet_resultat)
1213: .objet)).tableau)[1]));
1214:
1215: depassement |= depassement_multiplication(&(((integer8 *)
1216: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1217: .tableau)[0]), &(((integer8 *) (*((struct_vecteur *)
1218: (*s_objet_argument_1).objet)).tableau)[1]), &(tampon_1));
1219:
1220: depassement |= depassement_multiplication(&(((integer8 *)
1221: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1222: .tableau)[1]), &(((integer8 *) (*((struct_vecteur *)
1223: (*s_objet_argument_1).objet)).tableau)[0]), &(tampon_2));
1224:
1225: tampon_2 = -tampon_2;
1226:
1227: depassement |= depassement_addition(&(tampon_1), &(tampon_2),
1228: &(((integer8 *) (*((struct_vecteur *) (*s_objet_resultat)
1229: .objet)).tableau)[2]));
1230:
1231: if (depassement != d_absence_erreur)
1232: {
1233: (*s_objet_resultat).type = VRL;
1234: (*((struct_vecteur *) (*s_objet_resultat).objet)).type = 'R';
1235: free((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau);
1236:
1237: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1238: malloc(3 * sizeof(real8))) == NULL)
1239: {
1240: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1241: return;
1242: }
1243:
1244: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1245: .tableau)[0] = ((real8) ((integer8 *) (*((struct_vecteur *)
1246: (*s_objet_argument_2).objet)).tableau)[1] * (real8)
1247: ((integer8 *) (*((struct_vecteur *) (*s_objet_argument_1)
1248: .objet)).tableau)[2]) - ((real8) ((integer8 *)
1249: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1250: .tableau)[2] * (real8) ((integer8 *) (*((struct_vecteur *)
1251: (*s_objet_argument_1).objet)).tableau)[1]);
1252: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1253: .tableau)[1] = ((real8) ((integer8 *) (*((struct_vecteur *)
1254: (*s_objet_argument_2).objet)).tableau)[2] * (real8)
1255: ((integer8 *) (*((struct_vecteur *) (*s_objet_argument_1)
1256: .objet)).tableau)[0]) - ((real8) ((integer8 *)
1257: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1258: .tableau)[0] * (real8) ((integer8 *) (*((struct_vecteur *)
1259: (*s_objet_argument_1).objet)).tableau)[2]);
1260: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1261: .tableau)[2] = ((real8) ((integer8 *) (*((struct_vecteur *)
1262: (*s_objet_argument_2).objet)).tableau)[0] * (real8)
1263: ((integer8 *) (*((struct_vecteur *) (*s_objet_argument_1)
1264: .objet)).tableau)[1]) - ((real8) ((integer8 *)
1265: (*((struct_vecteur *) (*s_objet_argument_2)
1266: .objet)).tableau)[1] * (real8) ((integer8 *)
1267: (*((struct_vecteur *) (*s_objet_argument_1).objet))
1268: .tableau)[0]);
1269: }
1270: }
1271:
1272: /*
1273: --------------------------------------------------------------------------------
1274: Résultat réel
1275: --------------------------------------------------------------------------------
1276: */
1277:
1278: else if (((*s_objet_argument_1).type == VRL) &&
1279: ((*s_objet_argument_2).type == VIN))
1280: {
1281: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1282: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1283: != 3))
1284: {
1285: liberation(s_etat_processus, s_objet_argument_1);
1286: liberation(s_etat_processus, s_objet_argument_2);
1287:
1288: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1289: return;
1290: }
1291:
1292: if ((s_objet_resultat = allocation(s_etat_processus, VRL))
1293: == NULL)
1294: {
1295: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1296: return;
1297: }
1298:
1299: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1300:
1301: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1302: malloc(3 * sizeof(real8))) == NULL)
1303: {
1304: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1305: return;
1306: }
1307:
1308: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1309: .tableau)[0] = (((integer8 *) (*((struct_vecteur *)
1310: (*s_objet_argument_2).objet)).tableau)[1] * ((real8 *)
1311: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[2])
1312: - (((integer8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1313: .objet)).tableau)[2] * ((real8 *) (*((struct_vecteur *)
1314: (*s_objet_argument_1).objet)).tableau)[1]);
1315: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1316: .tableau)[1] = (((integer8 *) (*((struct_vecteur *)
1317: (*s_objet_argument_2).objet)).tableau)[2] * ((real8 *)
1318: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[0])
1319: - (((integer8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1320: .objet)).tableau)[0] * ((real8 *) (*((struct_vecteur *)
1321: (*s_objet_argument_1).objet)).tableau)[2]);
1322: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1323: .tableau)[2] = (((integer8 *) (*((struct_vecteur *)
1324: (*s_objet_argument_2).objet)).tableau)[0] * ((real8 *)
1325: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[1])
1326: - (((integer8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1327: .objet)).tableau)[1] * ((real8 *) (*((struct_vecteur *)
1328: (*s_objet_argument_1).objet)).tableau)[0]);
1329: }
1330: else if (((*s_objet_argument_1).type == VIN) &&
1331: ((*s_objet_argument_2).type == VRL))
1332: {
1333: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1334: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1335: != 3))
1336: {
1337: liberation(s_etat_processus, s_objet_argument_1);
1338: liberation(s_etat_processus, s_objet_argument_2);
1339:
1340: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1341: return;
1342: }
1343:
1344: if ((s_objet_resultat = allocation(s_etat_processus, VRL))
1345: == NULL)
1346: {
1347: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1348: return;
1349: }
1350:
1351: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1352:
1353: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1354: malloc(3 * sizeof(real8))) == NULL)
1355: {
1356: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1357: return;
1358: }
1359:
1360: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1361: .tableau)[0] = (((real8 *) (*((struct_vecteur *)
1362: (*s_objet_argument_2).objet)).tableau)[1] * ((integer8 *)
1363: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[2])
1364: - (((real8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1365: .objet)).tableau)[2] * ((integer8 *) (*((struct_vecteur *)
1366: (*s_objet_argument_1).objet)).tableau)[1]);
1367: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1368: .tableau)[1] = (((real8 *) (*((struct_vecteur *)
1369: (*s_objet_argument_2).objet)).tableau)[2] * ((integer8 *)
1370: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[0])
1371: - (((real8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1372: .objet)).tableau)[0] * ((integer8 *) (*((struct_vecteur *)
1373: (*s_objet_argument_1).objet)).tableau)[2]);
1374: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1375: .tableau)[2] = (((real8 *) (*((struct_vecteur *)
1376: (*s_objet_argument_2).objet)).tableau)[0] * ((integer8 *)
1377: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[1])
1378: - (((real8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1379: .objet)).tableau)[1] * ((integer8 *) (*((struct_vecteur *)
1380: (*s_objet_argument_1).objet)).tableau)[0]);
1381: }
1382: else if (((*s_objet_argument_1).type == VRL) &&
1383: ((*s_objet_argument_2).type == VRL))
1384: {
1385: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1386: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1387: != 3))
1388: {
1389: liberation(s_etat_processus, s_objet_argument_1);
1390: liberation(s_etat_processus, s_objet_argument_2);
1391:
1392: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1393: return;
1394: }
1395:
1396: if ((s_objet_resultat = allocation(s_etat_processus, VRL))
1397: == NULL)
1398: {
1399: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1400: return;
1401: }
1402:
1403: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1404:
1405: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1406: malloc(3 * sizeof(real8))) == NULL)
1407: {
1408: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1409: return;
1410: }
1411:
1412: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1413: .tableau)[0] = (((real8 *) (*((struct_vecteur *)
1414: (*s_objet_argument_2).objet)).tableau)[1] * ((real8 *)
1415: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[2])
1416: - (((real8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1417: .objet)).tableau)[2] * ((real8 *) (*((struct_vecteur *)
1418: (*s_objet_argument_1).objet)).tableau)[1]);
1419: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1420: .tableau)[1] = (((real8 *) (*((struct_vecteur *)
1421: (*s_objet_argument_2).objet)).tableau)[2] * ((real8 *)
1422: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[0])
1423: - (((real8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1424: .objet)).tableau)[0] * ((real8 *) (*((struct_vecteur *)
1425: (*s_objet_argument_1).objet)).tableau)[2]);
1426: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1427: .tableau)[2] = (((real8 *) (*((struct_vecteur *)
1428: (*s_objet_argument_2).objet)).tableau)[0] * ((real8 *)
1429: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[1])
1430: - (((real8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1431: .objet)).tableau)[1] * ((real8 *) (*((struct_vecteur *)
1432: (*s_objet_argument_1).objet)).tableau)[0]);
1433: }
1434:
1435: /*
1436: --------------------------------------------------------------------------------
1437: Résultat complexe
1438: --------------------------------------------------------------------------------
1439: */
1440:
1441: else if (((*s_objet_argument_1).type == VIN) &&
1442: ((*s_objet_argument_2).type == VCX))
1443: {
1444: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1445: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1446: != 3))
1447: {
1448: liberation(s_etat_processus, s_objet_argument_1);
1449: liberation(s_etat_processus, s_objet_argument_2);
1450:
1451: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1452: return;
1453: }
1454:
1455: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
1456: == NULL)
1457: {
1458: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1459: return;
1460: }
1461:
1462: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1463:
1464: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1465: malloc(3 * sizeof(struct_complexe16))) == NULL)
1466: {
1467: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1468: return;
1469: }
1470:
1471: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1472: (*s_objet_argument_2).objet)).tableau)[1]),
1473: &(((integer8 *) (*((struct_vecteur *)
1474: (*s_objet_argument_1).objet)).tableau)[2]), ®istre_a);
1475: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1476: (*s_objet_argument_2).objet)).tableau)[2]),
1477: &(((integer8 *) (*((struct_vecteur *)
1478: (*s_objet_argument_1).objet)).tableau)[1]), ®istre_b);
1479: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1480: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[0]));
1481:
1482: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1483: (*s_objet_argument_2).objet)).tableau)[2]),
1484: &(((integer8 *) (*((struct_vecteur *)
1485: (*s_objet_argument_1).objet)).tableau)[0]), ®istre_a);
1486: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1487: (*s_objet_argument_2).objet)).tableau)[0]),
1488: &(((integer8 *) (*((struct_vecteur *)
1489: (*s_objet_argument_1).objet)).tableau)[2]), ®istre_b);
1490: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1491: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[1]));
1492:
1493: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1494: (*s_objet_argument_2).objet)).tableau)[0]),
1495: &(((integer8 *) (*((struct_vecteur *)
1496: (*s_objet_argument_1).objet)).tableau)[1]), ®istre_a);
1497: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1498: (*s_objet_argument_2).objet)).tableau)[1]),
1499: &(((integer8 *) (*((struct_vecteur *)
1500: (*s_objet_argument_1).objet)).tableau)[0]), ®istre_b);
1501: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1502: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[2]));
1503: }
1504: else if (((*s_objet_argument_1).type == VRL) &&
1505: ((*s_objet_argument_2).type == VCX))
1506: {
1507: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1508: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1509: != 3))
1510: {
1511: liberation(s_etat_processus, s_objet_argument_1);
1512: liberation(s_etat_processus, s_objet_argument_2);
1513:
1514: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1515: return;
1516: }
1517:
1518: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
1519: == NULL)
1520: {
1521: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1522: return;
1523: }
1524:
1525: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1526:
1527: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1528: malloc(3 * sizeof(struct_complexe16))) == NULL)
1529: {
1530: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1531: return;
1532: }
1533:
1534: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1535: (*s_objet_argument_2).objet)).tableau)[1]),
1536: &(((real8 *) (*((struct_vecteur *)
1537: (*s_objet_argument_1).objet)).tableau)[2]), ®istre_a);
1538: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1539: (*s_objet_argument_2).objet)).tableau)[2]),
1540: &(((real8 *) (*((struct_vecteur *)
1541: (*s_objet_argument_1).objet)).tableau)[1]), ®istre_b);
1542: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1543: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[0]));
1544:
1545: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1546: (*s_objet_argument_2).objet)).tableau)[2]),
1547: &(((real8 *) (*((struct_vecteur *)
1548: (*s_objet_argument_1).objet)).tableau)[0]), ®istre_a);
1549: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1550: (*s_objet_argument_2).objet)).tableau)[0]),
1551: &(((real8 *) (*((struct_vecteur *)
1552: (*s_objet_argument_1).objet)).tableau)[2]), ®istre_b);
1553: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1554: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[1]));
1555:
1556: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1557: (*s_objet_argument_2).objet)).tableau)[0]),
1558: &(((real8 *) (*((struct_vecteur *)
1559: (*s_objet_argument_1).objet)).tableau)[1]), ®istre_a);
1560: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1561: (*s_objet_argument_2).objet)).tableau)[1]),
1562: &(((real8 *) (*((struct_vecteur *)
1563: (*s_objet_argument_1).objet)).tableau)[0]), ®istre_b);
1564: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1565: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[2]));
1566: }
1567: else if (((*s_objet_argument_1).type == VCX) &&
1568: ((*s_objet_argument_2).type == VCX))
1569: {
1570: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1571: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1572: != 3))
1573: {
1574: liberation(s_etat_processus, s_objet_argument_1);
1575: liberation(s_etat_processus, s_objet_argument_2);
1576:
1577: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1578: return;
1579: }
1580:
1581: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
1582: == NULL)
1583: {
1584: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1585: return;
1586: }
1587:
1588: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1589:
1590: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1591: malloc(3 * sizeof(struct_complexe16))) == NULL)
1592: {
1593: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1594: return;
1595: }
1596:
1597: f77multiplicationcc_((&((struct_complexe16 *) (*((struct_vecteur *)
1598: (*s_objet_argument_2).objet)).tableau)[1]),
1599: &(((struct_complexe16 *) (*((struct_vecteur *)
1600: (*s_objet_argument_1).objet)).tableau)[2]), ®istre_a);
1601: f77multiplicationcc_((&((struct_complexe16 *) (*((struct_vecteur *)
1602: (*s_objet_argument_2).objet)).tableau)[2]),
1603: &(((struct_complexe16 *) (*((struct_vecteur *)
1604: (*s_objet_argument_1).objet)).tableau)[1]), ®istre_b);
1605: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1606: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[0]));
1607:
1608: f77multiplicationcc_((&((struct_complexe16 *) (*((struct_vecteur *)
1609: (*s_objet_argument_2).objet)).tableau)[2]),
1610: &(((struct_complexe16 *) (*((struct_vecteur *)
1611: (*s_objet_argument_1).objet)).tableau)[0]), ®istre_a);
1612: f77multiplicationcc_((&((struct_complexe16 *) (*((struct_vecteur *)
1613: (*s_objet_argument_2).objet)).tableau)[0]),
1614: &(((struct_complexe16 *) (*((struct_vecteur *)
1615: (*s_objet_argument_1).objet)).tableau)[2]), ®istre_b);
1616: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1617: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[1]));
1618:
1619: f77multiplicationcc_((&((struct_complexe16 *) (*((struct_vecteur *)
1620: (*s_objet_argument_2).objet)).tableau)[0]),
1621: &(((struct_complexe16 *) (*((struct_vecteur *)
1622: (*s_objet_argument_1).objet)).tableau)[1]), ®istre_a);
1623: f77multiplicationcc_((&((struct_complexe16 *) (*((struct_vecteur *)
1624: (*s_objet_argument_2).objet)).tableau)[1]),
1625: &(((struct_complexe16 *) (*((struct_vecteur *)
1626: (*s_objet_argument_1).objet)).tableau)[0]), ®istre_b);
1627: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1628: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[2]));
1629: }
1630: else if (((*s_objet_argument_2).type == VRL) &&
1631: ((*s_objet_argument_1).type == VCX))
1632: {
1633: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1634: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1635: != 3))
1636: {
1637: liberation(s_etat_processus, s_objet_argument_1);
1638: liberation(s_etat_processus, s_objet_argument_2);
1639:
1640: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1641: return;
1642: }
1643:
1644: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
1645: == NULL)
1646: {
1647: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1648: return;
1649: }
1650:
1651: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1652:
1653: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1654: malloc(3 * sizeof(struct_complexe16))) == NULL)
1655: {
1656: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1657: return;
1658: }
1659:
1660: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1661: (*s_objet_argument_1).objet)).tableau)[1]),
1662: &(((real8 *) (*((struct_vecteur *)
1663: (*s_objet_argument_2).objet)).tableau)[2]), ®istre_b);
1664: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1665: (*s_objet_argument_1).objet)).tableau)[2]),
1666: &(((real8 *) (*((struct_vecteur *)
1667: (*s_objet_argument_2).objet)).tableau)[1]), ®istre_a);
1668: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1669: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[0]));
1670:
1671: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1672: (*s_objet_argument_1).objet)).tableau)[2]),
1673: &(((real8 *) (*((struct_vecteur *)
1674: (*s_objet_argument_2).objet)).tableau)[0]), ®istre_b);
1675: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1676: (*s_objet_argument_1).objet)).tableau)[0]),
1677: &(((real8 *) (*((struct_vecteur *)
1678: (*s_objet_argument_2).objet)).tableau)[2]), ®istre_a);
1679: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1680: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[1]));
1681:
1682: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1683: (*s_objet_argument_1).objet)).tableau)[0]),
1684: &(((real8 *) (*((struct_vecteur *)
1685: (*s_objet_argument_2).objet)).tableau)[1]), ®istre_b);
1686: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1687: (*s_objet_argument_1).objet)).tableau)[1]),
1688: &(((real8 *) (*((struct_vecteur *)
1689: (*s_objet_argument_2).objet)).tableau)[0]), ®istre_a);
1690: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1691: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[2]));
1692: }
1693: else if (((*s_objet_argument_2).type == VIN) &&
1694: ((*s_objet_argument_1).type == VCX))
1695: {
1696: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1697: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1698: != 3))
1699: {
1700: liberation(s_etat_processus, s_objet_argument_1);
1701: liberation(s_etat_processus, s_objet_argument_2);
1702:
1703: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1704: return;
1705: }
1706:
1707: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
1708: == NULL)
1709: {
1710: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1711: return;
1712: }
1713:
1714: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1715:
1716: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1717: malloc(3 * sizeof(struct_complexe16))) == NULL)
1718: {
1719: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1720: return;
1721: }
1722:
1723: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1724: (*s_objet_argument_1).objet)).tableau)[1]),
1725: &(((integer8 *) (*((struct_vecteur *)
1726: (*s_objet_argument_2).objet)).tableau)[2]), ®istre_b);
1727: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1728: (*s_objet_argument_1).objet)).tableau)[2]),
1729: &(((integer8 *) (*((struct_vecteur *)
1730: (*s_objet_argument_2).objet)).tableau)[1]), ®istre_a);
1731: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1732: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[0]));
1733:
1734: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1735: (*s_objet_argument_1).objet)).tableau)[2]),
1736: &(((integer8 *) (*((struct_vecteur *)
1737: (*s_objet_argument_2).objet)).tableau)[0]), ®istre_b);
1738: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1739: (*s_objet_argument_1).objet)).tableau)[0]),
1740: &(((integer8 *) (*((struct_vecteur *)
1741: (*s_objet_argument_2).objet)).tableau)[2]), ®istre_a);
1742: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1743: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[1]));
1744:
1745: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1746: (*s_objet_argument_1).objet)).tableau)[0]),
1747: &(((integer8 *) (*((struct_vecteur *)
1748: (*s_objet_argument_2).objet)).tableau)[1]), ®istre_b);
1749: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1750: (*s_objet_argument_1).objet)).tableau)[1]),
1751: &(((integer8 *) (*((struct_vecteur *)
1752: (*s_objet_argument_2).objet)).tableau)[0]), ®istre_a);
1753: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1754: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[2]));
1755: }
1756:
1757: /*
1758: --------------------------------------------------------------------------------
1759: Types incompatibles avec la fonction CROSS
1760: --------------------------------------------------------------------------------
1761: */
1762:
1763: else
1764: {
1765: liberation(s_etat_processus, s_objet_argument_1);
1766: liberation(s_etat_processus, s_objet_argument_2);
1767:
1768: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1769: return;
1770: }
1771:
1772: liberation(s_etat_processus, s_objet_argument_1);
1773: liberation(s_etat_processus, s_objet_argument_2);
1774:
1775: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1776: s_objet_resultat) == d_erreur)
1777: {
1778: return;
1779: }
1780:
1781: return;
1782: }
1783:
1784: // 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