--- rpl/src/types.c 2015/06/08 14:11:45 1.74 +++ rpl/src/types.c 2018/05/30 09:27:39 1.91 @@ -1,7 +1,7 @@ /* ================================================================================ - RPL/2 (R) version 4.1.22 - Copyright (C) 1989-2015 Dr. BERTRAND Joël + RPL/2 (R) version 4.1.29 + Copyright (C) 1989-2018 Dr. BERTRAND Joël This file is part of RPL/2. @@ -56,6 +56,7 @@ recherche_type(struct_processus *s_etat_ integer8 profondeur_initiale; integer8 sauvegarde_niveau_courant; integer8 sauvegarde_longueur_definitions_chainees; + integer8 (*__type_new)(struct_processus *, void **); struct_liste_chainee *l_base_liste_fonctions; struct_liste_chainee *l_base_liste_decomposition; @@ -260,6 +261,57 @@ recherche_type(struct_processus *s_etat_ (*s_etat_processus).instruction_valide = registre_instruction_valide; +/* +-------------------------------------------------------------------------------- + Types externes +-------------------------------------------------------------------------------- +*/ + + l_element_courant = (*s_etat_processus).s_bibliotheques; + + while(l_element_courant != NULL) + { + if ((__type_new = dlsym((*((struct_bibliotheque *) + (*l_element_courant).donnee)).descripteur, "__type_new")) + != NULL) + { + if (((*s_objet).extension_type = __type_new(s_etat_processus, + &element)) != 0) + { + // Le type peut être converti. + + (*s_objet).objet = element; + (*s_objet).type = EXT; + (*s_objet).descripteur_bibliotheque = + (*((struct_bibliotheque *) + (*l_element_courant).donnee)).descripteur; + + 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; + } + } + + l_element_courant = (*l_element_courant).suivant; + } + +/* +-------------------------------------------------------------------------------- + Types internes +-------------------------------------------------------------------------------- +*/ + switch(*((*s_etat_processus).instruction_courante)) { @@ -2980,14 +3032,21 @@ recherche_type(struct_processus *s_etat_ (*(*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_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; @@ -3036,6 +3095,8 @@ recherche_type(struct_processus *s_etat_ } (*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 = @@ -3089,6 +3150,8 @@ recherche_type(struct_processus *s_etat_ } (*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 = @@ -3116,6 +3179,8 @@ recherche_type(struct_processus *s_etat_ } (*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 = @@ -3477,20 +3542,23 @@ recherche_type(struct_processus *s_etat_ while((*ptr) != d_code_fin_chaine) { - if ((isalnum((*ptr)) == 0) && - ((*ptr) != '_') && - ((*ptr) != '$')) + if (isalnum(*ptr) != 0) + { + ptr++; + } + else if (((*ptr) == '_') || ((*ptr == '$'))) + { + ptr++; + } + else { 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;