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