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