Annotation of rpl/src/compilation.c, revision 1.69
1.1 bertrand 1: /*
2: ================================================================================
1.67 bertrand 3: RPL/2 (R) version 4.1.19
1.65 bertrand 4: Copyright (C) 1989-2014 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:
1.69 ! bertrand 22: #define DEBUG_ERREURS
1.15 bertrand 23: #include "rpl-conv.h"
1.1 bertrand 24:
25:
26: /*
27: ================================================================================
28: Procédure de vérification syntaxique du source et de précompilation
29: ================================================================================
30: Entrées :
31: --------------------------------------------------------------------------------
32: Sorties :
33: - renvoi : erreur
34: --------------------------------------------------------------------------------
35: Effets de bord :
36: ================================================================================
37: */
38:
39: logical1
40: compilation(struct_processus *s_etat_processus)
41: {
42: struct_objet *s_objet;
43:
44: struct_variable *s_variable;
45:
46: unsigned char apostrophe_ouverte;
47: unsigned char apostrophe_ouverte_registre;
48: unsigned char caractere_courant;
49: unsigned char caractere_precedent;
50: unsigned char caractere_suivant;
51: unsigned char *definition;
52: unsigned char fermeture_definition;
53: unsigned char guillemet_ouvert;
54: unsigned char ouverture_definition;
55: unsigned char position_debut_nom_definition_valide;
56:
1.58 bertrand 57: integer8 *adresse;
58: integer8 i;
59: integer8 niveau_definition;
60: integer8 niveau_definition_registre;
61: integer8 position_courante;
62: integer8 position_debut_nom_definition;
63: integer8 position_fin_nom_definition;
64: integer8 validation;
65: integer8 validation_registre;
1.1 bertrand 66:
67: (*s_etat_processus).erreur_compilation = d_ec;
68: (*s_etat_processus).erreur_systeme = d_es;
69: (*s_etat_processus).erreur_execution = d_ex;
70: (*s_etat_processus).exception = d_ep;
71: (*s_etat_processus).arret_si_exception = d_vrai;
72:
73: (*s_etat_processus).position_courante = 0;
74:
75: /*
76: --------------------------------------------------------------------------------
77: Recheche des définitions
78: --------------------------------------------------------------------------------
79: */
80:
81: niveau_definition = 0;
82: niveau_definition_registre = 0;
83: position_courante = 0;
84: position_debut_nom_definition = 0;
85: validation = 0;
86:
87: apostrophe_ouverte = d_faux;
88: apostrophe_ouverte_registre = d_faux;
89: guillemet_ouvert = d_faux;
90: position_debut_nom_definition_valide = d_faux;
91:
92: if ((*s_etat_processus).debug == d_vrai)
93: if (((*s_etat_processus).type_debug & d_debug_analyse) != 0)
94: {
95: printf("\n");
96: printf("[%d] Compilation\n", (int) getpid());
97: fflush(stdout);
98: }
99:
100: while((*s_etat_processus).definitions_chainees[position_courante] !=
101: d_code_fin_chaine)
102: {
103: caractere_courant = (*s_etat_processus)
104: .definitions_chainees[position_courante];
105:
106: fermeture_definition = d_faux;
107: ouverture_definition = d_faux;
108:
109: if (position_courante >= 1)
110: {
111: if (position_courante >= 2)
112: {
113: if (((*s_etat_processus).definitions_chainees
114: [position_courante - 2] == '\\') &&
115: ((*s_etat_processus).definitions_chainees
116: [position_courante - 1] == '\\'))
117: {
118: caractere_precedent = '*';
119: }
120: else
121: {
122: caractere_precedent = (*s_etat_processus)
123: .definitions_chainees[position_courante - 1];
124: }
125: }
126: else
127: {
128: caractere_precedent = (*s_etat_processus)
129: .definitions_chainees[position_courante - 1];
130: }
131: }
132: else
133: {
134: caractere_precedent = ' ';
135: }
136:
137: caractere_suivant = (*s_etat_processus)
138: .definitions_chainees[position_courante + 1];
139:
140: if (caractere_suivant == d_code_fin_chaine)
141: {
142: caractere_suivant = ' ';
143: }
144:
145: if ((caractere_courant == '[') || (caractere_courant == '{'))
146: {
147: validation++;
148: }
149: else if ((caractere_courant == ']') || (caractere_courant == '}'))
150: {
151: validation--;
152: }
153: else if (caractere_courant == '\'')
154: {
155: if (apostrophe_ouverte == d_faux)
156: {
157: validation++;
158: apostrophe_ouverte = d_vrai;
159: }
160: else
161: {
162: validation--;
163: apostrophe_ouverte = d_faux;
164: }
165: }
166: else if (caractere_courant == '"')
167: {
168: if (caractere_precedent != '\\')
169: {
170: swap((void *) &validation, (void *) &validation_registre,
171: sizeof(validation));
172: swap((void *) &apostrophe_ouverte,
173: (void *) &apostrophe_ouverte_registre,
174: sizeof(apostrophe_ouverte));
175: swap((void *) &niveau_definition,
176: (void *) &niveau_definition_registre,
177: sizeof(niveau_definition));
178:
179: guillemet_ouvert = (guillemet_ouvert == d_faux)
180: ? d_vrai : d_faux;
181: }
182: }
183: else if ((caractere_courant == '<') &&
184: (caractere_precedent == ' ') &&
185: (caractere_suivant == '<'))
186: {
187: if ((*s_etat_processus)
188: .definitions_chainees[position_courante + 2] == ' ')
189: {
190: niveau_definition++;
191: ouverture_definition = d_vrai;
192: }
193: }
194: else if ((caractere_courant == '>') &&
195: (caractere_precedent == ' ') &&
196: (caractere_suivant == '>'))
197: {
198: if (((*s_etat_processus)
199: .definitions_chainees[position_courante + 2] == ' ') ||
200: ((*s_etat_processus).definitions_chainees
201: [position_courante + 2] == d_code_fin_chaine))
202: {
203: if (niveau_definition == 0)
204: {
205: (*s_etat_processus).erreur_compilation =
206: d_ec_niveau_definition_negatif;
207: return(d_erreur);
208: }
209: else
210: {
211: niveau_definition--;
212: fermeture_definition = d_vrai;
213: position_courante++;
214: }
215: }
216: }
217:
218: if ((niveau_definition == 0) && (guillemet_ouvert == d_faux) &&
219: (caractere_courant != ' ') && (fermeture_definition == d_faux))
220: {
221: if (position_debut_nom_definition_valide == d_faux)
222: {
223: position_debut_nom_definition_valide = d_vrai;
224: position_debut_nom_definition = position_courante;
225: }
226: }
227:
228: if (((niveau_definition == 1) && (ouverture_definition == d_vrai)) &&
229: (position_debut_nom_definition_valide == d_vrai))
230: {
231: position_fin_nom_definition = position_courante - 1;
232: position_debut_nom_definition_valide = d_faux;
233:
234: while((*s_etat_processus).definitions_chainees
235: [position_fin_nom_definition] == ' ')
236: {
237: position_fin_nom_definition--;
238: }
239:
240: i = position_debut_nom_definition;
241:
242: while(i <= position_fin_nom_definition)
243: {
244: if ((*s_etat_processus).definitions_chainees[i] == ' ')
245: {
246: (*s_etat_processus).erreur_compilation =
247: d_ec_nom_definition_invalide;
248: return(d_erreur);
249: }
250: else
251: {
252: i++;
253: }
254: }
255:
256: s_objet = allocation(s_etat_processus, ADR);
257: s_variable = (struct_variable *)
258: malloc(sizeof(struct_variable));
259: adresse = (*s_objet).objet;
1.58 bertrand 260: definition = (unsigned char *) malloc(((size_t)
1.1 bertrand 261: (position_fin_nom_definition -
1.58 bertrand 262: position_debut_nom_definition + 2)) *
1.1 bertrand 263: sizeof(unsigned char));
264:
265: if ((s_objet == NULL) || (s_variable == NULL) ||
266: (adresse == NULL) || definition == NULL)
267: {
268: (*s_etat_processus).erreur_systeme =
269: d_es_allocation_memoire;
270: return(d_erreur);
271: }
272: else
273: {
274: (*adresse) = position_fin_nom_definition + 1;
275:
276: (*s_variable).nom = definition;
277: (*s_variable).niveau = (*s_etat_processus).niveau_courant;
278: (*s_variable).objet = s_objet;
279:
280: i = position_debut_nom_definition;
281:
282: while(i <= position_fin_nom_definition)
283: {
284: *(definition++) = (*s_etat_processus)
285: .definitions_chainees[i++];
286: }
287:
288: *definition = d_code_fin_chaine;
289:
290: if (recherche_variable(s_etat_processus, (*s_variable).nom)
291: == d_vrai)
292: {
293: if ((*s_etat_processus).langue == 'F')
294: {
295: printf("+++Attention : Plusieurs définitions de"
296: " même nom\n");
297: }
298: else
299: {
300: printf("+++Warning : Same name for several"
301: " definitions\n");
302: }
303:
304: fflush(stdout);
305: return(d_erreur);
306: }
307:
308: (*s_etat_processus).erreur_systeme = d_es;
309: creation_variable(s_etat_processus, s_variable, 'V', 'P');
310:
311: if ((*s_etat_processus).erreur_systeme != d_es)
312: {
313: free(s_variable);
314:
315: return(d_erreur);
316: }
317:
318: if ((*s_etat_processus).debug == d_vrai)
319: if (((*s_etat_processus).type_debug & d_debug_analyse) != 0)
320: {
321: if ((*s_etat_processus).langue == 'F')
322: {
323: printf("[%d] Compilation : Définition %s ($ %016lX) "
324: "\n", (int) getpid(), (*s_variable).nom,
325: (*adresse));
326: }
327: else
328: {
329: printf("[%d] Compilation : %s definition ($ %016lX) "
330: "\n", (int) getpid(), (*s_variable).nom,
331: (*adresse));
332: }
333:
334: fflush(stdout);
335: }
336: }
337:
338: free(s_variable);
339: }
340:
341: position_courante++;
342: }
343:
344: return(analyse_syntaxique(s_etat_processus));
345: }
346:
347:
348: /*
349: ================================================================================
350: Procédure de d'analyse syntaxique du source
351: ================================================================================
352: Entrées :
353: --------------------------------------------------------------------------------
354: Sorties :
355: - renvoi : erreur
356: --------------------------------------------------------------------------------
357: Effets de bord :
358: ================================================================================
359: */
360:
1.50 bertrand 361: enum t_condition { AN_IF = 1, AN_IFERR, AN_THEN, AN_ELSE, AN_ELSEIF,
362: AN_END, AN_DO, AN_UNTIL, AN_WHILE, AN_REPEAT, AN_SELECT,
363: AN_CASE, AN_DEFAULT, AN_UP, AN_DOWN, AN_FOR, AN_START,
364: AN_NEXT, AN_STEP, AN_CRITICAL, AN_FORALL };
365:
366: typedef struct pile
367: {
368: enum t_condition condition;
369: struct pile *suivant;
370: } struct_pile_analyse;
371:
372: static inline struct_pile_analyse *
373: empilement_analyse(struct_pile_analyse *ancienne_base,
374: enum t_condition condition)
1.1 bertrand 375: {
1.50 bertrand 376: struct_pile_analyse *nouvelle_base;
377:
378: if ((nouvelle_base = malloc(sizeof(struct_pile_analyse))) == NULL)
379: {
380: return(NULL);
381: }
1.1 bertrand 382:
1.50 bertrand 383: (*nouvelle_base).suivant = ancienne_base;
384: (*nouvelle_base).condition = condition;
1.1 bertrand 385:
1.50 bertrand 386: return(nouvelle_base);
387: }
1.1 bertrand 388:
1.50 bertrand 389: static inline struct_pile_analyse *
390: depilement_analyse(struct_pile_analyse *ancienne_base)
391: {
392: struct_pile_analyse *nouvelle_base;
1.1 bertrand 393:
1.50 bertrand 394: if (ancienne_base == NULL)
1.1 bertrand 395: {
1.50 bertrand 396: return(NULL);
397: }
1.1 bertrand 398:
1.50 bertrand 399: nouvelle_base = (*ancienne_base).suivant;
400: free(ancienne_base);
1.1 bertrand 401:
1.50 bertrand 402: return(nouvelle_base);
403: }
1.1 bertrand 404:
1.50 bertrand 405: static inline logical1
406: test_analyse(struct_pile_analyse *l_base_pile, enum t_condition condition)
407: {
408: if (l_base_pile == NULL)
409: {
410: return(d_faux);
1.1 bertrand 411: }
412:
1.50 bertrand 413: return(((*l_base_pile).condition == condition) ? d_vrai : d_faux);
414: }
1.1 bertrand 415:
1.50 bertrand 416: static inline void
417: liberation_analyse(struct_pile_analyse *l_base_pile)
418: {
419: struct_pile_analyse *l_nouvelle_base_pile;
1.1 bertrand 420:
1.50 bertrand 421: while(l_base_pile != NULL)
1.1 bertrand 422: {
1.50 bertrand 423: l_nouvelle_base_pile = (*l_base_pile).suivant;
424: free(l_base_pile);
425: l_base_pile = l_nouvelle_base_pile;
1.1 bertrand 426: }
427:
1.50 bertrand 428: return;
429: }
1.1 bertrand 430:
1.50 bertrand 431: logical1
432: analyse_syntaxique(struct_processus *s_etat_processus)
433: {
434: unsigned char *instruction;
435: unsigned char registre;
1.1 bertrand 436:
1.50 bertrand 437: struct_pile_analyse *l_base_pile;
438: struct_pile_analyse *l_nouvelle_base_pile;
1.1 bertrand 439:
440: l_base_pile = NULL;
441: l_nouvelle_base_pile = NULL;
442:
443: if ((*s_etat_processus).debug == d_vrai)
444: if (((*s_etat_processus).type_debug & d_debug_analyse) != 0)
445: {
446: if ((*s_etat_processus).langue == 'F')
447: {
448: printf("[%d] Analyse\n", (int) getpid());
449: }
450: else
451: {
452: printf("[%d] Analysis\n", (int) getpid());
453: }
454:
455: fflush(stdout);
456: }
457:
458: (*s_etat_processus).position_courante = 0;
459: registre = (*s_etat_processus).autorisation_empilement_programme;
460: (*s_etat_processus).autorisation_empilement_programme = 'N';
461:
462: /*
463: --------------------------------------------------------------------------------
464: Analyse structurelle
465: --------------------------------------------------------------------------------
466: */
467:
468: while((*s_etat_processus).definitions_chainees
469: [(*s_etat_processus).position_courante] != d_code_fin_chaine)
470: {
471: if (recherche_instruction_suivante(s_etat_processus) !=
472: d_absence_erreur)
473: {
474: liberation_analyse(l_base_pile);
475:
476: (*s_etat_processus).autorisation_empilement_programme = registre;
477: return(d_erreur);
478: }
479:
480: if ((instruction = conversion_majuscule(
481: (*s_etat_processus).instruction_courante)) == NULL)
482: {
483: liberation_analyse(l_base_pile);
484:
485: (*s_etat_processus).autorisation_empilement_programme = registre;
486: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
487: return(d_erreur);
488: }
489:
490: if (strcmp(instruction, "IF") == 0)
491: {
492: if ((l_nouvelle_base_pile = empilement_analyse(l_base_pile, AN_IF))
493: == NULL)
494: {
495: liberation_analyse(l_base_pile);
496:
497: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
498: return(d_erreur);
499: }
500:
501: l_base_pile = l_nouvelle_base_pile;
502: (*l_base_pile).condition = AN_IF;
503: }
504: else if (strcmp(instruction, "IFERR") == 0)
505: {
506: if ((l_nouvelle_base_pile = empilement_analyse(l_base_pile,
507: AN_IFERR)) == NULL)
508: {
509: liberation_analyse(l_base_pile);
510:
511: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
512: return(d_erreur);
513: }
514:
515: l_base_pile = l_nouvelle_base_pile;
516: }
1.48 bertrand 517: else if (strcmp(instruction, "CRITICAL") == 0)
518: {
519: if ((l_nouvelle_base_pile = empilement_analyse(l_base_pile,
520: AN_CRITICAL)) == NULL)
521: {
522: liberation_analyse(l_base_pile);
523:
524: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
525: return(d_erreur);
526: }
527:
528: l_base_pile = l_nouvelle_base_pile;
529: }
1.1 bertrand 530: else if (strcmp(instruction, "THEN") == 0)
531: {
532: if ((test_analyse(l_base_pile, AN_IF) == d_faux) &&
533: (test_analyse(l_base_pile, AN_ELSEIF) == d_faux) &&
534: (test_analyse(l_base_pile, AN_CASE) == d_faux) &&
535: (test_analyse(l_base_pile, AN_IFERR) == d_faux))
536: {
537: liberation_analyse(l_base_pile);
538:
539: (*s_etat_processus).autorisation_empilement_programme =
540: registre;
541:
542: (*s_etat_processus).erreur_compilation =
543: d_ec_erreur_instruction_then;
544: return(d_erreur);
545: }
546:
547: (*l_base_pile).condition = AN_THEN;
548: }
549: else if (strcmp(instruction, "ELSE") == 0)
550: {
551: if (test_analyse(l_base_pile, AN_THEN) == d_faux)
552: {
553: liberation_analyse(l_base_pile);
554:
555: (*s_etat_processus).autorisation_empilement_programme =
556: registre;
557:
558: (*s_etat_processus).erreur_compilation =
559: d_ec_erreur_instruction_else;
560: return(d_erreur);
561: }
562:
563: (*l_base_pile).condition = AN_ELSE;
564: }
565: else if (strcmp(instruction, "ELSEIF") == 0)
566: {
567: if (test_analyse(l_base_pile, AN_THEN) == d_faux)
568: {
569: liberation_analyse(l_base_pile);
570:
571: (*s_etat_processus).autorisation_empilement_programme =
572: registre;
573:
574: (*s_etat_processus).erreur_compilation =
575: d_ec_erreur_instruction_elseif;
576: return(d_erreur);
577: }
578:
579: (*l_base_pile).condition = AN_ELSEIF;
580: }
581: else if (strcmp(instruction, "END") == 0)
582: {
583: if ((test_analyse(l_base_pile, AN_UNTIL) == d_faux) &&
584: (test_analyse(l_base_pile, AN_REPEAT) == d_faux) &&
585: (test_analyse(l_base_pile, AN_DEFAULT) == d_faux) &&
586: (test_analyse(l_base_pile, AN_SELECT) == d_faux) &&
587: (test_analyse(l_base_pile, AN_THEN) == d_faux) &&
1.48 bertrand 588: (test_analyse(l_base_pile, AN_CRITICAL) == d_faux) &&
1.1 bertrand 589: (test_analyse(l_base_pile, AN_ELSE) == d_faux))
590: {
591: liberation_analyse(l_base_pile);
592:
593: (*s_etat_processus).autorisation_empilement_programme =
594: registre;
595:
596: (*s_etat_processus).erreur_compilation =
597: d_ec_erreur_instruction_end;
598: return(d_erreur);
599: }
600:
601: l_base_pile = depilement_analyse(l_base_pile);
602: }
603: else if (strcmp(instruction, "DO") == 0)
604: {
605: if ((l_nouvelle_base_pile = empilement_analyse(l_base_pile, AN_DO))
606: == NULL)
607: {
608: liberation_analyse(l_base_pile);
609:
610: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
611: return(d_erreur);
612: }
613:
614: l_base_pile = l_nouvelle_base_pile;
615: }
616: else if (strcmp(instruction, "UNTIL") == 0)
617: {
618: if (test_analyse(l_base_pile, AN_DO) == d_faux)
619: {
620: liberation_analyse(l_base_pile);
621:
622: (*s_etat_processus).autorisation_empilement_programme =
623: registre;
624:
625: (*s_etat_processus).erreur_compilation =
626: d_ec_erreur_instruction_until;
627: return(d_erreur);
628: }
629:
630: (*l_base_pile).condition = AN_UNTIL;
631: }
632: else if (strcmp(instruction, "WHILE") == 0)
633: {
634: if ((l_nouvelle_base_pile = empilement_analyse(l_base_pile,
635: AN_WHILE)) == NULL)
636: {
637: liberation_analyse(l_base_pile);
638:
639: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
640: return(d_erreur);
641: }
642:
643: l_base_pile = l_nouvelle_base_pile;
644: }
645: else if (strcmp(instruction, "REPEAT") == 0)
646: {
647: if (test_analyse(l_base_pile, AN_WHILE) == d_faux)
648: {
649: liberation_analyse(l_base_pile);
650:
651: (*s_etat_processus).autorisation_empilement_programme =
652: registre;
653:
654: (*s_etat_processus).erreur_compilation =
655: d_ec_erreur_instruction_while;
656: return(d_erreur);
657: }
658:
659: (*l_base_pile).condition = AN_REPEAT;
660: }
661: else if (strcmp(instruction, "SELECT") == 0)
662: {
663: if ((l_nouvelle_base_pile = empilement_analyse(l_base_pile,
664: AN_SELECT)) == NULL)
665: {
666: liberation_analyse(l_base_pile);
667:
668: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
669: return(d_erreur);
670: }
671:
672: l_base_pile = l_nouvelle_base_pile;
673: }
674: else if (strcmp(instruction, "CASE") == 0)
675: {
676: if (test_analyse(l_base_pile, AN_SELECT) == d_faux)
677: {
678: liberation_analyse(l_base_pile);
679:
680: (*s_etat_processus).autorisation_empilement_programme =
681: registre;
682:
683: (*s_etat_processus).erreur_compilation =
684: d_ec_erreur_instruction_case;
685: return(d_erreur);
686: }
687:
688: if ((l_nouvelle_base_pile = empilement_analyse(l_base_pile,
689: AN_CASE)) == NULL)
690: {
691: liberation_analyse(l_base_pile);
692:
693: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
694: return(d_erreur);
695: }
696:
697: l_base_pile = l_nouvelle_base_pile;
698: }
699: else if (strcmp(instruction, "DEFAULT") == 0)
700: {
701: if (test_analyse(l_base_pile, AN_SELECT) == d_faux)
702: {
703: liberation_analyse(l_base_pile);
704:
705: (*s_etat_processus).autorisation_empilement_programme =
706: registre;
707:
708: (*s_etat_processus).erreur_compilation =
709: d_ec_erreur_instruction_select;
710: return(d_erreur);
711: }
712:
713: (*l_base_pile).condition = AN_DEFAULT;
714: }
715: else if (strcmp(instruction, "<<") == 0)
716: {
717: if ((l_nouvelle_base_pile = empilement_analyse(l_base_pile, AN_UP))
718: == NULL)
719: {
720: liberation_analyse(l_base_pile);
721:
722: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
723: return(d_erreur);
724: }
725:
726: l_base_pile = l_nouvelle_base_pile;
727: }
728: else if (strcmp(instruction, ">>") == 0)
729: {
730: if (test_analyse(l_base_pile, AN_UP) == d_faux)
731: {
732: liberation_analyse(l_base_pile);
733:
734: (*s_etat_processus).autorisation_empilement_programme =
735: registre;
736:
737: (*s_etat_processus).erreur_compilation =
738: d_ec_source_incoherent;
739: return(d_erreur);
740: }
741:
742: l_base_pile = depilement_analyse(l_base_pile);
743: }
744: else if (strcmp(instruction, "FOR") == 0)
745: {
746: if ((l_nouvelle_base_pile = empilement_analyse(l_base_pile, AN_FOR))
747: == NULL)
748: {
749: liberation_analyse(l_base_pile);
750:
751: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
752: return(d_erreur);
753: }
754:
755: l_base_pile = l_nouvelle_base_pile;
756: }
757: else if (strcmp(instruction, "START") == 0)
758: {
759: if ((l_nouvelle_base_pile = empilement_analyse(l_base_pile,
760: AN_START)) == NULL)
761: {
762: liberation_analyse(l_base_pile);
763:
764: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
765: return(d_erreur);
766: }
767:
768: l_base_pile = l_nouvelle_base_pile;
769: }
1.49 bertrand 770: else if (strcmp(instruction, "FORALL") == 0)
771: {
772: if ((l_nouvelle_base_pile = empilement_analyse(l_base_pile,
773: AN_FORALL)) == NULL)
774: {
775: liberation_analyse(l_base_pile);
776:
777: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
778: return(d_erreur);
779: }
780:
781: l_base_pile = l_nouvelle_base_pile;
782: }
1.1 bertrand 783: else if (strcmp(instruction, "NEXT") == 0)
784: {
785: if ((test_analyse(l_base_pile, AN_FOR) == d_faux) &&
1.49 bertrand 786: (test_analyse(l_base_pile, AN_FORALL) == d_faux) &&
1.1 bertrand 787: (test_analyse(l_base_pile, AN_START) == d_faux))
788: {
789: liberation_analyse(l_base_pile);
790:
791: (*s_etat_processus).autorisation_empilement_programme =
792: registre;
793:
794: (*s_etat_processus).erreur_compilation =
795: d_ec_erreur_boucle_definie;
796: return(d_erreur);
797: }
798:
799: l_base_pile = depilement_analyse(l_base_pile);
800: }
801: else if (strcmp(instruction, "STEP") == 0)
802: {
803: if ((test_analyse(l_base_pile, AN_FOR) == d_faux) &&
804: (test_analyse(l_base_pile, AN_START) == d_faux))
805: {
806: liberation_analyse(l_base_pile);
807:
808: (*s_etat_processus).autorisation_empilement_programme =
809: registre;
810:
811: (*s_etat_processus).erreur_compilation =
812: d_ec_erreur_boucle_definie;
813: return(d_erreur);
814: }
815:
816: l_base_pile = depilement_analyse(l_base_pile);
817: }
818:
819: // Invalidation de l'instruction courante dans le fichier rpl-core
820: free((*s_etat_processus).instruction_courante);
821: (*s_etat_processus).instruction_courante = NULL;
822: free(instruction);
823: }
824:
825: (*s_etat_processus).autorisation_empilement_programme = registre;
826:
827: if (l_base_pile != NULL)
828: {
829: liberation_analyse(l_base_pile);
830:
831: (*s_etat_processus).autorisation_empilement_programme = registre;
832: (*s_etat_processus).erreur_compilation = d_ec_source_incoherent;
833: return(d_erreur);
834: }
835:
836: return(d_absence_erreur);
837: }
838:
839:
840: /*
841: ================================================================================
1.39 bertrand 842: Procédure de d'analyse syntaxique du source pour readline
843: ================================================================================
844: Entrées :
845: --------------------------------------------------------------------------------
846: Sorties :
847: - rl_done à 0 ou à 1.
848: --------------------------------------------------------------------------------
849: Effets de bord :
850: ================================================================================
851: */
852:
1.40 bertrand 853: static char *ligne = NULL;
854: static unsigned int niveau = 0;
855:
1.39 bertrand 856: int
857: readline_analyse_syntaxique(int count, int key)
858: {
1.40 bertrand 859: char prompt[] = "+ %03d> ";
860: char prompt2[8];
861: char *registre;
862:
1.39 bertrand 863: struct_processus s_etat_processus;
864:
865: if ((*rl_line_buffer) == d_code_fin_chaine)
866: {
1.40 bertrand 867: if (ligne == NULL)
868: {
869: rl_done = 1;
870: }
871: else
872: {
873: rl_done = 0;
874: }
1.39 bertrand 875: }
876: else
877: {
1.40 bertrand 878: if (ligne == NULL)
879: {
880: if ((ligne = malloc((strlen(rl_line_buffer) + 1)
881: * sizeof(char))) == NULL)
882: {
883: rl_done = 1;
884: return(0);
885: }
886:
887: strcpy(ligne, rl_line_buffer);
888: }
889: else
890: {
891: registre = ligne;
892:
893: if ((ligne = malloc((strlen(registre)
1.41 bertrand 894: + strlen(rl_line_buffer) + 2) * sizeof(char))) == NULL)
1.40 bertrand 895: {
896: rl_done = 1;
897: return(0);
898: }
899:
1.41 bertrand 900: sprintf(ligne, "%s %s", registre, rl_line_buffer);
1.40 bertrand 901: }
902:
903: rl_replace_line("", 1);
904:
905: s_etat_processus.definitions_chainees = ligne;
906: s_etat_processus.debug = d_faux;
907: s_etat_processus.erreur_systeme = d_es;
908: s_etat_processus.erreur_execution = d_ex;
909:
1.39 bertrand 910: if (analyse_syntaxique(&s_etat_processus) == d_absence_erreur)
911: {
912: rl_done = 1;
913: }
914: else
915: {
1.40 bertrand 916: if (s_etat_processus.erreur_systeme != d_es)
917: {
918: rl_done = 1;
919: }
920: else
921: {
922: rl_done = 0;
923: rl_crlf();
924:
925: sprintf(prompt2, prompt, ++niveau);
926:
927: rl_expand_prompt(prompt2);
928: rl_on_new_line();
929: }
1.39 bertrand 930: }
931: }
932:
933: if (rl_done != 0)
934: {
935: uprintf("\n");
1.40 bertrand 936:
937: if (ligne != NULL)
938: {
939: rl_replace_line(ligne, 1);
940:
941: free(ligne);
942: ligne = NULL;
943: }
944:
945: niveau = 0;
1.39 bertrand 946: }
947:
948: return(0);
949: }
950:
1.40 bertrand 951: int
952: readline_effacement(int count, int key)
953: {
954: rl_done = 0;
955: rl_replace_line("", 1);
956:
957: free(ligne);
958: ligne = NULL;
959: niveau = 0;
960:
1.43 bertrand 961: uprintf("^G\n");
1.40 bertrand 962: rl_expand_prompt("RPL/2> ");
963: rl_on_new_line();
964: return(0);
965: }
1.39 bertrand 966:
1.41 bertrand 967:
1.39 bertrand 968: /*
969: ================================================================================
1.1 bertrand 970: Routine d'échange de deux variables
971: ================================================================================
972: Entrées :
973: - pointeurs génériques sur les deux variables,
974: - longueur en octet des objets à permuter.
975: --------------------------------------------------------------------------------
976: Sorties : idem.
977: --------------------------------------------------------------------------------
978: Effets de bord : néant.
979: ================================================================================
980: */
981:
982: void
1.57 bertrand 983: swap(void *variable_1, void *variable_2, integer8 taille)
1.1 bertrand 984: {
985: register unsigned char *t_var_1;
986: register unsigned char *t_var_2;
987: register unsigned char variable_temporaire;
988:
1.57 bertrand 989: register integer8 i;
1.1 bertrand 990:
991: t_var_1 = (unsigned char *) variable_1;
992: t_var_2 = (unsigned char *) variable_2;
993:
1.14 bertrand 994: for(i = 0; i < taille; i++)
1.1 bertrand 995: {
1.14 bertrand 996: variable_temporaire = (*t_var_1);
997: (*(t_var_1++)) = (*t_var_2);
998: (*(t_var_2++)) = variable_temporaire;
1.1 bertrand 999: }
1.14 bertrand 1000:
1001: return;
1.1 bertrand 1002: }
1003:
1004:
1005: /*
1006: ================================================================================
1007: Routine recherchant l'instruction suivante dans le programme compilé
1008: ================================================================================
1009: Entrée :
1010: --------------------------------------------------------------------------------
1011: Sortie :
1012: --------------------------------------------------------------------------------
1013: Effets de bord : néant.
1014: ================================================================================
1015: */
1016:
1017: logical1
1018: recherche_instruction_suivante(struct_processus *s_etat_processus)
1019: {
1.69 ! bertrand 1020: return(recherche_instruction_suivante_recursive(s_etat_processus, 0));
! 1021: }
! 1022:
! 1023: logical1
! 1024: recherche_instruction_suivante_recursive(struct_processus *s_etat_processus,
! 1025: integer8 recursivite)
! 1026: {
1.68 bertrand 1027: enum t_type registre_type_en_cours;
1028:
1.1 bertrand 1029: logical1 drapeau_fin_objet;
1030: logical1 erreur;
1.60 bertrand 1031:
1032: int erreur_analyse;
1033: int erreur_format;
1.1 bertrand 1034:
1035: unsigned char base_binaire;
1.68 bertrand 1036: unsigned char caractere_fin;
1.1 bertrand 1037: unsigned char *pointeur_caractere_courant;
1038: unsigned char *pointeur_caractere_destination;
1039: unsigned char *pointeur_debut_instruction;
1040: unsigned char *pointeur_fin_instruction;
1041:
1042: signed long niveau;
1043:
1044: erreur_analyse = d_ex;
1045: erreur_format = d_ex;
1046: erreur = d_absence_erreur;
1047:
1.68 bertrand 1048: switch((*s_etat_processus).type_en_cours)
1049: {
1050: case RPN:
1051: {
1052: caractere_fin = '>';
1053: break;
1054: }
1055:
1056: case LST:
1057: {
1058: caractere_fin = '}';
1059: break;
1060: }
1061:
1062: case TBL:
1063: {
1064: caractere_fin = ']';
1065: break;
1066: }
1067:
1068: default:
1069: {
1070: caractere_fin = d_code_espace;
1071: break;
1072: }
1073: }
1074:
1.1 bertrand 1075: drapeau_fin_objet = d_faux;
1076: niveau = 0;
1077:
1078: pointeur_caractere_courant = (*s_etat_processus).definitions_chainees +
1079: (*s_etat_processus).position_courante;
1080:
1081: while(((*pointeur_caractere_courant) == d_code_espace) &&
1082: ((*pointeur_caractere_courant) != d_code_fin_chaine))
1083: {
1084: pointeur_caractere_courant++;
1085: }
1086:
1087: if ((*pointeur_caractere_courant) == d_code_fin_chaine)
1088: {
1089: (*s_etat_processus).instruction_courante = (unsigned char *)
1090: malloc(sizeof(unsigned char));
1091:
1092: if ((*s_etat_processus).instruction_courante == NULL)
1093: {
1094: erreur = d_erreur;
1095: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1096: }
1097: else
1098: {
1099: erreur = d_absence_erreur;
1100: (*(*s_etat_processus).instruction_courante) = d_code_fin_chaine;
1101: (*s_etat_processus).position_courante = pointeur_caractere_courant
1102: - (*s_etat_processus).definitions_chainees;
1103: }
1104:
1105: return(erreur);
1106: }
1107:
1108: pointeur_debut_instruction = pointeur_caractere_courant;
1109:
1110: while(((*pointeur_caractere_courant) != d_code_espace) &&
1111: ((*pointeur_caractere_courant) != d_code_fin_chaine) &&
1112: (drapeau_fin_objet == d_faux) &&
1.68 bertrand 1113: (erreur_analyse == d_ex) && (erreur_format == d_ex))
1.1 bertrand 1114: {
1115: switch(*pointeur_caractere_courant++)
1116: {
1117: case ']' :
1118: case '}' :
1.56 bertrand 1119: {
1120: break;
1121: }
1122:
1.1 bertrand 1123: case ')' :
1124: {
1125: erreur_format = d_ex_syntaxe;
1126: break;
1127: }
1128:
1129: case '"' :
1130: {
1131: if (pointeur_debut_instruction !=
1132: (pointeur_caractere_courant - 1))
1133: {
1134: erreur_format = d_ex_syntaxe;
1135: }
1136:
1137: while((*pointeur_caractere_courant != '"') &&
1138: ((*pointeur_caractere_courant) != d_code_fin_chaine))
1139: {
1140: if (*pointeur_caractere_courant == '\\')
1141: {
1142: pointeur_caractere_courant++;
1143:
1144: switch(*pointeur_caractere_courant)
1145: {
1146: case '\\' :
1147: case '"' :
1148: {
1149: pointeur_caractere_courant++;
1150: break;
1151: }
1152: }
1153: }
1154: else
1155: {
1156: pointeur_caractere_courant++;
1157: }
1158: }
1159:
1160: if ((*pointeur_caractere_courant) != '"')
1161: {
1162: erreur_analyse = d_ex_syntaxe;
1163: }
1164:
1165: if (erreur_analyse == d_ex)
1166: {
1167: pointeur_caractere_courant++;
1168: }
1169:
1170: drapeau_fin_objet = d_vrai;
1171: break;
1172: }
1173:
1174: case '\'' :
1175: {
1176: if (pointeur_debut_instruction !=
1177: (pointeur_caractere_courant - 1))
1178: {
1179: erreur_format = d_ex_syntaxe;
1180: }
1181:
1182: while(((*pointeur_caractere_courant) != '\'') &&
1183: ((*pointeur_caractere_courant) != d_code_fin_chaine))
1184: {
1185: if ((*pointeur_caractere_courant) == '(')
1186: {
1187: niveau++;
1188: }
1189: else if ((*pointeur_caractere_courant) == ')')
1190: {
1191: niveau--;
1192: }
1193:
1194: pointeur_caractere_courant++;
1195: }
1196:
1197: if ((*pointeur_caractere_courant) != '\'')
1198: {
1199: erreur_analyse = d_ex_syntaxe;
1200: }
1201: else if (niveau != 0)
1202: {
1203: erreur_analyse = d_ex_syntaxe;
1204: }
1205:
1206: if (erreur_analyse == d_ex)
1207: {
1208: pointeur_caractere_courant++;
1209: }
1210:
1211: drapeau_fin_objet = d_vrai;
1212: break;
1213: }
1214:
1215: case '(' :
1216: {
1217: if (pointeur_debut_instruction !=
1218: (pointeur_caractere_courant - 1))
1219: {
1220: erreur_format = d_ex_syntaxe;
1221: }
1222:
1223: while(((*pointeur_caractere_courant) != ')') &&
1224: ((*pointeur_caractere_courant) != d_code_fin_chaine)
1225: && (erreur_analyse == d_ex))
1226: {
1227: switch(*pointeur_caractere_courant)
1228: {
1229: case '0' :
1230: case '1' :
1231: case '2' :
1232: case '3' :
1233: case '4' :
1234: case '5' :
1235: case '6' :
1236: case '7' :
1237: case '8' :
1238: case '9' :
1239: case 'e' :
1240: case 'E' :
1241: case ',' :
1242: case '.' :
1243: case ' ' :
1244: case '-' :
1245: case '+' :
1246: case ')' :
1247: {
1248: break;
1249: }
1250:
1251: default :
1252: {
1253: erreur_analyse = d_ex_syntaxe;
1254: break;
1255: }
1256: }
1257:
1258: pointeur_caractere_courant++;
1259: }
1260:
1261: if ((*pointeur_caractere_courant) != ')')
1262: {
1263: erreur_analyse = d_ex_syntaxe;
1264: }
1265:
1266: if (erreur_analyse == d_ex)
1267: {
1268: pointeur_caractere_courant++;
1269: }
1270:
1271: drapeau_fin_objet = d_vrai;
1272: break;
1273: }
1274:
1275: case '#' :
1276: {
1277: if (pointeur_debut_instruction !=
1278: (pointeur_caractere_courant - 1))
1279: {
1280: erreur_format = d_ex_syntaxe;
1281: }
1282:
1283: while(((*pointeur_caractere_courant) != 'b') &&
1284: ((*pointeur_caractere_courant) != 'o') &&
1285: ((*pointeur_caractere_courant) != 'd') &&
1286: ((*pointeur_caractere_courant) != 'h') &&
1287: ((*pointeur_caractere_courant) !=
1288: d_code_fin_chaine) &&
1289: (erreur_analyse == d_ex))
1290: {
1291: switch(*pointeur_caractere_courant)
1292: {
1293: case ' ' :
1294: case '0' :
1295: case '1' :
1296: case '2' :
1297: case '3' :
1298: case '4' :
1299: case '5' :
1300: case '6' :
1301: case '7' :
1302: case '8' :
1303: case '9' :
1304: case 'A' :
1305: case 'B' :
1306: case 'C' :
1307: case 'D' :
1308: case 'E' :
1309: case 'F' :
1310: case 'b' :
1311: case 'o' :
1312: case 'd' :
1313: case 'h' :
1314: {
1315: break;
1316: }
1317:
1318: default :
1319: {
1320: erreur_analyse = d_ex_syntaxe;
1321: break;
1322: }
1323: }
1324:
1325: pointeur_caractere_courant++;
1326: }
1327:
1328: base_binaire = (*pointeur_caractere_courant);
1329: pointeur_caractere_courant++;
1330:
1331: if (((*pointeur_caractere_courant) != d_code_fin_chaine) &&
1.68 bertrand 1332: ((*pointeur_caractere_courant) != d_code_espace) &&
1333: ((*pointeur_caractere_courant) != caractere_fin))
1.1 bertrand 1334: {
1335: erreur_analyse = d_ex_syntaxe;
1336: }
1337: else
1338: {
1339: pointeur_caractere_courant = pointeur_debut_instruction + 1;
1340:
1341: switch(base_binaire)
1342: {
1343: case 'b' :
1344: case 'o' :
1345: case 'd' :
1346: case 'h' :
1347: {
1348: break;
1349: }
1350:
1351: default :
1352: {
1353: erreur_analyse = d_ex_syntaxe;
1354: break;
1355: }
1356: }
1357: }
1358:
1359: while(((*pointeur_caractere_courant) != base_binaire) &&
1360: ((*pointeur_caractere_courant) != d_code_fin_chaine) &&
1361: (erreur_analyse == d_ex))
1362: {
1363: if (base_binaire == 'b')
1364: {
1365: switch(*pointeur_caractere_courant)
1366: {
1367: case ' ' :
1368: case '0' :
1369: case '1' :
1370: {
1371: break;
1372: }
1373:
1374: default :
1375: {
1376: erreur_analyse = d_ex_syntaxe;
1377: break;
1378: }
1379: }
1380: }
1381: else if (base_binaire == 'o')
1382: {
1383: switch(*pointeur_caractere_courant)
1384: {
1385: case ' ' :
1386: case '0' :
1387: case '1' :
1388: case '2' :
1389: case '3' :
1390: case '4' :
1391: case '5' :
1392: case '6' :
1393: case '7' :
1394: {
1395: break;
1396: }
1397:
1398: default :
1399: {
1400: erreur_analyse = d_ex_syntaxe;
1401: break;
1402: }
1403: }
1404: }
1405: else if (base_binaire == 'd')
1406: {
1407: switch(*pointeur_caractere_courant)
1408: {
1409: case ' ' :
1410: case '0' :
1411: case '1' :
1412: case '2' :
1413: case '3' :
1414: case '4' :
1415: case '5' :
1416: case '6' :
1417: case '7' :
1418: case '8' :
1419: case '9' :
1420: {
1421: break;
1422: }
1423:
1424: default :
1425: {
1426: erreur_analyse = d_ex_syntaxe;
1427: break;
1428: }
1429: }
1430: }
1431: else if (base_binaire != 'h')
1432: {
1433: erreur_analyse = d_ex_syntaxe;
1434: }
1435:
1436: pointeur_caractere_courant++;
1437: }
1438:
1439: if (erreur_analyse == d_ex)
1440: {
1441: pointeur_caractere_courant++;
1442: }
1443:
1444: drapeau_fin_objet = d_vrai;
1445: break;
1446: }
1447:
1448: case '{' :
1449: {
1450: if (pointeur_debut_instruction !=
1451: (pointeur_caractere_courant - 1))
1452: {
1453: erreur_format = d_ex_syntaxe;
1454: }
1455:
1456: niveau = 1;
1457:
1458: while((niveau != 0) && ((*pointeur_caractere_courant) !=
1459: d_code_fin_chaine))
1460: {
1.56 bertrand 1461: (*s_etat_processus).position_courante =
1462: pointeur_caractere_courant
1463: - (*s_etat_processus).definitions_chainees;
1464:
1.68 bertrand 1465: registre_type_en_cours = (*s_etat_processus).type_en_cours;
1466: (*s_etat_processus).type_en_cours = LST;
1467:
1.69 ! bertrand 1468: if (recherche_instruction_suivante_recursive(
! 1469: s_etat_processus, recursivite + 1) == d_erreur)
1.1 bertrand 1470: {
1.68 bertrand 1471: (*s_etat_processus).type_en_cours =
1472: registre_type_en_cours;
1473:
1.56 bertrand 1474: if ((*s_etat_processus).instruction_courante
1475: != NULL)
1.1 bertrand 1476: {
1.56 bertrand 1477: free((*s_etat_processus).instruction_courante);
1.68 bertrand 1478: (*s_etat_processus).instruction_courante = NULL;
1.56 bertrand 1479: }
1480:
1481: return(d_erreur);
1482: }
1483:
1.69 ! bertrand 1484: (*s_etat_processus).type_en_cours = registre_type_en_cours;
1.56 bertrand 1485: pointeur_caractere_courant =
1486: (*s_etat_processus).definitions_chainees +
1487: (*s_etat_processus).position_courante;
1.1 bertrand 1488:
1.68 bertrand 1489: if (strcmp((*s_etat_processus).instruction_courante, "}")
1.56 bertrand 1490: == 0)
1491: {
1492: niveau--;
1493: }
1.1 bertrand 1494:
1.56 bertrand 1495: free((*s_etat_processus).instruction_courante);
1.1 bertrand 1496: }
1497:
1.68 bertrand 1498: if (niveau != 0)
1.1 bertrand 1499: {
1500: erreur_analyse = d_ex_syntaxe;
1501: }
1502:
1503: drapeau_fin_objet = d_vrai;
1504: break;
1505: }
1506:
1507: case '[' :
1508: {
1509: if (pointeur_debut_instruction !=
1510: (pointeur_caractere_courant - 1))
1511: {
1512: erreur_format = d_ex_syntaxe;
1513: }
1514:
1515: niveau = 1;
1516:
1517: while((niveau > 0) && ((*pointeur_caractere_courant) !=
1518: d_code_fin_chaine) && (erreur_analyse == d_ex))
1519: {
1520: switch(*pointeur_caractere_courant)
1521: {
1522: case '[' :
1523: {
1524: niveau++;
1525: break;
1526: }
1527:
1528: case ']' :
1529: {
1530: niveau--;
1531: break;
1532: }
1533:
1534: case '0' :
1535: case '1' :
1536: case '2' :
1537: case '3' :
1538: case '4' :
1539: case '5' :
1540: case '6' :
1541: case '7' :
1542: case '8' :
1543: case '9' :
1544: case '+' :
1545: case '-' :
1546: case 'e' :
1547: case 'E' :
1548: case '.' :
1549: case ',' :
1550: case '(' :
1551: case ')' :
1552: case ' ' :
1553: {
1554: break;
1555: }
1556:
1557: default :
1558: {
1559: erreur_analyse = d_ex_syntaxe;
1560: break;
1561: }
1562: }
1563:
1564: if (niveau < 0)
1565: {
1566: erreur_analyse = d_ex_syntaxe;
1567: }
1568: else if (niveau > 2)
1569: {
1570: erreur_format = d_ex_syntaxe;
1571: }
1572:
1573: pointeur_caractere_courant++;
1574: }
1575:
1576: if (niveau != 0)
1577: {
1578: erreur_analyse = d_ex_syntaxe;
1579: }
1580:
1581: drapeau_fin_objet = d_vrai;
1582: break;
1583: }
1584:
1585: case '<' :
1586: {
1587: if (((*s_etat_processus).autorisation_empilement_programme
1588: == 'Y') && ((*pointeur_caractere_courant) == '<'))
1.56 bertrand 1589: { // Cas << >>
1.1 bertrand 1590: if (pointeur_debut_instruction !=
1591: (pointeur_caractere_courant - 1))
1592: {
1593: erreur_format = d_ex_syntaxe;
1594: }
1595:
1.69 ! bertrand 1596: pointeur_caractere_courant++;
! 1597: drapeau_fin_objet = d_faux;
1.1 bertrand 1598:
1.69 ! bertrand 1599: while(((*pointeur_caractere_courant) != d_code_fin_chaine)
! 1600: && (erreur_format == d_absence_erreur))
1.1 bertrand 1601: {
1.69 ! bertrand 1602: while((*pointeur_caractere_courant) == d_code_espace)
! 1603: {
! 1604: pointeur_caractere_courant++;
! 1605: }
! 1606:
! 1607: if ((*pointeur_caractere_courant) == '>')
! 1608: {
! 1609: if ((*(++pointeur_caractere_courant)) == '>')
! 1610: {
! 1611: drapeau_fin_objet = d_vrai;
! 1612: }
! 1613: else
! 1614: {
! 1615: erreur_analyse = d_ex_syntaxe;
! 1616: }
1.56 bertrand 1617:
1.69 ! bertrand 1618: pointeur_caractere_courant++;
! 1619: break;
! 1620: }
1.68 bertrand 1621:
1.69 ! bertrand 1622: if ((erreur_format == d_absence_erreur) &&
! 1623: (drapeau_fin_objet == d_faux))
1.56 bertrand 1624: {
1.69 ! bertrand 1625: (*s_etat_processus).position_courante =
! 1626: pointeur_caractere_courant
! 1627: - (*s_etat_processus).definitions_chainees;
! 1628:
! 1629: registre_type_en_cours = (*s_etat_processus)
! 1630: .type_en_cours;
! 1631: (*s_etat_processus).type_en_cours = RPN;
1.68 bertrand 1632:
1.69 ! bertrand 1633: if ((erreur =
! 1634: recherche_instruction_suivante_recursive(
! 1635: s_etat_processus, recursivite + 1))
! 1636: != d_absence_erreur)
1.56 bertrand 1637: {
1.69 ! bertrand 1638: (*s_etat_processus).type_en_cours =
! 1639: registre_type_en_cours;
! 1640:
! 1641: if ((*s_etat_processus).instruction_courante
! 1642: != NULL)
! 1643: {
! 1644: free((*s_etat_processus)
! 1645: .instruction_courante);
! 1646: (*s_etat_processus).instruction_courante
! 1647: = NULL;
! 1648: }
! 1649:
! 1650: return(d_erreur);
1.56 bertrand 1651: }
1652:
1.69 ! bertrand 1653: (*s_etat_processus).type_en_cours =
! 1654: registre_type_en_cours;
! 1655: pointeur_caractere_courant = (*s_etat_processus)
! 1656: .definitions_chainees + (*s_etat_processus)
! 1657: .position_courante;
1.56 bertrand 1658:
1.69 ! bertrand 1659: free((*s_etat_processus).instruction_courante);
1.1 bertrand 1660: }
1661: }
1662:
1.69 ! bertrand 1663: if (drapeau_fin_objet == d_faux)
1.1 bertrand 1664: {
1665: erreur_analyse = d_ex_syntaxe;
1.69 ! bertrand 1666: drapeau_fin_objet = d_vrai;
1.1 bertrand 1667: }
1668: }
1669: else if ((*pointeur_caractere_courant) == '[')
1.56 bertrand 1670: { // Cas <[ ]>
1.1 bertrand 1671: if (pointeur_debut_instruction !=
1672: (pointeur_caractere_courant - 1))
1673: {
1674: erreur_format = d_ex_syntaxe;
1675: }
1676:
1677: pointeur_caractere_courant++;
1678: drapeau_fin_objet = d_faux;
1679:
1680: while(((*pointeur_caractere_courant) != d_code_fin_chaine)
1681: && (erreur_format == d_absence_erreur))
1682: {
1683: while((*pointeur_caractere_courant) == d_code_espace)
1684: {
1685: pointeur_caractere_courant++;
1686: }
1687:
1688: if ((*pointeur_caractere_courant) == ']')
1689: {
1690: if ((*(++pointeur_caractere_courant)) == '>')
1691: {
1692: drapeau_fin_objet = d_vrai;
1693: }
1694: else
1695: {
1696: erreur_analyse = d_ex_syntaxe;
1697: }
1698:
1699: pointeur_caractere_courant++;
1700: break;
1701: }
1702:
1703: if ((erreur_format == d_absence_erreur) &&
1704: (drapeau_fin_objet == d_faux))
1705: {
1706: (*s_etat_processus).position_courante =
1707: pointeur_caractere_courant
1708: - (*s_etat_processus).definitions_chainees;
1709:
1.68 bertrand 1710: registre_type_en_cours = (*s_etat_processus)
1711: .type_en_cours;
1712: (*s_etat_processus).type_en_cours = TBL;
1713:
1.69 ! bertrand 1714: if ((erreur =
! 1715: recherche_instruction_suivante_recursive(
! 1716: s_etat_processus, recursivite + 1))
! 1717: != d_absence_erreur)
1.1 bertrand 1718: {
1.68 bertrand 1719: (*s_etat_processus).type_en_cours =
1720: registre_type_en_cours;
1721:
1.1 bertrand 1722: if ((*s_etat_processus).instruction_courante
1723: != NULL)
1724: {
1725: free((*s_etat_processus)
1726: .instruction_courante);
1.68 bertrand 1727: (*s_etat_processus).instruction_courante
1728: = NULL;
1.1 bertrand 1729: }
1730:
1731: return(d_erreur);
1732: }
1733:
1.68 bertrand 1734: (*s_etat_processus).type_en_cours =
1735: registre_type_en_cours;
1.1 bertrand 1736: pointeur_caractere_courant = (*s_etat_processus)
1737: .definitions_chainees + (*s_etat_processus)
1738: .position_courante;
1739:
1740: free((*s_etat_processus).instruction_courante);
1741: }
1742: }
1743:
1744: if (drapeau_fin_objet == d_faux)
1745: {
1746: erreur_analyse = d_ex_syntaxe;
1747: drapeau_fin_objet = d_vrai;
1748: }
1749: }
1750:
1751: break;
1752: }
1753: }
1.68 bertrand 1754:
1.69 ! bertrand 1755: if ((*(pointeur_caractere_courant - 1)) == caractere_fin)
1.68 bertrand 1756: {
1.69 ! bertrand 1757: // Cas des objets composites (LST, RPN, TBL)
! 1758: break;
! 1759: }
! 1760: else if ((*pointeur_caractere_courant) == caractere_fin)
! 1761: {
! 1762: // Condition pour traiter les cas 123}
1.68 bertrand 1763: break;
1764: }
1.1 bertrand 1765: }
1766:
1767: pointeur_fin_instruction = pointeur_caractere_courant;
1768:
1.69 ! bertrand 1769: if (recursivite == 0)
! 1770: {
! 1771: // Si la variable récursivité est nulle, il faut que le caractère
! 1772: // suivant l'objet soit un espace ou une fin de chaîne. Si ce n'est pas
! 1773: // le cas, il faut retourner une erreur car les objets de type
! 1774: // [[ 1 4 ]]3 doivent être invalides.
! 1775:
! 1776: switch((*pointeur_fin_instruction))
! 1777: {
! 1778: case d_code_fin_chaine:
! 1779: case d_code_espace:
! 1780: {
! 1781: break;
! 1782: }
! 1783:
! 1784: default:
! 1785: {
! 1786: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
! 1787: return(d_erreur);
! 1788: }
! 1789: }
! 1790: }
! 1791:
1.1 bertrand 1792: (*s_etat_processus).instruction_courante = (unsigned char *)
1.57 bertrand 1793: malloc((((size_t) (pointeur_fin_instruction
1794: - pointeur_debut_instruction)) + 1) * sizeof(unsigned char));
1.1 bertrand 1795:
1796: if ((*s_etat_processus).instruction_courante == NULL)
1797: {
1798: erreur = d_erreur;
1799: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1800: }
1801: else if (pointeur_fin_instruction != pointeur_debut_instruction)
1802: {
1803: pointeur_caractere_courant = pointeur_debut_instruction;
1804: pointeur_caractere_destination =
1805: (*s_etat_processus).instruction_courante;
1806:
1807: do
1808: {
1809: *pointeur_caractere_destination++ = *pointeur_caractere_courant++;
1810: } while(pointeur_caractere_courant < pointeur_fin_instruction);
1811:
1812: (*pointeur_caractere_destination) = d_code_fin_chaine;
1813:
1814: erreur = ((erreur_analyse == d_ex) && (erreur_format == d_ex))
1815: ? d_absence_erreur : d_erreur;
1816: (*s_etat_processus).erreur_execution = erreur_analyse;
1817: }
1818: else
1819: {
1820: (*(*s_etat_processus).instruction_courante) = d_code_fin_chaine;
1821: }
1822:
1823: (*s_etat_processus).position_courante = pointeur_fin_instruction
1824: - (*s_etat_processus).definitions_chainees;
1825:
1826: return(erreur);
1827: }
1828:
1829:
1830: /*
1831: ================================================================================
1.69 ! bertrand 1832: Routine mettant la chaîne d'entrée en majuscule
1.1 bertrand 1833: ================================================================================
1.69 ! bertrand 1834: Entrée : pointeur sur une chaîne en minuscules.
1.1 bertrand 1835: --------------------------------------------------------------------------------
1.69 ! bertrand 1836: Sortie : pointeur sur la chaîne en majuscules. Si le pointeur retourné
1.1 bertrand 1837: est nul, il s'est produit une erreur. L'allocation est faite dans la
1838: routine.
1839: --------------------------------------------------------------------------------
1840: Effets de bord : néant.
1841: ================================================================================
1842: */
1843:
1844: unsigned char *
1845: conversion_majuscule(unsigned char *chaine)
1846: {
1847: register unsigned char *caractere_courant;
1848: register unsigned char *caractere_courant_converti;
1849: register unsigned char *chaine_convertie;
1850:
1.58 bertrand 1851: integer8 longueur_chaine_plus_terminaison;
1.1 bertrand 1852:
1853: longueur_chaine_plus_terminaison = 0;
1854: caractere_courant = chaine;
1855:
1856: while((*caractere_courant) != d_code_fin_chaine)
1857: {
1858: caractere_courant++;
1859: longueur_chaine_plus_terminaison++;
1860: }
1861:
1862: caractere_courant = chaine;
1863: caractere_courant_converti = chaine_convertie = (unsigned char *) malloc(
1.59 bertrand 1864: ((size_t) (longueur_chaine_plus_terminaison + 1))
1865: * sizeof(unsigned char));
1.1 bertrand 1866:
1867: if (chaine_convertie != NULL)
1868: {
1869: while((*caractere_courant) != d_code_fin_chaine)
1870: {
1871: if (isalpha((*caractere_courant)))
1872: {
1873: (*caractere_courant_converti) = (unsigned char)
1874: toupper((*caractere_courant));
1875: }
1876: else
1877: {
1878: (*caractere_courant_converti) = (*caractere_courant);
1879: }
1880:
1881: caractere_courant++;
1882: caractere_courant_converti++;
1883: }
1884:
1885: (*caractere_courant_converti) = d_code_fin_chaine;
1886: }
1887:
1888: return(chaine_convertie);
1889: }
1890:
1.9 bertrand 1891: void
1892: conversion_majuscule_limitee(unsigned char *chaine_entree,
1.57 bertrand 1893: unsigned char *chaine_sortie, integer8 longueur)
1.9 bertrand 1894: {
1.57 bertrand 1895: integer8 i;
1.9 bertrand 1896:
1897: for(i = 0; i < longueur; i++)
1898: {
1899: if (isalpha((*chaine_entree)))
1900: {
1901: (*chaine_sortie) = (unsigned char) toupper((*chaine_entree));
1902: }
1903: else
1904: {
1905: (*chaine_sortie) = (*chaine_entree);
1906: }
1907:
1908: if ((*chaine_entree) == d_code_fin_chaine)
1909: {
1910: break;
1911: }
1912:
1913: chaine_entree++;
1914: chaine_sortie++;
1915: }
1916:
1917: return;
1918: }
1919:
1.1 bertrand 1920:
1921: /*
1922: ================================================================================
1923: Initialisation de l'état du calculateur
1924: Configuration par défaut d'un calculateur HP-28S
1925: ================================================================================
1926: Entrée : pointeur sur la structure struct_processus
1927: --------------------------------------------------------------------------------
1928: Sortie : néant
1929: --------------------------------------------------------------------------------
1930: Effets de bord : néant
1931: ================================================================================
1932: */
1933:
1934: void
1935: initialisation_drapeaux(struct_processus *s_etat_processus)
1936: {
1937: unsigned long i;
1938:
1.57 bertrand 1939: for(i = 0; i < 31; cf(s_etat_processus, (unsigned char) i++));
1.1 bertrand 1940:
1941: if ((*s_etat_processus).lancement_interactif == d_vrai)
1942: {
1943: sf(s_etat_processus, 31);
1944: /* LAST autorisé */
1945: }
1946: else
1947: {
1948: cf(s_etat_processus, 31);
1949: /* LAST invalidé */
1950: }
1951:
1952: cf(s_etat_processus, 32); /* Impression automatique */
1953: cf(s_etat_processus, 33); /* CR automatique (disp) */
1.23 bertrand 1954: sf(s_etat_processus, 34); /* Évaluation des caractères de contrôle */
1955: sf(s_etat_processus, 35); /* Évaluation symbolique des constantes */
1956: sf(s_etat_processus, 36); /* Évaluation symbolique des fonctions */
1.1 bertrand 1957: sf(s_etat_processus, 37); /* Taille de mot pour les entiers binaires */
1958: sf(s_etat_processus, 38); /* Taille de mot pour les entiers binaires */
1959: sf(s_etat_processus, 39); /* Taille de mot pour les entiers binaires */
1960: sf(s_etat_processus, 40); /* Taille de mot pour les entiers binaires */
1961: sf(s_etat_processus, 41); /* Taille de mot pour les entiers binaires */
1962: sf(s_etat_processus, 42); /* Taille de mot pour les entiers binaires */
1963: /*
1964: 37 : bit de poids faible
1965: 42 : bit de poids fort
1966: Les six drapeaux peuvent être nuls. Dans ce cas, la longueur des mots
1967: binaires reste de un bit.
1968: */
1969: cf(s_etat_processus, 43); /* Base de numération binaire */
1970: cf(s_etat_processus, 44); /* Base de numération binaire */
1971: /*
1972: 43 44 = 00 => décimal
1973: 43 44 = 01 => binaire
1974: 43 44 = 10 => octal
1975: 43 44 = 11 => hexadécimal
1976: */
1977: sf(s_etat_processus, 45); /* Affichage multiligne du niveau 1 */
1978: cf(s_etat_processus, 46); /* Réservé */
1979: cf(s_etat_processus, 47); /* Réservé */
1980: /*
1981: 46 et 47 réservés sur le calculateur HP28S
1982: 46 47 = 00 => système rectangulaire
1983: 46 47 = 01 => système cylindrique
1984: 46 47 = 10 => système sphérique
1985: */
1986: cf(s_etat_processus, 48); /* Séparateur décimal */
1987: cf(s_etat_processus, 49); /* Format des nombres réels */
1988: cf(s_etat_processus, 50); /* Format des nombres réels */
1989: /*
1990: 49 50 = 00 => standard
1991: 49 50 = 01 => scientifique
1992: 49 50 = 10 => virgule fixe
1993: 49 50 = 11 => ingénieur
1994: */
1995: cf(s_etat_processus, 51); /* Tonalité */
1996: cf(s_etat_processus, 52); /* REDRAW automatique */
1997: cf(s_etat_processus, 53); /* Nombre de chiffres décimaux */
1998: cf(s_etat_processus, 54); /* Nombre de chiffres décimaux */
1999: cf(s_etat_processus, 55); /* Nombre de chiffres décimaux */
2000: cf(s_etat_processus, 56); /* Nombre de chiffres décimaux */
2001: /*
2002: 53 : bit de poids faible
2003: 56 : bit de poids fort
2004: */
2005: cf(s_etat_processus, 57); /* Underflow traité normalement */
2006: cf(s_etat_processus, 58); /* Overflow traité normalement */
2007: sf(s_etat_processus, 59); /* Infinite result traité normalement */
2008: sf(s_etat_processus, 60); /* Angles */
2009: /*
2010: 60 = 0 => degrés
2011: 60 = 1 => radians
2012: */
2013: cf(s_etat_processus, 61); /* Underflow- traité en exception */
2014: cf(s_etat_processus, 62); /* Underflow+ traité en exception */
2015: cf(s_etat_processus, 63); /* Overflow traité en exception */
2016: cf(s_etat_processus, 64); /* Infinite result traité en exception */
2017: }
2018:
2019: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>