File:
[local] /
rpl /
src /
instructions_d2.c
Revision
1.21:
download - view:
text,
annotated -
select for diffs -
revision graph
Tue Jun 21 15:26:30 2011 UTC (13 years, 10 months ago) by
bertrand
Branches:
MAIN
CVS tags:
HEAD
Correction d'une réinitialisation sauvage de la pile des variables par niveau
dans la copie de la structure de description du processus. Cela corrige
la fonction SPAWN qui échouait sur un segmentation fault car la pile des
variables par niveau était vide alors même que l'arbre des variables contenait
bien les variables. Passage à la prerelease 2.
1: /*
2: ================================================================================
3: RPL/2 (R) version 4.1.0.prerelease.2
4: Copyright (C) 1989-2011 Dr. BERTRAND Joël
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:
23: #include "rpl-conv.h"
24:
25:
26: /*
27: ================================================================================
28: Fonction 'd->r'
29: ================================================================================
30: Entrées : pointeur sur une structure struct_processus
31: --------------------------------------------------------------------------------
32: Sorties :
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: void
39: instruction_d_vers_r(struct_processus *s_etat_processus)
40: {
41: struct_liste_chainee *l_element_courant;
42: struct_liste_chainee *l_element_precedent;
43:
44: struct_objet *s_copie_argument;
45: struct_objet *s_objet_argument;
46: struct_objet *s_objet_resultat;
47:
48: (*s_etat_processus).erreur_execution = d_ex;
49:
50: if ((*s_etat_processus).affichage_arguments == 'Y')
51: {
52: printf("\n D->R ");
53:
54: if ((*s_etat_processus).langue == 'F')
55: {
56: printf("(degrés vers radians)\n\n");
57: }
58: else
59: {
60: printf("(degrees to radians)\n\n");
61: }
62:
63: printf(" 1: %s, %s\n", d_INT, d_REL);
64: printf("-> 1: %s\n\n", d_REL);
65:
66: printf(" 1: %s, %s\n", d_NOM, d_ALG);
67: printf("-> 1: %s\n\n", d_ALG);
68:
69: printf(" 1: %s\n", d_RPN);
70: printf("-> 1: %s\n", d_RPN);
71:
72: return;
73: }
74: else if ((*s_etat_processus).test_instruction == 'Y')
75: {
76: (*s_etat_processus).nombre_arguments = -1;
77: return;
78: }
79:
80: if (test_cfsf(s_etat_processus, 31) == d_vrai)
81: {
82: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
83: {
84: return;
85: }
86: }
87:
88: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
89: &s_objet_argument) == d_erreur)
90: {
91: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
92: return;
93: }
94:
95: /*
96: --------------------------------------------------------------------------------
97: Conversion d'un entier ou d'un réel
98: --------------------------------------------------------------------------------
99: */
100:
101: if (((*s_objet_argument).type == INT) ||
102: ((*s_objet_argument).type == REL))
103: {
104: if ((s_objet_resultat = allocation(s_etat_processus, REL))
105: == NULL)
106: {
107: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
108: return;
109: }
110:
111: if ((*s_objet_argument).type == INT)
112: {
113: (*((real8 *) (*s_objet_resultat).objet)) =
114: (real8) (*((integer8 *) (*s_objet_argument).objet));
115: }
116: else
117: {
118: (*((real8 *) (*s_objet_resultat).objet)) =
119: (*((real8 *) (*s_objet_argument).objet));
120: }
121:
122: conversion_degres_vers_radians((real8 *) (*s_objet_resultat).objet);
123: }
124:
125: /*
126: --------------------------------------------------------------------------------
127: Conversion d'un nom
128: --------------------------------------------------------------------------------
129: */
130:
131: else if ((*s_objet_argument).type == NOM)
132: {
133: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
134: == NULL)
135: {
136: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
137: return;
138: }
139:
140: if (((*s_objet_resultat).objet =
141: allocation_maillon(s_etat_processus)) == NULL)
142: {
143: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
144: return;
145: }
146:
147: l_element_courant = (*s_objet_resultat).objet;
148:
149: if (((*l_element_courant).donnee =
150: allocation(s_etat_processus, FCT)) == NULL)
151: {
152: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
153: return;
154: }
155:
156: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
157: .nombre_arguments = 0;
158: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
159: .fonction = instruction_vers_niveau_superieur;
160:
161: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
162: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
163: {
164: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
165: return;
166: }
167:
168: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
169: .nom_fonction, "<<");
170:
171: if (((*l_element_courant).suivant =
172: allocation_maillon(s_etat_processus)) == NULL)
173: {
174: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
175: return;
176: }
177:
178: l_element_courant = (*l_element_courant).suivant;
179: (*l_element_courant).donnee = s_objet_argument;
180:
181: if (((*l_element_courant).suivant =
182: allocation_maillon(s_etat_processus)) == NULL)
183: {
184: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
185: return;
186: }
187:
188: l_element_courant = (*l_element_courant).suivant;
189:
190: if (((*l_element_courant).donnee =
191: allocation(s_etat_processus, FCT)) == NULL)
192: {
193: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
194: return;
195: }
196:
197: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
198: .nombre_arguments = 1;
199: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
200: .fonction = instruction_d_vers_r;
201:
202: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
203: .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
204: {
205: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
206: return;
207: }
208:
209: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
210: .nom_fonction, "D->R");
211:
212: if (((*l_element_courant).suivant =
213: allocation_maillon(s_etat_processus)) == NULL)
214: {
215: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
216: return;
217: }
218:
219: l_element_courant = (*l_element_courant).suivant;
220:
221: if (((*l_element_courant).donnee =
222: allocation(s_etat_processus, FCT)) == NULL)
223: {
224: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
225: return;
226: }
227:
228: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
229: .nombre_arguments = 0;
230: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
231: .fonction = instruction_vers_niveau_inferieur;
232:
233: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
234: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
235: {
236: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
237: return;
238: }
239:
240: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
241: .nom_fonction, ">>");
242:
243: (*l_element_courant).suivant = NULL;
244: s_objet_argument = NULL;
245: }
246:
247: /*
248: --------------------------------------------------------------------------------
249: Conversion d'une expression
250: --------------------------------------------------------------------------------
251: */
252:
253: else if (((*s_objet_argument).type == ALG) ||
254: ((*s_objet_argument).type == RPN))
255: {
256: if ((s_copie_argument = copie_objet(s_etat_processus,
257: s_objet_argument, 'N')) == NULL)
258: {
259: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
260: return;
261: }
262:
263: l_element_courant = (struct_liste_chainee *)
264: (*s_copie_argument).objet;
265: l_element_precedent = l_element_courant;
266:
267: while((*l_element_courant).suivant != NULL)
268: {
269: l_element_precedent = l_element_courant;
270: l_element_courant = (*l_element_courant).suivant;
271: }
272:
273: if (((*l_element_precedent).suivant =
274: allocation_maillon(s_etat_processus)) == NULL)
275: {
276: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
277: return;
278: }
279:
280: if (((*(*l_element_precedent).suivant).donnee =
281: allocation(s_etat_processus, FCT)) == NULL)
282: {
283: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
284: return;
285: }
286:
287: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
288: .donnee).objet)).nombre_arguments = 1;
289: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
290: .donnee).objet)).fonction = instruction_d_vers_r;
291:
292: if (((*((struct_fonction *) (*(*(*l_element_precedent)
293: .suivant).donnee).objet)).nom_fonction =
294: malloc(5 * sizeof(unsigned char))) == NULL)
295: {
296: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
297: return;
298: }
299:
300: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
301: .suivant).donnee).objet)).nom_fonction, "D->R");
302:
303: (*(*l_element_precedent).suivant).suivant = l_element_courant;
304:
305: s_objet_resultat = s_copie_argument;
306: }
307:
308: /*
309: --------------------------------------------------------------------------------
310: Réalisation impossible de la fonction R->D
311: --------------------------------------------------------------------------------
312: */
313:
314: else
315: {
316: liberation(s_etat_processus, s_objet_argument);
317:
318: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
319: return;
320: }
321:
322: liberation(s_etat_processus, s_objet_argument);
323:
324: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
325: s_objet_resultat) == d_erreur)
326: {
327: return;
328: }
329:
330: return;
331: }
332:
333:
334: /*
335: ================================================================================
336: Fonction 'det'
337: ================================================================================
338: Entrées : pointeur sur une structure struct_processus
339: --------------------------------------------------------------------------------
340: Sorties :
341: --------------------------------------------------------------------------------
342: Effets de bord : néant
343: ================================================================================
344: */
345:
346: void
347: instruction_det(struct_processus *s_etat_processus)
348: {
349: struct_objet *s_objet_argument;
350: struct_objet *s_objet_resultat;
351:
352: (*s_etat_processus).erreur_execution = d_ex;
353:
354: if ((*s_etat_processus).affichage_arguments == 'Y')
355: {
356: printf("\n DET ");
357:
358: if ((*s_etat_processus).langue == 'F')
359: {
360: printf("(déterminant)\n\n");
361: }
362: else
363: {
364: printf("(determinant)\n\n");
365: }
366:
367: printf(" 1: %s\n", d_MIN);
368: printf("-> 1: %s, %s\n\n", d_INT, d_REL);
369:
370: printf(" 1: %s\n", d_MRL);
371: printf("-> 1: %s\n\n", d_REL);
372:
373: printf(" 1: %s\n", d_MCX);
374: printf("-> 1: %s\n", d_CPL);
375:
376: return;
377: }
378: else if ((*s_etat_processus).test_instruction == 'Y')
379: {
380: (*s_etat_processus).nombre_arguments = -1;
381: return;
382: }
383:
384: if (test_cfsf(s_etat_processus, 31) == d_vrai)
385: {
386: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
387: {
388: return;
389: }
390: }
391:
392: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
393: &s_objet_argument) == d_erreur)
394: {
395: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
396: return;
397: }
398:
399: /*
400: --------------------------------------------------------------------------------
401: L'argument est une matrice carrée
402: --------------------------------------------------------------------------------
403: */
404:
405: if (((*s_objet_argument).type == MIN) ||
406: ((*s_objet_argument).type == MRL))
407: {
408: if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes !=
409: (*((struct_matrice *) (*s_objet_argument).objet))
410: .nombre_colonnes)
411: {
412: liberation(s_etat_processus, s_objet_argument);
413:
414: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
415: return;
416: }
417:
418: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
419: {
420: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
421: return;
422: }
423:
424: determinant(s_etat_processus, (struct_matrice *)
425: (*s_objet_argument).objet, (*s_objet_resultat).objet);
426:
427: if ((*s_etat_processus).erreur_systeme != d_es)
428: {
429: return;
430: }
431:
432: if (((*s_etat_processus).exception != d_ep) ||
433: ((*s_etat_processus).erreur_execution != d_ex))
434: {
435: liberation(s_etat_processus, s_objet_resultat);
436: liberation(s_etat_processus, s_objet_argument);
437: return;
438: }
439: }
440: else if ((*s_objet_argument).type == MCX)
441: {
442: if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes !=
443: (*((struct_matrice *) (*s_objet_argument).objet))
444: .nombre_colonnes)
445: {
446: liberation(s_etat_processus, s_objet_argument);
447:
448: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
449: return;
450: }
451:
452: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
453: {
454: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
455: return;
456: }
457:
458: determinant(s_etat_processus, (struct_matrice *)
459: (*s_objet_argument).objet,
460: ((complex16 *) (*s_objet_resultat).objet));
461:
462: if ((*s_etat_processus).erreur_systeme != d_es)
463: {
464: return;
465: }
466:
467: if (((*s_etat_processus).exception != d_ep) ||
468: ((*s_etat_processus).erreur_execution != d_ex))
469: {
470: liberation(s_etat_processus, s_objet_resultat);
471: liberation(s_etat_processus, s_objet_argument);
472: return;
473: }
474: }
475:
476: /*
477: --------------------------------------------------------------------------------
478: Type incompatible avec la fonction déterminant
479: --------------------------------------------------------------------------------
480: */
481:
482: else
483: {
484: liberation(s_etat_processus, s_objet_argument);
485:
486: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
487: return;
488: }
489:
490: liberation(s_etat_processus, s_objet_argument);
491:
492: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
493: s_objet_resultat) == d_erreur)
494: {
495: return;
496: }
497:
498: return;
499: }
500:
501:
502: /*
503: ================================================================================
504: Fonction 'dot'
505: ================================================================================
506: Entrées : pointeur sur une structure struct_processus
507: --------------------------------------------------------------------------------
508: Sorties :
509: --------------------------------------------------------------------------------
510: Effets de bord : néant
511: ================================================================================
512: */
513:
514: void
515: instruction_dot(struct_processus *s_etat_processus)
516: {
517: integer8 cumul;
518: integer8 tampon;
519:
520: logical1 depassement;
521: logical1 erreur_memoire;
522:
523: struct_objet *s_objet_argument_1;
524: struct_objet *s_objet_argument_2;
525: struct_objet *s_objet_resultat;
526:
527: unsigned long i;
528:
529: void *accumulateur;
530:
531: (*s_etat_processus).erreur_execution = d_ex;
532:
533: if ((*s_etat_processus).affichage_arguments == 'Y')
534: {
535: printf("\n DOT ");
536:
537: if ((*s_etat_processus).langue == 'F')
538: {
539: printf("(produit scalaire)\n\n");
540: }
541: else
542: {
543: printf("(scalar product)\n\n");
544: }
545:
546: printf(" 2: %s\n", d_VIN);
547: printf(" 1: %s\n", d_VIN);
548: printf("-> 1: %s, %s\n\n", d_INT, d_REL);
549:
550: printf(" 2: %s, %s\n", d_VIN, d_VRL);
551: printf(" 1: %s, %s\n", d_VIN, d_VRL);
552: printf("-> 1: %s\n\n", d_REL);
553:
554: printf(" 2: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
555: printf(" 1: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
556: printf("-> 1: %s\n\n", d_CPL);
557:
558: return;
559: }
560: else if ((*s_etat_processus).test_instruction == 'Y')
561: {
562: (*s_etat_processus).nombre_arguments = -1;
563: return;
564: }
565:
566: if (test_cfsf(s_etat_processus, 31) == d_vrai)
567: {
568: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
569: {
570: return;
571: }
572: }
573:
574: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
575: &s_objet_argument_1) == d_erreur)
576: {
577: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
578: return;
579: }
580:
581: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
582: &s_objet_argument_2) == d_erreur)
583: {
584: liberation(s_etat_processus, s_objet_argument_1);
585:
586: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
587: return;
588: }
589:
590: /*
591: --------------------------------------------------------------------------------
592: Résultat entier
593: --------------------------------------------------------------------------------
594: */
595:
596: if (((*s_objet_argument_1).type == VIN) &&
597: ((*s_objet_argument_2).type == VIN))
598: {
599: if ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille !=
600: (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille)
601: {
602: liberation(s_etat_processus, s_objet_argument_1);
603: liberation(s_etat_processus, s_objet_argument_2);
604:
605: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
606: return;
607: }
608:
609: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
610: {
611: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
612: return;
613: }
614:
615: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
616: depassement = d_faux;
617:
618: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument_1).objet))
619: .taille; i++)
620: {
621: if (depassement_multiplication(&(((integer8 *) (*((struct_vecteur *)
622: (*s_objet_argument_1).objet)).tableau)[i]),
623: &(((integer8 *) (*((struct_vecteur *) (*s_objet_argument_2)
624: .objet)).tableau)[i]), &tampon) == d_erreur)
625: {
626: depassement = d_vrai;
627: break;
628: }
629:
630: if (depassement_addition((integer8 *) (*s_objet_resultat).objet,
631: &tampon, &cumul) == d_erreur)
632: {
633: depassement = d_vrai;
634: break;
635: }
636:
637: (*((integer8 *) (*s_objet_resultat).objet)) = cumul;
638: }
639:
640: if (depassement == d_vrai)
641: {
642: free((*s_objet_resultat).objet);
643: (*s_objet_resultat).type = REL;
644:
645: if (((*s_objet_resultat).objet = malloc(sizeof(real8))) == NULL)
646: {
647: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
648: return;
649: }
650:
651: if ((accumulateur = malloc((*((struct_vecteur *)
652: (*s_objet_argument_1).objet)).taille * sizeof(real8)))
653: == NULL)
654: {
655: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
656: return;
657: }
658:
659: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument_1).objet))
660: .taille; i++)
661: {
662: ((real8 *) accumulateur)[i] = (real8) ((integer8 *)
663: (*((struct_vecteur *) (*s_objet_argument_1)
664: .objet)).tableau)[i] * (real8) ((integer8 *)
665: (*((struct_vecteur *) (*s_objet_argument_2).objet))
666: .tableau)[i];
667: }
668:
669: (*((real8 *) (*s_objet_resultat).objet)) = sommation_vecteur_reel(
670: accumulateur, &((*((struct_vecteur *) (*s_objet_argument_1)
671: .objet)).taille), &erreur_memoire);
672:
673: if (erreur_memoire == d_vrai)
674: {
675: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
676: return;
677: }
678:
679: free(accumulateur);
680: }
681: }
682:
683: /*
684: --------------------------------------------------------------------------------
685: Résultat réel
686: --------------------------------------------------------------------------------
687: */
688:
689: else if (((*s_objet_argument_1).type == VIN) &&
690: ((*s_objet_argument_2).type == VRL))
691: {
692: if ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille !=
693: (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille)
694: {
695: liberation(s_etat_processus, s_objet_argument_1);
696: liberation(s_etat_processus, s_objet_argument_2);
697:
698: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
699: return;
700: }
701:
702: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
703: {
704: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
705: return;
706: }
707:
708: if ((accumulateur = malloc((*((struct_vecteur *)
709: (*s_objet_argument_1).objet)).taille * sizeof(real8))) == NULL)
710: {
711: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
712: return;
713: }
714:
715: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument_1).objet))
716: .taille; i++)
717: {
718: ((real8 *) accumulateur)[i] =
719: ((integer8 *) (*((struct_vecteur *) (*s_objet_argument_1)
720: .objet)).tableau)[i] * ((real8 *) (*((struct_vecteur *)
721: (*s_objet_argument_2).objet)).tableau)[i];
722: }
723:
724: (*((real8 *) (*s_objet_resultat).objet)) = sommation_vecteur_reel(
725: accumulateur, &((*((struct_vecteur *) (*s_objet_argument_1)
726: .objet)).taille), &erreur_memoire);
727:
728: if (erreur_memoire == d_vrai)
729: {
730: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
731: return;
732: }
733:
734: free(accumulateur);
735: }
736: else if (((*s_objet_argument_1).type == VRL) &&
737: ((*s_objet_argument_2).type == VIN))
738: {
739: if ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille !=
740: (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille)
741: {
742: liberation(s_etat_processus, s_objet_argument_1);
743: liberation(s_etat_processus, s_objet_argument_2);
744:
745: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
746: return;
747: }
748:
749: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
750: {
751: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
752: return;
753: }
754:
755: if ((accumulateur = malloc((*((struct_vecteur *)
756: (*s_objet_argument_1).objet)).taille * sizeof(real8))) == NULL)
757: {
758: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
759: return;
760: }
761:
762: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument_1).objet))
763: .taille; i++)
764: {
765: ((real8 *) accumulateur)[i] =
766: ((real8 *) (*((struct_vecteur *) (*s_objet_argument_1)
767: .objet)).tableau)[i] * ((integer8 *) (*((struct_vecteur *)
768: (*s_objet_argument_2).objet)).tableau)[i];
769: }
770:
771: (*((real8 *) (*s_objet_resultat).objet)) = sommation_vecteur_reel(
772: accumulateur, &((*((struct_vecteur *) (*s_objet_argument_1)
773: .objet)).taille), &erreur_memoire);
774:
775: if (erreur_memoire == d_vrai)
776: {
777: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
778: return;
779: }
780:
781: free(accumulateur);
782: }
783: else if (((*s_objet_argument_1).type == VRL) &&
784: ((*s_objet_argument_2).type == VRL))
785: {
786: if ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille !=
787: (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille)
788: {
789: liberation(s_etat_processus, s_objet_argument_1);
790: liberation(s_etat_processus, s_objet_argument_2);
791:
792: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
793: return;
794: }
795:
796: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
797: {
798: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
799: return;
800: }
801:
802: if ((accumulateur = malloc((*((struct_vecteur *)
803: (*s_objet_argument_1).objet)).taille * sizeof(real8))) == NULL)
804: {
805: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
806: return;
807: }
808:
809: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument_1).objet))
810: .taille; i++)
811: {
812: ((real8 *) accumulateur)[i] =
813: ((real8 *) (*((struct_vecteur *) (*s_objet_argument_1)
814: .objet)).tableau)[i] * ((real8 *) (*((struct_vecteur *)
815: (*s_objet_argument_2).objet)).tableau)[i];
816: }
817:
818: (*((real8 *) (*s_objet_resultat).objet)) = sommation_vecteur_reel(
819: accumulateur, &((*((struct_vecteur *) (*s_objet_argument_1)
820: .objet)).taille), &erreur_memoire);
821:
822: if (erreur_memoire == d_vrai)
823: {
824: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
825: return;
826: }
827:
828: free(accumulateur);
829: }
830:
831: /*
832: --------------------------------------------------------------------------------
833: Résultat complexe
834: --------------------------------------------------------------------------------
835: */
836:
837: else if (((*s_objet_argument_1).type == VCX) &&
838: ((*s_objet_argument_2).type == VIN))
839: {
840: if ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille !=
841: (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille)
842: {
843: liberation(s_etat_processus, s_objet_argument_1);
844: liberation(s_etat_processus, s_objet_argument_2);
845:
846: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
847: return;
848: }
849:
850: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
851: {
852: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
853: return;
854: }
855:
856: if ((accumulateur = malloc((*((struct_vecteur *)
857: (*s_objet_argument_1).objet)).taille * sizeof(complex16)))
858: == NULL)
859: {
860: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
861: return;
862: }
863:
864: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument_1).objet))
865: .taille; i++)
866: {
867: f77multiplicationci_(&(((struct_complexe16 *) (*((struct_vecteur *)
868: (*s_objet_argument_1).objet)).tableau)[i]),
869: &(((integer8 *) (*((struct_vecteur *) (*s_objet_argument_2)
870: .objet)).tableau)[i]), &(((complex16 *) accumulateur)[i]));
871: }
872:
873: (*((complex16 *) (*s_objet_resultat).objet)) =
874: sommation_vecteur_complexe(accumulateur,
875: &((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille),
876: &erreur_memoire);
877:
878: if (erreur_memoire == d_vrai)
879: {
880: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
881: return;
882: }
883:
884: free(accumulateur);
885: }
886: else if (((*s_objet_argument_1).type == VCX) &&
887: ((*s_objet_argument_2).type == VRL))
888: {
889: if ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille !=
890: (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille)
891: {
892: liberation(s_etat_processus, s_objet_argument_1);
893: liberation(s_etat_processus, s_objet_argument_2);
894:
895: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
896: return;
897: }
898:
899: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
900: {
901: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
902: return;
903: }
904:
905: if ((accumulateur = malloc((*((struct_vecteur *)
906: (*s_objet_argument_1).objet)).taille * sizeof(complex16)))
907: == NULL)
908: {
909: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
910: return;
911: }
912:
913: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument_1).objet))
914: .taille; i++)
915: {
916: f77multiplicationcr_(&(((struct_complexe16 *) (*((struct_vecteur *)
917: (*s_objet_argument_1).objet)).tableau)[i]),
918: &(((real8 *) (*((struct_vecteur *) (*s_objet_argument_2)
919: .objet)).tableau)[i]), &(((complex16 *) accumulateur)[i]));
920: }
921:
922: (*((complex16 *) (*s_objet_resultat).objet)) =
923: sommation_vecteur_complexe(accumulateur,
924: &((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille),
925: &erreur_memoire);
926:
927: if (erreur_memoire == d_vrai)
928: {
929: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
930: return;
931: }
932:
933: free(accumulateur);
934: }
935: else if (((*s_objet_argument_1).type == VCX) &&
936: ((*s_objet_argument_2).type == VCX))
937: {
938: /*
939: * s_argument_2 est conjugué avant d'effectuer le produit
940: */
941:
942: if ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille !=
943: (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille)
944: {
945: liberation(s_etat_processus, s_objet_argument_1);
946: liberation(s_etat_processus, s_objet_argument_2);
947:
948: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
949: return;
950: }
951:
952: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
953: {
954: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
955: return;
956: }
957:
958: if ((accumulateur = malloc((*((struct_vecteur *)
959: (*s_objet_argument_1).objet)).taille * sizeof(complex16)))
960: == NULL)
961: {
962: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
963: return;
964: }
965:
966: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument_1).objet))
967: .taille; i++)
968: {
969: ((struct_complexe16 *) (*((struct_vecteur *) (*s_objet_argument_2)
970: .objet)).tableau)[i].partie_imaginaire =
971: -((struct_complexe16 *) (*((struct_vecteur *)
972: (*s_objet_argument_2).objet)).tableau)[i].partie_imaginaire;
973:
974: f77multiplicationcc_(&(((struct_complexe16 *) (*((struct_vecteur *)
975: (*s_objet_argument_2).objet)).tableau)[i]),
976: &(((struct_complexe16 *) (*((struct_vecteur *)
977: (*s_objet_argument_1).objet)).tableau)[i]),
978: &(((complex16 *) accumulateur)[i]));
979: }
980:
981: (*((complex16 *) (*s_objet_resultat).objet)) =
982: sommation_vecteur_complexe(accumulateur,
983: &((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille),
984: &erreur_memoire);
985:
986: if (erreur_memoire == d_vrai)
987: {
988: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
989: return;
990: }
991:
992: free(accumulateur);
993: }
994: else if (((*s_objet_argument_1).type == VRL) &&
995: ((*s_objet_argument_2).type == VCX))
996: {
997: /*
998: * s_argument_2 est conjugué avant d'effectuer le produit
999: */
1000:
1001: if ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille !=
1002: (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille)
1003: {
1004: liberation(s_etat_processus, s_objet_argument_1);
1005: liberation(s_etat_processus, s_objet_argument_2);
1006:
1007: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1008: return;
1009: }
1010:
1011: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
1012: {
1013: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1014: return;
1015: }
1016:
1017: if ((accumulateur = malloc((*((struct_vecteur *)
1018: (*s_objet_argument_1).objet)).taille * sizeof(complex16)))
1019: == NULL)
1020: {
1021: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1022: return;
1023: }
1024:
1025: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument_1).objet))
1026: .taille; i++)
1027: {
1028: ((struct_complexe16 *) (*((struct_vecteur *) (*s_objet_argument_2)
1029: .objet)).tableau)[i].partie_imaginaire =
1030: -((struct_complexe16 *) (*((struct_vecteur *)
1031: (*s_objet_argument_2).objet)).tableau)[i].partie_imaginaire;
1032:
1033: f77multiplicationcr_(&(((struct_complexe16 *) (*((struct_vecteur *)
1034: (*s_objet_argument_2).objet)).tableau)[i]),
1035: &(((real8 *) (*((struct_vecteur *) (*s_objet_argument_1)
1036: .objet)).tableau)[i]), &(((complex16 *) accumulateur)[i]));
1037: }
1038:
1039: (*((complex16 *) (*s_objet_resultat).objet)) =
1040: sommation_vecteur_complexe(accumulateur,
1041: &((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille),
1042: &erreur_memoire);
1043:
1044: if (erreur_memoire == d_vrai)
1045: {
1046: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1047: return;
1048: }
1049:
1050: free(accumulateur);
1051: }
1052: else if (((*s_objet_argument_1).type == VIN) &&
1053: ((*s_objet_argument_2).type == VCX))
1054: {
1055: /*
1056: * s_argument_2 est conjugué avant d'effectuer le produit
1057: */
1058:
1059: if ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille !=
1060: (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille)
1061: {
1062: liberation(s_etat_processus, s_objet_argument_1);
1063: liberation(s_etat_processus, s_objet_argument_2);
1064:
1065: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1066: return;
1067: }
1068:
1069: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
1070: {
1071: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1072: return;
1073: }
1074:
1075: if ((accumulateur = malloc((*((struct_vecteur *)
1076: (*s_objet_argument_1).objet)).taille * sizeof(complex16)))
1077: == NULL)
1078: {
1079: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1080: return;
1081: }
1082:
1083: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument_1).objet))
1084: .taille; i++)
1085: {
1086: ((struct_complexe16 *) (*((struct_vecteur *) (*s_objet_argument_2)
1087: .objet)).tableau)[i].partie_imaginaire =
1088: -((struct_complexe16 *) (*((struct_vecteur *)
1089: (*s_objet_argument_2).objet)).tableau)[i].partie_imaginaire;
1090:
1091: f77multiplicationci_(&(((struct_complexe16 *) (*((struct_vecteur *)
1092: (*s_objet_argument_2).objet)).tableau)[i]),
1093: &(((integer8 *) (*((struct_vecteur *) (*s_objet_argument_1)
1094: .objet)).tableau)[i]), &(((complex16 *) accumulateur)[i]));
1095: }
1096:
1097: (*((complex16 *) (*s_objet_resultat).objet)) =
1098: sommation_vecteur_complexe(accumulateur,
1099: &((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille),
1100: &erreur_memoire);
1101:
1102: if (erreur_memoire == d_vrai)
1103: {
1104: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1105: return;
1106: }
1107:
1108: free(accumulateur);
1109: }
1110:
1111: /*
1112: --------------------------------------------------------------------------------
1113: Types d'objets incompatibles avec le calcul d'un produit scalaire
1114: --------------------------------------------------------------------------------
1115: */
1116:
1117: else
1118: {
1119: liberation(s_etat_processus, s_objet_argument_1);
1120: liberation(s_etat_processus, s_objet_argument_2);
1121:
1122: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1123: return;
1124: }
1125:
1126: liberation(s_etat_processus, s_objet_argument_1);
1127: liberation(s_etat_processus, s_objet_argument_2);
1128:
1129: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1130: s_objet_resultat) == d_erreur)
1131: {
1132: return;
1133: }
1134:
1135: return;
1136: }
1137:
1138: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_d2.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src