1: /*
2: ================================================================================
3: RPL/2 (R) version 4.1.20
4: Copyright (C) 1989-2015 Dr. BERTRAND Joël
5:
6: This file is part of RPL/2.
7:
8: RPL/2 is free software; you can redistribute it and/or modify it
9: under the terms of the CeCILL V2 License as published by the french
10: CEA, CNRS and INRIA.
11:
12: RPL/2 is distributed in the hope that it will be useful, but WITHOUT
13: ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14: FITNESS FOR A PARTICULAR PURPOSE. See the CeCILL V2 License
15: for more details.
16:
17: You should have received a copy of the CeCILL License
18: along with RPL/2. If not, write to info@cecill.info.
19: ================================================================================
20: */
21:
22:
23: #include "rpl-conv.h"
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:
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;
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;
260: definition = (unsigned char *) malloc(((size_t)
261: (position_fin_nom_definition -
262: position_debut_nom_definition + 2)) *
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: 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:
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: {
302: free(s_variable);
303:
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:
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 *
383: empilement_analyse(struct_processus *s_etat_processus,
384: struct_pile_analyse *ancienne_base,
385: enum t_condition condition)
386: {
387: struct_pile_analyse *nouvelle_base;
388:
389: if ((nouvelle_base = malloc(sizeof(struct_pile_analyse))) == NULL)
390: {
391: return(NULL);
392: }
393:
394: (*nouvelle_base).suivant = ancienne_base;
395: (*nouvelle_base).condition = condition;
396:
397: return(nouvelle_base);
398: }
399:
400: static inline struct_pile_analyse *
401: depilement_analyse(struct_processus *s_etat_processus,
402: struct_pile_analyse *ancienne_base)
403: {
404: struct_pile_analyse *nouvelle_base;
405:
406: if (ancienne_base == NULL)
407: {
408: return(NULL);
409: }
410:
411: nouvelle_base = (*ancienne_base).suivant;
412: free(ancienne_base);
413:
414: return(nouvelle_base);
415: }
416:
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);
423: }
424:
425: return(((*l_base_pile).condition == condition) ? d_vrai : d_faux);
426: }
427:
428: static inline void
429: liberation_analyse(struct_processus *s_etat_processus,
430: struct_pile_analyse *l_base_pile)
431: {
432: struct_pile_analyse *l_nouvelle_base_pile;
433:
434: while(l_base_pile != NULL)
435: {
436: l_nouvelle_base_pile = (*l_base_pile).suivant;
437: free(l_base_pile);
438: l_base_pile = l_nouvelle_base_pile;
439: }
440:
441: return;
442: }
443:
444: logical1
445: analyse_syntaxique(struct_processus *s_etat_processus)
446: {
447: unsigned char *instruction;
448: unsigned char registre;
449:
450: struct_pile_analyse *l_base_pile;
451: struct_pile_analyse *l_nouvelle_base_pile;
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: {
487: liberation_analyse(s_etat_processus, l_base_pile);
488:
489: (*s_etat_processus).autorisation_empilement_programme = registre;
490: return(d_erreur);
491: }
492:
493: if ((instruction = conversion_majuscule(s_etat_processus,
494: (*s_etat_processus).instruction_courante)) == NULL)
495: {
496: liberation_analyse(s_etat_processus, l_base_pile);
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: {
505: if ((l_nouvelle_base_pile = empilement_analyse(s_etat_processus,
506: l_base_pile, AN_IF)) == NULL)
507: {
508: liberation_analyse(s_etat_processus, l_base_pile);
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: {
519: if ((l_nouvelle_base_pile = empilement_analyse(s_etat_processus,
520: l_base_pile, AN_IFERR)) == NULL)
521: {
522: liberation_analyse(s_etat_processus, l_base_pile);
523:
524: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
525: return(d_erreur);
526: }
527:
528: l_base_pile = l_nouvelle_base_pile;
529: }
530: else if (strcmp(instruction, "CRITICAL") == 0)
531: {
532: if ((l_nouvelle_base_pile = empilement_analyse(s_etat_processus,
533: l_base_pile, AN_CRITICAL)) == NULL)
534: {
535: liberation_analyse(s_etat_processus, l_base_pile);
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: }
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: {
550: liberation_analyse(s_etat_processus, l_base_pile);
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: {
566: liberation_analyse(s_etat_processus, l_base_pile);
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: {
582: liberation_analyse(s_etat_processus, l_base_pile);
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) &&
601: (test_analyse(l_base_pile, AN_CRITICAL) == d_faux) &&
602: (test_analyse(l_base_pile, AN_ELSE) == d_faux))
603: {
604: liberation_analyse(s_etat_processus, l_base_pile);
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:
614: l_base_pile = depilement_analyse(s_etat_processus, l_base_pile);
615: }
616: else if (strcmp(instruction, "DO") == 0)
617: {
618: if ((l_nouvelle_base_pile = empilement_analyse(s_etat_processus,
619: l_base_pile, AN_DO)) == NULL)
620: {
621: liberation_analyse(s_etat_processus, l_base_pile);
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: {
633: liberation_analyse(s_etat_processus, l_base_pile);
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: {
647: if ((l_nouvelle_base_pile = empilement_analyse(s_etat_processus,
648: l_base_pile, AN_WHILE)) == NULL)
649: {
650: liberation_analyse(s_etat_processus, l_base_pile);
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: {
662: liberation_analyse(s_etat_processus, l_base_pile);
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: {
676: if ((l_nouvelle_base_pile = empilement_analyse(s_etat_processus,
677: l_base_pile, AN_SELECT)) == NULL)
678: {
679: liberation_analyse(s_etat_processus, l_base_pile);
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: {
691: liberation_analyse(s_etat_processus, l_base_pile);
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:
701: if ((l_nouvelle_base_pile = empilement_analyse(s_etat_processus,
702: l_base_pile, AN_CASE)) == NULL)
703: {
704: liberation_analyse(s_etat_processus, l_base_pile);
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: {
716: liberation_analyse(s_etat_processus, l_base_pile);
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: {
730: if ((l_nouvelle_base_pile = empilement_analyse(s_etat_processus,
731: l_base_pile, AN_UP)) == NULL)
732: {
733: liberation_analyse(s_etat_processus, l_base_pile);
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: {
745: liberation_analyse(s_etat_processus, l_base_pile);
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:
755: l_base_pile = depilement_analyse(s_etat_processus, l_base_pile);
756: }
757: else if (strcmp(instruction, "FOR") == 0)
758: {
759: if ((l_nouvelle_base_pile = empilement_analyse(s_etat_processus,
760: l_base_pile, AN_FOR)) == NULL)
761: {
762: liberation_analyse(s_etat_processus, l_base_pile);
763:
764: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
765: return(d_erreur);
766: }
767:
768: l_base_pile = l_nouvelle_base_pile;
769: }
770: else if (strcmp(instruction, "START") == 0)
771: {
772: if ((l_nouvelle_base_pile = empilement_analyse(s_etat_processus,
773: l_base_pile, AN_START)) == NULL)
774: {
775: liberation_analyse(s_etat_processus, l_base_pile);
776:
777: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
778: return(d_erreur);
779: }
780:
781: l_base_pile = l_nouvelle_base_pile;
782: }
783: else if (strcmp(instruction, "FORALL") == 0)
784: {
785: if ((l_nouvelle_base_pile = empilement_analyse(s_etat_processus,
786: l_base_pile, AN_FORALL)) == NULL)
787: {
788: liberation_analyse(s_etat_processus, l_base_pile);
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: }
796: else if (strcmp(instruction, "NEXT") == 0)
797: {
798: if ((test_analyse(l_base_pile, AN_FOR) == d_faux) &&
799: (test_analyse(l_base_pile, AN_FORALL) == d_faux) &&
800: (test_analyse(l_base_pile, AN_START) == d_faux))
801: {
802: liberation_analyse(s_etat_processus, l_base_pile);
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:
812: l_base_pile = depilement_analyse(s_etat_processus, l_base_pile);
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: {
819: liberation_analyse(s_etat_processus, l_base_pile);
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:
829: l_base_pile = depilement_analyse(s_etat_processus, l_base_pile);
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: {
842: liberation_analyse(s_etat_processus, l_base_pile);
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
868: swap(void *variable_1, void *variable_2, integer8 taille)
869: {
870: register unsigned char *t_var_1;
871: register unsigned char *t_var_2;
872: register unsigned char variable_temporaire;
873:
874: register integer8 i;
875:
876: t_var_1 = (unsigned char *) variable_1;
877: t_var_2 = (unsigned char *) variable_2;
878:
879: for(i = 0; i < taille; i++)
880: {
881: variable_temporaire = (*t_var_1);
882: (*(t_var_1++)) = (*t_var_2);
883: (*(t_var_2++)) = variable_temporaire;
884: }
885:
886: return;
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: {
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: {
912: enum t_type registre_type_en_cours;
913:
914: logical1 drapeau_fin_objet;
915: logical1 erreur;
916:
917: int erreur_analyse;
918: int erreur_format;
919:
920: unsigned char base_binaire;
921: unsigned char caractere_fin;
922: unsigned char *pointeur_caractere_courant;
923: unsigned char *pointeur_caractere_destination;
924: unsigned char *pointeur_debut_instruction;
925: unsigned char *pointeur_fin_instruction;
926:
927: signed long niveau;
928:
929: erreur_analyse = d_ex;
930: erreur_format = d_ex;
931: erreur = d_absence_erreur;
932:
933: switch((*s_etat_processus).type_en_cours)
934: {
935: case RPN:
936: {
937: caractere_fin = '>';
938: break;
939: }
940:
941: case LST:
942: {
943: caractere_fin = '}';
944: break;
945: }
946:
947: case TBL:
948: {
949: caractere_fin = ']';
950: break;
951: }
952:
953: default:
954: {
955: caractere_fin = d_code_espace;
956: break;
957: }
958: }
959:
960: drapeau_fin_objet = d_faux;
961: niveau = 0;
962:
963: pointeur_caractere_courant = (*s_etat_processus).definitions_chainees +
964: (*s_etat_processus).position_courante;
965:
966: while(((*pointeur_caractere_courant) == d_code_espace) &&
967: ((*pointeur_caractere_courant) != d_code_fin_chaine))
968: {
969: pointeur_caractere_courant++;
970: }
971:
972: if ((*pointeur_caractere_courant) == d_code_fin_chaine)
973: {
974: (*s_etat_processus).instruction_courante = (unsigned char *)
975: malloc(sizeof(unsigned char));
976:
977: if ((*s_etat_processus).instruction_courante == NULL)
978: {
979: erreur = d_erreur;
980: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
981: }
982: else
983: {
984: erreur = d_absence_erreur;
985: (*(*s_etat_processus).instruction_courante) = d_code_fin_chaine;
986: (*s_etat_processus).position_courante = pointeur_caractere_courant
987: - (*s_etat_processus).definitions_chainees;
988: }
989:
990: return(erreur);
991: }
992:
993: pointeur_debut_instruction = pointeur_caractere_courant;
994:
995: while(((*pointeur_caractere_courant) != d_code_espace) &&
996: ((*pointeur_caractere_courant) != d_code_fin_chaine) &&
997: (drapeau_fin_objet == d_faux) &&
998: (erreur_analyse == d_ex) && (erreur_format == d_ex))
999: {
1000: uprintf("%c", *pointeur_caractere_courant);
1001: switch(*pointeur_caractere_courant++)
1002: {
1003: case ']' :
1004: case '}' :
1005: {
1006: break;
1007: }
1008:
1009: case ')' :
1010: {
1011: erreur_format = d_ex_syntaxe;
1012: break;
1013: }
1014:
1015: case '"' :
1016: {
1017: if (pointeur_debut_instruction !=
1018: (pointeur_caractere_courant - 1))
1019: {
1020: erreur_format = d_ex_syntaxe;
1021: }
1022:
1023: while((*pointeur_caractere_courant != '"') &&
1024: ((*pointeur_caractere_courant) != d_code_fin_chaine))
1025: {
1026: if (*pointeur_caractere_courant == '\\')
1027: {
1028: pointeur_caractere_courant++;
1029:
1030: switch(*pointeur_caractere_courant)
1031: {
1032: case '\\' :
1033: case '"' :
1034: {
1035: pointeur_caractere_courant++;
1036: break;
1037: }
1038: }
1039: }
1040: else
1041: {
1042: pointeur_caractere_courant++;
1043: }
1044: }
1045:
1046: if ((*pointeur_caractere_courant) != '"')
1047: {
1048: erreur_analyse = d_ex_syntaxe;
1049: }
1050:
1051: if (erreur_analyse == d_ex)
1052: {
1053: pointeur_caractere_courant++;
1054: }
1055:
1056: drapeau_fin_objet = d_vrai;
1057: break;
1058: }
1059:
1060: case '\'' :
1061: {
1062: if (pointeur_debut_instruction !=
1063: (pointeur_caractere_courant - 1))
1064: {
1065: erreur_format = d_ex_syntaxe;
1066: }
1067:
1068: while(((*pointeur_caractere_courant) != '\'') &&
1069: ((*pointeur_caractere_courant) != d_code_fin_chaine))
1070: {
1071: if ((*pointeur_caractere_courant) == '(')
1072: {
1073: niveau++;
1074: }
1075: else if ((*pointeur_caractere_courant) == ')')
1076: {
1077: niveau--;
1078: }
1079:
1080: pointeur_caractere_courant++;
1081: }
1082:
1083: if ((*pointeur_caractere_courant) != '\'')
1084: {
1085: erreur_analyse = d_ex_syntaxe;
1086: }
1087: else if (niveau != 0)
1088: {
1089: erreur_analyse = d_ex_syntaxe;
1090: }
1091:
1092: if (erreur_analyse == d_ex)
1093: {
1094: pointeur_caractere_courant++;
1095: }
1096:
1097: drapeau_fin_objet = d_vrai;
1098: break;
1099: }
1100:
1101: case '(' :
1102: {
1103: if (pointeur_debut_instruction !=
1104: (pointeur_caractere_courant - 1))
1105: {
1106: erreur_format = d_ex_syntaxe;
1107: }
1108:
1109: while(((*pointeur_caractere_courant) != ')') &&
1110: ((*pointeur_caractere_courant) != d_code_fin_chaine)
1111: && (erreur_analyse == d_ex))
1112: {
1113: switch(*pointeur_caractere_courant)
1114: {
1115: case '0' :
1116: case '1' :
1117: case '2' :
1118: case '3' :
1119: case '4' :
1120: case '5' :
1121: case '6' :
1122: case '7' :
1123: case '8' :
1124: case '9' :
1125: case 'e' :
1126: case 'E' :
1127: case ',' :
1128: case '.' :
1129: case ' ' :
1130: case '-' :
1131: case '+' :
1132: case ')' :
1133: {
1134: break;
1135: }
1136:
1137: default :
1138: {
1139: erreur_analyse = d_ex_syntaxe;
1140: break;
1141: }
1142: }
1143:
1144: pointeur_caractere_courant++;
1145: }
1146:
1147: if ((*pointeur_caractere_courant) != ')')
1148: {
1149: erreur_analyse = d_ex_syntaxe;
1150: }
1151:
1152: if (erreur_analyse == d_ex)
1153: {
1154: pointeur_caractere_courant++;
1155: }
1156:
1157: drapeau_fin_objet = d_vrai;
1158: break;
1159: }
1160:
1161: case '#' :
1162: {
1163: if (pointeur_debut_instruction !=
1164: (pointeur_caractere_courant - 1))
1165: {
1166: erreur_format = d_ex_syntaxe;
1167: }
1168:
1169: while(((*pointeur_caractere_courant) != 'b') &&
1170: ((*pointeur_caractere_courant) != 'o') &&
1171: ((*pointeur_caractere_courant) != 'd') &&
1172: ((*pointeur_caractere_courant) != 'h') &&
1173: ((*pointeur_caractere_courant) !=
1174: d_code_fin_chaine) &&
1175: (erreur_analyse == d_ex))
1176: {
1177: switch(*pointeur_caractere_courant)
1178: {
1179: case ' ' :
1180: case '0' :
1181: case '1' :
1182: case '2' :
1183: case '3' :
1184: case '4' :
1185: case '5' :
1186: case '6' :
1187: case '7' :
1188: case '8' :
1189: case '9' :
1190: case 'A' :
1191: case 'B' :
1192: case 'C' :
1193: case 'D' :
1194: case 'E' :
1195: case 'F' :
1196: case 'b' :
1197: case 'o' :
1198: case 'd' :
1199: case 'h' :
1200: {
1201: break;
1202: }
1203:
1204: default :
1205: {
1206: erreur_analyse = d_ex_syntaxe;
1207: break;
1208: }
1209: }
1210:
1211: pointeur_caractere_courant++;
1212: }
1213:
1214: base_binaire = (*pointeur_caractere_courant);
1215: pointeur_caractere_courant++;
1216:
1217: if (((*pointeur_caractere_courant) != d_code_fin_chaine) &&
1218: ((*pointeur_caractere_courant) != d_code_espace) &&
1219: ((*pointeur_caractere_courant) != caractere_fin))
1220: {
1221: erreur_analyse = d_ex_syntaxe;
1222: }
1223: else
1224: {
1225: pointeur_caractere_courant = pointeur_debut_instruction + 1;
1226:
1227: switch(base_binaire)
1228: {
1229: case 'b' :
1230: case 'o' :
1231: case 'd' :
1232: case 'h' :
1233: {
1234: break;
1235: }
1236:
1237: default :
1238: {
1239: erreur_analyse = d_ex_syntaxe;
1240: break;
1241: }
1242: }
1243: }
1244:
1245: while(((*pointeur_caractere_courant) != base_binaire) &&
1246: ((*pointeur_caractere_courant) != d_code_fin_chaine) &&
1247: (erreur_analyse == d_ex))
1248: {
1249: if (base_binaire == 'b')
1250: {
1251: switch(*pointeur_caractere_courant)
1252: {
1253: case ' ' :
1254: case '0' :
1255: case '1' :
1256: {
1257: break;
1258: }
1259:
1260: default :
1261: {
1262: erreur_analyse = d_ex_syntaxe;
1263: break;
1264: }
1265: }
1266: }
1267: else if (base_binaire == 'o')
1268: {
1269: switch(*pointeur_caractere_courant)
1270: {
1271: case ' ' :
1272: case '0' :
1273: case '1' :
1274: case '2' :
1275: case '3' :
1276: case '4' :
1277: case '5' :
1278: case '6' :
1279: case '7' :
1280: {
1281: break;
1282: }
1283:
1284: default :
1285: {
1286: erreur_analyse = d_ex_syntaxe;
1287: break;
1288: }
1289: }
1290: }
1291: else if (base_binaire == 'd')
1292: {
1293: switch(*pointeur_caractere_courant)
1294: {
1295: case ' ' :
1296: case '0' :
1297: case '1' :
1298: case '2' :
1299: case '3' :
1300: case '4' :
1301: case '5' :
1302: case '6' :
1303: case '7' :
1304: case '8' :
1305: case '9' :
1306: {
1307: break;
1308: }
1309:
1310: default :
1311: {
1312: erreur_analyse = d_ex_syntaxe;
1313: break;
1314: }
1315: }
1316: }
1317: else if (base_binaire != 'h')
1318: {
1319: erreur_analyse = d_ex_syntaxe;
1320: }
1321:
1322: pointeur_caractere_courant++;
1323: }
1324:
1325: if (erreur_analyse == d_ex)
1326: {
1327: pointeur_caractere_courant++;
1328: }
1329:
1330: drapeau_fin_objet = d_vrai;
1331: break;
1332: }
1333:
1334: case '{' :
1335: {
1336: if (pointeur_debut_instruction !=
1337: (pointeur_caractere_courant - 1))
1338: {
1339: erreur_format = d_ex_syntaxe;
1340: }
1341:
1342: niveau = 1;
1343:
1344: while((niveau != 0) && ((*pointeur_caractere_courant) !=
1345: d_code_fin_chaine))
1346: {
1347: (*s_etat_processus).position_courante =
1348: pointeur_caractere_courant
1349: - (*s_etat_processus).definitions_chainees;
1350:
1351: registre_type_en_cours = (*s_etat_processus).type_en_cours;
1352: (*s_etat_processus).type_en_cours = LST;
1353:
1354: if (recherche_instruction_suivante_recursive(
1355: s_etat_processus, recursivite + 1) == d_erreur)
1356: {
1357: (*s_etat_processus).type_en_cours =
1358: registre_type_en_cours;
1359:
1360: if ((*s_etat_processus).instruction_courante
1361: != NULL)
1362: {
1363: free((*s_etat_processus).instruction_courante);
1364: (*s_etat_processus).instruction_courante = NULL;
1365: }
1366:
1367: return(d_erreur);
1368: }
1369:
1370: (*s_etat_processus).type_en_cours = registre_type_en_cours;
1371: pointeur_caractere_courant =
1372: (*s_etat_processus).definitions_chainees +
1373: (*s_etat_processus).position_courante;
1374:
1375: if (strcmp((*s_etat_processus).instruction_courante, "}")
1376: == 0)
1377: {
1378: niveau--;
1379: }
1380:
1381: free((*s_etat_processus).instruction_courante);
1382: }
1383:
1384: if (niveau != 0)
1385: {
1386: erreur_analyse = d_ex_syntaxe;
1387: }
1388:
1389: drapeau_fin_objet = d_vrai;
1390: break;
1391: }
1392:
1393: case '[' :
1394: {
1395: if (pointeur_debut_instruction !=
1396: (pointeur_caractere_courant - 1))
1397: {
1398: erreur_format = d_ex_syntaxe;
1399: }
1400:
1401: niveau = 1;
1402:
1403: while((niveau > 0) && ((*pointeur_caractere_courant) !=
1404: d_code_fin_chaine) && (erreur_analyse == d_ex))
1405: {
1406: switch(*pointeur_caractere_courant)
1407: {
1408: case '[' :
1409: {
1410: niveau++;
1411: break;
1412: }
1413:
1414: case ']' :
1415: {
1416: niveau--;
1417: break;
1418: }
1419:
1420: case '0' :
1421: case '1' :
1422: case '2' :
1423: case '3' :
1424: case '4' :
1425: case '5' :
1426: case '6' :
1427: case '7' :
1428: case '8' :
1429: case '9' :
1430: case '+' :
1431: case '-' :
1432: case 'e' :
1433: case 'E' :
1434: case '.' :
1435: case ',' :
1436: case '(' :
1437: case ')' :
1438: case ' ' :
1439: {
1440: break;
1441: }
1442:
1443: default :
1444: {
1445: erreur_analyse = d_ex_syntaxe;
1446: break;
1447: }
1448: }
1449:
1450: if (niveau < 0)
1451: {
1452: erreur_analyse = d_ex_syntaxe;
1453: }
1454: else if (niveau > 2)
1455: {
1456: erreur_format = d_ex_syntaxe;
1457: }
1458:
1459: pointeur_caractere_courant++;
1460: }
1461:
1462: if (niveau != 0)
1463: {
1464: erreur_analyse = d_ex_syntaxe;
1465: }
1466:
1467: drapeau_fin_objet = d_vrai;
1468: break;
1469: }
1470:
1471: case '<' :
1472: {
1473: if (((*s_etat_processus).autorisation_empilement_programme
1474: == 'Y') && ((*pointeur_caractere_courant) == '<'))
1475: { // Cas << >>
1476: if (pointeur_debut_instruction !=
1477: (pointeur_caractere_courant - 1))
1478: {
1479: erreur_format = d_ex_syntaxe;
1480: }
1481:
1482: pointeur_caractere_courant++;
1483: drapeau_fin_objet = d_faux;
1484:
1485: while(((*pointeur_caractere_courant) != d_code_fin_chaine)
1486: && (erreur_format == d_absence_erreur))
1487: {
1488: while((*pointeur_caractere_courant) == d_code_espace)
1489: {
1490: pointeur_caractere_courant++;
1491: }
1492:
1493: if ((*pointeur_caractere_courant) == '>')
1494: {
1495: if ((*(++pointeur_caractere_courant)) == '>')
1496: {
1497: drapeau_fin_objet = d_vrai;
1498: }
1499: else
1500: {
1501: erreur_analyse = d_ex_syntaxe;
1502: }
1503:
1504: pointeur_caractere_courant++;
1505: break;
1506: }
1507:
1508: if ((erreur_format == d_absence_erreur) &&
1509: (drapeau_fin_objet == d_faux))
1510: {
1511: (*s_etat_processus).position_courante =
1512: pointeur_caractere_courant
1513: - (*s_etat_processus).definitions_chainees;
1514:
1515: registre_type_en_cours = (*s_etat_processus)
1516: .type_en_cours;
1517: (*s_etat_processus).type_en_cours = RPN;
1518:
1519: if ((erreur =
1520: recherche_instruction_suivante_recursive(
1521: s_etat_processus, recursivite + 1))
1522: != d_absence_erreur)
1523: {
1524: (*s_etat_processus).type_en_cours =
1525: registre_type_en_cours;
1526:
1527: if ((*s_etat_processus).instruction_courante
1528: != NULL)
1529: {
1530: free((*s_etat_processus)
1531: .instruction_courante);
1532: (*s_etat_processus).instruction_courante
1533: = NULL;
1534: }
1535:
1536: return(d_erreur);
1537: }
1538:
1539: (*s_etat_processus).type_en_cours =
1540: registre_type_en_cours;
1541: pointeur_caractere_courant = (*s_etat_processus)
1542: .definitions_chainees + (*s_etat_processus)
1543: .position_courante;
1544:
1545: free((*s_etat_processus).instruction_courante);
1546: }
1547: }
1548:
1549: if (drapeau_fin_objet == d_faux)
1550: {
1551: erreur_analyse = d_ex_syntaxe;
1552: drapeau_fin_objet = d_vrai;
1553: }
1554: }
1555: else if ((*pointeur_caractere_courant) == '[')
1556: { // Cas <[ ]>
1557: if (pointeur_debut_instruction !=
1558: (pointeur_caractere_courant - 1))
1559: {
1560: erreur_format = d_ex_syntaxe;
1561: }
1562:
1563: pointeur_caractere_courant++;
1564: drapeau_fin_objet = d_faux;
1565:
1566: while(((*pointeur_caractere_courant) != d_code_fin_chaine)
1567: && (erreur_format == d_absence_erreur))
1568: {
1569: while((*pointeur_caractere_courant) == d_code_espace)
1570: {
1571: pointeur_caractere_courant++;
1572: }
1573:
1574: if ((*pointeur_caractere_courant) == ']')
1575: {
1576: if ((*(++pointeur_caractere_courant)) == '>')
1577: {
1578: drapeau_fin_objet = d_vrai;
1579: }
1580: else
1581: {
1582: erreur_analyse = d_ex_syntaxe;
1583: }
1584:
1585: pointeur_caractere_courant++;
1586: break;
1587: }
1588:
1589: if ((erreur_format == d_absence_erreur) &&
1590: (drapeau_fin_objet == d_faux))
1591: {
1592: (*s_etat_processus).position_courante =
1593: pointeur_caractere_courant
1594: - (*s_etat_processus).definitions_chainees;
1595:
1596: registre_type_en_cours = (*s_etat_processus)
1597: .type_en_cours;
1598: (*s_etat_processus).type_en_cours = TBL;
1599:
1600: if ((erreur =
1601: recherche_instruction_suivante_recursive(
1602: s_etat_processus, recursivite + 1))
1603: != d_absence_erreur)
1604: {
1605: (*s_etat_processus).type_en_cours =
1606: registre_type_en_cours;
1607:
1608: if ((*s_etat_processus).instruction_courante
1609: != NULL)
1610: {
1611: free((*s_etat_processus)
1612: .instruction_courante);
1613: (*s_etat_processus).instruction_courante
1614: = NULL;
1615: }
1616:
1617: return(d_erreur);
1618: }
1619:
1620: (*s_etat_processus).type_en_cours =
1621: registre_type_en_cours;
1622: pointeur_caractere_courant = (*s_etat_processus)
1623: .definitions_chainees + (*s_etat_processus)
1624: .position_courante;
1625:
1626: free((*s_etat_processus).instruction_courante);
1627: }
1628: }
1629:
1630: if (drapeau_fin_objet == d_faux)
1631: {
1632: erreur_analyse = d_ex_syntaxe;
1633: drapeau_fin_objet = d_vrai;
1634: }
1635: }
1636:
1637: break;
1638: }
1639: }
1640:
1641: if ((*(pointeur_caractere_courant - 1)) == caractere_fin)
1642: {
1643: uprintf(" > cas 1");
1644: // Cas des objets composites (LST, RPN, TBL)
1645: break;
1646: }
1647: else if ((*pointeur_caractere_courant) == caractere_fin)
1648: {
1649: uprintf(" > cas 2");
1650: // Condition pour traiter les cas 123}
1651: break;
1652: }
1653: }
1654: uprintf("\n");
1655:
1656: pointeur_fin_instruction = pointeur_caractere_courant;
1657:
1658: if (recursivite == 0)
1659: {
1660: // Si la variable récursivité est nulle, il faut que le caractère
1661: // suivant l'objet soit un espace ou une fin de chaîne. Si ce n'est pas
1662: // le cas, il faut retourner une erreur car les objets de type
1663: // [[ 1 4 ]]3 doivent être invalides.
1664:
1665: switch((*pointeur_fin_instruction))
1666: {
1667: case d_code_fin_chaine:
1668: case d_code_espace:
1669: {
1670: break;
1671: }
1672:
1673: default:
1674: {
1675: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
1676: // return(d_erreur);
1677: }
1678: }
1679: }
1680:
1681: (*s_etat_processus).instruction_courante = (unsigned char *)
1682: malloc((((size_t) (pointeur_fin_instruction
1683: - pointeur_debut_instruction)) + 1) * sizeof(unsigned char));
1684:
1685: if ((*s_etat_processus).instruction_courante == NULL)
1686: {
1687: erreur = d_erreur;
1688: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1689: }
1690: else if (pointeur_fin_instruction != pointeur_debut_instruction)
1691: {
1692: pointeur_caractere_courant = pointeur_debut_instruction;
1693: pointeur_caractere_destination =
1694: (*s_etat_processus).instruction_courante;
1695:
1696: do
1697: {
1698: *pointeur_caractere_destination++ = *pointeur_caractere_courant++;
1699: } while(pointeur_caractere_courant < pointeur_fin_instruction);
1700:
1701: (*pointeur_caractere_destination) = d_code_fin_chaine;
1702:
1703: erreur = ((erreur_analyse == d_ex) && (erreur_format == d_ex))
1704: ? d_absence_erreur : d_erreur;
1705: (*s_etat_processus).erreur_execution = erreur_analyse;
1706: }
1707: else
1708: {
1709: (*(*s_etat_processus).instruction_courante) = d_code_fin_chaine;
1710: }
1711:
1712: (*s_etat_processus).position_courante = pointeur_fin_instruction
1713: - (*s_etat_processus).definitions_chainees;
1714:
1715: uprintf("'%s'\n", (*s_etat_processus).instruction_courante);
1716: return(erreur);
1717: }
1718:
1719:
1720: /*
1721: ================================================================================
1722: Routine mettant la chaîne d'entrée en majuscule
1723: ================================================================================
1724: Entrée : pointeur sur une chaîne en minuscules.
1725: --------------------------------------------------------------------------------
1726: Sortie : pointeur sur la chaîne en majuscules. Si le pointeur retourné
1727: est nul, il s'est produit une erreur. L'allocation est faite dans la
1728: routine.
1729: --------------------------------------------------------------------------------
1730: Effets de bord : néant.
1731: ================================================================================
1732: */
1733:
1734: unsigned char *
1735: conversion_majuscule(struct_processus *s_etat_processus, unsigned char *chaine)
1736: {
1737: register unsigned char *caractere_courant;
1738: register unsigned char *caractere_courant_converti;
1739: register unsigned char *chaine_convertie;
1740:
1741: integer8 longueur_chaine_plus_terminaison;
1742:
1743: longueur_chaine_plus_terminaison = 0;
1744: caractere_courant = chaine;
1745:
1746: while((*caractere_courant) != d_code_fin_chaine)
1747: {
1748: caractere_courant++;
1749: longueur_chaine_plus_terminaison++;
1750: }
1751:
1752: caractere_courant = chaine;
1753: caractere_courant_converti = chaine_convertie = (unsigned char *) malloc(
1754: ((size_t) (longueur_chaine_plus_terminaison + 1))
1755: * sizeof(unsigned char));
1756:
1757: if (chaine_convertie != NULL)
1758: {
1759: while((*caractere_courant) != d_code_fin_chaine)
1760: {
1761: if (isalpha((*caractere_courant)))
1762: {
1763: (*caractere_courant_converti) = (unsigned char)
1764: toupper((*caractere_courant));
1765: }
1766: else
1767: {
1768: (*caractere_courant_converti) = (*caractere_courant);
1769: }
1770:
1771: caractere_courant++;
1772: caractere_courant_converti++;
1773: }
1774:
1775: (*caractere_courant_converti) = d_code_fin_chaine;
1776: }
1777:
1778: return(chaine_convertie);
1779: }
1780:
1781: void
1782: conversion_majuscule_limitee(unsigned char *chaine_entree,
1783: unsigned char *chaine_sortie, integer8 longueur)
1784: {
1785: integer8 i;
1786:
1787: for(i = 0; i < longueur; i++)
1788: {
1789: if (isalpha((*chaine_entree)))
1790: {
1791: (*chaine_sortie) = (unsigned char) toupper((*chaine_entree));
1792: }
1793: else
1794: {
1795: (*chaine_sortie) = (*chaine_entree);
1796: }
1797:
1798: if ((*chaine_entree) == d_code_fin_chaine)
1799: {
1800: break;
1801: }
1802:
1803: chaine_entree++;
1804: chaine_sortie++;
1805: }
1806:
1807: return;
1808: }
1809:
1810:
1811: /*
1812: ================================================================================
1813: Initialisation de l'état du calculateur
1814: Configuration par défaut d'un calculateur HP-28S
1815: ================================================================================
1816: Entrée : pointeur sur la structure struct_processus
1817: --------------------------------------------------------------------------------
1818: Sortie : néant
1819: --------------------------------------------------------------------------------
1820: Effets de bord : néant
1821: ================================================================================
1822: */
1823:
1824: void
1825: initialisation_drapeaux(struct_processus *s_etat_processus)
1826: {
1827: unsigned long i;
1828:
1829: for(i = 0; i < 31; cf(s_etat_processus, (unsigned char) i++));
1830:
1831: if ((*s_etat_processus).lancement_interactif == d_vrai)
1832: {
1833: sf(s_etat_processus, 31);
1834: /* LAST autorisé */
1835: }
1836: else
1837: {
1838: cf(s_etat_processus, 31);
1839: /* LAST invalidé */
1840: }
1841:
1842: cf(s_etat_processus, 32); /* Impression automatique */
1843: cf(s_etat_processus, 33); /* CR automatique (disp) */
1844: sf(s_etat_processus, 34); /* Évaluation des caractères de contrôle */
1845: sf(s_etat_processus, 35); /* Évaluation symbolique des constantes */
1846: sf(s_etat_processus, 36); /* Évaluation symbolique des fonctions */
1847: sf(s_etat_processus, 37); /* Taille de mot pour les entiers binaires */
1848: sf(s_etat_processus, 38); /* Taille de mot pour les entiers binaires */
1849: sf(s_etat_processus, 39); /* Taille de mot pour les entiers binaires */
1850: sf(s_etat_processus, 40); /* Taille de mot pour les entiers binaires */
1851: sf(s_etat_processus, 41); /* Taille de mot pour les entiers binaires */
1852: sf(s_etat_processus, 42); /* Taille de mot pour les entiers binaires */
1853: /*
1854: 37 : bit de poids faible
1855: 42 : bit de poids fort
1856: Les six drapeaux peuvent être nuls. Dans ce cas, la longueur des mots
1857: binaires reste de un bit.
1858: */
1859: cf(s_etat_processus, 43); /* Base de numération binaire */
1860: cf(s_etat_processus, 44); /* Base de numération binaire */
1861: /*
1862: 43 44 = 00 => décimal
1863: 43 44 = 01 => binaire
1864: 43 44 = 10 => octal
1865: 43 44 = 11 => hexadécimal
1866: */
1867: sf(s_etat_processus, 45); /* Affichage multiligne du niveau 1 */
1868: cf(s_etat_processus, 46); /* Réservé */
1869: cf(s_etat_processus, 47); /* Réservé */
1870: /*
1871: 46 et 47 réservés sur le calculateur HP28S
1872: 46 47 = 00 => système rectangulaire
1873: 46 47 = 01 => système cylindrique
1874: 46 47 = 10 => système sphérique
1875: */
1876: cf(s_etat_processus, 48); /* Séparateur décimal */
1877: cf(s_etat_processus, 49); /* Format des nombres réels */
1878: cf(s_etat_processus, 50); /* Format des nombres réels */
1879: /*
1880: 49 50 = 00 => standard
1881: 49 50 = 01 => scientifique
1882: 49 50 = 10 => virgule fixe
1883: 49 50 = 11 => ingénieur
1884: */
1885: cf(s_etat_processus, 51); /* Tonalité */
1886: cf(s_etat_processus, 52); /* REDRAW automatique */
1887: cf(s_etat_processus, 53); /* Nombre de chiffres décimaux */
1888: cf(s_etat_processus, 54); /* Nombre de chiffres décimaux */
1889: cf(s_etat_processus, 55); /* Nombre de chiffres décimaux */
1890: cf(s_etat_processus, 56); /* Nombre de chiffres décimaux */
1891: /*
1892: 53 : bit de poids faible
1893: 56 : bit de poids fort
1894: */
1895: cf(s_etat_processus, 57); /* Underflow traité normalement */
1896: cf(s_etat_processus, 58); /* Overflow traité normalement */
1897: sf(s_etat_processus, 59); /* Infinite result traité normalement */
1898: sf(s_etat_processus, 60); /* Angles */
1899: /*
1900: 60 = 0 => degrés
1901: 60 = 1 => radians
1902: */
1903: cf(s_etat_processus, 61); /* Underflow- traité en exception */
1904: cf(s_etat_processus, 62); /* Underflow+ traité en exception */
1905: cf(s_etat_processus, 63); /* Overflow traité en exception */
1906: cf(s_etat_processus, 64); /* Infinite result traité en exception */
1907: }
1908:
1909: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[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