/* ================================================================================ RPL/2 (R) version 4.1.32 Copyright (C) 1989-2020 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" /* ================================================================================ Fonction 'pr1' ================================================================================ Entrées : -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_pr1(struct_processus *s_etat_processus) { struct_objet *s_objet; (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n PR1 "); if ((*s_etat_processus).langue == 'F') { printf("(impression d'un objet)\n\n"); } else { printf("(print object)\n\n"); } printf(" 1: %s, %s, %s, %s, %s, %s,\n" " %s, %s, %s, %s, %s,\n" " %s, %s, %s, %s, %s,\n" " %s\n", d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB); printf("-> 1: %s, %s, %s, %s, %s, %s,\n" " %s, %s, %s, %s, %s,\n" " %s, %s, %s, %s, %s,\n" " %s\n", d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB); 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) == d_erreur) { (*s_etat_processus).erreur_execution = d_ex_manque_argument; return; } formateur_tex(s_etat_processus, s_objet, 'N'); /* * La fonction pr1 ne modifie pas la pile */ if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), s_objet) == d_erreur) { return; } return; } /* ================================================================================ Fonction 'print' ================================================================================ Entrées : -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_print(struct_processus *s_etat_processus) { (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n PRINT "); if ((*s_etat_processus).langue == 'F') { printf("(impression puis destruction de la file d'impression)" "\n\n"); printf(" Aucun argument\n"); } else { printf("(print and purge the printer queue)\n\n"); printf(" No argument\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, 0) == d_erreur) { return; } } if ((*s_etat_processus).nom_fichier_impression == NULL) { (*s_etat_processus).erreur_execution = d_ex_queue_impression; return; } # ifdef POSTSCRIPT_SUPPORT impression_tex(s_etat_processus); # else if ((*s_etat_processus).langue == 'F') { printf("+++Attention : Support de TeX non compilé !\n"); } else { printf("+++Warning : TeX not available !\n"); } fflush(stdout); # endif return; } /* ================================================================================ Fonction 'prst' ================================================================================ Entrées : -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_prst(struct_processus *s_etat_processus) { (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n PRST "); if ((*s_etat_processus).langue == 'F') { printf("(imprime la pile opérationnelle)\n\n"); } else { printf("(print stack)\n\n"); } printf(" n: %s, %s, %s, %s, %s, %s,\n" " %s, %s, %s, %s, %s,\n" " %s, %s, %s, %s, %s,\n" " %s\n", d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX, d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB); printf(" ...\n"); printf(" 1: %s, %s, %s, %s, %s, %s,\n" " %s, %s, %s, %s, %s,\n" " %s, %s, %s, %s, %s,\n" " %s\n", d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX, d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB); printf("-> n: %s, %s, %s, %s, %s, %s,\n" " %s, %s, %s, %s, %s,\n" " %s, %s, %s, %s, %s,\n" " %s\n", d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX, d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB); printf(" ...\n"); printf(" 1: %s, %s, %s, %s, %s, %s,\n" " %s, %s, %s, %s, %s,\n" " %s, %s, %s, %s, %s,\n" " %s\n", d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX, d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB); 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, 0) == d_erreur) { return; } } routine_recursive = 2; impression_pile(s_etat_processus, (*s_etat_processus).l_base_pile, 'E', 1); routine_recursive = 0; return; } /* ================================================================================ Fonction 'prstc' ================================================================================ Entrées : -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_prstc(struct_processus *s_etat_processus) { (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n PRSTC "); if ((*s_etat_processus).langue == 'F') { printf("(imprime la pile opérationnelle en mode compact)\n\n"); } else { printf("(print stack in compact mode)\n\n"); } printf(" n: %s, %s, %s, %s, %s, %s,\n" " %s, %s, %s, %s, %s,\n" " %s, %s, %s, %s, %s,\n" " %s\n", d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX, d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB); printf(" ...\n"); printf(" 1: %s, %s, %s, %s, %s, %s,\n" " %s, %s, %s, %s, %s,\n" " %s, %s, %s, %s, %s,\n" " %s\n", d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX, d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB); printf("-> n: %s, %s, %s, %s, %s, %s,\n" " %s, %s, %s, %s, %s,\n" " %s, %s, %s, %s, %s,\n" " %s\n", d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX, d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB); printf(" ...\n"); printf(" 1: %s, %s, %s, %s, %s, %s,\n" " %s, %s, %s, %s, %s,\n" " %s, %s, %s, %s, %s,\n" " %s\n", d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX, d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB); 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, 0) == d_erreur) { return; } } routine_recursive = 2; impression_pile(s_etat_processus, (*s_etat_processus).l_base_pile, 'C', 1); routine_recursive = 0; return; } /* ================================================================================ Fonction 'prvar' ================================================================================ Entrées : -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_prvar(struct_processus *s_etat_processus) { struct_objet *s_objet; (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n PRVAR "); if ((*s_etat_processus).langue == 'F') { printf("(imprime le contenu d'une variable)\n\n"); } else { printf("(print variable)\n\n"); } printf(" 1: %s\n", d_NOM); 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) == d_erreur) { (*s_etat_processus).erreur_execution = d_ex_manque_argument; return; } if ((*s_objet).type != NOM) { liberation(s_etat_processus, s_objet); (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument; return; } if (recherche_variable(s_etat_processus, (*((struct_nom *) (*s_objet).objet)).nom) == d_faux) { (*s_etat_processus).erreur_systeme = d_es; (*s_etat_processus).erreur_execution = d_ex_variable_non_definie; liberation(s_etat_processus, s_objet); return; } if ((*(*s_etat_processus).pointeur_variable_courante).objet != NULL) { formateur_tex(s_etat_processus, (*(*s_etat_processus) .pointeur_variable_courante).objet, 'N'); } else { if (recherche_variable_partagee(s_etat_processus, (*(*s_etat_processus).pointeur_variable_courante).nom, (*(*s_etat_processus).pointeur_variable_courante) .variable_partagee, (*(*s_etat_processus) .pointeur_variable_courante).origine) == NULL) { (*s_etat_processus).erreur_systeme = d_es; (*s_etat_processus).erreur_execution = d_ex_variable_non_definie; liberation(s_etat_processus, s_objet); return; } formateur_tex(s_etat_processus, (*(*s_etat_processus) .pointeur_variable_partagee_courante).objet, 'N'); if (pthread_mutex_unlock(&((*(*s_etat_processus) .pointeur_variable_partagee_courante).mutex)) != 0) { (*s_etat_processus).erreur_systeme = d_es_processus; return; } } liberation(s_etat_processus, s_objet); return; } /* ================================================================================ Fonction 'prusr' ================================================================================ Entrées : -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_prusr(struct_processus *s_etat_processus) { integer8 i; integer8 j; integer8 nb_variables; struct_objet s_objet; struct_tableau_variables *tableau; (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n PRUSR "); if ((*s_etat_processus).langue == 'F') { printf("(impression de toutes les variables utilisateur)\n\n"); printf(" Aucun argument\n"); } else { printf("(print all user variables)\n\n"); printf(" No argument\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, 0) == d_erreur) { return; } } nb_variables = nombre_variables(s_etat_processus); if ((tableau = malloc(((size_t) nb_variables) * sizeof(struct_tableau_variables))) == NULL) { liberation_mutexes_arbre_variables_partagees(s_etat_processus, (*(*s_etat_processus).s_arbre_variables_partagees)); (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } nb_variables = liste_variables(s_etat_processus, tableau); s_objet.type = CHN; for(i = 0; i < nb_variables; i++) { if ((s_objet.objet = malloc((strlen(tableau[i].nom) + 64) * sizeof(unsigned char))) == NULL) { for(j = i; j < nb_variables; j++) { if (tableau[j].mutex != NULL) { pthread_mutex_unlock(tableau[i].mutex); } } free(tableau); (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } sprintf((unsigned char *) s_objet.objet, "\\\\noindent %s [%lld]\n", tableau[i].nom, tableau[i].niveau); if (tableau[i].mutex != NULL) { pthread_mutex_unlock(tableau[i].mutex); } formateur_tex(s_etat_processus, &s_objet, 'N'); free(s_objet.objet); } free(tableau); return; } /* ================================================================================ Fonction 'prmd' ================================================================================ Entrées : -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_prmd(struct_processus *s_etat_processus) { long i; long j; long longueur_utile; long longueur_utile_limite; struct_objet s_objet; (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n PRMD "); if ((*s_etat_processus).langue == 'F') { printf("(impression de l'état du séquenceur)\n\n"); printf(" Aucun argument\n"); } else { printf("(print sequencer state)\n\n"); printf(" No argument\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, 0) == d_erreur) { return; } } s_objet.type = CHN; if ((s_objet.objet = malloc(128 * sizeof(unsigned char))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } longueur_utile = 0; j = 1; for(i = 53; i <= 56; i++) { longueur_utile += (test_cfsf(s_etat_processus, (unsigned char) i) == d_vrai) ? j : 0; j *= 2; } longueur_utile_limite = 12; if (longueur_utile > longueur_utile_limite) { longueur_utile = longueur_utile_limite; } if ((test_cfsf(s_etat_processus, 49) == d_faux) && (test_cfsf(s_etat_processus, 50) == d_faux)) { if ((*s_etat_processus).langue == 'F') { sprintf((unsigned char *) s_objet.objet, "\\noindent Mode d'affichage numérique: standard\n"); } else { sprintf((unsigned char *) s_objet.objet, "\\noindent Numerical mode: standard\n"); } } else if ((test_cfsf(s_etat_processus, 49) == d_faux) && (test_cfsf(s_etat_processus, 50) == d_vrai)) { if ((*s_etat_processus).langue == 'F') { sprintf((unsigned char *) s_objet.objet, "\\noindent Mode d'affichage numérique: " "scientifique (%ld)\n", longueur_utile); } else { sprintf((unsigned char *) s_objet.objet, "\\noindent Numerical mode: scientific (%ld)\n", longueur_utile); } } else if ((test_cfsf(s_etat_processus, 49) == d_vrai) && (test_cfsf(s_etat_processus, 50) == d_faux)) { if ((*s_etat_processus).langue == 'F') { sprintf((unsigned char *) s_objet.objet, "\\noindent Mode d'affichage numérique: " "virgule fixe (%ld)\n", longueur_utile); } else { sprintf((unsigned char *) s_objet.objet, "\\noindent Numerical mode: fixed point (%ld)\n", longueur_utile); } } else { if ((*s_etat_processus).langue == 'F') { sprintf((unsigned char *) s_objet.objet, "\\noindent Mode d'affichage numérique: notation ingénieur " "(%ld)\n", longueur_utile); } else { sprintf((unsigned char *) s_objet.objet, "\\noindent Numerical mode: engineer " "(%ld)\n", longueur_utile); } } formateur_tex(s_etat_processus, &s_objet, 'N'); free(s_objet.objet); if ((s_objet.objet = malloc(128 * sizeof(unsigned char))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if ((*s_etat_processus).langue == 'F') { sprintf((unsigned char *) s_objet.objet, "\\noindent \\'Echelle angulaire: %s\n", (test_cfsf(s_etat_processus, 60) == d_faux) ? "degrés" : "radians"); } else { sprintf((unsigned char *) s_objet.objet, "\\noindent Angular scale: %s\n", (test_cfsf(s_etat_processus, 60) == d_faux) ? "degrees" : "radians"); } formateur_tex(s_etat_processus, &s_objet, 'N'); free(s_objet.objet); if ((s_objet.objet = malloc(128 * sizeof(unsigned char))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if ((test_cfsf(s_etat_processus, 43) == d_faux) && (test_cfsf(s_etat_processus, 44) == d_faux)) { if ((*s_etat_processus).langue == 'F') { sprintf((unsigned char *) s_objet.objet, "\\noindent Base des entiers : décimale\n"); } else { sprintf((unsigned char *) s_objet.objet, "\\noindent Integer base: decimal\n"); } } else if ((test_cfsf(s_etat_processus, 43) == d_vrai) && (test_cfsf(s_etat_processus, 44) == d_faux)) { if ((*s_etat_processus).langue == 'F') { sprintf((unsigned char *) s_objet.objet, "\\noindent Base des entiers : octale\n"); } else { sprintf((unsigned char *) s_objet.objet, "\\noindent Integer base: octal\n"); } } else if ((test_cfsf(s_etat_processus, 43) == d_vrai) && (test_cfsf(s_etat_processus, 44) == d_vrai)) { if ((*s_etat_processus).langue == 'F') { sprintf((unsigned char *) s_objet.objet, "\\noindent Base des entiers : hexadécimale\n"); } else { sprintf((unsigned char *) s_objet.objet, "\\noindent Integer base: hexadecimal\n"); } } else { if ((*s_etat_processus).langue == 'F') { sprintf((unsigned char *) s_objet.objet, "\\noindent Base des entiers : binaire\n"); } else { sprintf((unsigned char *) s_objet.objet, "\\noindent Integer base: binary\n"); } } formateur_tex(s_etat_processus, &s_objet, 'N'); free(s_objet.objet); if ((s_objet.objet = malloc(128 * sizeof(unsigned char))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if ((*s_etat_processus).langue == 'F') { sprintf((unsigned char *) s_objet.objet, "\\noindent Longueur des entiers : %d bits\n", longueur_entiers_binaires(s_etat_processus)); } else { sprintf((unsigned char *) s_objet.objet, "\\noindent Length of integers: %d bits\n", longueur_entiers_binaires(s_etat_processus)); } formateur_tex(s_etat_processus, &s_objet, 'N'); free(s_objet.objet); if ((s_objet.objet = malloc(128 * sizeof(unsigned char))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if ((*s_etat_processus).langue == 'F') { sprintf((unsigned char *) s_objet.objet, "\\noindent Séparateur décimal: %s\n", (test_cfsf(s_etat_processus, 48) == d_faux) ? "point" : "virgule"); } else { sprintf((unsigned char *) s_objet.objet, "\\noindent Radix: %s\n", (test_cfsf(s_etat_processus, 48) == d_faux) ? "period" : "coma"); } formateur_tex(s_etat_processus, &s_objet, 'N'); free(s_objet.objet); return; } /* ================================================================================ Fonction 'pmin' ================================================================================ Entrées : -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_pmin(struct_processus *s_etat_processus) { struct_objet *s_objet; (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n PMIN "); if ((*s_etat_processus).langue == 'F') { printf("(minima d'un graphique 2D)\n\n"); } else { printf("(2D-graphic minima)\n\n"); } printf(" 1: %s\n", d_CPL); 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) == d_erreur) { (*s_etat_processus).erreur_execution = d_ex_manque_argument; return; } if ((*s_objet).type == CPL) { if ((*s_etat_processus).systeme_axes == 0) { (*s_etat_processus).x_min = (*((complex16 *) (*s_objet).objet)) .partie_reelle; (*s_etat_processus).y_min = (*((complex16 *) (*s_objet).objet)) .partie_imaginaire; } else { (*s_etat_processus).x2_min = (*((complex16 *) (*s_objet).objet)) .partie_reelle; (*s_etat_processus).y2_min = (*((complex16 *) (*s_objet).objet)) .partie_imaginaire; } } else { liberation(s_etat_processus, s_objet); (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument; return; } liberation(s_etat_processus, s_objet); if (test_cfsf(s_etat_processus, 52) == d_faux) { if ((*s_etat_processus).fichiers_graphiques != NULL) { appel_gnuplot(s_etat_processus, 'N'); } } return; } /* ================================================================================ Fonction 'pmax' ================================================================================ Entrées : -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_pmax(struct_processus *s_etat_processus) { struct_objet *s_objet; (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n PMAX "); if ((*s_etat_processus).langue == 'F') { printf("(maxima d'un graphique 2D)\n\n"); } else { printf("(2D-graphic maxima)\n\n"); } printf(" 1: %s\n", d_CPL); 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) == d_erreur) { (*s_etat_processus).erreur_execution = d_ex_manque_argument; return; } if ((*s_objet).type == CPL) { if ((*s_etat_processus).systeme_axes == 0) { (*s_etat_processus).x_max = (*((complex16 *) (*s_objet).objet)) .partie_reelle; (*s_etat_processus).y_max = (*((complex16 *) (*s_objet).objet)) .partie_imaginaire; } else { (*s_etat_processus).x2_max = (*((complex16 *) (*s_objet).objet)) .partie_reelle; (*s_etat_processus).y2_max = (*((complex16 *) (*s_objet).objet)) .partie_imaginaire; } } else { liberation(s_etat_processus, s_objet); (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument; return; } liberation(s_etat_processus, s_objet); if (test_cfsf(s_etat_processus, 52) == d_faux) { if ((*s_etat_processus).fichiers_graphiques != NULL) { appel_gnuplot(s_etat_processus, 'N'); } } return; } /* ================================================================================ Fonction 'persist' ================================================================================ Entrées : -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_persist(struct_processus *s_etat_processus) { (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n PERSIST "); if ((*s_etat_processus).langue == 'F') { printf("(détachement d'un graphique)\n\n"); printf(" Aucun argument\n"); } else { printf("(spawn a graphic output)\n\n"); printf(" No argument\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, 0) == d_erreur) { return; } } appel_gnuplot(s_etat_processus, 'E'); return; } /* ================================================================================ Fonction 'polar' (passe en mode d'affichage r=f(t)) ================================================================================ Entrées : structure processus -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_polar(struct_processus *s_etat_processus) { (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n POLAR "); if ((*s_etat_processus).langue == 'F') { printf("(tracé théta=f(r))\n\n"); printf(" Aucun argument\n"); } else { printf("(plot theta=f(r))\n\n"); printf(" No argument\n"); } return; } else if ((*s_etat_processus).test_instruction == 'Y') { (*s_etat_processus).nombre_arguments = -1; return; } strcpy((*s_etat_processus).type_trace_eq, "POLAIRE"); return; } /* ================================================================================ Fonction 'parametric' (passe en mode d'affichage r=f(t)) ================================================================================ Entrées : structure processus -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_parametric(struct_processus *s_etat_processus) { (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n PARAMETRIC "); if ((*s_etat_processus).langue == 'F') { printf("(tracé (x,y)=f(t)+i*g(t))\n\n"); printf(" Aucun argument\n"); } else { printf("(plot (x,y)=f(t)+i*g(t))\n\n"); printf(" No argument\n"); } return; } else if ((*s_etat_processus).test_instruction == 'Y') { (*s_etat_processus).nombre_arguments = -1; return; } strcpy((*s_etat_processus).type_trace_eq, "PARAMETRIQUE"); return; } /* ================================================================================ Fonction 'perm' ================================================================================ Entrées : -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_perm(struct_processus *s_etat_processus) { integer8 k; integer8 n; integer8 cint_max; real8 c; struct_objet *s_objet_argument_1; struct_objet *s_objet_argument_2; struct_objet *s_objet_resultat; unsigned long i; (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n PERM "); if ((*s_etat_processus).langue == 'F') { printf("(permutation)\n\n"); } else { printf("(permutation)\n\n"); } printf(" 2: %s\n", d_INT); printf(" 1: %s\n", d_INT); printf("-> 1: %s, %s\n", d_INT, d_REL); return; } else if ((*s_etat_processus).test_instruction == 'Y') { (*s_etat_processus).nombre_arguments = 2; return; } if (test_cfsf(s_etat_processus, 31) == d_vrai) { if (empilement_pile_last(s_etat_processus, 2) == d_erreur) { return; } } if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), &s_objet_argument_1) == d_erreur) { (*s_etat_processus).erreur_execution = d_ex_manque_argument; return; } if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), &s_objet_argument_2) == d_erreur) { liberation(s_etat_processus, s_objet_argument_1); (*s_etat_processus).erreur_execution = d_ex_manque_argument; return; } if (((*s_objet_argument_1).type == INT) && ((*s_objet_argument_2).type == INT)) { n = (*((integer8 *) (*s_objet_argument_2).objet)); k = (*((integer8 *) (*s_objet_argument_1).objet)); if ((n < 0) || (k < 0) || (k > n)) { liberation(s_etat_processus, s_objet_argument_1); liberation(s_etat_processus, s_objet_argument_2); (*s_etat_processus).erreur_execution = d_ex_argument_invalide; return; } f90arrangement(&n, &k, &c); for(i = 1, cint_max = 1; i < (8 * sizeof(integer8)) - 1; cint_max = (cint_max << 1) + 1, i++); if (c > cint_max) { 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)) = c; } else { if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if (abs(c - floor(c)) < fabs(ceil(c) - c)) { (*((integer8 *) (*s_objet_resultat).objet)) = (integer8) floor(c); } else { (*((integer8 *) (*s_objet_resultat).objet)) = 1 + (integer8) floor(c); } } } else { liberation(s_etat_processus, s_objet_argument_1); liberation(s_etat_processus, s_objet_argument_2); (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument; return; } liberation(s_etat_processus, s_objet_argument_1); liberation(s_etat_processus, s_objet_argument_2); if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), s_objet_resultat) == d_erreur) { return; } return; } /* ================================================================================ Fonction 'psdev' ================================================================================ Entrées : -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_psdev(struct_processus *s_etat_processus) { struct_objet *s_objet_statistique; struct_objet *s_objet_resultat; struct_objet *s_objet_temporaire; integer8 nombre_colonnes; (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n PSDEV "); if ((*s_etat_processus).langue == 'F') { printf("(écart-type d'une population)\n\n"); } else { printf("(population standard deviation)\n\n"); } printf("-> 1: %s, %s, %s, %s\n", d_INT, d_REL, d_VIN, d_VRL); 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, 0) == d_erreur) { return; } } /* * Recherche d'une variable globale référencée par SIGMA */ if (recherche_variable_globale(s_etat_processus, ds_sdat) == d_faux) { /* * Aucune variable SIGMA */ (*s_etat_processus).erreur_systeme = d_es; if ((*s_etat_processus).erreur_execution == d_ex) { (*s_etat_processus).erreur_execution = d_ex_absence_observations; } return; } else { if (((*(*(*s_etat_processus).pointeur_variable_courante).objet) .type != MIN) && ((*(*(*s_etat_processus) .pointeur_variable_courante).objet).type != MRL)) { (*s_etat_processus).erreur_execution = d_ex_matrice_statistique_invalide; return; } nombre_colonnes = (*((struct_matrice *) (*(*(*s_etat_processus) .pointeur_variable_courante).objet).objet)).nombre_colonnes; } s_objet_statistique = (*(*s_etat_processus).pointeur_variable_courante) .objet; if (((*s_objet_statistique).type == MIN) || ((*s_objet_statistique).type == MRL)) { if ((s_objet_resultat = allocation(s_etat_processus, NON)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if (((*s_objet_resultat).objet = ecart_type_statistique( s_etat_processus, (struct_matrice *) (*s_objet_statistique).objet, 'P')) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if (nombre_colonnes == 1) { if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I') { (*s_objet_resultat).type = VIN; s_objet_temporaire = s_objet_resultat; if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((integer8 *) (*s_objet_resultat).objet)) = ((integer8 *) (*((struct_vecteur *) (*s_objet_temporaire).objet)).tableau)[0]; liberation(s_etat_processus, s_objet_temporaire); } else { (*s_objet_resultat).type = VRL; s_objet_temporaire = s_objet_resultat; 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 *) (*((struct_vecteur *) (*s_objet_temporaire).objet)).tableau)[0]; liberation(s_etat_processus, s_objet_temporaire); } } else { if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I') { (*s_objet_resultat).type = VIN; } else { (*s_objet_resultat).type = VRL; } } if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), s_objet_resultat) == d_erreur) { return; } } else { (*s_etat_processus).erreur_execution = d_ex_matrice_statistique_invalide; return; } return; } /* ================================================================================ Fonction 'pvar' ================================================================================ Entrées : -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_pvar(struct_processus *s_etat_processus) { struct_objet *s_objet_statistique; struct_objet *s_objet_resultat; struct_objet *s_objet_temporaire; integer8 nombre_colonnes; (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n PVAR "); if ((*s_etat_processus).langue == 'F') { printf("(variance d'une population)\n\n"); } else { printf("(population variance)\n\n"); } printf("-> 1: %s, %s, %s, %s\n", d_INT, d_REL, d_VIN, d_VRL); 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, 0) == d_erreur) { return; } } /* * Recherche d'une variable globale référencée par SIGMA */ if (recherche_variable_globale(s_etat_processus, ds_sdat) == d_faux) { /* * Aucune variable SIGMA */ (*s_etat_processus).erreur_systeme = d_es; if ((*s_etat_processus).erreur_execution == d_ex) { (*s_etat_processus).erreur_execution = d_ex_absence_observations; } return; } else { if (((*(*(*s_etat_processus).pointeur_variable_courante).objet) .type != MIN) && ((*(*(*s_etat_processus) .pointeur_variable_courante).objet).type != MRL)) { (*s_etat_processus).erreur_execution = d_ex_matrice_statistique_invalide; return; } nombre_colonnes = (*((struct_matrice *) (*(*(*s_etat_processus) .pointeur_variable_courante).objet).objet)).nombre_colonnes; } s_objet_statistique = (*(*s_etat_processus).pointeur_variable_courante) .objet; if (((*s_objet_statistique).type == MIN) || ((*s_objet_statistique).type == MRL)) { if ((s_objet_resultat = allocation(s_etat_processus, NON)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if (((*s_objet_resultat).objet = variance_statistique(s_etat_processus, (struct_matrice *) (*s_objet_statistique).objet, 'P')) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if (nombre_colonnes == 1) { if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I') { (*s_objet_resultat).type = VIN; s_objet_temporaire = s_objet_resultat; if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((integer8 *) (*s_objet_resultat).objet)) = ((integer8 *) (*((struct_vecteur *) (*s_objet_temporaire).objet)).tableau)[0]; liberation(s_etat_processus, s_objet_temporaire); } else { (*s_objet_resultat).type = VRL; s_objet_temporaire = s_objet_resultat; 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 *) (*((struct_vecteur *) (*s_objet_temporaire).objet)).tableau)[0]; liberation(s_etat_processus, s_objet_temporaire); } } else { if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I') { (*s_objet_resultat).type = VIN; } else { (*s_objet_resultat).type = VRL; } } if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), s_objet_resultat) == d_erreur) { return; } } else { (*s_etat_processus).erreur_execution = d_ex_matrice_statistique_invalide; return; } return; } // vim: ts=4