--- rpl/src/instructions_i4.c 2010/01/27 22:22:13 1.2 +++ rpl/src/instructions_i4.c 2019/02/03 14:40:40 1.68 @@ -1,7 +1,7 @@ /* ================================================================================ - RPL/2 (R) version 4.0.10 - Copyright (C) 1989-2010 Dr. BERTRAND Joël + RPL/2 (R) version 4.1.31 + Copyright (C) 1989-2019 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); @@ -218,6 +219,215 @@ instruction_in(struct_processus *s_etat_ { return; } + + return; +} + + +/* +================================================================================ + Fonction 'implicit' +================================================================================ + Entrées : +-------------------------------------------------------------------------------- + Sorties : +-------------------------------------------------------------------------------- + Effets de bord : néant +================================================================================ +*/ + +void +instruction_implicit(struct_processus *s_etat_processus) +{ + struct_objet *s_objet_argument; + + unsigned char *commande; + + (*s_etat_processus).erreur_execution = d_ex; + + if ((*s_etat_processus).affichage_arguments == 'Y') + { + printf("\n IMPLICIT "); + + if ((*s_etat_processus).langue == 'F') + { + printf("(gestion des noms implicites)\n\n"); + } + else + { + printf("(implicit names management)\n\n"); + } + + printf(" 1: %s\n\n", d_CHN); + + if ((*s_etat_processus).langue == 'F') + { + printf(" Utilisation :\n\n"); + } + else + { + printf(" Usage:\n\n"); + } + + printf(" \"NONE\" IMPLICIT\n"); + printf(" \"ALL\" IMPLICIT\n"); + return; + } + else if ((*s_etat_processus).test_instruction == 'Y') + { + (*s_etat_processus).nombre_arguments = -1; + return; + } + + if (test_cfsf(s_etat_processus, 31) == d_vrai) + { + if (empilement_pile_last(s_etat_processus, 1) == d_erreur) + { + return; + } + } + + if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), + &s_objet_argument) == d_erreur) + { + (*s_etat_processus).erreur_execution = d_ex_manque_argument; + return; + } + + if ((*s_objet_argument).type == CHN) + { + if ((commande = conversion_majuscule(s_etat_processus, (unsigned char *) + (*s_objet_argument).objet)) == NULL) + { + (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; + return; + } + + if (strcmp(commande, "NONE") == 0) + { + (*s_etat_processus).autorisation_nom_implicite = 'N'; + } + else if (strcmp(commande, "ALL") == 0) + { + (*s_etat_processus).autorisation_nom_implicite = 'Y'; + } + else + { + (*s_etat_processus).erreur_execution = d_ex_argument_invalide; + } + + free(commande); + } + else + { + liberation(s_etat_processus, s_objet_argument); + + (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument; + return; + } + + liberation(s_etat_processus, s_objet_argument); + 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; }