1: /*
2: ================================================================================
3: RPL/2 (R) version 4.1.14
4: Copyright (C) 1989-2013 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 'lcd->'
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_lcd_fleche(struct_processus *s_etat_processus)
40: {
41: file *descripteur;
42: file *descripteur_graphique;
43:
44: int caractere;
45:
46: struct_fichier_graphique *l_fichier_courant;
47:
48: struct_liste_chainee *l_element_courant;
49:
50: struct_objet *s_objet_argument;
51:
52: unsigned long nombre_elements;
53:
54: (*s_etat_processus).erreur_execution = d_ex;
55:
56: if ((*s_etat_processus).affichage_arguments == 'Y')
57: {
58: printf("\n LCD-> ");
59:
60: if ((*s_etat_processus).langue == 'F')
61: {
62: printf("(sauvegarde d'un fichier graphique)\n\n");
63: }
64: else
65: {
66: printf("(graphical file storage)\n\n");
67: }
68:
69: printf(" 1: %s, %s\n\n", d_CHN, d_LST);
70:
71: if ((*s_etat_processus).langue == 'F')
72: {
73: printf(" Utilisation :\n\n");
74: }
75: else
76: {
77: printf(" Usage:\n\n");
78: }
79:
80: printf(" \"filename\" LCD->\n");
81: printf(" { \"filename\" \"postscript eps enhanced monochrome "
82: "dashed\" } LCD->\n");
83:
84: return;
85: }
86: else if ((*s_etat_processus).test_instruction == 'Y')
87: {
88: (*s_etat_processus).nombre_arguments = -1;
89: return;
90: }
91:
92: nombre_elements = 0;
93:
94: if (test_cfsf(s_etat_processus, 31) == d_vrai)
95: {
96: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
97: {
98: return;
99: }
100: }
101:
102: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
103: &s_objet_argument) == d_erreur)
104: {
105: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
106: return;
107: }
108:
109: if ((*s_objet_argument).type == CHN)
110: {
111: if ((descripteur = fopen((unsigned char *) (*s_objet_argument).objet,
112: "w")) == NULL)
113: {
114: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
115: return;
116: }
117:
118: l_fichier_courant = (*s_etat_processus).fichiers_graphiques;
119:
120: while(l_fichier_courant != NULL)
121: {
122: if (fprintf(descripteur, "@ %c %d %lld %s\n",
123: ((*l_fichier_courant).presence_axes == d_faux) ? 'F' : 'T',
124: (*l_fichier_courant).dimensions,
125: (*l_fichier_courant).systeme_axes,
126: (*l_fichier_courant).type) < 0)
127: {
128: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
129: return;
130: }
131:
132: if ((descripteur_graphique = fopen((*l_fichier_courant).nom, "r"))
133: == NULL)
134: {
135: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
136: return;
137: }
138:
139: while((caractere = getc(descripteur_graphique)) != EOF)
140: {
141: if (putc(caractere, descripteur) < 0)
142: {
143: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
144: return;
145: }
146: }
147:
148: if (fclose(descripteur_graphique) != 0)
149: {
150: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
151: return;
152: }
153:
154: l_fichier_courant = (*l_fichier_courant).suivant;
155: }
156:
157: if (fclose(descripteur) != 0)
158: {
159: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
160: return;
161: }
162:
163: }
164: else if ((*s_objet_argument).type == LST)
165: {
166: l_element_courant = (struct_liste_chainee *) (*s_objet_argument).objet;
167:
168: while(l_element_courant != NULL)
169: {
170: if ((*(*l_element_courant).donnee).type != CHN)
171: {
172: liberation(s_etat_processus, s_objet_argument);
173:
174: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
175: return;
176: }
177:
178: nombre_elements++;
179:
180: switch(nombre_elements)
181: {
182: case 1 : /* Nom du fichier */
183: {
184: if (((*s_etat_processus).nom_fichier_gnuplot =
185: malloc((strlen((unsigned char *)
186: (*(*l_element_courant).donnee).objet) + 1) *
187: sizeof(unsigned char))) == NULL)
188: {
189: (*s_etat_processus).erreur_systeme =
190: d_es_allocation_memoire;
191: return;
192: }
193:
194: strcpy((*s_etat_processus).nom_fichier_gnuplot,
195: (unsigned char *) (*(*l_element_courant).donnee)
196: .objet);
197:
198: break;
199: }
200:
201: case 2 : /* Type de fichier */
202: {
203: if (((*s_etat_processus).type_fichier_gnuplot =
204: malloc((strlen((unsigned char *)
205: (*(*l_element_courant).donnee).objet) + 1) *
206: sizeof(unsigned char))) == NULL)
207: {
208: (*s_etat_processus).erreur_systeme =
209: d_es_allocation_memoire;
210: return;
211: }
212:
213: strcpy((*s_etat_processus).type_fichier_gnuplot,
214: (unsigned char *) (*(*l_element_courant).donnee)
215: .objet);
216:
217: break;
218: }
219:
220: default :
221: {
222: liberation(s_etat_processus, s_objet_argument);
223:
224: (*s_etat_processus).erreur_execution =
225: d_ex_argument_invalide;
226: return;
227: }
228: }
229:
230: l_element_courant = (*l_element_courant).suivant;
231: }
232:
233: appel_gnuplot(s_etat_processus, 'F');
234: }
235: else
236: {
237: liberation(s_etat_processus, s_objet_argument);
238:
239: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
240: return;
241: }
242:
243: liberation(s_etat_processus, s_objet_argument);
244:
245: return;
246: }
247:
248:
249: /*
250: ================================================================================
251: Fonction 'label'
252: ================================================================================
253: Entrées : pointeur sur une structure struct_processus
254: --------------------------------------------------------------------------------
255: Sorties :
256: --------------------------------------------------------------------------------
257: Effets de bord : néant
258: ================================================================================
259: */
260:
261: void
262: instruction_label(struct_processus *s_etat_processus)
263: {
264: struct_liste_chainee *l_element_courant;
265:
266: struct_objet *s_objet_argument;
267:
268: integer8 nombre_labels;
269:
270: (*s_etat_processus).erreur_execution = d_ex;
271:
272: if ((*s_etat_processus).affichage_arguments == 'Y')
273: {
274: printf("\n LABEL ");
275:
276: if ((*s_etat_processus).langue == 'F')
277: {
278: printf("(spécification des labels sur les axes)\n\n");
279: }
280: else
281: {
282: printf("(axes labels specification)\n\n");
283: }
284:
285: printf(" 1: %s\n\n", d_LST);
286:
287: if ((*s_etat_processus).langue == 'F')
288: {
289: printf(" Utilisation :\n\n");
290: }
291: else
292: {
293: printf(" Usage:\n\n");
294: }
295:
296: printf(" { \"label X\" \"label Y\" \"label Z\" } LABEL\n");
297: printf(" { \"label X\" } LABEL\n");
298:
299: return;
300: }
301: else if ((*s_etat_processus).test_instruction == 'Y')
302: {
303: (*s_etat_processus).nombre_arguments = -1;
304: return;
305: }
306:
307: nombre_labels = 0;
308:
309: if (test_cfsf(s_etat_processus, 31) == d_vrai)
310: {
311: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
312: {
313: return;
314: }
315: }
316:
317: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
318: &s_objet_argument) == d_erreur)
319: {
320: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
321: return;
322: }
323:
324: if ((*s_objet_argument).type == LST)
325: {
326: l_element_courant = (struct_liste_chainee *) (*s_objet_argument).objet;
327:
328: while(l_element_courant != NULL)
329: {
330: if ((*(*l_element_courant).donnee).type != CHN)
331: {
332: liberation(s_etat_processus, s_objet_argument);
333:
334: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
335: return;
336: }
337:
338: nombre_labels++;
339:
340: switch(nombre_labels)
341: {
342: case 1 :
343: {
344: free((*s_etat_processus).label_x);
345:
346: if (((*s_etat_processus).label_x = malloc((strlen(
347: (unsigned char *) (*(*l_element_courant).donnee)
348: .objet) + 1) * sizeof(unsigned char))) == NULL)
349: {
350: (*s_etat_processus).erreur_systeme =
351: d_es_allocation_memoire;
352: return;
353: }
354:
355: strcpy((*s_etat_processus).label_x, (unsigned char *)
356: (*(*l_element_courant).donnee).objet);
357:
358: break;
359: }
360:
361: case 2 :
362: {
363: free((*s_etat_processus).label_y);
364:
365: if (((*s_etat_processus).label_y = malloc((strlen(
366: (unsigned char *) (*(*l_element_courant).donnee)
367: .objet) + 1) * sizeof(unsigned char))) == NULL)
368: {
369: (*s_etat_processus).erreur_systeme =
370: d_es_allocation_memoire;
371: return;
372: }
373:
374: strcpy((*s_etat_processus).label_y, (unsigned char *)
375: (*(*l_element_courant).donnee).objet);
376:
377: break;
378: }
379:
380: case 3 :
381: {
382: free((*s_etat_processus).label_z);
383:
384: if (((*s_etat_processus).label_z = malloc((strlen(
385: (unsigned char *) (*(*l_element_courant).donnee)
386: .objet) + 1) * sizeof(unsigned char))) == NULL)
387: {
388: (*s_etat_processus).erreur_systeme =
389: d_es_allocation_memoire;
390: return;
391: }
392:
393: strcpy((*s_etat_processus).label_z, (unsigned char *)
394: (*(*l_element_courant).donnee).objet);
395:
396: break;
397: }
398:
399: default :
400: {
401: liberation(s_etat_processus, s_objet_argument);
402:
403: (*s_etat_processus).erreur_execution =
404: d_ex_argument_invalide;
405: return;
406: }
407: }
408:
409: l_element_courant = (*l_element_courant).suivant;
410: }
411: }
412: else
413: {
414: liberation(s_etat_processus, s_objet_argument);
415:
416: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
417: return;
418: }
419:
420: liberation(s_etat_processus, s_objet_argument);
421:
422: if (test_cfsf(s_etat_processus, 52) == d_faux)
423: {
424: if ((*s_etat_processus).fichiers_graphiques != NULL)
425: {
426: appel_gnuplot(s_etat_processus, 'N');
427: }
428: }
429:
430: return;
431: }
432:
433:
434: /*
435: ================================================================================
436: Fonction 'logger'
437: ================================================================================
438: Entrées : pointeur sur une structure struct_processus
439: --------------------------------------------------------------------------------
440: Sorties :
441: --------------------------------------------------------------------------------
442: Effets de bord : néant
443: ================================================================================
444: */
445:
446: void
447: instruction_logger(struct_processus *s_etat_processus)
448: {
449: struct_objet *s_objet_argument;
450:
451: (*s_etat_processus).erreur_execution = d_ex;
452:
453: if ((*s_etat_processus).affichage_arguments == 'Y')
454: {
455: printf("\n LOGGER ");
456:
457: if ((*s_etat_processus).langue == 'F')
458: {
459: printf("(écriture d'un message de journalisation)\n\n");
460: }
461: else
462: {
463: printf("(send message to system logger)\n\n");
464: }
465:
466: printf(" 1: %s\n", d_CHN);
467:
468: return;
469: }
470: else if ((*s_etat_processus).test_instruction == 'Y')
471: {
472: (*s_etat_processus).nombre_arguments = -1;
473: return;
474: }
475:
476: if (test_cfsf(s_etat_processus, 31) == d_vrai)
477: {
478: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
479: {
480: return;
481: }
482: }
483:
484: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
485: &s_objet_argument) == d_erreur)
486: {
487: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
488: return;
489: }
490:
491: if ((*s_objet_argument).type == CHN)
492: {
493: syslog(LOG_NOTICE, "%s", (unsigned char *) (*s_objet_argument).objet);
494: }
495: else
496: {
497: liberation(s_etat_processus, s_objet_argument);
498:
499: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
500: return;
501: }
502:
503: liberation(s_etat_processus, s_objet_argument);
504:
505: return;
506: }
507:
508:
509: /*
510: ================================================================================
511: Fonction 'line'
512: ================================================================================
513: Entrées : pointeur sur une structure struct_processus
514: --------------------------------------------------------------------------------
515: Sorties :
516: --------------------------------------------------------------------------------
517: Effets de bord : néant
518: ================================================================================
519: */
520:
521: void
522: instruction_line(struct_processus *s_etat_processus)
523: {
524: file *fichier;
525:
526: struct_fichier_graphique *l_fichier_candidat;
527: struct_fichier_graphique *l_fichier_courant;
528: struct_fichier_graphique *l_fichier_precedent;
529:
530: struct_objet *s_objet_argument_1;
531: struct_objet *s_objet_argument_2;
532:
533: unsigned char *nom_fichier;
534:
535: (*s_etat_processus).erreur_execution = d_ex;
536:
537: if ((*s_etat_processus).affichage_arguments == 'Y')
538: {
539: printf("\n LINE ");
540:
541: if ((*s_etat_processus).langue == 'F')
542: {
543: printf("(dessin d'un segment)\n\n");
544: }
545: else
546: {
547: printf("(draw line)\n\n");
548: }
549:
550: printf(" 2: %s\n", d_CPL);
551: printf(" 1: %s\n", d_CPL);
552:
553: return;
554: }
555: else if ((*s_etat_processus).test_instruction == 'Y')
556: {
557: (*s_etat_processus).nombre_arguments = -1;
558: return;
559: }
560:
561: if (test_cfsf(s_etat_processus, 31) == d_vrai)
562: {
563: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
564: {
565: return;
566: }
567: }
568:
569: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
570: &s_objet_argument_1) == d_erreur)
571: {
572: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
573: return;
574: }
575:
576: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
577: &s_objet_argument_2) == d_erreur)
578: {
579: liberation(s_etat_processus, s_objet_argument_1);
580:
581: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
582: return;
583: }
584:
585: // Vérification du nombre de dimensions de l'espace
586:
587: if (((*s_objet_argument_1).type == CPL) &&
588: ((*s_objet_argument_2).type == CPL))
589: {
590: /*
591: * Vérification de la présence d'un fichier de dessin
592: * parmi la liste des fichiers graphiques
593: */
594:
595: l_fichier_courant = (*s_etat_processus).fichiers_graphiques;
596: l_fichier_candidat = NULL;
597:
598: while(l_fichier_courant != NULL)
599: {
600: if (strcmp((*l_fichier_courant).type, "DESSIN") == 0)
601: {
602: l_fichier_candidat = l_fichier_courant;
603: }
604:
605: l_fichier_courant = (*l_fichier_courant).suivant;
606: }
607:
608: l_fichier_courant = l_fichier_candidat;
609:
610: if ((l_fichier_courant == NULL) ||
611: ((*s_etat_processus).requete_nouveau_plan == d_vrai))
612: {
613: // Création d'un fichier
614:
615: (*s_etat_processus).requete_nouveau_plan = d_faux;
616:
617: if ((nom_fichier = creation_nom_fichier(s_etat_processus,
618: (*s_etat_processus).chemin_fichiers_temporaires)) == NULL)
619: {
620: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
621: return;
622: }
623:
624: if ((fichier = fopen(nom_fichier, "w+")) == NULL)
625: {
626: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
627: return;
628: }
629:
630: l_fichier_courant = (*s_etat_processus).fichiers_graphiques;
631:
632: if (l_fichier_courant == NULL)
633: {
634: if (((*s_etat_processus).fichiers_graphiques =
635: malloc(sizeof(struct_fichier_graphique))) == NULL)
636: {
637: (*s_etat_processus).erreur_systeme =
638: d_es_allocation_memoire;
639: return;
640: }
641:
642: (*(*s_etat_processus).fichiers_graphiques).suivant = NULL;
643: (*(*s_etat_processus).fichiers_graphiques).nom = nom_fichier;
644: (*(*s_etat_processus).fichiers_graphiques).legende = NULL;
645: (*(*s_etat_processus).fichiers_graphiques).dimensions = 2;
646: (*(*s_etat_processus).fichiers_graphiques).presence_axes =
647: d_faux;
648: (*(*s_etat_processus).fichiers_graphiques).systeme_axes =
649: (*s_etat_processus).systeme_axes;
650: strcpy((*(*s_etat_processus).fichiers_graphiques).type,
651: "DESSIN");
652: }
653: else
654: {
655: while(l_fichier_courant != NULL)
656: {
657: if ((*l_fichier_courant).dimensions != 2)
658: {
659: (*s_etat_processus).erreur_execution =
660: d_ex_dimensions_differentes;
661: return;
662: }
663:
664: l_fichier_precedent = l_fichier_courant;
665: l_fichier_courant = (*l_fichier_courant).suivant;
666: }
667:
668: l_fichier_courant = l_fichier_precedent;
669:
670: if (((*l_fichier_courant).suivant =
671: malloc(sizeof(struct_fichier_graphique))) == NULL)
672: {
673: (*s_etat_processus).erreur_systeme =
674: d_es_allocation_memoire;
675: return;
676: }
677:
678: l_fichier_courant = (*l_fichier_courant).suivant;
679:
680: (*l_fichier_courant).suivant = NULL;
681: (*l_fichier_courant).nom = nom_fichier;
682: (*l_fichier_courant).legende = NULL;
683: (*l_fichier_courant).dimensions = 2;
684: (*l_fichier_courant).presence_axes = d_faux;
685: (*l_fichier_courant).systeme_axes =
686: (*s_etat_processus).systeme_axes;
687: strcpy((*l_fichier_courant).type, "DESSIN");
688: }
689: }
690: else
691: {
692: // Le fichier préexiste.
693:
694: if ((fichier = fopen((*l_fichier_courant).nom, "a")) == NULL)
695: {
696: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
697: return;
698: }
699: }
700:
701: /*
702: * Inscription du segment
703: */
704:
705: if (fprintf(fichier, "%f %f\n", (*((complex16 *)
706: (*s_objet_argument_2).objet)).partie_reelle, (*((complex16 *)
707: (*s_objet_argument_2).objet)).partie_imaginaire) < 0)
708: {
709: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
710: return;
711: }
712:
713: if (fprintf(fichier, "%f %f\n\n", (*((complex16 *)
714: (*s_objet_argument_1).objet)).partie_reelle, (*((complex16 *)
715: (*s_objet_argument_1).objet)).partie_imaginaire) < 0)
716: {
717: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
718: return;
719: }
720:
721: if (fclose(fichier) != 0)
722: {
723: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
724: return;
725: }
726:
727: (*s_etat_processus).mise_a_jour_trace_requise = d_vrai;
728: }
729: else
730: {
731: liberation(s_etat_processus, s_objet_argument_1);
732: liberation(s_etat_processus, s_objet_argument_2);
733:
734: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
735: return;
736: }
737:
738: liberation(s_etat_processus, s_objet_argument_1);
739: liberation(s_etat_processus, s_objet_argument_2);
740:
741: return;
742: }
743:
744:
745: /*
746: ================================================================================
747: Fonction 'lq'
748: ================================================================================
749: Entrées : pointeur sur une structure struct_processus
750: --------------------------------------------------------------------------------
751: Sorties :
752: --------------------------------------------------------------------------------
753: Effets de bord : néant
754: ================================================================================
755: */
756:
757: void
758: instruction_lq(struct_processus *s_etat_processus)
759: {
760: complex16 registre;
761: complex16 *tau_complexe;
762: complex16 *vecteur_complexe;
763:
764: real8 *tau_reel;
765: real8 *vecteur_reel;
766:
767: struct_liste_chainee *registre_pile_last;
768:
769: struct_objet *s_copie_argument;
770: struct_objet *s_matrice_identite;
771: struct_objet *s_objet;
772: struct_objet *s_objet_argument;
773: struct_objet *s_objet_resultat;
774:
775: integer8 i;
776: integer8 j;
777: integer8 k;
778: integer8 nombre_reflecteurs_elementaires;
779:
780: void *tau;
781:
782: (*s_etat_processus).erreur_execution = d_ex;
783:
784: if ((*s_etat_processus).affichage_arguments == 'Y')
785: {
786: printf("\n LQ ");
787:
788: if ((*s_etat_processus).langue == 'F')
789: {
790: printf("(décomposition LQ)\n\n");
791: }
792: else
793: {
794: printf("(LQ décomposition)\n\n");
795: }
796:
797: printf(" 1: %s, %s\n", d_MIN, d_MRL);
798: printf("-> 2: %s\n", d_MRL);
799: printf(" 1: %s\n\n", d_MRL);
800:
801: printf(" 1: %s\n", d_MCX);
802: printf("-> 2: %s\n", d_MCX);
803: printf(" 1: %s\n", d_MCX);
804:
805: return;
806: }
807: else if ((*s_etat_processus).test_instruction == 'Y')
808: {
809: (*s_etat_processus).nombre_arguments = -1;
810: return;
811: }
812:
813: if (test_cfsf(s_etat_processus, 31) == d_vrai)
814: {
815: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
816: {
817: return;
818: }
819: }
820:
821: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
822: &s_objet_argument) == d_erreur)
823: {
824: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
825: return;
826: }
827:
828: if (((*s_objet_argument).type == MIN) ||
829: ((*s_objet_argument).type == MRL))
830: {
831: /*
832: * Matrice entière ou réelle
833: */
834:
835: if ((s_copie_argument = copie_objet(s_etat_processus,
836: s_objet_argument, 'Q')) == NULL)
837: {
838: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
839: return;
840: }
841:
842: factorisation_lq(s_etat_processus, (*s_copie_argument).objet, &tau);
843: (*s_copie_argument).type = MRL;
844:
845: tau_reel = (real8 *) tau;
846:
847: if ((*s_etat_processus).erreur_systeme != d_es)
848: {
849: return;
850: }
851:
852: if (((*s_etat_processus).exception != d_ep) ||
853: ((*s_etat_processus).erreur_execution != d_ex))
854: {
855: free(tau);
856: liberation(s_etat_processus, s_objet_argument);
857: liberation(s_etat_processus, s_copie_argument);
858: return;
859: }
860:
861: if ((s_objet_resultat = copie_objet(s_etat_processus,
862: s_copie_argument, 'O')) == NULL)
863: {
864: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
865: return;
866: }
867:
868: // Matrice L
869:
870: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
871: .nombre_lignes; i++)
872: {
873: for(j = i + 1; j < (*((struct_matrice *) (*s_objet_resultat)
874: .objet)).nombre_colonnes; j++)
875: {
876: ((real8 **) (*((struct_matrice *) (*s_objet_resultat).objet))
877: .tableau)[i][j] = 0;
878: }
879: }
880:
881: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
882: s_objet_resultat) == d_erreur)
883: {
884: return;
885: }
886:
887: // Matrice Q
888:
889: nombre_reflecteurs_elementaires = ((*((struct_matrice *)
890: (*s_copie_argument).objet)).nombre_colonnes <
891: (*((struct_matrice *) (*s_copie_argument).objet))
892: .nombre_lignes) ? (*((struct_matrice *)
893: (*s_copie_argument).objet)).nombre_colonnes
894: : (*((struct_matrice *) (*s_copie_argument).objet))
895: .nombre_lignes;
896:
897: registre_pile_last = NULL;
898:
899: if (test_cfsf(s_etat_processus, 31) == d_vrai)
900: {
901: registre_pile_last = (*s_etat_processus).l_base_pile_last;
902: (*s_etat_processus).l_base_pile_last = NULL;
903: }
904:
905: if ((s_objet = allocation(s_etat_processus, INT)) == NULL)
906: {
907: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
908: return;
909: }
910:
911: (*((integer8 *) (*s_objet).objet)) = (*((struct_matrice *)
912: (*s_copie_argument).objet)).nombre_colonnes;
913:
914: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
915: s_objet) == d_erreur)
916: {
917: return;
918: }
919:
920: instruction_idn(s_etat_processus);
921:
922: if (((*s_etat_processus).erreur_systeme != d_es) ||
923: ((*s_etat_processus).erreur_execution != d_ex) ||
924: ((*s_etat_processus).exception != d_ep))
925: {
926: liberation(s_etat_processus, s_copie_argument);
927: free(tau);
928:
929: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
930: {
931: return;
932: }
933:
934: (*s_etat_processus).l_base_pile_last = registre_pile_last;
935: return;
936: }
937:
938: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
939: &s_matrice_identite) == d_erreur)
940: {
941: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
942: return;
943: }
944:
945: for(i = 0; i < nombre_reflecteurs_elementaires; i++)
946: {
947: // Calcul de H(i) = I - tau * v * v'
948:
949: if ((s_objet = copie_objet(s_etat_processus, s_matrice_identite,
950: 'P')) == NULL)
951: {
952: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
953: return;
954: }
955:
956: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
957: s_objet) == d_erreur)
958: {
959: return;
960: }
961:
962: if ((s_objet = allocation(s_etat_processus, REL)) == NULL)
963: {
964: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
965: return;
966: }
967:
968: (*((real8 *) (*s_objet).objet)) = tau_reel[i];
969:
970: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
971: s_objet) == d_erreur)
972: {
973: return;
974: }
975:
976: if ((s_objet = allocation(s_etat_processus, MRL)) == NULL)
977: {
978: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
979: return;
980: }
981:
982: (*((struct_matrice *) (*s_objet).objet)).nombre_lignes =
983: (*((struct_matrice *) (*s_copie_argument).objet))
984: .nombre_colonnes;
985: (*((struct_matrice *) (*s_objet).objet)).nombre_colonnes =
986: (*((struct_matrice *) (*s_copie_argument).objet))
987: .nombre_colonnes;
988:
989: if ((vecteur_reel = malloc(((size_t) (*((struct_matrice *)
990: (*s_objet).objet)).nombre_lignes) * sizeof(real8))) == NULL)
991: {
992: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
993: return;
994: }
995:
996: for(j = 0; j < (*((struct_matrice *) (*s_objet).objet))
997: .nombre_lignes; j++)
998: {
999: if (j < i)
1000: {
1001: vecteur_reel[j] = 0;
1002: }
1003: else if (j == i)
1004: {
1005: vecteur_reel[j] = 1;
1006: }
1007: else
1008: {
1009: vecteur_reel[j] = ((real8 **) (*((struct_matrice *)
1010: (*s_copie_argument).objet)).tableau)[i][j];
1011: }
1012: }
1013:
1014: if (((*((struct_matrice *) (*s_objet).objet)).tableau =
1015: malloc(((size_t) (*((struct_matrice *) (*s_objet).objet))
1016: .nombre_lignes) * sizeof(real8 *))) == NULL)
1017: {
1018: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1019: return;
1020: }
1021:
1022: for(j = 0; j < (*((struct_matrice *) (*s_objet).objet))
1023: .nombre_lignes; j++)
1024: {
1025: if ((((real8 **) (*((struct_matrice *) (*s_objet).objet))
1026: .tableau)[j] = malloc(((size_t) (*((struct_matrice *)
1027: (*s_objet).objet)).nombre_lignes) * sizeof(real8)))
1028: == NULL)
1029: {
1030: (*s_etat_processus).erreur_systeme =
1031: d_es_allocation_memoire;
1032: return;
1033: }
1034:
1035: for(k = 0; k < (*((struct_matrice *) (*s_objet).objet))
1036: .nombre_colonnes; k++)
1037: {
1038: ((real8 **) (*((struct_matrice *) (*s_objet).objet))
1039: .tableau)[j][k] = vecteur_reel[j] * vecteur_reel[k];
1040: }
1041: }
1042:
1043: free(vecteur_reel);
1044:
1045: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1046: s_objet) == d_erreur)
1047: {
1048: return;
1049: }
1050:
1051: instruction_multiplication(s_etat_processus);
1052:
1053: if (((*s_etat_processus).erreur_systeme != d_es) ||
1054: ((*s_etat_processus).erreur_execution != d_ex) ||
1055: ((*s_etat_processus).exception != d_ep))
1056: {
1057: liberation(s_etat_processus, s_copie_argument);
1058: liberation(s_etat_processus, s_matrice_identite);
1059: free(tau);
1060:
1061: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1062: {
1063: return;
1064: }
1065:
1066: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1067: return;
1068: }
1069:
1070: instruction_moins(s_etat_processus);
1071:
1072: if (((*s_etat_processus).erreur_systeme != d_es) ||
1073: ((*s_etat_processus).erreur_execution != d_ex) ||
1074: ((*s_etat_processus).exception != d_ep))
1075: {
1076: liberation(s_etat_processus, s_copie_argument);
1077: liberation(s_etat_processus, s_matrice_identite);
1078: free(tau);
1079:
1080: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1081: {
1082: return;
1083: }
1084:
1085: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1086: return;
1087: }
1088:
1089: if (i > 0)
1090: {
1091: instruction_swap(s_etat_processus);
1092:
1093: if (((*s_etat_processus).erreur_systeme != d_es) ||
1094: ((*s_etat_processus).erreur_execution != d_ex) ||
1095: ((*s_etat_processus).exception != d_ep))
1096: {
1097: liberation(s_etat_processus, s_copie_argument);
1098: liberation(s_etat_processus, s_matrice_identite);
1099: free(tau);
1100:
1101: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1102: {
1103: return;
1104: }
1105:
1106: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1107: return;
1108: }
1109:
1110: instruction_multiplication(s_etat_processus);
1111:
1112: if (((*s_etat_processus).erreur_systeme != d_es) ||
1113: ((*s_etat_processus).erreur_execution != d_ex) ||
1114: ((*s_etat_processus).exception != d_ep))
1115: {
1116: liberation(s_etat_processus, s_copie_argument);
1117: liberation(s_etat_processus, s_matrice_identite);
1118: free(tau);
1119:
1120: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1121: {
1122: return;
1123: }
1124:
1125: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1126: return;
1127: }
1128: }
1129: }
1130:
1131: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1132: {
1133: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1134: {
1135: return;
1136: }
1137:
1138: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1139: }
1140:
1141: liberation(s_etat_processus, s_matrice_identite);
1142: liberation(s_etat_processus, s_copie_argument);
1143: free(tau);
1144: }
1145: else if ((*s_objet_argument).type == MCX)
1146: {
1147: /*
1148: * Matrice complexe
1149: */
1150:
1151: if ((s_copie_argument = copie_objet(s_etat_processus,
1152: s_objet_argument, 'Q')) == NULL)
1153: {
1154: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1155: return;
1156: }
1157:
1158: factorisation_lq(s_etat_processus, (*s_copie_argument).objet, &tau);
1159:
1160: tau_complexe = (complex16 *) tau;
1161:
1162: if ((*s_etat_processus).erreur_systeme != d_es)
1163: {
1164: return;
1165: }
1166:
1167: if (((*s_etat_processus).exception != d_ep) ||
1168: ((*s_etat_processus).erreur_execution != d_ex))
1169: {
1170: free(tau);
1171: liberation(s_etat_processus, s_objet_argument);
1172: liberation(s_etat_processus, s_copie_argument);
1173: return;
1174: }
1175:
1176: if ((s_objet_resultat = copie_objet(s_etat_processus,
1177: s_copie_argument, 'O')) == NULL)
1178: {
1179: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1180: return;
1181: }
1182:
1183: // Matrice L
1184:
1185: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
1186: .nombre_lignes; i++)
1187: {
1188: for(j = i + 1; j < (*((struct_matrice *) (*s_objet_resultat)
1189: .objet)).nombre_colonnes; j++)
1190: {
1191: ((complex16 **) (*((struct_matrice *)
1192: (*s_objet_resultat).objet)).tableau)[i][j]
1193: .partie_reelle = 0;
1194: ((complex16 **) (*((struct_matrice *)
1195: (*s_objet_resultat).objet)).tableau)[i][j]
1196: .partie_imaginaire = 0;
1197: }
1198: }
1199:
1200: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1201: s_objet_resultat) == d_erreur)
1202: {
1203: return;
1204: }
1205:
1206: // Matrice Q
1207:
1208: nombre_reflecteurs_elementaires = ((*((struct_matrice *)
1209: (*s_copie_argument).objet)).nombre_colonnes <
1210: (*((struct_matrice *) (*s_copie_argument).objet))
1211: .nombre_lignes) ? (*((struct_matrice *)
1212: (*s_copie_argument).objet)).nombre_colonnes
1213: : (*((struct_matrice *) (*s_copie_argument).objet))
1214: .nombre_lignes;
1215:
1216: registre_pile_last = NULL;
1217:
1218: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1219: {
1220: registre_pile_last = (*s_etat_processus).l_base_pile_last;
1221: (*s_etat_processus).l_base_pile_last = NULL;
1222: }
1223:
1224: if ((s_objet = allocation(s_etat_processus, INT)) == NULL)
1225: {
1226: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1227: return;
1228: }
1229:
1230: (*((integer8 *) (*s_objet).objet)) = (*((struct_matrice *)
1231: (*s_copie_argument).objet)).nombre_colonnes;
1232:
1233: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1234: s_objet) == d_erreur)
1235: {
1236: return;
1237: }
1238:
1239: instruction_idn(s_etat_processus);
1240:
1241: if (((*s_etat_processus).erreur_systeme != d_es) ||
1242: ((*s_etat_processus).erreur_execution != d_ex) ||
1243: ((*s_etat_processus).exception != d_ep))
1244: {
1245: liberation(s_etat_processus, s_copie_argument);
1246: free(tau);
1247:
1248: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1249: {
1250: return;
1251: }
1252:
1253: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1254: return;
1255: }
1256:
1257: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1258: &s_matrice_identite) == d_erreur)
1259: {
1260: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1261: return;
1262: }
1263:
1264: for(i = 0; i < nombre_reflecteurs_elementaires; i++)
1265: {
1266: // Calcul de H'(i) = (I - tau * v * v')'
1267:
1268: if ((s_objet = copie_objet(s_etat_processus, s_matrice_identite,
1269: 'P')) == NULL)
1270: {
1271: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1272: return;
1273: }
1274:
1275: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1276: s_objet) == d_erreur)
1277: {
1278: return;
1279: }
1280:
1281: if ((s_objet = allocation(s_etat_processus, CPL)) == NULL)
1282: {
1283: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1284: return;
1285: }
1286:
1287: (*((complex16 *) (*s_objet).objet)) = tau_complexe[i];
1288:
1289: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1290: s_objet) == d_erreur)
1291: {
1292: return;
1293: }
1294:
1295: if ((s_objet = allocation(s_etat_processus, MCX)) == NULL)
1296: {
1297: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1298: return;
1299: }
1300:
1301: (*((struct_matrice *) (*s_objet).objet)).nombre_lignes =
1302: (*((struct_matrice *) (*s_copie_argument).objet))
1303: .nombre_colonnes;
1304: (*((struct_matrice *) (*s_objet).objet)).nombre_colonnes =
1305: (*((struct_matrice *) (*s_copie_argument).objet))
1306: .nombre_colonnes;
1307:
1308: if ((vecteur_complexe = malloc(((size_t) (*((struct_matrice *)
1309: (*s_objet).objet)).nombre_lignes) * sizeof(complex16)))
1310: == NULL)
1311: {
1312: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1313: return;
1314: }
1315:
1316: for(j = 0; j < (*((struct_matrice *) (*s_objet).objet))
1317: .nombre_lignes; j++)
1318: {
1319: if (j < i)
1320: {
1321: vecteur_complexe[j].partie_reelle = 0;
1322: vecteur_complexe[j].partie_imaginaire = 0;
1323: }
1324: else if (j == i)
1325: {
1326: vecteur_complexe[j].partie_reelle = 1;
1327: vecteur_complexe[j].partie_imaginaire = 0;
1328: }
1329: else
1330: {
1331: vecteur_complexe[j].partie_reelle =
1332: ((complex16 **) (*((struct_matrice *)
1333: (*s_copie_argument).objet)).tableau)[i][j]
1334: .partie_reelle;
1335: vecteur_complexe[j].partie_imaginaire =
1336: -((complex16 **) (*((struct_matrice *)
1337: (*s_copie_argument).objet)).tableau)[i][j]
1338: .partie_imaginaire;
1339: }
1340: }
1341:
1342: if (((*((struct_matrice *) (*s_objet).objet)).tableau =
1343: malloc(((size_t) (*((struct_matrice *) (*s_objet).objet))
1344: .nombre_lignes) * sizeof(complex16 *))) == NULL)
1345: {
1346: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1347: return;
1348: }
1349:
1350: for(j = 0; j < (*((struct_matrice *) (*s_objet).objet))
1351: .nombre_lignes; j++)
1352: {
1353: if ((((complex16 **) (*((struct_matrice *) (*s_objet).objet))
1354: .tableau)[j] = malloc(((size_t) (*((struct_matrice *)
1355: (*s_objet).objet)).nombre_lignes) * sizeof(complex16)))
1356: == NULL)
1357: {
1358: (*s_etat_processus).erreur_systeme =
1359: d_es_allocation_memoire;
1360: return;
1361: }
1362:
1363: for(k = 0; k < (*((struct_matrice *) (*s_objet).objet))
1364: .nombre_colonnes; k++)
1365: {
1366: registre = vecteur_complexe[k];
1367: registre.partie_imaginaire = -registre.partie_imaginaire;
1368:
1369: f77multiplicationcc_(&(vecteur_complexe[j]), ®istre,
1370: &(((complex16 **) (*((struct_matrice *)
1371: (*s_objet).objet)).tableau)[j][k]));
1372: }
1373: }
1374:
1375: free(vecteur_complexe);
1376:
1377: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1378: s_objet) == d_erreur)
1379: {
1380: return;
1381: }
1382:
1383: instruction_multiplication(s_etat_processus);
1384:
1385: if (((*s_etat_processus).erreur_systeme != d_es) ||
1386: ((*s_etat_processus).erreur_execution != d_ex) ||
1387: ((*s_etat_processus).exception != d_ep))
1388: {
1389: liberation(s_etat_processus, s_copie_argument);
1390: liberation(s_etat_processus, s_matrice_identite);
1391: free(tau);
1392:
1393: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1394: {
1395: return;
1396: }
1397:
1398: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1399: return;
1400: }
1401:
1402: instruction_moins(s_etat_processus);
1403:
1404: if (((*s_etat_processus).erreur_systeme != d_es) ||
1405: ((*s_etat_processus).erreur_execution != d_ex) ||
1406: ((*s_etat_processus).exception != d_ep))
1407: {
1408: liberation(s_etat_processus, s_copie_argument);
1409: liberation(s_etat_processus, s_matrice_identite);
1410: free(tau);
1411:
1412: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1413: {
1414: return;
1415: }
1416:
1417: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1418: return;
1419: }
1420:
1421: instruction_trn(s_etat_processus);
1422:
1423: if (((*s_etat_processus).erreur_systeme != d_es) ||
1424: ((*s_etat_processus).erreur_execution != d_ex) ||
1425: ((*s_etat_processus).exception != d_ep))
1426: {
1427: liberation(s_etat_processus, s_copie_argument);
1428: liberation(s_etat_processus, s_matrice_identite);
1429: free(tau);
1430:
1431: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1432: {
1433: return;
1434: }
1435:
1436: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1437: return;
1438: }
1439:
1440: if (i > 0)
1441: {
1442: instruction_swap(s_etat_processus);
1443:
1444: if (((*s_etat_processus).erreur_systeme != d_es) ||
1445: ((*s_etat_processus).erreur_execution != d_ex) ||
1446: ((*s_etat_processus).exception != d_ep))
1447: {
1448: liberation(s_etat_processus, s_copie_argument);
1449: liberation(s_etat_processus, s_matrice_identite);
1450: free(tau);
1451:
1452: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1453: {
1454: return;
1455: }
1456:
1457: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1458: return;
1459: }
1460:
1461: instruction_multiplication(s_etat_processus);
1462:
1463: if (((*s_etat_processus).erreur_systeme != d_es) ||
1464: ((*s_etat_processus).erreur_execution != d_ex) ||
1465: ((*s_etat_processus).exception != d_ep))
1466: {
1467: liberation(s_etat_processus, s_copie_argument);
1468: liberation(s_etat_processus, s_matrice_identite);
1469: free(tau);
1470:
1471: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1472: {
1473: return;
1474: }
1475:
1476: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1477: return;
1478: }
1479: }
1480: }
1481:
1482: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1483: {
1484: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1485: {
1486: return;
1487: }
1488:
1489: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1490: }
1491:
1492: liberation(s_etat_processus, s_matrice_identite);
1493: liberation(s_etat_processus, s_copie_argument);
1494: free(tau);
1495: }
1496:
1497: /*
1498: * Type d'argument invalide
1499: */
1500:
1501: else
1502: {
1503: liberation(s_etat_processus, s_objet_argument);
1504:
1505: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1506: return;
1507: }
1508:
1509: liberation(s_etat_processus, s_objet_argument);
1510:
1511: return;
1512: }
1513:
1514:
1515: /*
1516: ================================================================================
1517: Fonction 'localization'
1518: ================================================================================
1519: Entrées : pointeur sur une structure struct_processus
1520: --------------------------------------------------------------------------------
1521: Sorties :
1522: --------------------------------------------------------------------------------
1523: Effets de bord : néant
1524: ================================================================================
1525: */
1526:
1527: void
1528: instruction_localization(struct_processus *s_etat_processus)
1529: {
1530: struct_objet *s_objet_argument;
1531:
1532: (*s_etat_processus).erreur_execution = d_ex;
1533:
1534: if ((*s_etat_processus).affichage_arguments == 'Y')
1535: {
1536: printf("\n LOCALIZATION ");
1537:
1538: if ((*s_etat_processus).langue == 'F')
1539: {
1540: printf("(spécifie les variables de localisation)\n\n");
1541: }
1542: else
1543: {
1544: printf("(set locales)\n\n");
1545: }
1546:
1547: printf(" 1: %s\n", d_CHN);
1548: return;
1549: }
1550: else if ((*s_etat_processus).test_instruction == 'Y')
1551: {
1552: (*s_etat_processus).nombre_arguments = -1;
1553: return;
1554: }
1555:
1556: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1557: {
1558: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1559: {
1560: return;
1561: }
1562: }
1563:
1564: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1565: &s_objet_argument) == d_erreur)
1566: {
1567: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1568: return;
1569: }
1570:
1571: if ((*s_objet_argument).type == CHN)
1572: {
1573: if (setlocale(LC_ALL, (unsigned char *) (*s_objet_argument).objet)
1574: == NULL)
1575: {
1576: liberation(s_etat_processus, s_objet_argument);
1577:
1578: (*s_etat_processus).erreur_execution = d_ex_locales;
1579: return;
1580: }
1581: }
1582: else
1583: {
1584: liberation(s_etat_processus, s_objet_argument);
1585:
1586: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1587: return;
1588: }
1589:
1590: liberation(s_etat_processus, s_objet_argument);
1591:
1592: return;
1593: }
1594:
1595:
1596: /*
1597: ================================================================================
1598: Fonction 'lcase'
1599: ================================================================================
1600: Entrées : pointeur sur une structure struct_processus
1601: --------------------------------------------------------------------------------
1602: Sorties :
1603: --------------------------------------------------------------------------------
1604: Effets de bord : néant
1605: ================================================================================
1606: */
1607:
1608: void
1609: instruction_lcase(struct_processus *s_etat_processus)
1610: {
1611: struct_objet *s_objet_argument;
1612: struct_objet *s_objet_resultat;
1613:
1614: (*s_etat_processus).erreur_execution = d_ex;
1615:
1616: if ((*s_etat_processus).affichage_arguments == 'Y')
1617: {
1618: printf("\n LCASE ");
1619:
1620: if ((*s_etat_processus).langue == 'F')
1621: {
1622: printf("(conversion d'une chaîne de caractères en minuscules)\n\n");
1623: }
1624: else
1625: {
1626: printf("(convert string to lower case)\n\n");
1627: }
1628:
1629: printf(" 1: %s\n", d_CHN);
1630: printf("-> 1: %s\n", d_CHN);
1631: return;
1632: }
1633: else if ((*s_etat_processus).test_instruction == 'Y')
1634: {
1635: (*s_etat_processus).nombre_arguments = -1;
1636: return;
1637: }
1638:
1639: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1640: {
1641: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1642: {
1643: return;
1644: }
1645: }
1646:
1647: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1648: &s_objet_argument) == d_erreur)
1649: {
1650: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1651: return;
1652: }
1653:
1654: if ((*s_objet_argument).type == CHN)
1655: {
1656: if ((s_objet_resultat = copie_objet(s_etat_processus,
1657: s_objet_argument, 'O')) == NULL)
1658: {
1659: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1660: return;
1661: }
1662:
1663: liberation(s_etat_processus, s_objet_argument);
1664: conversion_chaine(s_etat_processus, (unsigned char *)
1665: (*s_objet_resultat).objet, 'm');
1666:
1667: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1668: s_objet_resultat) == d_erreur)
1669: {
1670: return;
1671: }
1672: }
1673: else
1674: {
1675: liberation(s_etat_processus, s_objet_argument);
1676:
1677: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1678: return;
1679: }
1680:
1681: return;
1682: }
1683:
1684:
1685: /*
1686: ================================================================================
1687: Fonction 'l->t'
1688: ================================================================================
1689: Entrées : pointeur sur une structure struct_processus
1690: --------------------------------------------------------------------------------
1691: Sorties :
1692: --------------------------------------------------------------------------------
1693: Effets de bord : néant
1694: ================================================================================
1695: */
1696:
1697: void
1698: instruction_l_vers_t(struct_processus *s_etat_processus)
1699: {
1700: logical1 last;
1701:
1702: (*s_etat_processus).erreur_execution = d_ex;
1703:
1704: if ((*s_etat_processus).affichage_arguments == 'Y')
1705: {
1706: printf("\n L->T ");
1707:
1708: if ((*s_etat_processus).langue == 'F')
1709: {
1710: printf("(converison d'une liste en table)\n\n");
1711: }
1712: else
1713: {
1714: printf("(convert list to table)\n\n");
1715: }
1716:
1717: printf(" 1: %s\n", d_LST);
1718: printf("-> 1: %s\n", d_TAB);
1719: return;
1720: }
1721: else if ((*s_etat_processus).test_instruction == 'Y')
1722: {
1723: (*s_etat_processus).nombre_arguments = -1;
1724: return;
1725: }
1726:
1727: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1728: {
1729: last = d_vrai;
1730: cf(s_etat_processus, 31);
1731:
1732: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1733: {
1734: return;
1735: }
1736: }
1737: else
1738: {
1739: last = d_faux;
1740: }
1741:
1742: instruction_list_fleche(s_etat_processus);
1743:
1744: if (((*s_etat_processus).erreur_systeme == d_es) &&
1745: ((*s_etat_processus).erreur_execution == d_ex))
1746: {
1747: instruction_fleche_table(s_etat_processus);
1748: }
1749:
1750: if (last == d_vrai)
1751: {
1752: sf(s_etat_processus, 31);
1753: }
1754:
1755: return;
1756: }
1757:
1758: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_l5.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src