/* ================================================================================ RPL/2 (R) version 4.1.19 Copyright (C) 1989-2015 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 'FORMAT' ================================================================================ Entrées : structure processus -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_format(struct_processus *s_etat_processus) { struct_objet *s_copie_argument_1; struct_objet *s_objet_argument_1; struct_objet *s_objet_argument_2; (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n FORMAT "); if ((*s_etat_processus).langue == 'F') { printf("(associe un format à un descripteur de fichier " "ou à une socket)\n\n"); } else { printf("(associate a format to a file or socket descriptor)\n\n"); } printf(" 2: %s\n", d_LST); printf(" 1: %s, %s\n", d_FCH, d_SCK); printf("-> 1: %s, %s\n\n", d_FCH, d_SCK); if ((*s_etat_processus).langue == 'F') { printf(" Utilisation :\n\n"); } else { printf(" Usage:\n\n"); } printf(" { \"STANDARD*(*)\" }\n"); printf(" { { \"NAME\" \"lambda\" } \"SEQUENTIAL\" \"NEW\"" "\"WRITEONLY\" \"FORMATTED\" } OPEN\n FORMAT\n\n"); if ((*s_etat_processus).langue == 'F') { printf(" Formats autorisés :\n\n"); } else { printf(" Authorized formats:\n\n"); } printf(" FORMATTED\n"); printf(" { \"STANDARD*(*)\" }\n"); printf(" { \"STANDARD*(%s)\" }\n", d_INT); printf(" { \"FIXED*%s(*)\" }\n", d_INT); printf(" { \"FIXED*%s(%s)}\n", d_INT, d_INT); printf(" { \"SCIENTIFIC*%s(*)\" }\n", d_INT); printf(" { \"SCIENTIFIC*%s(%s)\" }\n", d_INT, d_INT); printf(" { \"ENGINEER*%s(*)\" }\n", d_INT); printf(" { \"ENGINEER*%s(%s)\" }\n", d_INT, d_INT); printf(" { \"CHARACTER*(*)\" }\n"); printf(" { \"CHARACTER*(%s)\" }\n", d_INT); printf(" { \"BINARY*%s(*)\" }\n", d_INT); printf(" { \"BINARY*%s(%s)\" }\n", d_INT, d_INT); printf(" { \"NATIVE*(*)\" }\n\n"); printf(" UNFORMATTED\n"); printf(" { \"INTEGER*1\", \"INTEGER*2\", \"INTEGER*4\", " "\"INTEGER*8\" }\n"); printf(" { \"LOGICAL*1\", \"LOGICAL*2\", \"LOGICAL*4\", " "\"LOGICAL*8\" }\n"); printf(" { \"REAL*4\", \"REAL*8\" }\n"); printf(" { \"COMPLEX*8\", \"COMPLEX*16\" }\n"); printf(" { \"CHARACTER*(*)\", \"CHARACTER*(%s)\" }\n", d_INT); printf(" { \"NATIVE*(*)\" }\n\n"); printf(" FLOW\n"); printf(" { \"LENGTH*(*)\" }\n"); printf(" { \"LENGTH*(%s)\" }\n", d_INT); 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, 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 == FCH) && ((*s_objet_argument_2).type == LST)) { if ((s_copie_argument_1 = copie_objet(s_etat_processus, s_objet_argument_1, 'N')) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } liberation(s_etat_processus, s_objet_argument_1); s_objet_argument_1 = s_copie_argument_1; liberation(s_etat_processus, (*((struct_fichier *) (*s_objet_argument_1).objet)).format); (*((struct_fichier *) (*s_objet_argument_1).objet)).format = s_objet_argument_2; } else if (((*s_objet_argument_1).type == SCK) && ((*s_objet_argument_2).type == LST)) { if ((s_copie_argument_1 = copie_objet(s_etat_processus, s_objet_argument_1, 'N')) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } liberation(s_etat_processus, s_objet_argument_1); s_objet_argument_1 = s_copie_argument_1; liberation(s_etat_processus, (*((struct_socket *) (*s_objet_argument_1).objet)).format); (*((struct_socket *) (*s_objet_argument_1).objet)).format = s_objet_argument_2; } 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; } if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), s_objet_argument_1) == d_erreur) { return; } return; } /* ================================================================================ Fonction '->LCD' ================================================================================ Entrées : structure processus -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_fleche_lcd(struct_processus *s_etat_processus) { file *fichier_destination; file *fichier_source; int caractere; int dimensions; integer8 systeme_axes; logical1 axes; struct_fichier_graphique *l_fichier_courant; struct_objet *s_objet_argument; unsigned char drapeau_axes; unsigned char *nom_fichier; unsigned char type[21]; (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n ->LCD "); if ((*s_etat_processus).langue == 'F') { printf("(lecture d'un fichier graphique)\n\n"); } else { printf("(read a graphical file)\n\n"); } printf(" 1: %s\n", d_CHN); 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 (fflush(NULL) != 0) { (*s_etat_processus).erreur_systeme = d_es_erreur_fichier; return; } if ((fichier_source = fopen((unsigned char *) (*s_objet_argument).objet, "r")) == NULL) { liberation(s_etat_processus, s_objet_argument); (*s_etat_processus).erreur_execution = d_ex_erreur_fichier; return; } fichier_destination = NULL; while((caractere = getc(fichier_source)) != EOF) { if (caractere == '@') { /* Création d'un nouveau fichier */ if (fichier_destination != NULL) { if (fclose(fichier_destination) != 0) { (*s_etat_processus).erreur_systeme = d_es_erreur_fichier; return; } } if (fscanf(fichier_source, " %c %d %lld %s", &drapeau_axes, &dimensions, &systeme_axes, type) != 4) { (*s_etat_processus).erreur_systeme = d_es_erreur_fichier; return; } axes = (drapeau_axes == 'T') ? d_vrai : d_faux; if ((nom_fichier = creation_nom_fichier(s_etat_processus, (*s_etat_processus).chemin_fichiers_temporaires)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_erreur_fichier; return; } if ((fichier_destination = fopen(nom_fichier, "w")) == NULL) { (*s_etat_processus).erreur_systeme = d_es_erreur_fichier; return; } /* Chaînage */ l_fichier_courant = (*s_etat_processus).fichiers_graphiques; if (l_fichier_courant == NULL) { if (((*s_etat_processus).fichiers_graphiques = malloc(sizeof(struct_fichier_graphique))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*(*s_etat_processus).fichiers_graphiques).suivant = NULL; (*(*s_etat_processus).fichiers_graphiques).nom = nom_fichier; (*(*s_etat_processus).fichiers_graphiques).legende = NULL; (*(*s_etat_processus).fichiers_graphiques).presence_axes = axes; (*(*s_etat_processus).fichiers_graphiques).dimensions = dimensions; (*(*s_etat_processus).fichiers_graphiques).systeme_axes = systeme_axes; strcpy((*(*s_etat_processus).fichiers_graphiques).type, type); } else { while((*l_fichier_courant).suivant != NULL) { l_fichier_courant = (*l_fichier_courant).suivant; } if (((*l_fichier_courant).suivant = malloc(sizeof(struct_fichier_graphique))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } l_fichier_courant = (*l_fichier_courant).suivant; (*l_fichier_courant).suivant = NULL; (*l_fichier_courant).nom = nom_fichier; (*l_fichier_courant).legende = NULL; (*l_fichier_courant).presence_axes = axes; (*l_fichier_courant).dimensions = dimensions; (*l_fichier_courant).systeme_axes = systeme_axes; strcpy((*l_fichier_courant).type, type); } } else { if (putc(caractere, fichier_destination) == EOF) { (*s_etat_processus).erreur_systeme = d_es_erreur_fichier; return; } } } if (fichier_destination != NULL) { if (fclose(fichier_destination) != 0) { (*s_etat_processus).erreur_systeme = d_es_erreur_fichier; return; } } if (fclose(fichier_source) != 0) { (*s_etat_processus).erreur_systeme = d_es_erreur_fichier; return; } } 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); appel_gnuplot(s_etat_processus, 'N'); return; } /* ================================================================================ Fonction '->Q' ================================================================================ Entrées : structure processus -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_fleche_q(struct_processus *s_etat_processus) { double epsilon; struct_liste_chainee *l_element_courant; struct_objet *s_objet_argument; struct_objet *s_objet_argument_1; struct_objet *s_objet_argument_2; struct_objet *s_objet_resultat; real8 f; real8 objectif; real8 r1; real8 r2; real8 s1; real8 s2; real8 t1; real8 t2; real8 x; real8 y; real8 z; (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n ->Q "); if ((*s_etat_processus).langue == 'F') { printf("(transformation d'un réel en rationnel)\n\n"); } else { printf("(transform a real into a rational)\n\n"); } printf(" 1: %s\n", d_INT); printf("-> 1: %s\n\n", d_INT); printf(" 1: %s\n", d_REL); printf("-> 1: %s\n", d_ALG); 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 == INT) { s_objet_resultat = s_objet_argument; s_objet_argument = NULL; } else if ((*s_objet_argument).type == REL) { x = (*((real8 *) (*s_objet_argument).objet)); objectif = x; epsilon = nextafter(-abs(x), 0) + abs(x); r1 = 1; r2 = 0; s1 = 0; s2 = 1; do { f = floor(x); t1 = r1; t2 = r2; r1 = (f * r1) + s1; r2 = (f * r2) + s2; s1 = t1; s2 = t2; y = x - f; if (y != 0) { z = abs(objectif - (r1 / r2)); x = ((real8) 1) / y; } else { z = 0; } } while(z > epsilon); if (r2 != ((real8) ((integer8) r2))) { if ((s_objet_argument_1 = allocation(s_etat_processus, REL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((real8 *) (*s_objet_argument_1).objet)) = r2; } else { if ((s_objet_argument_1 = allocation(s_etat_processus, INT)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((integer8 *) (*s_objet_argument_1).objet)) = (integer8) r2; } if (r1 != ((real8) ((integer8) r1))) { if ((s_objet_argument_2 = allocation(s_etat_processus, REL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((real8 *) (*s_objet_argument_2).objet)) = r1; } else { if ((s_objet_argument_2 = allocation(s_etat_processus, INT)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((integer8 *) (*s_objet_argument_2).objet)) = (integer8) r1; } if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if (((*s_objet_resultat).objet = allocation_maillon(s_etat_processus)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } l_element_courant = (*s_objet_resultat).objet; if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nombre_arguments = 0; (*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .fonction = instruction_vers_niveau_superieur; if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nom_fonction, "<<"); if (((*l_element_courant).suivant = allocation_maillon(s_etat_processus)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } l_element_courant = (*l_element_courant).suivant; (*l_element_courant).donnee = s_objet_argument_2; if (((*l_element_courant).suivant = allocation_maillon(s_etat_processus)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } l_element_courant = (*l_element_courant).suivant; (*l_element_courant).donnee = s_objet_argument_1; if (((*l_element_courant).suivant = allocation_maillon(s_etat_processus)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } l_element_courant = (*l_element_courant).suivant; if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nombre_arguments = 0; (*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .fonction = instruction_division; if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nom_fonction = malloc(2 * sizeof(unsigned char))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nom_fonction, "/"); if (((*l_element_courant).suivant = allocation_maillon(s_etat_processus)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } l_element_courant = (*l_element_courant).suivant; if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nombre_arguments = 0; (*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .fonction = instruction_vers_niveau_inferieur; if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nom_fonction, ">>"); (*l_element_courant).suivant = NULL; s_objet_argument_1 = NULL; s_objet_argument_2 = NULL; liberation(s_etat_processus, s_objet_argument_1); liberation(s_etat_processus, s_objet_argument_2); } else { liberation(s_etat_processus, s_objet_argument); (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument; return; } if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), s_objet_resultat) == d_erreur) { return; } liberation(s_etat_processus, s_objet_argument); return; } /* ================================================================================ Fonction '->ROW' ================================================================================ Entrées : structure processus -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_fleche_row(struct_processus *s_etat_processus) { integer8 i; integer8 j; integer8 nombre_colonnes; integer8 nombre_lignes; struct_liste_chainee *l_element_courant; struct_objet *s_objet; struct_objet *s_objet_resultat; unsigned char type; (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n ->ROW "); if ((*s_etat_processus).langue == 'F') { printf("(construction d'une matrice à partir de ses lignes)\n\n"); } else { printf("(build a matrix from rows)\n\n"); } printf(" n: %s, %s, %s\n", d_MIN, d_MRL, d_MCX); printf(" ...\n"); printf(" 2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX); printf(" 1: %s\n", d_INT); printf("-> 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX); 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).hauteur_pile_operationnelle == 0) { (*s_etat_processus).erreur_execution = d_ex_manque_argument; return; } if ((*(*(*s_etat_processus).l_base_pile).donnee).type != INT) { (*s_etat_processus).erreur_execution = d_ex_argument_invalide; return; } nombre_lignes = (*((integer8 *) (*(*(*s_etat_processus).l_base_pile) .donnee).objet)); if (nombre_lignes <= 0) { /* * Nombre lignes négatif ou nul, l'opération est absurde. */ (*s_etat_processus).erreur_execution = d_ex_argument_invalide; return; } if (nombre_lignes >= (integer8) (*s_etat_processus) .hauteur_pile_operationnelle) { (*s_etat_processus).erreur_execution = d_ex_manque_argument; return; } /* * Traitement de la pile last le cas échéant. */ if (test_cfsf(s_etat_processus, 31) == d_vrai) { if (empilement_pile_last(s_etat_processus, nombre_lignes + 1) == d_erreur) { return; } } /* * Retrait de l'objet indiquant le nombre de lignes. */ if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), &s_objet) == d_erreur) { return; } liberation(s_etat_processus, s_objet); /* * Recherche du type de la matrice finale. */ type = 'I'; l_element_courant = (*s_etat_processus).l_base_pile; nombre_colonnes = 0; for(i = 0; i < nombre_lignes; i++) { if (((*(*l_element_courant).donnee).type != MIN) && ((*(*l_element_courant).donnee).type != MRL) && ((*(*l_element_courant).donnee).type != MCX)) { /* * Problème : on vient de tirer autre chose qu'une matrice * dans la pile. */ (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument; return; } if ((*((struct_matrice *) (*(*l_element_courant).donnee).objet)) .nombre_lignes != 1) { /* * La matrice n'est pas une matrice ligne. */ (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides; return; } if (i == 0) { nombre_colonnes = (*((struct_matrice *) (*(*l_element_courant) .donnee).objet)).nombre_colonnes; } else { if (nombre_colonnes != (integer8) (*((struct_matrice *) (*(*l_element_courant).donnee).objet)).nombre_colonnes) { /* * La dernière matrice observée n'a pas les mêmes dimensions * (nombre de colonnes) que les précédentes. */ (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides; return; } } if (type == 'I') { if ((*(*l_element_courant).donnee).type == MRL) { type = 'R'; } else if ((*(*l_element_courant).donnee).type == MCX) { type = 'C'; } } else if (type == 'R') { if ((*(*l_element_courant).donnee).type == MCX) { type = 'C'; } } l_element_courant = (*l_element_courant).suivant; } if (type == 'I') { if ((s_objet_resultat = allocation(s_etat_processus, MIN)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes = nombre_colonnes; (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes = nombre_lignes; if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau = malloc(((size_t) nombre_lignes) * sizeof(integer8 *))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } for(i = nombre_lignes - 1; i >= 0; i--) { if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), &s_objet) == d_erreur) { return; } if ((((integer8 **) (*((struct_matrice *) (*s_objet_resultat) .objet)).tableau)[i] = malloc(((size_t) nombre_colonnes) * sizeof(integer8))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } for(j = 0; j < nombre_colonnes; j++) { ((integer8 **) (*((struct_matrice *) (*s_objet_resultat) .objet)).tableau)[i][j] = ((integer8 **) (*((struct_matrice *) (*s_objet).objet)).tableau)[0][j]; } liberation(s_etat_processus, s_objet); } } else if (type == 'R') { if ((s_objet_resultat = allocation(s_etat_processus, MRL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes = nombre_colonnes; (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes = nombre_lignes; if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau = malloc(((size_t) nombre_lignes) * sizeof(real8 *))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } for(i = nombre_lignes - 1; i >= 0; i--) { if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), &s_objet) == d_erreur) { return; } if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat) .objet)).tableau)[i] = malloc(((size_t) nombre_colonnes) * sizeof(real8))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if ((*s_objet).type == MIN) { for(j = 0; j < nombre_colonnes; j++) { ((real8 **) (*((struct_matrice *) (*s_objet_resultat) .objet)).tableau)[i][j] = (real8) ((integer8 **) (*((struct_matrice *) (*s_objet).objet)) .tableau)[0][j]; } } else { for(j = 0; j < nombre_colonnes; j++) { ((real8 **) (*((struct_matrice *) (*s_objet_resultat) .objet)).tableau)[i][j] = ((real8 **) (*((struct_matrice *) (*s_objet).objet)) .tableau)[0][j]; } } liberation(s_etat_processus, s_objet); } } else { if ((s_objet_resultat = allocation(s_etat_processus, MCX)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes = nombre_colonnes; (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes = nombre_lignes; if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau = malloc(((size_t) nombre_lignes) * sizeof(complex16 *))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } for(i = nombre_lignes - 1; i >= 0; i--) { if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), &s_objet) == d_erreur) { return; } if ((((complex16 **) (*((struct_matrice *) (*s_objet_resultat) .objet)).tableau)[i] = malloc(((size_t) nombre_colonnes) * sizeof(complex16))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if ((*s_objet).type == MIN) { for(j = 0; j < nombre_colonnes; j++) { (((complex16 **) (*((struct_matrice *) (*s_objet_resultat) .objet)).tableau)[i][j]).partie_reelle = (real8) ((integer8 **) (*((struct_matrice *) (*s_objet).objet)).tableau)[0][j]; (((complex16 **) (*((struct_matrice *) (*s_objet_resultat) .objet)).tableau)[i][j]).partie_imaginaire = 0; } } else if ((*s_objet).type == MRL) { for(j = 0; j < nombre_colonnes; j++) { (((complex16 **) (*((struct_matrice *) (*s_objet_resultat) .objet)).tableau)[i][j]).partie_reelle = ((real8 **) (*((struct_matrice *) (*s_objet).objet)).tableau)[0][j]; (((complex16 **) (*((struct_matrice *) (*s_objet_resultat) .objet)).tableau)[i][j]).partie_imaginaire = 0; } } else { for(j = 0; j < nombre_colonnes; j++) { (((complex16 **) (*((struct_matrice *) (*s_objet_resultat) .objet)).tableau)[i][j]).partie_reelle = (((complex16 **) (*((struct_matrice *) (*s_objet).objet)).tableau)[0][j]) .partie_reelle; (((complex16 **) (*((struct_matrice *) (*s_objet_resultat) .objet)).tableau)[i][j]).partie_imaginaire = (((complex16 **) (*((struct_matrice *) (*s_objet).objet)).tableau)[0][j]) .partie_imaginaire; } } liberation(s_etat_processus, s_objet); } } if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), s_objet_resultat) == d_erreur) { return; } return; } /* ================================================================================ Fonction '->COL' ================================================================================ Entrées : structure processus -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_fleche_col(struct_processus *s_etat_processus) { integer8 i; integer8 j; integer8 nombre_colonnes; integer8 nombre_lignes; struct_liste_chainee *l_element_courant; struct_objet *s_objet; struct_objet *s_objet_resultat; unsigned char type; (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n ->COL "); if ((*s_etat_processus).langue == 'F') { printf("(construction d'une matrice à partir de ses colonnes)\n\n"); } else { printf("(build a matrix from columns)\n\n"); } printf(" n: %s, %s, %s\n", d_MIN, d_MRL, d_MCX); printf(" ...\n"); printf(" 2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX); printf(" 1: %s\n", d_INT); printf("-> 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX); 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).hauteur_pile_operationnelle == 0) { (*s_etat_processus).erreur_execution = d_ex_manque_argument; return; } if ((*(*(*s_etat_processus).l_base_pile).donnee).type != INT) { (*s_etat_processus).erreur_execution = d_ex_argument_invalide; return; } nombre_colonnes = (*((integer8 *) (*(*(*s_etat_processus).l_base_pile) .donnee).objet)); if (nombre_colonnes <= 0) { /* * Nombre lignes négatif ou nul, l'opération est absurde. */ (*s_etat_processus).erreur_execution = d_ex_argument_invalide; return; } if (nombre_colonnes >= (integer8) (*s_etat_processus) .hauteur_pile_operationnelle) { (*s_etat_processus).erreur_execution = d_ex_manque_argument; return; } /* * Traitement de la pile last le cas échéant. */ if (test_cfsf(s_etat_processus, 31) == d_vrai) { if (empilement_pile_last(s_etat_processus, nombre_colonnes + 1) == d_erreur) { return; } } /* * Retrait de l'objet indiquant le nombre de lignes. */ if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), &s_objet) == d_erreur) { return; } liberation(s_etat_processus, s_objet); /* * Recherche du type de la matrice finale. */ type = 'I'; l_element_courant = (*s_etat_processus).l_base_pile; nombre_lignes = 0; for(i = 0; i < nombre_colonnes; i++) { if (((*(*l_element_courant).donnee).type != MIN) && ((*(*l_element_courant).donnee).type != MRL) && ((*(*l_element_courant).donnee).type != MCX)) { /* * Problème : on vient de tirer autre chose qu'une matrice * dans la pile. */ (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument; return; } if ((*((struct_matrice *) (*(*l_element_courant).donnee).objet)) .nombre_colonnes != 1) { /* * La matrice n'est pas une matrice colonne. */ (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides; return; } if (i == 0) { nombre_lignes = (*((struct_matrice *) (*(*l_element_courant) .donnee).objet)).nombre_lignes; } else { if (nombre_lignes != (integer8) (*((struct_matrice *) (*(*l_element_courant).donnee).objet)).nombre_lignes) { /* * La dernière matrice observée n'a pas les mêmes dimensions * (nombre de colonnes) que les précédentes. */ (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides; return; } } if (type == 'I') { if ((*(*l_element_courant).donnee).type == MRL) { type = 'R'; } else if ((*(*l_element_courant).donnee).type == MCX) { type = 'C'; } } else if (type == 'R') { if ((*(*l_element_courant).donnee).type == MCX) { type = 'C'; } } l_element_courant = (*l_element_courant).suivant; } if (type == 'I') { if ((s_objet_resultat = allocation(s_etat_processus, MIN)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes = nombre_colonnes; (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes = nombre_lignes; if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau = malloc(((size_t) nombre_lignes) * sizeof(integer8 *))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } for(i = 0; i < nombre_lignes; i++) { if ((((integer8 **) (*((struct_matrice *) (*s_objet_resultat) .objet)).tableau)[i] = malloc(((size_t) nombre_colonnes) * sizeof(integer8))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } } for(j = nombre_colonnes - 1; j >= 0; j--) { if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), &s_objet) == d_erreur) { return; } for(i = 0; i < nombre_lignes; i++) { ((integer8 **) (*((struct_matrice *) (*s_objet_resultat) .objet)).tableau)[i][j] = ((integer8 **) (*((struct_matrice *) (*s_objet).objet)).tableau)[i][0]; } liberation(s_etat_processus, s_objet); } } else if (type == 'R') { if ((s_objet_resultat = allocation(s_etat_processus, MRL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes = nombre_colonnes; (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes = nombre_lignes; if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau = malloc(((size_t) nombre_lignes) * sizeof(real8 *))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } for(i = 0; i < nombre_lignes; i++) { if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat) .objet)).tableau)[i] = malloc(((size_t) nombre_colonnes) * sizeof(real8))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } } for(j = nombre_colonnes - 1; j >= 0; j--) { if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), &s_objet) == d_erreur) { return; } if ((*s_objet).type == MIN) { for(i = 0; i < nombre_lignes; i++) { ((real8 **) (*((struct_matrice *) (*s_objet_resultat) .objet)).tableau)[i][j] = (real8) ((integer8 **) (*((struct_matrice *) (*s_objet).objet)) .tableau)[i][0]; } } else { for(i = 0; i < nombre_lignes; i++) { ((real8 **) (*((struct_matrice *) (*s_objet_resultat) .objet)).tableau)[i][j] = ((real8 **) (*((struct_matrice *) (*s_objet).objet)) .tableau)[i][0]; } } liberation(s_etat_processus, s_objet); } } else { if ((s_objet_resultat = allocation(s_etat_processus, MRL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes = nombre_colonnes; (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes = nombre_lignes; if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau = malloc(((size_t) nombre_lignes) * sizeof(complex16 *))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } for(i = 0; i < nombre_lignes; i++) { if ((((complex16 **) (*((struct_matrice *) (*s_objet_resultat) .objet)).tableau)[i] = malloc(((size_t) nombre_colonnes) * sizeof(complex16))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } } for(j = nombre_colonnes - 1; j >= 0; j--) { if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), &s_objet) == d_erreur) { return; } if ((*s_objet).type == MIN) { for(i = 0; i < nombre_lignes; i++) { (((complex16 **) (*((struct_matrice *) (*s_objet_resultat) .objet)).tableau)[i][j]).partie_reelle = (real8) ((integer8 **) (*((struct_matrice *) (*s_objet).objet)).tableau)[i][0]; (((complex16 **) (*((struct_matrice *) (*s_objet_resultat) .objet)).tableau)[i][j]).partie_imaginaire = 0; } } else if ((*s_objet).type == MRL) { for(i = 0; i < nombre_lignes; i++) { (((complex16 **) (*((struct_matrice *) (*s_objet_resultat) .objet)).tableau)[i][j]).partie_reelle = ((real8 **) (*((struct_matrice *) (*s_objet).objet)).tableau)[i][0]; (((complex16 **) (*((struct_matrice *) (*s_objet_resultat) .objet)).tableau)[i][j]).partie_imaginaire = 0; } } else { for(i = 0; i < nombre_lignes; i++) { (((complex16 **) (*((struct_matrice *) (*s_objet_resultat) .objet)).tableau)[i][j]).partie_reelle = (((complex16 **) (*((struct_matrice *) (*s_objet).objet)).tableau)[i][0]).partie_reelle; (((complex16 **) (*((struct_matrice *) (*s_objet_resultat) .objet)).tableau)[i][j]).partie_imaginaire = (((complex16 **) (*((struct_matrice *) (*s_objet).objet)).tableau)[i][0]) .partie_imaginaire; } } liberation(s_etat_processus, s_objet); } } if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), s_objet_resultat) == d_erreur) { return; } return; } /* ================================================================================ Fonction '->NUM' ================================================================================ Entrées : structure processus -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_fleche_num(struct_processus *s_etat_processus) { logical1 last_valide; struct_objet *s_objet; struct_objet *s_objet_simplifie; unsigned char registre_type_evaluation; (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n ->NUM "); if ((*s_etat_processus).langue == 'F') { printf("(évaluation d'un objet)\n\n"); } else { printf("(object evaluation)\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("-> 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_BIN, 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_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 ((last_valide = test_cfsf(s_etat_processus, 31)) == d_vrai) { if (empilement_pile_last(s_etat_processus, 1) == d_erreur) { return; } cf(s_etat_processus, 31); } registre_type_evaluation = (test_cfsf(s_etat_processus, 35) == d_vrai) ? 'E' : 'N'; cf(s_etat_processus, 35); if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), &s_objet) == d_erreur) { if (last_valide == d_vrai) { sf(s_etat_processus, 31); } if (registre_type_evaluation == 'E') { sf(s_etat_processus, 35); } else { cf(s_etat_processus, 35); } (*s_etat_processus).erreur_execution = d_ex_manque_argument; return; } if ((s_objet_simplifie = simplification(s_etat_processus, s_objet)) == NULL) { if (last_valide == d_vrai) { sf(s_etat_processus, 31); } if (registre_type_evaluation == 'E') { sf(s_etat_processus, 35); } else { cf(s_etat_processus, 35); } return; } liberation(s_etat_processus, s_objet); s_objet = s_objet_simplifie; if (evaluation(s_etat_processus, s_objet, 'N') == d_erreur) { if (last_valide == d_vrai) { sf(s_etat_processus, 31); } if (registre_type_evaluation == 'E') { sf(s_etat_processus, 35); } else { cf(s_etat_processus, 35); } liberation(s_etat_processus, s_objet); return; } liberation(s_etat_processus, s_objet); if (registre_type_evaluation == 'E') { sf(s_etat_processus, 35); } else { cf(s_etat_processus, 35); } if (last_valide == d_vrai) { sf(s_etat_processus, 31); } return; } /* ================================================================================ Fonction 'fuse' ================================================================================ Entrées : -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_fuse(struct_processus *s_etat_processus) { pthread_attr_t attributs; real8 timeout; struct_objet *s_objet_argument; (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n FUSE "); if ((*s_etat_processus).langue == 'F') { printf("(mise en place d'un fusible)\n\n"); } else { printf("(set fuse signal)\n\n"); } printf(" 1: %s, %s\n", d_INT, d_REL); 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 (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_etat_processus).presence_fusible == d_vrai) { liberation(s_etat_processus, s_objet_argument); (*s_etat_processus).erreur_execution = d_ex_fusible; return; } if ((*s_objet_argument).type == INT) { timeout = (real8) (*((integer8 *) (*s_objet_argument).objet)); } else if ((*s_objet_argument).type == REL) { timeout = (*((real8 *) (*s_objet_argument).objet)); } 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); if (timeout < 0) { (*s_etat_processus).erreur_execution = d_ex_argument_invalide; return; } (*s_etat_processus).temps_maximal_cpu = timeout; (*s_etat_processus).presence_fusible = d_vrai; (*s_etat_processus).thread_surveille_par_fusible = pthread_self(); // Génération du thread de surveillance if (pthread_attr_init(&attributs) != 0) { (*s_etat_processus).erreur_systeme = d_es_processus; return; } if (pthread_attr_setdetachstate(&attributs, PTHREAD_CREATE_DETACHED) != 0) { (*s_etat_processus).erreur_systeme = d_es_processus; return; } # ifdef SCHED_OTHER if (pthread_attr_setschedpolicy(&attributs, SCHED_OTHER) != 0) { (*s_etat_processus).erreur_systeme = d_es_processus; return; } # endif # ifdef PTHREAD_EXPLICIT_SCHED if (pthread_attr_setinheritsched(&attributs, PTHREAD_EXPLICIT_SCHED) != 0) { (*s_etat_processus).erreur_systeme = d_es_processus; return; } # endif # ifdef PTHREAD_SCOPE_SYSTEM if (pthread_attr_setscope(&attributs, PTHREAD_SCOPE_SYSTEM) != 0) { (*s_etat_processus).erreur_systeme = d_es_processus; return; } # endif if (pthread_create(&(*s_etat_processus).thread_fusible, &attributs, fusible, s_etat_processus) != 0) { (*s_etat_processus).erreur_systeme = d_es_processus; return; } if (pthread_attr_destroy(&attributs) != 0) { (*s_etat_processus).erreur_systeme = d_es_processus; return; } return; } // vim: ts=4