--- rpl/src/instructions_i4.c 2010/04/07 13:45:06 1.7 +++ rpl/src/instructions_i4.c 2017/08/03 17:17:47 1.64 @@ -1,7 +1,7 @@ /* ================================================================================ - RPL/2 (R) version 4.0.14 - Copyright (C) 1989-2010 Dr. BERTRAND Joël + RPL/2 (R) version 4.1.28 + Copyright (C) 1989-2017 Dr. BERTRAND Joël This file is part of RPL/2. @@ -20,7 +20,7 @@ */ -#include "rpl.conv.h" +#include "rpl-conv.h" /* @@ -176,6 +176,7 @@ instruction_in(struct_processus *s_etat_ if ((*s_objet_resultat_intermediaire).type != INT) { + liberation(s_etat_processus, s_objet_resultat_intermediaire); liberation(s_etat_processus, s_objet_argument_1); liberation(s_etat_processus, s_objet_argument_2); liberation(s_etat_processus, s_objet_resultat); @@ -250,11 +251,11 @@ instruction_implicit(struct_processus *s if ((*s_etat_processus).langue == 'F') { - printf("(test de l'appartenance à un ensemble)\n\n"); + printf("(gestion des noms implicites)\n\n"); } else { - printf("(check membership)\n\n"); + printf("(implicit names management)\n\n"); } printf(" 1: %s\n\n", d_CHN); @@ -295,7 +296,7 @@ instruction_implicit(struct_processus *s if ((*s_objet_argument).type == CHN) { - if ((commande = conversion_majuscule((unsigned char *) + if ((commande = conversion_majuscule(s_etat_processus, (unsigned char *) (*s_objet_argument).objet)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; @@ -329,4 +330,106 @@ instruction_implicit(struct_processus *s return; } + +/* +================================================================================ + Fonction 'infinity' +================================================================================ + Entrées : +-------------------------------------------------------------------------------- + Sorties : +-------------------------------------------------------------------------------- + Effets de bord : néant +================================================================================ +*/ + +void +instruction_sensible_infinity(struct_processus *s_etat_processus) +{ + (*s_etat_processus).instruction_sensible = 'Y'; + + if (strcmp((*s_etat_processus).instruction_courante, "infinity") == 0) + { + instruction_infinity(s_etat_processus); + } + else + { + (*s_etat_processus).instruction_valide = 'N'; + } + + return; +} + +void +instruction_infinity(struct_processus *s_etat_processus) +{ + struct_objet *s_objet; + + if ((*s_etat_processus).affichage_arguments == 'Y') + { + printf("\n infinity "); + + if ((*s_etat_processus).langue == 'F') + { + printf("(infini)\n\n"); + } + else + { + printf("(infinity constant)\n\n"); + } + + printf("-> 1: %s\n", d_REL); + + return; + } + else if ((*s_etat_processus).test_instruction == 'Y') + { + (*s_etat_processus).constante_symbolique = 'Y'; + (*s_etat_processus).nombre_arguments = -1; + return; + } + + /* Indicateur 35 armé => évaluation symbolique */ + if (test_cfsf(s_etat_processus, 35) == d_vrai) + { + if ((s_objet = allocation(s_etat_processus, NOM)) == NULL) + { + (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; + return; + } + + if (((*((struct_nom *) (*s_objet).objet)).nom = + malloc(9 * sizeof(unsigned char))) == NULL) + { + (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; + return; + } + + strcpy((*((struct_nom *) (*s_objet).objet)).nom, "infinity"); + (*((struct_nom *) (*s_objet).objet)).symbole = d_faux; + } + else + { + if ((s_objet = allocation(s_etat_processus, REL)) == NULL) + { + (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; + return; + } + +# ifdef FP_INFINITE + (*((real8 *) (*s_objet).objet)) = (double) INFINITY; +# else + (*((real8 *) (*s_objet).objet)) = HUGE_VAL; +# endif + } + + if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), + s_objet) == d_erreur) + { + return; + } + + return; +} + // vim: ts=4