![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to types.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src|
Return to types.c CVS log | Up to [local] / rpl / src |
1.1 bertrand 1: /*
2: ================================================================================
1.62 ! bertrand 3: RPL/2 (R) version 4.1.16
1.55 bertrand 4: Copyright (C) 1989-2013 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.19 bertrand 23: #include "rpl-conv.h"
1.1 bertrand 24:
25:
26: /*
27: ================================================================================
28: Affectation automatique d'un type à des données
29: ================================================================================
30: Entrées : structure sur l'état du processus
31: --------------------------------------------------------------------------------
32: Sorties : Néant
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: void
39: recherche_type(struct_processus *s_etat_processus)
40: {
1.59 bertrand 41: integer8 i;
42: integer8 j;
43: integer8 niveau;
44: integer8 niveau_maximal;
45: integer8 nombre_colonnes;
46: integer8 nombre_egalites;
47: integer8 nombre_elements;
48: integer8 nombre_elements_convertis;
49: integer8 nombre_exposants;
50: integer8 nombre_lignes;
51: integer8 nombre_lignes_a_supprimer;
52: integer8 nombre_points;
53: integer8 nombre_virgules;
54: integer8 position_courante;
55: integer8 profondeur_finale;
56: integer8 profondeur_initiale;
57: integer8 sauvegarde_niveau_courant;
58: integer8 sauvegarde_longueur_definitions_chainees;
1.1 bertrand 59:
60: struct_liste_chainee *l_base_liste_fonctions;
61: struct_liste_chainee *l_base_liste_decomposition;
62: struct_liste_chainee *l_element_courant;
63: struct_liste_chainee *l_element_courant_fonctions;
64: struct_liste_chainee *l_element_precedent;
65:
66: struct_liste_pile_systeme *s_sauvegarde_pile;
67:
68: struct_objet *s_objet;
1.47 bertrand 69: struct_objet *s_objet_registre;
1.1 bertrand 70: struct_objet *s_sous_objet;
71:
72: logical1 drapeau_chaine;
73: logical1 drapeau_complexe;
74: logical1 drapeau_matrice;
75: logical1 drapeau_reel;
76: logical1 drapeau_valeur_entiere;
77: logical1 drapeau_valeur_reelle;
78: logical1 erreur;
79: logical1 erreur_lecture_binaire;
80:
81: logical8 ancienne_valeur_base;
82: logical8 valeur_base;
83:
84: long coherence_liste;
85:
86: unsigned char autorisation_evaluation_nom;
87: unsigned char *definitions_chainees_precedentes;
88: unsigned char *fonction_majuscule;
89: unsigned char *instruction_majuscule;
90: unsigned char *ptr;
91: unsigned char *ptr_ecriture;
92: unsigned char *ptr_lecture;
93: unsigned char registre_instruction_valide;
94: unsigned char registre_interruption;
95: unsigned char registre_mode_execution_programme;
1.24 bertrand 96: unsigned char registre_recherche_type;
1.1 bertrand 97: unsigned char registre_test;
98: unsigned char registre_test_bis;
99: unsigned char *tampon;
1.34 bertrand 100: unsigned char variable_implicite;
1.1 bertrand 101:
102: void *element;
103:
1.47 bertrand 104: if ((s_objet = allocation(s_etat_processus, NON)) == NULL)
1.1 bertrand 105: {
106: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
107: return;
108: }
109:
1.47 bertrand 110: element = NULL;
111: nombre_egalites = 0;
112: i = 0;
113:
1.1 bertrand 114: registre_test = (*s_etat_processus).test_instruction;
115: registre_instruction_valide = (*s_etat_processus).instruction_valide;
116: registre_interruption = (*s_etat_processus).traitement_interruptible;
117: (*s_etat_processus).test_instruction = 'Y';
118: (*s_etat_processus).traitement_interruptible = 'N';
119:
120: analyse(s_etat_processus, NULL);
121:
122: (*s_etat_processus).test_instruction = registre_test;
123:
124: if ((*s_etat_processus).instruction_valide == 'Y')
125: {
126: if ((*s_etat_processus).constante_symbolique == 'N')
127: {
128: if ((element = malloc(sizeof(struct_fonction))) == NULL)
129: {
130: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
131: (*s_etat_processus).traitement_interruptible =
132: registre_interruption;
133: return;
134: }
135:
136: (*((struct_fonction *) element)).nombre_arguments = 0;
137: (*((struct_fonction *) element)).prediction_saut = NULL;
138:
139: if ((*s_etat_processus).instruction_intrinseque == 'Y')
140: {
141: /*
142: * Les fonctions intrinsèques ne sont pas sensibles à la casse.
143: */
144:
145: if (((*((struct_fonction *) element)).nom_fonction =
146: conversion_majuscule((*s_etat_processus)
147: .instruction_courante)) == NULL)
148: {
149: (*s_etat_processus).erreur_systeme =
150: d_es_allocation_memoire;
151: (*s_etat_processus).traitement_interruptible =
152: registre_interruption;
153: return;
154: }
155: }
156: else
157: {
158: if (((*((struct_fonction *) element)).nom_fonction =
159: malloc((strlen((*s_etat_processus).instruction_courante)
160: + 1) * sizeof(unsigned char))) == NULL)
161: {
162: (*s_etat_processus).erreur_systeme =
163: d_es_allocation_memoire;
164: (*s_etat_processus).traitement_interruptible =
165: registre_interruption;
166: return;
167: }
168:
169: strcpy((*((struct_fonction *) element)).nom_fonction,
170: (*s_etat_processus).instruction_courante);
171: }
172:
173: (*((struct_fonction *) element)).fonction =
174: analyse_instruction(s_etat_processus,
175: (*((struct_fonction *) element)).nom_fonction);
176:
177: (*s_objet).type = FCT;
178: (*s_objet).objet = element;
1.7 bertrand 179: (*((struct_fonction *) (*s_objet).objet)).prediction_saut = NULL;
180: (*((struct_fonction *) (*s_objet).objet)).prediction_execution
181: = d_faux;
1.1 bertrand 182:
183: if (empilement(s_etat_processus,
184: &((*s_etat_processus).l_base_pile), s_objet) == d_erreur)
185: {
186: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
187: (*s_etat_processus).traitement_interruptible =
188: registre_interruption;
189: return;
190: }
191: }
192: else
193: {
194: if ((instruction_majuscule = conversion_majuscule(
195: (*s_etat_processus).instruction_courante)) == NULL)
196: {
197: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
198: (*s_etat_processus).traitement_interruptible =
199: registre_interruption;
200: return;
201: }
202:
203: if ((*s_etat_processus).constante_symbolique == 'Y')
204: {
205: registre_test_bis = (*s_etat_processus).test_instruction;
206: (*s_etat_processus).test_instruction = 'N';
207: analyse(s_etat_processus, NULL);
208: (*s_etat_processus).test_instruction = registre_test_bis;
1.47 bertrand 209: liberation(s_etat_processus, s_objet);
1.1 bertrand 210: }
211: else
212: {
213: (*s_objet).type = NOM;
214:
215: if (((*s_objet).objet = malloc(sizeof(struct_nom))) == NULL)
216: {
217: (*s_etat_processus).erreur_systeme =
218: d_es_allocation_memoire;
219: (*s_etat_processus).traitement_interruptible =
220: registre_interruption;
221: return;
222: }
223:
224: (*((struct_nom *) (*s_objet).objet)).symbole = d_faux;
225:
226: if (((*((struct_nom *) (*s_objet).objet)).nom =
227: (unsigned char *) malloc((strlen((*s_etat_processus)
228: .instruction_courante) + 1) * sizeof(unsigned char)))
229: == NULL)
230: {
231: (*s_etat_processus).erreur_systeme =
232: d_es_allocation_memoire;
233: (*s_etat_processus).traitement_interruptible =
234: registre_interruption;
235: return;
236: }
237:
238: strcpy((*((struct_nom *) (*s_objet).objet)).nom,
239: (*s_etat_processus).instruction_courante);
240:
241: if (empilement(s_etat_processus,
242: &((*s_etat_processus).l_base_pile), s_objet) ==
243: d_erreur)
244: {
245: (*s_etat_processus).erreur_systeme =
246: d_es_allocation_memoire;
247: (*s_etat_processus).traitement_interruptible =
248: registre_interruption;
249: return;
250: }
251: }
252:
253: free(instruction_majuscule);
254: }
255:
256: (*s_etat_processus).instruction_valide = registre_instruction_valide;
257: (*s_etat_processus).traitement_interruptible = registre_interruption;
258: return;
259: }
260:
261: (*s_etat_processus).instruction_valide = registre_instruction_valide;
262:
263: switch(*((*s_etat_processus).instruction_courante))
264: {
265:
266: /*
267: --------------------------------------------------------------------------------
268: Complexe
269: --------------------------------------------------------------------------------
270: */
271:
272: case '(' :
273: {
274: element = (void *) ((struct_complexe16 *) malloc(
275: sizeof(struct_complexe16)));
276:
277: if (element == NULL)
278: {
279: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
280: (*s_etat_processus).traitement_interruptible =
281: registre_interruption;
282: return;
283: }
284:
285: conversion_format(s_etat_processus,
286: (*s_etat_processus).instruction_courante);
287:
288: sauvegarde_longueur_definitions_chainees =
289: (*s_etat_processus).longueur_definitions_chainees;
290:
1.59 bertrand 291: tampon = (unsigned char *) malloc(((size_t)
1.1 bertrand 292: (((*s_etat_processus).longueur_definitions_chainees
1.59 bertrand 293: = (integer8) strlen((*s_etat_processus)
294: .instruction_courante) + 4) + 1)) * sizeof(unsigned char));
1.1 bertrand 295:
296: if (tampon == NULL)
297: {
298: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
299: (*s_etat_processus).traitement_interruptible =
300: registre_interruption;
301: return;
302: }
303:
304: strcpy(tampon, "<< ");
305: ptr_ecriture = tampon + 3;
306: ptr_lecture = (*s_etat_processus).instruction_courante + 1;
307:
308: nombre_virgules = 0;
309:
310: while((*ptr_lecture) != d_code_fin_chaine)
311: {
312: if ((*ptr_lecture) == ',')
313: {
314: (*ptr_lecture) = ' ';
315: nombre_virgules++;
316: }
317:
318: *ptr_ecriture++ = *ptr_lecture++;
319: }
320:
321: (*(--ptr_ecriture)) = d_code_fin_chaine;
322: strcat(ptr_ecriture, " >>");
323:
324: position_courante = (*s_etat_processus).position_courante;
325: (*s_etat_processus).position_courante = 0;
326:
327: profondeur_initiale = (*s_etat_processus)
328: .hauteur_pile_operationnelle;
329:
330: /*
331: -- On met le tout dans la pile opérationnelle ----------------------------------
332: */
333:
334: (*s_etat_processus).niveau_recursivite++;
335: definitions_chainees_precedentes = (*s_etat_processus)
336: .definitions_chainees;
337: (*s_etat_processus).definitions_chainees = tampon;
338:
339: s_sauvegarde_pile = (*s_etat_processus).l_base_pile_systeme;
340: sauvegarde_niveau_courant = (*s_etat_processus).niveau_courant;
341:
342: (*s_etat_processus).l_base_pile_systeme = NULL;
343: empilement_pile_systeme(s_etat_processus);
344:
345: if ((*s_etat_processus).erreur_systeme != d_es)
346: {
347: (*s_etat_processus).traitement_interruptible =
348: registre_interruption;
349: return;
350: }
351:
352: (*(*s_etat_processus).l_base_pile_systeme).retour_definition = 'Y';
353: (*s_etat_processus).niveau_courant = 0;
354: (*s_etat_processus).autorisation_empilement_programme = 'N';
355: registre_mode_execution_programme =
356: (*s_etat_processus).mode_execution_programme;
357: (*s_etat_processus).mode_execution_programme = 'Y';
358:
359: tampon = (*s_etat_processus).instruction_courante;
360:
361: if ((*s_etat_processus).profilage == d_vrai)
362: {
363: profilage(s_etat_processus, "RPL/2 internals");
364:
365: if ((*s_etat_processus).erreur_systeme != d_es)
366: {
367: return;
368: }
369: }
370:
1.24 bertrand 371: registre_recherche_type = (*s_etat_processus).recherche_type;
372: (*s_etat_processus).recherche_type = 'Y';
373:
1.1 bertrand 374: if (sequenceur(s_etat_processus) == d_erreur)
375: {
1.24 bertrand 376: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
377: (*s_etat_processus).recherche_type = registre_recherche_type;
1.1 bertrand 378: (*s_etat_processus).instruction_courante = tampon;
379: (*s_etat_processus).mode_execution_programme =
380: registre_mode_execution_programme;
381:
1.12 bertrand 382: effacement_pile_systeme(s_etat_processus);
1.1 bertrand 383: (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile;
384: (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant;
385:
386: (*s_etat_processus).niveau_recursivite--;
387:
388: (*s_etat_processus).position_courante = position_courante;
389: free((*s_etat_processus).definitions_chainees);
390: (*s_etat_processus).definitions_chainees =
391: definitions_chainees_precedentes;
392: (*s_etat_processus).longueur_definitions_chainees =
393: sauvegarde_longueur_definitions_chainees;
394:
395: free(element);
1.47 bertrand 396: liberation(s_etat_processus, s_objet);
1.1 bertrand 397:
398: (*s_etat_processus).traitement_interruptible =
399: registre_interruption;
400: return;
401: }
402:
1.24 bertrand 403: (*s_etat_processus).recherche_type = registre_recherche_type;
1.1 bertrand 404: (*s_etat_processus).instruction_courante = tampon;
405: (*s_etat_processus).mode_execution_programme =
406: registre_mode_execution_programme;
407:
408: (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile;
409: (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant;
410:
411: (*s_etat_processus).niveau_recursivite--;
412:
413: (*s_etat_processus).position_courante = position_courante;
414: free((*s_etat_processus).definitions_chainees);
415: (*s_etat_processus).definitions_chainees =
416: definitions_chainees_precedentes;
417: (*s_etat_processus).longueur_definitions_chainees =
418: sauvegarde_longueur_definitions_chainees;
419:
420: /*
421: -- On relit la pile pour remplir le complexe -----------------------------------
422: */
423:
424: profondeur_finale = (*s_etat_processus).hauteur_pile_operationnelle;
425: nombre_elements_convertis = profondeur_finale - profondeur_initiale;
426:
427: if ((nombre_elements_convertis != 2) || (nombre_virgules != 1))
428: {
429: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
430:
1.47 bertrand 431: liberation(s_etat_processus, s_objet);
1.1 bertrand 432: free(element);
433:
1.59 bertrand 434: for(i = 0; i < nombre_elements_convertis; i++)
1.1 bertrand 435: {
436: if (depilement(s_etat_processus, &((*s_etat_processus)
437: .l_base_pile), &s_sous_objet) == d_erreur)
438: {
439: (*s_etat_processus).traitement_interruptible =
440: registre_interruption;
441: return;
442: }
443:
444: liberation(s_etat_processus, s_sous_objet);
445: }
446:
447: (*s_etat_processus).traitement_interruptible =
448: registre_interruption;
449: return;
450: }
451: else
452: {
453: if (depilement(s_etat_processus,
454: &((*s_etat_processus).l_base_pile), &s_sous_objet) ==
455: d_absence_erreur)
456: {
457: if ((*s_sous_objet).type == INT)
458: {
459: (*((struct_complexe16 *) element)).partie_imaginaire =
1.59 bertrand 460: (real8) (*((integer8 *) (*s_sous_objet).objet));
1.1 bertrand 461: }
462: else if ((*s_sous_objet).type == REL)
463: {
464: (*((struct_complexe16 *) element)).partie_imaginaire =
465: (*((real8 *) (*s_sous_objet).objet));
466: }
467: else
468: {
469: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
470:
471: free(element);
1.47 bertrand 472: liberation(s_etat_processus, s_objet);
1.1 bertrand 473:
474: liberation(s_etat_processus, s_sous_objet);
475:
476: (*s_etat_processus).traitement_interruptible =
477: registre_interruption;
478: return;
479: }
480:
481: liberation(s_etat_processus, s_sous_objet);
482:
483: if (depilement(s_etat_processus,
484: &((*s_etat_processus).l_base_pile), &s_sous_objet)
485: == d_absence_erreur)
486: {
487: if ((*s_sous_objet).type == INT)
488: {
489: (*((struct_complexe16 *) element)).partie_reelle =
1.59 bertrand 490: (real8) (*((integer8 *)
491: (*s_sous_objet).objet));
1.1 bertrand 492: }
493: else if ((*s_sous_objet).type == REL)
494: {
495: (*((struct_complexe16 *) element)).partie_reelle =
496: (*((real8 *) (*s_sous_objet).objet));
497: }
498: else
499: {
500: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
501:
502: free(element);
1.47 bertrand 503: liberation(s_etat_processus, s_objet);
1.1 bertrand 504:
505: liberation(s_etat_processus, s_sous_objet);
506:
507: (*s_etat_processus).traitement_interruptible =
508: registre_interruption;
509: return;
510: }
511:
512: liberation(s_etat_processus, s_sous_objet);
513: }
514: }
515: }
516:
1.47 bertrand 517: (*s_objet).type = CPL;
1.1 bertrand 518: break;
519: }
520:
521: /*
522: --------------------------------------------------------------------------------
523: Binaire
524: --------------------------------------------------------------------------------
525: */
526:
527: case '#' :
528: {
529: element = (void *) ((logical8 *) malloc(
530: sizeof(logical8)));
531:
532: if (element == NULL)
533: {
534: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
535: (*s_etat_processus).traitement_interruptible =
536: registre_interruption;
537: return;
538: }
539:
540: erreur_lecture_binaire = d_faux;
541:
542: switch((*s_etat_processus).instruction_courante
543: [strlen((*s_etat_processus).instruction_courante) - 1])
544: {
545: case 'b' :
546: {
1.59 bertrand 547: i = ((integer8) strlen((*s_etat_processus)
548: .instruction_courante)) - 2;
1.1 bertrand 549: valeur_base = 1;
550:
551: (*((logical8 *) element)) = 0;
552:
553: while(i > 0)
554: {
555: if ((*s_etat_processus).instruction_courante[i] == '1')
556: {
557: (*((logical8 *) element)) += valeur_base;
558: }
559: else if ((*s_etat_processus).instruction_courante[i]
560: != '0')
561: {
562: if ((*s_etat_processus).instruction_courante[i]
563: == ' ')
564: {
565: while(i > 0)
566: {
567: if ((*s_etat_processus)
568: .instruction_courante[i] != ' ')
569: {
570: break;
571: }
572:
573: i--;
574: }
575: }
576:
577: if (i != 0)
578: {
579: free(element);
1.47 bertrand 580: liberation(s_etat_processus, s_objet);
1.1 bertrand 581:
582: (*s_etat_processus).erreur_execution =
583: d_ex_syntaxe;
584: (*s_etat_processus).traitement_interruptible =
585: registre_interruption;
586: return;
587: }
588:
589: break;
590: }
591:
592: ancienne_valeur_base = valeur_base;
593: valeur_base *= 2;
594:
595: if (ancienne_valeur_base > valeur_base)
596: {
597: i--;
598:
599: while(i > 0)
600: {
601: if ((*s_etat_processus).instruction_courante[i]
602: != ' ')
603: {
604: erreur_lecture_binaire = d_vrai;
605: }
606:
607: i--;
608: }
609:
610: break;
611: }
612:
613: i--;
614: }
615:
616: nombre_elements_convertis = 1;
617: break;
618: }
619:
620: case 'o' :
621: {
1.59 bertrand 622: i = ((integer8) strlen((*s_etat_processus)
623: .instruction_courante)) - 2;
1.1 bertrand 624: valeur_base = 1;
625:
626: (*((logical8 *) element)) = 0;
627:
628: while(i > 0)
629: {
630: if ((*s_etat_processus).instruction_courante[i] == '1')
631: {
632: (*((logical8 *) element)) += valeur_base;
633: }
634: else if ((*s_etat_processus).instruction_courante[i]
635: == '2')
636: {
637: (*((logical8 *) element)) += 2 * valeur_base;
638: }
639: else if ((*s_etat_processus).instruction_courante[i]
640: == '3')
641: {
642: (*((logical8 *) element)) += 3 * valeur_base;
643: }
644: else if ((*s_etat_processus).instruction_courante[i]
645: == '4')
646: {
647: (*((logical8 *) element)) += 4 * valeur_base;
648: }
649: else if ((*s_etat_processus).instruction_courante[i]
650: == '5')
651: {
652: (*((logical8 *) element)) += 5 * valeur_base;
653: }
654: else if ((*s_etat_processus).instruction_courante[i]
655: == '6')
656: {
657: (*((logical8 *) element)) += 6 * valeur_base;
658: }
659: else if ((*s_etat_processus).instruction_courante[i]
660: == '7')
661: {
662: (*((logical8 *) element)) += 7 * valeur_base;
663: }
664: else if ((*s_etat_processus).instruction_courante[i]
665: != '0')
666: {
667: if ((*s_etat_processus).instruction_courante[i]
668: == ' ')
669: {
670: while(i > 0)
671: {
672: if ((*s_etat_processus)
673: .instruction_courante[i] != ' ')
674: {
675: break;
676: }
677:
678: i--;
679: }
680: }
681:
682: if (i != 0)
683: {
684: free(element);
1.47 bertrand 685: liberation(s_etat_processus, s_objet);
1.1 bertrand 686:
687: (*s_etat_processus).erreur_execution =
688: d_ex_syntaxe;
689: (*s_etat_processus).traitement_interruptible =
690: registre_interruption;
691: return;
692: }
693:
694: break;
695: }
696:
697: ancienne_valeur_base = valeur_base;
698: valeur_base *= 8;
699:
700: if (ancienne_valeur_base > valeur_base)
701: {
702: i--;
703:
704: while(i > 0)
705: {
706: if ((*s_etat_processus).instruction_courante[i]
707: != ' ')
708: {
709: erreur_lecture_binaire = d_vrai;
710: }
711:
712: i--;
713: }
714:
715: break;
716: }
717:
718: i--;
719: }
720:
721: nombre_elements_convertis = 1;
722: break;
723: }
724:
725: case 'd' :
726: {
1.59 bertrand 727: i = ((integer8) strlen((*s_etat_processus)
728: .instruction_courante)) - 2;
1.1 bertrand 729: valeur_base = 1;
730:
731: (*((logical8 *) element)) = 0;
732:
733: while(i > 0)
734: {
735: if ((*s_etat_processus).instruction_courante[i] == '1')
736: {
737: (*((logical8 *) element)) += valeur_base;
738: }
739: else if ((*s_etat_processus).instruction_courante[i]
740: == '2')
741: {
742: (*((logical8 *) element)) += 2 * valeur_base;
743: }
744: else if ((*s_etat_processus).instruction_courante[i]
745: == '3')
746: {
747: (*((logical8 *) element)) += 3 * valeur_base;
748: }
749: else if ((*s_etat_processus).instruction_courante[i]
750: == '4')
751: {
752: (*((logical8 *) element)) += 4 * valeur_base;
753: }
754: else if ((*s_etat_processus).instruction_courante[i]
755: == '5')
756: {
757: (*((logical8 *) element)) += 5 * valeur_base;
758: }
759: else if ((*s_etat_processus).instruction_courante[i]
760: == '6')
761: {
762: (*((logical8 *) element)) += 6 * valeur_base;
763: }
764: else if ((*s_etat_processus).instruction_courante[i]
765: == '7')
766: {
767: (*((logical8 *) element)) += 7 * valeur_base;
768: }
769: else if ((*s_etat_processus).instruction_courante[i]
770: == '8')
771: {
772: (*((logical8 *) element)) += 8 * valeur_base;
773: }
774: else if ((*s_etat_processus).instruction_courante[i]
775: == '9')
776: {
777: (*((logical8 *) element)) += 9 * valeur_base;
778: }
779: else if ((*s_etat_processus).instruction_courante[i]
780: != '0')
781: {
782: if ((*s_etat_processus).instruction_courante[i]
783: == ' ')
784: {
785: while(i > 0)
786: {
787: if ((*s_etat_processus)
788: .instruction_courante[i] != ' ')
789: {
790: break;
791: }
792:
793: i--;
794: }
795: }
796:
797: if (i != 0)
798: {
799: free(element);
1.47 bertrand 800: liberation(s_etat_processus, s_objet);
1.1 bertrand 801:
802: (*s_etat_processus).erreur_execution =
803: d_ex_syntaxe;
804: (*s_etat_processus).traitement_interruptible =
805: registre_interruption;
806: return;
807: }
808:
809: break;
810: }
811:
812: ancienne_valeur_base = valeur_base;
813: valeur_base *= 10;
814:
815: if (ancienne_valeur_base > valeur_base)
816: {
817: i--;
818:
819: while(i > 0)
820: {
821: if ((*s_etat_processus).instruction_courante[i]
822: != ' ')
823: {
824: erreur_lecture_binaire = d_vrai;
825: }
826:
827: i--;
828: }
829:
830: break;
831: }
832:
833: i--;
834: }
835:
836: nombre_elements_convertis = 1;
837: break;
838: }
839:
840: case 'h' :
841: {
1.59 bertrand 842: i = ((integer8) strlen((*s_etat_processus)
843: .instruction_courante)) - 2;
1.1 bertrand 844: valeur_base = 1;
845:
846: (*((logical8 *) element)) = 0;
847:
848: while(i > 0)
849: {
850: if ((*s_etat_processus).instruction_courante[i] == '1')
851: {
852: (*((logical8 *) element)) += valeur_base;
853: }
854: else if ((*s_etat_processus).instruction_courante[i]
855: == '2')
856: {
857: (*((logical8 *) element)) += 2 * valeur_base;
858: }
859: else if ((*s_etat_processus).instruction_courante[i]
860: == '3')
861: {
862: (*((logical8 *) element)) += 3 * valeur_base;
863: }
864: else if ((*s_etat_processus).instruction_courante[i]
865: == '4')
866: {
867: (*((logical8 *) element)) += 4 * valeur_base;
868: }
869: else if ((*s_etat_processus).instruction_courante[i]
870: == '5')
871: {
872: (*((logical8 *) element)) += 5 * valeur_base;
873: }
874: else if ((*s_etat_processus).instruction_courante[i]
875: == '6')
876: {
877: (*((logical8 *) element)) += 6 * valeur_base;
878: }
879: else if ((*s_etat_processus).instruction_courante[i]
880: == '7')
881: {
882: (*((logical8 *) element)) += 7 * valeur_base;
883: }
884: else if ((*s_etat_processus).instruction_courante[i]
885: == '8')
886: {
887: (*((logical8 *) element)) += 8 * valeur_base;
888: }
889: else if ((*s_etat_processus).instruction_courante[i]
890: == '9')
891: {
892: (*((logical8 *) element)) += 9 * valeur_base;
893: }
894: else if ((*s_etat_processus).instruction_courante[i]
895: == 'A')
896: {
897: (*((logical8 *) element)) += 10 * valeur_base;
898: }
899: else if ((*s_etat_processus).instruction_courante[i]
900: == 'B')
901: {
902: (*((logical8 *) element)) += 11 * valeur_base;
903: }
904: else if ((*s_etat_processus).instruction_courante[i]
905: == 'C')
906: {
907: (*((logical8 *) element)) += 12 * valeur_base;
908: }
909: else if ((*s_etat_processus).instruction_courante[i]
910: == 'D')
911: {
912: (*((logical8 *) element)) += 13 * valeur_base;
913: }
914: else if ((*s_etat_processus).instruction_courante[i]
915: == 'E')
916: {
917: (*((logical8 *) element)) += 14 * valeur_base;
918: }
919: else if ((*s_etat_processus).instruction_courante[i]
920: == 'F')
921: {
922: (*((logical8 *) element)) += 15 * valeur_base;
923: }
924: else if ((*s_etat_processus).instruction_courante[i]
925: != '0')
926: {
927: if ((*s_etat_processus).instruction_courante[i]
928: == ' ')
929: {
930: while(i > 0)
931: {
932: if ((*s_etat_processus)
933: .instruction_courante[i] != ' ')
934: {
935: break;
936: }
937:
938: i--;
939: }
940: }
941:
942: if (i != 0)
943: {
944: free(element);
1.47 bertrand 945: liberation(s_etat_processus, s_objet);
1.1 bertrand 946:
947: (*s_etat_processus).erreur_execution =
948: d_ex_syntaxe;
949: (*s_etat_processus).traitement_interruptible =
950: registre_interruption;
951: return;
952: }
953:
954: break;
955: }
956:
957: ancienne_valeur_base = valeur_base;
958: valeur_base *= 16;
959:
960: if (ancienne_valeur_base > valeur_base)
961: {
962: i--;
963:
964: while(i > 0)
965: {
966: if ((*s_etat_processus).instruction_courante[i]
967: != ' ')
968: {
969: erreur_lecture_binaire = d_vrai;
970: }
971:
972: i--;
973: }
974:
975: break;
976: }
977:
978: i--;
979: }
980:
981: nombre_elements_convertis = 1;
982: break;
983: }
984:
985: default :
986: {
987: nombre_elements_convertis = 0;
988: break;
989: }
990: }
991:
992: if ((nombre_elements_convertis != 1) ||
993: (erreur_lecture_binaire == d_vrai))
994: {
995: free(element);
1.47 bertrand 996: liberation(s_etat_processus, s_objet);
1.1 bertrand 997:
998: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
999: (*s_etat_processus).traitement_interruptible =
1000: registre_interruption;
1001: return;
1002: }
1003:
1.47 bertrand 1004: (*s_objet).type = BIN;
1.1 bertrand 1005: break;
1006: }
1007:
1008: /*
1009: --------------------------------------------------------------------------------
1010: Matrices ou vecteurs entiers, réels ou complexes
1011: --------------------------------------------------------------------------------
1012: */
1013:
1014: case '[' :
1015: {
1016: niveau = 0;
1017: niveau_maximal = 0;
1018:
1019: nombre_colonnes = 0;
1020: nombre_lignes = 0;
1021:
1022: drapeau_complexe = d_faux;
1023: drapeau_reel = d_faux;
1024:
1025: ptr = (*s_etat_processus).instruction_courante;
1026:
1027: while((*ptr) != d_code_fin_chaine)
1028: {
1029: switch(*ptr)
1030: {
1031: case '(' :
1032: case ')' :
1033: {
1034: drapeau_complexe = d_vrai;
1035: drapeau_reel = d_vrai;
1036: break;
1037: }
1038:
1039: case '.' :
1040: case 'E' :
1041: case 'e' :
1042: {
1043: drapeau_reel = d_vrai;
1044: break;
1045: }
1046:
1047: case '[' :
1048: {
1049: niveau_maximal = (++niveau);
1050: break;
1051: }
1052:
1053: case ']' :
1054: {
1055: niveau--;
1056: break;
1057: }
1058: }
1059:
1060: ptr++;
1061: }
1062:
1063: if (niveau != 0)
1064: {
1.47 bertrand 1065: liberation(s_etat_processus, s_objet);
1.1 bertrand 1066:
1067: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
1068: (*s_etat_processus).traitement_interruptible =
1069: registre_interruption;
1070: return;
1071: }
1072:
1073: drapeau_matrice = (niveau_maximal == 2) ? d_vrai : d_faux;
1074:
1075: switch (drapeau_matrice)
1076: {
1077:
1078: /*
1079: --------------------------------------------------------------------------------
1080: Vecteur
1081: --------------------------------------------------------------------------------
1082: */
1083:
1084: case d_faux :
1085: {
1086:
1087: /*
1088: -- Sauvegarde des paramètres du processus pour analyser le vecteur -------------
1.3 bertrand 1089: -- Analyse récursive en appelant l'interprète sur le vecteur moins -------------
1.1 bertrand 1090: -- ses délimiteurs -------------------------------------------------------------
1091: */
1092:
1093: sauvegarde_longueur_definitions_chainees =
1094: (*s_etat_processus).longueur_definitions_chainees;
1095:
1.59 bertrand 1096: tampon = (unsigned char *) malloc(((size_t)
1.1 bertrand 1097: (((*s_etat_processus).longueur_definitions_chainees
1.59 bertrand 1098: = (integer8) strlen((*s_etat_processus)
1099: .instruction_courante) + 4) + 1)) *
1100: sizeof(unsigned char));
1.1 bertrand 1101:
1102: if (tampon == NULL)
1103: {
1104: (*s_etat_processus).erreur_systeme =
1105: d_es_allocation_memoire;
1106: (*s_etat_processus).traitement_interruptible =
1107: registre_interruption;
1108: return;
1109: }
1110:
1111: strcpy(tampon, "<< ");
1112: ptr_ecriture = tampon + 3;
1113: ptr_lecture = (*s_etat_processus).instruction_courante + 1;
1114:
1115: while((*ptr_lecture) != d_code_fin_chaine)
1116: {
1117: *ptr_ecriture++ = *ptr_lecture++;
1118: }
1119:
1120: (*(--ptr_ecriture)) = d_code_fin_chaine;
1121: strcat(ptr_ecriture, " >>");
1122:
1123: position_courante = (*s_etat_processus).position_courante;
1124: (*s_etat_processus).position_courante = 0;
1125:
1126: profondeur_initiale = (*s_etat_processus)
1127: .hauteur_pile_operationnelle;
1128:
1129: /*
1130: -- On met le tout dans la pile opérationnelle ----------------------------------
1131: */
1132:
1133: (*s_etat_processus).niveau_recursivite++;
1134: definitions_chainees_precedentes = (*s_etat_processus)
1135: .definitions_chainees;
1136: (*s_etat_processus).definitions_chainees = tampon;
1137:
1138: s_sauvegarde_pile = (*s_etat_processus).l_base_pile_systeme;
1139: sauvegarde_niveau_courant = (*s_etat_processus)
1140: .niveau_courant;
1141:
1142: (*s_etat_processus).l_base_pile_systeme = NULL;
1143: empilement_pile_systeme(s_etat_processus);
1144:
1145: if ((*s_etat_processus).erreur_systeme != d_es)
1146: {
1147: (*s_etat_processus).traitement_interruptible =
1148: registre_interruption;
1149: return;
1150: }
1151:
1152: (*(*s_etat_processus).l_base_pile_systeme)
1153: .retour_definition = 'Y';
1154: (*s_etat_processus).niveau_courant = 0;
1155: (*s_etat_processus).autorisation_empilement_programme = 'N';
1156: registre_mode_execution_programme =
1157: (*s_etat_processus).mode_execution_programme;
1158: (*s_etat_processus).mode_execution_programme = 'Y';
1159: (*s_etat_processus).erreur_scrutation = d_faux;
1160:
1161: tampon = (*s_etat_processus).instruction_courante;
1162: nombre_lignes_a_supprimer =
1163: (*s_etat_processus).hauteur_pile_operationnelle;
1164:
1165: if ((*s_etat_processus).profilage == d_vrai)
1166: {
1167: profilage(s_etat_processus, "RPL/2 internals");
1168:
1169: if ((*s_etat_processus).erreur_systeme != d_es)
1170: {
1171: return;
1172: }
1173: }
1174:
1.24 bertrand 1175: registre_recherche_type =
1176: (*s_etat_processus).recherche_type;
1177: (*s_etat_processus).recherche_type = 'Y';
1178:
1.1 bertrand 1179: if (sequenceur(s_etat_processus) == d_erreur)
1180: {
1.24 bertrand 1181: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
1182: (*s_etat_processus).recherche_type =
1183: registre_recherche_type;
1.1 bertrand 1184: (*s_etat_processus).mode_execution_programme =
1185: registre_mode_execution_programme;
1186: nombre_lignes_a_supprimer =
1187: (*s_etat_processus).hauteur_pile_operationnelle
1188: - nombre_lignes_a_supprimer;
1189:
1190: for(i = 0; i < nombre_lignes_a_supprimer; i++)
1191: {
1192: if (depilement(s_etat_processus,
1193: &((*s_etat_processus).l_base_pile),
1194: &s_sous_objet) == d_erreur)
1195: {
1196: (*s_etat_processus).traitement_interruptible =
1197: registre_interruption;
1198: return;
1199: }
1200:
1201: liberation(s_etat_processus, s_sous_objet);
1202: }
1203:
1204: (*s_etat_processus).instruction_courante = tampon;
1205:
1.12 bertrand 1206: effacement_pile_systeme(s_etat_processus);
1.1 bertrand 1207: (*s_etat_processus).l_base_pile_systeme =
1208: s_sauvegarde_pile;
1209: (*s_etat_processus).niveau_courant =
1210: sauvegarde_niveau_courant;
1211:
1212: (*s_etat_processus).niveau_recursivite--;
1213: free((*s_etat_processus).definitions_chainees);
1214:
1215: (*s_etat_processus).position_courante =
1216: position_courante;
1217: (*s_etat_processus).definitions_chainees =
1218: definitions_chainees_precedentes;
1219: (*s_etat_processus).longueur_definitions_chainees =
1220: sauvegarde_longueur_definitions_chainees;
1221:
1.47 bertrand 1222: liberation(s_etat_processus, s_objet);
1.1 bertrand 1223:
1224: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
1225: (*s_etat_processus).traitement_interruptible =
1226: registre_interruption;
1227: return;
1228: }
1229:
1.24 bertrand 1230: (*s_etat_processus).recherche_type =
1231: registre_recherche_type;
1.1 bertrand 1232: (*s_etat_processus).mode_execution_programme =
1233: registre_mode_execution_programme;
1234:
1235: if ((*s_etat_processus).erreur_scrutation == d_vrai)
1236: {
1237: nombre_lignes_a_supprimer =
1238: (*s_etat_processus).hauteur_pile_operationnelle
1239: - nombre_lignes_a_supprimer;
1240:
1241: for(i = 0; i < nombre_lignes_a_supprimer; i++)
1242: {
1243: if (depilement(s_etat_processus,
1244: &((*s_etat_processus).l_base_pile),
1245: &s_sous_objet) == d_erreur)
1246: {
1247: (*s_etat_processus).traitement_interruptible =
1248: registre_interruption;
1249: return;
1250: }
1251:
1252: liberation(s_etat_processus, s_sous_objet);
1253: }
1254:
1255: (*s_etat_processus).instruction_courante = tampon;
1256:
1.12 bertrand 1257: effacement_pile_systeme(s_etat_processus);
1.1 bertrand 1258: (*s_etat_processus).l_base_pile_systeme =
1259: s_sauvegarde_pile;
1260: (*s_etat_processus).niveau_courant =
1261: sauvegarde_niveau_courant;
1262:
1263: (*s_etat_processus).niveau_recursivite--;
1264: free((*s_etat_processus).definitions_chainees);
1265:
1266: (*s_etat_processus).position_courante =
1267: position_courante;
1268: (*s_etat_processus).definitions_chainees =
1269: definitions_chainees_precedentes;
1270: (*s_etat_processus).longueur_definitions_chainees =
1271: sauvegarde_longueur_definitions_chainees;
1272:
1.47 bertrand 1273: liberation(s_etat_processus, s_objet);
1.1 bertrand 1274:
1275: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
1276: (*s_etat_processus).traitement_interruptible =
1277: registre_interruption;
1278: return;
1279: }
1280:
1281: (*s_etat_processus).instruction_courante = tampon;
1282:
1283: (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile;
1284: (*s_etat_processus).niveau_courant =
1285: sauvegarde_niveau_courant;
1286:
1287: (*s_etat_processus).niveau_recursivite--;
1288:
1289: (*s_etat_processus).position_courante = position_courante;
1290: free((*s_etat_processus).definitions_chainees);
1291: (*s_etat_processus).definitions_chainees =
1292: definitions_chainees_precedentes;
1293: (*s_etat_processus).longueur_definitions_chainees =
1294: sauvegarde_longueur_definitions_chainees;
1295:
1296: /*
1297: -- On relit la pile pour remplir le vecteur ------------------------------------
1298: */
1299:
1300: profondeur_finale = (*s_etat_processus)
1301: .hauteur_pile_operationnelle;
1302: nombre_colonnes = profondeur_finale - profondeur_initiale;
1303:
1304: element = (void *) ((struct_vecteur *)
1305: malloc(sizeof(struct_vecteur)));
1306:
1307: if (element == NULL)
1308: {
1309: (*s_etat_processus).erreur_systeme =
1310: d_es_allocation_memoire;
1311: (*s_etat_processus).traitement_interruptible =
1312: registre_interruption;
1313: return;
1314: }
1315:
1316: (*((struct_vecteur *) element)).taille = nombre_colonnes;
1317:
1318: if (drapeau_complexe == d_vrai)
1319: {
1320: (*((struct_vecteur *) element)).tableau = (void *)
1.59 bertrand 1321: ((struct_complexe16 *) malloc(((size_t)
1322: nombre_colonnes) *
1.1 bertrand 1323: sizeof(struct_complexe16)));
1324: (*((struct_vecteur *) element)).type = 'C';
1325: }
1326: else if (drapeau_reel == d_vrai)
1327: {
1328: (*((struct_vecteur *) element)).tableau = (void *)
1.59 bertrand 1329: ((real8 *) malloc(((size_t) nombre_colonnes) *
1.1 bertrand 1330: sizeof(real8)));
1331: (*((struct_vecteur *) element)).type = 'R';
1332: }
1333: else
1334: {
1335: (*((struct_vecteur *) element)).tableau = (void *)
1.59 bertrand 1336: ((integer8 *) malloc(((size_t) nombre_colonnes)
1337: * sizeof(integer8)));
1.1 bertrand 1338: (*((struct_vecteur *) element)).type = 'I';
1339: }
1340:
1341: if ((*((struct_vecteur *) element)).tableau == NULL)
1342: {
1343: (*s_etat_processus).erreur_systeme =
1344: d_es_allocation_memoire;
1345: (*s_etat_processus).traitement_interruptible =
1346: registre_interruption;
1347: return;
1348: }
1349:
1350: erreur = d_absence_erreur;
1.47 bertrand 1351: s_objet_registre = s_objet;
1.1 bertrand 1352:
1353: for(i = 0; (i < nombre_colonnes) &&
1354: (erreur == d_absence_erreur); i++)
1355: {
1356: erreur = depilement(s_etat_processus,
1357: &((*s_etat_processus).l_base_pile), &s_objet);
1358:
1359: if (erreur == d_absence_erreur)
1360: {
1361: if (drapeau_complexe == d_vrai)
1362: {
1363: if ((*s_objet).type == CPL)
1364: {
1365: ((struct_complexe16 *) (*((struct_vecteur *)
1366: element)).tableau)[nombre_colonnes
1367: - i - 1] = *((struct_complexe16 *)
1368: ((*s_objet).objet));
1369: }
1370: else if ((*s_objet).type == REL)
1371: {
1372: ((struct_complexe16 *) (*((struct_vecteur *)
1373: element)).tableau)[nombre_colonnes
1374: - i - 1].partie_reelle =
1375: *((real8 *) ((*s_objet).objet));
1376: ((struct_complexe16 *) (*((struct_vecteur *)
1377: element)).tableau)[nombre_colonnes
1378: - i - 1].partie_imaginaire =
1379: (real8) 0;
1380: }
1381: else if ((*s_objet).type == INT)
1382: {
1383: ((struct_complexe16 *) (*((struct_vecteur *)
1384: element)).tableau)[nombre_colonnes
1385: - i - 1].partie_reelle = (real8)
1386: (*((integer8 *) ((*s_objet)
1387: .objet)));
1388: ((struct_complexe16 *) (*((struct_vecteur *)
1389: element)).tableau) [nombre_colonnes
1390: - i - 1].partie_imaginaire =
1391: (real8) 0;
1392: }
1393: else
1394: {
1395: erreur = d_erreur;
1396: }
1397: }
1398: else if (drapeau_reel == d_vrai)
1399: {
1400: if ((*s_objet).type == REL)
1401: {
1402: ((real8 *) (*((struct_vecteur *)
1403: element)).tableau)
1404: [nombre_colonnes - i - 1] =
1405: *((real8 *) ((*s_objet).objet));
1406: }
1407: else if ((*s_objet).type == INT)
1408: {
1409: ((real8 *) (*((struct_vecteur *)
1410: element)).tableau)
1411: [nombre_colonnes - i - 1] =
1412: (real8) (*((integer8 *)
1413: ((*s_objet).objet)));
1414: }
1415: else
1416: {
1417: erreur = d_erreur;
1418: }
1419: }
1420: else
1421: {
1422: if ((*s_objet).type == INT)
1423: {
1424: ((integer8 *) (*((struct_vecteur *)
1425: element)).tableau)
1426: [nombre_colonnes - i - 1] =
1427: *((integer8 *) ((*s_objet).objet));
1428: }
1429: else
1430: {
1431: erreur = d_erreur;
1432: }
1433: }
1434:
1435: liberation(s_etat_processus, s_objet);
1436:
1437: if (erreur == d_erreur)
1438: {
1439: for(i++; i < nombre_colonnes; i++)
1440: {
1441: if (depilement(s_etat_processus,
1442: &((*s_etat_processus).l_base_pile),
1443: &s_objet) == d_erreur)
1444: {
1445: (*s_etat_processus)
1446: .traitement_interruptible =
1447: registre_interruption;
1.47 bertrand 1448: liberation(s_etat_processus,
1449: s_objet_registre);
1.1 bertrand 1450: return;
1451: }
1452:
1453: liberation(s_etat_processus, s_objet);
1454: }
1455:
1456: (*s_etat_processus).erreur_execution =
1457: d_ex_syntaxe;
1458:
1459: free((*((struct_vecteur *) element)).tableau);
1460: free(element);
1461:
1.47 bertrand 1462: liberation(s_etat_processus, s_objet_registre);
1.1 bertrand 1463: (*s_etat_processus).traitement_interruptible =
1464: registre_interruption;
1465: return;
1466: }
1467: }
1468: else
1469: {
1.48 bertrand 1470: liberation(s_etat_processus, s_objet_registre);
1471:
1.1 bertrand 1472: (*s_etat_processus).erreur_systeme = d_es_pile_vide;
1473: (*s_etat_processus).traitement_interruptible =
1474: registre_interruption;
1475: return;
1476: }
1477: }
1478:
1.47 bertrand 1479: s_objet = s_objet_registre;
1.1 bertrand 1480:
1481: if (drapeau_complexe == d_vrai)
1482: {
1483: (*s_objet).type = VCX;
1484: }
1485: else if (drapeau_reel == d_vrai)
1486: {
1487: (*s_objet).type = VRL;
1488: }
1489: else
1490: {
1491: (*s_objet).type = VIN;
1492: }
1493:
1494: break;
1495: }
1496:
1497: /*
1498: --------------------------------------------------------------------------------
1499: Matrice
1500: --------------------------------------------------------------------------------
1501: */
1502:
1503: case d_vrai :
1504: {
1505: nombre_lignes--;
1506:
1507: sauvegarde_longueur_definitions_chainees =
1508: (*s_etat_processus).longueur_definitions_chainees;
1509:
1.59 bertrand 1510: tampon = (unsigned char *) malloc(((size_t)
1.1 bertrand 1511: (((*s_etat_processus).longueur_definitions_chainees
1.59 bertrand 1512: = (integer8) strlen((*s_etat_processus)
1513: .instruction_courante) + 4) + 1)) *
1514: sizeof(unsigned char));
1.1 bertrand 1515:
1516: if (tampon == NULL)
1517: {
1518: (*s_etat_processus).erreur_systeme =
1519: d_es_allocation_memoire;
1520: (*s_etat_processus).traitement_interruptible =
1521: registre_interruption;
1522: return;
1523: }
1524:
1525: strcpy(tampon, "<< ");
1526: ptr_ecriture = tampon + 3;
1527: ptr_lecture = (*s_etat_processus).instruction_courante + 1;
1528:
1529: while((*ptr_lecture) != d_code_fin_chaine)
1530: {
1531: *ptr_ecriture++ = *ptr_lecture++;
1532: }
1533:
1534: (*(--ptr_ecriture)) = d_code_fin_chaine;
1535: strcat(ptr_ecriture, " >>");
1536:
1537: position_courante = (*s_etat_processus).position_courante;
1538: (*s_etat_processus).position_courante = 0;
1539:
1540: profondeur_initiale = (*s_etat_processus)
1541: .hauteur_pile_operationnelle;
1542:
1543: /*
1544: -- On met les lignes de la matrice dans la pile opérationnelle -----------------
1545: */
1546:
1547: (*s_etat_processus).niveau_recursivite++;
1548: definitions_chainees_precedentes = (*s_etat_processus)
1549: .definitions_chainees;
1550: (*s_etat_processus).definitions_chainees = tampon;
1551:
1552: s_sauvegarde_pile = (*s_etat_processus).l_base_pile_systeme;
1553: sauvegarde_niveau_courant = (*s_etat_processus)
1554: .niveau_courant;
1555:
1556: (*s_etat_processus).l_base_pile_systeme = NULL;
1557: empilement_pile_systeme(s_etat_processus);
1558:
1559: if ((*s_etat_processus).erreur_systeme != d_es)
1560: {
1561: (*s_etat_processus).traitement_interruptible =
1562: registre_interruption;
1563: return;
1564: }
1565:
1566: (*(*s_etat_processus).l_base_pile_systeme)
1567: .retour_definition = 'Y';
1568: (*s_etat_processus).niveau_courant = 0;
1569: (*s_etat_processus).autorisation_empilement_programme = 'N';
1570: registre_mode_execution_programme =
1571: (*s_etat_processus).mode_execution_programme;
1572: (*s_etat_processus).mode_execution_programme = 'Y';
1573: (*s_etat_processus).erreur_scrutation = d_faux;
1574:
1575: tampon = (*s_etat_processus).instruction_courante;
1576: nombre_lignes_a_supprimer =
1577: (*s_etat_processus).hauteur_pile_operationnelle;
1578:
1579: if ((*s_etat_processus).profilage == d_vrai)
1580: {
1581: profilage(s_etat_processus, "RPL/2 internals");
1582:
1583: if ((*s_etat_processus).erreur_systeme != d_es)
1584: {
1585: return;
1586: }
1587: }
1.24 bertrand 1588:
1589: registre_recherche_type = (*s_etat_processus)
1590: .recherche_type;
1591: (*s_etat_processus).recherche_type = 'Y';
1.1 bertrand 1592:
1593: if (sequenceur(s_etat_processus) == d_erreur)
1594: {
1.24 bertrand 1595: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
1596: (*s_etat_processus).recherche_type =
1597: registre_recherche_type;
1.1 bertrand 1598: (*s_etat_processus).mode_execution_programme =
1599: registre_mode_execution_programme;
1600: nombre_lignes_a_supprimer =
1601: (*s_etat_processus).hauteur_pile_operationnelle
1602: - nombre_lignes_a_supprimer;
1603:
1604: for(i = 0; i < nombre_lignes_a_supprimer; i++)
1605: {
1606: if (depilement(s_etat_processus,
1607: &((*s_etat_processus).l_base_pile),
1608: &s_sous_objet) == d_erreur)
1609: {
1610: (*s_etat_processus).traitement_interruptible =
1611: registre_interruption;
1612: return;
1613: }
1614:
1615: liberation(s_etat_processus, s_sous_objet);
1616: }
1617:
1618: (*s_etat_processus).instruction_courante = tampon;
1619:
1.12 bertrand 1620: effacement_pile_systeme(s_etat_processus);
1.1 bertrand 1621: (*s_etat_processus).l_base_pile_systeme =
1622: s_sauvegarde_pile;
1623: (*s_etat_processus).niveau_courant =
1624: sauvegarde_niveau_courant;
1625:
1626: free((*s_etat_processus).definitions_chainees);
1627: (*s_etat_processus).niveau_recursivite--;
1628:
1629: (*s_etat_processus).definitions_chainees =
1630: definitions_chainees_precedentes;
1631: (*s_etat_processus).longueur_definitions_chainees =
1632: sauvegarde_longueur_definitions_chainees;
1633:
1634: (*s_etat_processus).position_courante =
1635: position_courante;
1636:
1.47 bertrand 1637: liberation(s_etat_processus, s_objet);
1.1 bertrand 1638:
1639: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
1640: (*s_etat_processus).traitement_interruptible =
1641: registre_interruption;
1642: return;
1643: }
1644:
1.24 bertrand 1645: (*s_etat_processus).recherche_type =
1646: registre_recherche_type;
1.1 bertrand 1647: (*s_etat_processus).mode_execution_programme =
1648: registre_mode_execution_programme;
1649:
1650: if ((*s_etat_processus).erreur_scrutation == d_vrai)
1651: {
1652: nombre_lignes_a_supprimer =
1653: (*s_etat_processus).hauteur_pile_operationnelle
1654: - nombre_lignes_a_supprimer;
1655:
1656: for(i = 0; i < nombre_lignes_a_supprimer; i++)
1657: {
1658: if (depilement(s_etat_processus,
1659: &((*s_etat_processus).l_base_pile),
1660: &s_sous_objet) == d_erreur)
1661: {
1662: (*s_etat_processus).traitement_interruptible =
1663: registre_interruption;
1664: return;
1665: }
1666:
1667: liberation(s_etat_processus, s_sous_objet);
1668: }
1669:
1670: (*s_etat_processus).instruction_courante = tampon;
1671:
1.12 bertrand 1672: effacement_pile_systeme(s_etat_processus);
1.1 bertrand 1673: (*s_etat_processus).l_base_pile_systeme =
1674: s_sauvegarde_pile;
1675: (*s_etat_processus).niveau_courant =
1676: sauvegarde_niveau_courant;
1677:
1678: free((*s_etat_processus).definitions_chainees);
1679: (*s_etat_processus).niveau_recursivite--;
1680:
1681: (*s_etat_processus).definitions_chainees =
1682: definitions_chainees_precedentes;
1683: (*s_etat_processus).longueur_definitions_chainees =
1684: sauvegarde_longueur_definitions_chainees;
1685:
1686: (*s_etat_processus).position_courante =
1687: position_courante;
1688:
1.47 bertrand 1689: liberation(s_etat_processus, s_objet);
1.1 bertrand 1690:
1691: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
1692: (*s_etat_processus).traitement_interruptible =
1693: registre_interruption;
1694: return;
1695: }
1696:
1697: (*s_etat_processus).instruction_courante = tampon;
1698:
1699: (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile;
1700: (*s_etat_processus).niveau_courant =
1701: sauvegarde_niveau_courant;
1702:
1703: free((*s_etat_processus).definitions_chainees);
1704: (*s_etat_processus).definitions_chainees =
1705: definitions_chainees_precedentes;
1706: (*s_etat_processus).longueur_definitions_chainees =
1707: sauvegarde_longueur_definitions_chainees;
1708:
1709: (*s_etat_processus).niveau_recursivite--;
1710:
1711: (*s_etat_processus).position_courante = position_courante;
1712:
1713: /*
1714: -- On relit la pile qui contient des objets "vecteurs" contenant les -----------
1715: -- lignes de la matrice --------------------------------------------------------
1716: */
1717:
1718: profondeur_finale = (*s_etat_processus)
1719: .hauteur_pile_operationnelle;
1720:
1721: nombre_lignes = profondeur_finale - profondeur_initiale;
1722:
1723: element = (void *) ((struct_matrice *) malloc(
1724: sizeof(struct_matrice)));
1725:
1726: if (element == NULL)
1727: {
1728: (*s_etat_processus).erreur_systeme =
1729: d_es_allocation_memoire;
1730: (*s_etat_processus).traitement_interruptible =
1731: registre_interruption;
1732: return;
1733: }
1734:
1735: (*((struct_matrice *) element))
1736: .nombre_lignes = nombre_lignes;
1737: (*((struct_matrice *) element)).nombre_colonnes =
1738: (*((struct_vecteur *) ((*(*(*s_etat_processus)
1739: .l_base_pile).donnee).objet))).taille;
1740: nombre_colonnes = (*((struct_matrice *)
1741: element)).nombre_colonnes;
1742:
1743: l_element_courant = (*s_etat_processus).l_base_pile;
1744:
1745: drapeau_complexe = d_faux;
1746: drapeau_reel = d_faux;
1747: erreur = d_absence_erreur;
1748:
1749: for(i = 0; i < nombre_lignes; i++)
1750: {
1751: if (nombre_colonnes != (*((struct_vecteur *)
1752: (*(*l_element_courant).donnee).objet)).taille)
1753: {
1754: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
1755:
1756: for(j = 0; j < nombre_lignes; j++)
1757: {
1758: if (depilement(s_etat_processus,
1759: &((*s_etat_processus).l_base_pile),
1760: &s_sous_objet) == d_erreur)
1761: {
1762: (*s_etat_processus)
1763: .traitement_interruptible =
1764: registre_interruption;
1765: return;
1766: }
1767:
1768: liberation(s_etat_processus, s_sous_objet);
1769: }
1770:
1771: free(element);
1.47 bertrand 1772: liberation(s_etat_processus, s_objet);
1.1 bertrand 1773:
1774: (*s_etat_processus).traitement_interruptible =
1775: registre_interruption;
1776: return;
1777: }
1778:
1779: if ((*(*l_element_courant)
1780: .donnee).type == VRL)
1781: {
1782: drapeau_reel = d_vrai;
1783: }
1784: else if ((*(*l_element_courant)
1785: .donnee).type == VCX)
1786: {
1787: drapeau_complexe = d_vrai;
1788: }
1789:
1790: l_element_courant = (*l_element_courant).suivant;
1791: }
1792:
1.47 bertrand 1793: s_objet_registre = s_objet;
1.1 bertrand 1794:
1795: if ((*s_etat_processus).erreur_execution == d_ex)
1796: {
1797: if (drapeau_complexe == d_vrai)
1798: {
1799: if (((*((struct_matrice *) element)).tableau =
1800: (void **) ((struct_complexe16 **)
1.59 bertrand 1801: malloc(((size_t) nombre_lignes) * sizeof(
1.1 bertrand 1802: struct_complexe16 *)))) == NULL)
1803: {
1.47 bertrand 1804: liberation(s_etat_processus, s_objet_registre);
1805:
1.1 bertrand 1806: (*s_etat_processus).erreur_systeme =
1807: d_es_allocation_memoire;
1808: (*s_etat_processus).traitement_interruptible =
1809: registre_interruption;
1810: return;
1811: }
1812:
1813: (*((struct_matrice *) element)).type = 'C';
1814:
1815: for(i = 0; i < nombre_lignes; i++)
1816: {
1817: if ((((*((struct_matrice *)
1818: element)).tableau)[i] = (void *)
1819: ((struct_complexe16 *)
1.59 bertrand 1820: malloc(((size_t) nombre_colonnes) *
1821: sizeof(struct_complexe16)))) == NULL)
1.1 bertrand 1822: {
1.47 bertrand 1823: liberation(s_etat_processus,
1824: s_objet_registre);
1825:
1.1 bertrand 1826: (*s_etat_processus).erreur_systeme =
1827: d_es_allocation_memoire;
1828: (*s_etat_processus)
1829: .traitement_interruptible =
1830: registre_interruption;
1831: return;
1832: }
1833: }
1834: }
1835: else if (drapeau_reel == d_vrai)
1836: {
1837: if (((*((struct_matrice *) element)).tableau =
1.59 bertrand 1838: (void **) ((real8 **) malloc(((size_t)
1839: nombre_lignes) * sizeof(real8 *))))
1.1 bertrand 1840: == NULL)
1841: {
1.47 bertrand 1842: liberation(s_etat_processus, s_objet_registre);
1843:
1.1 bertrand 1844: (*s_etat_processus).erreur_systeme =
1845: d_es_allocation_memoire;
1846: (*s_etat_processus).traitement_interruptible =
1847: registre_interruption;
1848: return;
1849: }
1850:
1851: (*((struct_matrice *) element)).type = 'R';
1852:
1853: for(i = 0; i < nombre_lignes; i++)
1854: {
1855: if ((((*((struct_matrice *)element)).tableau)[i]
1856: = (void *) ((real8 *)
1.59 bertrand 1857: malloc(((size_t) nombre_colonnes) *
1.1 bertrand 1858: sizeof(real8)))) == NULL)
1859: {
1.47 bertrand 1860: liberation(s_etat_processus,
1861: s_objet_registre);
1862:
1.1 bertrand 1863: (*s_etat_processus).erreur_systeme =
1864: d_es_allocation_memoire;
1865: (*s_etat_processus)
1866: .traitement_interruptible =
1867: registre_interruption;
1868: return;
1869: }
1870: }
1871: }
1872: else
1873: {
1874: if (((*((struct_matrice *) element)).tableau =
1875: (void **) ((integer8 **)
1.59 bertrand 1876: malloc(((size_t) nombre_lignes) *
1.1 bertrand 1877: sizeof(integer8 *)))) == NULL)
1878: {
1.47 bertrand 1879: liberation(s_etat_processus, s_objet_registre);
1880:
1.1 bertrand 1881: (*s_etat_processus).erreur_systeme =
1882: d_es_allocation_memoire;
1883: (*s_etat_processus).traitement_interruptible =
1884: registre_interruption;
1885: return;
1886: }
1887:
1888: (*((struct_matrice *) element)).type = 'I';
1889:
1890: for(i = 0; i < nombre_lignes; i++)
1891: {
1892: if ((((*((struct_matrice *)
1893: element)).tableau)[i] = (void *)
1894: ((integer8 *)
1.59 bertrand 1895: malloc(((size_t) nombre_colonnes) *
1.1 bertrand 1896: sizeof(integer8)))) == NULL)
1897: {
1.47 bertrand 1898: liberation(s_etat_processus,
1899: s_objet_registre);
1900:
1.1 bertrand 1901: (*s_etat_processus).erreur_systeme =
1902: d_es_allocation_memoire;
1903: (*s_etat_processus)
1904: .traitement_interruptible =
1905: registre_interruption;
1906: return;
1907: }
1908: }
1909: }
1910:
1911: for(i = 0; i < nombre_lignes; i++)
1912: {
1913: if (depilement(s_etat_processus,
1914: &((*s_etat_processus)
1915: .l_base_pile), &s_objet) ==
1916: d_absence_erreur)
1917: {
1918: if (drapeau_complexe == d_vrai)
1919: {
1920: if ((*s_objet).type == VCX)
1921: {
1922: for(j = 0; j < nombre_colonnes; j++)
1923: {
1924: ((struct_complexe16 **) ((*(
1925: (struct_matrice *) element))
1926: .tableau))[nombre_lignes - i
1927: - 1][j] =
1928: ((struct_complexe16 *)
1929: (*((struct_vecteur *)
1930: (*s_objet).objet))
1931: .tableau)[j];
1932: }
1933: }
1934: else if ((*s_objet).type == VRL)
1935: {
1936: for(j = 0; j < nombre_colonnes; j++)
1937: {
1938: (((struct_complexe16 **) ((*(
1939: (struct_matrice *) element))
1940: .tableau))[nombre_lignes - i
1941: - 1][j]).partie_reelle =
1942: ((real8 *) (*(
1943: (struct_vecteur *)
1944: (*s_objet).objet))
1945: .tableau)[j];
1946: (((struct_complexe16 **) ((*(
1947: (struct_matrice *) element))
1948: .tableau))[nombre_lignes - i
1949: - 1][j]).partie_imaginaire =
1950: (real8) 0;
1951: }
1952: }
1953: else if ((*s_objet).type == VIN)
1954: {
1955: for(j = 0; j < nombre_colonnes; j++)
1956: {
1957: (((struct_complexe16 **) ((*(
1958: (struct_matrice *) element))
1959: .tableau))[nombre_lignes - i
1960: - 1][j]).partie_reelle =
1961: (real8) ((integer8 *)
1962: (*((struct_vecteur *)
1963: (*s_objet).objet)).tableau)
1964: [j];
1965: (((struct_complexe16 **) ((*(
1966: (struct_matrice *) element))
1967: .tableau))[nombre_lignes - i
1968: - 1][j]).partie_imaginaire =
1969: (real8) 0;
1970: }
1971: }
1972: else
1973: {
1974: erreur = d_erreur;
1975: }
1976: }
1977: else if (drapeau_reel == d_vrai)
1978: {
1979: if ((*s_objet).type == VRL)
1980: {
1981: for(j = 0; j < nombre_colonnes; j++)
1982: {
1983: ((real8 **) ((*((struct_matrice *)
1984: element)).tableau))
1985: [nombre_lignes - i - 1][j] =
1986: ((real8 *) (*(
1987: (struct_vecteur *)
1988: (*s_objet).objet)).tableau)
1989: [j];
1990: }
1991: }
1992: else if ((*s_objet).type == VIN)
1993: {
1994: for(j = 0; j < nombre_colonnes; j++)
1995: {
1996: ((real8 **) ((*((struct_matrice *)
1997: element)).tableau))
1998: [nombre_lignes - i - 1][j] =
1999: (real8) ((integer8 *)
2000: (*((struct_vecteur *)
2001: (*s_objet).objet)).tableau)
2002: [j];
2003: }
2004: }
2005: else
2006: {
2007: erreur = d_erreur;
2008: }
2009: }
2010: else
2011: {
2012: if ((*s_objet).type == VIN)
2013: {
2014: for(j = 0; j < nombre_colonnes; j++)
2015: {
2016: ((integer8 **)
2017: ((*((struct_matrice *)
2018: element)).tableau))
2019: [nombre_lignes - i - 1][j] =
2020: ((integer8 *)
2021: (*((struct_vecteur *)
2022: (*s_objet)
2023: .objet)).tableau)[j];
2024: }
2025: }
2026: else
2027: {
2028: erreur = d_erreur;
2029: }
2030: }
2031:
2032: liberation(s_etat_processus, s_objet);
2033:
2034: if (erreur == d_erreur)
2035: {
2036: for(i++; i < nombre_lignes; i++)
2037: {
2038: if (depilement(s_etat_processus,
2039: &((*s_etat_processus)
2040: .l_base_pile), &s_objet)
2041: == d_erreur)
2042: {
1.47 bertrand 2043: liberation(s_etat_processus,
2044: s_objet_registre);
2045:
1.1 bertrand 2046: (*s_etat_processus)
2047: .traitement_interruptible =
2048: registre_interruption;
2049: return;
2050: }
2051:
2052: liberation(s_etat_processus, s_objet);
2053: }
2054:
2055: (*s_etat_processus).erreur_execution =
2056: d_ex_syntaxe;
2057:
2058: for(j = 0; j < (*((struct_matrice *)
2059: element)).nombre_lignes; j++)
2060: {
2061: free((*((struct_matrice *) element))
2062: .tableau[j]);
2063: }
2064:
2065: free((*((struct_matrice *) element))
2066: .tableau);
2067: free(element);
2068:
1.47 bertrand 2069: liberation(s_etat_processus,
2070: s_objet_registre);
2071:
1.1 bertrand 2072: (*s_etat_processus)
2073: .traitement_interruptible =
2074: registre_interruption;
2075: return;
2076: }
2077: }
2078: else
2079: {
1.48 bertrand 2080: liberation(s_etat_processus,
2081: s_objet_registre);
2082:
1.1 bertrand 2083: (*s_etat_processus).erreur_systeme =
2084: d_es_pile_vide;
2085: (*s_etat_processus).traitement_interruptible =
2086: registre_interruption;
2087: return;
2088: }
2089: }
2090:
1.47 bertrand 2091: s_objet = s_objet_registre;
1.1 bertrand 2092:
2093: if (drapeau_complexe == d_vrai)
2094: {
2095: (*s_objet).type = MCX;
2096: }
2097: else if (drapeau_reel == d_vrai)
2098: {
2099: (*s_objet).type = MRL;
2100: }
2101: else
2102: {
2103: (*s_objet).type = MIN;
2104: }
2105: }
2106: else
2107: {
2108: if ((*s_etat_processus).langue == 'F')
2109: {
2110: printf("+++Erreur : Matrice %s invalide [%d]\n",
2111: (*s_etat_processus).instruction_courante,
2112: (int) getpid());
2113: }
2114: else
2115: {
2116: printf("+++Error : Invalid %s matrix [%d]\n",
2117: (*s_etat_processus).instruction_courante,
2118: (int) getpid());
2119: }
2120:
2121: fflush(stdout);
2122: }
2123:
2124: break;
2125: }
2126: }
2127:
2128: break;
2129: }
2130:
2131: /*
2132: --------------------------------------------------------------------------------
2133: Liste
2134: --------------------------------------------------------------------------------
2135: */
2136:
2137: case '{' :
2138: {
2139: sauvegarde_longueur_definitions_chainees =
2140: (*s_etat_processus).longueur_definitions_chainees;
2141:
1.59 bertrand 2142: tampon = (unsigned char *) malloc(((size_t)
1.1 bertrand 2143: (((*s_etat_processus).longueur_definitions_chainees =
1.59 bertrand 2144: (integer8) strlen((*s_etat_processus)
2145: .instruction_courante) + 4) + 1)) * sizeof(unsigned char));
1.1 bertrand 2146:
2147: if (tampon == NULL)
2148: {
2149: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2150: (*s_etat_processus).traitement_interruptible =
2151: registre_interruption;
2152: return;
2153: }
2154:
2155: strcpy(tampon, "<< ");
2156: ptr_ecriture = tampon + 3;
2157: ptr_lecture = (*s_etat_processus).instruction_courante + 1;
2158:
2159: while((*ptr_lecture) != d_code_fin_chaine)
2160: {
2161: *ptr_ecriture++ = *ptr_lecture++;
2162: }
2163:
2164: (*(--ptr_ecriture)) = d_code_fin_chaine;
2165: strcat(ptr_ecriture, " >>");
2166:
2167: position_courante = (*s_etat_processus).position_courante;
2168: (*s_etat_processus).position_courante = 0;
2169:
2170: profondeur_initiale = (*s_etat_processus)
2171: .hauteur_pile_operationnelle;
2172:
2173: /*
2174: -- On met le tout dans la pile opérationnelle. ---------------------------------
2175: */
2176:
2177: (*s_etat_processus).niveau_recursivite++;
2178: definitions_chainees_precedentes = (*s_etat_processus)
2179: .definitions_chainees;
2180: (*s_etat_processus).definitions_chainees = tampon;
2181:
2182: s_sauvegarde_pile = (*s_etat_processus).l_base_pile_systeme;
2183: sauvegarde_niveau_courant = (*s_etat_processus).niveau_courant;
2184:
2185: (*s_etat_processus).l_base_pile_systeme = NULL;
2186: empilement_pile_systeme(s_etat_processus);
2187:
2188: if ((*s_etat_processus).erreur_systeme != d_es)
2189: {
2190: (*s_etat_processus).traitement_interruptible =
2191: registre_interruption;
2192: return;
2193: }
2194:
2195: (*(*s_etat_processus).l_base_pile_systeme).retour_definition = 'Y';
2196: (*(*s_etat_processus).l_base_pile_systeme)
2197: .origine_routine_evaluation = 'N';
2198: (*s_etat_processus).niveau_courant = 0;
2199: (*s_etat_processus).autorisation_empilement_programme = 'N';
2200:
2201: tampon = (*s_etat_processus).instruction_courante;
2202: autorisation_evaluation_nom = (*s_etat_processus)
2203: .autorisation_evaluation_nom;
2204: (*s_etat_processus).autorisation_evaluation_nom = 'N';
2205:
2206: registre_test = (*s_etat_processus).test_instruction;
2207: (*s_etat_processus).test_instruction = 'Y';
2208: registre_mode_execution_programme =
2209: (*s_etat_processus).mode_execution_programme;
2210: (*s_etat_processus).mode_execution_programme = 'Y';
2211: (*s_etat_processus).erreur_scrutation = d_faux;
2212:
2213: nombre_lignes_a_supprimer =
2214: (*s_etat_processus).hauteur_pile_operationnelle;
2215:
2216: /*
2217: * Vérification de la cohérence des arguments.
2218: * Il doit y avoir autant de '<<' que de '>>' dans
2219: * l'expression candidate.
2220: */
2221:
2222: coherence_liste = 0;
2223: drapeau_chaine = d_faux;
2224:
2225: while((*s_etat_processus).definitions_chainees
2226: [(*s_etat_processus).position_courante] !=
2227: d_code_fin_chaine)
2228: {
2229: if ((*s_etat_processus).definitions_chainees
2230: [(*s_etat_processus).position_courante] == '"')
2231: {
1.56 bertrand 2232: if ((*s_etat_processus).position_courante > 0)
1.1 bertrand 2233: {
1.56 bertrand 2234: if ((*s_etat_processus).definitions_chainees
2235: [(*s_etat_processus).position_courante - 1]
2236: != '\\')
2237: {
2238: if (drapeau_chaine == d_faux)
2239: {
2240: drapeau_chaine = d_vrai;
2241: }
2242: else
2243: {
2244: drapeau_chaine = d_faux;
2245: }
2246: }
1.1 bertrand 2247: }
1.56 bertrand 2248: else
1.1 bertrand 2249: {
1.56 bertrand 2250: if (drapeau_chaine == d_faux)
2251: {
2252: drapeau_chaine = d_vrai;
2253: }
2254: else
2255: {
2256: drapeau_chaine = d_faux;
2257: }
1.1 bertrand 2258: }
2259: }
2260: else if (drapeau_chaine == d_faux)
2261: {
2262: if (((*s_etat_processus).definitions_chainees
2263: [(*s_etat_processus).position_courante] == '<') &&
2264: ((*s_etat_processus).definitions_chainees
2265: [(*s_etat_processus).position_courante + 1] == '<'))
2266: {
2267: coherence_liste++;
2268: }
2269: else if (((*s_etat_processus).definitions_chainees
2270: [(*s_etat_processus).position_courante] == '>') &&
2271: ((*s_etat_processus).definitions_chainees
2272: [(*s_etat_processus).position_courante + 1] == '>'))
2273: {
2274: coherence_liste--;
2275: }
2276:
2277: }
2278:
2279: (*s_etat_processus).position_courante++;
2280: }
2281:
2282: (*s_etat_processus).position_courante = 0;
2283:
2284: if ((coherence_liste != 0) || (drapeau_chaine == d_vrai))
2285: {
2286: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
2287:
2288: nombre_lignes_a_supprimer =
2289: (*s_etat_processus).hauteur_pile_operationnelle
2290: - nombre_lignes_a_supprimer;
2291:
2292: for(i = 0; i < nombre_lignes_a_supprimer; i++)
2293: {
2294: if (depilement(s_etat_processus, &((*s_etat_processus)
2295: .l_base_pile), &s_sous_objet) == d_erreur)
2296: {
2297: (*s_etat_processus).traitement_interruptible =
2298: registre_interruption;
2299: (*s_etat_processus).mode_execution_programme =
2300: registre_mode_execution_programme;
2301: return;
2302: }
2303:
2304: liberation(s_etat_processus, s_sous_objet);
2305: }
2306:
2307: (*s_etat_processus).test_instruction = registre_test;
2308: (*s_etat_processus).longueur_definitions_chainees =
2309: sauvegarde_longueur_definitions_chainees;
2310:
2311: (*s_etat_processus).instruction_courante = tampon;
2312: (*s_etat_processus).autorisation_evaluation_nom =
2313: autorisation_evaluation_nom;
2314:
1.12 bertrand 2315: effacement_pile_systeme(s_etat_processus);
1.1 bertrand 2316: (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile;
2317: (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant;
2318:
2319: free((*s_etat_processus).definitions_chainees);
1.47 bertrand 2320: liberation(s_etat_processus, s_objet);
1.1 bertrand 2321:
2322: (*s_etat_processus).definitions_chainees =
2323: definitions_chainees_precedentes;
2324:
2325: (*s_etat_processus).niveau_recursivite--;
2326:
2327: (*s_etat_processus).position_courante = position_courante;
2328:
2329: (*s_etat_processus).traitement_interruptible =
2330: registre_interruption;
2331: (*s_etat_processus).mode_execution_programme =
2332: registre_mode_execution_programme;
2333: return;
2334: }
2335:
2336: /*
2337: * Scrutation de la séquence.
2338: */
2339:
2340: (*s_etat_processus).position_courante = 0;
2341:
2342: if ((*s_etat_processus).profilage == d_vrai)
2343: {
2344: profilage(s_etat_processus, "RPL/2 internals");
2345:
2346: if ((*s_etat_processus).erreur_systeme != d_es)
2347: {
2348: return;
2349: }
2350: }
2351:
1.34 bertrand 2352: variable_implicite = (*s_etat_processus).autorisation_nom_implicite;
1.24 bertrand 2353: registre_recherche_type = (*s_etat_processus).recherche_type;
2354: (*s_etat_processus).recherche_type = 'Y';
1.34 bertrand 2355: (*s_etat_processus).autorisation_nom_implicite = 'Y';
1.24 bertrand 2356:
1.1 bertrand 2357: if (sequenceur(s_etat_processus) == d_erreur)
2358: {
1.34 bertrand 2359: (*s_etat_processus).autorisation_nom_implicite =
2360: variable_implicite;
1.24 bertrand 2361: (*s_etat_processus).recherche_type = registre_recherche_type;
1.1 bertrand 2362: (*s_etat_processus).mode_execution_programme =
2363: registre_mode_execution_programme;
1.34 bertrand 2364:
2365: if ((*s_etat_processus).erreur_execution !=
2366: d_ex_nom_implicite)
2367: {
2368: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
2369: }
1.1 bertrand 2370:
2371: nombre_lignes_a_supprimer =
2372: (*s_etat_processus).hauteur_pile_operationnelle
2373: - nombre_lignes_a_supprimer;
2374:
2375: for(i = 0; i < nombre_lignes_a_supprimer; i++)
2376: {
2377: if (depilement(s_etat_processus, &((*s_etat_processus)
2378: .l_base_pile), &s_sous_objet) == d_erreur)
2379: {
2380: (*s_etat_processus).traitement_interruptible =
2381: registre_interruption;
2382: return;
2383: }
2384:
2385: liberation(s_etat_processus, s_sous_objet);
2386: }
2387:
2388: (*s_etat_processus).test_instruction = registre_test;
2389: (*s_etat_processus).longueur_definitions_chainees =
2390: sauvegarde_longueur_definitions_chainees;
2391:
2392: (*s_etat_processus).instruction_courante = tampon;
2393: (*s_etat_processus).autorisation_evaluation_nom =
2394: autorisation_evaluation_nom;
2395:
1.12 bertrand 2396: effacement_pile_systeme(s_etat_processus);
1.1 bertrand 2397: (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile;
2398: (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant;
2399:
2400: free((*s_etat_processus).definitions_chainees);
1.47 bertrand 2401: liberation(s_etat_processus, s_objet);
1.1 bertrand 2402:
2403: (*s_etat_processus).definitions_chainees =
2404: definitions_chainees_precedentes;
2405:
2406: (*s_etat_processus).niveau_recursivite--;
2407:
2408: (*s_etat_processus).position_courante = position_courante;
2409:
2410: (*s_etat_processus).traitement_interruptible =
2411: registre_interruption;
2412: return;
2413: }
2414:
1.34 bertrand 2415: (*s_etat_processus).autorisation_nom_implicite = variable_implicite;
1.24 bertrand 2416: (*s_etat_processus).recherche_type = registre_recherche_type;
1.1 bertrand 2417: (*s_etat_processus).mode_execution_programme =
2418: registre_mode_execution_programme;
2419:
2420: if ((*s_etat_processus).erreur_scrutation == d_vrai)
2421: {
2422: nombre_lignes_a_supprimer =
2423: (*s_etat_processus).hauteur_pile_operationnelle
2424: - nombre_lignes_a_supprimer;
2425:
2426: for(i = 0; i < nombre_lignes_a_supprimer; i++)
2427: {
2428: if (depilement(s_etat_processus, &((*s_etat_processus)
2429: .l_base_pile), &s_sous_objet) == d_erreur)
2430: {
2431: (*s_etat_processus).traitement_interruptible =
2432: registre_interruption;
2433: return;
2434: }
2435:
2436: liberation(s_etat_processus, s_sous_objet);
2437: }
2438:
2439: (*s_etat_processus).test_instruction = registre_test;
2440: (*s_etat_processus).longueur_definitions_chainees =
2441: sauvegarde_longueur_definitions_chainees;
2442:
2443: (*s_etat_processus).instruction_courante = tampon;
2444: (*s_etat_processus).autorisation_evaluation_nom =
2445: autorisation_evaluation_nom;
2446:
1.12 bertrand 2447: effacement_pile_systeme(s_etat_processus);
1.1 bertrand 2448: (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile;
2449: (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant;
2450:
2451: free((*s_etat_processus).definitions_chainees);
1.47 bertrand 2452: liberation(s_etat_processus, s_objet);
1.1 bertrand 2453:
2454: (*s_etat_processus).definitions_chainees =
2455: definitions_chainees_precedentes;
2456:
2457: (*s_etat_processus).niveau_recursivite--;
2458: (*s_etat_processus).position_courante = position_courante;
2459:
2460: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
2461: (*s_etat_processus).traitement_interruptible =
2462: registre_interruption;
2463: return;
2464: }
2465:
2466: (*s_etat_processus).test_instruction = registre_test;
2467: (*s_etat_processus).longueur_definitions_chainees =
2468: sauvegarde_longueur_definitions_chainees;
2469:
2470: (*s_etat_processus).instruction_courante = tampon;
2471: (*s_etat_processus).autorisation_evaluation_nom =
2472: autorisation_evaluation_nom;
2473:
2474: (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile;
2475: (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant;
2476:
2477: free((*s_etat_processus).definitions_chainees);
2478: (*s_etat_processus).definitions_chainees =
2479: definitions_chainees_precedentes;
2480:
2481: (*s_etat_processus).niveau_recursivite--;
2482:
2483: (*s_etat_processus).position_courante = position_courante;
2484:
2485: /*
2486: -- Relecture de la pile opérationnelle -----------------------------------------
2487: */
2488:
2489: profondeur_finale = (*s_etat_processus).hauteur_pile_operationnelle;
2490:
2491: l_element_courant = NULL;
1.47 bertrand 2492: s_objet_registre = s_objet;
1.1 bertrand 2493:
2494: for(i = 0; i < (profondeur_finale - profondeur_initiale); i++)
2495: {
2496: if (depilement(s_etat_processus,
2497: &((*s_etat_processus).l_base_pile),
2498: &s_objet) == d_erreur)
2499: {
1.47 bertrand 2500: liberation(s_etat_processus, s_objet_registre);
1.1 bertrand 2501: (*s_etat_processus).traitement_interruptible =
2502: registre_interruption;
2503: return;
2504: }
2505:
2506: if (empilement(s_etat_processus, &l_element_courant,
2507: s_objet) == d_erreur)
2508: {
1.47 bertrand 2509: liberation(s_etat_processus, s_objet_registre);
1.1 bertrand 2510: (*s_etat_processus).traitement_interruptible =
2511: registre_interruption;
2512: return;
2513: }
2514: }
2515:
1.47 bertrand 2516: s_objet = s_objet_registre;
1.1 bertrand 2517: (*s_objet).type = LST;
2518: element = (void *) l_element_courant;
2519:
2520: break;
2521: }
2522:
2523: /*
2524: --------------------------------------------------------------------------------
2525: Nom ou expression algébrique
2526: --------------------------------------------------------------------------------
2527: */
2528:
2529: case '\'' :
2530: {
2531: if ((tampon = analyse_algebrique(s_etat_processus,
2532: (*s_etat_processus).instruction_courante,
2533: &l_base_liste_fonctions)) == NULL)
2534: {
2535: /*
2536: * L'erreur est de type exécution ou système.
2537: * Dans le doute, on libère *s_objet.
2538: */
2539:
2540: while(l_base_liste_fonctions != NULL)
2541: {
2542: l_element_courant_fonctions = l_base_liste_fonctions;
2543: l_base_liste_fonctions = (*l_base_liste_fonctions).suivant;
2544:
2545: free((*((struct_fonction *) (*l_element_courant_fonctions)
2546: .donnee)).nom_fonction);
2547: free((struct_fonction *) (*l_element_courant_fonctions)
2548: .donnee);
2549: free(l_element_courant_fonctions);
2550: }
2551:
1.47 bertrand 2552: liberation(s_etat_processus, s_objet);
1.1 bertrand 2553:
2554: (*s_etat_processus).traitement_interruptible =
2555: registre_interruption;
2556: return;
2557: }
2558:
2559: l_base_liste_decomposition = analyse_rpn(s_etat_processus, tampon);
2560: l_element_courant = l_base_liste_decomposition;
2561: nombre_elements = 0;
2562:
2563: while(l_element_courant != NULL)
2564: {
2565: nombre_elements++;
2566: l_element_courant = (*l_element_courant).suivant;
2567: }
2568:
2569: if (nombre_elements == 3)
2570: {
2571: free(tampon);
2572:
2573: (*s_objet).type = (*(*(*l_base_liste_decomposition)
2574: .suivant).donnee).type;
2575: element = (void *) (*(*(*l_base_liste_decomposition)
2576: .suivant).donnee).objet;
2577:
2578: if ((*s_objet).type == NOM)
2579: {
2580: (*((struct_nom *) (*(*(*l_base_liste_decomposition)
2581: .suivant).donnee).objet)).symbole = d_vrai;
2582: }
2583: else if ((*s_objet).type == FCT)
2584: {
2585: /*
2586: * On essaye de mettre d'utiliser une fonction
2587: * comme un nom... On convertit la fonction en nom
2588: * puis on renvoie une erreur.
2589: */
2590:
1.47 bertrand 2591: (*s_objet).type = NON;
2592: liberation(s_etat_processus, s_objet);
1.1 bertrand 2593:
2594: l_element_courant = l_base_liste_decomposition;
2595:
2596: while(l_element_courant != NULL)
2597: {
2598: liberation(s_etat_processus,
2599: (*l_element_courant).donnee);
2600: l_element_precedent = l_element_courant;
2601: l_element_courant = (*l_element_courant).suivant;
2602: free(l_element_precedent);
2603: }
2604:
2605: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
2606: (*s_etat_processus).traitement_interruptible =
2607: registre_interruption;
2608: return;
2609: }
2610:
2611: l_element_precedent = l_base_liste_decomposition;
2612: l_element_courant = (*l_element_precedent).suivant;
2613: liberation(s_etat_processus, (*l_element_precedent).donnee);
2614: free(l_element_precedent);
2615: l_element_precedent = l_element_courant;
2616: l_element_courant = (*l_element_courant).suivant;
2617: free((*l_element_precedent).donnee);
2618: free(l_element_precedent);
2619: liberation(s_etat_processus, (*l_element_courant).donnee);
2620: free(l_element_courant);
2621: }
2622: else
2623: {
2624: (*s_objet).type = ALG;
2625:
2626: if ((*s_etat_processus).debug == d_vrai)
2627: if (((*s_etat_processus).type_debug &
2628: d_debug_variables) != 0)
2629: {
2630: if ((*s_etat_processus).langue == 'F')
2631: {
2632: printf("[%d] Conversion de l'expression en "
2633: "notation polonaise inversée\n%s\n",
2634: (int) getpid(), tampon);
2635: }
2636: else
2637: {
2638: printf("[%d] Translation of expression "
2639: "into reverse polish notation\n%s",
2640: (int) getpid(), tampon);
2641: }
2642:
2643: fflush(stdout);
2644: }
2645:
2646: element = (void *) l_base_liste_decomposition;
2647: free(tampon);
2648:
2649: if (element == NULL)
2650: {
2651: (*s_etat_processus).erreur_execution =
2652: d_ex_expression_invalide;
2653: (*s_etat_processus).traitement_interruptible =
2654: registre_interruption;
2655: return;
2656: }
2657:
2658: l_element_courant = (struct_liste_chainee *) element;
2659:
2660: while(l_element_courant != NULL)
2661: {
2662: if ((*(*l_element_courant).donnee).type == FCT)
2663: {
2664: /*
2665: * Si la fonction est intrinsèque au langage,
2666: * elle est convertie en majuscules.
2667: */
2668:
2669: tampon = conversion_majuscule((*((struct_fonction *)
2670: (*(*l_element_courant).donnee).objet))
2671: .nom_fonction);
2672:
2673: free((*((struct_fonction *)
2674: (*(*l_element_courant).donnee).objet))
2675: .nom_fonction);
2676:
2677: (*((struct_fonction *) (*(*l_element_courant).donnee)
2678: .objet)).nom_fonction = tampon;
2679:
2680: if (strcmp(tampon, "=") == 0)
2681: {
2682: nombre_egalites++;
2683: }
2684: }
2685:
2686: l_element_courant = (*l_element_courant).suivant;
2687: }
2688:
2689: l_element_courant = (struct_liste_chainee *) element;
2690:
2691: while(l_element_courant != NULL)
2692: {
2693: if (((*(*l_element_courant).donnee).type == FCT)
2694: || ((*(*l_element_courant).donnee).type == NOM))
2695: {
2696: if ((*(*l_element_courant).donnee).type == FCT)
2697: {
2698: if (l_base_liste_fonctions != NULL)
2699: {
2700: l_element_courant_fonctions =
2701: l_base_liste_fonctions;
2702:
2703: while(l_element_courant_fonctions != NULL)
2704: {
2705: if ((fonction_majuscule =
2706: conversion_majuscule(
2707: (*((struct_fonction *)
2708: ((*l_element_courant_fonctions)
2709: .donnee))).nom_fonction)) == NULL)
2710: {
2711: (*s_etat_processus).erreur_systeme =
2712: d_es_allocation_memoire;
2713: (*s_etat_processus)
2714: .traitement_interruptible =
2715: registre_interruption;
2716: return;
2717: }
2718:
2719: if (strcmp(fonction_majuscule,
2720: (*((struct_fonction *)
2721: (*(*l_element_courant).donnee)
2722: .objet)).nom_fonction) == 0)
2723: {
2724: free(fonction_majuscule);
2725: break;
2726: }
2727:
2728: free(fonction_majuscule);
2729: l_element_courant_fonctions =
2730: (*l_element_courant_fonctions)
2731: .suivant;
2732: }
2733:
2734: if (l_element_courant_fonctions != NULL)
2735: {
2736: (*((struct_fonction *)
2737: (*(*l_element_courant)
2738: .donnee).objet)).nombre_arguments =
2739: (*((struct_fonction *)
2740: ((*l_element_courant_fonctions)
2741: .donnee))).nombre_arguments;
2742: }
2743: else
2744: {
2745: (*((struct_fonction *)
2746: (*(*l_element_courant).donnee)
2747: .objet)).nombre_arguments = 0;
2748: }
2749: }
2750: else
2751: {
2752: (*((struct_fonction *)
2753: (*(*l_element_courant).donnee)
2754: .objet)).nombre_arguments = 0;
2755: }
2756: }
2757: else
2758: {
2759: (*((struct_nom *) (*(*l_element_courant).donnee)
2760: .objet)).symbole = d_faux;
2761:
2762: if (l_base_liste_fonctions != NULL)
2763: {
2764: l_element_courant_fonctions =
2765: l_base_liste_fonctions;
2766:
2767: while((strcmp((*((struct_fonction *)
2768: ((*l_element_courant_fonctions)
2769: .donnee))).nom_fonction,
2770: (*((struct_nom *)
2771: (*(*l_element_courant).donnee).objet))
2772: .nom) != 0) &&
2773: ((*l_element_courant_fonctions)
2774: .suivant != NULL))
2775: {
2776: l_element_courant_fonctions =
2777: (*l_element_courant_fonctions)
2778: .suivant;
2779: }
2780:
2781: if (((*l_element_courant_fonctions).suivant !=
2782: NULL) || (strcmp((*((struct_nom *)
2783: (*(*l_element_courant).donnee).objet))
2784: .nom, (*((struct_fonction *)
2785: ((*l_element_courant_fonctions)
2786: .donnee))).nom_fonction) == 0))
2787: {
2788: tampon = (*((struct_nom *)
2789: (*(*l_element_courant)
2790: .donnee).objet)).nom;
2791:
2792: if ((s_sous_objet = (struct_objet *)
2793: malloc(sizeof(
2794: struct_objet))) == NULL)
2795: {
2796: (*s_etat_processus).erreur_systeme =
2797: d_es_allocation_memoire;
2798: (*s_etat_processus)
2799: .traitement_interruptible =
2800: registre_interruption;
2801: return;
2802: }
2803:
2804: initialisation_objet(s_sous_objet);
2805: (*s_sous_objet).type = FCT;
2806:
2807: if (((*s_sous_objet).objet = (void *)
1.8 bertrand 2808: malloc(sizeof(struct_fonction)))
1.1 bertrand 2809: == NULL)
2810: {
2811: (*s_etat_processus).erreur_systeme =
2812: d_es_allocation_memoire;
2813: (*s_etat_processus)
2814: .traitement_interruptible =
2815: registre_interruption;
2816: return;
2817: }
2818:
2819: (*((struct_fonction *) ((*s_sous_objet)
2820: .objet))).nom_fonction = tampon;
2821:
2822: (*((struct_fonction *) ((*s_sous_objet)
2823: .objet))).fonction =
2824: analyse_instruction(
2825: s_etat_processus, tampon);
2826:
2827: (*((struct_fonction *) ((*s_sous_objet)
2828: .objet))).nombre_arguments =
2829: (*((struct_fonction *)
2830: ((*l_element_courant_fonctions)
2831: .donnee))).nombre_arguments;
2832:
2833: free((struct_nom *) (*(*l_element_courant)
2834: .donnee).objet);
2835: free((*l_element_courant).donnee);
2836:
2837: (*l_element_courant).donnee = s_sous_objet;
2838: }
2839: }
2840: }
2841: }
2842:
2843: l_element_courant = (*l_element_courant).suivant;
2844: }
2845: }
2846:
2847: while(l_base_liste_fonctions != NULL)
2848: {
2849: l_element_courant_fonctions = l_base_liste_fonctions;
2850: l_base_liste_fonctions = (*l_base_liste_fonctions).suivant;
2851:
2852: free((*((struct_fonction *) (*l_element_courant_fonctions)
2853: .donnee)).nom_fonction);
2854: free((struct_fonction *) (*l_element_courant_fonctions).donnee);
2855: free(l_element_courant_fonctions);
2856: }
2857:
2858: break;
2859: }
2860:
2861: /*
2862: --------------------------------------------------------------------------------
2863: Chaîne de caractères
2864: --------------------------------------------------------------------------------
2865: */
2866:
2867: case '"' :
2868: {
2869: (*s_objet).type = CHN;
2870:
2871: element = (void *) ((unsigned char *) malloc(
2872: (strlen((*s_etat_processus).instruction_courante) - 1)
2873: * sizeof(unsigned char)));
2874:
2875: if (element == NULL)
2876: {
2877: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2878: (*s_etat_processus).traitement_interruptible =
2879: registre_interruption;
2880: return;
2881: }
2882:
2883: ptr_lecture = (*s_etat_processus).instruction_courante + 1;
2884: ptr_ecriture = (unsigned char *) element;
2885:
2886: while((*ptr_lecture) != d_code_fin_chaine)
2887: {
2888: *ptr_ecriture++ = *ptr_lecture++;
2889: }
2890:
2891: (*(--ptr_ecriture)) = d_code_fin_chaine;
2892:
1.41 bertrand 2893: if (validation_chaine((unsigned char *) element) == d_faux)
2894: {
2895: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
2896: (*s_etat_processus).traitement_interruptible =
2897: registre_interruption;
2898:
2899: free(element);
2900: return;
2901: }
2902:
1.1 bertrand 2903: break;
2904: }
2905:
2906: /*
2907: --------------------------------------------------------------------------------
2908: Définition ou tableau
2909: --------------------------------------------------------------------------------
2910: */
2911:
2912: case '<' :
2913: {
2914: if ((*s_etat_processus).instruction_courante[1] == '[')
2915: {
2916: // Tableau
2917:
2918: sauvegarde_longueur_definitions_chainees =
2919: (*s_etat_processus).longueur_definitions_chainees;
2920:
1.59 bertrand 2921: tampon = (unsigned char *) malloc(((size_t)
1.1 bertrand 2922: (((*s_etat_processus).longueur_definitions_chainees
1.59 bertrand 2923: = (integer8) strlen((*s_etat_processus)
2924: .instruction_courante) + 2) + 1)) *
2925: sizeof(unsigned char));
1.1 bertrand 2926:
2927: if (tampon == NULL)
2928: {
2929: (*s_etat_processus).erreur_systeme =
2930: d_es_allocation_memoire;
2931: (*s_etat_processus).traitement_interruptible =
2932: registre_interruption;
2933: return;
2934: }
2935:
2936: strcpy(tampon, "<< ");
2937: ptr_ecriture = tampon + 3;
2938: ptr_lecture = (*s_etat_processus).instruction_courante + 2;
2939:
2940: while((*ptr_lecture) != d_code_fin_chaine)
2941: {
2942: *ptr_ecriture++ = *ptr_lecture++;
2943: }
2944:
2945: ptr_ecriture -= 2;
2946: (*ptr_ecriture) = d_code_fin_chaine;
2947: strcat(ptr_ecriture, " >>");
2948:
2949: position_courante = (*s_etat_processus).position_courante;
2950: (*s_etat_processus).position_courante = 0;
2951:
2952: profondeur_initiale = (*s_etat_processus)
2953: .hauteur_pile_operationnelle;
2954:
2955: /*
2956: -- On met les éléments du tableau dans la pile opérationnelle ------------------
2957: */
2958:
2959: (*s_etat_processus).niveau_recursivite++;
2960: definitions_chainees_precedentes = (*s_etat_processus)
2961: .definitions_chainees;
2962: (*s_etat_processus).definitions_chainees = tampon;
2963:
2964: s_sauvegarde_pile = (*s_etat_processus).l_base_pile_systeme;
2965: sauvegarde_niveau_courant = (*s_etat_processus).niveau_courant;
2966:
2967: (*s_etat_processus).l_base_pile_systeme = NULL;
2968: empilement_pile_systeme(s_etat_processus);
2969:
2970: if ((*s_etat_processus).erreur_systeme != d_es)
2971: {
2972: (*s_etat_processus).traitement_interruptible =
2973: registre_interruption;
2974: return;
2975: }
2976:
2977: (*(*s_etat_processus).l_base_pile_systeme)
2978: .retour_definition = 'Y';
2979: (*s_etat_processus).niveau_courant = 0;
2980: (*s_etat_processus).autorisation_empilement_programme = 'N';
2981: registre_mode_execution_programme =
2982: (*s_etat_processus).mode_execution_programme;
2983: (*s_etat_processus).mode_execution_programme = 'Y';
2984: (*s_etat_processus).erreur_scrutation = d_faux;
2985:
2986: tampon = (*s_etat_processus).instruction_courante;
2987: nombre_lignes_a_supprimer =
2988: (*s_etat_processus).hauteur_pile_operationnelle;
2989:
2990: if ((*s_etat_processus).profilage == d_vrai)
2991: {
2992: profilage(s_etat_processus, "RPL/2 internals");
2993:
2994: if ((*s_etat_processus).erreur_systeme != d_es)
2995: {
2996: return;
2997: }
2998: }
2999:
1.24 bertrand 3000: registre_recherche_type = (*s_etat_processus).recherche_type;
3001: (*s_etat_processus).recherche_type = 'Y';
3002:
1.34 bertrand 3003: variable_implicite =
3004: (*s_etat_processus).autorisation_nom_implicite;
3005: (*s_etat_processus).autorisation_nom_implicite = 'Y';
3006:
1.1 bertrand 3007: if (sequenceur(s_etat_processus) == d_erreur)
3008: {
1.34 bertrand 3009: (*s_etat_processus).autorisation_nom_implicite =
3010: variable_implicite;
1.24 bertrand 3011: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3012: (*s_etat_processus).recherche_type =
3013: registre_recherche_type;
1.1 bertrand 3014: (*s_etat_processus).mode_execution_programme =
3015: registre_mode_execution_programme;
3016: nombre_lignes_a_supprimer =
3017: (*s_etat_processus).hauteur_pile_operationnelle
3018: - nombre_lignes_a_supprimer;
3019:
3020: for(i = 0; i < nombre_lignes_a_supprimer; i++)
3021: {
3022: if (depilement(s_etat_processus,
3023: &((*s_etat_processus).l_base_pile),
3024: &s_sous_objet) == d_erreur)
3025: {
3026: (*s_etat_processus).traitement_interruptible =
3027: registre_interruption;
3028: return;
3029: }
3030:
3031: liberation(s_etat_processus, s_sous_objet);
3032: }
3033:
3034: (*s_etat_processus).instruction_courante = tampon;
3035:
1.12 bertrand 3036: effacement_pile_systeme(s_etat_processus);
1.1 bertrand 3037: (*s_etat_processus).l_base_pile_systeme =
3038: s_sauvegarde_pile;
3039: (*s_etat_processus).niveau_courant =
3040: sauvegarde_niveau_courant;
3041:
3042: free((*s_etat_processus).definitions_chainees);
3043: (*s_etat_processus).niveau_recursivite--;
3044:
3045: (*s_etat_processus).definitions_chainees =
3046: definitions_chainees_precedentes;
3047: (*s_etat_processus).longueur_definitions_chainees =
3048: sauvegarde_longueur_definitions_chainees;
3049:
3050: (*s_etat_processus).position_courante =
3051: position_courante;
3052:
1.47 bertrand 3053: liberation(s_etat_processus, s_objet);
1.1 bertrand 3054:
3055: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3056: (*s_etat_processus).traitement_interruptible =
3057: registre_interruption;
3058: return;
3059: }
3060:
1.34 bertrand 3061: (*s_etat_processus).autorisation_nom_implicite =
3062: variable_implicite;
1.24 bertrand 3063: (*s_etat_processus).recherche_type = registre_recherche_type;
1.1 bertrand 3064: (*s_etat_processus).mode_execution_programme =
3065: registre_mode_execution_programme;
3066:
3067: if ((*s_etat_processus).erreur_scrutation == d_vrai)
3068: {
3069: nombre_lignes_a_supprimer =
3070: (*s_etat_processus).hauteur_pile_operationnelle
3071: - nombre_lignes_a_supprimer;
3072:
3073: for(i = 0; i < nombre_lignes_a_supprimer; i++)
3074: {
3075: if (depilement(s_etat_processus,
3076: &((*s_etat_processus).l_base_pile),
3077: &s_sous_objet) == d_erreur)
3078: {
3079: (*s_etat_processus).traitement_interruptible =
3080: registre_interruption;
3081: return;
3082: }
3083:
3084: liberation(s_etat_processus, s_sous_objet);
3085: }
3086:
3087: (*s_etat_processus).instruction_courante = tampon;
3088:
1.12 bertrand 3089: effacement_pile_systeme(s_etat_processus);
1.1 bertrand 3090: (*s_etat_processus).l_base_pile_systeme =
3091: s_sauvegarde_pile;
3092: (*s_etat_processus).niveau_courant =
3093: sauvegarde_niveau_courant;
3094:
3095: free((*s_etat_processus).definitions_chainees);
3096: (*s_etat_processus).niveau_recursivite--;
3097:
3098: (*s_etat_processus).definitions_chainees =
3099: definitions_chainees_precedentes;
3100: (*s_etat_processus).longueur_definitions_chainees =
3101: sauvegarde_longueur_definitions_chainees;
3102:
3103: (*s_etat_processus).position_courante =
3104: position_courante;
3105:
1.47 bertrand 3106: liberation(s_etat_processus, s_objet);
1.1 bertrand 3107:
3108: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3109: (*s_etat_processus).traitement_interruptible =
3110: registre_interruption;
3111: return;
3112: }
3113:
3114: (*s_etat_processus).instruction_courante = tampon;
3115:
3116: (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile;
3117: (*s_etat_processus).niveau_courant =
3118: sauvegarde_niveau_courant;
3119:
3120: free((*s_etat_processus).definitions_chainees);
3121: (*s_etat_processus).definitions_chainees =
3122: definitions_chainees_precedentes;
3123: (*s_etat_processus).longueur_definitions_chainees =
3124: sauvegarde_longueur_definitions_chainees;
3125:
3126: (*s_etat_processus).niveau_recursivite--;
3127:
3128: (*s_etat_processus).position_courante = position_courante;
3129:
3130: /*
3131: -- On relit la pile qui contient des sous-objets contenant les -----------------
3132: -- éléments du tableau ---------------------------------------------------------
3133: */
3134:
3135: profondeur_finale = (*s_etat_processus)
3136: .hauteur_pile_operationnelle;
3137:
3138: nombre_lignes = profondeur_finale - profondeur_initiale;
3139:
1.12 bertrand 3140: if ((element = malloc(sizeof(struct_tableau))) == NULL)
1.1 bertrand 3141: {
3142: (*s_etat_processus).erreur_systeme =
3143: d_es_allocation_memoire;
3144: (*s_etat_processus).traitement_interruptible =
3145: registre_interruption;
3146: return;
3147: }
3148:
3149: (*((struct_tableau *) element)).nombre_elements = nombre_lignes;
3150:
3151: if (((*((struct_tableau *) element)).elements =
1.59 bertrand 3152: malloc(((size_t) nombre_lignes) *
3153: sizeof(struct_objet *))) == NULL)
1.1 bertrand 3154: {
3155: (*s_etat_processus).erreur_systeme =
3156: d_es_allocation_memoire;
3157: (*s_etat_processus).traitement_interruptible =
3158: registre_interruption;
3159: return;
3160: }
3161:
3162: for(i = 1; i <= nombre_lignes; i++)
3163: {
3164: if (depilement(s_etat_processus,
3165: &((*s_etat_processus).l_base_pile),
3166: &s_sous_objet) == d_erreur)
3167: {
3168: (*s_etat_processus).traitement_interruptible =
3169: registre_interruption;
3170: return;
3171: }
3172:
3173: (*((struct_tableau *) element)).elements[nombre_lignes - i]
3174: = s_sous_objet;
3175: }
3176:
3177: (*s_objet).type = TBL;
3178:
3179: (*s_etat_processus).traitement_interruptible =
3180: registre_interruption;
3181: }
3182: else
3183: {
3184: // Définition
3185:
3186: if (strlen((*s_etat_processus).instruction_courante) < 5)
3187: {
1.47 bertrand 3188: liberation(s_etat_processus, s_objet);
1.1 bertrand 3189:
3190: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3191: (*s_etat_processus).traitement_interruptible =
3192: registre_interruption;
3193: return;
3194: }
3195:
3196: if ((strncmp((*s_etat_processus).instruction_courante, "<< ", 3)
3197: != 0) && (strcmp((*s_etat_processus)
3198: .instruction_courante, "<<") != 0))
3199: {
1.47 bertrand 3200: liberation(s_etat_processus, s_objet);
1.1 bertrand 3201:
3202: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3203: (*s_etat_processus).traitement_interruptible =
3204: registre_interruption;
3205: return;
3206: }
3207:
3208: (*s_objet).type = RPN;
3209:
3210: element = (void *) analyse_rpn(s_etat_processus,
3211: (*s_etat_processus).instruction_courante);
3212:
3213: if (element == NULL)
3214: {
3215: if ((*s_etat_processus).erreur_systeme != d_es)
3216: {
3217: (*s_etat_processus).erreur_systeme =
3218: d_es_allocation_memoire;
3219: }
3220:
1.47 bertrand 3221: liberation(s_etat_processus, s_objet);
1.12 bertrand 3222:
1.1 bertrand 3223: (*s_etat_processus).traitement_interruptible =
3224: registre_interruption;
3225: return;
3226: }
3227:
3228: l_element_courant = (struct_liste_chainee *) element;
3229:
3230: while(l_element_courant != NULL)
3231: {
3232: if ((*(*l_element_courant).donnee).type == FCT)
3233: {
3234: if (strcmp((*((struct_fonction *) (*(*l_element_courant)
3235: .donnee).objet)).nom_fonction, "=") == 0)
3236: {
3237: nombre_egalites++;
3238: }
3239: }
3240:
3241: l_element_courant = (*l_element_courant).suivant;
3242: }
3243: }
3244:
3245: break;
3246: }
3247:
3248: /*
3249: --------------------------------------------------------------------------------
3250: Entier ou réel
3251: --------------------------------------------------------------------------------
3252: */
3253:
3254: default :
3255: {
3256: if (((*((*s_etat_processus).instruction_courante)) == '-') ||
3257: ((*((*s_etat_processus).instruction_courante)) == '+') ||
3258: (((*((*s_etat_processus).instruction_courante)) >= '0') &&
3259: ((*((*s_etat_processus).instruction_courante))
3260: <= '9')) || ((*((*s_etat_processus).instruction_courante))
3261: == '.'))
3262: {
3263: drapeau_valeur_entiere = ((*((*s_etat_processus)
3264: .instruction_courante)) != '.') ? d_vrai : d_faux;
3265: drapeau_valeur_reelle = d_vrai;
3266:
3267: nombre_points = 0;
3268: nombre_exposants = 0;
3269:
3270: conversion_format(s_etat_processus,
3271: (*s_etat_processus).instruction_courante);
3272:
3273: ptr = (*s_etat_processus).instruction_courante;
3274:
3275: while((*ptr) != d_code_fin_chaine)
3276: {
3277: switch(*ptr)
3278: {
3279: case '0' :
3280: case '1' :
3281: case '2' :
3282: case '3' :
3283: case '4' :
3284: case '5' :
3285: case '6' :
3286: case '7' :
3287: case '8' :
3288: case '9' :
3289: {
3290: break;
3291: }
3292:
3293: // Ne peut survenir qu'après un 'E', un 'e' ou au
3294: // début de la chaîne.
3295: case '+' :
3296: case '-' :
3297: {
3298: if (ptr > (*s_etat_processus).instruction_courante)
3299: {
3300: if (((*(ptr - 1)) != 'e') &&
3301: ((*(ptr - 1)) != 'E'))
3302: {
3303: drapeau_valeur_entiere = d_faux;
3304: drapeau_valeur_reelle = d_faux;
3305: }
3306: }
3307:
3308: break;
3309: }
3310:
3311: // Ne peut que commencer une chaîne, suivre un
3312: // chiffre ou un signe. Ne peut constituer un
3313: // nombre seul.
3314: case '.' :
3315: {
3316: nombre_points++;
3317:
3318: if (ptr > (*s_etat_processus).instruction_courante)
3319: {
3320: switch(*(ptr - 1))
3321: {
3322: case '+' :
3323: case '-' :
3324: case '0' :
3325: case '1' :
3326: case '2' :
3327: case '3' :
3328: case '4' :
3329: case '5' :
3330: case '6' :
3331: case '7' :
3332: case '8' :
3333: case '9' :
3334: {
3335: drapeau_valeur_entiere = d_faux;
3336: break;
3337: }
3338:
3339: default :
3340: {
3341: drapeau_valeur_entiere = d_faux;
3342: drapeau_valeur_reelle = d_faux;
3343: break;
3344: }
3345: }
3346: }
3347: else
3348: {
3349: if ((*(ptr + 1)) == d_code_fin_chaine)
3350: {
3351: drapeau_valeur_entiere = d_faux;
3352: drapeau_valeur_reelle = d_faux;
3353: }
3354: }
3355:
3356: break;
3357: }
3358:
3359: // Ne peut suivre qu'un chiffre ou un point
3360: case 'e' :
3361: case 'E' :
3362: {
3363: nombre_exposants++;
3364:
3365: if (ptr > (*s_etat_processus).instruction_courante)
3366: {
3367: switch(*(ptr - 1))
3368: {
3369: case '0' :
3370: case '1' :
3371: case '2' :
3372: case '3' :
3373: case '4' :
3374: case '5' :
3375: case '6' :
3376: case '7' :
3377: case '8' :
3378: case '9' :
3379: {
3380: drapeau_valeur_entiere = d_faux;
3381: break;
3382: }
3383:
3384: // Le point doit suivre un chiffre
3385: case '.' :
3386: {
3387: if ((ptr - 1) > (*s_etat_processus)
3388: .instruction_courante)
3389: {
3390: switch(*(ptr - 2))
3391: {
3392: case '0' :
3393: case '1' :
3394: case '2' :
3395: case '3' :
3396: case '4' :
3397: case '5' :
3398: case '6' :
3399: case '7' :
3400: case '8' :
3401: case '9' :
3402: {
3403: drapeau_valeur_entiere =
3404: d_faux;
3405: break;
3406: }
3407:
3408: default :
3409: {
3410: drapeau_valeur_entiere =
3411: d_faux;
3412: drapeau_valeur_reelle =
3413: d_faux;
3414: break;
3415: }
3416: }
3417: }
3418: else
3419: {
3420: drapeau_valeur_entiere = d_faux;
3421: drapeau_valeur_reelle = d_faux;
3422: }
3423:
3424: break;
3425: }
3426:
3427: default :
3428: {
3429: drapeau_valeur_entiere = d_faux;
3430: drapeau_valeur_reelle = d_faux;
3431: break;
3432: }
3433: }
3434: }
3435: else
3436: {
3437: drapeau_valeur_entiere = d_faux;
3438: drapeau_valeur_reelle = d_faux;
3439: }
3440:
3441: break;
3442: }
3443:
3444: default :
3445: {
3446: drapeau_valeur_entiere = d_faux;
3447: drapeau_valeur_reelle = d_faux;
3448: break;
3449: }
3450: }
3451:
3452: ptr++;
3453: }
3454:
3455: if ((nombre_points > 1) || (nombre_exposants > 1))
3456: {
3457: drapeau_valeur_reelle = d_faux;
3458: drapeau_valeur_entiere = d_faux;
3459: }
3460: }
3461: else
3462: {
3463: drapeau_valeur_entiere = d_faux;
3464: drapeau_valeur_reelle = d_faux;
3465: }
3466:
3467: if ((drapeau_valeur_reelle == d_faux) &&
3468: (drapeau_valeur_entiere == d_faux))
3469: {
1.23 bertrand 3470: ptr = (*s_etat_processus).instruction_courante;
3471:
3472: while((*ptr) != d_code_fin_chaine)
3473: {
1.25 bertrand 3474: if ((isalnum((*ptr)) == 0) &&
3475: ((*ptr) != '_') &&
3476: ((*ptr) != '$'))
1.23 bertrand 3477: {
1.47 bertrand 3478: liberation(s_etat_processus, s_objet);
1.23 bertrand 3479:
3480: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3481: (*s_etat_processus).traitement_interruptible =
3482: registre_interruption;
3483:
3484: return;
3485: }
3486:
3487: ptr++;
3488: }
3489:
1.1 bertrand 3490: (*s_objet).type = NOM;
3491:
3492: element = malloc(sizeof(struct_nom));
3493:
3494: if (element == NULL)
3495: {
3496: (*s_etat_processus).erreur_systeme =
3497: d_es_allocation_memoire;
3498: (*s_etat_processus).traitement_interruptible =
3499: registre_interruption;
3500: return;
3501: }
3502:
3503: (*((struct_nom *) element)).symbole = d_faux;
3504: (*((struct_nom *) element)).nom = ((unsigned char *) malloc(
3505: (strlen((*s_etat_processus)
3506: .instruction_courante) + 1) * sizeof(unsigned char)));
3507:
3508: if ((*((struct_nom *) element)).nom == NULL)
3509: {
3510: (*s_etat_processus).erreur_systeme =
3511: d_es_allocation_memoire;
3512: (*s_etat_processus).traitement_interruptible =
3513: registre_interruption;
3514: return;
3515: }
3516:
3517: strcpy((*((struct_nom *) element)).nom, (*s_etat_processus)
3518: .instruction_courante);
3519: }
3520: else
3521: {
3522: if (drapeau_valeur_entiere == d_faux)
3523: {
3524: (*s_objet).type = REL;
3525:
3526: element = (void *) ((real8 *) malloc(
3527: sizeof(real8)));
3528:
3529: if (element == NULL)
3530: {
3531: (*s_etat_processus).erreur_systeme =
3532: d_es_allocation_memoire;
3533: (*s_etat_processus).traitement_interruptible =
3534: registre_interruption;
3535: return;
3536: }
3537:
3538: nombre_elements_convertis = sscanf(
3539: (*s_etat_processus).instruction_courante, "%lg",
3540: (real8 *) element);
3541:
3542: if (nombre_elements_convertis != 1)
3543: {
3544: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3545: }
3546: }
3547: else
3548: {
1.43 bertrand 3549: // Le format ressemble à un entier mais il peut y avoir
3550: // un dépassement de capacité lors de la conversion.
3551: // On convertit donc en entier et en réel. Si les
3552: // deux conversions donnent le même résultat, on
3553: // considère que la conversion en entier est bonne. Dans
3554: // le cas contraire, on garde la conversion en réel.
1.1 bertrand 3555:
1.43 bertrand 3556: integer8 conversion_entiere;
3557: real8 conversion_reelle;
1.1 bertrand 3558:
1.43 bertrand 3559: if (sscanf((*s_etat_processus).instruction_courante, "%lld",
3560: &conversion_entiere) != 1)
3561: {
3562: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3563: }
1.1 bertrand 3564:
1.58 bertrand 3565: if (errno != ERANGE)
1.1 bertrand 3566: {
1.43 bertrand 3567: (*s_objet).type = INT;
3568:
3569: element = malloc(sizeof(integer8));
3570:
3571: if (element == NULL)
3572: {
3573: (*s_etat_processus).erreur_systeme =
3574: d_es_allocation_memoire;
3575: (*s_etat_processus).traitement_interruptible =
3576: registre_interruption;
3577: return;
3578: }
3579:
3580: (*((integer8 *) element)) = conversion_entiere;
3581: }
3582: else
3583: {
1.58 bertrand 3584: if (sscanf((*s_etat_processus).instruction_courante,
3585: "%lg", &conversion_reelle) != 1)
3586: {
3587: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3588: }
3589:
1.43 bertrand 3590: (*s_objet).type = REL;
3591:
3592: element = malloc(sizeof(real8));
3593:
3594: if (element == NULL)
3595: {
3596: (*s_etat_processus).erreur_systeme =
3597: d_es_allocation_memoire;
3598: (*s_etat_processus).traitement_interruptible =
3599: registre_interruption;
3600: return;
3601: }
3602:
3603: (*((real8 *) element)) = conversion_reelle;
1.1 bertrand 3604: }
3605: }
3606: }
3607:
3608: break;
3609: }
3610: }
3611:
3612: (*s_objet).objet = element;
3613:
3614: if (nombre_egalites > 1)
3615: {
3616: liberation(s_etat_processus, s_objet);
3617:
3618: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
3619: (*s_etat_processus).traitement_interruptible = registre_interruption;
3620: return;
3621: }
3622:
3623: if (empilement(s_etat_processus,
3624: &((*s_etat_processus).l_base_pile), s_objet) == d_erreur)
3625: {
3626: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1.7 bertrand 3627: (*s_etat_processus).traitement_interruptible =
3628: registre_interruption;
1.1 bertrand 3629: return;
3630: }
3631:
3632: (*s_etat_processus).traitement_interruptible = registre_interruption;
3633: return;
3634: }
3635:
3636:
3637: /*
3638: ================================================================================
3639: Conversion de la virgule
3640: ================================================================================
3641: Entrées : structure sur l'état du processus
3642: --------------------------------------------------------------------------------
3643: Sorties : néant
3644: --------------------------------------------------------------------------------
3645: Effets de bord : néant
3646: ================================================================================
3647: */
3648:
3649: void
3650: conversion_format(struct_processus *s_etat_processus, unsigned char *chaine)
3651: {
3652: unsigned char *ptr;
3653:
3654: /*
3655: --------------------------------------------------------------------------------
3656: Transcription du point en virgule et réciproquement selon l'indicateur 48
3657: --------------------------------------------------------------------------------
3658: */
3659:
3660: if (test_cfsf(s_etat_processus, 48) == d_vrai)
3661: {
3662: ptr = chaine;
3663:
3664: while((*ptr) != d_code_fin_chaine)
3665: {
3666: if ((*ptr) == '.')
3667: {
3668: (*ptr) = ',';
3669: }
3670: else if ((*ptr) == ',')
3671: {
3672: (*ptr) = '.';
3673: }
3674:
3675: ptr++;
3676: }
3677: }
3678:
3679: return;
3680: }
3681:
3682: // vim: ts=4