![[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|
Return to instructions_l5.c CVS log | Up to [local] / rpl / src |
1.1 bertrand 1: /*
2: ================================================================================
1.29 ! bertrand 3: RPL/2 (R) version 4.1.4
1.15 bertrand 4: Copyright (C) 1989-2011 Dr. BERTRAND Joël
1.1 bertrand 5:
6: This file is part of RPL/2.
7:
8: RPL/2 is free software; you can redistribute it and/or modify it
9: under the terms of the CeCILL V2 License as published by the french
10: CEA, CNRS and INRIA.
11:
12: RPL/2 is distributed in the hope that it will be useful, but WITHOUT
13: ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14: FITNESS FOR A PARTICULAR PURPOSE. See the CeCILL V2 License
15: for more details.
16:
17: You should have received a copy of the CeCILL License
18: along with RPL/2. If not, write to info@cecill.info.
19: ================================================================================
20: */
21:
22:
1.11 bertrand 23: #include "rpl-conv.h"
1.1 bertrand 24:
25:
26: /*
27: ================================================================================
28: Fonction '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: unsigned long 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: unsigned long i;
776: unsigned long j;
777: unsigned long k;
778: unsigned long 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((*((struct_matrice *) (*s_objet).objet))
990: .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((*((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((*((struct_matrice *) (*s_objet)
1027: .objet)).nombre_lignes * sizeof(real8))) == NULL)
1028: {
1029: (*s_etat_processus).erreur_systeme =
1030: d_es_allocation_memoire;
1031: return;
1032: }
1033:
1034: for(k = 0; k < (*((struct_matrice *) (*s_objet).objet))
1035: .nombre_colonnes; k++)
1036: {
1037: ((real8 **) (*((struct_matrice *) (*s_objet).objet))
1038: .tableau)[j][k] = vecteur_reel[j] * vecteur_reel[k];
1039: }
1040: }
1041:
1042: free(vecteur_reel);
1043:
1044: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1045: s_objet) == d_erreur)
1046: {
1047: return;
1048: }
1049:
1050: instruction_multiplication(s_etat_processus);
1051:
1052: if (((*s_etat_processus).erreur_systeme != d_es) ||
1053: ((*s_etat_processus).erreur_execution != d_ex) ||
1054: ((*s_etat_processus).exception != d_ep))
1055: {
1056: liberation(s_etat_processus, s_copie_argument);
1057: liberation(s_etat_processus, s_matrice_identite);
1058: free(tau);
1059:
1060: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1061: {
1062: return;
1063: }
1064:
1065: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1066: return;
1067: }
1068:
1069: instruction_moins(s_etat_processus);
1070:
1071: if (((*s_etat_processus).erreur_systeme != d_es) ||
1072: ((*s_etat_processus).erreur_execution != d_ex) ||
1073: ((*s_etat_processus).exception != d_ep))
1074: {
1075: liberation(s_etat_processus, s_copie_argument);
1076: liberation(s_etat_processus, s_matrice_identite);
1077: free(tau);
1078:
1079: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1080: {
1081: return;
1082: }
1083:
1084: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1085: return;
1086: }
1087:
1088: if (i > 0)
1089: {
1090: instruction_swap(s_etat_processus);
1091:
1092: if (((*s_etat_processus).erreur_systeme != d_es) ||
1093: ((*s_etat_processus).erreur_execution != d_ex) ||
1094: ((*s_etat_processus).exception != d_ep))
1095: {
1096: liberation(s_etat_processus, s_copie_argument);
1097: liberation(s_etat_processus, s_matrice_identite);
1098: free(tau);
1099:
1100: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1101: {
1102: return;
1103: }
1104:
1105: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1106: return;
1107: }
1108:
1109: instruction_multiplication(s_etat_processus);
1110:
1111: if (((*s_etat_processus).erreur_systeme != d_es) ||
1112: ((*s_etat_processus).erreur_execution != d_ex) ||
1113: ((*s_etat_processus).exception != d_ep))
1114: {
1115: liberation(s_etat_processus, s_copie_argument);
1116: liberation(s_etat_processus, s_matrice_identite);
1117: free(tau);
1118:
1119: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1120: {
1121: return;
1122: }
1123:
1124: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1125: return;
1126: }
1127: }
1128: }
1129:
1130: if (test_cfsf(s_etat_processus, 31) == d_vrai)
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: }
1139:
1140: liberation(s_etat_processus, s_matrice_identite);
1141: liberation(s_etat_processus, s_copie_argument);
1142: free(tau);
1143: }
1144: else if ((*s_objet_argument).type == MCX)
1145: {
1146: /*
1147: * Matrice complexe
1148: */
1149:
1150: if ((s_copie_argument = copie_objet(s_etat_processus,
1151: s_objet_argument, 'Q')) == NULL)
1152: {
1153: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1154: return;
1155: }
1156:
1157: factorisation_lq(s_etat_processus, (*s_copie_argument).objet, &tau);
1158:
1159: tau_complexe = (complex16 *) tau;
1160:
1161: if ((*s_etat_processus).erreur_systeme != d_es)
1162: {
1163: return;
1164: }
1165:
1166: if (((*s_etat_processus).exception != d_ep) ||
1167: ((*s_etat_processus).erreur_execution != d_ex))
1168: {
1169: free(tau);
1170: liberation(s_etat_processus, s_objet_argument);
1171: liberation(s_etat_processus, s_copie_argument);
1172: return;
1173: }
1174:
1175: if ((s_objet_resultat = copie_objet(s_etat_processus,
1176: s_copie_argument, 'O')) == NULL)
1177: {
1178: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1179: return;
1180: }
1181:
1182: // Matrice L
1183:
1184: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
1185: .nombre_lignes; i++)
1186: {
1187: for(j = i + 1; j < (*((struct_matrice *) (*s_objet_resultat)
1188: .objet)).nombre_colonnes; j++)
1189: {
1190: ((complex16 **) (*((struct_matrice *)
1191: (*s_objet_resultat).objet)).tableau)[i][j]
1192: .partie_reelle = 0;
1193: ((complex16 **) (*((struct_matrice *)
1194: (*s_objet_resultat).objet)).tableau)[i][j]
1195: .partie_imaginaire = 0;
1196: }
1197: }
1198:
1199: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1200: s_objet_resultat) == d_erreur)
1201: {
1202: return;
1203: }
1204:
1205: // Matrice Q
1206:
1207: nombre_reflecteurs_elementaires = ((*((struct_matrice *)
1208: (*s_copie_argument).objet)).nombre_colonnes <
1209: (*((struct_matrice *) (*s_copie_argument).objet))
1210: .nombre_lignes) ? (*((struct_matrice *)
1211: (*s_copie_argument).objet)).nombre_colonnes
1212: : (*((struct_matrice *) (*s_copie_argument).objet))
1213: .nombre_lignes;
1214:
1215: registre_pile_last = NULL;
1216:
1217: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1218: {
1219: registre_pile_last = (*s_etat_processus).l_base_pile_last;
1220: (*s_etat_processus).l_base_pile_last = NULL;
1221: }
1222:
1223: if ((s_objet = allocation(s_etat_processus, INT)) == NULL)
1224: {
1225: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1226: return;
1227: }
1228:
1229: (*((integer8 *) (*s_objet).objet)) = (*((struct_matrice *)
1230: (*s_copie_argument).objet)).nombre_colonnes;
1231:
1232: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1233: s_objet) == d_erreur)
1234: {
1235: return;
1236: }
1237:
1238: instruction_idn(s_etat_processus);
1239:
1240: if (((*s_etat_processus).erreur_systeme != d_es) ||
1241: ((*s_etat_processus).erreur_execution != d_ex) ||
1242: ((*s_etat_processus).exception != d_ep))
1243: {
1244: liberation(s_etat_processus, s_copie_argument);
1245: free(tau);
1246:
1247: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1248: {
1249: return;
1250: }
1251:
1252: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1253: return;
1254: }
1255:
1256: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1257: &s_matrice_identite) == d_erreur)
1258: {
1259: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1260: return;
1261: }
1262:
1263: for(i = 0; i < nombre_reflecteurs_elementaires; i++)
1264: {
1265: // Calcul de H'(i) = (I - tau * v * v')'
1266:
1267: if ((s_objet = copie_objet(s_etat_processus, s_matrice_identite,
1268: 'P')) == NULL)
1269: {
1270: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1271: return;
1272: }
1273:
1274: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1275: s_objet) == d_erreur)
1276: {
1277: return;
1278: }
1279:
1280: if ((s_objet = allocation(s_etat_processus, CPL)) == NULL)
1281: {
1282: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1283: return;
1284: }
1285:
1286: (*((complex16 *) (*s_objet).objet)) = tau_complexe[i];
1287:
1288: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1289: s_objet) == d_erreur)
1290: {
1291: return;
1292: }
1293:
1294: if ((s_objet = allocation(s_etat_processus, MCX)) == NULL)
1295: {
1296: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1297: return;
1298: }
1299:
1300: (*((struct_matrice *) (*s_objet).objet)).nombre_lignes =
1301: (*((struct_matrice *) (*s_copie_argument).objet))
1302: .nombre_colonnes;
1303: (*((struct_matrice *) (*s_objet).objet)).nombre_colonnes =
1304: (*((struct_matrice *) (*s_copie_argument).objet))
1305: .nombre_colonnes;
1306:
1307: if ((vecteur_complexe = malloc((*((struct_matrice *)
1308: (*s_objet).objet)).nombre_lignes * sizeof(complex16)))
1309: == NULL)
1310: {
1311: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1312: return;
1313: }
1314:
1315: for(j = 0; j < (*((struct_matrice *) (*s_objet).objet))
1316: .nombre_lignes; j++)
1317: {
1318: if (j < i)
1319: {
1320: vecteur_complexe[j].partie_reelle = 0;
1321: vecteur_complexe[j].partie_imaginaire = 0;
1322: }
1323: else if (j == i)
1324: {
1325: vecteur_complexe[j].partie_reelle = 1;
1326: vecteur_complexe[j].partie_imaginaire = 0;
1327: }
1328: else
1329: {
1330: vecteur_complexe[j].partie_reelle =
1331: ((complex16 **) (*((struct_matrice *)
1332: (*s_copie_argument).objet)).tableau)[i][j]
1333: .partie_reelle;
1334: vecteur_complexe[j].partie_imaginaire =
1335: -((complex16 **) (*((struct_matrice *)
1336: (*s_copie_argument).objet)).tableau)[i][j]
1337: .partie_imaginaire;
1338: }
1339: }
1340:
1341: if (((*((struct_matrice *) (*s_objet).objet)).tableau =
1342: malloc((*((struct_matrice *) (*s_objet).objet))
1343: .nombre_lignes * sizeof(complex16 *))) == NULL)
1344: {
1345: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1346: return;
1347: }
1348:
1349: for(j = 0; j < (*((struct_matrice *) (*s_objet).objet))
1350: .nombre_lignes; j++)
1351: {
1352: if ((((complex16 **) (*((struct_matrice *) (*s_objet).objet))
1353: .tableau)[j] = malloc((*((struct_matrice *) (*s_objet)
1354: .objet)).nombre_lignes * sizeof(complex16))) == NULL)
1355: {
1356: (*s_etat_processus).erreur_systeme =
1357: d_es_allocation_memoire;
1358: return;
1359: }
1360:
1361: for(k = 0; k < (*((struct_matrice *) (*s_objet).objet))
1362: .nombre_colonnes; k++)
1363: {
1364: registre = vecteur_complexe[k];
1365: registre.partie_imaginaire = -registre.partie_imaginaire;
1366:
1367: f77multiplicationcc_(&(vecteur_complexe[j]), ®istre,
1368: &(((complex16 **) (*((struct_matrice *)
1369: (*s_objet).objet)).tableau)[j][k]));
1370: }
1371: }
1372:
1373: free(vecteur_complexe);
1374:
1375: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1376: s_objet) == d_erreur)
1377: {
1378: return;
1379: }
1380:
1381: instruction_multiplication(s_etat_processus);
1382:
1383: if (((*s_etat_processus).erreur_systeme != d_es) ||
1384: ((*s_etat_processus).erreur_execution != d_ex) ||
1385: ((*s_etat_processus).exception != d_ep))
1386: {
1387: liberation(s_etat_processus, s_copie_argument);
1388: liberation(s_etat_processus, s_matrice_identite);
1389: free(tau);
1390:
1391: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1392: {
1393: return;
1394: }
1395:
1396: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1397: return;
1398: }
1399:
1400: instruction_moins(s_etat_processus);
1401:
1402: if (((*s_etat_processus).erreur_systeme != d_es) ||
1403: ((*s_etat_processus).erreur_execution != d_ex) ||
1404: ((*s_etat_processus).exception != d_ep))
1405: {
1406: liberation(s_etat_processus, s_copie_argument);
1407: liberation(s_etat_processus, s_matrice_identite);
1408: free(tau);
1409:
1410: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1411: {
1412: return;
1413: }
1414:
1415: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1416: return;
1417: }
1418:
1419: instruction_trn(s_etat_processus);
1420:
1421: if (((*s_etat_processus).erreur_systeme != d_es) ||
1422: ((*s_etat_processus).erreur_execution != d_ex) ||
1423: ((*s_etat_processus).exception != d_ep))
1424: {
1425: liberation(s_etat_processus, s_copie_argument);
1426: liberation(s_etat_processus, s_matrice_identite);
1427: free(tau);
1428:
1429: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1430: {
1431: return;
1432: }
1433:
1434: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1435: return;
1436: }
1437:
1438: if (i > 0)
1439: {
1440: instruction_swap(s_etat_processus);
1441:
1442: if (((*s_etat_processus).erreur_systeme != d_es) ||
1443: ((*s_etat_processus).erreur_execution != d_ex) ||
1444: ((*s_etat_processus).exception != d_ep))
1445: {
1446: liberation(s_etat_processus, s_copie_argument);
1447: liberation(s_etat_processus, s_matrice_identite);
1448: free(tau);
1449:
1450: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1451: {
1452: return;
1453: }
1454:
1455: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1456: return;
1457: }
1458:
1459: instruction_multiplication(s_etat_processus);
1460:
1461: if (((*s_etat_processus).erreur_systeme != d_es) ||
1462: ((*s_etat_processus).erreur_execution != d_ex) ||
1463: ((*s_etat_processus).exception != d_ep))
1464: {
1465: liberation(s_etat_processus, s_copie_argument);
1466: liberation(s_etat_processus, s_matrice_identite);
1467: free(tau);
1468:
1469: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1470: {
1471: return;
1472: }
1473:
1474: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1475: return;
1476: }
1477: }
1478: }
1479:
1480: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1481: {
1482: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1483: {
1484: return;
1485: }
1486:
1487: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1488: }
1489:
1490: liberation(s_etat_processus, s_matrice_identite);
1491: liberation(s_etat_processus, s_copie_argument);
1492: free(tau);
1493: }
1494:
1495: /*
1496: * Type d'argument invalide
1497: */
1498:
1499: else
1500: {
1501: liberation(s_etat_processus, s_objet_argument);
1502:
1503: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1504: return;
1505: }
1506:
1507: liberation(s_etat_processus, s_objet_argument);
1508:
1509: return;
1510: }
1511:
1512:
1513: /*
1514: ================================================================================
1515: Fonction 'localization'
1516: ================================================================================
1517: Entrées : pointeur sur une structure struct_processus
1518: --------------------------------------------------------------------------------
1519: Sorties :
1520: --------------------------------------------------------------------------------
1521: Effets de bord : néant
1522: ================================================================================
1523: */
1524:
1525: void
1526: instruction_localization(struct_processus *s_etat_processus)
1527: {
1528: struct_objet *s_objet_argument;
1529:
1530: (*s_etat_processus).erreur_execution = d_ex;
1531:
1532: if ((*s_etat_processus).affichage_arguments == 'Y')
1533: {
1534: printf("\n LOCALIZATION ");
1535:
1536: if ((*s_etat_processus).langue == 'F')
1537: {
1538: printf("(spécifie les variables de localisation)\n\n");
1539: }
1540: else
1541: {
1542: printf("(set locales)\n\n");
1543: }
1544:
1545: printf(" 1: %s\n", d_CHN);
1546: return;
1547: }
1548: else if ((*s_etat_processus).test_instruction == 'Y')
1549: {
1550: (*s_etat_processus).nombre_arguments = -1;
1551: return;
1552: }
1553:
1554: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1555: {
1556: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1557: {
1558: return;
1559: }
1560: }
1561:
1562: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1563: &s_objet_argument) == d_erreur)
1564: {
1565: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1566: return;
1567: }
1568:
1569: if ((*s_objet_argument).type == CHN)
1570: {
1571: if (setlocale(LC_ALL, (unsigned char *) (*s_objet_argument).objet)
1572: == NULL)
1573: {
1574: liberation(s_etat_processus, s_objet_argument);
1575:
1576: (*s_etat_processus).erreur_execution = d_ex_locales;
1577: return;
1578: }
1579: }
1580: else
1581: {
1582: liberation(s_etat_processus, s_objet_argument);
1583:
1584: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1585: return;
1586: }
1587:
1588: liberation(s_etat_processus, s_objet_argument);
1589:
1590: return;
1591: }
1592:
1593:
1594: /*
1595: ================================================================================
1596: Fonction 'lcase'
1597: ================================================================================
1598: Entrées : pointeur sur une structure struct_processus
1599: --------------------------------------------------------------------------------
1600: Sorties :
1601: --------------------------------------------------------------------------------
1602: Effets de bord : néant
1603: ================================================================================
1604: */
1605:
1606: void
1607: instruction_lcase(struct_processus *s_etat_processus)
1608: {
1609: struct_objet *s_objet_argument;
1610: struct_objet *s_objet_resultat;
1611:
1612: unsigned char *ptr;
1613: unsigned char registre;
1614:
1615: (*s_etat_processus).erreur_execution = d_ex;
1616:
1617: if ((*s_etat_processus).affichage_arguments == 'Y')
1618: {
1619: printf("\n LCASE ");
1620:
1621: if ((*s_etat_processus).langue == 'F')
1622: {
1623: printf("(converison d'une chaîne de caractères en minuscules)\n\n");
1624: }
1625: else
1626: {
1627: printf("(convert string to lower case)\n\n");
1628: }
1629:
1630: printf(" 1: %s\n", d_CHN);
1.16 bertrand 1631: printf("-> 1: %s\n", d_CHN);
1.1 bertrand 1632: return;
1633: }
1634: else if ((*s_etat_processus).test_instruction == 'Y')
1635: {
1636: (*s_etat_processus).nombre_arguments = -1;
1637: return;
1638: }
1639:
1640: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1641: {
1642: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1643: {
1644: return;
1645: }
1646: }
1647:
1648: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1649: &s_objet_argument) == d_erreur)
1650: {
1651: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1652: return;
1653: }
1654:
1655: if ((*s_objet_argument).type == CHN)
1656: {
1657: if ((s_objet_resultat = copie_objet(s_etat_processus,
1658: s_objet_argument, 'O')) == NULL)
1659: {
1660: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1661: return;
1662: }
1663:
1664: liberation(s_etat_processus, s_objet_argument);
1665: ptr = (unsigned char *) (*s_objet_resultat).objet;
1666:
1667: while((*ptr) != d_code_fin_chaine)
1668: {
1669: registre = tolower((*ptr));
1670:
1671: if (toupper(registre) == (*ptr))
1672: {
1673: (*ptr) = registre;
1674: }
1675:
1676: ptr++;
1677: }
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:
1.16 bertrand 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: {
1.17 bertrand 1712: logical1 last;
1.16 bertrand 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:
1.17 bertrand 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:
1.16 bertrand 1767: return;
1768: }
1769:
1.1 bertrand 1770: // vim: ts=4