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