/* ================================================================================ RPL/2 (R) version 4.1.7 Copyright (C) 1989-2012 Dr. BERTRAND Joël This file is part of RPL/2. RPL/2 is free software; you can redistribute it and/or modify it under the terms of the CeCILL V2 License as published by the french CEA, CNRS and INRIA. RPL/2 is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the CeCILL V2 License for more details. You should have received a copy of the CeCILL License along with RPL/2. If not, write to info@cecill.info. ================================================================================ */ #include "rpl-conv.h" /* ================================================================================ Affectation automatique d'un type à des données ================================================================================ Entrées : structure sur l'état du processus -------------------------------------------------------------------------------- Sorties : Néant -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void recherche_type(struct_processus *s_etat_processus) { int nombre_elements_convertis; struct_liste_chainee *l_base_liste_fonctions; struct_liste_chainee *l_base_liste_decomposition; struct_liste_chainee *l_element_courant; struct_liste_chainee *l_element_courant_fonctions; struct_liste_chainee *l_element_precedent; struct_liste_pile_systeme *s_sauvegarde_pile; struct_objet *s_objet; struct_objet *s_objet_registre; struct_objet *s_sous_objet; logical1 drapeau_chaine; logical1 drapeau_complexe; logical1 drapeau_matrice; logical1 drapeau_reel; logical1 drapeau_valeur_entiere; logical1 drapeau_valeur_reelle; logical1 erreur; logical1 erreur_lecture_binaire; logical8 ancienne_valeur_base; logical8 valeur_base; long coherence_liste; unsigned char autorisation_evaluation_nom; unsigned char *definitions_chainees_precedentes; unsigned char *fonction_majuscule; unsigned char *instruction_majuscule; unsigned char *ptr; unsigned char *ptr_ecriture; unsigned char *ptr_lecture; unsigned char registre_instruction_valide; unsigned char registre_interruption; unsigned char registre_mode_execution_programme; unsigned char registre_recherche_type; unsigned char registre_test; unsigned char registre_test_bis; unsigned char *tampon; unsigned char variable_implicite; unsigned long i; unsigned long j; unsigned long niveau; unsigned long niveau_maximal; unsigned long nombre_colonnes; unsigned long nombre_egalites; unsigned long nombre_elements; unsigned long nombre_exposants; unsigned long nombre_lignes; unsigned long nombre_lignes_a_supprimer; unsigned long nombre_points; unsigned long nombre_virgules; unsigned long position_courante; unsigned long profondeur_finale; unsigned long profondeur_initiale; unsigned long sauvegarde_niveau_courant; unsigned long sauvegarde_longueur_definitions_chainees; void *element; if ((s_objet = allocation(s_etat_processus, NON)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } element = NULL; nombre_egalites = 0; i = 0; registre_test = (*s_etat_processus).test_instruction; registre_instruction_valide = (*s_etat_processus).instruction_valide; registre_interruption = (*s_etat_processus).traitement_interruptible; (*s_etat_processus).test_instruction = 'Y'; (*s_etat_processus).traitement_interruptible = 'N'; analyse(s_etat_processus, NULL); (*s_etat_processus).test_instruction = registre_test; if ((*s_etat_processus).instruction_valide == 'Y') { if ((*s_etat_processus).constante_symbolique == 'N') { if ((element = malloc(sizeof(struct_fonction))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } (*((struct_fonction *) element)).nombre_arguments = 0; (*((struct_fonction *) element)).prediction_saut = NULL; if ((*s_etat_processus).instruction_intrinseque == 'Y') { /* * Les fonctions intrinsèques ne sont pas sensibles à la casse. */ if (((*((struct_fonction *) element)).nom_fonction = conversion_majuscule((*s_etat_processus) .instruction_courante)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } } else { if (((*((struct_fonction *) element)).nom_fonction = malloc((strlen((*s_etat_processus).instruction_courante) + 1) * sizeof(unsigned char))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } strcpy((*((struct_fonction *) element)).nom_fonction, (*s_etat_processus).instruction_courante); } (*((struct_fonction *) element)).fonction = analyse_instruction(s_etat_processus, (*((struct_fonction *) element)).nom_fonction); (*s_objet).type = FCT; (*s_objet).objet = element; (*((struct_fonction *) (*s_objet).objet)).prediction_saut = NULL; (*((struct_fonction *) (*s_objet).objet)).prediction_execution = d_faux; if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), s_objet) == d_erreur) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } } else { if ((instruction_majuscule = conversion_majuscule( (*s_etat_processus).instruction_courante)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } if ((*s_etat_processus).constante_symbolique == 'Y') { registre_test_bis = (*s_etat_processus).test_instruction; (*s_etat_processus).test_instruction = 'N'; analyse(s_etat_processus, NULL); (*s_etat_processus).test_instruction = registre_test_bis; liberation(s_etat_processus, s_objet); } else { (*s_objet).type = NOM; if (((*s_objet).objet = malloc(sizeof(struct_nom))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } (*((struct_nom *) (*s_objet).objet)).symbole = d_faux; if (((*((struct_nom *) (*s_objet).objet)).nom = (unsigned char *) malloc((strlen((*s_etat_processus) .instruction_courante) + 1) * sizeof(unsigned char))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } strcpy((*((struct_nom *) (*s_objet).objet)).nom, (*s_etat_processus).instruction_courante); if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), s_objet) == d_erreur) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } } free(instruction_majuscule); } (*s_etat_processus).instruction_valide = registre_instruction_valide; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } (*s_etat_processus).instruction_valide = registre_instruction_valide; switch(*((*s_etat_processus).instruction_courante)) { /* -------------------------------------------------------------------------------- Complexe -------------------------------------------------------------------------------- */ case '(' : { element = (void *) ((struct_complexe16 *) malloc( sizeof(struct_complexe16))); if (element == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } conversion_format(s_etat_processus, (*s_etat_processus).instruction_courante); sauvegarde_longueur_definitions_chainees = (*s_etat_processus).longueur_definitions_chainees; tampon = (unsigned char *) malloc( (((*s_etat_processus).longueur_definitions_chainees = strlen((*s_etat_processus).instruction_courante) + 4) + 1) * sizeof(unsigned char)); if (tampon == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } strcpy(tampon, "<< "); ptr_ecriture = tampon + 3; ptr_lecture = (*s_etat_processus).instruction_courante + 1; nombre_virgules = 0; while((*ptr_lecture) != d_code_fin_chaine) { if ((*ptr_lecture) == ',') { (*ptr_lecture) = ' '; nombre_virgules++; } *ptr_ecriture++ = *ptr_lecture++; } (*(--ptr_ecriture)) = d_code_fin_chaine; strcat(ptr_ecriture, " >>"); position_courante = (*s_etat_processus).position_courante; (*s_etat_processus).position_courante = 0; profondeur_initiale = (*s_etat_processus) .hauteur_pile_operationnelle; /* -- On met le tout dans la pile opérationnelle ---------------------------------- */ (*s_etat_processus).niveau_recursivite++; definitions_chainees_precedentes = (*s_etat_processus) .definitions_chainees; (*s_etat_processus).definitions_chainees = tampon; s_sauvegarde_pile = (*s_etat_processus).l_base_pile_systeme; sauvegarde_niveau_courant = (*s_etat_processus).niveau_courant; (*s_etat_processus).l_base_pile_systeme = NULL; empilement_pile_systeme(s_etat_processus); if ((*s_etat_processus).erreur_systeme != d_es) { (*s_etat_processus).traitement_interruptible = registre_interruption; return; } (*(*s_etat_processus).l_base_pile_systeme).retour_definition = 'Y'; (*s_etat_processus).niveau_courant = 0; (*s_etat_processus).autorisation_empilement_programme = 'N'; registre_mode_execution_programme = (*s_etat_processus).mode_execution_programme; (*s_etat_processus).mode_execution_programme = 'Y'; tampon = (*s_etat_processus).instruction_courante; if ((*s_etat_processus).profilage == d_vrai) { profilage(s_etat_processus, "RPL/2 internals"); if ((*s_etat_processus).erreur_systeme != d_es) { return; } } registre_recherche_type = (*s_etat_processus).recherche_type; (*s_etat_processus).recherche_type = 'Y'; if (sequenceur(s_etat_processus) == d_erreur) { (*s_etat_processus).erreur_execution = d_ex_syntaxe; (*s_etat_processus).recherche_type = registre_recherche_type; (*s_etat_processus).instruction_courante = tampon; (*s_etat_processus).mode_execution_programme = registre_mode_execution_programme; effacement_pile_systeme(s_etat_processus); (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile; (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant; (*s_etat_processus).niveau_recursivite--; (*s_etat_processus).position_courante = position_courante; free((*s_etat_processus).definitions_chainees); (*s_etat_processus).definitions_chainees = definitions_chainees_precedentes; (*s_etat_processus).longueur_definitions_chainees = sauvegarde_longueur_definitions_chainees; free(element); liberation(s_etat_processus, s_objet); (*s_etat_processus).traitement_interruptible = registre_interruption; return; } (*s_etat_processus).recherche_type = registre_recherche_type; (*s_etat_processus).instruction_courante = tampon; (*s_etat_processus).mode_execution_programme = registre_mode_execution_programme; (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile; (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant; (*s_etat_processus).niveau_recursivite--; (*s_etat_processus).position_courante = position_courante; free((*s_etat_processus).definitions_chainees); (*s_etat_processus).definitions_chainees = definitions_chainees_precedentes; (*s_etat_processus).longueur_definitions_chainees = sauvegarde_longueur_definitions_chainees; /* -- On relit la pile pour remplir le complexe ----------------------------------- */ profondeur_finale = (*s_etat_processus).hauteur_pile_operationnelle; nombre_elements_convertis = profondeur_finale - profondeur_initiale; if ((nombre_elements_convertis != 2) || (nombre_virgules != 1)) { (*s_etat_processus).erreur_execution = d_ex_syntaxe; liberation(s_etat_processus, s_objet); free(element); for(i = 0; i < (unsigned long) nombre_elements_convertis; i++) { if (depilement(s_etat_processus, &((*s_etat_processus) .l_base_pile), &s_sous_objet) == d_erreur) { (*s_etat_processus).traitement_interruptible = registre_interruption; return; } liberation(s_etat_processus, s_sous_objet); } (*s_etat_processus).traitement_interruptible = registre_interruption; return; } else { if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), &s_sous_objet) == d_absence_erreur) { if ((*s_sous_objet).type == INT) { (*((struct_complexe16 *) element)).partie_imaginaire = (*((integer8 *) (*s_sous_objet).objet)); } else if ((*s_sous_objet).type == REL) { (*((struct_complexe16 *) element)).partie_imaginaire = (*((real8 *) (*s_sous_objet).objet)); } else { (*s_etat_processus).erreur_execution = d_ex_syntaxe; free(element); liberation(s_etat_processus, s_objet); liberation(s_etat_processus, s_sous_objet); (*s_etat_processus).traitement_interruptible = registre_interruption; return; } liberation(s_etat_processus, s_sous_objet); if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), &s_sous_objet) == d_absence_erreur) { if ((*s_sous_objet).type == INT) { (*((struct_complexe16 *) element)).partie_reelle = (*((integer8 *) (*s_sous_objet).objet)); } else if ((*s_sous_objet).type == REL) { (*((struct_complexe16 *) element)).partie_reelle = (*((real8 *) (*s_sous_objet).objet)); } else { (*s_etat_processus).erreur_execution = d_ex_syntaxe; free(element); liberation(s_etat_processus, s_objet); liberation(s_etat_processus, s_sous_objet); (*s_etat_processus).traitement_interruptible = registre_interruption; return; } liberation(s_etat_processus, s_sous_objet); } } } (*s_objet).type = CPL; break; } /* -------------------------------------------------------------------------------- Binaire -------------------------------------------------------------------------------- */ case '#' : { element = (void *) ((logical8 *) malloc( sizeof(logical8))); if (element == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } erreur_lecture_binaire = d_faux; switch((*s_etat_processus).instruction_courante [strlen((*s_etat_processus).instruction_courante) - 1]) { case 'b' : { i = strlen((*s_etat_processus).instruction_courante) - 2; valeur_base = 1; (*((logical8 *) element)) = 0; while(i > 0) { if ((*s_etat_processus).instruction_courante[i] == '1') { (*((logical8 *) element)) += valeur_base; } else if ((*s_etat_processus).instruction_courante[i] != '0') { if ((*s_etat_processus).instruction_courante[i] == ' ') { while(i > 0) { if ((*s_etat_processus) .instruction_courante[i] != ' ') { break; } i--; } } if (i != 0) { free(element); liberation(s_etat_processus, s_objet); (*s_etat_processus).erreur_execution = d_ex_syntaxe; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } break; } ancienne_valeur_base = valeur_base; valeur_base *= 2; if (ancienne_valeur_base > valeur_base) { i--; while(i > 0) { if ((*s_etat_processus).instruction_courante[i] != ' ') { erreur_lecture_binaire = d_vrai; } i--; } break; } i--; } nombre_elements_convertis = 1; break; } case 'o' : { i = strlen((*s_etat_processus).instruction_courante) - 2; valeur_base = 1; (*((logical8 *) element)) = 0; while(i > 0) { if ((*s_etat_processus).instruction_courante[i] == '1') { (*((logical8 *) element)) += valeur_base; } else if ((*s_etat_processus).instruction_courante[i] == '2') { (*((logical8 *) element)) += 2 * valeur_base; } else if ((*s_etat_processus).instruction_courante[i] == '3') { (*((logical8 *) element)) += 3 * valeur_base; } else if ((*s_etat_processus).instruction_courante[i] == '4') { (*((logical8 *) element)) += 4 * valeur_base; } else if ((*s_etat_processus).instruction_courante[i] == '5') { (*((logical8 *) element)) += 5 * valeur_base; } else if ((*s_etat_processus).instruction_courante[i] == '6') { (*((logical8 *) element)) += 6 * valeur_base; } else if ((*s_etat_processus).instruction_courante[i] == '7') { (*((logical8 *) element)) += 7 * valeur_base; } else if ((*s_etat_processus).instruction_courante[i] != '0') { if ((*s_etat_processus).instruction_courante[i] == ' ') { while(i > 0) { if ((*s_etat_processus) .instruction_courante[i] != ' ') { break; } i--; } } if (i != 0) { free(element); liberation(s_etat_processus, s_objet); (*s_etat_processus).erreur_execution = d_ex_syntaxe; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } break; } ancienne_valeur_base = valeur_base; valeur_base *= 8; if (ancienne_valeur_base > valeur_base) { i--; while(i > 0) { if ((*s_etat_processus).instruction_courante[i] != ' ') { erreur_lecture_binaire = d_vrai; } i--; } break; } i--; } nombre_elements_convertis = 1; break; } case 'd' : { i = strlen((*s_etat_processus).instruction_courante) - 2; valeur_base = 1; (*((logical8 *) element)) = 0; while(i > 0) { if ((*s_etat_processus).instruction_courante[i] == '1') { (*((logical8 *) element)) += valeur_base; } else if ((*s_etat_processus).instruction_courante[i] == '2') { (*((logical8 *) element)) += 2 * valeur_base; } else if ((*s_etat_processus).instruction_courante[i] == '3') { (*((logical8 *) element)) += 3 * valeur_base; } else if ((*s_etat_processus).instruction_courante[i] == '4') { (*((logical8 *) element)) += 4 * valeur_base; } else if ((*s_etat_processus).instruction_courante[i] == '5') { (*((logical8 *) element)) += 5 * valeur_base; } else if ((*s_etat_processus).instruction_courante[i] == '6') { (*((logical8 *) element)) += 6 * valeur_base; } else if ((*s_etat_processus).instruction_courante[i] == '7') { (*((logical8 *) element)) += 7 * valeur_base; } else if ((*s_etat_processus).instruction_courante[i] == '8') { (*((logical8 *) element)) += 8 * valeur_base; } else if ((*s_etat_processus).instruction_courante[i] == '9') { (*((logical8 *) element)) += 9 * valeur_base; } else if ((*s_etat_processus).instruction_courante[i] != '0') { if ((*s_etat_processus).instruction_courante[i] == ' ') { while(i > 0) { if ((*s_etat_processus) .instruction_courante[i] != ' ') { break; } i--; } } if (i != 0) { free(element); liberation(s_etat_processus, s_objet); (*s_etat_processus).erreur_execution = d_ex_syntaxe; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } break; } ancienne_valeur_base = valeur_base; valeur_base *= 10; if (ancienne_valeur_base > valeur_base) { i--; while(i > 0) { if ((*s_etat_processus).instruction_courante[i] != ' ') { erreur_lecture_binaire = d_vrai; } i--; } break; } i--; } nombre_elements_convertis = 1; break; } case 'h' : { i = strlen((*s_etat_processus).instruction_courante) - 2; valeur_base = 1; (*((logical8 *) element)) = 0; while(i > 0) { if ((*s_etat_processus).instruction_courante[i] == '1') { (*((logical8 *) element)) += valeur_base; } else if ((*s_etat_processus).instruction_courante[i] == '2') { (*((logical8 *) element)) += 2 * valeur_base; } else if ((*s_etat_processus).instruction_courante[i] == '3') { (*((logical8 *) element)) += 3 * valeur_base; } else if ((*s_etat_processus).instruction_courante[i] == '4') { (*((logical8 *) element)) += 4 * valeur_base; } else if ((*s_etat_processus).instruction_courante[i] == '5') { (*((logical8 *) element)) += 5 * valeur_base; } else if ((*s_etat_processus).instruction_courante[i] == '6') { (*((logical8 *) element)) += 6 * valeur_base; } else if ((*s_etat_processus).instruction_courante[i] == '7') { (*((logical8 *) element)) += 7 * valeur_base; } else if ((*s_etat_processus).instruction_courante[i] == '8') { (*((logical8 *) element)) += 8 * valeur_base; } else if ((*s_etat_processus).instruction_courante[i] == '9') { (*((logical8 *) element)) += 9 * valeur_base; } else if ((*s_etat_processus).instruction_courante[i] == 'A') { (*((logical8 *) element)) += 10 * valeur_base; } else if ((*s_etat_processus).instruction_courante[i] == 'B') { (*((logical8 *) element)) += 11 * valeur_base; } else if ((*s_etat_processus).instruction_courante[i] == 'C') { (*((logical8 *) element)) += 12 * valeur_base; } else if ((*s_etat_processus).instruction_courante[i] == 'D') { (*((logical8 *) element)) += 13 * valeur_base; } else if ((*s_etat_processus).instruction_courante[i] == 'E') { (*((logical8 *) element)) += 14 * valeur_base; } else if ((*s_etat_processus).instruction_courante[i] == 'F') { (*((logical8 *) element)) += 15 * valeur_base; } else if ((*s_etat_processus).instruction_courante[i] != '0') { if ((*s_etat_processus).instruction_courante[i] == ' ') { while(i > 0) { if ((*s_etat_processus) .instruction_courante[i] != ' ') { break; } i--; } } if (i != 0) { free(element); liberation(s_etat_processus, s_objet); (*s_etat_processus).erreur_execution = d_ex_syntaxe; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } break; } ancienne_valeur_base = valeur_base; valeur_base *= 16; if (ancienne_valeur_base > valeur_base) { i--; while(i > 0) { if ((*s_etat_processus).instruction_courante[i] != ' ') { erreur_lecture_binaire = d_vrai; } i--; } break; } i--; } nombre_elements_convertis = 1; break; } default : { nombre_elements_convertis = 0; break; } } if ((nombre_elements_convertis != 1) || (erreur_lecture_binaire == d_vrai)) { free(element); liberation(s_etat_processus, s_objet); (*s_etat_processus).erreur_execution = d_ex_syntaxe; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } (*s_objet).type = BIN; break; } /* -------------------------------------------------------------------------------- Matrices ou vecteurs entiers, réels ou complexes -------------------------------------------------------------------------------- */ case '[' : { niveau = 0; niveau_maximal = 0; nombre_colonnes = 0; nombre_lignes = 0; drapeau_complexe = d_faux; drapeau_reel = d_faux; ptr = (*s_etat_processus).instruction_courante; while((*ptr) != d_code_fin_chaine) { switch(*ptr) { case '(' : case ')' : { drapeau_complexe = d_vrai; drapeau_reel = d_vrai; break; } case '.' : case 'E' : case 'e' : { drapeau_reel = d_vrai; break; } case '[' : { niveau_maximal = (++niveau); break; } case ']' : { niveau--; break; } } ptr++; } if (niveau != 0) { liberation(s_etat_processus, s_objet); (*s_etat_processus).erreur_execution = d_ex_syntaxe; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } drapeau_matrice = (niveau_maximal == 2) ? d_vrai : d_faux; switch (drapeau_matrice) { /* -------------------------------------------------------------------------------- Vecteur -------------------------------------------------------------------------------- */ case d_faux : { /* -- Sauvegarde des paramètres du processus pour analyser le vecteur ------------- -- Analyse récursive en appelant l'interprète sur le vecteur moins ------------- -- ses délimiteurs ------------------------------------------------------------- */ sauvegarde_longueur_definitions_chainees = (*s_etat_processus).longueur_definitions_chainees; tampon = (unsigned char *) malloc( (((*s_etat_processus).longueur_definitions_chainees = strlen((*s_etat_processus).instruction_courante) + 4) + 1) * sizeof(unsigned char)); if (tampon == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } strcpy(tampon, "<< "); ptr_ecriture = tampon + 3; ptr_lecture = (*s_etat_processus).instruction_courante + 1; while((*ptr_lecture) != d_code_fin_chaine) { *ptr_ecriture++ = *ptr_lecture++; } (*(--ptr_ecriture)) = d_code_fin_chaine; strcat(ptr_ecriture, " >>"); position_courante = (*s_etat_processus).position_courante; (*s_etat_processus).position_courante = 0; profondeur_initiale = (*s_etat_processus) .hauteur_pile_operationnelle; /* -- On met le tout dans la pile opérationnelle ---------------------------------- */ (*s_etat_processus).niveau_recursivite++; definitions_chainees_precedentes = (*s_etat_processus) .definitions_chainees; (*s_etat_processus).definitions_chainees = tampon; s_sauvegarde_pile = (*s_etat_processus).l_base_pile_systeme; sauvegarde_niveau_courant = (*s_etat_processus) .niveau_courant; (*s_etat_processus).l_base_pile_systeme = NULL; empilement_pile_systeme(s_etat_processus); if ((*s_etat_processus).erreur_systeme != d_es) { (*s_etat_processus).traitement_interruptible = registre_interruption; return; } (*(*s_etat_processus).l_base_pile_systeme) .retour_definition = 'Y'; (*s_etat_processus).niveau_courant = 0; (*s_etat_processus).autorisation_empilement_programme = 'N'; registre_mode_execution_programme = (*s_etat_processus).mode_execution_programme; (*s_etat_processus).mode_execution_programme = 'Y'; (*s_etat_processus).erreur_scrutation = d_faux; tampon = (*s_etat_processus).instruction_courante; nombre_lignes_a_supprimer = (*s_etat_processus).hauteur_pile_operationnelle; if ((*s_etat_processus).profilage == d_vrai) { profilage(s_etat_processus, "RPL/2 internals"); if ((*s_etat_processus).erreur_systeme != d_es) { return; } } registre_recherche_type = (*s_etat_processus).recherche_type; (*s_etat_processus).recherche_type = 'Y'; if (sequenceur(s_etat_processus) == d_erreur) { (*s_etat_processus).erreur_execution = d_ex_syntaxe; (*s_etat_processus).recherche_type = registre_recherche_type; (*s_etat_processus).mode_execution_programme = registre_mode_execution_programme; nombre_lignes_a_supprimer = (*s_etat_processus).hauteur_pile_operationnelle - nombre_lignes_a_supprimer; for(i = 0; i < nombre_lignes_a_supprimer; i++) { if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), &s_sous_objet) == d_erreur) { (*s_etat_processus).traitement_interruptible = registre_interruption; return; } liberation(s_etat_processus, s_sous_objet); } (*s_etat_processus).instruction_courante = tampon; effacement_pile_systeme(s_etat_processus); (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile; (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant; (*s_etat_processus).niveau_recursivite--; free((*s_etat_processus).definitions_chainees); (*s_etat_processus).position_courante = position_courante; (*s_etat_processus).definitions_chainees = definitions_chainees_precedentes; (*s_etat_processus).longueur_definitions_chainees = sauvegarde_longueur_definitions_chainees; liberation(s_etat_processus, s_objet); (*s_etat_processus).erreur_execution = d_ex_syntaxe; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } (*s_etat_processus).recherche_type = registre_recherche_type; (*s_etat_processus).mode_execution_programme = registre_mode_execution_programme; if ((*s_etat_processus).erreur_scrutation == d_vrai) { nombre_lignes_a_supprimer = (*s_etat_processus).hauteur_pile_operationnelle - nombre_lignes_a_supprimer; for(i = 0; i < nombre_lignes_a_supprimer; i++) { if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), &s_sous_objet) == d_erreur) { (*s_etat_processus).traitement_interruptible = registre_interruption; return; } liberation(s_etat_processus, s_sous_objet); } (*s_etat_processus).instruction_courante = tampon; effacement_pile_systeme(s_etat_processus); (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile; (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant; (*s_etat_processus).niveau_recursivite--; free((*s_etat_processus).definitions_chainees); (*s_etat_processus).position_courante = position_courante; (*s_etat_processus).definitions_chainees = definitions_chainees_precedentes; (*s_etat_processus).longueur_definitions_chainees = sauvegarde_longueur_definitions_chainees; liberation(s_etat_processus, s_objet); (*s_etat_processus).erreur_execution = d_ex_syntaxe; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } (*s_etat_processus).instruction_courante = tampon; (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile; (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant; (*s_etat_processus).niveau_recursivite--; (*s_etat_processus).position_courante = position_courante; free((*s_etat_processus).definitions_chainees); (*s_etat_processus).definitions_chainees = definitions_chainees_precedentes; (*s_etat_processus).longueur_definitions_chainees = sauvegarde_longueur_definitions_chainees; /* -- On relit la pile pour remplir le vecteur ------------------------------------ */ profondeur_finale = (*s_etat_processus) .hauteur_pile_operationnelle; nombre_colonnes = profondeur_finale - profondeur_initiale; element = (void *) ((struct_vecteur *) malloc(sizeof(struct_vecteur))); if (element == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } (*((struct_vecteur *) element)).taille = nombre_colonnes; if (drapeau_complexe == d_vrai) { (*((struct_vecteur *) element)).tableau = (void *) ((struct_complexe16 *) malloc(nombre_colonnes * sizeof(struct_complexe16))); (*((struct_vecteur *) element)).type = 'C'; } else if (drapeau_reel == d_vrai) { (*((struct_vecteur *) element)).tableau = (void *) ((real8 *) malloc(nombre_colonnes * sizeof(real8))); (*((struct_vecteur *) element)).type = 'R'; } else { (*((struct_vecteur *) element)).tableau = (void *) ((integer8 *) malloc(nombre_colonnes * sizeof(integer8))); (*((struct_vecteur *) element)).type = 'I'; } if ((*((struct_vecteur *) element)).tableau == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } erreur = d_absence_erreur; s_objet_registre = s_objet; for(i = 0; (i < nombre_colonnes) && (erreur == d_absence_erreur); i++) { erreur = depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), &s_objet); if (erreur == d_absence_erreur) { if (drapeau_complexe == d_vrai) { if ((*s_objet).type == CPL) { ((struct_complexe16 *) (*((struct_vecteur *) element)).tableau)[nombre_colonnes - i - 1] = *((struct_complexe16 *) ((*s_objet).objet)); } else if ((*s_objet).type == REL) { ((struct_complexe16 *) (*((struct_vecteur *) element)).tableau)[nombre_colonnes - i - 1].partie_reelle = *((real8 *) ((*s_objet).objet)); ((struct_complexe16 *) (*((struct_vecteur *) element)).tableau)[nombre_colonnes - i - 1].partie_imaginaire = (real8) 0; } else if ((*s_objet).type == INT) { ((struct_complexe16 *) (*((struct_vecteur *) element)).tableau)[nombre_colonnes - i - 1].partie_reelle = (real8) (*((integer8 *) ((*s_objet) .objet))); ((struct_complexe16 *) (*((struct_vecteur *) element)).tableau) [nombre_colonnes - i - 1].partie_imaginaire = (real8) 0; } else { erreur = d_erreur; } } else if (drapeau_reel == d_vrai) { if ((*s_objet).type == REL) { ((real8 *) (*((struct_vecteur *) element)).tableau) [nombre_colonnes - i - 1] = *((real8 *) ((*s_objet).objet)); } else if ((*s_objet).type == INT) { ((real8 *) (*((struct_vecteur *) element)).tableau) [nombre_colonnes - i - 1] = (real8) (*((integer8 *) ((*s_objet).objet))); } else { erreur = d_erreur; } } else { if ((*s_objet).type == INT) { ((integer8 *) (*((struct_vecteur *) element)).tableau) [nombre_colonnes - i - 1] = *((integer8 *) ((*s_objet).objet)); } else { erreur = d_erreur; } } liberation(s_etat_processus, s_objet); if (erreur == d_erreur) { for(i++; i < nombre_colonnes; i++) { if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), &s_objet) == d_erreur) { (*s_etat_processus) .traitement_interruptible = registre_interruption; liberation(s_etat_processus, s_objet_registre); return; } liberation(s_etat_processus, s_objet); } (*s_etat_processus).erreur_execution = d_ex_syntaxe; free((*((struct_vecteur *) element)).tableau); free(element); liberation(s_etat_processus, s_objet_registre); (*s_etat_processus).traitement_interruptible = registre_interruption; return; } } else { liberation(s_etat_processus, s_objet_registre); (*s_etat_processus).erreur_systeme = d_es_pile_vide; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } } s_objet = s_objet_registre; if (drapeau_complexe == d_vrai) { (*s_objet).type = VCX; } else if (drapeau_reel == d_vrai) { (*s_objet).type = VRL; } else { (*s_objet).type = VIN; } break; } /* -------------------------------------------------------------------------------- Matrice -------------------------------------------------------------------------------- */ case d_vrai : { nombre_lignes--; sauvegarde_longueur_definitions_chainees = (*s_etat_processus).longueur_definitions_chainees; tampon = (unsigned char *) malloc( (((*s_etat_processus).longueur_definitions_chainees = strlen((*s_etat_processus).instruction_courante) + 4) + 1) * sizeof(unsigned char)); if (tampon == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } strcpy(tampon, "<< "); ptr_ecriture = tampon + 3; ptr_lecture = (*s_etat_processus).instruction_courante + 1; while((*ptr_lecture) != d_code_fin_chaine) { *ptr_ecriture++ = *ptr_lecture++; } (*(--ptr_ecriture)) = d_code_fin_chaine; strcat(ptr_ecriture, " >>"); position_courante = (*s_etat_processus).position_courante; (*s_etat_processus).position_courante = 0; profondeur_initiale = (*s_etat_processus) .hauteur_pile_operationnelle; /* -- On met les lignes de la matrice dans la pile opérationnelle ----------------- */ (*s_etat_processus).niveau_recursivite++; definitions_chainees_precedentes = (*s_etat_processus) .definitions_chainees; (*s_etat_processus).definitions_chainees = tampon; s_sauvegarde_pile = (*s_etat_processus).l_base_pile_systeme; sauvegarde_niveau_courant = (*s_etat_processus) .niveau_courant; (*s_etat_processus).l_base_pile_systeme = NULL; empilement_pile_systeme(s_etat_processus); if ((*s_etat_processus).erreur_systeme != d_es) { (*s_etat_processus).traitement_interruptible = registre_interruption; return; } (*(*s_etat_processus).l_base_pile_systeme) .retour_definition = 'Y'; (*s_etat_processus).niveau_courant = 0; (*s_etat_processus).autorisation_empilement_programme = 'N'; registre_mode_execution_programme = (*s_etat_processus).mode_execution_programme; (*s_etat_processus).mode_execution_programme = 'Y'; (*s_etat_processus).erreur_scrutation = d_faux; tampon = (*s_etat_processus).instruction_courante; nombre_lignes_a_supprimer = (*s_etat_processus).hauteur_pile_operationnelle; if ((*s_etat_processus).profilage == d_vrai) { profilage(s_etat_processus, "RPL/2 internals"); if ((*s_etat_processus).erreur_systeme != d_es) { return; } } registre_recherche_type = (*s_etat_processus) .recherche_type; (*s_etat_processus).recherche_type = 'Y'; if (sequenceur(s_etat_processus) == d_erreur) { (*s_etat_processus).erreur_execution = d_ex_syntaxe; (*s_etat_processus).recherche_type = registre_recherche_type; (*s_etat_processus).mode_execution_programme = registre_mode_execution_programme; nombre_lignes_a_supprimer = (*s_etat_processus).hauteur_pile_operationnelle - nombre_lignes_a_supprimer; for(i = 0; i < nombre_lignes_a_supprimer; i++) { if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), &s_sous_objet) == d_erreur) { (*s_etat_processus).traitement_interruptible = registre_interruption; return; } liberation(s_etat_processus, s_sous_objet); } (*s_etat_processus).instruction_courante = tampon; effacement_pile_systeme(s_etat_processus); (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile; (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant; free((*s_etat_processus).definitions_chainees); (*s_etat_processus).niveau_recursivite--; (*s_etat_processus).definitions_chainees = definitions_chainees_precedentes; (*s_etat_processus).longueur_definitions_chainees = sauvegarde_longueur_definitions_chainees; (*s_etat_processus).position_courante = position_courante; liberation(s_etat_processus, s_objet); (*s_etat_processus).erreur_execution = d_ex_syntaxe; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } (*s_etat_processus).recherche_type = registre_recherche_type; (*s_etat_processus).mode_execution_programme = registre_mode_execution_programme; if ((*s_etat_processus).erreur_scrutation == d_vrai) { nombre_lignes_a_supprimer = (*s_etat_processus).hauteur_pile_operationnelle - nombre_lignes_a_supprimer; for(i = 0; i < nombre_lignes_a_supprimer; i++) { if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), &s_sous_objet) == d_erreur) { (*s_etat_processus).traitement_interruptible = registre_interruption; return; } liberation(s_etat_processus, s_sous_objet); } (*s_etat_processus).instruction_courante = tampon; effacement_pile_systeme(s_etat_processus); (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile; (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant; free((*s_etat_processus).definitions_chainees); (*s_etat_processus).niveau_recursivite--; (*s_etat_processus).definitions_chainees = definitions_chainees_precedentes; (*s_etat_processus).longueur_definitions_chainees = sauvegarde_longueur_definitions_chainees; (*s_etat_processus).position_courante = position_courante; liberation(s_etat_processus, s_objet); (*s_etat_processus).erreur_execution = d_ex_syntaxe; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } (*s_etat_processus).instruction_courante = tampon; (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile; (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant; free((*s_etat_processus).definitions_chainees); (*s_etat_processus).definitions_chainees = definitions_chainees_precedentes; (*s_etat_processus).longueur_definitions_chainees = sauvegarde_longueur_definitions_chainees; (*s_etat_processus).niveau_recursivite--; (*s_etat_processus).position_courante = position_courante; /* -- On relit la pile qui contient des objets "vecteurs" contenant les ----------- -- lignes de la matrice -------------------------------------------------------- */ profondeur_finale = (*s_etat_processus) .hauteur_pile_operationnelle; nombre_lignes = profondeur_finale - profondeur_initiale; element = (void *) ((struct_matrice *) malloc( sizeof(struct_matrice))); if (element == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } (*((struct_matrice *) element)) .nombre_lignes = nombre_lignes; (*((struct_matrice *) element)).nombre_colonnes = (*((struct_vecteur *) ((*(*(*s_etat_processus) .l_base_pile).donnee).objet))).taille; nombre_colonnes = (*((struct_matrice *) element)).nombre_colonnes; l_element_courant = (*s_etat_processus).l_base_pile; drapeau_complexe = d_faux; drapeau_reel = d_faux; erreur = d_absence_erreur; for(i = 0; i < nombre_lignes; i++) { if (nombre_colonnes != (*((struct_vecteur *) (*(*l_element_courant).donnee).objet)).taille) { (*s_etat_processus).erreur_execution = d_ex_syntaxe; for(j = 0; j < nombre_lignes; j++) { if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), &s_sous_objet) == d_erreur) { (*s_etat_processus) .traitement_interruptible = registre_interruption; return; } liberation(s_etat_processus, s_sous_objet); } free(element); liberation(s_etat_processus, s_objet); (*s_etat_processus).traitement_interruptible = registre_interruption; return; } if ((*(*l_element_courant) .donnee).type == VRL) { drapeau_reel = d_vrai; } else if ((*(*l_element_courant) .donnee).type == VCX) { drapeau_complexe = d_vrai; } l_element_courant = (*l_element_courant).suivant; } s_objet_registre = s_objet; if ((*s_etat_processus).erreur_execution == d_ex) { if (drapeau_complexe == d_vrai) { if (((*((struct_matrice *) element)).tableau = (void **) ((struct_complexe16 **) malloc(nombre_lignes * sizeof( struct_complexe16 *)))) == NULL) { liberation(s_etat_processus, s_objet_registre); (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } (*((struct_matrice *) element)).type = 'C'; for(i = 0; i < nombre_lignes; i++) { if ((((*((struct_matrice *) element)).tableau)[i] = (void *) ((struct_complexe16 *) malloc(nombre_colonnes * sizeof( struct_complexe16)))) == NULL) { liberation(s_etat_processus, s_objet_registre); (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus) .traitement_interruptible = registre_interruption; return; } } } else if (drapeau_reel == d_vrai) { if (((*((struct_matrice *) element)).tableau = (void **) ((real8 **) malloc(nombre_lignes * sizeof(real8 *)))) == NULL) { liberation(s_etat_processus, s_objet_registre); (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } (*((struct_matrice *) element)).type = 'R'; for(i = 0; i < nombre_lignes; i++) { if ((((*((struct_matrice *)element)).tableau)[i] = (void *) ((real8 *) malloc(nombre_colonnes * sizeof(real8)))) == NULL) { liberation(s_etat_processus, s_objet_registre); (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus) .traitement_interruptible = registre_interruption; return; } } } else { if (((*((struct_matrice *) element)).tableau = (void **) ((integer8 **) malloc(nombre_lignes * sizeof(integer8 *)))) == NULL) { liberation(s_etat_processus, s_objet_registre); (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } (*((struct_matrice *) element)).type = 'I'; for(i = 0; i < nombre_lignes; i++) { if ((((*((struct_matrice *) element)).tableau)[i] = (void *) ((integer8 *) malloc(nombre_colonnes * sizeof(integer8)))) == NULL) { liberation(s_etat_processus, s_objet_registre); (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus) .traitement_interruptible = registre_interruption; return; } } } for(i = 0; i < nombre_lignes; i++) { if (depilement(s_etat_processus, &((*s_etat_processus) .l_base_pile), &s_objet) == d_absence_erreur) { if (drapeau_complexe == d_vrai) { if ((*s_objet).type == VCX) { for(j = 0; j < nombre_colonnes; j++) { ((struct_complexe16 **) ((*( (struct_matrice *) element)) .tableau))[nombre_lignes - i - 1][j] = ((struct_complexe16 *) (*((struct_vecteur *) (*s_objet).objet)) .tableau)[j]; } } else if ((*s_objet).type == VRL) { for(j = 0; j < nombre_colonnes; j++) { (((struct_complexe16 **) ((*( (struct_matrice *) element)) .tableau))[nombre_lignes - i - 1][j]).partie_reelle = ((real8 *) (*( (struct_vecteur *) (*s_objet).objet)) .tableau)[j]; (((struct_complexe16 **) ((*( (struct_matrice *) element)) .tableau))[nombre_lignes - i - 1][j]).partie_imaginaire = (real8) 0; } } else if ((*s_objet).type == VIN) { for(j = 0; j < nombre_colonnes; j++) { (((struct_complexe16 **) ((*( (struct_matrice *) element)) .tableau))[nombre_lignes - i - 1][j]).partie_reelle = (real8) ((integer8 *) (*((struct_vecteur *) (*s_objet).objet)).tableau) [j]; (((struct_complexe16 **) ((*( (struct_matrice *) element)) .tableau))[nombre_lignes - i - 1][j]).partie_imaginaire = (real8) 0; } } else { erreur = d_erreur; } } else if (drapeau_reel == d_vrai) { if ((*s_objet).type == VRL) { for(j = 0; j < nombre_colonnes; j++) { ((real8 **) ((*((struct_matrice *) element)).tableau)) [nombre_lignes - i - 1][j] = ((real8 *) (*( (struct_vecteur *) (*s_objet).objet)).tableau) [j]; } } else if ((*s_objet).type == VIN) { for(j = 0; j < nombre_colonnes; j++) { ((real8 **) ((*((struct_matrice *) element)).tableau)) [nombre_lignes - i - 1][j] = (real8) ((integer8 *) (*((struct_vecteur *) (*s_objet).objet)).tableau) [j]; } } else { erreur = d_erreur; } } else { if ((*s_objet).type == VIN) { for(j = 0; j < nombre_colonnes; j++) { ((integer8 **) ((*((struct_matrice *) element)).tableau)) [nombre_lignes - i - 1][j] = ((integer8 *) (*((struct_vecteur *) (*s_objet) .objet)).tableau)[j]; } } else { erreur = d_erreur; } } liberation(s_etat_processus, s_objet); if (erreur == d_erreur) { for(i++; i < nombre_lignes; i++) { if (depilement(s_etat_processus, &((*s_etat_processus) .l_base_pile), &s_objet) == d_erreur) { liberation(s_etat_processus, s_objet_registre); (*s_etat_processus) .traitement_interruptible = registre_interruption; return; } liberation(s_etat_processus, s_objet); } (*s_etat_processus).erreur_execution = d_ex_syntaxe; for(j = 0; j < (*((struct_matrice *) element)).nombre_lignes; j++) { free((*((struct_matrice *) element)) .tableau[j]); } free((*((struct_matrice *) element)) .tableau); free(element); liberation(s_etat_processus, s_objet_registre); (*s_etat_processus) .traitement_interruptible = registre_interruption; return; } } else { liberation(s_etat_processus, s_objet_registre); (*s_etat_processus).erreur_systeme = d_es_pile_vide; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } } s_objet = s_objet_registre; if (drapeau_complexe == d_vrai) { (*s_objet).type = MCX; } else if (drapeau_reel == d_vrai) { (*s_objet).type = MRL; } else { (*s_objet).type = MIN; } } else { if ((*s_etat_processus).langue == 'F') { printf("+++Erreur : Matrice %s invalide [%d]\n", (*s_etat_processus).instruction_courante, (int) getpid()); } else { printf("+++Error : Invalid %s matrix [%d]\n", (*s_etat_processus).instruction_courante, (int) getpid()); } fflush(stdout); } break; } } break; } /* -------------------------------------------------------------------------------- Liste -------------------------------------------------------------------------------- */ case '{' : { sauvegarde_longueur_definitions_chainees = (*s_etat_processus).longueur_definitions_chainees; tampon = (unsigned char *) malloc( (((*s_etat_processus).longueur_definitions_chainees = strlen((*s_etat_processus).instruction_courante) + 4) + 1) * sizeof(unsigned char)); if (tampon == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } strcpy(tampon, "<< "); ptr_ecriture = tampon + 3; ptr_lecture = (*s_etat_processus).instruction_courante + 1; while((*ptr_lecture) != d_code_fin_chaine) { *ptr_ecriture++ = *ptr_lecture++; } (*(--ptr_ecriture)) = d_code_fin_chaine; strcat(ptr_ecriture, " >>"); position_courante = (*s_etat_processus).position_courante; (*s_etat_processus).position_courante = 0; profondeur_initiale = (*s_etat_processus) .hauteur_pile_operationnelle; /* -- On met le tout dans la pile opérationnelle. --------------------------------- */ (*s_etat_processus).niveau_recursivite++; definitions_chainees_precedentes = (*s_etat_processus) .definitions_chainees; (*s_etat_processus).definitions_chainees = tampon; s_sauvegarde_pile = (*s_etat_processus).l_base_pile_systeme; sauvegarde_niveau_courant = (*s_etat_processus).niveau_courant; (*s_etat_processus).l_base_pile_systeme = NULL; empilement_pile_systeme(s_etat_processus); if ((*s_etat_processus).erreur_systeme != d_es) { (*s_etat_processus).traitement_interruptible = registre_interruption; return; } (*(*s_etat_processus).l_base_pile_systeme).retour_definition = 'Y'; (*(*s_etat_processus).l_base_pile_systeme) .origine_routine_evaluation = 'N'; (*s_etat_processus).niveau_courant = 0; (*s_etat_processus).autorisation_empilement_programme = 'N'; tampon = (*s_etat_processus).instruction_courante; autorisation_evaluation_nom = (*s_etat_processus) .autorisation_evaluation_nom; (*s_etat_processus).autorisation_evaluation_nom = 'N'; registre_test = (*s_etat_processus).test_instruction; (*s_etat_processus).test_instruction = 'Y'; registre_mode_execution_programme = (*s_etat_processus).mode_execution_programme; (*s_etat_processus).mode_execution_programme = 'Y'; (*s_etat_processus).erreur_scrutation = d_faux; nombre_lignes_a_supprimer = (*s_etat_processus).hauteur_pile_operationnelle; /* * Vérification de la cohérence des arguments. * Il doit y avoir autant de '<<' que de '>>' dans * l'expression candidate. */ coherence_liste = 0; drapeau_chaine = d_faux; while((*s_etat_processus).definitions_chainees [(*s_etat_processus).position_courante] != d_code_fin_chaine) { if ((*s_etat_processus).definitions_chainees [(*s_etat_processus).position_courante] == '"') { if (drapeau_chaine == d_faux) { drapeau_chaine = d_vrai; } else { drapeau_chaine = d_faux; } } else if (drapeau_chaine == d_faux) { if (((*s_etat_processus).definitions_chainees [(*s_etat_processus).position_courante] == '<') && ((*s_etat_processus).definitions_chainees [(*s_etat_processus).position_courante + 1] == '<')) { coherence_liste++; } else if (((*s_etat_processus).definitions_chainees [(*s_etat_processus).position_courante] == '>') && ((*s_etat_processus).definitions_chainees [(*s_etat_processus).position_courante + 1] == '>')) { coherence_liste--; } } (*s_etat_processus).position_courante++; } (*s_etat_processus).position_courante = 0; if ((coherence_liste != 0) || (drapeau_chaine == d_vrai)) { (*s_etat_processus).erreur_execution = d_ex_syntaxe; nombre_lignes_a_supprimer = (*s_etat_processus).hauteur_pile_operationnelle - nombre_lignes_a_supprimer; for(i = 0; i < nombre_lignes_a_supprimer; i++) { if (depilement(s_etat_processus, &((*s_etat_processus) .l_base_pile), &s_sous_objet) == d_erreur) { (*s_etat_processus).traitement_interruptible = registre_interruption; (*s_etat_processus).mode_execution_programme = registre_mode_execution_programme; return; } liberation(s_etat_processus, s_sous_objet); } (*s_etat_processus).test_instruction = registre_test; (*s_etat_processus).longueur_definitions_chainees = sauvegarde_longueur_definitions_chainees; (*s_etat_processus).instruction_courante = tampon; (*s_etat_processus).autorisation_evaluation_nom = autorisation_evaluation_nom; effacement_pile_systeme(s_etat_processus); (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile; (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant; free((*s_etat_processus).definitions_chainees); liberation(s_etat_processus, s_objet); (*s_etat_processus).definitions_chainees = definitions_chainees_precedentes; (*s_etat_processus).niveau_recursivite--; (*s_etat_processus).position_courante = position_courante; (*s_etat_processus).traitement_interruptible = registre_interruption; (*s_etat_processus).mode_execution_programme = registre_mode_execution_programme; return; } /* * Scrutation de la séquence. */ (*s_etat_processus).position_courante = 0; if ((*s_etat_processus).profilage == d_vrai) { profilage(s_etat_processus, "RPL/2 internals"); if ((*s_etat_processus).erreur_systeme != d_es) { return; } } variable_implicite = (*s_etat_processus).autorisation_nom_implicite; registre_recherche_type = (*s_etat_processus).recherche_type; (*s_etat_processus).recherche_type = 'Y'; (*s_etat_processus).autorisation_nom_implicite = 'Y'; if (sequenceur(s_etat_processus) == d_erreur) { (*s_etat_processus).autorisation_nom_implicite = variable_implicite; (*s_etat_processus).recherche_type = registre_recherche_type; (*s_etat_processus).mode_execution_programme = registre_mode_execution_programme; if ((*s_etat_processus).erreur_execution != d_ex_nom_implicite) { (*s_etat_processus).erreur_execution = d_ex_syntaxe; } nombre_lignes_a_supprimer = (*s_etat_processus).hauteur_pile_operationnelle - nombre_lignes_a_supprimer; for(i = 0; i < nombre_lignes_a_supprimer; i++) { if (depilement(s_etat_processus, &((*s_etat_processus) .l_base_pile), &s_sous_objet) == d_erreur) { (*s_etat_processus).traitement_interruptible = registre_interruption; return; } liberation(s_etat_processus, s_sous_objet); } (*s_etat_processus).test_instruction = registre_test; (*s_etat_processus).longueur_definitions_chainees = sauvegarde_longueur_definitions_chainees; (*s_etat_processus).instruction_courante = tampon; (*s_etat_processus).autorisation_evaluation_nom = autorisation_evaluation_nom; effacement_pile_systeme(s_etat_processus); (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile; (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant; free((*s_etat_processus).definitions_chainees); liberation(s_etat_processus, s_objet); (*s_etat_processus).definitions_chainees = definitions_chainees_precedentes; (*s_etat_processus).niveau_recursivite--; (*s_etat_processus).position_courante = position_courante; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } (*s_etat_processus).autorisation_nom_implicite = variable_implicite; (*s_etat_processus).recherche_type = registre_recherche_type; (*s_etat_processus).mode_execution_programme = registre_mode_execution_programme; if ((*s_etat_processus).erreur_scrutation == d_vrai) { nombre_lignes_a_supprimer = (*s_etat_processus).hauteur_pile_operationnelle - nombre_lignes_a_supprimer; for(i = 0; i < nombre_lignes_a_supprimer; i++) { if (depilement(s_etat_processus, &((*s_etat_processus) .l_base_pile), &s_sous_objet) == d_erreur) { (*s_etat_processus).traitement_interruptible = registre_interruption; return; } liberation(s_etat_processus, s_sous_objet); } (*s_etat_processus).test_instruction = registre_test; (*s_etat_processus).longueur_definitions_chainees = sauvegarde_longueur_definitions_chainees; (*s_etat_processus).instruction_courante = tampon; (*s_etat_processus).autorisation_evaluation_nom = autorisation_evaluation_nom; effacement_pile_systeme(s_etat_processus); (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile; (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant; free((*s_etat_processus).definitions_chainees); liberation(s_etat_processus, s_objet); (*s_etat_processus).definitions_chainees = definitions_chainees_precedentes; (*s_etat_processus).niveau_recursivite--; (*s_etat_processus).position_courante = position_courante; (*s_etat_processus).erreur_execution = d_ex_syntaxe; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } (*s_etat_processus).test_instruction = registre_test; (*s_etat_processus).longueur_definitions_chainees = sauvegarde_longueur_definitions_chainees; (*s_etat_processus).instruction_courante = tampon; (*s_etat_processus).autorisation_evaluation_nom = autorisation_evaluation_nom; (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile; (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant; free((*s_etat_processus).definitions_chainees); (*s_etat_processus).definitions_chainees = definitions_chainees_precedentes; (*s_etat_processus).niveau_recursivite--; (*s_etat_processus).position_courante = position_courante; /* -- Relecture de la pile opérationnelle ----------------------------------------- */ profondeur_finale = (*s_etat_processus).hauteur_pile_operationnelle; l_element_courant = NULL; s_objet_registre = s_objet; for(i = 0; i < (profondeur_finale - profondeur_initiale); i++) { if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), &s_objet) == d_erreur) { liberation(s_etat_processus, s_objet_registre); (*s_etat_processus).traitement_interruptible = registre_interruption; return; } if (empilement(s_etat_processus, &l_element_courant, s_objet) == d_erreur) { liberation(s_etat_processus, s_objet_registre); (*s_etat_processus).traitement_interruptible = registre_interruption; return; } } s_objet = s_objet_registre; (*s_objet).type = LST; element = (void *) l_element_courant; break; } /* -------------------------------------------------------------------------------- Nom ou expression algébrique -------------------------------------------------------------------------------- */ case '\'' : { if ((tampon = analyse_algebrique(s_etat_processus, (*s_etat_processus).instruction_courante, &l_base_liste_fonctions)) == NULL) { /* * L'erreur est de type exécution ou système. * Dans le doute, on libère *s_objet. */ while(l_base_liste_fonctions != NULL) { l_element_courant_fonctions = l_base_liste_fonctions; l_base_liste_fonctions = (*l_base_liste_fonctions).suivant; free((*((struct_fonction *) (*l_element_courant_fonctions) .donnee)).nom_fonction); free((struct_fonction *) (*l_element_courant_fonctions) .donnee); free(l_element_courant_fonctions); } liberation(s_etat_processus, s_objet); (*s_etat_processus).traitement_interruptible = registre_interruption; return; } l_base_liste_decomposition = analyse_rpn(s_etat_processus, tampon); l_element_courant = l_base_liste_decomposition; nombre_elements = 0; while(l_element_courant != NULL) { nombre_elements++; l_element_courant = (*l_element_courant).suivant; } if (nombre_elements == 3) { free(tampon); (*s_objet).type = (*(*(*l_base_liste_decomposition) .suivant).donnee).type; element = (void *) (*(*(*l_base_liste_decomposition) .suivant).donnee).objet; if ((*s_objet).type == NOM) { (*((struct_nom *) (*(*(*l_base_liste_decomposition) .suivant).donnee).objet)).symbole = d_vrai; } else if ((*s_objet).type == FCT) { /* * On essaye de mettre d'utiliser une fonction * comme un nom... On convertit la fonction en nom * puis on renvoie une erreur. */ (*s_objet).type = NON; liberation(s_etat_processus, s_objet); l_element_courant = l_base_liste_decomposition; while(l_element_courant != NULL) { liberation(s_etat_processus, (*l_element_courant).donnee); l_element_precedent = l_element_courant; l_element_courant = (*l_element_courant).suivant; free(l_element_precedent); } (*s_etat_processus).erreur_execution = d_ex_syntaxe; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } l_element_precedent = l_base_liste_decomposition; l_element_courant = (*l_element_precedent).suivant; liberation(s_etat_processus, (*l_element_precedent).donnee); free(l_element_precedent); l_element_precedent = l_element_courant; l_element_courant = (*l_element_courant).suivant; free((*l_element_precedent).donnee); free(l_element_precedent); liberation(s_etat_processus, (*l_element_courant).donnee); free(l_element_courant); } else { (*s_objet).type = ALG; if ((*s_etat_processus).debug == d_vrai) if (((*s_etat_processus).type_debug & d_debug_variables) != 0) { if ((*s_etat_processus).langue == 'F') { printf("[%d] Conversion de l'expression en " "notation polonaise inversée\n%s\n", (int) getpid(), tampon); } else { printf("[%d] Translation of expression " "into reverse polish notation\n%s", (int) getpid(), tampon); } fflush(stdout); } element = (void *) l_base_liste_decomposition; free(tampon); if (element == NULL) { (*s_etat_processus).erreur_execution = d_ex_expression_invalide; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } l_element_courant = (struct_liste_chainee *) element; while(l_element_courant != NULL) { if ((*(*l_element_courant).donnee).type == FCT) { /* * Si la fonction est intrinsèque au langage, * elle est convertie en majuscules. */ tampon = conversion_majuscule((*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nom_fonction); free((*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nom_fonction); (*((struct_fonction *) (*(*l_element_courant).donnee) .objet)).nom_fonction = tampon; if (strcmp(tampon, "=") == 0) { nombre_egalites++; } } l_element_courant = (*l_element_courant).suivant; } l_element_courant = (struct_liste_chainee *) element; while(l_element_courant != NULL) { if (((*(*l_element_courant).donnee).type == FCT) || ((*(*l_element_courant).donnee).type == NOM)) { if ((*(*l_element_courant).donnee).type == FCT) { if (l_base_liste_fonctions != NULL) { l_element_courant_fonctions = l_base_liste_fonctions; while(l_element_courant_fonctions != NULL) { if ((fonction_majuscule = conversion_majuscule( (*((struct_fonction *) ((*l_element_courant_fonctions) .donnee))).nom_fonction)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus) .traitement_interruptible = registre_interruption; return; } if (strcmp(fonction_majuscule, (*((struct_fonction *) (*(*l_element_courant).donnee) .objet)).nom_fonction) == 0) { free(fonction_majuscule); break; } free(fonction_majuscule); l_element_courant_fonctions = (*l_element_courant_fonctions) .suivant; } if (l_element_courant_fonctions != NULL) { (*((struct_fonction *) (*(*l_element_courant) .donnee).objet)).nombre_arguments = (*((struct_fonction *) ((*l_element_courant_fonctions) .donnee))).nombre_arguments; } else { (*((struct_fonction *) (*(*l_element_courant).donnee) .objet)).nombre_arguments = 0; } } else { (*((struct_fonction *) (*(*l_element_courant).donnee) .objet)).nombre_arguments = 0; } } else { (*((struct_nom *) (*(*l_element_courant).donnee) .objet)).symbole = d_faux; if (l_base_liste_fonctions != NULL) { l_element_courant_fonctions = l_base_liste_fonctions; while((strcmp((*((struct_fonction *) ((*l_element_courant_fonctions) .donnee))).nom_fonction, (*((struct_nom *) (*(*l_element_courant).donnee).objet)) .nom) != 0) && ((*l_element_courant_fonctions) .suivant != NULL)) { l_element_courant_fonctions = (*l_element_courant_fonctions) .suivant; } if (((*l_element_courant_fonctions).suivant != NULL) || (strcmp((*((struct_nom *) (*(*l_element_courant).donnee).objet)) .nom, (*((struct_fonction *) ((*l_element_courant_fonctions) .donnee))).nom_fonction) == 0)) { tampon = (*((struct_nom *) (*(*l_element_courant) .donnee).objet)).nom; if ((s_sous_objet = (struct_objet *) malloc(sizeof( struct_objet))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus) .traitement_interruptible = registre_interruption; return; } initialisation_objet(s_sous_objet); (*s_sous_objet).type = FCT; if (((*s_sous_objet).objet = (void *) malloc(sizeof(struct_fonction))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus) .traitement_interruptible = registre_interruption; return; } (*((struct_fonction *) ((*s_sous_objet) .objet))).nom_fonction = tampon; (*((struct_fonction *) ((*s_sous_objet) .objet))).fonction = analyse_instruction( s_etat_processus, tampon); (*((struct_fonction *) ((*s_sous_objet) .objet))).nombre_arguments = (*((struct_fonction *) ((*l_element_courant_fonctions) .donnee))).nombre_arguments; free((struct_nom *) (*(*l_element_courant) .donnee).objet); free((*l_element_courant).donnee); (*l_element_courant).donnee = s_sous_objet; } } } } l_element_courant = (*l_element_courant).suivant; } } while(l_base_liste_fonctions != NULL) { l_element_courant_fonctions = l_base_liste_fonctions; l_base_liste_fonctions = (*l_base_liste_fonctions).suivant; free((*((struct_fonction *) (*l_element_courant_fonctions) .donnee)).nom_fonction); free((struct_fonction *) (*l_element_courant_fonctions).donnee); free(l_element_courant_fonctions); } break; } /* -------------------------------------------------------------------------------- Chaîne de caractères -------------------------------------------------------------------------------- */ case '"' : { (*s_objet).type = CHN; element = (void *) ((unsigned char *) malloc( (strlen((*s_etat_processus).instruction_courante) - 1) * sizeof(unsigned char))); if (element == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } ptr_lecture = (*s_etat_processus).instruction_courante + 1; ptr_ecriture = (unsigned char *) element; while((*ptr_lecture) != d_code_fin_chaine) { *ptr_ecriture++ = *ptr_lecture++; } (*(--ptr_ecriture)) = d_code_fin_chaine; if (validation_chaine((unsigned char *) element) == d_faux) { (*s_etat_processus).erreur_execution = d_ex_syntaxe; (*s_etat_processus).traitement_interruptible = registre_interruption; free(element); return; } break; } /* -------------------------------------------------------------------------------- Définition ou tableau -------------------------------------------------------------------------------- */ case '<' : { if ((*s_etat_processus).instruction_courante[1] == '[') { // Tableau sauvegarde_longueur_definitions_chainees = (*s_etat_processus).longueur_definitions_chainees; tampon = (unsigned char *) malloc( (((*s_etat_processus).longueur_definitions_chainees = strlen((*s_etat_processus).instruction_courante) + 2) + 1) * sizeof(unsigned char)); if (tampon == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } strcpy(tampon, "<< "); ptr_ecriture = tampon + 3; ptr_lecture = (*s_etat_processus).instruction_courante + 2; while((*ptr_lecture) != d_code_fin_chaine) { *ptr_ecriture++ = *ptr_lecture++; } ptr_ecriture -= 2; (*ptr_ecriture) = d_code_fin_chaine; strcat(ptr_ecriture, " >>"); position_courante = (*s_etat_processus).position_courante; (*s_etat_processus).position_courante = 0; profondeur_initiale = (*s_etat_processus) .hauteur_pile_operationnelle; /* -- On met les éléments du tableau dans la pile opérationnelle ------------------ */ (*s_etat_processus).niveau_recursivite++; definitions_chainees_precedentes = (*s_etat_processus) .definitions_chainees; (*s_etat_processus).definitions_chainees = tampon; s_sauvegarde_pile = (*s_etat_processus).l_base_pile_systeme; sauvegarde_niveau_courant = (*s_etat_processus).niveau_courant; (*s_etat_processus).l_base_pile_systeme = NULL; empilement_pile_systeme(s_etat_processus); if ((*s_etat_processus).erreur_systeme != d_es) { (*s_etat_processus).traitement_interruptible = registre_interruption; return; } (*(*s_etat_processus).l_base_pile_systeme) .retour_definition = 'Y'; (*s_etat_processus).niveau_courant = 0; (*s_etat_processus).autorisation_empilement_programme = 'N'; registre_mode_execution_programme = (*s_etat_processus).mode_execution_programme; (*s_etat_processus).mode_execution_programme = 'Y'; (*s_etat_processus).erreur_scrutation = d_faux; tampon = (*s_etat_processus).instruction_courante; nombre_lignes_a_supprimer = (*s_etat_processus).hauteur_pile_operationnelle; if ((*s_etat_processus).profilage == d_vrai) { profilage(s_etat_processus, "RPL/2 internals"); if ((*s_etat_processus).erreur_systeme != d_es) { return; } } registre_recherche_type = (*s_etat_processus).recherche_type; (*s_etat_processus).recherche_type = 'Y'; variable_implicite = (*s_etat_processus).autorisation_nom_implicite; (*s_etat_processus).autorisation_nom_implicite = 'Y'; if (sequenceur(s_etat_processus) == d_erreur) { (*s_etat_processus).autorisation_nom_implicite = variable_implicite; (*s_etat_processus).erreur_execution = d_ex_syntaxe; (*s_etat_processus).recherche_type = registre_recherche_type; (*s_etat_processus).mode_execution_programme = registre_mode_execution_programme; nombre_lignes_a_supprimer = (*s_etat_processus).hauteur_pile_operationnelle - nombre_lignes_a_supprimer; for(i = 0; i < nombre_lignes_a_supprimer; i++) { if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), &s_sous_objet) == d_erreur) { (*s_etat_processus).traitement_interruptible = registre_interruption; return; } liberation(s_etat_processus, s_sous_objet); } (*s_etat_processus).instruction_courante = tampon; effacement_pile_systeme(s_etat_processus); (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile; (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant; free((*s_etat_processus).definitions_chainees); (*s_etat_processus).niveau_recursivite--; (*s_etat_processus).definitions_chainees = definitions_chainees_precedentes; (*s_etat_processus).longueur_definitions_chainees = sauvegarde_longueur_definitions_chainees; (*s_etat_processus).position_courante = position_courante; liberation(s_etat_processus, s_objet); (*s_etat_processus).erreur_execution = d_ex_syntaxe; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } (*s_etat_processus).autorisation_nom_implicite = variable_implicite; (*s_etat_processus).recherche_type = registre_recherche_type; (*s_etat_processus).mode_execution_programme = registre_mode_execution_programme; if ((*s_etat_processus).erreur_scrutation == d_vrai) { nombre_lignes_a_supprimer = (*s_etat_processus).hauteur_pile_operationnelle - nombre_lignes_a_supprimer; for(i = 0; i < nombre_lignes_a_supprimer; i++) { if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), &s_sous_objet) == d_erreur) { (*s_etat_processus).traitement_interruptible = registre_interruption; return; } liberation(s_etat_processus, s_sous_objet); } (*s_etat_processus).instruction_courante = tampon; effacement_pile_systeme(s_etat_processus); (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile; (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant; free((*s_etat_processus).definitions_chainees); (*s_etat_processus).niveau_recursivite--; (*s_etat_processus).definitions_chainees = definitions_chainees_precedentes; (*s_etat_processus).longueur_definitions_chainees = sauvegarde_longueur_definitions_chainees; (*s_etat_processus).position_courante = position_courante; liberation(s_etat_processus, s_objet); (*s_etat_processus).erreur_execution = d_ex_syntaxe; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } (*s_etat_processus).instruction_courante = tampon; (*s_etat_processus).l_base_pile_systeme = s_sauvegarde_pile; (*s_etat_processus).niveau_courant = sauvegarde_niveau_courant; free((*s_etat_processus).definitions_chainees); (*s_etat_processus).definitions_chainees = definitions_chainees_precedentes; (*s_etat_processus).longueur_definitions_chainees = sauvegarde_longueur_definitions_chainees; (*s_etat_processus).niveau_recursivite--; (*s_etat_processus).position_courante = position_courante; /* -- On relit la pile qui contient des sous-objets contenant les ----------------- -- éléments du tableau --------------------------------------------------------- */ profondeur_finale = (*s_etat_processus) .hauteur_pile_operationnelle; nombre_lignes = profondeur_finale - profondeur_initiale; if ((element = malloc(sizeof(struct_tableau))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } (*((struct_tableau *) element)).nombre_elements = nombre_lignes; if (((*((struct_tableau *) element)).elements = malloc(nombre_lignes * sizeof(struct_objet *))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } for(i = 1; i <= nombre_lignes; i++) { if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), &s_sous_objet) == d_erreur) { (*s_etat_processus).traitement_interruptible = registre_interruption; return; } (*((struct_tableau *) element)).elements[nombre_lignes - i] = s_sous_objet; } (*s_objet).type = TBL; (*s_etat_processus).traitement_interruptible = registre_interruption; } else { // Définition if (strlen((*s_etat_processus).instruction_courante) < 5) { liberation(s_etat_processus, s_objet); (*s_etat_processus).erreur_execution = d_ex_syntaxe; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } if ((strncmp((*s_etat_processus).instruction_courante, "<< ", 3) != 0) && (strcmp((*s_etat_processus) .instruction_courante, "<<") != 0)) { liberation(s_etat_processus, s_objet); (*s_etat_processus).erreur_execution = d_ex_syntaxe; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } (*s_objet).type = RPN; element = (void *) analyse_rpn(s_etat_processus, (*s_etat_processus).instruction_courante); if (element == NULL) { if ((*s_etat_processus).erreur_systeme != d_es) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; } liberation(s_etat_processus, s_objet); (*s_etat_processus).traitement_interruptible = registre_interruption; return; } l_element_courant = (struct_liste_chainee *) element; while(l_element_courant != NULL) { if ((*(*l_element_courant).donnee).type == FCT) { if (strcmp((*((struct_fonction *) (*(*l_element_courant) .donnee).objet)).nom_fonction, "=") == 0) { nombre_egalites++; } } l_element_courant = (*l_element_courant).suivant; } } break; } /* -------------------------------------------------------------------------------- Entier ou réel -------------------------------------------------------------------------------- */ default : { if (((*((*s_etat_processus).instruction_courante)) == '-') || ((*((*s_etat_processus).instruction_courante)) == '+') || (((*((*s_etat_processus).instruction_courante)) >= '0') && ((*((*s_etat_processus).instruction_courante)) <= '9')) || ((*((*s_etat_processus).instruction_courante)) == '.')) { drapeau_valeur_entiere = ((*((*s_etat_processus) .instruction_courante)) != '.') ? d_vrai : d_faux; drapeau_valeur_reelle = d_vrai; nombre_points = 0; nombre_exposants = 0; conversion_format(s_etat_processus, (*s_etat_processus).instruction_courante); ptr = (*s_etat_processus).instruction_courante; while((*ptr) != d_code_fin_chaine) { switch(*ptr) { case '0' : case '1' : case '2' : case '3' : case '4' : case '5' : case '6' : case '7' : case '8' : case '9' : { break; } // Ne peut survenir qu'après un 'E', un 'e' ou au // début de la chaîne. case '+' : case '-' : { if (ptr > (*s_etat_processus).instruction_courante) { if (((*(ptr - 1)) != 'e') && ((*(ptr - 1)) != 'E')) { drapeau_valeur_entiere = d_faux; drapeau_valeur_reelle = d_faux; } } break; } // Ne peut que commencer une chaîne, suivre un // chiffre ou un signe. Ne peut constituer un // nombre seul. case '.' : { nombre_points++; if (ptr > (*s_etat_processus).instruction_courante) { switch(*(ptr - 1)) { case '+' : case '-' : case '0' : case '1' : case '2' : case '3' : case '4' : case '5' : case '6' : case '7' : case '8' : case '9' : { drapeau_valeur_entiere = d_faux; break; } default : { drapeau_valeur_entiere = d_faux; drapeau_valeur_reelle = d_faux; break; } } } else { if ((*(ptr + 1)) == d_code_fin_chaine) { drapeau_valeur_entiere = d_faux; drapeau_valeur_reelle = d_faux; } } break; } // Ne peut suivre qu'un chiffre ou un point case 'e' : case 'E' : { nombre_exposants++; if (ptr > (*s_etat_processus).instruction_courante) { switch(*(ptr - 1)) { case '0' : case '1' : case '2' : case '3' : case '4' : case '5' : case '6' : case '7' : case '8' : case '9' : { drapeau_valeur_entiere = d_faux; break; } // Le point doit suivre un chiffre case '.' : { if ((ptr - 1) > (*s_etat_processus) .instruction_courante) { switch(*(ptr - 2)) { case '0' : case '1' : case '2' : case '3' : case '4' : case '5' : case '6' : case '7' : case '8' : case '9' : { drapeau_valeur_entiere = d_faux; break; } default : { drapeau_valeur_entiere = d_faux; drapeau_valeur_reelle = d_faux; break; } } } else { drapeau_valeur_entiere = d_faux; drapeau_valeur_reelle = d_faux; } break; } default : { drapeau_valeur_entiere = d_faux; drapeau_valeur_reelle = d_faux; break; } } } else { drapeau_valeur_entiere = d_faux; drapeau_valeur_reelle = d_faux; } break; } default : { drapeau_valeur_entiere = d_faux; drapeau_valeur_reelle = d_faux; break; } } ptr++; } if ((nombre_points > 1) || (nombre_exposants > 1)) { drapeau_valeur_reelle = d_faux; drapeau_valeur_entiere = d_faux; } } else { drapeau_valeur_entiere = d_faux; drapeau_valeur_reelle = d_faux; } if ((drapeau_valeur_reelle == d_faux) && (drapeau_valeur_entiere == d_faux)) { ptr = (*s_etat_processus).instruction_courante; while((*ptr) != d_code_fin_chaine) { if ((isalnum((*ptr)) == 0) && ((*ptr) != '_') && ((*ptr) != '$')) { liberation(s_etat_processus, s_objet); (*s_etat_processus).erreur_execution = d_ex_syntaxe; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } ptr++; } (*s_objet).type = NOM; element = malloc(sizeof(struct_nom)); if (element == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } (*((struct_nom *) element)).symbole = d_faux; (*((struct_nom *) element)).nom = ((unsigned char *) malloc( (strlen((*s_etat_processus) .instruction_courante) + 1) * sizeof(unsigned char))); if ((*((struct_nom *) element)).nom == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } strcpy((*((struct_nom *) element)).nom, (*s_etat_processus) .instruction_courante); } else { if (drapeau_valeur_entiere == d_faux) { (*s_objet).type = REL; element = (void *) ((real8 *) malloc( sizeof(real8))); if (element == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } nombre_elements_convertis = sscanf( (*s_etat_processus).instruction_courante, "%lg", (real8 *) element); if (nombre_elements_convertis != 1) { (*s_etat_processus).erreur_execution = d_ex_syntaxe; } } else { // Le format ressemble à un entier mais il peut y avoir // un dépassement de capacité lors de la conversion. // On convertit donc en entier et en réel. Si les // deux conversions donnent le même résultat, on // considère que la conversion en entier est bonne. Dans // le cas contraire, on garde la conversion en réel. integer8 conversion_entiere; real8 conversion_reelle; if (sscanf((*s_etat_processus).instruction_courante, "%lg", &conversion_reelle) != 1) { (*s_etat_processus).erreur_execution = d_ex_syntaxe; } if (sscanf((*s_etat_processus).instruction_courante, "%lld", &conversion_entiere) != 1) { (*s_etat_processus).erreur_execution = d_ex_syntaxe; } if (abs(nextafter(conversion_reelle, conversion_entiere) - conversion_reelle) >= abs(conversion_reelle - conversion_entiere)) { (*s_objet).type = INT; element = malloc(sizeof(integer8)); if (element == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } (*((integer8 *) element)) = conversion_entiere; } else { (*s_objet).type = REL; element = malloc(sizeof(real8)); if (element == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } (*((real8 *) element)) = conversion_reelle; } } } break; } } (*s_objet).objet = element; if (nombre_egalites > 1) { liberation(s_etat_processus, s_objet); (*s_etat_processus).erreur_execution = d_ex_syntaxe; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), s_objet) == d_erreur) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; (*s_etat_processus).traitement_interruptible = registre_interruption; return; } (*s_etat_processus).traitement_interruptible = registre_interruption; return; } /* ================================================================================ Conversion de la virgule ================================================================================ Entrées : structure sur l'état du processus -------------------------------------------------------------------------------- Sorties : néant -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void conversion_format(struct_processus *s_etat_processus, unsigned char *chaine) { unsigned char *ptr; /* -------------------------------------------------------------------------------- Transcription du point en virgule et réciproquement selon l'indicateur 48 -------------------------------------------------------------------------------- */ if (test_cfsf(s_etat_processus, 48) == d_vrai) { ptr = chaine; while((*ptr) != d_code_fin_chaine) { if ((*ptr) == '.') { (*ptr) = ','; } else if ((*ptr) == ',') { (*ptr) = '.'; } ptr++; } } return; } // vim: ts=4