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