--- rpl/src/instructions_n1.c 2012/12/19 09:58:25 1.42 +++ rpl/src/instructions_n1.c 2020/01/10 11:15:46 1.72 @@ -1,7 +1,7 @@ /* ================================================================================ - RPL/2 (R) version 4.1.12 - Copyright (C) 1989-2012 Dr. BERTRAND Joël + RPL/2 (R) version 4.1.32 + Copyright (C) 1989-2020 Dr. BERTRAND Joël This file is part of RPL/2. @@ -27,11 +27,11 @@ ================================================================================ Fonction 'neg' ================================================================================ - Entrées : + Entrées : -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- - Effets de bord : néant + Effets de bord : néant ================================================================================ */ @@ -48,8 +48,8 @@ instruction_neg(struct_processus *s_etat struct_objet *s_objet_argument; struct_objet *s_objet_resultat; - unsigned long i; - unsigned long j; + integer8 i; + integer8 j; (*s_etat_processus).erreur_execution = d_ex; @@ -112,28 +112,43 @@ instruction_neg(struct_processus *s_etat if ((*s_objet_argument).type == INT) { - if ((s_objet_resultat = copie_objet(s_etat_processus, - s_objet_argument, 'Q')) == NULL) + if ((*((integer8 *) (*s_objet_argument).objet)) != INT64_MIN) { - (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; - return; - } + if ((s_objet_resultat = copie_objet(s_etat_processus, + s_objet_argument, 'Q')) == NULL) + { + (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; + return; + } - /* - * Permet d'éviter les résultats du type -0. Valable pour tous - * les types... - */ + /* + * Permet d'éviter les résultats du type -0. Valable pour tous + * les types... + */ - if ((*((integer8 *) (*s_objet_argument).objet)) != 0) + if ((*((integer8 *) (*s_objet_argument).objet)) != 0) + { + (*((integer8 *) (*s_objet_resultat).objet)) = + -(*((integer8 *) (*s_objet_argument).objet)); + } + } + else { - (*((integer8 *) (*s_objet_resultat).objet)) = - -(*((integer8 *) (*s_objet_argument).objet)); + if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL) + { + (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; + return; + } + + (*((real8 *) (*s_objet_resultat).objet)) = + -((real8) (*((integer8 *) (*s_objet_argument).objet))); + } } /* -------------------------------------------------------------------------------- - Opposition d'un réel + Opposition d'un réel -------------------------------------------------------------------------------- */ @@ -194,30 +209,80 @@ instruction_neg(struct_processus *s_etat else if ((*s_objet_argument).type == VIN) { - if ((s_objet_resultat = copie_objet(s_etat_processus, - s_objet_argument, 'Q')) == NULL) + drapeau = d_faux; + + for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet)) + .taille; i++) { - (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; - return; + if (((integer8 *) (*((struct_vecteur *) + (*s_objet_argument).objet)).tableau)[i] == INT64_MIN) + { + drapeau = d_vrai; + break; + } } - for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument).objet))) - .taille; i++) + if (drapeau == d_vrai) { - if (((integer8 *) (*(((struct_vecteur *) - (*s_objet_argument).objet))).tableau)[i] != 0) + if ((s_objet_resultat = allocation(s_etat_processus, VRL)) == NULL) { - ((integer8 *) (*(((struct_vecteur *) (*s_objet_resultat) - .objet))).tableau)[i] = -((integer8 *) - (*(((struct_vecteur *) - (*s_objet_argument).objet))).tableau)[i]; + (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; + return; + } + + if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau = + malloc(((size_t) (*((struct_vecteur *) (*s_objet_argument) + .objet)).taille) * sizeof(real8))) == NULL) + { + (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; + return; + } + + for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet)) + .taille; i++) + { + if (((real8 *) (*(((struct_vecteur *) + (*s_objet_argument).objet))).tableau)[i] != 0) + { + ((real8 *) (*((struct_vecteur *) (*s_objet_resultat) + .objet)).tableau)[i] = -((real8) ((integer8 *) + (*((struct_vecteur *) + (*s_objet_argument).objet)).tableau)[i]); + } + else + { + ((real8 *) (*((struct_vecteur *) (*s_objet_resultat) + .objet)).tableau)[i] = 0; + } + } + } + else + { + if ((s_objet_resultat = copie_objet(s_etat_processus, + s_objet_argument, 'Q')) == NULL) + { + (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; + return; + } + + for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument).objet))) + .taille; i++) + { + if (((integer8 *) (*(((struct_vecteur *) + (*s_objet_argument).objet))).tableau)[i] != 0) + { + ((integer8 *) (*(((struct_vecteur *) (*s_objet_resultat) + .objet))).tableau)[i] = -((integer8 *) + (*(((struct_vecteur *) + (*s_objet_argument).objet))).tableau)[i]; + } } } } /* -------------------------------------------------------------------------------- - Opposition d'un vecteur de réels + Opposition d'un vecteur de réels -------------------------------------------------------------------------------- */ @@ -293,26 +358,99 @@ instruction_neg(struct_processus *s_etat else if ((*s_objet_argument).type == MIN) { - if ((s_objet_resultat = copie_objet(s_etat_processus, - s_objet_argument, 'Q')) == NULL) - { - (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; - return; - } + drapeau = d_faux; - for(i = 0; i < (*(((struct_matrice *) (*s_objet_argument).objet))) + for(i = 0; i < (*((struct_matrice *) (*s_objet_argument).objet)) .nombre_lignes; i++) { - for(j = 0; j < (*(((struct_matrice *) (*s_objet_argument).objet))) + for(j = 0; j < (*((struct_matrice *) (*s_objet_argument).objet)) .nombre_colonnes; j++) { - if (((integer8 **) (*(((struct_matrice *) (*s_objet_argument) - .objet))).tableau)[i][j] != 0) + if (((integer8 **) (*((struct_matrice *) + (*s_objet_argument).objet)).tableau)[i][j] == INT64_MIN) { - ((integer8 **) (*(((struct_matrice *) (*s_objet_resultat) - .objet))).tableau)[i][j] = -((integer8 **) - (*(((struct_matrice *) - (*s_objet_argument).objet))).tableau)[i][j]; + drapeau = d_vrai; + break; + } + } + + if (drapeau == d_vrai) + { + break; + } + } + + if (drapeau == d_vrai) + { + if ((s_objet_resultat = allocation(s_etat_processus, MRL)) == NULL) + { + (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; + return; + } + + if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau = + malloc(((size_t) (*((struct_matrice *) (*s_objet_argument) + .objet)).nombre_lignes) * sizeof(real8 *))) == NULL) + { + (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; + return; + } + + for(i = 0; i < (*((struct_matrice *) (*s_objet_argument).objet)) + .nombre_lignes; i++) + { + if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat) + .objet)).tableau)[i] = malloc(((size_t) + ((*((struct_matrice *) (*s_objet_argument).objet)) + .nombre_colonnes)) * sizeof(real8))) == NULL) + { + (*s_etat_processus).erreur_systeme = + d_es_allocation_memoire; + return; + } + + for(j = 0; j < (*((struct_matrice *) (*s_objet_argument) + .objet)).nombre_colonnes; j++) + { + if (((integer8 **) (*((struct_matrice *) + (*s_objet_argument).objet)).tableau)[i][j] != 0) + { + ((real8 **) (*((struct_matrice *) (*s_objet_resultat) + .objet)).tableau)[i][j] = -((real8) + ((integer8 **) (*(((struct_matrice *) + (*s_objet_argument).objet))).tableau)[i][j]); + } + else + { + ((real8 **) (*((struct_matrice *) (*s_objet_resultat) + .objet)).tableau)[i][j] = 0; + } + } + } + } + else + { + if ((s_objet_resultat = copie_objet(s_etat_processus, + s_objet_argument, 'Q')) == NULL) + { + (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; + return; + } + + for(i = 0; i < (*((struct_matrice *) (*s_objet_argument).objet)) + .nombre_lignes; i++) + { + for(j = 0; j < (*((struct_matrice *) (*s_objet_argument) + .objet)).nombre_colonnes; j++) + { + if (((integer8 **) (*((struct_matrice *) + (*s_objet_argument).objet)).tableau)[i][j] != 0) + { + ((integer8 **) (*((struct_matrice *) + (*s_objet_resultat).objet)).tableau)[i][j] = + -((integer8 **) (*((struct_matrice *) + (*s_objet_argument).objet)).tableau)[i][j]; + } } } } @@ -320,7 +458,7 @@ instruction_neg(struct_processus *s_etat /* -------------------------------------------------------------------------------- - Opposition d'une matrice de réels + Opposition d'une matrice de réels -------------------------------------------------------------------------------- */ @@ -641,11 +779,11 @@ instruction_neg(struct_processus *s_etat ================================================================================ Fonction 'not' ================================================================================ - Entrées : pointeur sur une struct_processus + Entrées : pointeur sur une struct_processus -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- - Effets de bord : néant + Effets de bord : néant ================================================================================ */ @@ -978,11 +1116,11 @@ instruction_not(struct_processus *s_etat ================================================================================ Fonction '<>' ================================================================================ - Entrées : + Entrées : -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- - Effets de bord : néant + Effets de bord : néant ================================================================================ */ @@ -1003,9 +1141,9 @@ instruction_ne(struct_processus *s_etat_ logical1 difference; - unsigned long i; - unsigned long j; - unsigned long nombre_elements; + integer8 i; + integer8 j; + integer8 nombre_elements; (*s_etat_processus).erreur_execution = d_ex; @@ -1084,7 +1222,7 @@ instruction_ne(struct_processus *s_etat_ /* -------------------------------------------------------------------------------- - SAME NOT sur des valeurs numériques + SAME NOT sur des valeurs numériques -------------------------------------------------------------------------------- */ @@ -1182,7 +1320,7 @@ instruction_ne(struct_processus *s_etat_ /* -------------------------------------------------------------------------------- - SAME NOT portant sur des chaînes de caractères + SAME NOT portant sur des chaînes de caractères -------------------------------------------------------------------------------- */ @@ -1206,7 +1344,7 @@ instruction_ne(struct_processus *s_etat_ -------------------------------------------------------------------------------- */ /* - * Il y a de la récursivité dans l'air... + * Il y a de la récursivité dans l'air... */ else if ((((*s_objet_argument_1).type == LST) && @@ -1334,7 +1472,7 @@ instruction_ne(struct_processus *s_etat_ } /* - * Vecteurs de réels + * Vecteurs de réels */ else if (((*s_objet_argument_1).type == VRL) && @@ -1462,7 +1600,7 @@ instruction_ne(struct_processus *s_etat_ } /* - * Matrice de réels + * Matrice de réels */ else if (((*s_objet_argument_1).type == MRL) && @@ -1564,7 +1702,7 @@ instruction_ne(struct_processus *s_etat_ */ /* - * Nom ou valeur numérique / Nom ou valeur numérique + * Nom ou valeur numérique / Nom ou valeur numérique */ else if ((((*s_objet_argument_1).type == NOM) && @@ -1701,7 +1839,7 @@ instruction_ne(struct_processus *s_etat_ } /* - * Nom ou valeur numérique / Expression + * Nom ou valeur numérique / Expression */ else if (((((*s_objet_argument_1).type == ALG) || @@ -1793,7 +1931,7 @@ instruction_ne(struct_processus *s_etat_ } /* - * Expression / Nom ou valeur numérique + * Expression / Nom ou valeur numérique */ else if ((((*s_objet_argument_1).type == NOM) || @@ -2044,11 +2182,11 @@ instruction_ne(struct_processus *s_etat_ ================================================================================ Fonction 'next' ================================================================================ - Entrées : + Entrées : -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- - Effets de bord : néant + Effets de bord : néant ================================================================================ */ @@ -2124,7 +2262,7 @@ instruction_next(struct_processus *s_eta * Pour une boucle avec indice, on fait pointer * (*(*s_etat_processus).l_base_pile_systeme).indice_boucle sur * la variable correspondante. Remarque, le contenu de la variable - * est détruit au courant de l'opération. + * est détruit au courant de l'opération. */ if (presence_compteur == d_vrai) @@ -2158,7 +2296,7 @@ instruction_next(struct_processus *s_eta /* * Empilement pour calculer le nouvel indice. Au passage, la * variable (*(*s_etat_processus).l_base_pile_systeme).indice_boucle - * est libérée. + * est libérée. */ if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), @@ -2205,7 +2343,7 @@ instruction_next(struct_processus *s_eta if (presence_compteur == d_vrai) { /* - * L'addition crée si besoin une copie de l'objet + * L'addition crée si besoin une copie de l'objet */ (*(*s_etat_processus).l_base_pile_systeme).indice_boucle = NULL; @@ -2301,7 +2439,7 @@ instruction_next(struct_processus *s_eta { // FORALL if ((*(*(*s_etat_processus).l_base_pile_systeme).limite_indice_boucle) .type == NON) - { // L'objet initial était vide. + { // L'objet initial était vide. (*s_etat_processus).niveau_courant--; depilement_pile_systeme(s_etat_processus); @@ -2462,11 +2600,11 @@ instruction_next(struct_processus *s_eta ================================================================================ Fonction 'nrand' ================================================================================ - Entrées : structure processus + Entrées : structure processus ------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- - Effets de bord : néant + Effets de bord : néant ================================================================================ */