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