File:  [local] / rpl / src / compilation.c
Revision 1.48: download - view: text, annotated - select for diffs - revision graph
Sat Sep 15 12:57:09 2012 UTC (11 years, 7 months ago) by bertrand
Branches: MAIN
CVS tags: HEAD
Ajout de l'instruction CRITICAL qui fonctionne comme un bloc
CRITICAL <expression> END.

    1: /*
    2: ================================================================================
    3:   RPL/2 (R) version 4.1.10
    4:   Copyright (C) 1989-2012 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:     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,
  367:                         AN_NEXT, AN_STEP, AN_CRITICAL };
  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:         }
  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:         }
  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) &&
  588:                     (test_analyse(l_base_pile, AN_CRITICAL) == d_faux) &&
  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: ================================================================================
  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: 
  839: static char                 *ligne = NULL;
  840: static unsigned int         niveau = 0;
  841: 
  842: int
  843: readline_analyse_syntaxique(int count, int key)
  844: {
  845:     char                        prompt[] = "+ %03d> ";
  846:     char                        prompt2[8];
  847:     char                        *registre;
  848: 
  849:     struct_processus            s_etat_processus;
  850: 
  851:     if ((*rl_line_buffer) == d_code_fin_chaine)
  852:     {
  853:         if (ligne == NULL)
  854:         {
  855:             rl_done = 1;
  856:         }
  857:         else
  858:         {
  859:             rl_done = 0;
  860:         }
  861:     }
  862:     else
  863:     {
  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)
  880:                     + strlen(rl_line_buffer) + 2) * sizeof(char))) == NULL)
  881:             {
  882:                 rl_done = 1;
  883:                 return(0);
  884:             }
  885: 
  886:             sprintf(ligne, "%s %s", registre, rl_line_buffer);
  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: 
  896:         if (analyse_syntaxique(&s_etat_processus) == d_absence_erreur)
  897:         {
  898:             rl_done = 1;
  899:         }
  900:         else
  901:         {
  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:             }
  916:         }
  917:     }
  918: 
  919:     if (rl_done != 0)
  920:     {
  921:         uprintf("\n");
  922: 
  923:         if (ligne != NULL)
  924:         {
  925:             rl_replace_line(ligne, 1);
  926: 
  927:             free(ligne);
  928:             ligne = NULL;
  929:         }
  930: 
  931:         niveau = 0;
  932:     }
  933: 
  934:     return(0);
  935: }
  936: 
  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: 
  947:     uprintf("^G\n");
  948:     rl_expand_prompt("RPL/2> ");
  949:     rl_on_new_line();
  950:     return(0);
  951: }
  952: 
  953: 
  954: /*
  955: ================================================================================
  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: 
  975:     register unsigned long      i;
  976: 
  977:     t_var_1 = (unsigned char *) variable_1;
  978:     t_var_2 = (unsigned char *) variable_2;
  979: 
  980:     for(i = 0; i < taille; i++)
  981:     {
  982:         variable_temporaire = (*t_var_1);
  983:         (*(t_var_1++)) = (*t_var_2);
  984:         (*(t_var_2++)) = variable_temporaire;
  985:     }
  986: 
  987:     return;
  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: 
 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: 
 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)                    */
 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      */
 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

CVSweb interface <joel.bertrand@systella.fr>