1: /*
2: ================================================================================
3: RPL/2 (R) version 4.1.36
4: Copyright (C) 1989-2025 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: integer8 longueur;
450:
451: struct_objet *s_objet_argument;
452:
453: unsigned char *tampon;
454:
455: (*s_etat_processus).erreur_execution = d_ex;
456:
457: if ((*s_etat_processus).affichage_arguments == 'Y')
458: {
459: printf("\n LOGGER ");
460:
461: if ((*s_etat_processus).langue == 'F')
462: {
463: printf("(écriture d'un message de journalisation)\n\n");
464: }
465: else
466: {
467: printf("(send message to system logger)\n\n");
468: }
469:
470: printf(" 1: %s\n", d_CHN);
471:
472: return;
473: }
474: else if ((*s_etat_processus).test_instruction == 'Y')
475: {
476: (*s_etat_processus).nombre_arguments = -1;
477: return;
478: }
479:
480: if (test_cfsf(s_etat_processus, 31) == d_vrai)
481: {
482: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
483: {
484: return;
485: }
486: }
487:
488: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
489: &s_objet_argument) == d_erreur)
490: {
491: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
492: return;
493: }
494:
495: if ((*s_objet_argument).type == CHN)
496: {
497: if ((tampon = formateur_flux(s_etat_processus,
498: (unsigned char *) (*s_objet_argument).objet, &longueur))
499: == NULL)
500: {
501: return;
502: }
503:
504: syslog(LOG_NOTICE, "%s", tampon);
505: free(tampon);
506: }
507: else
508: {
509: liberation(s_etat_processus, s_objet_argument);
510:
511: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
512: return;
513: }
514:
515: liberation(s_etat_processus, s_objet_argument);
516:
517: return;
518: }
519:
520:
521: /*
522: ================================================================================
523: Fonction 'line'
524: ================================================================================
525: Entrées : pointeur sur une structure struct_processus
526: --------------------------------------------------------------------------------
527: Sorties :
528: --------------------------------------------------------------------------------
529: Effets de bord : néant
530: ================================================================================
531: */
532:
533: void
534: instruction_line(struct_processus *s_etat_processus)
535: {
536: file *fichier;
537:
538: struct_fichier_graphique *l_fichier_candidat;
539: struct_fichier_graphique *l_fichier_courant;
540: struct_fichier_graphique *l_fichier_precedent;
541:
542: struct_objet *s_objet_argument_1;
543: struct_objet *s_objet_argument_2;
544:
545: unsigned char *nom_fichier;
546:
547: (*s_etat_processus).erreur_execution = d_ex;
548:
549: if ((*s_etat_processus).affichage_arguments == 'Y')
550: {
551: printf("\n LINE ");
552:
553: if ((*s_etat_processus).langue == 'F')
554: {
555: printf("(dessin d'un segment)\n\n");
556: }
557: else
558: {
559: printf("(draw line)\n\n");
560: }
561:
562: printf(" 2: %s\n", d_CPL);
563: printf(" 1: %s\n", d_CPL);
564:
565: return;
566: }
567: else if ((*s_etat_processus).test_instruction == 'Y')
568: {
569: (*s_etat_processus).nombre_arguments = -1;
570: return;
571: }
572:
573: if (test_cfsf(s_etat_processus, 31) == d_vrai)
574: {
575: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
576: {
577: return;
578: }
579: }
580:
581: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
582: &s_objet_argument_1) == d_erreur)
583: {
584: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
585: return;
586: }
587:
588: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
589: &s_objet_argument_2) == d_erreur)
590: {
591: liberation(s_etat_processus, s_objet_argument_1);
592:
593: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
594: return;
595: }
596:
597: // Vérification du nombre de dimensions de l'espace
598:
599: if (((*s_objet_argument_1).type == CPL) &&
600: ((*s_objet_argument_2).type == CPL))
601: {
602: /*
603: * Vérification de la présence d'un fichier de dessin
604: * parmi la liste des fichiers graphiques
605: */
606:
607: l_fichier_courant = (*s_etat_processus).fichiers_graphiques;
608: l_fichier_candidat = NULL;
609:
610: while(l_fichier_courant != NULL)
611: {
612: if (strcmp((*l_fichier_courant).type, "DESSIN") == 0)
613: {
614: l_fichier_candidat = l_fichier_courant;
615: }
616:
617: l_fichier_courant = (*l_fichier_courant).suivant;
618: }
619:
620: l_fichier_courant = l_fichier_candidat;
621:
622: if ((l_fichier_courant == NULL) ||
623: ((*s_etat_processus).requete_nouveau_plan == d_vrai))
624: {
625: // Création d'un fichier
626:
627: (*s_etat_processus).requete_nouveau_plan = d_faux;
628:
629: if ((nom_fichier = creation_nom_fichier(s_etat_processus,
630: (*s_etat_processus).chemin_fichiers_temporaires)) == NULL)
631: {
632: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
633: return;
634: }
635:
636: if ((fichier = fopen(nom_fichier, "w+")) == NULL)
637: {
638: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
639: return;
640: }
641:
642: l_fichier_courant = (*s_etat_processus).fichiers_graphiques;
643:
644: if (l_fichier_courant == NULL)
645: {
646: if (((*s_etat_processus).fichiers_graphiques =
647: malloc(sizeof(struct_fichier_graphique))) == NULL)
648: {
649: (*s_etat_processus).erreur_systeme =
650: d_es_allocation_memoire;
651: return;
652: }
653:
654: (*(*s_etat_processus).fichiers_graphiques).suivant = NULL;
655: (*(*s_etat_processus).fichiers_graphiques).nom = nom_fichier;
656: (*(*s_etat_processus).fichiers_graphiques).legende = NULL;
657: (*(*s_etat_processus).fichiers_graphiques).dimensions = 2;
658: (*(*s_etat_processus).fichiers_graphiques).presence_axes =
659: d_faux;
660: (*(*s_etat_processus).fichiers_graphiques).systeme_axes =
661: (*s_etat_processus).systeme_axes;
662: strcpy((*(*s_etat_processus).fichiers_graphiques).type,
663: "DESSIN");
664: }
665: else
666: {
667: while(l_fichier_courant != NULL)
668: {
669: if ((*l_fichier_courant).dimensions != 2)
670: {
671: (*s_etat_processus).erreur_execution =
672: d_ex_dimensions_differentes;
673: return;
674: }
675:
676: l_fichier_precedent = l_fichier_courant;
677: l_fichier_courant = (*l_fichier_courant).suivant;
678: }
679:
680: l_fichier_courant = l_fichier_precedent;
681:
682: if (((*l_fichier_courant).suivant =
683: malloc(sizeof(struct_fichier_graphique))) == NULL)
684: {
685: (*s_etat_processus).erreur_systeme =
686: d_es_allocation_memoire;
687: return;
688: }
689:
690: l_fichier_courant = (*l_fichier_courant).suivant;
691:
692: (*l_fichier_courant).suivant = NULL;
693: (*l_fichier_courant).nom = nom_fichier;
694: (*l_fichier_courant).legende = NULL;
695: (*l_fichier_courant).dimensions = 2;
696: (*l_fichier_courant).presence_axes = d_faux;
697: (*l_fichier_courant).systeme_axes =
698: (*s_etat_processus).systeme_axes;
699: strcpy((*l_fichier_courant).type, "DESSIN");
700: }
701: }
702: else
703: {
704: // Le fichier préexiste.
705:
706: if ((fichier = fopen((*l_fichier_courant).nom, "a")) == NULL)
707: {
708: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
709: return;
710: }
711: }
712:
713: /*
714: * Inscription du segment
715: */
716:
717: if (fprintf(fichier, "%f %f\n", (*((complex16 *)
718: (*s_objet_argument_2).objet)).partie_reelle, (*((complex16 *)
719: (*s_objet_argument_2).objet)).partie_imaginaire) < 0)
720: {
721: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
722: return;
723: }
724:
725: if (fprintf(fichier, "%f %f\n\n", (*((complex16 *)
726: (*s_objet_argument_1).objet)).partie_reelle, (*((complex16 *)
727: (*s_objet_argument_1).objet)).partie_imaginaire) < 0)
728: {
729: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
730: return;
731: }
732:
733: if (fclose(fichier) != 0)
734: {
735: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
736: return;
737: }
738:
739: (*s_etat_processus).mise_a_jour_trace_requise = d_vrai;
740: }
741: else
742: {
743: liberation(s_etat_processus, s_objet_argument_1);
744: liberation(s_etat_processus, s_objet_argument_2);
745:
746: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
747: return;
748: }
749:
750: liberation(s_etat_processus, s_objet_argument_1);
751: liberation(s_etat_processus, s_objet_argument_2);
752:
753: return;
754: }
755:
756:
757: /*
758: ================================================================================
759: Fonction 'lq'
760: ================================================================================
761: Entrées : pointeur sur une structure struct_processus
762: --------------------------------------------------------------------------------
763: Sorties :
764: --------------------------------------------------------------------------------
765: Effets de bord : néant
766: ================================================================================
767: */
768:
769: void
770: instruction_lq(struct_processus *s_etat_processus)
771: {
772: complex16 registre;
773: complex16 *tau_complexe;
774: complex16 *vecteur_complexe;
775:
776: real8 *tau_reel;
777: real8 *vecteur_reel;
778:
779: struct_liste_chainee *registre_pile_last;
780:
781: struct_objet *s_copie_argument;
782: struct_objet *s_matrice_identite;
783: struct_objet *s_objet;
784: struct_objet *s_objet_argument;
785: struct_objet *s_objet_resultat;
786:
787: integer8 i;
788: integer8 j;
789: integer8 k;
790: integer8 nombre_reflecteurs_elementaires;
791:
792: void *tau;
793:
794: (*s_etat_processus).erreur_execution = d_ex;
795:
796: if ((*s_etat_processus).affichage_arguments == 'Y')
797: {
798: printf("\n LQ ");
799:
800: if ((*s_etat_processus).langue == 'F')
801: {
802: printf("(décomposition LQ)\n\n");
803: }
804: else
805: {
806: printf("(LQ décomposition)\n\n");
807: }
808:
809: printf(" 1: %s, %s\n", d_MIN, d_MRL);
810: printf("-> 2: %s\n", d_MRL);
811: printf(" 1: %s\n\n", d_MRL);
812:
813: printf(" 1: %s\n", d_MCX);
814: printf("-> 2: %s\n", d_MCX);
815: printf(" 1: %s\n", d_MCX);
816:
817: return;
818: }
819: else if ((*s_etat_processus).test_instruction == 'Y')
820: {
821: (*s_etat_processus).nombre_arguments = -1;
822: return;
823: }
824:
825: if (test_cfsf(s_etat_processus, 31) == d_vrai)
826: {
827: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
828: {
829: return;
830: }
831: }
832:
833: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
834: &s_objet_argument) == d_erreur)
835: {
836: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
837: return;
838: }
839:
840: if (((*s_objet_argument).type == MIN) ||
841: ((*s_objet_argument).type == MRL))
842: {
843: /*
844: * Matrice entière ou réelle
845: */
846:
847: if ((s_copie_argument = copie_objet(s_etat_processus,
848: s_objet_argument, 'Q')) == NULL)
849: {
850: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
851: return;
852: }
853:
854: factorisation_lq(s_etat_processus, (*s_copie_argument).objet, &tau);
855: (*s_copie_argument).type = MRL;
856:
857: tau_reel = (real8 *) tau;
858:
859: if ((*s_etat_processus).erreur_systeme != d_es)
860: {
861: return;
862: }
863:
864: if (((*s_etat_processus).exception != d_ep) ||
865: ((*s_etat_processus).erreur_execution != d_ex))
866: {
867: free(tau);
868: liberation(s_etat_processus, s_objet_argument);
869: liberation(s_etat_processus, s_copie_argument);
870: return;
871: }
872:
873: if ((s_objet_resultat = copie_objet(s_etat_processus,
874: s_copie_argument, 'O')) == NULL)
875: {
876: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
877: return;
878: }
879:
880: // Matrice L
881:
882: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
883: .nombre_lignes; i++)
884: {
885: for(j = i + 1; j < (*((struct_matrice *) (*s_objet_resultat)
886: .objet)).nombre_colonnes; j++)
887: {
888: ((real8 **) (*((struct_matrice *) (*s_objet_resultat).objet))
889: .tableau)[i][j] = 0;
890: }
891: }
892:
893: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
894: s_objet_resultat) == d_erreur)
895: {
896: return;
897: }
898:
899: // Matrice Q
900:
901: nombre_reflecteurs_elementaires = ((*((struct_matrice *)
902: (*s_copie_argument).objet)).nombre_colonnes <
903: (*((struct_matrice *) (*s_copie_argument).objet))
904: .nombre_lignes) ? (*((struct_matrice *)
905: (*s_copie_argument).objet)).nombre_colonnes
906: : (*((struct_matrice *) (*s_copie_argument).objet))
907: .nombre_lignes;
908:
909: registre_pile_last = NULL;
910:
911: if (test_cfsf(s_etat_processus, 31) == d_vrai)
912: {
913: registre_pile_last = (*s_etat_processus).l_base_pile_last;
914: (*s_etat_processus).l_base_pile_last = NULL;
915: }
916:
917: if ((s_objet = allocation(s_etat_processus, INT)) == NULL)
918: {
919: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
920: return;
921: }
922:
923: (*((integer8 *) (*s_objet).objet)) = (*((struct_matrice *)
924: (*s_copie_argument).objet)).nombre_colonnes;
925:
926: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
927: s_objet) == d_erreur)
928: {
929: return;
930: }
931:
932: instruction_idn(s_etat_processus);
933:
934: if (((*s_etat_processus).erreur_systeme != d_es) ||
935: ((*s_etat_processus).erreur_execution != d_ex) ||
936: ((*s_etat_processus).exception != d_ep))
937: {
938: liberation(s_etat_processus, s_copie_argument);
939: free(tau);
940:
941: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
942: {
943: return;
944: }
945:
946: (*s_etat_processus).l_base_pile_last = registre_pile_last;
947: return;
948: }
949:
950: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
951: &s_matrice_identite) == d_erreur)
952: {
953: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
954: return;
955: }
956:
957: for(i = 0; i < nombre_reflecteurs_elementaires; i++)
958: {
959: // Calcul de H(i) = I - tau * v * v'
960:
961: if ((s_objet = copie_objet(s_etat_processus, s_matrice_identite,
962: 'P')) == NULL)
963: {
964: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
965: return;
966: }
967:
968: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
969: s_objet) == d_erreur)
970: {
971: return;
972: }
973:
974: if ((s_objet = allocation(s_etat_processus, REL)) == NULL)
975: {
976: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
977: return;
978: }
979:
980: (*((real8 *) (*s_objet).objet)) = tau_reel[i];
981:
982: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
983: s_objet) == d_erreur)
984: {
985: return;
986: }
987:
988: if ((s_objet = allocation(s_etat_processus, MRL)) == NULL)
989: {
990: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
991: return;
992: }
993:
994: (*((struct_matrice *) (*s_objet).objet)).nombre_lignes =
995: (*((struct_matrice *) (*s_copie_argument).objet))
996: .nombre_colonnes;
997: (*((struct_matrice *) (*s_objet).objet)).nombre_colonnes =
998: (*((struct_matrice *) (*s_copie_argument).objet))
999: .nombre_colonnes;
1000:
1001: if ((vecteur_reel = malloc(((size_t) (*((struct_matrice *)
1002: (*s_objet).objet)).nombre_lignes) * sizeof(real8))) == NULL)
1003: {
1004: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1005: return;
1006: }
1007:
1008: for(j = 0; j < (*((struct_matrice *) (*s_objet).objet))
1009: .nombre_lignes; j++)
1010: {
1011: if (j < i)
1012: {
1013: vecteur_reel[j] = 0;
1014: }
1015: else if (j == i)
1016: {
1017: vecteur_reel[j] = 1;
1018: }
1019: else
1020: {
1021: vecteur_reel[j] = ((real8 **) (*((struct_matrice *)
1022: (*s_copie_argument).objet)).tableau)[i][j];
1023: }
1024: }
1025:
1026: if (((*((struct_matrice *) (*s_objet).objet)).tableau =
1027: malloc(((size_t) (*((struct_matrice *) (*s_objet).objet))
1028: .nombre_lignes) * sizeof(real8 *))) == NULL)
1029: {
1030: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1031: return;
1032: }
1033:
1034: for(j = 0; j < (*((struct_matrice *) (*s_objet).objet))
1035: .nombre_lignes; j++)
1036: {
1037: if ((((real8 **) (*((struct_matrice *) (*s_objet).objet))
1038: .tableau)[j] = malloc(((size_t) (*((struct_matrice *)
1039: (*s_objet).objet)).nombre_lignes) * sizeof(real8)))
1040: == NULL)
1041: {
1042: (*s_etat_processus).erreur_systeme =
1043: d_es_allocation_memoire;
1044: return;
1045: }
1046:
1047: for(k = 0; k < (*((struct_matrice *) (*s_objet).objet))
1048: .nombre_colonnes; k++)
1049: {
1050: ((real8 **) (*((struct_matrice *) (*s_objet).objet))
1051: .tableau)[j][k] = vecteur_reel[j] * vecteur_reel[k];
1052: }
1053: }
1054:
1055: free(vecteur_reel);
1056:
1057: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1058: s_objet) == d_erreur)
1059: {
1060: return;
1061: }
1062:
1063: instruction_multiplication(s_etat_processus);
1064:
1065: if (((*s_etat_processus).erreur_systeme != d_es) ||
1066: ((*s_etat_processus).erreur_execution != d_ex) ||
1067: ((*s_etat_processus).exception != d_ep))
1068: {
1069: liberation(s_etat_processus, s_copie_argument);
1070: liberation(s_etat_processus, s_matrice_identite);
1071: free(tau);
1072:
1073: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1074: {
1075: return;
1076: }
1077:
1078: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1079: return;
1080: }
1081:
1082: instruction_moins(s_etat_processus);
1083:
1084: if (((*s_etat_processus).erreur_systeme != d_es) ||
1085: ((*s_etat_processus).erreur_execution != d_ex) ||
1086: ((*s_etat_processus).exception != d_ep))
1087: {
1088: liberation(s_etat_processus, s_copie_argument);
1089: liberation(s_etat_processus, s_matrice_identite);
1090: free(tau);
1091:
1092: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1093: {
1094: return;
1095: }
1096:
1097: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1098: return;
1099: }
1100:
1101: if (i > 0)
1102: {
1103: instruction_swap(s_etat_processus);
1104:
1105: if (((*s_etat_processus).erreur_systeme != d_es) ||
1106: ((*s_etat_processus).erreur_execution != d_ex) ||
1107: ((*s_etat_processus).exception != d_ep))
1108: {
1109: liberation(s_etat_processus, s_copie_argument);
1110: liberation(s_etat_processus, s_matrice_identite);
1111: free(tau);
1112:
1113: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1114: {
1115: return;
1116: }
1117:
1118: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1119: return;
1120: }
1121:
1122: instruction_multiplication(s_etat_processus);
1123:
1124: if (((*s_etat_processus).erreur_systeme != d_es) ||
1125: ((*s_etat_processus).erreur_execution != d_ex) ||
1126: ((*s_etat_processus).exception != d_ep))
1127: {
1128: liberation(s_etat_processus, s_copie_argument);
1129: liberation(s_etat_processus, s_matrice_identite);
1130: free(tau);
1131:
1132: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1133: {
1134: return;
1135: }
1136:
1137: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1138: return;
1139: }
1140: }
1141: }
1142:
1143: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1144: {
1145: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1146: {
1147: return;
1148: }
1149:
1150: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1151: }
1152:
1153: liberation(s_etat_processus, s_matrice_identite);
1154: liberation(s_etat_processus, s_copie_argument);
1155: free(tau);
1156: }
1157: else if ((*s_objet_argument).type == MCX)
1158: {
1159: /*
1160: * Matrice complexe
1161: */
1162:
1163: if ((s_copie_argument = copie_objet(s_etat_processus,
1164: s_objet_argument, 'Q')) == NULL)
1165: {
1166: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1167: return;
1168: }
1169:
1170: factorisation_lq(s_etat_processus, (*s_copie_argument).objet, &tau);
1171:
1172: tau_complexe = (complex16 *) tau;
1173:
1174: if ((*s_etat_processus).erreur_systeme != d_es)
1175: {
1176: return;
1177: }
1178:
1179: if (((*s_etat_processus).exception != d_ep) ||
1180: ((*s_etat_processus).erreur_execution != d_ex))
1181: {
1182: free(tau);
1183: liberation(s_etat_processus, s_objet_argument);
1184: liberation(s_etat_processus, s_copie_argument);
1185: return;
1186: }
1187:
1188: if ((s_objet_resultat = copie_objet(s_etat_processus,
1189: s_copie_argument, 'O')) == NULL)
1190: {
1191: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1192: return;
1193: }
1194:
1195: // Matrice L
1196:
1197: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
1198: .nombre_lignes; i++)
1199: {
1200: for(j = i + 1; j < (*((struct_matrice *) (*s_objet_resultat)
1201: .objet)).nombre_colonnes; j++)
1202: {
1203: ((complex16 **) (*((struct_matrice *)
1204: (*s_objet_resultat).objet)).tableau)[i][j]
1205: .partie_reelle = 0;
1206: ((complex16 **) (*((struct_matrice *)
1207: (*s_objet_resultat).objet)).tableau)[i][j]
1208: .partie_imaginaire = 0;
1209: }
1210: }
1211:
1212: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1213: s_objet_resultat) == d_erreur)
1214: {
1215: return;
1216: }
1217:
1218: // Matrice Q
1219:
1220: nombre_reflecteurs_elementaires = ((*((struct_matrice *)
1221: (*s_copie_argument).objet)).nombre_colonnes <
1222: (*((struct_matrice *) (*s_copie_argument).objet))
1223: .nombre_lignes) ? (*((struct_matrice *)
1224: (*s_copie_argument).objet)).nombre_colonnes
1225: : (*((struct_matrice *) (*s_copie_argument).objet))
1226: .nombre_lignes;
1227:
1228: registre_pile_last = NULL;
1229:
1230: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1231: {
1232: registre_pile_last = (*s_etat_processus).l_base_pile_last;
1233: (*s_etat_processus).l_base_pile_last = NULL;
1234: }
1235:
1236: if ((s_objet = allocation(s_etat_processus, INT)) == NULL)
1237: {
1238: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1239: return;
1240: }
1241:
1242: (*((integer8 *) (*s_objet).objet)) = (*((struct_matrice *)
1243: (*s_copie_argument).objet)).nombre_colonnes;
1244:
1245: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1246: s_objet) == d_erreur)
1247: {
1248: return;
1249: }
1250:
1251: instruction_idn(s_etat_processus);
1252:
1253: if (((*s_etat_processus).erreur_systeme != d_es) ||
1254: ((*s_etat_processus).erreur_execution != d_ex) ||
1255: ((*s_etat_processus).exception != d_ep))
1256: {
1257: liberation(s_etat_processus, s_copie_argument);
1258: free(tau);
1259:
1260: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1261: {
1262: return;
1263: }
1264:
1265: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1266: return;
1267: }
1268:
1269: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1270: &s_matrice_identite) == d_erreur)
1271: {
1272: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1273: return;
1274: }
1275:
1276: for(i = 0; i < nombre_reflecteurs_elementaires; i++)
1277: {
1278: // Calcul de H'(i) = (I - tau * v * v')'
1279:
1280: if ((s_objet = copie_objet(s_etat_processus, s_matrice_identite,
1281: 'P')) == NULL)
1282: {
1283: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1284: return;
1285: }
1286:
1287: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1288: s_objet) == d_erreur)
1289: {
1290: return;
1291: }
1292:
1293: if ((s_objet = allocation(s_etat_processus, CPL)) == NULL)
1294: {
1295: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1296: return;
1297: }
1298:
1299: (*((complex16 *) (*s_objet).objet)) = tau_complexe[i];
1300:
1301: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1302: s_objet) == d_erreur)
1303: {
1304: return;
1305: }
1306:
1307: if ((s_objet = allocation(s_etat_processus, MCX)) == NULL)
1308: {
1309: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1310: return;
1311: }
1312:
1313: (*((struct_matrice *) (*s_objet).objet)).nombre_lignes =
1314: (*((struct_matrice *) (*s_copie_argument).objet))
1315: .nombre_colonnes;
1316: (*((struct_matrice *) (*s_objet).objet)).nombre_colonnes =
1317: (*((struct_matrice *) (*s_copie_argument).objet))
1318: .nombre_colonnes;
1319:
1320: if ((vecteur_complexe = malloc(((size_t) (*((struct_matrice *)
1321: (*s_objet).objet)).nombre_lignes) * sizeof(complex16)))
1322: == NULL)
1323: {
1324: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1325: return;
1326: }
1327:
1328: for(j = 0; j < (*((struct_matrice *) (*s_objet).objet))
1329: .nombre_lignes; j++)
1330: {
1331: if (j < i)
1332: {
1333: vecteur_complexe[j].partie_reelle = 0;
1334: vecteur_complexe[j].partie_imaginaire = 0;
1335: }
1336: else if (j == i)
1337: {
1338: vecteur_complexe[j].partie_reelle = 1;
1339: vecteur_complexe[j].partie_imaginaire = 0;
1340: }
1341: else
1342: {
1343: vecteur_complexe[j].partie_reelle =
1344: ((complex16 **) (*((struct_matrice *)
1345: (*s_copie_argument).objet)).tableau)[i][j]
1346: .partie_reelle;
1347: vecteur_complexe[j].partie_imaginaire =
1348: -((complex16 **) (*((struct_matrice *)
1349: (*s_copie_argument).objet)).tableau)[i][j]
1350: .partie_imaginaire;
1351: }
1352: }
1353:
1354: if (((*((struct_matrice *) (*s_objet).objet)).tableau =
1355: malloc(((size_t) (*((struct_matrice *) (*s_objet).objet))
1356: .nombre_lignes) * sizeof(complex16 *))) == NULL)
1357: {
1358: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1359: return;
1360: }
1361:
1362: for(j = 0; j < (*((struct_matrice *) (*s_objet).objet))
1363: .nombre_lignes; j++)
1364: {
1365: if ((((complex16 **) (*((struct_matrice *) (*s_objet).objet))
1366: .tableau)[j] = malloc(((size_t) (*((struct_matrice *)
1367: (*s_objet).objet)).nombre_lignes) * sizeof(complex16)))
1368: == NULL)
1369: {
1370: (*s_etat_processus).erreur_systeme =
1371: d_es_allocation_memoire;
1372: return;
1373: }
1374:
1375: for(k = 0; k < (*((struct_matrice *) (*s_objet).objet))
1376: .nombre_colonnes; k++)
1377: {
1378: registre = vecteur_complexe[k];
1379: registre.partie_imaginaire = -registre.partie_imaginaire;
1380:
1381: f77multiplicationcc_(&(vecteur_complexe[j]), ®istre,
1382: &(((complex16 **) (*((struct_matrice *)
1383: (*s_objet).objet)).tableau)[j][k]));
1384: }
1385: }
1386:
1387: free(vecteur_complexe);
1388:
1389: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1390: s_objet) == d_erreur)
1391: {
1392: return;
1393: }
1394:
1395: instruction_multiplication(s_etat_processus);
1396:
1397: if (((*s_etat_processus).erreur_systeme != d_es) ||
1398: ((*s_etat_processus).erreur_execution != d_ex) ||
1399: ((*s_etat_processus).exception != d_ep))
1400: {
1401: liberation(s_etat_processus, s_copie_argument);
1402: liberation(s_etat_processus, s_matrice_identite);
1403: free(tau);
1404:
1405: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1406: {
1407: return;
1408: }
1409:
1410: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1411: return;
1412: }
1413:
1414: instruction_moins(s_etat_processus);
1415:
1416: if (((*s_etat_processus).erreur_systeme != d_es) ||
1417: ((*s_etat_processus).erreur_execution != d_ex) ||
1418: ((*s_etat_processus).exception != d_ep))
1419: {
1420: liberation(s_etat_processus, s_copie_argument);
1421: liberation(s_etat_processus, s_matrice_identite);
1422: free(tau);
1423:
1424: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1425: {
1426: return;
1427: }
1428:
1429: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1430: return;
1431: }
1432:
1433: instruction_trn(s_etat_processus);
1434:
1435: if (((*s_etat_processus).erreur_systeme != d_es) ||
1436: ((*s_etat_processus).erreur_execution != d_ex) ||
1437: ((*s_etat_processus).exception != d_ep))
1438: {
1439: liberation(s_etat_processus, s_copie_argument);
1440: liberation(s_etat_processus, s_matrice_identite);
1441: free(tau);
1442:
1443: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1444: {
1445: return;
1446: }
1447:
1448: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1449: return;
1450: }
1451:
1452: if (i > 0)
1453: {
1454: instruction_swap(s_etat_processus);
1455:
1456: if (((*s_etat_processus).erreur_systeme != d_es) ||
1457: ((*s_etat_processus).erreur_execution != d_ex) ||
1458: ((*s_etat_processus).exception != d_ep))
1459: {
1460: liberation(s_etat_processus, s_copie_argument);
1461: liberation(s_etat_processus, s_matrice_identite);
1462: free(tau);
1463:
1464: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1465: {
1466: return;
1467: }
1468:
1469: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1470: return;
1471: }
1472:
1473: instruction_multiplication(s_etat_processus);
1474:
1475: if (((*s_etat_processus).erreur_systeme != d_es) ||
1476: ((*s_etat_processus).erreur_execution != d_ex) ||
1477: ((*s_etat_processus).exception != d_ep))
1478: {
1479: liberation(s_etat_processus, s_copie_argument);
1480: liberation(s_etat_processus, s_matrice_identite);
1481: free(tau);
1482:
1483: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1484: {
1485: return;
1486: }
1487:
1488: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1489: return;
1490: }
1491: }
1492: }
1493:
1494: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1495: {
1496: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1497: {
1498: return;
1499: }
1500:
1501: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1502: }
1503:
1504: liberation(s_etat_processus, s_matrice_identite);
1505: liberation(s_etat_processus, s_copie_argument);
1506: free(tau);
1507: }
1508:
1509: /*
1510: * Type d'argument invalide
1511: */
1512:
1513: else
1514: {
1515: liberation(s_etat_processus, s_objet_argument);
1516:
1517: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1518: return;
1519: }
1520:
1521: liberation(s_etat_processus, s_objet_argument);
1522:
1523: return;
1524: }
1525:
1526:
1527: /*
1528: ================================================================================
1529: Fonction 'localization'
1530: ================================================================================
1531: Entrées : pointeur sur une structure struct_processus
1532: --------------------------------------------------------------------------------
1533: Sorties :
1534: --------------------------------------------------------------------------------
1535: Effets de bord : néant
1536: ================================================================================
1537: */
1538:
1539: void
1540: instruction_localization(struct_processus *s_etat_processus)
1541: {
1542: struct_objet *s_objet_argument;
1543:
1544: (*s_etat_processus).erreur_execution = d_ex;
1545:
1546: if ((*s_etat_processus).affichage_arguments == 'Y')
1547: {
1548: printf("\n LOCALIZATION ");
1549:
1550: if ((*s_etat_processus).langue == 'F')
1551: {
1552: printf("(spécifie les variables de localisation)\n\n");
1553: }
1554: else
1555: {
1556: printf("(set locales)\n\n");
1557: }
1558:
1559: printf(" 1: %s\n", d_CHN);
1560: return;
1561: }
1562: else if ((*s_etat_processus).test_instruction == 'Y')
1563: {
1564: (*s_etat_processus).nombre_arguments = -1;
1565: return;
1566: }
1567:
1568: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1569: {
1570: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1571: {
1572: return;
1573: }
1574: }
1575:
1576: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1577: &s_objet_argument) == d_erreur)
1578: {
1579: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1580: return;
1581: }
1582:
1583: if ((*s_objet_argument).type == CHN)
1584: {
1585: if (setlocale(LC_ALL, (unsigned char *) (*s_objet_argument).objet)
1586: == NULL)
1587: {
1588: liberation(s_etat_processus, s_objet_argument);
1589:
1590: (*s_etat_processus).erreur_execution = d_ex_locales;
1591: return;
1592: }
1593: }
1594: else
1595: {
1596: liberation(s_etat_processus, s_objet_argument);
1597:
1598: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1599: return;
1600: }
1601:
1602: liberation(s_etat_processus, s_objet_argument);
1603:
1604: return;
1605: }
1606:
1607:
1608: /*
1609: ================================================================================
1610: Fonction 'lcase'
1611: ================================================================================
1612: Entrées : pointeur sur une structure struct_processus
1613: --------------------------------------------------------------------------------
1614: Sorties :
1615: --------------------------------------------------------------------------------
1616: Effets de bord : néant
1617: ================================================================================
1618: */
1619:
1620: void
1621: instruction_lcase(struct_processus *s_etat_processus)
1622: {
1623: struct_objet *s_objet_argument;
1624: struct_objet *s_objet_resultat;
1625:
1626: (*s_etat_processus).erreur_execution = d_ex;
1627:
1628: if ((*s_etat_processus).affichage_arguments == 'Y')
1629: {
1630: printf("\n LCASE ");
1631:
1632: if ((*s_etat_processus).langue == 'F')
1633: {
1634: printf("(conversion d'une chaîne de caractères en minuscules)\n\n");
1635: }
1636: else
1637: {
1638: printf("(convert string to lower case)\n\n");
1639: }
1640:
1641: printf(" 1: %s\n", d_CHN);
1642: printf("-> 1: %s\n", d_CHN);
1643: return;
1644: }
1645: else if ((*s_etat_processus).test_instruction == 'Y')
1646: {
1647: (*s_etat_processus).nombre_arguments = -1;
1648: return;
1649: }
1650:
1651: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1652: {
1653: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1654: {
1655: return;
1656: }
1657: }
1658:
1659: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1660: &s_objet_argument) == d_erreur)
1661: {
1662: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1663: return;
1664: }
1665:
1666: if ((*s_objet_argument).type == CHN)
1667: {
1668: if ((s_objet_resultat = copie_objet(s_etat_processus,
1669: s_objet_argument, 'O')) == NULL)
1670: {
1671: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1672: return;
1673: }
1674:
1675: liberation(s_etat_processus, s_objet_argument);
1676: conversion_chaine(s_etat_processus, (unsigned char *)
1677: (*s_objet_resultat).objet, 'm');
1678:
1679: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1680: s_objet_resultat) == d_erreur)
1681: {
1682: return;
1683: }
1684: }
1685: else
1686: {
1687: liberation(s_etat_processus, s_objet_argument);
1688:
1689: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1690: return;
1691: }
1692:
1693: return;
1694: }
1695:
1696:
1697: /*
1698: ================================================================================
1699: Fonction 'l->t'
1700: ================================================================================
1701: Entrées : pointeur sur une structure struct_processus
1702: --------------------------------------------------------------------------------
1703: Sorties :
1704: --------------------------------------------------------------------------------
1705: Effets de bord : néant
1706: ================================================================================
1707: */
1708:
1709: void
1710: instruction_l_vers_t(struct_processus *s_etat_processus)
1711: {
1712: logical1 last;
1713:
1714: (*s_etat_processus).erreur_execution = d_ex;
1715:
1716: if ((*s_etat_processus).affichage_arguments == 'Y')
1717: {
1718: printf("\n L->T ");
1719:
1720: if ((*s_etat_processus).langue == 'F')
1721: {
1722: printf("(converison d'une liste en table)\n\n");
1723: }
1724: else
1725: {
1726: printf("(convert list to table)\n\n");
1727: }
1728:
1729: printf(" 1: %s\n", d_LST);
1730: printf("-> 1: %s\n", d_TAB);
1731: return;
1732: }
1733: else if ((*s_etat_processus).test_instruction == 'Y')
1734: {
1735: (*s_etat_processus).nombre_arguments = -1;
1736: return;
1737: }
1738:
1739: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1740: {
1741: last = d_vrai;
1742: cf(s_etat_processus, 31);
1743:
1744: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1745: {
1746: return;
1747: }
1748: }
1749: else
1750: {
1751: last = d_faux;
1752: }
1753:
1754: instruction_list_fleche(s_etat_processus);
1755:
1756: if (((*s_etat_processus).erreur_systeme == d_es) &&
1757: ((*s_etat_processus).erreur_execution == d_ex))
1758: {
1759: instruction_fleche_table(s_etat_processus);
1760: }
1761:
1762: if (last == d_vrai)
1763: {
1764: sf(s_etat_processus, 31);
1765: }
1766:
1767: return;
1768: }
1769:
1770: // 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