Annotation of rpl/src/instructions_c2.c, revision 1.41
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.1 bertrand 565: == d_faux)
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;
591: }
592:
593: /*
594: --------------------------------------------------------------------------------
595: Tableau créé à partir d'une spécification de dimension
596: --------------------------------------------------------------------------------
597: */
598:
599: if ((*s_objet_2).type == LST)
600: {
601: l_element_courant = (*s_objet_2).objet;
602: nombre_dimensions = 0;
603:
604: while(l_element_courant != NULL)
605: {
606: nombre_dimensions++;
607: l_element_courant = (*l_element_courant).suivant;
608: }
609:
610: if ((nombre_dimensions != 1) && (nombre_dimensions != 2))
611: {
612: liberation(s_etat_processus, s_objet_1);
613:
614: if (argument_nom == d_faux)
615: {
616: liberation(s_etat_processus, s_objet_2);
617: }
1.41 ! bertrand 618: else
! 619: {
! 620: if (variable_partagee == d_vrai)
! 621: {
! 622: if (pthread_mutex_unlock(&((*(*s_etat_processus)
! 623: .pointeur_variable_partagee_courante).mutex)) != 0)
! 624: {
! 625: (*s_etat_processus).erreur_systeme = d_es_processus;
! 626: return;
! 627: }
! 628: }
! 629: }
1.1 bertrand 630:
631: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
632: return;
633: }
634:
635: nombre_colonnes = 0;
636: nombre_lignes = 0;
637:
638: l_element_courant = (*s_objet_2).objet;
639:
640: while(l_element_courant != NULL)
641: {
642: if ((*(*l_element_courant).donnee).type != INT)
643: {
644: liberation(s_etat_processus, s_objet_1);
645:
646: if (argument_nom == d_faux)
647: {
648: liberation(s_etat_processus, s_objet_2);
649: }
1.41 ! bertrand 650: else
! 651: {
! 652: if (variable_partagee == d_vrai)
! 653: {
! 654: if (pthread_mutex_unlock(&((*(*s_etat_processus)
! 655: .pointeur_variable_partagee_courante).mutex))
! 656: != 0)
! 657: {
! 658: (*s_etat_processus).erreur_systeme = d_es_processus;
! 659: return;
! 660: }
! 661: }
! 662: }
1.1 bertrand 663:
664: (*s_etat_processus).erreur_execution =
665: d_ex_erreur_type_argument;
666: return;
667: }
668:
669: if ((*((integer8 *) (*(*l_element_courant).donnee).objet)) <= 0)
670: {
671: liberation(s_etat_processus, s_objet_1);
672:
673: if (argument_nom == d_faux)
674: {
675: liberation(s_etat_processus, s_objet_2);
676: }
1.41 ! bertrand 677: else
! 678: {
! 679: if (variable_partagee == d_vrai)
! 680: {
! 681: if (pthread_mutex_unlock(&((*(*s_etat_processus)
! 682: .pointeur_variable_partagee_courante).mutex))
! 683: != 0)
! 684: {
! 685: (*s_etat_processus).erreur_systeme = d_es_processus;
! 686: return;
! 687: }
! 688: }
! 689: }
1.1 bertrand 690:
691: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
692: return;
693: }
694:
695: if (nombre_lignes == 0)
696: {
697: nombre_lignes = (*((integer8 *)
698: (*(*l_element_courant).donnee).objet));
699: }
700: else
701: {
702: nombre_colonnes = (*((integer8 *)
703: (*(*l_element_courant).donnee).objet));
704: }
705:
706: l_element_courant = (*l_element_courant).suivant;
707: }
708: }
709:
710: /*
711: --------------------------------------------------------------------------------
712: Tableau créé à partir des dimensions d'un autre tableau
713: --------------------------------------------------------------------------------
714: */
715:
716: else if (((*s_objet_2).type == VIN) ||
717: ((*s_objet_2).type == VRL) ||
718: ((*s_objet_2).type == VCX))
719: {
720: nombre_dimensions = 1;
721: nombre_lignes = (*((struct_vecteur *) (*s_objet_2).objet)).taille;
722: nombre_colonnes = 0;
723: }
724: else if (((*s_objet_2).type == MIN) ||
725: ((*s_objet_2).type == MRL) ||
726: ((*s_objet_2).type == MCX))
727: {
728: nombre_dimensions = 2;
729: nombre_lignes = (*((struct_matrice *) (*s_objet_2).objet))
730: .nombre_lignes;
731: nombre_colonnes = (*((struct_matrice *) (*s_objet_2).objet))
732: .nombre_colonnes;
733: }
734:
735: /*
736: --------------------------------------------------------------------------------
737: Spécifications incorrectes
738: --------------------------------------------------------------------------------
739: */
740:
741: else
742: {
743: if (argument_nom == d_faux)
744: {
745: liberation(s_etat_processus, s_objet_2);
746: }
1.41 ! bertrand 747: else
! 748: {
! 749: if (variable_partagee == d_vrai)
! 750: {
! 751: if (pthread_mutex_unlock(&((*(*s_etat_processus)
! 752: .pointeur_variable_partagee_courante).mutex)) != 0)
! 753: {
! 754: (*s_etat_processus).erreur_systeme = d_es_processus;
! 755: return;
! 756: }
! 757: }
! 758: }
1.1 bertrand 759:
760: liberation(s_etat_processus, s_objet_1);
761:
762: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
763: return;
764: }
765:
766: /*
767: --------------------------------------------------------------------------------
768: Création effective du tableau
769: --------------------------------------------------------------------------------
770: */
771:
772: if (((*s_objet_1).type != INT) &&
773: ((*s_objet_1).type != REL) &&
774: ((*s_objet_1).type != CPL))
775: {
776: if (argument_nom == d_faux)
777: {
778: liberation(s_etat_processus, s_objet_2);
779: }
1.41 ! bertrand 780: else
! 781: {
! 782: if (variable_partagee == d_vrai)
! 783: {
! 784: if (pthread_mutex_unlock(&((*(*s_etat_processus)
! 785: .pointeur_variable_partagee_courante).mutex)) != 0)
! 786: {
! 787: (*s_etat_processus).erreur_systeme = d_es_processus;
! 788: return;
! 789: }
! 790: }
! 791: }
1.1 bertrand 792:
793: liberation(s_etat_processus, s_objet_1);
794:
795: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
796: return;
797: }
798:
799: if (nombre_dimensions == 1)
800: {
801: /*
802: * Vecteur
803: */
804:
805: if ((*s_objet_1).type == INT)
806: {
807: if ((s_objet_resultat = allocation(s_etat_processus, VIN))
808: == NULL)
809: {
810: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
811: return;
812: }
813:
814: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
815: nombre_lignes;
816:
817: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
818: malloc(nombre_lignes * sizeof(integer8))) == NULL)
819: {
820: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
821: return;
822: }
823:
824: for(i = 0; i < nombre_lignes; i++)
825: {
826: ((integer8 *) (*((struct_vecteur *) (*s_objet_resultat)
827: .objet)).tableau)[i] = (*((integer8 *)
828: (*s_objet_1).objet));
829: }
830: }
831: else if ((*s_objet_1).type == REL)
832: {
833: if ((s_objet_resultat = allocation(s_etat_processus, VRL))
834: == NULL)
835: {
836: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
837: return;
838: }
839:
840: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
841: nombre_lignes;
842:
843: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
844: malloc(nombre_lignes * sizeof(real8))) == NULL)
845: {
846: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
847: return;
848: }
849:
850: for(i = 0; i < nombre_lignes; i++)
851: {
852: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat)
853: .objet)).tableau)[i] = (*((real8 *)
854: (*s_objet_1).objet));
855: }
856: }
857: else
858: {
859: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
860: == NULL)
861: {
862: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
863: return;
864: }
865:
866: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
867: nombre_lignes;
868:
869: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
870: malloc(nombre_lignes * sizeof(struct_complexe16))) == NULL)
871: {
872: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
873: return;
874: }
875:
876: for(i = 0; i < nombre_lignes; i++)
877: {
878: ((struct_complexe16 *) (*((struct_vecteur *) (*s_objet_resultat)
879: .objet)).tableau)[i].partie_reelle =
880: (*((struct_complexe16 *)
881: (*s_objet_1).objet)).partie_reelle;
882: ((struct_complexe16 *) (*((struct_vecteur *) (*s_objet_resultat)
883: .objet)).tableau)[i].partie_imaginaire =
884: (*((struct_complexe16 *)
885: (*s_objet_1).objet)).partie_imaginaire;
886: }
887: }
888: }
889: else
890: {
891: /*
892: * Matrice
893: */
894:
895: if ((*s_objet_1).type == INT)
896: {
897: if ((s_objet_resultat = allocation(s_etat_processus, MIN))
898: == NULL)
899: {
900: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
901: return;
902: }
903:
904: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
905: nombre_lignes;
906: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
907: nombre_colonnes;
908:
909: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
910: malloc(nombre_lignes * sizeof(integer8 *))) == NULL)
911: {
912: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
913: return;
914: }
915:
916: for(i = 0; i < nombre_lignes; i++)
917: {
918: if ((((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
919: .objet)).tableau)[i] = malloc(
920: nombre_colonnes * sizeof(integer8))) == NULL)
921: {
922: (*s_etat_processus).erreur_systeme =
923: d_es_allocation_memoire;
924: return;
925: }
926:
927: for(j = 0; j < nombre_colonnes; j++)
928: {
929: ((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
930: .objet)).tableau)[i][j] = (*((integer8 *)
931: (*s_objet_1).objet));
932: }
933: }
934: }
935: else if ((*s_objet_1).type == REL)
936: {
937: if ((s_objet_resultat = allocation(s_etat_processus, MRL))
938: == NULL)
939: {
940: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
941: return;
942: }
943:
944: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
945: nombre_lignes;
946: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
947: nombre_colonnes;
948:
949: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
950: malloc(nombre_lignes * sizeof(real8 *))) == NULL)
951: {
952: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
953: return;
954: }
955:
956: for(i = 0; i < nombre_lignes; i++)
957: {
958: if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat)
959: .objet)).tableau)[i] = malloc(
960: nombre_colonnes * sizeof(real8))) == NULL)
961: {
962: (*s_etat_processus).erreur_systeme =
963: d_es_allocation_memoire;
964: return;
965: }
966:
967: for(j = 0; j < nombre_colonnes; j++)
968: {
969: ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
970: .objet)).tableau)[i][j] = (*((real8 *)
971: (*s_objet_1).objet));
972: }
973: }
974: }
975: else
976: {
977: if ((s_objet_resultat = allocation(s_etat_processus, MCX))
978: == NULL)
979: {
980: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
981: return;
982: }
983:
984: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
985: nombre_lignes;
986: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
987: nombre_colonnes;
988:
989: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
990: malloc(nombre_lignes * sizeof(struct_complexe16 *)))
991: == NULL)
992: {
993: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
994: return;
995: }
996:
997: for(i = 0; i < nombre_lignes; i++)
998: {
999: if ((((struct_complexe16 **) (*((struct_matrice *)
1000: (*s_objet_resultat).objet)).tableau)[i] =
1001: malloc(nombre_colonnes *
1002: sizeof(struct_complexe16))) == NULL)
1003: {
1004: (*s_etat_processus).erreur_systeme =
1005: d_es_allocation_memoire;
1006: return;
1007: }
1008:
1009: for(j = 0; j < nombre_colonnes; j++)
1010: {
1011: ((struct_complexe16 **) (*((struct_matrice *)
1012: (*s_objet_resultat).objet)).tableau)[i][j]
1013: .partie_reelle = (*((struct_complexe16 *)
1014: (*s_objet_1).objet)).partie_reelle;
1015: ((struct_complexe16 **) (*((struct_matrice *)
1016: (*s_objet_resultat).objet)).tableau)[i][j]
1017: .partie_imaginaire = (*((struct_complexe16 *)
1018: (*s_objet_1).objet)).partie_imaginaire;
1019: }
1020: }
1021: }
1022: }
1023:
1024: liberation(s_etat_processus, s_objet_1);
1025: liberation(s_etat_processus, s_objet_2);
1026:
1027: if (argument_nom == d_faux)
1028: {
1029: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1030: s_objet_resultat) == d_erreur)
1031: {
1032: return;
1033: }
1034: }
1035: else
1036: {
1.41 ! bertrand 1037: if (variable_partagee == d_vrai)
! 1038: {
! 1039: (*(*s_etat_processus).pointeur_variable_partagee_courante).objet =
! 1040: s_objet_resultat;
! 1041:
! 1042: if (pthread_mutex_unlock(&((*(*s_etat_processus)
! 1043: .pointeur_variable_partagee_courante).mutex)) != 0)
! 1044: {
! 1045: (*s_etat_processus).erreur_systeme = d_es_processus;
! 1046: return;
! 1047: }
! 1048: }
! 1049: else
! 1050: {
! 1051: (*(*s_etat_processus).pointeur_variable_courante).objet =
! 1052: s_objet_resultat;
! 1053: }
1.1 bertrand 1054: }
1055:
1056: return;
1057: }
1058:
1059:
1060: /*
1061: ================================================================================
1062: Fonction 'cross'
1063: ================================================================================
1064: Entrées : structure processus
1065: --------------------------------------------------------------------------------
1066: Sorties :
1067: --------------------------------------------------------------------------------
1068: Effets de bord : néant
1069: ================================================================================
1070: */
1071:
1072: void
1073: instruction_cross(struct_processus *s_etat_processus)
1074: {
1075: integer8 tampon_1;
1076: integer8 tampon_2;
1077:
1078: logical1 depassement;
1079:
1080: struct_complexe16 registre_a;
1081: struct_complexe16 registre_b;
1082:
1083: struct_objet *s_objet_argument_1;
1084: struct_objet *s_objet_argument_2;
1085: struct_objet *s_objet_resultat;
1086:
1087: (*s_etat_processus).erreur_execution = d_ex;
1088:
1089: if ((*s_etat_processus).affichage_arguments == 'Y')
1090: {
1091: printf("\n CROSS ");
1092:
1093: if ((*s_etat_processus).langue == 'F')
1094: {
1095: printf("(produit vectoriel)\n\n");
1096: }
1097: else
1098: {
1099: printf("(product of vectors)\n\n");
1100: }
1101:
1102: printf(" 2: %s, %s\n", d_VIN, d_VRL);
1103: printf(" 1: %s, %s\n", d_VIN, d_VRL);
1104: printf("-> 1: %s, %s\n\n", d_VIN, d_VRL);
1105:
1106: printf(" 2: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
1107: printf(" 1: %s\n", d_VCX);
1108: printf("-> 1: %s\n\n", d_VCX);
1109:
1110: printf(" 2: %s\n", d_VCX);
1111: printf(" 1: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
1112: printf("-> 1: %s\n", d_VCX);
1113:
1114: return;
1115: }
1116: else if ((*s_etat_processus).test_instruction == 'Y')
1117: {
1118: (*s_etat_processus).nombre_arguments = -1;
1119: return;
1120: }
1121:
1122: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1123: {
1124: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
1125: {
1126: return;
1127: }
1128: }
1129:
1130: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1131: &s_objet_argument_1) == d_erreur)
1132: {
1133: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1134: return;
1135: }
1136:
1137: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1138: &s_objet_argument_2) == d_erreur)
1139: {
1140: liberation(s_etat_processus, s_objet_argument_1);
1141:
1142: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1143: return;
1144: }
1145:
1146: /*
1147: --------------------------------------------------------------------------------
1148: Résultat entier
1149: --------------------------------------------------------------------------------
1150: */
1151:
1152: if (((*s_objet_argument_1).type == VIN) &&
1153: ((*s_objet_argument_2).type == VIN))
1154: {
1155: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1156: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1157: != 3))
1158: {
1159: liberation(s_etat_processus, s_objet_argument_1);
1160: liberation(s_etat_processus, s_objet_argument_2);
1161:
1162: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1163: return;
1164: }
1165:
1166: if ((s_objet_resultat = allocation(s_etat_processus, VIN))
1167: == NULL)
1168: {
1169: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1170: return;
1171: }
1172:
1173: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1174:
1175: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1176: malloc(3 * sizeof(integer8))) == NULL)
1177: {
1178: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1179: return;
1180: }
1181:
1182: depassement = depassement_multiplication(&(((integer8 *)
1183: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1184: .tableau)[1]), &(((integer8 *) (*((struct_vecteur *)
1185: (*s_objet_argument_1).objet)).tableau)[2]), &(tampon_1));
1186:
1187: depassement |= depassement_multiplication(&(((integer8 *)
1188: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1189: .tableau)[2]), &(((integer8 *) (*((struct_vecteur *)
1190: (*s_objet_argument_1).objet)).tableau)[1]), &(tampon_2));
1191:
1192: tampon_2 = -tampon_2;
1193:
1194: depassement |= depassement_addition(&(tampon_1), &(tampon_2),
1195: &(((integer8 *) (*((struct_vecteur *) (*s_objet_resultat)
1196: .objet)).tableau)[0]));
1197:
1198: depassement |= depassement_multiplication(&(((integer8 *)
1199: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1200: .tableau)[2]), &(((integer8 *) (*((struct_vecteur *)
1201: (*s_objet_argument_1).objet)).tableau)[0]), &(tampon_1));
1202:
1203: depassement |= depassement_multiplication(&(((integer8 *)
1204: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1205: .tableau)[0]), &(((integer8 *) (*((struct_vecteur *)
1206: (*s_objet_argument_1).objet)).tableau)[2]), &(tampon_2));
1207:
1208: tampon_2 = -tampon_2;
1209:
1210: depassement |= depassement_addition(&(tampon_1), &(tampon_2),
1211: &(((integer8 *) (*((struct_vecteur *) (*s_objet_resultat)
1212: .objet)).tableau)[1]));
1213:
1214: depassement |= depassement_multiplication(&(((integer8 *)
1215: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1216: .tableau)[0]), &(((integer8 *) (*((struct_vecteur *)
1217: (*s_objet_argument_1).objet)).tableau)[1]), &(tampon_1));
1218:
1219: depassement |= depassement_multiplication(&(((integer8 *)
1220: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1221: .tableau)[1]), &(((integer8 *) (*((struct_vecteur *)
1222: (*s_objet_argument_1).objet)).tableau)[0]), &(tampon_2));
1223:
1224: tampon_2 = -tampon_2;
1225:
1226: depassement |= depassement_addition(&(tampon_1), &(tampon_2),
1227: &(((integer8 *) (*((struct_vecteur *) (*s_objet_resultat)
1228: .objet)).tableau)[2]));
1229:
1230: if (depassement != d_absence_erreur)
1231: {
1232: (*s_objet_resultat).type = VRL;
1233: (*((struct_vecteur *) (*s_objet_resultat).objet)).type = 'R';
1234: free((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau);
1235:
1236: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1237: malloc(3 * sizeof(real8))) == NULL)
1238: {
1239: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1240: return;
1241: }
1242:
1243: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1244: .tableau)[0] = ((real8) ((integer8 *) (*((struct_vecteur *)
1245: (*s_objet_argument_2).objet)).tableau)[1] * (real8)
1246: ((integer8 *) (*((struct_vecteur *) (*s_objet_argument_1)
1247: .objet)).tableau)[2]) - ((real8) ((integer8 *)
1248: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1249: .tableau)[2] * (real8) ((integer8 *) (*((struct_vecteur *)
1250: (*s_objet_argument_1).objet)).tableau)[1]);
1251: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1252: .tableau)[1] = ((real8) ((integer8 *) (*((struct_vecteur *)
1253: (*s_objet_argument_2).objet)).tableau)[2] * (real8)
1254: ((integer8 *) (*((struct_vecteur *) (*s_objet_argument_1)
1255: .objet)).tableau)[0]) - ((real8) ((integer8 *)
1256: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1257: .tableau)[0] * (real8) ((integer8 *) (*((struct_vecteur *)
1258: (*s_objet_argument_1).objet)).tableau)[2]);
1259: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1260: .tableau)[2] = ((real8) ((integer8 *) (*((struct_vecteur *)
1261: (*s_objet_argument_2).objet)).tableau)[0] * (real8)
1262: ((integer8 *) (*((struct_vecteur *) (*s_objet_argument_1)
1263: .objet)).tableau)[1]) - ((real8) ((integer8 *)
1264: (*((struct_vecteur *) (*s_objet_argument_2)
1265: .objet)).tableau)[1] * (real8) ((integer8 *)
1266: (*((struct_vecteur *) (*s_objet_argument_1).objet))
1267: .tableau)[0]);
1268: }
1269: }
1270:
1271: /*
1272: --------------------------------------------------------------------------------
1273: Résultat réel
1274: --------------------------------------------------------------------------------
1275: */
1276:
1277: else if (((*s_objet_argument_1).type == VRL) &&
1278: ((*s_objet_argument_2).type == VIN))
1279: {
1280: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1281: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1282: != 3))
1283: {
1284: liberation(s_etat_processus, s_objet_argument_1);
1285: liberation(s_etat_processus, s_objet_argument_2);
1286:
1287: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1288: return;
1289: }
1290:
1291: if ((s_objet_resultat = allocation(s_etat_processus, VRL))
1292: == NULL)
1293: {
1294: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1295: return;
1296: }
1297:
1298: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1299:
1300: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1301: malloc(3 * sizeof(real8))) == NULL)
1302: {
1303: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1304: return;
1305: }
1306:
1307: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1308: .tableau)[0] = (((integer8 *) (*((struct_vecteur *)
1309: (*s_objet_argument_2).objet)).tableau)[1] * ((real8 *)
1310: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[2])
1311: - (((integer8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1312: .objet)).tableau)[2] * ((real8 *) (*((struct_vecteur *)
1313: (*s_objet_argument_1).objet)).tableau)[1]);
1314: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1315: .tableau)[1] = (((integer8 *) (*((struct_vecteur *)
1316: (*s_objet_argument_2).objet)).tableau)[2] * ((real8 *)
1317: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[0])
1318: - (((integer8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1319: .objet)).tableau)[0] * ((real8 *) (*((struct_vecteur *)
1320: (*s_objet_argument_1).objet)).tableau)[2]);
1321: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1322: .tableau)[2] = (((integer8 *) (*((struct_vecteur *)
1323: (*s_objet_argument_2).objet)).tableau)[0] * ((real8 *)
1324: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[1])
1325: - (((integer8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1326: .objet)).tableau)[1] * ((real8 *) (*((struct_vecteur *)
1327: (*s_objet_argument_1).objet)).tableau)[0]);
1328: }
1329: else if (((*s_objet_argument_1).type == VIN) &&
1330: ((*s_objet_argument_2).type == VRL))
1331: {
1332: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1333: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1334: != 3))
1335: {
1336: liberation(s_etat_processus, s_objet_argument_1);
1337: liberation(s_etat_processus, s_objet_argument_2);
1338:
1339: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1340: return;
1341: }
1342:
1343: if ((s_objet_resultat = allocation(s_etat_processus, VRL))
1344: == NULL)
1345: {
1346: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1347: return;
1348: }
1349:
1350: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1351:
1352: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1353: malloc(3 * sizeof(real8))) == NULL)
1354: {
1355: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1356: return;
1357: }
1358:
1359: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1360: .tableau)[0] = (((real8 *) (*((struct_vecteur *)
1361: (*s_objet_argument_2).objet)).tableau)[1] * ((integer8 *)
1362: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[2])
1363: - (((real8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1364: .objet)).tableau)[2] * ((integer8 *) (*((struct_vecteur *)
1365: (*s_objet_argument_1).objet)).tableau)[1]);
1366: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1367: .tableau)[1] = (((real8 *) (*((struct_vecteur *)
1368: (*s_objet_argument_2).objet)).tableau)[2] * ((integer8 *)
1369: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[0])
1370: - (((real8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1371: .objet)).tableau)[0] * ((integer8 *) (*((struct_vecteur *)
1372: (*s_objet_argument_1).objet)).tableau)[2]);
1373: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1374: .tableau)[2] = (((real8 *) (*((struct_vecteur *)
1375: (*s_objet_argument_2).objet)).tableau)[0] * ((integer8 *)
1376: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[1])
1377: - (((real8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1378: .objet)).tableau)[1] * ((integer8 *) (*((struct_vecteur *)
1379: (*s_objet_argument_1).objet)).tableau)[0]);
1380: }
1381: else if (((*s_objet_argument_1).type == VRL) &&
1382: ((*s_objet_argument_2).type == VRL))
1383: {
1384: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1385: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1386: != 3))
1387: {
1388: liberation(s_etat_processus, s_objet_argument_1);
1389: liberation(s_etat_processus, s_objet_argument_2);
1390:
1391: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1392: return;
1393: }
1394:
1395: if ((s_objet_resultat = allocation(s_etat_processus, VRL))
1396: == NULL)
1397: {
1398: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1399: return;
1400: }
1401:
1402: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1403:
1404: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1405: malloc(3 * sizeof(real8))) == NULL)
1406: {
1407: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1408: return;
1409: }
1410:
1411: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1412: .tableau)[0] = (((real8 *) (*((struct_vecteur *)
1413: (*s_objet_argument_2).objet)).tableau)[1] * ((real8 *)
1414: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[2])
1415: - (((real8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1416: .objet)).tableau)[2] * ((real8 *) (*((struct_vecteur *)
1417: (*s_objet_argument_1).objet)).tableau)[1]);
1418: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1419: .tableau)[1] = (((real8 *) (*((struct_vecteur *)
1420: (*s_objet_argument_2).objet)).tableau)[2] * ((real8 *)
1421: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[0])
1422: - (((real8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1423: .objet)).tableau)[0] * ((real8 *) (*((struct_vecteur *)
1424: (*s_objet_argument_1).objet)).tableau)[2]);
1425: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1426: .tableau)[2] = (((real8 *) (*((struct_vecteur *)
1427: (*s_objet_argument_2).objet)).tableau)[0] * ((real8 *)
1428: (*((struct_vecteur *) (*s_objet_argument_1).objet)).tableau)[1])
1429: - (((real8 *) (*((struct_vecteur *) (*s_objet_argument_2)
1430: .objet)).tableau)[1] * ((real8 *) (*((struct_vecteur *)
1431: (*s_objet_argument_1).objet)).tableau)[0]);
1432: }
1433:
1434: /*
1435: --------------------------------------------------------------------------------
1436: Résultat complexe
1437: --------------------------------------------------------------------------------
1438: */
1439:
1440: else if (((*s_objet_argument_1).type == VIN) &&
1441: ((*s_objet_argument_2).type == VCX))
1442: {
1443: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1444: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1445: != 3))
1446: {
1447: liberation(s_etat_processus, s_objet_argument_1);
1448: liberation(s_etat_processus, s_objet_argument_2);
1449:
1450: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1451: return;
1452: }
1453:
1454: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
1455: == NULL)
1456: {
1457: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1458: return;
1459: }
1460:
1461: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1462:
1463: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1464: malloc(3 * sizeof(struct_complexe16))) == NULL)
1465: {
1466: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1467: return;
1468: }
1469:
1470: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1471: (*s_objet_argument_2).objet)).tableau)[1]),
1472: &(((integer8 *) (*((struct_vecteur *)
1473: (*s_objet_argument_1).objet)).tableau)[2]), ®istre_a);
1474: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1475: (*s_objet_argument_2).objet)).tableau)[2]),
1476: &(((integer8 *) (*((struct_vecteur *)
1477: (*s_objet_argument_1).objet)).tableau)[1]), ®istre_b);
1478: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1479: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[0]));
1480:
1481: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1482: (*s_objet_argument_2).objet)).tableau)[2]),
1483: &(((integer8 *) (*((struct_vecteur *)
1484: (*s_objet_argument_1).objet)).tableau)[0]), ®istre_a);
1485: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1486: (*s_objet_argument_2).objet)).tableau)[0]),
1487: &(((integer8 *) (*((struct_vecteur *)
1488: (*s_objet_argument_1).objet)).tableau)[2]), ®istre_b);
1489: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1490: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[1]));
1491:
1492: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1493: (*s_objet_argument_2).objet)).tableau)[0]),
1494: &(((integer8 *) (*((struct_vecteur *)
1495: (*s_objet_argument_1).objet)).tableau)[1]), ®istre_a);
1496: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1497: (*s_objet_argument_2).objet)).tableau)[1]),
1498: &(((integer8 *) (*((struct_vecteur *)
1499: (*s_objet_argument_1).objet)).tableau)[0]), ®istre_b);
1500: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1501: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[2]));
1502: }
1503: else if (((*s_objet_argument_1).type == VRL) &&
1504: ((*s_objet_argument_2).type == VCX))
1505: {
1506: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1507: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1508: != 3))
1509: {
1510: liberation(s_etat_processus, s_objet_argument_1);
1511: liberation(s_etat_processus, s_objet_argument_2);
1512:
1513: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1514: return;
1515: }
1516:
1517: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
1518: == NULL)
1519: {
1520: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1521: return;
1522: }
1523:
1524: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1525:
1526: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1527: malloc(3 * sizeof(struct_complexe16))) == NULL)
1528: {
1529: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1530: return;
1531: }
1532:
1533: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1534: (*s_objet_argument_2).objet)).tableau)[1]),
1535: &(((real8 *) (*((struct_vecteur *)
1536: (*s_objet_argument_1).objet)).tableau)[2]), ®istre_a);
1537: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1538: (*s_objet_argument_2).objet)).tableau)[2]),
1539: &(((real8 *) (*((struct_vecteur *)
1540: (*s_objet_argument_1).objet)).tableau)[1]), ®istre_b);
1541: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1542: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[0]));
1543:
1544: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1545: (*s_objet_argument_2).objet)).tableau)[2]),
1546: &(((real8 *) (*((struct_vecteur *)
1547: (*s_objet_argument_1).objet)).tableau)[0]), ®istre_a);
1548: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1549: (*s_objet_argument_2).objet)).tableau)[0]),
1550: &(((real8 *) (*((struct_vecteur *)
1551: (*s_objet_argument_1).objet)).tableau)[2]), ®istre_b);
1552: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1553: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[1]));
1554:
1555: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1556: (*s_objet_argument_2).objet)).tableau)[0]),
1557: &(((real8 *) (*((struct_vecteur *)
1558: (*s_objet_argument_1).objet)).tableau)[1]), ®istre_a);
1559: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1560: (*s_objet_argument_2).objet)).tableau)[1]),
1561: &(((real8 *) (*((struct_vecteur *)
1562: (*s_objet_argument_1).objet)).tableau)[0]), ®istre_b);
1563: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1564: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[2]));
1565: }
1566: else if (((*s_objet_argument_1).type == VCX) &&
1567: ((*s_objet_argument_2).type == VCX))
1568: {
1569: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1570: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1571: != 3))
1572: {
1573: liberation(s_etat_processus, s_objet_argument_1);
1574: liberation(s_etat_processus, s_objet_argument_2);
1575:
1576: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1577: return;
1578: }
1579:
1580: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
1581: == NULL)
1582: {
1583: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1584: return;
1585: }
1586:
1587: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1588:
1589: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1590: malloc(3 * sizeof(struct_complexe16))) == NULL)
1591: {
1592: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1593: return;
1594: }
1595:
1596: f77multiplicationcc_((&((struct_complexe16 *) (*((struct_vecteur *)
1597: (*s_objet_argument_2).objet)).tableau)[1]),
1598: &(((struct_complexe16 *) (*((struct_vecteur *)
1599: (*s_objet_argument_1).objet)).tableau)[2]), ®istre_a);
1600: f77multiplicationcc_((&((struct_complexe16 *) (*((struct_vecteur *)
1601: (*s_objet_argument_2).objet)).tableau)[2]),
1602: &(((struct_complexe16 *) (*((struct_vecteur *)
1603: (*s_objet_argument_1).objet)).tableau)[1]), ®istre_b);
1604: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1605: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[0]));
1606:
1607: f77multiplicationcc_((&((struct_complexe16 *) (*((struct_vecteur *)
1608: (*s_objet_argument_2).objet)).tableau)[2]),
1609: &(((struct_complexe16 *) (*((struct_vecteur *)
1610: (*s_objet_argument_1).objet)).tableau)[0]), ®istre_a);
1611: f77multiplicationcc_((&((struct_complexe16 *) (*((struct_vecteur *)
1612: (*s_objet_argument_2).objet)).tableau)[0]),
1613: &(((struct_complexe16 *) (*((struct_vecteur *)
1614: (*s_objet_argument_1).objet)).tableau)[2]), ®istre_b);
1615: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1616: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[1]));
1617:
1618: f77multiplicationcc_((&((struct_complexe16 *) (*((struct_vecteur *)
1619: (*s_objet_argument_2).objet)).tableau)[0]),
1620: &(((struct_complexe16 *) (*((struct_vecteur *)
1621: (*s_objet_argument_1).objet)).tableau)[1]), ®istre_a);
1622: f77multiplicationcc_((&((struct_complexe16 *) (*((struct_vecteur *)
1623: (*s_objet_argument_2).objet)).tableau)[1]),
1624: &(((struct_complexe16 *) (*((struct_vecteur *)
1625: (*s_objet_argument_1).objet)).tableau)[0]), ®istre_b);
1626: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1627: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[2]));
1628: }
1629: else if (((*s_objet_argument_2).type == VRL) &&
1630: ((*s_objet_argument_1).type == VCX))
1631: {
1632: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1633: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1634: != 3))
1635: {
1636: liberation(s_etat_processus, s_objet_argument_1);
1637: liberation(s_etat_processus, s_objet_argument_2);
1638:
1639: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1640: return;
1641: }
1642:
1643: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
1644: == NULL)
1645: {
1646: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1647: return;
1648: }
1649:
1650: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1651:
1652: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1653: malloc(3 * sizeof(struct_complexe16))) == NULL)
1654: {
1655: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1656: return;
1657: }
1658:
1659: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1660: (*s_objet_argument_1).objet)).tableau)[1]),
1661: &(((real8 *) (*((struct_vecteur *)
1662: (*s_objet_argument_2).objet)).tableau)[2]), ®istre_b);
1663: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1664: (*s_objet_argument_1).objet)).tableau)[2]),
1665: &(((real8 *) (*((struct_vecteur *)
1666: (*s_objet_argument_2).objet)).tableau)[1]), ®istre_a);
1667: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1668: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[0]));
1669:
1670: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1671: (*s_objet_argument_1).objet)).tableau)[2]),
1672: &(((real8 *) (*((struct_vecteur *)
1673: (*s_objet_argument_2).objet)).tableau)[0]), ®istre_b);
1674: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1675: (*s_objet_argument_1).objet)).tableau)[0]),
1676: &(((real8 *) (*((struct_vecteur *)
1677: (*s_objet_argument_2).objet)).tableau)[2]), ®istre_a);
1678: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1679: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[1]));
1680:
1681: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1682: (*s_objet_argument_1).objet)).tableau)[0]),
1683: &(((real8 *) (*((struct_vecteur *)
1684: (*s_objet_argument_2).objet)).tableau)[1]), ®istre_b);
1685: f77multiplicationcr_((&((struct_complexe16 *) (*((struct_vecteur *)
1686: (*s_objet_argument_1).objet)).tableau)[1]),
1687: &(((real8 *) (*((struct_vecteur *)
1688: (*s_objet_argument_2).objet)).tableau)[0]), ®istre_a);
1689: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1690: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[2]));
1691: }
1692: else if (((*s_objet_argument_2).type == VIN) &&
1693: ((*s_objet_argument_1).type == VCX))
1694: {
1695: if (((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille != 3)
1696: || ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille
1697: != 3))
1698: {
1699: liberation(s_etat_processus, s_objet_argument_1);
1700: liberation(s_etat_processus, s_objet_argument_2);
1701:
1702: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1703: return;
1704: }
1705:
1706: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
1707: == NULL)
1708: {
1709: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1710: return;
1711: }
1712:
1713: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = 3;
1714:
1715: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1716: malloc(3 * sizeof(struct_complexe16))) == NULL)
1717: {
1718: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1719: return;
1720: }
1721:
1722: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1723: (*s_objet_argument_1).objet)).tableau)[1]),
1724: &(((integer8 *) (*((struct_vecteur *)
1725: (*s_objet_argument_2).objet)).tableau)[2]), ®istre_b);
1726: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1727: (*s_objet_argument_1).objet)).tableau)[2]),
1728: &(((integer8 *) (*((struct_vecteur *)
1729: (*s_objet_argument_2).objet)).tableau)[1]), ®istre_a);
1730: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1731: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[0]));
1732:
1733: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1734: (*s_objet_argument_1).objet)).tableau)[2]),
1735: &(((integer8 *) (*((struct_vecteur *)
1736: (*s_objet_argument_2).objet)).tableau)[0]), ®istre_b);
1737: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1738: (*s_objet_argument_1).objet)).tableau)[0]),
1739: &(((integer8 *) (*((struct_vecteur *)
1740: (*s_objet_argument_2).objet)).tableau)[2]), ®istre_a);
1741: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1742: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[1]));
1743:
1744: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1745: (*s_objet_argument_1).objet)).tableau)[0]),
1746: &(((integer8 *) (*((struct_vecteur *)
1747: (*s_objet_argument_2).objet)).tableau)[1]), ®istre_b);
1748: f77multiplicationci_((&((struct_complexe16 *) (*((struct_vecteur *)
1749: (*s_objet_argument_1).objet)).tableau)[1]),
1750: &(((integer8 *) (*((struct_vecteur *)
1751: (*s_objet_argument_2).objet)).tableau)[0]), ®istre_a);
1752: f77soustractioncc_(®istre_a, ®istre_b, &(((struct_complexe16 *)
1753: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau)[2]));
1754: }
1755:
1756: /*
1757: --------------------------------------------------------------------------------
1758: Types incompatibles avec la fonction CROSS
1759: --------------------------------------------------------------------------------
1760: */
1761:
1762: else
1763: {
1764: liberation(s_etat_processus, s_objet_argument_1);
1765: liberation(s_etat_processus, s_objet_argument_2);
1766:
1767: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1768: return;
1769: }
1770:
1771: liberation(s_etat_processus, s_objet_argument_1);
1772: liberation(s_etat_processus, s_objet_argument_2);
1773:
1774: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1775: s_objet_resultat) == d_erreur)
1776: {
1777: return;
1778: }
1779:
1780: return;
1781: }
1782:
1783: // 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